home *** CD-ROM | disk | FTP | other *** search
/ DP Tool Club 9 / CD_ASCQ_09_1193.iso / maj / 4437 / demo / demo09.pas < prev    next >
Pascal/Delphi Source File  |  1993-09-24  |  5KB  |  190 lines
  1. Program Demo9;
  2.  
  3. { SPX library - Geomorph HexMap demo Copyright 1993 Scott D. Ramsay  }
  4.  
  5. Uses crt,spx_vga,spx_fnc,spx_txt,spx_geo,spx_key;
  6.  
  7. const
  8.   path = '';      { default path for files }
  9.   gmx  = 50;      { geomorph width }
  10.   gmy  = 50;      { geomorph height }
  11.   sp   = 6;       { scroll speed }
  12.  
  13. type
  14.   ThexPos     = record
  15.                   hexcol,hexrow : byte;
  16.                 end;
  17.   PMyHexMorph = ^TMyHexMorph;
  18.   TMyHexMorph = object(THexMorph)
  19.                   function geomap(x,y:integer):integer;virtual;
  20.                   procedure placegeo(x,y,geonum:integer);virtual;
  21.                   procedure nogogeo(x,y:integer);virtual;
  22.                 end;
  23.  
  24. var
  25.   hexes : array[0..7] of pointer;               { hold loaded sprites }
  26.   vx,vy,                                        { object's pixel position }
  27.   cx,cy : integer;                              { current drawn hex map pos }
  28.   map   : array[0..gmy-1,0..gmx-1] of byte;     { hex map - geomorph }
  29.   mm    : PMyHexMorph;
  30.   h1,                                           { object's hex coordinates }
  31.   h2    : THexPos;                              { random target coord }
  32.  
  33. { Create a random geomorph }
  34. procedure createmap;
  35. var
  36.   d,e : integer;
  37. begin
  38.   for d := 0 to gmy-1 do
  39.     for e := 0 to gmx-1 do
  40.       map[d,e] := random(5)+2; { use only sprites 2..6 }
  41. end;
  42.  
  43. { draw the screen }
  44. procedure drawscreen;
  45. begin
  46.   rectangle(9,9,161,161,4);
  47.   putletter(180,20,15,'Hex Map test');
  48.   putletter(180,60,9,'USE ARROW KEYS TO SCROLL MAP');
  49.   putletter(180,67,9,'PRESS ESC TO QUIT');
  50.   putletter(10,165,4,'Object position:');
  51.   putletter(10,172,4,'Target position:');
  52.   putletter(cp,172,12,st(h2.hexcol)+','+st(h2.hexrow));
  53. end;
  54.  
  55.  
  56. { Set variables and screen }
  57. procedure setup;
  58. begin
  59.   openmode(1);                      { open vga 320x200x256 mode }
  60.   randomize;                        { set random seed }
  61.   loadvsp(path+'hex2.vsp',hexes);   { load sprites }
  62.   createmap;                        { create map }
  63.   mm := new(PMyHexMorph,init(gmx,gmy,14,14,0,0)); { init HexMap }
  64.  { Adjust sprite size. Note that GSX and GSY are smaller than the }
  65.  { actual sprites so they will overlap }
  66.   mm^.gsx := 13; mm^.gsy := 12;
  67.  { The Y position of the odd columns will be offset by 6.  The }
  68.  { first column is even (0) }
  69.   mm^.oddy := 6;
  70.   vx := 0; vy := 0;      { Set objects starting position }
  71.   h2.hexcol := random(gmx);     { Set random object position }
  72.   h2.hexrow := random(gmy);
  73.   drawscreen;            { Draw screen }
  74. end;
  75.  
  76.  
  77. { Get keyboard input }
  78. procedure getinput;
  79. var
  80.   ox,oy : integer;
  81. begin
  82.   ox := h1.hexcol; oy := h2.hexrow; { save old object position }
  83.   if (np[7,2] or np[8,2] or np[9,2])
  84.     then dec(vy,sp) { move up }
  85.     else
  86.       if (np[1,2] or np[2,2] or np[3,2])
  87.         then inc(vy,sp); { move down }
  88.   if (np[7,2] or np[4,2] or np[1,2])
  89.     then dec(vx,sp) { move left }
  90.     else
  91.       if (np[9,2] or np[6,2] or np[3,2])
  92.         then inc(vx,sp); { move right }
  93.  { make sure VX,VY is always in the legal ranges }
  94.   ifix(vx,0,gmx*mm^.gsx-1);
  95.   ifix(vy,0,gmy*mm^.gsy-1);
  96.  { Calcuate the actual tile location }
  97.   h1.hexcol := vx div mm^.gsx; h1.hexrow := vy div mm^.gsy;
  98.  { print stats on screen }
  99.   if (h1.hexcol<>ox) or (h1.hexrow<>oy)
  100.     then
  101.       begin
  102.         bar(69,165,100,170,0);
  103.         putletter(69,165,12,st(h1.hexcol)+','+st(h1.hexrow));
  104.       end;
  105. end;
  106.  
  107.  
  108. { program loop }
  109. procedure ani;
  110. begin
  111.   repeat
  112.     getinput;                 { get keyboard input }
  113.     mm^.drawmap_n16(vx,vy);   { draw the map }
  114.   until esc;                  { Press ESC to quit }
  115. end;
  116.  
  117.  
  118. { Set the screen clipping region on or off }
  119. procedure setclip(on:boolean);
  120. begin
  121.   if on
  122.     then
  123.       begin
  124.         WinMinX := 10; WinMinY := 10;
  125.         WinMaxX := 160; WinMaxY := 160;
  126.       end
  127.     else
  128.       begin
  129.         WinMinX := 0; WinMinY := 0;
  130.         WinMaxX := 320; WinMaxY := 200;
  131.       end;
  132. end;
  133.  
  134. (**) { TMyHexMorph }
  135.  
  136. function TMyHexMorph.geomap(x,y:integer):integer;
  137. begin
  138.   geomap := map[y,x];
  139.   cx := x; cy := y;
  140. end;
  141.  
  142.  
  143. procedure TMyHexMorph.nogogeo(x,y:integer);
  144. begin
  145.   setclip(true);
  146.   ftput_clip(x,y,hexes[0]^,false);
  147.   setclip(false);
  148. end;
  149.  
  150.  
  151. procedure TMyHexMorph.placegeo(x,y,geonum:integer);
  152. begin
  153.   if geonum>0
  154.     then
  155.       begin
  156.       { display the tiles, display the object if its on this tile }
  157.         setclip(true);
  158.         if (h1.hexcol=cx) and (h1.hexrow=cy)
  159.           then ftput_clip(x,y,hexes[6]^,false)
  160.           else
  161.         if (h2.hexcol=cx) and (h2.hexrow=cy)
  162.           then ftput_clip(x,y,hexes[7]^,false)
  163.           else ftput_clip(x,y,hexes[geonum-1]^,false);
  164.         setclip(false);
  165.       end;
  166. end;
  167.  
  168.  
  169. procedure showit;
  170. begin
  171.   clrscr;
  172.   writeln('SPX library - Geomorph demo 2 - HexMap ');
  173.   writeln('Copyright 1993 Scott D. Ramsay');
  174.   writeln;
  175.   writeln('Keys:');
  176.   writeln(' ESC          - quit demo');
  177.   writeln(' Arrow keys   - move object');
  178.   writeln;
  179.   write('Press SPACE to continue.');
  180.   clearbuffer;
  181.   repeat until space;
  182. end;
  183.  
  184.  
  185. begin
  186.   showit;
  187.   setup;
  188.   ani;
  189.   closemode;
  190. end.