Web Version of RockPaperScissors
Smart Pascal version of RockPaperScissors by Hasaan Ausat: Y12 Age ~16
Introduction
This web version of RockPaperScissors is designed as a preview to be run in a browser on a PC. If the program does not work in your current browser, 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. The Smart Pascal code of the main unit follows the program in action. See the web version of MorseCode for the code of the Crt unit. On a Raspberry Pi, install the Lucida Console font.
Program in Action
Code of the Main Unit
unit uMain; { Copyright (c) 2010 Hasaan Ausat 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 for web preview by PPS 2014 } interface uses System.Types, SmartCL.System, SmartCL.Components, SmartCL.Application, SmartCL.Game, SmartCL.GameApp, SmartCL.Graphics, uCrtCanvas; type TReadState = (rsNotReading, rsReading, rsFinishedReading); TCanvasProject = class(TW3CustomGameApplication) private const DELAY = 2; const SCALE_FACTOR = 2; 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; playcount, playercount, compcount, tiecount, number, answer, entry_point : Integer; reading_state: TReadState = rsNotReading; TempReadString: string = ''; Grid: TConsoleGrid; protected procedure ApplicationStarting; override; procedure ApplicationClosing; override; procedure PaintView(Canvas: TW3Canvas); override; procedure KeyDownEvent(mCode: integer); procedure GoToXY(X, Y: integer); procedure clrscr; procedure ClrEOL; procedure textColor(colour: TConsoleColour); procedure textBackground(colour: TConsoleColour); procedure write(txt: string); procedure writeln(txt: string); overload; procedure writeln; overload; procedure readln(var InputString : string); procedure Main; end; implementation var input_chars: string = ''; procedure TCanvasProject.ApplicationStarting; begin inherited; Randomize; entry_point := 1; playcount := 0; compcount := 0; playercount := 0; tiecount := 0; Grid := new TConsoleGrid; Grid.Rows := ROWS; Grid.Cols := COLS; GameView.Width:= WIDTH; GameView.Height := HEIGHT; asm window.onkeydown = function(e) { TCanvasProject.KeyDownEvent(Self, e.keyCode); } end; KeyDownEvent(0); GameView.Delay := DELAY; GameView.StartSession(False); end; procedure TCanvasProject.KeyDownEvent(mCode: integer); begin if mCode = 27 then ApplicationClosing; if reading_state = rsReading then if mCode = 13 then reading_state := rsFinishedReading else begin case mCode of 32, 48, 49, 50, 78, 89: TempReadString := chr(mCode); end; end; end; procedure TCanvasProject.GoToXY(X, Y: integer); begin Grid.CursorX := X; Grid.CursorY := Y; end; procedure TCanvasProject.ClrScr; begin Grid.ClearGrid; GoToXY(1, 1); end; procedure TCanvasProject.ClrEOL; begin grid.ClearEol(Grid.CursorX, Grid.CursorY); end; procedure TCanvasProject.textColor(colour: TConsoleColour); begin Grid.TextColour := colour; end; procedure TCanvasProject.textBackground(colour: TConsoleColour); begin Grid.BackgroundColour := colour; end; procedure TCanvasProject.write(txt: string); begin Grid.write(txt); end; procedure TCanvasProject.writeln(txt : string); begin Grid.write(txt); Grid.CursorX := 1; Grid.CursorY := Grid.CursorY + 1; end; procedure TCanvasProject.writeln; begin Grid.CursorX := 1; Grid.CursorY := Grid.CursorY + 1; end; procedure TCanvasProject.readln(var InputString : string); begin case reading_state of rsReading: write(TempReadString); rsNotReading: begin reading_state := rsReading; TempReadString := ''; end; rsFinishedReading: begin InputString := TempReadString; reading_state := rsNotReading; writeln(TempReadString); end; end; end; procedure TCanvasProject.ApplicationClosing; begin GameView.EndSession; Grid.Destroy; inherited; end; procedure TCanvasProject.Main; begin case entry_point of 1: begin writeln('|-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*|'); writeln('| |'); writeln('| WELCOME TO ROCK PAPER SCISSORS |'); writeln('| |'); writeln('|*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-|'); writeln; writeln('Rock is 0, Paper is 1, Scissors is 2'); writeln; readln(input_chars); if TempReadString = '' then exit; answer := RandomInt(3); //answer will be 0, 1, or 2 entry_point := 2; number := strToInt(TempReadString[1]); end; 2: begin writeln; writeln('I have picked ' + intToStr(answer)); writeln; if answer = number then begin writeln('|-------|'); writeln('| Tie!! |'); writeln('|-------|'); writeln; playcount := playcount + 1; tiecount := tiecount + 1; end; if (answer = 0) and (number = 1) then begin writeln('|------------|'); writeln('| You win :) |'); writeln('|------------|'); writeln; playcount := playcount + 1; playercount := playercount + 1; end; if (answer = 1) and (number = 0) then begin writeln('|--------------|'); writeln('| You lose :( |'); writeln('|--------------|'); writeln; playcount := playcount + 1; compcount := compcount + 1; end; if (answer = 1) and (number = 2) then begin writeln('|------------|'); writeln('| You win :) |'); writeln('|------------|'); writeln; playercount := playercount + 1; playcount := playcount + 1; end; if (answer = 2) and (number = 1) then begin writeln('|--------------|'); writeln('| You lose :( |'); writeln('|--------------|'); writeln; playcount := playcount + 1; compcount := compcount + 1; end; if (answer = 2) and (number = 0) then begin writeln('|------------|'); writeln('| You win :) |'); writeln('|------------|'); writeln; playercount := playercount + 1; playcount := playcount + 1; end; if (answer = 0) and (number = 2) then begin writeln('|--------------|'); writeln('| You lose :( |'); writeln('|--------------|'); writeln; playcount := playcount + 1; compcount := compcount + 1; end; entry_point := 3; writeln('Would you like to play again? y/n'); writeln; readln(input_chars); end; 3: begin if TempReadString[1] in ['Y', 'N'] then begin if tempReadString[1] = 'Y' then begin ClrScr; entry_point := 1; TempReadString := ''; reading_state := rsNotReading; exit; end else begin ClrScr; writeln('You have played ' + intToStr(playcount) + ' times'); writeln; writeln('You won ' + intToStr(playercount) + ' times'); writeln('You lost ' + intToStr(compcount) + ' times'); writeln('We drew ' + intToStr(tiecount) + ' times'); writeln; if compcount < playercount then begin writeln(' _'); writeln(' ( (('); writeln(' \ =\'); writeln(' __\_ `-\'); writeln('(____))( \----'); writeln('(____)) _'); writeln('(____))'); writeln('(____))____/----'); writeln; end; if compcount > playercount then begin writeln(' _____'); writeln('((____ \----'); writeln('((____'); writeln('((____'); writeln('((____ ----'); writeln(' / /'); writeln(' (_(('); writeln; end; if compcount = playercount then begin writeln(' _'); writeln(' ( (('); writeln(' \ =\'); writeln(' __\_ `-\'); writeln('(____))( \----'); writeln('(____)) _'); writeln('(____))'); writeln('(____))____/----'); writeln(' _____'); writeln('((____ \----'); writeln('((____'); writeln('((____'); writeln('((____ ----'); writeln(' / /'); writeln(' / =/'); writeln(' (_(('); writeln; end; writeln('Goodbye, Hope you had fun!!!!!!!!!'); writeln; writeln('RockPaperScissors (c) 2009 - Huskimo'); end; end; //if end; //case 3 end; // case entry end; procedure TCanvasProject.PaintView(Canvas: TW3Canvas); procedure PaintGrid; begin Canvas.Font := IntToStr(FONT_SIZE) +'px Courier New'; 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) + 2, CELL_WIDTH, CELL_HEIGHT); SetTextColor(currentChar.TextColour, Canvas); Canvas.FillText(currentChar.Letter, (x - 1) * CELL_WIDTH, y * CELL_HEIGHT); end; end; begin Main; PaintGrid; if entry_point < 3 then ClrScr; end; end.