-+-+-+-+-+-+-+-+ START OF PART 3 -+-+-+-+-+-+-+-+ X`5BHIDDEN`5DTYPE X v_array = varying `5B100`5D of char; X X`5BGLOBAL`5D XFUNCTION Get_Posn ( x , y : integer ) : v_array; XVAR X sx,sy : v_array; XBEGIN X IF ( x < 2 ) then X IF ( y < 2 ) then X get_posn := VT100_ESC + '`5BH' X ELSE X BEGIN X writev (sy,y:1); X get_posn := VT100_ESC + '`5B' + sy + 'H'; X END X ELSE X IF ( y < 2 ) then X BEGIN X writev (sx,x:1); X get_posn := VT100_ESC + '`5B;' + sx + 'H'; X END X ELSE X BEGIN X writev (sx,x:1); X writev (sy,y:1); X get_posn := VT100_ESC + '`5B' + sy + ';' + sx + 'H'; X END; XEND; X XEND. $ CALL UNPACK GET_POSN.PAS;1 106504768 $ create 'f' X`5B X Inherit X ('SYS$LIBRARY:STARLET','SYS$LIBRARY:PASCAL$LIB_ROUTINES','ERROR'), X Environment X ('HANDLER.PEN') X`5D X XMODULE HANDLER; X X`5BHIDDEN`5D XTYPE X $UWORD = `5BWORD`5D 0..65535; X v_array = varying `5B256`5D of char; X X`5BHIDDEN`5D XVAR X efn : `5BVOLATILE`5D unsigned; X channel : $UWORD; X channel_initialized : boolean; X XVAR X`7BHandler`7D X desblk : `5BGLOBAL`5D 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 initialize_channel; XVAR X ret_status : integer; XBEGIN X channel_initialized := true; X lib$get_ef (efn); X IF efn = -1 then X ERROR ('%HANDLER-F-INITIALIZE, No Event Flag Avaliable.'); X ret_status := $assign ( chan := channel , devnam := 'tt:' ); X IF not odd(ret_status) then X LIB$SIGNAL(ret_status); XEND; X X`5BHIDDEN`5D XPROCEDURE ctrlc_ast; XBEGIN X $exit ( code := ss$_clifrcext ); XEND; X X`5BGLOBAL`5D XPROCEDURE Force; XVAR X ret_status : integer; XBEGIN X IF not channel_initialized then X initialize_channel; X ret_status := $qiow ( efn := efn, X chan := channel, X func := io$_setmode + io$m_ctrlcast, X p1 := %immed iaddress (ctrlc_ast) X ); X IF not odd(ret_status) then X LIB$SIGNAL(ret_status); XEND; X X X`5BGLOBAL`5D XPROCEDURE Setup_handler ( handler_address : integer ); XVAR X ret_status : 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 ret_status := $DCLEXH (desblk); X IF not odd(ret_status) then X LIB$SIGNAL(ret_status); XEND;`20 X X X`5BGLOBAL`5D XPROCEDURE No_handler; XVAR X ret_status : integer; XBEGIN X ret_status := $CANEXH (desblk); X IF not odd(ret_status) then X LIB$SIGNAL(ret_status); XEND; X XEND. $ CALL UNPACK HANDLER.PAS;1 1467956080 $ create 'f' X`5B X Inherit X ('SYS$LIBRARY:STARLET'), X Environment X ('HEX.PEN') X`5D X XMODULE HEX; X X`5BHIDDEN`5DTYPE X v_array = varying `5B256`5D of char; X X`5BGLOBAL`5D XFUNCTION Hex ( number, len : integer) : v_array; XVAR X Result : v_array; XBEGIN X result := ''; X WHILE ( number <> 0 ) do X BEGIN X IF (number mod 16) < 10 then X result := chr(ord('0')+(number mod 16)) + result X ELSE X result := chr(ord('A')+(number mod 16)-10) + result; X number := number div 16; X END; `20 X WHILE result.length < len do X result := '0' + result; X hex := result; XEND; X XEND. $ CALL UNPACK HEX.PAS;1 107231765 $ 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;1 173433367 $ create 'f' X`5B X Inherit X ('SYS$LIBRARY:STARLET','SYS$LIBRARY:PASCAL$LIB_ROUTINES','GET_JPI'), X Environment X ('IMAGE_DIR.PEN') X`5D X XMODULE Image_dir; X X`5BHIDDEN`5DTYPE X $UWORD = `5BWORD`5D 0..65535; X v_array = varying `5B256`5D of char; X X`5BHIDDEN`5DVAR X image_dir_done : boolean; X X X`5BGLOBAL`5D XPROCEDURE Image_dir; XVAR X itemlist : record X item : array `5B1..1`5D of`20 X record X bufsize : $uword; X code : $uword; X bufadr : integer; X lenadr : integer X end; X no_more : integer; X end; X the_name : v_array; X name_str : packed array `5B1..256`5D of char; X ret_status : integer; XBEGIN X IF not image_dir_done then X BEGIN X image_dir_done := true; X the_name := Get_jpi(jpi$_imagname,100); X `20 X WHILE ( index(the_name,'`5D`5B') <> 0 ) do X BEGIN X the_name := substr(the_name,1,index(the_name,'`5D`5B')-1) + substr V(the_name,index(the_name,'`5D`5B')+2,length(the_name)-(index(the_name,'`5D`5 VB')+2)); X END; X `20 X the_name := substr(the_name,1,index(the_name,'`5D')); X name_str := the_name; X `20 X WITH itemlist do X BEGIN X WITH item`5B1`5D do X BEGIN X Bufsize := length(the_name); X Code := lnm$_string; X Bufadr := iaddress(name_str); X Lenadr := 0 X END; X No_more := 0 X END; X X ret_status := $Crelnm (tabnam:='LNM$PROCESS_TABLE', X lognam:='IMAGE_DIR', X itmlst:=itemlist ); X X IF not odd(ret_status) then X LIB$SIGNAL(ret_status); X END; XEND; X X XEND. $ CALL UNPACK IMAGE_DIR.PAS;1 324076598 $ create 'f' X`5B X Inherit X ('SYS$LIBRARY:STARLET'), X Environment X ('INTERACT.PEN') X`5D X X XMODULE INTERACT; X X%INCLUDE 'VT100_ESC_SEQS.PAS' X X`5BHIDDEN`5D XTYPE X $UWORD = `5BWORD`5D 0..65535; X $DEFTYP = `5BUNSAFE`5D INTEGER; X $DEFPTR = `5BUNSAFE`5D `5E$DEFTYP; X v_array = varying `5B256`5D of char; X string = varying `5B20`5D of char; X date_time_type = array `5B1..7`5D of $uword; X unknown_file = `5BUNSAFE,VOLATILE`5D File of char; X fabptr = `5Efab$type; X rabptr = `5Erab$type; X XVAR X date_time : `5BGLOBAL`5D date_time_type; X`7BHandler`7D X desblk : `5BGLOBAL`5D Record X findlink : integer; X proc : integer; X arglist : array `5B0..1`5D of integer; X exitreason : integer; X End; X qio_write_speed : integer := 0; X X X`5BEXTERNAL`5D XPROCEDURE check_status; XExtern; X X`5BEXTERNAL`5D XPROCEDURE Clear ( portiontype : v_array := 'SCREEN'; X cleartype : v_array := 'WHOLETHING' ); X`7B X'SCREEN' or 'LINE' X'WHOLETHING', 'TO_START' or 'TO_END' X`7D XExtern; X X`5BEXTERNAL`5D XPROCEDURE Create_global_section X ( X Section_name : v_array; X Section_size : integer; X var Section_ptr : $defptr; X var Section_end : `5BTRUNCATE`5D $defptr X ); XExtern; X X`5BEXTERNAL`5D XPROCEDURE Create_event_flag_cluster ( name : v_array; X cluster : v_array := '64-95' ); XExtern; X X`5BEXTERNAL`5D XFUNCTION Day_num : integer; XExtern; X X`5BEXTERNAL`5D XFUNCTION Day_str ( day : integer ) : v_array; XExtern; X X`5BEXTERNAL`5D XFUNCTION Dec ( number : integer; X pad_char : char := ' '; X pad_len : integer := 0 X ) : v_array; XExtern; X X`5BEXTERNAL`5D XPROCEDURE Delete_global_section ( Section_ptr, Section_end : $defptr ); XExtern; X X`5BEXTERNAL`5D XFUNCTION Extract ( str : v_array; X start : integer ) : v_array; XExtern; X X`5BEXTERNAL`5D XPROCEDURE ERROR ( text : v_array ); XExtern; X X`5BEXTERNAL`5D XPROCEDURE Force; XExtern; X X`5BEXTERNAL`5D XPROCEDURE Formated_read X (VAR return_value : v_array; X picture_clause : v_array; X x_posn : integer; X y_posn : integer; X default_value : v_array := ''; X field_full_terminate : boolean := false; X begin_brace : v_array := ''; X end_brace : v_array := '' X ); XExtern; X X`5BEXTERNAL`5D XFUNCTION Get_Clear ( portiontype : v_array := 'SCREEN'; X cleartype : v_array := 'WHOLETHING' ) : v_array; XExtern; X X`5BEXTERNAL`5D XPROCEDURE Get_Date_time; XExtern; X X`5BEXTERNAL`5D XFUNCTION Full_char ( character : char ) : v_array; XExtern; X X`5BEXTERNAL`5D XFUNCTION Get_jpi ( jpicode , retlen : integer ) : v_array; XExtern; X X`5BEXTERNAL`5D XFUNCTION Get_Posn ( x , y : integer ) : v_array; XExtern; X X`5BEXTERNAL`5D XFUNCTION Hex ( number , len : integer ) : v_array; XExtern; X X`5BEXTERNAL`5D XPROCEDURE Image_dir; XExtern; X X`5BEXTERNAL`5D XPROCEDURE KILL ( PID : `5BTRUNCATE`5D UNSIGNED ); XExtern; X X`5BEXTERNAL`5D XFUNCTION Lower_case ( c : char ) : char; XExtern; X X`5BEXTERNAL`5D XFUNCTION Lower_string ( text : v_array ) : v_array; XExtern; X X`5BEXTERNAL`5D XPROCEDURE No_handler; XExtern; X X`5BEXTERNAL`5D `7B user action procedure `7D XFUNCTION Open_status_new ( VAR Fab : fab$type; X VAR Rab : rab$type; X VAR Filevar : unknown_file ) : integer; XExtern; X X`5BEXTERNAL`5D `7B user action procedure `7D XFUNCTION Open_status_old ( VAR Fab : fab$type; X VAR Rab : rab$type; X VAR Filevar : unknown_file ) : integer; XExtern; X X`5BEXTERNAL`5D XPROCEDURE Posn ( x , y : integer ); XExtern; X X`5BEXTERNAL`5D XFUNCTION QIO_1_char : char; XExtern; X X`5BEXTERNAL`5D XFUNCTION QIO_1_char_now : char; XExtern; X X`5BEXTERNAL`5D XFUNCTION QIO_1_char_timed ( delay : integer ) : char; XExtern; X X`5BEXTERNAL`5D XPROCEDURE QIO_purge; XExtern; X X`5BEXTERNAL`5D XFUNCTION QIO_read_integer : integer; XExtern; X X`5BEXTERNAL`5D XFUNCTION QIO_read_varying ( chars : integer := 80 ) : v_array; XExtern; X X`5BEXTERNAL`5D XFUNCTION QIO_readln ( characters : integer ) : v_array; XExtern; X X`5BEXTERNAL`5D XPROCEDURE QIO_Write ( text : v_array ); XExtern; X X`5BEXTERNAL`5D XPROCEDURE QIO_writeln ( text : `5BTRUNCATE`5D v_array ); XExtern; X X`5BEXTERNAL`5D XFUNCTION Random ( ub : integer ) : integer; XExtern; X X`5BEXTERNAL`5D XFUNCTION Randomize ( ub : integer ) : integer; X`7B produce a random number between 1 and ub inclusive `7D XExtern; X X`5BEXTERNAL`5D XPROCEDURE Reset_randomizer; XExtern; X X`5BEXTERNAL`5D XPROCEDURE Reset_screen; XExtern; X X`5BEXTERNAL`5D XPROCEDURE RMS_signal; XExtern; X X`5BEXTERNAL`5D XFUNCTION RMS_Status : integer; XExtern; X X`5BEXTERNAL`5D XFUNCTION Rnd ( lb, ub : integer ) : integer; X`7B produce a random number between lb and ub inclusive `7D XExtern; X X`5BEXTERNAL`5D XPROCEDURE Seed_initialize ( users_seed : `5BTRUNCATE`5D integer ); XExtern; X X`5BEXTERNAL`5D XPROCEDURE Setup_handler ( handler_address : integer ); XExtern; X X`5BEXTERNAL`5D XPROCEDURE Show_graphedt ( filename : string; wait : boolean := true ); XExtern; X X`5BEXTERNAL`5D XFUNCTION Sign ( n : integer ) : integer; XExtern; X X`5BEXTERNAL`5D XPROCEDURE Sleep ( sec : integer := 0; frac : `5BTRUNCATE`5D real ); XExtern; X X`5BEXTERNAL`5D XPROCEDURE Sleep_start ( interval : integer ); XExtern; X X`5BEXTERNAL`5D XPROCEDURE Sleep_wait; XExtern; X X`5BEXTERNAL`5D XPROCEDURE Smart_Posn ( to_x, to_y : integer; VAR init : boolean ); XExtern; X X`5BEXTERNAL`5D XPROCEDURE Smart_qio_write ( str : v_array ); XExtern; X X`5BEXTERNAL`5D XPROCEDURE Smart_shift ( i : integer ); XExtern; X X`5BEXTERNAL`5D XPROCEDURE Square ( x1 , y1 , x2 , y2 : integer ); XExtern; X X`5BEXTERNAL`5D XPROCEDURE Start_stopwatch; XExtern; X X`5BEXTERNAL`5D XFUNCTION Stop_stopwatch : v_array; XExtern; X +-+-+-+-+-+-+-+- END OF PART 3 +-+-+-+-+-+-+-+-