//
// 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)