Extending TINY

You should find it interesting and rewarding to add functionality to TINY. We demonstrate how to add more keywords to the language by adapting TINY14E so that it has much of the functionality of the CRT unit in Lazarus. We name the new version TINY14_CRT. We provide the additional code in later sections on this page and also some of the TINY code that we have used to test it.

As a preliminary, we tested examples of the MASM assembler code were aiming to generate. See Console Games in the assembler tutorial.

The new functionality is provided using the keywords HALT, GOTOXY, CLS, SETCOLORS, KEYPRESS, READKEY, SLEEP and RANDOM.

The steps are as follows (illustrated for GoToXY):
  1. Add a new procedure to uParser e.g. DoGoToXY.
  2. Give it a keyword e.g. GOTOXY in the KWlist array in uGlobals.
  3. Give it a letter (in this case g) to represent it in the symbol table and put it in the appropriate position in the KWcode string.
  4. Increment the values of the constants NKW and NKW1.
  5. Write the new code generation procedure (GoToXY) in the uCodeGen unit and remember to include the first line in the interface section.
  6. Add the symbol (u) and the corresponding procedure call (DoGoToXY) to the case statement in the DoBlock procedure in the uParser unit.

We used the following batch file to translate the TINY source in src.txt and then execute the resultant temp.exe.

TINY14_CRT
\masm32\bin\ml /c /Zd /coff temp.asm
\masm32\bin\Link /SUBSYSTEM:CONSOLE temp.obj 
temp

The new uGlobals unit

unit uGlobals;

interface

{ Type declarations }
type
  Symbol = string[9]; 
  SymTab = array[1 .. 1000] of Symbol;
  TabPtr = ^SymTab;

{ Constant declarations }
const
  TAB = ^I;
  CR  = ^M;
  LF  = ^J;
  MaxEntry = 1000;
  MaxParams = 50;

  { Definition of keywords and token types }
  NKW =  25;
  NKW1 = 26;
  KWlist : array[1 .. NKW] of Symbol =
                ('IF', 'ELSE', 'ENDIF', 'WHILE', 'ENDWHILE','REPEAT','UNTIL',
                 'FOR', 'ENDFOR', 'READ', 'READLN', 'WRITE', 'WRITELN', 'VAR',
                 'END', 'PROCEDURE', 'PROGRAM', 'HALT', 'GOTOXY', 'CLS', 'SETCOLORS',
                 'KEYPRESS', 'READKEY', 'SLEEP', 'RANDOM' );

  KWcode : string[NKW1] = 'xilewerufeRLWNvepPhgcCkKsm';

{ Variable declarations }
var
  Look : char;             { Lookahead character }
  Token : char;            { Encoded token       }
  Value : string[16];      { Unencoded token     }

  ST : array[1 .. MaxEntry] of Symbol;
  SType : array[1 .. MaxEntry] of char;
  LCount : integer = 0;
  NEntry : integer = 0;

  NumParams : integer; //Number of params in current procedure
  Base : integer;
  Params : array[1 .. MaxParams] of Symbol;

  SourceFile, AsmFile : textfile;

implementation

end.

Additional procedures in the uParser unit

{ End the program. }
procedure DoHalt;
begin
  Next;
  Quit;
end;

{ Process a GoToXY statement. }
procedure DoGoToXY;  //CRT
begin
  Next;
  MatchString('(');
  Expression;
  Store('X');
  MatchString(',');
  Expression;
  Store('Y');
  MatchString(')');
  GoToXY;
end;

{ Process a cls statement. }
procedure DoClrScr;
begin
  Next;
  MatchString('(');
  MatchString(')');
  ClrScr;
end;

{ Process a setColors statement. }
procedure DoSetColors;
var
  TextColour, BackColour : string;
begin
  Next;
  MatchString('(');
  TextColour := Value;
  Next;
  MatchString(',');
  BackColour := Value;
  Next;
  MatchString(')');
  SetColors(TextColour, BackColour);
end;

{ Process a key press statement. }
procedure DoKeyPress;
begin
  Next;
  MatchString('(');
  MatchString(')');
  KeyPress;
end;

{ Process a readkey statement. }
procedure DoReadKey;
var
  Key : string;
begin
  Next;
  MatchString('(');
  Key := Value;
  Next;
  MatchString(')');
  ReadKey(Key);
end;

{ Process a random statement.
  Puts random value in var given as first argument
  RANDOM(Varname, Limit)
}
procedure DoRandom;
var
  Rand : string;
begin
  Next;
  MatchString('(');
  Rand := Value;
  Next;
  MatchString(',');
  Expression;
  Store(Rand);
  Random(Rand);
  MatchString(')');
end;

{ Process a sleep statement. }
procedure DoSleep;
begin
  Next;
  MatchString('(');
  Expression;
  Store('DELAY');
  MatchString(')');
  Sleep;
end; 

The new DoBlock procedure in the uParser unit

{ Parse and translate a block of statements. }
procedure Block;
begin
  Scan;
  while not (Token in ['e', 'l', 'u']) do
    begin
      case Token of
        'i' : DoIf;
        'w' : DoWhile;
        'r' : DoRepeat;
        'f' : DoFor;
        'R' : DoRead;
        'L' : DoReadLn;
        'W' : DoWrite;
        'N' : DoWriteLn;
        'h' : DoHalt;
        'g' : DoGoToXY;
        'c' : DoClrScr;
        'C' : DoSetColors;
        'k' : DoKeyPress;
        'K' : DoReadKey;
        's' : DoSleep;
        'm' : DoRandom;
      else
        AssignOrProc;
      end;
      Semi;
      Scan;
    end;
