home *** CD-ROM | disk | FTP | other *** search
/ Media Share 9 / MEDIASHARE_09.ISO / pascal / spx10.zip / SPX_DEMO.ZIP / DEMO3.PAS < prev    next >
Pascal/Delphi Source File  |  1993-05-05  |  5KB  |  201 lines
  1. Program Demo3;
  2.  
  3. { SPX library - Sprite demo 3  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.              lvl,                       { ball level number }
  21.              dx,dy : integer;           { direction }
  22.              constructor init(nx,ny,k,l:integer);
  23.              procedure drawitemobject;virtual;
  24.              procedure eraseitemobject;virtual;
  25.              procedure updateitemobject;virtual;
  26.              procedure calcitemobject;virtual;
  27.            end;
  28.  
  29. var
  30.   balls : array[0..2] of pointer;
  31.   pal   : RGBlist;
  32.   head,
  33.   tail  : plist;
  34.  
  35. procedure setup;
  36. var
  37.   p : plist;
  38.   d : integer;
  39. begin
  40.   openmode(5);
  41.   randomize;
  42.   setpageactive(5);
  43.   loadpcx(path+'virt1.pcx');
  44.   setpageactive(3);
  45.   loadpcx(path+'virt2.pcx');
  46.   loadvsp(path+'balls.vsp',balls);
  47.   loadcolors(path+'balls.pal',pal,256);
  48.   head := nil; tail := nil;
  49.   for d := 1 to max do
  50.     begin
  51.       new(p);
  52.       p^.item := new(Pballs,init(random(320),random(200),d mod 3,d shl 1));
  53.       p^.item^.powner := p;
  54.       addp(head,tail,p);
  55.     end;
  56.   fsetcolors(zdc);  { all black palette }
  57.   pcopy(5,4);       { copy virt page }
  58.   pcopy(3,2);       { copy to work page }
  59.   pcopy(3,1);       { copy to visual }
  60.   fadein(40,pal);
  61. end;
  62.  
  63.  
  64. procedure placespeed(mode:putmode);
  65. begin
  66.   case mode of
  67.     draw   : begin
  68.                putletter(5,5,5,st(framerate));
  69.                putletter(4,4,255,st(framerate));
  70.              end;
  71.     erase  : CopyRect(4,4,50,12,pages[3]^,pages[2]^);
  72.     update : CopyRect(4,4,50,12,pages[2]^,pages[1]^);
  73.   end;
  74. end;
  75.  
  76.  
  77. procedure placeballs(var head:plist;mode:putmode);
  78. var
  79.   p : plist;
  80. begin
  81.   p := head;
  82.   while p<>nil do
  83.     begin
  84.       case mode of
  85.         draw   : p^.item^.drawitemobject;
  86.         erase  : pballs(p^.item)^.eraseitemobject;
  87.         update : pballs(p^.item)^.updateitemobject;
  88.       end;
  89.       p := p^.next;
  90.     end;
  91. end;
  92.  
  93.  
  94. procedure animate;
  95. var
  96.   p : pointer;
  97. begin
  98.   setpageactive(2);
  99.   setrate(1000);
  100.   repeat
  101.     f_clk[0] := framerate;
  102.     if plus and (framerate<60)
  103.       then inc(framerate)
  104.       else
  105.         if minus and (framerate>0)
  106.           then dec(framerate);
  107.     placeballs(head,erase);
  108.     placespeed(erase);
  109.     if not space
  110.       then calcitems(head);
  111.     placeballs(head,draw);
  112.     placespeed(draw);
  113.     placeballs(head,update);
  114.     placespeed(update);
  115.     if enter
  116.       then
  117.         begin
  118.           pcopy(4,1);
  119.           repeat until not enter;
  120.           pcopy(3,1);
  121.         end;
  122.     repeat until (f_clk[0]=0);
  123.   until esc;
  124. end;
  125.  
  126. (**) { Tballs methods }
  127.  
  128. constructor Tballs.init(nx,ny,k,l:integer);
  129. begin
  130.   Tobjs.init;
  131.   kind := k;
  132.   lvl := l;
  133.   x := nx; y := ny; 
  134.   ox := x; oy := y;
  135.   repeat
  136.     dx := random(7)-3;
  137.     dy := random(7)-3;
  138.   until (dx<>0) and (dy<>0);
  139.   imagedims(balls[kind]^,width,height);
  140. end;
  141.  
  142.  
  143. procedure Tballs.eraseitemobject;
  144. begin
  145.   CopyRect(x,y,x+width-1,y+height-1,pages[5]^,pages[4]^);
  146.   CopyRect(ox,oy,ox+width-1,oy+height-1,pages[3]^,pages[2]^);
  147.   CopyRect(x,y,x+width-1,y+height-1,pages[3]^,pages[2]^);
  148. end;
  149.  
  150.  
  151. procedure Tballs.updateitemobject;
  152. begin
  153.   CopyRect(ox,oy,ox+width-1,oy+height-1,pages[2]^,pages[1]^);
  154.   CopyRect(x,y,x+width-1,y+height-1,pages[2]^,pages[1]^);
  155. end;
  156.  
  157.  
  158. procedure Tballs.drawitemobject;
  159. begin
  160.   displayer(x,y,balls[kind]^,pages[4]^,lvl);
  161.   dispvirt(x,y,balls[kind]^,pages[4]^,lvl);
  162. end;
  163.  
  164.  
  165. procedure Tballs.calcitemobject;
  166. begin
  167.   ox := x; oy := y;
  168.   inc(x,dx); inc(y,dy);
  169.   if (x<0) or (x>320-width)
  170.     then dx := -dx;
  171.   if (y<0) or (y>199-height)
  172.     then dy := -dy;
  173.   ifix(x,0,320-width);
  174.   ifix(y,0,200-height);
  175. end;
  176.  
  177.  
  178. procedure showit;
  179. begin
  180.    writeln('SPX library - Sprite demo 2');
  181.    writeln('Copyright 1993 Scott D. Ramsay');
  182.    writeln;
  183.    writeln('Keys:');
  184.    writeln(' ESC          - quit demo');
  185.    writeln(' +/-          - change frame speed');
  186.    writeln(' SPACE        - pause ');
  187.    writeln(' ENTER        - view sprite level page');
  188.    writeln;
  189.    write('Press any key.');
  190.    clearbuffer;
  191.    repeat until anykey;
  192. end;
  193.  
  194.  
  195. begin
  196.   showit;
  197.   setup;
  198.   animate;
  199.   clean_plist(head,tail);
  200.   closemode;
  201. end.