home *** CD-ROM | disk | FTP | other *** search
/ Collection of Hack-Phreak Scene Programs / cleanhpvac.zip / cleanhpvac / WAV3D.ZIP / WAV3D.PAS < prev   
Pascal/Delphi Source File  |  1995-02-16  |  4KB  |  186 lines
  1. (* ---------------------------- WAV3D.PAS ------------------------------- *)
  2. (* Coded bye Jare/Iguana in 1993. Want more comment's? Write'em!          *)
  3. (* Use this as you like; you're going to anyway, so who cares.            *)
  4. (* But remember: proper crediting and greeting rules.                     *)
  5.  
  6. USES Dos;
  7.  
  8. VAR
  9.    reg : Registers;
  10.  
  11. FUNCTION GetKey: WORD;
  12. BEGIN
  13.    reg.AH := 0;
  14.    Intr($16, reg);
  15.    GetKey := reg.AX
  16. END;
  17.  
  18. FUNCTION TestKey: BOOLEAN;
  19. BEGIN
  20.    reg.AH := 1;
  21.    Intr($16, reg);
  22.    TestKey := (reg.Flags AND FZero) = 0
  23. END;
  24.  
  25. PROCEDURE VSync;
  26. BEGIN
  27.    WHILE (Port[$3DA] AND 8) =  8 DO;
  28.    WHILE (Port[$3DA] AND 8) <> 8 DO;
  29. END;
  30.  
  31.   (* -------------------- *)
  32.  
  33. TYPE
  34.    tScrBuf = ARRAY [0..200-1,0..320-1] OF BYTE;
  35.    tScrWBuf = ARRAY [0..200-1,0..160-1] OF WORD;
  36. VAR
  37.    VGABuf : TScrBuf ABSOLUTE $A000:0000;
  38.    VGAWBuf : TScrWBuf ABSOLUTE $A000:0000;
  39.  
  40. VAR
  41.    i, j, k, n : INTEGER;   { Shitty global vars. This is just a prototype! }
  42.    r, d, v, a : REAL;
  43.    c, lasth, limit : WORD;
  44.    highest : ARRAY [0..159] OF BYTE;
  45.  
  46. TYPE
  47.    TWavBuf = ARRAY [0..63, 0..127] OF BYTE;
  48.    TLandBuf = ARRAY [0..31, 0..159] OF BYTE;
  49.  
  50. VAR
  51.    Wb : TWavBuf;
  52.    fw : FILE OF TWavBuf;
  53.    lb : TLandBuf;
  54.    fl : FILE OF TLandBuf;
  55.  
  56. CONST
  57.    MaxRadius = 159.0*159.0 + 31.0*31.0;
  58.    s159       = 159.0*159.0;
  59.    s31       = 31.0*31.0;
  60.  
  61. PROCEDURE GenerateLand;
  62.    BEGIN
  63.      FOR i := 0 TO 31 DO
  64.         FOR j := 0 TO 159 DO BEGIN
  65.            lb[i,j] := ROUND(SQRT((i+0.0)*i/s31 + (j+0.0)*j/s159)*127{/SQRT(2)});
  66.            IF lb[i,j] > 127 THEN
  67.               lb[i,j] := 127
  68.         END;
  69.      Assign(fl, 'land.dat');             { Escritura de la tabla. }
  70.      ReWrite(fl);
  71.      Write(fl, lb);
  72.      Close(fl)
  73.    END;
  74.  
  75. PROCEDURE GenerateWav;
  76.   BEGIN
  77.     FOR j := 0 TO 63 DO                  { Generacion de la tabla. }
  78.         FOR i := 0 TO 127{319} DO BEGIN
  79.            r := (i+1) * 5.0 * PI / 320.0;
  80.            d := j * PI / 32.0;
  81.            v := ((Sin(r - d)-Sin(-d)) / r )
  82.                 - (Cos(r-d)/2);
  83.            a := Cos(i*PI/2/128);
  84.            k := 100 + ROUND(100.0 * a * a * v);
  85.            Wb[j, i] := BYTE(k);
  86.            VGABuf[k,i] := 150 + j
  87.         END;
  88.      Assign(fw, 'waves.dat');            { Grabación de la tabla. }
  89.      ReWrite(fw);
  90.      Write(fw, wb);
  91.      Close(fw)
  92.   END;
  93.  
  94. VAR
  95.    par, pcod : INTEGER;
  96.  
  97. BEGIN
  98.    VAL(ParamStr(1), par, pcod);
  99.    IF pcod = 0 THEN BEGIN
  100.       ASM
  101.          MOV AX,13h
  102.          INT 10h
  103.       END;
  104.       IF (par AND 1) = 1 THEN
  105.          GenerateLand;
  106.       IF (par AND 2) = 2 THEN
  107.          GenerateWav;
  108.    END ELSE BEGIN
  109.       WriteLn('3D Wave bye Jare/Iguana (Pascal prototype & .DAT generator).'#13#10,
  110.               '   Type "WAV3D 3" to generate files. From then on just type "WAV3D 0",'#13#10,
  111.               '     which will use the created files.');
  112.       HALT
  113.    END;
  114.  
  115.    Assign(fl, 'land.dat');             { Lectura de la tabla. }
  116.    ReSet(fl);
  117.    Read(fl, lb);
  118.    Close(fl);
  119.  
  120.    Assign(fw, 'waves.dat');             { Lectura de la tabla. }
  121.    ReSet(fw);
  122.    Read(fw, wb);
  123.    Close(fw);
  124.  
  125.    FillChar(VGABuf,  64000, 0);
  126.    FillChar(highest, 160, 199);
  127.  
  128.    WHILE TestKey DO
  129.       GetKey;
  130.  
  131.    ASM
  132.       MOV  CX,64
  133.       MOV  DX,03C8h
  134.       MOV  AL,64
  135.       OUT  DX,AL
  136.       INC  DX
  137.       XOR  AL,AL
  138.      @@l:
  139.        OUT DX,AL
  140.        OUT DX,AL
  141.        OUT DX,AL
  142.        INC AL
  143.        LOOP @@l
  144.    END;
  145.  
  146.    k := 0;
  147.    REPEAT
  148.       n := (k + 1) MOD 64;
  149.       FOR j := 0 TO 159 DO BEGIN
  150.          c := 63+64;
  151.          lasth := 199;
  152.          FOR i := 31 DOWNTO 0 DO BEGIN
  153.             limit := 56+i+Wb[n,Lb[i,j]];
  154.             WHILE lasth > limit DO BEGIN
  155.                VGABuf[lasth,j+160] := c;
  156.                VGABuf[lasth,159-j] := c;
  157.                DEC(lasth)
  158.             END;
  159.             DEC(c)
  160.          END;
  161.          FOR i := 0 TO 31 DO BEGIN
  162.             limit := 55-i+Wb[n,Lb[i,j]];
  163.             WHILE lasth > limit DO BEGIN
  164.                VGABuf[lasth,j+160] := c;
  165.                VGABuf[lasth,159-j] := c;
  166.                DEC(lasth)
  167.             END;
  168.             DEC(c)
  169.          END;
  170.          FOR i := lasth DOWNTO highest[j] DO BEGIN
  171.             VGABuf[i, j+160] := 0;
  172.             VGABuf[i, 159-j] := 0
  173.          END;
  174.          highest[j] := lasth
  175.       END;
  176.       VSync;
  177.       k := n
  178.    UNTIL TestKey;
  179.  
  180.    GetKey;
  181.    ASM
  182.       MOV AX,3h
  183.       INT 10h
  184.    END
  185. END.
  186.