{podle tutorialu z programatorskeho koutku na pinknetu,
jmeno autora jsem zapomnel, ale stejne mu dekuju }
unit fliplaya;
interface

type data=array[0..65534] of byte;

var rychlost,snimky:word;
    heigh:word;
    snimek:^data;
    f:file;

procedure readheader_init(jmeno:string);
procedure anyframes(from,into:word);
procedure deinit;


implementation
uses crt,dos,mygraph;

{neimplementovane procedury}

Procedure Fli_Color; Assembler;      {zapakovana paleta}
         asm
            push ds
            mov si,word ptr snimek    {do si ofset na sunku}
            mov ax,word ptr snimek+2  {do ax segment sunky}
            mov ds,ax
            mov cx,[ds:si]            {do cx pocet paketu v sunce}
            inc si
            inc si
         @navrat:
            push cx                    {ulozi pocet paketu do cx}
            cld                        {zvysovani ukazatele}
            mov al,[ds:si]             {prvni 1 bajt paketu,kolik preskocit}
            mov dx,$3c8
            out dx,al                  {cislo barvy na port}
            inc dx
            inc si
            xor ax,ax                   {vynuluj ax}
            mov al,[ds:si]              {do al kolik nastavit}
            mov cx,ax                   {do cx kolik nastavit}
            shl cx,1
            add cx,ax
            cmp cx,0                    {jestli 0 nastav 256 barev}
            jnz @ne_256
            mov cx,256*3
         @ne_256:
            inc si                      {nastavi barvy}
            rep outsb
            pop cx
            loop @navrat                 {snizi pocet paketu o 1 a dalsi paket}
            pop ds
         end;

Procedure Fli_LC;
var
   paketu,j,i,skok:byte;
   pocet,x,y,pozice,offs:word;
   odd:word;
   oddx:array [1..2] of byte absolute odd;
   kolik:word;
   kolx:array [1..2] of byte absolute kolik;
begin
     oddx[1]:=snimek^[0];                          {pocet stejnych radek 2 byte}
     oddx[2]:=snimek^[1];
     kolx[1]:=snimek^[2];                       {kolik ruznych radek 2 byte}
     kolx[2]:=snimek^[3];
     pozice:=4;
     for y:=odd to kolik+odd-1 do begin         {projede menici se radky}
         paketu:=snimek^[pozice];               {pocet paketu v radce}
         inc (pozice);
         x:=0;
         if paketu>0 then for i:=1 to paketu do begin
             skok:=snimek^[pozice];   {kolik bodu preskocit}
             inc (pozice);
             x:=x+skok;               {preskoceni}
             pocet:=snimek^[pozice];  {2 byte paketu}
             inc (pozice);
             if pocet>128 then begin  {8 bit nastaven, stejna data}
                {stejna data}         {byte urcuje kolikrat kreslit nasledujici byte}
                asm                   {kresleni dat}
                   push ds
                   push es
                   push di
                   mov si,word ptr snimek
                   add si,pozice
                   mov ax,word ptr snimek+2
                   mov ds,ax
                   inc pozice
                   mov ax,$a000       {video pamet}
                   mov es,ax
                   mov di,y
                   shl di,6
                   mov cx,4
                   mov ax,di
                @kok:
                   add di,ax
                   loop @kok
                   add di,x
                   mov cx,255
                   sub cx,pocet
                   inc cx
                   mov al,[ds:si]
                @lop:
                   mov [es:di],al
                   inc di
                   inc x
                   loop @lop
                   pop di
                   pop es
                   pop ds
                end;
             end else begin
                 {ruzna data}             {ruzna data, kazdy dalsi byte v paketu se}
                  asm                     {primo vykresli}
                     push ds
                     push es
                     push di
                     mov si,word ptr snimek
                     add si,pozice
                     mov ax,word ptr snimek+2
                     mov ds,ax
                     mov di,y
                     shl di,6
                     mov cx,4
                     mov ax,di
                   @koj:
                     add di,ax
                     loop @koj
                     add di,x
                     mov ax,$a000
                     mov es,ax
                     mov cx,pocet
                 @noping:
                     mov al,[ds:si]
                     mov [es:di],al
                     inc si
                     inc di
                     inc x
                     inc pozice
                     loop @noping
                     pop di
                     pop es
                     pop ds
                  end;
             end;
         end;
     end;
end;


Procedure Fli_Black; Assembler; {vyplni celou obrazovku cerne}
Asm
        MOV     AX,$a000
        MOV     ES, ax
        MOV     DI,0
        MOV     CX,64000
        XOR     AX, AX
        REP     STOSB
end;

