!  File  MOUSE:IO_T

! TERMINAL device interface module

! We do not deal with ^S/^Q/^O/^T/^Y, the terminal process does that.
! Page mode, however, IS dealt with here, but is disabled be default.

%option "-low-nons-nocheck-nodiag"

%constinteger noecho=1,notermecho=2,nobuffering=4,nopage=8
%owninteger normal=nopage,mode=nopage

%include "mouse.inc"
%include "io.inc"

%ownrecord(mailboxfm)%name server == nil, reply == nil
%ownrecord(messagefm)%name msg == nil
%owninteger msgpos = 0, linesleft = maxint

%constinteger del=127,bs=8,tab=9,lf=10,cr=13,esc=27

@16_3724 %integer exemptmask
@16_3fa0 %byte ttyrows
@16_3fa2 %routine screenput(%integer x)
@16_4000c1 %byte acias,*,aciad

%externalintegerfn testsymbol
  %if msg==nil %start
    %if server==nil %start
      server == lookup kernel object("Keyboard mailbox")
      %signal 3,3,,"Keyboard mailbox not found" %if server==nil
      reply == create mailbox(create semaphore(0))
    %finish
    msg == get message buffer
    msg_reply == reply; msg_size = 0
    send message(msg,server)
    msg == receive message(reply)
    msgpos = 0
  %finish
  %if msgpos>=msg_size %start
    put message buffer(msg); msg == nil; %result = -1
  %finish
  msgpos = msgpos+1
  %result = msg_data(msgpos)
%end

%externalintegerfn pendsymbol
%integer k = testsymbol
  msgpos = msgpos-1 %unless k<0
  %result = k
%end

%integerfn getsym
%integer k
  k = testsymbol %until k>=0
  %result = k&127
%end

%routine putstring(%string(255)s)
%integer i
  screenput(charno(s,i)) %for i = 1,1,length(s)
%end

%routine refresh input (%record(scbfm)%name cb)
%owninteger pendeof=0
%integer k
  %routine add(%integer k)
    byte(cb_l) = k; cb_l = cb_l+1
  %end
  pendeof = 0 %and %signal 9,,,"End of file" %unless pendeof=0
  k = pendsymbol
  linesleft = ttyrows-1 %if mode&nopage=0
  putstring(cb_prompt) %unless cb_prompt==nil
  cb_p = cb_bs; cb_l = cb_p
  %cycle
    k = getsym
    %if k<' ' %and 1<<k&exemptmask#0 %start
      add(k); %exit
    %finish
    k = k!!(cr!!lf) %if k=cr %or k=lf
    %if k=esc %start
      add(k); k = getsym
      add(k) %and k = getsym %if k='['
      add(k) %and k = getsym %if k='O' %or k='?'
      %cycle
        add(k); %exitif k>='@'
        k = getsym
      %repeat
      %exit
    %finish
    %if k='F'-64 %start
      normal = normal!!nopage
      mode = (mode&\nopage)!(normal&nopage)
      %if mode&nopage#0 %start
        linesleft = maxint
        screenput(' ';bs)
      %else
        linesleft = ttyrows-1
        screenput('P';bs)
      %finish
      %continue
    %finish
    %if mode&nobuffering#0 %start
      k = getsym %if k='P'-64
      add(k); %exit
    %finish
    %if k='D'-64 %or k='Z'-64 %start
      pendeof = 1; %exit
    %finish
    %if k=cr %or k=lf %start
      add(k); screenput(cr;lf) %if mode&notermecho=0; %exit
    %finish
    %if k=del %start
      %if cb_l>cb_bs %start
        cb_l = cb_l-1; screenput(bs;' ';bs) %if mode&noecho=0
      %finish
    %elseif k=bs %or k='X'-64
      %while cb_l>cb_bs %cycle
        screenput(bs;' ';bs) %if mode&noecho=0; cb_l = cb_l-1
      %repeat
    %elseif k>=' '
      add(k); screenput(k) %if mode&noecho=0
    %elseif k='P'-64
      add(getsym)
    %elseif k=tab
      add(' ';' ';' ')
    %else
      %exitif k='C'-64
      screenput('?';'^';k+64;'?';bs;bs;bs;bs)
    %finish
  %repeatuntil cb_l>=cb_bl-10 {in case longish esc seq}
%end

