home *** CD-ROM | disk | FTP | other *** search
/ POINT Software Programming / PPROG1.ISO / pascal / swag / graphics.swg / 0088_3D Landscape Source.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1994-01-27  |  2.9 KB  |  121 lines
  1. {
  2. From: SEAN PALMER
  3. Subj: 3d Landscape src
  4. ---------------------------------------------------------------------------
  5. Check it out! Clean-room reverse-engineering of something pretty damn
  6. similar to Comanche's patented Voxel-space technology... In Turbo!!
  7.  
  8. {by Sean Palmer}
  9. {use I,J,K,L to look around, ESC ends}
  10.  
  11. uses crt;
  12.  
  13. const
  14.  xSize=256;           {90 degrees}
  15.  ySize=128;           {60 degrees}
  16.  angleMask=xSize*4-1; {xSize must be power of 2 or and's won't work}
  17.  mapSize=128;
  18.  
  19. var
  20.  sinTab:array[0..angleMask]of integer;  {sin(xyAngle)*$7FFF}
  21.  tanTab:array[0..ySize-1]of integer; {tan(zAngle)*$7FFF}
  22.  
  23.  map:array[0..mapSize-1,0..mapSize-1]of byte;
  24.  
  25. type
  26.  fixed=record case boolean of
  27.   false:(l:longint);
  28.   true:(f:word;i:integer);
  29.   end;
  30.  
  31. procedure drawScene(x,y,z,rot:integer);
  32. var lastTan,lastAngle,h:integer;
  33.     mapTan:longint;
  34. var scrn:word;
  35. var color,height:byte;
  36. var xs,ys,ds:longint;
  37. var xp,yp,dp:fixed;
  38. begin
  39.  fillchar(mem[$A000:0],320*200,0);
  40.  for h:=0 to xSize-1 do begin
  41.   lastAngle:=0;
  42.   scrn:=h+320*(ySize-1);
  43.   lastTan:=tanTab[lastAngle];
  44.   xp.i:=x; xp.f:=0;
  45.   yp.i:=y; yp.f:=0;
  46.   dp.l:=0;
  47.   xs:=longint(sinTab[(h+rot-(xSize shr 1))and angleMask])*2;
  48.   ys:=longint(sinTab[(h+rot-(xSize shr 1)+xSize)and angleMask])*2; {cos}
  49.   ds:=$FFFE;
  50.   inc(xp.l,xs*16);
  51.   inc(yp.l,ys*16);
  52.   inc(dp.l,ds*16);
  53.   while lastAngle<ySize do begin
  54.    inc(xp.l,xs*2);
  55.    inc(yp.l,ys*2);
  56.    inc(dp.l,ds*2);
  57.    inc(xs,xs div 32);
  58.    inc(ys,ys div 32);
  59.    inc(ds,ds shr 5);
  60.    if word(xp.i)>mapSize-1 then
  61.     break;
  62.    if word(yp.i)>mapSize-1 then
  63.     break;
  64.    height:=map[xp.i,yp.i];
  65.    mapTan:=(longint(height-z)*$7FFF)div dp.i;
  66.    color:=32+(z-height);
  67.    while(lastTan<=mapTan)and(lastAngle<ySize)do begin
  68.     mem[$A000:scrn]:=color;
  69.     dec(scrn,320);
  70.     inc(lastAngle);
  71.     lastTan:=tanTab[lastAngle];
  72.     end;
  73.    end;
  74.   end;
  75.  end;
  76.  
  77.  
  78. procedure initTables; var i:integer; r:real; begin
  79.  for i:=0 to angleMask do
  80.   sinTab[i]:=round(sin(i*pi/512)*$7FFF);
  81.  for i:=0 to ySize-1 do begin
  82.   r:=(i-64)*pi/(3*ySize);
  83.   tanTab[i]:=round(sin(r)/cos(r)*$7FFF);
  84.   end;
  85.  end;
  86.  
  87. procedure initMap; var x,y:integer; begin
  88.  for x:=0 to 127 do
  89.   for y:=0 to 127 do
  90.    map[x,y]:=((longint(sinTab[(y*21-12)and angleMask])+sinTab[(x*31+296)and angleMask]div 2)shr 12)+120;
  91.  end;
  92.  
  93.  
  94. var c:char;
  95.  x,y,z,r,a:integer;
  96.  i:word;
  97.  
  98. begin
  99.  asm mov ax,$13; int $10; end;
  100.  initTables;
  101.  initMap;
  102.  randomize;
  103.  x:=50+random(29);
  104.  y:=50+random(29);
  105.  z:=125+random(10);
  106.  r:=random(angleMask);
  107.  a:=64;
  108.  repeat
  109.   drawScene(x,y,z,r);
  110.   c:=upcase(readkey);
  111.   case c of
  112.    'I':if tanTab[ySize-1]<30000 then for i:=0 to ySize-1 do inc(tanTab[i],500);
  113.    'K':if tanTab[0]>-30000 then for i:=0 to ySize-1 do dec(tanTab[i],500);
  114.    'J':r:=(r-32)and angleMask;
  115.    'L':r:=(r+32)and angleMask;
  116.    end;
  117.   until c=^[;
  118.  textMode(lastMode);
  119.  end.
  120.  
  121.