Procedure Fli_Brun;    {jako fli_lc, ale nepreskakuje radky}
var
   paketu,j,i:byte;
   x,y,pozice,pocet:word;
begin
     pozice:=0;
     for y:=0 to heigh-1 do begin
         paketu:=snimek^[pozice];
         inc (pozice);
         x:=0;
         if paketu>0 then for i:=1 to paketu do begin
             pocet:=snimek^[pozice];
             inc (pozice);
             if pocet>=128 then begin {pozor tady je to opacne nez u fli_lc}
                {ruzna data}
                  asm
                     push ds
                     push es
                     push di
                     mov si,word ptr snimek
                     add si,pozice
                     mov ax,word ptr snimek+2
                     mov ds,ax
                     mov di,y
                     shl di,6
                     mov cx,4
                     mov ax,di
                   @koj:
                     add di,ax
                     loop @koj
                     add di,x
                     mov ax,$a000
                     mov es,ax
                     mov cx,255
                     sub cx,pocet
                     inc cx
                 @noping:
                     mov al,[ds:si]
                     mov [es:di],al
                     inc si
                     inc di
                     inc x
                     inc pozice
                     loop @noping
                     pop di
                     pop es
                     pop ds
                  end;
             end else begin
                 {stejna data}{zase bacha na to ze to je opacne nez u fli_lc}
                asm
                   push ds
                   push es
                   push di
                   mov si,word ptr snimek
                   add si,pozice
                   mov ax,word ptr snimek+2
                   mov ds,ax
                   inc pozice
                   mov ax,$a000
                   mov es,ax
                   mov di,y
                   shl di,6
                   mov cx,4
                   mov ax,di
                @kok:
                   add di,ax
                   loop @kok
                   add di,x
                   mov cx,pocet
                   mov al,[ds:si]
                @lop:
                   mov [es:di],al
                   inc di
                   inc x
                   loop @lop
                   pop di
                   pop es
                   pop ds
                end;
             end;
         end;
     end;
end;


Procedure Fli_Copy; Assembler; {kopie bytu v sunce rovnou na obrazovku}
asm
         push ds
         push es
         push di
         mov si,word ptr snimek
         mov ax,word ptr snimek+2
         mov ds,ax
         mov ax,$a000
         mov es,ax
         mov di,0
         mov cx,64000
         rep movsb
         pop di
         pop es
         pop ds
end;

{implementovane procedury}

procedure readheader_init(jmeno:string);
var hlav:record
               size:longint;
               magic:word;
               frames:word;
               width:word;
               heigh:word;
               depth:longint;
               speed:word;
                next:longint;
               frit:longint;
               expand:array[0..101] of byte;
         end;
begin
     assign(f,jmeno);
     reset(f,1);
     blockread(f,hlav,128);                {nacte hlavicku cely animace}
     rychlost:=hlav.speed;
     snimky:=hlav.frames;
     heigh:=hlav.heigh;
     getmem(snimek,sizeof(snimek));
     setmode;
end;



procedure anyframes(from,into:word);
var hlavicka:record
               size:longint;
               magic:word;
               chunks:word;
               expand:array [0..7] of byte;
             end;
     hlavicka2:record
                size:longint;
                typ:word;
               end;

    jump,procedur:word;
    size:longint;

begin
seek(f,0);
size:=128;
hlavicka.size:=0;
for jump:=1 to from-1 do
 begin                                  {pro kazdej obrazek}
  size:=size+hlavicka.size;
  seek(f,size);                         {skoci na dalsi obrazek}
  blockread(f,hlavicka,16);             {nacte hlavicku obrazku}
 end;
for jump:=from to into do
 begin
  size:=size+hlavicka.size;
  seek(f,size);                         {skoci na dalsi obrazek}
  blockread(f,hlavicka,16);             {nacte hlavicku obrazku}
   for procedur:=1 to hlavicka.chunks do
    begin                                     {pro kazdou sunku v obrazku}
     blockread(f,hlavicka2,6);                     {nacte hlavicku sunky}
     blockread(f,snimek^,hlavicka2.size-6);   {nacte sunku do pameti,bez hlavicky}
           case hlavicka2.typ of                   {jakyho je sunka typu}
                11: Fli_Color;                     {paleta}
                12: Fli_LC;                        {radkova komprese}
                13: Fli_Black;                     {cely obrazek cerny}
                15: Fli_Brun;                      {bytewise run compress, jen prvni obr}
                16: Fli_Copy;                      {obrazek bez komprese}
           end
    end;
  delay(rychlost*16);
  if port[$60]=1 then
   begin
    deinit;
    halt(0);
   end;
 end;
end;

procedure deinit;
begin
close(f);
freemem (snimek,sizeof(snimek));
setvideo(3);
end;



end.



