-+-+-+-+-+-+-+-+ START OF PART 5 -+-+-+-+-+-+-+-+ X random_number_count : integer; X head_random_number : r_number_pointer; X this_random_number : r_number_pointer; X stack_random_number : r_number_pointer; X X X`5BGLOBAL`5D XPROCEDURE Reset_randomizer; XBEGIN X random_number_ub := 0; X random_number_count := 0; X this_random_number := head_random_number;; X WHILE ( this_random_number <> nil ) do X BEGIN X this_random_number := this_random_number`5E.next; X head_random_number`5E.next := stack_random_number; X stack_random_number := head_random_number; X head_random_number := this_random_number; X END; XEND; X X X`5BGLOBAL`5D XFUNCTION Randomize ( ub : integer ) : integer; XVAR X temp : integer; X add : integer; X X PROCEDURE Insert_random_number ( temp : integer ); X VAR X hold : r_number_pointer; X linked : boolean; X BEGIN X this_random_number := head_random_number; X IF ( this_random_number = nil ) then X BEGIN X IF ( stack_random_number = nil ) then X NEW (head_random_number) X ELSE X BEGIN X head_random_number := stack_random_number; X stack_random_number := stack_random_number`5E.next; X END; X head_random_number`5E.number := temp; X head_random_number`5E.next := nil; X END X ELSE X IF ( this_random_number`5E.number > temp ) then X BEGIN X IF ( stack_random_number = nil ) then X NEW (this_random_number) X ELSE X BEGIN X this_random_number := stack_random_number; X stack_random_number := stack_random_number`5E.next; X END; X this_random_number`5E.number := temp; X this_random_number`5E.next := head_random_number; X head_random_number := this_random_number; X END X ELSE X BEGIN X IF ( stack_random_number = nil ) then X NEW (hold) X ELSE X BEGIN X hold := stack_random_number; X stack_random_number := stack_random_number`5E.next; X END; X hold`5E.number := temp; X hold`5E.next := nil; X linked := false; X WHILE ( this_random_number`5E.next <> nil ) do X BEGIN X IF ( this_random_number`5E.number < temp ) and X ( this_random_number`5E.next`5E.number > temp ) then X BEGIN X hold`5E.next := this_random_number`5E.next; X this_random_number`5E.next := hold; X linked := true; X END; X this_random_number := this_random_number`5E.next; X END; X IF not linked then X this_random_number`5E.next := hold; X END; X END; X XBEGIN X IF ( random_number_ub <> ub ) then X BEGIN X random_number_ub := ub; X random_number_count := ub; X END X ELSE X random_number_count := random_number_count - 1; X X IF ( random_number_count <= 0 ) then X Randomize := 0 X ELSE X BEGIN X temp := Random (random_number_count); X add := 0; X X this_random_number := head_random_number; X WHILE ( this_random_number <> nil ) do X BEGIN X IF ( this_random_number`5E.number < temp ) then X add := add + 1; X this_random_number:= this_random_number`5E.next; X END; X X this_random_number := head_random_number; X WHILE ( this_random_number <> nil ) do X BEGIN X IF ( this_random_number`5E.number = temp ) then X temp := temp + 1; X IF ( this_random_number`5E.number > temp ) and ( add > 0 ) then X BEGIN X add := add - 1; X temp := temp + 1; X END X ELSE X this_random_number := this_random_number`5E.next; X END; X temp := temp + add; X randomize := temp; X Insert_random_number ( temp ); X END; XEND; X XEND. $ CALL UNPACK RANDOMIZE.PAS;1 70607709 $ create 'f' X`5B X Inherit X ('QIO_WRITE','VT100'), X Environment X ('RESET_SCREEN.PEN') X`5D X XMODULE RESET_SCREEN; X X`5BHIDDEN`5D XTYPE X v_array = varying `5B256`5D of char; X X`5BGLOBAL`5D XPROCEDURE Reset_screen; XBEGIN X qio_write ( VT100 + VT100_graphics_off + VT100_normal + VT100_normal_scrol Vl + VT100_no_application_keypad ); XEND; X XEND. $ CALL UNPACK RESET_SCREEN.PAS;1 341325326 $ create 'f' X`5B`20 X Inherit`20 X ('SYS$LIBRARY:STARLET'), X Environment`20 X ('RMS_STATUS.PEN')`20 X`5D X XMODULE RMS_STATUS; X X`5BHIDDEN`5D XTYPE X unknown_file = `5BUNSAFE,VOLATILE`5D File of char; X fabptr = `5Efab$type; X rabptr = `5Erab$type; X X`5BHIDDEN`5D XVAR X glo_fab : fabptr; X glo_fabsts : unsigned; X glo_fabstv : unsigned; X glo_rab : rabptr; X glo_rabsts : unsigned; X glo_rabstv : unsigned; X X X`5BEXTERNAL`5D XFUNCTION PAS$FAB ( VAR file_var : unknown_file ) : fabptr; XExtern; X X`5BEXTERNAL`5D XFUNCTION PAS$RAB ( VAR file_var : unknown_file ) : rabptr; XExtern; X X`5BGLOBAL`5D XPROCEDURE RMS_signal; XVAR X item_list : array `5B0..2`5D of unsigned; XBEGIN X item_list`5B0`5D := 2; `7B No. arguements `7D X IF glo_fab = nil then X item_list`5B1`5D := glo_fabsts X ELSE X item_list`5B1`5D := glo_fab`5E.fab$l_sts; X IF glo_fab = nil then X item_list`5B2`5D := glo_fabstv X ELSE X item_list`5B2`5D := glo_fab`5E.fab$l_stv; X IF odd(item_list`5B1`5D) then X BEGIN X IF glo_rab = nil then X item_list`5B1`5D := glo_rabsts X ELSE X item_list`5B1`5D := glo_rab`5E.rab$l_sts; X IF glo_rab = nil then X item_list`5B2`5D := glo_rabstv X ELSE X item_list`5B2`5D := glo_rab`5E.rab$l_stv; X END; X $putmsg (item_list); XEND; X X`5BGLOBAL`5D XFUNCTION RMS_Status : integer; XVAR X temp : unsigned; XBEGIN X IF glo_fab = nil then X temp := glo_fabsts X ELSE X temp := glo_fab`5E.fab$l_sts; X IF odd(temp) then X IF glo_rab = nil then X temp := glo_rabsts X ELSE X temp := glo_rab`5E.rab$l_sts; X RMS_status := temp::integer; XEND; X X X`5BGLOBAL`5D XFUNCTION Open_status_new ( VAR Fab : fab$type; X VAR Rab : rab$type; X VAR Filevar : unknown_file ) : integer; XVAR X status : integer; XBEGIN X Status := $create(fab); X If odd(status) then X Status := $connect(rab); X open_status_new := status; X glo_fab := PAS$FAB ( filevar ); X glo_fabsts := fab.fab$l_sts; X glo_fabstv := fab.fab$l_stv; X glo_rab := PAS$RAB ( filevar ); X glo_rabsts := rab.rab$l_sts; X glo_rabstv := rab.rab$l_stv; XEND; X X`5BGLOBAL`5D XFUNCTION Open_status_old ( VAR Fab : fab$type; X VAR Rab : rab$type; X VAR Filevar : unknown_file ) : integer; XVAR X status : integer; XBEGIN X Status := $open(fab); X If odd(status) then X Status := $connect(rab); X open_status_old := status; X glo_fab := PAS$FAB ( filevar ); X glo_fabsts := fab.fab$l_sts; X glo_fabstv := fab.fab$l_stv; X glo_rab := PAS$RAB ( filevar ); X glo_rabsts := rab.rab$l_sts; X glo_rabstv := rab.rab$l_stv; XEND; X X`5BGLOBAL`5D XPROCEDURE check_status; XBEGIN X IF not odd(rms_status) then X BEGIN X rms_signal; X $exit(1); X END; XEND; X XEND. $ CALL UNPACK RMS_STATUS.PAS;1 2103312526 $ create 'f' X`5B X Inherit X ('QIO_WRITE','QIO_READ','IMAGE_DIR','POSN','CLEAR','RESET_SCREEN','VT100 V'), X Environment X ('SHOW_GRAPHEDT.PEN') X`5D X XMODULE SHOW_GRAPHEDT ( Ingraphedt ); X X`5BHIDDEN`5D XTYPE X v_array = varying `5B256`5D of char; X string = varying `5B20`5D of char; X`5BHIDDEN`5D XVAR X ingraphedt : text; X image_dir_done : boolean; X X`5BGLOBAL`5D XPROCEDURE Show_graphedt ( filename : string; wait : boolean := true ); XVAR X line : v_array; X rep : char; XBEGIN X IF not image_dir_done then X Image_dir; X IF ( wait ) then X rep := qio_1_char_now; X OPEN (ingraphedt,'image_dir:'+filename,history:=readonly,error:=continue); X IF status(ingraphedt) = 0 then X BEGIN X reset (ingraphedt); X WHILE not eof(ingraphedt) and (( rep = chr(-1)) or ( not wait )) do X BEGIN X IF wait then X rep := qio_1_char_now; X readln (ingraphedt,line); X qio_write (line); X END; X close (ingraphedt); X posn (1,1); X IF wait and ( rep = chr(-1) ) then X rep := qio_1_char; X END X ELSE X BEGIN X clear; X posn (18,10); X qio_write ('couldn''t find filename .... '+filename); X posn (28,20); X qio_write (VT100_Bright+'Press <'+VT100_Flash+'Return'+VT100_normal+V VT100_bright+'>'+VT100_normal); X posn (1,1); X IF ( rep = chr(-1) ) then X rep := qio_1_char; X END; X reset_screen; XEND; X XEND. $ CALL UNPACK SHOW_GRAPHEDT.PAS;1 893603068 $ create 'f' X`5B X Inherit X ('SYS$LIBRARY:STARLET'), X Environment X ('SIGN.PEN') X`5D X XMODULE SIGN; X X`5BGLOBAL`5D XFUNCTION Sign ( n : integer ) : integer; XBEGIN X IF n < 0 then X sign := -1 X ELSE X IF n > 0 then X sign := 1 X ELSE X sign := 0; XEND; X XEND. $ CALL UNPACK SIGN.PAS;1 1950222027 $ 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`5B X Inherit X ('SYS$LIBRARY:STARLET','SYS$LIBRARY:PASCAL$LIB_ROUTINES','ERROR'), X Environment X ('SLEEP.PEN') X`5D X XMODULE SLEEP; X X`5BHIDDEN`5D XTYPE X X $QUAD = `5BQUAD,UNSAFE`5D RECORD X L0:UNSIGNED; L1:INTEGER; END; X v_array = varying `5B256`5D of char; X X`5BHIDDEN`5D XVAR X efn : `5BVOLATILE`5D unsigned; X initialized : boolean; X X X`5BHIDDEN`5D XPROCEDURE Initialise; XBEGIN X initialized := true; X lib$get_ef (efn); X IF efn = -1 then X ERROR ('%INTERACT-SLEEP_START_INITIALIZE, No Event Flag Avaliable.'); XEND; X X`5BGLOBAL`5D XPROCEDURE Sleep_start ( interval : integer ); XVAR X delta_timer_alarm : $quad; X ret_status : integer; XBEGIN X IF not initialized then X initialise; X X IF interval > 0 then X BEGIN X ret_status := LIB$EMUL (interval, -100000, 0, delta_timer_alarm); X IF not odd(ret_status) then X LIB$SIGNAL(ret_status); X ret_status := $setimr (efn:=efn,daytim:=delta_timer_alarm); X IF not odd(ret_status) then X LIB$SIGNAL(ret_status); X END; XEND; X X X`5BGLOBAL`5D XPROCEDURE Sleep_wait; XVAR X ret_status : integer; XBEGIN X ret_status := $waitfr (efn:=efn); X IF not odd(ret_status) then X LIB$SIGNAL(ret_status); XEND; X X X`5BGLOBAL`5D XPROCEDURE Sleep ( sec : integer := 0; frac : `5BTRUNCATE`5D real ); XVAR X Hundredths : integer; X delta_wake_time : $quad; X ret_status : integer; XBEGIN X Hundredths := sec*100; X IF PRESENT(frac) then X Hundredths := Hundredths + round(frac*100); X IF ( hundredths > 0 ) then X BEGIN X ret_status := LIB$EMUL (Hundredths, -100000, 0, delta_wake_time); X IF not odd(ret_status) then X LIB$SIGNAL(ret_status); X ret_status := $Schdwk ( daytim := delta_wake_time ); X IF not odd(ret_status) then X LIB$SIGNAL(ret_status) X ELSE X BEGIN X ret_status := $Hiber; X IF not odd(ret_status) then X LIB$SIGNAL(ret_status); X END; X END; XEND; X XEND. $ CALL UNPACK SLEEP.PAS;1 2104853131 $ create 'f' X`5B X Inherit X ('VT100','QIO_WRITE','POSN'), X Environment X ('SMART_POSN.PEN') X`5D X XMODULE SMART_POSN; X X`5BHIDDEN`5D XTYPE X v_array = varying `5B256`5D of char; X X`5BHIDDEN`5D XVAR X Smart_Cursor : Record X C_x : integer; X C_y : integer; X End; X X`5BGLOBAL`5D XPROCEDURE Smart_Posn ( to_x, to_y : integer; VAR init : boolean ); XVAR X smart_sequence : `5BSTATIC`5D Array `5B-3..2,-2..2`5D of v_array X := (`7Bx=-3`7D (VT100_ESC+'`5B2A'+VT100_bs+VT100_bs+VT100_bs, X VT100_ESC+'M'+VT100_bs+VT100_bs+VT100_bs, X VT100_bs+VT100_bs+VT100_bs, X VT100_LF+VT100_bs+VT100_bs+VT100_bs, X VT100_LF+VT100_LF+VT100_bs+VT100_bs+VT100_bs), X `7Bx=-2`7D (VT100_ESC+'`5B2A'+VT100_bs+VT100_bs, X VT100_ESC+'M'+VT100_bs+VT100_bs, X VT100_bs+VT100_bs, X VT100_LF+VT100_bs+VT100_bs, X VT100_LF+VT100_LF+VT100_bs+VT100_bs), X `7Bx=-1`7D (VT100_ESC+'`5B2A'+VT100_bs, X VT100_ESC+'M'+VT100_bs, X VT100_bs, X VT100_LF+VT100_bs, X VT100_LF+VT100_LF+VT100_bs), X `7Bx= 0`7D (VT100_ESC+'`5B2A', X VT100_ESC+'M', X '', X VT100_LF, X VT100_LF+VT100_LF), X `7Bx=+1`7D (VT100_ESC+'`5B2A'+VT100_ESC+'`5BC', X VT100_ESC+'M'+VT100_ESC+'`5BC', X VT100_ESC+'`5BC', X VT100_LF+VT100_ESC+'`5BC', X VT100_LF+VT100_LF+VT100_ESC+'`5BC'), +-+-+-+-+-+-+-+- END OF PART 5 +-+-+-+-+-+-+-+-