
(********************************************************************)
(*                                                                  *)
(*  snake.sd7     Snake eats apple game                             *)
(*  Copyright (C) 1993, 1994, 2004  Thomas Mertes                   *)
(*                                                                  *)
(*  This program is free software; you can redistribute it and/or   *)
(*  modify it under the terms of the GNU General Public License as  *)
(*  published by the Free Software Foundation; either version 2 of  *)
(*  the License, or (at your option) any later version.             *)
(*                                                                  *)
(*  This program is distributed in the hope that it will be useful, *)
(*  but WITHOUT ANY WARRANTY; without even the implied warranty of  *)
(*  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the   *)
(*  GNU General Public License for more details.                    *)
(*                                                                  *)
(*  You should have received a copy of the GNU General Public       *)
(*  License along with this program; if not, write to the           *)
(*  Free Software Foundation, Inc., 51 Franklin Street,             *)
(*  Fifth Floor, Boston, MA  02110-1301, USA.                       *)
(*                                                                  *)
(********************************************************************)


$ include "seed7_05.s7i";
  include "time.s7i";
  include "duration.s7i";
  include "console.s7i";
  include "window.s7i";
  include "keybd.s7i";

const char: BLANK is ' ';
const char: BODY  is '*';

const type: direction_type is new enum
    STAY, UP, DOWN, LEFT, RIGHT
  end enum;

var integer: max_line is 0;
var integer: max_column is 0;

const type: char_line is array char;
const type: pos_type is array integer;

var array char_line: FIELD is 0 times 0 times ' ';

const type: screen_object is new struct
    var integer: line is 0;
    var integer: column is 0;
    var char: picture is ' ';
  end struct;

const type: apple_object is sub screen_object struct
  end struct;

var apple_object: APPLE is apple_object.value;
APPLE.picture := 'o';

const type: snake_object is sub screen_object struct
    var direction_type: direction is STAY;
    var boolean: backward_movement is FALSE;
    var boolean: fence_movement is FALSE;
    var char: last_meal is ' ';
    var integer: head_index is 1;
    var integer: end_index is 1;
    var array pos_type: position is 2000 times (2 times 0);
    var integer: length is 0;
    var integer: grow is 2;
  end struct;

var snake_object: SNAKE is snake_object.value;
SNAKE.picture := 'S';

const proc: move (SNAKE, in direction_type: direction) is DYNAMIC;


var text: scr is STD_NULL;
var text: win is STD_NULL;
var text: status is STD_NULL;


const proc: beep is func

  begin
(*  write("\G"); *)
    noop;
  end func;


const proc: set_position (inout screen_object: scr_object) is func

  local
    var integer: lin is 0;
    var integer: col is 0;
    var char: ch is ' ';
  begin
    repeat
      lin := rand(1, max_line - 2);
      col := rand(1, max_column - 2);
      ch := FIELD[lin][col];
    until ch = BLANK;
    setPos(win, lin, col);
    write(win, scr_object.picture);
    FIELD[lin][col] := scr_object.picture;
    scr_object.line := lin;
    scr_object.column := col;
  end func;


const proc: show_status is func

  begin
    setPos(status, 1, max_column div 2 - 3);
    write(status, " " <& SNAKE.length <& " ");
  end func;


const proc: turn (SNAKE, UP) is func

  begin
    if SNAKE.direction = DOWN then
      SNAKE.backward_movement := TRUE;
    else
      SNAKE.direction := UP;
      SNAKE.picture := 'v';
    end if;
  end func;


const proc: turn (SNAKE, DOWN) is func

  begin
    if SNAKE.direction = UP then
      SNAKE.backward_movement := TRUE;
    else
      SNAKE.direction := DOWN;
      SNAKE.picture := '^';
    end if;
  end func;


const proc: turn (SNAKE, LEFT) is func

  begin
    if SNAKE.direction = RIGHT then
      SNAKE.backward_movement := TRUE;
    else
      SNAKE.direction := LEFT;
      SNAKE.picture := '>';
    end if;
  end func;


const proc: turn (SNAKE, RIGHT) is func

  begin
    if SNAKE.direction = LEFT then
      SNAKE.backward_movement := TRUE;
    else
      SNAKE.direction := RIGHT;
      SNAKE.picture := '<';
    end if;
  end func;


const proc: move (SNAKE, UP) is func

  begin
    if SNAKE.line > 1 then
      decr(SNAKE.line);
    else
      SNAKE.fence_movement := TRUE;
    end if;
  end func;


