## suker lump desolve sim try

General FreeBASIC programming questions.
bluatigro
Posts: 620
Joined: Apr 25, 2012 10:35
Location: netherlands

### suker lump desolve sim try

this is a sim of a suker lump in water
slowly desolving

error :
where com the suker on the edge from ?

Code: Select all

`''suker lump desolve tryscreen 18 , 32dim as integer winx , winyscreeninfo winx , winypaint ( 1 , 1 ) , 0line ( winx / 4 , winy / 4 ) - step ( winx / 2 , winy / 2 ) , rgb( 255 , 255 , 255 ) , bfdim as integer x , y , dx , dydim as ulong a,bfunction range( low as integer , high as integer ) as integer  return int( rnd * ( high - low + 1 ) + low )end functionrandomize timerdo  x = range( 0 , winx )  y = range( 0 , winy )  dx = range( -1 , 1 )  dy = range( -1 , 1 )  a = point( x , y )  b = point( x + dx , y + dy )  pset ( x , y ) , b  pset ( x + dx , y + dy ) , aloop while inkey = ""`
Posts: 1777
Joined: May 24, 2007 22:10
Location: The Netherlands

### Re: suker lump desolve sim try

From using point outside the window/screen.
Reference manual wrote:If the coordinates are off-screen or off-buffer, -1 is returned

-1 is FF FF FF FF in hex is white.
MrSwiss
Posts: 3348
Joined: Jun 02, 2013 9:27
Location: Switzerland

### Re: suker lump desolve sim try

Recoded from scratch (faster than correcting):

Code: Select all

`' dissolve a piece of sugar#Define i_rng(l, h)     ( Int(Rnd() * (((h) + 1) - (l)) + (l)) ) ' color constantsConst As ULong  black = &hFF000000, white = &hFFFFFFFFScreen 18, 32Color(white, black) : Cls   ' instead of paint()Dim As Integer  winx, winyScreenInfo(winx, winy)' whatever can be pre-calculated should be (for main-loop speed)Dim As Short    wx_q = winx \ 4, wy_q = winy \ 4, _                wx3q = wx_q * 3, wy3q = wy_q * 3, _                x, y, rRandomize Timer, 3          ' initialize Mersenne Twister (FB's default)For i As UInteger = 0 To 999    ' 8000 call's: heat it up (like a cold engine)    Rnd() : Rnd() : Rnd() : Rnd() : _    Rnd() : Rnd() : Rnd() : Rnd()NextLine (wx_q, wy_q)-(wx3q, wy3q), white, BF   ' sugar pieceDo    x = i_rng(wx_q, wx3q)   ' limit to white rectangle    y = i_rng(wy_q, wy3q)   ' dito (as above)    r = i_rng(5, 10)        ' the larger the radiuses, the faster it dissolves    ScreenLock    Circle (x, y), r, black,,,, F   ' faster than single pixels (takes forever)    ScreenUnLock    Sleep(1, 1)             ' don't hog the CPULoop Until InKey() <> ""    ' inverted check (from original)`
Posts: 1777
Joined: May 24, 2007 22:10
Location: The Netherlands

### Re: suker lump desolve sim try

Recoded from scratch (faster than correcting):
...

That is not sugar, that is Swiss cheese.
MrSwiss
Posts: 3348
Joined: Jun 02, 2013 9:27
Location: Switzerland

### Re: suker lump desolve sim try

badidea wrote:That is not sugar, that is Swiss cheese.

Nope, never seen white 'original' swiss cheese (only in the USA possible). ;-)

Btw.: 'swiss cheese' is a term only in USA used, because cheese in Switzerland
usually has a name (most often related to: where its been made, location)
dodicat
Posts: 6155
Joined: Jan 10, 2006 20:30
Location: Scotland

### Re: suker lump desolve sim try

Takes a bit of time (almost real time)

Code: Select all

`''suker lump desolve tryscreen 18 , 32dim as integer winx , winyscreeninfo winx , winypaint ( 1 , 1 ) , 0line ( winx / 4 , winy / 4 ) - step ( winx / 2 , winy / 2 ) , rgb( 255 , 255 , 255 ) , bfdim as integer x , y , dx , dydim as ulong a,bfunction range( low as integer , high as integer ) as integer  return int( rnd * ( high - low + 1 ) + low )end functionrandomize timerdo  x = range( 1 , winx-2 )  y = range( 1 , winy-2 )  dx = range( -1 , 1 )  dy = range( -1 , 1 )  a = point( x , y )  b = point( x + dx , y + dy )  pset ( x , y ) , b  pset ( x + dx , y + dy ) , aloop while inkey = ""  `
Posts: 1777
Joined: May 24, 2007 22:10
Location: The Netherlands

### Re: suker lump desolve sim try

I dropped the sugar. Also very slow due to heavy use of 'point' and 'pset':

Code: Select all

`const SCRN_W = 640, SCRN_H = 480const as ulong BLACK = rgb(0, 0, 0)const as ulong WHITE = rgb(255, 255, 255)dim as integer x, y, i, dxscreenres SCRN_W, SCRN_H, 32width SCRN_W \ 8, SCRN_H \ 16randomize timerfor x = 0 to SCRN_W \ 2 - 1   for y = 0 to SCRN_H \ 2 - 1      if rnd > 0.8 then pset(x + SCRN_W \ 4, y + SCRN_H \ 4), WHITE   nextnextsleep 500while inkey = ""   for x = 1 to SCRN_W - 2 'stay awy from edge      for y = SCRN_H - 2 to 1 step -1 'bottom to top         if point(x, y) = WHITE then            'check below            if point(x, y + 1) = BLACK then               'move grain / pixel               pset(x, y), BLACK               pset(x, y + 1), WHITE            else               'check left or right first               dx = iif(rnd > 0.5, -1, +1)               if point(x + dx, y + 1) = BLACK then                  pset(x, y), BLACK                  pset(x + dx, y + 1), WHITE               elseif point(x - dx, y + 1) = BLACK then                  pset(x, y), BLACK                  pset(x - dx, y + 1), WHITE               end if            end if         end if      next   next   sleep 15wendsleep`