unit uoszlop;

interface

procedure OSZLOP_INIT;
procedure OSZLOP_ACTION;
procedure OSZLOP_CLOSE;

implementation

uses
  crt,dos,usm,video,grafix;

const
  pii:real=3.141592654/180;
  points:array[0..3,0..1] of integer=((-1,1),(1,1),(1,-1),(-1,-1));

type
  tbackgr=array[0..255999] of byte;
  pbackgr=^tbackgr;
  texture=array[0..12287] of byte;
  Ptexture=^texture;
  tlight=array[0..3071] of byte;
  plight=^tlight;
  lpos=record
         x,y,z:integer;
       end;

var
  x,y:word;
  soxx,oxx:integer;
  lox,loy,loz:integer;
  backgr:pbackgr;
  tex:Ptexture;
  l1,l2,l3,l4,l5,l6:plight;
  lp:array[0..11] of lpos;
  tsin,tcos:array[0..359] of integer;
  tpoints:array[0..359,0..3,0..1] of integer;
  lpoint:array[0..1] of integer;
  langle,stangle,tangle:integer;

  ufade,dfade:byte;
  TERM:boolean;

  korder,vorder,aorder:byte;

procedure alloc;
begin
  new(tex);
  new(backgr);
  new(l1);
  new(l2);
  new(l3);
  new(l4);
  new(l5);
  new(l6);
end;

procedure dealloc;
begin
  dispose(tex);
  dispose(backgr);
  dispose(l1);
  dispose(l2);
  dispose(l3);
  dispose(l4);
  dispose(l5);
  dispose(l6);
end;

{$i-}
procedure loadimages;
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:='oszl_tex.dat';
  assign(f,filename);
  reset(f,1);
  if ioresult<>0 then notfound;
  blockread(f,tex^,12288);
  if ioresult<>0 then fileerr;
  close(f);
  filename:='oszl_l1.dat';
  assign(f,filename);
  reset(f,1);
  if ioresult<>0 then notfound;
  blockread(f,l1^,3072);
  if ioresult<>0 then fileerr;
  close(f);
  filename:='oszl_l2.dat';
  assign(f,filename);
  reset(f,1);
  if ioresult<>0 then notfound;
  blockread(f,l2^,3072);
  if ioresult<>0 then fileerr;
  close(f);
  filename:='oszl_l3.dat';
  assign(f,filename);
  reset(f,1);
  if ioresult<>0 then notfound;
  blockread(f,l3^,3072);
  if ioresult<>0 then fileerr;
  close(f);
  filename:='oszl_l4.dat';
  assign(f,filename);
  reset(f,1);
  if ioresult<>0 then notfound;
  blockread(f,l4^,3072);
  if ioresult<>0 then fileerr;
  close(f);
  filename:='oszl_l5.dat';
  assign(f,filename);
  reset(f,1);
  if ioresult<>0 then notfound;
  blockread(f,l5^,3072);
  if ioresult<>0 then fileerr;
  close(f);
  filename:='oszl_l6.dat';
  assign(f,filename);
  reset(f,1);
  if ioresult<>0 then notfound;
  blockread(f,l6^,3072);
  if ioresult<>0 then fileerr;
  close(f);
  filename:='oszl_bck.dat';
  assign(f,filename);
  reset(f,1);
  if ioresult<>0 then notfound;
  blockread(f,backgr^,192000);
  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 maketables;
var
  i:integer;
begin
  for i:=0 to 359 do begin
    tsin[i]:=round(256*sin(pi/180*i));
    tcos[i]:=round(256*cos(pi/180*i));
  end;
end;

procedure MakePoints;
var
  i,j:word;
begin
  for j:=0 to 359 do
    for i:=0 to 3 do begin
      tpoints[j,i,0]:=round(32*(points[i,0]*tcos[j]/256+points[i,1]*tsin[j]/256));
      tpoints[j,i,1]:=round(32*(points[i,1]*tcos[j]/256+points[i,0]*tsin[j]/256));
    end;
end;

procedure putimage(x,y,sx,sy:longint;source:pointer;fade:byte);
label
  quit;
var
  x1,x2,y1,y2:longint;
{  i,j:longint;}
  r,g,b:byte;
