!!!!!!!!!!!!!! Standard Video Terminal Interface !!!!!!!!!!!!!
!!!!!!!!!!!!!!!! for Vax/VMS, Emas and APM !!!!!!!!!!!!!!!!!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! Hamish Dewar EU Computer Science Department January 1983 !
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! 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, 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,
newtcp=1<<29 {temp}
! 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)
externalrecord (wininfo) VDU; !full-screen frame
externalrecord (wininfo) WIN; !current frame
externalinteger LEADIN=esc
constinteger STACKMAX=7
ownrecord (wininfo)array STACK(1:stackmax)
owninteger SP=0
!
!$IF EMAS
{%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 esprit=13, vt100=12; !special cases of VTTYPE
externalinteger vttype=-1
! 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]
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'
externalintegerarray doselect(0:15) = escflag+'3', escflag+'4', 0 (*)
!
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 EMAS
{%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
!$IF VAX
constinteger outstreambase=0
constinteger lfmap=rt
!%externalintegerfnspec UINFI(%integer i)
!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}
!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)
routine IO fail(integer why)
{\V10IMP %externalstring(127)%fn %spec sysmess(%integer i)
{\V10IMP event_message = sysmess(why)
{V10IMP} from imp include sysmisc
{V10IMP} event_message = get message(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
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 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
routine GET BUFFER
!Read characters to INBUFF
integer status,i,k
record (IOSB fm) IOSB
incount = 0; inpos = 0; traildels = 0
cycle
put buffer if outcount # 0
! %if options&inserting # 0 %start
! k = single symbol
! %exit %if k < ' '
! insert char(k)
! %finish %else %start
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
outbuff(0) = bs; outbuff(1) = ' '; outbuff(2) = bs
outcount = 3
finish
! %finish
repeat
incount = incount+IOSB_termlength
end
!$IF EMAS
{%owninteger lfmap=lf; ![no mapping unless RT seen]
{!!!!!!!!!!!!!!!!! Emulation of part of Emas IOCP !!!!!!!!!!!!!!!!
{!
{%externalintegerfnspec UINFI(%integer I)
{%externalintegerfnspec EXIST(%string(255) S)
{%externalroutinespec PROMPT(%string(15) S)
{%externalroutinespec DEF INFO(%integer CHAN,
{ %string(255) %name FILENAME, %integer %name STATUS)
{%systemintegermapspec COMREG(%integer N)
{! COMREG values used -
{%constinteger INSTR = 22, OUTSTR = 23, ERRMESS = 24
{%systemintegerfnspec IOCP(%integer entry,param)
{%constinteger READCH=4, PRINTCH=5, SELIN=8, SELOUT=9,
{ RESET=16, NEXTCH=18
{%recordformat ITF(%integer inbase, inlength, inpointer, outbase, %c
{ outlength, outpointer, outbusy, omwaiting, inttwaiting, %c
{ jnbase, jncur, jnmax, lastfree, spare5, spare6, spare7)
{%recordformat IOSTATF(%integer inpos, %string (15) intmess)
{%systemroutinespec CONSOLE(%integer ep, %integername start, len)
{%systemroutinespec DEFINE(%integer chan, %string(255) parm,
{ %integername a,b)
{%systemstring(255)%fnspec FAILURE MESSAGE(%integer errno)
{%externalroutinespec DSTOP(%integer i)
{%externalintegerfnspec REQUESTINPUT(%integer trigad, inad)
{%externalintegerfnspec REQUESTOUTPUT(%integer trigad, outad)
{!
{%owninteger aitbuffer=0, aiostat=0
{%ownrecord(itf)%name it
{%ownrecord(iostatf)%name iostat; !status of input from fep
{%owninteger outstreambase=0; !or 16
{%ownstring(1) emasprom="?"
{!
{%routine MOVE(%integer length, from, to)
{!Block move
{ *LB_LENGTH
{ *JAT_14,<L99>
{ *LDTB_X'18000000'
{ *LDB_%B
{ *LDA_FROM
{ *CYD_0
{ *LDA_TO
{ *MV_%L=%DR
{L99:
{%END
{!
{!IMP77 compatible I/O
{%externalroutine OPEN INPUT %alias "VTOPIN"(%integer STREAM, %string(255) FILE)
{%integer flag,dump
{ %signal 9,2 %unless 0 < stream <= 15
{ %if charno(file,1) # '.' %and exist(file) = 0 %start
{ event_message = file." not found"
{ %signal 9,3
{ %finish
{ dump = iocp(reset,stream)
{ define(stream,file,dump,flag)
{ %if flag # 0 %start
{ define(stream,".null",dump,dump)
{ event_message = failure message(flag)
{ %signal 9,3
{ %finish
{%end
{
{%externalroutine OPEN OUTPUT %alias "VTOPOUT"(%integer STREAM, %string(255) FILE)
{!ANY CALL ON THIS PROCEDURE IMPLIES IMP77 OUTPUT STREAM NUMBERING
{%integer flag,dump
{ %signal 9,2 %unless 0 < stream <= 15
{ outstreambase = 16; stream = stream+outstreambase
{ dump = iocp(reset,stream)
{ define(stream,file,dump,flag)
{ %if flag # 0 %start
{ define(stream,".null",dump,dump)
{ event_message = failure message(flag)
{ %signal 9,3
{ %finish
{%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
{
{!!!!!!!!!!!! Set tcp options
{%routine SET HANDLER MODE(%integer mode)
{!The following rubbish to stop IOCP searching for non-existent NL:
{%record %format FDF(%integer link, dsnum,
{ %byteinteger status, accessroute, valid action, cur state,
{ %byteinteger mode of use, mode, file org, dev code,
{ %byteinteger rec type, flags, lm, rm,
{ %integer asvar, arec, recsize, minrec, maxrec, maxsize,
{ lastrec, conad, currec, cur, end, transfers, darecnum,
{ cursize, datastart, %string (31) iden,
{ %integer keydesc0, keydesc1, recsizedesc0, recsizedesc1,
{ %byte %integer f77flag, f77form, f77access, f77status,
{ %integer f77recl, f77nrec, idaddr,
{ %byte %integer f77blank, f77ufd, spare1, spare2)
{%systemintegerfnspec fdmap(%integer chan)
{%record(fdf)%name inf
{!TCP SETMODE codes
{%constinteger SCREENMODE=23,
{ CCMASK1=24, CCMASK2=25, CCMASK3=26, CCMASK4=27,
{ CSMASK=29, {control sequence terminators}
{ DELOPTIONS=31, {DEL treatment}
{ LEADINS=32, {define LEADIN1,LEADIN2}
{ INTERMED=33, {define intermediate range}
{ GRAPH=11, {graph-mode - to stop line-breaking}
{ INTERRUPT=6, {select interrupt char}
{ ZMODE=19
{%constinteger OFF=0, ON=1
{%constbyteintegerarray SET Z MODE(0:4) = 4,
{ graph,on, zmode,on
{%constbyteintegerarray RESET Z MODE(0:2) = 2,
{ zmode,off
{%constbyteintegerarray SET SCREEN MODE(0:40) = 40,
{ interrupt,'@'&31, graph,on,
{ ccmask1,16_FF, ccmask2,16_FF, ccmask3,16_FF, ccmask4,16_F7, {not ESC}
{ csmask,0,16_FF(16),
{ screenmode,on,
{ leadins,esc,'?', intermed,1,0, {no intermediates}
{ deloptions,5 {*uncertain*}
{%constbyteintegerarray SET SCREEN MODE vt100(0:40) = 40,
{ interrupt,'@'&31, graph,on,
{ ccmask1,16_FF, ccmask2,16_FF, ccmask3,16_FF, ccmask4,16_F7, {not ESC}
{ csmask,0,16_FF(16),
{ screenmode,on,
{ leadins,esc,'O', intermed,'[','[',
{ deloptions,5 {*uncertain*}
{%constbyteintegerarray RESET SCREEN MODE(0:4) = 4,
{ screenmode,off, interrupt,esc
{
{%routine SEND(%byteintegerarrayname a)
{%integer i,j
{ i = addr(a(0)); j = 1
{ console(17,i,j); !set tcp mode
{%end
{
{ %if mode # 0 %start
{ %if mode&newtcp # 0 %start
{ %if vttype # vt100 %then send(set screen mode) %c
{ %else send(set screen mode vt100)
{ %finish %else send(set z mode)
{ %finish %else %start
{ %if options&newtcp # 0 %start
{ send(reset screen mode)
{ INF == RECORD (fdMAP(90)) {****}
{ INF_CURREC = INF_CUR {****}
{ %finish %else send(reset z mode)
{ %finish
{%end; !SET HANDLER
{!
{!!!!!!!!!! Output to journal file (*not used*)
{%routine TOJOURNAL(%integer from,len)
{%integer hole
{ %return %if it_jnbase <= 0 %or len <= 0; !nojournal or no text
{ len = 4096 %if len > 4096; !truncate long requests
{ %if it_jncur+len >= it_jnmax %start
{ hole = it_jnmax-it_jncur
{ move(hole,from,it_jncur)
{ it_jncur = it_jnbase+32; !use constant in case header corrupt
{ len = len-hole; from = from+hole
{ %finish
{ move(len,from,it_jncur)
{ it_jncur = it_jncur+len
{ byteinteger(it_jncur) = 255; !current end-marker
{%end
{
{!!!!!!!!!!! Store data in system terminal buffer
{%routine TOBUFFER(%integer start,len, %integername pos)
{!Put data into output buffer wrapping around if required
{!POS returns the position of the next free byte in the buffer
{!** Freespace is known to be sufficient **
{%integer hole
{ hole = it_outlength-it_outpointer
{ %if len <= hole %start; !no split needed
{ move(len,start,it_outbase+it_outpointer)
{ pos = it_outpointer+len
{ pos = 0 %if pos = it_outlength; !deal with exact fit
{ %finish %else %start
{ move(hole,start,it_outbase+it_outpointer)
{ len = len-hole
{ move(len,start+hole,it_outbase); !put rest at start of buffer
{ pos = len
{ %finish
{%end
{
{!!!!!!!!!!!!! Output to terminal
{%routine PUT BUFFER
{%integer free,pos,flag,trigger,from
{ outcount = 0 %and %return %if outcount <= 0 %or outmode < 0
{ from = addr(outbuff(0))
{ it_outbusy = 1
{!Note: output to recall file suppressed
{! tojournal(from,len)
{ %cycle
{ free = it_lastfree-it_outpointer
{ free = free+it_outlength %if free <= 0
{ free = free-maxprompt
{ free = 0 %if free < 0
{ %exit %if outcount <= free; !enough room for it all
{ tobuffer(from,free,pos); !pos points to byte after inserted text
{ trigger = pos-it_outlength>>2; !send 3/4 of buffer
{ trigger = trigger+it_outlength %if trigger < 0
{ it_outpointer = pos
{ outcount = outcount-free; from = from+free
{ flag = requestoutput(pos,trigger)
{ dstop(115) %if flag < 0
{ it_lastfree = flag
{ %repeat
{ %if outcount > 0 %start; !some left
{ tobuffer(from,outcount,pos)
{ it_outpointer = pos
{ flag = requestoutput(pos,-1)
{ dstop(115) %if flag < 0
{ it_lastfree = flag
{ %finish
{ it_outbusy = 0
{ console(6,flag,flag) %if it_omwaiting # 0
{ console(12,flag,flag) %if it_inttwaiting # 0
{ outcount = 0
{%end; !of PUT BUFFER
{!
{%routine GET BUFFER
{!Request next input packet
{%integer i,pos,flag,kk
{ put buffer %if outcount > 0
{ inpos = 0; incount = 0
{ leaddels = 0; traildels = 0
{ %while it_inpointer = iostat_inpos %cycle
{ pos = it_outpointer
{ tobuffer(addr(emasprom)+1,length(emasprom),pos)
{ it_outbusy = 1; !dont print oper message while waiting for input
{ flag = requestinput(pos,it_inpointer); !get input
{ dstop(111) %if flag # 0
{ it_outbusy = 0
{ console(12,flag,flag) %if it_inttwaiting # 0
{ console(6,flag,flag) %if it_omwaiting # 0
{ %repeat
{ %cycle
{ kk = byteinteger(it_inbase+it_inpointer)&127
{ it_inpointer = it_inpointer+1
{ it_inpointer = 0 %if it_inpointer >= it_inlength
{ %if kk = del %start
{ %if incount # 0 %start
{ incount = incount-1; traildels = traildels+1
{ %finish %else leaddels = leaddels+1
{ %finish %else %start
{ inbuff(incount) = kk; incount = incount+1
{ %exit %if kk < ' '
{ traildels = traildels-1 %if traildels > 0
{ %finish
{ %repeat %until it_inpointer = iostat_inpos
{! tojournal(addr(prom)+1,length(prom))
{! tojournal(addr(inbuff(0)),incount)
{%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(0)
exit if seq&255 = 0
seq = seq-1
repeat
else
put symbol(esc); put symbol(seq&127)
finish
else
put symbol(seq&127)
finish
seq = seq>>8
repeat
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
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 =>
! 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
if col = 0 and row = vdu_row+1 start
!$IF VAX
put symbol(rt)
!$FINISH
put symbol(nl)
!$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
seq = docursor
while seq # 0 cycle
k = seq&255
k = row+' ' if k = rowcode
if k = colcode start
k = col+' '
if vttype = esprit start
if col # 31 start
col = col+96 if col < 31
put symbol(col); k = row+96
finish else start ; !Esprit ignores DEL even after ESC!
put symbol(32); put symbol(row+96); !col 32
k = bs; !back to 31
finish
finish
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
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 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
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
!
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
position cursor(b,0) if vb # vdu_row; !any col OK
put symbol(nl); !hardware scroll
return
finish
finish else win_row = t
if vttype # vt100 start
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
if vt < vbot 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 < vbot start
position cursor(b,0)
for i = 1,1,n cycle
put sequence(doinsert)
repeat
finish
finish else start ; !vt100
put sequence(escflag+'[')
putnum(vt+1); put symbol(';'); putnum(vb+1)
put symbol('r'); !Set Scrolling region
vdu_row = 255; !?
cycle
if n > 0 start
position cursor(b,0)
put sequence(escflag+'D'); !Index
n = n-1
finish else start
position cursor(t,0)
put sequence(escflag+'M'); !Reverse Index
n = n+1
finish
repeat until n = 0
put sequence(escflag+'['+';'<<8+'r'<<16); !restore scroll region
vdu_row = 255
finish
end ; !SCROLL
!
!$IF VAX
{V10IMP} from imp include formats
{V10IMP} from imp include devdef
{V10IMP} Integerfn intype
{V10IMP} record (fdfm)name fd==inscb_fd
{V10IMP} result = -1 if fd_fab_dev&dev m trm # 0
{V10IMP} result = 0
{V10IMP} End
{V10IMP} integerfn outtype
{V10IMP} record (fdfm)name fd==outscb_fd
{V10IMP} result = -1 if fd_fab_dev&dev m trm # 0
{V10IMP} result = 0
{V10IMP} End
externalroutine VT SELECT INPUT alias "VTSELIN"(integer i)
select input(i)
inmode = -1
inmode = vdu_fun if intype = -1 or options&noevent9 # 0
end
externalroutine VT SELECT OUTPUT alias "VTSELOUT"(integer i)
select output(outstreambase+i)
outmode = -1
outmode = vdu_fun if outtype = -1
end
!$IF EMAS
{%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
{%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
{%end
{!
!$FINISH
!
externalroutine VT PRINT SYM alias "VTPSYM"(integer sym)
integer i
if outmode <= 0 start ; !non-video
if outmode = 0 start ; !hard-copy
!$IF VAX
put symbol(rt) if sym = nl
!$FINISH
put symbol(sym)
finish else start
!$IF VAX
print symbol(sym); !standard route
!$IF EMAS
{ i = iocp(printch,sym)
!$FINISH
finish
finish else if escaping # 0 start
escaping = 0
put symbol(sym)
vdu_row = 255; !assume the worst
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
outbuff(outcount) = sym; outcount = outcount+1
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]
!$IF VAX
put symbol(rt)
!$FINISH
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
{\V10IMP i = instream; select input(0); prompt("")
{V10IMP} i = inputstream; 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 EMAS
{ i = comreg(instr) %and select input(0) %if inmode < 0
{! set handler mode(options&(\specialpad)!notermecho) %c
{! %if options¬ermecho = 0
{ get buffer; incount = 0
{! set handler mode(options&(\specialpad)) %if options¬ermecho = 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)
prom <- s if inmode >= 0
end
!
owninteger pend=\nl
externalroutine VT READ SYMBOL alias "VTRSYM"(integername k)
integer kk,s,i
routine get another
!$IF VAX
if inpos >= incount then kk = single symbol c
else kk = inbuff(inpos)&127 and inpos = inpos+1
!$IF EMAS
{ get buffer %while inpos >= incount
{ kk = inbuff(inpos)&127; inpos = inpos+1
!$FINISH
end
!$IF EMAS
{ k = iocp(readch,0) %and %return %if inmode < 0
!$IF VAX
read symbol(k) and return if inmode < 0
!$FINISH
k = pend and pend = \pend and return if pend >= 0
!$IF EMAS
{ %if leaddels > 0 %start
{ leaddels = leaddels-1
{ pend = \del; k = del
{ %return
{ %finish
!$FINISH
if inpos >= incount start
if prom # "" start
{\V10IMP s = outstream %and select output(0) %if outmode < 0
{V10IMP} s = outputstream 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 VAX or APM
if options&single # 0 then kk = single symbol else start
!$FINISH
get buffer until incount > inpos
kk = inbuff(inpos)&127; inpos = inpos+1
!$IF VAX or APM
finish
!$FINISH
else
kk = inbuff(inpos)&127; inpos = inpos+1
finish
if kk < ' ' start
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 EMAS
{ lfmap = rt
!$FINISH
kk = lf
finish else if kk = lf start
kk = lfmap
finish else if kk = leadin start
get another
get another if kk = '['
if kk = '?' or kk = 'O' start
get another; kk = kk!!96
finish
kk = kk!128
finish
kk = nl if options&leavecontrols = 0
finish else start
win_col = win_col+inc if win_col # 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 EMAS
{ %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
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
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¬ermecho # 0
readfunction = readfunction+vmspurge if mode¬ypeahead # 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 EMAS
{ %if options = untouched %start
{ select input(0); select output(0)
{ %if aitbuffer = 0 %start; !not initialised
{ console(13,aitbuffer,aiostat)
{ %if aitbuffer # 0 %start
{ it == record(aitbuffer)
{ iostat == record(aiostat)
{ inmode = vdu_fun; outmode = vdu_fun
{ %finish
{ %finish
{ win = vdu; prompt("")
{ emasprom = tostring(del)
{ %finish
{ set handler mode(mode-p)
!$FINISH
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
inc = 1; inc = 0 if options&noecho # 0
end
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! 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
integerfn terminaltype
string (15) term
{\V10IMP %externalstring(15)%fnspec terminal model
{V10IMP} externalstring (15)fnspec terminal model alias "IMP_TERMINAL_MODEL"
term = terminal model
result = 8 if term = "VT52"
result = 11 if term = "VISUAL200"
result =12 if term="VT100" or term="VT200" or term="VT102" or term="VT220"
result = 6 if term = "PE550"
result = 13 if term = "ESPRIT"
result = 25 if term = "VISUAL50" or term = "VISUAL55"
result = 0
end
!$FINISH
!
externalroutine DEFINE VIDEO alias "VTDEFVIDEO"(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=25
constbyteintegerarray VINFO(0:299) =
{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} 2,30,80,
{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} 31,24,80, e+'[','J',0, e+'[','K',0, e+'[',0,
e,0,0,
e+'[','(','B',0,e+'[','(','0',0,
e+'>',0,e+'=',0,
e+'[','m',0,e+'[','7','m',
{13: Hazeltine Esprit} 25,24,80, 0, e+15,0, e+17,c,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} 19,24,80, 16_1F,0, 16_19,0, 16_16,c,r,0,
2,0,1,0, 0,0, 16_13,0,16_12,
{16: Pericom} 2,24,80,
{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',
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
!$IF EMAS
{ emastype = uinfi(23) %if emastype < 0; !terminal type
!$IF VAX
emastype = terminaltype if emastype < 0
!$FINISH
suppress = emastype//100; emastype = emastype-suppress*100
emastype = esprit if emastype = 22 or emastype = 23
emastype = vt100 if emastype = 27
emastype = 0 if emastype > maxtype
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_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
suppress = suppress>>1
for i = 0,1,15 cycle
doselect(i) = nextseq
vdu_fun = vdu_fun!i if doselect(i) # 0
repeat
vdu_row = 255; ![safety]
end
endoffile