unit ucyl;

interface

procedure CYL_INIT;
procedure CYL_ACTION;
procedure CYL_CLOSE;

implementation

uses
  video,grafix,crt,dos,usm;

type
  Tmap=array[0..71999] of byte;
  Pmap=^Tmap;
  Ttex=array[0..71999] of dword;
  Ptex=^Ttex;
  ttab=array[0..179] of byte;
  Ptab=^ttab;
  Tsin=array[0..359] of word;
  Psin=^Tsin;

var
  map:pmap;
  tex:ptex;
  sint:Psin;
  dtab:Ptab;

  korder,vorder,aorder,row:byte;
  TERM:boolean;

procedure alloc;
begin
  new(map);
  new(tex);
  new(dtab);
  new(sint);
end;

procedure dealloc;
begin
  dispose(map);
  dispose(tex);
  dispose(dtab);
  dispose(sint);
end;

procedure maketables;
var
  a:word;
begin
  for a:=0 to 359 do begin
    sint^[a]:=round(sin(a*pi/180)*256);
  end;
end;

{$i-}
procedure loadmaps;
var
  f:file;
  filename:string[12];

  procedure notfound;
  begin
    writeln('File ',filename,' not found');
    dealloc;
    halt;
  end;

  procedure fileerr;
  begin
    writeln('Error in file ',filename);
    dealloc;
    halt;
  end;

begin
  filename:='cyln_map.dat';
  assign(f,filename);
  reset(f,1);
  if ioresult<>0 then notfound;
  blockread(f,map^,72000);
  if ioresult<>0 then fileerr;
  close(f);
  filename:='cyln_tex.dat';
  assign(f,filename);
  reset(f,1);
  if ioresult<>0 then notfound;
  blockread(f,tex^,216000);
  if ioresult<>0 then fileerr;
  close(f);
end;
{$i+}

procedure convertimage(image:pointer;size:dword);
begin
  asm
    mov esi,[image]
    mov edi,[image]
    mov eax,4
    mov ebx,size
    dec ebx
    mul ebx
    add edi,eax
    mov eax,3
    mul ebx
    add esi,eax
    mov ecx,size
   @loop0:
    mov eax,[esi]
    mov bh,ah
    ror eax,16
    mov ah,bh
    mov [edi],eax
    sub esi,3
    sub edi,4
    loop @loop0
  end;
end;

procedure HorLine(x,y,l,col,z:dword); assembler;
asm
  mov edi,video_screen
  mov eax,320
  mul y
  add eax,x
  shl eax,2
  add edi,eax
  mov eax,col
  mov ecx,l
  mov ebx,z
  sub al,bl
  jnc @ok0
  mov al,0
 @ok0:
  sub ah,bl
  jnc @ok1
  mov ah,0
 @ok1:
  ror eax,16
  sub al,bl
  jnc @ok2
  mov al,0
 @ok2:
  ror eax,16
  rep stosd
end;

procedure render;
var
  o:longint;
  x,y:word;
  d:dword;
  e:dword;
  f:byte;
  g:byte;
  p1,p2:integer;
  q:dword;
begin
  clearscreen;
  o:=counter;
  q:=0;
  for y:=0 to 199 do begin
    p1:=-1;
    for x:=179 downto 52 do begin
      d:=q+((x+o) mod 360);
      f:=map^[d];
      g:=sint^[x]*f shr 9;
      if g>p1 then begin
        e:=tex^[d];
        horline(159-g,y,g-p1,e,(179-x)*2);
        p1:=g;
      end;
    end;
    p2:=-1;
    for x:=179 downto 52 do begin
      d:=q+((359-x+o) mod 360);
      f:=map^[d];
      g:=sint^[179-x]*f shr 9;
      if g>p2 then begin
        e:=tex^[d];
        horline(160+p2,y,g-p2,e,(179-x)*2);
        p2:=g;
      end;
    end;
    q:=q+360;
  end;
    if counter<128 then fadeup(255-counter*2);
  video_copy;
end;

procedure CYL_INIT;
begin
  alloc;
  loadmaps;
  convertimage(tex,72000);
  maketables;
end;

procedure newint;
begin
  inc(counter);
end;

procedure CYL_ACTION;
begin
  asm
   mov al,[_order]
   mov korder,al
  end;
  vorder:=korder+3;
  TERM:=false;
  counter:=0;
  USS_SetTimer(@newint,timerspeed div 40);
  repeat
    render;
    asm
     mov al,[_order]
     mov aorder,al
    end;
    if (aorder=vorder) then term:=true;
    if TerminateDemo Then Begin USS_StopTimer(@newint); ExitDemo; End;
  until{ (keypressed) or} (TERM);
  while keypressed do readkey;
  USS_StopTimer(@newint);
end;

procedure CYL_CLOSE;
begin
  dealloc;
end;

begin
end.
