home *** CD-ROM | disk | FTP | other *** search
/ Collection of Hack-Phreak Scene Programs / cleanhpvac.zip / cleanhpvac / GFXFX2.ZIP / VOXEL.PAS < prev    next >
Pascal/Delphi Source File  |  1995-02-14  |  4KB  |  96 lines
  1.  
  2. program voxel_landscape; { VOXEL.PAS }
  3. { Kinda slow on 386-, works great on 486+ though, by Jeroen Bouwens }
  4. uses u_vga,u_pal,u_kb;
  5.  
  6. { create landscape in 2d, color is height -----------------------------------}
  7.  
  8. function ncol(mc,n,dvd:integer):byte; begin
  9.   ncol:=((mc+n-random(n)) div dvd) mod 245; end;
  10.  
  11. procedure subdivide(x1,y1,x2,y2:word);
  12. var xn,yn,dxy,p1,p2,p3,p4:word;
  13. begin
  14.   if (x2-x1<2) and (y2-y1<2) then exit;
  15.   p1:=mem[u_vidseg:320*y1+x1];
  16.   p2:=mem[u_vidseg:320*y2+x1];
  17.   p3:=mem[u_vidseg:320*y1+x2];
  18.   p4:=mem[u_vidseg:320*y2+x2];
  19.   xn:=(x2+x1) shr 1; yn:=(y2+y1) shr 1;
  20.   dxy:=5*(x2-x1+y2-y1) div 3;
  21.   if mem[u_vidseg:320*y1+xn]=0 then mem[u_vidseg:320*y1+xn]:=ncol(p1+p3,dxy,2);
  22.   if mem[u_vidseg:320*yn+x1]=0 then mem[u_vidseg:320*yn+x1]:=ncol(p1+p2,dxy,2);
  23.   if mem[u_vidseg:320*yn+x2]=0 then mem[u_vidseg:320*yn+x2]:=ncol(p3+p4,dxy,2);
  24.   if mem[u_vidseg:320*y2+xn]=0 then mem[u_vidseg:320*y2+xn]:=ncol(p2+p4,dxy,2);
  25.   mem[u_vidseg:320*yn+xn]:=ncol(p1+p2+p3+p4,dxy,4);
  26.   subdivide(x1,y1,xn,yn); subdivide(xn,y1,x2,yn);
  27.   subdivide(x1,yn,xn,y2); subdivide(xn,yn,x2,y2);
  28. end;
  29.  
  30. { voxelize: remap 2d scape to 3d --------------------------------------------}
  31.  
  32. procedure voxelize(landscape:pointer; p,q,r : integer);
  33. var oldy:pointer; bo,ho:word; i,j,x,y1,v,y0,sc,y2,y,if1,h1,c,u:integer;
  34. begin
  35.   getmem(oldy,320);
  36.   fillchar(oldy^,320,101);
  37.   for v:=50 downto 0 do begin                                        { depth }
  38.     y0:=199-v+(25600 div (v+1)) shr 8+(r shl 1) div (v+1); { y-coord for high 0 }
  39.     u:=p shl 8-v shl 7-5120;             { u-coord of screen-position (0,y0) }
  40.     c:=(v shl 8+10240) div 320;                   { add-constant for u-coord }
  41.     sc:=256-(v shl 8) div 100;                 { scaling-constant for height }
  42.     bo:=ofs(landscape^)+320*((v+q) mod 200);
  43.     for x:=0 to 319 do begin                                         { width }
  44.       h1:=mem[seg(landscape^):bo+(u shr 8) mod 320];
  45.       y1:=y0-(h1*sc) shr 8;
  46.       if y1>199 then y1:=199;
  47.       if y1>mem[seg(oldy^):ofs(oldy^)+x] then begin                 
  48.         ho:=mem[seg(oldy^):ofs(oldy^)+x]*320+x{+so};
  49.         for i:=mem[seg(oldy^):ofs(oldy^)+x] to y1 do begin          { height }
  50.          mem[destseg:ho]:=h1;
  51.          inc(ho,320);
  52.         end;
  53.       end;
  54.       u:=u+c;
  55.       mem[seg(oldy^):ofs(oldy^)+x]:=y1;
  56.     end;
  57.   end;
  58.   freemem(oldy,320);
  59. end;
  60.  
  61. { init, setup and main ------------------------------------------------------}
  62.  
  63. var virscr,plasma:pointer; i,j:word;
  64. begin
  65.   setvideo($13);
  66.   for i:=1 to 255 do setrgb(i,32+i div 8,i div 6,i div 6);
  67.   mem[u_vidseg:0]:=128;
  68.   mem[u_vidseg:320*199]:=128;
  69.   mem[u_vidseg:320*199+319]:=128;
  70.   mem[u_vidseg:319]:=128;
  71.   randomize;
  72.   subdivide(0,0,319,199);                          { create plasma-landscape }
  73.  
  74.   for i:=0 to 199 do for j:=0 to 319 do                           { smoothen }
  75.     mem[u_vidseg:320*i+j]:=
  76.       (mem[u_vidseg:320*i+j]+mem[u_vidseg:320*i+j-3]+
  77.       mem[u_vidseg:320*i+j+3]+mem[u_vidseg:320*(i+3)+j]) shr 2;
  78.  
  79.   getmem(plasma,64000);                 {store the plasma landscape in memory}
  80.   for i:=0 to 199 do for j:=0 to 320 do
  81.     mem[seg(plasma^):ofs(plasma^)+320*i+j]:=mem[u_vidseg:320*i+j];
  82.  
  83.   {create and show 3d-landscape}
  84.   getmem(virscr,64000);
  85.   destenation:=virscr; destseg:=seg(destenation^);
  86.   repeat
  87.     cls(virscr,64000);
  88.     voxelize(plasma,130,i,mem[seg(plasma^):ofs(plasma^)+320*i+130]);
  89.     flip(virscr,vidptr,64000);
  90.     i:=(i+4) mod 200;
  91.   until keypressed;
  92.   freemem(plasma,64000);
  93.   freemem(virscr,64000);
  94.   setvideo(u_lm);
  95. end.
  96.