'===========================================================================
' Subject: SNAKE-GAME (LIKE NIBBLES)         Date: 07-11-98 (11:40)       
' Author:  Anders Olofsson                   Code: QB, QBasic, PDS        
' Origin:  anders.olofsson@mail.bip.net    Packet: GAMES.ABC
'===========================================================================
'
'   Simple snake-game with 10 different skill levels.
'
'     By Anders Olofsson 1998.
'
'        E-mail: anders.olofsson@mail.bip.net
'
'

DEFINT A-Z
DECLARE SUB Makelevel (Num%)
DECLARE SUB QuitProgram ()
DECLARE SUB RAlign (Row%, text$)
DECLARE SUB ClrScr (Dir%)
DECLARE SUB MoveSnake ()
DECLARE FUNCTION Keyboard% ()
DECLARE SUB Playgame ()
DECLARE SUB Intro ()
DECLARE SUB Center (Row%, text$)
DECLARE SUB Delay (HowLong!)
DECLARE FUNCTION Ascii% (Y%, X%)
DECLARE FUNCTION Colr% (Y%, X%)
DECLARE SUB YouWin ()
DECLARE SUB Updatesnake ()
DECLARE SUB Updatescreen ()
DECLARE SUB UpdateSnakes (NumSnakes%)
DECLARE SUB Demo ()


CONST Right = 1
CONST Up = 2
CONST Left = 3
CONST Down = 4

TYPE SnakeType      'Keeps information about the snake
 Row AS INTEGER
 Col AS INTEGER
 Score AS INTEGER
 Lives AS INTEGER
 Direction AS INTEGER
 SnakeColor AS INTEGER
 Currentlen AS INTEGER
 Maxlen AS INTEGER
END TYPE

TYPE BG              'To save background where the snake has been
 Row AS INTEGER
 Col AS INTEGER
 Old AS STRING * 2
END TYPE

DIM SHARED Background(1 TO 399) AS BG
DIM SHARED Snake AS SnakeType

CONST BorderColor = 1
CONST WallColor = 4

 CONST GameDelay = .1

CONST RArrow = -77, LArrow = -75, UpArrow = -72, DnArrow = -80
CONST MaxRows = 50, MaxCols = 80

'-------------------------------------------------------------------


RANDOMIZE TIMER

CLS


Intro        'Demo of snake & show my name...

Playgame

END

FUNCTION Ascii (Y, X)
 DEF SEG = &HB800
   Memloc = 80 * (Y - 1) + (X - 1)
   Memloc = Memloc * 2
   Ascii = PEEK(Memloc)

END FUNCTION

SUB Center (Row, text$)
LOCATE Row, 41 - LEN(text$) \ 2: PRINT text$;
END SUB

SUB ClrScr (WhichWay)

T! = TIMER
DO
 WAIT 64, 128: WAIT 64, 128, 128: P& = P& + 1
LOOP UNTIL TIMER - T! > .5

Del% = P& / 250


DEF SEG = &HB800

IF WhichWay = 1 THEN
StartC = 0: EndC = 4000: St = 1
ELSE
StartC = 4000: EndC = 0: St = -1
END IF

FOR S = StartC TO EndC STEP St
 POKE 4000 - S, 0
 POKE 4000 + S, 0
 FOR Z% = 0 TO Del%: WAIT 64, 128: WAIT 64, 128, 128: NEXT
NEXT

END SUB

FUNCTION Colr (Y, X)
 DEF SEG = &HB800
   Memloc = 80 * (Y - 1) + (X - 1)
   Memloc = Memloc * 2
   Colr = PEEK(Memloc + 1)

END FUNCTION

SUB Delay (HowLong!)
T! = TIMER: DO: LOOP UNTIL TIMER - T! > HowLong!
END SUB

SUB Intro

Updatescreen
 
  Snake.Row = 1
  Snake.Col = 2
  Snake.Direction = Down
  Snake.SnakeColor = 9 + RND * 5
  Snake.Maxlen = 40
  Snake.Currentlen = 0

COLOR 0, 3

Center MaxRows \ 2 - 1, "ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿"
    Center MaxRows \ 2, "³  Snake game by Anders Olofsson...  ³"
Center MaxRows \ 2 + 1, "ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ"

LOCATE , , 0

