Source code of Tetris applet

(*
   National russian game "Tetris"
   Created by Alexey Pajitnov
   Programmed in JOB by S.Sverdlov
   8.03.98/23.04.98

   <applet code="Tetris_Game" width=180 height=360>
   </applet>
*)

MODULE Tetris;

IMPORT
   app := javaapplet,
   awt := javaawt,
   ut  := javautil,
   Timers, SYSTEM;

CONST
   n = 24;
   m = 12;
   s = 14;

   UP    = 1004;
   DOWN  = 1005;
   LEFT  = 1006;
   RIGHT = 1007;

TYPE
   Field    = ARRAY n, m OF awt.PColor;
   Figure   = ARRAY 4, 4 OF BOOLEAN;
   Figures  = ARRAY 7 OF Figure;
   Colors   = ARRAY 7 OF awt.PColor;

   PGame* = POINTER TO Game;
   Game* = RECORD (app.Applet)
      g        : awt.PGraphics;
      field    : Field;
      figs     : Figures;
      bc       : awt.PColor;
      cols     : Colors;
      ncurr    : INTEGER;
      curr     : Figure;
      x, y     : INTEGER;
      timer    : Timers.Timer;
      rand     : ut.PRandom;
      fly      : BOOLEAN;
      timeevent: BOOLEAN;
      keyevent : BOOLEAN;
   END;

PROCEDURE ( a : PGame ) paint*( g : awt.PGraphics );
VAR
   i, j  : INTEGER;
   x, y  : INTEGER;
BEGIN
   y := 0;
   FOR i := 0 TO n-1 DO
      x := 0;
      FOR j := 0 TO m-1 DO
         g.setColor(a.field[i,j]);
         g.fillRect(x,y,s,s);
         INC( x, s+1 );
      END;
      INC( y, s+1 );
   END;
END paint;

PROCEDURE InitField( a : PGame );
VAR
   i, j  : INTEGER;
BEGIN
   FOR i := 0 TO n-1 DO
      FOR j := 0 TO m-1 DO
         a.field[i,j] := a.bc;
      END;
   END;
END InitField;

PROCEDURE Draw( a : PGame; col : awt.PColor );
VAR
   i, j  : INTEGER;
   x, y  : INTEGER;
BEGIN
   y := a.y;
   FOR i := 0 TO 3 DO
      x := a.x;
      FOR j := 0 TO 3 DO
         IF a.curr[i,j] & ( 0 <= x ) & ( x < m ) & ( 0 <= y ) & ( y < n ) THEN
            a.g.setColor(col);
            a.g.fillRect(x*(s+1),y*(s+1),s,s);
         END;
         INC(x);
      END;
      INC(y);
   END;
END Draw;

PROCEDURE Free( a : PGame; VAR f : Figure; x0, y0 : INTEGER ) : BOOLEAN;
VAR
   i, j  : INTEGER;
   x, y  : INTEGER;
   F     : BOOLEAN;
