{$G+}
uses dos, vga256c;
const FonScr=16; cursorXpos=13;{ ext='SCR';} scrSize=6912; col=3;
      pal:array[0..15,1..3] of byte=
((0,0,0),(0,0,41),(58,0,0),(58,0,46),(0,54,0),(0,54,54),(53,53,0),(51,51,51),
 (0,0,0),(0,0,44),(61,0,0),(63,0,56),(0,61,0),(0,63,63),(63,63,0),(63,63,63));
{                            | head            |  size   |datapos| ??}
header: array[1..14]of byte=(ord('B'), ord('M'),$36,$C4,0,$36,4,  $28,
{sizeX|sizeY| ??|2^farieb}
 0,1 , 192,0, 1,  8);
nothing:char=chr(0);
greetz:string[23]='Dedicated to: MikeOFzt';
boutme:string[55]='Created by MireX, contact me at: janosik_m@hotmail.com';
var fInfo:searchRec;
    dir:record files,dirs:word; end;
    scr,posOnScr,i,key,j:byte;
    Flist:array[1..FonScr] of string[13];
    Fdir :array[1..FonScr] of boolean;
    path,curpath:string[64];
    fName:string;
    fHandle:word;
    f:file;
{do suboru zapise CX znakov chr(0)}
procedure skip;
{CX=count} label _noth;
var pp, segNo, ofsNo:word;
begin
 segNo:= seg(nothing); ofsNo:= ofs(nothing);
 asm
   push ds
   push dx
   push bx
  mov   pp, CX
  mov   ax, segNo
  mov   ds, ax
  mov   dx, ofsNo
  mov   bx, Fhandle
  mov   CX, 1
_noth:  mov   ah,40h
  int 21h
  dec   pp
  cmp   pp,0
  ja    _noth
   pop  bx
   pop  dx
   pop  ds
 end;
end;
{zapise do suboru}
procedure wr;assembler;
{DS:DX= odkial, CX=count}
asm
 mov    ah,40h
 int    21h
 add    dx,cx
end;
{ulozi obrazovku do 256x192x256c BMP od X=20 , Y=0 }
procedure save_bmp;
var segN,ofsN, segH,ofsH:word;
    pos:word;
