$! ------------------ CUT HERE -----------------------
$ v='f$verify(f$trnlnm("SHARE_VERIFY"))'
$!
$! This archive created by VMS_SHARE Version 7.2-007  22-FEB-1990
$!   On  9-APR-1993 08:57:52.02   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 5 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. $README.TXT;1
$!       2. MAKE.COM;1
$!       3. MISC.PAS;1
$!       4. REFLEX.PAS;1
$!       5. REFLEX.PIC;1
$!       6. VT100_ESC_SEQS.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'
XREFLEX `20
X
XSingle Player game for VT100 compatable terminals.
X
XWritten in VAX Pascal, under VMS A5.2.
X
XThe files included are
X
X$README.TXT   (this one)
XREFLEX.PAS   Game source
XREFLEX.PIC   Introduction screen`20
XMISC.PAS     Usefull routines extracted from Paul Denize's INTERACT Library.
XVT100_ESC_SEQS.PAS  Terminal Escape Codes used in INTERACT.
X
XThe game REFLEX will create a score file called REFLEX.ACN.
X
XThis isn't a very impressive game at all, but it was quick and easy to
Xwrite.  You may enjoy it.  It may inspire you to write your own games for
Xthe VAX. If you do, let me know!
X
XMany thanks to Paul Denize for providing the source to his INTERACT library.
X
XNo warranty of any kind is provided with this software. This software is
Xcopyright of the University Of Waikato, Hamilton, New Zealand.
XYou may distribute these files provided you retain the headers and credits.
X
XHere is the header of the file MISC.PAS:
X
X(****************** This file is a collection of routines from  ************
V**
X ******************    the INTERACT Pascal Games Library...     ************
V**
X *****************                                               ***********
V**
X ****************  (c) Waikato University, Hamilton, NEW ZEALAND  **********
V**
X *
X *  The INTERACT Library was written by Paul Denize   PDENIZE@WAIKATO.AC.NZ`
V20
X *
X *  Contributing authors: Rex Croft                   CCC_REX@WAIKATO.AC.NZ
X *                        Lawrence D'Oliviero         LDO@WAIKATO.AC.NZ
X *                        Chris Guthrey               CGUTHREY@WAIKATO.AC.NZ
X *
X *  Several improvements to the TOPTEN Score Table System`20
X *  contributed by:
X *                        Bill Brennessel      MASMUMMY@ubvmsc.cc.buffalo.ed
Vu
X *
X * You are granted permission to use the routines in this file or any other
X * routines from any INTERACT Library File on condition that this header is
X * retained and credit given where due.
X *
X * Note of course that there is no warranty of any kind whatsoever.
X *
X *)
X
X
XHave fun,
XChris Guthrey
Xcguthrey@waikato.ac.nz
$ CALL UNPACK $README.TXT;1 2036555234
$ create 'f'
X$ write sys$output "Compiling..."
X$ pascal/opt/nodebug misc, reflex
X$ write sys$output "Linking..."
X$ link/nodebug reflex, misc
X$ write sys$output "Finished!"
$ CALL UNPACK MAKE.COM;1 1560878412
$ create 'f'
X(****************** This file is a collection of routines from  ************
V**
X ******************    the INTERACT Pascal Games Library...     ************
V**
X *****************                                               ***********
V**
X ****************  (c) Waikato University, Hamilton, NEW ZEALAND  **********
V**
X *
X *  The INTERACT Library was written by Paul Denize   PDENIZE@WAIKATO.AC.NZ`
V20
X *
X *  Contributing authors: Rex Croft                   CCC_REX@WAIKATO.AC.NZ
X *                        Lawrence D'Oliviero         LDO@WAIKATO.AC.NZ
X *                        Chris Guthrey               CGUTHREY@WAIKATO.AC.NZ
X *
X *  Several improvements to the TOPTEN Score Table System`20
X *  contributed by:
X *                        Bill Brennessel      MASMUMMY@ubvmsc.cc.buffalo.ed
Vu
X *
X * You are granted permission to use the routines in this file or any other
X * routines from any INTERACT Library File on condition that this header is
X * retained and credit given where due.
X *
X * Note of course that there is no warranty of any kind whatsoever.
X *
X *)
X`5B
X  Inherit(
X    (*'GEN$:`5BPAS`5DVAXTYPES', *)
X    'SYS$LIBRARY:PASCAL$LIB_ROUTINES',
X    'SYS$LIBRARY:STARLET'`20
X    (* 'GEN$:`5BPAS`5DVMSRTL' *)`20
X  ),
X  Environment
X    ('MISC.PEN')
X`5D
XMODULE MISC( OUTPUT );
X
X(*****************************************************************
X ** THIS FILE IS MERELY A CONCISE COMPILATION OF ROUTINES TAKEN **
X ** FROM A NUMBER OF INTERACT GAMES LIBRARY SOURCE FILES. ONLY  **
X ** THE ROUTINES NEEDED BY THIS PARTICULAR GAME ARE INCLUDED.   **
X *****************************************************************)
X
X%INCLUDE 'VT100_ESC_SEQS.PAS'
X
XTYPE
X      `7B signed integer types `7D
X`09$byte = `5BBYTE`5D -128..127;
X`09$word = `5BWORD`5D -32768..32767;
X`09$quad = `5BQUAD,UNSAFE`5D RECORD
X`09`09l0:UNSIGNED; l1:INTEGER; END;
X`09$octa = `5BOCTA,UNSAFE`5D RECORD
X`09`09l0,l1,l2:UNSIGNED; l3:INTEGER; END;
X
X      `7B unsigned integer types `7D
X`09$ubyte = `5BBYTE`5D 0..255;
X`09$uword = `5BWORD`5D 0..65535;
X`09$uquad = `5BQUAD,UNSAFE`5D RECORD
X`09`09l0,l1:UNSIGNED; END;
X`09$uocta = `5BOCTA,UNSAFE`5D RECORD
X`09`09l0,l1,l2,l3:UNSIGNED; END;
X
X      `7B miscellaneous types `7D
X`09$packed_dec = `5BBIT(4),UNSAFE`5D 0..15;
X`09$deftyp = `5BUNSAFE`5D INTEGER;
X`09$defptr = `5BUNSAFE`5D `5E$DEFTYP;
X
X
X`5BHIDDEN`5D
XTYPE
X  v_array = varying `5B256`5D of char;
X
X`5BGLOBAL`5D
XFUNCTION System_Call ( ret_status : integer ) : Boolean;
XBEGIN
X  IF not odd(ret_status) then
X    LIB$SIGNAL(ret_status);
X  System_Call := odd(ret_status);
XEND;
X
X`5BGLOBAL`5D
XPROCEDURE  TERMINATE ( code : integer := 1 );
XBEGIN
X  $EXIT ( code );
XEND;
X
X`5BGLOBAL`5D
XPROCEDURE  KILL ( PID : `5BTRUNCATE`5D UNSIGNED );
XBEGIN
X  IF PRESENT(PID) then
X    System_Call ($DELPRC(pidadr:=PID))
X  ELSE
X    System_Call ($DELPRC);
XEND;
X
XVAR
X  terminal_input_channel    : $UWORD;
X  terminal_output_channel   : $UWORD;
X  channel_initialized : Boolean := False;
X
X
X`5BGLOBAL`5D
XPROCEDURE  initialize_channel( input_device : v_array := 'TT:';
X                               output_device : v_array := 'TT:' );
XBEGIN
X  IF not channel_initialized then
X    BEGIN `20
X      System_Call ($assign ( chan := terminal_output_channel , devnam := out
Vput_device));
X      IF input_device = output_device THEN     `7Bare in and out devices sam
Ve?`7D
X        terminal_input_channel := terminal_output_channel `7Bsame channel`7D
X      ELSE
X        System_Call ($assign ( chan := terminal_input_channel ,devnam := inp
Vut_device ));
X    END;
XEND;
X
X`5BGLOBAL`5D
XFUNCTION  QIO_1_char_now : char;
XVAR
X  buffer : packed array `5B1..1`5D of char;
XBEGIN
X  buffer`5B1`5D := chr(-1);
X  System_Call ($qiow ( chan:= terminal_input_channel,
X                        func:= io$_readvblk+io$m_timed+io$m_noecho+io$m_nofi
Vltr,
X                        p1:= buffer,
X                        p2:= 1, `7B bufferlength `7D
X                        p3:= 0 ));
X   Qio_1_char_now := buffer`5B1`5D;
XEND;
X
X
X`5BGLOBAL`5D
XFUNCTION  QIO_readln ( characters : integer ) : v_array;
XTYPE
X  iosb_type = `5BQUAD`5D Record
X                       Status : $uword;
X                       Nrbytes : $uword;
X                       Terminator : char;
X                       Reserved : $ubyte;
X                       Terminator_length : $ubyte;
X                       Cursor_offset : $ubyte
X                     End;
XVAR
X  temp : v_array;
X  Read_iosb : iosb_type;
XBEGIN
X  system_Call ( $qiow ( chan:= terminal_input_channel,
X                        func:= io$m_timed+io$_readvblk+io$m_noecho+io$m_nofi
Vltr+io$m_escape,
X                        iosb:= read_iosb,
X                          p1:= temp.body,
X                          p2:= characters,
X                          p3:= 0 ));
X   temp.length := ( read_iosb.Nrbytes );
X   qio_readln := temp;
XEND;
X
X
X`5BGLOBAL`5D
XFUNCTION  QIO_1_char : char;
XVAR
X  buffer : packed array `5B1..1`5D of char;
XBEGIN
X  System_Call ($qiow ( chan:= terminal_input_channel,
X                        func:= io$_readvblk+io$m_noecho+io$m_nofiltr,
X                          p1:= buffer,
X                          p2:= 1 ));
X  Qio_1_char := buffer`5B1`5D;
XEND;
X
X
X`5BGLOBAL`5D
XPROCEDURE  QIO_purge;
XBEGIN
X  System_Call ($qiow ( chan:= terminal_input_channel,
X                        func:= io$_readvblk+io$m_purge ));
XEND;
X
X
X`5BGLOBAL`5D
XFUNCTION  QIO_1_char_timed ( delay : integer ) : char;
XVAR
X  buffer : packed array `5B1..1`5D of char;
XBEGIN
X  buffer`5B1`5D := chr(255);
X  System_Call ($qiow ( chan:= terminal_input_channel,
X                        func:=io$m_timed+io$_readvblk+io$m_noecho+io$m_nofil
Vtr+io$m_escape,
X                          p1:= buffer,
X                          p2:= 1,
X                          p3:= delay ));
X  Qio_1_char_timed := buffer`5B1`5D;
XEND;
X
X`5BGLOBAL`5D
XPROCEDURE  QIO_write ( text : v_array );
XBEGIN
X  System_Call ($qiow (chan:= terminal_output_channel,
X                       func:= io$_writevblk,
X                         p1:= text.body,
X                         p2:= text.length ));
XEND;
X
X
X`5BGLOBAL`5D
XPROCEDURE  QIO_writeln ( text : `5BTRUNCATE`5D v_array );
XVAR
X  outline     : v_array;
XBEGIN
X  IF present(text) then
X    BEGIN
X      outline := text + VT100_cr + VT100_lf;
X      System_Call ($qiow (chan:= terminal_output_channel,
X                           func:= io$_writevblk,
X                             p1:= outline.body,
X                             p2:= outline.length  ));
X    END
X  ELSE
X    BEGIN
X      outline := VT100_cr + VT100_lf;
X      System_Call ($qiow (chan:= terminal_output_channel,
X                           func:= io$_writevblk,
X                             p1:= outline.body,
X                             p2:= outline.length  ));
X    END;
XEND;
X
X`5BGLOBAL`5D
XPROCEDURE  Sleep ( sec : integer := 0; frac : `5BTRUNCATE`5D real );
XVAR
X  Hundredths : integer;
X  delta_wake_time : $quad;
XBEGIN
X  Hundredths := sec*100;
X  IF PRESENT(frac) then
X    Hundredths := Hundredths + round(frac*100);
X  IF ( hundredths > 0 ) then
X    BEGIN
X      System_Call (LIB$EMUL (Hundredths, -100000, 0, delta_wake_time));
X      IF System_Call ($Schdwk ( daytim := delta_wake_time )) then
X        System_Call ($Hiber);
X    END;
XEND;
X
XTYPE
X  portiontype = (The_Screen,The_Line);
X  cleartype   = (Wholething, To_Start, To_End);
X `20
X`5BHIDDEN`5D
XVAR
X  desblk : Record
X             findlink   : integer;
X             proc       : integer;
X             arglist    : array `5B0..1`5D of integer;
X             exitreason : integer;
X           End;
X
X
X`5BHIDDEN`5D
XPROCEDURE  ctrlc_ast;
XBEGIN
X  $exit ( code := ss$_clifrcext );
XEND;
X
X`5BGLOBAL`5D
XPROCEDURE  Force;
XBEGIN
X  System_Call ($qiow ( chan := terminal_output_channel,
X                        func := io$_setmode + io$m_ctrlcast,
X                        p1   := %immed iaddress (ctrlc_ast)));
XEND;
X
X
X`5BGLOBAL`5D
XPROCEDURE Setup_handler ( handler_address : integer );
XBEGIN
X  WITH desblk do
X    BEGIN
X      proc       := handler_address;
X      arglist`5B0`5D := 1;
X      arglist`5B1`5D := iaddress(exitreason);
X    END;
X
X  System_Call ($DCLEXH (desblk));
XEND;`20
X
X
X`5BGLOBAL`5D
XPROCEDURE  No_handler;
XBEGIN
X  System_Call ($CANEXH (desblk));
XEND;
X
X
X`5BGLOBAL`5D
XFUNCTION  Upper_case ( c : char ) : char;
XBEGIN
X  IF ( c in `5B'a'..'z'`5D ) then
X    c := chr ( ord(c) - ord('a') + ord('A') );
X  upper_case := c;
XEND;
X
X`5BGLOBAL`5D
XPROCEDURE  Clear ( portion : portiontype := The_Screen;
X                   clear   : cleartype   := Wholething );
XVAR
X  outline : v_array;
XBEGIN
X  outline := VT100_ESC + '`5B';
X
X  IF ( clear = Wholething ) then
X    outline := outline + '2'
X  ELSE
X  IF ( clear = To_Start ) then
X    outline := outline + '1';
X
X  IF ( portion = The_Screen ) then
X    outline := outline + 'J'
X  ELSE
X  IF ( portion = The_Line ) then
X    outline := outline + 'K';
X
+-+-+-+-+-+-+-+-  END  OF PART 1 +-+-+-+-+-+-+-+-