end;  

The new procedures in the uCodeGen unit

{ Position the cursor at X, Y  }
procedure GoToXY; //locate is zero based
begin
  EmitLn('DEC X');
  EmitLn('DEC Y');
  EmitLn('invoke locate, X, Y');
end;

{ Clear screen }
procedure ClrScr;
begin
  EmitLn('invoke locate, 0, 0');
  EmitLn('print OFFSET spaces');
  EmitLn('invoke locate, 0, 0');
end;

{ Change the  colours. }
procedure SetColors(TextColour, BackColour : string);
begin
  EmitLn('invoke GetStdHandle, STD_OUTPUT_HANDLE');
  EmitLn('MOV OUTHANDLE, EAX');
  EmitLn('invoke SetConsoleTextAttribute, OUTHANDLE, FOREGROUND_' + TextColour + ' OR BACKGROUND_' +  BackColour);
end;

{ Test for key press. }
procedure KeyPress;
begin
  EmitLn('call crt__kbhit'); //EAX is zero if no key press
  EmitLn('Test EAX, EAX');
  EmitLn('CMOVZ EDX, F');
  EmitLn('CMOVNZ EDX, T');
  EmitLn('MOV KP, EDX');
end;

{ Read the pressed key. }
procedure Readkey(K : string);
begin
  EmitLn('call crt__getch');
  EmitLn('MOV ' + K + ', EAX');
end;

{ Store a random number in the variable supplied as a parameter. }
procedure Random(RandVar : string);
begin
  EmitLn('invoke nrandom, ' + RandVar);
  EmitLn('MOV ' + RandVar + ', EAX');
end;

{ Pause for DELAY ms. }
procedure Sleep;
begin
  EmitLn('invoke Sleep, DELAY');
end;

{ End the program. }
procedure Quit;
begin
  EmitLn('exit');
end;     

A TINY test program

We adapted Joe's SnakeWithoutATail to obtain this test program. It displays effectively without a procedure to turn off the cursor.

program Snake

{   Based on Pascal Version 1.0
    Copyright (c) 2012 Joe

    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/
}

var
  c1, oldC, playerX, playerY, oldplrX, oldplrY, speed, fruitY,
  fruitX, scr, MaxX, MaxY, SlowSpeed, FastSpeed, x1, TempRand

procedure game()
begin
  MaxX = 79
  MaxY = 24
  SlowSpeed = 120
  FastSpeed = 60
  x1 = 10
  fruitX = 8
  fruitY = 9
  playerX = 10
  playerY = 10
  speed = SlowSpeed
  scr = 0
  oldplrX = playerX
  oldplrY = playerY
  setColors(blue, green)
  cls()
  {This is the start screen.}
  gotoxy(1, 1);
  writeln('Welcome To The Game');
  writeln('Instructions');
  writeln('Eat fruit');
  writeln('W     - Up');
  writeln('S     - Down');
  writeln('D     - Right');
  writeln('A     - Left');
  writeln('Space - toggle run or walk');
  writeln('ESC - End');
  writeln('Press any key to begin');

  readkey(c1)
  cls()
  {Draw initial screen position}
  gotoxy(playerX, playerY)
  writeln('#')
  repeat

    keypress()
    if KP = T
      oldC = c1
      readkey(c1)
    endIf

    {Controls}
    if c1 = 119
      PlayerY = PlayerY - 1
    endIf
    if c1 = 97
      PlayerX = PlayerX - 1
    endIf
    if c1 = 100
      PlayerX = PlayerX + 1
    endIf
    if c1 = 115
      PlayerY = PlayerY + 1
    endIf
    if c1 = 27
      Halt
    endIf
    if c1 = 32
      if speed = SlowSpeed
        speed = FastSpeed
      else
        speed = SlowSpeed
      endIf
      c1 = oldC
    endIf
    if (c1 <> 119) & (c1 <> 97) & (c1 <> 100) & (c1 <> 115) & (c1 <> 27)
      c1 = oldC
    endIf

    {drawing fruit}
    gotoxy(fruitX, fruitY)
    write('&')

    if playerX < 1
      playerX = MaxX
    endIf
    if playerY < 1
      playerY = MaxY
    endIf
    if playerX > MaxX
      playerX = 1
    endIf
    if playerY > MaxY
      playerY = 1
    endIf
    if (playerX <> oldplrX) | (playerY <> oldplrY)
      {Delete old snake.}
      gotoxy(oldplrX, oldplrY)
      write(' ');

      {Write new snake.}
      gotoxy(playerX, playerY)
      write('#')

      {Remember old snake coordinates.}
      oldplrX = playerX
      oldplrY = playerY
    endIf

    {drawing fruit}
    gotoxy(fruitX, fruitY)
    write('&')
    sleep(speed)

    {code for collecting fruit}
    if (playerX = fruitX) & (playerY = fruitY)
      TempRand = MaxX
      Random(TempRand, TempRand)
      fruitX = TempRand + 1
      TempRand = MaxY
      Random(TempRand, TempRand)
      fruitY = TempRand + 1
      scr = scr + x1
    endIf

  until F
end

begin
  game()
end.
Programming - a skill for life!

by PPS in association with Jack Crenshaw