//
// snake:
//    Classic Snake game
//    Written in RTB - Return to BASIC
//    http://projects.drogon.net/return-to-basic/
//
PROC setup
PROC welcome
PROC getSpace
//
// Main Game Loops
//
CYCLE 
  PROC reset
  //
  // Border
  //
  COLOUR = Pink
  RECT (0, 0, GWIDTH, GHEIGHT, 0)
  RECT (1, 1, GWIDTH - 1, GHEIGHT  - 1, 0)
  CYCLE 
    //
    loopStartTime = TIME
    //
    PROC displaySnake(FALSE)
    //
    // Check keyboard
    //
    key = INKEY
    SWITCH (key)
      CASE KeyUp
        xSpeed = 0
        ySpeed = snakeDia
      ENDCASE 
      CASE KeyDown
        xSpeed = 0
        ySpeed =  - snakeDia
      ENDCASE 
      CASE KeyLeft
        xSpeed =  - snakeDia
        ySpeed = 0
      ENDCASE 
      CASE KeyRight
        xSpeed = snakeDia
        ySpeed = 0
      ENDCASE 
      // Debugging
      CASE 98
        PROC shorter(5)
      ENDCASE 
      CASE 97
        PROC longer(5)
      ENDCASE 
      CASE 32
        PROC longer(1)
      ENDCASE 
    ENDSWITCH 
    //
    // Slow ticker?
    //
    IF TIME > slowTick THEN 
      PROC shorter(1)
      slowTick = TIME + slowTickTime
    ENDIF 
    //
    PROC checkFood
    PROC updateSnake
    PROC displaySnake(TRUE)
    // collision?
    IF FN collided THEN 
      BREAK 
    ENDIF 
    //
    // Quick ticker?
    //
    IF TIME > quickTick THEN 
      PROC moreFood
      quickTick = TIME + quickTickTime
    ENDIF 
    //
    UPDATE 
    //
    // We want 10 updates/sec
    //
    loopTime = TIME - loopStartTime // mS
    delayTime = 100 - loopTime
    IF delayTime < 0 THEN delayTime = 0
    WAIT (delayTime / 1000)
  REPEAT 
  //
  // We've broken out - the result of a collision
  //
  x = snakeX(0)
  y = snakeY(0)
  COLOUR = Pink
  ELLIPSE (x, y, snakeDia * 2, snakeRad, 1)
  ELLIPSE (x, y, snakeRad, snakeDia * 2, 1)
  UPDATE 
  WAIT (2)
  PROC printTitle
  TCOLOUR = Pink
  IF numSegs > highScore THEN 
    highScore = numSegs
    PROC center("New High Score: " + STR$ (numSegs))
  ELSE 
    PROC center("You scored: " + STR$ (numSegs))
    PRINT 
    PROC center("Current high score: " + STR$ (highScore))
  ENDIF 
  PROC getSpace
REPEAT 
END 
//
// checkFood:
//    Eat food (if we land on it!)
//
DEF PROC checkFood
LOCAL i, x, y
x = snakeX(0)
y = snakeY(0)
FOR i = 1 TO mxFood CYCLE 
  IF (foodX(i) = x) AND (foodY(i) = y) THEN 
    PROC longer(3)
    foodX(i) = 0
    BREAK 
  ENDIF 
REPEAT 
ENDPROC 
//
// moreFood:
//    See if we can put more food on the table
//
DEF PROC moreFood
LOCAL i, j, hit, fx, fy, store
store = 0
// Can we store more food?
FOR i = 1 TO mxFood CYCLE 
  IF foodX(i) = 0 THEN 
    store = i
    BREAK 
  ENDIF 
REPEAT 
IF store = 0 THEN ENDPROC  // Table full
// find a free slot
//     ie. don't land food on the snake or a rock
FOR i = 1 TO 5 CYCLE  // Only try 5 times, then give up
  fx = (RND (screenSegsWide - 2) + 1) * snakeDia
  fy = (RND (screenSegsHigh - 2) + 1) * snakeDia
  hit = FALSE
  FOR j = 0 TO numSegs - 1 CYCLE 
    IF snakeX(j) = fx AND snakeY(j) = fy THEN hit = TRUE
  REPEAT 
  IF hit THEN CONTINUE 
