{$R-}
unit usword;

interface

procedure SWORD_INIT;
procedure SWORD_ACTION;
procedure SWORD_CLOSE;

implementation

uses
  crt,usm,video,grafix;

type
  TSword1Image=array[0..100351] of byte;
  PSword1Image=^TSword1Image;
  TSword2Image=array[0..113079] of byte;
  PSword2Image=^TSword2Image;
  TSword3Image=array[0..207199] of byte;
  PSword3Image=^TSword3Image;
  TPresents=array[0..24887] of byte;
  PPresents=^TPresents;
  TLight=array[0..256] of byte;
  PLight=^TLight;

var
  ISw1:PSword1Image;
  ISw2:PSword2Image;
  ISw3:PSword3Image;
  IPre:PPresents;
  lred,lgreen,lblue:plight;
  blobpoz:array[0..1199,0..1] of real;

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

procedure newint;
begin
  inc(counter);
end;

procedure alloc;
begin
  new(ISw1);
  new(ISw2);
  new(ISw3);
  new(IPre);
  new(lred);
  new(lgreen);
  new(lblue);
end;

procedure dealloc;
begin
  dispose(ISw1);
  dispose(ISw2);
  dispose(ISw3);
  dispose(IPre);
  dispose(lred);
  dispose(lgreen);
  dispose(lblue);
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:='swrd_sw1.dat';
  assign(f,filename);
  reset(f,1);
  if ioresult<>0 then notfound;
  blockread(f,isw1^,75264);
  if ioresult<>0 then fileerr;
  filename:='swrd_sw2.dat';
  assign(f,filename);
  reset(f,1);
  if ioresult<>0 then notfound;
  blockread(f,isw2^,84810);
  if ioresult<>0 then fileerr;
  filename:='swrd_sw3.dat';
  assign(f,filename);
  reset(f,1);
  if ioresult<>0 then notfound;
  blockread(f,isw3^,155400);
  if ioresult<>0 then fileerr;
  filename:='swrd_pre.dat';
  assign(f,filename);
  reset(f,1);
  if ioresult<>0 then notfound;
  blockread(f,ipre^,18666);
  if ioresult<>0 then fileerr;

  filename:='swrd_red.dat';
  assign(f,filename);
  reset(f,1);
  if ioresult<>0 then notfound;
  blockread(f,lred^,192);
  if ioresult<>0 then fileerr;

  filename:='swrd_blu.dat';
  assign(f,filename);
  reset(f,1);
  if ioresult<>0 then notfound;
  blockread(f,lblue^,192);
  if ioresult<>0 then fileerr;

  filename:='swrd_grn.dat';
  assign(f,filename);
  reset(f,1);
  if ioresult<>0 then notfound;
  blockread(f,lgreen^,192);
  if ioresult<>0 then fileerr;
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 putimage(x,y,sx,sy:longint;source:pointer;fade:byte);
label
  quit;
var
  x1,x2,y1,y2:longint;
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
        pushad
        mov ebx,y1
        mov ecx,x1
        mov esi,[source]
        mov eax,sx
        mul ebx
        add eax,ecx
        shl eax,2
        add esi,eax

        mov edi,[video_SCREEN]
        mov eax,320
        add ebx,Y
        mul ebx
        add eax,ecx
        add eax,X
        shl eax,2
        add edi,eax

        mov edx,y1
        mov ecx,x2
        SUB ECX,X1
        INC ECX
        MOV EBX,ECX
        mov bl,fade
       @loopx:
        lodsd
        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
        stosd
        LOOP @LOOPX

        mov ecx,x2
        SUB ECX,X1
        INC ECX
        MOV EAX,320
        SUB EAX,EcX
        SHL EAX,2
        ADD EDI,EAX

        inc edx
        cmp edx,y2
        jbe @loopX

        popad
      end;
  quit:
end;

procedure putimagea(x,y,sx,sy:longint;source:pointer;fade:byte);
label
  quit;