%routine newline
%integer k
  screenput(cr;lf)
  linesleft = linesleft-1
  %if linesleft<=0 %start
    %if mode&nopage#0 %start
      linesleft = maxint
    %else
      putstring("^F:Free  LF:Line  Other:Page"); screenput(cr)
      k = testsymbol %until k>=0
      %if k='F'-64 %start
        mode = mode!!nopage; normal = mode
        linesleft = maxint
      %elseif k=lf
        linesleft = 1
      %else
        linesleft = ttyrows-1
      %finish
      putstring("                            "); screenput(cr)
    %finish
  %finish
%end

%routine flush output (%record(scbfm)%name cb,%integer k)
  %unless k<0 %start
    %if k=nl %then newline %else screenput(k)
  %finish
  cb_p = cb_bs; cb_l = cb_bs
%end

%routine read input(%record(scbfm)%name cb,%integer amount,%bytename p)
! (POSITION ignored)
  %while amount>0 %cycle
    amount = amount-1
    refresh input(cb) %if cb_p>=cb_l
    p = byte(cb_p); cb_p = cb_p+1; p == p[1]
  %repeat
%end

%routine write output(%integer amount,%bytename p)
  %while amount>0 %cycle
    amount = amount-1
    %if p=nl %then newline %else screenput(p)
    p == p[1]
  %repeat
%end

%externalintegerfn terminalmode
  %result = mode
%end

%externalroutine set terminalmode(%integer x)
  x = normal %if x<0
  mode = x
  %if mode&nopage#0 %start
    linesleft = maxint
  %else
    linesleft = ttyrows-1
  %finish
%end

%routine SOP (%record(scb fm)%name cb,%integer code,p1,p2,%bytename b)
%switch sw(sopclose:sopread)
  ->sw(code) %if sopclose<=code<=sopread
  %signal 3,4,code,"Illegal SCB operation (:T)"
sw(sopflush):   flushoutput(cb,p1); %return
sw(sopwrite):   readinput(cb,p2,b); %return
sw(soprefresh): refreshinput(cb); %return
sw(sopread):    writeoutput(p2,b); %return
sw(sopclose):
sw(sopabort):
  heapput(cb_bs) %unless cb_bs=0; cb_bs = 0
  dispose(cb_prompt) %unless cb_prompt==nil; cb_prompt == nil
  dispose(cb)
%end

%externalrecord(scbfm)%map FOP %alias "FOP_T" -
  (%integer code,%string(*)%name file,%name x)
%record(scbfm)%name cb == nil
%integer fastpc,soppc
{* back-compat *} @748(a5) %integer ttygla

{}%routine stm{%integer x}
{}  *movem.l d0-d7/a0-a6,-(sp)
{}  *moveq #0,d4
{}  *move.l #16_80808080,d7
{}  *move.l ttygla,a4
{}  *jsr set terminal mode
{}  *movem.l (sp)+,d0-d7/a0-a6
{}%end
{}%routine{integerfn} ts
{}%register(d0)%integer k
{}  *movem.l d1-d7/a0-a6,-(sp)
{}  *moveq #0,d4
{}  *move.l #16_80808080,d7
{}  *move.l ttygla,a4
{}  *jsr testsymbol
{}  k = k!!(cr!!lf) %if k=cr %or k=lf
{}  *movem.l (sp)+,d1-d7/a0-a6
{}%end
{}%routine xcode(%integer n {, %routine(*) A0})
{}  *muls #-6,d0
{}  *lea 16_3f00,a1
{}  *move.w #16_4ef9,0(a1,d0.l)
{}  *move.l a0,2(a1,d0.l)
{}%end

{}%if ttygla=0 %start
{}  *lea ts,a0;  xcode(36)
{}  *lea stm,a0; xcode(49)
{}  ttygla = a4
{}%finish
  *lea sop,a0; *move.l a0,soppc
  %if code = fop openi %start
    *lea refreshinput,a0; *move.l a0,fastpc
    cb == newscb(file)
    cb_fastpc = fastpc; cb_soppc = soppc; cb_gla = a4
    cb_prompt == string(heapget(256)); make global(cb_prompt); cb_prompt = ":"
    cb_bs = heapget(256); make global(record(cb_bs)); cb_bl = cb_bs+256
    cb_fs = cb_bs; cb_fl = cb_fs
    cb_p = cb_bs; cb_l = cb_p
  %elseif fop openo <= code <= fop opena
    *lea flushoutput,a0; *move.l a0,fastpc
    cb == newscb(file)
    cb_fastpc = fastpc; cb_soppc = soppc; cb_gla = a4
  %else
    %signal 3,3,code,"File operation not supported (:T)"
  %finish
  %result == cb
%end