Subversion Repositories Kolibri OS

Rev

Blame | Last modification | View Log | Download | RSS feed

  1. unit LRLHighScores;
  2.  
  3. {$mode objfpc}
  4. {$i-}
  5.  
  6.  
  7. interface
  8.  
  9.  
  10. uses
  11.   SysUtils,
  12.   LRLRoutines, LRLSprites;
  13.  
  14.  
  15. procedure LRLLoadHighScores;
  16. procedure LRLShowHighScores;
  17. function LRLBestScore(Score: Longint): Boolean;
  18. procedure LRLInsertScore(Name: String; Score: Longint);
  19. procedure LRLSaveHighScores;
  20. function LRLEnterName: String;
  21.  
  22.  
  23. implementation
  24.  
  25.  
  26. const
  27.   HighsFileName = 'LRL.HSR';
  28.   HighsFileHeader: String[29] = 'Lode Runner Live High Scores'#26;
  29.  
  30. type
  31.   TSupers = packed record
  32.     Name:  String[20];
  33.     Score: Longint;
  34.   end;
  35.  
  36. var
  37.   MainScreen: Pointer;
  38.   HighFrame:  Pointer;
  39.   HighTable:  array[1..5] of TSupers;
  40.  
  41.  
  42. procedure LoadData;
  43. var
  44.   j: Word;
  45. begin
  46.   GetMem(MainScreen, 64004);
  47.   GetMem(HighFrame, 45000);
  48.   Seek(ImageFile, LRLImagesFilePosition);
  49.   BlockRead(ImageFile, MainScreen^, 7940, j);
  50.   DecompressRepByte(MainScreen^, HighFrame^, 7940, j);
  51.   BlockRead(ImageFile, MainScreen^, 64004, j);
  52. end;
  53.  
  54.  
  55. procedure DisposeData;
  56. begin
  57.   FreeMem(MainScreen, 64004);
  58.   FreeMem(HighFrame, 45000);
  59. end;
  60.  
  61.  
  62. procedure LRLShowHighScores;
  63. var
  64.   p: Pointer;
  65.   i: Integer;
  66.   s: String;
  67. begin
  68.   LRLLoadHighScores;
  69.  
  70.   GetMem(p, 768);
  71.   DataFill(p^, 768, 0, 0);
  72.   Palette256Set(p^);
  73.   FreeMem(p, 768);
  74.  
  75.   LoadData;
  76.   ImagePut(LRLScreen^, MainScreen^, 0, 0, 0, 0, 319, 199);
  77.   ImagePut(LRLScreen^, HighFrame^, 6, 50, 0, 0, 319, 199);
  78.  
  79.   for i := 1 to 5 do
  80.   begin
  81.     ImageStringGet(Chr(i + 48) + '. ' + HighTable[i].Name, LRLFont^, LRLFontBuffer^, 110);
  82.     ImagePut(LRLScreen^, LRLFontBuffer^, 55, 85 + i * 17, 8, 0, 319, 199);
  83.     Str(HighTable[i].Score, s);
  84.     ImageStringGet(s, LRLFont^, LRLFontBuffer^, 46);
  85.     ImagePut(LRLScreen^, LRLFontBuffer^, 260 - ImageSizex(LRLFontBuffer^), 85 + i * 17, 8, 0, 319, 199);
  86.   end;
  87.  
  88.   ScreenApply(LRLScreen^);
  89.   FadeTo(LRLMenuPalette);
  90.  
  91.   ReadKey;
  92.  
  93.   FadeClear;
  94.   ImageClear(LRLScreen^);
  95.   ScreenApply(LRLScreen^);
  96.  
  97.   DisposeData;
  98. end;
  99.  
  100.  
  101. procedure LRLLoadHighScores;
  102. var
  103.   InFile: File;
  104.   i, j:  Word;
  105.   Dummy: String[30];
  106. begin
  107.   FileMode := 0;
  108.   AssignFile(InFile, HighsFileName);
  109.   Reset(InFile, 1);
  110.  
  111.   if IOResult <> 0 then
  112.   begin
  113.     for i := 1 to 5 do
  114.     begin
  115.       HighTable[i].Name := 'Lode Runner';
  116.       HighTable[i].score := 60000 - i * 10000;
  117.     end;
  118.     AssignFile(InFile, HighsFileName);
  119.     Rewrite(InFile, 1);
  120.     BlockWrite(InFile, HighsFileHeader[1], 29, i);
  121.     BlockWrite(InFile, HighTable, SizeOf(TSupers) * 5, j);
  122.   end else
  123.   begin
  124.     Seek(InFile, 0);
  125.     BlockRead(InFile, Dummy[1], 29, j);
  126.     if (IOResult <> 0) or (not DataIdentical(Dummy[1], HighsFileHeader[1], 29, 0, 0)) then
  127.           raise Exception.Create('Error: Invalid file with high scores! (try to remove LRL.HSR file)');
  128.     BlockRead(InFile, HighTable, SizeOf(TSupers) * 5, j);
  129.   end;
  130.  
  131.   Close(InFile);
  132. end;
  133.  
  134.  
  135. procedure LRLSaveHighScores;
  136. var
  137.   InFile: File;
  138.   j: Word;
  139. begin
  140.   FileMode := 2;
  141.   AssignFile(InFile, HighsFileName);
  142.   Reset(InFile, 1);
  143.   Seek(InFile, 29);
  144.   BlockWrite(InFile, HighTable, SizeOf(TSupers) * 5, j);
  145.   Close(InFile);
  146. end;
  147.  
  148.  
  149. function LRLBestScore(Score: Longint): Boolean;
  150. var
  151.   i: Integer;
  152. begin
  153.   LRLBestScore := True;
  154.   LRLLoadHighScores;
  155.   i := 1;
  156.   while True do
  157.   begin
  158.     if Score >= HighTable[i].Score then
  159.       Exit;
  160.     Inc(i);
  161.     if i > 5 then
  162.     begin
  163.       LRLBestScore := False;
  164.       Exit;
  165.     end;
  166.   end;
  167. end;
  168.  
  169.  
  170. procedure LRLInsertScore(Name: String; Score: Longint);
  171. var
  172.   i, j: Word;
  173. begin
  174.   LRLLoadHighScores;
  175.   i := 1;
  176.   while True do
  177.   begin
  178.     if Score >= HighTable[i].Score then
  179.     begin
  180.       for j := 4 downto i do
  181.       begin
  182.         HighTable[j + 1].Name  := HighTable[j].Name;
  183.         HighTable[j + 1].Score := HighTable[j].Score;
  184.       end;
  185.       HighTable[i].Name  := Name;
  186.       HighTable[i].Score := Score;
  187.       LRLSaveHighScores;
  188.       Exit;
  189.     end;
  190.     Inc(i);
  191.     if i > 5 then
  192.     begin
  193.       Exit;
  194.     end;
  195.   end;
  196. end;
  197.  
  198.  
  199. function LRLEnterName: String;
  200. var
  201.   p: Pointer;
  202.   RedrawName: Boolean;
  203.   Keypress: Word;
  204.   Name: String;
  205.   C: Char;
  206. begin
  207.   Name := '';
  208.  
  209.   GetMem(p, 768);
  210.   DataFill(p^, 768, 0, 0);
  211.   Palette256Set(p^);
  212.   FreeMem(p, 768);
  213.  
  214.   ImageClear(LRLScreen^);
  215.   ImagePut(LRLScreen^, LRLLogo^, 3, 3, 0, 0, 319, 199);
  216.   ImageStringGet('Congratulations! You are in Top-Five!', LRLFont^, LRLFontBuffer^, 110);
  217.   ImagePut(LRLScreen^, LRLFontBuffer^, 160 - ImageSizex(LRLFontBuffer^) shr 1, 85, 0, 0, 319, 199);
  218.   ImageStringGet('Enter your name below, Champ', LRLFont^, LRLFontBuffer^, 111);
  219.   ImagePut(LRLScreen^, LRLFontBuffer^, 160 - ImageSizex(LRLFontBuffer^) shr
  220.     1, 110, 0, 0, 319, 199);
  221.   ImageStringGet('---------------------------', LRLFont^, LRLFontBuffer^, 100);
  222.   ImagePut(LRLScreen^, LRLFontBuffer^, 160 - ImageSizex(LRLFontBuffer^) shr
  223.     1, 155, 0, 0, 319, 199);
  224.   ScreenApply(LRLScreen^);
  225.   FadeTo(LRLMenuPalette);
  226.  
  227.   RedrawName := True;
  228.   repeat
  229.     if RedrawName = True then
  230.     begin
  231.       ImageFill(LRLFontBuffer^, 320, 20, 0);
  232.       ImagePut(LRLScreen^, LRLFontBuffer^, 0, 140, 0, 0, 319, 199);
  233.       ImageStringGet(Name, LRLFont^, LRLFontBuffer^, 100);
  234.       ImagePut(LRLScreen^, LRLFontBuffer^, 160 - ImageSizex(LRLFontBuffer^) shr 1, 140, 0, 0, 319, 199);
  235.       ScreenApply(LRLScreen^);
  236.       RedrawName := False;
  237.     end;
  238.  
  239.     Keypress := ReadKey;
  240.  
  241.     if (Keypress = KEY_BACK) and (Length(Name) > 0) then
  242.     begin
  243.           SetLength(Name, Length(Name) - 1);
  244.       RedrawName := True;
  245.     end;
  246.  
  247.     C := ScanToChar(Keypress);
  248.     if (C > #31) and (Length(Name) < 20) then
  249.     begin
  250.       Name := Name + C;
  251.       RedrawName := True;
  252.     end;
  253.  
  254.   until Keypress = KEY_ENTER;
  255.   FadeClear;
  256.  
  257.   Name := Trim(Name);
  258.   if Length(Name) = 0 then
  259.     Name := 'Anonymous';
  260.   LRLEnterName := Name;
  261. end;
  262.  
  263.  
  264. end.
  265.