!TITLE Storing terminal characteristics
!
! This program creates and maintains a file of terminal
! characteristics, which is used by the Screen Control Package to find
! out how to drive a particular terminal.
!
! The program is entered by the command
!
! TERMCHS(file,commands)
!
! where 'file' specifies the terminal characteristics file to be
! operated on, and 'commands' specifies a file of commands for TERMCHS.
! If 'file' is null, the name TERMCHSFILE is used, and if 'commands' is
! null, .IN is used.
!
! The user is prompted for the action required. That action is
! carried out, and the prompt is repeated. The command STOP exits from
! TERMCHS. All commands may be abbreviated as long as they remain
! unambiguous.
!
! The available commands are given below. A summary of these may be
! obtained by typing '?' in response to the 'Action:' prompt.
!
!<Initialise
!
! The form of this command is:
!
! INITIALISE
!
! The terminal characteristics file is emptied, after being created if
! it did not exist.
!>
!<Edit
!
! The form of this command is:
!
! EDIT n
!
! The action is to edit record 'n' in the terminal characteristics
! file. If 'n' is not specified, the prompt
!
! Type:
!
! is issued, and the response should be a valid terminal record
! number. The prompt
!
! Ed:
!
! is then issued, and one of several editing commands may now be given.
! On completion of the edit, the appropriate record is updated. The
! characteristics file is manipulated using NEWGEN to avoid problems
! with users who have it connected during the update.
!PAGE
!
! Users should beware of the fact that some programs (e.g. VIEW)
! disable disconnection of the terminal characteristics file. Thus, if
! such a program is used prior to, and in the same session as, an edit
! to the terminal characteristics file, the effect of the edit cannot be
! seen without logging off and on again.
!PAGE
!
! Most editing commands consist of a keyword, an equals sign and a
! value. For example, to set a Clear Screen sequence of three nulls,
! the command would be:
!
! CLEARSCREEN=0,0,0
!
! which could be abbreviated to:
!
! CLEARSCREEN=0(3)
!PAGE
!
! Values in sequences may be expressed as:
!
! * Hexadecimal numbers (e.g. 1B). Any leading X is ignored
! * ASCII mnemonics (for non-printing characters and spaces) (e.g ESC)
! * Single characters within single quotes (e.g. 'A')
!
! Repeat counts are in decimal.
!PAGE
!
! Some items are in fact truth values. They may be specified with
! the keywords TRUE, YES, FALSE and NO as required. TRUE is equivalent
! to YES, and FALSE is equivalent to NO.
!PAGE
!
! Keywords may be abbreviated as long as they remain unambiguous. A
! null sequence (i.e. no characters at all) may be entered by giving the
! keyword and the equals sign only. This should be done if a terminal
! does not support a particular operation.
!
! A summary of available keywords may be obtained by typing '?' in
! response to the 'Ed:' prompt. These keywords are:
!
!<Quit
!
! Abandon the edit without updating the characteristics file.
!>
!<.End
!
! Complete the edit, updating the characteristics file.
!>
!<Name
!
! Set the name of the terminal associated with this record. For
! example:
!
! Name={7}
!>
!<Columns
!
! Set the number of columns available on the terminal associated
! with this record. This will often be used to update the ITWIDTH
! option setting.
!>
!<Lines
!
! Set the number of lines available on the screen of this terminal
! type. A value of zero should be used for hardcopy devices.
!>
!<Leadin
!
! Set the lead-in sequence for this terminal type.
!>
!<Clear
!
! Set the clear screen sequence for this terminal type. The
! sequence should also return the cursor to the 'home' position.
!>
!<Chome
!
! Set the 'home' sequence for this terminal type.
!>
!<Endline
!
! Set the sequence which will cause the terminal to clear the rest
! of the current line from the current cursor position.
!>
!<Endscreen
!
! Set the sequence which will cause the terminal to clear the rest
! of the screen from the current cursor position.
!>
!<Initialise
!
! Set the sequence which will initialise the terminal in a sensible
! way. Preferred settings are:
!
! * Roll mode
! * Protection off
!>
!<Interrupt
!
! Set the single character that is the preferred one for user
! programs to select as the INT: key. This may not always be ESCape,
! because this key often has a special meaning to the terminal hardware.
!>
!<Cursor up
!
! Set the sequence which will cause the cursor to move up by one
! line.
!>
!<Cursor down
!
! Set the sequence which will cause the cursor to move down by one
! line.
!>
!<Cursor left
!
! Set the sequence which will cause the cursor to move left by one
! character position.
!>
!<Cursor right
!
! Set the sequence which will cause the cursor to move right by one
! character position.
!>
!<Insert line
!
! Set the sequence which will insert a blank line on the display at
! the current cursor position.
!>
!<Delete line
!
! Set the sequence which will remove a line from the display at the
! current cursor position.
!>
!<Home at top
!
! Indicate whether the Home operation leaves the cursor at the top
! line of the screen. The setting is TRUE if so, otherwise FALSE.
!>
!<Can do page mode
!
! Indicate whether the terminal is capable of operating in page
! mode. The setting is TRUE if so, otherwise FALSE.
!>
!<Xbase
!
! The value to be added to an X coordinate value before use. This
! is a single byte.
!>
!<Ybase
!
! The value to be added to a Y coordinate value before use. This is
! a single byte.
!>
!<X intro
!
! The string that introduces the X coordinate setting string, or the
! whole coordinate setting string for those terminals where both are
! lumped together.
!>
!<Y intro
!
! The string that introduces the Y coordinate setting string. This
! will be null if both settings are lumped together.
!>
!<Y first
!
! Indicate whether the Y coordinate setting comes before or after the
! X coordinate setting. The setting is TRUE if the Y coordinate value
! is first, otherwise FALSE.
!
! Note that the column number is the X coordinate, and the line
! number is the Y coordinate.
!>
!<Auto wrap
! Indicate whether the terminal automatically 'wraps round'
! (generates a carriage return, linefeed sequence) when an attempt is
! made to write a character beyond the last column of the screen.
!
! The setting is TRUE if the terminal behaves like this, otherwise
! FALSE.
!>
!<Unix name
! The two character abbreviation commonly used by UNIX systems to
! describe this type of terminal.
!>
!<Start standout mode
! Set the sequence which will cause the terminal to display
! subsequent output in 'standout' or 'highlighted' mode.
!>
!<End standout
! Set the sequence which will end 'standout' or 'highlighted' mode.
!>
!<Cursor position
!
! Set the sequence which indicates precisely how to position the
! cursor at a given point on the screen.
!
! The string used is precisely that which needs to be sent to the screen
! in order to position the cursor appropriately. Variable information is
! indicated by an escape character, '%', which indicates that row or
! column values are to be inserted in a specified format. The row is
! normally sent first, followed by the column (this may be reversed by
! the %i escape). Escape sequences are also used to side-effect the
! string.
!PAGE
!
! Escape sequences are as follows:
!
! %d - Minimum width ASCII representation of number
! (like 'write(n,1) in IMP)
! %2 - Same as %d, but padded to a width of 2
! %3 - Same as %d, but padded to a width of 3
! %. - Output of value as stored (like a %byteinteger)
! %+x - Same as %., but with the character 'x' added to the value
! %r - Reverses the order of the 'x' and 'y' values, but generates
! no output
! %i - Increments both the 'x' and the 'y' value, but generates no
! output
! %% - Outputs a '%'
!>
!<Print
!
! Print the current state of the terminal record, then continue
! editing.
!>
!>
!<Print
!
! The form of this command is:
!
! PRINT n
!
! The action is to print the contents of record 'n' in the
! characteristics file. If 'n' is not specified, the prompt
!
! Which:
!
! is issued, and the response should be a valid terminal record number,
! or .ALL to print all the records currently in use.
!>
!<New
!
! The form of this command is:
!
! NEW
!
! The action is to locate an empty terminal record, and then to invoke
! the Edit action (see above) to fill it in. The type number allocated
! to the record is output for future reference.
!>
!<Copy
!
! The form of this command is:
!
! COPY
!
! The action is to copy a complete terminal record (apart from the name
! field) to another (possibly empty) record. It is useful when more than
! one record has a very similar structure. Prompts are issued for the
! type numbers of the source and destination records.
!>
!<Delete
!
! The form of this command is:
!
! DELETE
!
! The action is to clear out a terminal record, and free it for re-use.
! This command is only needed when a particular type of terminal is no
! longer in use by any user. A prompt is issued for the type number of
! the terminal whose record is to be deleted.
!>
!<Dump
!
! The form of this command is:
!
! DUMP
!
! The action is to dump the current state of the characteristics file,
! to a specified character file. This is useful as a backup, and if the
! format of the characteristics file is to be changed.
!
! A prompt is issued for the name of the output file.
!>
!<Cmode
!
! The form of this command is:
!
! The action is to set the output mode for subsequent Print commands so
! that bytes are represented as characters and ASCII mnemonics.
!>
!<Nmode
!
! The form of this command is:
!
! The action is to set the output mode for subsequent Print commands so
! that bytes are represented as hexadecimal numbers.
!>
!<Stop
!
! The form of this command is:
!
! STOP
!
! The action is to cause an immediate exit from the program.
!>
!
!***********************************************************************
!*
!* Program to create and edit terminal characteristics file
!*
!* R.D. Eager University of Kent MCMLXXXVI
!*
!***********************************************************************
!
!
!***********************************************************************
!*
!* Constants
!*
!***********************************************************************
!
constantinteger no = 0, yes = 1
constantinteger inchan = 1, outchan = 2
constantinteger character mode = 0, number mode = 1
constantinteger max space = 224; ! Space in terminal record
constantinteger ssdatafiletype = 4; ! Subsystem file type
constantinteger maxterm = 31; ! Max number of terminal types
constantstring (11) default chsfile = "TERMCHSFILE"
! Default name for characteristics file
constantstring (10) temp chsfile = "T#TEMPCHS"
constantinteger hdsize = 32; ! Size of a file header
constantinteger maxcom = 12; ! Number of commands
constantstring (10)array com(1:maxcom) = c
"INITIALISE","EDIT","PRINT","NEW","COPY","DELETE","DUMP","SUMMARY",
"CMODE","NMODE","QUIT","STOP"
constantinteger maxedcom = 33; ! Number of editing commands
constantstring (10)array edcom(1:maxedcom) = c
"QUIT",".END","NAME","COLUMNS","LINES","LEADIN","CLEAR","CHOME",
"ENDLINE","ENDSCREEN","INITIALISE","INTERRUPT","CUP","CDOWN","CLEFT",
"CRIGHT","INSERTLINE","DELETELINE","HOMETOP","PAGEMODE","ROLLMODE",
"CANPAGE","XBASE","YBASE","XINTRO","YINTRO","YFIRST","AUTOWRAP",
"UNIXNAME","SSTAND","ESTAND","CPOSITION","PRINT"
constantstring (1) snl = "
"
constantstring (3)array ascode(0:32) = c
"NUL","SOH","STX","ETX","EOT","ENQ","ACK","BEL", "BS", "HT", "LF", "VT",
"FF", "CR", "SO", "SI","DLE","DC1","DC2","DC3","DC4","NAK","SYN","ETB",
"CAN", "EM","SUB","ESC", "FS", "GS", "RS", "US", "SP"
!
!
!***********************************************************************
!*
!* Record and array formats
!*
!***********************************************************************
!
recordformat fdf(integer link,dsnum,byteinteger status,accessroute,
valid action,cur state,mode of use,mode,file org,
dev code,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,byteinteger f77flag,
f77form,f77access,f77status,integer f77recl,f77nrec,
idaddr,byteinteger f77blank,f77ufd,spare1,spare2)
recordformat hf(integer dataend,datastart,filesize,filetype,
sum,datetime,format,records)
recordformat rf(integer conad,filetype,datastart,dataend)
recordformat termf(byteinteger type,name,columns,lines,leadin,
clearscreen,home,endofline,endofscreen,init,int,
cursor up,cursor down,cursor left,cursor right,
insert line,delete line,home at top,page mode,
roll mode,can do page mode,xbase,ybase,xintro,
yintro,yfirst,auto wrap,uname,start standout,
end standout,cursor pos,
(byteinteger string ptr or c
string (max space) string space))
!
ownrecord (termf)arrayformat termaf(1:maxterm)
!
!
!***********************************************************************
!*
!* Subsystem references
!*
!***********************************************************************
!
systemroutinespec connect(string (31) file,integer mode,hole,
prot,record (rf)name r,integername flag)
systemroutinespec define(integer chan,string (31) iden,
integername afd,flag)
systemroutinespec disconnect(string (31) file,integername flag)
systemstringfunctionspec failuremessage(integer mess)
systemstringfunctionspec htos(integer value,places)
externalintegerfunctionspec instream
systemintegerfunctionspec iocp(integer ep,parm)
systemstringfunctionspec itos(integer n)
systemintegermapspec mapssfd(integer dsnum)
systemroutinespec move(integer length,from,to)
systemroutinespec newgen(string (31) file,newfile,integername flag)
systemroutinespec outfile(string (31) file,integer size,hole,
prot,integername conad,flag)
externalintegerfunctionspec outpos
externalintegerfunctionspec outstream
systemintegerfunctionspec parmap
externalroutinespec prompt(string (255) s)
systemintegerfunctionspec pstoi(string (63) s)
systemroutinespec setfname(string (63) s)
systemroutinespec setpar(string (255) s)
externalroutinespec set return code(integer i)
systemstringfunctionspec spar(integer n)
systemroutinespec uctranslate(integer ad,len)
!
!
!***********************************************************************
!*
!* Service routines
!*
!***********************************************************************
!
routine closestream(integer chan)
! Private version of 'closestream'. Does not give an error if the
! operation fails.
integer flag
!
return unless instream # chan # outstream
flag = iocp(16,chan)
end ; ! of closestream
!
!-----------------------------------------------------------------------
!
routine clearstream(integer chan)
! Clears out a channel definition, but does not give an error if the
! channel was not defined.
record (fdf)name f
!
if mapssfd(chan) # 0 then start
f == record(mapssfd(chan))
if f_status = 0 then start
mapssfd(chan) = 0
f_dsnum = 0; ! Mark descriptor as free
finish
finish
end ; ! of clearstream
!
!-----------------------------------------------------------------------
!
integerfunction stoh(string (2) s)
! Converts the string 's' to a number. 's' is in hexadecimal.
integer c,i,j,n
!
uctranslate(addr(s)+1,length(s))
n = 0
for i = 1,1,length(s) cycle
c = charno(s,i)
if '0' <= c <= '9' then start
j = c - '0'
finish else c
if 'A' <= c <= 'F' then start
j = c - 'A' + 10
finish else result = -1; ! Invalid character
n = (n << 4)!j
repeat
result = n
end ; ! of stoh
!
!-----------------------------------------------------------------------
!
integerfunction matchstrings(stringname a,string (255) b)
! Performs minimum-length string comparison.
integer l
!
l = length(a)
result = 0 if length(b) < l
length(b) = l
if a = b then result = yes else result = no
end ; ! of matchstrings
!
!-----------------------------------------------------------------------
!
integerfunction getcode(string (4) s)
! Yields the ASCII code of the character described by 's'. Yields -1 if
! 's' is not recognised.
integer i
!
if length(s) = 3 and charno(s,1) = '''' = charno(s,3) then start
result = charno(s,2)
finish
!
if length(s) = 4 and charno(s,1) = '''' = charno(s,4) and charno(s,2) = '^' then start
i = charno(s,3)
if 'a' <= i <= 'z' then i = i - 'a' + 'A'
if '@' <= i <= '_' then result = i - 64 else result = -1
finish
!
if length(s) = 4 and charno(s,1) = '''' = charno(s,2) and c
charno(s,3) = '''' = charno(s,4) then result = ''''
!
if 2 <= length(s) <= 3 then start
uctranslate(addr(s)+1,length(s))
result = x'7f' if s = "DEL"; ! Special case
!
for i = 0,1,32 cycle
result = i if s = ascode(i)
repeat
finish
result = -1
end ; ! of getcode
!
!-----------------------------------------------------------------------
!
stringfunction readchs(string (255) s,integername flag)
! Converts the string 's', which is a textual representation of a set of
! control bytes in hexadecimal, into those bytes themselves.
integer i,l,ch,count
string (255) chs,s0,s1,s2,s3
!
length(chs) = 0
flag = 0
result = "" if s = ""
!
l = 0
cycle
if not s -> s0.(",").s then start
s0 = s
s = ""
finish
if s0 = "" then start
printstring("Null field".snl)
flag = 1
exit
finish
if s0 -> s1.("(").s2.(")").s3 and s3 = "" then start
count = pstoi(s2)
if count <= 0 then start
printstring("Invalid repeat count '".s2."'".snl)
flag = 1
exit
finish
s0 = s1
finish else count = 1
ch = getcode(s0); ! See if it is a mnemonic
if ch < 0 then start ; ! It is not - try for number
if length(s0) > 1 and (charno(s0,1) = 'X' or charno(s0,1) = 'x') then start
s0 = substring(s0,2,length(s0))
finish
if length(s0) > 2 then start
printstring("Field '".s0."' too large".snl)
flag = 1
exit
finish
ch = stoh(s0)
if ch < 0 then start
printstring("Invalid number '".s0."'".snl)
flag = 1
exit
finish
finish
for i = 1,1,count cycle
l = l + 1
charno(chs,l) = ch
repeat
repeat until s = ""
length(chs) = l
result = chs
end ; ! of readchs
!
!-----------------------------------------------------------------------
!
integerfunction readbool(string (255) s)
! Yields the boolean value described by 's', or -1 if 's' is not
! recognised. TRUE and YES are represented by 1, while FALSE and NO are
! represented by 0.
uctranslate(addr(s)+1,length(s))
if matchstrings(s,"TRUE") = yes then result = yes else c
if matchstrings(s,"YES") = yes then result = yes else c
if matchstrings(s,"FALSE") = yes then result = no else c
if matchstrings(s,"NO") = yes then result = no else c
printstring("Unrecognised boolean value".snl)
result = -1; ! Error
end ; ! of readbool
!
!-----------------------------------------------------------------------
!
routine to term string(record (termf)name term,byteintegername field,
string (63) value)
! Stores 'value' in the terminal record 'term', returning its key byte
! in 'field'.
if value = "" then start
field = 0
finish else c
if length(value) + term_string ptr > max space then start
printstring("No more space for strings for this terminal type".snl)
field = 0
else
field = term_string ptr
string(addr(term_string space)+field) = value
term_string ptr = field + length(value) + 1
finish
end ; ! of to term string
!
!-----------------------------------------------------------------------
!
stringfunction term string(record (termf)name term,byteinteger ptr)
! Returns the string associated with the item described by 'ptr' in the
! record 'term'.
result = "" if ptr = 0
result = string(addr(term_string space)+ptr)
end ; ! of term string
!
!-----------------------------------------------------------------------
!
stringfunction character(integer ch,mode)
! Yields a string describing 'ch', in a form which depends on 'mode'.
string (4) res
!
if mode = character mode then start
if 0 <= ch <= 32 then result = ascode(ch) else c
if ch = x'7f' then result = "DEL" else start
res = "'".tostring(ch)."'"
res = res."'" if ch = ''''
result = res
finish
else
result = htos(ch,2)
finish
end ; ! of character
!
!-----------------------------------------------------------------------
!
stringfunction chs string(record (termf)name term,byteinteger ptr,
integer mode)
! Yields a printable version of the item described by 'ptr' in the
! record 'term'.
integer last,i,count,flag,ch
string (63) value
string (255) res
!
res = ""
value = term string(term,ptr)
result = "" if length(value) = 0
last = -1
count = 0
flag = no
for i = 1,1,length(value) cycle
ch = charno(value,i)
if ch = last then count = count + 1 else start
if last # -1 then start
res = res."," if flag = yes
flag = yes
res = res.character(last,mode)
if count # 1 then res = res."(".itos(count).")"
finish
last = ch
count = 1
finish
repeat
res = res."," if flag = yes
res = res.character(last,mode)
if count # 1 then res = res."(".itos(count).")"
result = res
end ; ! of chs string
!
!-----------------------------------------------------------------------
!
stringfunction boolstring(byteinteger value)
! Yields a string describing the boolean item 'value'.
if value = yes then result = "TRUE" else result = "FALSE"
end ; ! of boolstring
!
!-----------------------------------------------------------------------
!
routine itemi(string (15) title,record (termf) term,byteinteger ptr,
integer mode)
! Prints a non-graphic string item.
printstring(title)
spaces(31-outpos)
printstring(": ")
if ptr = 0 then printstring("<null>") else start
printstring(chs string(term,ptr,mode))
finish
newline
end ; ! of itemi
!
!-----------------------------------------------------------------------
!
routine itemn(string (31) title,byteinteger info)
! Prints a decimal numeric item.
printstring(title)
spaces(31-outpos)
printstring(": ".itos(info).snl)
end ; ! of itemn
!
!-----------------------------------------------------------------------
!
routine itemc(string (31) title,byteinteger info,integer mode)
! Prints a single character item.
printstring(title)
spaces(31-outpos)
printstring(": ".character(info,mode).snl)
end ; ! of itemc
!
!-----------------------------------------------------------------------
!
routine itemb(string (31) title,byteinteger info)
! Prints a boolean item.
printstring(title)
spaces(31-outpos)
printstring(": ")
if info = no then printstring("False") else printstring("True")
newline
end ; ! of itemb
!
!-----------------------------------------------------------------------
!
routine items(string (31) title,record (termf)name term,
byteinteger ptr)
! Prints a graphic string item.
printstring(title)
spaces(31-outpos)
printstring(": ".term string(term,ptr).snl)
end ; ! of items
!
!-----------------------------------------------------------------------
!
routine printterm(record (termf)name term,integer mode)
! Prints complete details about one terminal type.
itemn("Type",term_type)
items("Name",term,term_name)
itemn("Columns",term_columns)
itemn("Lines",term_lines)
itemi("Lead in",term,term_leadin,mode)
itemi("Clear Screen",term,term_clearscreen,mode)
itemi("Home",term,term_home,mode)
itemi("End of line",term,term_endofline,mode)
itemi("End of screen",term,term_endofscreen,mode)
itemi("Initialise",term,term_init,mode)
itemc("Interrupt",term_int,mode)
itemi("Cursor up",term,term_cursor up,mode)
itemi("Cursor down",term,term_cursor down,mode)
itemi("Cursor left",term,term_cursor left,mode)
itemi("Cursor right",term,term_cursor right,mode)
itemi("Insert line",term,term_insert line,mode)
itemi("Delete line",term,term_delete line,mode)
itemb("Home at top",term_home at top)
itemi("Page mode",term,term_page mode,mode)
itemi("Roll mode",term,term_roll mode,mode)
itemb("Can do page mode",term_can do page mode)
itemc("X base",term_xbase,mode)
itemc("Y base",term_ybase,mode)
itemi("X intro",term,term_xintro,mode)
itemi("Y intro",term,term_yintro,mode)
itemb("Y first",term_yfirst)
itemb("Auto wrap",term_auto wrap)
items("Unix name",term,term_uname)
itemi("Start standout",term,term_start standout,mode)
itemi("End standout",term,term_end standout,mode)
itemi("Cursor position",term,term_cursor pos,mode)
end ; ! of printterm
!
!-----------------------------------------------------------------------
!
routine readline(stringname s)
! Reads one line from the currently selected input into 's'. Trailing
! spaces and completely blank lines are suppressed.
integer c
!
s = ""
cycle
cycle
readsymbol(c)
exit if c = nl
s <- s.tostring(c)
repeat
while length(s) > 0 and charno(s,length(s)) = ' ' cycle
length(s) = length(s) - 1
repeat
exit unless s = ""
repeat
end ; ! of readline
!
!-----------------------------------------------------------------------
!
routine despace(stringname s)
! Removes embedded spaces from 's'.
string (255) work1,work2
!
s = work1.work2 while s -> work1.(" ").work2
end ; ! of despace
!
!-----------------------------------------------------------------------
!
integerfunction decode command(stringname op,stringarrayname com,
integer max)
! Checks the command 'op' against its possible values in the table
! 'com'. The number of items in 'com' is given by 'max'. There must be
! exactly one match, or a negative result is returned after printing a
! suitable message. Otherwise, the command index in 'com' is yielded.
integer i,j
!
uctranslate(addr(op)+1,length(op))
j = -1
for i = 1,1,max cycle
if matchstrings(op,com(i)) = yes then start
if j # -1 then start ; ! Already seen a match
printstring("Ambiguous command".snl)
j = -2
exit
finish
j = i
finish
repeat
if j = -1 then printstring("Unrecognised command".snl)
result = j
end ; ! of decode command
!
!-----------------------------------------------------------------------
!
routine printhelp(string (31) title,stringarrayname com,integer max)
! Prints a helpful summary of the commands in the 'com', which has a
! length of 'max'. 'title' is output as an explanatory initial line.
integer i
!
printstring(title.":-".snl)
for i = 1,1,max cycle
printstring(com(i))
printsymbol(',') unless i = max
newline if outpos > 60 and i # max
repeat
newline unless outpos = 0
end ; ! of printhelp
!
!-----------------------------------------------------------------------
!
integerfunction setc(stringname param,byteintegername value)
integer flag
string (255) s
!
s = readchs(param,flag)
result = no if flag # 0
if length(s) # 1 then start
printstring("Only one character allowed".snl)
result = no
finish
value = charno(s,1)
result = yes
end ; ! of setc
!
!-----------------------------------------------------------------------
!
routine setn(stringname param,byteintegername value,oldvalue)
integer i
!
i = pstoi(param)
if i < 0 then printstring("Invalid number".snl) else start
value <- i
oldvalue = 0
finish
end ; ! of setn
!
!-----------------------------------------------------------------------
!
integerfunction edit function(record (termf)name term,
integer interactive,silent)
! Performs an edit on a particular terminal record.
integer j,flag,home at top set,can do page mode set,int set,xbase set
integer ybase set,y first set,auto wrap set,printflag
record (termf) tw
string (255) s,op,param
switch edsw(1:maxedcom)
!
tw = 0
tw_type = term_type
tw_string ptr = 1
int set = no
home at top set = no
can do page mode set = no
xbase set = no
ybase set = no
yfirst set = no
auto wrap set = no
!
if term_name # 0 and silent = no then start
printstring("Editing record for """.term string(term,term_name)."""".snl)
finish
!
cycle
prompt("Ed: ")
readline(s)
if s = "?" then start
printhelp("Editing commands are",edcom,maxedcom)
continue
finish
!
if not s -> op.("=").param then start
op = s
param = ""
finish
despace(op)
printflag = 0
!
j = decode command(op,edcom,maxedcom)
continue if j < 0
!
-> edsw(j)
!
edsw(1): ! Quit
if interactive = yes then printstring("Edit abandoned".snl)
result = 1
!
edsw(2): ! .End
to term string(tw,tw_name,term string(term,term_name)) if term_name # 0
tw_columns = term_columns if term_columns # 0
tw_lines = term_lines if term_lines # 0
to term string(tw,tw_leadin,term string(term,term_leadin)) if term_leadin # 0
to term string(tw,tw_clearscreen,term string(term,term_clearscreen)) if term_clearscreen # 0
to term string(tw,tw_home,term string(term,term_home)) if term_home # 0
to term string(tw,tw_endofline,term string(term,term_endofline)) if term_endofline # 0
to term string(tw,tw_endofscreen,term string(term,term_endofscreen)) if term_endofscreen # 0
to term string(tw,tw_init,term string(term,term_init)) if term_init # 0
tw_int = term_int unless int set = yes
to term string(tw,tw_cursor up,term string(term,term_cursor up)) if term_cursor up # 0
to term string(tw,tw_cursor down,term string(term,term_cursor down)) if term_cursor down # 0
to term string(tw,tw_cursor left,term string(term,term_cursor left)) if term_cursor left # 0
to term string(tw,tw_cursor right,term string(term,term_cursor right)) if term_cursor right # 0
to term string(tw,tw_insert line,term string(term,term_insert line)) if term_insert line # 0
to term string(tw,tw_delete line,term string(term,term_delete line)) if term_delete line # 0
tw_home at top = term_home at top unless home at top set = yes
to term string(tw,tw_page mode,term string(term,term_page mode)) if term_page mode # 0
to term string(tw,tw_roll mode,term string(term,term_roll mode)) if term_roll mode # 0
tw_can do page mode = term_can do page mode unless can do page mode set = yes
tw_xbase = term_xbase unless xbase set = yes
tw_ybase = term_ybase unless ybase set = yes
to term string(tw,tw_xintro,term string(term,term_xintro)) if term_xintro # 0
to term string(tw,tw_yintro,term string(term,term_yintro)) if term_yintro # 0
tw_yfirst = term_yfirst unless yfirst set = yes
tw_auto wrap = term_auto wrap unless auto wrap set = yes
to term string(tw,tw_uname,term string(term,term_uname)) if term_uname # 0
to term string(tw,tw_start standout,term string(term,term_start standout)) if term_start standout # 0
to term string(tw,tw_end standout,term string(term,term_end standout)) if term_end standout # 0
to term string(tw,tw_cursor pos,term string(term,term_cursor pos)) if term_cursor pos # 0
term = tw
if interactive = yes and printflag = 0 then printstring("Edit completed".snl)
result = printflag
!
edsw(3): ! Name
to term string(tw,tw_name,param)
term_name = 0
continue
!
edsw(4): ! Columns
setn(param,tw_columns,term_columns)
continue
!
edsw(5): ! Lines
setn(param,tw_lines,term_lines)
continue
!
edsw(6): ! Leadin
s = readchs(param,flag)
if flag = 0 then start
to term string(tw,tw_leadin,s)
term_leadin = 0
finish
continue
!
edsw(7): ! Clearscreen
s = readchs(param,flag)
if flag = 0 then start
to term string(tw,tw_clearscreen,s)
term_clearscreen = 0
finish
continue
!
edsw(8): ! Home
s = readchs(param,flag)
if flag = 0 then start
to term string(tw,tw_home,s)
term_home = 0
finish
continue
!
edsw(9): ! Endline
s = readchs(param,flag)
if flag = 0 then start
to term string(tw,tw_endofline,s)
term_endofline = 0
finish
continue
!
edsw(10): ! Endscreen
s = readchs(param,flag)
if flag = 0 then start
to term string(tw,tw_endofscreen,s)
term_endofscreen = 0
finish
continue
!
edsw(11): ! Initialise
s = readchs(param,flag)
if flag = 0 then start
to term string(tw,tw_init,s)
term_init = 0
finish
continue
!
edsw(12): ! Interrupt
int set = setc(param,tw_int)
continue
!
edsw(13): ! Cursor up
s = readchs(param,flag)
if flag = 0 then start
to term string(tw,tw_cursor up,s)
term_cursor up = 0
finish
continue
!
edsw(14): ! Cursor down
s = readchs(param,flag)
if flag = 0 then start
to term string(tw,tw_cursor down,s)
term_cursor down = 0
finish
continue
!
edsw(15): ! Cursor left
s = readchs(param,flag)
if flag = 0 then start
to term string(tw,tw_cursor left,s)
term_cursor left = 0
finish
continue
!
edsw(16): ! Cursor right
s = readchs(param,flag)
if flag = 0 then start
to term string(tw,tw_cursor right,s)
term_cursor right = 0
finish
continue
!
edsw(17): ! Insert line
s = readchs(param,flag)
if flag = 0 then start
to term string(tw,tw_insert line,s)
term_insert line = 0
finish
continue
!
edsw(18): ! Delete line
s = readchs(param,flag)
if flag = 0 then start
to term string(tw,tw_delete line,s)
term_delete line = 0
finish
continue
!
edsw(19): ! Home at top
flag = readbool(param)
if flag >= 0 then start
tw_home at top = flag
home at top set = yes
finish
continue
!
edsw(20): ! Set page mode
s = readchs(param,flag)
if flag = 0 then start
to term string(tw,tw_page mode,s)
term_page mode = 0
finish
continue
!
edsw(21): ! Set roll mode
s = readchs(param,flag)
if flag = 0 then start
to term string(tw,tw_roll mode,s)
term_roll mode = 0
finish
continue
!
edsw(22): ! Can do page mode
flag = readbool(param)
if flag >= 0 then start
tw_can do page mode = flag
can do page mode set = yes
finish
continue
!
edsw(23): ! X base
xbase set = setc(param,tw_xbase)
continue
!
edsw(24): ! Y base
ybase set = setc(param,tw_ybase)
continue
!
edsw(25): ! X intro
s = readchs(param,flag)
if flag = 0 then start
to term string(tw,tw_xintro,s)
term_xintro = 0
finish
continue
!
edsw(26): ! Y intro
s = readchs(param,flag)
if flag = 0 then start
to term string(tw,tw_yintro,s)
term_yintro = 0
finish
continue
!
edsw(27): ! Y coordinate first
flag = readbool(param)
if flag >= 0 then start
tw_yfirst = flag
yfirst set = yes
finish
continue
!
edsw(28): ! Auto wrap at line end
flag = readbool(param)
if flag >= 0 then start
tw_auto wrap = flag
auto wrap set = yes
finish
continue
!
edsw(29): ! Unix name for terminal
to term string(tw,tw_uname,param)
term_uname = 0
continue
!
edsw(30): ! Start standout mode
s = readchs(param,flag)
if flag = 0 then start
to term string(tw,tw_start standout,s)
term_start standout = 0
finish
continue
!
edsw(31): ! End standout mode
s = readchs(param,flag)
if flag = 0 then start
to term string(tw,tw_end standout,s)
term_end standout = 0
finish
continue
!
edsw(32): ! Cursor position
s = readchs(param,flag)
if flag = 0 then start
to term string(tw,tw_cursor pos,s)
term_cursor pos = 0
finish
continue
!
edsw(33): ! Print record
printflag = -1
-> edsw(2); ! Use code for .END
repeat
end ; ! of edit function
!
!-----------------------------------------------------------------------
!
routine dump function(record (termf)arrayname terms)
! Dumps the contents of all non-empty terminal records to the currently
! selected output, in a suitable form for re-input at a later time.
integer i
record (termf)name t
!
printstring("INITIALISE".snl)
for i = 1,1,maxterm cycle
t == terms(i)
continue if t_name = 0
printstring("EDIT".snl.itos(i).snl)
printstring("NAME=".term string(t,t_name).snl)
printstring("COLUMNS=".itos(t_columns).snl)
printstring("LINES=".itos(t_lines).snl)
printstring("LEADIN=".chs string(t,t_leadin,number mode).snl)
printstring("CLEAR=".chs string(t,t_clearscreen,number mode).snl)
printstring("CHOME=".chs string(t,t_home,number mode).snl)
printstring("ENDLINE=".chs string(t,t_endofline,number mode).snl)
printstring("ENDSCREEN=".chs string(t,t_endofscreen,number mode).snl)
printstring("INITIALISE=".chs string(t,t_init,number mode).snl)
printstring("INTERRUPT=".htos(t_int,2).snl)
printstring("CUP=".chs string(t,t_cursor up,number mode).snl)
printstring("CDOWN=".chs string(t,t_cursor down,number mode).snl)
printstring("CLEFT=".chs string(t,t_cursor left,number mode).snl)
printstring("CRIGHT=".chs string(t,t_cursor right,number mode).snl)
printstring("INSERTLINE=".chs string(t,t_insert line,number mode).snl)
printstring("DELETELINE=".chs string(t,t_delete line,number mode).snl)
printstring("HOMETOP=".bool string(t_home at top).snl)
printstring("PAGEMODE=".chs string(t,t_page mode,number mode).snl)
printstring("ROLLMODE=".chs string(t,t_roll mode,number mode).snl)
printstring("CANPAGE=".bool string(t_can do page mode).snl)
printstring("XBASE=".htos(t_xbase,2).snl)
printstring("YBASE=".htos(t_ybase,2).snl)
printstring("XINTRO=".chs string(t,t_xintro,number mode).snl)
printstring("YINTRO=".chs string(t,t_yintro,number mode).snl)
printstring("YFIRST=".bool string(t_yfirst).snl)
printstring("AUTOWRAP=".bool string(t_auto wrap).snl)
printstring("UNIXNAME=".term string(t,t_uname).snl)
printstring("SSTAND=".chs string(t,t_start standout,number mode).snl)
printstring("ESTAND=".chs string(t,t_end standout,number mode).snl)
printstring("CPOSITION=".chs string(t,t_cursor pos,number mode).snl)
printstring(".END".snl)
repeat
printstring("STOP".snl)
end ; ! of dump function
!
!-----------------------------------------------------------------------
!
integerfunction connect chsfile(string (31) file,record (rf)name rr)
! Connects and validates the terminal characteristics file 'file'.
! Yields zero if OK, otherwise a standard error code.
integer flag
record (hf)name r
!
connect(file,1,0,0,rr,flag)
if flag = 0 then start
r == record(rr_conad)
unless r_filetype = ssdatafiletype and r_format = 3 then start
setfname(file)
flag = 267; ! Invalid filetype
finish
finish
result = flag
end ; ! of connect chsfile
!
!-----------------------------------------------------------------------
!
integerfunction make chsfile(string (31) file,integer size,
integername conad)
! Creates an empty characteristics file 'file', of 'size' bytes
! including header. The connect address is returned in 'conad', and the
! result yielded is zero for success, otherwise a standard error code.
integer flag
record (hf)name r
!
outfile(file,size,0,0,conad,flag)
if flag = 0 then start
r == record(conad)
r_dataend = r_filesize
r_filetype = ssdatafiletype
r_format = 3
finish
result = flag
end ; ! of make chsfile
!
!
!***********************************************************************
!*
!* T E R M C H S
!*
!***********************************************************************
!
externalroutine termchs(string (255) parms)
integer i,j,conad,flag,type,newtype,afd,print mode,interactive,silent
string (31) file,commands
string (255) action,s
record (rf) rr
record (hf)name r
record (termf)name t,newt
record (termf)arrayname terms
switch sw(1:maxcom)
!
set return code(1000)
if sizeof(t) # 256 then start
setfname("'term' record length is wrong")
flag = 233; ! General error
-> err2
finish
!
if parms = "?" then start
printstring("Parameters are:-".snl)
printstring("TERMCHS(characteristics file,commands file)".snl)
set return code(0)
return
finish
!
setpar(parms)
if parmap > 3 then start
flag = 263; ! Wrong number of parameters
-> err2
finish
file <- spar(1)
file = default chsfile if file = ""
commands <- spar(2)
if commands # "" then start
define(inchan,commands,afd,flag)
-> err2 if flag # 0
selectinput(inchan)
finish
!
print mode = number mode
cycle
selectoutput(0)
closestream(outchan)
clearstream(outchan)
prompt("Action: ")
readline(action)
if action -> action.(" ").s then despace(s) else s = ""
if action = "?" then start
printhelp("Actions are",com,maxcom)
continue
finish
!
j = decode command(action,com,maxcom)
continue if j < 0
!
-> sw(j)
!
sw(1): ! Initialise
flag = make chsfile(file,sizeof(t)*maxterm+hdsize,conad)
-> err if flag # 0
r == record(conad)
terms == array(conad+r_datastart,termaf)
for i = 1,1,maxterm cycle
t == terms(i)
t = 0
t_type = i
t_string ptr = 1
repeat
disconnect(file,flag)
continue
!
sw(2): ! Edit
silent = no
flag = connect chsfile(file,rr)
-> err if flag # 0
r == record(rr_conad)
flag = make chsfile(temp chsfile,r_filesize,conad)
-> err if flag # 0
r == record(conad)
move(rr_dataend-rr_datastart,rr_conad+rr_datastart,conad+r_datastart)
terms == array(conad+r_datastart,termaf)
!
prompt("Which: ")
cycle
readline(s) if s = ""
despace(s)
type = pstoi(s)
unless 1 <= type <= maxterm then start
printstring("Invalid type number".snl)
s = ""
finish else exit
repeat
!
if commands = "" then interactive = yes else interactive = no
t == terms(type)
cycle
flag = edit function(t,interactive,silent)
if flag < 0 then start
printterm(t,print mode)
silent = yes
finish else exit
repeat
if flag = 0 then newgen(temp chsfile,file,flag) else flag = 0
-> err if flag # 0
continue
!
sw(3): ! Print
if s = "" then start
prompt("Which: ")
readline(s)
finish
uctranslate(addr(s)+1,length(s))
flag = connect chsfile(file,rr)
-> err if flag # 0
terms == array(rr_conad+rr_datastart,termaf)
unless s -> s.(",").parms then parms = ".OUT"
define(outchan,parms,afd,flag)
-> err if flag # 0
selectoutput(outchan)
s = "" if matchstrings(s,".ALL") = yes
if s # "" then start
type = pstoi(s)
unless 1 <= type <= maxterm then start
selectoutput(0)
printstring("Invalid type number".snl)
continue
finish
newline
t == terms(type)
if t_name = 0 then start
printstring("Slot for this terminal type is empty".snl)
else
printterm(t,print mode)
finish
else
newline
for i = 1,1,maxterm cycle
t == terms(i)
continue if t_name = 0
printterm(t,print mode)
newline
repeat
finish
continue
!
sw(4): ! New
flag = connect chsfile(file,rr)
-> err if flag # 0
r == record(rr_conad)
flag = make chsfile(temp chsfile,r_filesize,conad)
-> err if flag # 0
r == record(conad)
move(rr_dataend-rr_datastart,rr_conad+rr_datastart,conad+r_datastart)
terms == array(conad+r_datastart,termaf)
!
type = -1
for i = 1,1,maxterm cycle
t == terms(i)
if t_name = 0 then start
type = i
exit
finish
repeat
if type = -1 then start ; ! No slot found
setfname("No free terminal records")
flag = 233; ! General error
-> err
finish
printstring("New terminal type: ".itos(type).snl)
flag = edit function(t,yes,yes)
if flag = 0 then newgen(temp chsfile,file,flag) else flag = 0
-> err if flag # 0
continue
!
sw(5): ! Copy
flag = connect chsfile(file,rr)
-> err if flag # 0
r == record(rr_conad)
flag = make chsfile(temp chsfile,r_filesize,conad)
-> err if flag # 0
r == record(conad)
move(rr_dataend-rr_datastart,rr_conad+rr_datastart,conad+r_datastart)
terms == array(conad+r_datastart,termaf)
!
prompt("From: ")
readline(s)
type = pstoi(s)
unless 1 <= type <= maxterm then start
printstring("Invalid type number".snl)
continue
finish
t == terms(type)
prompt("To: ")
readline(s)
newtype = pstoi(s)
unless 1 <= type <= maxterm then start
printstring("Invalid type number".snl)
continue
finish
newt == terms(newtype)
i = newt_type; ! Save type
s = term string(newt,newt_name); ! Save name field
newt = t
newt_type = i; ! Restore type
to term string(newt,newt_name,s); ! Restore name field
newgen(temp chsfile,file,flag)
-> err if flag # 0
continue
!
sw(6): ! Delete
flag = connect chsfile(file,rr)
-> err if flag # 0
r == record(rr_conad)
flag = make chsfile(temp chsfile,r_filesize,conad)
-> err if flag # 0
r == record(conad)
move(rr_dataend-rr_datastart,rr_conad+rr_datastart,conad+r_datastart)
terms == array(conad+r_datastart,termaf)
!
prompt("Which: ")
readline(s)
type = pstoi(s)
unless 1 <= type <= maxterm then start
printstring("Invalid type number".snl)
continue
finish
t == terms(type)
t = 0; ! Null implies empty slot
newgen(temp chsfile,file,flag)
-> err if flag # 0
continue
!
sw(7): ! Dump
flag = connect chsfile(file,rr)
-> err if flag # 0
terms == array(rr_conad+rr_datastart,termaf)
!
prompt("Dump to: ")
readline(s)
uctranslate(addr(s)+1,length(s))
define(outchan,s,afd,flag)
-> err if flag # 0
selectoutput(outchan)
dump function(terms)
continue
!
sw(8): ! Summary
flag = connect chsfile(file,rr)
-> err if flag # 0
terms == array(rr_conad+rr_datastart,termaf)
newline
for i = 1,1,maxterm cycle
t == terms(i)
continue if t_name = 0
write(i,2)
printstring(": ".term string(t,t_name).snl)
repeat
newline
continue
!
sw(9): ! Cmode
print mode = character mode
continue
!
sw(10): ! Nmode
print mode = number mode
continue
!
sw(11): ! Quit
sw(12): ! Stop
exit
!
err:
s = failuremessage(flag)
printstring(substring(s,2,length(s)))
repeat
!
selectinput(0)
closestream(inchan)
clearstream(inchan)
set return code(0)
return
!
err2:
printstring(snl."TERMCHS fails -".failuremessage(flag))
selectinput(0)
closestream(inchan)
clearstream(inchan)
set return code(flag)
stop
end ; ! of termchs
endoffile