!This version is for V200 emulator driven from WY75 keyboard
!01/04/85 RWT

! VTI LIB file for Motorola 68000 IMP Compiler
@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
%constinteger STACKMAX=7
%ownrecord(wininfo)%array STACK(1:stackmax)
%owninteger SP=0
!
! Video operations
%constinteger escflag=128 {flag for ESC},
              rowcode=254 {place-saver for row},
              colcode=255 {place-saver for col}
! Control sequences (coded - 4 bytes max)
!  [Initial values shown are for V200]
%constinteger docursor=escflag+'Y'+rowcode<<8+colcode<<16,
            doclearline=escflag+'x',doclearscreen=escflag+'v',
            dodelete=escflag+'M',doinsert=escflag+'L',
            donormalpad=escflag+'>',dospecialpad=escflag+'=',
            dostandard=escflag+'G',dograph=escflag+'F'
%constintegerarray doselect(0:15) = escflag+'3', escflag+'4', 0 (*)
!
!ASCII control characters:
%constinteger bs=8, tab=9, lf=10, ff=12, rt=13, esc=27
%constinteger 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 PUT SEQUENCE(%integer seq)
  %while seq # 0 %cycle
    screenput(esc) %if seq&escflag # 0 %and seq&127 # 0
    screenput(seq&127)
    seq = seq>>8
  %repeat
%end

%constinteger dostartins=escflag+'i',dostopins=escflag+'j',
            dodelchar=escflag+'O'
%routine INSERT CHAR(%integer k)
  put sequence(dostartins)
  screenput(k)
  put sequence(dostopins)
%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
!Interpret cursor address sequence
  seq = docursor
  %while seq # 0 %cycle
    k = seq&255
    k = row+' ' %if k = rowcode
    %if k = colcode %start
      k = col+' '
    %finish
    screenput(esc) %if k&escflag # 0
    screenput(k&127)
    seq = seq>>8
  %repeat
%end

%routine CHANGE SHADE
  %if (win_mode!!vdu_mode)&graphical # 0 %start
    %if win_mode&graphical = 0 %then put sequence(dostandard) %c
    %else put sequence(dograph)
  %finish
  %if (win_mode!!vdu_mode)&15 # 0 %start
    put sequence(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 {%and doclearline # 0} %start
      put sequence(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 {%and doclearscreen # 0} %start
    put sequence(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
    %for i = 1,1,n %cycle
      put sequence(dodelete)
      vdu_col = 0
    %repeat
  %finish
  %if vb < vdu_rows-1 %start
    position cursor(b,0)
    %for i = 1,1,n %cycle
      put sequence(doinsert)
    %repeat
  %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)
%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 put sequence(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
    %if insertpos # 0 %then 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(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 put sequence(dospecialpad) %c
    %else put sequence(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
      screenput(esc) %and screenput('i') %if insertpos#0
      screenput(kk)
      screenput(esc) %and screenput('j') %if insertpos#0
    %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