Falling Sand

-=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- (c) WidthPadding Industries 1987 0\|471\|0 -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=-
SoCoder -> Snippet Home -> Graphical Effects

flying_cucco	Created : 12 May 2007 System : Windows Language : Cobra Falling Sand My first Cobra program
program uses pure2d,keyset const emptycellcolor = $ff000000 wallcellcolor = $ffffffff planewidth = 200 planeheight = 200 pensize = 3 screenplaneoffsetx = 100 screenplaneoffsety = 20 var sandplane : element i : integer starttime : integer procedure SandDrawScreen begin //draw to screen CLS($ff000040) DrawImage(sandplane,screenplaneoffsetx,screenplaneoffsety) //Text(20,20,i) Text(20,20,"fps: "+((i*1000)/(Millisecs-starttime))) Flip end procedure SandGetInput var x : integer y : integer begin //if Left mouse button then paint wall if MouseDown(0) if (MouseX>screenplaneoffsetx) and (MouseX<screenplaneoffsetx+planewidth) if (MouseY>screenplaneoffsety) and (MouseY<screenplaneoffsety+planeheight) for x =0 to pensize-1 for y=0 to pensize-1 PixelFast(MouseX+x-screenplaneoffsetx,MouseY+y-screenplaneoffsety,wallcellcolor,sandplane) next next endif endif endif //if Right mouse button then clear wall if MouseDown(1) if (MouseX>screenplaneoffsetx) and (MouseX<screenplaneoffsetx+planewidth) if (MouseY>screenplaneoffsety) and( MouseY<screenplaneoffsety+planeheight) for x =0 to pensize-1 for y=0 to pensize-1 PixelFast(MouseX+x-screenplaneoffsetx,MouseY+y-screenplaneoffsety,emptycellcolor,sandplane) next next endif endif endif end procedure SandUpdate var x,y : integer sandcellcolor : integer begin //loop pixels for y=planeheight-2 to 0 step -1 for x=0 to planewidth-1 //is not empty if PixelFast(x,y,sandplane)<>emptycellcolor //is not wall if PixelFast(x,y,sandplane)<>wallcellcolor //below empty? if PixelFast(x,y+1,sandplane)=emptycellcolor //get color sandcellcolor=PixelFast(x,y,sandplane) //move cell PixelFast(x,y,emptycellcolor,sandplane) PixelFast(x,y+1,sandcellcolor,sandplane) else //below Left empty? if (x>0) and (PixelFast(x-1,y+1,sandplane)=emptycellcolor) //get color sandcellcolor=PixelFast(x,y,sandplane) //move cell PixelFast(x,y,emptycellcolor,sandplane) PixelFast(x-1,y+1,sandcellcolor,sandplane) else //below Right empty? if (x<planewidth-1) and (PixelFast(x+1,y+1,sandplane)=emptycellcolor) //get color sandcellcolor=PixelFast(x,y,sandplane) //move cell PixelFast(x,y,emptycellcolor,sandplane) PixelFast(x+1,y+1,sandcellcolor,sandplane) endif endif endif endif endif next next end procedure SandInitPlane var x : integer y : integer begin //make plane sandplane = CreateImage(planewidth,planeheight) //fill space for x=0 to planewidth-1 for y=0 to planeheight-1 PixelFast(x,y,emptycellcolor,sandplane) next next end procedure SandSourceSink var sandcellcolor : integer begin //new grains sandcellcolor=ToRGBA(255,i mod 255,0,255) PixelFast(Rand(0,planewidth-1),0,sandcellcolor,sandplane) sandcellcolor=ToRGBA(0,i mod 255,255,255) PixelFast(Rand(100,105),0,sandcellcolor,sandplane) //sink PixelFast(50,planeheight-1,emptycellcolor,sandplane) PixelFast(51,planeheight-1,emptycellcolor,sandplane) end begin starttime = Millisecs //set graphics OpenScreen(320,240,32,FALSE) //start up SandInitPlane //main loop repeat SandSourceSink inc(i) SandGetInput //SandDropSand //SandMoveSand SandUpdate SandDrawScreen until KeyDown(VK_ESCAPE) end --v

Comments

Comments