unit design;

interface
uses crt,windos;

procedure writexy(x,y : integer;s : string);
procedure frame(rt: byte;startx,starty,dx,dy : integer);
function select_file(dir : string;mask : pchar;mtext,comment: string) : string;
function wrhexb(b : byte) : string;
function wrhexw(w : word) : string;
procedure save_screen;
procedure restore_screen;
procedure window1(x,y,dx,dy : integer; s : string;rcol,bcol : byte);
procedure cursor_on;
procedure cursor_off;

implementation

var filenames : array[1..512] of string[12];
const      Screen_Cur   : byte = 1;

procedure writexy(x,y : integer;s : string);
begin;
 gotoxy(x,y);
 write(s);
end;

procedure save_screen;
var Screen : array[1..4,1..8000] of byte absolute $b800:0000;
begin;
  if Screen_Cur <= 4 then begin;
    inc(Screen_Cur);
    move(screen[1],screen[Screen_Cur],8000);
  end;
end;

procedure restore_screen;
var Screen : array[1..4,1..8000] of byte absolute $b800:0000;
begin;
  if Screen_Cur >= 2 then begin;
    move(screen[Screen_Cur],screen[1],8000);
    dec(Screen_Cur);
  end;
end;

procedure frame(rt: byte;startx,starty,dx,dy : integer);
const frames : array[1..2,1..6] of char =
 (('Ú','¿','Ù','À','Ä','³'),
  ('É','»','¼','È','Í','º'));
var lx,ly : integer;
    s : string;
begin;
  { top row }
  s := frames[rt,1];
  for lx := 1 to dx-2 do s := s + frames[rt,5];
  s := s + frames[rt,2];
  gotoxy(startx,starty);
  write(s);
  { middle rows }
  for ly := 1 to dy-2 do begin;
    s := frames[rt,6];
    for lx := 1 to dx-2 do s := s + ' ';
    s := s + frames[rt,6];
    gotoxy(startx,starty+ly);
    write(s);
  end;
  { bottom row }
  s := frames[rt,4];
  for lx := 1 to dx-2 do s := s + frames[rt,5];
  s := s + frames[rt,3];
  gotoxy(startx,starty+dy-1);
  write(s);
end;

Procedure Window1(x,y,dx,dy : integer; s : string;rcol,bcol : byte);
var tleng : byte;
    deltx,tstartpos : byte;
begin;
  tleng := length(s);
  tstartpos := x + ((dx-Tleng) SHR 1);
  textcolor(rcol);
  textbackground(bcol);
  frame(1,x,y,dx,dy);
  writexy(tstartpos,y,s);
end;

procedure sort_filenames(start,end1 : integer);
{
 Quick-Sort should be built in here for larger directories !
}
var help : string;
    l1,l2 : integer;
begin;
  for l1 := start to end1-1 do begin;
    for l2 := start to end1-1 do begin;
      if filenames[l2] > filenames[l2+1] then begin;
        help := filenames[l2];
        filenames[l2] := filenames[l2+1];
        filenames[l2+1] := help;
      end;
    end;
  end;
end;

function select_file(dir : string;mask : pchar;mtext,comment: string) : string;
const  row : byte = 1;
  column : byte = 0;
  Start_fndisp : word = 0;
var
  DirInfo: TSearchRec;
  count : integer;
  Nullpos : byte;
var li,lj : integer;
    inp : char;
    retval : string;
    box_found : boolean;
    select : byte;
    changed : boolean;
    End_fndisp : word;
