EXTERNALROUTINE VVDESK(STRING (255)DESKDATA)
ROUTINE STRINGS TO FILE(STRINGARRAYNAME S, INTEGER N,
STRING (11)FILE, STRING (255)HEADER)
INTEGER I
EXTERNALROUTINESPEC CLEAR(STRING (255)S)
EXTERNALROUTINESPEC DEFINE(STRING (255)S)
DEFINE("61,".FILE)
SELECT OUTPUT(61)
PRINTSTRING(HEADER)
IF N > 0 START
CYCLE I = 1, 1, N
PRINTSTRING(S(I))
NEWLINE
REPEAT
FINISH
SELECT OUTPUT(0)
CLOSE STREAM(61)
CLEAR("61")
END
!
!
!
INCLUDE "ERCC10.VVPSPECS"
INCLUDE "ERCC10.VVPFORMATS"
routine VVrstrg(stringname s)
! Assuming that the VV DEFINE TRIGGERS call allows left-right cursor
! movement, this routine supplies an input line (message), possibly edited
! by cursor movement, from the terminal and terminated (of course) by a
! trigger character.
! The input is considered "cancelled" if a control character other than
! CR ("Return") terminates the message, or if printable characters are typed
! to the left of the first printable charcter typed (belonging to the current
! message). If the input message is "cancelled", this routine returns a null
! string.
integer first printable, j, curpt, cancel, start col, nmax, it scrolled
ownbyteintegerarray buf(-1:255)
curpt=0 { used in line editing to point to intermediate chars in buf }
nmax=-1 { highest position used in BUF }
it scrolled=0
cancel=0
first printable=0
for j=255, -1, 0 cycle ; buf(j)=' '; repeat
cycle { read chars of message }
if curpt>250 then cancel=1
vv read ch(j)
if vv bits&scrolled#0 then it scrolled=it scrolled+1
{ This can't happen with VV DEFINE TRIGGERS(3, ..) because
{ up-down cursor movement is inhibited, except maybe with
{ terminals which do a line-feed operation on typing in
{ col SCOLS-1.
exit if vv bits&trigger#0
if vv bits&(strange cursor!no effect)#0 then cancel=1
if vv bits&canon#0 start
! left-right line editing
if j=cursor left canon then curpt=curpt-1 else c
if j=cursor right canon then curpt=curpt+1 else cancel=1
finish
if vv bits&printable#0 start
if first printable=0 start
first printable=j
startcol=vv charx
finish
if 0<=curpt<=250 then buf(curpt)=j else cancel=1
curpt=curpt+1
if curpt>nmax then nmax=curpt
finish
repeat
if j#13 then cancel=1 { trigger not CR }
vv repair screen
if it scrolled#0 then vv unscroll(it scrolled)
if cancel#0 start
s=""
finish else start
buf(-1)=nmax+1
s=string(addr(buf(-1)))
finish
end { rstrg }
RECORDFORMAT RF(INTEGER ADR, TYPE, START, END)
RECORDFORMAT WF(STRING (31)NAME, INTEGER START, END, CP, L0, C0,
SL, SC, L, C, TB, BB)
!
!
!
DYNAMICROUTINESPEC CALL(STRING (31)C, STRING (255)P)
SYSTEMROUTINESPEC CONNECT(STRING (31)FILE, INTEGER MODE, HOLE, PROT,
RECORD (RF)NAME R, INTEGERNAME FLAG)
EXTERNALINTEGERFNSPEC EXIST(STRING (255)S)
SYSTEMROUTINESPEC LOAD(STRING (31)COM, INTEGER I,
INTEGERNAME FLAG)
SYSTEMROUTINESPEC OUTFILE(STRING (31)S, INTEGER LEN, MAX, PRM,
INTEGERNAME ADR, RES)
SYSTEMROUTINESPEC PRINTMESS(INTEGER I)
EXTERNALROUTINESPEC PROMPT(STRING (255)S)
SYSTEMROUTINESPEC UCTRANSLATE(INTEGER ADR, LEN)
EXTERNALSTRINGFNSPEC UINFS(INTEGER N)
EXTERNALSTRINGFNSPEC VDUS(INTEGER I)
!
!
!
ROUTINE RSTRG(STRINGNAME S)
INTEGER I
S = ""
CYCLE
READSYMBOL(I)
IF I = NL START
RETURN UNLESS S = ""
FINISH ELSE S = S . TOSTRING(I)
REPEAT
END
!
!
!
STRINGFN ITOS(INTEGER VALUE)
STRING (11)S
STRING (1)SIGN
INTEGER J
SIGN = ""
S = ""
SIGN = "-" AND VALUE = -VALUE IF VALUE < 0
CYCLE
J = VALUE
VALUE = VALUE//10
J = J-VALUE*10+'0'
S = TO STRING(J).S
EXIT IF VALUE <= 0
REPEAT
RESULT = SIGN.S
END
INTEGERFN STOI(STRING (255)S, INTEGERNAME I)
STRING (63)P
INTEGER TOTAL, SIGN, AD, J, HEX
HEX = 0
TOTAL = 0
SIGN = 1
AD = ADDR(P)
A: IF S -> P.(" ").S AND P="" THEN -> A; !CHOP LEADING SPACES
IF S -> P.("-").S AND P="" THEN SIGN = -1
IF S -> P.("X").S AND P="" THEN HEX = 1 AND -> A
P = S
UNLESS S -> P.(" ").S THEN S = ""
I = 1
WHILE I <= BYTEINTEGER(AD) CYCLE
J = BYTE INTEGER(I+AD)
-> FAULT UNLESS '0' <= J <= '9' OR (HEX # 0 C
AND 'A' <= J <= 'F')
IF HEX = 0 C
THEN TOTAL = 10*TOTAL C
ELSE TOTAL = TOTAL<<4+9*J>>6
TOTAL = TOTAL+J&15
I = I+1
REPEAT
IF HEX # 0 AND I > 9 THEN -> FAULT
IF I > 1 THEN I = SIGN*TOTAL AND RESULT = 0
FAULT:
I = 0
RESULT = 1
END
!
!
!
ROUTINE FILL(INTEGER LEN, FROM, FILLER)
RETURN UNLESS LEN > 0
!
*LDTB_X'18000000'
*LDB_LEN
*LDA_FROM
*LB_FILLER
*MVL_L =DR
END
!
!
!
ROUTINE PRINTCHS(STRING (255)S)
SYSTEMINTEGERFNSPEC IOCP(INTEGER EP, PARM)
INTEGER LEN, ADR, RES; ! KEEP IN THIS ORDER !!!!
RETURN IF LENGTH(S) = 0
LEN = LENGTH(S)
ADR = ADDR(S) + 1
RES = IOCP(19, ADDR(LEN))
END
!
!
!
ROUTINE SORT STRINGS(STRINGARRAYNAME U, INTEGER N)
! U declared 1:N
INTEGER I, J, K, M
STRING (255)W
RETURN IF N < 1
!
M = 1
M = M << 1 WHILE M <= N
M = M - 1
!
CYCLE
M = M >> 1
EXIT IF M = 0
CYCLE I = 1, 1, N-M
K = I
WHILE K > 0 CYCLE
J = K + M
!
EXIT IF U(K) <= U(J)
W = U(J)
U(J) = U(K)
U(K) = W
!
K = K - M
REPEAT
REPEAT
REPEAT
END
!
!
!
ROUTINE FILES(STRING (6)USER)
INTEGER J, N, TOT
STRING (11)ARRAY S(1:256)
RECORDFORMAT INFF(STRING (11)NAME, INTEGER S0, KB, S1, S2, S3)
RECORD (INFF)ARRAY INF(0:254)
EXTERNALINTEGERFNSPEC DFILENAMES(STRING (6)USER,
RECORD (INFF)ARRAYNAME INF, INTEGERNAME JUNK, N, TOT,
INTEGER FSYS, TYPE)
N = 255
J = DFILENAMES(USER, INF, J, N, TOT, -1, 0)
IF N > 0 = J START
CYCLE I = 1, 1, N
S(I) = INF(I-1)_NAME
REPEAT
IF TOT > N START
S(N+1) = "{".ITOS(TOT - N)." more}"
N = N + 1
FINISH
FINISH
SORTSTRINGS(S, N)
STRINGS TO FILE(S, N, "T#FILES", "")
END
!
!
!
ROUTINE PDFILE(INTEGER BASE, STRING (11)FILE, STRING (255)HDR)
INTEGER N, I
STRING (11)ARRAY S(1:2048)
RECORDFORMAT FHDRF(INTEGER NFB, TXTST, MAX, TYPE, CHKSUM,
TIMESTAMP, ADR, COUNT)
RECORDFORMAT MEMF(INTEGER START, STRING (11)NAME, INTEGER A,B,C,D)
RECORD (MEMF)ARRAYFORMAT MEMSF(0:2047)
RECORD (FHDRF)NAME H
RECORD (MEMSF)ARRAYNAME MEMS
H == RECORD(BASE)
N = H_COUNT
IF N = 0 START
N = 1
S(1) = "**empty**"
FINISH ELSE START
MEMS == ARRAY(BASE+H_ADR, MEMSF)
CYCLE I = 1, 1, N
S(I) = MEMS(I-1)_NAME
REPEAT
FINISH
SORT STRINGS(S, N)
STRINGS TO FILE(S, N, FILE, HDR)
END
!
!
!
INTEGER I, J, C, L, ERR, T, EOF, C0, STATE, CH, P, Q
INTEGER A, AS1, BOF, L0
STRING (31)CS
STRING (255)S, ASREAD, SLAST, W1, W2
BYTEINTEGERARRAY OLDSCREEN, SCREEN(1:23*80)
!
RECORD (RF)R
!
CONSTINTEGER MAXW = 32
RECORD (WF)ARRAYFORMAT WSF(1:MAXW)
RECORD (WF)ARRAYNAME WS
RECORD (WF)NAME W
INTEGERARRAYFORMAT SVF(1:MAXW)
INTEGERARRAYNAME SV
INTEGERNAME NOS
INTEGERARRAY INT(1:15)
STRING (31)ARRAY STR(1:15)
!
!
CONSTINTEGER NCOMS = 9
CONSTSTRING (1)ARRAY COMS(1:NCOMS) = "W", "S", "*", ":", "C", "L",
"?", "X", "Q"
SWITCH COM(1:NCOMS)
!
!
CONSTINTEGER HORIZ = '-'
CONSTINTEGER VERT = '|'
CONSTINTEGER CRNR = '+'
SWITCH SW(0:6)
ROUTINE WRSN(STRING (255)S, INTEGER N)
PRINTSTRING(S)
WRITE(N, 1)
NEWLINE
END
!
!
!
ROUTINE WRS(STRING (255)S)
PRINTSTRING(S)
NEWLINE
END
!
!
ROUTINE MSG(INTEGER I)
CONSTSTRING (15)ARRAY T(1:5) = C
"window no",
"screen line",
"screen col",
"no of lines",
"no of cols"
!
!
!
ERR = 1 IF I > 0
I = -I AND PRINTSTRING("**WARNING ") IF I < 0
WRS(T(I))
END
!
!
CS = VDUS(1)
AS1 = ADDR(SCREEN(1))
FILL(23*80, ADDR(OLDSCREEN(1)), ' ')
SLAST = ""
! PROMPT("Desk: ")
VVINIT(J)
RETURN UNLESS J = 0
VV DEFINE TRIGGERS(3, 0, 0)
DESKDATA = "DESKDATA" IF DESKDATA = ""
!
IF EXIST(DESKDATA) = 0 START
OUTFILE(DESKDATA, 4064, 0, 0, A, J)
PRINTMESS(J) AND RETURN UNLESS J = 0
!
NOS == INTEGER(A+32)
SV == ARRAY(A+36, SVF)
WS == ARRAY(A+36+4*MAXW, WSF)
!
NOS = 0
CYCLE I = 1, 1, MAXW
SV(I) = 0
WS(I) = 0
REPEAT
FINISH ELSE START
CONNECT(DESKDATA, 3, 0, 0, R, J)
PRINTMESS(J) AND RETURN UNLESS J = 0
A = R_ADR
NOS == INTEGER(A+32)
SV == ARRAY(A+36, SVF)
WS == ARRAY(A+36+4*MAXW, WSF)
CYCLE I = 1, 1, MAXW
W == WS(I)
UNLESS W_NAME = "" START
FILES(UINFS(1)) IF W_NAME = "T#FILES"
CONNECT(W_NAME, 1, 0, 0, R, J)
IF J = 0 START
W_START = R_ADR + R_START
W_END = R_ADR + R_END
W_CP = W_START
!
IF W_L0 > 1 START ; ! move forward
T = W_CP
Q = W_L0 - 1; ! number of lines to move
CYCLE
CH = BYTEINTEGER(T)
T = T + 1
Q = Q - 1 IF CH = NL
W_CP = T AND EXIT IF Q = 0 OR T > W_END
REPEAT
FINISH
FINISH ELSE W = 0
FINISH
REPEAT
-> LOOP IF NOS = 0
J = 0
CYCLE I = 1, 1, NOS
IF 0 < SV(I) <= MAXW START
IF WS(SV(I))_NAME # "" START
J = J + 1
SV(J) = SV(I)
FINISH
FINISH ELSE EXIT
REPEAT
NOS = J
-> COM(3) IF NOS > 0; ! Display
FINISH
LOOP:
! RSTRG(S)
VVGOTO(0, 23)
PRINTSTRING("Desk: ")
VVRSTRG(S)
ASREAD = S ."###"
LENGTH(S) = LENGTH(S)-1
UCTRANSLATE(ADDR(S)+1, LENGTH(S))
!
IF CHARNO(S, 1) = '!' START
S -> ("!") . S
IF S = "" START
-> LOOP IF SLAST = ""
S = SLAST
FINISH ELSE SLAST = S
W1 = "" UNLESS S -> S . (" ") . W1
LOAD(S, 0, J)
IF J = 0 START
CALL(S, W1)
PROMPT("Desk: ")
FINISH ELSE WRS("?")
-> LOOP
FINISH
!
S = W1." ".W2 WHILE S-> W1.(" ").W2
S = W1.",".W2 WHILE S-> W1.(" ").W2
S = S . ","
I = 0
I=I+1 AND J=STOI(STR(I), INT(I)) WHILE S -> STR(I+1).(",").S
CYCLE J = 1, 1, NCOMS
-> COM(J) IF STR(1) = COMS(J)
REPEAT
WRS(STR(1) . "???")
-> LOOP
COM(1): ! W(INDOW) num user.file sl sc l c l0 c0
WRS("???") AND -> LOOP IF I < 3
ERR = 0
INT(9) = 1 IF I < 9
INT(8) = 1 IF I < 8
INT(7) = 80 IF I < 7
INT(6) = 23 IF I < 6
INT(5) = 1 IF I < 5
INT(4) = 1 IF I < 4
MSG(1) UNLESS 1 <= INT(2) <= MAXW
MSG(2) UNLESS 1 <= INT(4) <= 23
MSG(3) UNLESS 1 <= INT(5) <= 80
MSG(4) UNLESS 1 <= INT(6) <= 23
MSG(5) UNLESS 1 <= INT(7) <= 80
INT(6) = 24 - INT(4) IF INT(4)+INT(6) > 24
INT(7) = 81 - INT(5) IF INT(5)+INT(7) > 81
-> LOOP UNLESS ERR = 0
INT(8) = 1 IF INT(8) < 1
INT(9) = 1 IF INT(9) < 1
!
IF STR(3) = "!FILES" START
FILES(UINFS(1))
STR(3) = "T#FILES"
FINISH
CONN:
CONNECT(STR(3), 1, 0, 0, R, J)
UNLESS J = 0 START
PRINTMESS(J)
WRS("Filename: ".STR(3))
-> LOOP
FINISH
W == WS(INT(2))
!
UNLESS R_TYPE = 3 START
IF R_TYPE = 6 START ; ! PD file
STR(3) = "T#".STR(3)
LENGTH(STR(3)) = 11 IF LENGTH(STR(3)) > 11
PDFILE(R_ADR, STR(3), "")
-> CONN
FINISH ELSE WRS("Wrong kind of file") AND -> LOOP
FINISH
!
W = 0
W_NAME = STR(3)
W_START = R_ADR + R_START
W_END = R_ADR + R_END
W_CP = W_START
W_SL = INT(4)
W_SC = INT(5)
W_L = INT(6)
W_C = INT(7)
W_TB = (W_SL-2)*80+W_SC-1 IF W_SL > 1
W_BB = (W_SL+W_L-1)*80+W_SC-1 IF W_SL+W_L<24
W_L0 = INT(8)
W_C0 = INT(9)
-> LOOP
COM(2): ! SCREEN VECTOR
WRS("?") AND -> LOOP UNLESS 1 < I <= MAXW+1
NOS = I - 1
CYCLE J = 2, 1, I
SV(J-1) = INT(J)
REPEAT
-> LOOP
COM(3): ! DISPLAY
COM(4):
WRS("No S") AND -> LOOP IF NOS = 0
! PRINTCHS(CS) %AND NEWLINE %UNLESS CS = ""
FILL(23*80, ADDR(SCREEN(1)), ' ')
CYCLE J = 1, 1, NOS
W == WS(SV(J))
T = W_CP
EOF = W_END
!
CYCLE P = 0, 1, 1
Q = W_TB
Q = W_BB IF P = 1
IF Q > 0 START
Q = Q + AS1
FILL(W_C, Q, HORIZ)
BYTEINTEGER(Q-1) = CRNR IF W_SC > 1
BYTEINTEGER(Q+W_C) = CRNR IF W_SC+W_C < 81
FINISH
REPEAT
CYCLE L = 1, 1, W_L
A = AS1 + (W_SL + L - 2)*80 + W_SC - 1
C0 = W_C0
C = W_C
!
BYTEINTEGER(A-1) = VERT IF W_SC > 1; ! left border
BYTEINTEGER(A+C) = VERT IF W_SC+C < 81; ! right border
!
CH = 0
STATE = 0
STATE = 1 IF C0 <= 1
L:
CH = -2 IF T > EOF
UNLESS CH < 0 START
CH = BYTEINTEGER(T)
T = T + 1
CH = -1 IF CH = NL
FINISH
STATE = STATE ! 4 IF CH < 0; ! EOF or EOL
-> SW(STATE)
SW(0):
C0 = C0 - 1; ! ignoring first part of line
STATE = 1 IF C0 <= 1
-> L
SW(1):
BYTEINTEGER(A) = CH; ! filling
A = A + 1
C = C - 1
STATE = 2 UNLESS C > 0
-> L
SW(2):
-> L; ! skipping to eol
SW(4):
SW(5):
BYTEINTEGER(A) = ' '
A = A + 1
C = C - 1
STATE = 6 UNLESS C > 0
-> L
SW(6):
REPEAT
REPEAT
!
J = 1
CYCLE L = 1, 1, 23
P = 0
CYCLE C = 1, 1, 80
IF OLDSCREEN(J) = SCREEN(J) START
P = 0
FINISH ELSE START
OLDSCREEN(J) = SCREEN(J)
IF P = 0 START
P = 1
VVGOTO(C-1, L-1)
FINISH
PRINTCH(SCREEN(J))
FINISH
J = J + 1
REPEAT
REPEAT
-> LOOP
J = 1
CYCLE L = 1, 1, 23
CYCLE C = 1, 1, 80
PRINTSYMBOL(SCREEN(J))
J = J + 1
REPEAT
NEWLINE
REPEAT
-> LOOP
COM(5): ! C
WRS("?") AND -> LOOP UNLESS I > 1
MSG(1) UNLESS 1 <= INT(2) <= MAXW
W == WS(INT(2))
MSG(1) AND -> LOOP IF W_NAME = ""
INT(3) = W_C IF I < 3
Q = INT(3)
W_C0 = W_C0 + Q
W_C0 = 1 IF W_C0 < 1
W_C0 = 130 IF W_C0 > 130
-> LOOP
COM(6): ! L
WRS("?") AND -> LOOP UNLESS I > 1
P = INT(2)
MSG(1) AND -> LOOP UNLESS 1 <= P <= MAXW
W == WS(P)
MSG(1) AND -> LOOP IF W_NAME = ""
!
IF I = 3 START
S = STR(3)
L = LENGTH(S)
IF L > 0 AND CHARNO(S, L) = '%' START
LENGTH(S) = L - 1
IF STOI(S, L) = 0 START
IF L > 99 START
W_CP = W_END
W_L0 = 1000000
FINISH ELSE START
W_L0 = 1
IF L > 0 START
T = ((W_END - W_START)*L)//100 + W_START
T = T + 1 WHILE BYTEINTEGER(T)#NL
W_CP = T + 1
FINISH ELSE W_CP = W_START
FINISH
FINISH ELSE WRS("?")
-> LOOP
FINISH
FINISH
!
INT(3) = W_L IF I < 3
Q = INT(3)
!
-> LOOP IF Q = 0; ! no op
T = W_CP
L0 = W_L0
IF Q > 0 START ; ! go forward
EOF = W_END
-> LOOP IF T > EOF
CYCLE
CH = BYTEINTEGER(T)
T = T + 1
Q = Q - 1 AND L0 = L0 + 1 IF CH = NL
W_CP = T AND W_L0 = L0 AND -> LOOP IF Q = 0 OR T > EOF
REPEAT
FINISH ELSE START
BOF = W_START
-> LOOP IF T = BOF
T = T - 1
CYCLE
T = T - 1
W_CP = T + 1 AND W_L0 = L0 AND -> LOOP IF Q = 0 OR T <= BOF
Q = Q + 1 AND L0 = L0 - 1 IF BYTEINTEGER(T) = NL
REPEAT
FINISH
COM(7): ! ?
CYCLE J = 1, 1, MAXW
W == WS(J)
UNLESS W_NAME = "" START
PRINTSTRING("W")
WRITE(J, 2)
SPACE
PRINTSTRING(W_NAME)
WRITE(W_SL, 2)
WRITE(W_SC, 2)
WRITE(W_L, 2)
WRITE(W_C, 2)
WRITE(W_L0, 2)
WRITE(W_C0, 2)
NEWLINE
FINISH
REPEAT
!
IF NOS > 0 START
PRINTSTRING("S ")
CYCLE J = 1, 1, NOS
WRITE(SV(J), 2)
REPEAT
NEWLINE
FINISH
-> LOOP
COM(8): ! X
NOS = 0
CYCLE J = 1, 1, MAXW
SV(J) = 0
WS(J) = 0
REPEAT
-> LOOP
COM(9): ! Q
VV DEFINE TRIGGERS(0, 0, 0)
END
ENDOFFILE