Editor animácií

Kategorija: KMP (Programy mladňakoch

Zrobil: Ľuboš Saloky
Program: Animacie.pas
Subor exe: Animacie.exe
Mušiš mac: Mukogr.pas,  Mukoutil.pas,  Myska.pas

{ MUKOUTIL.PAS                                                      }
{ Grafické utility.                                                 }
{                                                                   }
{ Author: Ľuboš Saloky                                              }
{ Datum: 01.01.1996                           http://www.trsek.com  }
 
unit MukoUtil;{MukoSoft graficke utility}
                        INTERFACE
uses Dos,Myska,MukoGr,Crt;
{ ----- rozne doplnkove procedury a funkcie ----- }
procedure SuboroveOkno(APosX,APosY:word;Titul,Filter:string;var ASubor:SearchRec);
procedure Citaj(Dlzka,Odtien:byte);             {cita retazec do Ret}
{ ----- procedury pre pracu s priemrovanym pozadim ----- }
procedure PripravPozadie(RozX,RozY:word;Farba:byte;var ObrazUkaz:pointer);
procedure ZlikvidujPozadie(ObrazUkaz:pointer);
procedure PriemerujBitmapu(ObrazUkaz:pointer);
procedure StmavBitmapu(ObrazUkaz:pointer);
{ ----- pomocne procedury pre bitmapy ----- }
procedure PreklopBitmapu(RozX,RozY,Zdroj:word;Smer:shortint);
{-1=okolo hlavnej diagonaly, 1 okolo vedlajsej,2 okolo zvislej osi,-2 okolo vodorovnej}
procedure PosunVRamDole(oKolko:word);
 
 
                      IMPLEMENTATION
procedure SuboroveOkno(APosX,APosY:word;Titul,Filter:string;var ASubor:SearchRec);
const Sirka=120;Vyska=124;
      SipkaHore:array[1..64] of byte=(0 ,0 ,0 ,55,55,0 ,0 ,0 ,
                                      0 ,0 ,0 ,55,55,0 ,0 ,0 ,
                                      0 ,0 ,55,59,59,55,0, 0 ,
                                      0 ,0 ,55,59,59,55,0, 0 ,
                                      0 ,55,59,63,63,59,55,0 ,
                                      55,59,63,28,28,63,59,55,
                                      55,59,63,28,28,63,59,55,
                                      0 ,0 ,55,59,59,55,0 ,0 );
      SipkaDole:array[1..64] of byte=(0 ,0 ,55,59,59,55,0 ,0,
                                      55,59,63,28,28,63,59,55,
                                      55,59,63,28,28,63,59,55,
                                      0 ,55,59,63,63,59,55,0 ,
                                      0 ,0 ,55,59,59,55,0, 0 ,
                                      0 ,0 ,55,59,59,55,0, 0 ,
                                      0 ,0 ,0 ,55,55,0 ,0 ,0 ,
                                      0 ,0 ,0 ,55,55,0 ,0 ,0 );
{ ----- suradnice RELATIVNE KU APosX,APosY v tvare XMIN,YMIN,XMAX,YMAX ----- }
      AktivIn:array[1..6,1..4]of byte=((4,19,Sirka-4,33),        {ramcek pre meno suboru}
                                       (4,36,Sirka-4,96),        {ramcek s nazvami suborov}
                                       (Sirka-13,37,Sirka-5,45), {sipka hore}
                                       (Sirka-13,87,Sirka-5,95), {sipka dole}
                                       (18,108,42,124),          {OK}
                                       (46,108,94,124));         {ZAVRI}
var p1,p2,UdalostIn,PocetSub,HornySub,AktSub:integer;
    pomx,pomy:word;
    pomSubor:SearchRec;
    ATlacidla:byte;
    Adresar:array[1..100] of SearchRec;
{ ----- vypis adresara ----- }
  procedure ZmazCiarku;
  var p1:word;
  begin
    VypniKurzorMysi;
    p1:=APosY+45+(42 * (HornySub-1)) div (PocetSub-7);
    Nastav(APosX+Sirka-13,p1,0);
    CiaraVodorovna(8);
    PolozBod(APosX+Sirka-9,p1,59);
    PolozBod(APosX+Sirka-10,p1,59);
    ZapniKurzorMysi;
  end; {SuboroveOkno.ZmazCiarku }
  procedure VypisSubory;
  var p1:word;
  begin
    VypniKurzorMysi;
    Nastav(APosX+Sirka-13,APosY+45+(42* (HornySub-1)) div (PocetSub-7) ,69);
    CiaraVodorovna(8);
    Nastav(APosX+5,APosY+37,0);VyplnPlochu(Sirka-20,58);
    for p1:=1 to 7 do begin
      Nastav(APosX+6,APosY+30+8*p1,0);
      VypisPriehladne(Adresar[p1+HornySub-1].Name,SvetloModra);
    end;
    ZapniKurzorMysi;
  end; { SuboroveOkno.VypisSubory }
  { ----- nacitanie adresara a upravy ----- }
  procedure NacitajSubory(Filter:string);
  var p2:word;
      PomStr,FilStr:string;
  begin
    FillChar(Adresar,SizeOf(Adresar),#0);
    FindFirst('*.*',AnyFile,pomSubor);
    PocetSub:=1;
    while DosError=0 do begin
      FindNext(pomSubor);
      if pomSubor.Attr and Directory=0 then begin{DownCase}
        for p2:=1 to Length(pomSubor.Name) do
          if pomSubor.Name[p2] in ['A'..'Z'] then PomSubor.Name[p2]:=Chr(Ord(PomSubor.Name[p2])+32);
      end else                                   {UpCase}
        for p2:=1 to Length(pomSubor.Name) do PomSubor.Name[p2]:=UpCase(PomSubor.Name[p2]);
      PomStr:=Copy(PomSubor.Name,Pos('.',PomSubor.Name)+1,3);
      if (pomSubor.Attr and Directory>0) or (PomStr=Filter) then begin
        Adresar[PocetSub]:=pomSubor;
        Inc(PocetSub);
      end;
    end;
    HornySub:=1;
    Dec(PocetSub);
  end; { Suboroveokno.NacitajSubory }
begin { SuboroveOkno }
{ ----- kreslenie ----- }
  VypniKurzorMysi;
  Nastav(APosX,APosY,15);Obdlznik(Sirka,Vyska);
  Nastav(APosX+1,APosY+1,12);Obdlznik(Sirka-2,Vyska-2);
  Nastav(APosX+Sirka div 2-Length(Titul)*4,APosY+4,0);
  VypisPriehladne(Titul,Zelena);
  Nastav(APosX+1,APosY+14,12);CiaraVodorovna(Sirka-2);
  Nastav(APosX+4,APosY+18,12);Obdlznik(Sirka-8,14);
  Nastav(APosX+4,APosY+36,12);Obdlznik(Sirka-8,60);
  Nastav(APosX+14,APosY+104,12);Ramcek(24,16,99);
  Nastav(APosX+42,APosY+104,12);Ramcek(48,16,99);
  Nastav(APosX+18,APosY+108,0);VypisPriehladne('OK',Zlta);
  Nastav(APosX+46,APosY+108,0);VypisPriehladne('ZAVRI',Zlta);
  Nastav(APosX+Sirka-13,APosY+37,0);PrilepBitmapu(8,8,Ofs(SipkaHore));
  Nastav(APosX+Sirka-13,APosY+87,0);PrilepBitmapu(8,8,Ofs(SipkaDole));
  Nastav(APosX+Sirka-9,APosY+45,59);CiaraZvisla(42);
  Nastav(APosX+Sirka-10,APosY+45,59);CiaraZvisla(42);
  Nastav(APosX+7,APosY+21,0);VypisPriehladne('*.'+Filter,SvetloModra);
  ASubor.Name:='';
  NacitajSubory(Filter);
  VypisSubory;
  ZapniKurzorMysi;
{ ----- cakanie na udalost ----- }
  repeat
    repeat
      ZistiPoziciu(pomx,pomy,ATlacidla);
    until ATlacidla>0;
    pomx:=pomx div 2;
    UdalostIn:=0;
    for p1:=1 to 6 do
      if (pomx>=APosX+AktivIn[p1,1]) and (pomx<=APosX+AktivIn[p1,3]) and
         (pomy>=APosY+AktivIn[p1,2]) and (pomy<=APosY+AktivIn[p1,4]) then UdalostIn:=p1;
{ ----- spracovanie udalosti ----- }
    case UdalostIn of
      1:begin          {natukanie mena suboru}
        VypniKurzorMysi;
        Nastav(APosX+5,APosY+19,0);VyplnPlochu(Sirka-10,12);
        Nastav(APosX+7,APosY+21,0);Citaj(12,SvetloModra);
        for p2:=1 to Length(pomSubor.Name) do       {DownCase}
          if Ret[p2] in ['A'..'Z'] then Ret[p2]:=Chr(Ord(Ret[p2])+32);
        ASubor.Name:='';
        for p1:=1 to PocetSub do
          if Ret=Adresar[p1].Name then ASubor:=Adresar[p1];
        if ASubor.Name='' then begin
          Nastav(APosX+5,APosY+19,0);VyplnPlochu(Sirka-10,12);
          Nastav(APosX+7,APosY+21,0);VypisPriehladne('*.'+Filter,SvetloModra);
        end;
        ZapniKurzorMysi;
      end;
      2:begin         {priamy vyber suboru}
        AktSub:=HornySub+(pomy-APosY-36) div 8;
        ASubor:=Adresar[AktSub];
        if ASubor.Attr and Directory=0 then begin
          Nastav(APosX+5,APosY+19,0);VyplnPlochu(Sirka-10,12);
          Nastav(APosX+7,APosY+21,0);VypisPriehladne(Adresar[AktSub].Name,SvetloModra);
        end;
      end;
      3:if HornySub>1 then begin {posun dole}
        ZmazCiarku;
        Dec(HornySub);
        VypisSubory;
      end;
      4:if HornySub<PocetSub-7 then begin {posun hore}
        ZmazCiarku;
        Inc(HornySub);
        VypisSubory;
      end;
    end;
    if (UdalostIn=3) or (UdalostIn=4) then Delay(150);
    if UdalostIn=2 then CakajNaPustenie;
    if ASubor.Attr and Directory>0 then begin
      ZmazCiarku;
      ChDir(ASubor.Name);
      NacitajSubory(Filter);
      VypisSubory;
      ASubor.Name:='';
      ASubor.Attr:=0;
      Nastav(APosX+5,APosY+19,0);VyplnPlochu(Sirka-10,12);
      Nastav(APosX+7,APosY+21,0);VypisPriehladne('*.'+Filter,SvetloModra);
    end;
  until UdalostIn>=5;
  if UdalostIn=6 then ASubor.Name:='';
end;
procedure ZmazKurzor;assembler;
asm
             mov ax,0000h        {zmaz kurzor}
             mov di,Adresa
             mov bx,320*8        {BX - posun offsetu od DI}
@DalsiRiadoQ:sub bx,320
             mov word[es:di+bx],ax
             jnz @DalsiRiadoQ
end;
procedure Citaj(Dlzka,Odtien:byte);assembler;
var Stot,Sek:byte;
asm
             lea si,Ret
             mov byte[si],0
             mov ax,VSeg
             mov es,ax
             cld
             mov Stot,0
             mov Sek,0
             mov si,0
{ ----- hlavny cakaci cyklus ----- }
@Cakaj:      mov ah,1           {if keypressed}
             int 16h            {znak je v AL}
             jnz @VypisPismeno
             mov ah,2Ch         {zisti systemovy cas}
             int 21h
             cmp Sek,dh         {prechod cez zmenu sekund}
             je @Pokracuj0
             add dl,100
@Pokracuj0:  cmp Stot,dl
             ja @Cakaj   { ----- navrat do cakania, nic sa nedeje}
{ ----- blikanie kurzora ----- }
             mov Sek,dh
             add Stot,20
             cmp Stot,120
             jb @OK
             mov Stot,0
@OK:         xor si,1            {prekresli kurzor}
             test si,1           {if SI=0}
             je @Zapnuty
             mov ax,0000h        {zmaz kurzor}
             jmp @Pokracuj
@Zapnuty:    mov ax,1F1Fh        {vykresli kurzor}
@Pokracuj:   mov di,Adresa
             mov bx,320*8        {BX - posun offsetu od DI}
@DalsiRiadok:sub bx,320
             mov word[es:di+bx],ax
             jnz @DalsiRiadok
             jmp @Cakaj   { ----- navrat do cakania, bol prepisany kurzor }
{ ----- spracovanie Enter,Esc  a nepustenie dalej ----- }
@VypisPismeno:mov ah,0
             int 16h
             cmp al,1Bh  {Esc}
             je @Zmaz
             cmp al,0Dh  {Enter}
             je @Koniec
             cmp al,08h  {BkSp}
             je @SpracujBkSp
             lea si,Ret
             mov dl,byte[si]
             cmp dl,Dlzka
             jae @Cakaj    { ----- navrat do cakania, je vela znakov}
{ ----- vypisovanie pismena ----- }
             lea si,Ret
             inc byte[si]
             mov bl,byte[si]
             xor bh,bh
             mov byte[si+bx],al
             mov cl,al
             call ZmazKurzor
             mov al,cl
@SpracujPism:lea si,Font
             xor ah,ah
             shl ax,6
             add si,ax    {zdrojovy offset pre pismeno}
             mov di,Adresa{cielovy offset}
             mov cx,0
@DalsiBod:   mov al,byte[si]
             and al,$0F
             jz @Nekresli
             mov al,Odtien
             shl al,4
             add al,byte[si]
             mov [es:di],al
@Nekresli:   inc si
             inc di
             inc cx
             test cl,00000111b
             jnz @Pokracuj3
             add di,312
@Pokracuj3:  cmp cx,63
             jbe @DalsiBod
             add Adresa,8
             jmp @Cakaj   { ----- navrat do cakania, bolo vypisane pismeno}
{ ----- spracovanie BkSp ----- }
@SpracujBkSp:lea si,Ret
             cmp byte[si],0
             je @Cakaj    { ----- navrat do cakania, uz dalej nie je mozne mazat}
             call ZmazKurzor
             mov bx,8
             mov ax,0
             sub Adresa,8
             mov di,Adresa
@DalsiW:     mov cx,4
         rep stosw
             add di,312
             dec bx
             cmp bx,0
             jne @DalsiW
             lea si,Ret
             dec byte[si]
             jmp @Cakaj { ----- navrat do cakania, zmazany znak}
@Zmaz:       lea si,Ret  {zmazanie retazca}
             mov byte[si],0
@Koniec:     call ZmazKurzor
end;
procedure PripravPozadie(RozX,RozY:word;Farba:byte;var ObrazUkaz:pointer);
var ObrazSeg,p1:word;
begin
  GetMem(ObrazUkaz,RozX*RozY+16);
  ObrazSeg:=Seg(ObrazUkaz^)+1;
  MemW[ObrazSeg:0]:=RozX;
  MemW[ObrazSeg:2]:=RozY;
  for p1:=4 to RozX*RozY+4 do Mem[ObrazSeg:p1]:=Random(16)+16*Farba;
end;
 
procedure ZlikvidujPozadie(ObrazUkaz:pointer);
var RozX,RozY:word;
begin
  RozX:=MemW[Seg(ObrazUkaz^)+1:0];
  RozY:=MemW[Seg(ObrazUkaz^)+1:2];
  FreeMem(ObrazUkaz,RozX*RozY+16);
end;
 
procedure PriemerujBitmapu(ObrazUkaz:pointer);
var RozX,RozY,ObrazSeg:word;
begin
  ObrazSeg:=Seg(ObrazUkaz^)+1;
  RozX:=MemW[ObrazSeg:0];
  RozY:=MemW[ObrazSeg:2];
  asm
             cld
             push ds
             xor bx,bx          {pocitadlo v riadku}
             mov si,4           {cez SI sa citaju body}
             mov di,RozX
             add di,5           {a uklada do bodu s adresou DI }
             mov cx,RozY        {pocitadlo v stlpci}
             sub cx,2
             mov dx,RozX
             mov ax,ObrazSeg
             mov ds,ax
             mov es,ax
@DalsiRiadok:
@DalsiBod:     xor ah,ah
               mov al,byte[si]
               add al,byte[si+1]
               adc ah,0
               add al,byte[si+2]
               adc ah,0
               add si,dx         {na dalsi riadok}
               add al,byte[si]
               adc ah,0
               add al,byte[si+2]
               adc ah,0
               add si,dx         {na dalsi riadok}
               add al,byte[si]
               adc ah,0
               add al,byte[si+1]
               adc ah,0
               add al,byte[si+2]
               adc ah,0
               shr ax,3          {uz je spriemerovane}
 
               adc al,0
               stosb
 
               sub si,dx         {Ăşprava SI a smycka DalsiBod}
               sub si,dx
               inc si
               inc bx
               cmp bx,dx
               jb @DalsiBod
 
             xor bx,bx            {prechod na dalsi riadok}
             loop @DalsiRiadok
             pop ds
  end;
end;
Procedure StmavBitmapu(ObrazUkaz:pointer);
var ObrazSeg,Kolko:word;
begin
  ObrazSeg:=Seg(ObrazUkaz^)+1;
  Kolko:=MemW[ObrazSeg:0]*MemW[ObrazSeg:2];
  asm
             cld
             mov es,ObrazSeg
             mov di,4
             mov cx,Kolko
@DalsiBod:   mov al,byte[es:di]
             mov ah,al
             and ah,0F0h
             and al,00Fh
             shr al,1
             add al,ah
             stosb
             loop @DalsiBod
  end;
end;  { StmavBitmapu }
 
 
procedure PreklopBitmapu(RozX,RozY,Zdroj:word;Smer:shortint);assembler;
asm
             cld            {inicializacia ES,SI,DI,CX,DX}
             mov ax,ds
             mov es,ax
             mov dx,RozY
             mov cx,RozX
             mov si,Zdroj
             mov di,Zdroj
             cmp Smer,-2
             jne @NieVodor
{----- preklapanie okolo vodorovnej osi ----- }
             mov ax,RozX
             mul dx
             sub ax,RozX      {offset ciela}
             add di,ax
             mov dx,RozY
             shr dx,1
@DalsiBod1:  mov al,byte[di]
             movsb
             mov byte[si-1],al  {vymena a posun indexovych registrov}
             loop @DalsiBod1
             sub di,RozX
             sub di,RozX
             mov cx,RozX
             dec dx
             jnz @DalsiBod1
             jmp @Hotovo
{ ----- preklapanie okolo zvislej osi ----- }
@NieVodor:   cmp Smer,2
             jne @NieZvis
             add di,RozX
             dec di
             shr cx,1    {priprava registrov}
             mov bx,cx
@DalsiBod3:  mov al,byte[di]
             movsb
             mov byte[si-1],al
             sub di,2
             loop @DalsiBod3
             add si,RozX
             add di,RozX
             sub si,bx
             add di,bx
             mov cx,bx
             dec dx
             jnz @DalsiBod3
             jmp @Hotovo
{ ----- otacanie proti smeru hodinovych ruciciek ----- }
@NieZvis:    cmp Smer,-1
             jne @ProtiSmeru
             mov bx,Zdroj
@DalsiBod2:  mov al,byte[si]
             mov ah,byte[di]
             mov byte[si],ah
             mov byte[di],al
             inc si
             add di,RozX
             loop @DalsiBod2
             add bx,RozX
             inc bx
             mov si,bx      {nova adresa}
             mov di,bx
             mov cx,dx      {presuvaj menej bajtov}
             dec cx
             dec dx
             jnz @DalsiBod2
             jmp @Hotovo
{ ----- preklapanie okolo vedlajsej diagonaly ----- }
@ProtiSmeru: cmp Smer,1
             jne @Hotovo
             add si,RozX  {priprava registrov}
             add di,RozX
             dec si
             dec di
             mov bx,di
@DalsiBod4:  mov al,byte[si]
             mov ah,byte[di]
             mov byte[si],ah
             mov byte[di],al
             dec si
             add di,RozX
             loop @DalsiBod4
             dec dx
             add si,RozX   {nova adresa SI}
             add si,dx
             mov di,si     {nova adresa DI}
             mov cx,dx     {presuvaj menej bajtov}
             cmp dx,0
             jne @DalsiBod4
@Hotovo:
end;
procedure PosunVRamDole(oKolko:word);assembler;
asm
             std
             push ds
             mov ax,VSeg
             mov es,ax
             mov ds,ax
             mov ax,oKolko
             mov cx,320
             mul cx
             mov si,63998
             sub si,ax
             mov di,63998
             mov cx,32000
             shr ax,1
             mov dx,ax    {odloz si tam pocet bajtov}
             sub cx,dx
         rep movsw
             cld
             mov di,0
             mov cx,dx
             mov ax,0
         rep stosw
             pop ds
end;
 
BEGIN
END.