Program ScrabbleScoreKeeper;

Uses Crt,DOS;

{$I dnstr.inc}
{$I getkey.inc}
{$I initcaps.inc}
{$I style.inc}

Var
  DMY:Char;
  NOMORE:Boolean;
  HISCORE,CTR,CTB,PLAYERS:Integer;
  PLAYER:Packed Array [1..4] Of String[15];
  SCORES:Packed Array [1..4] Of Integer;
  LOSER,WINNER,BLANK:String[15];

Procedure ProgramTitle;
Begin
  Style(0,1);
  ClrScr;
  Style(1,1);
  Style(3,1);
  WriteLn('Scrabble Score Keeper v1.00 by Zebedee ',#$a9,'1995 Carnage (15-Mar-95)',#$a);
  Style(0,1);
End;

Procedure Information;
Begin
  WriteLn('$VER: Scrabble Score Keeper v1.00 (15-Mar-95) ');
  Halt(5);
End;

Function AskName(CTR:Integer):String;
Var
  TXT:String[15];
Begin
  Repeat
    GotoXY(28,7+CTR);
    WriteLn('  ');
    GotoXY(1,7+CTR);
    Write('Enter your name, player ',CTR,': ');
    ReadLn(TXT);
  Until Length(TXT)>1;
  TXT:=DnStr(TXT);
  TXT:=InitCaps(TXT);
  AskName:=TXT;
End;

Procedure GetNames;
Begin
  ProgramTitle;
  WriteLn('Before we can start recording the scores in the game, I need to know how');
  WriteLn('many people are playing, and what their names are.',#$a);
  Write('How many players (2-4) ? ');
  Repeat
    DMY:=ReadKey;
  Until (DMY='2') or (DMY='3') or (DMY='4');
  If DMY='2' Then PLAYERS:=2 Else
    If DMY='3' Then PLAYERS:=3 Else
    If DMY='4' Then PLAYERS:=4;
  Write(PLAYERS,#$a,#$a);
  For CTR:=1 To PLAYERS Do
  Begin
    PLAYER[CTR]:=AskName(CTR);
    GotoXY(28,7+CTR);
    WriteLn(PLAYER[CTR]);
  End;
  BLANK:='               ';
End;

Procedure UpdateInformation;
Begin
  Style(1,1);
  GotoXY(55,7);
  Write(HISCORE);
  GotoXY(8,8);
  Write(BLANK);
  GotoXY(8,8);
  Write(BLANK);
  GotoXY(8,8);
  Write(LOSER);
  GotoXY(48,8);
  Write(BLANK);
  GotoXY(48,8);
  Write(WINNER);
  For CTR:=1 To PLAYERS Do
  Begin
    GotoXY(40,10+CTR);
    Write(SCORES[CTR],'  ');
  End;
  Style(1,0);
End;

Function AskAnotherGame:Boolean;
Begin
  GotoXY(1,22);
  DMY:=GetKey('Enter more scores (Yy/Nn) ? ','Y','N');
  GotoXY(1,22);
  Write('                             ');
  If DMY='N' Then AskAnotherGame:=True Else AskAnotherGame:=False;
End;

Procedure GetScores;
Var
  QTF:Boolean;
  TMPL,TMPH,GO,SCORE:Integer;
Begin
  QTF:=False;
  GO:=0;
  Repeat
    TMPH:=0;
    TMPL:=999;
    Inc(GO);
    GotoXY(40,16+GO);
    Write('          ');
    GotoXY(40,16+GO);
    ReadLn(SCORE);
    SCORES[GO]:=SCORES[GO]+SCORE;
    If SCORE>HISCORE Then HISCORE:=SCORE;
    If GO=PLAYERS Then
    Begin
      For CTR:=1 To PLAYERS Do
      Begin
        If SCORES[CTR]>TMPH Then
        Begin
          TMPH:=SCORES[CTR];
          WINNER:=PLAYER[CTR];
        End;
        If SCORES[CTR]<TMPL Then
        Begin
          TMPL:=SCORES[CTR];
          LOSER:=PLAYER[CTR];
        End;
      End;
    End;
    UpdateInformation;
    If GO=PLAYERS Then
    Begin
      GO:=0;
      QTF:=AskAnotherGame;
    End;
    Until QTF;
End;

Procedure ShowWinner;
Begin
  GotoXY(1,22);
  WriteLn('Game over!');
  WriteLn('The winner is ',WINNER,', and the loser is ',LOSER,'.',#$a);
  DMY:=GetKey('Another game (Yy/Nn) ? ','Y','N');
  If DMY='Y' Then NOMORE:=False Else NOMORE:=True;
End;

Procedure MainLoop;
Begin
  ProgramTitle;
  HISCORE:=0;
  LOSER:='-';
  WINNER:='-';
  WriteLn('Type in each player''s score in turn and press return.  If a player misses');
  WriteLn('their turn then enter 0.  If a player''s score is too high, then enter a');
  WriteLn('negative number to bring their score down.',#$a);
  Write('Players: ');
  Style(1,1);
  Write(PLAYERS);
  Style(1,0);
  WriteLn('.............................Highest score:'); {Dots are spaces}
  WriteLn('Loser:.................................Winner:'); {Dots are spaces}
  UpdateInformation;
  GotoXY(1,10);
  WriteLn('Current Scores:');
  For CTR:=1 To PLAYERS Do
  Begin
    Write(CTR,'. ',PLAYER[CTR],' ');
    For CTB:=Length(PLAYER[CTR])+1 To 34 Do
      Write('.');
    WriteLn;
  End;
  GotoXY(1,16);
  WriteLn('Enter the scores:');
  For CTR:=1 To PLAYERS Do
  Begin
    Write(CTR,'. ',PLAYER[CTR],' ');
    For CTB:=Length(PLAYER[CTR])+1 To 34 Do
      Write('.');
    WriteLn;
  End;
  GetScores;
  ShowWinner;
End;

Procedure ClearScores;
Begin
  For CTR:=1 To PLAYERS Do
    SCORES[CTR]:=0;
End;

Procedure Terminate;
Begin
  ProgramTitle;
  WriteLn('Thanks for using this program.',#$a);
  WriteLn('If you like SSK, then please send me a postcard to:');
  WriteLn('Zebedee, 72 Hessary Drive, Belliver, Plymouth, PL6 7DQ, England');
End;

Begin
  If ParamStr(1)='?' Then Information;
  NOMORE:=False;
  Repeat
    GetNames;
    ClearScores;
    MainLoop;
  Until NOMORE;
  Terminate;
End.