const proc: move (SNAKE, DOWN) is func

  begin
    if SNAKE.line < max_line then
      incr(SNAKE.line);
    else
      SNAKE.fence_movement := TRUE;
    end if;
  end func;


const proc: move (SNAKE, LEFT) is func

  begin
    if SNAKE.column > 1 then
      decr(SNAKE.column);
    else
      SNAKE.fence_movement := TRUE;
    end if;
  end func;


const proc: move (SNAKE, RIGHT) is func

  begin
    if SNAKE.column < max_column then
      incr(SNAKE.column);
    else
      SNAKE.fence_movement := TRUE;
    end if;
  end func;


const proc: move (SNAKE, STAY) is func

  begin
    noop;
  end func;


const proc: move (SNAKE) is func

  begin
    move(SNAKE, SNAKE.direction);
    if not SNAKE.fence_movement then
      SNAKE.last_meal := FIELD[SNAKE.line][SNAKE.column];
    end if;
  end func;


const proc: enlarge (SNAKE) is func

  local
    var integer: number is 0;
  begin
    number := SNAKE.length div 2;
    if number <= 5 then
      SNAKE.grow +:= 5;
    elsif number >= 30 then
      SNAKE.grow +:= 30;
    else
      SNAKE.grow +:= number;
    end if;
  end func;


const proc: show (SNAKE) is func

  begin
    if SNAKE.grow <> 0 then
      if SNAKE.length = 0 then
        setPos(win, SNAKE.position[SNAKE.end_index][1],
            SNAKE.position[SNAKE.end_index][2]);
        write(win, BODY);
        FIELD[SNAKE.position[SNAKE.end_index][1]]
            [SNAKE.position[SNAKE.end_index][2]] := BODY;
      end if;
      decr(SNAKE.grow);
      incr(SNAKE.length);
      show_status();
    else
      setPos(win, SNAKE.position[SNAKE.end_index][1],
          SNAKE.position[SNAKE.end_index][2]);
      write(win, BLANK);
      FIELD[SNAKE.position[SNAKE.end_index][1]]
          [SNAKE.position[SNAKE.end_index][2]] := BLANK;
      incr(SNAKE.end_index);
    end if;

    incr(SNAKE.head_index);
    SNAKE.position[SNAKE.head_index][1] := SNAKE.line;
    SNAKE.position[SNAKE.head_index][2] := SNAKE.column;

    setPos(win, SNAKE.line, SNAKE.column);
    write(win, SNAKE.picture);
    FIELD[SNAKE.line][SNAKE.column] := SNAKE.picture;
    setPos(win, SNAKE.position[pred(SNAKE.head_index)][1],
        SNAKE.position[pred(SNAKE.head_index)][2]);
    write(win, BODY);
    FIELD[SNAKE.position[pred(SNAKE.head_index)][1]]
        [SNAKE.position[pred(SNAKE.head_index)][2]] := BODY;
  end func;


const func boolean: play(ROUND) is func

  result
    var boolean: success is FALSE;
  local
    var char: inp is ' ';
    var time: start_time is time.value;
    var integer: apple_counter is 0;
  begin
    show_status();
    inp := busy_getc(KEYBOARD);
    while inp <> 'q' do
      start_time := time(NOW);
      if inp <> KEY_NONE then
        case inp of
          when {KEY_UP}:
            turn(SNAKE, UP);
          when {KEY_DOWN}:
            turn(SNAKE, DOWN);
          when {KEY_LEFT}:
            turn(SNAKE, LEFT);
          when {KEY_RIGHT}:
            turn(SNAKE, RIGHT);
        end case;
      end if;

      move(SNAKE);

      if SNAKE.fence_movement then
        beep();
        setPos(scr, 1, 1);
        write(scr, "FENCE");
        inp := 'q';
      else

        if SNAKE.direction <> STAY then
          show(SNAKE);
        end if;

        if SNAKE.last_meal = BODY then
          beep();
          setPos(scr, 1, 1);
          write(scr, "BODY");
          inp := 'q';
        elsif SNAKE.last_meal = '#' then
          beep();
          setPos(scr, 1, 1);
          write(scr, "#");
          inp := 'q';
        elsif apple_counter >= 10 then
          inp := 'q';
        else

          if SNAKE.last_meal = APPLE.picture then
            incr(apple_counter);
            if apple_counter < 10 then
              enlarge(SNAKE);
              beep();
              set_position(APPLE);
            end if;
          end if;


          await(start_time + 100000 . MICRO_SECONDS);

          inp := busy_getc(KEYBOARD);

        end if;
      end if;
    end while;
    success := apple_counter >= 10;
  end func;


