[Back to GRAPHICS SWAG index]  [Back to Main SWAG index]  [Original]

{
MSGID: 1:108/180 868965DB
Well, here is the cool wormhole program that everybody has been awaiting.

It consists of three programs, WGEN, PGEN, and WORMHOLE. The WGen program
generates the data file for the wormhole. PGen generates a palette file
for the wormhole. WORMHOLE actually runs the program once everything is done.

************  Listing of WGEN.PAS
}

{$N+,E+,G+}
Program WGen;
{actually generates the Wormhole, SLOW}
{ math co-processor HIGHLY recommended }

Uses Crt;

Const
  Stretch = 25;     XCenter = 160;
  YCenter = 50;     DIVS = 1200;
  SPOKES = 2400;

Procedure TransArray;

Var
  x, y, z : Real;
  i, j, color : Integer;

Begin
  For j := 1 to DIVS do
    Begin
      For i := 0 to (Spokes-1) do
        Begin
          z := (-1.0)+(Ln(2.0*j/DIVS));
          x := (320.0*j/DIVS*cos(2*Pi*i/SPOKES));
          y := (240.0*j/DIVS*sin(2*Pi*i/Spokes));
          y := y-STRETCH*z;
          x := x + XCenter;
          y := y + YCenter;
          Color := (Round(i/8) Mod 15)+15*(Round(j/6) MOD 15)+1;
          if ((X>=0)and(x<320)and(Y>=0)and(y<200))
            Then Mem[$A000:Round(x) + (Round(y) * 320)] := Color;
        End;
    End;
End;

Procedure SaveImage;

Var
  i, j : Integer;
  Diskfile : File of Byte;

Begin
  Assign(Diskfile, 'Ln.DAT');
  Rewrite(Diskfile);
  For i := 0 to 199 do
    For j := 0 to 319 do
      Write(Diskfile, Mem[$A000:j + (320 * i)]);
  Close(Diskfile);
End;

Begin
  Asm  MOV  AX,$13; INT $10; End;
  FillChar(Mem[$A000:$0000], 64000, 0);
  transarray;
  SaveImage;
  Asm MOV  AX,3; INT $10; End;
End.

[Back to GRAPHICS SWAG index]  [Back to Main SWAG index]  [Original]