Rosetta Code

Task - Implement the Abelian sandpile model.

I've been playing with various animations of cascading sand or paint arriving on a target, with various distributions of arrival ( eg all arrive in a stream at one point) or distributed unifomly over a stated area, or normally distributed according to the 'bell curve'. A bit like using a spray gun or spray graphics tool... and you get great graphic effects by experimenting with various colour-coded ranges as well as white-to-black.

The common problem is that updating a graphic screen is limited by the huge overhead of running a GUI display on modern machines. I get past this usually by writing direct to arrays and to bmp files. Results can be pretty fast, but look great if you assemble the saved bmp images into an animated GIF. This is a one-liner using GIMP programmatically ( see my other pages) or from its own GUI.

The top edge of these images is the colour or greyscale gradient being used to represent 256 levels.

- -

The Rosetta Code task requires the creation of a 2D grid of arbitrary size on which "piles of sand" can be placed. Any "pile" that has 4 or more sand particles on it collapses, resulting in four particles being subtracted from the pile and distributed among its neighbors. Here black, red, orange and yellow represent piles of 0, 1, 2 or 3 grains of sand. The number shown is the number of grains deposited on the centre spot. On Rosetta Code it is striking how well-adapted Liberty BASIC is to such graphics tasks- many languages struggle to produce very limited representations. But do look at the referenced Wikipedia article- machines doing 10,000,000,000 iterations on large surfaces!!

LB Code

Will be added in-line here soon or as a downloadable zip file. 

    nomainwin

    WindowWidth  =416: WindowHeight =436

    open "Sand Pile- on-screen updates" for graphics_nsb as #wg

    #wg "trapclose quit"
    #wg "down ; fill 40 40 40 ; size 8 ; backcolor black"

    dim sandtray( 40, 40), c$( 10000)

    c$( 0)  ="40 40 40" '   grey red orange yellow cyan
    c$( 1)  ="red"
    c$( 2)  ="220 180  30"
    c$( 3)  ="255 255  80"
    for i =4 to 10000
        c$( i)  ="cyan"
    next i

    '   tray is 40x40, coordinates x, y between 0 and 39
  [main]
    for n =1 to 257
        'calldll #kernel32, "Sleep", 1000 as long, ret as void
        #wg "cls ; fill 40 40 40"

        for y =0 to 39
            for x =0 to 39
                sandtray( x, y) =0
            next x
        next y

        sandtray( 20, 20) =n
        #wg "color "; c$( sandtray( 20, 20))
        #wg "down ; set "; 10 *20 +2; " "; 10 *20 +2

        calldll #kernel32, "Sleep", 1000 as long, ret as void

        call tumble 20, 20

        for u =1 to 5000
            x   =int( 1 +39 *rnd( 1)): y =int( 1 +39 *rnd( 1))
            call tumble x, y
        next u

        #wg "up ; goto 170 100 ; down ; color white ; font 24"
        #wg "\" +str$( n)
        #wg "flush ; getbmp scr 50 50 300 300"
        bmpsave "scr", "P/scr" +right$( "0000" +str$( n), 4) +".bmp"

        'calldll #kernel32, "Sleep", 1000 as long, ret as void

    next n

    wait

    sub tumble x, y '   four direcions -make target tumble to zero, distribute to four neighbours, and lose any that fall off edges /corners.
        [h]
        if sandtray( x, y) >=4 then
            sandtray( x   , y  )  =sandtray( x   , y  )  -4:               #wg "color "; c$( sandtray( x, y))      : #wg "set "; 10 *x       +2   ; " "; 10 *y    +2

            if x <38 then sandtray( x +1, y  )  =sandtray( x +1, y   ) +1: #wg "color "; c$( sandtray( x +1, y   )): #wg "set "; 10 *( x +1) +2; " "; 10 *y       +2 : call tumble x +1, y:    'calldll #kernel32, "Sleep", 100 as long, ret as void
            if x >1  then sandtray( x -1, y  )  =sandtray( x -1, y   ) +1: #wg "color "; c$( sandtray( x -1, y   )): #wg "set "; 10 *( x -1) +2; " "; 10 *y       +2 : call tumble x -1, y:    'calldll #kernel32, "Sleep", 100 as long, ret as void
            if y <38 then sandtray( x   , y +1) =sandtray( x   , y +1) +1: #wg "color "; c$( sandtray( x   , y +1)): #wg "set "; 10 *x       +2; " "; 10 *( y +1) +2 : call tumble x   , y +1: 'calldll #kernel32, "Sleep", 100 as long, ret as void
            if y >1  then sandtray( x   , y -1) =sandtray( x   , y -1) +1: #wg "color "; c$( sandtray( x   , y -1)): #wg "set "; 10 *x       +2; " "; 10 *( y -1) +2 : call tumble x   , y -1: 'calldll #kernel32, "Sleep", 100 as long, ret as void
        end if
        if sandtray( x, y) >=4 then [h]
        scan
    end sub

    sub quit h$
        close #wg
        end
    end sub