{******************************************************************************
 
SNAKE GAME PROGRAM
 
84 S. A. MOORE
 
Plays a moving target game were the player is a snake, winding it's body around
the screen, eating score producing digit 'targets' and trying to avoid the wall
and itself. The snake's movements are dictated by up, down, east and west
keys. for play details examine the program or simply activate the game (it has
instruction banners). This game is a fairly literal copy (functionality wise)
of the unix 'worm' program.
Adjustments; the following may be adjusted:

     Maximum size of snake: Change maxsn if the snake needs more or less
     possible positions.

     Size of score: adjust scrnum.

     Time between moves: adjust maxtim.

     If accumulated score overflows: adjust maxlft.

*******************************************************************************}

program snake(input, output); { user input (for break checking ) }

uses trmlib; { terminal standard library }

label 88, 99; { end game terminations }

const maxsn  = 1000;  { total snake positions }
      timmax = 5000; { time between forced moves (1 second) }
      blntim = 1000;  { delay time for blinker }
      maxlft = 100;   { maximum amount of score achevable before
                        being registered without overflow }
      { instruction message at top of screen; s/b maxx
        characters long }
      scrnum = 4;    { number of score digits }
      scroff = 45;   { location of first (high) digit of score
                       (should correspond with 'msgstr' above }
      maxscn = 100; { maximum screen demention }

type

     word   = 0..65535; { 16 bit word }
     string = packed array of char; { general string type }
     scrinx = 1..scrnum; { index for score save }
     sninx  = 1..maxsn;  { index for snake array }
     scnpos = record     { index set for screen }

                 scnx: integer;
                 scny: integer

              end;

var

    timcnt:  integer;      { move countdown }
    snakel:  array[sninx] of scnpos; { snake's positions }
    sntop:   sninx;        { current snake array top }
    lstmov:  evtcod;       { player move type }
    rndseq:  integer;      { random number sequencer }
    scrsav:  packed array [1..scrnum] of char; { screen score counter }
    scrlft:  0..maxlft;    { units of score left to add }
    scrloc:  integer; { location of score digits }
    fblink:  boolean; { crash blinker }
    er:      evtrec; { event record }
    image:   array [1..maxscn, 1..maxscn] of char; { screen image }
    crash:   boolean; { crash occurred flag }
    i:       integer;
    x:       integer;
    tx, ty:  integer;

{******************************************************************************

Check digit

We verify  that the passed digit lies in the set ['0'..'9'].
Of course this is done because of our lack of sets.

*******************************************************************************}

function digit(c : char)  { character to check }
              : boolean;  { is character digit ? }

begin

   digit := (c >= '0') and (c <= '9')

end;

{******************************************************************************

Write single character to screen

Writes the given character to the given X and Y point on the
screen. Also saves a copy to our screen image.

*******************************************************************************}

procedure writescreen(x, y: integer; { position to place character }
                      c:    char);   { write screen }

begin

   cursor(output, x, y); { position to the given location }
   if c <> image[x, y] then begin { filter redundant placements }

      write(c); { write the character }
      image[x, y] := c { place character in image }

   end

end;

{******************************************************************************

Write centered string

Writes a string that is centered on the line given. Returns the
starting position of the string.

*******************************************************************************}

procedure wrtcen(     y:   integer;  { y position of string }
                 view s:   string;   { string to write }
                 var  off: integer); { returns string offset }

var i: integer; { index for string }

begin

   off := maxx(output) div 2-max(s) div 2;
   { write out contents }
   for i := 1 to max(s) do writescreen(i+off, y, s[i])

end;

{******************************************************************************

Clear screen

Places the banner at the top of screen, then clears and sets
the border on the screen below. This is done in top to
bottom order (no skipping about) to avoid any text mixing
with characters already on the screen (looks cleaner).
This is a concern because the screen clear is not quite
instantaineous.

*******************************************************************************}

procedure clrscn;

var y: integer; { index y }
    x: integer; { index x }

begin

   page; { clear display screen }
   for x := 1 to maxx(output) do { clear image }
      for y := 1 to maxy(output) do image[x, y] := ' ';
   { place top }
   for x := 1 to maxx(output) do writescreen(x, 1, '*');
   { place sides }
   for y := 2 to maxy(output) - 1 do begin { lines }

      writescreen(1, y, '*'); { place left border }
      writescreen(maxx(output), y, '*') { place right border }

   end;
   { place bottom }
   for x := 1 to maxx(output) do writescreen(x, maxy(output), '*');
   { size and place banners }
   wrtcen(1, ' -> FUNCTION 1 RESTARTS <-   SCORE - 0000 ', x);
   scrloc := x+38;
   wrtcen(maxy(output), ' SNAKE VS. 2.0 ', x)

end;

{******************************************************************************

Random number generator

This generator was designed after the technequies in 'The Art
Of Programming'. Despite considerable testing, the damm thing
is largely arbitrary. Note that in the below version overflow
occurs.
A 'top' integer is required, which indicates the size of the
requested result.
If time permits, an overhaul of this business would be helpful.

*******************************************************************************}

function rand(top : integer): integer;

begin

   rndseq := (11 * rndseq + 6) mod 1000;
   rand := rndseq mod top + 1

end;

{******************************************************************************

Place target

Places a digit on the screen for use as a target. Both the
location of the target and it's value (0-9) are picked at
random. Multiple tries are used to avoid colisions.
 
*******************************************************************************}
 
procedure plctrg;
 
var x: integer; { index x }
    y: integer; { index y }
    c: char;
 
begin
 
   repeat { pick postions and check if the're free }
 
      { find x, y locations, not on a border using
        a zero - n random function }
      y := rand(maxy(output) - 2) + 1;
      x := rand(maxx(output) - 2) + 1;
      c := image[x, y]; { get character at position }
 
   until c = ' '; { area is unoccupied }
   { place target integer }
   writescreen(x, y, chr(rand(9) + ord('0')))
 
end;

{******************************************************************************
 
Next score
 
Increments the displayed score counter. This overflow is not
checked. Note that the 'scrloc' global constant tells us
where to place the score on screen, and scrnum indicates the
number of score digits.
 
*******************************************************************************}
 
procedure nxtscr;

var i     : scrinx;  { score save index }
    carry : boolean; { carry out for addition }
 
begin
 
   i := scrnum; { index LSD }
   carry := true; { initalize carry }
   repeat { process digit add }
 
      if scrsav[i] = '9' then begin
 
         scrsav[i] := '0'; { carry out digit }
         i := pred(i) { next digit }
 
      end else begin
 
         scrsav[i] := succ(scrsav[i]); { add single turnover }
         carry := false { stop }
 
      end
 
   until (i < 1) or not carry; { last digit is processed,
                                 no digit carry }
   { place score on screen }
   for i := 1 to scrnum do writescreen(scrloc + i - 1, 1, scrsav[i])
 
end;

{******************************************************************************
 
Move snake
 
Since this game is pretty much solitary, the movement of the
snake (activated by a player or automatically) evokes most
game behavor.
A move character is accepted, the new position calculated, and
the following may happen:

     1. The new position is inside a wall or border
        (game terminates, user loss).

     2. The new position crosses the snake itself
        (same result).

     3. A score tolken is found. The score value is
        added to the 'bank' of acculate score. The score
        is later removed from the bank one value at a time.

After the new position is found, the decision is make to
'grow' the snake (make it longer by the new position), or
'move' the snake (eliminate the last positon opposite the
new one).

*******************************************************************************}

procedure movesnake(usrmov: evtcod);

label 1; { exit label }

var sn: sninx;   { index for snake array }
    c:  char;
    x:  integer; { index x }
    y:  integer; { index y }

begin

   if (usrmov = etdown) or (usrmov = etup) or
      (usrmov = etleft) or (usrmov = etright) then begin

      x := snakel[sntop].scnx; { save present top }
      y := snakel[sntop].scny;
      case usrmov of

         etdown:  y := succ(y); { move down }
         etup:    y := pred(y); { move up }
         etleft:  x := pred(x); { move left }
         etright: x := succ(x)  { move right }

      end;
      c := image[x, y]; { load new character }
      { check terminate }
      if (y = 1) or (y = maxy(output)) or (x = 1) or (x = maxx(output)) or
         ((c <> ' ') and not digit(c)) then begin

         crash := true; { set crash occurred }
         goto 1 { exit }

      end;
      writescreen(x, y, '@'); { place new head }
      if digit(c) then begin

         plctrg; { place new target }
         { set digit score }
         scrlft := scrlft + (ord(c) - ord('0'));

      end;
      if scrlft <> 0 then begin

         sntop := succ(sntop); { 'grow' snake }
         if sntop > maxsn then begin { snake to big }

            crash := true; { set crash occurred }
            goto 1 { exit }

         end;
         nxtscr; { increment score }
         scrlft := pred(scrlft) { decrement score to add }

      end else begin

         writescreen(snakel[1].scnx, snakel[1].scny, ' ');
         for sn := 1 to sntop - 1 do { copy old positions }
         snakel[sn] := snakel[sn + 1]

      end;
      snakel[sntop].scnx := x; { update coordinates }
      snakel[sntop].scny := y;
      lstmov := usrmov { set the last move }

   end;

   1: { terminate move }

end;

{******************************************************************************

Event loop

Waits for interesting events, processes them, and if a move is performed,
executes that. We include a flag to reject timer forced moves, because we
may be waiting for the user to start the game.
We treat the joystick as being direction arrows, so we in fact convert it to
direction events here. I don't care which joystick is being used.
The joystick is deadbanded to 1/10 of it's travel (it must be moved more than
1/10 away from center to register a move). If the user is trying to give
us two axies at once, one is picked ad hoc. Because the joystick dosen't
dictate speed, we just set up the default move with it.
The advanced mode for the joystick would be to pick a rate for it that is
proportional to it's deflection, ie., move it farther, go faster.

*******************************************************************************}

procedure getevt(tim: boolean); { accept timer events }

var accept: boolean; { accept event flag }

begin

   repeat { process rejection loop }

      repeat { event rejection loop }

         event(input, er) { get event }

      until er.etype in [etleft, etright, etup, etdown, etterm, ettim, etfun,
                         etjoymov];
      accept := true; { set event accepted by default }
      if er.etype = etjoymov then begin { handle joystick }

         { change joystick to default move directions }
         if er.joypx > maxint div 10 then lstmov := etright
         else if er.joypx < -maxint div 10 then lstmov := etleft
         else if er.joypy > maxint div 10 then lstmov := etdown
         else if er.joypy < -maxint div 10 then lstmov := etup;
         accept := false { these events don't exit }

      end else if er.etype = ettim then begin { timer }

         if tim then begin

            if er.timnum = 1 then { time's up..default move }
               movesnake(lstmov) { move the same as last }
            else accept := false { suppress exit }

         end else accept := false { suppress exit }

      end else if not (er.etype in [etfun, etterm]) then { movement }
         movesnake(er.etype) { process user move }

   until accept

end;

{******************************************************************************

Main program

Various set-ups are performed, then the move loop is activated.
The user is given n chances in the loop to enter a move
character (and therefore a certain time), after which the snake
moves automatically in the same direction as it last moved.
This, of course, requires that the user have moved before the
game starts !
This problem is handled by requiring a user move to start the
play.
Besides the direction keys, the user has avalible restart
and cancel game keys.

*******************************************************************************}

begin { snake }

   select(output, 2, 2); { switch screens }
   curvis(output, false); { remove drawing cursor }
   auto(output, false); { remove automatic scrolling }
   bcolor(output, cyan); { on cyan background }
   rndseq := 5; { initalize random number generator }
   for i := 1 to 58 do x := rand(1); { stablize generator }
   timer(input, 1, timmax, true); { set move timer }
   timer(input, 2, blntim, true); { set blinker timer }
   repeat { game }

      88: { start new game }

      scrlft := 0; { clear score add count }
      clrscn;
      snakel[1].scnx := maxx(output) div 2; { set snake position middle }
      snakel[1].scny := maxy(output) div 2;
      sntop := 1; { set top snake character }
      writescreen(maxx(output) div 2, maxy(output) div 2, '@'); { place snake }
      timcnt := timmax;
      for i := 1 to scrnum do scrsav[i] := '0'; { zero score }
      nxtscr;
      getevt(false); { get the next event, without timers }
      if er.etype = etterm then goto 99 { immediate termination }
      else if er.etype = etfun then goto 88; { start new game }
      plctrg; { place starting target }
      crash := false; { set no crash occurred }
      repeat { game loop }

         getevt(true); { get next event, with timers }
         if er.etype = etterm then goto 99; { immediate termination }
         if er.etype = etfun then goto 88 { start new game }

      until crash; { we crash into an object }
      { not a voluntary cancel, must have *** crashed *** }
      tx := snakel[sntop].scnx;
      ty := snakel[sntop].scny;
      { blink the head off and on (so that snakes
        behind us won't run into us) }
      fblink := false; { clear crash blinker }
      repeat { blink cycles }

         { wait for an interesting event }
         repeat event(input, er) until er.etype in [ettim, etterm, etfun];
         if er.etype = etterm then goto 99; { immediate termination }
         if er.etype = etfun then goto 88; { restart game }
         { must be timer }
         if er.timnum = 2 then begin { blink cycle }

            if fblink then { turn back on }
               writescreen(tx, ty, '@')
            else { turn off }
               writescreen(tx, ty, ' ');
            fblink := not fblink { invert blinker status }

         end

      until false { forever }

   until false; { forever }

   99: { terminate program }

   curvis(output, true); { restore drawing cursor }
   auto(output, true); { restore automatic scrolling }
   select(output, 1, 1) { back to original screen }

end.