! Transmogrification of HMD's 68000 VTLIB for Visual 200
! For { Visual 200, Wyse 75 }
! RWT 12/02/85

@16_1140 %routine SET TERMINAL MODE(%integer k)
@16_3FA0 %byte screenrows,screencols
@16_3FA2 %routine screenput(%integer sym)

! Standard Video Terminal Interface

! Terminal mode options
%constinteger single=1<<2, noecho=1<<0, notermecho=1<<1,
              nopage=1<<3,
              specialpad=1<<13
%constinteger screenmode=single+notermecho+nopage
! Video FUNction/MODE flag values:-
%constinteger intense=1, reverse=2, underline=4, blink=8,
              graphical=16, shade=31
%constinteger fullscroll=64, anyscroll=128;  !FUN only
%constinteger noscroll=64, freeze=128;       !MODE only

%recordformat WININFO(%byteinteger top,rows,left,cols,
               row,col,fun,mode)
%external%record(wininfo) VDU=0;  !full-screen frame
%external%record(wininfo) WIN=0;  !current frame
%external%integer insertpos=0;    !non-zero if inserting

%constinteger STACKMAX=7
%ownrecord(wininfo)%array STACK(1:stackmax)
%owninteger SP=0

!ASCII control characters:
%constinteger bs=8, tab=9, lf=10, ff=12, rt=13, esc=27, del=127

%constinteger untouched=1<<30
%owninteger options=untouched;  !record of VIDEO MODE
%owninteger echoinc=1;      !0 if NOECHO
%owninteger escaping=0;  !temp for current window
%owninteger inmode=-1, outmode=-1;     !input/output modes
!  IN/OUTMODE < 0 ==> file,etc
!             = 0 ==> hardcopy terminal
!             > 0 ==> video terminal

! Internal procedures

