-+-+-+-+-+-+-+-+ START OF PART 6 -+-+-+-+-+-+-+-+ X `7Bx=+2`7D (VT100_ESC+'`5B2A'+VT100_ESC+'`5B2C', X VT100_ESC+'M'+VT100_ESC+'`5B2C', X VT100_ESC+'`5B2C', X VT100_LF+VT100_ESC+'`5B2C', X VT100_LF+VT100_LF+VT100_ESC+'`5B2C')); X dx, dy : integer; XBEGIN X IF clear_interlocked(init) then X posn (to_x,to_y) X ELSE X BEGIN X dx := to_x - Smart_Cursor.c_x; X dy := to_y - Smart_Cursor.c_y; X IF ( dx >= -3 ) and ( dx <= 2 ) and ( abs(dy) <= 2 ) then X qio_write (smart_sequence`5Bdx,dy`5D) X ELSE X posn (to_x,to_y); X END; X Smart_Cursor.C_x := to_x; X Smart_Cursor.C_y := to_y; XEND; X X X`5BGLOBAL`5D XPROCEDURE Smart_qio_write ( str : v_array ); XBEGIN X Smart_Cursor.C_x := min(80,Smart_Cursor.C_x + str.length); X qio_write (str); XEND; X X X`5BGLOBAL`5D XPROCEDURE Smart_shift ( i : integer ); XBEGIN X Smart_Cursor.C_x := min(80,Smart_Cursor.C_x + i); XEND; X `20 XEND. $ CALL UNPACK SMART_POSN.PAS;1 2119434463 $ create 'f' X`5B X Inherit X ('QIO_WRITE','GET_POSN','ERROR','VT100'), X Environment X ('SQUARE.PEN') X`5D X XMODULE SQUARE; X X`5BHIDDEN`5D XTYPE X v_array = varying `5B256`5D of char; X X`5BGLOBAL`5D XPROCEDURE Square ( x1 , y1 , x2 , y2 : integer ); XVAR X i : integer; X sx : v_array; X buffer : v_array; XBEGIN X IF ( x1 > x2 - 1 ) or ( y1 > y2 - 1 ) then X ERROR ('%INTERACT-SQUARE, Top Corner Bottom Corner Overlap'); X IF ( abs(x2-x1) > 132 ) then X ERROR ('%INTERACT-SQUARE, Size Error delta x distance too large.'); X IF ( abs(y2-y1) > 24 ) then X ERROR ('%INTERACT-SQUARE, Size Error delta y distance too large.'); X X buffer := get_posn (x1,y1) + VT100_graphics_on + 'l'; X FOR i := x1+1 to x2-1 do X buffer := buffer + 'q'; X buffer := buffer + 'k'; X qio_write (buffer); X writev(sx,x2-x1-1:1); X sx := 'x' + VT100_ESC + '`5B' + sx + 'C' + 'x'; X FOR i := y1+1 to y2-1 do X qio_write ( get_posn(x1,i)+ sx ); X buffer := get_posn (x1,y2) + 'm'; X IF ( x1 < x2 - 1 ) then X FOR i := x1+1 to x2-1 do X buffer := buffer + 'q'; X buffer := buffer + 'j' + VT100_graphics_off; X qio_write (buffer); XEND; X XEND. $ CALL UNPACK SQUARE.PAS;1 572125355 $ create 'f' X`5B X Inherit X ('SYS$LIBRARY:STARLET','SYS$LIBRARY:PASCAL$LIB_ROUTINES'), X Environment X ('STOPWATCH.PEN') X`5D X XMODULE STOPWATCH; X X`5BHIDDEN`5D XTYPE X $UWORD = `5BWORD`5D 0..65535; X v_array = varying `5B256`5D of char; X date_time_type = array `5B1..7`5D of $uword; X X`5BHIDDEN`5D XVAR X start_date_time : `5BGLOBAL`5D date_time_type; X stop_date_time : `5BGLOBAL`5D date_time_type; X X X`5BGLOBAL`5D XPROCEDURE Start_stopwatch; XVAR X ret_status : integer; XBEGIN X ret_status := $numtim (start_date_time); X IF not odd(ret_status) then X LIB$SIGNAL(ret_status); XEND; X X X`5BGLOBAL`5D XFUNCTION Stop_stopwatch : v_array; XVAR X temp : date_time_type; X ret_status : integer; X i : integer; X s : array `5B4..7`5D of v_array; XBEGIN X ret_status := $numtim (stop_date_time); X IF not odd(ret_status) then X LIB$SIGNAL(ret_status); X X FOR i := 7 downto 5 do X IF ( stop_date_time`5Bi`5D - start_date_time`5Bi`5D ) < 0 then X stop_date_time`5Bi-1`5D := stop_date_time`5Bi-1`5D - 1; X X IF ( stop_date_time`5B7`5D - start_date_time`5B7`5D ) < 0 then X stop_date_time`5B7`5D := stop_date_time`5B7`5D + 100; X IF ( stop_date_time`5B6`5D - start_date_time`5B6`5D ) < 0 then X stop_date_time`5B6`5D := stop_date_time`5B6`5D + 60; X IF ( stop_date_time`5B5`5D - start_date_time`5B5`5D ) < 0 then X stop_date_time`5B5`5D := stop_date_time`5B5`5D + 60; X IF ( stop_date_time`5B4`5D - start_date_time`5B4`5D ) < 0 then X stop_date_time`5B4`5D := stop_date_time`5B4`5D + 24; X X FOR i := 4 to 7 do X BEGIN X temp`5Bi`5D := stop_date_time`5Bi`5D - start_date_time`5Bi`5D; X writev (s`5Bi`5D,temp`5Bi`5D:1); X IF s`5Bi`5D.length=1 then X s`5Bi`5D := '0' + s`5Bi`5D; X END; X X stop_stopwatch := s`5B4`5D + ':' + s`5B5`5D + ':' + s`5B6`5D + '.' + s`5B7 V`5D; XEND; X XEND. $ CALL UNPACK STOPWATCH.PAS;1 87379337 $ create 'f' X`5B X Inherit X ('SYS$LIBRARY:STARLET'), X Environment X ('SWAP.PEN') X`5D X XMODULE SWAP; X X`5BGLOBAL`5D XPROCEDURE Swap ( VAR i, j : integer ); XVAR X temp : integer; XBEGIN X temp := j; X j := i; X i := temp; XEND; X XEND. $ CALL UNPACK SWAP.PAS;1 1650724562 $ create 'f' X`5B X Inherit X ('SYS$LIBRARY:STARLET','SYS$LIBRARY:PASCAL$LIB_ROUTINES'), X Environment X ('SYSCALL.PEN') X`5D X XMODULE SYSCALL; X X`5BGLOBAL`5D XPROCEDURE TERMINATE ( code : integer := 1 ); XBEGIN X $EXIT ( code ); XEND; X X`5BGLOBAL`5D XPROCEDURE KILL ( PID : `5BTRUNCATE`5D UNSIGNED ); XVAR X ret_status : integer; XBEGIN X IF PRESENT(PID) then X ret_status := $DELPRC(pidadr:=PID) X ELSE X ret_status := $DELPRC; X IF not odd(ret_status) then X LIB$SIGNAL(ret_status); XEND; X XEND. $ CALL UNPACK SYSCALL.PAS;1 1947671753 $ create 'f' X`5B X Inherit`20 X ('SYS$LIBRARY:STARLET','VT100','QIO_WRITE','CLEAR','POSN','GET_POSN','QI VO_READ_VARYING','RESET_SCREEN','TRIM','DAYTIME','DEC','GET_JPI','SLEEP'), X Environment`20 X ('TOPTEN.PEN')`20 X`5D X XMODULE Topten ( infile ,output); X`5BHIDDEN`5D XCONST X%include 'sys$library:passtatus.pas' `7BStatus values for PASCAL IO - WWB`7D X X`5BHIDDEN`5D XTYPE X v_array = varying `5B256`5D of char; X u_array = varying `5B8`5D of char; X s_array = varying `5B12`5D of char; X everything = Record X tot_games : integer; X month : integer; X m_user : array `5B1..12`5D of u_array; X m_name : array `5B1..12`5D of s_array; X m_score : array `5B1..12`5D of integer; X user : array `5B0..19`5D of u_array; X name : array `5B0..19`5D of s_array; X score : array `5B0..19`5D of integer; X games : array `5B0..19`5D of integer; X End; X`5BHIDDEN`5D XVAR X infile : File of everything; X filerec : everything; X X`5BGLOBAL`5D XPROCEDURE top_ten ( this_score : integer ); XVAR X last_score : integer; X directory : v_array; X gamename : v_array; X username : v_array; X year_now : integer; X month_now : integer; X i,j,k, me : integer; X old_name : s_array; X old_games : integer; X X PROCEDURE Get_Image_dir_and_ACN_name ( VAR directory, gamename : v_arra Vy ); X VAR X the_name : v_array; X BEGIN X the_name := Get_jpi(jpi$_imagname,100); 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 directory := substr(the_name,1,index(the_name,'`5D')); X the_name := substr(the_name,index(the_name,'`5D')+1,the_name.length-in Vdex(the_name,'`5D')); X gamename := substr(the_name,1,index(the_name,'.')-1); X END; X X FUNCTION month_of_year ( i : integer ) : v_array; X BEGIN X month_of_year := substr('JanFebMarAprMayJunJulAugSepOctNovDec',(i*3)-2 V,3); X END; X XBEGIN X reset_screen; X clear; X posn (1,1); X X username := Get_jpi(jpi$_username,8); X Get_Date_time;`20 X year_now := date_time`5B1`5D; X month_now := date_time`5B2`5D; X X Get_Image_dir_and_ACN_name (directory,gamename); X X REPEAT X OPEN (infile,directory+gamename+'.ACN',old,,direct,sharing:=readwrite, X error:=continue); X CASE status(infile) of X PAS$K_SUCCESS : ; X PAS$K_FILNOTFOU : BEGIN X qio_writeln ('Can''t find file '+gamename+'.ACN Creating New Fil Ve ...'); X OPEN(infile,directory+gamename+'.ACN',new,,direct, X sharing:=readwrite,error:=continue); X IF status(infile) <> 0 THEN X BEGIN X qio_writeln ('Can''t Create '+gamename+'.ACN Insufficient pr Viviledge.'); X $exit(1); X END; X rewrite (infile); X X infile`5E.tot_games := 0; X infile`5E.month := month_now; X FOR i := 1 to 12 do X infile`5E.m_user`5Bi`5D := ' '; X FOR i := 1 to 12 do X infile`5E.m_name`5Bi`5D := ' '; X FOR i := 1 to 12 do X infile`5E.m_score`5Bi`5D := -maxint-1; X FOR i := 0 to 19 do X infile`5E.user`5Bi`5D := ' '; X FOR i := 0 to 19 do X infile`5E.name`5Bi`5D := ' '; X FOR i := 0 to 19 do X infile`5E.score`5Bi`5D := -maxint-1; X infile`5E.games := zero; X X put (infile); X reset (infile); X END; X PAS$K_ACCMETINC, X PAS$K_RECLENINC : BEGIN X qio_writeln ('Error in file format of '+gamename+'.ACN'); X $exit(1); X END; X OTHERWISE X BEGIN X sleep (1); X clear; X Posn(1,1); X qio_writeln (trim(Username)+', Please Wait ...'); X END; X END; X UNTIL status(infile)=PAS$K_SUCCESS; X X REPEAT X reset (infile,error:=continue); X UNTIL (status(infile)<>PAS$K_FAIGETLOC); X X`7B high score for the month `7D X X infile`5E.tot_games := infile`5E.tot_games + 1; X IF ( infile`5E.month <> month_now ) and ( infile`5E.month <> 0 ) then X BEGIN X infile`5E.m_user`5Binfile`5E.month`5D := infile`5E.user`5B0`5D; X infile`5E.m_name`5Binfile`5E.month`5D := infile`5E.name`5B0`5D; X infile`5E.m_score`5Binfile`5E.month`5D := infile`5E.score`5B0`5D; X FOR i := 0 to 19 do X infile`5E.user`5Bi`5D := ' '; X FOR i := 0 to 19 do X infile`5E.name`5Bi`5D := ' '; X FOR i := 0 to 19 do X infile`5E.score`5Bi`5D := -maxint-1; X infile`5E.games := zero; X END; X infile`5E.month := month_now; X X`7B insert/find user somewhere `7D X X i := 0; X WHILE ( i<19 ) and ( infile`5E.user`5Bi`5D<>username ) do X i := i + 1; X IF ( infile`5E.user`5Bi`5D<>username ) then X BEGIN X infile`5E.user`5Bi`5D := username; X infile`5E.name`5Bi`5D := ' '; X infile`5E.score`5Bi`5D := -maxint-1; X infile`5E.games`5Bi`5D := 0; X END; X last_score := infile`5E.score`5Bi`5D; X infile`5E.games`5Bi`5D := infile`5E.games`5Bi`5D + 1; X me := i; X X`7B move user up `7D X X IF this_score > infile`5E.score`5Bi`5D then X BEGIN X j := 0; X WHILE this_score <= infile`5E.score`5Bj`5D do X j := j + 1; X IF j < i then X BEGIN X old_name := infile`5E.name`5Bi`5D; X old_games := infile`5E.games`5Bi`5D; X FOR k := i downto j+1 do X BEGIN X infile`5E.user`5Bk`5D := infile`5E.user`5Bk-1`5D; X infile`5E.name`5Bk`5D := infile`5E.name`5Bk-1`5D; X infile`5E.score`5Bk`5D := infile`5E.score`5Bk-1`5D; X infile`5E.games`5Bk`5D := infile`5E.games`5Bk-1`5D; X END; X infile`5E.user`5Bj`5D := username; X infile`5E.name`5Bj`5D := old_name; X infile`5E.games`5Bj`5D := old_games; X me := j; X END; X infile`5E.score`5Bme`5D := this_score; X END; X X`7B display this `7D X X clear; X posn (1,1); X qio_write ('Immortal Players For '+dec(year_now-1)+' - '+dec(year_now)+' V Top Players For '+month_of_year(month_now)+' '); X qio_writeln (VT100_bright+dec(infile`5E.tot_games,,6)+' Games'+VT100_norma Vl); X qio_writeln (VT100_graphics_on+'oooooooooooooooooooooooooooooooo V ooooooooooooooooooo'+VT100_graphics_off); X qio_writeln ('Month Username Name Score Num Username Name V Score Games'); X qio_writeln; X X For i := month_now-1 downto 1 do X IF ( infile`5E.m_score`5Bi`5D <> -maxint-1 ) then X qio_writeln (' '+month_of_year(i)+' '+infile`5E.m_user`5Bi`5D+' '+i Vnfile`5E.m_name`5Bi`5D+' '+dec(infile`5E.m_score`5Bi`5D,,5)); X For i := 12 downto month_now do X IF ( infile`5E.m_score`5Bi`5D <> -maxint-1 ) then X qio_writeln (' '+month_of_year(i)+' '+infile`5E.m_user`5Bi`5D+' '+i Vnfile`5E.m_name`5Bi`5D+' '+dec(infile`5E.m_score`5Bi`5D,,5)); X X For i := 0 to 11 do X IF ( infile`5E.score`5Bi`5D <> -maxint-1 ) then X qio_write (get_posn(41,5+i)+dec(i+1,,3)+' '+infile`5E.user`5Bi`5D+' ' V+infile`5E.name`5Bi`5D+' '+dec(infile`5E.score`5Bi`5D,,5)+' '+dec(infile`5 VE.games`5Bi`5D,,3)); X X posn (5,18); X qio_write ('You Are Seated At '+dec(me+1)+' In '+gamename); X IF ( last_score = -maxint-1 ) AND ( me < 12 ) THEN X BEGIN X `7B on board first game `7D X posn (5,20); X qio_writeln (VT100_bright+'Enter Your Name `5B Return to Leave `5D'+VT V100_normal); X posn (42,18); X qio_writeln ('Current Score '+dec(this_score)); X END X ELSE X IF ( last_score = -maxint-1 ) THEN X BEGIN X `7B first game not on board `7D X posn (42,18); X qio_writeln ('Current Score '+dec(this_score)); X END X ELSE X IF ( last_score < this_score ) and ( me < 12 ) THEN X BEGIN X `7B on board and doing better `7D X posn (42,18); X qio_write ('Previous Score '+dec(last_score)); X posn (5,20); X qio_writeln (VT100_bright+'Enter Your Name `5B Return to Leave `5D'+VT V100_normal); X posn (42,20); X qio_writeln ('Current Score '+dec(this_score)); X END X ELSE X BEGIN X `7B doing worse on or off board or better but still off board `7D X posn (42,18); X qio_writeln ('Previous Score '+dec(last_score)); X posn (42,20); X qio_writeln ('Current Score '+dec(this_score)); X END; X X IF (( last_score < this_score ) or ( last_score = -maxint-1 ))`20 X AND ( me < 12 ) THEN X BEGIN X posn (55,5+me); X infile`5E.name`5Bme`5D := QIO_read_varying (12); X infile`5E.name`5Bme`5D.length := 12; X END; X X filerec := infile`5E; X REPEAT X rewrite (infile,error:=continue); X until (status(infile)<>PAS$K_ERRDURREW); X infile`5E := filerec; X REPEAT X Put (infile); +-+-+-+-+-+-+-+- END OF PART 6 +-+-+-+-+-+-+-+-