Web version of MazePlus

Smart Pascal version of Nikhil's MazePlus

Introduction

This web version of MazePlus is designed as a preview to be run in a browser, preferably on a PC. You can use the wasd or arrow keys or the buttons to move to the destination 'O'. If the game does not work in your current browser, please try another such as Chrome. If you see no display at school, the security system might have blocked it. You can try instead this direct link to the program running on its own page. On a Raspberry Pi, the display might look better if you install the Lucida Console font.

MazePlus Game

MazePlus.html

Smart Pascal Code of Main Unit

unit uMain;
{
    Copyright (c) 2013 Nikhil

    Licensed under the Apache License, Version 2.0 (the "License"); you may not
    use this file except in compliance with the License, as described at
    http://www.apache.org/licenses/ and http://www.pp4s.co.uk/licenses/

    Converted to Smart Pascal by PPS 2015
}
interface

uses 
  System.Types, SmartCL.System, SmartCL.Components, SmartCL.Application,
  SmartCL.Game, SmartCL.GameApp, SmartCL.Graphics, SmartCL.Controls.Button, SmartCL.Touch,
  uCrtCanvas;

type
  TCanvasProject = class(TW3CustomGameApplication)
  private
    const DELAY = 1;
    const SCALE_FACTOR = 1;
    const CELL_WIDTH = 5 * SCALE_FACTOR;
    const CELL_HEIGHT = 8 * SCALE_FACTOR;
    const FONT_SIZE = 9 * SCALE_FACTOR;
    const ROWS = 25;
    const COLS = 80;
    const WIDTH = COLS * CELL_WIDTH;
    const HEIGHT = ROWS * CELL_HEIGHT;
    btnLeft, btnRight, btnUp, btnDown: TW3Button;
    Grid: TConsoleGrid;
    FrameNumber, PlayerX, PlayerY: integer;
    Maze: array[1..24] of string = [
    '################################################################################',
    '#                     #                                                         ',
    '#   ###############   ###############   #############   ########################',
    '#   #   ##  ##    #   ###############   #   #########   #                     ##',
    '#   #             #   ###############   #   #########   #   ###############   ##',
    '#   #   ###########   ###############   #   #########   #   ###############   ##',
    '#                                       #                   #######       #   ##',
    '#   #########################   #########   #########################   ###   ##',
    '#   #                       #   #########   #########################         ##',
    '#   #   #################   #   #       #   ####################################',
    '#   #                   #   #   #   #   #   #                       ############',
    '#   #################   #   #   #   #   #   #   #################   ############',
    '#                       #   #       #   #   #   #######      #  #   ###       ##',
    '###############   ###########   #########   #   ###  ##   #  #  #   ###   #   ##',
    '###############   ###########   #########   #   ###  ##   #  #  #   ###   #   ##',
    '#             #   ####   ####       #####   #   ###  ##   #  #  #   ###   #   ##',
    '#   #######   #   ##       ##   #   #####   #   ###  ##   #  #  #         #   ##',
    '#   #     #   #   ##   #   ##   #     ###   #   ###  ##   #  #  #   ###   #   ##',
    '#   #   ###   ######   #   ##   #########   #   ###  ##   #  #  #   ###   #   ##',
    '#   #             ##   #   ##   #########   #   ###  ##   #  #  #   ###   #   ##',
    '#   ################   #   ##   #                     #   #     ###########   ##',
    '#   ################   #   ############################   #################   ##',
    '#                      #                                                      ##',
    '################################################################################'];

    start, finish: TDateTime;
    seconds: real;
  protected
    procedure ApplicationStarting; override;
    procedure ApplicationClosing; override;
    procedure PaintView(Canvas: TW3Canvas); override;
    procedure KeyDownEvent(mCode: integer);
    procedure GoToXY(X, Y: integer);
    function Random(LessThan : integer) : integer;
    procedure SetupGameButton(Btn: TW3Button; Capt: string;
                              W, L, T: integer; var Pressed: Boolean);
  end;

implementation

var
  PressedLeft, PressedRight, PressedUp, PressedDown: Boolean;


