## suker lump desolve sim try

General FreeBASIC programming questions.
bluatigro
Posts: 651
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 try

screen 18 , 32
dim as integer winx , winy
screeninfo winx , winy
paint ( 1 , 1 ) , 0
line ( winx / 4 , winy / 4 ) - step ( winx / 2 , winy / 2 ) , rgb( 255 , 255 , 255 ) , bf
dim as integer x , y , dx , dy
dim as ulong a,b
function range( low as integer , high as integer ) as integer
return int( rnd * ( high - low + 1 ) + low )
end function
randomize timer
do
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 ) , a
loop while inkey = ""
Posts: 2132
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: 3583
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 constants
Const As ULong  black = &hFF000000, white = &hFFFFFFFF

Screen 18, 32
Color(white, black) : Cls   ' instead of paint()

Dim As Integer  winx, winy
ScreenInfo(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, r

Randomize 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()
Next

Line (wx_q, wy_q)-(wx3q, wy3q), white, BF   ' sugar piece

Do
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 CPU
Loop Until InKey() <> ""    ' inverted check (from original)
Posts: 2132
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: 3583
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: 6650
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 try

screen 18 , 32
dim as integer winx , winy
screeninfo winx , winy
paint ( 1 , 1 ) , 0
line ( winx / 4 , winy / 4 ) - step ( winx / 2 , winy / 2 ) , rgb( 255 , 255 , 255 ) , bf
dim as integer x , y , dx , dy
dim as ulong a,b

function range( low as integer , high as integer ) as integer
return int( rnd * ( high - low + 1 ) + low )
end function

randomize timer
do
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 ) , a
loop while inkey = ""
Posts: 2132
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 = 480
const as ulong BLACK = rgb(0, 0, 0)
const as ulong WHITE = rgb(255, 255, 255)

dim as integer x, y, i, dx

screenres SCRN_W, SCRN_H, 32
width SCRN_W \ 8, SCRN_H \ 16

randomize timer
for 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
next
next

sleep 500

while 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 15
wend

sleep