home *** CD-ROM | disk | FTP | other *** search
/ HPAVC / HPAVC CD-ROM.iso / pc / J4FTUT03.ZIP / temp / techtut / tut3 / tech03.pas < prev   
Encoding:
Pascal/Delphi Source File  |  1997-09-10  |  10.3 KB  |  337 lines
  1. {
  2.  
  3.         TechTutor3
  4.         HighScores for the SuperFX Engine
  5.  
  6.         Coding by P.Bestebroer
  7.         FreeWare
  8.  
  9.         To get this code to work, you need the SuperFX engine, and a little
  10.         bit of programming...
  11.  
  12.         Contacting:
  13.  
  14.          HTTP://people.zeelandnet.nl/rpb/
  15.         EMAIL:just4fun@zeelandnet.nl
  16.  
  17. }
  18. PROGRAM Tech03;
  19.  
  20. USES CRT,DOS,SuperFX;
  21.  
  22. {─────────────────────────────────────────────────────────────────────────────
  23.  
  24.                            Hi-Score procedures
  25.  
  26. ─────────────────────────────────────────────────────────────────────────────}
  27. CONST MNAmes      : array[1..12] of string[3] = (
  28.                     'JAN','FEB','MAR','APR','MAY','JUN','JUL','AUG','SEP',
  29.                     'OCT','NOV','DEC');
  30.  
  31. TYPE  TScore = record
  32.         name   : string[8];     { name of the player }
  33.         score  : longint;       { the high-score of the player }
  34.         level  : word;          { the level the played reached }
  35.         date   : Longint;       { the date of the played game  }
  36.       end;
  37.  
  38. VAR   HiScore  : array[1..15] of Tscore;          { a top-15 high-score table}
  39.  
  40. {────────────────────────────────────────────────────────────────────────────}
  41. {
  42.         Load the hiscores
  43.  
  44.         Expects: Nothing
  45.         Returns: Nothing
  46. }
  47. PROCEDURE LoadScores;
  48. VAR f : file;
  49.     i : byte;
  50.     dow,hs      : word;
  51.     tempD       : DateTime;
  52. BEGIN
  53.  assign(f,'hiscore.his');       { name of the hiscore file }
  54.  {$I-}
  55.    reset(f,1);
  56.  {$I+}
  57.   if ioresult<>0 then begin     { No hiscore file found, so create one! }
  58.      rewrite(f,1);
  59.      Hiscore[01].score:=1500;  Hiscore[02].score:=1400;
  60.      Hiscore[03].score:=1300;  Hiscore[04].score:=1200;
  61.      Hiscore[05].score:=1100;  Hiscore[06].score:=1000;
  62.      Hiscore[07].score:=0900;  Hiscore[08].score:=0800;
  63.      Hiscore[09].score:=0700;  Hiscore[10].score:=0600;
  64.      Hiscore[11].score:=0500;  Hiscore[12].score:=0400;
  65.      Hiscore[13].score:=0300;  Hiscore[14].score:=0200;
  66.      Hiscore[15].score:=0100;
  67.      for i:=1 to 15 do begin
  68.          with HiScore[i] do begin
  69.               Name:='SFX';
  70.               Level:=$101;
  71.               GetDate(TempD.year,TempD.month,TempD.day,dow);
  72.               GetTime(TempD.hour,TempD.min,TempD.sec,hs);
  73.               PackTime(TempD,date);
  74.          end;
  75.          blockwrite(f,hiscore[i],sizeof(TScore));
  76.      end;
  77.      close(f);
  78.      exit; { done the loading, so exit }
  79.   end;
  80.  i:=1;
  81.  while (not eof(f)) and (i<16) do begin
  82.        blockread(f,hiscore[i],sizeof(TSCORE));
  83.        inc(i);
  84.  end;
  85.  close(f);
  86. END;
  87.  
  88. {────────────────────────────────────────────────────────────────────────────}
  89. {
  90.         Save the hiscores
  91.  
  92.         Expects: Nothing
  93.         Returns: Nothing
  94. }
  95. PROCEDURE SaveScores;
  96. VAR f : file;
  97.     i : byte;
  98.     dow,hs      : word;
  99.     tempD        : DateTime;
  100. BEGIN
  101.  assign(f,'hiscore.his');
  102.  rewrite(f,1);
  103.  for i:=1 to 15 do blockwrite(f,hiscore[i],sizeof(TSCORE));
  104.  close(f);
  105. END;
  106. {────────────────────────────────────────────────────────────────────────────}
  107. {
  108.         Get the player name
  109.  
  110.         Expects: Nothing
  111.         Returns: The name
  112. }
  113. FUNCTION GetNAME:string;
  114. VAR zin : string;
  115.     i   : byte;
  116.     stop: boolean;
  117. BEGIN
  118.  zin:='';
  119.  UPDATEMAP;                                     { draw background map }
  120.  WText(100,120,zin);                             { show current name   }
  121.  WText(120,90, 'A NEW HIGH SCORE!');             { text1 }
  122.  WText(100,105,'PLEASE ENTER YOU''R NAME');      { text2 }
  123.  SHOWBITMAP;                                    { show virtual page   }
  124.  FadeIn(0,255);                                 { fade in the colors  }
  125.  stop:=false;
  126.  repeat
  127.    UPDATEMAP;                                   { draw background map }
  128.    WText(100,120,zin+'@');                       { show current name   }
  129.    WText(120,90, 'A NEW HIGH SCORE!');           { text1 }
  130.    WText(100,105,'PLEASE ENTER YOU''R NAME');    { text2 }
  131.    SHOWBITMAP;                                  { show virtual page }
  132.  
  133.    if key[ 28] then stop:=true;                 { ENTER key         }
  134.    IF length(zin)<8 then begin
  135.        for i:=1 to 84 do if key[i] then begin
  136.            if length(KeyName[i])=1 then zin:=zin+KeyName[i]; { add letter    }
  137.            if KeyName[i]='Space' then zin:=zin+' ';          { add space     }
  138.            if Key[ 14{BackSpace}] then begin                 { delete char   }
  139.               if length(zin)>1 then zin:=copy(zin,1,length(zin)-1)
  140.                  else zin:='';
  141.            end;
  142.            while key[i] do;         { repeat until key is unpressed }
  143.        end;
  144.     END else IF key[ 14{BackSpace}] then begin
  145.         if length(zin)>1 then zin:=copy(zin,1,length(zin)-1) else zin:='';
  146.         while AnyPressed do;
  147.     END;
  148.  until key[ 28 ] or stop;
  149.  GetName:=zin;                      { return the sentence (name) }
  150. END;
  151. {────────────────────────────────────────────────────────────────────────────}
  152. {
  153.         See if we've got a new hi-score
  154.  
  155.         Expects: the score gotten by the player
  156.         Returns: Nothing
  157. }
  158. FUNCTION SeeHIScore(Nscore:longint;Nlevel:word):boolean;
  159. VAR i,j  : byte;
  160.     done : boolean;
  161.     dow,hs      : word;
  162.     tempD        : DateTime;
  163.  
  164. BEGIN
  165.  SeeHiscore:=false;
  166.  if Nscore<HiScore[15].score then exit;{ if score is lower than last one,exit}
  167.  i:=15;
  168.  done:=false;
  169.  repeat
  170.     if Nscore>HiScore[i].score then dec(i) else Done:=true;
  171.  until (i=0) or (done);
  172.     inc(i);
  173.     SeeHiScore:=true;
  174.     for j:=14 downto i do HiScore[j+1]:=HiScore[j];
  175.     with HiScore[i] do begin             { add new highscore }
  176.          Name:=GetName;                  { get the name }
  177.  
  178.          score := Nscore;                { add score }
  179.          level := NLevel;                { add level }
  180.          GetDate(TempD.year,TempD.month,TempD.day,dow);
  181.          GetTime(TempD.hour,TempD.min,TempD.sec,hs);
  182.          PackTime(TempD,date);           { add date  }
  183.     end;
  184. END;
  185. {────────────────────────────────────────────────────────────────────────────}
  186. {
  187.         Show the hiscores
  188.  
  189.         Expects: Nothing
  190.         Returns: Nothing
  191. }
  192. PROCEDURE ShowHIScore;
  193. VAR i    : byte;
  194.     zin  : string;
  195.     Tdate: DateTime;
  196.     ScoreOFS : byte;
  197.     YSpd     : byte;
  198.     YAdd     : integer;
  199.     YPos     : integer;
  200. BEGIN
  201.  Fadeout(0,255);         { fade the colors out }
  202.  ClearScreen;            { clear the screen }
  203.  SetPal;                 { set correct palette }
  204.  
  205.  SetTEXTSegment(vpage_seg); { make sure text is printed on correct page }
  206.  
  207.  ScoreOfs:=20;              { Y offset of score }
  208.  
  209.  Ypos:=199;                 { these variables }
  210.  Yspd:=9;                   { are used }
  211.  Yadd:=-1;                  { for "bouncing" the screen }
  212.  REPEAT
  213.    AddImage(8,10,StatusSprite[1].data,false,false);      { rank  }
  214.    AddImage(37,10,StatusSprite[2].data,false,false);     { name  }
  215.    AddImage(105,10,StatusSprite[3].data,false,false);    { score }
  216.    AddImage(159,10,StatusSprite[4].data,false,false);    { stage }
  217.    AddImage(200,10,StatusSprite[5].data,false,false);    { time  }
  218.    AddImage(255,10,StatusSprite[6].data,false,false);    { date  }
  219.  
  220.    UpdateMap;               { show the background map }
  221.  
  222.    for i:=1 to 15 do begin
  223.      with HiScore[i] do begin
  224.           {
  225.              Show NAME and rank
  226.           }
  227.           str(i,zin);
  228.           while length(zin)<2 do zin:=' '+zin;
  229.           zin:=zin+'. '+NAME;
  230.           Wtext(10,ScoreOfs+(i*9),zin);
  231.  
  232.           {
  233.             Show the Score
  234.           }
  235.           str(score,zin);
  236.           while length(zin)<9 do zin:='.'+zin;
  237.           Wtext(95,ScoreOfs+(i*9),zin);
  238.  
  239.           {
  240.             Show the level
  241.           }
  242.           str(level div 256,zin);
  243.           Wtext(166,ScoreOfs+(i*9),zin+'-');
  244.           str(level and $ff,zin);
  245.           Wtext(177,ScoreOfs+(i*9),zin);
  246.           {
  247.             Get the time of the played game
  248.           }
  249.           UnpackTime(Date,TDate);
  250.           {
  251.              Show the hour played
  252.           }
  253.           str(Tdate.hour,zin);
  254.           while length(zin)<2 do zin:=' '+zin;
  255.           zin:=zin+':';
  256.           Wtext(195,ScoreOfs+(i*9),zin);
  257.           {
  258.             Show minutes
  259.           }
  260.           str(Tdate.Min,zin);
  261.           while length(zin)<2 do zin:='0'+zin;
  262.           Wtext(212,ScoreOfs+(i*9),zin);
  263.  
  264.           {
  265.             Show month name
  266.           }
  267.           zin:=MNames[Tdate.Month];
  268.           zin:=zin+'-';
  269.           Wtext(236,ScoreOfs+(i*9),zin);
  270.           {
  271.             Show the day
  272.           }
  273.           str(Tdate.day,zin);
  274.           while length(zin)<2 do zin:=' '+zin;
  275.           Wtext(261,ScoreOfs+(i*9),zin);
  276.           {
  277.             Show the Year
  278.           }
  279.           str(Tdate.year,zin);
  280.           Wtext(278,ScoreOfs+(i*9),zin);
  281.      end;
  282.    end;
  283.  
  284.    {
  285.       Show the screen normal, or bounce it in if needed
  286.    }
  287.    if (ypos=0) and (yspd=0) then ShowBitmap else begin
  288.       asm
  289.         xor ax,ax
  290.         mov bx,Ypos
  291.         call Displace
  292.       end;
  293.       inc(ypos,yadd);
  294.       if yadd>-8 then dec(Yadd);
  295.       if ypos<=0 then begin
  296.          Ypos:=0;
  297.          Yadd:=Yspd;
  298.          if Yspd>0 then dec(Yspd) else Yspd:=0;
  299.       end;
  300.    end;
  301.  
  302.  until (ypos=0) and (yspd=0);
  303.  repeat until ANYPRESSED;
  304.  FadeOut(0,255);
  305. END;
  306. {────────────────────────────────────────────────────────────────────────────}
  307. BEGIN
  308.   while port[$60]<>156 do ;
  309.   textcolor(7); textbackground(0); clrscr;
  310.   writeln('TechTutor #3');
  311.   writeln('written by P.Bestebroer, Just4Fun Productions');
  312.   writeln('');
  313.   writeln('This tutor should work, but you need a few things:');
  314.   writeln(' * The SuperFX engine (its freeware, so why not download it ;)');
  315.   writeln(' * some grafichs to use');
  316.   writeln(' * and a game to put it in!');
  317.   writeln;
  318.   writeln('These little procedures where ripped from a space-invadors game');
  319.   writeln('I was working on (never got finished) I just ripped it out, and');
  320.   writeln('used them as example material.');
  321.  
  322.   writeln('Press a key');
  323.   writeln;
  324.   writeln;
  325.   writeln;
  326.   writeln('----------------------------------');
  327.   writeln('Contacting: just4fun@zeelandnet.nl');
  328.   writeln('http://people.zeelandnet.nl/rpb   ');
  329.   writeln('----------------------------------');
  330.   repeat until port[$60]<>156;
  331.  
  332.   {=-=-=-=-= This should be the order of calling the procedures =-=-=-=-=}
  333.   LoadScores;
  334.   if SeeHiScore(1000,5) then SaveScores;
  335.              {score^ ^name}
  336.   ShowHiScore;
  337. END.