suker lump desolve sim try

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

suker lump desolve sim try

Postby bluatigro » Jun 26, 2019 13:14

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 = ""
badidea
Posts: 1461
Joined: May 24, 2007 22:10
Location: The Netherlands

Re: suker lump desolve sim try

Postby badidea » Jun 26, 2019 17:25

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: 3220
Joined: Jun 02, 2013 9:27
Location: Switzerland

Re: suker lump desolve sim try

Postby MrSwiss » Jun 26, 2019 17:39

Read comments in code ...
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)
badidea
Posts: 1461
Joined: May 24, 2007 22:10
Location: The Netherlands

Re: suker lump desolve sim try

Postby badidea » Jun 26, 2019 18:29

MrSwiss wrote:Read comments in code ...
Recoded from scratch (faster than correcting):
...

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

Re: suker lump desolve sim try

Postby MrSwiss » Jun 26, 2019 18:38

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: 5913
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: suker lump desolve sim try

Postby dodicat » Jun 26, 2019 19:30

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 = "" 
badidea
Posts: 1461
Joined: May 24, 2007 22:10
Location: The Netherlands

Re: suker lump desolve sim try

Postby badidea » Jun 26, 2019 23:02

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

Return to “General”

Who is online

Users browsing this forum: No registered users and 4 guests