/* 
   terminal.sim               V0.1  (Cim 3.29 / Win32)  

   Simula class for managing console output & input

   ported by Petr Novak 1999
*/
/* This interface was taken from PC-Simula trying not to change it too much */

/*
   Some new functionality have been added: **********************************

      boolean silentDeedit;
      text procedure lastError;
      short integer procedure maxx; 
      short integer procedure maxy; 
      text procedure edittext(t, w); name t; short integer w; text t;
      integer procedure editint(t, w); text t; short integer w;
      long real procedure editreal(t, w); text t; short integer w;
      integer procedure editfrac(t, w); text t; short integer w;
      ref(Attributes) procedure attributeCode (a); short integer a;
      procedure showCursor;
      procedure hideCursor;
      procedure sleep (ms); integer ms;
      procedure printAll (enable); boolean enable;
      boolean procedure isSet (character attribute, integer bit);

   These methods are public (why not):
      short integer procedure wAND(i,j); short integer i,j; ;
      short integer procedure wOR(i,j); short integer i,j; ;
      short integer procedure wSHL(i,j); short integer i,j; ;
      short integer procedure wSHR(i,j); short integer i,j; ;

   New functionality in "keyboard.ins":

      procedure flushInput;;
      procedure listenControllKeys (enable); boolean enable;
      procedure listenReleaseKeys (enable); boolean enable;
      procedure setInsert (on); boolean on;
      procedure setMouse (on); boolean on;
      boolean procedure wasMouse;

*****************************************************************************/

class TERMINAL;
Hidden Protected
                   MAXLIN,MAXPOS,EDTBUF,
                   FIELD,KEYIN,EEDTTXT,
                   EHEIGHT,EWIDTH,CURLIN,CURPOS,EUPDPOS,
                   ENEWLIN,
                   EOUTCHR,EOUTTXT, EGETTXT,ECLOSE, EOPEN,
                   EERASELINE, EERASEPAGE
                   ;
begin


#include keyboard.ins

      short integer MAXLIN;
      short integer MAXPOS;
      text OsIdent,EDTBUF;
      boolean silentDeedit;

      short integer procedure maxx; maxx := MAXPOS; 
      short integer procedure maxy; maxy := MAXLIN; 

      boolean procedure open(Hgt,Wdt); short integer Hgt,Wdt;
      begin