var
  x1,x2,y1,y2:longint;
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
        pushad
        mov ebx,y1
        mov ecx,x1
        mov esi,[source]
        mov eax,sx
        mul ebx
        add eax,ecx
        shl eax,2
        add esi,eax

        mov edi,[video_SCREEN]
        mov eax,320
        add ebx,Y
        mul ebx
        add eax,ecx
        add eax,X
        shl eax,2
        add edi,eax

        mov edx,y1
        mov ecx,x2
        SUB ECX,X1
        INC ECX
        MOV EBX,ECX
       @loopx:
        lodsd
        mov bl,fade
        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
        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
        LOOP @LOOPX

        mov ecx,x2
        SUB ECX,X1
        INC ECX
        MOV EAX,320
        SUB EAX,EcX
        SHL EAX,2
        ADD EDI,EAX

        inc edx
        cmp edx,y2
        jbe @loopX

        popad
      end;
  quit:
end;

procedure makemaps;
var
  a:integer;
begin
  randseed:=0;
  for a:=0 to 1199 do begin
    blobpoz[a,0]:=(random(240)-120)/100;
    blobpoz[a,1]:=(random(2600)-1300)/100;
  end;
end;

procedure render;
var
  f:byte;
  a:word;
  o,p:longint;
begin
  clearscreen;
  if counter<110 then begin
    f:=255-round(counter/110*128);
    o:=round(sin(counter*pi/220)*710);
{    putimage(32+94,-1200+o,64,392,isw1,f);}
    putimage(32,-1200+o+392,257,110,isw2,f);
    putimage(32+90,-1200+o+502,74,700,isw3,f);
  end else
  if (counter>=110) and (counter<120) then begin
    f:=128-round((counter-110)/10*128);
{    putimage(32+94,-490,64,292,isw1,f);}
    putimage(32,-490+392,257,110,isw2,f);
    putimage(32+90,-490+502,74,700,isw3,f);
  end else
  if (counter>=120) and (counter<220) then begin
    f:=round((counter-120)/100*128);
{    putimage(32+94,-490,64,292,isw1,f);}
    putimage(32,-490+392,257,110,isw2,f);
    putimage(32+90,-490+502,74,700,isw3,f);
  end else
  if (counter>=220) and (counter<300) then begin
    f:=128-round((counter-220)/80*128);
{    putimage(32+94,-490,64,292,isw1,f);}
    putimage(32,-490+392,257,110,isw2,f);
    putimage(32+90,-490+502,74,700,isw3,f);
  end else
  if (counter>=300) and (counter<430) then begin
    f:=0;
    o:=250-round(sin((90-(counter-300)/130*90)*pi/180)*250);
    putimage(32+94,-490+o,64,392,isw1,f);
    putimage(32,-490+392+o,257,110,isw2,f);
    putimage(32+90,-490+502+o,74,700,isw3,f);
  end;
  if counter>400 then fadedown((counter-400)*8);
  if (counter>=215) and (counter<333) then begin
    f:=255-round(sin((counter-215)/128*pi)*255);
    for a:=0 to 1199 do begin
      o:=round(blobpoz[a,0]*(counter-215));
      p:=round(blobpoz[a,1]-(counter-215)*0.5+sin((counter-215)/128*pi)*40);
      if (a mod 3)=0 then begin
        putimagea(160+o,90-p,8,8,lred,f);
      end;
      if (a mod 3)=1 then begin
        putimagea(160+o,90-p,8,8,lgreen,f);
      end;
      if (a mod 3)=2 then begin
        putimagea(160+o,90-p,8,8,lblue,f);
      end;
    end;
  end;
  if (counter>=270) and (counter<302) then begin
    f:=255-(counter-270)*8;
    putimagea(68,70,183,34,ipre,f);
  end else
  if (counter>=302) and (counter<430) then begin
    f:=(counter-302)*2;
    putimagea(68,70,183,34,ipre,f);
  end;
  video_copy;
end;

procedure SWORD_INIT;
begin
  alloc;
  loadmaps;
  makemaps;
  convertimage(isw1,25088);
  convertimage(isw2,28270);
  convertimage(isw3,51800);
  convertimage(lred,64);
  convertimage(lgreen,64);
  convertimage(lblue,64);
  convertimage(ipre,6222);
end;

procedure SWORD_ACTION;
begin
  asm
   mov al,[_order]
   mov korder,al
  end;
  vorder:=korder+2;
  TERM:=false;
  counter:=0;
  USS_SetTimer(@newint,timerspeed div 25);
  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 SWORD_CLOSE;
begin
  dealloc;
end;

begin
end.
