(* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *)
(*  Soubor: CUTVIEW.PAS                                                    *)
(*  Obsah: prohlizec obrazku typu CUT                                      *)
(*  Autor: Mircosoft (http://mircosoft.mzf.cz)                             *)
(*  Posledni uprava: 31.10.2020                                            *)
(*  Pro kompilaci: viz Uses                                                *)
(*  Pro spusteni: MSDFLT.FNT, pripadne nejaka paleta                       *)
(*  Upozorneni: tyto zdrojove kody pouzivate na vlastni nebezpeci          *)
(* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *)
program cutview;

{Pozor: tenhle program jsem si psal pro vlastni potrebu, takze je potreba ho
pred spustenim trochu upravit. Hlavne ty cesty k fontu a k palete (a paletu
asi nebudete chtit nacitat timhle zpusobem, ale spis z daneho obrazku, ale
to uz si zaridte sami).}

uses images,vesa2,klavesy2,retezce,paleta2,dos,errmsg,cfg;

type string3=string[3];
     UkNaTSoubor=^TSoubor;
     TSoubor=record
             jmeno:string[12];
             dalsi:array[false..true] of uknatsoubor; {false->predchozi, true->dalsi}
             end;

var komplet:pathstr;
    cesta:dirstr;
    jmeno:namestr;
    koncovka:extstr;
    prvni,vybrany,novy,predchozi:uknatsoubor;
    vysledek:searchrec;
    smer:boolean; {0=predchozi, 1=dalsi}
    pal:rgbpal256;
    o:word;
    obrazek:pointer;
    sirka,vyska:word;
    f:_font;
    index,pocet:word;

BEGIN
cfgsoubor:='CUTVIEW.CFG';
if paramcount=0 then chyba('Neni zadane jmeno souboru.',0);
komplet:=stringup(paramstr(1));
fsplit(komplet,cesta,jmeno,koncovka);
if (koncovka<>'.CUT')and(koncovka<>'.BMP')and(koncovka<>'.PCX')
   and(koncovka<>'.ORF') then chyba('Typ *'+koncovka+' neumim.',0);

prvni:=nil; vybrany:=nil;

findfirst(cesta+'*'+koncovka,anyfile-directory,vysledek);
while doserror=0 do
 begin
 if sizeof(tsoubor)>maxavail
   then break
   else begin
        new(novy);
        with novy^ do begin
                      jmeno:=vysledek.name;
                      dalsi[false]:=nil;
                      dalsi[true]:=nil;
                      end;
        if prvni=nil
          then prvni:=novy
          else begin
               if vybrany=nil then vybrany:=prvni;
               smer:=novy^.jmeno>=vybrany^.jmeno;
                repeat
                predchozi:=vybrany;
                vybrany:=vybrany^.dalsi[smer];
                until (vybrany=nil)
                      or (smer and (vybrany^.jmeno>novy^.jmeno))
                      or (not smer and (vybrany^.jmeno<=novy^.jmeno));
               novy^.dalsi[smer]:=vybrany;
               novy^.dalsi[not smer]:=predchozi;
               if vybrany<>nil then vybrany^.dalsi[not smer]:=novy;
               if predchozi<>nil then predchozi^.dalsi[smer]:=novy;
               if prvni^.dalsi[false]<>nil then prvni:=prvni^.dalsi[false];{aby prvni byl porad prvni}
               end;
        end;
 findnext(vysledek);
 end;
if prvni=nil then chyba('Asi nebylo dost pameti na seznam souboru.',0);
{seznam je hotovy, najdeme ten puvodni soubor:}
vybrany:=prvni;
index:=1;
while (vybrany<>nil)and(vybrany^.jmeno<>jmeno+koncovka) do begin
                                                           vybrany:=vybrany^.dalsi[true];
                                                           inc(index);
                                                           end;
if vybrany=nil then chyba('Vybrany soubor '+jmeno+koncovka+' v hotovem seznamu neni.',0); {teoreticky nemozne}
{zacyklime seznam:}
novy:=prvni;
pocet:=1;
while novy^.dalsi[true]<>nil do begin
                                novy:=novy^.dalsi[true]; {novym najed na posledni}
                                inc(pocet);
                                end;
prvni^.dalsi[false]:=novy;
novy^.dalsi[true]:=prvni;
{hlavni cyklus:}
_setmode(_800x600);
_loadfont2(f,'c:\tp\msdflt.fnt');
if f.glyphdata<>nil then _setfont(f,true);
if nactipaletu(pal,'c:\tp\dungeon\dungeon.pal') then nastavceloupaletu(pal);
 repeat
 _fill(0);
 if loadimagefromfile2(obrazek,sirka,vyska,cesta+vybrany^.jmeno,nil,nil)=0
   then begin
        __putimage(0,0,sirka,vyska,obrazek);
        freemem(obrazek,sirka*vyska);
        end
   else begin
        _line(0,0,_maxx,_maxy,239,0);
        _line(0,_maxy,_maxx,0,239,0);
        end;
 __print(10,_maxy-10,82,0,cesta+vybrany^.jmeno);
 __print(_maxx-100,_maxy-10,82,0,nastr2(index,5)+'/'+nastr(pocet));
 o:=xreadkey;
 case o of xlsipka,xbksp:begin
                         if vybrany=prvni then index:=pocet
                                          else dec(index);
                         vybrany:=vybrany^.dalsi[false];
                         end;
           xpsipka,32:begin
                      vybrany:=vybrany^.dalsi[true];
                      if vybrany=prvni then index:=1
                                       else inc(index);
                      end;
           end;
 until o=27;
_disposefont(f);
_setmode(0);
vybrany:=prvni^.dalsi[false];{posledni}
vybrany^.dalsi[true]:=nil;{uvolneni konce seznamu}
while prvni<>nil do begin
                    vybrany:=prvni;
                    prvni:=prvni^.dalsi[true];
                    dispose(vybrany);
                    end;
END.