const proc: init_level (in integer: level) is func

  local
    var integer: number is 0;
    var integer: column is 0;
  begin
    case level of
      when {1}:
        noop;
(*      SNAKE(1).row = 25: SNAKE(2).row = 25
        SNAKE(1).col = 50: SNAKE(2).col = 30
        SNAKE(1).direction = 4: SNAKE(2).direction = 3 *)


      when {2}:
        for number range 19 to 59 do
          FIELD[11][number] := '#';
          setPos(win, 11, number);
          write(win, "#");
        end for;
(*      SNAKE(1).row = 7: SNAKE(2).row = 43
        SNAKE(1).col = 60: SNAKE(2).col = 20
        SNAKE(1).direction = 3: SNAKE(2).direction = 4 *)

      when {3}:
        for number range 6 to 16 do
          FIELD[number][19] := '#';
          FIELD[number][59] := '#';
          setPos(win, number, 19);
          write(win, "#");
          setPos(win, number, 59);
          write(win, "#");
        end for;
(*      SNAKE(1).row = 25: SNAKE(2).row = 25
        SNAKE(1).col = 50: SNAKE(2).col = 30
        SNAKE(1).direction = 1: SNAKE(2).direction = 2 *)

      when {4}:
        for number range 1 to 12 do
          FIELD[number][19] := '#';
          FIELD[22 - number][59] := '#';
          setPos(win, number, 19);
          write(win, "#");
          setPos(win, 22 - number, 59);
          write(win, "#");
        end for;
        for number range 1 to 45 do
          FIELD[16][number] := '#';
          FIELD[6][79 - number] := '#';
          setPos(win, 16, number);
          write(win, "#");
          setPos(win, 6, 79 - number);
          write(win, "#");
        end for;
(*      SNAKE(1).row = 7: SNAKE(2).row = 43
        SNAKE(1).col = 60: SNAKE(2).col = 20
        SNAKE(1).direction = 3: SNAKE(2).direction = 4 *)

      when {5}:
        for number range 6 to 16 do
          FIELD[number][19] := '#';
          FIELD[number][59] := '#';
          setPos(win, number, 19);
          write(win, "#");
          setPos(win, number, 59);
          write(win, "#");
        end for;
        for number range 21 to 57 do
          FIELD[4][number] := '#';
          FIELD[18][number] := '#';
          setPos(win, 4, number);
          write(win, "#");
          setPos(win, 18, number);
          write(win, "#");
        end for;
(*      SNAKE(1).row = 25: SNAKE(2).row = 25
        SNAKE(1).col = 50: SNAKE(2).col = 30
        SNAKE(1).direction = 1: SNAKE(2).direction = 2 *)

      when {6}:
        for number range 1 to 21 do
          if number <= 9 or number >= 13 then
            FIELD[number][10] := '#';
            FIELD[number][20] := '#';
            FIELD[number][30] := '#';
            FIELD[number][40] := '#';
            FIELD[number][50] := '#';
            FIELD[number][60] := '#';
            FIELD[number][70] := '#';
            setPos(win, number, 10);
            write(win, "#");
            setPos(win, number, 20);
            write(win, "#");
            setPos(win, number, 30);
            write(win, "#");
            setPos(win, number, 40);
            write(win, "#");
            setPos(win, number, 50);
            write(win, "#");
            setPos(win, number, 60);
            write(win, "#");
            setPos(win, number, 70);
            write(win, "#");
          end if;
        end for;
(*      SNAKE(1).row = 7: SNAKE(2).row = 43
        SNAKE(1).col = 65: SNAKE(2).col = 15
        SNAKE(1).direction = 2: SNAKE(2).direction = 1 *)

      when {7}:
(*      for number range 4 to 49 STEP 2 do
          FIELD[number][40] := '#';
          setPos(win, number, 40);
          write(win, "#");
        end for; *)
        number := 1;
        while number <= 21 do
          FIELD[number][39] := '#';
          setPos(win, number, 39);
          write(win, "#");
          number +:= 2;
        end while;