DO
 
  MoveSnake
 
  IF Snake.Row = 2 AND Snake.Direction = Up THEN
   IF Snake.Col <> 79 THEN Snake.Direction = Right ELSE Snake.Direction = Left
  END IF
 
  IF Snake.Row = MaxRows - 1 AND Snake.Direction = Down THEN
   IF Snake.Col <> MaxCols - 1 THEN Snake.Direction = Right ELSE Snake.Direction = Left
  END IF

  IF Snake.Col = MaxCols - 1 AND Snake.Direction = Right THEN
   IF Snake.Row <> 2 THEN Snake.Direction = Up ELSE Snake.Direction = Down
  END IF

  IF Snake.Col = 2 AND Snake.Direction = Left THEN
   IF Snake.Row <> MaxRows - 1 THEN Snake.Direction = Down ELSE Snake.Direction = Up
  END IF


 Updatesnake

 'Delay .02                       'use the one you prefer
 WAIT &H3DA, 8: WAIT &H3DA, 8, 1

 IF LEN(INKEY$) THEN EXIT DO
 IF (Snake.Row = 2 AND Snake.Col = 3) THEN NumTimes = NumTimes + 1

LOOP UNTIL NumTimes = 2

 ClrScr 2

END SUB

FUNCTION Keyboard
S$ = INKEY$
 IF LEN(S$) = 1 THEN
  Keyboard = ASC(S$)
 ELSEIF LEN(S$) = 2 THEN
  Keyboard = -ASC(RIGHT$(S$, 1))
 END IF
END FUNCTION

SUB Makelevel (Num)

COLOR WallColor, 0

SELECT CASE Num

CASE 2
 FOR R = MaxRows \ 2 - 10 TO MaxRows \ 2 + 10
  LOCATE R, MaxCols \ 2 - 20: PRINT CHR$(219);
  LOCATE R, MaxCols \ 2 + 20: PRINT CHR$(219);
 NEXT

CASE 3
 FOR R = MaxRows \ 2 - 10 TO MaxRows \ 2 + 10
  LOCATE R, MaxCols \ 2 - 10: PRINT CHR$(219);
  LOCATE R, MaxCols \ 2 + 10: PRINT CHR$(219);
  LOCATE R, MaxCols \ 2 - 20: PRINT CHR$(219);
  LOCATE R, MaxCols \ 2 + 20: PRINT CHR$(219);
 NEXT

CASE 4
  FOR R = MaxRows \ 2 - 11 TO MaxRows \ 2 + 11
   LOCATE R, MaxCols \ 2 - 20: PRINT CHR$(219);
   LOCATE R, MaxCols \ 2 + 20: PRINT CHR$(219);
  NEXT
 
  FOR C = MaxCols \ 2 - 18 TO MaxCols \ 2 + 18
   LOCATE MaxRows \ 2 - 10, C: PRINT CHR$(219);
   LOCATE MaxRows \ 2 + 10, C: PRINT CHR$(219);
  NEXT

CASE 5
 FOR C = 2 TO MaxCols - 2 STEP 3
  LOCATE MaxRows \ 2 - 15, C: PRINT CHR$(219);
  LOCATE MaxRows \ 2 + 15, C: PRINT CHR$(219);
 NEXT


CASE 6
 FOR R = MaxRows \ 2 - 10 TO MaxRows \ 2 + 10 STEP 2
  LOCATE R, MaxCols \ 2 - 20: PRINT CHR$(219);
  LOCATE R, MaxCols \ 2 + 20: PRINT CHR$(219);
 NEXT
 FOR C = MaxCols \ 2 - 20 TO MaxCols \ 2 + 20 STEP 2
  LOCATE MaxRows \ 2 - 10, C: PRINT CHR$(219);
  LOCATE MaxRows \ 2 + 10, C: PRINT CHR$(219);
 NEXT

CASE 7
 DIM Co AS SINGLE, Co2 AS SINGLE
 Co2 = MaxCols - 2

 FOR R = 2 TO MaxRows - 2
  Co = Co + (MaxCols / MaxRows)
  LOCATE R, Co: PRINT CHR$(219);
  Co2 = Co2 - (MaxCols / MaxRows)
  LOCATE R, Co2: PRINT CHR$(219);
 NEXT

CASE 8
 FOR R = 2 TO MaxRows - 2 STEP 2
  LOCATE R, MaxCols \ 2: PRINT CHR$(219);
 NEXT
 FOR C = 2 TO MaxCols - 2 STEP 2
  LOCATE MaxRows \ 2 - 2, C: PRINT CHR$(219);
 NEXT

CASE 9
 FOR R = 3 TO MaxRows - 3 STEP 2
  LOCATE R, MaxCols \ 2 - 20: PRINT CHR$(219);
  LOCATE R, MaxCols \ 2 + 20: PRINT CHR$(219);
  LOCATE R + 1, MaxCols \ 2 - 22: PRINT CHR$(219);
  LOCATE R - 1, MaxCols \ 2 + 22: PRINT CHR$(219);
 NEXT


CASE 10
 FOR R = 2 TO MaxRows - 2 STEP 4
 FOR C = 2 TO MaxCols - 2 STEP 4
  LOCATE R, C: PRINT CHR$(219);
 NEXT
 NEXT