begin
  if x>319 then goto quit;
  if y>199 then goto quit;
  if (sx+x)<0 then goto quit;
  if (sy+y)<0 then goto quit;
  if x<0 then x1:=0-x else x1:=0;
  if y<0 then y1:=0-y else y1:=0;
  if (x+sx)>319 then x2:=319-x else x2:=sx-1;
  if (y+sy)>199 then y2:=199-y else y2:=sy-1;
      asm
        mov edx,y1

       @loopy:
        mov ecx,x1
        push edx

        mov esi,[source]
        mov eax,edx
        mul sx
        add eax,ecx
        mov ebx,3
        mul ebx
        add esi,eax

        pop edx
        push edx
        mov edi,[Video_SCREEN]
        mov eax,320
        mov ebx,y
        add ebx,edx
        mul ebx
        add eax,x
        add eax,ecx
        shl eax,2
        add edi,eax

        pop edx
       @loopx:
        mov eax,[esi]
        add esi,3

        mov bl,fade
        sub al,bl
        jnc @ok0
        mov al,0
       @ok0:
        sub ah,bl
        jnc @ok1
        mov ah,0
       @ok1:
        mov bh,ah
        ror eax,16
        sub al,bl
        jnc @ok2
        mov al,0
       @ok2:
        mov ah,bh
        mov ebx,[edi]
        add al,bl
        jnc @ok3
        mov al,255
       @ok3:
        add ah,bh
        jnc @ok4
        mov ah,255
       @ok4:
        ror eax,16
        ror ebx,16
        add al,bl
        jnc @ok5
        mov al,255
       @ok5:
        ror eax,16
        stosd

        inc ecx
        cmp ecx,x2
        jbe @loopx

        inc edx
        cmp edx,y2
        jbe @loopy
      end;
  quit:
end;

procedure clearscreenbackgr; assembler;
asm
  mov esi,[backgr]
  mov edi,[video_screen]
  mov ecx,64000
  rep movsd
end;

procedure render;
var
  x,y:word;
  xx,i:integer;
  r,g,b:byte;
  p1,p2,p3:byte;
  k1,k2,k3:integer;
  o1:integer;
  t:word;
  t1,t2,t3:word;
begin
  tangle:=stangle;
  for y:=0 to 199 do begin
    t:=tangle;
    tangle:=(tangle+(tsin[tangle]*y div 128)+360) mod 360;
    o1:=(tsin[tangle]) div 16;
    p1:=0;
    for i:=1 to 3 do begin
      if tpoints[tangle,p1,0]>=tpoints[tangle,i,0] then p1:=i;
    end;
    p2:=(p1+1) mod 4;
    p3:=(p1+2) mod 4;
    k1:=tpoints[tangle,p1,0];
    k2:=tpoints[tangle,p2,0];
    k3:=tpoints[tangle,p3,0];
    t1:=y mod 64;
    if (160+o1+k1+oxx<320) and (160+o1+k2+oxx>=0) then if k1<>k2 then for i:=k1 to k2 do begin
      asm
        mov bx,i
        sub bx,k1
        mov ax,63
        mul bx
        mov bx,k2
        sub bx,k1
        div bx
        mov bx,ax
        xor eax,eax
        mov ax,t1
        shl ax,6
        add ax,bx
        mov bx,ax
        shl ax,1
        add ax,bx
        mov esi,[tex]
        add esi,eax
        lodsd
        mov dx,k2
        sub dx,k1
        mov ebx,eax
        xor eax,eax
        mov ax,dx
        mul bl
        shr ax,6
        mov r,al
        mov ax,dx
        mul bh
        shr ax,6
        mov g,al
        mov ax,dx
        ror ebx,16
        mul bl
        shr ax,6
        mov b,al
      end;
      xx:=i+160+o1+oxx;
      if (xx<320) and (xx>=0) then putpixel(xx,y,r,g,b);
    end;
    if (160+o1+k2+oxx<320) and (160+o1+k3+oxx>=0) then if k3<>k2 then for i:=k2 to k3 do begin
      asm
        mov bx,i
        sub bx,k2
        mov ax,63
        mul bx
        mov bx,k3
        sub bx,k2
        div bx
        mov bx,ax
        xor eax,eax
        mov ax,t1
        shl ax,6
        add ax,bx
        mov bx,ax
        shl ax,1
        add ax,bx
        mov esi,[tex]
        add esi,eax
        mov dx,k3
        sub dx,k2
        lodsd
        mov ebx,eax
        xor eax,eax
        mov ax,dx
        mul bl
        shr ax,6
        mov r,al
        mov ax,dx
        mul bh
        shr ax,6
        mov g,al
        mov ax,dx
        ror ebx,16
        mul bl
        shr ax,6
        mov b,al
      end;
      xx:=i+160+o1+oxx;
      if (xx<320) and (xx>=0) then putpixel(xx,y,r,g,b);
    end;
    tangle:=t;
  end;
  fadedown(dfade);
  fadeup(ufade);
