EXTERNALROUTINE CHARACTERISTICS(STRING (255)S)
!
!This command allows a 'terminal characteristics' file to be
!created and maintained. This file, or a copy of it, is used
!by the EMAS Screen Control Package.
!
!
!<Changes
!>
!
!
!
SYSTEMROUTINESPEC CONNECT(STRING (31)FILE, INTEGER MOD, HOL, PRO, C
RECORDNAME R, INTEGERNAME FLAG)
SYSTEMROUTINESPEC OUTFILE(STRING (31)FILE, INTEGER LEN, MAX, PRM, C
INTEGERNAME ADR, FLAG)
SYSTEMROUTINESPEC PRINTMESS(INTEGER N)
DYNAMICROUTINESPEC PROMPT(STRING (255)S)
SYSTEMROUTINESPEC UCTRANSLATE(INTEGER ADR, LEN)
!
!
ROUTINE WS(STRING (255)S)
PRINTSTRING(S)
NEWLINE
END
!
!
!
ROUTINE WSN(STRING (255)S, INTEGER N)
PRINTSTRING(S)
WRITE(N, 1)
NEWLINE
END
!
!
!
STRINGFN ITOS(INTEGER N)
STRING (15)S
INTEGER J
S = ""
CYCLE
J = N
N = N // 10
J = J - N*10 + '0'
S = TO STRING(J) . S
EXIT UNLESS N > 0
REPEAT
RESULT = S
END
!
!
!
INTEGERFN STOI(STRING (255) P, INTEGERNAME I2)
INTEGER TOTAL, AD, I, J
TOTAL = 0
AD = ADDR(P)
A: IF P -> (" ").P THEN -> A; !CHOP LEADING SPACES
I = 1
WHILE I <= BYTEINTEGER(AD) CYCLE
J = BYTE INTEGER(I+AD)
-> FAULT UNLESS '0' <= J <= '9'
TOTAL = 10*TOTAL + J&15
I = I+1
-> FAULT IF TOTAL > 10000
REPEAT
I2 = TOTAL AND RESULT = 0 IF I > 1
FAULT:
I2 = 0
RESULT = 1
END ; ! STOI2
!
!
!
ROUTINE RSTRG(STRINGNAME STRING)
INTEGER SYMBOL
STRING = ""
WHILE LENGTH(STRING) = 0 CYCLE
UNTIL SYMBOL = NL CYCLE
READSYMBOL(SYMBOL)
STRING = STRING . TOSTRING(SYMBOL)
REPEAT
LENGTH(STRING) = LENGTH(STRING) - 1
REPEAT
END ; ! OF RSTRG
!
!
!
!<Record Format
RECORDFORMAT TERMF(BYTEINTEGER TYPE, STRING (31)NAME, C
BYTEINTEGER COLUMNS, LINES, B1, C
STRING (7)LEADIN, C
STRING (7)CLEARSCREEN, C
BYTEINTEGERARRAY SPARE(1:204))
!
!This format is designed to be 256 bytes in length and must be kept so.
!
! TYPE A number 1 - n used to identify the record
! This number may be held in the user's OPTION
! file
!
! NAME A name which identifies the terminal. This name
! is printed when the user is prompted to specify
! his terminal
!
! COLUMNS The number of columns/line. This value can be
! put into the user's OPTION file
!
! LINES The number of lines/page. Conventionally, zero
! is used to indicate 'hardcopy'
!
! CLEAR SCREEN A sequence of characters which, if printed with
! PRINTCH, clears the screen. Null if the feature
! is not supported
!
! Other fields are spare
!>
!
!
INTEGERFN READCHS(STRING (63)Z, STRINGNAME CHS)
INTEGER N, W, FLAG
STRING (63)Z0
CHS = ""
RESULT = 0 IF Z = "NULL"
N = 0
UNTIL Z = "" CYCLE
Z0 = Z AND Z = "" UNLESS Z -> Z0 . (",") . Z
FLAG = STOI(Z0, W)
RESULT = 1 UNLESS FLAG = 0
N = N + 1
CHARNO(CHS, N) = W
REPEAT
!
RESULT = 1 IF N = 0
LENGTH(CHS) = N
RESULT = 0
END ; ! OF READ CHS
!
!
!
ROUTINE WRITECHS(STRING (63)NAME, VALUE)
INTEGER I, L
PRINTSTRING(NAME)
PRINTSTRING(": ")
L = LENGTH(VALUE)
IF L = 0 C
THEN WS(" - null -") C
ELSE START
CYCLE I = 1, 1, L
PRINTSTRING(ITOS(CHARNO(VALUE, I)))
PRINTSTRING(", ") UNLESS I = L
REPEAT
NEWLINE
FINISH
END ; ! OF WRITE CHS
!
!
!
ROUTINE PRINTTERM(RECORDNAME TERM)
RECORDSPEC TERM(TERMF)
WSN("Type ", TERM_TYPE)
WS ("Name ". TERM_NAME)
WSN("Columns ", TERM_COLUMNS)
WSN("Lines ", TERM_LINES)
WRITECHS("Lead in ", TERM_LEADIN)
WRITECHS("Clear Screen ", TERM_CLEARSCREEN)
END
!
!
!
CONSTINTEGER TOPTERM = 31
CONSTSTRING (11)CHSFILE = "TERMINALCHS"
!
INTEGER ADR, FLAG, I, FROM, TO
STRING (255)ACT, J1, J2, UC, Y, Z
!
!
RECORDARRAYFORMAT TERMSF(1:TOPTERM)(TERMF)
RECORDARRAYNAME TERMS(TERMF)
RECORDNAME TERM(TERMF)
RECORD TERMW(TERMF)
!
RECORDFORMAT RECF(INTEGER ADR, TYPE, START, END)
RECORD REC(RECF)
!
!
!
CONSTINTEGER EDTOP = 8
CONSTSTRING (7)ARRAY EDITEM(1:EDTOP) = "PR", "Q", "E", C
"NAM", "COL", "LIN", "LEA", "CLE"
!
SWITCH EDSW(1:EDTOP)
!
!
ACT = S
-> TEST UNLESS S = ""
PROMPT:
PROMPT("Action: ")
RSTRG(ACT)
TEST:
UCTRANSLATE(ADDR(ACT)+1, LENGTH(ACT))
-> CREATE IF ACT -> ("CR") . Z
-> EDIT IF ACT -> ("ED") . Z
-> PRINT IF ACT -> ("PR") . Z
-> PROMPT
!
!
!
!<Operation
!The command prompts for an 'activity' (which may alternatively be
!specified as a parameter). Only the first two characters are
!examined. Upper or lower case may be used. The following activities
!are supported:
!
!
!<Create
!
!Creates a file of 8192 bytes which can accomodate records 1 to 31,
!clears the records to zero
!>
CREATE:
TO = 32 + TOPTERM * 256; ! size required
OUTFILE(CHSFILE, TO, 0, 0, ADR, FLAG)
INTEGER(ADR) = TO
TERMS == ARRAY(ADR + 32, TERMSF)
CYCLE I = 1, 1, TOPTERM
TERMS(I) = 0
TERMS(I)_TYPE = I
REPEAT
RETURN
!
!
!
!<Edit
!
!Allows a record to be defined from scratch (or changed) or by using
!another as a model. Reply n or m,n to the prompt (from,)to
!
!The 'edit' commands are
! PR print the record
! Q abandon the edit
! E end the edit and save the result
! NAM=string set the NAME field 2 < length(string) < 32
! COL=n set the COLUMNS field
! LIN=n set the LINES field, zero is used to imply hardcopy
! LEA=n1,n2,... set the LEADIN sequence to the integers
! n1, n2,... A null sequence is specified by NULL
! CLE=n1,n2,... set the CLEAR SCREEN sequence to the integers
! n1, n2,... A null sequence is specified by NULL
!>
EDIT:
CONNECT(CHSFILE, 3, 0, 0, REC, FLAG)
UNLESS FLAG = 0 START
PRINTMESS(FLAG)
RETURN
FINISH
TERMS == ARRAY(REC_ADR + 32, TERMSF)
TYPE:
PROMPT("(from,)to: ")
RSTRG(Z)
Y = "" UNLESS Z -> Y . (",") . Z
FLAG = STOI(Z, TO)
-> TYPE UNLESS 0 < TO <= TOPTERM
TERMW = TERMS(TO)
-> ED1 IF Y = ""
FLAG = STOI(Y, FROM)
-> TYPE UNLESS 0 < FROM <= TOPTERM
-> TYPE IF TERMS(FROM)_NAME = ""
TERMW = TERMS(FROM)
ED1:
TERMW_TYPE = TO
ED2:
PROMPT("Ed: ")
RSTRG(Z)
UC = Z
UCTRANSLATE(ADDR(UC)+1, LENGTH(UC))
WHILE UC -> J1 . (" ") . J2 THEN UC = J1 . J2
CYCLE I = 1, 1, EDTOP
-> EDSW(I) IF UC -> (EDITEM(I)) . UC
REPEAT
WS("syntax ?")
-> ED2
!
!
EDSW(1): ! PRINT
PRINTTERM(TERMW)
-> ED2
!
!
EDSW(2): ! QUIT (abandon)
WS("abandoned")
RETURN
!
!
EDSW(3): ! END
TERMS(TO) = TERMW
WS("terminal type ".ITOS(TO)." completed")
RETURN
!
!
EDSW(4): ! NAME
-> ED42 IF Z -> Y . ("=") . Z
ED41:
PROMPT("Name: ")
RSTRG(Z)
ED42:
-> ED41 UNLESS 2 < LENGTH(Z) < 32
TERMW_NAME = Z
-> ED2
!
!
EDSW(5): ! COLUMNS
-> ED52 IF Z -> Y . ("=") . Z
ED51:
PROMPT("Columns: ")
RSTRG(Z)
ED52:
-> ED51 UNLESS STOI(Z, I) = 0
TERMW_COLUMNS = I
-> ED2
!
!
EDSW(6): ! LINES
-> ED62 IF Z -> Y . ("=") . Z
ED61:
PROMPT("Lines: ")
RSTRG(Z)
ED62:
-> ED61 UNLESS STOI(Z, I) = 0
TERMW_LINES = I
-> ED2
!
!
EDSW(7): ! LEAD IN
-> ED72 IF Z -> Y . ("=") . Z
ED71:
PROMPT("Lead In: ")
RSTRG(Z)
ED72:
UCTRANSLATE(ADDR(Z)+1, LENGTH(Z)) UNLESS Z = ""
-> ED71 UNLESS READCHS(Z, TERMW_LEADIN) = 0
-> ED2
!
!
EDSW(8): ! CLEAR SCREEN
-> ED82 IF Z -> Y . ("=") . Z
ED81:
PROMPT("Clear Screen: ")
RSTRG(Z)
ED82:
UCTRANSLATE(ADDR(Z)+1, LENGTH(Z)) UNLESS Z = ""
-> ED81 UNLESS READCHS(Z, TERMW_CLEARSCREEN) = 0
-> ED2
!
!
!
!<Print
!Prints the values of all records defined, ie those whose names are
!not NULL
!>
!>
PRINT:
CONNECT(CHSFILE, 1, 0, 0, REC, FLAG)
UNLESS FLAG = 0 START
PRINTMESS(FLAG)
RETURN
FINISH
TERMS == ARRAY(REC_ADR+32, TERMSF)
!
CYCLE I = 1, 1, TOPTERM
TERM == TERMS(I)
UNLESS TERM_NAME = "" START
PRINTTERM(TERM)
FINISH
REPEAT
RETURN
END
ENDOFFILE