END SELECT

END SUB

SUB MoveSnake
  IF Snake.Direction = Right THEN
   Snake.Col = Snake.Col + 1
  ELSEIF Snake.Direction = Left THEN
   Snake.Col = Snake.Col - 1
  ELSEIF Snake.Direction = Down THEN
   Snake.Row = Snake.Row + 1
  ELSEIF Snake.Direction = Up THEN
   Snake.Row = Snake.Row - 1
  END IF
  Snake.Currentlen = Snake.Currentlen + 1

END SUB

SUB Playgame

DO: LOOP WHILE LEN(INKEY$) 'Empty keyboardbuffer

NewGame:

 Updatescreen

 Snake.Score = 0
 Snake.SnakeColor = 11 + RND * 3
 Snake.Lives = 5
 CurrentSkill = 1                        'You can cheat!

TryAgain:
 Snake.Row = MaxRows \ 2
 Snake.Col = MaxCols \ 2
 Snake.Direction = 1
 Snake.Currentlen = 0
 Snake.Maxlen = 2
 Thistime = 0

  GOSUB PrintStatus
 
  Makelevel CurrentSkill

 DEF SEG = &HB800
  FOR X = 1 TO 10
ReTry:
   Row = 2 + RND * (MaxRows - 4)
   Col = 2 + RND * (MaxCols - 4)
   IF PEEK((Row * 80 + Col) * 2 + 1) <> 8 THEN GOTO ReTry:
   POKE (Row * 80 + Col) * 2, 1 + RND * 1
   POKE (Row * 80 + Col) * 2 + 1, 10
  NEXT

  LOCATE , , 0

DO

 '----- Key events
         
          Keys = Keyboard

  IF Keys = LArrow THEN
   IF Snake.Direction <> Right THEN Snake.Direction = Left

  ELSEIF Keys = RArrow THEN
   IF Snake.Direction <> Left THEN Snake.Direction = Right

  ELSEIF Keys = DnArrow THEN
   IF Snake.Direction <> Up THEN Snake.Direction = Down

  ELSEIF Keys = UpArrow THEN
   IF Snake.Direction <> Down THEN Snake.Direction = Up
 
  ELSEIF Keys = 27 THEN
   QuitProgram
 
'  ELSEIF Keys = 43 THEN                'No cheating here... anylonger :)
'   GOSUB ChangeSkill
 
'  ELSEIF Keys = 45 THEN
'   CurrentSkill = CurrentSkill - 2
'   GOSUB ChangeSkill

  END IF

 '----------

     MoveSnake
 
 '------
  
   IF Colr(Snake.Row, Snake.Col) = 10 THEN
    Snake.Maxlen = Snake.Maxlen + CurrentSkill * 3
    DEF SEG = &HB800
    POKE (80 * (Snake.Row - 1) + (Snake.Col - 1)) * 2, RND * 255 'Make a fake background
    POKE (80 * (Snake.Row - 1) + (Snake.Col - 1)) * 2 + 1, 8
    Snake.Score = Snake.Score + 10
    GOSUB PrintStatus
    Thistime = Thistime + 1: IF Thistime = 10 THEN GOSUB ChangeSkill
   END IF

   IF Colr(Snake.Row, Snake.Col) = Snake.SnakeColor OR Colr(Snake.Row, Snake.Col) <> 8 THEN
    IF Snake.Lives = 0 THEN GOTO TryAgainOrExit
    Snake.Lives = Snake.Lives - 1
    COLOR 0, 3
      Center MaxRows \ 2 - 1, "ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿"
          Center MaxRows \ 2, "³               Oh no!               ³"
      Center MaxRows \ 2 + 1, "³         Life is too short...       ³"
      Center MaxRows \ 2 + 2, "ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ"
    
     WHILE INKEY$ <> "": WEND
     DO: LOOP UNTIL Keyboard


    GOSUB PrintStatus
    Updatescreen
    GOTO TryAgain
   END IF

 '--------
   
    Updatesnake  ' Draw snake
 
 '--------
 
    Delay GameDelay    ' It goes *quite* fast without this... :)

 '--------


LOOP



EXIT SUB




'--------------------------

ChangeSkill:

IF CurrentSkill = 10 THEN YouWin

COLOR 0, 3
 
      Center MaxRows \ 2 - 1, "ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿"
          Center MaxRows \ 2, "³         You've made it!            ³"
Center MaxRows \ 2 + 1, LEFT$("³      Next level is: " + STR$(CurrentSkill + 1) + SPACE$(40), 37) + "³"
      Center MaxRows \ 2 + 2, "ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ"
  
     WHILE INKEY$ <> "": WEND
     DO: LOOP UNTIL Keyboard
 

 Updatescreen
 GOSUB PrintStatus

 CurrentSkill = CurrentSkill + 1

 GOTO TryAgain

