$! ------------------ CUT HERE ----------------------- $ v='f$verify(f$trnlnm("SHARE_VERIFY"))' $! $! This archive created by VMS_SHARE Version 7.2-007 22-FEB-1990 $! On 2-APR-1993 16:11:19.16 By user ANDERSON $! $! This VMS_SHARE Written by: $! Andy Harper, Kings College London UK $! $! Acknowledgements to: $! James Gray - Original VMS_SHARE $! Michael Bednarek - Original Concept and implementation $! $! $! THE FOLLOWING FILE(S) WILL BE CREATED AFTER UNPACKING: $! 1. IMAGEDIR.MAR;6 $! 2. MAKE.COM;2 $! 3. QIX.COM;13 $! 4. QIX.PAS;1 $! 5. QIX.SCN;1 $! 6. QIX.TOP;1 $! 7. QIXF.FOR;1 $! 8. QIXH.FOR;1 $! 9. QIXTOPINI.FOR;1 $! 10. SLEEP.MAR;1 $! 11. TTIO.DIFF;1 $! 12. TTIO.MAR;49 $! 13. UTIL.COM;3 $! $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`09.title`09imagedir`09find directory image was run from X X;+ X;`09Modified 25-Jul-1985 to handle VMS V4 rooted directory specs X;- X X`09$jpidef X X`09.psect`09$code4`09rd, nowrt, exe, rel, pic, con, shr, long X Xlog:`09.ascii`09'IMAGE_DIR' Xlog_len = . - log X X`09.align`09word X`09.entry`09- Ximage_dir, `5Em X;+ X;`09status = image_dir() X; X;`09assigns the disk and directory that the current image is stored in X;`09to the logical "image_dir" X; X;`09status`09system service status code X;- X`09moval`09-(sp), r4`09`09; address of return length X`09subl2`09#256, sp`09`09; allocate room for image name X`09movl`09sp, r3`09`09`09; remember its address X X`09pushl`09#0`09`09`09; end of item list X`09pushl`09r4`09`09`09; return length address X`09pushl`09r3`09`09`09; buffer address X`09pushl`09#256! ; length and item code X`09movl`09sp, r1`09`09`09; address of item list X X`09$getjpi_s itmlst=(r1)`09`09; get info for this process X`09blbc`09r0, 1000$`09`09; br if error X X`09subl2`09#4*4, sp`09`09; remove item list from stack X;+ X;`09now search for end of directory name ("`5D" or ">") X;- X`09movzwl`09(r4), r4`09`09; get full length of image name X`09movl`09r3, r5`09`09`09; get address X10$: X`09locc`09#`5EA/:/, r4, (r5)`09; look for end of logical name X`09beql`0920$`09`09`09; br if not found X X`09subl3`09#1, r0, r4`09`09; get new length X`09addl3`09#1, r1, r5`09`09; get new address X`09brb`0910$`09`09`09; look for another colon X20$: X`09locc`09#`5EA/`5D/, r4, (r5)`09; find closing bracket X`09beql`0940$`09`09`09; br if not found X X`09subl3`09#1, r0, r4`09`09; get new length X`09addl3`09#1, r1, r5`09`09; get new address X`09brb`0920$`09`09`09; look for another "`5D" X40$: X`09locc`09#`5EA/>/, r4, (r5)`09; find closing bracket X`09beql`0960$`09`09`09; br if not found X X`09subl3`09#1, r0, r4`09`09; get new length X`09addl3`09#1, r1, r5`09`09; get new address X`09brb`0940$`09`09`09; look for another ">" X60$: X X100$: X`09pushl`09r3`09`09`09; address of eqlnam X`09subl3`09r3, r5, -(sp)`09`09; get length of eqlnam X`09movl`09sp, r2`09`09`09; save address of descriptor X X`09pushab`09W`5Elog`09`09`09; address of lognam X`09pushl`09#log_len`09`09; length of lognam X`09movl`09sp, r3`09`09`09; save address of descriptor X X`09$crelog_s tblflg=#2, lognam=(r3), eqlnam=(r2) ; create process logical X;`09blbc`09r0, 1000$`09`09; br if error X1000$: X`09ret`09`09`09`09; which will clean up the stack X X X`09.end $ CALL UNPACK IMAGEDIR.MAR;6 173433367 $ create 'f' X$ pascal qix X$ fortran qixh X$ fortran qixf X$ fortran qixtopini X$ link qixtopini X$ @util X$ link qix,qixh,qixf,util/lib X$ exit X X $ CALL UNPACK MAKE.COM;2 1382619411 $ create 'f' X$ set noverify X$! DCL rewritten and modified by Doran Anderson. X$! X$ blank X$! X$ esc`5B0,32`5D = %o33`09`09`09 ! X$ chr_esc = f$extract(0,1,esc) X$ reset_term = chr_esc + "`5B!p" X$! X$ on control_y then goto exit_quick!'f$verify(0) X$ on warning then goto exit_qix X$ current_directory=f$environment("default") X$ time=f$extract(12,2,f$time()) X$ today=f$cvtime(,,"weekday") X$ devdir=f$environment("procedure") X$ set default 'f$parse(devdir,,,"device")''f$parse(devdir,,,"directory")' X$ define/nolog/user games 'f$parse(devdir,,,"device")''f$parse(devdir,,,"dir Vectory")' X$ define/nolog/user sys$input sys$command X$ run qix X$ goto exit_qix X$exit_quick: X$ blank X$exit_qix: X$ set default 'current_directory' X$ write sys$output reset_term X$ set term/inquire X$ exit $ CALL UNPACK QIX.COM;13 255805371 $ create 'f' X`7B$C+`7D X`7B$S-`7D X`7B X X`09`09 XXXX XXXXX X X X`09`09X X X X X X`09`09X X X XX X`09`09X X X X XX X`09`09X X X X X X`09`09 XXX X XXXXX X X X`09`09 X X X`09`09Program`09: Qix`20 X X`09`09Author`09: Murray Speight`20 X X`09`09Place`09: University Of Waikato`20 X X`09`09Date `09: Mar 1982`20 X X`09Software Is Subject To Change Without Notification X The Author And His Family assume No Rsponsability For X`09Its Reliabliity Or Use.`20 X X `20 X`09A Game Derived From a Video Game Of The Same Name `7D X X X X X XProgram Qix(Input,Output); X XLabel 9999; X XConst Max_Len_snake `09= 40; X`09Max_Buff_len `09= 200; X Blank `09= ' '; X You `09= 'O'; X Qix_Head = '`60'; X`09Esc`09`09= '`1B'; X XType`09Buff_String `09= PAcked Array `5B1..Max_Buff_Len`5D Of Char; X`09 X`09rng`09`09= 1..20; X X Wall_Types`09= (Inside,Outside,Created,Other,Snake,Tmp,TmpN,TmpN2,Tm VpCreat); X X`09Char_On_Screen`09= Record X`09 Sym`09 `09: Char; X`09 Wall`09`09: Wall_Types; X`09end; X X Direction = ( Clockwise , AntiClockwise ); X X Screen_type = Array`5B0..24,0..81`5D Of Char_On_Screen; X X XVar`09Screen `09`09: Screen_Type; X`09Buff `09`09: Buff_String; X`09Buff_Len `09`09, X`09Marked_Clock_Greeb_X`09, X`09Marked_Clock_Greeb_Y`09, X`09Marked_Anti_Greeb_X`09, X`09Marked_Anti_Greeb_Y`09, X`09Num_Marked_Clock_Greeb `09, X`09Num_Marked_Anti_Greeb `09, X Last_Clock_Greeb_X`09, X Last_Clock_Greeb_y`09, X Last_Anti_Greeb_X`09, X Last_Anti_Greeb_y`09, X Clock_Greeb_X`09`09, X Clock_Greeb_y`09`09, X Anti_Greeb_X`09`09, X Anti_Greeb_y`09`09, X Extra_Greeb_X`09`09, X Extra_Greeb_Y`09`09, X Last_Extra_Greeb_X`09, X Last_Extra_Greeb_Y`09, X You_X`09`09`09, X`09You_Y`09`09`09, X Last_You_X `09`09, X Last_You_Y `09`09, X`09Move_X`09`09`09, X Level `09`09`09, X`09Move_y`09`09`09, X Start_Creat_X `09`09, X Start_Creat_Y `09`09, X Last_Start_Creat_X`09, X Last_Start_Creat_Y`09, X Snake_After_X `09`09, X Snake_After_Y `09`09, X Snake_Head_X `09`09, X`09Snake_Head_Y `09`09, X Snake_Move_X `09`09, X Snake_Move_Y `09`09, X`09Snake_Tail_X`09`09, X Lives`09`09`09, X Score`09`09`09, X Amt_Filled_In `09`09, X Len_Snake `09`09, X`09Len_Snake_When_Stuck`09, X`09Num_Snake_Searched`09, X`09Num_Moves_After_This_Pt , X`09Moves_since_stuck`09, X`09Snake_Tail_Y`09`09: Integer; X Seed`09`09`09: REal; X Can_Create_wall `09, X Moving_Extra_Greebly `09, X`09Marked_Clock_Greeb`09, X`09Marked_Anti_Greeb`09, X Snake_got_stuck `09, X`09Died`09`09`09, X`09Creating_wall`09`09: Boolean; X Dir_You `09`09,`09`09`09`7B Direction You Are moving In `7D X Dir_When_Start_Creat `09: Direction;`09`09`7B Direction You Were In V Before Starting To Create `7D X XProcedure TopTen(Var Score : Integer);extern; X XProcedure Sleep(X_Sec,X_100_n_Sec : Integer);Extern; X XProcedure Help_Screen(%STDESCR file$ : Packed array `5Brng`5D of char );exte Vrn; X XProcedure TT_init( One : Integer);extern; X XFunction TT_1_Char_Now:Integer;extern; X XProcedure TT_Write( S : Buff_String; L : Integer );extern; X XProcedure TT_Cancel;extern; X XProcedure Sleep_Set( Seven : Integer ; Sec_100_th : Integer );extern; X XProcedure Sleep_Start;extern; X XProcedure Sleep_Wait;extern; X X X X XProcedure Break_Buff; X X XBegin X TT_Write(Buff,Buff_Len); X Buff_len := 0; Xend; X XProcedure Write_Buff( C : Char); X XBegin X Buff_Len := Buff_Len + 1; X Buff`5BBuff_Len`5D := C; X If Buff_Len > ( MAx_Buff_len - 10 ) Then`20 X`09Break_Buff; Xend; X X X X XProcedure Pos(X,Y : Integer; Ch : Char); X XBegin X Buff`5Bbuff_Len+1`5D := Esc; X Buff`5BBuff_Len+2`5D := 'Y'; X Buff`5BBuff_Len+3`5D := Chr(31+x); X Buff`5BBuff_Len+4`5D := Chr(31+y); X Buff`5BBuff_Len+5`5D := Ch; X Buff_Len := Buff_Len + 5; X If Buff_Len > ( MAx_Buff_len - 10 ) Then`20 X`09Break_Buff; XEnd; X X XProcedure Draw_Screen; X XVar X,Y,Dummy : Integer; X XBegin X Break_Buff; X Write(Esc,'<',Esc,'`5B?2l'); X Write(Esc,'H',esc,'J',Esc,'F'); X For Y := 1 to 80 do`20 X Write(Screen`5B1,Y`5D.Sym); X Writeln; X For X := 2 to 22 do begin X Write(Esc,'Y',chr(31+X),Chr(31+1),Screen`5BX,1`5D.Sym); X Writeln(Esc,'Y',CHr(31+X),Chr(31+80),Screen`5BX,80`5D.Sym); X end; X For Y := 1 to 80 do`20 X Write(Screen`5B23,Y`5D.Sym); X Writeln(Esc,'G'); X Write(Esc,'<',esc,'`5B1m',Esc,'#6Covered '); X Write(Esc,'`5B24;9H'); X Write((Amt_Filled_In * 100 / 1638 ):5:2); X Write(esc,'`5B24;16HScore '); X write(esc,'`5B24;22H',Score:5); X Write(esc,'`5B24;29HLives'); X For Dummy := 1 to Lives Do`20 X Write(' O'); X Writeln(esc,'`5B0m',esc,'`5B?2l',esc,'F',esc,'H'); X Pos(Snake_Head_X,Snake_Head_Y,Qix_Head); X Pos(You_X,You_Y,You); X Break_Buff; Xend; X XFunction Rand( X : Integer):Integer; X X Function mth$Random(Var Seed : Real):Real;Extern; X X XBegin X Rand := Trunc(Mth$Random(Seed)*X+1); Xend; X XFunction Correct_Sym(X,Y,Compare_X,Compare_Y:Integer):Char; X XVar Count : Integer; X XBegin X Count := 0; `20 X If Screen`5BX-1,y`5D.Sym In `5B'l','w','k','t','n','u','x'`5D Then`20 X Count := Count + 1 X Else X If ( X - 1 = Compare_X ) And ( Y = Compare_Y ) Then`20 X Count := Count + 1; X If Screen`5Bx,Y-1`5D.Sym In `5B'l','w','t','n','m','v','q'`5D Then X Count := Count + 2 X Else X If ( X = Compare_X ) And ( Y - 1 = Compare_Y ) Then`20 X Count := Count + 2; X If Screen`5BX,Y+1`5D.Sym In `5B'w','n','v','k','u','j','q'`5D Then`20 X Count := Count + 4 X Else X If ( X = Compare_X ) And ( Y + 1 = Compare_Y ) Then`20 X Count := Count + 4; X If Screen`5BX+1,Y`5D.Sym In `5B't','n','u','m','v','j','x'`5D Then`20 X Count := Count + 8 X Else X If ( X + 1 = Compare_X ) And ( Y = Compare_Y ) Then`20 X Count := Count + 8; X Case Count Of`20 X 0`09: `7B NOthing `7D; X 1,8,9 `09: Correct_Sym := 'x'; X 2,4,6`09: Correct_Sym := 'q'; X 3`09: Correct_Sym := 'j'; X 5`09: Correct_Sym := 'm'; X 7`09: Correct_Sym := 'v'; X 10`09: Correct_Sym := 'k'; X 11`09: Correct_Sym := 'u'; X 12`09: Correct_Sym := 'l'; X 13`09: Correct_Sym := 't'; X 14`09: Correct_Sym := 'w'; X 15`09: Correct_Sym := 'n' X end `7B case `7D; Xend; X XProcedure IniTalise_screen; X XVar X,Y,Dummy,Snake_Move_x,Snake_Move_Y,Cnt : Integer; X Save_ch : Char; X Xbegin X Died := False; X Level := Level + 1; X Sleep_set(7,17-Level); X For X := 0 To 24 Do`20 X For Y := 0 To 81 Do Begin X Screen`5BX,Y`5D.Sym := Blank; X Screen`5BX,Y`5D.Wall := Other; X End; X For Y := 0 To 81 Do Begin X Screen`5B0,Y`5D.Sym := '.'; X Screen`5B0,Y`5D.Wall := Outside; X Screen`5B24,Y`5D.Sym := '.'; X Screen`5B24,Y`5D.Wall := Outside; X End `7B For `7D; X For X := 0 To 24 Do Begin X Screen`5BX,0`5D.Sym := '.'; X Screen`5BX,0`5D.Wall:= Outside; X Screen`5BX,81`5D.Sym := '.'; X Screen`5BX,81`5D.Wall := Outside; X end; X For Y := 1 To 80 Do Begin X Screen`5B1,Y`5D.Sym := 'q'; X Screen`5B1,Y`5D.Wall := Inside; X Screen`5B23,Y`5D.Sym := 'q'; X Screen`5B23,Y`5D.Wall := Inside; X end; +-+-+-+-+-+-+-+- END OF PART 1 +-+-+-+-+-+-+-+- -+-+-+-+-+-+-+-+ START OF PART 2 -+-+-+-+-+-+-+-+ X For X := 1 to 23 Do Begin X Screen`5BX,1`5D.Sym := 'x'; X Screen`5BX,1`5D.Wall := Inside; X Screen`5BX,80`5D.Sym := 'x'; X Screen`5BX,80`5D.Wall := Inside; X end; X Screen`5B1,1`5D.Sym := 'l'; X Screen`5B1,1`5D.wall := Inside; X Screen`5B1,80`5D.Sym := 'k'; X Screen`5B1,80`5D.wall := Inside; X Screen`5B23,1`5D.Sym := 'm'; X Screen`5B23,1`5D.wall := Inside; X Screen`5B23,80`5D.Sym := 'j'; X Screen`5B23,80`5D.wall := Inside; X You_X := 1; X You_Y := 1; X Move_X := 0; X Move_Y := 1; X Last_You_X := 2; X Last_You_Y := 1; X Dir_You := Clockwise; X Snake_Head_X := 11; X Snake_Head_Y := 40; X Snake_Tail_X := Snake_Head_X; X Snake_Tail_Y := Snake_Head_Y; X Moves_since_stuck := 0; X Screen`5BSnake_Head_X,Snake_Head_Y`5D.Sym := Qix_Head; X Screen`5BSnake_Head_X,Snake_Head_Y`5D.Wall := Snake; X Len_Snake := 0; X Amt_Filled_In := 0; X Moving_extra_Greebly := False; X Snake_got_stuck := False; X Snake_Move_X := 0; X Snake_Move_Y := -1; X Can_Create_wall := False; X Clock_Greeb_X := 23;`20 X Clock_Greeb_Y := 40; X Last_Clock_Greeb_X := Clock_Greeb_X; X Last_Clock_Greeb_Y := Clock_Greeb_Y + 1; X Anti_Greeb_X := 12;`20 X Anti_Greeb_Y := 80; X Last_Anti_Greeb_X := Anti_Greeb_X + 1; X Last_Anti_Greeb_Y := Anti_Greeb_Y; X Marked_Anti_Greeb := False; X Marked_Clock_Greeb := False; X Marked_Anti_Greeb_X := 0; X Marked_Anti_Greeb_Y := 0; X Marked_Clock_Greeb_X := 0; X Marked_Clock_Greeb_Y := 0; X Num_Moves_After_This_pt := 9999; X Draw_Screen; Xend; X X XProcedure Initalise; X XVar Rep : Char; X X XBegin X LineLimit(Output,Maxint); X TT_Init(1); X Seed := Clock; X Write(Esc,'<',Esc,'`5B2J',esc,'`5B1;1H'); X Help_Screen('Games:qix.Scn'); X Level := 0; X Lives := 3; X Score := 0; X Buff_Len := 0; X Initalise_Screen; Xend `7B Initalise `7D; X `20 X XFunction Valid_Move(X,Y:INteger):Boolean; X Xbegin X If Screen`5BX,Y`5D.Sym = '.' Then`20 X Valid_Move := False X Else`20 X If Screen`5BX,Y`5D.Wall = Created Then`20 X Valid_Move := False X Else X Valid_Move := True; Xend; X XProcedure Move_Anti_Clockwise(Var X,Y,Last_X,Last_Y:INteger); X XVar Tmp_X,Tmp_Y : Integer; X XBegin XTmp_X := X; XTmp_Y := Y; XCase ( Last_Y-Y) Of`20 X 1 : Case Screen`5BX,Y`5D.Sym Of`20 X 'l' : X := X + 1; X 'w' : X := X + 1; X 't' : X := X + 1; X 'n' : X := X + 1; X 'm' : X := X - 1; X 'v' : Y := Y - 1; X 'q' : Y := Y - 1; X end; X 0 : Case (Last_X-X) Of`20 X 1 : Case Screen`5BX,y`5D.Sym Of`20 X 'l' : Y := Y + 1; X 'w' : Y := Y - 1; X 'k' : Y := Y - 1; X 't' : X := X - 1; X 'n' : Y := Y - 1; X 'u' : Y := Y - 1; X 'x' : X := X - 1; X end; X 0 : ; X -1 : Case Screen`5BX,y`5D.Sym Of`20 X 't' : Y := Y + 1; X 'n' : Y := Y + 1; X 'u' : X := X + 1; X 'm' : Y := Y + 1; X 'v' : Y := Y + 1; X 'j' : Y := Y - 1; X 'x' : X := X + 1; X end; X end; X -1 : Case Screen`5BX,Y`5D.Sym Of`20 X 'w' : Y := Y + 1; X 'k' : X := X + 1; X 'n' : X := X - 1; X 'u' : X := X - 1; X 'v' : X := X - 1; X 'j' : X := X - 1; X 'q' : Y := Y + 1; X end; X End `7B case `7D; X Last_X := Tmp_X; X LAst_Y := Tmp_Y; Xend `7B Move_Anti_Clockwise`7D; X X X XProcedure Move_Clockwise(Var X,Y,Last_X,Last_Y:INteger); X XVar Tmp_X,Tmp_Y : Integer; X XBegin XTmp_X := X; XTmp_Y := Y; XCase ( Last_Y-Y) Of`20 X 1 : Case Screen`5BX,Y`5D.Sym Of`20 X 'l' : X := X + 1; X 'w' : Y := Y - 1; X 't' : X := X - 1; X 'n' : X := X - 1; X 'm' : X := X - 1; X 'v' : X := X - 1; X 'q' : Y := Y - 1; X end; X 0 : Case (Last_X-X) Of`20 X 1 : Case Screen`5BX,y`5D.Sym Of`20 X 'l' : Y := Y + 1; X 'w' : Y := Y + 1; X 'k' : Y := Y - 1; X 't' : Y := Y + 1; X 'n' : Y := Y + 1; X 'u' : X := X - 1; X 'x' : X := X - 1; X end; X 0 : ; X -1 : Case Screen`5BX,y`5D.Sym Of`20 X 't' : X := X + 1; X 'n' : Y := Y - 1; X 'u' : Y := Y - 1; X 'm' : Y := Y + 1; X 'v' : Y := Y - 1; X 'j' : Y := Y - 1; X 'x' : X := X + 1; X end; X end; X -1 : Case Screen`5BX,Y`5D.Sym Of`20 X 'w' : X := X + 1; X 'k' : X := X + 1; X 'n' : X := X + 1; X 'u' : X := X + 1; X 'v' : Y := Y + 1; X 'j' : X := X - 1; X 'q' : Y := Y + 1; X end; X End `7B case `7D; X Last_X := Tmp_X; X LAst_Y := Tmp_Y; Xend `7B Move_Clockwise`7D; X XProcedure Move_Opp_Anti_Clockwise(Var X,Y,Last_X,Last_Y : Integer); X XVar Tmp_X,Tmp_Y : Integer; X XBegin XIf Screen`5BX,y`5D.Sym = 'n' Then Begin X Tmp_X := X; X Tmp_Y := Y; X Y := Y + (Y-Last_Y); X X := X + (X-Last_X); X Last_X := Tmp_X; X Last_Y := Tmp_Y; Xend Else X Move_Clockwise(X,Y,Last_X,Last_Y); Xend; X XProcedure Move_Opp_Clockwise(Var X,Y,Last_X,Last_Y : Integer); X XVar Tmp_X,Tmp_Y : Integer; X XBegin XIf Screen`5BX,y`5D.Sym = 'n' Then Begin X Tmp_X := X; X Tmp_Y := Y; X Y := Y + (Y-Last_Y); X X := X + (X-Last_X); X Last_X := Tmp_X; X Last_Y := Tmp_Y; Xend Else X Move_anti_Clockwise(X,Y,Last_X,Last_Y); Xend; X X X X XProcedure Move_Greeblys; X XVar Tmp : Integer; X XProcedure Jump_Greeb(Var Sudo_X,Sudo_Y,LSudo_X,LSudo_Y : Integer); X X X XBegin X Sudo_X := Snake_Head_X; X Sudo_Y := Snake_Head_Y; X While Not ( Screen`5BSudo_X,Sudo_Y`5D.Wall In `5BCreated,Inside`5D) Do`20 X Sudo_X := Sudo_X - 1; X If Screen`5BSudo_X,Sudo_Y`5D.Wall = Created Then Begin X LSudo_X := Sudo_X; X LSudo_Y := Sudo_Y; X Case Screen`5BSudo_X,Sudo_Y`5D.Sym Of`20 X 'm' , `20 X 'v' , X 'q' : Sudo_Y := Sudo_Y + 1; X 'j' : Sudo_X := Sudo_X - 1; X Otherwise Begin X LSudo_X := Sudo_X + 1; X LSudo_Y := Sudo_Y; X end X End `7B CAse `7D; X While Screen`5BSudo_X,Sudo_Y`5D.Wall = Created Do Begin X Move_Clockwise(Sudo_X,Sudo_Y,LSudo_X,LSudo_Y); X end; X end Else begin X LSudo_X := Sudo_X; X LSudo_Y := Sudo_Y; X Case Screen`5BSudo_X,Sudo_Y`5D.Sym Of`20 X 'm' , X 'v' , X 'q' : Sudo_Y := Sudo_Y + 1; X 'j' : Sudo_X := Sudo_X - 1; X Otherwise Begin X LSudo_X := Sudo_X + 1; X LSudo_Y := Sudo_Y; X end X End `7B CAse `7D; X end; Xend; X X XBegin X`7BMove_Clockwise_wise_one`7D XPos(Clock_Greeb_X,Clock_Greeb_Y,Screen`5BClock_Greeb_X,Clock_Greeb_Y`5D.Sym) V; XIf Screen`5BClock_Greeb_X,Clock_Greeb_Y`5D.Wall = Inside Then Begin X If Screen`5BLast_Clock_Greeb_X,Last_Clock_Greeb_Y`5D.Wall = Outside Then V Begin X Marked_Clock_Greeb := False; X Move_Opp_Clockwise(Clock_Greeb_X,Clock_Greeb_Y,Last_Clock_Greeb_X,Last V_Clock_Greeb_Y) X end Else Begin X If Marked_Clock_Greeb Then Begin X If Num_Marked_Clock_Greeb > 80 Then begin X Marked_Clock_Greeb := False; X Move_Clockwise(Clock_Greeb_X,Clock_Greeb_Y,Last_Clock_Greeb_X,La Vst_Clock_Greeb_Y); X end else begin X`09 Num_Marked_Clock_Greeb := Num_Marked_Clock_Greeb + 1; X If ( Clock_Greeb_X = Marked_Clock_Greeb_X ) and ( Clock_Greeb_Y V = Marked_Clock_Greeb_Y ) Then Begin X Marked_Clock_Greeb := False; X Jump_Greeb(Clock_Greeb_X,Clock_Greeb_Y,Last_Clock_Greeb_X,Las Vt_Clock_Greeb_Y) X end else`20 X Move_Clockwise(Clock_Greeb_X,Clock_Greeb_Y,Last_Clock_Greeb_ VX,Last_Clock_Greeb_Y); X end`20 X end else`20 X Move_Clockwise(Clock_Greeb_X,Clock_Greeb_Y,Last_Clock_Greeb_X,Last_ VClock_Greeb_Y); X end Xend else X If Screen`5BClock_Greeb_X,Clock_Greeb_Y`5D.Wall = Created Then`20 X Move_Opp_Clockwise(Clock_Greeb_X,Clock_Greeb_Y,Last_Clock_Greeb_X,Last V_Clock_Greeb_Y) X Else Begin X If Marked_Clock_Greeb Then Begin X`09If ( Clock_Greeb_X = Marked_Clock_Greeb_X ) And ( Clock_Greeb_Y = Marked_ VClock_Greeb_Y) Then Begin X Marked_Clock_Greeb := False; X Jump_Greeb(Clock_Greeb_X,Clock_Greeb_Y,Last_Clock_Greeb_X,Last_C Vlock_Greeb_Y) X end else X Move_Clockwise(Clock_Greeb_X,Clock_Greeb_Y,Last_Clock_Greeb_X,La Vst_Clock_Greeb_Y) X End Else X Move_Clockwise(Clock_Greeb_X,Clock_Greeb_Y,Last_Clock_Greeb_X,Last_ VClock_Greeb_Y); X end; XPos(Clock_Greeb_X,Clock_Greeb_Y,'*'); XIf (You_X=Clock_Greeb_X) and (You_Y=Clock_Greeb_Y) Then`20 X Died := True; X`7BMove AntiClockwise One `7D XPos(Anti_Greeb_X,Anti_Greeb_Y,Screen`5BAnti_Greeb_X,Anti_Greeb_Y`5D.Sym); XIf Screen`5BAnti_Greeb_X,Anti_Greeb_Y`5D.Wall = Inside Then Begin X If Screen`5BLast_Anti_Greeb_X,Last_Anti_Greeb_Y`5D.Wall = Outside Then Be Vgin X Marked_Anti_Greeb := False; X Move_Opp_Anti_Clockwise(Anti_Greeb_X,Anti_Greeb_Y,Last_Anti_Greeb_X,La Vst_Anti_Greeb_Y) X End Else`20 X If Marked_Anti_Greeb Then Begin X If Num_Marked_Anti_Greeb > 80 Then begin X Marked_Anti_Greeb := False; X Move_Anti_Clockwise(Anti_Greeb_X,Anti_Greeb_Y,Last_Anti_Greeb_X, VLast_Anti_Greeb_Y) X end else begin X`09 Num_Marked_Anti_Greeb := Num_Marked_Anti_Greeb + 1; X If ( Anti_Greeb_X = Marked_Anti_Greeb_X ) and ( Anti_Greeb_Y = M Varked_Anti_Greeb_Y ) Then Begin X Marked_Anti_Greeb := False; X Jump_Greeb(Anti_Greeb_X,Anti_Greeb_Y,Last_Anti_Greeb_X,Last_A Vnti_Greeb_Y); X Tmp := Anti_Greeb_X; X Anti_Greeb_X := Last_Anti_Greeb_X; X Last_Anti_Greeb_X := Tmp; X Tmp := Anti_Greeb_Y; X Anti_Greeb_Y := Last_Anti_Greeb_Y; X Last_Anti_Greeb_Y := Tmp; X end else`20 X Move_Anti_Clockwise(Anti_Greeb_X,Anti_Greeb_Y,Last_Anti_Greeb V_X,Last_Anti_Greeb_Y) X end`20 X end else`20 X Move_Anti_Clockwise(Anti_Greeb_X,Anti_Greeb_Y,Last_Anti_Greeb_X,Las Vt_Anti_Greeb_Y) Xend else X If Screen`5BAnti_Greeb_X,Anti_Greeb_Y`5D.Wall = Created Then`20 X Move_Opp_Anti_Clockwise(Anti_Greeb_X,Anti_Greeb_Y,Last_Anti_Greeb_X,La Vst_Anti_Greeb_Y) X Else Begin X If Marked_Anti_Greeb Then Begin X`09If ( Anti_Greeb_X = Marked_Anti_Greeb_X ) And ( Anti_Greeb_Y = Marked_Ant Vi_Greeb_Y) Then Begin X Marked_Anti_Greeb := False; X Jump_Greeb(Anti_Greeb_X,Anti_Greeb_Y,Last_Anti_Greeb_X,Last_Anti V_Greeb_Y); X Tmp := Anti_Greeb_X; X Anti_Greeb_X := Last_Anti_Greeb_X; X Last_Anti_Greeb_X := Tmp; X Tmp := Anti_Greeb_Y; X Anti_Greeb_Y := Last_Anti_Greeb_Y; X Last_Anti_Greeb_Y := Tmp; X end else X Move_Anti_Clockwise(Anti_Greeb_X,Anti_Greeb_Y,Last_Anti_Greeb_X, VLast_Anti_Greeb_Y); X End Else`20 X Move_Anti_Clockwise(Anti_Greeb_X,Anti_Greeb_Y,Last_Anti_Greeb_X,Las Vt_Anti_Greeb_Y); X end; XPos(Anti_Greeb_X,Anti_Greeb_Y,'*'); XIf (You_X=Anti_Greeb_X) and (You_Y=Anti_Greeb_Y) Then`20 X Died := True; XIf Moving_Extra_Greebly Then Begin X Pos(Extra_Greeb_X,Extra_Greeb_Y,Screen`5BExtra_Greeb_X,Extra_Greeb_Y`5D.S Vym); X If Dir_When_Start_Creat = Clockwise Then`20 X Move_ClockWise(Extra_Greeb_X,Extra_Greeb_Y,Last_Extra_Greeb_X,Last_Ext Vra_Greeb_Y) X Else X Move_Anti_ClockWise(Extra_Greeb_X,Extra_Greeb_Y,Last_Extra_Greeb_X,Las Vt_Extra_Greeb_Y); X Pos(Extra_Greeb_X,Extra_Greeb_Y,'*'); X If (You_X=Extra_Greeb_X) And (You_Y =Extra_Greeb_Y) Then X Died := True X Else begin X Pos(Extra_Greeb_X,Extra_Greeb_Y,Screen`5BExtra_Greeb_X,Extra_Greeb_Y`5 VD.Sym); X If Dir_When_Start_Creat = Clockwise Then`20 X Move_ClockWise(Extra_Greeb_X,Extra_Greeb_Y,Last_Extra_Greeb_X,Last_ VExtra_Greeb_Y) X Else X Move_Anti_ClockWise(Extra_Greeb_X,Extra_Greeb_Y,Last_Extra_Greeb_X, VLast_Extra_Greeb_Y); X Pos(Extra_Greeb_X,Extra_Greeb_Y,'*'); X If (You_X=Extra_Greeb_X) And (You_Y =Extra_Greeb_Y) Then`20 X Died := True; X end; Xend; Xend; X X X XProcedure Move_Snake; X XVar tmp,cnt: Integer; X Save_ch : Char; X Swaped_head : Boolean; X Dist_From_Head, X Dist_From_Tail : Integer; X XProcedure Get_Move_For_Snake ; X X XProcedure Swap_snake_head_and_Tail; X XVar Tmp_Tail_X,Tmp_Tail_Y : Integer; X Xbegin X Swaped_Head := True; X Moves_since_stuck := 0; X Snake_Got_stuck := False; X Tmp_Tail_X := Snake_Tail_X; X Tmp_Tail_Y := Snake_Tail_Y; X Screen`5BSnake_Head_X,Snake_Head_Y`5D.Wall := Other; X Screen`5BSnake_Head_X,Snake_Head_Y`5D.Sym := Blank; X pos(Snake_Head_X,Snake_Head_Y,Blank); X If ( Screen`5BSnake_Head_X,Snake_Head_Y+1`5D.Wall = Snake ) and`20 X ( Screen`5BSnake_Head_X,Snake_Head_Y+1`5D.Sym in `5B'q','k','j'`5D ) T Vhen begin X Snake_Tail_X := Snake_Head_X; X Snake_Tail_Y := Snake_Head_Y+1; X end else X If ( Screen`5BSnake_Head_X,Snake_Head_Y-1`5D.Wall = Snake ) and`20 X ( Screen`5BSnake_Head_X,Snake_Head_Y-1`5D.Sym in `5B'q','l','m'`5D V ) Then begin X Snake_Tail_X := Snake_Head_X; X Snake_Tail_Y := Snake_Head_Y-1; X end else X If ( Screen`5BSnake_Head_X+1,Snake_Head_Y`5D.Wall = Snake ) and`20 X ( Screen`5BSnake_Head_X+1,Snake_Head_Y`5D.Sym in `5B'x','m','j'` V5D ) Then begin X Snake_Tail_X := Snake_Head_X+1; X Snake_Tail_Y := Snake_Head_Y; X end else X If ( Screen`5BSnake_Head_X-1,Snake_Head_Y`5D.Wall = Snake ) and` V20 X ( Screen`5BSnake_Head_X-1,Snake_Head_Y`5D.Sym in `5B'x','l',' Vk'`5D ) Then begin X Snake_Tail_X := Snake_Head_X-1; X Snake_Tail_Y := Snake_Head_Y; X end; X Snake_Head_X := Tmp_Tail_X; X Snake_Head_Y := Tmp_Tail_Y; +-+-+-+-+-+-+-+- END OF PART 2 +-+-+-+-+-+-+-+- -+-+-+-+-+-+-+-+ START OF PART 3 -+-+-+-+-+-+-+-+ X Screen`5BSnake_Head_X,Snake_Head_Y`5D.Sym := Blank; X Screen`5BSnake_Head_X,Snake_Head_Y`5D.Wall := Snake; X pos(Snake_Head_X,Snake_Head_Y,Qix_Head); X Len_Snake := Len_Snake - 1; Xend; X X XFunction Sgn(X:Integer):Integer; X XBegin X If X > 0 Then`20 X Sgn := 1 X else X If X < 0 Then`20 X Sgn := -1 X Else`20 X Sgn := 0; Xend; X XProcedure Search_For_Move; X XVar X,Y,XX,YY,Dist,Closest : Integer; X XBegin X Num_Snake_Searched := Num_Snake_Searched + 1; X Snake_Move_X := 0; X Snake_Move_Y := 0; X X := 0; X Y := 0; X X Closest := 999999; X For Xx := 1 To 4 do begin X Case Xx of`20 X 1 : Y := 1; X 2 : Y := -1; X 3 : Begin X Y := 0; X X := 1; X end; X 4 : X := -1 ; X end; X Dist := (((Snake_Head_X + X ) - Snake_After_X))**2`20 X + ((Snake_Head_Y + Y ) - Snake_After_Y)**2; X If Dist < Closest Then`20 X If (( X + Y ) <> 0 ) and`20 X ( Screen`5BSnake_Head_X+X,Snake_Head_Y+Y`5D.wall in `5BCreated,O Vther`5D ) and`20 X ( Not (( Snake_Head_X+X = Start_Creat_X ) and ( Snake_Head_Y+Y = V Start_Creat_Y))) Then Begin X Snake_Move_X := X; X Snake_Move_Y := Y; X Closest := Dist; X end; X end; Xend; X X X X X XBegin X If Creating_wall Then begin X If ( Num_Snake_Searched > ( 10 + Rand(10))) And X ( Moves_Since_stuck > 15 ) Then Begin X Num_Snake_Searched := 0; `20 X Swap_Snake_Head_and_Tail; X Snake_After_X := You_X; X Snake_After_Y := You_Y; X end else begin X Dist_from_Tail := (( Snake_Tail_X - Snake_After_X )**2 )+`20 X (( Snake_Head_Y - Snake_After_Y )**2 ); X If (( Snake_Head_X - Snake_After_X )**2 +`20 X ( Snake_Head_Y - Snake_After_Y )**2 ) > ( Dist_From_Tail*2 ) The Vn`20 X If ( Moves_since_Stuck > 10 ) and ( Len_snake > 10 ) and X ( dist_from_tail > 10 ) Then`20 X Swap_Snake_Head_and_Tail; X If (( You_X - Snake_Head_X ) ** 2 + ( You_Y - Snake_Head_Y)**2 ) < X (( Snake_Head_X - Snake_After_X )**2 + ( Snake_Head_Y - Snake_Af Vter_Y )**2 ) Then Begin X Num_Snake_Searched := 0; X Snake_After_X := You_X; X Snake_After_Y := You_Y; X end; X end; X end Else begin X Num_Snake_Searched := 0; X If Num_MOves_After_This_Pt > ( 10 + Rand(10)) Then Begin X Snake_After_X := Rand(21); X Snake_After_Y := Rand(78); X Num_Moves_After_This_Pt := 0; X end else X Num_Moves_After_This_Pt := Num_Moves_After_This_Pt + 1; X end; X If Not Snake_Got_Stuck Then Begin X Snake_Move_X := 0; X Snake_Move_Y := 0; X If Rand(4) = 1 then Begin X Snake_Move_X := Sgn(Snake_After_X - Snake_Head_X); X If Snake_Move_X = 0 Then`20 X Snake_Move_Y := Sgn(Snake_After_Y - Snake_Head_Y); X end else begin X Snake_Move_Y := Sgn(Snake_After_Y - Snake_Head_Y); X If Snake_Move_Y = 0 Then`20 X Snake_Move_X := Sgn(Snake_After_X - Snake_Head_X); X end; X If (( Snake_Move_X + Snake_Move_Y ) = 0 ) or`20 X ( Not ( Screen`5BSnake_Head_X+Snake_Move_X,Snake_Head_Y+Snake_Move_ VY`5D.wall in `5BCreated,Other`5D )) or`20 X (( Snake_Head_X+Snake_Move_X = Start_Creat_X ) and ( Snake_Head_Y+S Vnake_Move_Y = Start_Creat_Y)) Then`20 X Search_For_Move; X end else X Search_For_Move; X If ( Snake_Move_X = 0 ) And ( Snake_Move_Y = 0 ) Then Begin X If Not Snake_got_stuck Then Begin X If ( Moves_since_stuck > 10 ) and ( Len_snake > 10 ) Then begin X Swap_snake_Head_and_Tail X end else begin X Len_snake_When_stuck := Len_snake; X Snake_got_stuck := true; X end; X end Else X If ( Len_Snake < ( Len_Snake_When_stuck - 10 )) and ( Len_snake > 1 V0 ) Then begin X Swap_Snake_Head_and_Tail; X Moves_since_stuck := 0; X Snake_Got_stuck := False; X end; X end Else`20 X Snake_got_stuck := False; X Moves_Since_stuck := Moves_since_stuck + 1; X If ( Screen`5BSnake_Head_X+Snake_Move_X,Snake_Head_Y+Snake_Move_Y`5D.Wal Vl = Created ) or`20 X (( Snake_Head_X+Snake_Move_X = You_X ) And ( Snake_Head_Y+Snake_Move_ VY = You_Y ) )Then begin X Died := True; Xend;`20 X Xend; X XProcedure Remove_tail; X XBegin X If ( Len_Snake >= Max_Len_Snake ) Or Snake_got_stuck Then Begin X If ( Snake_Tail_X <> Snake_Head_X ) or (Snake_Tail_Y <> Snake_Head_Y) V Then Begin;`20 X Pos(Snake_Tail_X,Snake_Tail_Y,Blank); X Save_ch := Screen`5BSnake_Tail_X,Snake_Tail_Y`5D.Sym; X Screen`5BSnake_Tail_X,Snake_Tail_Y`5D.Sym := Blank; X Screen`5BSnake_Tail_X,Snake_Tail_Y`5D.wall := Other; X end; X If Len_Snake <= 1 Then Begin X Len_Snake := 1; X Snake_Tail_X := Snake_Head_X; X Snake_Tail_Y := Snake_Head_Y; X end else begin X Case Save_ch of`20 X 'l' : If Screen`5BSnake_Tail_X,Snake_Tail_Y+1`5D.Sym In `5B'k','j', V'q'`5D Then`20 X Snake_Tail_Y := Snake_Tail_Y + 1 X Else X Snake_Tail_X := Snake_Tail_X + 1; X 'k' : If Screen `5BSnake_Tail_X,Snake_Tail_Y-1`5D.Sym In `5B'l','m' V,'q'`5D Then`20 X Snake_Tail_Y := Snake_Tail_Y - 1 X Else X Snake_Tail_X := Snake_Tail_X +1 ; X 'm' : If Screen`5BSnake_Tail_X,Snake_Tail_Y+1`5D.Sym In `5B'k','j', V'q'`5D Then X Snake_Tail_Y := Snake_Tail_Y + 1 X Else X Snake_Tail_X := Snake_Tail_X - 1 ; X 'j' : If Screen`5BSnake_Tail_X,Snake_Tail_Y-1`5D.Sym In `5B'm','l', V'q'`5D Then`20 X Snake_Tail_Y := Snake_Tail_Y - 1 X Else X Snake_Tail_X := Snake_Tail_X - 1; X 'x' : If Screen`5BSnake_Tail_X-1,Snake_Tail_Y`5D.Sym In `5B'l','k', V'x'`5D Then`20 X Snake_Tail_X := Snake_Tail_X - 1 X Else X Snake_Tail_X := Snake_Tail_X + 1; X 'q' : If Screen`5BSnake_Tail_X,Snake_Tail_Y - 1 `5D.Sym In `5B 'l', V'm','q'`5D Then`20 X Snake_Tail_Y := Snake_Tail_Y - 1 X Else X Snake_Tail_Y := Snake_Tail_Y + 1; X Blank,'0' : `7B Nothing `7D; X end `7B CAse `7D; X end; X Len_Snake := Len_Snake - 1; X end Else X pos(Snake_Tail_X,Snake_Tail_Y,Screen`5BSnake_Tail_X,Snake_Tail_Y`5D.Sy Vm); Xend `7B remove_Tail`7D; X XBegin X Swaped_head := False; X Get_Move_For_Snake; X If Snake_Got_Stuck Then begin X Remove_tail; X Get_Move_For_Snake; X If Snake_Got_Stuck Then begin X Remove_tail; X Get_Move_For_Snake; X end; X end; X If ( Not Snake_Got_Stuck ) and ( Not Swaped_head ) Then Begin X Save_ch := Screen`5BSnake_Tail_X,Snake_Tail_Y`5D.Sym; X If Len_Snake > 2 Then`20 X Screen`5BSnake_Tail_X,Snake_Tail_Y`5D.Sym := '%'; X Screen`5BSnake_Head_X,Snake_Head_Y`5D.Wall := Snake; X Screen`5BSnake_Head_X,Snake_Head_Y`5D.Sym :=`20 X Correct_Sym(Snake_Head_X,Snake_Head_Y,Snake_Head_X+Snake_Move V_X,Snake_Head_Y+Snake_Move_Y); `20 X If (( Snake_Head_X<>Snake_Tail_X ) or ( Snake_Head_Y<>Snake_Tail_Y ) ) V and (Len_Snake > 2) Then`20 X Screen`5BSnake_Tail_X,Snake_Tail_Y`5D.Sym := Save_ch ; X Pos(Snake_Head_X,Snake_Head_Y,Screen`5BSnake_Head_X,Snake_Head_Y`5D.Sy Vm); X Len_snake := Len_Snake+1; X Snake_Head_X := Snake_Head_X + Snake_Move_X; X Snake_Head_Y := Snake_Head_Y + Snake_Move_Y; X Pos(Snake_Head_X,Snake_Head_Y,Qix_Head); X Remove_tail; X end; Xend; X X `20 X X XProcedure Move_You; X XVar Count,X,Y,Tmp_X,Tmp_Y,LTmp_X,LTmp_Y: Integer; X ch,save_ch : char; X Inside_Box,Created_Box : Boolean; X XProcedure Cal_Inside; X XVar X,Y,Last_Y,Sudo_X,Sudo_Y,Lsudo_X,LSudo_Y,Max_X,Min_X,Max_Y,Min_Y: Intege Vr; X Inside_Box,Written_something : Boolean; X XProcedure Max_Or_Min(X,Y:Integer); X XBegin XIf X > Max_X Then`20 X Max_X := X Xelse X If X < Min_X Then`20 X Min_X := X; XIf Y > Max_Y Then`20 X Max_Y := Y Xelse X If Y < Min_Y Then`20 X Min_Y := Y; Xend; X X XBegin X Sudo_X := Snake_Head_X; X Sudo_Y := Snake_Head_Y; X While Not ( Screen`5BSudo_X,Sudo_Y`5D.Wall In `5BCreated,Inside`5D) Do`20 X Sudo_X := Sudo_X - 1; X If Screen`5BSudo_X,Sudo_Y`5D.Wall = Created Then Begin X LSudo_X := Sudo_X; X LSudo_Y := Sudo_Y; X Case Screen`5BSudo_X,Sudo_Y`5D.Sym Of`20 X 'm' , `20 X 'v' , X 'q' : Sudo_Y := Sudo_Y + 1; X 'j' : Sudo_X := Sudo_X - 1; X End `7B CAse `7D; X While Screen`5BSudo_X,Sudo_Y`5D.Wall = Created Do Begin X Move_Clockwise(Sudo_X,Sudo_Y,LSudo_X,LSudo_Y); X end; X end Else begin X LSudo_X := Sudo_X; X LSudo_Y := Sudo_Y; X Case Screen`5BSudo_X,Sudo_Y`5D.Sym Of`20 X 'm' , X 'v' , X 'q' : Sudo_Y := Sudo_Y + 1; X 'j' : Sudo_X := Sudo_X - 1; X End `7B CAse `7D; X end; X While Screen`5BSudo_X,Sudo_Y`5D.Wall <> Created Do Begin X Move_Clockwise(Sudo_X,Sudo_Y,LSudo_X,LSudo_Y); X end; X Sleep(0,2500000); X X X If ( Sudo_X = Start_Creat_X ) And ( Sudo_Y = Start_Creat_Y ) Then`20 X Dir_You := Clockwise X Else X Dir_You := AntiClockwise; X X Move_Opp_Clockwise(Sudo_X,Sudo_Y,LSudo_X,LSudo_Y); X X Min_X := 9999; X Min_Y := 9999; X Max_X := -9999; X Max_Y := -9999; X While Screen`5BSudo_X,Sudo_Y`5D.Wall <> Created Do Begin X Screen`5BSudo_X,Sudo_Y`5D.Wall := Tmp; X If Screen`5BSudo_X,Sudo_Y`5D.Sym = 'k' Then`20 X IF ( LSudo_X = Sudo_X + 1) Then`20 X Screen`5BSudo_X,Sudo_Y`5D.wall := TmpN X else X else X If Screen`5BSudo_X,Sudo_Y`5D.Sym = 'j' Then X If (LSudo_Y = Sudo_Y - 1) Then`20 X Screen`5BSudo_X,Sudo_Y`5D.Wall := TmpN X`09`09else X else X If Screen`5BSudo_X,Sudo_Y`5D.Sym = 'u' Then`20 X If (Lsudo_X = Sudo_X + 1 ) Then`20 X Screen`5BSudo_X,Sudo_Y`5D.Wall := TmpN; X Move_Clockwise(Sudo_X,Sudo_Y,LSudo_X,LSudo_Y); X Max_Or_Min(Sudo_X,Sudo_Y); X end; X Sleep(0,2500000); X While ( Screen`5BSudo_X,Sudo_Y`5D.Wall = Created ) Do Begin X Screen`5BSudo_X,Sudo_Y`5D.Wall := TmpCreat; X If Screen`5BSudo_X,Sudo_Y`5D.Sym = 'k' Then`20 X IF ( LSudo_X= Sudo_X + 1) Then`20 X Screen`5BSudo_X,Sudo_Y`5D.wall := TmpN2 X else X else X If Screen`5BSudo_X,Sudo_Y`5D.Sym = 'j' Then X If (LSudo_Y = Sudo_Y - 1) Then`20 X Screen`5BSudo_X,Sudo_Y`5D.Wall := TmpN2 X`09`09else X else X If Screen`5BSudo_X,Sudo_Y`5D.Sym = 'u' Then`20 X If (Lsudo_X = Sudo_X + 1 ) Then`20 X Screen`5BSudo_X,Sudo_Y`5D.Wall := TmpN2; X Max_Or_Min(Sudo_X,Sudo_Y); X Move_Clockwise(Sudo_X,Sudo_Y,LSudo_X,LSudo_Y); X end; X Sleep(0,2500000); X Break_Buff; X Writeln(esc,'<',Esc,'`5B7m',esc,'`5B?2l',esc,'F',Esc,'H'); X For X := Min_X To Max_X Do Begin X Inside_box := False; X For Y := Min_Y To Max_Y Do begin X If Not ( Screen`5BX,Y`5D.Wall IN `5BInside,Outside,Snake,Other`5D V) Then Begin X If Screen`5BX,Y`5D.Sym In `5B'x','t'`5D Then`20 X If Inside_Box Then Begin X Written_something := False; X Inside_box := False X End else X Inside_Box := True X else X If Screen`5BX,y`5D.Sym in `5B'k','j','u'`5D Then Begin X If Not ( Screen`5BX,Y`5D.Wall In `5BTmpN,TmpN2`5D ) Then b Vegin X Written_Something := False; X Inside_Box := False X end else X Inside_Box := True; X end else begin X If Written_Something Then begin X Written_Something := False; X Inside_Box := False X end Else X Inside_box := True; X end; X end Else Begin X If INside_Box and ( Screen`5BX,y`5D.wall = Other ) Then Begin X Amt_Filled_In := Amt_Filled_In + 1; X If Not Written_Something Then Begin X Pos(X,Y,Blank); X Written_Something := True; X end Else X Write_Buff(Blank); X Screen`5BX,Y`5D.Wall := Outside; X end Else Begin X Inside_Box := False; X Written_something := False X end; X end; X End; X end;`20 X Break_Buff; X Writeln(esc,'<',esc,'`5B0m',esc,'`5B?2l',Esc,'F',Esc,'H'); X While Screen`5BSudo_X,Sudo_Y`5D.Wall in `5BTmp,TmpN`5D Do Begin X Screen`5BSudo_X,Sudo_Y`5D.Wall := Outside; X Max_Or_Min(Sudo_X,Sudo_Y); X Move_Clockwise(Sudo_X,Sudo_Y,LSudo_X,LSudo_Y); X end; X Amt_Filled_In := Amt_Filled_In - 2; X While Screen`5BSudo_X,Sudo_Y`5D.Wall in `5BTmpCreat,Created,TmpN2`5D Do B Vegin X Amt_Filled_In := Amt_Filled_In + 1; X Screen`5BSudo_X,Sudo_Y`5D.Wall := INside; X Max_Or_Min(Sudo_X,Sudo_Y); X Move_Clockwise(Sudo_X,Sudo_Y,LSudo_X,LSudo_Y); X end; X If ( Not Marked_Clock_Greeb ) or`20 X ( Num_Marked_Clock_Greeb > 0 ) Then Begin `7B > 0 If Marked When Ins Vide `7D X Marked_Clock_Greeb := True; X Marked_Clock_Greeb_X := Last_Clock_Greeb_X; X Marked_Clock_Greeb_Y := Last_Clock_Greeb_Y; X Num_Marked_Clock_Greeb := 0; X end; X If ( Not Marked_Anti_Greeb ) or`20 X ( Num_Marked_Anti_Greeb > 0 ) Then Begin X Marked_Anti_Greeb := True; X Marked_Anti_Greeb_X := Last_Anti_Greeb_X; X Marked_Anti_Greeb_Y := Last_Anti_Greeb_Y; X Num_Marked_Anti_Greeb := 0; X end; Xend; X `20 X X `20 XFunction Valid_MOve:Boolean; X +-+-+-+-+-+-+-+- END OF PART 3 +-+-+-+-+-+-+-+- -+-+-+-+-+-+-+-+ START OF PART 4 -+-+-+-+-+-+-+-+ XFunction VAlid_MOve_Clockwise(X,Y,LX,LY,NX,NY:Integer):Boolean; X XBegin XMove_Clockwise(X,Y,LX,LY); XIf ( X = NX ) And ( Y = NY ) Then`20 X Valid_MOve_Clockwise := True XElse X Valid_Move_Clockwise := False; Xend; X XFunction VAlid_MOve_Anti_Clockwise(X,Y,LX,LY,NX,NY:Integer):Boolean; X XBegin XMove_Anti_Clockwise(X,Y,LX,LY); XIf ( X = NX ) And ( Y = NY ) Then`20 X Valid_MOve_Anti_Clockwise := True XElse X Valid_Move_Anti_Clockwise := False; Xend; X X XBegin XIf ( You_X = Last_You_X ) And ( You_Y = Last_You_Y ) Then Begin X ValiD_Move := True; X If Dir_You = Clockwise Then`20 X Dir_You := AntiClockwise X Else X Dir_You := Clockwise; Xend Else begin X If Dir_You = Clockwise Then begin X If Valid_MOve_Clockwise(X,Y,Last_You_X,Last_You_Y,You_X,You_Y) Then`20 X Valid_Move := True X Else X Valid_Move := False; X End Else BEgin X If Valid_Move_Anti_Clockwise(X,Y,Last_You_X,Last_You_Y,You_X,You_Y) Th Ven`20 X Valid_Move := True X Else X Valid_Move := False; X end; Xend; X X`7B Case (Goto_X - x ) Of`20 X 1 : If Screen`5BX,Y`5D.Sym in `5B'l','w','k','t','n','u','x'`5D Then`2 V0 X Valid_Move := True X Else X Valid_Move := False; X -1 : If Screen`5BX,y`5D.Sym in `5B't','n','u','m','v','j','x'`5D Then` V20 X Valid_Move := True X Else X Valid_Move := False; X 0 : Case (Goto_Y - Y ) Of`20 X 1 : If Screen`5BX,y`5D.Sym In `5B'l','w','t','n','m','v','q'`5D V Then`20 X Valid_Move := True X Else X Valid_Move := False; X -1: If Screen`5BX,y`5D.Sym In `5B'w','k','n','u','v','j','q'`5D V Then`20 X Valid_Move := True X Else X Valid_Move := False; X 0 : Valid_Move := False; X end; X end;`7D X end; X XBegin XSave_ch := Screen`5BSnake_Tail_X,Snake_Tail_Y`5D.Sym; XIf Len_Snake > 2 Then`20 X Screen`5BSnake_Tail_X,Snake_Tail_Y`5D.Sym := '%'; XX := You_X; XY := You_Y; XYou_X := You_X + Move_X; XYou_Y := You_Y + Move_Y; XCase Screen`5BYou_X ,You_Y`5D.Wall Of`20 X Other : Begin X If Can_Create_Wall Then Begin X If Not Creating_wall Then begin X Moves_since_stuck := 999; X Snake_After_X := 9999; X Snake_After_Y := 9999; X Start_Creat_X := X; X Start_Creat_Y := Y; X Last_Start_Creat_X := Last_You_X; X Last_Start_Creat_Y := Last_You_Y; X Dir_When_Start_Creat := Dir_You; X end; X `09 Screen`5BX,y`5D.Sym := Correct_Sym(X,Y,You_X,You_Y); X `09 Screen`5BX,Y`5D.wall := Created; X Creating_wall := True; X Last_You_X := X; X Last_You_Y := Y; X end else begin X You_X := X; X You_Y := Y; X end; X end; X Snake : Begin X If ( Can_Create_wall ) Then Begin X Died := True; X If Not Creating_wall Then begin X Snake_After_X := 9999; X Snake_After_Y := 9999; X Start_Creat_X := X; X Start_Creat_Y := Y; X Last_Start_Creat_X := Last_You_X; X Last_Start_Creat_Y := Last_You_Y; X Dir_When_Start_Creat := Dir_You; X end; X `09 Screen`5BX,y`5D.Sym := Correct_Sym(X,Y,You_X,You_Y); X `09 Screen`5BX,Y`5D.wall := Created; X Creating_wall := True; X Last_You_X := X; X Last_You_Y := Y; X end else begin`20 X You_X := X; X You_Y := Y; X end; X end; X Inside : Begin X If Creating_wall Then begin X `7B Have Created A Box `7D X Creating_wall := False; X Can_Create_wall := False; X Screen`5BX,Y`5D.Sym := Correct_Sym(X,Y,You_X,You_Y); X Screen`5BX,Y`5D.Wall := Created; X Pos(X,Y,Screen`5BX,Y`5D.Sym); X Pos(You_X,You_Y,You); X Screen`5BYou_X,You_Y`5D.Sym := Correct_Sym(You_X,You_Y,You V_X,You_Y); X Screen`5BYou_X,You_Y`5D.Wall := Created; X`09`09 Break_Buff; X Cal_Inside; X If Moving_Extra_Greebly Then`20 X Pos(Extra_Greeb_X,Extra_Greeb_Y,Screen`5BExtra_Greeb_X,E Vxtra_Greeb_Y`5D.sym); X Moving_Extra_Greebly := False; X If Amt_Filled_In > 1228 Then Begin X Score := Score + Amt_Filled_In + ( Amt_Filled_In - 1228 V); X Break_Buff; X Write(Esc,'Y',Chr(55),CHr(40),(Amt_Filled_In * 100 / 16 V38 ):5:2); X Writeln(Esc,'Y',Chr(55),Chr(53),(Score):5,Esc,'H'); X`09`09 Sleep(3,0); X Initalise_Screen; X end else begin X Break_Buff; X Write(Esc,'Y',Chr(55),CHr(40),(Amt_Filled_In * 100 / 163 V8 ):5:2); X Writeln(Esc,'Y',Chr(55),Chr(53),(Score+Amt_Filled_In):5, VEsc,'H'); X Last_You_X := X; X Last_You_Y := Y; X end; X end else`20 X If Not VAlid_Move Then begin X You_X := X; X You_Y := Y; X end Else begin X Last_You_X := X; X Last_You_Y := Y; X end; X `20 X END; X Created : Begin X If Not Moving_Extra_Greebly Then Begin X Moving_Extra_Greebly := True; X Extra_Greeb_X := Start_Creat_X; X Extra_Greeb_Y := Start_Creat_Y; X Last_Extra_Greeb_X := Last_Start_Creat_X; X Last_Extra_Greeb_Y := Last_Start_Creat_Y; X Pos(Extra_Greeb_X,Extra_Greeb_Y,'*'); X end; X You_X := X; X You_Y := Y; X end; X OutSide : Begin X You_X := X; X You_Y := Y; X end; Xend `7B Case `7D; X XIf ((You_X=Snake_Head_X) and (You_Y=Snake_Head_Y)) or`20 X ((You_X=Clock_Greeb_X) and (You_Y=Clock_Greeb_Y)) or`20 X ((You_X=Anti_Greeb_X) and (You_Y=Anti_Greeb_Y)) Then`20 X Died := True; XIf Len_Snake > 2 Then`20 X Screen`5BSnake_Tail_X,Snake_Tail_Y`5D.Sym := Save_ch; XPos(X,Y,Screen`5BX,Y`5D.Sym); `20 XPos(You_X,You_Y,You); Xend; X XProcedure Get_move; X Xvar ch : char; X XBegin X CAse TT_1_Char_Now Of`20 X`7B' '`7D 32 : Can_Create_Wall := True; X`7B'4'`7D 52 : Begin X Move_X := 0; X Move_Y := -1; X end; X`7B'6'`7D 54 : Begin X Move_X := 0; X Move_Y := 1; X end; X`7B'8'`7D 56 : begin X Move_Y :=0; X Move_X :=-1; X end; X`7B'2'`7D 50 : Begin X Move_Y := 0; X Move_X := 1; X end; X`7B'e','E'`7D 101,69 : Goto 9999; X Otherwise `7B Noyhing `7D X end; Xend; X `20 X XProcedure Have_Died; X XVar Dummy,LSudo_X,LSudo_Y,Sudo_X,Sudo_Y : Integer; X Save_Sym : Char; X XBegin XBreak_Buff; XDied := False; XLives := Lives - 1; XIf Lives > 0 Then Begin X If Creating_wall Then Begin X If Moving_Extra_Greebly Then`20 X Pos(Extra_Greeb_X,Extra_Greeb_Y,Screen`5BExtra_Greeb_X,Extra_Greeb_ VY`5D.Sym); X Moving_Extra_Greebly := False; X Save_sym := Screen`5BSnake_Tail_X,Snake_Tail_Y`5D.Sym; X Sudo_X := Last_You_X; X Sudo_Y := Last_You_Y; X LSudo_X := You_X; X LSudo_Y := You_Y; X Pos(LSudo_X,LSudo_Y,Screen`5BYou_X,You_Y`5D.Sym); X Move_Clockwise(Sudo_X,Sudo_Y,Lsudo_X,LSudo_Y); X While Screen`5BSudo_X,Sudo_Y`5D.Wall <> Inside do begin X Pos(LSudo_X,LSudo_Y,Blank); X Screen`5BLSudo_X,LSudo_Y`5D.Sym := Blank; X Screen`5BLSudo_X,LSudo_Y`5D.Wall := Other; X Move_Clockwise(Sudo_X,Sudo_Y,Lsudo_X,LSudo_Y); X end; X Creating_wall := False; X If ( Snake_Head_X <> Snake_Tail_X ) or ( Snake_Head_Y <> Snake_Tail_Y V ) Then`20 X Screen`5BSnake_Tail_X,Snake_Tail_Y`5D.Sym := '%'; X Screen`5BLSudo_X,LSudo_Y`5D.Sym := Correct_sym(LSudo_X,LSudo_Y,LSudo_X V,LSudo_Y); X If ( Snake_Head_X <> Snake_Tail_X ) or ( Snake_Head_Y <> Snake_Tail_Y V ) Then`20 X Screen`5BSnake_Tail_X,Snake_Tail_Y`5D.Sym := Save_sym; X Screen`5BLSudo_X,LSudo_Y`5D.Wall := Inside; X Pos(LSudo_X,LSudo_Y,Screen`5BLSudo_X,LSudo_Y`5D.Sym); X You_X := Start_Creat_X; X You_Y := Start_Creat_Y; X Last_You_X := Last_Start_Creat_X; X Last_You_Y := Last_Start_Creat_Y; X Dir_You := Dir_When_Start_Creat; X end; X Write_Buff(chr(7)); X Pos(Snake_Head_X,Snake_Head_Y,Qix_Head); X Pos(You_X,You_Y,You); X Pos(Clock_Greeb_X,Clock_Greeb_Y,Screen`5BClock_Greeb_X,Clock_Greeb_Y`5D.S Vym); X Pos(Anti_Greeb_X,Anti_Greeb_Y,Screen`5BAnti_Greeb_X,Anti_Greeb_Y`5D.Sym); X Break_Buff; X Write(Esc,'Y',chr(31+24),chr(31+34),Esc,'K'); X For Dummy := 1 to Lives Do`20 X Write(' O'); X Writeln(Esc,'H'); X Can_Create_wall := False; X For Dummy := 1 to 4 do`20 X Move_Greeblys; Xend; `20 Xend; X XBegin X Initalise; X Break_Buff; X Repeat X Sleep_Start; X Get_move; X Move_You; X If Not Died Then Begin X Move_snake; X Move_Greeblys;`20 X If ( Rand(Level) >= 4 ) and ( Not Died )Then Begin X Move_Greeblys; X If ( rand(Level) >= 5 ) and ( Not Died ) Then Begin X Move_Snake; X If ( rand(Level) >= 6 ) and ( Not Died ) Then Begin X Move_Greeblys; X If ( rand(Level) >= 7 ) and ( Not Died ) Then Begin X Move_snake; X If ( rand(Level) >= 8 ) and ( Not Died ) Then Begin X Move_Greeblys; X If ( rand(Level) >= 9 ) and ( Not Died ) Then Begin X Move_Snake; X end; X end; X end; X end; X end; X end; X end; X Break_Buff; X Sleep_wait; X If Died Then`20 X Have_Died; X until Lives <= 0; X `20 X 9999: `7B This Goto Was Not My Idea only Used For Abortive Exit `7D X Break_Buff; X writeln(Esc,'G',Esc,'H',Esc,'J',Esc,'<'); X Score := Score + Amt_Filled_In; X TT_Cancel; X TopTen(Score); Xend. $ CALL UNPACK QIX.PAS;1 606979058 $ create 'f' X`1B`5BH`1B`5BJ`1B(B`1B`5B0m X`1B`5B1;1H`1B(0lqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqq Vqqqqqqqqqqqqqqqqqqk X`1B`5B2;1Hx`1B`5B2;80Hx`1B`5B3;1Hx Y`1B(Bou - O`1B`5B3;32H`1B(0lqq Vk qwq qk l`1B(B- Qix `1B(0q `60qqqqqq X`1B`5B3;67Hk lqqqqq x`1B`5B4;1Hx`1B`5B4;31Hlj x x mwj`1B`5B4;64Hlq Vqj x`1B`5B4;80Hx`1B`5B5;1Hx F`1B(Buse X`1B`5B5;12H - *`1B`5B5;31H`1B(0x kx x lvk`1B`5B5;64Hmqqqqj`1B`5B5; V80Hx`1B`5B6;1Hx`1B`5B6;31Hmqqvvk qvq qj mq`1B`5B6;80H X`1B`5B6;80Hx`1B`5B7;1Hx`1B`5B7;36Hm`1B`5B7;80Hx`1B`5B8;1Hx F`1B(Bence Off V The Screen Trying To Avoid The Hazzards X`1B`5B8;54H.`1B`5B8;80H`1B(0x`1B`5B9;1Hx`1B`5B9;80Hx`1B`5B10;1Hx H`1B(Bazz Vards : Qix - Kills If Touches The Line X`1B`5B10;51H You Are Drawing`1B`5B10;80H`1B(0x`1B`5B11;1Hx`1B`5B11;18HF`1B(B Vuse - Traverses The Outside Killing On Con X`1B`5B11;62Htact`1B`5B11;80H`1B(0x`1B`5B12;1Hx`1B`5B12;80Hx`1B`5B13;1Hx`1B`5 VB13;80Hx`1B`5B14;1Hx M`1B(Bovement : 8 - Up`1B`5B14;43H X`1B`5B14;43HNew Screen `1B(0`60 O`1B(Bnce 75% Fenced Off `1B(0x`1B`5B15; V1Hx`1B`5B15;80Hx`1B`5B16;1Hx`1B`5B16;13H4 `1B(B- Lef X`1B`5B16;20Ht 6 - Right`1B`5B16;43HHigher Scoring For Areas`1B`5B16;80H`1 VB(0x`1B`5B17;1Hx`1B`5B17;80Hx X`1B`5B18;1Hx`1B`5B18;20H2 `1B(B- Down`1B`5B18;46HGreater Than 75%.`1B`5B18;8 V0H`1B(0x`1B`5B19;1Hx`1B`5B19;80Hx X`1B`5B20;1Hx D`1B(Braw Fence : < Space Bar >`1B`5B20;43H`1B`5B7m Hit < R Veturn > To Play `1B`5B0m E : Exit `1B(0x X`1B`5B21;1Hx`1B`5B21;80Hx`1B`5B22;1Hx`1B`5B22;80Hx`1B`5B23;1Hmqqqqqqqqqqqqqq Vqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqq`1B`5B1;1H X`1B`5B23;57Hqqqqqqqqqqqqqqqqqqqqqqqj`1B`5B1;1H X`1B* $ CALL UNPACK QIX.SCN;1 824521603 $ create 'f' X V V Qix Qix Qix V Qix Qix Qix V Qix Qix Qix V V V V V V V V V V V V V V V V V V V +-+-+-+-+-+-+-+- END OF PART 4 +-+-+-+-+-+-+-+- -+-+-+-+-+-+-+-+ START OF PART 5 -+-+-+-+-+-+-+-+ V V V V $ CALL UNPACK QIX.TOP;1 3257187579 $ create 'f' XC X`09SUBROUTINE`09TOPTEN(ISCORE) XC X`09PARAMETER ESC = 27 X`09PARAMETER MAX_SCORE = 11`09!MAX NUMBER SCORES HELD + 1 X`09INTEGER`09ISCORE,ISCO,IHISCR,ISCOAT,ErrNum X`09LOGICAL*1 CHAMP(30),PLayer(20) X`09INTEGER`09NUM_Games,SCORES(MAX_SCORE),SORT,ASCTIM_DESCR(2) X Real*8 Date_Quad(Max_Score),Now_Time X`09LOGICAL*1 NAMES(20,MAX_SCORE),TEMP(20),ASCTIM(17) XC X Write(5,111)esc X111 Format(X,A1,'<') X`09AscTim_descr(2) = %LOC(ASCTIM(1)) X`09AscTim_Descr(1) = 17 ! Lenght`20 X1`09OPEN(UNIT=4,FILE='GAMES:QIX.TOP',FORM='UNFORMATTED', X`091 RECORDTYPE='FIXED',STATUS='OLD',RECL=512,IoStat=ErrNum) X If (ERRNUM.EQ.30) Goto 50 X If (ERRNUM.NE.0 ) Goto 999 XC`09GET TOP TEN SCORES XC X`09READ`09(4) Num_Games,SCORES,Date_Quad,NAMES X Num_Games = Num_Games + 1 X`09IHISCR = SCORES(1) XC`09Copy Over Score Player Got`20 X`09SCORES(MAX_SCORE)=ISCORE X`09Call sys$GETTIM(NOw_Time) X`09DATe_Quad(MAx_Score) = Now_Time XC`09Copy Over His Name`20 X`09DO 2 J=1,20 X `09 NAMES(J,MAX_SCORE)= ' ' X2`09CONTINUE X3`09SORT=0 X`09DO 5 I=1,MAX_SCORE-1 X`09IF (SCORES(I).GE.SCORES(I+1)) GO TO 5 X`09SORT=SCORES(I) X`09SCORES(I)=SCORES(I+1) X`09SCORES(I+1)=SORT X`09NOW_Time = Date_Quad(I) X Date_Quad(I) = Date_Quad(I + 1) X Date_Quad(I+1) = Now_Time X`09SORT=1 X`09DO 4 J=1,20 X`09TEMP(J)=NAMES(J,I) X`09NAMES(J,I)=NAMES(J,I+1) X`09NAMES(J,I+1)=TEMP(J) X4`09CONTINUE X5`09CONTINUE X`09IF (SORT.NE.0) GO TO 3 XC XC X WRITE (5,409),ESC,ESC X ISCO=ISCORE X`09IF`09(ISCORE.GT.IHISCR) GO TO 10`09!Who is champ. X`09ISCORE=ISCORE/200 X`09IF`09(ISCORE.EQ.0) WRITE (5,410) X`09IF`09(ISCORE.EQ.1) WRITE (5,411) X`09IF`09(ISCORE.EQ.2) WRITE (5,412) X`09IF`09(ISCORE.EQ.3) WRITE (5,413) X`09IF`09(ISCORE.EQ.4) WRITE (5,414) X`09IF`09(ISCORE.EQ.5) WRITE (5,415) X`09IF`09(ISCORE.EQ.6) WRITE (5,416) X`09IF`09(ISCORE.EQ.7) WRITE (5,417) X`09IF`09(ISCORE.EQ.8) WRITE (5,418) X`09IF`09(ISCORE.EQ.9) WRITE (5,419) X`09IF`09(ISCORE.EQ.10) WRITE (5,420) X`09IF`09(ISCORE.EQ.11) WRITE (5,421) X`09IF`09(ISCORE.EQ.12) WRITE (5,422) X`09IF`09(ISCORE.EQ.13) WRITE (5,423) X`09IF`09(ISCORE.EQ.14) WRITE (5,424) X`09IF`09(ISCORE.EQ.15) WRITE (5,425) X`09IF`09(ISCORE.EQ.16) WRITE (5,426) X`09IF`09(ISCORE.EQ.17) WRITE (5,427) X`09IF`09(ISCORE.EQ.18) WRITE (5,428) X`09IF`09(ISCORE.EQ.19) WRITE (5,429) X`09IF`09(ISCORE.EQ.20) WRITE (5,430) X`09IF`09(ISCORE.EQ.21) WRITE (5,431) X`09IF`09(ISCORE.EQ.22) WRITE (5,432) X`09IF`09(ISCORE.EQ.23) WRITE (5,433) X`09IF`09(ISCORE.EQ.24) WRITE (5,434) X`09IF`09(ISCORE.EQ.25) WRITE (5,435) X`09IF`09(ISCORE.EQ.26) WRITE (5,436) X`09IF`09(ISCORE.EQ.27) WRITE (5,437) X`09IF`09(ISCORE.EQ.28) WRITE (5,438) X`09IF`09(ISCORE.EQ.29) WRITE (5,439) X`09If (ISCORE.GE.30) WRITE (5,440) XC X`09GO TO 20 X10`09WRITE`09(5,500) X20`09WRITE`09(5,250) Num_Games XC X21`09CONTINUE X ISCOAT = 0 X `09DO 28 I=1,10,1 X`09 If (ISCO.EQ.SCORES(I)) ISCOAT = I X If (Scores(i) .GT. 0 ) Then`20 X`09`09Call sys$Asctim(,asctim_Descr,Date_Quad(I),%Val(0)) X `09`09WRITE`09(5,300)I,(NAMES(J,I),J=1,20),SCORES(I),ASCTIM X`09 end If`20 X28`09Continue X`09Write(5,29),ISCO X29`09Format(X,/,' Your Score ',I6) X IF (ISCOAT.EQ.0.OR.SCORES(11).EQ.ISCO) GOTO 49 X Write(5,30)esc,ISCOAT+10,ESC,ISCOAT+10,ESC,ISCOat+10 X30`09Format('$',A1,'`5B',I2,';1H=>', `20 X`091 A1,'`5B',I2,';59H<= Enter Name', X`092 A1,'`5B',I2,';8H') X Accept 31,ILen,PLayer X31`09Format(Q,20A1) X`09DO 32 J=1,20 X If ((PLAYER(J).LT.65).OR. X`091 (PLAYER(J).GT.90.And.PLAYER(J).LT.97).Or. X`092 (PLAYER(J).Gt.122)) PLAYER(J) = ' ' X `09 NAMES(J,ISCOAT)=PLAYER(J) X32`09CONTINUE X49`09REWIND(4) X`09WRITE(4) ,Num_Games,SCORES,Date_Quad,NAMES X`09close (unit = 4) X Write(5,36),esc X36`09Format(X,A1,'`5B23;1H') X999`09Continue X`09RETURN X50`09Write(5,51),Esc,Esc X51 FORMAT(X,A1,'`5B2J',A1,'`5B1;1HPlease Wait ...') X Call Sleep(4) X Goto 1 XC X100`09FORMAT`09(I6) X200`09FORMAT`09(20A1) X201`09format (A) X250`09FORMAT`09(///20X,' QIX Super League ',I13,' Games',/, X + 20X,' ================ ',//, X + 8X,'Player',19x,'Score',6X,'Date',4X,'Time',/) X300`09FORMAT`09(1X,I5,2X,20A1,4X,I6,2X,17A1) X409`09FORMAT (X,A,'`5B2J',A,'`5B1;1H') `09`09! CLEAR AND HOME`20 X410`09FORMAT`09(20X'** What Utter Crap ***')`09`09!0-199 X411`09FORMAT`09(20X'** I don''t believe it **')`09`09!200-399 X412`09FORMAT`09(20X'** Rubbish !! **')`09`09!400-599 X413`09FORMAT`09(20X'** What can I say **')`09`09!600-799 X414`09FORMAT`09(20X'** Four figures one day **')`09!800-999 X415`09FORMAT`09(20X'** Past the magic thousand **')`09!1000-1199 X416`09FORMAT`09(20X'** Must try harder **')`09`09!1200-1399 X417`09FORMAT`09(20X'** Well I suppose you''re trying **') !1400-1599 X418`09FORMAT`09(20X'** Come on **')`09`09`09!1600-1799 X419`09FORMAT`09(20X'** Almost there **')`09`09!1800-1999 X420`09FORMAT`09(20X'** WOW! over 2000 **')`09`09!2000-2199 X421`09FORMAT`09(20X'** Are you a novice? **')`09`09!2200-2399 X422`09FORMAT`09(20X'** Getting Better **')`09`09!2400-2599 X423`09FORMAT`09(20X'** Keep on trying **')`09`09!2600-2799 X424`09FORMAT`09(20X'** 3000 One of these days **')`09!2800-2999 X425`09FORMAT`09(20X'** Practice makes perfect **')`09!3000-3199 X426`09FORMAT`09(20X'** OK Now impress me **')`09`09!3200-3399 X427`09FORMAT`09(20X'** You''ve played before **')`09!3400-3599 X428`09FORMAT`09(20X'** I''ve seen worse **')`09`09!3600-3799 X429`09FORMAT`09(20X'** Keep it up **')`09`09`09!3800-3999 X430`09FORMAT`09(20X'** Hurrah! 4000 bust **')`09`09!4000-4199 X431`09FORMAT`09(20X'** Not Bad **')`09`09`09!4200-4399 X432`09FORMAT`09(20X'** Not bad at all **')`09`09!4400-4599 X433`09FORMAT`09(20X'** Pretty fair **')`09`09!4600-4799 X434`09FORMAT`09(20X'** Oh, So close **')`09`09!4800-4999 X435`09FORMAT`09(20X'** I''m almost impressed **')`09!5000-5199 X436`09FORMAT`09(20X'** Pretty Good **')`09`09!5200-5399 X437`09FORMAT`09(20X'** OK I like it **')`09`09!5400-5599 X438`09FORMAT`09(20X'** You''ve got style **')`09`09!5600-5799 X439`09FORMAT`09(20X'** Come on, you can do it **')`09!5800-5900 X440`09FORMAT`09(20X'** OK that wasn''t bad **')`09!6000 et seq X500`09FORMAT`09(20X'** Congatulations Champ !! **') X END $ CALL UNPACK QIXF.FOR;1 1432862011 $ create 'f' X`09SUBROUTINE`09HELP_SCREEN( FILE_NAME ) X`09CHARACTER*(*) FILE_NAME XC X`09PARAMETER ESC = 27 X`09CHARACTER Line*256 X`09BYTE LINEL(256),Ch X`09EQUIVALENCE (LINE, LINEL) X BYte REP X`09INTEGER Len_Line,ErrNum XC X Write(5,111)esc X111 Format(X,A1,'<') X1`09OPEN( UNIT=4, FILE=FILE_NAME, ReadOnly, X`091 STATUS='OLD',IoStat=ErrNum) X If (ERRNUM.EQ.30) Goto 50 X If (ERRNUM.NE.0 ) Goto 999 X100 READ(4,110,END=200) LEN_LINE, LINE(:LEN_LINE) X110 FORMAT(Q,A) XC Write(6,120) LINE(:LEN_LINE) XC120 FORMAT(1X,A) X`09CALL TT_WRITE( LINEL, LEN_LINE ) X GOTO 100 X200`09close (unit = 4) X999`09Write(5,220),Esc X220 Format(1X,A1,'`5B1;1H') X Accept 210, ch X210 Format(A1) X RETURN XC X50`09Write(5,51),Esc,Esc X51 FORMAT(X,A1,'`5B2J',A1,'`5B1;1HPlease wait...') X Call Sleep(4) X Goto 1 XC X END $ CALL UNPACK QIXH.FOR;1 1812387409 $ create 'f' XC XC X`09PARAMETER MAX_SCORE = 11`09!MAX NUMBER SCORES HELD + 1 X`09INTEGER`09ISCORE,ISCO,IHISCR,NUm_Games X`09LOGICAL*1 CHAMP(20),PLAYER(20) X`09INTEGER`09SCORES(MAX_SCORE),SORT X`09Real*8 Date_Quad(Max_Score) X`09LOGICAL*1 NAMES(20,MAX_SCORE),TEMP(20) XC X`09OPEN(UNIT=4,FILE='Qix.Top',FORM='UNFORMATTED', X`091 RECORDTYPE='FIXED',STATUS='NEW',RECL=512) XC XC`09GET TOP TEN SCORES XC X`09DO 5 I=1,MAX_SCORE-1 X Num_Games = 0 X SCORES(I) = (MAX_SCORE-I)*500 X DATE_QUAD(I) = 0 X`09NAMES(1, I) = 'Q' X`09NAMES(2, I) = 'i' X`09NAMES(3, I) = 'x' X`09DO 4 J=4,20 X`09NAMES(J, I) = ' ' X4`09CONTINUE X5`09CONTINUE X`09WRITE(4) Num_Games,SCORES,DATE_QUAD,NAMES X STOP X END $ CALL UNPACK QIXTOPINI.FOR;1 1465607682 $ create 'f' X`09.title`09SLEEP - delay for specified interval X`09$ssdef`09`09`09; want ss$_insfarg X`09.psect`09$code`09pic, shr, rd, nowrt, exe X`09.entry`09- Xsleep, `5Em X; Subroutine Sleep(Seconds, Fraction) X; Integer*4 Seconds, Fraction X`09seconds = 4`09`09; param offset X`09fraction = 8`09`09; optional fraction, in 100 ns units X`09sleep_efn = 0`09`09; which event flag to use X`09cmpb`09(ap), #1`09; how many args? X`09beqlu`092100$ X`09bgtru`092200$ X`09movl`09#ss$_insfarg, r0 ; none - error X`09brb`099000$ X2100$:`09clrl`09r1`09`09; one arg, so fraction part is zero X`09brb`092900$ X2200$:`09mnegl`09@fraction(ap), r1 ; else get fraction part X2900$:`09mnegl`09@seconds(ap), r0 ; make negative X`09emul`09#10000000, r0, r1, r2`09; convert to proper units in r2, r3 X`09movq`09r2, -(sp)`09; push time onto stack X`09movaq`09(sp), r2`09; remember address X`09$setimr_s-`09`09; set timer X`09`09efn=#sleep_efn,- X`09`09daytim=(r2)`09; address of time value X`09blbc`09r0, 9000$ X`09$waitfr_s-`09`09; wait for timer X`09`09efn=#sleep_efn X9000$:`09ret`09`09`09; done X X`09.end $ CALL UNPACK SLEEP.MAR;1 1182597876 $ create 'f' X************ XFile CCC_:`5BREX.UTIL`5DTTIO.MAR;46 X 210 `09$dvidef X 211 `09$iodef`09`09; qio io$_... X****** XFile CCC_:`5BREX.UTIL`5DTTIO.MAR;43 X 210 `09$dibdef X 211 `09$iodef`09`09; qio io$_... X************ X************ XFile CCC_:`5BREX.UTIL`5DTTIO.MAR;46 X 231 mbxitmlst: X 232 `09.word`09mbxname_len, dvi$_devnam X 233 `09.address mbxname X 234 `09.address mbxiosb`09`09; return length, don't want X 235 `09.long`090`09`09`09; end of list X 236 `20 X****** XFile CCC_:`5BREX.UTIL`5DTTIO.MAR;43 X 231 dibbuf_descr: X 232 `09.word`09dib$k_length, 0 X 233 `09.address dibbuf X 234 `20 X************ X************ XFile CCC_:`5BREX.UTIL`5DTTIO.MAR;46 X 241 mbxname_len = 64 X 242 mbxname:`09`09`09; room to hold the physical mbx name X****** XFile CCC_:`5BREX.UTIL`5DTTIO.MAR;43 X 239 mbxname_len = 16 X 240 mbxname:`09`09`09; room to hold the physical mbx name X************ X************ XFile CCC_:`5BREX.UTIL`5DTTIO.MAR;46 X 253 `09.align`09long X****** XFile CCC_:`5BREX.UTIL`5DTTIO.MAR;43 X 251 dibbuf: X 252 `09.blkb`09dib$k_length X 253 `20 X 254 `09.align`09long X************ X************ XFile CCC_:`5BREX.UTIL`5DTTIO.MAR;46 X 359 `20 X 360 ;`09$getchn_s`09chan=mbxchan, pribuf=dibbuf_descr X 361 ;`09bsbw`09`09error X 362 ;`09$fao_s`09`09ctrstr=mbxcnv, outbuf=mbxname_descr,- X 363 ;`09`09`09outlen=mbxname_descr, p1=dibbuf+dib$w_unit X 364 `20 X 365 `09$getdvi_s`09chan=mbxchan, itmlst=mbxitmlst X 366 `09bsbw`09`09error X 367 `09locc`09`09#0, #mbxname_len, mbxname ; find trailing nulls X 368 `09subl3`09`09r0, #mbxname_len, r0 X 369 `09movw`09`09r0, mbxname_descr`09; store length of name X 370 `20 X 371 `09$assign_s`09devnam=ttname_descr, chan=ttchan, acmode=#`5ExFF00,- X****** XFile CCC_:`5BREX.UTIL`5DTTIO.MAR;43 X 360 `09$getchn_s`09chan=mbxchan, pribuf=dibbuf_descr X 361 `09bsbw`09`09error X 362 `09$fao_s`09`09ctrstr=mbxcnv, outbuf=mbxname_descr,- X 363 `09`09`09outlen=mbxname_descr, p1=dibbuf+dib$w_unit X 364 `09$assign_s`09devnam=ttname_descr, chan=ttchan, acmode=#`5ExFF00,- X************ X XNumber of difference sections found: 5 XNumber of difference records found: 22 X XDIFFERENCES /IGNORE=()/MERGED=1/OUTPUT=CCC_:`5BREX.UTIL`5DTTIO.DIFF;1- X CCC_:`5BREX.UTIL`5DTTIO.MAR;46- X CCC_:`5BREX.UTIL`5DTTIO.MAR;43 $ CALL UNPACK TTIO.DIFF;1 1664959250 $ create 'f' X`09.title`09TTIO`09Terminal IO routines ($QIO's) X;+ X;`09Routines to do IO via $QIO's to get special features. X;- X.if ne 0 X1 TTIO XThis is a group of routines to enable you to perform efficient/special Xinput and/or output to a terminal. X2 TT_INIT XCALL TT_INIT( type ) X X"type" is an integer variable which indicates the input you wish. X X"type" = 0 ordinary line input X 1 efficient single character input if available X 2 line input with escape sequences X2 TT_SET_FUNC XSets the read function modifiers and the wait time. Once set, the options Xwill stay in effect until changed. X XINTEGER TT_SET_FUNC X XI = TT_SET_FUNC( value `5B, seconds `5D ) X X"value" is a bit encoded integer specifying options required X Symbol Hex value Description XIO$M_NOFILTR '0200'X Ctrl/U, Ctrl/R or Delete are passed to the user XIO$M_PURGE '0800'X Type-ahead buffer is purged before the read XIO$M_TIMED '0080'X Read must complete within specified time XIO$M_TRMNOECHO '1000'X The terminator character (if any) is not echoed X X"seconds" maximum time a read may take in seconds X"I" is the IO completion status code X2 TT_SET_READF XSets the buffer address and length before calling TT_SET_READF. X XINTEGER FUNCTION TT_SET_READF( buffer, buf_len ) X Xbuffer`09address of buffer or address of descriptor of buffer Xbuf_len length of buffer. If omitted then "buffer" is a descriptor X XValue of function is the I/O status completion code X2 TT_SET_TERM XSet terminator character mask X XCALL TT_SET_TERM( option, parameters... ) X Xoption X 0`09normal terminators (any control char except LF VT FF TAB BS X 1`09parameter 1 is the address of a longword containing the X `09terminator bit mask (first 32 characters only) X `09eg. CALL TT_SET_TERM( 1, '00000001'X ) X `09 enable Control A as terminator X 2`09parameter 1 is address of # of bytes in terminator mask X `09parameter 2 is address of array containing terminator bit mask X 3`09the following parameters are addresses of a byte containing X `09the acsii code of the character to be a terminator. X `09eg. CALL TT_SET_TERM( 3, 10, 13 ) X `09 enable LF and CR to be terminators X2 TT_CTRLCAST X XCALL TT_CTRLCAST( subroutine ) X XThis causes the next control C to call the named routine. X2 TT_1_CHAR XINTEGER TT_1_CHAR X XI = TT_1_CHAR() X X"I" contains the ascii value of the character typed. +-+-+-+-+-+-+-+- END OF PART 5 +-+-+-+-+-+-+-+- -+-+-+-+-+-+-+-+ START OF PART 6 -+-+-+-+-+-+-+-+ XThis routine waits for the character and then returns it. XWhatever options that are set (see TT_SET_OPTION) are applied. (not true) X2 TT_1_CHAR_T XINTEGER TT_1_CHAR_T X XI = TT_1_CHAR_T( seconds ) X XThis routine reads 1 character if typed within "seconds" time. X"I" contains the ascii value of the character typed, X it is 0 if the read timed out. X2 TT_1_CHAR_NOW XINTEGER TT_1_CHAR_NOW X XI = TT_1_CHAR_NOW() X X"I" contains the ascii value of the character typed, or -1 if no Xcharacter is available. The character is not echoed. XThis routine returns immediately. X2 TT_READ XThis routine reads a line from the terminal. X XINTEGER TT_READ XI = TT_READ( buffer, buf_len, data_len `5B, term_len `5D ) X or XI = TT_READ( buf_desc, , data_len `5B, term_len `5D ) X X"buffer" is the address of the input buffer X"buf_len" is the length of the input buffer in bytes X"data_len" will contain the number of characters read X"term_len" (if specified) will contain the length of the terminator X"I" will contain the IO completion status code X X"buf_desc" is the address of a descriptor of the input buffer X X2 TT_READF X XINTEGER FUNCTION TT_READF( data_len ) Xdata_len length of data read (# of characters) (not including term) X XThis routine is used for reading a lot of data (presumably with Xecho reset). READF stands for READ FAST. XTT_READF_SET must be called first. X XValue of function is the I/O status completion code X2 TT_PROMPT XThis routine reads a line from the terminal. X XINTEGER TT_PROMPT XI = TT_PROMPT( prompt, prompt_len, buffer, buf_len, data_len X`09`09`09`09`09`09`5B, term_len `5D ) X or XI = TT_PROMPT( prompt_desc, , buf_desc, , data_len `5B, term_len `5D ) X X"prompt" is the address of a character string X"prompt_len" is the length of the prompt character string X"buffer" is the address of the input buffer X"buf_len" is the length of the input buffer in bytes X"data_len" will contain the number of characters read X"term_len" (if specified) will contain the length of the terminator X"I" will contain the IO completion status code X X"prompt_desc" is the address of a descriptor of the prompt string X"buf_desc" is the address of a descriptor of the input buffer X X2 TT_WRITE XCALL TT_WRITE( array, length ) XINTEGER length XBYTE array( length ) X X"array" is the address of the characters X"length" is the number of characters to write X XThe write is done in "noformat" (binary) mode. This completely bypasses Xany checking done by the terminal driver eg. for tabs, escape sequences, Xor end of line wrapping. `20 X2 TT_WRITE_S XCALL TT_WRITE( array, length, efn ) XINTEGER length, efn XBYTE array( length ) X X"array" is the address of the characters X"length" is the number of characters to write X"efn" is the efn which will be set upon the writes completion X`09This routine does not wait for it to be set. X XCan be called synchronously with TT_WRITE. XThis is so that you can do 2 writes at the same time. XIt is designed for use within an AST procedure. X2 TT_CANCEL XCALL TT_CANCEL X XCancels type-ahead. X2 TT_CANCEL_IO XCALL TT_CANCEL_IO X XCancels all pending I/O requests that were issued via the TTIO routines. XThis will normally be called from within an AST procedure. X2 Examples XC`09TEST TTIO ROUTINES XC X`09INTEGER TT_PROMPT X`09CHARACTER PROMPT*16, BUF_IN*80 X`09DATA PROMPT / 'ABCDEFGHIJKLMNO>' / XC X`09CALL TT_INIT( 2 ) XC X`09DO J=1,10 X`09 I = TT_PROMPT( PROMPT, , BUF_IN, , LEN_IN , LEN_TERM ) X`09 TYPE *,I,LEN_IN, LEN_TERM X`09 TYPE *,BUF_IN(:LEN_IN)`09! THE TERMINATOR IS AFTER THIS X`09END DO X`09END X1 SLEEP_SET XThis routine, along with SLEEP_START and SLEEP_WAIT, allows your program Xto execute an asynchronous sleep. You call SLEEP_SET to specify the length Xof time. Then you call SLEEP_START to begin the timed period. Control Xreturns immediately to your image; you can then execute whatever code is Xrequired. Then you call SLEEP_WAIT to wait for the timed period to expire. XThe timed period may have already finished, in which case control will Xreturn immediately. X2 Parameters XCALL SLEEP_SET( time , efn ) X X"time" is the address of an integer specifying the timed period in X hundredths of a second. X"efn" is the address of an integer indicating which event flag to use. X Use 21 if you have no preference. Must be less than 24. X1 SLEEP_START XThis starts a timed period, as specified by the previous call to SLEEP_SET. X XCALL SLEEP_START X XControl returns immediately. X1 SLEEP_WAIT XThis waits for the completion of a timed period, as started by the previous Xcall to SLEEP_START X XCALL SLEEP_WAIT X.endc X`09$dvidef X`09$iodef`09`09; qio io$_... X`09$ttdef`09`09; terminal characteristics X X X`09.psect`09$rw_TT_channel$ wrt, rd, noexe, noshr, pic, long Xttchan: X`09.long`09; channel on which terminal is open (if non zero) X X`09.psect`09tt$rodata`09nowrt, noexe, shr, pic, long X Xttname_descr: X`09.ascid`09/TT/ X Xmbxcnv: X`09.ascid`09/_MBA!UW:/`09; convert mbx unit number to physical name X Xmbxbuf_descr: X`09.word`09mbxbuf_siz, 0 X`09.address mbxbuf X Xmbxitmlst: X`09.word`09mbxname_len, dvi$_devnam X`09.address mbxname X`09.address mbxiosb`09`09; return length, don't want X`09.long`090`09`09`09; end of list X X`09.align long X X`09.psect`09tt$rwbuf`09wrt, noexe, noshr, pic, long X Xmbxname_len = 64 Xmbxname:`09`09`09; room to hold the physical mbx name X`09.blkb`09mbxname_len Xmbxname_descr: X`09.word`09mbxname_len, 0 X`09.address mbxname Xmbxiosb: X`09.long`090,0 Xmbxbuf_siz = 32 Xmbxbuf: X`09.blkb`09mbxbuf_siz X X`09.align`09long Xttbuf_siz = 128 Xttbuf: X`09.blkb`09ttbuf_siz X;outbuf_siz = 128 X;outbuf:: X;`09.blkb`09outbuf_siz X Xttiosb: X`09.long`090,0 Xtt_func: X`09.long`09io$_readvblk Xtt_p_func: X`09.long`09io$_readprompt Xtt_timed: X`09.long`09`09`09; wait time if specified Xtt_term_addr: X`09.long`09`09`09; p4 parameter of read Xtt_term_quad: X`09.quad`09`09`09; quad word pointed to be tt_term_addr Xtt_term_mask: X`09.blkb`0916`09`09; bit set if that char is a terminator (0-127) X X X`09.psect`09tt$rwdata`09wrt, noexe, noshr, pic, long X Xmbxchan: X`09.word Xdata_ready: X`09.word X Xchars_left: X`09.long Xchar_pointer: X`09.long X Xsleep_time: X`09.long -100000*30, -1`09`09; time to sleep (30/100ths default) X Xttmode:`09`09`09`09`09; terminal chars changed X`09.quad Xttsavemode:`09`09`09`09; original terminal characteristics X`09.quad X Xsleep_args: X`09.long`094 Xsleep_efn: X`09.long`0921`09; event flag to use for sleeps X`09.address sleep_time X`09.long`090`09; astadr X`09.long`090`09; reqidt X X;outbuf_qio: X;`09$qio`09func=io$_writevblk!io$m_noformat,- X;`09`09p1=outbuf Xoutput_qio: X`09$qio`09func=io$_writevblk!io$m_noformat X Xread_now_qio: X`09$qio`09func=io$_readvblk!io$m_timed!io$m_noecho!io$m_nofiltr,- X`09`09iosb=ttiosb,- X`09`09p1=ttbuf, p2=ttbuf_siz, p3=0`09; wait time = 0 X Xread_fast_qio:`09; inittialized by TT_SET_READF X`09$qio`09func=io$_ttyreadall!io$m_noecho, iosb=ttiosb X Xtt_exit_blk:`09`09`09; exit handler block X`09.long X`09.address tt_exit_handler X`09.long`091`09`09; 1 argument X`09.address 10$ X10$:`09.long`090`09`09; exit reason X X X`09.psect`09tt$code nowrt, exe, shr, pic, long X X`09.entry`09- XTT_INIT, `5Em X;+ X; CALL TT_INIT( type ) X; type`09= 0, ordinary line input X;`09 1, single character input X;`09 2, line input with escape sequences X; X;`09patch 16-Sep-1982 X;`09`09Only allow 1 call to TT_INIT X;- X`09tstw`09ttchan`09`09; if channel already allocated, return X`09beql`0950$`09`09; patch 16-Sep-1982 X`09ret X50$: X`09movl`09@4(ap), r2`09; get type code X X`09caseb`09r2, #0, #2 X20$:`09.word`09100$-20$ X`09.word`09200$-20$ X`09.word`09300$-20$ X100$:`09; type 0 (line input) X`09$assign_s`09devnam=ttname_descr, chan=ttchan X`09bsbw`09error`09`09`09; check for error X`09brw`091000$ X X200$:`09; type 1 (single character input) X; Create a mailbox. Assign a channel to terminal with an associated mailbox V. X`09$crembx_s`09chan=mbxchan, promsk=#`5ExFF00 X`09bsbw`09`09error X X;`09$getchn_s`09chan=mbxchan, pribuf=dibbuf_descr X;`09bsbw`09`09error X;`09$fao_s`09`09ctrstr=mbxcnv, outbuf=mbxname_descr,- X;`09`09`09outlen=mbxname_descr, p1=dibbuf+dib$w_unit X X`09$getdvi_s`09chan=mbxchan, itmlst=mbxitmlst X`09bsbw`09`09error X`09locc`09`09#0, #mbxname_len, mbxname ; find trailing nulls X`09subl3`09`09r0, #mbxname_len, r0 X`09movw`09`09r0, mbxname_descr`09; store length of name X X`09$assign_s`09devnam=ttname_descr, chan=ttchan, - ; acmode=#`5ExFF00 X`09`09`09mbxnam=mbxname_descr`09; acmode fails in VMS 5.5 X`09bsbw`09error X`09bsbw`09queue_mbxread`09`09; start mail box read X`09brw`091000$ X X300$:`09; type 2 (line input with escape sequences) X`09$assign_s`09devnam=ttname_descr, chan=ttchan X`09bsbw`09error`09`09`09; check for error X`09$qiow_s func=#io$_sensemode, chan=ttchan, - X`09`09iosb=ttiosb, p1=ttmode`09; get terminal characteristics X`09bsbw`09error X`09movzwl`09ttiosb, r0 X`09bsbw`09error X`09movq`09ttmode, ttsavemode`09; save current terminal chars X`09$dclexh_s desblk=tt_exit_blk`09; declare exit handler to restore X`09`09`09`09`09; terminal chars on exit. X`09bsbw`09error X`09bbss`09#tt$v_escape, ttmode+4, 310$`09; want escape sequences X310$:`09$qiow_s func=#io$_setmode, chan=ttchan, - X`09`09iosb=ttiosb, p1=ttmode X`09bsbw`09error X`09movzwl`09ttiosb, r0 X`09bsbw`09error X;`09brbw`091000$ X X1000$: X;`09movw`09ttchan, outbuf_qio+qio$_chan`09`09;store channel # X`09movw`09ttchan, output_qio+qio$_chan`09`09;store channel # X`09movw`09ttchan, read_now_qio+qio$_chan`09`09;store channel # X;`09$qiow_s`09func=#io$_setmode!io$m_ctrlcast, chan=ttchan,- X;`09`09p1=control_c`09`09`09; set control C trap X`09ret X X X`09.entry`09- XTT_SET_FUNC, `5Em<> X;+ X;`09I = TT_SET_FUNC( value `5B, seconds `5D ) X;`09set read modifiers X;- X`09movl`09@4(ap), r0`09`09`09; get modifiers X`09movl`09#io$m_nofiltr!io$m_purge!io$m_timed!io$m_trmnoecho, r1 X`09`09`09`09`09; get bits allowed to set X`09bicl2`09r1, tt_func`09`09; clear previous options X`09bicl2`09r1, tt_p_func X`09mcoml`09r1, r1`09`09`09; get bits cannot change X`09bicl2`09r1, r0`09`09`09; make sure only change correct bits X`09bisl2`09r0, tt_func`09`09; and set new options X`09bisl2`09r0, tt_p_func X X`09cmpb`09#1, (ap)`09`09; check if "seconds" parameter here X`09bgtr`09100$ X`09ret X100$:`09movl`09@8(ap), tt_timed`09; store time X`09ret X X X`09.entry`09- XTT_SET_TERM, `5Em X;+ X;`09CALL TT_SET_TERM( option, parameters... ) X;`09set terminator character mask X; X;`09option X;`090`09normal terminators (any control char except LF VT FF TAB BS X;`091`09parameter 1 is the address of a longword containing the X;`09`09terminator bit mask (first 32 characters only) X;`09`09( 1, '00000001'X )`09! enable Control A as terminator X;`092`09parameter 1 is address of # of bytes in terminator mask X;`09`09parameter 2 is address of array containing terminator bit mask X;`093`09the following parameters are addresses of a byte containing X;`09`09the acsii code of the character to be a terminator. X;`09`09( 3, 10, 13 )`09`09! enable LF and CR to be terminators X;- X`09subl3`09#1, (ap)+, r0`09`09; get number of parameters - 1 X`09movl`09@(ap)+, r1`09`09; get option X X`09caseb`09r1, #0, #3 X10$:`09.word`09100$-10$ X`09.word`09200$-10$ X`09.word`09300$-10$ X`09.word`09400$-10$ X; fall thru to option 0 X100$: X`09clrl`09tt_term_addr`09`09; 0 means the default term mask X`09ret X200$:`09; option 1 X`09sobgeq`09r0, 210$`09`09; see if another parameter X`09ret X210$:`09movl`09@(ap)+, r3`09`09; get longword terminator mask X240$:`09; r3 contains low 32 bits of terminator mask X`09clrl`09r2`09`09`09; first longword must be zero X`09movq`09r2, tt_term_quad`09; store it X250$:`09movaq`09tt_term_quad, tt_term_addr ; set up pointer to quadword X`09ret X X300$:`09; option 2`09; param1 is # of bytes`09; param2 if address of bytes X`09sobgeq`09r0, 310$`09`09; see if another parameter X`09ret X310$:`09movzbl`09@(ap)+, tt_term_quad`09; store # of bytes in term mask X`09sobgeq`09r0, 320$`09`09; see if another parameter X`09ret X320$:`09movl`09@(ap)+, tt_term_quad+4`09; store address of term bit mask X`09brb`09250$`09`09`09; go set up pointer and exit X X400$:`09; option 3`09; a list of ascii codes follow X`09movab`09tt_term_mask, r3`09; base of terminator bit mask X`09movl`09r3, r1 X`09clrq`09(r1)+`09`09`09; zero terminator bit mask X`09clrq`09(r1)+`09`09`09; 16 bytes (0-127) X`09clrq`09(r1)+ X`09clrq`09(r1)+ X`09clrl`09r1`09`09`09; maximum ascii code X`09clrl`09r2`09`09`09; we put ascii code in low byte X`09tstl`09r0`09`09`09; see if at least 1 parameter X`09bgtr`09410$ X`09ret X410$: X`09bicb3`09#`5EX80, @(ap)+, r2`09; get ascii code (0-127) X`09cmpl`09r2, r1`09`09`09; bigger than previous maximum ? X`09bleq`09420$ X`09movl`09r2, r1 X420$:`09bbss`09r2, (r3), 440$`09`09; set bit X440$:`09sobgtr`09r0, 410$`09`09; do all parameters X X`09addl2`09#7, r1`09`09`09; round up to nearest byte X`09divl2`09#8, r1`09`09`09; get # of bytes in term mask X`09cmpl`09r1, #4`09`09`09; if <= 4 bytes, use short format X`09bgtr`09450$ X`09movl`09(r3), r3`09`09; get first 4 bytes of mask in r3 X`09brw`09240$`09`09`09; go store it and pointer and exit X450$: X`09movl`09r1, tt_term_quad`09; store # of bytes for long format X`09movl`09r3, tt_term_quad+4`09; store address of term bit mask X`09brb`09250$`09`09`09; store pointer and exit X X X X`09.entry`09- XTT_CTRLCAST,`09`5Em<> X;+ X;`09CALL TT_CTRLCAST( routine address ) X;`09enable a control C ast X;- X`09$qiow_s func=#io$_setmode!io$m_ctrlcast, chan=ttchan, iosb=ttiosb, - X`09`09p1=@4(ap) X`09ret`09`09`09`09; ignore all erros X X X`09.entry`09- XTT_1_CHAR,`09`5Em<> X;+ X;`09I = TT_1_CHAR X;`09read 1 character. Waits for it. X;- X`09clrb`09ttbuf X`09$qiow_s`09func=#io$_readvblk!io$m_noecho!io$m_nofiltr,- X`09`09chan=ttchan, iosb=ttiosb,- X`09`09p1=ttbuf, p2=#1 X`09cvtbl`09ttbuf, r0 X`09ret X X`09.entry`09- XTT_1_CHAR_T,`09`5Em<> X;+ X;`09I = TT_1_CHAR_T( seconds ) X;`09read 1 character. Waits "seconds" for it. X;`09returns 0 if times out X;- X`09clrb`09ttbuf X`09$qiow_s`09func=#io$_readvblk!io$m_noecho!io$m_nofiltr!io$m_timed,- X`09`09chan=ttchan, iosb=ttiosb,- X`09`09p1=ttbuf, p2=#1, p3=@4(ap) X`09cvtbl`09ttbuf, r0 X`09ret +-+-+-+-+-+-+-+- END OF PART 6 +-+-+-+-+-+-+-+- -+-+-+-+-+-+-+-+ START OF PART 7 -+-+-+-+-+-+-+-+ X X`09.entry`09- XTT_1_CHAR_NOW, `5Em<> X;+ X;`09I = TT_1_CHAR_NOW() X;`09get next character if typed. Returns immediately. X;`09I = -1 if no character available X;- X`09tstl`09chars_left`09`09; have we used all characters ? X`09bgtr`0950$`09`09`09; no --> 50$ X`09bbsc`09#0, data_ready, 20$`09; check if input ready X5$:`09mnegl`09#1, r0`09`09`09; no characters read X`09ret`09`09`09`09; no X20$: X`09$qiow_g read_now_qio X`09blbc`09r0, 5$`09`09`09; error X; X;`09$qiow_s`09func=#io$_writevblk,chan=ttchan,-`09; debug write X;`09`09p1=ttbuf, p2=ttiosb+2, p4=#`5Ex1000 X X`09movzwl`09ttiosb+2, chars_left`09`09; # chars read X`09movab`09ttbuf, char_pointer`09`09; store address of character X50$: X`09decl`09chars_left X`09movzbl`09@char_pointer, r0`09`09; get next char X`09incl`09char_pointer`09`09`09; point to next X`09ret X X X`09.entry`09- XTT_READ, `5Em X;+ X;`09INTEGER FUNCTION TT_READ( buffer, buf_len, data_len, term_len ) X;`09buffer`09address of buffer or address of descriptor of buffer X;`09buf_len length of buffer. If omitted then "buffer" is a descriptor X;`09data_len length of data read (# of characters) X;`09term_len length of terminator X; X;`09Value of function is the I/O status completion code X;- X`09movl`098(ap), r2`09`09; get buf_len X`09bneq`09100$`09`09`09; if <> 0 then it was specified X`09movq`09@4(ap), r2`09`09; get descriptor of buffer X`09`09`09`09`09; r2 = length, r3 = address X`09bicl2`09#`5EXFFFF0000, r2`09`09; want length only X`09brb`09200$ X100$: X`09movl`09(r2), r2`09`09; get buffer length X`09movl`094(ap), r3`09`09; get buffer address X200$: X`09$qiow_s func=tt_func, chan=ttchan, iosb=ttiosb, - X`09`09p1=(r3), p2=r2, p3=tt_timed, p4=tt_term_addr X`09blbc`09r0, 600$`09`09; did $qio get an error. yes --> 600$ X X`09movzwl`09ttiosb+2, @12(ap)`09; store # characters read X`09cmpb`09(ap), #3`09`09; enough arguments supplied X`09bleq`09500$`09`09`09; no --> 500$ X`09movl`0916(ap), r2`09`09; does user want terminator length X`09beql`09500$ X`09movzwl`09ttiosb+6, (r2)`09`09; store terminator length X500$: X`09movzwl`09ttiosb, r0 X600$: X`09ret X X`09.entry`09- XTT_READ_S, `5Em<> X;+ X;`09CALL TT_READ_S( array, length, efn, iast, iosb ) X;`09BYTE ARRAY( LENGTH ) X;`09INTEGER iosb(2) X; X;`09reads a line asynchronously X;`09will set "iast" to one when complete X;- X`09$qio_s`09func=tt_func, - X`09`09chan=ttchan, - X`09`09efn=@12(ap), - X`09`09iosb=@20(ap), - X`09`09astadr=tt_read_s_ast, - X`09`09astprm=@16(ap), - X`09`09p1=@4(ap), p2=@8(ap) X`09blbc`09r0, 100$ X`09ret X100$: X`09bsbw`09error X`09ret X X`09.align`09word X`09.entry`09- XTT_READ_S_AST, `5Em<> X`09movl`09#1, @4(ap) X`09ret X X X`09.entry`09- XTT_SET_READF, `5Em X;+ X;`09CALL TT_SET_READF( buffer, buf_len ) X;`09buffer`09address of buffer or address of descriptor of buffer X;`09buf_len length of buffer. If omitted then "buffer" is a descriptor X;- X`09movl`098(ap), r2`09`09; get buf_len X`09bneq`09100$`09`09`09; if <> 0 then it was specified X`09movq`09@4(ap), r2`09`09; get descriptor of buffer X`09`09`09`09`09; r2 = length, r3 = address X`09bicl2`09#`5EXFFFF0000, r2`09`09; want length only X`09brb`09200$ X100$: X`09movl`09(r2), r2`09`09; get buffer length X`09movl`094(ap), r3`09`09; get buffer address X200$: X`09movl`09r3, read_fast_qio+qio$_p1`09; address of buffer X`09movl`09r2, read_fast_qio+qio$_p2`09; length of buffer X;`09movl`09tt_timed, read_fast_qio+qio$_p3 ; time out X`09movl`09tt_term_addr, read_fast_qio+qio$_p4 ; terminator pointer X;`09movl`09tt_func, read_fast_qio+qio$_func X`09movzwl`09ttchan, read_fast_qio+qio$_chan X X`09ret X X X`09.entry`09- XTT_READF, `5Em X;+ X;`09INTEGER FUNCTION TT_READF( data_len ) X;`09data_len length of data read (# of characters) (not including term) X; X;`09This routine is used for reading a lot of data in binary mode X;`09with no echo. READF stands for READ FAST. X;`09TT_READF_SET must be called first X; X;`09Value of function is the I/O status completion code X;- X X`09$qiow_g read_fast_qio X`09blbc`09r0, 600$`09`09; did $qio get an error. yes --> 600$ X X`09movzwl`09ttiosb+2, @4(ap)`09; store # characters read X`09movzwl`09ttiosb, r0 X600$: X`09ret X X X`09.entry`09- XTT_PROMPT, `5Em X;+ X;`09INTEGER FUNCTION TT_PROMPT( prompt, prompt_len, X;`09`09buffer, buf_len, data_len, term_len ) X;`09prompt address of prompt string or address of descriptor X;`09prompt_len length of prompt string. If omitted then "prompt" X;`09`09`09`09`09`09is a descriptor X;`09buffer`09address of buffer or address of descriptor of buffer X;`09buf_len length of buffer. If omitted then "buffer" is a descriptor X;`09data_len length of data read (# of characters) X;`09term_len length of terminator X; X;`09Value of function is the I/O status completion code X;- X`09movl`0916(ap), r2`09`09; get buf_len X`09bneq`09100$`09`09`09; if <> 0 then it was specified X`09movq`09@12(ap), r2`09`09; get descriptor of buffer X`09`09`09`09`09; r2 = length, r3 = address X`09bicl2`09#`5EXFFFF0000, r2`09`09; want length only X`09brb`09200$ X100$: X`09movl`09(r2), r2`09`09; get buffer length X`09movl`0912(ap), r3`09`09; get buffer address X200$: X`09movl`098(ap), r4`09`09; get prompt_len X`09bneq`09300$`09`09`09; if <> 0 then it was specified X`09movq`09@4(ap), r4`09`09; get descriptor of prompt string X`09`09`09`09`09; r4 = length, r5 = address X`09bicl2`09#`5EXFFFF0000, r4`09`09; get length only X`09brb`09400$ X300$: X`09movl`09(r4), r4`09`09; get prompt length X`09movl`094(ap), r5`09`09; get prompt address X400$: X X`09$qiow_s func=tt_p_func, chan=ttchan, iosb=ttiosb, - X`09`09p1=(r3), p2=r2, p3=tt_timed, p5=r5, p6=r4 X`09blbc`09r0, 600$`09`09; did $qio get an error. yes --> 600$ X X`09movzwl`09ttiosb+2, @20(ap)`09; store # characters read X`09cmpb`09(ap), #5`09`09; enough arguments supplied X`09bleq`09500$`09`09`09; no --> 500$ X`09movl`0924(ap), r2`09`09; does user want terminator length X`09beql`09500$ X`09movzwl`09ttiosb+6, (r2)`09`09; store terminator length X500$: X`09movzwl`09ttiosb, r0 X600$: X`09ret X X X`09.entry`09- XTT_MBX_READ,`09`5Em<> X;+ X; This is an AST routine which executes when the mailbox record has been rea Vd. X; The record itself is a status message which is assumed to say that X; unsolicited data is available at the terminal X;- X`09blbc`09mbxiosb, 100$`09`09; on error, dont re-que read X;`09we could have SS$_CANCEL or SS$_ABORT from the $CANCEL in the X;`09exit handler X`09movb`09#1, data_ready`09`09; indicate data is there X`09bsbw`09queue_mbxread`09`09; queue another read request X100$: X`09ret X XQUEUE_MBXREAD: X`09$qio_s`09efn=#2, func=#io$_readvblk, chan=mbxchan, iosb=mbxiosb,- X`09`09astadr=tt_mbx_read,- X`09`09p1=mbxbuf, p2=#mbxbuf_siz X`09blbc`09r0, 100$ X`09rsb X100$: X`09bsbw`09error X`09rsb X X;TT_WRITE$: X;+ X;`09bsbw`09ttwrite X;`09r3 contains length of buffer to write X;`09the buffer is outbuf X;- X;`09movl`09r3, outbuf_qio+qio$_p2`09`09; store length of buffer X;`09$qiow_g`09outbuf_qio X;`09blbc`09r0, 100$ X;`09rsb X;100$: X;`09bsbw`09error X;`09rsb X X`09.entry`09- XTT_WRITE, `5Em<> X;+ X;`09CALL TT_WRITE( array, length ) X;`09BYTE ARRAY( LENGTH ) X;`09writes buffer to terminal in noformat mode X;- X`09movl`094(ap), output_qio+qio$_p1`09; store address of buffer X`09movl`09@8(ap), output_qio+qio$_p2`09; store length of buffer X`09$qiow_g`09output_qio X`09blbc`09r0, 100$ X`09ret X100$: X`09bsbw`09error X`09ret X X`09.entry`09- XTT_WRITE_S, `5Em<> X;+ X;`09CALL TT_WRITE_S( array, length, efn ) X;`09BYTE ARRAY( LENGTH ) X;`09writes buffer to terminal in noformat mode X;`09this puts the qio on the stack so that it can be called X;`09synchronously with TT_WRITE X;- X`09$qio_s func=#io$_writevblk!io$m_noformat, - X`09`09chan=ttchan, - X`09`09efn=@12(ap), - X`09`09p1=@4(ap), p2=@8(ap) X`09blbc`09r0, 100$ X`09ret X100$: X`09bsbw`09error X`09ret X X`09.entry - XTT_CANCEL, `5Em<> X`09clrl`09r0 X`09tstw`09ttchan`09`09; check channel is open X`09beql`09100$ X`09$qiow_s`09func=#io$_readvblk!io$m_purge!io$m_timed,- X`09`09chan=ttchan, p1=ttbuf, p2=#0 X;###`09`09`09; do read with 0 length buffer (p2) X`09clrl`09chars_left`09; for TT_1_char_now X`09clrl`09data_ready`09; say no data ready to read X100$: X`09ret`09`09`09; return with status in r0 X X`09.entry - XTT_CANCEL_IO, `5Em<> X;+ X;`09cancels I/O on channel X;- X`09clrl`09r0 X`09tstw`09ttchan`09`09; check channel is open X`09beql`09100$ X`09$cancel_s chan=ttchan X`09bsbb`09error X100$:`09ret`09`09`09; return with status in r0 X XERROR: X`09blbs`09r0, 100$ X`09pushl`09r0 X`09calls`09#1, G`5Elib$signal X100$: X`09rsb X X;`09.entry`09- X;control_c, `5Em<> X;`09movb`09#1, control_c_flag X;`09ret X X X`09.entry`09- XSLEEP_SET, `5Em<> X;+ X;`09CALL SLEEP_SET( efn , time ) X;`09INTEGER efn, time X;`09use "efn" as event flag X;`09sleep for "time" 100th's of a second X;- X`09movl`09@4(ap), sleep_efn X`09emul`09#-100000, @8(ap), #0, sleep_time`09; get delta time format X`09$setef_s efn=sleep_efn`09`09; set ef in case SLEEP_START not called X`09ret X X`09.entry`09- XSLEEP_START, `5Em<> X;+ X;`09CALL SLEEP_START X;`09starts a timer X;- X`09$setimr_g sleep_args X`09blbc`09r0, 100$ X`09ret X100$:`09bsbw`09error X`09ret X X`09.entry`09- XSLEEP_WAIT, `5Em<> X;+ X;`09CALL SLEEP_WAIT X;`09waits for sleep efn to turn on X;- X`09$waitfr_s efn=sleep_efn X`09ret X Xtt_exit_handler = . X`09.word`09`5Em<> X`09$qiow_s func=#io$_setmode, chan=ttchan, iosb=ttiosb - X`09`09p1=ttsavemode`09`09; reset terminal mode X;`09if we get an error, too bad. X`09ret X X`09.end $ CALL UNPACK TTIO.MAR;49 980021740 $ create 'f' X$! X$!`09Create UTIL.OLB X$! X$ MACRO ttio X$ MACRO sleep X$ MACRO imagedir X$! X$ LIBR/CRE util ttio,sleep,imagedir X$ SET FILE/TRUNC util.olb X$! $ CALL UNPACK UTIL.COM;3 1963740437 $ v=f$verify(v) $ EXIT