function TCanvasProject.Random(LessThan: integer): integer;
begin
  Result := RandomInt(LessThan);
end;

procedure TCanvasProject.KeyDownEvent(mCode: integer);
begin
  GoToXY(PlayerX, PlayerY);
  case mCode of
    37, 65: if Grid.getCharacters[Grid.CursorX - 1, Grid.CursorY].Letter <> '#' then
              Grid.CursorX := Grid.CursorX - 1;  //move left if not blocked
    39, 68: if Grid.getCharacters[Grid.CursorX + 1, Grid.CursorY].Letter <> '#' then
              Grid.CursorX := Grid.CursorX + 1;  //move right if not blocked
    38, 87: if Grid.getCharacters[Grid.CursorX, Grid.CursorY - 1].Letter <> '#' then
              Grid.CursorY := Grid.CursorY - 1;  //move up if not blocked
    40, 83: if Grid.getCharacters[Grid.CursorX, Grid.CursorY + 1].Letter <> '#' then
              Grid.CursorY := Grid.CursorY + 1;  //move down if not blocked
    27: GameView.EndSession;
  end;
  PlayerX := Grid.CursorX;
  PlayerY := Grid.CursorY;
end;

procedure TCanvasProject.GoToXY(X, Y: integer);
begin
  Grid.CursorX := X;
  Grid.CursorY := Y;
end;

procedure TCanvasProject.SetupGameButton(Btn: TW3Button; Capt: string;
                                         W, L, T: integer; var Pressed: Boolean);
begin
  Pressed := False;
  Btn.Caption := Capt;
  Btn.Width := W;
  Btn.Left := L;
  Btn.Top := T;
  Btn.OnMouseDown := lambda Pressed := True; end;
  btn.OnMouseUp := lambda Pressed := False; end;
  btn.OnTouchBegin := lambda Pressed := True; end;
  btn.OnTouchEnd := lambda Pressed := False; end;
end;

procedure TCanvasProject.ApplicationStarting;
begin
  inherited;
  Randomize;
  Grid := new TConsoleGrid;
  Grid.Rows := ROWS;
  Grid.Cols := COLS;

  btnLeft := TW3Button.Create(Document);
  SetupGameButton(btnLeft, '←', 60, 5, HEIGHT + 5, PressedLeft);
  btnRight := TW3Button.Create(Document);
  SetupGameButton(btnRight, '→', 60, 85, HEIGHT + 5, PressedRight);
  btnUp := TW3Button.Create(Document);
  SetupGameButton(btnUp, '↑', 60, 165, HEIGHT + 5, PressedUp);
  btnDown := TW3Button.Create(Document);
  SetupGameButton(btnDown, '↓', 60, 245, HEIGHT + 5, PressedDown);

  asm
    window.onkeydown = function(e)
    {
    TCanvasProject.KeyDownEvent(Self,e.keyCode);
    }
    window.focus();
  end;
  KeyDownEvent(0);
  GameView.Delay := DELAY;
  GameView.StartSession(False);
end;

procedure TCanvasProject.ApplicationClosing;
begin
  GameView.EndSession;
  Grid.Destroy;
  inherited;
end;

procedure TCanvasProject.PaintView(Canvas: TW3Canvas);

  procedure TextColor(colour: TConsoleColour);
  begin
    Grid.TextColour := colour;
  end;

  procedure TextBackground(colour: TConsoleColour);
  begin
    Grid.BackgroundColour := colour;
  end;

  procedure write(txt: string);
  begin
    Grid.write(txt);
  end;

  procedure writeln(txt : string);
  begin
    Grid.write(txt);
    Grid.CursorX := 1;
    Grid.CursorY := Grid.CursorY + 1;
  end;

  procedure ClrScr;
  begin
    Grid.ClearGrid;
  end;

  procedure ClrEOL;
  begin
    grid.ClearEol(Grid.CursorX, Grid.CursorY);
  end;

  procedure PaintGrid;
  begin
    Canvas.Font := IntToStr(FONT_SIZE) + 'px Lucida Console, Monaco, monospace';
    var currentChar: TCharacter;
    for var x := 1 to COLS do
      for var y := 1 to ROWS do
        begin
          currentChar := Grid.getCharacters[x, y];
          SetTextColor(currentChar.TextBackGroundColour, Canvas);
          Canvas.FillRect((x - 1) * CELL_WIDTH, ((y - 1) * CELL_HEIGHT) + 1, CELL_WIDTH, CELL_HEIGHT);
          SetTextColor(currentChar.TextColour, Canvas);
          Canvas.FillText(currentChar.Letter, (x - 1) * CELL_WIDTH, y * CELL_HEIGHT);
        end;
  end;
