texture mapped tunnel effects in pascal

{$N-,E+,G+,s-,n-,R-,Q-}
{$M 16384,0,655360}
{
 Another old pascal tunnel effect. coded by bca
}

uses crt;
const
  pi            = 1.1415927;
  some_value    = 8000;
type
  lookup        = record u,v : byte end;
  alookup       = array[0..0] of lookup;
  texture       = array[0..0,0..255] of byte;

function calc_tunnel(xsize,ysize,radius : integer) : pointer;

var
  i,j,p         : integer;
  t             : ^alookup;
  a             : real;

begin
  getmem(t,xsize*ysize*2);
  p := 0;
  for i := -ysize to -1 do begin
    for j := -xsize to -1 do begin
      a := arctan(i/(j+0.5));
      t^[p].u := trunc(a*511/pi/2);
      t^[p].v := trunc(cos(a)*radius/-(j+0.5)) and $ff;
      inc(p)
    end
  end;
  calc_tunnel := t;
end;

var
  t             : ^alookup;
  b             : ^texture;
  i,j           : integer;
  screen        : array[0..99,0..319] of byte absolute $a000:0;

Procedure Palette(ColNum,R,G,B:Byte); Assembler;
Asm
    Mov dx,$3c8;
    Mov al,ColNum;
    Out dx,al;
    Inc dx;
    Mov al,R;
    Out dx,al;
    Mov al,B;
    Out dx,al;
    Mov al,B;
    Out dx,al
End;

procedure draw_tunnel(x,y : byte);

var
  i,j           : integer;

begin
  for i := 0 to 159 do
    for j := 0 to 99 do
      screen[j,i]     := b^[t^[i+j*160].u+x,-t^[i+j*160].v-y];
    for i := 0 to 159 do
    for j := 0 to 99 do
      screen[j,319-i] := b^[t^[i+j*160].u-x,+t^[i+j*160].v+y];
   for i := 0 to 159 do
    for j := 0 to 99 do
     screen[199-j,319-i] := b^[t^[i+j*160].u+x,-t^[i+j*160].v-y];
   for i := 0 to 159 do
    for j := 0 to 99 do
    screen[199-j,i] := b^[t^[i+j*160].u-x,+t^[i+j*160].v+y];
end;

var
  x,y           : integer;

begin
  asm mov ax,13h; int 10h end;
  t := calc_tunnel(160,100,some_value);
  GetMem(b,65535);
  for i := 0 to 65
  do Palette(i,i,80+Round(I/1.4),1+Round(I/1.6));
  for j := 0 to 255 do
  For I:=0 To 255 Do For J:=0 To 255 Do
  mem[Seg(b^):Ofs(b^)+Word(256*I)+J]:=
  1+((Sqr(i-128) + Sqr(j-128)) DIV 520);
  Mem[$A000:320*Round(1.25)]:=Mem[Seg(b^):Ofs(b^)+Word(256)];

repeat

  draw_tunnel(x,y);
  {hehhehh, same as  x := x + 0;
                     y := y + 10;
  }
  Asm;
      xor  ax,ax
      add  ax,X
      add  ax,0
      mov  X,ax
      xor  ax,ax
      add  ax,Y
      add  ax,5
      mov  Y,ax
  End;
 until keypressed;
 freeMem(b,65535);
 asm mov ax,03h; int 10h end;
end.