[Back to MENU SWAG index] [Back to Main SWAG index] [Original]

    unit iface; { INTERFACE, for creating TEXT interfaces. }

    INTERFACE

    uses crt,dos,link,txtwin;
         { NOTE : Link in POINTERS.SWG
                  txtwin in TEXTWNDW.SWG }

    const
      kbnull=#0;
      kbesc=#27;
      kbpgup=#73;
      kbpgdown=#81;
      kbhome=#71;
      kbend=#79;
      kbleft=#75;
      kbright=#77;
      kbup=#72;
      kbdown=#80;
      kbf1=#59;
      kbenter=#13;
      kbdel=#83;
      kbbackspace=#8;
      colseg:word=$b800;
    type
      tchok=set of char;

    function  getkey(const s:string;const chok:tchok):char;
    function  getstring(col,x,y,max:byte;legalch:tchok):string;
    procedure xorbar(x1,x2,y:word;c:byte);
    function  selectbar(xp,yp,x2,num,col,ystart:byte;abort:boolean):byte;
    function  selectfile(wildcard:string;x,y,col:byte;abort:boolean):string;

    IMPLEMENTATION

    var
      dirlink:plink;
      dirinfo:searchrec;

    function getkey(const s:string;const chok:tchok):char;
    var ch:char;
    begin
      write(s);
      repeat
        ch:=readkey;
      until(ch in chok);
      getkey:=ch;
    end;

    function getstring(col,x,y,max:byte;legalch:tchok):string;
    var
      ch:char;
      input,temp:string;
      oldcol,i,xpos,ypos:byte;
      hoejre,venstre:string[23];
    begin
      getstring:='';
      gotoxy(x,y);
      oldcol:=textattr;
      textattr:=col;
      ch:=#0;
      input:=''; hoejre:=''; venstre:='';
      xpos:=x; ypos:=y;
      repeat
        gotoxy(xpos,ypos);
        venstre:=copy(input,1,xpos-13);
        hoejre:=copy(input,xpos-12,36-xpos);
        repeat
          ch:=readkey;
        until(ch in legalch);
        if(ch=kbnull)then
        begin
          ch:=readkey;
          case ch of
            kbhome:xpos:=x;
            kbleft:if(xpos>x)then dec(xpos);
            kbright:if(xpos<ord(input[0])+x)then inc(xpos);
            kbdel:begin
    {                hoejre:=copy(hoejre,2,length(hoejre)-1);
                    input:=venstre+hoejre;}
                    delete(input,(xpos-x)+1,1);
                  end;
            kbend:begin
                    xpos:=ord(input[0])+x;
                  end;
          end;
        end else if(ord(input[0])<max)and(ch<>kbbackspace)and
                   (ch<>kbenter)then
        begin
    {      input:=venstre+ch+hoejre;     (* inds�t karakter *)}
          temp:=copy(input,1,(xpos-x));
          temp:=temp+ch;
          temp:=temp+copy(input,(xpos-x)+1,length(input));
          input:=temp;
          write(ch);
          inc(xpos);
        end;
        if(ch=kbbackspace)then
        begin
          if(ord(input[0])>0)then
          begin
            if(xpos>x)then dec(xpos);
            delete(venstre,(xpos-x)+1,1);
            gotoxy(xpos,ypos);
            write(' ');
            input:=venstre+hoejre;
          end;
        end;
        gotoxy(x,y); clreol; write(input);
      until(ch=kbenter)or(ch=kbesc);
      if(ch=kbesc)then
      begin
        getstring:='';
        exit;
      end;
      textattr:=oldcol;
      getstring:=input;
    end;

    procedure xorbar(x1,x2,y:word;c:byte); assembler;
    asm
      dec [y]
      push colseg
      pop es
      mov di,[y]
      mov bx,di
      shl di,6
      shl bx,4
      add di,bx
      add di,[x1]
      shl di,1
      dec di
      mov cx,[x2]
      sub cx,[x1]
      inc cx
      @@loop:
        mov al,[c]
        xor es:[di],al
        add di,2
        dec cx
        jnz @@loop
    end;

    function selectbar(xp,yp,x2,num,col,ystart:byte;abort:boolean):byte;
    var
      ch:char;
      y,oy:byte;
      done:boolean;
    begin
      selectbar:=0;
      oy:=255; y:=ystart;
      if(y>num)then exit;
      done:=false;
      repeat
        if(y<>oy)then
        begin
          if(oy<>255)then xorbar(xp,x2,pred(oy+yp),col);
          xorbar(xp,x2,pred(y+yp),col);
          oy:=y;
        end;
        ch:=readkey;
        if(ch=kbnull)then
        begin
          ch:=readkey;
          case ch of
            kbleft,kbup:if(y>1)then dec(y);
            kbright,kbdown:if(y<num)then inc(y);
          end;
        end else
        case ch of
          kbenter:begin selectbar:=succ(y-yp); done:=true; end;
          kbesc:begin if(abort)then done:=true; end;
        end;
      until(done);
    end;

    function selectfile(wildcard:string;x,y,col:byte;abort:boolean):string;
    var
      wx1,wy1,wx2,wy2:byte; { Window dimensions. }
    begin
      inilink(dirlink);
      selectfile:='';
      findfirst(wildcard,archive,dirinfo);
      if(dirinfo.name='')then exit;
      while(doserror=0)do
      begin
        addlink2(dirlink,dirinfo.name);
        findnext(dirinfo);
      end;
      writeln(numlinks(dirlink));
      killink(dirlink);
    end;

    end.

[Back to MENU SWAG index] [Back to Main SWAG index] [Original]