begin
  inc(FrameNumber);
  textColor(green);
  textBackground(brown);
  clrscr;
  if framenumber = 1 then
    begin
      start := time;
      for var row := 1 to 24 do  //populating grid without player
        writeln(Maze[row]);
      PlayerX := 79;
      PlayerY := 2;
    end
  else
    begin
      GoToXY(1, 1);
      for var row := 1 to 24 do // populating grid without player
        writeln(Maze[row]);
      GoToXY(PlayerX, PlayerY);
      if PressedLeft and (Grid.getCharacters[Grid.CursorX - 1, Grid.CursorY].Letter <> '#') then
        begin
          Grid.CursorX := Grid.CursorX - 1;  //move left if not blocked
          PlayerX := Grid.CursorX;
        end
      else if PressedRight and (Grid.getCharacters[Grid.CursorX + 1, Grid.CursorY].Letter <> '#') then
        begin
          Grid.CursorX := Grid.CursorX + 1;  //move right if not blocked
          PlayerX := Grid.CursorX;
        end
      else if PressedUp and (Grid.getCharacters[Grid.CursorX, Grid.CursorY - 1].Letter <> '#') then
        begin
          Grid.CursorY := Grid.CursorY - 1;  //move up if not blocked
          PlayerY := Grid.CursorY;
        end
      else if PressedDown and (Grid.getCharacters[Grid.CursorX, Grid.CursorY + 1].Letter <> '#') then
        begin
          Grid.CursorY := Grid.CursorY + 1;  //move down if not blocked
          PlayerY := Grid.CursorY;
        end;
      // teleporting
      if (PlayerX = 27) and (PlayerY = 13) then
        begin
          PlayerX -= 11;
          PlayerY +=7;
        end;
      if (PlayerX = 18) and (PlayerY = 20) then
        begin
          PlayerX += 10;
          PlayerY -= 7;
        end;
      if (PlayerX = 10) and (PlayerY = 18) then
        begin
          finish := time;
          seconds := (finish - start) * 24 * 60 * 60;
          var secs := round(seconds);
          ShowMessage('You win in ' + inttostr(secs) + ' seconds! Refresh for another try.');
          GameView.EndSession;
        end;
    end;
  // Target and teleporting symbols
  goToXY(10, 18);
  textcolor(white);
  write('0');
  textcolor(blue);
  goToXY(27, 13);
  write('X');
  goToXY(18, 20);
  write('X');

  goToXY(PlayerX, PlayerY);
  textcolor(yellow);
  write('@');
  PaintGrid;
end;

end.

    

Smart Pascal Code of uCrtCanvas Unit

unit uCrtCanvas;

interface

uses 
  SmartCL.System, System.Colors, SmartCL.Graphics;

type
  TConsoleColour = (black, blue, green, cyan, red, magenta, brown, lightgray,
                    darkgray, lightblue, lightgreen, lightcyan, lightred, lightmagenta, yellow, white);

  TCharacter = record
    Letter: string = ' ';
    TextColour: TConsoleColour = white;
    TextBackgroundColour = black;
  end;

  TCharacters = array[1..80, 1..25] of TCharacter;

  TConsoleGrid = class
  private
    FTextColour: TConsoleColour = black;
    FBackgroundColour: TConsoleColour = white;
    FCursorX: integer = 1;
    FCursorY: integer = 1;
    FRows: integer = 25;
    FCols: integer = 80;
    FCharacters: TCharacters;
  public
    procedure setCharacters(Char: TCharacters);
    function getCharacters: TCharacters;
    procedure SetCursorX(newX: integer);
    procedure SetCursorY(newY: integer);
    procedure SetXY(newRec: TCharacter; X, Y: integer);
    function GetXY(X, Y: integer): TCharacter;
    procedure write(txt: string);
    procedure ClearEOL(startX, clearY: integer);
    procedure ClearCell(clearX, clearY: integer);
    procedure ClearGrid;
    property TextColour: TConsoleColour read FTextColour write FTextColour;
    property BackgroundColour: TConsoleColour read FBackgroundColour write FBackgroundColour;
    property CursorX: integer read FCursorX write SetCursorX;
    property CursorY: integer read FCursorY write SetCursorY;
    property Cols: integer read FCols write FCols;
    property Rows: integer read FRows write FRows;
  end;

