$! ------------------ CUT HERE ----------------------- $ v='f$verify(f$trnlnm("SHARE_VERIFY"))' $! $! This archive created by VMS_SHARE Version 7.2-007 22-FEB-1990 $! On 4-JUN-1992 01:59:00.73 By user MASMUMMY $! $! This VMS_SHARE Written by: $! Andy Harper, Kings College London UK $! $! Acknowledgements to: $! James Gray - Original VMS_SHARE $! Michael Bednarek - Original Concept and implementation $! $!+ THIS PACKAGE DISTRIBUTED IN 4 PARTS, TO KEEP EACH PART $! BELOW 30 BLOCKS $! $! TO UNPACK THIS SHARE FILE, CONCATENATE ALL PARTS IN ORDER $! AND EXECUTE AS A COMMAND PROCEDURE ( @name ) $! $! THE FOLLOWING FILE(S) WILL BE CREATED AFTER UNPACKING: $! 1. BUILD.COM;1 $! 2. TETINTRO1.DAT;1 $! 3. TETINTRO2.DAT;1 $! 4. TETINTRO3.DAT;1 $! 5. TETRIS.PAS;1 $! 6. TETSHAPES.PAS;1 $! $set="set" $set symbol/scope=(nolocal,noglobal) $f=f$parse("SHARE_TEMP","SYS$SCRATCH:.TMP_"+f$getjpi("","PID")) $e="write sys$error ""%UNPACK"", " $w="write sys$output ""%UNPACK"", " $ if f$trnlnm("SHARE_LOG") then $ w = "!" $ ve=f$getsyi("version") $ if ve-f$extract(0,1,ve) .ges. "4.4" then $ goto START $ e "-E-OLDVER, Must run at least VMS 4.4" $ v=f$verify(v) $ exit 44 $UNPACK: SUBROUTINE ! P1=filename, P2=checksum $ if f$search(P1) .eqs. "" then $ goto file_absent $ e "-W-EXISTS, File ''P1' exists. Skipped." $ delete 'f'* $ exit $file_absent: $ if f$parse(P1) .nes. "" then $ goto dirok $ dn=f$parse(P1,,,"DIRECTORY") $ w "-I-CREDIR, Creating directory ''dn'." $ create/dir 'dn' $ if $status then $ goto dirok $ e "-E-CREDIRFAIL, Unable to create ''dn'. File skipped." $ delete 'f'* $ exit $dirok: $ w "-I-PROCESS, Processing file ''P1'." $ if .not. f$verify() then $ define/user sys$output nl: $ EDIT/TPU/NOSEC/NODIS/COM=SYS$INPUT 'f'/OUT='P1' PROCEDURE Unpacker ON_ERROR ENDON_ERROR;SET(FACILITY_NAME,"UNPACK");SET( SUCCESS,OFF);SET(INFORMATIONAL,OFF);f:=GET_INFO(COMMAND_LINE,"file_name");b:= CREATE_BUFFER(f,f);p:=SPAN(" ")@r&LINE_END;POSITION(BEGINNING_OF(b)); LOOP EXITIF SEARCH(p,FORWARD)=0;POSITION(r);ERASE(r);ENDLOOP;POSITION( BEGINNING_OF(b));g:=0;LOOP EXITIF MARK(NONE)=END_OF(b);x:=ERASE_CHARACTER(1); IF g=0 THEN IF x="X" THEN MOVE_VERTICAL(1);ENDIF;IF x="V" THEN APPEND_LINE; MOVE_HORIZONTAL(-CURRENT_OFFSET);MOVE_VERTICAL(1);ENDIF;IF x="+" THEN g:=1; ERASE_LINE;ENDIF;ELSE IF x="-" THEN IF INDEX(CURRENT_LINE,"+-+-+-+-+-+-+-+")= 1 THEN g:=0;ENDIF;ENDIF;ERASE_LINE;ENDIF;ENDLOOP;t:="0123456789ABCDEF"; POSITION(BEGINNING_OF(b));LOOP r:=SEARCH("`",FORWARD);EXITIF r=0;POSITION(r); ERASE(r);x1:=INDEX(t,ERASE_CHARACTER(1))-1;x2:=INDEX(t,ERASE_CHARACTER(1))-1; COPY_TEXT(ASCII(16*x1+x2));ENDLOOP;WRITE_FILE(b,GET_INFO(COMMAND_LINE, "output_file"));ENDPROCEDURE;Unpacker;QUIT; $ delete/nolog 'f'* $ CHECKSUM 'P1' $ IF CHECKSUM$CHECKSUM .eqs. P2 THEN $ EXIT $ e "-E-CHKSMFAIL, Checksum of ''P1' failed." $ ENDSUBROUTINE $START: $ create 'f' X$ PASCAL TETSHAPES X$ PASCAL TETRIS X$ LINK TETRIS,TETSHAPES,INTERACT/LIB X$ DELETE/NOCONFIRM *.OBJ;* X$ EXIT $ CALL UNPACK BUILD.COM;1 1297107295 $ create 'f' X`1B(0`1B`5B1;1H X qqqxqq x x x x x X x nqqn nqqqxqqq x xx X x x x x x nqn xx qqnq x qqqq nqqnqq X xxqqwqqqxqqqq x x xnqqqqq x qqqqxqq x x x X xxx x xx x nnqqqq xx xx xx xx x x xx x X x x x xx xqqnxqqqqq xxxqqqqqxqqqxxqqqxqqqqxqq x xqqq x x X nqxqqqqnxqqu x x qqq xqqqqxq x x nq xqqqqqqx X x x xx x qqxqqqx x xx xqqqxx x xqqq x x x X qq xx n x x x xx qqq xqqxxx xqqq xx qnqqq X x qqqqu qqqqqqqxqqq xqqqq qqqqqx qqxqqqqn qqqqq nq x x X x x x n x x nqqqqq x x x X x x x x x x x x x n x n X qqqxqqqqqxqqnqq nnqqqq x x xnqq x xx x X x x qxqqqqqvqqqxq n qnxq x nn n X x x x xx x qqqn X x X`1B(B $ CALL UNPACK TETINTRO1.DAT;1 1450525396 $ create 'f' X`1B(0`1B`5B1;1H qqqxqq x x x x x X x nqqn nqqqxqqq x xx X aaaaaaaaaaaaaax nqn xx qqnq x qqqq nqqnqq X axqqwqaaxqqqqax x xnqqqqq x qqqqxqq x x x X xxx x aax xaaaaaaaaaaxaaaaaaaaaaaaxaaaaaaaxx aaaax aaaaaxx x X x x x aax xqaaxqqqqqaxaxqqqaaxqqqaxqaaxqqqaxqqaax aaxqqqax x X nqxqqqaaxqqu aaaaaax qqq aaxqqqqxqaaaaaax aax qaaaaxqqqqqqx X x x aax x aaxqqqx ax aaxx aaxqqaax aax axqqqaax x x X qq aaaax aaaaaaaaaax xaaaax qaaaaxqqaaxaaaaxqaaaaaxx qnqqq X x qqqqu qqqqqqqxqqq xqqqq qqqqqx qqxqqqqn qqqqq nq x x X x x x n x x nqqqqq x x x X x x x x x x x x x n x n X qqqxqqqqqxqqnqq nnqqqq x x xnqq x xx x X x x qxqqqqqvqqqxq n qnxq x nn n X x x x xx x qqqn X x X`1B(B Vax Version by Chris Guthrey, University Of Waikato, 1990. X X`1B#6 ---- A VaxMagic Production! ---- X `20 X X ( Press 'I' for instructions, or space to play... ) $ CALL UNPACK TETINTRO2.DAT;1 926366697 $ create 'f' X`1B`5B2J`1B`5B1H`1B`5B1m`1B#3 WELCOME TO TETRIS! X`1B#4 WELCOME TO TETRIS! X`1B`5Bm XWelcome to the VAX version of the Russian game of the same name. X XRotate the falling shapes to fill in complete horizontal lines causeing them Xto vanish. The more lines you can vanish at once, the greater your score. XIf you completely clear the screen on your last move, you'll get a big Xbonus! X`1B(0 X`1B#6lqqqqk lqk lqk lqk lqk lqk lqk X`1B#6xCTRLx-xWx xQx xPx x4x x5x x6x X`1B#6mqqqqj mqj mqj mqj mqj mqj mqj X REDRAW SCREEN QUIT PAUSE LEFT ROTATE RIGHT X X`1B#6lqqqqqqqqqqqqqqqqqqqk lqk X`1B#6x SPACE BAR x x2x `20 X`1B#6mqqqqqqqqqqqqqqqqqqqj mqj `1B(B X DROP DOWN X X X <<<< PRESS THE `5BSPACE BAR`5D TO BEGIN! >>>> `20 $ CALL UNPACK TETINTRO3.DAT;1 861872444 $ create 'f' X`7B------------------------------------------------------------------------- V----`20 XTetris for VAX/VMS X `20 X Brought to you by Chris R. Guthrey, X University Of Waikato,`20 X New Zealand. X `20 X Comments/etc to 'cguthrey@waikato.ac.nz' or 'ccc_rex@waikato.ac.nz' X X Greetings and thanks to: All contributary authors of the Interact library V, X CCC_REX, X CCC_LDO, X CCC_SIMON. X X Have fun! X X Chris Guthrey, 3rd July, 1990 X---------------------------------------------------------------------------- V--`7D X X X`5BINHERIT( 'SYS$LIBRARY:STARLET', 'TETSHAPES', 'INTERACT' )`5D X `20 XPROGRAM Tetris( input, output ); XCONST`20 X datafile1 = 'image_dir:tetintro1.dat'; X datafile2 = 'image_dir:tetintro2.dat'; X datafile3 = 'image_dir:tetintro3.dat'; X initial_delay = 0.08; X XCONST`20 X apst = CHR( 39 ); X left_key = '4'; X right_key= '6'; X down_key= '2'; X rotate_key= '5'; X drop_key= ' '; X pause_key= 'p'; X quit_key= 'q'; X redraw_key= CHR(23); XTYPE X GridType = ARRAY`5B1..Grid_width,1..Grid_length`5D OF CHAR; X num_Str = VARYING`5B10`5D OF CHAR; X line_str_type = VARYING`5B120`5D OF CHAR; X XVAR grid : GridType; X`20 XVAR wow : RECORD X score :`5BLONG`5D INTEGER; X level : INTEGER; X lines : INTEGER; X linecount: INTEGER; X lines_target : INTEGER; X stage : INTEGER; X random : INTEGER; X END; X X Is_Msg : BOOLEAN; X play : BOOLEAN; X options : RECORD X display_next : BOOLEAN; X quit : BOOLEAN; X END; X X(*************************************************************************** V*) X(* ClearGrid`09`09`09`09`09`09`09`09 *) X(*`09`09`09`09`09`09`09`09 *) X(* Set the playing field matrix to zero`09`09`09`09 *) X(* V *) X XPROCEDURE ClearGrid( VAR Grid : GridType ); XVAR x,y : INTEGER; XBEGIN X FOR y := 1 TO grid_length DO X FOR x := 1 TO grid_width DO X grid`5Bx,y`5D := ' '; `20 XEND; X X(*************************************************************************** V) X(* SetUpScreen * V) X(* * V) X(* Setup the terminal display ready to begin game play * V) X(* * V) X XPROCEDURE SetUpScreen; XBEGIN X Clear; X Set40Screen; X Box( (21-(grid_width DIV 2)),1, grid_width+2, grid_length+1,0,1 ); X Box( 3,5, 12, 14, 0, 1 ); X Posn(6,6); X QIO_Write('Score'); X Posn(6,9); X QIO_Write('Lines'); X Posn(6,12); X QIO_Write('Stage'); X Posn(6,15); X QIO_Write('Next');`20 X Posn( 30,8 ); X QIO_Write( 'Lines Left:');`20 X Posn(6,2); X QIO_Write( vt100_bright_only+'TETRIS!'+vt100_normal ); XEND; X X`7B************************************************************************* V**** X** Message X** X** Write annoying little messages... X`7D XPROCEDURE Message ( msg : Line_Str_Type; no_clr : BOOLEAN ); XBEGIN X IF no_clr THEN X BEGIN X Posn( 20 - ( LENGTH( msg ) DIV 2 ), 23 ); X QIO_Write( msg ); X END X ELSE X BEGIN X Posn( 1, 23 ); X QIO_Write( vt100_esc + '`5BM'+ vt100_wide ); X END; XEND; X X`7B************************************************************************* V**** X** Check_Move Function. X** X** Checks the movement of greebie in a given direction. X*`7D X X FUNCTION Check_Move( dx, dy, sm_no, xpos,ypos : INTEGER ) X : BOOLEAN; X VAR wont_fit : BOOLEAN; X VAR sh_y, sh_x : INTEGER; X BEGIN X wont_fit := FALSE; X FOR sh_y := 0 TO 3 DO BEGIN X FOR sh_x := 0 TO 3 DO BEGIN X IF (xpos+sh_x+dx>grid_width) AND (sm`5Bsm_no,sh_y,sh_x`5D=1) TH VEN X wont_fit := TRUE X ELSE X IF (ypos+sh_y+dy>grid_length) AND (sm`5Bsm_no,sh_y,sh_x`5D=1) T VHEN X wont_fit := TRUE X ELSE X IF (xpos+sh_x+dx < 1 ) AND (sm`5Bsm_no,sh_y,sh_x`5D=1) THEN X wont_fit := TRUE X ELSE X IF (ypos+sh_y+dy < 1 ) AND (sm`5Bsm_no,sh_y,sh_x`5D=1) THEN X wont_fit := TRUE X ELSE X IF (sm`5Bsm_no,sh_y,sh_x`5D=1) AND (xpos+sh_x+dx <= grid_width V )`20 X AND (ypos+sh_y+dy<=grid_length) THEN X IF (grid`5Bxpos+sh_x+dx,ypos+sh_y+dy`5D<> ' ') THEN X wont_fit := TRUE; X END; X END; X Check_move := wont_fit; X X END; X X`7B************************************************************************* V**** X** Move_Left X** X** Attempts to move greebie left X`7D X PROCEDURE Move_Left( VAR greebie : greebie_type ); X VAR sh_x, sh_y, sm_no : INTEGER; X VAR wont_fit : BOOLEAN; X BEGIN X sm_no := binshape`5Bgreebie.shape`5D.sm_no`5Bgreebie.rot`5D; X wont_fit := Check_move( -1,0,sm_no,greebie.x_pos,greebie.y_pos ); X IF NOT( wont_fit ) THEN X BEGIN X PutShape( Greebie, s_clear ); X Greebie.x_pos := Greebie.x_pos - 1; X PutShape( Greebie, s_draw ); X END; X END; `20 X X`7B************************************************************************* V**** X** Move_Right X** X** Attempts to move greebie right X`7D X PROCEDURE Move_Right( VAR greebie : greebie_type ); X VAR sh_x, sh_y, sm_no : INTEGER; X VAR wont_fit : BOOLEAN; X BEGIN X IF greebie.x_pos < grid_width THEN`20 X BEGIN X sm_no := binshape`5Bgreebie.shape`5D.sm_no`5Bgreebie.rot`5D; X wont_fit := Check_move( 1,0,sm_no,greebie.x_pos,greebie.y_pos ); X IF NOT( wont_fit ) THEN X BEGIN X PutShape( Greebie, s_clear ); X Greebie.x_pos := Greebie.x_pos + 1; X PutShape( Greebie, s_draw ); X END; X END; `20 X END; X X`7B************************************************************************* V**** X** Rotate_Greebie X** X** Attempts to rotate greebie. X`7D X PROCEDURE Rotate_Greebie( VAR greebie: greebie_type );`20 X VAR sh_x, sh_y,st : INTEGER; X VAR wont_fit : BOOLEAN; X BEGIN X wont_fit := FALSE; X IF Greebie.shape <> 7 THEN BEGIN X WITH Greebie DO BEGIN X FOR sh_y := 0 TO binshape`5B shape `5D.max-1 DO BEGIN X FOR sh_x := 0 TO binshape`5B shape `5D.max-1 DO BEGIN X IF (x_pos+sh_x<1) OR (y_pos+sh_y<1) THEN`20 X wont_fit := true X ELSE X IF (x_pos+sh_x>grid_width) OR (y_pos+1+sh_y>grid_length) TH VEN X wont_fit := TRUE X ELSE X IF (grid`5Bx_pos+sh_x,y_pos+sh_y`5D<> ' ') THEN X wont_fit := TRUE; X END; X END; `20 X IF NOT( wont_fit ) THEN`20 X BEGIN X PutShape( Greebie, s_clear ); X Greebie.rot := Greebie.rot - 1; X IF Greebie.rot = 0 THEN Greebie.rot := 4; X (* IF (Greebie.shape=2)AND((greebie.rot=1)OR(greebie.rot=3)) THEN`2 V0 X Greebie.y_pos := Greebie.y_pos + 1; X Greebie.x_pos := Greebie.x_pos +`20 X binshape`5Bgreebie.shape`5D.delta_x`5Bgreebie.r Vot`5D; *) X PutShape( Greebie, s_draw ); X END; X END; `20 X END; `20 XEND; X`7B************************************************************************* V**** X** Move_Down X** X** Attempts to move greebie down, returns false if cannot. X`7D `20 X FUNCTION Move_Down( VAR greebie: greebie_type ):BOOLEAN; `20 X VAR sh_x, sh_y, sm_no : INTEGER; +-+-+-+-+-+-+-+- END OF PART 1 +-+-+-+-+-+-+-+-