BEGIN
   F := TRUE;
   i := 0; y := y0;
   REPEAT
      j := 0; x := x0;
      REPEAT
         IF f[i,j] &
            ( (x<0) OR (x>=m) OR (y>=n) OR
              (y>=0) & (a.field[y,x] # a.bc) )
         THEN
            F := FALSE;
         END;
         INC(j); INC(x);
      UNTIL ~F OR (j=4);
      INC(i); INC(y);
   UNTIL ~F OR (i=4);
   RETURN F;
END Free;

PROCEDURE Move( a : PGame; dx, dy : INTEGER );
BEGIN
   Draw( a, a.bc );
   INC( a.x, dx );  INC( a.y, dy );
   Draw( a, a.cols[a.ncurr] );
END Move;

PROCEDURE Fix( a : PGame );
VAR
   i, j  : INTEGER;
   x, y  : INTEGER;
BEGIN
   y := a.y;
   FOR i := 0 TO 3 DO
      x := a.x;
      FOR j := 0 TO 3 DO
         IF a.curr[i,j] & ( 0<=x ) & ( x<m ) & ( 0<=y ) & ( y<n ) THEN
            a.field[y,x] := a.cols[a.ncurr];
         END;
         INC(x);
      END;
      INC(y);
   END;
END Fix;

PROCEDURE RowEmpty( a : PGame; r : INTEGER ) : BOOLEAN;
VAR
   e  : BOOLEAN;
   j  : INTEGER;
BEGIN
   j := m;
   REPEAT
      DEC(j);
      e := a.field[r,j] = a.bc;
   UNTIL (j=0) OR ~e;
   RETURN e;
END RowEmpty;

PROCEDURE ClearRow( a : PGame; r : INTEGER );
BEGIN
   WHILE (r>0) & ~RowEmpty(a, r) DO
      a.field[r] := a.field[r-1];
      DEC(r);
   END;
   a.paint(a.g);
END ClearRow;

PROCEDURE RowFull( a : PGame; r : INTEGER ) : BOOLEAN;
VAR
   j     : INTEGER;
   full  : BOOLEAN;
BEGIN
   j := m;
   REPEAT
      DEC(j);
      full := a.field[r,j] # a.bc;
   UNTIL (j=0) OR ~full;
   RETURN full;
END RowFull;

PROCEDURE TestRows( a : PGame );
VAR
   i, j  : INTEGER;
   r     : INTEGER;
BEGIN
   i := 3;
   r := a.y + i;
   REPEAT
      IF ( r < n ) & ( r>=0 ) & RowFull( a, r ) THEN
         ClearRow( a, r );
      ELSE
         DEC(r);
      END;
      DEC(i);
   UNTIL i<0;
END TestRows;

PROCEDURE FigDown( a : PGame );
BEGIN
   IF Free( a, a.curr, a.x, a.y+1 ) THEN
      Move( a, 0, 1 )
   ELSE
      a.fly := FALSE;
      Fix(a);
      TestRows(a);
   END;
END FigDown;

PROCEDURE Rotate( f : Figure; VAR fr : Figure );
VAR
   i, j : INTEGER;
BEGIN
   i := 0; j := 3;
   REPEAT
      fr[i,0] := f[0,j];
      fr[3,i] := f[i,0];
      fr[j,3] := f[3,i];
      fr[0,i] := f[i,3];
      INC(i); DEC(j);
   UNTIL j<0;
   fr[1,1] := f[1,2];
   fr[2,1] := f[1,1];
   fr[2,2] := f[2,1];
   fr[1,2] := f[2,2];
END Rotate;

PROCEDURE FigRotate(a : PGame);
VAR
   temp : Figure;
BEGIN
   Rotate( a.curr, temp );
   IF Free( a, temp, a.x, a.y ) THEN
      Draw( a, a.bc );
      a.curr := temp;
      Draw( a, a.cols[a.ncurr] );
   END;
END FigRotate;

PROCEDURE FigRelease(a : PGame);
BEGIN
   WHILE Free( a, a.curr, a.x, a.y+1 ) DO
      Move( a, 0, 1 );
   END;
END FigRelease;

PROCEDURE FigRight(a : PGame);
BEGIN
   IF Free( a, a.curr, a.x+1, a.y ) THEN
      Move( a, 1, 0 );
   END;
END FigRight;

PROCEDURE FigLeft(a : PGame);
BEGIN
   IF Free( a, a.curr, a.x-1, a.y ) THEN
      Move( a, -1, 0 );
   END;
END FigLeft;

PROCEDURE NewColor( r, g, b : INTEGER ) : awt.PColor;
VAR
   c : awt.PColor;
BEGIN
   SYSTEM.NEW( c, r, g, b );
   RETURN c;
END NewColor;

PROCEDURE InitColors( a : PGame );
BEGIN
   a.bc := NewColor( 220, 220, 220 );

   a.cols[0] := NewColor( 255, 0, 0 );
   a.cols[1] := NewColor( 255, 128, 0 );
   a.cols[2] := NewColor( 255, 255, 0 );
   a.cols[3] := NewColor( 0, 255, 0 );
   a.cols[4] := NewColor( 0, 255, 255 );
   a.cols[5] := NewColor( 0, 0, 255 );
   a.cols[6] := NewColor( 255, 0, 255 );
END InitColors;

PROCEDURE InitFigures( a : PGame );

VAR
   i, j, k  : INTEGER;
BEGIN
   FOR i := 0 TO 6 DO
      FOR j := 0 TO 3 DO
         FOR k := 0 TO 3 DO
            a.figs[i,j,k] := FALSE;
         END;
      END;
   END;

   a.figs[0,1,0] := TRUE;
   a.figs[0,1,1] := TRUE;
   a.figs[0,1,2] := TRUE;
   a.figs[0,1,3] := TRUE;

   a.figs[1,1,2] := TRUE;
   a.figs[1,2,0] := TRUE;
   a.figs[1,2,1] := TRUE;
   a.figs[1,2,2] := TRUE;

   a.figs[2,1,0] := TRUE;
   a.figs[2,1,1] := TRUE;
   a.figs[2,1,2] := TRUE;
   a.figs[2,2,2] := TRUE;

   a.figs[3,1,1] := TRUE;
   a.figs[3,1,2] := TRUE;
   a.figs[3,2,1] := TRUE;
   a.figs[3,2,2] := TRUE;

   a.figs[4,1,0] := TRUE;
   a.figs[4,1,1] := TRUE;
   a.figs[4,2,1] := TRUE;
   a.figs[4,2,2] := TRUE;

   a.figs[5,0,1] := TRUE;
   a.figs[5,1,1] := TRUE;
   a.figs[5,1,2] := TRUE;
   a.figs[5,2,2] := TRUE;

   a.figs[6,1,0] := TRUE;
   a.figs[6,1,1] := TRUE;
   a.figs[6,1,2] := TRUE;
   a.figs[6,2,1] := TRUE;
END InitFigures;

PROCEDURE Rnd( r : ut.PRandom; n : INTEGER ) : INTEGER;
BEGIN
   RETURN SHORT(ENTIER(n*r.nextFloat()));
END Rnd;

PROCEDURE NewFigure( a : PGame );
VAR
   rot   : INTEGER;
BEGIN
   a.x := m DIV 2 - 2;
   a.y := -2;
   a.ncurr := Rnd( a.rand, 7 );
   a.curr := a.figs[a.ncurr];
   rot := Rnd( a.rand, 4 );
   WHILE rot > 0 DO
      Rotate( a.curr, a.curr );
      DEC(rot);
   END;
END NewFigure;

PROCEDURE TimerStep( a : PGame );
BEGIN
   IF a.fly THEN
      FigDown(a);
   ELSE
      NewFigure(a);
      IF Free( a, a.curr, a.x, a.y ) THEN
         Draw(a, a.cols[a.ncurr]);
         a.fly := TRUE;
      ELSE
         InitField(a);
         a.paint(a.g);
      END;
   END;
END TimerStep;

PROCEDURE ( a : PGame ) keyDown*( e : awt.PEvent; key : INTEGER ) : BOOLEAN;
BEGIN
   REPEAT UNTIL ~a.timeevent;
   a.keyevent := TRUE;
   CASE key OF
   |UP      : FigRotate(a);
   |DOWN    : FigRelease(a);
   |LEFT    : FigLeft(a);
   |RIGHT   : FigRight(a);
   ELSE
   END;
   a.keyevent := FALSE;
   RETURN TRUE;
END keyDown;

PROCEDURE ( a : PGame ) handleEvent*( e : awt.PEvent ) : BOOLEAN;
BEGIN
   IF ( e.id = Timers.TimerEVENT ) & ~a.keyevent THEN
      a.timeevent := TRUE;
      TimerStep(a);
      a.timeevent := FALSE;
      RETURN TRUE;
   END;
   RETURN a.handleEvent^(e);
END handleEvent;

PROCEDURE ( a : PGame ) init*();
BEGIN
   InitColors( a );
   InitFigures( a );
   InitField( a );
   SYSTEM.NEW( a.rand );
   a.g := a.getGraphics();
   a.fly := FALSE;
   a.timer.Start( a, 400 );
   a.timeevent := FALSE;
   a.keyevent := FALSE;
END init;

END Tetris.