REPEAT 
IF hit THEN ENDPROC  // Oops. Can't find space!
// Draw a raspberry ...
//    although it could be a strawberry - hard to tell, really...
COLOUR = Maroon
CIRCLE (fx, fy, snakeRad * 0.8, 1)
COLOUR = Green
CIRCLE (fx - sr3, fy + sr3, sr3, 1)
CIRCLE (fx + sr3, fy + sr3, sr3, 1)
// Store location
foodX(store) = fx
foodY(store) = fy
ENDPROC 
//
// collided:
//    Did we hit something? Either ourself, or a wall
//
DEF FN collided
LOCAL x0, y0, i, hit
x0 = snakeX(0)
y0 = snakeY(0)
// Check walls
IF x0 = 0 THEN  = TRUE
IF y0 = 0 THEN  = TRUE
IF x0 / snakeDia = screenSegsWide THEN  = TRUE
IF y0 / snakeDia = screenSegsHigh THEN  = TRUE
// Now scan the snake
hit = FALSE
FOR i = 1 TO numSegs - 1 CYCLE 
  IF (snakeX(i) = x0) AND (snakeY(i) = y0) THEN hit = TRUE
REPEAT 
 = hit
//
// updateSnake
//    Move it along
//
DEF PROC updateSnake
LOCAL x0, y0, i
x0 = snakeX(0) + xSpeed
y0 = snakeY(0) + ySpeed
FOR i = numSegs - 1 TO 1 STEP -1 CYCLE 
  snakeX(i) = snakeX(i - 1)
  snakeY(i) = snakeY(i - 1)
REPEAT 
snakeX(0) = x0
snakeY(0) = y0
ENDPROC 
//
// longer
//    Add some length to it!
//
DEF PROC longer(segments)
LOCAL new, i
new = numSegs + segments
FOR i = numSegs TO new CYCLE 
  snakeX(i) = snakeX(numSegs - 1)
  snakeY(i) = snakeY(numSegs - 1)
REPEAT 
numSegs = new
ENDPROC 
//
// shorter
//    Remove some length from it!
//
DEF PROC shorter(segments)
LOCAL new
new = numSegs - segments
IF new < 2 THEN 
  numSegs = 2
ELSE 
  numSegs = new
ENDIF 
ENDPROC 
//
// displaySnake:
//    Put the snake on the display, or erase it!
//
DEF PROC displaySnake(displayIt)
LOCAL i
IF displayIt THEN 
  // Tongue
  COLOUR = Green
  IF xSpeed = 0 THEN  // Up/Down
    IF ySpeed > 0 THEN  // Up
      ELLIPSE (snakeX(0), snakeY(0) + snakeRad, snakeRad / 2, snakeRad, 1)
    ELSE 
      ELLIPSE (snakeX(0), snakeY(0) - snakeRad, snakeRad / 2, snakeRad, 1)
    ENDIF 
  ELSE  // Left/Right
    IF (xSpeed > 0) THEN  // Right
      ELLIPSE (snakeX(0) + snakeRad, snakeY(0), snakeRad, snakeRad / 2, 1)
    ELSE 
      ELLIPSE (snakeX(0) - snakeRad, snakeY(0), snakeRad, snakeRad / 2, 1)
    ENDIF 
  ENDIF 
  // Head
  COLOUR = Red
  CIRCLE (snakeX(0), snakeY(0), snakeRad, 1)
  COLOUR = Yellow
  CIRCLE (snakeX(0), snakeY(0), snakeRad / 2, 1)
  // Body
  COLOUR = Yellow
  FOR i = 1 TO numSegs - 1 CYCLE 
    COLOUR = Yellow
    CIRCLE (snakeX(i), snakeY(i), snakeRad, 1)
    COLOUR = Red
    CIRCLE (snakeX(i), snakeY(i), snakeRad / 2, 1)
  REPEAT 
ELSE  // Erase it
  COLOUR = 0
  // Tongue
  IF xSpeed = 0 THEN  // Up/Down
    IF ySpeed > 0 THEN  // Up
      ELLIPSE (snakeX(0), snakeY(0) + snakeRad, snakeRad / 2, snakeRad, 1)
    ELSE 
      ELLIPSE (snakeX(0), snakeY(0) - snakeRad, snakeRad / 2, snakeRad, 1)
    ENDIF 
  ELSE  // Left/Right
    IF (xSpeed > 0) THEN  // Right
      ELLIPSE (snakeX(0) + snakeRad, snakeY(0), snakeRad, snakeRad / 2, 1)
    ELSE 
      ELLIPSE (snakeX(0) - snakeRad, snakeY(0), snakeRad, snakeRad / 2, 1)
    ENDIF 
  ENDIF 
  ELLIPSE (snakeX(0) - snakeRad, snakeY(0), snakeRad, snakeRad / 2, 1)
  // Head + Body
  FOR i = 0 TO numSegs - 1 CYCLE 
    RECT (snakeX(i) - snakeRad, snakeY(i) - snakeRad, snakeDia + 1, snakeDia + 1, 1)
    //CIRCLE (snakeX(i), snakeY(i), snakeRad, 1)
  REPEAT 
