Gumdrops

Play SiMPLE's version of the popular "BEJEWELED" game.

Source Listing

// // Program: Gumdrops // Author: Bob Bishop // Ultra-SiMPLE [Gumdrops] Common Int noise=1 Int a, b, c, d, count, map[8][8] Int ticktock, got, done Randomize title @ start: setup (0) @ hintflag=0; score=0L tabxy (35, 4); Display "Score: 0", start timer Do done test (done) @ If done delay (500) tabxy (34, 15); framed text (" Game Over!\nPress any key.", 12, 0) If (noise) twing flushkbd z=waitkey(); If (z=27) quit Goto start Endif set clock @ flush kbd Do get move (got, a, b, c, d) @ If got>0 Break clock (ticktock) @ If ticktock Or got If (!hintflag) score=score-ticktock+500*got Else score=score-ticktock If (score<0) score=0 hide mouse tabxy (35, 4); Display "Score: ",score," ", If (got) hintflag=1 Endif Loop hide mouse swap gems (a, b, c, d) @ make group map (count, map) @ If !count swap gems (a, b, c, d) @ Continue Endif count=count+(count-3)*(count-3) Do k=1,999 erase gems (map) @ score=score+100*k*count tabxy (35, 4); Display "Score: ",score, drop gems @ make group map (count, map) @ If !count Break delay (250) Loop hintflag=0 Loop //------------------------------------------------------- Task title cls line color (7) line (0, 300, 639, 300) //frame (24, 24, 615, 455) winframe tabxy (29, 6); Display "The SiMPLE CodeWorks Inc.", tabxy (36, 8); Display " Presents:", tabxy (34, 12); cwrite ("G", 12, 0) tabxy (36, 12); cwrite ("U", 14, 0) tabxy (38, 12); cwrite ("M", 10, 0) tabxy (40, 12); cwrite ("D", 9, 0) tabxy (42, 12); cwrite ("R", 13, 0) tabxy (44, 12); cwrite ("O", 11, 0) tabxy (46, 13); cwrite ("P", 12, 0) tabxy (48, 14); cwrite ("S", 14, 0) tabxy (12, 24); cwrite ("Created with SiMPLE, \"The Programming Language for Kids!\"", 8, 0) tabxy (29, 27); cwrite ("(www.simplecodeworks.com)", 1, 0) cwrite ("", 7, 0) tabxy (28, 17); Display "Press any key to continue . . .", z=waitkey(); If (z=27) quit //------------------------------------------------------- Task setup (Int color) Common Int noise Int map[8][8], count hide mouse solid color (color) solid rectangle (0, 0, 639, 479) //frame (24, 24, 615, 455) winframe frame (193, 112, 193+256, 112+256) solid color (0) solid rectangle (193, 112, 193+256, 112+256) show sound @ tabxy (5, 8); cwrite ("", 7, 0) tabxy (5, 8); Display "Use the mouse", tabxy (5, 9); Display "to swap neigh-", tabxy (5,10); Display "boring pairs of", tabxy (5,11); Display "gumdrops.", tabxy (5,13); Display "Score points by", tabxy (5,14); Display "creating rows", tabxy (5,15); Display "(or columns) of", tabxy (5,16); Display "three or more.", tabxy (5,18); Display "Each group of", tabxy (5,19); Display "three or more", tabxy (5,20); Display "will then dis-", tabxy (5,21); Display "appear, making", tabxy (5,22); Display "room for other", tabxy (5,23); Display "gumdrops.", tabxy (62, 8); Display "Hold down the", tabxy (62, 9); Display "mouse button", tabxy (62,10); Display "to \"drag\" a", tabxy (62,11); Display "gumdrop to", tabxy (62,12); Display "its neighbor.", tabxy (62,14); Display "Stuck? Press", tabxy (62,15); Display "the \"H\" key to", tabxy (62,16); Display "flash a hint.", tabxy (62,18); Display "Press the \"S\"", tabxy (62,19); Display "key to toggle", tabxy (62,20); Display "sound On/Off.", tabxy (62,22); Display "Press the \"Esc\"", tabxy (62,23); Display "key to quit.", delay (500) tabxy (35, 4); cwrite ( "Please wait...", 12, 0) Do j=7,0 fill top row @ If (j) fast drop (j) @ Else If (noise) pop Endelse Loop delay (1000) Do make group map (count, map) @ If !count Break erase gems (map) @ drop gems @ Loop delay (500) tabxy (35, 4); cwrite (" ", 7, 0) flush kbd //------------------------------------------------------ Task fast drop (Int level) * Common Int noise Do row=0,level-1 Do k=0,31,8 Do col=0,7 x=209+32*col y=128+k+32*row id=getpixel(x,y) draw gem (x, y, 0) @ draw gem (x, y+8, id) @ Loop delay (5) Loop Loop If (noise) pop delay (100) //------------------------------------------------------ Task drop gems Common Int work[8][8] Do fill top row @ flag=0 Do j=0,7 x=209+32*j Do k=0,6 y=128+32*k If getpixel(x,y) And !getpixel(x,y+32) work[j][k]=1 flag=1 Endif Else work[j][k]=0 Loop Loop If !flag Break Do k=0,31 Do row=6,0 Do col=0,7 If !work[col][row] Continue x=209+32*col y=128+32*row+k id=getpixel(x,y) draw gem (x, y+1, id) @ delay (1) Loop Loop Loop Loop //------------------------------------------------------ Task fill top row Do k=0,7 If (!getpixel(209+32*k,128)) create gem (k, random(7)+1) @ Loop //------------------------------------------------------ Task get move (Int got, Int a, Int b, Int c, Int d) Common Int hx, hy, noise Int xm, ym, zm, xbox, ybox, xtarget, ytarget show mouse Do Do wait (1) key=read key () If key=27 Call quit If key=ascii("S") Or key=ascii("s") noise=!noise hide mouse show sound @ show mouse Endif If key=ascii("H") Or key=ascii("h") hide mouse line color (14) circle (209+32*hx, 128+32*hy, 16) delay (125) line color (0) circle (209+32*hx, 128+32*hy, 16) show mouse flush kbd got=-1 Return Endif read mouse (xm, ym, zm) If zm Break got=0 Return Loop pixel2cell (xm, ym, a, b) @ If a<0 Or b<0 Continue If a>7 Or b>7 Continue xx=xm; yy=ym cell2pixel (a, b, xbox, ybox) @ hide mouse line color (15) circle (xbox, ybox, 16) show mouse Do read mouse (xm, ym, zm) If !zm Break If read key (27) Call quit pixel2cell (xm, ym, c, d) @ If a=c And b=d Continue c=a; d=b If (iabs(xm-xx)>iabs(ym-yy)) c=a+sgn(xm-xx) Else d=b+sgn(ym-yy) If a!=c And b!=d Continue If a=c And b=d Continue If c<0 Or d<0 Continue If c>7 Or d>7 Continue cell2pixel (c, d, xtarget, ytarget) @ line color (15) hide mouse circle (xtarget, ytarget, 16) show mouse delay (100) line color (0) hide mouse circle (xtarget, ytarget, 16) line color (15) circle (xbox, ybox, 16) show mouse delay (100) Loop hide mouse line color (0) circle (xbox, ybox, 16) show mouse pixel2cell (xm, ym, c, d) @ If a=c And b=d Continue c=a; d=b If (iabs(xm-xx)>iabs(ym-yy)) c=a+sgn(xm-xx) Else d=b+sgn(ym-yy) If a!=c And b!=d Continue If a=c And b=d Continue If c<0 Or d<0 Continue If c>7 Or d>7 Continue Break Loop got=1 //------------------------------------------------------ Task swap gems (Int a, Int b, Int x, Int y) ida=getpixel(209+32*a,128+32*b) idx=getpixel(209+32*x,128+32*y) da=x-a; db=y-b Do k=1,32 draw gem (209+32*a+k*da, 128+32*b+k*db, ida) @ draw gem (209+32*x-k*da, 128+32*y-k*db, idx) @ delay (10) Loop //------------------------------------------------------ Task erase gems (Int map[8][8]) Common Int noise Int x, y id=open mci ("\\simple\\sounds\\ZIP.WAV") If (noise) start mci (id, 0, 0) delay (100) Do i=1,2500 Do j=0,7 Do k=0,7 If (map[j][k]) cell2pixel (j, k, x, y) @ If i=2500 solid color (0) solid rectangle (x-16, y-16, x+16, y+16) Endif Else put pixel (x+random(33)-16, y+random(33)-16, 0) Endelse Endif Loop Loop Loop delay (100) close mci (id) //------------------------------------------------------ Task create gem (Int col, Int color) draw gem (209+32*col, 128, color) @ //------------------------------------------------------ Task cell2pixel (Int col, Int row, Int x, Int y) x=209+32*col y=128+32*row //------------------------------------------------------ Task pixel2cell (Int x, Int y, Int col, Int row) col=(x-209+48)/32-1 row=(y-128+48)/32-1 //------------------------------------------------------ Task draw gem (Int x, Int y, Int z) * Common Int shell[]={0,3,5,2,7,4,8,1} If !z solid color (0) solid rectangle (x-16, y-16, x+16, y+16) Return Endif line color (0) fill color (shell[z]) filled circle (x, y, 16) fill color (z) filled circle (x, y, 7) //------------------------------------------------------ Task make group map (Int count, Int map[8][8]) Do j=0,7 Do k=0,7 map[j][k]=0 Loop Loop Do j=0,7 x=209+32*j Do k=1,6 y=128+32*k If getpixel(x,y-32)=getpixel(x,y) And getpixel(x,y)=getpixel(x,y+32) map[j][k-1]=1 map[j][k ]=1 map[j][k+1]=1 Endif Loop Loop Do j=0,7 y=128+32*j Do k=1,6 x=209+32*k If getpixel(x-32,y)=getpixel(x,y) And getpixel(x,y)=getpixel(x+32,y) map[k-1][j]=1 map[k ][j]=1 map[k+1][j]=1 Endif Loop Loop count=0 Do j=0,7 Do k=0,7 count=count+map[j][k] Loop Loop //------------------------------------------------------ Task done test (Int done) Common Int work[8][8] Int play done=0 Do y=0,7 Do x=0,7 work[x][y]=getpixel(209+32*x,128+32*y) Loop x Loop y Do y=7,0 Do x=0,7 If x<7 And work[x][y]=work[x+1][y] htestxx (x, y, play) @ If play Return Endif If x<6 And work[x][y]=work[x+2][y] htestxox (x+1, y, play) @ If play Return Endif If y<7 And work[x][y]=work[x][y+1] vtestxx (x, y, play) @ If play Return Endif If y<6 And work[x][y]=work[x][y+2] vtestxox (x, y+1, play) @ If play Return Endif Loop x Loop y done=1 //------------------------------------------------------ Task htestxx (Int x, Int y, Int play) * Common Int work[8][8] Common Int hx, hy play=0; base=work[x][y] // Test left side If x>0 And y>0 And work[x-1][y-1]=base hx=x-1; hy=y-1 play=1; Return Endif If x>1 And work[x-2][y]=base hx=x-2; hy=y play=1; Return Endif If x>0 And y<7 And work[x-1][y+1]=base hx=x-1; hy=y+1 play=1; Return Endif // Test right side If x<6 And y>0 And work[x+2][y-1]=base hx=x+2; hy=y-1 play=1; Return Endif If x<5 And work[x+3][y]=base hx=x+3; hy=y play=1; Return Endif If x<6 And y<7 And work[x+2][y+1]=base hx=x+2; hy=y+1 play=1; Return Endif //------------------------------------------------------ Task vtestxx (Int x, Int y, Int play) * Common Int work[8][8] Common Int hx, hy play=0; base=work[x][y] // Test top side If x>0 And y>0 And work[x-1][y-1]=base hx=x-1; hy=y-1 play=1; Return Endif If y>1 And work[x][y-2]=base hx=x; hy=y-2 play=1; Return Endif If x<7 And y>0 And work[x+1][y-1]=base hx=x+1; hy=y-1 play=1; Return Endif // Test bottom side If x>0 And y<6 And work[x-1][y+2]=base hx=x-1; hy=y+2 play=1; Return Endif If y<5 And work[x][y+3]=base hx=x; hy=y+3 play=1; Return Endif If x<7 And y<6 And work[x+1][y+2]=base hx=x+1; hy=y+2 play=1; Return Endif //------------------------------------------------------ Task htestxox (Int x, Int y, Int play) * Common Int work[8][8] Common Int hx, hy play=0; base=work[x-1][y] If y>0 And work[x][y-1]=base hx=x; hy=y-1 play=1; Return Endif If y<7 And work[x][y+1]=base hx=x; hy=y+1 play=1; Return Endif //------------------------------------------------------ Task vtestxox (Int x, Int y, Int play) * Common Int work[8][8] Common Int hx, hy play=0; base=work[x][y-1] If x>0 And work[x-1][y]=base hx=x-1; hy=y play=1; Return Endif If x<7 And work[x+1][y]=base hx=x+1; hy=y play=1; Return Endif //------------------------------------------------------ Task clock (Int ticktock) Common Int old=0 new=elapsed time()/1000 ticktock=new-old old=new //------------------------------------------------------ Task set clock Common Int old old=elapsed time()/1000 //------------------------------------------------------ Task show sound * Common Int noise line color (7) If (noise) fill color (2) Else fill color (4) filled rectangle (316, 421, 326, 426)

How To Run The Program If you're feeling ambitious and have nothing better to do, you could just copy the source listing by hand! However, there is a much easier way to do it: Copy the source listing into the Windows Clipboard Paste the Clipboard into a new text document Drop that text document onto the "Drop SiMPLE Listing Here" icon Or, if you don't have SiMPLE installed on your computer, click here to run the precompiled version of the program.

(If you would like to contribute any of your SiMPLE programs to The Gallery, just e-mail them to us.)

  [ Webmaster | FAQ's | Home Page | Contact Us ]

© Copyright 2006 SiMPLE CodeWorks, Inc. All rights reserved.