    !!!!!!!!!!!!!!  Standard Video Terminal Interface  !!!!!!!!!!!!!
    !!!!!!!!!!!!!!!!   for Vax/VMS, Emas and APM   !!!!!!!!!!!!!!!!!
    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    ! Hamish Dewar   EU Computer Science Department   January 1983 !
    !                                                              !
    !   Modified by Keith Refson , Physics Dept. 1985              !
    !  Prototype (and rather crummy) driver for Lynwood            !
    !  Improved driver for VT52 so that sussex emulation works     !
    !  at 9600 baud.                                               !
    !  Corrected mistake in Newbury driver - now OK in HILIGHT mode!
    !                                                              !
    !   Now works through a PAD in native mode by doing echoing in !
    !  software. Also code in VMS version for grabbing terminal    !
    !  definitions from the system database using the SMG routines.!
    !  Now has code to $ set term/passall/noescape on VMS          !
    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    ! This version is implemented wholly as an external library,
    ! with re-definition of the various input/output procedures.
    !
    ! The present version handles the standardisation of vdu operations
    ! and implements the concept of a single bounding box or frame
    ! applied to the screen.
    ! The input side is inadequate but really needs to be combined with
    ! the next lower level.
    ! Only the following I/O procedures are covered:-
    !   SELECT INPUT, SELECT OUTPUT, PROMPT,
    !   PRINT SYMBOL, SPACE(S), NEWLINE(S), PRINT STRING, WRITE,
    !   READ SYMBOL,SKIP SYMBOL, NEXT SYMBOL, READ (integer only)
    ! plus (for Emas):-
    !   OPEN INPUT, OPEN OUTPUT, CLOSE INPUT, CLOSE OUTPUT,
    !   OUTSTREAM, EVENT
    ! The following video functions are provided:-
    !   CLEAR LINE (ie rest of line), CLEAR FRAME, SCROLL, AT/GOTOXY,
    !   SET FRAME, SET MODE, SET SHADE, SET VIDEO MODE,
    !   PUSH WINDOW, POP WINDOW, SWOP WINDOW
    ! The routine DEFINE VIDEO is included for convenience at present.
    !!!!!!!!!!!!!!!!!!!!!!!   INTERFACE   !!!!!!!!!!!!!!!!!!!!!!!!!!
    constinteger  BS=8, LF=10, FF=12, RT=13, EM=25, ESC=27;  !ASCII control chars
    constinteger  DEL=127
    ! Terminal mode options
    constinteger  single=1<<0, maplower=1<<1, noecho=1<<2, passdel=1<<3,
                  notypeahead=1<<4, notermecho=1<<5,
                  controlterm=1<<6, noevent9=1<<7,
                  leavecontrols=1<<8, leavelf=1<<9,
                  leavert=1<<10, noflush=1<<11, nobuffer=1<<12,
                  specialpad=1<<13, nodelecho=1<<14,
                  inserting=1<<15,wide=1<<16,padecho=1<<17,debug=1<<18,
                  hostecho=1<<29
    ! 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  caninsert=32
    owninteger    ansiscroll = 0
    constinteger  noscroll=64, freeze=128;       !MODE only
    recordformat  WININFO(byteinteger  top,rows,left,cols,
                   row,col,fun,mode)
    externalrecord (wininfo) VDU = 0;  ! full-screen frame
    externalrecord (wininfo) WIN = 0;  ! current frame
    externalinteger  LEADIN=esc
    constinteger  STACKMAX=7
    ownrecord (wininfo)array  STACK(1:stackmax)
    owninteger  SP=0
    !$IF VAX
    !
    ! The following are added to cope with the changes made to the imp language
    ! by Lattice Logic Ltd
    ! The next release of their compiler will allow the line
    ! %from imp %include archaisms
    ! which will %include a file (not present in this version) to allow
    ! 'instream' and 'outstream' to be used - so the following functions can go
     externalintegerfunctionspec  instream
     externalintegerfunctionspec  outstream
    !
    ! The next changes are because the ECS IMP Compiler has the intrinsic functions
    ! 'intype' and 'outtype' to describe what the current I/O channels are attached to
    ! (This "user contributed set of routines supplied by Ian Young of Lattice to
    ! bridge this gap - they are likely to be part of the run-time environment at
    ! the next release of the compiler)
    ! IOTYPE
    !
    ! What type of thing is a stream connected to?
    !
    ! 11-Feb-86  JF    Created
    !
    ! Answers returned are as follows:
    !
    !   -2  =  can't tell
    !   -1  =  terminal
    !    0  =  null stream
    !    1  =  none of these - probably (always?) a file
    !
     external  integer  fn  spec  In Type
     external  integer  fn  spec  Out Type
    ! End of "user contributed routines" from Lattice
    !$IF AMDAHL
    {%recordformat EVENTINFO(%integer event,sub,extra, %string(255) message)
    {%externalrecord(eventinfo) EVENT     %alias "VTEVENT"
    {!%externalroutinespec OPEN INPUT     %alias "VTOPIN"(%integer s,
    {!                                          %string(255) file)
    {!%externalroutinespec OPEN OUTPUT    %alias "VTOPOUT"(%integer s,
    {!                                          %string(255) file)
    {!%externalroutinespec CLOSE INPUT    %alias "VTCLIN"
    {!%externalroutinespec CLOSE OUTPUT   %alias "VTCLOUT"
    {!%externalintegerfnspec OUTSTREAM    %alias "VTOUTS"
    !$FINISH
    !
    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    ! Terminal type (ERCC enumeration)
    constinteger  vt52=8, esprit=13, vt100=12, bbc=29, pericom=16, x5a=27,
                  ansi=28, wyse=32, wysew=31;     !special cases of VTTYPE
    externalinteger  vttype=-1
    ! Video operations
    constinteger  internal=0,smg=1,tcap=2
    !$IF VAX
    owninteger  initialise=internal
    !$IF AMDAHL OR APM
    {%owninteger initialise=internal
    !$FINISH
    !
    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]
    externalinteger  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',
                doscrolld=escflag+'D', doscrollu=escflag+'M',
                dobegininsert=0,doendinsert=0,dodeletechar=0
    externalintegerarray  doselect(0:15) = escflag+'3', escflag+'4', 0 (*)
    externalinteger  key u=0, key d=0, key l=0, key r=0
    own  integer  padchar=0
    owninteger  lfpad=0; !Pads after LF

    external  string (15) full screen scroll=""
    own  string (255) initialise tt=""
    owninteger  vbot=23,vright=79;  !=VDU_ROWS-1,VDU_COLS-1
    constinteger  untouched=1<<30
    owninteger  options=untouched;  !record of VIDEO MODE
    owninteger  inc=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
    !
    !Output buffer
    !$IF AMDAHL
    {%constinteger outbound=255
    {!
    !$IF VAX
    constinteger  outbound=126
    !$FINISH
    ownbyteintegerarray  outbuff(0:outbound)
    owninteger  outcount=0
    constinteger  maxprompt=63
    ownstring (maxprompt) prom = ""
    constinteger  inbound=255
    ownbyteintegerarray  inbuff(0:inbound)
    owninteger  incount=0,inpos=0
    owninteger  leaddels=0,traildels=0,repairch=0
    owninteger  insertflag=0;           ! Signals READ SYM and PRINT SYM to turn off insert mode
    !$IF VAX
    constinteger  outstreambase=0
    constinteger  lfmap=rt
    !%externalintegerfnspec UINFI(%integer i)
    external  integer  fn  spec  batch mode

    !VMS function codes:
    constinteger  vmsreadvblk=16_0031, vmswritevblk=16_0020,
                  vmsreadall =16_003A
    constinteger  vmsnoecho  =16_0040, vmsnofiltr  =16_0200,
                  vmspurge   =16_0800, vmstrmnoecho=16_1000,
                  vmsescape  =16_4000, vmsnoformat =16_0100
    constinteger  vmsread=vmsreadvblk{+vmsescape}
    constinteger  vms ttm noecho = x'2', vms ttm hostsync = x'10',
                  vms ttm nobrdcst = x'20000', vms ttm pasthru = x'40000',
                  vms ttm escape = x'8', vms ttm passall = x'1'
    constinteger  vms io sensemode = x'27' , vms io setmode = x'23'

    !VMS descriptor format
    recordformat  desc fm(integer  length, addr)
    !VMS I/O status block format
    recordformat  IOSB fm(short  status, length, term, termlength)

    system  integerfn  spec  qiow(integer  efn, chan, func, c
                                  record (IOSB fm)name  iosb, c
                                  integer  x1, x2, p1, p2, p3, p4, p5, p6)
    system  integerfn  spec  assign(record (desc fm)name  device, c
                                    integername  channel, c
                                    integer  x1, x2)

    ! %alias added for Lattice imp
    ! %externalstring(127)%fn %spec sysmess %alias "IMP_GET_MESSAGE"(%integer i)
    externalstring (127)fn  spec  sysmess (integer  i)
    routine  IO fail(integer  why)
      event_message = sysmess(why)
      signal  9, 3, why
    end

    owninteger  tt channel = 0;  !filled in to show initialised
    owninteger  readfunction=vmsread
    ownrecord (descfm) termmask
    ownintegerarray  mask(0:3) = \0, 0,0,16_80000000;  !controls+DEL
    ownintegerarray  saved terminal mode(0:2)

    routine  tt setup
    ownstring (7) tt name = "TT"
    integer  status
    record (descfm) tt
      tt_length = length(tt name)
      tt_addr = addr(tt name)+1
      status = assign(tt, tt channel, 0, 0)
      IO fail(status) if  status&1 = 0
    end

    routine  set passall noescape
       integerarray  new terminal mode(0:2)
       integer  status
       record (iosb fm)iosb
       status= qiow(0,tt channel,vms io sensemode,iosb,0,0,addr(saved terminal mode(0)),
          12,0,0,0,0)
       IO fail(status) if  status&1 = 0
       new terminal mode(0)=saved terminal mode(0)
       new terminal mode(1)=saved terminal mode(1)
       new terminal mode(2)=saved terminal mode(2)
       new terminal mode(1)=new terminal mode(1) ! vms ttm passall
       new terminal mode(1)=new terminal mode(1) & (-1!!vms ttm escape)
    !   new terminal mode(2)=new terminal mode(2) ! vms ttm pasthru
       status= qiow(0,tt channel,vms io setmode,iosb,0,0,addr(new terminal mode(0)),12,0,0,0,0)
       IO Fail(status) if  status&1 = 0
    end

    routine  set nopassall escape
       integer  status
       record (iosb fm)iosb
       status=qiow(0,tt channel,vms io setmode,iosb,0,0,addr(saved terminal mode(0)),
               12,0,0,0,0)
       IO Fail(status) if  status&1 = 0
    end

    routine  set handler mode(integer  mode)
    ! Only do the SET if mode and options differ ie changing mode. Mask handles untouched
    if  mode # 0 and  options&16_3FFFFFFF = 0 then  start ; ! entering vecce
       set passall noescape
    finish  else  if  mode = 0 and  options&16_3FFFFFFF # 0 start
       set nopassall escape
    finish
    end

    routine  PUT BUFFER
    !Send characters in OUTBUFF to device
    integer  status
    record (IOSB fm) IOSB
      status = qiow(10, tt channel, vmswritevblk+vmsnoformat, IOSB, c
                    0, 0, addr(outbuff(0)), outcount, 0, 0, 0, 0)
      outcount = 0
      IO fail(status) if  status&1 = 0
      IO fail(IOSB_status) if  IOSB_status&1 = 0
    end

    integerfn  SINGLE SYMBOL
    integer  status,buffer=0
    record (IOSB fm) IOSB
      put buffer if  outcount > 0
      status = qiow(11, tt channel, vmsread+vmsnoecho+vmsnofiltr, IOSB, 0, 0,
                    addr(buffer), 1, 0, 0, 0, 0)
      IO fail(status) if  status&1 = 0
      IO fail(IOSB_status) if  IOSB_status&1 = 0
      result  = buffer&127;  ! strip parity (just in case)
    end

    routinespec  put sequence(integer  seq)
    routinespec  put symbol(integer  k)
    routine  GET BUFFER
    !Read characters to INBUFF
    integer  status
    record (IOSB fm) IOSB
      incount = 0;  inpos = 0;  traildels = 0
      cycle
        put buffer if  outcount # 0
         status = qiow(11, tt channel, readfunction, IOSB, 0, 0,
            addr(inbuff(incount)), inbound-incount, 0, addr(termmask), 0, 0)
          IO fail(status) if  status&1 = 0
          IO fail(IOSB_status) if  IOSB_status&1 = 0
          incount = incount+IOSB_length
          traildels = traildels-IOSB_length;  traildels = 0 if  traildels < 0
          exit  unless  IOSB_term = del and  options&nodelecho = 0
          if  incount # 0 start
            incount = incount-1;  traildels = traildels+1
            if  options&inserting=0 start
              put symbol(bs); put symbol(' '); put symbol(bs)
            else
              put symbol(bs); put sequence(dodeletechar)
            finish
          finish
      repeat
      incount = incount+IOSB_termlength
    end
    !$IF AMDAHL
    {%constinteger lfmap=rt;  ![no mapping unless RT seen]
    {!!!!!!!!!!!!!!!!!   Emulation of part of Emas IOCP   !!!!!!!!!!!!!!!!
    {! COMREG values used -
    {%constinteger INSTR = 22, OUTSTR = 23, ERRMESS = 24
    {! IOCP ep flags
    {%constinteger READCH=4, PRINTCH=5, SELIN=8, SELOUT=9,
    {              RESET=16, NEXTCH=18
    {!
    {%externalroutinespec SETMODE %alias "S#SETMODE" (%string(255) par)
    {%externalstring(*)%fnspec MODESTR %alias "S#MODESTR"
    {%externalintegerfnspec UINFI %alias "S#UINFI"(%integer I)
    {%const %integer tmode=2, terminaltype=23
    {%const %integer forground=1, batch=2 ;       ! result of unifi(tmode)
    {%externalintegerfnspec EXIST %alias "S#EXIST"(%string(255) S)
    {%externalroutinespec PROMPT %alias "S#PROMPT"(%string(255) S)
    {%externalroutinespec setfname %alias "S#SETFNAME" (%string(255) file)
    {%external %routine %spec OUT FILE %alias "s#outfile"(%string (255) FILE,
    {   %integer SIZE, HOLE, PROT, %integer %name CONAD, FLAG)
    {%externalroutinespec DEF INFO %alias "S#DEFINFO"(%integer CHAN,
    {          %string(255) %name FILENAME, %integer %name STATUS)
    {%externalintegermapspec COMREG %alias "S#COMREGMAP"(%integer N)
    {%externalintegerfnspec IOCP %alias "S#IOCP"(%integer entry,param)
    {%externalroutinespec CONSOLE %alias "S#CONSOLE"(%integer ep, %integername start, len)
    {%externalroutinespec FLUSH BUFFER %alias "S#TERMINATE"
    {%externalroutinespec DEFINE %alias "S#DEFINE"(%integer chan, %string(255) parm,
    {                          %integername a,b)
    {%externalstringfnspec FAILURE MESSAGE %alias "S#FAILUREMESSAGE"(%integer errno)
    {%external %routine %spec journal off %alias "S#JOURNALOFF"
    {%external %routine %spec journal on  %alias "S#JOURNALON"
    {%externalroutinespec setiodefault %alias "S#SETIODEFAULT"(%integer d,c,b)
    {! Above added (+call in VT SET VIDEO) 23/03/86 at request of Tony Gibbons
    {! to allow vecce to work from his command macro scheme
    {%externalroutinespec move %alias "S#MOVE"(%integer length,from,to)
    {!
    {%owninteger outstreambase=0;             !or 16
    {!
    {!IMP77 compatible I/O
    {%externalroutinespec emas3checkname %c
    {   (%string %name name, %integer %name type, qualifier, flag)   {sriririw}
    {! flags for EMAS3checkname
    {%const %integer emas3fileormem=1,emas3file=2
    {%constinteger emas3read=1, emas3write=2, emas3exist=4, emas3notexist=8,
    {              emas3nosuffix=16, emas3char=128, emas3pd=1024, emas3myfile=x'4000'
    {!%routine check write(%string(255) file);      ! Test file for writing
    {!  %integer flag, conad
    {!  %const %integer filespec=2, charf=128
    {!  emas3checkname(file,filespec,charf,flag);   !Returns flag if error in name
    {!  -> signal %if flag # 0;                     !or file exists and is not char
    {!  out file(file,1024,0,2,conad,flag);        !Attempt to create file
    {!  %return %if flag = 0;                       !success
    {!signal:
    {!  %if flag # 0 %start
    {!    setfname(file)
    {!    event_message = failuremessage(flag)
    {!    %signal 9,4
    {!  %finish
    {!%end
    {
    {%externalroutine OPEN INPUT %alias "VTOPIN"(%integer STREAM, %string(255) FILE)
    {%integer flag,dump
    {  event_extra=223 %and %signal 9,2 %unless 0 < stream <= 15
    {  emas3checkname(file,emas3fileormem,emas3read!emas3exist!emas3char,flag)
    {  -> err %if flag # 0
    {  dump = iocp(reset,stream)
    {  define(stream,file,dump,flag)
    {  define(stream,".null",dump,dump) %and -> err %if flag # 0
    {  %return
    {err:
    {  setfname(file)
    {  event_extra = flag
    {  event_message = failure message(flag)
    {  %signal 9,3
    {%end
    {
    {%externalroutine OPEN OUTPUT %alias "VTOPOUT"(%integer STREAM, %string(255) FILE)
    {!ANY CALL ON THIS PROCEDURE IMPLIES IMP77 OUTPUT STREAM NUMBERING
    {%integer flag,dump,conad
    {  event_extra=223 %and %signal 9,2 %unless 0 < stream <= 15
    {  emas3checkname(file,emas3file,emas3char!emas3write!emas3myfile,flag);
    {                                          ! Check file name
    {  -> err %if flag # 0
    {  out file(file,4096,0,2,conad,flag);        !Attempt to create file
    {  -> err %if flag # 0
    {  stream = stream+outstreambase
    {  dump = iocp(reset,stream)
    {  define(stream,file,dump,flag)
    {  define(stream,".null",dump,dump) %and -> err %if flag # 0
    {  %return
    {err:
    {  setfname(file)
    {  event_extra = flag
    {  event_message = failure message(flag)
    {  %signal 9,3
    {%end
    {
    {%externalroutine CLOSE INPUT %alias "VTCLIN"
    {%integer s,dump
    {  s = comreg(instr)
    {  %if 0 < s <= 15 %start
    {    dump = iocp(reset,s);  define(s,".null",s,s)
    {  %finish
    {%end
    {
    {%externalroutine CLOSE OUTPUT %alias "VTCLOUT"
    {%integer s,dump
    {  s = comreg(outstr)
    {  %if 0 < s-outstreambase <= 15 %start
    {    dump = iocp(reset,s);  define(s,".null",s,s)
    {  %finish
    {%end
    {
    {%externalintegerfn OUTSTREAM %alias "VTOUTS"
    {  %result = comreg(outstr)-outstreambase
    {%end
    {
    {%externalintegerfn INSTREAM %alias "VTINS"
    {  %result = comreg(instr)
    {%end
    {
    {!!!!!!!!!!!!  Set PAD options
    {%routine SET HANDLER MODE(%integer mode)
    {
    {%own %string(255) defparms="P2=1,P3=126,P4=0,P10=80,P13=4,P15=1"
    {%string(127) pad mode
    {%constinteger RESETMODE=controlterm+leavecontrols+notermecho+passdel+noecho+padecho
    {
    {%return %if (mode!!options)&resetmode = 0 ; ! Don't reset PAD unless entering/leaving screen mode
    {%if mode # 0 %start
    {  defparms = modestr;     !Save PAD setting for later restore
    {  %if mode&notermecho#0 %start
    {    pad mode="P2=0"; pad mode="P2=1" %if mode&padecho#0
    {    pad mode=pad mode.",P3=127,P4=1,P10=0,P13=0,P15=0"
    {  %else
    {    pad mode="P2=1"; pad mode="P2=0" %if mode&noecho#0
    {    pad mode=pad mode.",P3=126,P4=0,P10=0,P13=0,P15=1"
    {  %finish
    {  setmode(pad mode.",NOCONTROLCHARINTS,NOCRTRANSLATE")
    {%finish %else %start
    {  ! This cludge is to cope with the forwarding of the first character
    {  ! typed after pads change from native mode - urgh! (G.Rule 24/09/86)
    {  setmode("P4=255")
    {  ! Setting a long (but non-zero) timeout before setting zero timeout
    {  ! seems to work!
    {  setmode(defparms);               ! Restore default
    {%finish
    {%end;  !SET HANDLER
    {
    {!!!!!!!!!!!!!  Output to terminal
    {%routine PUT BUFFER
    {%integer from
    {  outcount = 0 %and %return %if outcount <= 0 %or outmode < 0
    {  from = addr(outbuff(0))
    {  console(10,from,outcount)
    {  outcount = 0
    {%end; !of PUT BUFFER
    {!
    {%routinespec put symbol(%integer k)
    {%routinespec put sequence(%integer seq)
    {%own %integer from, amount
    {!
    {%routine GET BUFFER
    {!Request next input packet
    {%integer i,pos,flag,kk, exitflag
    {%constinteger maxecho=63
    {%string(maxecho) echo
    {%own %integer escaping=0
    {  inpos = 0;  incount = 0
    {  leaddels = 0;  traildels = 0
    {  exitflag = options&single;                  ! Always exit if single char.
    {  journal off
    {  %cycle;                                    ! until control char or esc seq.
    {    put buffer %if outcount > 0
    {    console(1,from,amount) %if amount = 0;    ! Get terminal Input
    {    echo = ""
    {    %cycle;                                   ! transfer data to INBUFF
    {      exitflag = 1 %and %exit %unless incount < inbound;       !Buffer full - rest of input is lost
    {      kk = byteinteger(from)&127
    {      from = from + 1; amount = amount - 1
    {      %if kk = del %and options&nodelecho=0 %start
    {        %if incount > 0 %start
    {          %continue %if escaping > 0;       ! Ignore delete during Esc seq.
    {          traildels = traildels+1
    {          incount = incount-1;
    {          %if options&hostecho # 0 %start ;                             ! Connection is by PAD
    {            %if length(echo) > 0 %and char no(echo,1) # bs %start; ! Check for previous DEL
    {              length(echo) = length(echo)-1
    {            %else
    {              put symbol(charno(echo,i)) %for i=1,1,length(echo)
    {              echo=""
    {              %if options&inserting=0 %start
    {                put symbol(bs); put symbol(' '); put symbol(bs)
    {              %else
    {                put symbol(bs); put sequence(dodeletechar)
    {              %finish
    {            %finish
    {          %finish
    {        %finish %else leaddels = leaddels+1
    {      %finish %else %start
    {        inbuff(incount) = kk;  incount = incount+1
    {        %if (kk>=' ' %and escaping=0) %or options&notermecho=0 %start
    {          %if options&hostecho#0 %and options&noecho=0 %start
    {            echo = echo.tostring(kk)
    {            %if length(echo) >= maxecho %start
    {              put symbol(charno(echo,i)) %for i=1,1,length(echo)
    {              echo=""
    {            %finish
    {          %finish
    {          traildels = traildels-1 %if traildels > 0
    {        %finish
    {        %if kk=esc %and escaping = 0 %and options&controlterm#0 %start;      ! Escape
    {          escaping=esc
    {        %finishelseunless ' ' <= kk < del %start;            ! Other Control
    {          escaping=0
    {          exitflag = 1 %if kk=rt %or kk=lf %or options&controlterm#0
    {        %finishelseif escaping # 0 %start
    {          repairch = repairch + 1 %if options&padecho#0
    {          %if escaping=esc %and (kk='[' %or kk ='O' %or kk='?') %start
    {            escaping=kk
    {          %finishelseif escaping='[' %and kk='?' %start
    {          %finishelseif escaping='[' %and '0'<=kk<='9' %start
    {          %else
    {            escaping=0
    {            exitflag = 1
    {          %finish
    {        %finish
    {      %finish
    {    %repeat %until amount = 0
    {    put symbol(charno(echo,i)) %for i=1,1,length(echo)
    {  %repeat %until exitflag # 0
    {  journal on
    {%end;  !of GET BUFFER
    {
    !$FINISH
    !
    !!!!!!!!!!!!!!!!!   Internal procedures   !!!!!!!!!!!!!!!!!!!!
    !
    routine  PUT SYMBOL(integer  k)
    ![also in-line within VT PSYM]
      outbuff(outcount) = k;  outcount = outcount+1
      put buffer if  outcount > outbound
    end
    !
    routine  PUT SEQUENCE(integer  seq)
      while  seq # 0 cycle
        if  seq&escflag # 0 start
          if  seq&127 = 0 start ;  !marker for padding
            seq = seq>>8
            cycle
              put symbol(padchar)
              exit  if  seq&255 = 0
              seq = seq-1
            repeat
          finish  else  if  vttype=bbc  start ;! Allow 8 bit codes- no escapes
            put symbol(seq&255)
          else
            put symbol(esc);  put symbol(seq&127)
          finish
        else
          put symbol(seq&127)
        finish
        seq = seq>>8
      repeat
    end

    routine  put string(string (255) s)
      integer  i
      put symbol(char no(s,i)) for  i = 1,1, length(s)
    end

    routine  PUTNUM(integer  val)
    !Numeric output (for VT100)
      putnum(val//10) and  val = val-val//10*10 if  val >= 10
      put symbol(val+'0')
    end
    !$IF VAX
    string (15)fnspec  smg cursor seq(integer  r,c)
    !$FINISH
    owninteger  ct=0, cb=0;    ! Current settings of scroll region (ANSI only()

    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
      return  if  vdu_fun = 0;      !hardcopy mode
      if  row = vdu_row start
        return  if  col = vdu_col;  !already there =>
    !    Optimise for RT and BS
    !    [RT disabled because of Vax interference]
         if  col = 0 start
           put symbol(rt);  vdu_col = 0
           return
         finish
        if   0 > col-vdu_col >= -3 start
          cycle
            put symbol(bs)
            vdu_col = vdu_col-1
          repeat  until  vdu_col = col
          return
        finish
      finish
                                            ! Don't cause a scroll
      if  col = 0 and  row = vdu_row+1 and  vdu_row # cb start
        put symbol(rt)  ;  ! For EMAS as well since now using graph mode
        put symbol(nl)
        put symbol(padchar) for  k=lfpad,-1,1
    !$IF VAX
    !!    put buffer %if outcount > outbound-80
    !$FINISH
        vdu_row = vdu_row+1;  vdu_col = 0
        return
      finish
      vdu_row = row;  vdu_col = col;      !new values
    !Interpret cursor address sequence
    !**************************************************************************
    ! First test for SETUP from SMG database USE SMG=) for emas
    !$IF VAX
      if  initialise=smg then  put string(smg cursor seq(row,col)) and  return
    !$FINISH
    !**************************************************************************
      seq = docursor
      while  seq # 0 cycle
        k = seq&255
        if  k=rowcode start
          k=row
          k=row+' ' unless  vttype=7 or  vttype=29 or  vttype=31
          k=row+96 if  vttype=esprit
        finish
        if  k = colcode start
          k=col
          k=col+' ' unless  vttype=7 or  vttype=29 or  vttype=31 or  vttype=esprit
          k=col+96 if  vttype=esprit and  col<31
        finish
        put symbol(esc) if  k&escflag # 0
        put symbol(k&127)
        seq = seq>>8
      repeat
      if  vttype = vt100 start ;  !(ESC [ generated from SEQ)
        putnum(row+1) if  row # 0;  !Internal setup only
        put symbol(';') and  putnum(col+1) if  col # 0
        put symbol('H')
      finish
    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   !!!!!!!!!!!!!!!!!!!!
    !
    externalroutine  DELETE CHAR alias  "VTDELCH"
      ! Call is Only valid if VDU_FUN&CANINSERT#0 ie terminal can delete
      put sequence(dodeletechar) if  dodeletechar # 0
    end

    externalroutine  CLEAR LINE alias  "VTCROL"
    integer  pos
      return  if  win_col >= win_cols
      position cursor(win_row,win_col)
      if  win_cols = vdu_cols and  doclearline # 0 start
        put sequence(doclearline)
      finish  else  if  outmode > 0 start
        change shade
        pos = win_col
        cycle
          put symbol(' ');  pos = pos+1
          if  vdu_col < vright then  vdu_col = vdu_col+1 c
          else  vdu_row = 255
        repeat  until  pos = win_cols
      finish
    end
    !
    externalroutine  CLEAR FRAME alias  "VTCFRAME"
      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
    !
    !$IF VAX
    string (15)fnspec  smg set scroll seq(integer  vt,vb)
    !$FINISH
    externalroutine  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 = vbot start ;  !full screen
          put string(full screen scroll) and  vdu_row=255 c
                  if  vdu_fun&ansiscroll # 0 and  (ct # vt or  cb # vb)
          ct = vt; cb = vb
          position cursor(b,0) if  vb # vdu_row;  !any col OK
          while  n>0 cycle
            put symbol(nl);  !hardware scroll
            n=n-1
          repeat
          return
        finish
      finish  else  win_row = t
      if  ansiscroll = 0 start ; !scroll by insert/delete line
        if  dodelete = 0 start
          clear line
          return
        finish
        if  n < 0 start
          n = -n
          i = t;  t = b;  b = i
          vt = t;  vb = b
        finish
        for  i = 1,1,n cycle
          if  vt < vbot start
            position cursor(t,0) if  vdu_row # vt;  !any col OK
            put sequence(dodelete)
            vdu_col = 0
          finish
          if  vb < vbot start
            position cursor(b,0)
            put sequence(doinsert)
          finish
        repeat
      finish  else  start ;  !vt100
        if  vt # ct or  vb # cb start ;    ! Is current scroll region OK?
    !$IF VAX
          if  initialise=smg then  put string(smg set scroll seq(vt,vb)) else  start
    !$FINISH
             put sequence(escflag+'[')
             putnum(vt+1);  put symbol(';');  putnum(vb+1)
             put symbol('r');                  !Set Scrolling region
    !$IF VAX
          finish
    !$FINISH
           cb = vb;  ct = vt
           vdu_row = 255;  !?
        finish
        cycle
          if  n > 0 start
            position cursor(b,0)
            put sequence(doscrolld); !Index
            n = n-1
          finish  else  if  n < 0 start
            position cursor(t,0)
            put sequence(doscrollu); !Reverse Index
            n = n+1
          finish
        repeat  until  n = 0
    !    put string(full screen scroll);  !restore scroll region
    !   vdu_row = 255
      finish
    end ;  !SCROLL
    !
    !$IF VAX
    externalroutine  VT SELECT INPUT alias  "VTSELIN"(integer  i)
      select input(i)
      inmode = -1
      inmode = vdu_fun if  intype = -1 or  options&noevent9 # 0
      inmode = 0 if  i = 0 and  options&16_7FFFFFFF = 0; ! Not in video mode
    end
    externalroutine  VT SELECT OUTPUT alias  "VTSELOUT"(integer  i)
      select output(outstreambase+i)
      outmode = -1
      outmode = vdu_fun if  outtype = -1
      outmode = 0 if  i = 0 and  options&16_7FFFFFFF = 0; ! Not in video mode
    end
    !$IF AMDAHL
    {%externalroutine SELECT INPUT %alias "VTSELIN"(%integer i)
    {%integer k
    {  i = i&15;  k = iocp(selin,i)
    {  inmode = -1
    {  inmode = vdu_fun %if i = 0 {%and aitbuffer # 0;  !terminal}
    {  inmode = 0 %if i = 0 %and options&16_7FFFFFFF = 0; ! Not in video mode
    {%end
    {%externalroutine SELECT OUTPUT %alias "VTSELOUT"(%integer i)
    {%integer k
    {  i = i&15;  i = i+outstreambase %if i # 0
    {  k = iocp(selout,i)
    {  outmode = -1
    {  outmode = vdu_fun %if i = 0 {%and aitbuffer # 0;  !terminal}
    {  outmode = 0 %if i = 0 %and options&16_7FFFFFFF = 0; ! Not in video mode
    {%end
    {!
    !$FINISH

    externalroutine  VT PRINT SYM alias  "VTPSYM"(integer  sym)
    integer  i
      if  outmode <= 0 start ;  !non-video
    !$IF AMDAHL
    {      i = iocp(printch,sym)
    !$IF VAX
    !   %if outmode = 0 %start;  !hard-copy
    !     put symbol(rt) %if sym = nl
    !     put symbol(sym)
    !   %finish %else %start
          print symbol(sym);  !standard route
    !   %finish
    !$FINISH
        return
      finish
      put sequence(doendinsert) and  insertflag = 0 if  insertflag # 0
      if  escaping # 0 start
        escaping = 0
        put symbol(sym)
        vdu_row = 255;  !assume the worst
      finish  else  if  sym = del start
        if  0 < win_col < win_cols start
          win_col = win_col - 1
          position cursor(win_row,win_col) if  win_row+win_top # vdu_row c
                                           or  win_col+win_left # vdu_col
          if  options&inserting#0 start
            put sequence(dodeletechar)
          else
            put symbol(' '); ! put symbol(bs)
            vdu_col = vdu_col + 1 if  vdu_col < vright
          finish
        finish
      finish  else  if  sym&96 # 0 start ;  !not control
        if  win_col < win_cols start
          position cursor(win_row,win_col) if  win_row+win_top # vdu_row c
                                           or  win_col+win_left # vdu_col
          change shade if  win_mode&shade # vdu_mode
          put symbol(sym)
          put buffer if  outcount > outbound
          if  vdu_col < vright then  vdu_col = vdu_col+1 c
          else  vdu_row = 255
        finish
        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)
          put symbol(sym)
          escaping = 1 if  sym = esc
        finish
      finish  else  start
        clear line
        if  win_row < win_rows-1 start
          ![following lines shouldn't be necessary, but lower-level]
          ![software happier with regular NLs]
    !     put symbol(rt);   ! EMAS now drives video T in graph mode so CR needed.
    !     put symbol(nl)
    !     vdu_row = vdu_row+1 %if vdu_row # 255;  vdu_col = 0
          win_row = win_row+1
        finish  else  start
          if  win_mode&freeze # 0 start
    !$IF VAX
            if  inmode < 0 start
              i = instream;  select input(0);  prompt("")
            finish
            sym = single symbol
            if  sym = leadin start
              sym = single symbol
              sym = single symbol if  sym = '?' or  sym = 'O' or  sym = '['
            finish
            vdu_row = 255
            select input(i) if  inmode < 0
    !$IF AMDAHL
    {        i = comreg(instr) %and select input(0) %if inmode < 0
    {!        set handler mode(options&(\specialpad)!notermecho) %c
    {!              %if options&notermecho = 0
    {        get buffer;  incount = 0
    {!        set handler mode(options&(\specialpad)) %if options&notermecho = 0
    {        select input(i) %if inmode < 0
    !$FINISH
          finish
          if  win_mode&(noscroll+freeze) # 0 then  win_row = 0 c
          else  scroll(0,win_row,1)
        finish
        win_col = 0
      finish
    end
    !
    externalroutine  VT SPACE alias  "VTSP"
      vt print sym(' ')
    end
    externalroutine  VT SPACES alias  "VTSPS"(integer  n)
      vt print sym(' ') and  n = n-1 while  n > 0
    end
    externalroutine  VT NEWLINE alias  "VTNL"
      vt print sym(nl)
    end
    externalroutine  VT NEWLINES alias  "VTNLS"(integer  n)
      vt print sym(nl) and  n = n-1 while  n > 0
    end
    externalroutine  VT PRINT STRING alias  "VTPSTRING"(string (255) s)
    integer  i
      vt print sym(charno(s,i)) for  i = 1,1,length(s)
    end
    !
    externalroutine  VT 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
        vt spaces(pos-16-p) if  p < 0
      finish  else  start
        vt spaces(pos-16+p)
        vt print sym(' ') if  v >= 0
      finish
      vt print sym('-') if  v < 0
      vt print sym(store(pos)) and  pos = pos+1 until  pos = 16
    end

    externalroutine  VT PROMPT alias  "VTPROMPT"(string (255) s)
      if  inmode > 0 then  prom <- s else  prompt(s)
    end
    !
    owninteger  pend=\nl
    externalroutine  VT READ SYMBOL alias  "VTRSYM"(integername  k)
    integer  kk,s,i,n
    constinteger  xoff = 'S'&31, xon = 'Q'&31
    routine  get another
    !$IF VAX
      if  inpos >= incount then  kk = single symbol c
      else  kk = inbuff(inpos)&127 and  inpos = inpos+1
    !$IF AMDAHL
    {  get buffer %while inpos >= incount
    {  kk = inbuff(inpos)&127;  inpos = inpos+1
    !$FINISH
      get another if  kk = xoff or  kk = xon
    end
    !$IF AMDAHL
    {  %if inmode <= 0 %start;     ! Hardcopy
    {    flush buffer
    {    k = iocp(readch,0)
    {    kk = iocp(nextch,0) %if k = em; ! signal END OF INPUT at right place
    {    %return
    {  %finish
    !$IF VAX
      read symbol(k) and  return  if  inmode <= 0
    !$FINISH
      k = pend and  pend = \pend and  return  if  pend >= 0
      if  inpos >= incount start
        put sequence(doendinsert) and  insertflag = 0 if  insertflag # 0
        if  prom # "" start
          s = outstream and  select output(0) if  outmode < 0
          vt print sym(charno(prom,i)) for  i = 1,1,length(prom)
          select output(s) if  outmode < 0
        finish
        if  outmode > 0 start
          position cursor(win_row,win_col)
          change shade if  win_mode&shade # vdu_mode
        finish  else  win_col = 0
        if  options&single # 0 start ;                 ! Single character interaction
    !$IF VAX or APM
          kk = single symbol
          put symbol(kk) if  ' ' <= kk < del and  options&noecho = 0;     ! Echo character
    !$IF AMDAHL
    {      get buffer %if inpos >= incount
    {      kk = inbuff(inpos)&127 %and incount = incount - 1 %if incount > inpos
    {      kk = del %and leaddels = leaddels-1 %if leaddels > 0;          ! To ensure del passed through
    !$FINISH
        finish  else  start
          get buffer until  incount > inpos
          kk = inbuff(inpos)&127;  inpos = inpos+1
        finish
      else
        kk = inbuff(inpos)&127;  inpos = inpos+1
      finish
      while  kk = xoff or  kk = xon cycle
        get another
    !$IF VAX
        put symbol(kk) if  ' ' <= kk < del and  options&noecho = 0;     ! Echo character
    !$FINISH
      repeat
      if  kk < ' ' start
    !$IF AMDAHL
    {    %if repairch > 0 %start
    {      inpos = inpos - 1;      !Put off seq till screen OK
    {      repairch = repairch-1
    {      pend = \(del+1); k = del+1
    {      %return
    {    %finish
    !$FINISH
        if  traildels > 0 start
          traildels = traildels-1;  inpos = inpos-1
          pend = \del;  k = del
          return
        finish
        if  kk = rt and  options&leavert = 0 start
    !$IF AMDAHL
    {!      lfmap = rt
    !$FINISH
          kk = lf
        finish  else  if  kk = lf start
          kk = lfmap
        finish  else  if  kk = leadin start
          get another
          if  kk = '[' start ;               ! Esc [
            get another
            get another if  kk='?';          ! Esc [ ?
            if  '0' <= kk <= '9' start ;     !numeric seq, terminated by '~' %or '~'
              n = kk - '0'; get another
              while   '0' <= kk <= '9' cycle ; !Should terminate with '~' but better safe!
                exit  if  n>100000000;     !avoid overflow
                n = 10*n+(kk-'0'); get another
              repeat
              kk = n&127
              if  kk >= 14 then  kk = kk + 60;  ! To avoid conflicting codes
            finish
          finish  else  if  kk = '?' or  kk = 'O' start
            get another;  kk = kk!!96
          finish
          kk = kk!128
        finish
        vdu_row = 255 if  options&notermecho=0 or  options&padecho#0
        kk = nl if  options&leavecontrols = 0
      finish  else  if  kk < del start
        win_col = win_col+inc if  win_col # 255
        if  vdu_col < vright then  vdu_col = vdu_col+inc else  vdu_row = 255
      finish
    !  vdu_row = 255;  ![safety for now]
      pend = \kk;  k = kk;  !NB order
    end

    externalintegerfn  VT NEXT SYMBOL alias  "VTNSYM"
    !$IF VAX
      result  = next symbol if  inmode < 0
    !$IF AMDAHL
    {  %result = iocp(nextch,0) %if inmode < 0
    !$FINISH
      result  = pend if  pend >= 0
      vt read symbol(pend)
      result  = pend
    end
    externalroutine  VT SKIP SYMBOL alias  "VTSSYM"
    integer  i
      vt read symbol(i)
    end

    externalroutine  READ alias  "VTREAD"(integername  v)
    integer  i,k,sign
      cycle
        k = vt next symbol
        exit  unless  k = ' '
        vt read symbol(k)
      repeat
      sign = 0
      if  k = '-' start
        sign = 1
        vt read symbol(k);  k = vt next symbol
      finish
      signal  4 unless  '0' <= k <= '9'
      i = k-'0'
      cycle
        vt read symbol(k)
        k = vt next symbol
        exit  unless  '0' <= k <= '9'
        i = i*10-'0'+k
      repeat
      i = -i if  sign # 0
      v = i
    end

    externalroutine  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
    externalroutine  GOTOXY alias  "VTGOTOXY"(integer  x,y)
      at(y,x)
    end
    externalroutine  VT SET MODE alias  "VTSETMODE"(integer  m)
      win_mode = win_mode&shade+m
    end
    externalroutine  SET SHADE alias  "VTSETSHADE"(integer  s)
      win_mode = win_mode&(\shade)+s
    end
    !
    externalroutine  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
    !
    externalroutine  PUSH WINDOW alias  "VTPUSH"
      if  sp = stackmax start
        event_message = "Too many windows";  signal  9,4
      finish
      sp = sp+1;  stack(sp) = win
    end

    externalroutine  POP WINDOW alias  "VTPOP"
      if  sp > 0 then  win = stack(sp) and  sp = sp-1 c
      else  win = vdu
    end

    externalroutine  SWOP WINDOW 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

    externalroutine  SET VIDEO MODE alias  "VTSETVIDEO"(integer  mode)
    integer  p,i
      put buffer if  outcount > 0;  !this routine guaranteed to flush
      return  if  mode = options
      p = mode&specialpad
    !$IF VAX
      if  options = untouched start
        tt setup
        inmode = vdu_fun if  intype = -1;  !terminal
        outmode = vdu_fun if  outtype = -1
        win = vdu;  prompt("")
      finish
      !interpret NOEVENT9 to mean use terminal anyway
      inmode = vdu_fun and  outmode = vdu_fun if  mode&noevent9 # 0
      readfunction = vmsread;       !basic function selection
      readfunction = readfunction+vmsnoecho if  mode&noecho # 0
      readfunction = readfunction+vmstrmnoecho if  mode&notermecho # 0
      readfunction = readfunction+vmspurge if  mode&notypeahead # 0
      termmask_length = 0;  termmask_addr = \16_1700;  !normal terminators
      if  mode&controlterm # 0 start
        termmask_addr = \0;           !all controls as terminators
        if  mode&passdel # 0 start ;  !DEL too?
          termmask_length = 16;  termmask_addr = addr(mask(0))
        finish
      finish
      readfunction = readfunction+vmsnofiltr if  mode&(passdel+nodelecho) # 0
    !$IF AMDAHL
    {  %if options = untouched %start
    {    select input(0);  select output(0)
    {    journal off %if mode&debug # 0;      ! For now, since CONSOLE calls fill it
    {    inmode = vdu_fun;  outmode = vdu_fun
    {    win = vdu;  prompt("")
    {  %finish
    {  ! Coerce mode options to be consistent
    {  mode=mode&(\padecho) %if  mode&noecho # 0
    {  mode=mode!nodelecho  %if  mode&noecho#0
    {  mode=mode!hostecho   %if  mode&notermecho#0 %c
    {                       %and mode&padecho=0;        !Flag for GET BUFF to echo.
    !$FINISH
      if  (mode!!options)&specialpad # 0 start ;  !change in pad mode
        if  p # 0 then  put sequence(dospecialpad) c
        else  put sequence(donormalpad)
        put string(initialise tt) if  p#0
      finish
      if  (mode!!options)&inserting # 0 start ;  !set terminal to insert mode
        if  mode&inserting # 0 start
          if  insert flag = 0 then  put sequence(do begin insert)
          insert flag = 0
        finish  else  insert flag = 1;        !Still in video mode
      finish
      if  mode = 0 start ;    ! Reset everything
        put sequence(do end insert) if  insert flag # 0;    !This is fairly final
        scroll(0,vdu_rows-1,0);   ! To reset scroll area on DEC - like terminals
        position cursor(vdu_row,vdu_col);  ! The call on Scroll moved the cursor
        put buffer; !BEFORE resetting PAD mode so that ESC gets through.
    !$IF AMDAHL
    {  %finishelseif options&16_3FFFFFFF = 0 %start
    {    amount = 0;          ! Tell GET BUFFER that no input is outstanding
    {    flush buffer;        ! empty SYSTEM IO buffer before VECCE takes over
    {  %finish
    {  set handler mode(mode-p)
    !$IF VAX
     finish
     set handler mode(mode) if  vdu_fun#0
    !$FINISH
      put buffer;            ! After setting PAD or TCP on entry
      options = mode
      inc = 1;  inc = 0 if  options&noecho # 0
      if  in stream = 0 start
        if  mode = 0 then  inmode = 0 else  inmode = vdu_fun
      finish
      if  out stream = 0 start
        if  mode = 0 then  outmode = 0 else  outmode = vdu_fun
      finish
    end

    string (255)fn  setup bbc
    !  Set up sequences for *KEY definitions for BBC in XTALK mode
      integer  i
      string (255) bbcset,bbcoff
      string (1) se
      ownstring (2) snl
      snl=tostring(lf)
    !$IF VAX
      snl=tostring(rt).snl
    !$FINISH
      se=tostring(esc)
      bbcset=""
      bbcset = se."*FX 4,2".snl
      for  i=0,1,9 cycle
         bbcset=bbcset.se."*KEY ".tostring(i+'0')." |[?".tostring(i+'p').snl
      repeat
      bbcset=bbcset.se."*KEY 10 |[?z".snl
      for  i=0,1,4 cycle
         bbcset=bbcset.se."*KEY 1".tostring(i+'1')." |[?".tostring(i+'@').snl
      repeat
      bbcoff=se."*FX 4,0".snl
      result =bbcset
    end ;                        !of SETUP BBC
    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

    !At present it is convenient to have a self-contained facility
    ! in the package for setting up the video attributes and
    ! control sequences appropriate to a given terminal, but
    ! it is assumed that this will be superseded by a more
    ! general facility (or set of facilities).
    ! There are a number of gaps and untried cases in the following.
    !
    !$IF VAX
    own  integer  term addr
     include  "SMGTRMPTR.INC"

      external  integer  fn  spec  init term table by type alias  c
    "SMG$INIT_TERM_TABLE_BY_TYPE" (integername  devtype,adr)
      external  integer  fn  spec  get term data alias  c
    "SMG$GET_TERM_DATA" (integername  adr,code,buflen,retlen,integer  bufad,parad)

    integer  fn  VMS TERMINAL TYPE
       integer   devtype,flag,len
       record (desc fm) d
       recordformat  item fm(short  buff len, code, integer  buff addr, ret len)
       record (item fm) null=0,item
       string (2) term
       constinteger  dvi devtype=6

       system  integerfn  spec  getdviw(integername  efn,chan,
                                        record (desc fm)name  devnam,
                                        record (item fm)name  itmlst,
                                        record (*)name  iosb,
                                        integer  ast addr,
                                        integer  ast parm,null)
       term="TT"; d_length=length(term); d_addr=addr(term)+1
       item_code = dvi devtype; item_buff len=4;
       item_buffaddr=addr(devtype);item_retlen=addr(len)
       flag=get dviw(integer(0),integer(0),d,item,record(0),0,0,0)
       result =devtype if  flag=1
       result =-1
    end

    integerfn  emas terminal type
      string (31) term
      integer  flag,data,len,size=size of(term)-1,code=smg name
      flag=get term data(term addr,code,size,len,addr(term)+1,0)
      signal  13,4,flag unless  flag=1
      length(term)<-len
      result  = 8 if  term = "VT52"
      result  = 11 if  term = "FT1";!     Visual 200
      result  = 12 if  term = "VT100"
      result  = 6  if  term = "FT2" or  term="BANTAM" or  term="PE550"
      result  = 13 if  term = "FT3" or  term="ESPRIT"
      result  = 15 if  term = "FT4" or  term="NEWBURY"
      result  = 25 if  term = "VISUAL50" or  term = "VISUAL55"
      result  = 29 if  term = "BBCX";   ! BBC micro with XTALK
      result  = 0
    end
    !
    integer  fn  smg get integer(integer  code)
       integer  flag,data,len,size=4
       flag=get term data(term addr,code,size,len,addr(data),0)
       signal  13,4,flag unless  flag=1
       data=0 if  len=0
       result =data
    end

    string (31) fn  smg get string 2(integer  code)
       ! RETURN STRING DATA FROM SMG
       constinteger  slen=31
       integer  flag,len,size=slen,i,seq,sh,k,pads
       string (slen) data
       flag=get term data(term addr,code,size,len,addr(data)+1,0)
       signal  13,4,flag unless  flag=1
       length(data)<-len
       result =data
    end

    integer  fn  smg get string 3(integer  code)
       ! RETURN STRING DATA FROM SMG IN SAME FORM AS READ SYMBOL (For cursor keys)
       constinteger  slen=31
       integer  flag,len,size=slen,i,k
       string (slen) data
       flag=get term data(term addr,code,size,len,addr(data)+1,0)
       signal  13,4,flag unless  flag=1
       length(data)<-len
       result  = 0 if  len = 0
       i=1
       k=char no(data,i)
       if  k=esc start
          i=i+1
          signal  13,1 if  i>length(data)
          k=char no(data,i)
          if  k='[' then  i=i+1 and  k=char no(data,i)
          signal  13,1 if  i>length(data)
          if  k='O' or  k='?' start
             i=i+1
             signal  13,1 if  i>length(data)
             k=char no(data,i)!!96
          finish
          k=k!escflag
       finishelseif  k=lf start
          k=rt
       finishelseif  k=rt start
          k=lf
       finish
       result =k&255
    end

    integer  fn  smg get string(integer  code)
       ! RETURN STRING DATA FROM SMG PACKED AS VECCE INTEGER SEQ
       constinteger  slen=31
       integer  flag,len,size=slen,i,seq,sh,k,pads
       string (slen) data
       flag=get term data(term addr,code,size,len,addr(data)+1,0)
       signal  13,4,flag unless  flag=1
       length(data)<-len
       i=0; sh=0; seq=0;pads=0
       while  i<length(data) and  sh<=24 cycle ; ! Code string as packed integer
          i=i+1; k=0
          i=i+1 and  k=escflag if  char no(data,i)=esc
          signal  13,1 if  i>length(data)
          k=k+char no(data,i)
          while  i<=length(data) and  char no(data,i)=0 cycle ; ! Count Padding chars
             pads=pads+1; i=i+1
          repeat
          if  pads>0 start ;                   ! Code padding as ESCFLAG,NPADS
             signal  13,2 if  sh>16
             seq=seq ! escflag<<sh; sh=sh+8
             seq=seq ! pads<<sh;    sh=sh+8
             pads=0
          finish
          seq=seq ! k << sh;  sh=sh+8
       repeat
       result =seq
    end

    string (15)fn  smg cursor seq(integer  r,c)
       integerarray  parms(0:2)
       integer  flag,len,size=15,code=smg set cursor abs
       string (15) data
       parms(0)=2; parms(1)=r+1; parms(2)=c+1
       flag=get term data(term addr,code,size,len,addr(data)+1,addr(parms(0)))
       signal  13,4,flag unless  flag=1
       length(data)<-len
       result =data
    end

    string (15)fn  smg set scroll seq(integer  t,b)
       integerarray  parms(0:2)
       integer  flag,len,size=15,code=smg set scroll region
       string (15) data
       parms(0)=2; parms(1)=t+1; parms(2)=b+1
       flag=get term data(term addr,code,size,len,addr(data)+1,addr(parms(0)))
       signal  13,4,flag unless  flag=1
       length(data)<-len
       result =data
    end

    routine  SETUP FROM SMG
       integer  vaxtype,flag,cols2
    !  %on %event 13 %start
    !     vdu_fun=0
    !     %monitor
    !     %return
    !  %finish

       vaxtype = VMS TERMINAL TYPE
       flag = init term table by type(vaxtype,term addr)
       if  flag&1 # 0 start ;        ! Success
          vttype=emas terminal type
          initialise=smg; vdu = 0
          vdu_rows= smg get integer(smg rows);     vbot=vdu_rows-1
          vdu_cols= smg get integer(smg columns)
          cols2= smg get integer(smg wide screen columns)
          vdu_cols=cols2 if  options&wide#0 and  cols2#0
          vright=vdu_cols-1
          vdu_fun=0
          doclearscreen=smg get string(smg erase to end display)
          doclearline  =smg get string(smg erase to end line)
          vdu_fun=vdu_fun + fullscroll if  smg get string(smg set cursor abs)#0
          dodelete=smg get string(smg delete line)
          doinsert=smg get string(smg insert line);
          dobegininsert=smg get string(smg begin insert mode)
          doendinsert  =smg get string(smg end   insert mode)
          dodeletechar =smg get string(smg delete char)
    !     docursorl    =smg get string(smg cursor left)
          vdu_fun=vdu_fun+caninsert c
                if  dodeletechar#0 and  dobegininsert#0 and  doendinsert#0
          if  smg get string(smg set scroll region) # 0 start ; ! VT100 type scroll
             doscrolld = smg get string(smg scroll forward);    ! These entries should be there
             doscrollu = smg get string(smg scroll reverse);    ! But people make mistakes
             vdu_fun=vdu_fun!anyscroll and  ansiscroll = 1 unless  doscrolld=0 or  doscrollu=0
             full screen scroll=smg set scroll seq(0,vdu_rows-1)
          finish
          vdu_fun=vdu_fun!anyscroll unless  dodelete=0 or  doinsert=0; ! Scroll via insert/delete
          dostandard=0; dograph=0
          donormalpad= smg get string(smg set numeric keypad)
          dospecialpad=smg get string(smg set application keypad)
          doselect(0) = smg get string(smg begin normal rendition)
          doselect(1) = smg get string(smg begin reverse);                ! First try reverse video
          doselect(1) = smg get string(smg begin bold) if  doselect(1)=0; ! Then bold
          doselect(1) = smg get string(smg begin underscore) if  doselect(1)=0; ! Then underline
          doselect(1) = smg get string(smg begin blink) if  doselect(1)=0
          vdu_fun=vdu_fun ! 1 if  doselect(1) #0
          key u=smg get string3(smg key up arrow)
          key d=smg get string3(smg key down arrow)
          key l=smg get string3(smg key left arrow)
          key r=smg get string3(smg key right arrow)
          padchar=smg get string(smg pad char)
          lfpad=smg get integer(smg lf fill)
    !     lfpad=20 %if vttype=vt52;   !Pad chars after LF
          initialise tt=""
          initialise tt=setup bbc if  vttype=bbc
       else
          initialise=internal
          vdu = 0;  vdu_rows = 24; vdu_cols = 80
          printstring(sysmess(flag).snl)
       finish
    end
    !$FINISH

    routine  SETUP INTERNAL(integer  emastype)
    !Use EMAS video type number to set up video parameters
    !    ie VDU details and control sequences
    ! The following byte array contains one IMP string for each
    ! terminal, specifying the following information:
    !     ROWS,COLS,CLEARSSEQ,CLEARLSEQ,CURSORSEQ,
    !     DELETESEQ,INSERTSEQ,
    !     STANDARDSEQ,GRAPHSEQ,
    !     NORMALPADSEQ,SPECIALPADSEQ,
    !     SELECTSEQ(0:15)
    ! Sequences may be up to 4 bytes and if less than 4 are
    ! terminated by a zero byte;  trailing null sequences may
    ! be omitted.
    ![Accommodation of individual device idiosyncrasies is]
    ![minimal and ad hoc: it would be easy to spend a lifetime]
    ![generalising to cater for all sorts of antiquated terminals]
    constinteger  E=128,R=254,C=255
    constinteger  MAXTYPE=33
    constbyteintegerarray  VINFO(0:532) =
    {0:  unspecified}        2,24,72,
    {1:  hardcopy width 72}  2,24,72,
    {2:  hardcopy width 80}  2,24,80,
    {3:  hardcopy width 132} 2,24,132,
    {4:  unknown video}      2,24,80,
    {5:  ITT}                2,24,80,
    {6:  P-Elmer Bantam}     13,24,80, e+'K',e,20,0, e+'I',e,0,
                                e+'X',r,e+'Y',c,
    {7:  Lynwood}            23,30,80,'A'&31,0,0,'X'&31,r,c,0,0,0,0,0,
                                'R'&31,'D'&31,'V'&31,0,
                                'S'&31,'T'&31,0,'Q'&31,0,'R'&31,
    {8:  DEC VT52}           17,24,80, e+'J',0, e+'K',0, e+'Y',r,c,0,
                                0,0, 0,0,
                                e+'>',0,e+'=',
    {9:  micro}              2,24,80,
    {10: ADM-3A}             8,24,80, 'Z'&31,0, 0, e+'=',c,r,
    {11: Visual 200}         25,24,80, e+'v',0, e+'x',0, e+'Y',r,c,0,
                                e+'M',0,e+'L',0,
                                e+'G',0,e+'F',0,
                                e+'>',0,e+'=',0,
                                e+'3',0,e+'4',
    {12: VT100}              34,24,80, e+'[','J',0, e+'[','K',0, e+'[',0,
                                e+'[','M',0,e+'[','L',0,
                                e+'[','(','B',0,e+'[','(','0',0,
                                e+'>',0,e+'=',0,
                                e+'[','m',0,e+'[','7','m',
    {13: Hazeltine Esprit}   27,24,80, e+24, 0, e+15,0, e+17,c,r,0,
                               e+19,e,20,0,e+26,e,20,0, {20 pads}
                               0,0,
                               e+'>',0,e+'=',0,
                               e+25,0,e+31,
    {14: Hazeltine 1500}     2,24,80,
    {15: Newbury}            21,24,80, 16_1F,0, 16_19,0, 16_16,c,r,0,
                               2,0,1,0,
                               0,0,
                               0,0,
                               16_13,0,16_12,
    {16: Pericom}            34,24,80, e+'[','J',0, e+'[','K',0, e+'[',0,
                                e+'[','M',0,e+'[','L',0,
                                e+'[','(','B',0,e+'[','(','0',0,
                                e+'>',0,e+'=',0,
                                e+'[','m',0,e+'[','7','m',
    {17: Tektronix 4010}     2,24,80,
    {18: IBM 3101}           2,24,80,
    {19: Dacoll 242E}        2,24,80,
    {20: Volker Craig 404}   8,24,80, 0, 'V'&31,0, 'P'&31,r,c,
    {21: ICL KDS7362}        20,24,80, 0, e+'T',0, e+'=',r,c,0,
       {&Televideo 912/20/25}  e+'R',0,e+'E',0,
                               0,0, 0,0,
                               e+'(',0,e+')',
    {22: Esprit II}          2,24,80,
    {23: Esprit III}         2,24,80,
    {24: ADM-5}              19,24,80, 'Z'&31,0, e+'T',0, e+'=',r,c,0,
                                0,0, 0,0, 0,0, e+'(',0,e+')',
    {25: Visual 50/5}        26,24,80, 0, e+'K',0, e+'Y',r,c,0,
                                e+'M',0,e+'L',0, e+'G',0,e+'F',0,
                                e+'>',0,e+'9','P',e+'=',0,
                                e+'T',0,e+'U',
    {26: TEKTRONIX 4014}     2,64,132,
    {27: Datatype X5A}       34,24,80, e+'[','J',0, e+'[','K',0, e+'[',0,
                                e+'[','M',0,e+'[','L',0,
                                e+'[','(','B',0,e+'[','(','0',0,
                                e+'>',0,e+'=',0,
                                e+'[','m',0,e+'[','7','m',
    {28: ANSI}               34,24,80, e+'[','J',0, e+'[','K',0, e+'[',0,
                                e+'[','M',0,e+'[','L',0,
                                e+'[','(','B',0,e+'[','(','0',0,
                                e+'>',0,e+'=',0,
                                e+'[','m',0,e+'[','7','m',
    {29: BBC with XTALK}     23,24,80,16_0C,0,0,16_1F,c,r,0,
                             0,0, 0,0, 0,0,
                             17,130,17,1, 17,129,17,2,
    {30: cromenco }         2, 24, 80,
    {31: Wyse - 132 col }    34,24,132, e+'[','J',0, e+'[','K',0, e+'[',0,
                                e+'[','M',0,e+'[','L',0,
                                e+'[','(','B',0,e+'[','(','0',0,
                                e+'>',0,e+'=',0,
                                e+'[','m',0,e+'[','7','m',
    {32: Wyse -  80 col }    34,24,80, e+'[','J',0, e+'[','K',0, e+'[',0,
                                e+'[','M',0,e+'[','L',0,
                                e+'[','(','B',0,e+'[','(','0',0,
                                e+'>',0,e+'=',0,
                                e+'[','m',0,e+'[','7','m',
    {33: Vt100 }             34,24,80, e+'[','J',0, e+'[','K',0, e+'[',0,
                                e+'[','M',0,e+'[','L',0,
                                e+'[','(','B',0,e+'[','(','0',0,
                                e+'>',0,e+'=',0,
                                e+'[','m',0,e+'[','7','m',
                             0 (*)
    integer  t,l,i,suppress
    integerfn  NEXTSEQ
    integer  seq,k,sh
      seq = 0;  sh = 0
      while  l > 0 and  sh <= 24 cycle
        l = l-1;  t = t+1
        k = vinfo(t)
        exit  if  k = 0
        seq = seq+k<<sh;  sh = sh+8
      repeat
      result  = 0 if  suppress&1 # 0
      result  = seq
    end

      emastype = 0 if  emastype > maxtype
      suppress=0
      vttype = emastype
      t = 0
      cycle
        l = vinfo(t);             !length of data for this terminal
        emastype = emastype-1
        exit  if  emastype < 0
        t = t+l+1
      repeat
      vdu = 0
      vdu_rows = vinfo(t+1);  vbot = vdu_rows {-1}
      vdu_cols = vinfo(t+2);  vright = vdu_cols-1
      t = t+2;  l = l-2
      vdu_fun = 0
      doclearscreen = nextseq;  doclearline = nextseq
      suppress = suppress&(\1)
      docursor = nextseq;  vdu_fun = vdu_fun+fullscroll if  docursor # 0
      suppress = suppress>>1
      dodelete = nextseq;  vdu_fun = vdu_fun+anyscroll if  dodelete # 0
      doinsert = nextseq
      suppress = suppress&(\1)
      dostandard = nextseq;  dograph=nextseq
      donormalpad = nextseq;  dospecialpad = nextseq
      if  vttype = pericom or  vttype = wyse or  vttype = wysew start
        do begin insert = escflag+'[' + '4'<<8 + 'h'<<16
        do end insert =   escflag+'[' + '4'<<8 + 'l'<<16
        do delete char =  escflag+'[' + 'P'<<8
        vdu_fun = vdu_fun ! caninsert
      finish
    !  %if vttype = esprit %start;   ! Don't know if this works
    !    do begin insert = escflag+'#'+(escflag+'P'<<8)
    !    do end insert   = escflag+'P'+(escflag+'$'<<8)
    !    do delete char  = escflag+'T'
    !    vdu_fun = vdu_fun ! caninsert
    !  %finish
      if  vttype=vt100{105} or  vttype = wyse or  vttype = pericom or  vttype = ansi or  c
          vttype = x5a or  vttype = wysew or  vttype = 33 {VT100} start
        vdu_fun=vdu_fun ! anyscroll
        ansiscroll = 1
        doscrolld = escflag+'D'
        doscrollu = escflag+'M'
        full screen scroll=tostring(esc)."[;r"
        vttype = vt100
      finish
      suppress = suppress>>1
      for  i = 0,1,15 cycle
        doselect(i) = nextseq
        vdu_fun = vdu_fun!i if  doselect(i) # 0
      repeat
      if  vttype=vt52 then  lfpad=20;   !padding after lf
      initialise tt=""
      initialise tt=setup bbc if  vttype=bbc
    end

    externalroutine  DEFINE VIDEO alias  "VTDEFVIDEO"(integer  emastype)
    !$IF AMDAHL
    {   emastype = uinfi(terminaltype) %if emastype < 0;  !terminal type
    {   emastype = 0 %if uinfi(tmode) = batch;        ! Disallow screen mode from batch
    !$IF VAX
      emastype = 0 if  batch mode # 0
      SETUP FROM SMG if  emastype < 0
      emastype = vttype and  initialise = internal if  vttype=esprit;
                                               ! Cursor addressing for esprit I
                                               ! can not be done by SMG. II& III OK.
    !$FINISH
      emastype = esprit if  emastype = 22 or  emastype = 23
      setup internal(emastype) if  initialise=internal
      vdu_row = 255;  ![safety]
    end

    endoffile