%            OsIdent:-Copy(OSID(Blanks(80)).Strip);
            Open := EOPEN(Hgt,Wdt);
            MAXLIN:=EHEIGHT; MAXPOS:=EWIDTH;
            MessageLine  := MAXLIN; 
            silentDeedit := false;
            EDTBUF:-Blanks(MAXPOS);
            if CurAttr  == none then CurAttr:-Monochrome;
            if EditAttr == none then EditAttr:-Curattr.Invers;
            if MsgAttr  == none then MsgAttr:-EditAttr;
            ErasePage; LastKey:-New KeyPkt;
            /* you really need ifchar here unles semouse would not initiate
               properly: */
            ifchar; setMouse (false); 
            flushInput;
      end;

      procedure close;
      begin ECLOSE; LastKey:-none end;

      procedure terminateProgram;
      begin close; terminate_program; end;

      short integer procedure pos;  Pos:= CURPOS+1;
      short integer procedure line; Line:=CURLIN+1;
      procedure setpos(L,P); short integer L,P; EUPDPOS(L-1,P-1);

      procedure eraseLine; EeraseLine (CurAttr.Encoding);

      procedure erasePage; EerasePage (CurAttr.Encoding);

      procedure outchar(c); character c; EOUTCHR(c,CurAttr.Encoding);
      procedure outtext(t); text t; EOUTTXT(t, t.length, CurAttr.Encoding);
      procedure outimage; ENEWLIN(CurAttr.Encoding);
      procedure outline(t); text t; begin outtext (t); outimage; end;

      procedure outint(i,w); integer i,w;
      begin text f; integer x; f:-FIELD(w); f.Putint(i);
            if w <= 0 then !*** Strip off leading blanks ***;
            begin f.Setpos(1); while f.Getchar=' ' do x:=x+1;
                  f:-f.Sub(x+1,if w=0 then 12-x else -w-x);
            end; Outtext(f);
      end;

      procedure outfix(r,n,w); long real r; short integer n,w;
      begin text f; integer x; f:-FIELD(w); f.Putfix(r,n);
            if w <= 0 then !*** Strip off leading blanks ***;
            begin f.Setpos(1); while f.Getchar=' ' do x:=x+1;
                  f:-f.Sub(x+1,if w=0 then 12-x else -w-x);
            end; Outtext(f);
      end;

      procedure outreal(r,n,w); long real r; short integer n,w;
      begin text f; integer x; f:-FIELD(w); f.Putreal(r,n);
            if w <= 0 then !*** Strip off leading blanks ***;
            begin f.Setpos(1); while f.Getchar=' ' do x:=x+1;
                  f:-f.Sub(x+1,if w=0 then 12-x else -w-x);
            end; Outtext(f);
      end;

      procedure outfrac(i,n,w); integer i,n,w;
      begin text f; integer x; f:-FIELD(w); f.Putfrac(i,n);
            if w <= 0 then !*** Strip off leading blanks ***;
            begin f.Setpos(1); while f.Getchar=' ' do x:=x+1;
                  f:-f.Sub(x+1,if w=0 then 12-x else -w-x);
            end; Outtext(f);
      end;

      text procedure FIELD(w); short integer w;
      begin if w=0 then w:=12 else if w<0 then w:= -w;
            if w>EDTBUF.Length then w:=EDTBUF.Length;
            FIELD:-EDTBUF.Sub(1,w);
      end FIELD;

      text procedure screen(Lin); short integer Lin;
      begin text t; Screen:-t:-Blanks(MAXPOS);
          EGETTXT(CURLIN,0,MAXPOS,t); EUPDPOS(CURLIN,0);
      end;

      text procedure intext(w); short integer w;
      begin text t;
            t :- Blanks(w);
            EGETTXT(CURLIN,CURPOS,w,t);
            intext :- edittext (t, w);
      end;

      /* function works like intext, but begins editting with t */
      text procedure edittext(t, w); name t; short integer w; text t;
      begin
            text Fld;
            w := min(w,MAXPOS-CURPOS);
            if (t.length > w) then error ("Terminal: editing of too long text");
            edittext :- Fld :- Blanks(w);
            Fld := t;
            EEDTTXT(Fld, w, EditAttr.Encoding,CurAttr.Encoding,LastKey);
      end;

      integer procedure inint(w); short integer w;
      begin
            text t;
            t :- Blanks(w);
            EGETTXT(CURLIN,CURPOS,w,t);
            inint := editint (t, w);
      end;

      integer procedure editint(t, w); text t; short integer w;
      begin short integer cl,cp;
            external C procedure getint is
            integer procedure getint(t); text t; ;
            cl:=CURLIN; cp:=CURPOS;
       REP: t:- edittext(t, w); editint:=GetInt(t.strip);
            if (lastError =/= notext and then not silentDeedit) then
            begin Message(" *** Illegal integer number *** ");
                  EUPDPOS(cl,cp); goto REP;
            end;
      end;

      long real procedure inreal(w); short integer w;
      begin
            text t;
            t :- Blanks(w);
            EGETTXT(CURLIN,CURPOS,w,t);
            inreal := editreal (t, w);
      end;

      long real procedure editreal(t, w); text t; short integer w;
      begin short integer cl,cp;
            external C procedure getreal is
            long real procedure getreal(t); text t; ;
            cl:=CURLIN; cp:=CURPOS;
       REP: t:- edittext(t, w); editReal:=GetReal(t.strip);
            if (lastError =/= notext and then not silentDeedit) then
            begin Message(" *** Illegal real number *** ");
                  EUPDPOS(cl,cp); goto REP;
            end;
      end;
      
      integer procedure infrac(w); short integer w;
      begin
            text t;
            t :- Blanks(w);
            EGETTXT(CURLIN,CURPOS,w,t);
            infrac := editfrac (t, w);
      end;

      integer procedure editfrac(t, w); text t; short integer w;
      begin short integer cl,cp;
            external C procedure getfrac is
            integer procedure getfrac(t); text t; ;
            cl:=CURLIN; cp:=CURPOS;
       REP: t:- edittext(t, w); editFrac:=GetFrac(t.strip);
            if (lastError =/= notext and then not silentDeedit) then
            begin
              Message(" *** Illegal integer number *** ");
              EUPDPOS(cl,cp);
              goto REP;
            end;
      end;

      ref(Attributes) CurAttr;   !** Current Output  Attributes  **;
      ref(Attributes) EditAttr;  !** Current Editing Attributes  **;
      ref(Attributes) MsgAttr;   !** Current Message Attributes  **;

      integer Black        =  0; !**  Black                   **;
      integer Blue         =  1; !**  Blue                    **;
      integer Green        =  2; !**  Green                   **;
      integer Cyan         =  3; !**  Cyan                    **;
      integer Red          =  4; !**  Red                     **;
      integer Magenta      =  5; !**  Magenta                 **;
      integer Brown        =  6; !**  Brown                   **;
      integer White        =  7; !**  White                   **;
      integer Gray         =  8; !**  Gray          (Black)   **;
      integer LightBlue    =  9; !**  Light Blue    (Blue)    **;
      integer LightGreen   = 10; !**  Light Green   (Green)   **;
      integer LightCyan    = 11; !**  Light Cyan    (Cyan)    **;
      integer LightRed     = 12; !**  Light Red     (Red)     **;
      integer LightMagenta = 13; !**  Light Magenta (Magenta) **;
      integer Yellow       = 14; !**  Yellow        (Brown)   **;
      integer BrightWhite  = 15; !**  Bright White  (White)   **;

      Class Attributes(BLNK,FGR,BGR); short integer BLNK,FGR,BGR;
      Hidden protected BLNK,FGR,BGR,ATR;
      begin integer ATR;

            integer procedure encoding; Encoding:=ATR;

            ref(Attributes) procedure bold;
            Bold:-new Attributes(BLNK,wOR(FGR,8),BGR);

            ref(Attributes) procedure lowIntensity;
            LowIntensity:-new Attributes(BLNK,BGR,wAND(FGR,7));

            ref(Attributes) procedure invers;
            Invers:-attributeCode(wSHL(FGR,4) + BGR + BLNK * 8);

            /* this only makes background highliting !!!!!!!!!!!!!!!! */
            ref(Attributes) procedure blink;
            Blink:-new Attributes(1,FGR,BGR);

            ref(Attributes) procedure withBackground(Bgr); short integer Bgr;
            WithBackground:-new Attributes(BLNK,FGR,Bgr);

            ref(Attributes) procedure withForeground(Fgr); short integer Fgr;
            WithForeground:-new Attributes(BLNK,Fgr,BGR);

            ATR:=(wOR(wOR(wSHL(BLNK,7),wSHL(wAND(BGR,7),4)),wAND(FGR,15)));
      end;

      ref(Attributes) procedure colours(Fgr,Bgr); short integer Fgr,Bgr;
      Colours:-new Attributes(0,Fgr,Bgr);

      ref(Attributes) procedure monochrome;
      Monochrome:-new Attributes(0,White,Black);

      ref(Attributes) procedure concealed;
      Concealed:-new Attributes(0,Black,Black);

      ref(Attributes) procedure attributeCode (a); short integer a;
      begin
        attributecode :- new Attributes (
          wSHR (wAND (a, 128), 7), wAND (a, 15), wAND (wSHR (a, 4), 7));
      end;

      short integer MessageLine;

      procedure message(ms); text ms;
      begin ref(Attributes) a; short integer L,P;
            a:-CurAttr; CurAttr:-MsgAttr; L:=Line; P:=Pos;
            Setpos(MessageLine,1); EraseLine;
            Setpos(MessageLine,(EWIDTH-ms.length)//2-1);
            Outtext(ms); Inchar; CurAttr:-a;
            Setpos(MessageLine,1); EraseLine; Setpos(L,P);
      end;


      short integer procedure setScreenMode(code); short integer code;
      begin !not implemented; !SetScreenMode:=SCMODE(code); end;

/********************  declaration of external C procedures ****************/

    external C procedure wAND is
    short integer procedure wAND(i,j); short integer i,j; ;

    external C procedure wOR is
    short integer procedure wOR(i,j); short integer i,j; ;

    external C procedure wSHL is
    short integer procedure wSHL(i,j); short integer i,j; ;

    external C procedure wSHR is
    short integer procedure wSHR(i,j); short integer i,j; ;

    external C procedure isSet is
    boolean procedure isSet (attribute, bit); character attribute; integer bit;;

    external C procedure EHEIGHT is
    short integer procedure EHEIGHT; ;

    external C procedure EWIDTH is
    short integer procedure EWIDTH; ;

    external C procedure CURLIN="ECURLIN" is
    short integer procedure CURLIN; ;

    external C procedure CURPOS="ECURPOS" is
    short integer procedure CURPOS; ;

    external C procedure EUPDPOS is
    procedure EUPDPOS(Lin,Pos); short integer Lin,Pos; ;

    external C procedure EerasePage is
    procedure EerasePage (c); integer c; ;

    external C procedure EeraseLine is
    procedure EeraseLine (c); integer c; ;

    external C procedure EOUTCHR is
    procedure EOUTCHR(c,a); character c; integer a; ;

    external C procedure ENEWLIN is
    procedure ENEWLIN(a); integer a; ;

    /*  unfortunately this is working only under NT */
    external C procedure beep="EBEEP" is procedure beep;;

    external C procedure EOUTTXT is
    procedure EOUTTXT(t, w, a); text t; short integer w; integer a; ;

    external C procedure EGETTXT is
    procedure EGETTXT(Lin,Pos,Width, t); short integer Lin,Pos,Width; text t; ;

    external C procedure EEDTTXT is
    procedure EEDTTXT(Fld, w, EdtAtr,OldAtr,Pkt);
    text Fld; short integer w; integer EdtAtr,OldAtr; ref(KeyPkt) Pkt; ;

    external C procedure EOPEN is
    boolean procedure EOPEN(H,W); short integer H, W;;

    external C procedure ECLOSE is
    procedure ECLOSE;;

    external C procedure showCursor="EshowCursor" is
    procedure showCursor;;

    external C procedure hideCursor="EhideCursor" is
    procedure hideCursor;;

    external C procedure sleep = "Esleep" is
    procedure sleep (ms); integer ms;;

    /* when enabled (not default), ascii 0-31 are not processed but printed */ 
    /* and locale characters are not processed */
    external C procedure printAll = "EprintAll" is
    procedure printAll (enable); boolean enable;;

    external C procedure autoWrap is
    procedure autoWrap(on); boolean on;;

    external C procedure lastError is
    text procedure lastError;;

%   I hope there is nothing to do in windows
%   external C procedure refresh is procedure EREFRSH;;
    procedure refresh;;

end;
