home *** CD-ROM | disk | FTP | other *** search
/ SuperHack / SuperHack CD.bin / CODING / DEMOS / ARAIDSRC.ZIP / KAS.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1996-03-11  |  2.8 KB  |  133 lines
  1. {
  2.         This SimPle prOGRAM precals an analraid-precalc ..
  3.         Used math is very basic..
  4.         It draws only circles and tries to calculate perspective too.
  5.         Use FPU if you have it..
  6.         This program is NOT optimized !!  ..but works..
  7.  
  8.         PlastiikkiPaketti / Skraappa!Skruuppi
  9. }
  10.  
  11. {$N+}
  12. {$g+}
  13.  
  14. uses crt;
  15.  
  16. const
  17.      mk = 1024;    {how many pixels in circle}
  18.      radiv = 4;    {radius divider : how many pixels in txtmap (1024/4=256!)}
  19.      cirx = 160;   {X resolution}
  20.      ciry = 100;   {Y resolution}
  21.      rays = 75 ;   {Radius in start}
  22.      aspcor = 0.8; {aspect ratio correction multiplier}
  23.      radsub = 0.5; {how many pixels to jump (should be very slow)}
  24.      persm = 0.035;{perspective multiplier (use as you like)}
  25.      zrsub = 0.5;  {radius substraction value}
  26.      filename = 'analraid.dat'; {guess}
  27.  
  28.  
  29. type alue = array[0..ciry-1,0..cirx-1] of byte;
  30.  
  31. var
  32.    f : file;
  33.    x,y,z : integer;
  34.    pr,soiro,kulma,pers,xr,yr,zr : real;
  35.    i,k,l,w : word;
  36.    t,b,c,kb : byte;
  37.    sb : shortint;
  38.    cnt : longint;
  39.    xalue : ^alue;
  40.    yalue : ^alue;
  41.  
  42.    label hust;             {.. if you want to stop precalccing}
  43.  
  44. begin
  45.  
  46. new(xalue);
  47. new(yalue);
  48.  
  49. t:=0;
  50.  
  51.      asm
  52.         mov ax,13h
  53.         int 10h
  54.  
  55. {        mov dx,3c8h    No need to palette, but..
  56.         xor al,al
  57.         out dx,al
  58.         inc dx
  59.         mov cx,255
  60. @@pal:
  61.       mov al,cl
  62.       neg al
  63.       shr al,2
  64.       out dx,al
  65.       out dx,al
  66.       out dx,al
  67.       loop @@pal}
  68.  
  69.      end;
  70.  
  71.       zr:=rays;
  72.       kulma:=mk-1;
  73.       cnt:=0;
  74.  
  75.       soiro:=0;
  76.       pers:=0;
  77.       pr:=0;
  78.  
  79. repeat
  80.  
  81.        xr:=zr*sin(kulma*pi/(mk/2)) - zr*cos(kulma*pi/(mk/2));
  82.        yr:=zr*cos(kulma*pi/(mk/2)) + zr*sin(kulma*pi/(mk/2));
  83.  
  84.        yr:=yr * aspcor;
  85.  
  86.        x:=round(xr+(cirx div 2));
  87.        y:=round(yr+(ciry div 2));
  88.  
  89.        kulma:=kulma-radsub;
  90.        if kulma<0 then begin
  91.                        kulma:=kulma+mk;
  92.                        pers:=pers + pers * persm;
  93.                        zr:=zr-zrsub;
  94.                        end;
  95.  
  96.        if (x>=0) and (x<cirx) and (y>=0) and (y<ciry) then
  97.        if mem[$a000:word(y*320+x)]=0 then
  98.        begin
  99.          if t=0 then begin pers:=1; t:=1; b:=0; end;
  100.          kb:=round(kulma/radiv);
  101.          xalue^[y,x]:=kb;
  102.          yalue^[y,x]:=byte(round(pers));
  103.          mem[$a000:word(y*320+x)]:=byte(round(pers));
  104.          mem[$a000:word(y*320+x+160)]:=kb;
  105.          mem[$a000:word(y*320+x+32000)]:=byte(round(pers+kb));
  106.        end;
  107.  
  108.        if keypressed then goto hust;
  109.  
  110.        inc(cnt);
  111.  
  112. until zr<0;
  113.  
  114.  
  115.   hust:
  116.  
  117.   assign(f,filename);
  118.   rewrite(f,1);
  119.  
  120. for y:=0 to ciry-1 do
  121.   for x:=0 to cirx-1 do
  122.   begin
  123.        blockwrite(f,xalue^[y,x],1);
  124.        blockwrite(f,yalue^[y,x],1);
  125.   end;
  126.   close(f);
  127.  
  128.      asm
  129.         mov ax,3h
  130.         int 10h
  131.      end;
  132. end.
  133.