unit LRLHighScores; {$mode objfpc} {$i-} interface uses SysUtils, LRLRoutines, LRLSprites; procedure LRLLoadHighScores; procedure LRLShowHighScores; function LRLBestScore(Score: Longint): Boolean; procedure LRLInsertScore(Name: String; Score: Longint); procedure LRLSaveHighScores; function LRLEnterName: String; implementation const HighsFileName = 'LRL.HSR'; HighsFileHeader: String[29] = 'Lode Runner Live High Scores'#26; type TSupers = packed record Name: String[20]; Score: Longint; end; var MainScreen: Pointer; HighFrame: Pointer; HighTable: array[1..5] of TSupers; procedure LoadData; var j: Word; begin GetMem(MainScreen, 64004); GetMem(HighFrame, 45000); Seek(ImageFile, LRLImagesFilePosition); BlockRead(ImageFile, MainScreen^, 7940, j); DecompressRepByte(MainScreen^, HighFrame^, 7940, j); BlockRead(ImageFile, MainScreen^, 64004, j); end; procedure DisposeData; begin FreeMem(MainScreen, 64004); FreeMem(HighFrame, 45000); end; procedure LRLShowHighScores; var p: Pointer; i: Integer; s: String; begin LRLLoadHighScores; GetMem(p, 768); DataFill(p^, 768, 0, 0); Palette256Set(p^); FreeMem(p, 768); LoadData; ImagePut(LRLScreen^, MainScreen^, 0, 0, 0, 0, 319, 199); ImagePut(LRLScreen^, HighFrame^, 6, 50, 0, 0, 319, 199); for i := 1 to 5 do begin ImageStringGet(Chr(i + 48) + '. ' + HighTable[i].Name, LRLFont^, LRLFontBuffer^, 110); ImagePut(LRLScreen^, LRLFontBuffer^, 55, 85 + i * 17, 8, 0, 319, 199); Str(HighTable[i].Score, s); ImageStringGet(s, LRLFont^, LRLFontBuffer^, 46); ImagePut(LRLScreen^, LRLFontBuffer^, 260 - ImageSizex(LRLFontBuffer^), 85 + i * 17, 8, 0, 319, 199); end; ScreenApply(LRLScreen^); FadeTo(LRLMenuPalette); ReadKey; FadeClear; ImageClear(LRLScreen^); ScreenApply(LRLScreen^); DisposeData; end; procedure LRLLoadHighScores; var InFile: File; i, j: Word; Dummy: String[30]; begin FileMode := 0; AssignFile(InFile, HighsFileName); Reset(InFile, 1); if IOResult <> 0 then begin for i := 1 to 5 do begin HighTable[i].Name := 'Lode Runner'; HighTable[i].score := 60000 - i * 10000; end; AssignFile(InFile, HighsFileName); Rewrite(InFile, 1); BlockWrite(InFile, HighsFileHeader[1], 29, i); BlockWrite(InFile, HighTable, SizeOf(TSupers) * 5, j); end else begin Seek(InFile, 0); BlockRead(InFile, Dummy[1], 29, j); if (IOResult <> 0) or (not DataIdentical(Dummy[1], HighsFileHeader[1], 29, 0, 0)) then raise Exception.Create('Error: Invalid file with high scores! (try to remove LRL.HSR file)'); BlockRead(InFile, HighTable, SizeOf(TSupers) * 5, j); end; Close(InFile); end; procedure LRLSaveHighScores; var InFile: File; j: Word; begin FileMode := 2; AssignFile(InFile, HighsFileName); Reset(InFile, 1); Seek(InFile, 29); BlockWrite(InFile, HighTable, SizeOf(TSupers) * 5, j); Close(InFile); end; function LRLBestScore(Score: Longint): Boolean; var i: Integer; begin LRLBestScore := True; LRLLoadHighScores; i := 1; while True do begin if Score >= HighTable[i].Score then Exit; Inc(i); if i > 5 then begin LRLBestScore := False; Exit; end; end; end; procedure LRLInsertScore(Name: String; Score: Longint); var i, j: Word; begin LRLLoadHighScores; i := 1; while True do begin if Score >= HighTable[i].Score then begin for j := 4 downto i do begin HighTable[j + 1].Name := HighTable[j].Name; HighTable[j + 1].Score := HighTable[j].Score; end; HighTable[i].Name := Name; HighTable[i].Score := Score; LRLSaveHighScores; Exit; end; Inc(i); if i > 5 then begin Exit; end; end; end; function LRLEnterName: String; var p: Pointer; RedrawName: Boolean; Keypress: Word; Name: String; C: Char; begin Name := ''; GetMem(p, 768); DataFill(p^, 768, 0, 0); Palette256Set(p^); FreeMem(p, 768); ImageClear(LRLScreen^); ImagePut(LRLScreen^, LRLLogo^, 3, 3, 0, 0, 319, 199); ImageStringGet('Congratulations! You are in Top-Five!', LRLFont^, LRLFontBuffer^, 110); ImagePut(LRLScreen^, LRLFontBuffer^, 160 - ImageSizex(LRLFontBuffer^) shr 1, 85, 0, 0, 319, 199); ImageStringGet('Enter your name below, Champ', LRLFont^, LRLFontBuffer^, 111); ImagePut(LRLScreen^, LRLFontBuffer^, 160 - ImageSizex(LRLFontBuffer^) shr 1, 110, 0, 0, 319, 199); ImageStringGet('---------------------------', LRLFont^, LRLFontBuffer^, 100); ImagePut(LRLScreen^, LRLFontBuffer^, 160 - ImageSizex(LRLFontBuffer^) shr 1, 155, 0, 0, 319, 199); ScreenApply(LRLScreen^); FadeTo(LRLMenuPalette); RedrawName := True; repeat if RedrawName = True then begin ImageFill(LRLFontBuffer^, 320, 20, 0); ImagePut(LRLScreen^, LRLFontBuffer^, 0, 140, 0, 0, 319, 199); ImageStringGet(Name, LRLFont^, LRLFontBuffer^, 100); ImagePut(LRLScreen^, LRLFontBuffer^, 160 - ImageSizex(LRLFontBuffer^) shr 1, 140, 0, 0, 319, 199); ScreenApply(LRLScreen^); RedrawName := False; end; Keypress := ReadKey; if (Keypress = KEY_BACK) and (Length(Name) > 0) then begin SetLength(Name, Length(Name) - 1); RedrawName := True; end; C := ScanToChar(Keypress); if (C > #31) and (Length(Name) < 20) then begin Name := Name + C; RedrawName := True; end; until Keypress = KEY_ENTER; FadeClear; Name := Trim(Name); if Length(Name) = 0 then Name := 'Anonymous'; LRLEnterName := Name; end; end.