[Back to MISC SWAG index]  [Back to Main SWAG index]  [Original]

Unit HighScr;
Interface
Procedure HS_Init(iNum: byte; ifn: string; icode: byte);
{Initializes the highscore manager}
{  iNum: byte -  The number of scores to keep track of.  Setting iNum to 0}
{                makes the program use however many scores it finds in the}
{                list file}
{  ifn: string - The filename of the list file.  If the file exists, it is
                 opened; otherwise, a new file is created.  If iNum if set to
                 more names than are in ifn, extra spaces are left blank.  If
                 ifn has too many, the extras are ignored.
                 NOTE:  do not make inum=0 if you are creating a new list
                 file}
{  icode: byte - encoding number, where 0=no encoding.  The higher the
                 number, the less recognizable the output file}

Function HS_CheckScore(score: longint): boolean;
{Checks to see if a score would make the highscore list}
{  score: longint - the score to check}
{Returns TRUE if the score made the list}

Function HS_NewScore(name: string; score: longint): boolean;
{Adds a new score to the list if it belongs}
{  name: string -   the name of the player}
{  score: longint - the player's score}
{Returns TRUE if the score made the list}

Procedure HS_Clear;
{Clears the highscore list, setting all names to dashes, all scores to 0}

Function HS_Name(i: byte): string;
{Returns the name from the Ith place of the list}
{  i: byte - the rank to check}

Function HS_Score(i: byte): longint;
{Returns the score from the Ith place of the list}
{  i: byte - the rank to check}

Procedure HS_Done;
{Disposes of the highscore manager and saves the highscore list}

Implementation
Uses
  Dos;
Type
  PHSItem = ^THSItem;
  THSItem = record
              name:                     string[25];
              score:                    longint;
            end;
  PHSItemList = ^THSItemList;
  THSItemList = array[1..100] of THSItem;
Var
  numitems, code:                       byte;
  item:                                 PHSItemList;
  fn:                                   string[50];
Procedure FlipBit(var Buf; len, code: byte);
Type
  TBuf = array[0..255] of byte;
var
  i:                                    byte;
begin
  for i:=0 to len-1 do
    TBuf(Buf)[i]:=TBuf(Buf)[i] XOR Code;
end;
Function GetStr(var f: file): string;
var
  s:                                    string;
begin
  BlockRead(f, s[0], 1);
  BlockRead(f, s[1], ord(s[0]));
  GetStr:=s;
end;
Function Exist(fn: string): boolean;
Var
  SRec:                                 SearchRec;
Begin
  FindFirst(fn, $3F, SRec);
  If DosError>0 then Exist:=False else Exist:=True;
End;
Procedure HS_Init(iNum: byte; ifn: string; icode: byte);
var
  f:                                    file;
  i, found:                             byte;
begin
  fn:=ifn;
  code:=icode;
  numitems:=iNum;
  GetMem(item, 30*numitems);
  HS_Clear;
  if exist(fn) then
  begin
    Assign(f, fn);
    Reset(f, 1);
    BlockRead(f, found, 1);
    if numitems=0 then numitems:=found;
    if found>numitems then found:=numitems;
    for i:=1 to found do
    begin
      item^[i].name:=GetStr(f);
      FlipBit(item^[i].name[1], ord(item^[i].name[0]), code);
      BlockRead(f, item^[i].score, 4);
      FlipBit(item^[i].score, 4, code);
    end;
  end;
  if numitems=0 then numitems:=1;
end;
Function HS_CheckScore(score: longint): boolean;
begin
  if score>item^[numitems].score then HS_CheckScore:=TRUE else HS_CheckScore:=FALSE;
end;
Function HS_NewScore(name: string; score: longint): boolean;
var
  i, j:                                 byte;
  on:                                   boolean;
begin
  HS_NewScore:=FALSE;
  for i:=1 to numitems do
    if score>item^[i].score then
    begin
      for j:=numitems downto i+1 do
        item^[j]:=item^[j-1];
      item^[i].name:=name;
      item^[i].score:=score;
      score:=0;
      i:=numitems;
      HS_NewScore:=TRUE;
    end;
end;
Procedure HS_Clear;
var
  i:                                    byte;
begin
  for i:=1 to numitems do
  begin
    item^[i].name:='-------------------------';
    item^[i].score:=0;
  end;
end;
Function HS_Name(i: byte): string;
begin
  HS_Name:=item^[i].name;
end;
Function HS_Score(i: byte): longint;
begin
  HS_Score:=item^[i].score;
end;
Procedure HS_Done;
var
  f:                                    file;
  i:                                    byte;
begin
  Assign(f, fn);
  Rewrite(f, 1);
  BlockWrite(f, numitems, 1);
  for i:=1 to numitems do
  begin
    FlipBit(item^[i].name[1], ord(item^[i].name[0]), code);
    BlockWrite(f, item^[i].name, ord(item^[i].name[0])+1);
    FlipBit(item^[i].score, 4, code);
    BlockWrite(f, item^[i].score, 4);
  end;
  FreeMem(item, 30*numitems);
end;
End.

[Back to MISC SWAG index]  [Back to Main SWAG index]  [Original]