home *** CD-ROM | disk | FTP | other *** search
/ HPAVC / HPAVC CD-ROM.iso / pc / SPADV.ZIP / EVALU.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1989-01-01  |  4.1 KB  |  125 lines
  1. unit Evalu;
  2.  
  3. interface
  4.  
  5. uses Crt,Globals,Graph,Title,Misc;
  6.  
  7. function Evaluation : integer;
  8. procedure ShowHiScores (Score : integer);
  9. procedure LoadHiScores;
  10. procedure SaveHiScores;
  11.  
  12. implementation
  13.                                          (**** EVALUATION OF GAME ****)
  14. function Evaluation : integer;
  15. var Txt   : Str80;
  16.     Score : integer;
  17. begin
  18.   ClearDevice;
  19.   SetTextStyle (SmallFont,HorizDir,7); SetColor (1);
  20.   SetTextJustify (CenterText,CenterText);
  21.   OutTextXY (160,10,'MISSION EVALUATION');
  22.   TextSize (3,2,3,2); SetColor (2);
  23.   if Done then Txt := 'COMPLETED' else Txt := 'terminated';
  24.   OutTextXY (160,40,'Mission '+Txt+' - '+
  25.     St(Ord(Done)*1000*Skill)+' points');
  26.   OutTextXY (160,55,'250x Crystals collected : '+St(Crystals));
  27.   OutTextXY (160,70,'100x Androids killed : '+St(RobotsKilled));
  28.   OutTextXY (160,85,'50x Electr. Keys carried : '+St(Keys));
  29.   OutTextXY (160,100,'10x Rooms visited : '+St(Rooms)+' of 90');
  30.   OutTextXY (160,115,'-10x Power packs used : '+St(PpacksUsed));
  31.   Score := (RobotsKilled * 100) - (PpacksUsed * 10) + (Crystals * 250) +
  32.            (Keys * 50) + (Rooms * 10) + (Ord (Done) * 1000 * Skill);
  33.   SetColor (1); SetLineStyle (DashedLn,1,ThickWidth); Line (0,137,319,137);
  34.   SetLineStyle (0,0,3); SetColor (3);
  35.   OutTextXY (160,150,'TOTAL SCORE : '+St(Score)+' points');
  36.   SetColor (2);
  37.   OutTextXY (160,180,'Press any key for Hi-Scores...');
  38.   while KeyPressed do K1:=ReadKey;
  39.   K1 := ReadKey;
  40.   Evaluation := Score;
  41. end;
  42.                                          (**** HI-SCORE PROCESSING ****)
  43. procedure ShowHiScores (Score : integer);
  44. var Number,Ctr,Ps,
  45.     Sx,Sy : word;
  46.     Key : char;
  47. begin
  48.   ClearDevice;
  49.   TextSize (4,3,3,1);
  50.   SetColor (1);
  51.   OutTextXY (160,7,'INTERGALACTIC SPACE WARRIORS OF ALL TIMES');
  52.   Number := 0;
  53.   if Score >= HiScore [MaxHiScores].Hscore then begin
  54.     repeat Inc (Number);
  55.     until Score >= HiScore [Number].Hscore;
  56.     for Ctr := MaxHiScores-1 downto Number do
  57.       HiScore [Ctr+1] := HiScore [Ctr];
  58.     with HiScore [Number] do begin
  59.       Hscore := Score;
  60.       Hdone  := Done;
  61.       TextSize (3,2,3,2); SetColor (3);
  62.       OutTextXY (160,60,'Congratulations !!');
  63.       OutTextXY (160,75,'You have entered the hall of fame !');
  64.       Play ('t120 o4 l16 ceg>c8<g>c4');
  65.       SetColor (2);
  66.       OutTextXY (160,100,'Please enter your name below :');
  67.       TextSize (2,1,3,1); SetColor (1);
  68.       Hname := ''; Ps := 1;
  69.       repeat                    { Get player's name in BIG text }
  70.         Key := ReadKey;
  71.         SetColor (0);
  72.         OutTextXY (160,140,Hname);
  73.         case Key of
  74.           #32..#126 : if Length (Hname) < 16 then Hname := Hname + Key;
  75.                  #8 : if Length (Hname) > 0 then Dec (Hname [0]);
  76.         end;
  77.         SetColor (1);
  78.         OutTextXY (160,140,Hname);
  79.       until (Key = #13);
  80.     end;
  81.   end;
  82.   Black (0,50,319,199);
  83.   SetTextJustify (LeftText,TopText);
  84.   TextSize (1,1,1,1);
  85.   for Ctr := 1 to MaxHiscores do begin       { Write hiscores in two columns }
  86.     SetColor (2);
  87.     if Ctr = Number then SetColor (3);
  88.     Sx := 8 + Ord (Ctr>20) *160;
  89.     Sy := 37 + ((Ctr-1) mod 20) *8;
  90.     OutTextXY (Sx,Sy,St(Ctr)+')');
  91.     with HiScore [Ctr] do begin
  92.       OutTextXY (Sx+20,Sy,Hname);
  93.       OutTextXY (Sx+120,Sy,St(Hscore));
  94.     end;
  95.   end;
  96.   TextSize (6,4,1,1); SetColor (3);
  97.   SetTextJustify (CenterText,CenterText);
  98.   OutTextXY (160,27,'Last score : '+St(Score)+'. Press any key...');
  99.   while KeyPressed do K1 := ReadKey;
  100.   Key := ReadKey;
  101. end;
  102.  
  103. procedure LoadHiScores;
  104. var Number : word;
  105. begin
  106.   if Exist ('HISC.DAT') then begin
  107.     Assign (HiScoreFile,'HISC.DAT');
  108.     Reset (HiScoreFile);
  109.     Read (HiScoreFile,HiScore);
  110.   end else for Number := 1 to MaxHiScores do with HiScore [Number] do begin
  111.     if (Number mod 2) > 0 then Hname := 'Robert Schmidt'    { If no file }
  112.                           else Hname := 'FireBall Ltd.';    {   exists   }
  113.     Hscore := (MaxHiscores-Number+1) * 50;    { Scores are easy to beat }
  114.     Hdone  := False;
  115.   end;
  116. end;
  117.  
  118. procedure SaveHiScores;
  119. begin
  120.   Assign (HiScoreFile,'HISC.DAT');
  121.   ReWrite (HiScoreFile);
  122.   Write (HiScoreFile,HiScore);
  123. end;
  124.  
  125. end.