Contributor: RODNEY JOHNSON
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, 3ドルF, 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.