RETURN


'----------------

PrintStatus:
  COLOR 3, 0
    RAlign 1, " Lives: " + LTRIM$(RTRIM$(STR$(Snake.Lives))) + " "
    LOCATE 1, 1: PRINT " Score: " + LTRIM$(RTRIM$(STR$(Snake.Score))) + " ";

RETURN


'---------------

TryAgainOrExit:

COLOR 0, 3
Center MaxRows \ 2 - 2, "ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿"
Center MaxRows \ 2 - 1, "³      *** G A M E   O V E R ***     ³"
    Center MaxRows \ 2, "³     Do you want to play again?     ³"
Center MaxRows \ 2 + 1, "³               (Y/N)                ³"
Center MaxRows \ 2 + 2, "ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ"

DO: S$ = UCASE$(INKEY$): LOOP UNTIL S$ = "N" OR S$ = "Y"

IF S$ = "Y" THEN GOTO NewGame

QuitProgram


END SUB

SUB QuitProgram
  CALL ClrScr(1): WIDTH 80, 25
  COLOR 7, 0
  PRINT "Snake-game by Anders Olofsson 1998."
  PRINT "E-mail: anders.olofsson@mail.bip.net"
  END

END SUB

SUB RAlign (Row, text$)
LOCATE Row, 81 - LEN(text$): PRINT text$;
END SUB

SUB Updatescreen

SCREEN 0: WIDTH 80, 50

DEF SEG = &HB800

FOR X = 0 TO MaxRows * 80 * 2 STEP 2
 POKE X, 255 * RND
 POKE X + 1, 8
NEXT

COLOR BorderColor, 0
FOR R = 1 TO MaxRows
 LOCATE R, 1: PRINT CHR$(219);
 LOCATE R, MaxCols: PRINT CHR$(219);
NEXT
FOR C = 1 TO MaxCols
 LOCATE 1, C: PRINT CHR$(219);
 LOCATE MaxRows, C: PRINT CHR$(219);
NEXT

END SUB

SUB Updatesnake
DEF SEG = &HB800


 Background(Snake.Currentlen).Old = CHR$(Colr(Snake.Row, Snake.Col)) + CHR$(Ascii(Snake.Row, Snake.Col))
 Background(Snake.Currentlen).Row = Snake.Row - 1
 Background(Snake.Currentlen).Col = Snake.Col - 1

 IF Snake.Currentlen >= Snake.Maxlen THEN
  DEF SEG = &HB800
   POKE (80 * Background(1).Row + Background(1).Col) * 2 + 1, ASC(Background(1).Old)
   POKE (80 * Background(1).Row + Background(1).Col) * 2, ASC(RIGHT$(Background(1).Old, 1))
  FOR T = 1 TO Snake.Maxlen - 1
   Background(T) = Background(T + 1)
  NEXT
  Snake.Currentlen = Snake.Currentlen - 1
 END IF

 LOCATE Snake.Row, Snake.Col
 COLOR Snake.SnakeColor
  PRINT CHR$(219);



END SUB

SUB YouWin


Updatescreen

  Snake.Row = 1
  Snake.Col = 2
  Snake.Direction = Down
  Snake.SnakeColor = 9 + RND * 5
  Snake.Maxlen = 50
  Snake.Currentlen = 0

COLOR 0, 3

Center MaxRows \ 2 - 1, "ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿"
    Center MaxRows \ 2, "³              YOU WIN!              ³"
Center MaxRows \ 2 + 1, "ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ"

LOCATE , , 0

DO

  MoveSnake

  IF Snake.Row = 2 AND Snake.Direction = Up THEN
   IF Snake.Col <> 79 THEN Snake.Direction = Right ELSE Snake.Direction = Left
  END IF

  IF Snake.Row = MaxRows - 1 AND Snake.Direction = Down THEN
   IF Snake.Col <> MaxCols - 1 THEN Snake.Direction = Right ELSE Snake.Direction = Left
  END IF

  IF Snake.Col = MaxCols - 1 AND Snake.Direction = Right THEN
   IF Snake.Row <> 2 THEN Snake.Direction = Up ELSE Snake.Direction = Down
  END IF

  IF Snake.Col = 2 AND Snake.Direction = Left THEN
   IF Snake.Row <> MaxRows - 1 THEN Snake.Direction = Down ELSE Snake.Direction = Up
  END IF


 Updatesnake

  WAIT &H3DA, 8: WAIT &H3DA, 8, 1 'Add some delays
  WAIT &H3DA, 8: WAIT &H3DA, 8, 1

 IF LEN(INKEY$) THEN EXIT DO

LOOP

QuitProgram

END SUB