home *** CD-ROM | disk | FTP | other *** search
/ Harvey Norman Games / HN.iso / SIMS / GOLF43.ZIP / GOLFSPEC.PAS < prev    next >
Pascal/Delphi Source File  |  1994-08-19  |  8KB  |  295 lines
  1. {Golfspecs-These specifications of types and variables
  2.            are used repeatedly by several programs}
  3. type
  4.     array255 = array[0..255] of byte;
  5.     real20 = array [1..20] of real;
  6.     holes = 1 .. 18;
  7.     scores = array[holes] of byte;
  8.     game_type = record
  9.       game_no : word;
  10.       hcp     : shortint;
  11.       score   : scores;
  12.       course_id: byte;
  13.       month   : byte;
  14.       day     : byte;
  15.       year    : word;
  16.     end;
  17.     game_file_type = file of game_type;
  18.     course_type = record
  19.                     rated_par : real;
  20.                     slope    : byte;
  21.                     card_par : scores;
  22.                     name : string[32];
  23.                     id   : byte;
  24.                   end;
  25.     course_file_type  = file of course_type;
  26.     golfer_type = record
  27.                     no_of_games: word;
  28.                     hcp        : real;
  29.                     last_20    : real20;
  30.                     name       : string[20];
  31.                     id         : byte;
  32.                   end;
  33.     golfer_file_type  = file of golfer_type;
  34.     option_type = (ViewCourses,SelectCourse,ViewGolfer,SelectGolfer,
  35.                   PostScore,CourseAnalysis,ProgramExit,EditGames);
  36.  
  37.   const
  38.     copyrite: string = 'Copyright (c) 1994  James W. Butler';
  39.     version : string = 'Golf - Version 4.3';
  40.     nobody : golfer_type =
  41.                (no_of_games:0;
  42.                hcp : 0;
  43.                last_20 : (0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0);
  44.                name : ' New Golfer name    ';
  45.                id   : 0);
  46.     nowhere : course_type =
  47.                (rated_par:0;
  48.                slope    : 113;
  49.                card_par : (0,0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0,0);
  50.                name : ' New Course name               ';
  51.                id   : 0);
  52.     max_golfer_box : byte = 15;
  53.     max_course_box : byte = 15;
  54.     space20        : string[20] = '                    ';
  55.     mono           : boolean = false;
  56.     max_holes      : byte = 18;
  57.     max_diffs      : byte = 20;
  58.     percent        : byte = 96;
  59.     use_slope      : boolean = false;
  60.     adj_score_rule : byte = 3;
  61.     first_game_no  : word = 0;
  62.     last_game_no   : word = 0;
  63.     last_club_id   : byte = 0;
  64.  
  65.   var
  66.     cx         : array255;  {Too bad I can't use initialized}
  67.     gx         : array255;  { constants instead of "255"    }
  68.     front,back : byte;
  69.     color      : boolean;
  70.     regs       : registers;
  71.     golfers    : golfer_file_type;
  72.     courses    : course_file_type;
  73.     game_file,old
  74.                : game_file_type;
  75.     default    : text;
  76.     club       : course_type;
  77.     golfer     : golfer_type;
  78.     course_hiline, course_over_top,
  79.     golfer_hiline, golfer_over_top : byte;
  80.     prev_game,
  81.     curr_game  : game_type;
  82.     esc_score  : scores;
  83.     eq_sum     : real;
  84.     hole       : shortint;
  85.     card_par   : byte;
  86.     Year,Month,Day,DayofWeek
  87.                : word;
  88.     id         : byte;
  89.     option     : option_type;
  90.     xloc,yloc  : byte;
  91.     ch         : char;
  92.     AntiHcp    : real;
  93.     pstring    : string;
  94.     code       : integer;
  95.     s          : string[4];
  96.     printing   : boolean;
  97.     errcode    : integer;
  98.  
  99.  {Preserved between runs in golf.ini }
  100.     course_id, golfer_id,
  101.     golfer_view, course_view : byte;
  102.  
  103. {   The Hex procedure has been deleted by being made a big comment,
  104.       but left for re-activation if desired.
  105.  
  106. procedure Hex(var x : string ; y : longint);
  107.  const
  108.    c:string = ('0123456789ABCDEF');
  109.  var
  110.    z,zz  : longint;
  111.    L,i   : byte;
  112.    minus : boolean;
  113.  begin
  114.    minus := (y < 0);
  115.    L := length(x);
  116.    z := abs(y);
  117.    x := '';
  118.    repeat
  119.    begin
  120.      zz := z mod 16;
  121.      x := c[(zz mod 16) + 1] + x;
  122.      z := z div 16;
  123.    end;
  124.    until (z = 0) and (length(x) >= L);
  125.    if minus then x[1] := chr(ord(x[1]) + 8);
  126.  end;
  127. }
  128.  
  129.  
  130. Procedure Box (var Xloc,yloc:byte;
  131.               width,height:byte;
  132.               name:string);
  133.  
  134.   Procedure Edge(left_corner,right_corner:char;width:byte);
  135.     var
  136.       i : byte;
  137.     begin
  138.       Write(left_corner);
  139.       for I := 2 to width - 1 do Write('─');
  140.       Writeln(right_corner);
  141.     end;  {Edge}
  142.  
  143.   const
  144.    upper_left = '┌';
  145.    upper_right = '┐';
  146.    lower_left = '└';
  147.    lower_right = '┘';
  148.  
  149.   var
  150.     i:byte;
  151.     box_width, box_height :byte;
  152.     ch : char;
  153.   begin
  154.     if color then TextColor(yellow);
  155.     if color then TextBackground(green);
  156.     box_width := width + 3;  {allows an extra space for linefeed in fillbox}
  157.     if (xloc + box_width) > 80 then xloc := 80 - box_width;
  158.     box_height := height+ 2;
  159.     if (yloc + box_height) > 25 then yloc := 25 - box_height;
  160.     Window(xloc,yloc,xloc+box_width,yloc+box_height);
  161.     Edge(upper_left,upper_right,box_width);
  162.     GotoXY((box_width + 1 - length(name)) div 2,1);
  163.     Writeln(name);
  164.     for i := 2 to box_height-1 do
  165.     begin
  166.        GotoXY(1,i);
  167.        Write('│');
  168.        GotoXY(box_width,i);
  169.        Writeln('│');
  170.     end;
  171.     GotoXY(1,box_height);
  172.     Edge(lower_left,lower_right,box_width);
  173.     Window (xloc + 1, yloc + 1, xloc + width + 1, yloc + height);
  174.     ClrScr;
  175.   end;   {Box}
  176.  
  177.  
  178. function GetNum(var status:char; defalt,limit:integer):integer;
  179. {This version is designed for only two digit numbers > 0 }
  180. var
  181.   ch         : char;
  182.   n          : integer;
  183.   x,y        : integer;
  184.   minus      : boolean;
  185. begin
  186.   x      := WhereX;
  187.   y      := WhereY;
  188.   n      := defalt;
  189.   status := ' ';
  190.   repeat
  191.     ch := ReadKey;
  192.     case ch of
  193.       #0:   begin
  194.               ch := ReadKey;
  195.               if (status in [' ',#0]) then
  196.               case ch of
  197.                 'H':   {Up arrow}
  198.                   n := n + 1;
  199.                 'P':   {Down arrow}
  200.                   if n > 0 then n := n - 1;
  201.                 '-':   {Alt-x}
  202.                   begin
  203.                     option := ProgramExit;
  204.                     exit;
  205.                   end;
  206.                 else   {Not Up or Down arrow}
  207.                   status := char(Ord(ch) + 128)
  208.                 end; {case}
  209.               if (ch in ['H','P'])
  210.                  then status := #0;
  211.             end;     {Extended key }
  212.       '0'..'9':
  213.           begin
  214.             if status = ' ' then
  215.             begin
  216.              status := #0;
  217.              n := 0;
  218.             end;
  219.           n := 10*n + Ord(ch) - Ord('0');
  220.           end;
  221.        #8:
  222.          begin  {backspace}
  223.            if x < WhereX
  224.              then
  225.                begin
  226.                  GotoXY(WhereX - 1,WhereY);
  227.                  Write(' ');
  228.                  GotoXY(WhereX - 1,WhereY);
  229.                  n := n div 10;
  230.                end;
  231.          end;  {backspace}
  232.  
  233.        {All others  ... not digit, B/S, or up/down arrow}
  234.         else
  235.           begin
  236.             status := ch;
  237.             GetNum := n;
  238.             exit;
  239.           end;  {'Others', including c/r or esc}
  240.       end; {of case statement}
  241.       n := n mod limit;
  242.       if n = 0 then n := limit;
  243.       GetNum := n;
  244.       GotoXY(x,y);
  245.       Write(n:2);
  246.   until not (status in [#0,' ']);
  247. end;  {GetNum}
  248.  
  249. procedure Get_Date(var status: char;var month,day,year:word);
  250. const
  251.   mlim : array[1..12] of word = (31,29,31,30,31,30,31,31,30,31,30,31);
  252. var
  253.   ans : char;
  254.   x,y : byte;
  255.  
  256.   procedure Next_item ;
  257.      begin
  258.        GotoXY(x,y);
  259.        TextBackground(green);
  260.        ClrEol;
  261.        Write(month:2,'/',day:2,'/',year:4);
  262.      end;
  263.  
  264.   begin
  265.     x := WhereX;
  266.     y := WhereY;
  267.     repeat
  268.       Next_item;
  269.       GotoXY(x,y);
  270.       Textbackground(white);
  271.       month := GetNum(status,month,12);
  272.       if option = ProgramExit then exit;
  273.       month := ((month + 11) mod 12) + 1;
  274.       Next_item;
  275.       if status in [#13,#27] then exit;
  276.       GotoXY(x+3,y);
  277.       TextBackground(white);
  278.       day := GetNum(status,day,mlim[month]);
  279.       if option = ProgramExit then exit;
  280.       if day = 0 then day := mlim[month];
  281.       Next_item;
  282.       if status in [#13,#27] then exit;
  283.       GotoXY(x+8,y);
  284.       Textbackground(white);
  285.       year := GetNum(status,year - 1900,99);
  286.       if option = ProgramExit then exit;
  287.       year := year + 1900;
  288.       Next_item;
  289.     until status <> #0;
  290. end;
  291.  
  292.  
  293. {Above is   $I golfspec}  { ---standard spec for all 'golf' programs}
  294.  
  295.