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

    { Turbo Pascal version 7.0 directive settings }
    {$a+,b-,d+,e+,f-,g+,i+,l+,n-,o-,p-,q-,r-,s+,t-,v+,x+}

    { if you have a 386 or better 'uncomment' the next line }
    {-$define cpu386}

    program wormhole;
    { Asm-version of Wormhole, by Bas van Gaalen, Holland, PD }
    uses
      crt;
    const
      vidseg:word=$a000;
      divd=128;
      astep=6;
      xst=4;
      yst=5;
    var
      sintab:array[0..449] of integer;
      stab,ctab:array[0..255] of integer;
      virscr:pointer;
      virseg:word;
      lstep:byte;

    procedure setpal(col,r,g,b : byte); assembler;
    asm
      mov dx,03c8h
      mov al,col
      out dx,al
      inc dx
      mov al,r
      out dx,al
      mov al,g
      out dx,al
      mov al,b
      out dx,al
    end;

    procedure drawpolar(xo,yo,r,a:word; c:byte; lvseg:word); assembler;
    asm
      mov es,lvseg

      mov bx,a
      add bx,a
      mov cx,word ptr sintab[bx]
      add bx,2*90
      mov ax,word ptr sintab[bx]
      mul r
      mov bx,divd
      xor dx,dx
      cwd
      idiv bx
      add ax,xo
      add ax,160
      cmp ax,320
      ja @out
      mov si,ax

      mov ax,cx
      mul r
      mov bx,divd
      xor dx,dx
      cwd
      idiv bx
      add ax,yo
      add ax,100
      cmp ax,200
      ja @out

      shl ax,6
      mov di,ax
      shl ax,2
      add di,ax
      add di,si
      mov al,c
      mov [es:di],al
     @out:
    end;

    procedure cls(lvseg:word); assembler;
    asm
      mov es,[lvseg]
      xor di,di
      xor ax,ax
    {$ifdef cpu386}
      mov cx,320*200/4
      rep
      db $66; stosw
    {$else}
      mov cx,320*200/2
      rep stosw
    {$endif}
    end;

    procedure flip(src,dst:word); assembler;
    asm
      push ds
      mov ax,[dst]
      mov es,ax
      mov ax,[src]
      mov ds,ax
      xor si,si
      xor di,di
    {$ifdef cpu386}
      mov cx,320*200/4
      rep
      db $66; movsw
    {$else}
      mov cx,320*200/2
      rep movsw
    {$endif}
      pop ds
    end;

    procedure retrace; assembler;
    asm
      mov dx,03dah
     @vert1:
      in al,dx
      test al,8
      jnz @vert1
     @vert2:
      in al,dx
      test al,8
      jz @vert2
    end;

    var x,y,i,j:word; c:byte;
    begin
      asm mov ax,13h; int 10h; end;
      for i:=0 to 255 do begin
        ctab[i]:=round(cos(pi*i/128)*60);
        stab[i]:=round(sin(pi*i/128)*45);
      end;
      for i:=0 to 449 do sintab[i]:=round(sin(2*pi*i/360)*divd);
      getmem(virscr,64000);
      virseg:=seg(virscr^);
      cls(virseg);
      x:=30; y:=90;
      repeat
        {retrace;}
        c:=22; lstep:=2; j:=10;
        while j<220 do begin
          i:=0;
          while i<360 do begin
            drawpolar(ctab[(x+(200-j)) mod 255],stab[(y+(200-j)) mod 255],j,i,c,virseg);
            inc(i,astep);
          end;
          inc(j,lstep);
          if (j mod 5)=0 then begin inc(lstep); inc(c); if c>31 then c:=22; end;
        end;
        x:=xst+x mod 255;
        y:=yst+y mod 255;
        flip(virseg,vidseg);
        cls(virseg);
      until keypressed;
      while keypressed do readkey;
      freemem(virscr,64000);
      textmode(lastmode);
    end.

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