home *** CD-ROM | disk | FTP | other *** search
/ POINT Software Programming / PPROG1.ISO / pascal / spx / demo / demo6.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-05-01  |  3.3 KB  |  165 lines
  1. Program Demo6;
  2.  
  3. { SPX library - 3D demo Copyright 1993 Scott D. Ramsay  }
  4.  
  5. Uses SPX_VGA,SPX_KEY,SPX_OBJ,SPX_T3D,SPX_SND;
  6.  
  7. const
  8.   pbeg : plist = nil;
  9.   pend : plist = nil;
  10.  
  11. type
  12.   Ppoint = ^Tpoint;
  13.   Tpoint = object(Tobjs)
  14.              x,y,z : integer;
  15.              constructor init(nx,ny,nz:integer);
  16.            end;
  17.  
  18. var
  19.   oldexit   : pointer;
  20.   d,m,r     : integer;
  21.  
  22. procedure cleanup;far;
  23. begin
  24.   clean_plist(pbeg,pend);
  25.   closemode;
  26.   exitproc := oldexit;
  27. end;
  28.  
  29. procedure setup;
  30. begin
  31.   setrate(8192);
  32.   openmode(2); randomize;
  33.   oldexit := exitproc; exitproc := @cleanup;
  34. end;
  35.  
  36.  
  37. procedure setlevel;
  38. const
  39.   lv1 : array[0..8,0..1] of integer =
  40.         ((-3,-5),(3,-5),(5,-3),(5,3),(3,5),(-3,5),(-5,3),(-5,-3),(-3,-5));
  41. var
  42.   p : plist;
  43.   d,e : integer;
  44. begin
  45.   for d := 0 to 8 do
  46.     begin
  47.       new(p);
  48.       p^.item := new(ppoint,init(lv1[d,0]*10,lv1[d,1]*10,0));
  49.       p^.item^.powner := p;
  50.       addp(pbeg,pend,p);
  51.     end;
  52. end;
  53.  
  54.  
  55. procedure drawlist(c:integer);
  56. var
  57.   nx,ny,nz,
  58.   ox,oy,oz : integer;
  59.   p        : plist;
  60. begin
  61.   p := pbeg;
  62.   while p<>nil do
  63.     with ppoint(p^.item)^ do
  64.       begin
  65.         nx := x; ny := y; nz := z;
  66.         rotate256xyz(nx,ny,nz,0,0,r);
  67.         if p<>pbeg
  68.           then
  69.             begin
  70.               line3D(ox,oy,100+m,nx,ny,100+m,c,true);
  71.               line3D(ox,oy,-200+m,nx,ny,-200+m,c,true);
  72.               line3D(nx,ny,100+m,nx,ny,-200+m,c,true);
  73.             end;
  74.         ox := nx; oy := ny; oz := nz;
  75.         p := p^.next;
  76.       end;
  77. end;
  78.  
  79.  
  80. procedure getkey;
  81. begin
  82.   if plus
  83.     then r := (r+1)mod 256
  84.     else
  85.      if minus
  86.        then r := (r+255)mod 256;
  87.   if np[4,2] and (xv>-300)
  88.     then dec(xv,5)
  89.     else
  90.       if np[6,2] and (xv<300)
  91.         then inc(xv,5);
  92.   if np[4,1] and (m>-200)
  93.     then dec(m,5)
  94.     else
  95.       if np[6,1] and (m<135)
  96.         then inc(m,5);
  97.   if np[8,2] and (yv>-300)
  98.     then dec(yv,5)
  99.     else
  100.       if np[2,2] and (yv<300)
  101.         then inc(yv,5);
  102. end;
  103.  
  104.  
  105. procedure drawall(draw:boolean);
  106. begin
  107.   for d := -10 to 10 do
  108.     line3d(d*10,20,100,d*10,20,-100,ord(draw),true);
  109.   drawlist(12*ord(draw));
  110.   pset3d(-100,-50,100,15*ord(draw));
  111.   pset3d(-100,50,100,15*ord(draw));
  112.   pset3d(100,-50,100,15*ord(draw));
  113.   pset3d(100,50,100,15*ord(draw));
  114.   pset3d(-100,-50,-100,15*ord(draw));
  115.   pset3d(-100,50,-100,15*ord(draw));
  116.   pset3d(100,-50,-100,15*ord(draw));
  117.   pset3d(100,50,-100,15*ord(draw));
  118. end;
  119.  
  120.  
  121. procedure Animate;
  122. begin
  123.   setlevel; zv := 300; m := 0; r := 0;
  124.   setrate(1000);
  125.   repeat
  126.     f_clk[0] := 20;
  127.     drawall(false);
  128.     getkey;
  129.     drawall(true);
  130.     repeat until f_clk[0]=0;
  131.   until esc;
  132. end;
  133.  
  134.  
  135. (**) { tpoint methods }
  136.  
  137. constructor tpoint.init(nx,ny,nz:integer);
  138. begin
  139.   inherited init;
  140.   x := nx; y := ny; z := nz;
  141. end;
  142.  
  143.  
  144. procedure showit;
  145. begin
  146.    writeln('SPX library - 3D demo');
  147.    writeln('Copyright 1993 Scott D. Ramsay');
  148.    writeln;
  149.    writeln('Keys:');
  150.    writeln(' ESC          - quit demo');
  151.    writeln(' Arrow keys   - change viewer''s postition');
  152.    writeln(' A/D          - move object along Z');
  153.    writeln(' +/-          - rotate object along Z axis');
  154.    writeln;
  155.    write('Press any key.');
  156.    clearbuffer;
  157.    repeat until anykey;
  158. end;
  159.  
  160.  
  161. begin
  162.   showit;
  163.   setup;
  164.   Animate;
  165. end.