-+-+-+-+-+-+-+-+ START OF PART 3 -+-+-+-+-+-+-+-+
X(* GameLoop                                                                *
V)
X(*                                                                         *
V)
X(* Main gameplay loop here.                                                *
V)
X(*                                                                         *
V)
XPROCEDURE GameLoop;
X
XVAR greebie, next_greebie : Greebie_Type;
XVAR Greebie_Start : INTEGER;
XVAR inChar : CHAR;
XVAR cycle: INTEGER;
XVAR Delay: real;
XVAR still_falling, was_dropped : BOOLEAN;
X     `20
X   PROCEDURE init;
X   BEGIN
X     Options.quit := FALSE;
X     Options.Display_next := TRUE;
X     wow.score := 0;
X     wow.level := 1;
X     wow.lines := 0;
X     wow.stage := 1;
X     wow.lines_target := 12;
X     wow.random := 4;
X     Seed_Initialize;
X     SetUpScreen;      `20
X     ClearGrid( grid );
X     QIO_Write( vt100_esc+'`5B?25l' ); `7BTurn off cursor `7D
X     QIO_Write( vt100_no_application_keypad );     `7BNumeric Keypad  `7D
X     QIO_Write( vt100_esc+'`5B4l' );   `7BReplace Mode    `7D
X     Next_Greebie.x_pos := 6;
X     Next_Greebie.y_pos := 17;
X     Greebie_Start := 4;
X     play := TRUE;
X     Is_Msg := FALSE;
X     still_falling := TRUE;
X     was_dropped := FALSE;
X     cycle := 1;`20
X     delay := initial_delay;
X     WITH greebie DO`20
X       BEGIN
X          shape := Random( 7 ) ;
X          rot := 1;
X          x_pos := Greebie_start;
X          y_pos := 1;
X       END;
X     Next_Greebie.shape := Random( 7 );
X     Next_Greebie.rot := 1;
X     PutShape( greebie, s_draw );
X     Show_wow;
X   END;
X
XBEGIN`7B GameLoop `7D
X   init;
X   QIO_Purge;
X   `7B********************************`7D
X   `7B*  Play Loop                    `7D
X    WHILE play DO `7BOh God, not Kathy playing again is it?`7D
X      BEGIN
X      Sleep( 0,delay );
X      still_falling := TRUE;
X      inchar := QIO_1_Char_Now;
X      CASE Lower_Case(inchar) OF
X         left_key  : Move_Left( greebie );
X         right_key : Move_Right( greebie );
X         down_key  : still_falling := Move_Down( greebie );  `20
X         rotate_key: Rotate_Greebie( greebie );
X         drop_key  : BEGIN
X                       Drop_Greebie( greebie );
X                       was_dropped := TRUE;
X                     END;                     `20
X         redraw_key: ReDraw_Complete_Screen( Next_Greebie );
X         pause_key : Pause;
X         quit_key  :  BEGIN
X                        options.quit := True;
X                        play := False; `7BPiker!`7D
X                      END;
X         END;
X      cycle := cycle + 1;
X      IF ((cycle = 6) AND (play)) OR (was_dropped) THEN
X         BEGIN
X         cycle := 1;
X         IF was_dropped THEN
X            BEGIN
X            still_falling := FALSE;
X            was_dropped := FALSE;
X            END
X         ELSE
X            IF still_falling THEN
X              still_falling := Move_Down( greebie );
X         IF NOT( still_falling ) THEN BEGIN
X            Show_Wow;
X            play := Check_Resting( greebie, delay );
X            Greebie := Next_Greebie;
X            ClearNext( Next_Greebie );
X            WITH greebie DO`20
X              BEGIN
X              x_pos := Greebie_start;
X              y_pos := 1;
X              END;
X            IF play THEN
X              play := Check_Top( greebie );
X            IF play THEN BEGIN
X              Next_Greebie.shape := Random( 7 );
X              Next_Greebie.rot := 1;
X              PutShape( greebie,s_draw );
X              DisplayNext( Next_Greebie );
X            END;
X          END;
X         END; `20
X      END;
X      QIO_Write( VT100_ESC+'`5B?25h' );  `7Bturn cursor on again...`7D
X   END;
X     `20
XPROCEDURE Introduction;
XTYPE
X    filenameStr = VARYING`5B40`5D OF CHAR;
XVAR inkey : CHAR;
X   infile : TEXT;
X
X  PROCEDURE Show_File( filename : filenameStr );
X  VAR line   : VARYING`5B127`5D OF CHAR;
X      notopen: BOOLEAN;
X      oc     : INTEGER;
X  BEGIN
X     notopen := TRUE; oc := 0;
X     WHILE notopen DO
X       BEGIN
X       OPEN ( infile, filename, old, sharing := readonly, error:= continue )
V;
X       IF status( infile ) = 0 THEN
X         BEGIN
X         oc := oc + 1;
X         notopen := FALSE;
X         IF oc > 5 THEN
X           BEGIN
X           QIO_WriteLn( 'ERROR! Unable to open '+filename );
X           Halt;
X           END;
X         END;
X       END;
X     RESET( infile );
X     WHILE NOT( EOF( infile )) DO
X        BEGIN
X        Readln( infile, line );
X        QIO_WriteLn( line );
X        END;
X     CLOSE( infile );
X   END;
X
XBEGIN
X   Clear;
X   QIO_Purge;
X   Show_File( datafile1 );
X   Sleep( 2, 0 );
X   Show_File( datafile2 );
X   REPEAT
X     inkey := QIO_1_Char;
X     IF (inkey = 'i') or  (inkey = 'I') THEN
X     Show_File( datafile3 );
X   UNTIL inkey = ' ';
XEND;
X
XBEGIN
X   Image_Dir;
X   Introduction;
X   InitShapes;
X   GameLoop;
X
X(*   Hall_Of_Fame( wow.score, wow.level ); *)  (* Use if desired - requires
V *)
X                                               (*                  FAME.OBJ
V *)
X
X   Top_Ten(  wow.score  );      (* Inherited from INTERACT library        *)
X                                (*            - note: does not show Level *)
V`20
XEND.  `20
X  `20
X
$ CALL UNPACK TETRIS.PAS;1 1146278201
$ create 'f'
X`5B
X ENVIRONMENT, INHERIT(
X                      'INTERACT'
X                     )
X`5D
X
XMODULE TetShapes( output );
X`7B*************************************************************************
V***
XInits, and draw shapes
X****************************************************************************
V`7D
X
XCONST`20
X      `09ShapesMax = 18;
X      `09e = CHR(27);
X      `09inv = e+'`5B7m';
X`09nml = e+'`5Bm';
X        up  = e+'`5BA';
X`09up2 = e+'`5B2A';
X`09dn  = e+'`5BB';
X        dn2 = e+'`5B2B';
X`09le  = e+'`5BD';
X        le2 = e+'`5B2D';
X        ri  = e+'`5BC';
X        ri2 = e+'`5B2C';
X
XCONST
X        s_clear = 1;
X        s_draw  = 0;`20
X        Grid_width = 10;
X        Grid_length = 20;
X        x_offset = 16;
X        y_offset = 1;
X        max_str_len = 255;
X
XTYPE
X        $ubyte = `5BBYTE`5D 0..255;
X      `09ShapeString = VARYING`5B30`5D OF CHAR;
X        smArrayT    = ARRAY`5B0..3,0..3`5D OF $ubyte;
X
X    shape_table = RECORD`20
X             ch : CHAR;
X             max: INTEGER;
X             pointv : ARRAY`5B0..4`5D OF INTEGER;
X             sm_no : ARRAY`5B0..4`5D OF INTEGER;
X             delta_x : ARRAY`5B0..4`5D OF INTEGER;
X             END;
X
X
XGreebie_Type = RECORD
X                shape : INTEGER;
X                rot   : INTEGER;
X                x_pos, y_pos : INTEGER;
X             END;
X
XVAR`20
X        binshape : ARRAY `5B0..7`5D OF shape_table;
X`20
X      `09Shape  : ARRAY`5B1..7,1..4,0..1`5D OF ShapeString;
X        sm     : ARRAY`5B0..18`5D OF smArrayT :=
X                 ( ( (1,1,1,0),    `20
X                     (0,1,0,0),     `7B object 0, shape 0 `7D
X                     (0,0,0,0),     `7B *** `7D
X                     (0,0,0,0) ),   `7B  *  `7D
X
X                   ( (0,0,1,0),     `7B1 * `7D
X`09`09             (0,1,1,0),     `7B ** `7D
X`09`09             (0,0,1,0),     `7B  * `7D
X                     (0,0,0,0) ),
X
X                   ( (0,1,0,0),    `7B2  *  `7D
X                     (1,1,1,0),    `7B  *** `7D
X                     (0,0,0,0),
X                     (0,0,0,0) ),
X
X                   ( (1,0,0,0),    `7B *  3 `7D
X                     (1,1,0,0),    `7B **   `7D
X                     (1,0,0,0),    `7B *    `7D
X                     (0,0,0,0) ),
X
X                   ( (0,0,0,0),
X                     (1,1,1,1),  `20
X                     (0,0,0,0),   `7Bobject 1 4`7D
X                     (0,0,0,0) ), `7B **** `7D
X
X                   ( (0,1,0,0),    `7B5 * `7D
X                     (0,1,0,0),    `7B  * `7D
X                     (0,1,0,0),    `7B  * `7D
X                     (0,1,0,0) ),  `7B  * `7D
X
X                   ( (1,1,0,0),  `20
X                     (0,1,1,0),   `7Bobject 2`7D
X                     (0,0,0,0),   `7B 6 **  `7D
X                     (0,0,0,0) ), `7B    ** `7D
X
X                   ( (0,1,0,0),   `7B7  * `7D
X                     (1,1,0,0),   `7B  ** `7D
X                     (1,0,0,0),   `7B  *  `7D
X                     (0,0,0,0) ),
X
X                   ( (0,1,1,0),
X                     (1,1,0,0), `7Bobject 3`7D
X                     (0,0,0,0),   `7B 8   ** `7D
X                     (0,0,0,0) ), `7B    **  `7D
X
X                   ( (1,0,0,0),   `7B9  *  `7D
X                     (1,1,0,0),   `7B   ** `7D
X                     (0,1,0,0),   `7B    * `7D
X                     (0,0,0,0) ),
X
X                   ( (1,1,1,0),  `7Bobject 4`7D
X                     (0,0,1,0),`20
X                     (0,0,0,0),  `7B 10 *** `7D
X                     (0,0,0,0) ),`7B      * `7D
X
X                   ( (0,0,1,0),  `7B11  * `7D
X                     (0,0,1,0),  `7B    * `7D
X                     (0,1,1,0),  `7B   ** `7D
X                     (0,0,0,0) ),
X
X                   ( (1,0,0,0), `7B12  *   `7D
X                     (1,1,1,0), `7B    *** `7D
X                     (0,0,0,0),
X                     (0,0,0,0) ),
X
X        `09`09   ( (1,1,0,0),
X                     (1,0,0,0),
X                     (1,0,0,0),
X                     (0,0,0,0) ),
X
X        `09`09   ( (1,1,1,0),   `7B Object 5 `7D
X                     (1,0,0,0),
X                     (0,0,0,0),
X                     (0,0,0,0) ),
X
X        `09`09   ( (0,1,1,0),
X                     (0,0,1,0),
X                     (0,0,1,0),
X                     (0,0,0,0) ), `20
X
X                   ( (0,0,1,0),
X                     (1,1,1,0),
X                     (0,0,0,0),
X                     (0,0,0,0) ),
X
X                   ( (1,0,0,0),
X                     (1,0,0,0),
X                     (1,1,0,0),
X                     (0,0,0,0) ),
X
X                   ( (1,1,0,0),
X                     (1,1,0,0),
X                     (0,0,0,0),
X                     (0,0,0,0) ) );
X
X
XPROCEDURE InitShapes;
X`7B*************************************************************************
V****
XInitialises shapes string
X****************************************************************************
V`7D
XBEGIN
X`09shape`5B1,1,0`5D:='. .'+dn+le2+'.';
X`09shape`5B1,2,0`5D:=ri2+'.'+dn+le2+'..'+dn+le+'.';
X`09shape`5B1,3,0`5D:=ri+'.'+dn+le2+'...';
X`09shape`5B1,4,0`5D:='.'+dn+le+'..'+dn+le2+'.';
X`09
X`09shape`5B2,1,0`5D:=dn+'////';
X`09shape`5B2,2,0`5D:=ri+'/'+dn+le+'/'+dn+le+'/'+dn+le+'/';
X`09shape`5B2,3,0`5D:=dn+'////';
X`09shape`5B2,4,0`5D:=ri+'/'+dn+le+'/'+dn+le+'/'+dn+le+'/';
X
X`09shape`5B3,1,0`5D:='--'+dn+le+'--';
X`09shape`5B3,2,0`5D:=ri+'-'+dn+le2+'--'+dn+le2+'-';
X`09shape`5B3,3,0`5D:='--'+dn+le+'--';
X`09shape`5B3,4,0`5D:=ri+'-'+dn+le2+'--'+dn+le2+'-';
X
X`09shape`5B4,1,0`5D:=ri+'`60`60'+dn+le2+le+'`60`60';
X        shape`5B4,2,0`5D:='`60'+dn+le+'`60`60'+dn+le+'`60';
X`09shape`5B4,3,0`5D:=ri+'`60`60'+dn+le2+le+'`60`60';
X        shape`5B4,4,0`5D:='`60'+dn+le+'`60`60'+dn+le+'`60';
X
X`09shape`5B5,1,0`5D:='`5B`5B`5B'+dn+le+'`5B';
X`09shape`5B5,2,0`5D:=ri2+'`5B'+dn+le+'`5B'+dn+le2+'`5B`5B';
X`09shape`5B5,3,0`5D:='`5B'+dn+le+'`5B`5B`5B';
X`09shape`5B5,4,0`5D:='`5B`5B'+dn+le2+'`5B'+dn+le+'`5B';
X
X`09shape`5B6,1,0`5D:=':::'+dn+le2+le+':';
X`09shape`5B6,2,0`5D:=ri+'::'+dn+le+':'+dn+le+':';
X`09shape`5B6,3,0`5D:=ri2+':'+dn+le2+le+':::';
X`09shape`5B6,4,0`5D:=':'+dn+le+':'+dn+le+'::';
X
X`09shape`5B7,1,0`5D:='++'+dn+le2+'++';
X`09shape`5B7,2,0`5D:='++'+dn+le2+'++';
X`09shape`5B7,3,0`5D:='++'+dn+le2+'++';
X`09shape`5B7,4,0`5D:='++'+dn+le2+'++';
X
X`09shape`5B1,1,1`5D:='   '+dn+le2+' ';
X`09shape`5B1,2,1`5D:=ri2+' '+dn+le2+'  '+dn+le+' ';
X`09shape`5B1,3,1`5D:=ri+' '+dn+le2+'   ';
X`09shape`5B1,4,1`5D:=' '+dn+le+'  '+dn+le2+' ';
X`09
X`09shape`5B2,1,1`5D:=dn+'    ';
X`09shape`5B2,2,1`5D:=ri+' '+dn+le+' '+dn+le+' '+dn+le+' ';
X`09shape`5B2,3,1`5D:=dn+'    ';
X`09shape`5B2,4,1`5D:=ri+' '+dn+le+' '+dn+le+' '+dn+le+' ';
X
X`09shape`5B3,1,1`5D:='  '+dn+le+'  ';
X`09shape`5B3,2,1`5D:=ri+' '+dn+le2+'  '+dn+le2+' ';
X`09shape`5B3,3,1`5D:='  '+dn+le+'  ';
X`09shape`5B3,4,1`5D:=ri+' '+dn+le2+'  '+dn+le2+' ';
X
X`09shape`5B4,1,1`5D:=ri+'  '+dn+le2+le+'  ';
X        shape`5B4,2,1`5D:=' '+dn+le+'  '+dn+le+' ';
X`09shape`5B4,3,1`5D:=ri+'  '+dn+le2+le+'  ';
X        shape`5B4,4,1`5D:=' '+dn+le+'  '+dn+le+' ';
X
X`09shape`5B5,1,1`5D:='   '+dn+le+' ';
X`09shape`5B5,2,1`5D:=ri2+' '+dn+le+' '+dn+le2+'  ';
X`09shape`5B5,3,1`5D:=' '+dn+le+'   ';
X`09shape`5B5,4,1`5D:='  '+dn+le2+' '+dn+le+' ';
X
X`09shape`5B6,1,1`5D:='   '+dn+le2+le+' ';
X`09shape`5B6,2,1`5D:=ri+'  '+dn+le+' '+dn+le+' ';
X`09shape`5B6,3,1`5D:=ri2+' '+dn+le2+le+'   ';
X`09shape`5B6,4,1`5D:=' '+dn+le+' '+dn+le+'  ';
X
X`09shape`5B7,1,1`5D:='  '+dn+le2+'  ';
X`09shape`5B7,2,1`5D:='  '+dn+le2+'  ';
X `20
X   `09shape`5B7,3,1`5D:='  '+dn+le2+'  ';
X`09shape`5B7,4,1`5D:='  '+dn+le2+'  ';
X
X`7B-------------------------------------------------------------------------
V-`7D
X    `7B begin shape 1 definition, four rotations `7D
X
X    binshape`5B1`5D.ch := '.';
X    binshape`5B1`5D.max := 3;
X
X    binshape`5B1`5D.pointv`5B3`5D := 5;`20
X    binshape`5B1`5D.sm_no`5B3`5D := 2;
X    binshape`5B1`5D.delta_x`5B3`5D := 0;
X
X    binshape`5B1`5D.pointv`5B4`5D := 5;`20
X    binshape`5B1`5D.sm_no`5B4`5D := 3;
X    binshape`5B1`5D.delta_x`5B4`5D := 1;
X
X    binshape`5B1`5D.pointv`5B1`5D := 6;`20
X    binshape`5B1`5D.sm_no`5B1`5D := 0;
X    binshape`5B1`5D.delta_x`5B1`5D := 0;
X
X    binshape`5B1`5D.pointv`5B2`5D := 5;`20
X    binshape`5B1`5D.sm_no`5B2`5D := 1;
X    binshape`5B1`5D.delta_x`5B2`5D := 0;
X  `20
X    `7B begin shape 2 definition, four rotations `7D
X
X    binshape`5B2`5D.ch := '/';
X    binshape`5B2`5D.max := 4;
X
X    binshape`5B2`5D.pointv`5B1`5D := 5;`20
X    binshape`5B2`5D.sm_no`5B1`5D := 4;
X    binshape`5B2`5D.delta_x`5B1`5D := 0;
X
X    binshape`5B2`5D.pointv`5B2`5D := 8;`20
X    binshape`5B2`5D.sm_no`5B2`5D := 5;
X    binshape`5B2`5D.delta_x`5B2`5D := 0;
X
X    binshape`5B2`5D.pointv`5B3`5D := 5;`20
X    binshape`5B2`5D.sm_no`5B3`5D := 4;
X    binshape`5B2`5D.delta_x`5B3`5D := 0;
X
X    binshape`5B2`5D.pointv`5B4`5D := 8;`20
X    binshape`5B2`5D.sm_no`5B4`5D := 5;
X    binshape`5B2`5D.delta_x`5B4`5D := 0;
X
X
+-+-+-+-+-+-+-+-  END  OF PART 3 +-+-+-+-+-+-+-+-