ENDIF 
ENDPROC 
//
// printTitle
//
DEF PROC printTitle
CLS 
HVTAB (TWIDTH / 2 - 5, 4)
TCOLOUR = Red
PRINT "S ";  
TCOLOUR = Yellow
PRINT "N ";  
TCOLOUR = Red
PRINT "A ";  
TCOLOUR = Yellow
PRINT "K ";  
TCOLOUR = Red
PRINT "E";  
HVTAB (TWIDTH / 2 - 5, 5)
TCOLOUR = Yellow
PRINT "========="
PRINT 
ENDPROC 
//
// getSpace:
//
DEF PROC getSpace
TCOLOUR = White
PRINT 
PRINT 
PROC center("Press the SPACE bar when ready ")
CYCLE 
REPEAT UNTIL GET$ = " "
ENDPROC 
//
// welcome
//    Splash screen and instructions
//
DEF PROC welcome
PROC printTitle
TCOLOUR = White
PROC center("Instructions ? ")
CYCLE 
  x$ = GET$
  IF x$ > "`" THEN x$ = CHR$ (ASC (x$) - 32)
REPEAT UNTIL x$ = "Y" OR x$ = "N"
IF x$ = "Y" THEN 
  PRINT "Yes."
  RESTORE
  CYCLE 
    READ x$
    IF x$ = "*" THEN BREAK 
    PROC center(x$)
    PRINT 
  REPEAT 
ENDIF 
ENDPROC 
//
// center:
//    Display centered text
//
DEF PROC center(s$)
LOCAL i
HTAB = TWIDTH / 2 - LEN (s$) / 2
PRINT s$;  
ENDPROC 
//
// reset:
//    Reset for a new game
//
DEF PROC reset
CLS 
//
// Initialise the snake with 5 segments, and going left
//
numSegs = 5
FOR i = 0 TO numSegs - 1 CYCLE 
  snakeX(i) = INT (screenSegsWide / 2) * snakeDia + i * snakeDia
  snakeY(i) = INT (screenSegsHigh / 2) * snakeDia
REPEAT 
xSpeed =  - snakeDia
ySpeed = 0
//
// Food
//
FOR i = 0 TO mxFood CYCLE 
  foodX(i) = 0
  foodY(i) = 0
REPEAT 
//
// Reset timers
//
quickTick = TIME + quickTickTime
slowTick = TIME + slowTickTime
ENDPROC 
//
// setup:
//    Initilise the game
//
DEF PROC setup
LOCAL i
//
// Cope with varying screen sizes
//
HGR 
screenSegsWide = 40
snakeDia = INT (GWIDTH / screenSegsWide)
snakeRad = INT (snakeDia / 2)
screenSegsHigh = INT (GHEIGHT / (snakeDia))
sr3 = snakeRad / 3
//
// Storage for the snake coordinates
//    0 to numSegs -1 with 0 being the head.
//
DIM snakeX(screenSegsWide * screenSegsHigh)
DIM snakeY(screenSegsWide * screenSegsHigh)
//
// Food
//
mxFood = INT (screenSegsWide * screenSegsHigh / 200)
DIM foodX(mxFood), foodY(mxFood)
//
// Timers, etc.
//
quickTickTime = 4000
slowTickTime = 9000
highScore = 0
ENDPROC 
//
// Debugging
//
DEF PROC debug
LOCAL i
PRINT "numSegs: ";  numSegs
NUMFORMAT (4, 0)
FOR i = 0 TO numSegs - 1 CYCLE 
  PRINT i;  ": ";  
  PRINT snakeX(i);  ",";  snakeY(i)
REPEAT 
PRINT "mxFood: ";  mxFood
FOR i = 1 TO mxFood CYCLE 
  PRINT i;  ": ";  
  PRINT foodX(i);  ",";  foodY(i)
REPEAT 
ENDPROC 
//
// Data for the instructions, etc.
//
DATA ""
DATA "Control the snake with the arrow keys"
DATA "Use the UP, DOWN, LEFT and RIGHT keys to change the"
DATA "snakes direction"
DATA ""
DATA "Look for food - Raspberry-like things but avoid rocks!"
DATA ""
DATA "Food will make the snake grow, but if you don't feed it,"
DATA "then it will shrink."
DATA ""
DATA "The longer the snake, the more points you get!"
DATA ""
DATA "*"