(*      SNAKE(1).row = 7: SNAKE(2).row = 43
        SNAKE(1).col = 65: SNAKE(2).col = 15
        SNAKE(1).direction = 2: SNAKE(2).direction = 1 *)

      when {8}:
        for number range 1 to 18 do
          FIELD[number][10] := '#';
          FIELD[22 - number][20] := '#';
          FIELD[number][30] := '#';
          FIELD[22 - number][40] := '#';
          FIELD[number][50] := '#';
          FIELD[22 - number][60] := '#';
          FIELD[number][70] := '#';
          setPos(win, number, 10);
          write(win, "#");
          setPos(win, 22 - number, 20);
          write(win, "#");
          setPos(win, number, 30);
          write(win, "#");
          setPos(win, 22 - number, 40);
          write(win, "#");
          setPos(win, number, 50);
          write(win, "#");
          setPos(win, 22 - number, 60);
          write(win, "#");
          setPos(win, number, 70);
          write(win, "#");
        end for;
(*      SNAKE(1).row = 7: SNAKE(2).row = 43
        SNAKE(1).col = 65: SNAKE(2).col = 15
        SNAKE(1).direction = 2: SNAKE(2).direction = 1 *)

      when {9}:
        for number range 3 to 19 do
          FIELD[number][2 * number] := '#';
          FIELD[number][2 * number + 1] := '#';
          FIELD[number][2 * number + 34] := '#';
          FIELD[number][2 * number + 35] := '#';
          setPos(win, number, 2 * number);
          write(win, "#");
          setPos(win, number, 2 * number + 1);
          write(win, "#");
          setPos(win, number, 2 * number + 28);
          write(win, "#");
          setPos(win, number, 2 * number + 29);
          write(win, "#");
        end for;
(*      SNAKE(1).row = 40: SNAKE(2).row = 15
        SNAKE(1).col = 75: SNAKE(2).col = 5
        SNAKE(1).direction = 1: SNAKE(2).direction = 2 *)

      otherwise:
(*      for number range 4 to 49 STEP 2 do
          FIELD[number][10] := '#';
          FIELD[number + 1][20] := '#';
          FIELD[number][30] := '#';
          FIELD[number + 1][40] := '#';
          FIELD[number][50] := '#';
          FIELD[number + 1][60] := '#';
          FIELD[number][70] := '#';
        end for; *)
        number := 1;
        while number <= 20 do
          FIELD[number][10] := '#';
          FIELD[21 - number][20] := '#';
          FIELD[number][30] := '#';
          FIELD[21 - number][40] := '#';
          FIELD[number][50] := '#';
          FIELD[21 - number][60] := '#';
          FIELD[number][70] := '#';
          setPos(win, number, 10);
          write(win, "#");
          setPos(win, 21 - number, 20);
          write(win, "#");
          setPos(win, number, 30);
          write(win, "#");
          setPos(win, 21 - number, 40);
          write(win, "#");
          setPos(win, number, 50);
          write(win, "#");
          setPos(win, 21 - number, 60);
          write(win, "#");
          setPos(win, number, 70);
          write(win, "#");
          number +:= 2;
        end while;
(*      SNAKE(1).row = 7: SNAKE(2).row = 43
        SNAKE(1).col = 65: SNAKE(2).col = 15
        SNAKE(1).direction = 2: SNAKE(2).direction = 1 *)

    end case;
(*  for number range 1 to 21 do
      for column range 1 to 78 do
        setPos(win, number, column);
        write(win, FIELD[number][column]);
      end for;
    end for; *)
  end func;


const proc: main is func

  local
    var integer: level is 1;
  begin
    scr := open(CONSOLE);
    win := openWindow(scr, 2, 2, 21, 78);
    status := openWindow(scr, 23, 2, 1, 78);

    max_line := 21; (* height(win); *)
    max_column := 78; (* width(win); *)

    repeat
      box(win);
      clear(win);
      FIELD := 21 times (78 times BLANK);
      init_level(level);
      SNAKE.picture := 'S';
      set_position(APPLE);
      set_position(SNAKE);
      SNAKE.direction := STAY;
      SNAKE.backward_movement := FALSE;
      SNAKE.fence_movement := FALSE;
      SNAKE.last_meal := ' ';
      SNAKE.head_index := 1;
      SNAKE.end_index := 1;
      SNAKE.position[SNAKE.end_index][1] := SNAKE.line;
      SNAKE.position[SNAKE.end_index][2] := SNAKE.column;
      SNAKE.length := 0;
      SNAKE.grow := 2;

      if play(ROUND) then
        incr(level);
      end if;

    until getc(KEYBOARD) = 'q';
  end func;