begin
  {$I+}
  for li := 1 to 512 do filenames[li] := ' - - -';
  count := 1;
  FindFirst(mask, faArchive, DirInfo);
  while DosError = 0 do
  begin
    filenames[count] := (DirInfo.Name);
    Nullpos := pos(#0,filenames[count]);
    if Nullpos <> 0 then
      filenames[count] := copy(filenames[count],0,Nullpos-1);
    inc(count);
    FindNext(DirInfo);
  end;
  {$I-}

  sort_filenames(1,count-1);
  save_screen;
  Window1(5,4,72,16,comment,black,7);
  textcolor(1);
  writexy(21,5,'         Please select file');
  textcolor(black);
  inp := #255;
  changed := true;
  repeat
    textcolor(black);
    if changed then begin;
      changed := false;
      for lj := 0 to 4 do begin;
        for li := 1 to 12 do begin;
          writexy(7+lj*14,5+li,'            ');
          writexy(7+lj*14,5+li,filenames[lj*12+li+Start_fndisp]);
        end;
      end;
      textcolor(14);
      writexy(7+Column*14,5+Row,filenames[Column*12+Row+Start_fndisp]);
    end;
    if keypressed then inp := readkey;
    if ord(inp) = 0 then inp := readkey;
    case ord(inp) of
      32,
      13: begin;
            inp := #13;
            changed := true;
            if (pos('- - -',filenames[Column*12+Row+Start_fndisp]) = 0) then
              retval := filenames[Column*12+Row+Start_fndisp]
            else
              retval := 'xxxx';
          end;
      27: begin;
            inp := #27;
            changed := true;
            retval := 'xxxx';
          end;
      71: begin; { Home }
            inp := #255;
            Row  := 1;
            Column := 0;
            changed := true;
          end;
      72: begin; { Arrow up }
            inp := #255;
            changed := true;
            if not ((Row = 1) and (Column = 0)) then
              dec(Row);
            if Row = 0 then begin;
              dec(Column);
              Row := 12;
            end;
          end;
      73: begin; { Page UP }
            if Start_fndisp >= 12 then
              dec(Start_fndisp,12)
            else begin;
              Start_fndisp := 0;
              Row := 1;
            end;
            inp := #255;
            changed := true;
          end;
      81: begin; { Page Down }
            if ((Column+1)*12+Start_fndisp < count) and
            (Start_fndisp < 500) then
              inc(Start_fndisp,12)
            else
              Start_fndisp := count-11;
            inp := #255;
            changed := true;
          end;
      75: begin; { Arrow left }
            inp := #255;
            changed := true;
            if Column = 0 then begin;
              if Start_fndisp >= 12 then dec(Start_fndisp,12);
            end else begin;
              if Column > 0 then dec(Column);
            end;
          end;
      77: begin; { Arrow right }
            inp := #255;
            changed := true;
            if Column = 4 then begin;
              if ((Column+1)*12+Start_fndisp < count) and
              (Start_fndisp < 500) then inc(Start_fndisp,12);
            end else begin;
            if (Column < 4) and
              (Row+(Column+1)*12+Start_fndisp < count) then
                inc(Column);
            end;
          end;
      79: begin; { End }
            inp := #255;
            changed := true;
            Column := (count-Start_fndisp-12) div 12;
            Row := (count-Start_fndisp) - Column*12 -1;
          end;
      80: begin; { Arrow down }
            inp := #255;
            changed := true;
            if ((Row = 12) and (Column = 4)) then begin;
              if (Start_fndisp+Row+Column*12 < count-1) then begin;
                inc(Start_fndisp,1);
              end;
            end else begin;
              if (Start_fndisp+Row+Column*12 < count-1) then
                inc(Row);
             end;
            if Row > 12 then begin;
              inc(Column);
              Row := 1;
            end;
          end;
      82 : begin;
            changed := true;
             save_screen;
             textcolor(black);
             frame(2,16,9,45,5);
             writexy(20,10,' Enter filename ('+mtext+')');
             writexy(20,12,'Name: ');
             readln(retval);
             if retval = '' then retval := 'xxxx';
             restore_screen;
           end;
     end;
  until (inp = #13) or (inp = #27) or (inp = #32)
     or (inp = #82);
  restore_screen;
  textbackground(black);
  textcolor(7);
  select_file := retval;
end;

function wrhexb(b : byte) : string;
const hexcar : array[0..15] of char =
 ('0','1','2','3','4','5','6','7','8','9','A','B','C','D','E','F');
begin;
  wrhexb := hexcar[(b shr 4)] + hexcar[(b AND $0F)];
end;

function wrhexw(w : word) : string;
begin;
  wrhexw := '$'+wrhexb(hi(w))+wrhexb(lo(w));
end;

procedure cursor_off; assembler;
asm
  xor ax,ax
  mov ah,01h
  mov cx,2020h
  int 10h
end;

procedure cursor_on; assembler;
asm
 mov ah,01h
 mov cx,0607h
 int 10h
end;



begin;
end.
