[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]