unit ufeed;

interface

procedure FEEDBACK_INIT;
procedure FEEDBACK_ACTION;
procedure FEEDBACK_CLOSE;

implementation

uses
  crt,dos,usm,video,grafix;

type
  TGreet=array[0..115655] of byte;
  PGreet=^TGreet;
  TFeedback=array[0..64000] of word;
  PFeedback=^TFeedback;

var
  IGreet:PGreet;
  korder,vorder,aorder,row:byte;
  TERM:boolean;
  feedbackt:pfeedback;

procedure alloc;
begin
  new(IGreet);
  new(feedbackt);
end;

procedure dealloc;
begin
{  dispose(IGreet);
  dispose(feedbackt);}
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:='feed_img.dat';
  assign(f,filename);
  reset(f,1);
  if ioresult<>0 then notfound;
  blockread(f,igreet^,86742);
  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 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
        ror eax,16
        xor ah,ah
        cmp eax,0
        je @noput
        ror eax,16
        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 [edi],eax
       @noput:
        add edi,4
        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 maketables;
var
  x,y:word;
begin
  for y:=0 to 99 do for x:=0 to 159 do
    feedbackt^[320*y+x]:=320*(y+round((99-y)*0.03))+x+round((159-x)*0.03);
  for y:=199 downto 100 do for x:=0 to 159 do
    feedbackt^[320*y+x]:=320*(y-round((y-100)*0.03))+x+round((159-x)*0.03);
  for y:=199 downto 100 do for x:=319 downto 160 do
    feedbackt^[320*y+x]:=320*(y-round((y-100)*0.03))+x-round((x-160)*0.03);
  for y:=0 to 99 do for x:=319 downto 160 do
    feedbackt^[320*y+x]:=320*(y+round((99-y)*0.03))+x-round((x-160)*0.03);
end;

procedure clearscreenfeed;
var
  x,y:dword;
  addr1,addr2,addr3:dword;
begin
  for y:=0 to 99 do for x:=0 to 159 do begin
    addr3:=320*y+x;
    addr1:=feedbackt^[addr3] shl 2;
    addr2:=addr3 shl 2;
    asm
        mov esi,video_screen
        mov edi,esi
        mov eax,addr1
        add esi,eax
        mov eax,addr2
        add edi,eax
        mov eax,[esi]
        mov bl,24
        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 [edi],eax
    end;
    addr3:=320*y+319-x;
    addr1:=feedbackt^[addr3] shl 2;
    addr2:=addr3 shl 2;
    asm
        mov esi,video_screen
        mov edi,esi
        mov eax,addr1
        add esi,eax
        mov eax,addr2
        add edi,eax
        mov eax,[esi]
        mov bl,24
        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 [edi],eax
    end;
    addr3:=320*(199-y)+x;
    addr1:=feedbackt^[addr3] shl 2;
    addr2:=addr3 shl 2;
    asm
        mov esi,video_screen
        mov edi,esi
        mov eax,addr1
        add esi,eax
        mov eax,addr2
        add edi,eax
        mov eax,[esi]
        mov bl,24
        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 [edi],eax
    end;
    addr3:=320*(199-y)+319-x;
    addr1:=feedbackt^[addr3] shl 2;
    addr2:=addr3 shl 2;
    asm
        mov esi,video_screen
        mov edi,esi
        mov eax,addr1
        add esi,eax
        mov eax,addr2
        add edi,eax
        mov eax,[esi]
        mov bl,24
        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 [edi],eax
    end;
  end;
  asm
    mov esi,video_screen
    mov edi,video_screen
    add esi,1280
    add edi,1280
    mov ecx,63360
   @loopkep:
    mov eax,[esi+4]
    rol eax,16
    xor ah,ah
    mov dx,ax
    rol eax,8
    xor ah,ah
    mov bx,ax
    rol eax,8
    xor ah,ah
    rol ebx,16
    mov bx,ax
    rol ebx,16
    mov eax,[esi-4]
    rol eax,16
    xor ah,ah
    add dx,ax
    rol eax,8
    xor ah,ah
    add bx,ax
    rol eax,8
    xor ah,ah
    rol ebx,16
    add bx,ax
    rol ebx,16
    mov eax,[esi+1280]
    rol eax,16
    xor ah,ah
    add dx,ax
    rol eax,8
    xor ah,ah
    add bx,ax
    rol eax,8
    xor ah,ah
    rol ebx,16
    add bx,ax
    rol ebx,16
    mov eax,[esi-1280]
    rol eax,16
    xor ah,ah
    add dx,ax
    rol eax,8
    xor ah,ah
    add bx,ax
    rol eax,8
    xor ah,ah
    rol ebx,16
    add bx,ax
    rol ebx,16

    shr dx,2
    shr bx,2
    rol ebx,16
    shr bx,2

    mov al,dl
    rol eax,16
    mov ah,bl
    ror ebx,16
    mov al,bl

    mov [edi],eax
    add edi,4
    add esi,4
    loop @loopkep
  end;
end;

procedure render;
var
  f:byte;
  o,p:longint;
begin
  clearscreenfeed;
  if (counter<64) then begin
    f:=255-(counter)*4;
    o:=round(cos(counter*pi/180)*40);
    p:=round(sin(counter*pi/180)*20);
    putimagea(68+o,21+p,183,158,igreet,f);
  end;
  if (counter>=64) and (counter<128) then begin
    f:=(counter-64)*2;
    o:=round(cos(counter*pi/180)*40);
    p:=round(sin(counter*pi/180)*20);
    putimagea(68+o,21+p,183,158,igreet,f);
  end;
  if (counter>=128) and (counter<192) then begin
    f:=128-(counter-128)*2;
    o:=round(cos(counter*pi/180)*40);
    p:=round(sin(counter*pi/180)*20);
    putimagea(68+o,21+p,183,158,igreet,f);
  end;
  if (counter>=192) and (counter<256) then begin
    f:=(counter-192)*2;
    o:=round(cos(counter*pi/180)*40);
    p:=round(sin(counter*pi/180)*20);
    putimagea(68+o,21+p,183,158,igreet,f);
  end;
  if (counter>=256) and (counter<320) then begin
    f:=128-(counter-256)*2;
    o:=round(cos(counter*pi/180)*40);
    p:=round(sin(counter*pi/180)*20);
    putimagea(68+o,21+p,183,158,igreet,f);
  end;
  if (counter>=320) and (counter<384) then begin
    f:=(counter-320)*2;
    o:=round(cos(counter*pi/180)*40);
    p:=round(sin(counter*pi/180)*20);
    putimagea(68+o,21+p,183,158,igreet,f);
  end;
  if (counter>=384) and (counter<448) then begin
    f:=128-(counter-384)*2;
    o:=round(cos(counter*pi/180)*40);
    p:=round(sin(counter*pi/180)*20);
    putimagea(68+o,21+p,183,158,igreet,f);
  end;
  if (counter>=448) and (counter<512) then begin
    f:=(counter-448)*4;
    o:=round(cos(counter*pi/180)*40);
    p:=round(sin(counter*pi/180)*20);
    putimagea(68+o,21+p,183,158,igreet,f);
  end;
  video_copy;
end;

procedure FEEDBACK_INIT;
begin
  alloc;
  loadmaps;
  convertimage(igreet,28914);
  maketables;
end;

procedure newint;
begin
  inc(counter);
end;

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

procedure FEEDBACK_CLOSE;
begin
  dealloc;
end;

begin
end.