-+-+-+-+-+-+-+-+ START OF PART 3 -+-+-+-+-+-+-+-+
X        source_str      : `5BCLASS_S`5D PACKED ARRAY `5B$L2 .. $U2 : INTEGER
V`5D OF CHAR;
X    VAR return_length   : $UWORD
X  ) : integer;
XExtern;
X
X`5BGLOBAL`5D
XFUNCTION  Trim ( text : v_array ) : v_array;
XBEGIN
X  System_Call ($trim (text.body,text,text.length));
X  trim := text;
XEND;
X
XTYPE
X  date_time_type = array `5B1..7`5D of $uword;
X
X
X`5BASYNCHRONOUS, EXTERNAL(LIB$DAY_OF_WEEK)`5D
XFUNCTION  $Day_of_week
X    (
X        time     : $quad := %IMMED 0;
X    VAR day_num  : integer
X    ) : integer;
XExtern;
X
X
X`5BGLOBAL`5D
XFUNCTION  Get_Date_time : date_time_type;
XVAR
X  Date_time : date_time_type;
XBEGIN
X  System_Call ($numtim (date_time));
X  get_date_time := date_time;
XEND;
X
X
X`5BGLOBAL`5D
XFUNCTION  Day_num ( Date_Time : date_time_type ) : integer;
XVAR
X  temp : integer;
X  q : $quad;
XBEGIN
X  System_Call ($gettim(q));
X  System_Call ($day_of_week(q,temp));
X  day_num := temp;
XEND;
X
X
X`5BHIDDEN`5D
XCONST
X(* These values are returned by the predefined STATUS function. *)
X
X    PAS$K_SUCCESS    =    0;    (* last operation successful *)
X    PAS$K_FILNOTFOU  =    3;    (* file not found *)
X    PAS$K_ACCMETINC  =    5;    (* ACCESS_METHOD specified is incompatible w
Vith this file *)
X    PAS$K_RECLENINC  =    6;    (* RECORD_LENGTH specified is inconsistent w
Vith this file *)
X
X`5BHIDDEN`5D
XTYPE
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  newfile : File of everything;
X  game_count_incremented : boolean := false;
X
X`5BHIDDEN`5D
XPROCEDURE  Get_Image_dir_and_ACN_name ( VAR directory, gamename : v_array );
XVAR
X  the_name : v_array;
XBEGIN
X  the_name := Get_jpi_str(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(the
V_name,index(the_name,'`5D`5B')+2,length(the_name)-(index(the_name,'`5D`5B')+
V2));
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-index(
Vthe_name,'`5D'));
X  gamename := substr(the_name,1,index(the_name,'.')-1);
XEND;
X
X`5BHIDDEN`5D
XFUNCTION  month_of_year ( i : integer ) : v_array;
XBEGIN
X  month_of_year := substr('JanFebMarAprMayJunJulAugSepOctNovDec',(i*3)-2,3);
XEND;
X
X`5BHIDDEN`5D
XPROCEDURE  Display_Screen ( current_state : everything; date_time : date_tim
Ve_type; me : integer; gamename : v_array; last_score : integer );
XVAR
X  i : integer;
X  year_now  : integer;
X  month_now : integer;
XBEGIN
X  year_now  := date_time`5B1`5D;
X  month_now := date_time`5B2`5D;
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(current_state.tot_games,,6)+' Games'+VT100_
Vnormal);
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 ( current_state.m_score`5Bi`5D <> -maxint-1 ) then
X      qio_writeln (' '+month_of_year(i)+'   '+current_state.m_user`5Bi`5D+'
V  '+current_state.m_name`5Bi`5D+' '+_dec(current_state.m_score`5Bi`5D,,5))
X    ELSE
X      qio_writeln;
X  For i := 12 downto month_now do
X    IF ( current_state.m_score`5Bi`5D <> -maxint-1 ) then
X      qio_writeln (' '+month_of_year(i)+'   '+current_state.m_user`5Bi`5D+'
V  '+current_state.m_name`5Bi`5D+' '+_dec(current_state.m_score`5Bi`5D,,5))
X    ELSE
X      qio_writeln;
X
X  For i := 0 to 11 do
X    IF ( current_state.score`5Bi`5D <> -maxint-1 ) then
X      qio_write (get_posn(41,5+i)+_dec(i+1,,3)+' '+current_state.user`5Bi`5D
V+'  '+current_state.name`5Bi`5D+' '+_dec(current_state.score`5Bi`5D,,5)+'
V   '+_dec(current_state.games`5Bi`5D,,3));
X
X  posn (5,18);
X  qio_write ('You Are Seated At '+_dec(me+1)+' In '+gamename);
X
X  IF ( last_score <> -maxint-1 ) THEN
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    END;
XEND;
X
X`5BHIDDEN`5D
XPROCEDURE  Display_Current_Score (last_score : integer; this_score : integer
V );
XBEGIN
X  posn (42,20);
X  qio_writeln ('Current Score '+_dec(this_score));
XEND;
X
X`5BHIDDEN`5D
XPROCEDURE  Display_Update_Prompts (me : integer; last_score : integer; this_
Vscore : integer );
XBEGIN
X  IF ( me < 12 ) THEN
X    BEGIN
X      posn (5,20);
X      qio_writeln (VT100_bright+'Enter Your Name `5B Return to Leave `5D'+VT
V100_normal);
X    END;
XEND;
X
X`5BHIDDEN`5D
XPROCEDURE  Create_new_score_file ( directory : v_array; gamename : v_array;
V date_time : date_time_type );
XVAR
X  i : integer;
X  month_now : integer;
XBEGIN
X  month_now := date_time`5B2`5D;
X  OPEN(newfile,directory+gamename+'.ACN',new,,direct,error:=continue);
X  IF status(newfile) <> PAS$K_SUCCESS THEN
X    BEGIN
X      qio_writeln ('Can''t Create '+gamename+'.ACN Insufficient priviledge.'
V);
X      $exit(1);
X    END;
X  rewrite (newfile);
X  newfile`5E.tot_games := 0;
X  newfile`5E.month     := month_now;
X  FOR i := 1 to 12 do
X    BEGIN
X      newfile`5E.m_user`5Bi`5D := '        ';
X      newfile`5E.m_name`5Bi`5D := '            ';
X      newfile`5E.m_score`5Bi`5D := -maxint-1;
X    END;
X  FOR i := 0 to 19 do
X    BEGIN
X      newfile`5E.user`5Bi`5D := '        ';
X      newfile`5E.name`5Bi`5D := '            ';
X      newfile`5E.score`5Bi`5D := -maxint-1;
X    END;
X  newfile`5E.games := zero;
X  put (newfile);
X  close (newfile);
XEND;
X
X`5BHIDDEN`5D
XPROCEDURE  Update_Topten ( VAR current_state : everything;`20
X                            date_time : date_time_type;`20
X                            username : v_array;`20
X                            this_score : integer;`20
X                        VAR me : integer;`20
X                        VAR last_score : integer;`20
X                            newname : `5BTRUNCATE`5D s_array );
XVAR
X  i, j, k : integer;
X  old_name  : s_array;
X  old_games : integer;
X  month_now : integer;
XBEGIN
X  `7B high score for the month `7D
X  month_now := date_time`5B2`5D;
X
X  if not game_count_incremented then
X    current_state.tot_games := current_state.tot_games + 1;
X  IF ( current_state.month <> month_now ) and ( current_state.month <> 0 ) t
Vhen
X    BEGIN
X      if month_now > current_state.month then
X        FOR i := current_state.month to month_now-1 do
X          BEGIN
X            newfile`5E.m_user`5Bi`5D := '        ';
X            newfile`5E.m_name`5Bi`5D := '            ';
X            newfile`5E.m_score`5Bi`5D := -maxint-1;
X          END
X      else
X        BEGIN
X          FOR i := current_state.month to 12 do
X            BEGIN
X              newfile`5E.m_user`5Bi`5D := '        ';
X              newfile`5E.m_name`5Bi`5D := '            ';
X              newfile`5E.m_score`5Bi`5D := -maxint-1;
X            END;
X          IF month_now-1 >= 1 THEN
X            FOR i := 1 to month_now-1 do
X              BEGIN
X                newfile`5E.m_user`5Bi`5D := '        ';
X                newfile`5E.m_name`5Bi`5D := '            ';
X                newfile`5E.m_score`5Bi`5D := -maxint-1;
X              END;
X        END;
X      current_state.m_user`5Bcurrent_state.month`5D := current_state.user`5B
V0`5D;
X      current_state.m_name`5Bcurrent_state.month`5D := current_state.name`5B
V0`5D;
X      current_state.m_score`5Bcurrent_state.month`5D := current_state.score`
V5B0`5D;
X      FOR i := 0 to 19 do
X        BEGIN
X          current_state.user`5Bi`5D := '        ';
X          current_state.name`5Bi`5D := '            ';
X          current_state.score`5Bi`5D := -maxint-1;
X        END;
X      current_state.games := zero;
X    END;
X  current_state.month := month_now;
X
X`7B insert/find user somewhere `7D
X
X  i := 0;
X  WHILE ( i<19 ) and ( current_state.user`5Bi`5D<>username ) do
X    i := i + 1;
X  IF ( current_state.user`5Bi`5D<>username ) then
X    BEGIN
X      current_state.user`5Bi`5D := username;
X      current_state.name`5Bi`5D := '            ';
X      current_state.score`5Bi`5D := -maxint-1;
X      current_state.games`5Bi`5D := 1;
X    END
X  ELSE
X    if not game_count_incremented then
X      current_state.games`5Bi`5D := current_state.games`5Bi`5D + 1;
X  last_score := current_state.score`5Bi`5D;
X  me := i;
X
X`7B move user up `7D
X
X  IF this_score > current_state.score`5Bi`5D then
X    BEGIN
X      j := 0;
X      WHILE this_score <= current_state.score`5Bj`5D do
X        j := j + 1;
X      IF j < i then
X        BEGIN
X          old_name := current_state.name`5Bi`5D;
X          old_games := current_state.games`5Bi`5D;
X          FOR k := i downto j+1 do
X            BEGIN
X              current_state.user`5Bk`5D := current_state.user`5Bk-1`5D;
X              current_state.name`5Bk`5D := current_state.name`5Bk-1`5D;
X              current_state.score`5Bk`5D := current_state.score`5Bk-1`5D;
X              current_state.games`5Bk`5D := current_state.games`5Bk-1`5D;
X            END;
X          current_state.user`5Bj`5D := username;
X          current_state.name`5Bj`5D := old_name;
X          current_state.games`5Bj`5D := old_games;
X          me := j;
X        END;
X      current_state.score`5Bme`5D := this_score;
X      IF present(newname) then
X        current_state.name`5Bme`5D := newname;
X    END;
XEND;
X
X`5BGLOBAL`5D
XPROCEDURE  increment_game_count;
XVAR
X  last_score : integer;
X  directory : v_array;
X  gamename  : v_array;
X  username  : v_array;
X  i,j,k, me : integer;
X  newname : s_array;
X  current_state : everything;
X  date_time : date_time_type;
XBEGIN
X  username := Get_jpi_str(jpi$_username,8);
X  Get_Image_dir_and_ACN_name (directory,gamename);
X
X  REPEAT
X    OPEN (newfile,directory+gamename+'.ACN',old,,direct,error:=continue);
X    CASE status(newfile) of
X      PAS$K_SUCCESS,
X      PAS$K_FILNOTFOU,
X      PAS$K_ACCMETINC,
X      PAS$K_RECLENINC : ;
X      OTHERWISE sleep (1);
X    END;
X  UNTIL (status(newfile)=PAS$K_SUCCESS) or
X        (status(newfile)=PAS$K_FILNOTFOU) or
X        (status(newfile)=PAS$K_ACCMETINC) or
X        (status(newfile)=PAS$K_RECLENINC);
X
X  IF status(newfile)=PAS$K_SUCCESS THEN
X    BEGIN
X      reset (newfile);
X      current_state := newfile`5E;
X      date_time := Get_Date_time;`20
X      update_topten (current_state,date_time,username,-maxint-1,me,last_scor
Ve);
X      rewrite (newfile);
X      newfile`5E := current_state;
X      Put (newfile);
X      Close (newfile);
X      game_count_incremented := true;
X    END;
XEND;
X
X`5BGLOBAL`5D
XPROCEDURE  read_top_ten;
XVAR
X  last_score : integer;
X  directory : v_array;
X  gamename  : v_array;
X  username  : v_array;
X  i,j,k, me : integer;
X  newname : s_array;
X  current_state : everything;
X  date_time : date_time_type;
XBEGIN
X  reset_screen;
X  clear;
X  posn (1,1);
X
X  username := Get_jpi_str(jpi$_username,8);
X  Get_Image_dir_and_ACN_name (directory,gamename);
X
X  REPEAT
X    OPEN (infile,directory+gamename+'.ACN',old,,direct,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            date_time := Get_Date_time;`20
X            create_new_score_file(directory,gamename,date_time);
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 sleep (1);
X    END;
X  UNTIL status(infile)=PAS$K_SUCCESS;
X  reset (infile);
X  current_state := infile`5E;
X  close (infile);
X
X  date_time := Get_Date_time;`20
X  update_topten (current_state,date_time,username,-maxint-1,me,last_score);
X  Display_screen (current_state,date_time,me,gamename,last_score);
XEND;
X
X`5BGLOBAL`5D
XFUNCTION  read_last_score : integer;
XVAR
X  last_score : integer;
X  directory : v_array;
X  gamename  : v_array;
X  username  : v_array;
X  i,j,k, me : integer;
X  newname : s_array;
X  current_state : everything;
X  date_time : date_time_type;
XBEGIN
X  username := Get_jpi_str(jpi$_username,8);
X  Get_Image_dir_and_ACN_name (directory,gamename);
X  REPEAT
X    OPEN (infile,directory+gamename+'.ACN',old,,direct,error:=continue);
X    CASE status(infile) of
X      PAS$K_SUCCESS,
X      PAS$K_FILNOTFOU,
X      PAS$K_ACCMETINC,
X      PAS$K_RECLENINC : last_score := -maxint-1;
X      OTHERWISE sleep (1);
X    END;
X  UNTIL (status(infile)=PAS$K_SUCCESS) or
X        (status(infile)=PAS$K_FILNOTFOU) or
X        (status(infile)=PAS$K_ACCMETINC) or
X        (status(infile)=PAS$K_RECLENINC);
X `20
X  IF status(infile)=PAS$K_SUCCESS THEN
X    BEGIN
X      reset (infile);
X      current_state := infile`5E;
X      close (infile);
X      date_time := Get_Date_time;`20
X      update_topten (current_state,date_time,username,-maxint-1,me,last_scor
Ve);
X    END;
X  read_last_score := last_score;
XEND;
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  i,j,k, me : integer;
X  v_name : v_array;
X  newname : s_array;
X  current_state : everything;
X  date_time : date_time_type;
XBEGIN
X  reset_screen;
X  clear;
X  posn (1,1);
X
X  username := Get_jpi_str(jpi$_username,8);
X  Get_Image_dir_and_ACN_name (directory,gamename);
X
X  REPEAT
X    OPEN (infile,directory+gamename+'.ACN',old,,direct,error:=continue);
X    CASE status(infile) of
+-+-+-+-+-+-+-+-  END  OF PART 3 +-+-+-+-+-+-+-+-