home *** CD-ROM | disk | FTP | other *** search
/ Media Share 9 / MEDIASHARE_09.ISO / pascal / spx10.zip / SPX_DEMO.ZIP / DEMO4.PAS < prev    next >
Pascal/Delphi Source File  |  1993-05-05  |  3KB  |  127 lines
  1. Program Demo4;
  2.  
  3. { SPX library - GeoMorph demo Copyright 1993 Scott D. Ramsay  }
  4.  
  5. Uses SPX_VGA,SPX_KEY,SPX_GEO,SPX_TXT,SPX_FNC;
  6.  
  7. const
  8.   path  = '';
  9.   gmx   = 50;                    { tile map size }
  10.   gmy   = 50;
  11.   gsx   = 16;                    { tile size }
  12.   gsy   = 16;
  13.   smx   = gmx*gsx;               { tile map size in pixels }
  14.   smy   = gmy*gsy;
  15.   speed : integer = 4;
  16.  
  17. type
  18.   PMyMorph = ^TMyMorph;
  19.   TMyMorph = object(TMorph)
  20.                function geomap(x,y:integer):integer;virtual;
  21.                procedure placegeo(x,y,geonum:integer);virtual;
  22.                procedure nogogeo(x,y:integer); virtual;
  23.              end;
  24.  
  25. var
  26.   MyMorph : PMyMorph;
  27.   gpic    : array[0..20] of pointer;
  28.   map     : array[0..gmy-1,0..gmx-1] of byte;
  29.   pal     : RGBlist;
  30.   flip,
  31.   geo_cnt,
  32.   x,y     : integer;
  33.  
  34. procedure setup;
  35. begin
  36.   openmode(2);
  37.   MyMorph := new(PMyMorph,init(gmx,gmy,19,12,16,16));
  38.   setpageactive(2);
  39.   geo_cnt := loadgmp(path+'demo.gmp',gpic,map);
  40.   loadcolors(path+'demo.pal',pal,256);
  41.   fsetcolors(pal);
  42.   x := 50; y := 50;
  43. end;
  44.  
  45.  
  46. procedure changexy;
  47. begin
  48.   if np[7,2] or np[8,2] or np[9,2]
  49.     then dec(y,speed)
  50.     else
  51.       if np[1,2] or np[2,2] or np[3,2]
  52.         then inc(y,speed);
  53.   if np[7,2] or np[4,2] or np[1,2]
  54.     then dec(x,speed)
  55.     else
  56.       if np[9,2] or np[6,2] or np[3,2]
  57.         then inc(x,speed);
  58.   if ch in ['1'..'9']
  59.     then speed := vl(ch);
  60.   ifix(x,0,smx-1); ifix(y,0,smy-1);
  61. end;
  62.  
  63.  
  64. procedure Animate;
  65. begin
  66.   flip := 0;
  67.   repeat
  68.      flip := (flip+1)mod 4;
  69.      changexy;
  70.      MyMorph^.drawmap(x,y);
  71.      putletter(25,20,5,st(x)+','+st(y));
  72.      putletter(24,19,255,st(x)+','+st(y));
  73.      putletter(25,27,5,'Speed = '+st(speed));
  74.      putletter(24,26,255,'Speed = '+st(speed));
  75.      pset(160,100,255);
  76.      pset(161,101,5);
  77.      copyRect(16,16,303,183,pages[2]^,pages[1]^);
  78.   until esc;
  79. end;
  80.  
  81. (**) { TMyMorph methods }
  82.  
  83. function TMyMorph.geomap(x,y:integer):integer;
  84. begin
  85.   geomap := map[y,x];
  86. end;
  87.  
  88.  
  89. procedure TMyMorph.nogogeo(x,y:integer);
  90. begin
  91.   fput(x,y,gpic[0]^,false);
  92. end;
  93.  
  94.  
  95. procedure TMyMorph.placegeo(x,y,geonum:integer);
  96. begin
  97.   if geonum in [1..geo_cnt]
  98.     then
  99.       if geonum=2
  100.         then fput(x,y,gpic[1+flip]^,false)
  101.         else fput(x,y,gpic[geonum-1]^,false);
  102. end;
  103.  
  104.  
  105. procedure showit;
  106. begin
  107.    writeln('SPX library - GeoMorph demo');
  108.    writeln('Copyright 1993 Scott D. Ramsay');
  109.    writeln;
  110.    writeln('Keys:');
  111.    writeln(' ESC          - quit demo');
  112.    writeln(' Arrow keys   - scroll');
  113.    writeln(' 0..9         - change speed');
  114.    writeln;
  115.    write('Press any key.');
  116.    clearbuffer;
  117.    repeat until anykey;
  118. end;
  119.  
  120.  
  121. begin
  122.   showit;
  123.   setup;
  124.   Animate;
  125.   dispose(MyMorph,done);
  126.   closemode;
  127. end.