home *** CD-ROM | disk | FTP | other *** search
/ POINT Software Programming / PPROG1.ISO / pascal / spx / demo / demo2.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-05-05  |  4.1 KB  |  181 lines
  1. Program Demo2;
  2.  
  3. { SPX library - Sprite demo  Copyright 1993 Scott D. Ramsay  }
  4.  
  5. Uses SPX_VGA,SPX_KEY,SPX_OBJ,SPX_IMG,SPX_SND,SPX_TXT,SPX_FNC;
  6.  
  7. const
  8.   path = '';
  9.   max  = 10;
  10.   framerate  : integer = 20;    { NOT in fps! }
  11.  
  12. type
  13.   putmode = (draw,erase,update);
  14.   Pballs = ^Tballs;
  15.   Tballs = object(Tobjs)
  16.              width,height,              { dimension of sprite }
  17.              kind,                      { sprite number }
  18.              ox,oy,                     { old position }
  19.              x,y,                       { new position }
  20.              dx,dy : integer;           { direction }
  21.              constructor init(nx,ny,k:integer);
  22.              procedure drawitemobject;virtual;
  23.              procedure eraseitemobject;virtual;
  24.              procedure updateitemobject;virtual;
  25.              procedure calcitemobject;virtual;
  26.            end;
  27.  
  28. var
  29.   balls : array[0..2] of pointer;
  30.   pal   : RGBlist;
  31.   head,
  32.   tail  : plist;
  33.  
  34. procedure setup;
  35. var
  36.   p : plist;
  37.   d : integer;
  38. begin
  39.   openmode(3);
  40.   randomize;
  41.   setpageactive(3);
  42.   loadpcx(path+'tank.pcx');
  43.   loadvsp(path+'balls.vsp',balls);
  44.   loadcolors(path+'balls.pal',pal,256);
  45.   head := nil; tail := nil;
  46.   for d := 1 to max do
  47.     begin
  48.       new(p);
  49.       p^.item := new(Pballs,init(random(320),random(200),d mod 3));
  50.       p^.item^.powner := p;
  51.       addp(head,tail,p);
  52.     end;
  53.   fsetcolors(zdc);  { all black palette }
  54.   pcopy(3,2);       { copy to work page }
  55.   pcopy(3,1);       { copy to visual }
  56.   fadein(40,pal);
  57. end;
  58.  
  59.  
  60. procedure placespeed(mode:putmode);
  61. begin
  62.   case mode of
  63.     draw   : putletter(4,4,255,st(framerate));
  64.     erase  : CopyRect(4,4,50,11,pages[3]^,pages[2]^);
  65.     update : CopyRect(4,4,50,11,pages[2]^,pages[1]^);
  66.   end;
  67. end;
  68.  
  69.  
  70. procedure placeballs(var head:plist;mode:putmode);
  71. var
  72.   p : plist;
  73. begin
  74.   p := head;
  75.   while p<>nil do
  76.     begin
  77.       case mode of
  78.         draw   : p^.item^.drawitemobject;
  79.         erase  : pballs(p^.item)^.eraseitemobject;
  80.         update : pballs(p^.item)^.updateitemobject;
  81.       end;
  82.       p := p^.next;
  83.     end;
  84. end;
  85.  
  86.  
  87. procedure animate;
  88. var
  89.   p : pointer;
  90. begin
  91.   setpageactive(2);
  92.   setrate(1000);
  93.   repeat
  94.     f_clk[0] := framerate;
  95.     if plus and (framerate<60)
  96.       then inc(framerate)
  97.       else
  98.         if minus and (framerate>0)
  99.           then dec(framerate);
  100.     placeballs(head,erase);
  101.     placespeed(erase);
  102.     if not space
  103.       then calcitems(head);
  104.     placeballs(head,draw);
  105.     placespeed(draw);
  106.     placeballs(head,update);
  107.     placespeed(update);
  108.     repeat until (f_clk[0]=0);
  109.   until esc;
  110. end;
  111.  
  112. (**) { Tballs methods }
  113.  
  114. constructor Tballs.init(nx,ny,k:integer);
  115. begin
  116.   Tobjs.init;
  117.   kind := k;
  118.   x := nx; y := ny; 
  119.   ox := x; oy := y;
  120.   repeat
  121.     dx := random(7)-3;
  122.     dy := random(7)-3;
  123.   until (dx<>0) and (dy<>0);
  124.   imagedims(balls[kind]^,width,height);
  125. end;
  126.  
  127.  
  128. procedure Tballs.eraseitemobject;
  129. begin
  130.   CopyRect(ox-width shr 1,oy-height shr 1,ox+width shr 1,oy+height shr 1,pages[3]^,pages[2]^);
  131.   CopyRect(x-width shr 1,y-height shr 1,x+width shr 1,y+height shr 1,pages[3]^,pages[2]^);
  132. end;
  133.  
  134.  
  135. procedure Tballs.updateitemobject;
  136. begin
  137.   CopyRect(ox-width shr 1,oy-height shr 1,ox+width shr 1,oy+height shr 1,pages[2]^,pages[1]^);
  138.   CopyRect(x-width shr 1,y-height shr 1,x+width shr 1,y+height shr 1,pages[2]^,pages[1]^);
  139. end;
  140.  
  141.  
  142. procedure Tballs.drawitemobject;
  143. begin
  144.   ftput_clip(x,y,balls[kind]^,true);
  145. end;
  146.  
  147.  
  148. procedure Tballs.calcitemobject;
  149. begin
  150.   ox := x; oy := y;
  151.   inc(x,dx); inc(y,dy);
  152.   if (x<0) or (x>319)
  153.     then dx := -dx;
  154.   if (y<0) or (y>199)
  155.     then dy := -dy;
  156. end;
  157.  
  158.  
  159. procedure showit;
  160. begin
  161.    writeln('SPX library - Sprite demo');
  162.    writeln('Copyright 1993 Scott D. Ramsay');
  163.    writeln;
  164.    writeln('Keys:');
  165.    writeln(' ESC          - quit demo');
  166.    writeln(' +/-          - change frame speed');
  167.    writeln(' SPACE        - pause ');
  168.    writeln;
  169.    write('Press any key.');
  170.    clearbuffer;
  171.    repeat until anykey;
  172. end;
  173.  
  174.  
  175. begin
  176.   showit;
  177.   setup;
  178.   animate;
  179.   clean_plist(head,tail);
  180.   closemode;
  181. end.