procedure SetTextColor(colour: TConsoleColour; Canvas : TW3Canvas);

implementation

procedure SetTextColor(colour: TConsoleColour; Canvas : TW3Canvas);
begin
  case colour of
    black: Canvas.FillStyle := 'black';
    white: Canvas.FillStyle := 'white';
    brown: Canvas.FillStyle := ColorToWebStr(clBrown);
    red: Canvas.FillStyle := 'red';
    magenta: Canvas.FillStyle := ColorToWebStr(clMagenta);
    yellow: Canvas.FillStyle := 'yellow';
    green: Canvas.FillStyle := 'green';
    cyan: Canvas.FillStyle := ColorToWebStr(clCyan);
    blue: Canvas.FillStyle := 'blue';
    lightgray: Canvas.FillStyle := ColorToWebStr(clLightGray);
    darkgray: Canvas.FillStyle := ColorToWebStr(clDarkGray);
    lightred: Canvas.FillStyle := 'rgb(250, 130, 130)';
    lightmagenta: Canvas.FillStyle := 'rgb(250, 130, 250)';
    lightgreen: Canvas.FillStyle := ColorToWebStr(clLightGreen);
    lightcyan: Canvas.FillStyle := ColorToWebStr(clLightCyan);
    lightblue: Canvas.FillStyle := 'rgb(130, 130, 250)';
  end;
end;

procedure TConsoleGrid.setCharacters(Char: TCharacters);
begin
  FCharacters := Char;
end;
function TConsoleGrid.getCharacters: TCharacters;
begin
  Result := FCharacters;
end;

procedure TConsoleGrid.SetCursorX(newX: integer);
begin
  if (newX > 0) and (newX <= Cols) then
    FCursorX := newX;
end;

procedure TConsoleGrid.SetCursorY(newY: integer);
begin
  if (newY > 0) and (newY <= Rows) then
    FCursorY := newY;
end;

procedure TConsoleGrid.SetXY(newRec: TCharacter; X, Y: integer);
begin
  if (X > 0) and (X <= Cols) and (Y > 0) and (Y <= Rows) then
    FCharacters[X, Y] := newRec;
end;

function TConsoleGrid.GetXY(X, Y: integer): TCharacter;
begin
  Result := getCharacters[X, Y];
end;

procedure TConsoleGrid.write(txt: string);
var
  tempchar: TCharacter;
begin
  for var i := 1 to length(txt) do
    begin
      tempChar.TextColour := TextColour;
      tempChar.TextBackgroundColour := BackgroundColour;
      tempChar.Letter := txt[i];
      SetXY(tempChar, CursorX + i - 1, CursorY);
    end;
end;

procedure TConsoleGrid.ClearCell(clearX, clearY: integer);
var
  tempChar: TCharacter;
begin
  tempChar.TextBackgroundColour := BackGroundColour;
  tempChar.Letter := ' ';
  tempChar.TextColour := black; //Not needed
  SetXY(tempChar, clearX, clearY);
end;

procedure TConsoleGrid.ClearEOL(startX, clearY: integer);
begin
  for var x := startX to Cols do
    ClearCell(x, clearY);
end;

procedure TConsoleGrid.ClearGrid;
begin
  for var y := 1 to Rows do
    ClearEOL(1, y);
end;

end.

Programming - a skill for life!

Crt game by Nikhil (Y9, Age ~14)