%routine pdec(%integer x)
  %if x<0 %start
    %returnif x=-1
    x = \x
    screenput('?')
  %finish
  pdec(x//10) %if x//10#0
  screenput(rem(x,10)+'0')
%end

%routine escape(%integer k)
  screenput(esc); screenput(k)
%end

%routine extra(%integer parm,char)
  pdec(parm); screenput(char)
%end

%routine escape with(%integer parm,char)
  escape('[');  extra(parm,char)
%end

%routine do cursor(%integer row,col)
{ansi} escape with(row+1,';'); extra(col+1,'H')
!v200! escape('Y'); screenput(row+' '); screenput(col+' ')
%end

%routine do clearline
{ansi} escape with(-1,'K')
!v200! escape('K')
%end

%routine do clearscreen
{ansi} escape with(2,'J'); do cursor(0,0)
!v200! escape('v')
!vt52! escape('J')
%end

%routine do delete
{ansi} escape with(-1,'M')
!v200! escape('M')
%end

%routine do insert
{ansi} escape with(-1,'L')
!v200! escape('L')
%end

%routine do specialpad
{dec,v200} escape('=')
%end

%routine do normalpad
{dec,v200} escape('>')
%end

%routine do graph
{ansi} escape('('); screenput('0')
!v200! escape('F')
%end

%routine do standard
{ansi} escape('('); screenput('B')
!v200! escape('G')
%end

%routine do select(%integer shade)
!v200! escape(shade&1+'3')
{ansi?wy75} shade = shade&1; shade = 7 %unless shade=0; escape with(shade,'m')
%end

%routine do insertchar(%integer sym)
!v200! escape('i'); screenput(sym); escape('j')
{ansi} escape with(-1,'@'); screenput(sym)
%end

%routine do delchar
!v200! escape('O')
{ansi} escape with(-1,'P')
%end

%routine POSITION CURSOR(%integer row,col)
! Set cursor to row ROW and column COL (relative)
%integer k,seq
  row = win_rows-1 %if row >= win_rows;  row = row+win_top
  col = win_cols-1 %if col >= win_cols;  col = col+win_left
  %if row = vdu_row %start
    %return %if col = vdu_col;  !already there =>
    ! Check for optimisable cases
!   %if col = 0 %start
!     screenput(rt);  vdu_col = 0
!     %return
!   %finish
    %if  0 > col-vdu_col >= -3 %start
      %cycle
        screenput(bs)
        vdu_col = vdu_col-1
      %repeat %until vdu_col = col
      %return
    %finish
  %finish
  %if col = 0 %and row-vdu_row = 1 %start
    screenput(rt)
    screenput(nl)
    vdu_row = vdu_row+1;  vdu_col = 0
    %return
  %finish
  vdu_row = row;  vdu_col = col;      !new values
  do cursor(row,col)
%end

%routine CHANGE SHADE
  %if (win_mode!!vdu_mode)&graphical # 0 %start
    %if win_mode&graphical = 0 %then dostandard %else dograph
  %finish
  %if (win_mode!!vdu_mode)&15 # 0 %start
    doselect(win_mode&15)
  %finish
  vdu_mode = win_mode&shade
%end

! External procedures

%external%routine CLEAR LINE     %alias "vtcrol"
  %if win_col < win_cols %start
    position cursor(win_row,win_col)
    %if win_cols = vdu_cols %start
      doclearline
    %finish %else %start
      %cycle
        screenput(' ');  win_col = win_col+1
        vdu_col = vdu_col+1 %if vdu_col # vdu_cols-1
      %repeat %until win_col = win_cols
    %finish
  %finish
%end

%external%routine CLEAR FRAME   %alias "vtcframe"
!(no point in updating?)
  win_row = 0;  win_col = 0
  position cursor(0,0)
  ![optimisable by record variation]
  %if win_top=0=win_left %and win_rows=vdu_rows %c
  %and win_cols=vdu_cols %start
    doclearscreen
  %finish %else %start
    %cycle
      clear line
      win_row = win_row+1
    %repeat %until win_row >= win_rows
    win_row = 0
  %finish
%end

%external%routine SCROLL  %alias "vtscroll"(%integer t,b,n)
!Scroll area delimited by T and B by N lines
! -- reverse scroll if N < 0
%integer i,vt,vb
  %return %unless outmode > 0 %and t >= 0 %and b < win_rows
  win_row = b;  win_col = 0
  %if t >= b %or win_cols # vdu_cols %start
    clear line;  !clear single line
    %return
  %finish
  vt = t+win_top;  vb = b+win_top
  %if n >= 0 %start
    %if vt = 0 %and vb = vdu_rows-1 %start;   !full screen
      position cursor(b,0) %if vb # vdu_row;  !any col OK
      screenput(rt); screenput(nl);           !hardware scroll
      %return
    %finish
  %finish %else win_row = t
  %if n < 0 %start
    n = -n
    i = t;  t = b-(n-1);  b = i
    vt = t;  vb = b
  %finish %else b = b-(n-1)
  %if vt < vdu_rows-1 %start
    position cursor(t,0) %if vdu_row # vt;  !any col OK
    dodelete %for i = 1,1,n
    vdu_col = 0
  %finish
  %if vb < vdu_rows-1 %start
    position cursor(b,0)
    doinsert %for i = 1,1,n
  %finish
%end;  !SCROLL

%external%routine VTSELIN(%integer n)
  select input(n)
  inmode = -1;  inmode = vdu_fun %if n = 0
%end
%external%routine VTSELOUT(%integer n)
  select output(n)
  outmode = -1;  outmode = vdu_fun %if n = 0
%end

%external%routine VTPSYM(%integer sym)
%constbytearray v200outmap('`':'~')=%c
'q','x','n','v','w','m','f','g','h','i','a','b','k','j','t','u',
{`   a   b   c   d   e   f   g   h   i   j   k   l   m   n   o}
'c','d','}','l','e','o','p','r','s','y','z','{','|','~','`'
!p   q   r   s   t   u   v   w   x   y   z   {   |   }   ~
%integer i
  %if outmode <= 0 %start;  !non-video
    printsymbol(sym)
  %finish %else %if escaping # 0 %start
    escaping = 0
    screenput(sym)
    vdu_row = 255
  %finish %else %if sym = del %start
    %return %if win_col = 0
    win_col = win_col-1
    %return %if win_col >= win_cols
    position cursor(win_row,win_col)
    %if insertpos # 0 %then dodelchar %c
    %else screenput(' ') %and vdu_col = vdu_col+1
  %finish %else %if sym&96 # 0 %start;  !not control
    %return %if win_col >= win_cols
    position cursor(win_row,win_col)
    change shade %if win_mode&shade # vdu_mode
    sym = v200outmap(sym) %if vdu_mode&graphical#0 %and '`'<=sym<='~'
    %if insertpos # 0 %then do insert char(sym) %c
    %else screenput(sym)
    vdu_col = vdu_col+1 %if vdu_col # vdu_cols-1
    win_col = win_col+1 %if win_col # 255
  %finish %else %if sym # nl %start
    %if sym = rt %start
      win_col = 0
    %finish %else %if sym = bs %start
      win_col = win_col-1 %if win_col # 0
    %finish %else %if sym = ff %start
      clear frame
    %finish %else %start
      position cursor(win_row,win_col)
      screenput(sym)
      escaping = 1 %if sym = esc
    %finish
  %finish %else %start
    clear line
    %if win_row # win_rows-1 %start
      ![following line shouldn't be necessary, but lower-level]
      ![software happier with regular NLs]
!      screenput(nl);  vdu_row = vdu_row+1;  vdu_col = 0
      win_row = win_row+1
    %finish %else %start
      %if win_mode&freeze # 0 %start
!        i = instream;  select input(0) %if i # 0
        readsymbol(sym);  vdu_row = 255
        %if sym = esc %start
          readsymbol(sym)
          readsymbol(sym) %if sym = '?';  !%or sym = 'O' %or sym = '['
        %finish
        select input(i) %if i # 0
      %finish
      %if win_mode&(noscroll+freeze) # 0 %then win_row = 0 %c
      %else scroll(0,win_row,1)
    %finish
    win_col = 0
  %finish
%end;  !vtpsym
!
%external%routine AT    %alias "vtsetcursor"(%integer row,col)
  %if row >= 0 %and col >= 0 %start
    row = win_rows-1 %if row >= win_rows
    win_row = row
    col = 255 %if col > 255
    win_col = col
  %finish
%end
%external%routine GOTOXY        %alias "vtgotoxy"(%integer x,y)
  at(y,x)
%end
%external%routine SET MODE       %alias "vtsetmode"(%integer m)
  win_mode = win_mode&shade+m
%end
%external%routine SET SHADE      %alias "vtsetshade"(%integer s)
  win_mode = win_mode&(\shade)+s
%end
!
%external%routine SET FRAME      %alias "vtsetframe"(%integer t,r,l,c)
  r = 1 %if r <= 0;  r = vdu_rows %if r > vdu_rows
  t = vdu_rows-r %if t > vdu_rows-r;  t = 0 %if t < 0
  c = 1 %if c <= 0;  c = vdu_cols %if c > vdu_cols
  l = vdu_cols-c %if l > vdu_cols-c;  l = 0 %if l < 0
  win = 0
  win_top = t;  win_rows = r;  win_row = r-1
  win_left = l;  win_cols = c
  win_fun = vdu_fun
  win_fun = win_fun&(\(anyscroll+fullscroll)) %if c # vdu_cols %c
             %or (win_fun&anyscroll = 0 %and r # vdu_rows)
%end
!
%external%routine HILIGHT(%integer k)
  set shade(intense)
  %if k < ' ' %then vtpsym('|') %else vtpsym(k)
! %if k > ' ' %then vtpsym(k) %else vtpsym('|')
  set shade(0)
%end

%external%routine LOLIGHT(%integer k)
  vtpsym(k)
%end

%external%routine PUSH FRAME    %alias "vtpush"
  %if sp = stackmax %start
!    event_message = "Too many frames";  %signal 9,4
  %finish
  sp = sp+1;  stack(sp) = win
%end

%external%routine POP FRAME     %alias "vtpop"
  %if sp > 0 %then win = stack(sp) %and sp = sp-1 %c
  %else win = vdu
%end

%external%routine SWOP FRAME    %alias "vtswop"
%record(wininfo) temp
  %if sp > 0 %start
    temp = stack(sp);  stack(sp) = win;  win = temp
  %finish %else %start
    sp = 1;  stack(sp) = win;  win = vdu
  %finish
%end

%external%routine SET VIDEO MODE %alias "vtsetvideo"(%integer mode)
%integer p
  %return %if mode = options
  p = mode&specialpad
  %if options = untouched %start
    vdu_fun = anyscroll+fullscroll+intense
    vdu_rows = screenrows;  vdu_cols = screencols
    inmode = vdu_fun;  outmode = vdu_fun
    win = vdu
  %finish
  set terminal mode(mode-p)
  echoinc = 1;  echoinc = 0 %if mode&noecho # 0
  %if (mode!!options)&specialpad # 0 %start;  !change in pad mode
    %if p # 0 %then dospecialpad %c
    %else donormalpad
  %finish
  options = mode
%end

%owninteger pend=\nl
%external%routine VTRSYM(%integername k)
%constbytearray v200inmap('l':'y')=%c
 '^','P',']','P',  2,'K','f','J','M','O','2','L','i','1'
! ,   -   .       0   1   2   3   4   5   6   7   8   9
%integer kk,i
  readsymbol(k) %and %return %if inmode < 0
  k = pend %and pend = \pend %and %return %if pend >= 0
  %unless \' ' >= pend > \del %start;  !last was control
    %if outmode > 0 %start
      position cursor(win_row,win_col)
      change shade %if win_mode&shade # vdu_mode
    %finish %else win_col = 0
  %finish
  readsymbol(kk)
normal:
!kk = kk!!(rt!!lf) %if kk = rt %or kk = lf
  %if ' ' <= kk < del %start
    %if options&(single+noecho) = single %start
      !IE echoing wanted at this level
      %if insertpos # 0 %then do insert char(kk) %c
      %else screenput(kk)
    %finish
    win_col = win_col+echoinc
  %finish
  %if kk = esc %start
    readsymbol(kk)
    %if kk = '?' %or kk='O' %start
      readsymbol(kk)
      kk = 'H'!!96 %if kk='S'  {vt220: PF4 as home}
      %if kk='P' %start {wy75: PF1 as keypad shift}
        readsymbol(kk)
        ->normal %unless kk=esc
        readsymbol(kk)
        ->normal %unless kk='O'
        readsymbol(kk)
        %if 'l'<=kk<='y' %start
          i = kk; kk = v200inmap(kk)!!96
        %finish
      %finish
      kk = kk!!96
    %elseif kk='['
      readsymbol(kk)
    %finish
    kk = kk!128
  %finish
  vdu_row = 255;  ![safety for now]
  pend = \kk
  k = kk
%end

%external%integerfn VTNSYM
  %result = nextsymbol %if inmode < 0
  %result = pend %if pend >= 0
  vtrsym(pend)
  %result = pend
%end
%external%routine SKIPSYMBOL    %alias "vtssym"
%integer i
  vtrsym(i)
%end

!!!!!!!!!!!!!!!   End of Video Package  !!!!!!!!!!!!!!!!!!!!!

%external%routine PRINT STRING   %alias "vtpstring"(%string(255) s)
%integer i
  vtpsym(charno(s,i)) %for i = 1,1,length(s)
%end
!
%external%routine NEWLINE        %alias "vtnl"
  vtpsym(nl)
%end
%external%routine NEWLINES       %alias "vtnls"(%integer i)
  newline %and i = i-1 %while i > 0
%end
%external%routine SPACE          %alias "vtsp"
  vtpsym(' ')
%end
%external%routine SPACES         %alias "vtsps"(%integer i)
  space %and i = i-1 %while i > 0
%end
%external%routine WRITE      %alias "vtwrite"(%integer v,p)
%integer vv,q,pos
%byteintegerarray store(0:15)
  vv = v;  vv = -vv %if vv > 0
  pos = 15
  %while vv <= -10 %cycle
    q = vv//10
    store(pos) = q*10-vv+'0';  pos = pos-1
    vv = q
  %repeat
  store(pos) = '0'-vv
  %if p <= 0 %start
    spaces(pos-16-p) %if p < 0
  %finish %else %start
    spaces(pos-16+p)
    vtpsym(' ') %if v >= 0
  %finish
  vtpsym('-') %if v < 0
  vtpsym(store(pos)) %and pos = pos+1 %until pos = 16
%end

%external%routine READ %alias "vtread"(%integername v)
%integer i,k,sign
  %cycle
    k = vtnsym
    %exit %if k > ' '
    vtrsym(k)
  %repeat
  sign = 0
  %if k = '-' %start
    sign = 1
    vtrsym(k);  k = vtnsym
  %finish
  %signal 4 %unless '0' <= k <= '9'
  i = k-'0'
  %cycle
    vtrsym(k)
    k = vtnsym
    %exit %unless '0' <= k <= '9'
    i = i*10-'0'+k
  %repeat
  i = -i %if sign # 0
  v = i
%end

%endoffile