perm filename GEMTXT[GEM,BGB] blob
sn#056512 filedate 1973-08-08 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00012 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 TITLE GEMTXT - TEXT ROUTINES FOR GEOMETRIC MODELING.
C00004 00003 SUBR(KLTEXT,NODE)
C00007 00004 SUBR(SETEXT,NODE,SUBRLOC)
C00011 00005 SUBR(EDTEXT,NODE)
C00013 00006 ----- EDTEXT COMMAND TABLES
C00015 00007 ----- EDTEXT COMMAND ROUTINES
C00018 00008 SUBR EDSYS,NODE,CHAR Invoke system line editor
C00024 00009 SUBR(EDDPY,NODE,CURCHR)
C00026 00010 SUBR(INSTXT,NODE)
C00028 00011 SUBR(NXTLIN,NODE)
C00031 00012 CLRLIN: BLOCK 2
C00032 ENDMK
C⊗;
TITLE GEMTXT - TEXT ROUTINES FOR GEOMETRIC MODELING.
EXTERN META,CTRL,GETCHW
EXTERN DPYBUF,AIVECT,IFORM2,GEODPY,DPYOUT,DPYBIG,DPYSET,NEWMAC
EXTERN DTYO,DPYSTR
SUBR(MKY,VERTEX,TYPREL) ;MAKE Y-NODE.
COMMENT ⊗____________________________________________________________
⊗↔ CALL(MKNODE↑,[$YNODE])
LAC TYPREL↔DAC YREL(1) ;SETUP RELLOCATION.
PUSHP 2↔LAC 2,VERTEX
LOOP: PY 0,2↔JUMPE 0,[
PY. 1,2↔NY. 2,1
POPP 2↔POP2J]
LAC 2,0
GO LOOP
ENDR MKY;------------------------------------------------------------
SUBR(KLY,NODE)
COMMENT ⊗____________________________________________________________
⊗↔ LAC 1,NODE
PUSHP 2↔PUSHP 3
PY 2,1↔NY 2,1
PY. 3,2↔SKIPE 3↔NY. 2,3
CALL(KLNODE↑,1)
LAC 1,3
POPP 3↔POPP 2
POP1J
ENDR KLY;____________________________________________________________
SUBR(KLTEXT,NODE)
COMMENT ⊗____________________________________________________________
If called with vertex, all text on that vertex is deleted.
If called with a text node, only that line is deleted.
Returns previous node.
Uses AC 0-1, Transparent wrt to other AC's. ⊗
ACCUMULATORS{LAST,NEXT}
LAC 1,NODE
TEST 1,VBIT
GO KLLINE
PTEXT 1,1 ;Get text pointer
JUMPE 1,POP1J. ;None there
TESTZ 1,VBIT ;Is it a vertex?
POP1J ;Oops, a TJOINT, return
PUSHP NEXT
VLOOP: TCCW NEXT,1 ;Save pointer to next node
CALL(KLNODE,1) ;Kill a text node
LAC 1,NEXT ;Get back pointer to next node
JUMPN 1,VLOOP ;Repeat until NIL is found.
POPP NEXT
POP1J
KLLINE: PUSHP LAST↔PUSHP NEXT ;Save old LAST and NEXT
TCW LAST,1 ;Save pointer to LAST
KLLOOP: TCCW NEXT,1 ;Save pointer to NEXT
TEST 1,CONBIT ;Last in line?
GO LAST1 ;Yes
CALL(KLNODE,1) ;Kill this node
LAC 1,NEXT ;Get back pointer to next node
GO KLLOOP ;Repeat for rest of line
LAST1: CALL(KLNODE,1) ;Kill last node in line
TESTZ LAST,VBIT ;Is previous a vertex.?
GO [ PTEXT. NEXT,LAST ;Yes, use a different pointer
GO LAST2 ]
TCCW. NEXT,LAST ;New forward link
LAST2: JUMPE NEXT,LAST3 ;Don't try to store into NIL!
TCW. LAST,NEXT ;New backward link
LAST3: LAC 1,LAST
POPP LAST↔POPP NEXT ;Restore AC 2 and 3
POP1J
ENDR KLTEXT;5/4/73(TVR)----------------------------------------------
SUBR(SETEXT,NODE,SUBRLOC)
COMMENT ⊗____________________________________________________________
Called with a text node and the address of a subroutine which
fetches a character and skips if successful, with character in AC.1.
SETEXT returns on failure from character fetching subroutine or when
a <line feed> or <alt mode> is seen. Leaves terminating character
in AC.1. Uses AC 0-3. Calls KLTEXT. ⊗
ACCUMULATORS {PTR,N}
LAC N,NODE
NDLOOP: CALL SETPTR ;Set up count and byte pointer
CHLOOP: PUSHJ P,@SUBRLOC ;Call character fetching routine
GO CHDONE ;Failure return
JUMPE 1,CHLOOP ;Ignore nulls for now
CAIN 1,15 ;CROCKISHNESS!!!
GO CHLOOP
CAIE 1,12 ;Terminate in <line feed>
CAIN 1,175 ;or <alt mode>
GO CHDONE
SOJGE 0,DEPCHR ;Make sure it fits
TESTZ N,CONBIT ;Need another block
GO [ TCCW N,N ;This line already has one, use it
GO GOTNODE ]
PUSHP 1 ;Save character over MKNODE
TCCW PTR,N ;Get next node
CALL(MKNODE↑,[$TEXT]) ;Make a new text node
TCCW. PTR,1 ;Make new forward links
TCCW. 1,N
TCW. N,1 ;Make new backward links
SKIPE PTR↔TCW. 1,PTR ;Don't store into NIL
MARK N,CONBIT ;Turn on bit indication this is continued
LAC N,1 ;Now use this node
POPP 1 ;Get back character
GOTNOD: CALL SETPTR ;Set up count and byte pointer
DEPCHR: IDPB 1,PTR ;Deposit character into text node
GO CHLOOP ;Back for more
CHDONE: PUSHP 1 ;Save terminator
SETZ 1, ;Fill remainder of node with nulls
ZPLOOP: SOJGE 0,[ IDPB 1,PTR
GO ZPLOOP]
TEST N,CONBIT ;Is there more on this line?
GO FIN
MARKZ N,CONBIT ;Turn off bit indicating more in line
TCCW N,N ;Get next node
CALL(KLTEXT,N) ;Kill rest of line
FIN: POPP 1 ;Get terminating character
POP2J ;Return
SETPTR: LAC PTR,N ;Make byte pointer to word number 1
HRLI PTR,000700
MOVEI 0,5*8-1 ;Number of characters per node
POPJ P,
ENDR SETEXT;4-MAY-73(TVR)____________________________________________
SUBR(EDTEXT,NODE)
COMMENT ⊗------------------------------------------------------------
⊗↔ ACCUMULATORS{T1,T2,T3,COUNT,SIGN,CHAR,N}
LAC N,NODE
TESTZ N,VBIT↔PY N,N
JUMPE N,[ CALL (MKY,NODE,[.RLTXT])
MARK 1,VBIT
LAC N,NODE
HRLZI 0,XWC(N) ;COPY CO-ORDINATES
HRRI 0,XWC(1)
BLT 0,ZWC(1)
LAC N,1 ;SET SIZE TO 1
LACI 0,1
DPSIZ. 0,N
GO NEWTXT ]
SETOM EDUPDATE
SETZM ENDFLG
TESTZ N,VBIT↔PTEXT N,N
LOOP0: SETZ CHAR,
LOOP: CALL(EDDPY,N,["→"])
SETZB COUNT,SIGN
SKIPN CHAR
LOOP2: GO [ CALL(GETCHW)
LAC CHAR,1
GO .+1 ]
CAIN CHAR,15↔GO LOOP2
LDB 1,[POINT 2,CHAR,35-7]
LAC T1,CTABS(1)
LAC T2,CHAR↔ANDI T2,177
CAIL T2,"0"↔CAIL T2,"9"↔GO NOTNUM
TRNN CHAR,200↔GO NOTNUM
IMULI COUNT,=10
ADDI COUNT,-"0"(T2)
GO LOOP2
NOTNUM: CAIL T2,"a"↔CAILE T2,"z"↔GO LOOP3
SUBI T2,40
LOOP3: CAR 0,(T1)
CAIE 0,(T2)↔AOBJN T1,LOOP3
CAIE 0,(T2)
GO [ TRNN CHAR,200↔GO LINED
UNKNOWN: OUTSTR[ASCIZ/Unknown command: /]
TRNE CHAR,200↔OUTSTR[ASCIZ/<control>/]
TRNE CHAR,400↔OUTSTR[ASCIZ/<meta>/]
OUTCHR CHAR↔GO LOOP0 ]
CDR T2,(T1)
GO(T2)
;----- EDTEXT ;COMMAND TABLES
CTABS: FOR @` I←0,3,1
< XWD -CLEN`I,CTAB`I
>
CTAB0: XWD 12,[MOVEI 0,1↔GO MOVER]
XWD 177,[MOVNI 0,1↔GO MOVER]
XWD 13,[MOVNI 0,1↔GO MOVER]
XWD 175,LOOP0
CLEN0←←.-CTAB0
CTAB1:
;Commands to system line editor (includes <space> and <tab>:
FOR I ε {DIKS }
< XWD "I",LINED
>
XWD 12,[MOVEI 0,1↔GO MOVER]
CTAB3: XWD 13,[MOVNI 0,1↔GO MOVER] ;VT
XWD "<",[MOVNI 0,4↔GO MOVER]
XWD ">",[MOVEI 0,4↔GO MOVER]
XWD "≤",[MOVNI 0,16↔GO MOVER]
XWD "≥",[MOVEI 0,16↔GO MOVER]
XWD "↑",[MOVNI 0,1↔MOVEI CHAR,211↔GO MOVER2]
XWD "↓",[MOVEI 0,1↔MOVEI CHAR,211↔GO MOVER2]
XWD "Q",[TCW 1,N↔TESTZ 1,VBIT↔GO LOOP0
SETZ CHAR,↔CALL(EDSYS+1,N,CHAR)
GO LOOP]
XWD "/",CHGSIZ ;SHRINK DPY CHR SIZE.
XWD "\",CHGSIZ ;EXPAND DPY CHR SIZE.
XWD "V",UPGEO ;REFRESH.
XWD "Z",JOIN
XWD "+",[MOVEI SIGN,1↔GO LOOP2]
XWD "-",[SKIPN SIGN↔MOVEI SIGN,1
MOVN SIGN,SIGN↔GO LOOP2]
XWD "E",[EDEXIT: PGIOT 2,↔POP1J]
XWD "M",[SETZM CTRL↔SETZM META
CALL(NEWMAC)↔GO LOOP0]
XWD "N",[SETZM CTRL↔SETZM META
CALL(IFORM2)↔GO LOOP0]
CLEN1←←.-CTAB1
XWD 12,INSLIN
XWD "I",INSLIN
XWD "D",DELLIN
CLEN3←←.-CTAB3
CTAB2: XWD 12,UNKNOWN
CLEN2←←.-CTAB2
;----- EDTEXT ;COMMAND ROUTINES
MOVER: SETZ CHAR,
MOVER2: SKIPN COUNT
MOVEI COUNT,1
IMUL COUNT,0
SKIPGE SIGN
MOVN COUNT,COUNT
JUMPL COUNT,BACK
SETZM ENDFLG
FORWRD: CALL NXTLIN,N
JUMPE 1,[SETOM ENDFLG
GO LOOP]
LAC N,1
SOJG COUNT,FORWRD
GO LOOP
BACK: SKIPE ENDFLG
GO [ SETZM ENDFLG
GO BACK2 ]
BACK1: CALL PRVLIN,N
TESTZ 1,VBIT
GO LOOP
LAC N,1
BACK2: AOJL COUNT,BACK1
GO LOOP
LINED: SKIPE ENDFLG
GO [ CAIL CHAR,177
GO UNKNOWN
CALL(INSTXT,N)
LAC N,1
SETZM ENDFLG
GO LINED ]
CALL EDSYS,N,CHAR
DAC 1,CHAR
GO LOOP
INSLIN: TCW N,N
JUMPG COUNT,INSLI2
NEWTXT: CALL(INSTXT,N)
DAC 1,N
CALL(EDDPY,N,["↔"])
SETZM CLRLIN
CALL(EDSYS,N,[0])
CAIN 1,12
GO NEWTXT
GO LOOP0
INSLI2: CALL(INSTXT,N)
SOJG COUNT,INSLI2
CALL(PRVLIN,N)
GO LOOP0
DELLIN: SKIPE ENDFLG
GO LOOP0
SKIPE SIGN
IMULI COUNT,SIGN
JUMPL COUNT,DBACK
DELLI2: CALL(KLTEXT,N)
LAC N,1
TESTZ N,VBIT
GO [ PTEXT 1,N
GO DELLI3 ]
TCCW 1,N
DELLI3: JUMPE 1,[ TESTZ N,VBIT
GO [ OUTSTR[ASCIZ/NOTHING LEFT!/]
GO EDEXIT ]
SETOM ENDFLG
GO LOOP0 ]
LAC N,1
SOJG COUNT,DELLI2
GO LOOP0
DBACK: CALL(KLTEXT,N)
LAC N,1
TESTZ N,VBIT
GO [ PTEXT N,N
JUMPE N,[ OUTSTR[ASCIZ/NOTHING LEFT!/]
GO EDEXIT ]
GO LOOP0 ]
TLNE 0,(CONBIT)
SUBI COUNT,1
DBACK2: AOJL COUNT,DBACK
GO LOOP0
JOIN: CALL(NXTLIN,N)
JUMPE 1,LOOP0
TCW 1,1
MARK 1,CONBIT
GO LOOP0
CHGSIZ: LAC 1,N
TEST 1,VBIT
GO [ TCW 1,1
GO CHGSIZ+1 ]
DPSIZ 0,1
CAIE CHAR,200+"/"
CAIN CHAR,600+"/"
SUBI 0,1
CAIE CHAR,200+"\"
CAIN CHAR,600+"\"
ADDI 0,1
ANDI 0,7 ;MUMBLE
DPSIZ. 0,1
UPGEO: PUSHP N
CALL GEODPY
POPP N
GO LOOP0
ENDR EDTEXT;4-MAY-73(TVR)____________________________________________
SUBR EDSYS,NODE,CHAR ;Invoke system line editor
COMMENT ⊗___________________________________________________________
Here we gronk the system line editor ⊗
ACCUMULATORS{N,C1,C2,P1,P2}
EXTERNAL FILFLG,MACNOD,MACGET
TDZA 0,0 ;Set or clear Q command flag
MOVEI 0,1
DAC 0,FOOFLG
LAC N,NODE ;Put text into EDBUF in preparation
LAC P2,[POINT 7,EDBUF] ;for line edit
MOVEI C2,5*EDBFLN-2
CH1: LAC P1,N ;For each node
HRLI P1,700
MOVEI C1,5*8-1
CHLOOP: ILDB 1,P1 ;Pick up a character
JUMPE 1,CH2 ;Ignore nulls
IDPB 1,P2 ;Put into EDBUF
SOJL C2,[OUTSTR[ASCIZ/Too long for line editor!/] ;Error check
CLRBFI↔SETZ 1,↔POP2J]
CH2: SOJG C1,CHLOOP ;For each character
TESTZ N,CONBIT ;More left?
GO [ TCCW N,N ;Yes
JUMPN N,CH1
GO .+1 ]
MOVEI 1,15 ;Make sure it ends with <return>
IDPB 1,P2
SETZ 0, ;Make sure it terminated with <null>
IDPB 0,P2
PTLOAD [0↔EDBUF] ;Stuff it into line buffer
;Here we should, but don't pick up anything typed ahead
LAC 1,CHAR ;Pick up character starting command
PTWR1W 0 ;Put it into input buffer
LAC 1,CLRLIN+1 ;Turn off line to be editted
PGSEL 17
SKIPE CLRLIN ;Unless we're in Q command
UPGMVM 1,@CLRLIN
MOVEI C1,1 ;Now, how many lines from top
LAC 1,N
CH3: CALL(PRVLIN,1) ;Get previous node
TEST 1,VBIT ;A vertex?
AOJA C1,CH3 ;Yes, try next back
IMULI C1,-30 ;Calculate line position
ADDI C1,=460
PPIOT 6,(C1) ;LAC line editor up there
LAC 1,NODE ;Pick up node
SKIPN FOOFLG ;If Q flag, then pick up display for new line
GO CH4
CALL(INSTXT,NODE) ;Insert a blank line to be filled
DAC 1,NODE ;Save that line
CALL(EDDPY,1,["→"]) ;A line and cursor
CH4: SKIPN FILFLG ;In a macro mode?
SKIPE MACNOD
GO CH5 ;Yes, handle special
TTYUUO 14, ;Wait for activation character
CH6: CALL(SETEXT,NODE,[EDGET]) ;Now
PPIOT 6,0 ;Reset page printer
SETOM EDUPDATE ;Make it know this is an update
LAC 1,BRKCHR ;Get back break character from line edit
POP2J
CH5: CALL(MACGET) ;Get a character from macro
JUMPE 1,CH4 ;If zero, end of macro
SETZ 0, ;Stuff character into input buffer
PTWR1W 0
LAC 0,1 ;Get low order 7 bits
ANDI 0,177
CAIL 0,"a" ;Convert to upper case
CAILE 0,"z"
SKIPA
SUBI 0,40
CAIE 0,12 ;<return> and <line> always terminate
CAIN 0,15
GO CH6
CAIN 0,175 ;As does <alt mode>
GO CH6
CAIL 1,600 ;Always terminate if <control><meta>
GO CH6
CAIL 1,200 ;Not a terminator if no control bits
CAIL 1,400 ;Or <meta>
GO CH5
CAIE 0,"S" ;Must be <control>, test each of edit commands
CAIN 0,"I"
GO CH5
CAIE 0,"D"
CAIN 0,"K"
GO CH5
CAIE 0,11
CAIN 0,40
GO CH5
CAIE 0,14
CAIN 0,177
GO CH5
GO CH6
EDGET: INCHSL 1
POPJ P,
CAIE 1,12
CAIL 1,200
GO [ DAC 1,BRKCHR
GO EDGET ]
CAIN 1,15
GO [ INCHSL 1
JFCL
DAC 1,BRKCHR
POPJ P,]
CAIN 1,175
GO BLAST
AOS (P)
POPJ P,
BLAST: SUB P,[XWD 4,4]
BLAST0: PPIOT 6,0
BLAST1: INCHSL 1
GO BLAST2
CAIE 1,15
GO BLAST1
INCHSL 1
JFCL
BLAST2: LAC P2,[POINT 7,EDBUF]
CALL(SETEXT,NODE,[EDGET2])
SETZ 1,
POP2J
EDGET2: ILDB 1,P2
JUMPE 1,[POPJ P,]
AOS(P)
POPJ P,
DECLARE{BRKCHR,FOOFLG}
ENDR EDSYS;4-MAY-73(TVR)_____________________________________________
SUBR(EDDPY,NODE,CURCHR)
COMMENT ⊗___________________________________________________________⊗
EXTERNAL DPYPTR,RIVECT,DPYBRT
N←4
CALL(DPYSET,DPYBUF)
CALL(DPYBIG,[2])
CALL(DPYBRT,[2])
CALL(AIVECT,[-777],[=460])
CALL(DPYSTR,[[ASCIZ/*****************
/]])
LAC N,NODE
SETZM CURFLG
SKIPA
FNDBEG: TCW N,N
TEST N,VBIT
GO FNDBEG
PTEXT N,N
DPLOOP: SKIPN ENDFLG
CAME N,NODE
GO DP2
CALL(DPYCUR)
DP2: MOVEI 0,1(N)
CALL(DPYSTR,0)
TESTZ N,CONBIT
GO [ TCCW N,N
JUMPN N,DP2
FATAL(MISSING END TO TEXT)]
CALL(DPCRLF)
TCCW N,N
JUMPN N,DPLOOP
DP3: SKIPN ENDFLG
GO DP4
CALL(DPYCUR)
DP4: CALL(DPYSTR,[[ASCIZ/********/]])
CALL(DPCRLF)
CALL(DPYOUT,[17])
POP2J
.PLEVEL←←.PLEVEL+1
DPYCUR: CALL(RIVECT,[-15],[0])
CDR 1,DPYPTR
DAC 1,CLRLIN
SETOM CURFLG
CALL(DTYO,CURCHR)
CALL(DPYSTR,<[[BYTE(7) " ",15,0]]>)
POPJ P,
.PLEVEL←←.PLEVEL-1
DPCRLF: SKIPN CURFLG
GO DPCRL2
SETZM CURFLG
MOVSI 1,000700
HLLM 1,DPYPTR
HRLZ 1,DPYPTR
ADD 1,[XWD 1,20]
DAC 1,CLRLIN+1
DPCRL2: CALL(DPYSTR,[[ASCIZ/
/]])
POPJ P,
DECLARE{CURFLG}
ENDR EDDPY;4-MAY-73(TVR)_____________________________________________
SUBR(INSTXT,NODE)
;Insert a text node in after of NODE. Return new node in 1.
;
;Uses AC 0-1, Transparent to all others
;Calls MKNODE
ACCUMULATORS{NEXT,LAST}
PUSHP NEXT
PUSHP LAST
LAC LAST,NODE
JUMPE LAST,[FATAL(INSTXT called with NIL)]
TESTZ LAST,VBIT
GO L2
L0: TCCW 0,LAST
JUMPE 0,L2
LAC LAST,0
TESTZ LAST,CONBIT
GO L0
L2: CALL(MKNODE↑,[$TEXT]) ;Make a new text node
TESTZ LAST,VBIT ;Are we inserting at beginning of text list?
GO [ PTEXT NEXT,LAST ;Yes, special pointers
PTEXT. 1,LAST
GO L1 ]
TCCW NEXT,LAST ;Get next node
TCCW. 1,LAST ;Make new forward link
L1: TCCW. NEXT,1
TCW. LAST,1 ;Make new backward links
SKIPE NEXT↔TCW. 1,NEXT ;Don't store into NIL
POPP LAST
POPP NEXT
POP1J
ENDR INSTXT;4-MAY-73(TVR)____________________________________________
SUBR(NXTLIN,NODE)
COMMENT ⊗___________________________________________________________
Return pointer to next line, 0 if last line. Uses AC 0-1.⊗
LAC 1,NODE ;Fetch node
TESTZ 1,VBIT ;Is it a vertex?
GO [ PTEXT 1,1 ;Yes, Next is alway the PTEXT link
POP1J ]
LOOP1: TESTZ 1,CONBIT ;Is node at end of line?
GO [ TCCW 1,1 ;No, get another and try again
GO LOOP1 ]
TCCW 1,1 ;Now the next character will be a new line
POP1J ;Return
ENDR NXTLIN;6-MAY-73(TVR)____________________________________________
SUBR(PRVLIN,NODE)
;Returns pointer to previous line or vertex if called with first line
;
;Uses AC 0-1
;
LAC 1,NODE ;Fetch node
TESTZ 1,VBIT ;Lose if at vertex
GO [ FATAL(PRVLIN called with VERTEX) ]
TCW 1,1 ;Get previous node
TESTZ 1,VBIT ;Is it the vertex?
POP1J ;Yes, return in
LOOP: TCW 1,1 ;Find end of previous line
TESTZ 1,VBIT ;Is it a line
GO [ PTEXT 1,1 ;No, the line starts thru PTEXT link
POP1J ]
TLNE 0,(CONBIT) ;Is it an end of line?
GO LOOP ;No, try next one back
TCCW 1,1 ;Now, go forward one and that's the line
POP1J ;Now, if the first node instead of the last
;were noted, this would be alot easier!
ENDR PRVLIN;6-MAY-73(TVR)____________________________________________
CLRLIN: BLOCK 2
EDBUF: BLOCK =21
EDBFLN←←.-EDBUF
DECLARE{EDUPDATE,ENDFLG}
END