label _pal,_r,_err;
begin
 Fname[0]:=chr(ord(Fname[0])-4); fName:=fName+'bmp'+chr(0);
 segN:=seg(fName); ofsN:=ofs(fName)+1;
 segH:=seg(header); ofsH:=ofs(header);
 asm
   push ds
{vytvorim subor}
  mov   ax, segN
  mov   ds, ax
  mov   dx, ofsN
  mov   ah,3Ch
  xor   cx,cx
  int   21h
  jc    _err
  mov   fHandle, ax
{pisem header}
  mov   bx, ax
  mov   ax, segH
  mov   ds, ax
  mov   dx, ofsH
  mov   cx,5
  call  WR                      {pisem prvych 5b, BM+size(3b)}
  jc    _err
  mov   CX, 10-5                {skocim na poziciu 10, (teraz som bol na 5)}
  call  SKIP
  mov   cx,2
  call  WR                      {pozicia zaciatku dat (2b)}
  mov   CX,14-(10+2)
  call  SKIP
  mov   cx,1
  call  WR                      {??}
  mov   CX,18-(14+1)
  call  SKIP
  mov   cx,2
  call  WR                      { sizeX (2b)}
  mov   CX,22-(18+2)            {seek 22}
  call  SKIP
  mov   cx,2
  call  WR                      { sizeY (2b)}
  mov   cx,26-(22+2)
  call  SKIP
  mov   cx,1
  call  WR
  mov   CX,28-(26+1)            {seek na 28- # of colors}
  call  SKIP
  mov   cx,1
  call  WR                      { colors (1b)}
   pop  ds
 end;
 segN:=seg(pal); ofsN:=ofs(pal);
{paleta}
 asm
   push ds
  mov   CX, 54-(28+1)           {54 - pal}
  call  SKIP

  mov   dx, ofsN
  mov   pos,16
_pal:mov   ah,40h
  mov   cx,3
  int   21h                     {RGB}
  add   DX,3                    {!!!ma byt BGR}
  mov   cx,1
  call  SKIP
  dec   POS
  cmp   pos,0
  ja    _pal
{vyplnim zvysok farieb nulami}
  mov   CX,(256-16)*4
  call  SKIP
(* teraz obrazovku *)   {nepreskakujem nic: 1078-(54+256*4)=0}
  mov   ax, 0A000h
  mov   ds, ax
  mov   cx, 256
  mov   dx, 20+320*192
  mov   POS, 192

_r: mov   ah, 40h
  int   21h

  sub   dx,320
  dec   POS
  cmp   POS,0
  ja    _r

  mov   ah,3Eh
  int   21h
_err: pop  ds
 end;
end;
{nastavi speccy paletu}
procedure set_palette;
var segP,ofsP:word;
label _pal, _loop1;
begin
{farby : 1-blue 2-red 3-magneta 4-green 5-cyan 6-yellow 7-white}
 segP:=seg(pal); ofsP:=ofs(pal);
 asm
         push   ds
        mov     ax, segP
        mov     DS, ax
        mov     SI, ofsP
        mov     dx, 03C6h
        mov     al, 0FFh
        out     dx, al
        inc     dx
        inc     dx
        mov     al, 0           {start with color 0}
        out     dx, al
        inc     dx
        mov     cx, 16 * 3
        rep     outsb           {blast palette to VGA}

        mov     al,0
        mov     cx, 768 - 16 *3
_pal:   out dx,al
        loop _pal

         pop    ds
 end;
 for segP:=0 to 15 do begin
  i:=pal[segP,1]; pal[segP,1]:=pal[segP,3]; pal[segP,3]:=i;
  for ofsP:=1 to 3 do pal[segP,ofsP]:= pal[segP,ofsP]*4;
 end;
{ked som uz nastavil, upravim, aby som to mohol pisat do BMP: BGR 0-255}
end;
{vycisti 320x200x256 obrazovku}
procedure cls;assembler;
asm
  push ds
 mov ax,0A000h
 mov es,ax
 mov cx,320*200-1
 mov di,0
 mov al,0
 rep stosb
{ [es:di]=al}
  pop ds
{ mov ax,0600h
 mov bh,07h
 xor cx,cx
 mov dx,184Fh
 int 10h <text}
end;
{nahra zo suboru .scr}
procedure LoadScr;
var segN,ofsN, segB,ofsB:word;
    fHandle, pos, ofsY, tretina:word;
    buf:array[1..32] of byte;
    lop1,lop2,  colB, colF:byte;
label _riadky, _ofsY, _err, _encode, _nextR, _ciara, _tretina, _atr, _r, _r2,
      noBright, _B, _F, _stvorcek;
begin
 cls;
 segN:=seg(fName); ofsN:=ofs(fName)+1;
 segB:=seg(buf); ofsB:=ofs(buf);
        asm
         push   ds
        mov     ax,0A000h
        mov     es,ax
        mov     di,19
        mov     cx,200
        mov     al,45                   {kreslim zvislu ciaru x=19}
_ciara: stosb
        add     di,319
        loop    _ciara

        mov     ax, segN
        mov     ds,ax
        mov     ax,3D00h                {Open file}
        mov     dx, ofsN
        xor     cl,cl
        int     21h
        jc      _err  {<- ak by subor neexistoval, nemoze byt!}
        mov     fHandle,ax              {handle}
{idem citat}
        mov     ax, 0A000h
        mov     es, ax                  {screen = ES:DI}
        mov     ax, segB
        mov     ds, ax                  {DS:SI= buf}
        mov     bx, fHandle
        mov     TRETINA, 0
_tretina: mov   ofsY,0
_ofsY:  mov     pos,20                  {budem vykreslovat od x:=20}
_riadky:mov     cx, 32
        mov     DX, ofsB
        mov     ah, 3Fh
        int     21h                     {nacital som dalsi riadok do BUF}
{LODSB DS:SI=>al STOSB al=>ES:DI}
        mov     si, dx                  {buf offs}
        mov     di, POS
        add     di, OFSY                {scr =ES:DI}
        add     di, TRETINA
        mov     lop2, 32
_nextR: LODSB                           {DS:SI = buf}
        mov     lop1, 8
_encode:mov     dl, al                  {dekodujem kazdy bajt na bity}
        and     dl, 128                 {ak bit7 =1 tak pixel}
        mov     es:[di], dl             {a hadzem to na obrazovku}
        inc     di
        shl     al, 1
        dec     lop1
        cmp     lop1,0
        ja      _encode                 {1b=8 byte}
        dec     lop2
        cmp     lop2,0
        ja      _nextR                  {bufer=32 byte}
{readol som 32B, a po 1b som hadzal na obr.(0 or 1) = 256 pixelov }
        add     pos, 8* 320
        cmp     pos, 8 * 8* 320  {pos- }  {<-24}
        jb      _riadky
        add     ofsY,  320
        cmp     ofsY, 8 * 320 {offsY je max 8 riadkov}
        jb      _ofsY
        add     TRETINA, 320 * 8*8      { do ktorej tretiny kreslim}
        cmp     TRETINA, 320 * 8*8*2
        jbe     _tretina
{najprv kreslim 24 riadkov , posunutych od seba o 8Ypix, offs0.}
{potom to iste ale offsY=0..7}
{pozicia zaciatku riadku kde kreslim je ofs+pos}
(*  teraz je naresleny obrazok cierno-modry. idem vyplnat stvorceky farbami*)
        mov     OFSy, 24
        mov     ax, 0A000h
        mov     ES, ax
        mov     ax, segB                {tieto 3\/ su pre citanie}
        mov     DS, ax
        mov     DX, ofsB
        mov     BX,20                   {pozicia prveho pixelu}
_atr:   mov     CX, 32
        mov     ah, 3Fh
         push   BX
        mov     BX, Fhandle
        int     21h                     {nacitany 1 riadok s atributmy}
         pop    BX
        mov     si, ofsB
_r2:    LODSB
{ rozdelim attr do colB a F}
        mov     colB, al
        and     colB, 7                 {posledne 3b - background}
        mov     colF, al
        shr     colF, 3                 {3-5 bit - foreground}
        and     colF, 7
        {teraz bright}
        mov     lop2,8  {<toto tu je pre lop o 15 r. nizsie}
        and     al, 64                  {01000000 , bright}
        cmp     al, 0
        je      noBright
        add     colB, 8                 {pridam bright}
        add     colF, 8
        {teraz vyfarbit stvorcek}
noBright:mov   lop1, 8
_stvorcek:mov    al, ES:[BX]              {nacitam z obr}
        cmp    al,0
        ja     _B
        mov    al, colF                 {pix je 0 = pozadie}
        jmp    _F
_B:     mov    al, colB
_F:     mov    ES:[BX], al              {dam na obrazovku}
        inc    BX
        dec    lop1
        cmp    lop1,0
        ja     _stvorcek
        add    BX, 320 - 8
        dec    lop2
        cmp    lop2,0
        ja     noBright

        sub    BX, 8*320 -8

        loop    _r2                     {dalsi riadok}
        add     BX, (320-256) + 320*7
        dec     ofsY
        cmp     ofsY,0
        ja      _atr

        mov     ah,3Eh                  {close file}
        mov     bx,fHandle
        int     21h
_err:    pop    ds                      {nevyuzite err}
         end;

end;

{skip,count by mali byt spravne! ; do listu da mena fajlov ^ dirov}
procedure F2list(skip,count:word; directory:boolean{^file}; where:byte);
var cnt,xx:word;
begin
 if not directory then begin  {filez}
   findFirst('*.*'{+ext}, 55,fInfo);
 if skip<>0 then
  for cnt:=1 to skip+1 do
   repeat FindNext(fInfo); until (fInfo.size=ScrSize) and
      ((fInfo.attr and 24)=0);{preskakujem DIRy&VOL}
  for cnt:=1 to count do begin
   while ( (fInfo.size<>ScrSize) or ((fInfo.attr and 24)>0) )
      and (DosError=0) do findNext(fInfo);
   if DosError<>0 then begin xx:=cnt; cnt:=count; end;
   Flist[where+cnt]:=fInfo.name; Fdir[where+cnt]:=false; FindNext(fInfo); end;
  for cnt:=where+xx to fOnScr do Flist[cnt]:=''; {vyplnim zvysok }
 end
 else begin         {Dirs}
  findFirst('*.*',55,fInfo);
  for cnt:=1 to skip do
   repeat FindNext(fInfo);             {vyberem iba DIRy }
    until ((fInfo.attr and 16)>0);
  for cnt:=1 to count do begin
   while ((fInfo.attr and 16)=0) do findNext(fInfo); {preskakujem filesy}
   Flist[where+cnt]:=fInfo.name; Fdir[where+cnt]:=true; FindNext(fInfo); end;
  for cnt:=where+cnt+1 to fOnScr do Flist[cnt]:=''; {vyplnim zvysok }
   if Flist[1]='.' then Flist[1]:='\'; {'.' je nanic, dam tam GOTO root}
 end;
end;
{da do dir.files a dir.dirs pocet DIR&files v aktivnom adresari}
procedure checkDir;
begin
 GetDir(0,curPath);
 Dir.Files:=0; Dir.Dirs:=0;
 FindFirst('*.*',55{110111 - dir&files},fInfo);
 while DosError = 0 do begin
  if ((fInfo.attr and 24{100111})=0) and
      {(copy( fInfo.name , length(fInfo.name)-2,3) =ext) {*.scr}
       (fInfo.size=scrSize)
               then inc(dir.files);
  if ((fInfo.attr and 16{010000})>0) then inc(dir.dirs);
 FindNext(fInfo);
 end;
end;

procedure gotoxy(x,y:byte);assembler;
asm
 mov    ah,2
 xor    bh,bh
 mov    dh,y
 mov    dl,x
 int    10h
end;

procedure reMake;
var i,j:word;
begin
  if (dir.dirs > scr*fOnScr) then begin   {pridaj na zaciatok diry}
     i:=dir.dirs - scr * fOnScr; if i>FonScr then i:=FonScr;
     F2list( scr*fOnScr, i, true, 0);
     end else i:=0;
{pridaj dalej Filezy}
  if ( dir.dirs < FonScr*(scr+1) ) and ( 0 < dir.files ) then begin
     if scr*fOnScr > dir.dirs then j:=  scr*fOnScr - dir.dirs
        else j:=0;
     F2list( j , fOnScr-i, false, i);
     end;
  cls;
  j:=1;
  while (Flist[j]<>'') and (j<=fOnScr) do inc(j);
  dec(j);
  gotoxy(0,0);
  for i:=1 to j do if Fdir[i] {then writeln('[',Flist[i],']')
                               else writeln( Flist[i] ); <TXT}
                               then OutTextXY256(0,i-1,'['+Flist[i]+']',col)
                               else OutTextXY256(0,i-1, Flist[i] ,col+1);
  {gotoxy(40,0); write(curPath);}
  OutTextXY256(cursorXPos+2, 0, curPath,col);
  OutTextXY256(cursorXpos, PosOnScr-1,'<',2);
  if (scr+1)*fOnScr < (dir.files +dir.dirs)
     then OutTextXY256(5, FonScr+1,chr(25),2);
end;

procedure kurzor(dopredu:boolean);
begin
 {gotoxy(cursorXpos, PosOnScr-1); write(' ');}
  OutTextXY256(cursorXpos, PosOnScr-1,' ',1);
 if dopredu then begin
  inc(PosOnScr);
  if PosOnScr = fOnScr+1 then begin PosOnScr:=1; inc(scr); reMake; end;
 end else
 begin
  dec(PosOnScr);
  if PosOnScr = 0 then begin PosOnScr:=fOnScr; dec(scr); reMake; end;
 end;
 {gotoxy(cursorXpos, PosOnScr-1); write('<');}
  OutTextXY256(cursorXpos, PosOnScr-1,'<',2);
end;

procedure getkey;assembler;
label _exit_key, _nie_hore;
asm
 xor ax,ax
 int 16h
 mov key,al
 cmp al,0
 ja  _exit_key
 mov key,ah
{uprava, ak 'H' (hore), premen na 201}
 cmp ah, 72
 jne _nie_hore
 mov key, 201
 jmp _exit_key
{uprava, ak 'P' (dole), premen na 202}
_nie_hore:
 cmp ah, 80
 jne _exit_key
 mov key,202
 jmp _exit_key

_exit_key:
end;

procedure chdir;assembler;
asm
  push DS
 mov AH, 3Bh
 mov BX, seg PATH
 mov DS, bx
 mov DX, offset PATH
 inc DX
 int 21h
  pop DS
end;

procedure chDsk(drive:byte);assembler;
asm
 mov    ah,0Eh
 mov    dl,DRIVE
 int    21h
end;

begin
 if (ParamCount<>0) then begin
  assign(f,ParamStr(1)); {$I-} reset(f); {$I+}
  if IOresult=0 then begin
   close(f);
   asm mov ax,13h; int 10h; end;
   set_palette;
   Fname:=paramStr(1)+chr(0);   LoadScr;
   repeat getkey; until key<>0;
   if (key=115) or (key=83) then save_bmp;
   if key<>13 then begin
     asm mov ax,3; int 10h; end;
     writeln(greetz); writeln(boutme); exit; end;
  end else begin {noFile}
    writeln(greetz); writeln(boutme);
    writeln('File ',paramStr(1),' does not exist!');
    exit;
  end;
 end else begin
  asm mov ax,13h; int 10h; end;
  set_palette;
 end;
 checkDir; reMake;
 scr:=0; posOnScr:=0; kurzor(true);
 repeat
  repeat
   getkey;
   if key in [ord('a')..ord('z')]then dec(key, ord('a')-ord('A') );
  until key in [27,201,202,13,ord('A')..ord('Z')];

  if ( key=201 ) then {hore}
     if (Scr>0) or (PosOnScr>1) then kurzor(false);
  if ( key=202 ) then {dole}
     if PosOnScr+ scr*fOnScr < (dir.files +dir.dirs) then kurzor(true);
  if key=13 then
     if Fdir[posOnScr] then begin {change dir}
{      exec('.','cd '+Flist[posOnScr]);}
       path:= curPath;  {vyrobim path, pridam na koniec \ + dir}
       if path[ord(path[0])]<>'\' then
          begin path[0]:=succ(path[0]); path[ord(path[0])]:='\'; end;
       path:= path +Flist[posOnScr] +chr(0) ;
       if Flist[posOnScr]='\' then path[4]:=chr(0);{odseknem path}
       chdir;
      PosOnScr:=0; scr:=0; checkDir; reMake; kurzor(true);
     end else
     begin {view}
      fName:=fList[posOnScr]+chr(0); LoadScr;
      repeat getkey; until key<>0;
      if (key=115) or (key=83) then save_bmp;
      reMake;
     end;
  if key in [ord('A')..ord('Z')] then begin
     chDsk( key-ord('A') );
     PosOnScr:=0; scr:=0; checkDir; reMake; kurzor(true);
     end;
 until key = 27;
 asm mov ax,3; int 10h; end;
 writeln(greetz);
 writeln(boutme);
end.