Program PFHiScoreEditor_v101;

Uses CRT;

{$I style.inc}
{$I baseconv.inc}
{$I pressspace.inc}

Const
  VNM='1.01';
  VDT='07-May-94';

Var
  IFS,OFS:Text;
  CTR,CTZ:Integer;
  PARTY_NAME,DRIVE_NAME,BILLION_NAME,BONES_NAME:Packed Array [1..4] Of String[3];
  PARTY_SCORE,DRIVE_SCORE,BILLION_SCORE,BONES_SCORE:Packed Array [1..4] Of String[16];
  QTF:Boolean;

Procedure ProgramTitle;
Begin
  Style(0,1);
  ClrScr;
  Style(1,1);
  Style(4,1);
  WriteLn('Pinball Fantasies Highscore Editor v',VNM,' by Zbd ',#$a9,'1994 Cybertek (',VDT,')');
  Style(0,1);
  WriteLn;
End;

Function AreYouSure(P,N:Char):Boolean;
Var
  RUS:Char;
Begin
  WriteLn;
  Write('Are you sure (',UpCase(P),P,'/',UpCase(N),N,') ? ');
  Repeat
    RUS:=UpCase(ReadKey);
  Until (RUS=UpCase(P)) or (RUS=UpCase(N));
  WriteLn(RUS);
  If RUS=UpCase(P) Then
    AreYouSure:=True
  Else
    AreYouSure:=False;
End;

Function GetChar:Char;
Var
  DMY:Char;
Begin
  Repeat
    DMY:=UpCase(ReadKey);
  Until (DMY>='A') and (DMY<='Z');
  If DMY='*' Then Write('$VER: Pinball Fantasies HighScore Editor v1.01 (07-May-94) ');
  GetChar:=DMY;
End;

Procedure EditNameParty(N:Integer);
Var
  NAME:String[3];
Begin
  ProgramTitle;
  Style(2,1);
  WriteLn('ENTER NAME FOR POSITION ',N,' IN PARTY LAND');
  Style(2,0);
  WriteLn;
  Write('Press three letters for the name: ');
  NAME[1]:=GetChar;
  Write(NAME[1]);
  NAME[2]:=GetChar;
  Write(NAME[2]);
  NAME[3]:=GetChar;
  WriteLn(NAME[3]);
  PARTY_NAME[N]:='';
  PARTY_NAME[N]:=NAME[1]+NAME[2]+NAME[3];
End;

Procedure EditNameDrive(N:Integer);
Var
  NAME:String[3];
Begin
  ProgramTitle;
  Style(2,1);
  WriteLn('ENTER NAME FOR POSITION ',N,' IN SPEED DEVILS');
  Style(2,0);
  WriteLn;
  Write('Press three letters for the name: ');
  NAME[1]:=GetChar;
  Write(NAME[1]);
  NAME[2]:=GetChar;
  Write(NAME[2]);
  NAME[3]:=GetChar;
  WriteLn(NAME[3]);
  DRIVE_NAME[N]:='';
  DRIVE_NAME[N]:=NAME[1]+NAME[2]+NAME[3];
End;

Procedure EditNameBillion(N:Integer);
Var
  NAME:String[3];
Begin
  ProgramTitle;
  Style(2,1);
  WriteLn('ENTER NAME FOR POSITION ',N,' IN BILLIONAIRE GAME SHOW');
  Style(2,0);
  WriteLn;
  Write('Press three letters for the name: ');
  NAME[1]:=GetChar;
  Write(NAME[1]);
  NAME[2]:=GetChar;
  Write(NAME[2]);
  NAME[3]:=GetChar;
  WriteLn(NAME[3]);
  BILLION_NAME[N]:='';
  BILLION_NAME[N]:=NAME[1]+NAME[2]+NAME[3];
End;

Procedure EditNameBones(N:Integer);
Var
  NAME:String[3];
Begin
  ProgramTitle;
  Style(2,1);
  WriteLn('ENTER NAME FOR POSITION ',N,' IN STONES`N''BONES');
  Style(2,0);
  WriteLn;
  Write('Press three letters for the name: ');
  NAME[1]:=GetChar;
  Write(NAME[1]);
  NAME[2]:=GetChar;
  Write(NAME[2]);
  NAME[3]:=GetChar;
  WriteLn(NAME[3]);
  BONES_NAME[N]:='';
  BONES_NAME[N]:=NAME[1]+NAME[2]+NAME[3];
End;

Procedure EditScoreParty(N:Integer);
Var
  SCOREA,SCOREB:String[16];
Begin
  ProgramTitle;
  Style(2,1);
  WriteLn('ENTER SCORE FOR POSITION ',N,' IN PARTY LAND');
  Style(2,0);
  WriteLn;
  Write('Enter the number for the score: ');
  ReadLn(SCOREA);
  For CTR:=1 To 16-Length(SCOREA) Do
    SCOREB:=SCOREB+'0';
  PARTY_SCORE[N]:=SCOREB+SCOREA;
End;

Procedure EditScoreDrive(N:Integer);
Var
  SCOREA,SCOREB:String[16];
Begin
  ProgramTitle;
  Style(2,1);
  WriteLn('ENTER SCORE FOR POSITION ',N,' IN SPEED DEVILS');
  Style(2,0);
  WriteLn;
  Write('Enter the number for the score: ');
  ReadLn(SCOREA);
  For CTR:=1 To 16-Length(SCOREA) Do
    SCOREB:=SCOREB+'0';
  DRIVE_SCORE[N]:=SCOREB+SCOREA;
End;

Procedure EditScoreBillion(N:Integer);
Var
  SCOREA,SCOREB:String[16];
Begin
  ProgramTitle;
  Style(2,1);
  WriteLn('ENTER SCORE FOR POSITION ',N,' IN BILLIONAIRE GAME SHOW');
  Style(2,0);
  WriteLn;
  Write('Enter the number for the score: ');
  ReadLn(SCOREA);
  For CTR:=1 To 16-Length(SCOREA) Do
    SCOREB:=SCOREB+'0';
  BILLION_SCORE[N]:=SCOREB+SCOREA;
End;

Procedure EditScoreBones(N:Integer);
Var
  SCOREA,SCOREB:String[16];
Begin
  ProgramTitle;
  Style(2,1);
  WriteLn('ENTER SCORE FOR POSITION ',N,' IN STONES`N''BONES');
  Style(2,0);
  WriteLn;
  Write('Enter the number for the score: ');
  ReadLn(SCOREA);
  For CTR:=1 To 16-Length(SCOREA) Do
    SCOREB:=SCOREB+'0';
  BONES_SCORE[N]:=SCOREB+SCOREA;
End;

Procedure CheckQuit;
Begin
  ProgramTitle;
  Style(2,1);
  WriteLn('QUIT - Have you saved your data?');
  Style(2,0);
  QTF:=AreYouSure('y','n');
End;

Procedure Terminate;
Begin
  ProgramTitle;
  Style(2,1);
  WriteLn('End of program.');
  Style(2,0);
End;

Procedure ViewStatus;
Begin
  ProgramTitle;
  Style(2,1);
  WriteLn('NAMES AND SCORES');
  Style(2,0);
  WriteLn;
  WriteLn('Party Land                            Speed Devils');
  For CTR:=1 To 4 Do
  Begin
    Write(CTR,': ',PARTY_NAME[CTR],' ',PARTY_SCORE[CTR]);
    Write('               ');
    WriteLn(CTR,': ',DRIVE_NAME[CTR],' ',DRIVE_SCORE[CTR]);
  End;
  WriteLn;
  WriteLn('Billionaire Game Show                 Stones`n''Bones');
  For CTR:=1 To 4 Do
  Begin
    Write(CTR,': ',BILLION_NAME[CTR],' ',BILLION_SCORE[CTR]);
    Write('               ');
    WriteLn(CTR,': ',BONES_NAME[CTR],' ',BONES_SCORE[CTR]);
  End;
  WriteLn;
  PressSpace;
End;

Function HexToDec(H:String):Integer;
Var
  CTB,NUT,N:Integer;
  CH:String[1];
  C:Char;
Begin
  NUT:=0;
  For CTB:=Length(H) DownTo 1 Do
  Begin
    CH:=Copy(H,CTB,1);
    C:=CH[1];
    Case C Of
      '0':N:=0;
      '1':N:=1;
      '2':N:=2;
      '3':N:=3;
      '4':N:=4;
      '5':N:=5;
      '6':N:=6;
      '7':N:=7;
      '8':N:=8;
      '9':N:=9;
      'A':N:=10;
      'B':N:=11;
      'C':N:=12;
      'D':N:=13;
      'E':N:=14;
      'F':N:=15;
    End;
    If CTB < Length(H) Then N:=N*16;
    NUT:=NUT+N;
  End;
  HexToDec:=NUT;
End;

Procedure WriteScore(N:String);
Var
  CTB,NUM,ERR:Integer;
  HEX:String[2];
  DMY:Char;
Begin
  For CTB:=1 To 16 Do
  Begin
    HEX:=Copy(N,CTB,2);
    NUM:=HexToDec(HEX);
    Write(OFS,Chr(NUM));
    Inc(CTB);
  End;
End;

Procedure SaveData;
Var
  SURE:Boolean;
Begin
  ProgramTitle;
  Style(2,1);
  WriteLn('SAVE DATA');
  Style(2,0);
  SURE:=AreYouSure('y','n');
  WriteLn;
  If SURE Then
  Begin
    WriteLn('Saving highscore table...');
    Assign(OFS,'NonVolatile/Pinball/Highscore');
    ReWrite(OFS);
    For CTR:=1 To 4 Do
    Begin
      Write(OFS,PARTY_NAME[CTR],' ');
      WriteScore(PARTY_SCORE[CTR]);
    End;
    For CTR:=1 To 4 Do
    Begin
      Write(OFS,DRIVE_NAME[CTR],' ');
      WriteScore(DRIVE_SCORE[CTR]);
    End;
    {Zebedee/Cybertek}
{    For CTR:=1 To 32 Do
      Write(OFS,Chr(0));}
    Write(OFS,'Zebedee/CybertekZebedee/Cybertek');
    For CTR:=1 To 4 Do
    Begin
      Write(OFS,BILLION_NAME[CTR],' ');
      WriteScore(BILLION_SCORE[CTR]);
    End;
    For CTR:=1 To 4 Do
    Begin
      Write(OFS,BONES_NAME[CTR],' ');
      WriteScore(BONES_SCORE[CTR]);
    End;
  {  For CTR:=1 To 36 Do
      Write(OFS,Chr(0));}
    Write(OFS,'Zebedee/CybertekZebedee/Cybertek1994');
    Close(OFS);
  End Else Begin
    WriteLn('Save aborted.');
    WriteLn;
    PressSpace;
  End;
End;

Function ReadText(N:Integer):String;
Var
  CHR:Char;
  DMY:String;
  CTY:Integer;
Begin
  DMY:='';
  For CTY:=1 To N Do
  Begin
    Read(IFS,CHR);
    DMY:=DMY+CHR;
  End;
  ReadText:=DMY;
End;

Function ReadNum(N:Integer):String;
Var
  CHR:Char;
  DMY,NUM:String;
  NMB,CTY:Integer;
Begin
  DMY:='';
  NUM:='';
  For CTY:=1 To N Do
  Begin
    Read(IFS,CHR);
    NUM:=BaseConv(Ord(CHR),2,16);
    DMY:=DMY+NUM;
  End;
  ReadNum:=DMY
End;

Procedure LoadData;
Var
  CHR:Char;
  CTB:Integer;
  SURE:Boolean;
Begin
  ProgramTitle;
  Style(2,1);
  WriteLn('LOAD DATA');
  Style(2,0);
  SURE:=AreYouSure('y','n');
  WriteLn;
  If SURE Then
  Begin
    WriteLn('Please wait...');
    Assign(IFS,'NonVolatile/Pinball/Highscore');
    Reset(IFS);
    CTB:=0;
    For CTR:=1 To 4 Do
    Begin
      PARTY_NAME[CTR]:=ReadText(3);
      Read(IFS,CHR);
      PARTY_SCORE[CTR]:=ReadNum(8);
    End;
    For CTR:=1 To 4 Do
    Begin
      DRIVE_NAME[CTR]:=ReadText(3);
      Read(IFS,CHR);
      DRIVE_SCORE[CTR]:=ReadNum(8);
    End;
    For CTR:=1 To 32 Do
      Read(IFS,CHR);
    For CTR:=1 To 4 Do
    Begin
      BILLION_NAME[CTR]:=ReadText(3);
      Read(IFS,CHR);
      BILLION_SCORE[CTR]:=ReadNum(8);
    End;
    For CTR:=1 To 4 Do
    Begin
      BONES_NAME[CTR]:=ReadText(3);
      Read(IFS,CHR);
      BONES_SCORE[CTR]:=ReadNum(8);
    End;
    Close(IFS);
    WriteLn;
  End Else Begin
    WriteLn('Load aborted.');
    WriteLn;
    PressSpace;
  End;
End;

Procedure ResetDefaults(FLG:Boolean);
Var
  SURE:Boolean;
Begin
  If FLG Then
  Begin
    ProgramTitle;
    Style(2,1);
    WriteLn('RESET HIGHSCORES TO DEFAULTS');
    Style(2,0);
    SURE:=AreYouSure('y','n');
    If SURE Then
      FLG:=False
    Else
      FLG:=True;
  End;
  If not FLG Then
  Begin
    PARTY_NAME[1]:='ZBD';
    PARTY_NAME[2]:='CTK';
    PARTY_NAME[3]:='AWW';
    PARTY_NAME[4]:='ZEB';
    PARTY_SCORE[1]:='0000000010000000';
    PARTY_SCORE[2]:='0000000008000000';
    PARTY_SCORE[3]:='0000000006000000';
    PARTY_SCORE[4]:='0000000004000000';
    DRIVE_NAME[1]:='ZBD';
    DRIVE_NAME[2]:='CTK';
    DRIVE_NAME[3]:='AWW';
    DRIVE_NAME[4]:='ZEB';
    DRIVE_SCORE[1]:='0000000010000000';
    DRIVE_SCORE[2]:='0000000008000000';
    DRIVE_SCORE[3]:='0000000006000000';
    DRIVE_SCORE[4]:='0000000004000000';
    BILLION_NAME[1]:='ZBD';
    BILLION_NAME[2]:='CTK';
    BILLION_NAME[3]:='AWW';
    BILLION_NAME[4]:='ZEB';
    BILLION_SCORE[1]:='0000000010000000';
    BILLION_SCORE[2]:='0000000008000000';
    BILLION_SCORE[3]:='0000000006000000';
    BILLION_SCORE[4]:='0000000004000000';
    BONES_NAME[1]:='ZBD';
    BONES_NAME[2]:='CTK';
    BONES_NAME[3]:='AWW';
    BONES_NAME[4]:='ZEB';
    BONES_SCORE[1]:='0000000010000000';
    BONES_SCORE[2]:='0000000008000000';
    BONES_SCORE[3]:='0000000006000000';
    BONES_SCORE[4]:='0000000004000000';
  End Else Begin
    WriteLn;
    WriteLn('Reset highscores aborted.');
    PressSpace;
  End;
End;

Procedure ViewInformation;
Begin
  ProgramTitle;
  Style(2,1);
  WriteLn('CREDITS, GREETINGS AND INFORMATION');
  Style(2,0);
  WriteLn('Credits to Sirius for supplying me with a copy of Pinball Fantasies,');
  WriteLn('Beaker for supplying me with a copy of HighSpeed Pascal v1.00 and');
  WriteLn('Commodore Amiga for being the best computer ever!!!');
  WriteLn;
  WriteLn('Greetings to all other Cybertek Members (Sirius, Sprinter, Fireball, Devoe,');
  WriteLn('DJ Nosferatu, Holsten, Capone) - Lard Design (esp. Freeman and Skuzzy)');
  WriteLn('Beaker - The Tempest - Slidex/Pacific Heights - LSD - Slush/Delta8');
  WriteLn('Kei/CyberDreams and all else as I''ve not got the complete greets list!');
  WriteLn;
  WriteLn('Thanks to Pete Tong''s Essential Mix and Dallas J Hodgsen for NewZAP v3.3.');
  WriteLn;
  WriteLn('For PFEdit to be able to access the highscore file, PFEdit must be in the');
  WriteLn('same directory as the actual game itself.  This is because PFEdit uses the');
  WriteLn('directory "NonVolatile/Pinball/" to save to and load from.  PFEdit does NOT');
  WriteLn('support a crunched highscore file so make sure it is decrunched before you');
  WriteLn('attempt to load it, or alternatively you could have PowerData running in');
  WriteLn('the background.');
  WriteLn;
  PressSpace;
End;

Procedure Menu;
Var
  DMY:Char;
Begin
  Repeat
    ProgramTitle;
    Style(2,1);
    Write('Menu');
    Style(2,0);
    Style(1,1);
    WriteLn('                        ***PREVIEW COPY***');
    Style(1,0);
    WriteLn;
    WriteLn('A-D. Edit names for Party Land             (A=1st,B=2nd,C=3rd,D=4th)');
    WriteLn('E-H. Edit scores for Party Land            (E=1st,F=2nd,G=3rd,H=4th)');
    WriteLn('I-L. Edit names for Speed Devils           (I=1st,J=2nd,K=3rd,L=4th)');
    WriteLn('M-P. Edit scores for Speed Devils          (M=1st,N=2nd,O=3rd,P=4th)');
    WriteLn('Q-T. Edit names for Billionaire Game Show  (Q=1st,R=2nd,S=3rd,T=4th)');
    WriteLn('U-X. Edit scores for Billionaire Game Show (U=1st,V=2nd,W=3rd,X=4th)');
    WriteLn('Y-2. Edit names for Stones`n''Bones         (Y=1st,Z=2nd,1=3rd,2=4th)');
    WriteLn('3-6. Edit scores for Stones`n''Bones        (3=1st,4=2nd,5=3rd,6=4th)');
    WriteLn('  7. View names and scores');
    WriteLn('  8. Save data to disk');
    WriteLn('  9. Load data from disk');
    WriteLn('  0. Reset all names and scores to defaults');
    WriteLn('  ?. View credits, greetings and information');
    WriteLn('  +. Quit program');
    WriteLn;
    Write('Press [A-Z/1-9/0/?/+] to select: ');
    DMY:=UpCase(ReadKey);
    Case DMY Of
      'A':EditNameParty(1);
      'B':EditNameParty(2);
      'C':EditNameParty(3);
      'D':EditNameParty(4);
      'E':EditScoreParty(1);
      'F':EditScoreParty(2);
      'G':EditScoreParty(3);
      'H':EditScoreParty(4);
      'I':EditNameDrive(1);
      'J':EditNameDrive(2);
      'K':EditNameDrive(3);
      'L':EditNameDrive(4);
      'M':EditScoreDrive(1);
      'N':EditScoreDrive(2);
      'O':EditScoreDrive(3);
      'P':EditScoreDrive(4);
      'Q':EditNameBillion(1);
      'R':EditNameBillion(2);
      'S':EditNameBillion(3);
      'T':EditNameBillion(4);
      'U':EditScoreBillion(1);
      'V':EditScoreBillion(2);
      'W':EditScoreBillion(3);
      'X':EditScoreBillion(4);
      'Y':EditNameBones(1);
      'Z':EditNameBones(2);
      '1':EditNameBones(3);
      '2':EditNameBones(4);
      '3':EditScoreBones(1);
      '4':EditScoreBones(2);
      '5':EditScoreBones(3);
      '6':EditScoreBones(4);
      '7':ViewStatus;
      '8':SaveData;
      '9':LoadData;
      '0':ResetDefaults(True);
      '?':ViewInformation;
      '/':ViewInformation;
      '+':CheckQuit;
    End;
  Until QTF;
End;

Procedure ShowWarning;
Begin
  ProgramTitle;
  Style(2,1);
  WriteLn('WARNING');
  Style(2,0);
  WriteLn;
  WriteLn('You are advised to make a backup copy of your highscore file for Pinball');
  WriteLn('Fantasies because this version of PFEdit has NOT been tested thoroughly.');
  WriteLn;
  PressSpace;
End;

Begin
  ShowWarning;
  ResetDefaults(False);
  Menu;
  Terminate;
End.