end;

procedure newint;
begin
  inc(counter);
end;

procedure OSZLOP_INIT;
begin
  Alloc;
  LoadImages;
  MakeTables;
  MakePoints;
  convertimage(backgr,64000);
end;

procedure OSZLOP_ACTION;
begin
  stangle:=0;
  counter:=0;
  asm
   mov al,[_order]
   mov korder,al
  end;
  vorder:=korder+3;
  ufade:=0;
  dfade:=0;
{  lfade:=255;}
  soxx:=256;
  langle:=0;
  lpoint[0]:=0;
  lpoint[1]:=-128;
  lox:=0;
  loz:=-382;
  TERM:=false;
  USS_SetTimer(@newint,timerspeed div 80);
  repeat
    stangle:=counter mod 360;
{    if counter<64 then dfade:=252-counter*4;}
    if counter<91 then soxx:=256-tsin[counter];
    if counter>200 then begin
      lox:=round(lpoint[0]*cos(3*langle*pii)+lpoint[1]*sin(3*langle*pii));
      loz:=round(lpoint[1]*cos(3*langle*pii)-lpoint[0]*sin(3*langle*pii));
      loy:=round(sin(2*langle*pii)*50);
      langle:=(counter-200) mod 360;
    end;
    if (counter>1280) and (counter<1370) then soxx:=tsin[1370-counter]-256;
{    if (counter>=1306) and (counter<1370) then ufade:=(counter-1306)*4;}
    oxx:=soxx;

    lp[0].x:=round(cos(counter*pi/180*1.1)*60);
    lp[0].z:=round(sin(-counter*pi/180*1.1)*128);
    lp[0].y:=round(sin(counter*pi/180*1.1)*50)+20;
    lp[1].x:=round(cos((counter+60)*pi/180*1.3)*70);
    lp[1].z:=round(sin((counter+60)*pi/180*1.3)*128);
    lp[1].y:=round(sin((counter+60)*pi/180*1.3)*60);
    lp[2].x:=round(cos((-counter)*pi/180*1.5)*80);
    lp[2].z:=round(sin((-counter)*pi/180*1.5)*128);
    lp[2].y:=round(sin((-counter)*pi/180*1.5)*70);
    lp[3].x:=round(cos(counter*pi/180*1.9)*85);
    lp[3].z:=round(sin(counter*pi/180*1.9)*128);
    lp[3].y:=round(sin(counter*pi/180*1.9)*50)+30;
    lp[4].x:=round(cos((counter+140)*pi/180*0.9)*75);
    lp[4].z:=round(sin((counter+140)*pi/180*0.9)*128);
    lp[4].y:=round(sin((-counter+140)*pi/180*0.9)*60)-20;
    lp[5].x:=round(cos((-counter+200)*pi/180*0.8)*65);
    lp[5].z:=round(sin((-counter+200)*pi/180*0.8)*128);
    lp[5].y:=round(sin((-counter+200)*pi/180*0.8)*30)-40;
    lp[6].x:=round(cos((counter+200)*pi/180*1.4)*85);
    lp[6].z:=round(sin((counter+200)*pi/180*1.4)*128);
    lp[6].y:=round(sin((counter+200)*pi/180*1.4)*80);
    lp[7].x:=round(cos(counter*pi/180*1.6)*70);
    lp[7].z:=round(sin(-counter*pi/180*1.6)*128);
    lp[7].y:=round(sin(counter*pi/180*1.6)*50)-20;
    lp[8].x:=round(cos((counter+60)*pi/180*1)*70);
    lp[8].z:=round(sin((counter+60)*pi/180*1)*128);
    lp[8].y:=round(sin((counter+60)*pi/180*1)*60)-20;
    lp[9].x:=round(cos((-counter)*pi/180*1.8)*75);
    lp[9].z:=round(sin((-counter)*pi/180*1.8)*128);
    lp[9].y:=round(sin((-counter)*pi/180*1.8)*70)-30;
    lp[10].x:=round(cos(counter*pi/180*0.6)*80);
    lp[10].z:=round(sin(counter*pi/180*0.6)*128);
    lp[10].y:=round(sin(counter*pi/180*0.6)*55)-10;
    lp[11].x:=round(cos((counter+100)*pi/180*0.5)*70);
    lp[11].z:=round(sin((counter+100)*pi/180*0.5)*128);
    lp[11].y:=round(sin((-counter+100)*pi/180*0.5)*65);

      clearscreenbackgr;

    if lp[0].z<0 then
      putimage(144+lp[0].x+oxx,84+lp[0].y,32,32,l1,128-lp[0].z);
    if lp[1].z<0 then
      putimage(144+lp[1].x+oxx,84+lp[1].y,32,32,l2,128-lp[1].z);
    if lp[2].z<0 then
      putimage(144+lp[2].x+oxx,84+lp[2].y,32,32,l3,128-lp[2].z);
    if lp[3].z<0 then
      putimage(144+lp[3].x+oxx,84+lp[3].y,32,32,l4,128-lp[3].z);
    if lp[4].z<0 then
      putimage(144+lp[4].x+oxx,84+lp[4].y,32,32,l5,128-lp[4].z);
    if lp[5].z<0 then
      putimage(144+lp[5].x+oxx,84+lp[5].y,32,32,l6,128-lp[5].z);
    if lp[6].z<0 then
      putimage(144+lp[6].x+oxx,84+lp[6].y,32,32,l1,128-lp[6].z);
    if lp[7].z<0 then
      putimage(144+lp[7].x+oxx,84+lp[7].y,32,32,l2,128-lp[7].z);
    if lp[8].z<0 then
      putimage(144+lp[8].x+oxx,84+lp[8].y,32,32,l3,128-lp[8].z);
    if lp[9].z<0 then
      putimage(144+lp[9].x+oxx,84+lp[9].y,32,32,l4,128-lp[9].z);
    if lp[10].z<0 then
      putimage(144+lp[10].x+oxx,84+lp[10].y,32,32,l5,128-lp[10].z);
    if lp[11].z<0 then
      putimage(144+lp[11].x+oxx,84+lp[11].y,32,32,l6,128-lp[11].z);

      Render;

    if lp[0].z>=0 then
      putimage(144+lp[0].x+oxx,84+lp[0].y,32,32,l1,128-lp[0].z);
    if lp[1].z>=0 then
      putimage(144+lp[1].x+oxx,84+lp[1].y,32,32,l2,128-lp[1].z);
    if lp[2].z>=0 then
      putimage(144+lp[2].x+oxx,84+lp[2].y,32,32,l3,128-lp[2].z);
    if lp[3].z>=0 then
      putimage(144+lp[3].x+oxx,84+lp[3].y,32,32,l4,128-lp[3].z);
    if lp[4].z>=0 then
      putimage(144+lp[4].x+oxx,84+lp[4].y,32,32,l5,128-lp[4].z);
    if lp[5].z>=0 then
      putimage(144+lp[5].x+oxx,84+lp[5].y,32,32,l6,128-lp[5].z);
    if lp[6].z>=0 then
      putimage(144+lp[6].x+oxx,84+lp[6].y,32,32,l1,128-lp[6].z);
    if lp[7].z>=0 then
      putimage(144+lp[7].x+oxx,84+lp[7].y,32,32,l2,128-lp[7].z);
    if lp[8].z>=0 then
      putimage(144+lp[8].x+oxx,84+lp[8].y,32,32,l3,128-lp[8].z);
    if lp[9].z>=0 then
      putimage(144+lp[9].x+oxx,84+lp[9].y,32,32,l4,128-lp[9].z);
    if lp[10].z>=0 then
      putimage(144+lp[10].x+oxx,84+lp[10].y,32,32,l5,128-lp[10].z);
    if lp[11].z>=0 then
      putimage(144+lp[11].x+oxx,84+lp[11].y,32,32,l6,128-lp[11].z);

      if counter<64 then fadedown(255-counter*4);
    video_copy;
    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 OSZLOP_CLOSE;
begin
  Dealloc;
end;

begin
end.

