1
0
mirror of https://github.com/PDP-10/its.git synced 2026-01-22 18:42:15 +00:00
PDP-10.its/src/draw/point.502
2018-05-05 19:19:09 +02:00

3094 lines
61 KiB
Plaintext
Raw Blame History

This file contains invisible Unicode characters

This file contains invisible Unicode characters that are indistinguishable to humans but may be processed differently by a computer. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

;<DRAW>POINT.FAI.93, 15-NOV-75 18:07:33, EDIT BY HELLIWELL
VERSION(POINT,8)
;STRAIGHTEN LINES (D) CHECK FOR COINCIDENT POINTS
MD,<
STRAIGHTEN:
TRO MCHG!NEEDCL
SKIPN A,PONPNT
POPJ P,
STRTN1: FETCH(TT,A,PXY) ;X,Y
PUSHJ P,PMOVX ;STRAIGHTEN X
PUSHJ P,PMOVY ;STRAIGHTEN Y
FETCH(A,A,PNXT)
JUMPN A,STRTN1
POPJ P,
>;MD
;STOP MOVING POINT - CHECK FOR TWO COINCIDENT POINTS
STOPM:
MPC,< FETCHL(TT,A,PBIT)
EQV TT,SID
JUMPL TT,SAMSTP
SKIPE B,PONPN2
JRST STOPM0
POPJ P,
SAMSTP:
>;MPC
SKIPN B,PONPNT
POPJ P,
STOPM0: FETCH(T,A,PXY)
MD,< HRLM B,(P)
PUSHJ P,STOPM4 ;CHECK THIS POINT
POPJ P, ;FOUND LOSER
MOVE C,A ; BECAUSE STRAIGHTEN MIGHT HAVE MOVED THEM
DEFINE STPMAC ' (DIR)
< FETCH(A,C,PN'DIR)
JUMPE A,STPM'DIR
FETCH(T,A,PXY)
HLRZ B,(P)
PUSHJ P,STOPM4
POPJ P, ;A LOSER!
STPM'DIR:
>
STPMAC(U)
STPMAC(D)
STPMAC(L)
STPMAC(R)
POPJ P,
>;MD
STOPM4: CAMN T,ADDR(B,PXY)
JRST STOPM3 ;SAME X,Y
STOPM1: FETCH(B,B,PNXT)
JUMPN B,STOPM4
MD,< JRST CPOPJ1 >
MPC,< POPJ P, >
STOPM3: CAMN A,B ;SAME POINT THOUGH?
JRST STOPM1
OUTSTR[ASCIZ/
YOU JUST PUT ONE POINT ON TOP OF ANOTHER,
YOU'D BETTER FIX IT!
/]
POPJ P, ;ONLY SAY IT ONCE
;PNTPUT
;CALL WITH
;T = X,Y FOR NEW POINT
;RETURNS WITH
;D = POINTER TO POINT
HSHPUT: AOSA HSHFLG# ;MAKE FAST HASH ENTRY FOR NOW
PNTPUT: SETZM HSHFLG
PUSH P,A
PUSH P,B ;SAVE B
SETZB A,B
PUSH P,T ;SAVE X,Y
PUSHJ P,PUTPN0 ;CREATE ENTRY
POP P,T
STORE(T,D,PXY) ;DEPOSIT X,Y
JRST POPBAJ
;PUTPNT: CREATES A POINT ENTRY ...
;CALL WITH:
; A = (TEXT?),,BPLOC
; B = BITS,,BODY POINTER
;RETURNS
; D = POINT CREATED
PUTPNT: SETZM HSHFLG#
PUTPN0: PUSH P,T
PUSH P,TT
PUSH P,E
TRO NEEDCL ;MAY NEED ANOTHER CLOSES
MPC,<
TLZ B,FRONT ;CLEAR THIS BIT
IOR B,SID ;PUT IT ON CURRENT SIDE
ROUTE,< TLZ M,%ROUTE ;MAKE HIM ROUTE AGAIN>
>;MPC
TLNE B,ISPIN ;BODY POINT?
JRST [ PUSHJ P,MAKPIN ;MAKE BODY PIN
MOVE D,TT
STORE(B,D,BBODY)
STORE(A,D,BPLOC) ;PTR TO TYPE PINLOC BLOCK
HLRZ TT,A ;MAYBE TEXT PTR
STORE(TT,D,BPTXT)
HLRZ TT,B ;BITS
STORE(TT,D,BPBIT)
JRST PUTPN1]
PUSHJ P,MAKPNT ;MAKE NORMAL POINT
MOVE D,TT
AOS E,PID ;NEW POINT ID
STORE(E,D,PID) ;SAVE PID
STORE(A,D,PLOC) ;MAYBE CPIN
HLRZ TT,B ;BITS
STORE(TT,D,PBIT)
HLRZ TT,A ;MAYBE TEXT PTR
STORE(A,D,PTXT)
PUTPN1: SKIPE HSHFLG ;FAST ENTRY?
JRST PUTPN4
MOVE T,D
HRLI T,PONPNT
MOVEM T,LSTPNT ;LAST POINT STORED AND ITS LAST
MOVE T,PONPNT
HRRZM D,PONPNT
HRRM T,(D)
PUTPN4: POP P,E
POP P,TT
POP P,T
POPJ P,
;ONSCR - CHECK T FOR ONSCREEN POINT
ONSCR: CAML T,LEFT
CAMLE T,RIGHT
POPJ P,
HRRE TTT,T ;GET Y
CAML TTT,BOTTOM
CAMLE TTT,TOP
POPJ P,
AOS (P) ;DO THIS FOR SPEED
POPJ P,
;ALTMODE, SPACE
PNALT: TRZE INLIN
TRO NEEDCL
CLRMOV: TRZE INMOV ;TURN OFF MOVING
TRO NEEDCL
POPJ P,
MD,<
PNSPC: TRNN INLIN
JRST CLRMOV
TRC ZIGZAG ;COMPLIMENT THE WAY THE ZIG ZAGS
POPJ P,
>;MD
;NOT (D)
MD,<
PNOT: TRNE INLIN ;CHECK DRAWING LINE
PUSHJ P,GETCLS
JRST PERRET ;NO
PUSHJ P,PNOT1
JRST PERRET
POPJ P,
;A = POINT
PNOT1: MOVE B,LINING
FETCH(T,A,PXY) ;X,Y OF START POINT
ADJUST(SUB,T,<ADDR(B,PXY)>) ;- X,Y OF DESTINATION
HRRE TT,T
HLRES T
MOVEI E,0
MOVEI F,2
SKIPGE T
MOVEI E,1
SKIPGE TT
MOVEI F,3
MOVMS T
MOVMS TT
CAMN T,TT ;45 DEGREES?
TRNN ZIGZAG ;YES, TAKE HINT FROM ZIGZAG
CAMLE T,TT ;HORZ OR VERT?
MOVE F,E ;HORZ, USE HORZ DISP.
JRST @(F)[ NRIGHT
NLEFT
NUP
NDOWN]
NRIGHT: FETCH(T,B,PNR)
JUMPN T,CPOPJ ;ONE THERE ALREADY, LOSE
FETCH(T,A,PNL)
JUMPN T,CPOPJ ;ONE LEFT OF DEST., LOSE
STORE(A,B,PNR)
STORE(B,A,PNL)
JRST NOUT
NLEFT: FETCH(T,B,PNL)
JUMPN T,CPOPJ
FETCH(T,A,PNR)
JUMPN T,CPOPJ
STORE(A,B,PNL)
STORE(B,A,PNR)
JRST NOUT
NUP: FETCH(T,B,PNU)
JUMPN T,CPOPJ
FETCH(T,A,PND)
JUMPN T,CPOPJ
STORE(A,B,PNU)
STORE(B,A,PND)
JRST NOUT
NDOWN: FETCH(T,B,PND)
JUMPN T,CPOPJ
FETCH(T,A,PNU)
JUMPN T,CPOPJ
STORE(A,B,PND)
STORE(B,A,PNU)
NOUT: TRZ INLIN
TRO MCHG!NEEDCL
JRST CPOPJ1
;MINUS, PLUS (D)
PNMNS: TRNE INLIN ;CHECK DRAWING LINE
PUSHJ P,GETCLS
JRST PERRET
PUSHJ P,PNMNS1 ;TRY THE WAY WE ARE NOW
TRCA ZIGZAG ;CAN'T GO THIS WAY
POPJ P,
PUSHJ P,PNMNS1 ;TRY THE OTHER WAY TOO
TRCA ZIGZAG ;PUT IT BACK THE WAY WE FOUND IT
POPJ P,
JRST PERRET
PNMNS1: MOVE B,LINING ;POINT COMING FROM
FETCH(TT,B,PXY)
FETCH(T,A,PXY)
XOR TT,T
TLNE TT,-1
TRNN TT,-1
JRST PNOT1 ;ONLY DIFFERENT IN ONE DIMENSION, GO DO PNOT
FETCH(TT,B,PXY)
SUB TT,T ;COMPUTE DIF BETWEEN POINTS, PLUS MEANS D OR L
SETZ C,
TRNE ZIGZAG ;WHICH WAY ARE WE GOING?
TROA C,1 ;VERT/THEN/HORIZ
MOVSS TT ;HORIZ/THEN/VERT
TLNN TT,400000
XCT (C)[FETCH(TTT,A,PNU) ;ENDING DOWN
FETCH(TTT,A,PNR)] ;ENDING LEFT
TLNE TT,400000
XCT (C)[FETCH(TTT,A,PND) ;ENDING UP
FETCH(TTT,A,PNL)] ;ENDING RIGHT
JUMPN TTT,CPOPJ ;LINE ENDS THERE ALREADY?
TRNN TT,400000 ;NOW CHECK POINT WE ARE COMING FROM
XCT(C)[ FETCH(TTT,B,PNL) ;STARTING LEFT
FETCH(TTT,B,PND)] ;STARTING DOWN
TRNE TT,400000
XCT(C)[ FETCH(TTT,B,PNR) ;STARTING RIGHT
FETCH(TTT,B,PNU)] ;STARTING UP
JUMPN TTT,CPOPJ ;LINE STARTS THERE ALREADY?
PUSH P,CURSE
MOVEM T,CURSE
PUSH P,A
PUSHJ P,PLPNT ;MAKE A CORNER POINT
MOVE B,LINING ;GET POINTER TO NEW OLD POINT
POP P,D
PUSHJ P,PLENT ;ENTER THE LAST LINE
POP P,CURSE
TRZ INLIN
TRO NEEDCL!MCHG
JRST CPOPJ1
PPLUS: PUSHJ P,CLRMOV
TRNE INLIN ;ARE WE ALREADY DRAWING A LINE?
JRST PLPNT ;YES
PUSHJ P,GETCLS ;NO, DRAW IT TO CLOSEST POINT?
JRST PERRET
DOPLUS: MOVEM A,LINING ;...
TRZ ZIGZAG!INMOV ;START OUT HORIZ/THEN/VERT
TRO NEEDCL!INLIN
POPJ P,
;MINUS, PLUS SUBRS (D)
;PLPNT - PLANT A CORNER POINT
;LINING = POINT COMING FROM
PLPNTF: TRC ZIGZAG ;TRY THE OTHER WAY
PLPNT: MOVE B,LINING ;GET POINT WE ARE COMING FROM
MOVE T,CURSE ;GET CURSOR POSITION
CAMN T,ADDR(B,PXY) ;SHOULD BE DIFFERENT
POPJ P,
TRNN ZIGZAG ;WHICH WAY ARE WE GOING?
MOVE T,1(B) ;HORIZ, MAKE END-Y = START-Y
HLL T,CURSE ;GET CURSOR X
TRNE ZIGZAG ;WHICH WAY ARE WE GOING?
HLL T,1(B) ;VERT, MAKE END-X = START-X
CAMN T,1(B) ;STILL SHOULD BE DIFFERENT
JRST PLPNTF ;TRY THE OTHER WAY
PUSHJ P,PNTPUT ;CREATE THE POINT
;D = NEW POINT
;B = OLD POINT
PLENT: FETCH(T,D,PXY)
MOVEI A,
FETCH(TT,B,PXY) ;GET X,Y FOR OLD POINT
TRNE ZIGZAG ;WHICH WAY?
JRST PLENT1 ;VERT
MOVEI A,1 ;_ INSTEAD OF ^
MOVSS T ;X,Y OF END-POINT
MOVSS TT ;LOOK AT X INSTEAD OF Y
PLENT1: SUB T,TT ;GET DIRECTION OF DIFFERENCE
MOVE TT,A
TRNN T,400000 ;WAS SIGN NEGATIVE?
ADDI A,2 ;NO, SWITCH WHICH IS LEFT & WHICH IS RIGHT
XCT (A)[FETCH(F,B,PND) ;GET OLD POINTER FROM OLD
FETCH(F,B,PNL) ;SEE ROT0 FOR COMMENTS::::
FETCH(F,B,PNU)
FETCH(F,B,PNR)]
JUMPN F,PERRET ;LOSE IF LINE THERE ALREADY
XCT (A)[STORE(B,D,PNU) ;NEW TO OLD
STORE(B,D,PNR)
STORE(B,D,PND)
STORE(B,D,PNL)]
XCT (A)[STORE(D,B,PND) ;OLD TO NEW
STORE(D,B,PNL)
STORE(D,B,PNU)
STORE(D,B,PNR)]
TRC ZIGZAG ;CHANGE THE WAY WE GO
MOVEM D,LINING ;GO FROM NEW POINT
MOVEM D,MOVED ;BETTER CHECK IF ON TOP OF ANOTHER POINT
TRO MCHG
POPJ P,
>;MD
;MAKE FEEDTHROUGH(|), PLUS (PC)
MPC,<
;SIMULATE +$1F1R+
PLFEED: PUSHJ P,CLRMOV ;CAN'T BE MOVING
TRNE INLIN ;IF NOT DRAWING LINE
JRST PLFEDL
PUSHJ P,GETCLS ;FIND CLOSEST
JRST PERRET ;NONE
FETCH(T,A,PBIT)
TRNE T,ISPIN!CPIN!FEEDTH
JRST PERRET
MOVEM A,LINING ;THE REST IS THE SAME
TRO INLIN ;NOW IN LINE DRAWING MODE
JRST PLFDL0
PLFEDL: PUSHJ P,PPLUS0 ;SIMULATE PLUS
JRST PERRET ;CAN'T +
PLFDL0: MOVE G,LINING
PUSHJ P,RDFEED ;SIMULATE 1F
PUSHJ P,FUCKUP ;JUST MADE POINT, CAN'T LOSE
MOVE G,LINING
FETCH(B,G,PFEED) ;POINTER TO OTHER SIDE
FETCH(T,G,PBIT)
TRNN T,FEEDTH ;DID IT REALLY FEED THROUGH?
JRST PERRET
HRRZM B,LINING ;GO FROM OTHER SIDE NOW
SWITCH ;NOW WE'RE ON THE OTHER SIDE
POPJ P,
PPLUS: PUSHJ P,PPLUS0
JRST PERRET
POPJ P,
PPLUS0: TRNE INLIN
JRST PLPNT
PUSHJ P,GETCLS
POPJ P,
MOVEM A,LINING
TRZ INMOV
TRO NEEDCL!INLIN
JRST CPOPJ1
;PLANT A POINT
PLPNT: MOVE T,CURSE
MOVE B,LINING
CAMN T,ADDR(B,PXY) ;WILL THIS MAKE COINCIDENT POINTS?
POPJ P,
PUSHJ P,PNTPUT
GETFS(E)
STORE(E,D,PNEB) ;WILL NEED NEIGHBOR BLOCK
SETZM 1(E)
HRLZM B,(E) ;LINK NEW TO OLD
MOVE T,B
PUSHJ P,FRLINK ;FIND LINK FOR OLD TO NEW
XCT (T)[PUTAB: HRLM D,(B)
HRRM D,1(B)
HRLM D,1(B)]
MOVEM D,LINING
MOVEM D,MOVED ;BETTER CHECK IF ON TOP OF ANOTHER POINT
TRO MCHG
JRST CPOPJ1 ;WIN RETURN
;MINUS, FNDLNK (PC)
PNMNS: TRNE INLIN
PUSHJ P,GETCLS
JRST PERRET
PNMNS1: MOVE B,LINING ;ENTER HERE FROM LATTL
FETCH(B,B,PNEB)
PUSHJ P,FNDLNK ;ALREADY GOT A POINTER TO IT?
TRZA INLIN ;NO, MAKE IT!
JRST PERRET ;YES, SCREW HIM!
PUSH P,A
MOVE T,A
PUSHJ P,FRLINK
MOVE D,LINING
XCT (T)PUTAB
MOVE T,D
PUSHJ P,FRLINK
POP P,D
XCT (T)PUTAB
TRO MCHG!NEEDCL
MOVEI T,ANGLPG
JRST HYDPOG
;FNDLNK - FIND MATCHING LINK
;B = PNEB LIST
;A = ITEM TO FIND
;SKIPS IF FOUND
;RETURNS B(PTR) T(SLOT#) (Suitable for PUTAB, GETAB)
FNDL2: MOVEI T,2
FNDL1: XCT (T)[GETAB: HLRZ TT,(B)
HRRZ TT,1(B)
HLRZ TT,1(B)]
CAIN TT,(A)
JRST CPOPJ1
SOJGE T,FNDL1
MOVE TT,B
HRRZ B,(B)
FNDLNK: JUMPN B,FNDL2
POPJ P,
;FIND FREE LINK (PC)
;T = POINT
FRLINK: FETCH(B,T,PNEB)
JUMPN B,FRLNK1
GETFS(B)
SETZM 1(B)
SETZM (B)
STORE(B,T,PNEB)
FRLNK1: SETZ A,
PUSHJ P,FNDLNK
CAIA
POPJ P,
GETFS(B)
HRRM B,(TT)
SETZM (B)
SETZM 1(B)
MOVEI T,2 ;USE LAST FIRST
POPJ P,
;OLD ROUTINE, USE FRLINK INSTEAD
NIL,<
FRELNK: HLRZ B,1(T)
JUMPN B,FRLNK1
GETFS(B)
SETZM 1(B)
SETZM (B)
HRLM B,1(T)
JRST FRLNK1
>;NIL
>;MPC
;PLANT STUB (D)
MD,<
STUBCC: TLOA T,400000 ;CCW AROUND BODY
STUBCW: MOVEI T,1 ;CW AROUND BODY
CAIA
STUB: SETZ T,
MOVEM T,CCW ;0 NO MOTION, - CCW, + CW
PUSHJ P,STBPIN ;FIND BODY PIN WE'RE AT NOW
JRST PERRET
PUSHJ P,STBSTP ;GET NEXT
STUBB1: PUSHJ P,DOPLUS ;START STUB FROM THERE
FETCH(T,A,BPX)
FETCH(TT,A,BPY)
ANDI E,3
XCT MOVSTB(E) ;MOVE STUB OFF A LITTLE
HRLS T
HRR T,TT
JRST CHKON
;STBPIN - FIND THE PIN WE ARE NEAR
;SKIPS IF FOUND
;A = PIN
STBPIN: HRRZ A,LINING
TRNE INLIN ;DOING ANGLE?
JRST STBPI1
PUSHJ P,GETCLS
POPJ P,
STBPI1: FETCH(T,A,PBIT)
TRNE T,ISPIN
JRST CPOPJ1
PUSHJ P,FNDPIN ;FIND PIN FROM POINT
POPJ P,
JRST CPOPJ1
;FNDPIN - FIND PIN FROM POINT
;A = POINT
;SKIPS IF FOUND
;A = PIN
FNDPIN: MOVEI D,20 ;CROCK, ELIMINATE INFINITE RECURSION
PINPN0: FETCH(T,A,PBIT)
TRNE T,ISPIN
JRST CPOPJ1
SOJL D,PINPN1
HRLM A,(P)
FOR I IN (PNR,PND,PNU,PNL)
< HLRZ A,(P)
FETCH(A,A,I)
SKIPE A
PUSHJ P,PINPN0
CAIA
JRST CPOPJ1
>
PINPN1: AOS D
POPJ P,
;STEP STUB CW/CCW
;A = CURRENT PIN
;CCW = MOTION, 0:THIS PIN, -:CCW, +:CW
;RETURNS
;A = NEW PIN
;E = SIDE OF BODY PIN ON
STBSTP: MOVEM A,STBPNT
MOVE G,A
FETCH(H,G,BBODY)
MOVEM H,STBBDY
FETCH(H,H,BTYP)
PUSHJ P,CALSET ;CALC BODY'S X,Y CENTER
PUSHJ P,CALPIN ;WHICH SIDE OF BODY?
trc f,4 ;because of old convention
MOVE E,F
LSH E,-1 ;1,3,5,7  D,R,U,L
SKIPGE CCW
TRO E,4
SKIPN CCW ;NEED TO STEP?
POPJ P,
MOVE G,STBPNT
FETCH(G,G,BPLOC)
FETCH(T,G,TPX)
MOVEM T,STUBX
FETCH(T,G,TPY)
MOVEM T,STUBY
JRST STBST0
STUBB: PUSHJ P,GETCLS ;START STUB ON BODY
JRST PERRET
MOVEM A,STBBDY
MOVEI T,PNTM
PUSHJ P,CHNGMD
MOVEI E,3+4 ;START ON LEFT SIDE, GO CCW
PUSHJ P,STBST1
JRST STUBB1
;FIND NEXT PIN ALONG AROUND BODY
;E = SIDE OF BODY, DIRECTION OF TRAVEL (CW/CCW)
;STBBDY = BODY
;STBPNT = LAST POINT (IF ANY)
;(C,D = X,Y OF LAST POINT)
;RETURNS
;A = PIN
STBST1: SETOM STBPNT ;ALLOW FIND OF ORIGINAL POINT
STBST0: MOVE A,STBBDY
FETCH(A,A,BLNK)
SETZM STBLAS
XCT STBMAX(E) ;INIT BEST SO FAR TO WORST
STBST2: CAMN A,STBPNT ;FIND NEXT PIN FOR STUB
JRST STBST9
FETCH(B,A,BPLOC)
FETCH(T,B,TPX)
FETCH(TT,B,TPY)
XCT STBTST(E) ;FIND MIN POINT IN DIRECTION OF TRAVEL
JRST STBST9
SKIPGE STBPNT ;STEPPING FROM A POINT?
JRST STBST3
XCT STBLIM(E) ;FIND POINT BELOW OLD POINT
JRST STBST9
STBST3: MOVE G,A ;YES, ALSO STILL ON SAME SIDE?
PUSHJ P,CALPIN
trc f,4 ;because of old convention
LSH F,-1
XOR F,E
TRNE F,3 ;SAME SIDE?
JRST STBST9
FETCH(C,B,TPX)
FETCH(D,B,TPY)
MOVEM A,STBLAS
STBST9: FETCH(A,A,BPLNK)
JUMPN A,STBST2
SKIPE A,STBLAS ;FOUND ONE MORE ON THAT SIDE?
POPJ P, ;YES
HRRZ E,STBNXT(E) ;LOOK ON THE NEXT SIDE
JRST STBST1
;TABLES FOR STUB STEPPER
;E = STUB SIDE, AND STEP DIRECTION
; 0 BOTTOM
; 1 RIGHT SIDE
; 2 TOP
; 3 LEFT SIDE
;+4 MEANS STEP IN CCW
;SETUP FOR WORST, WE'RE LOOKING FOR MINIMUM IN DIRECTION OF TRAVEL
STBMAX: MOVSI C,400000
MOVSI D,400000
HRLOI C,377777
HRLOI D,377777
HRLOI C,377777
HRLOI D,377777
MOVSI C,400000
MOVSI D,400000
;TEST FOR BETTER MIN IN DIRECTION OF TRAVEL
STBTST: CAMGE T,C ;CW-BOTTOM, MIN IS BIGGEST X
CAMGE TT,D
CAMLE T,C
CAMLE TT,D
CAMLE T,C
CAMLE TT,D
CAMGE T,C
CAMGE TT,D
;BUT MINIMUM JUST BEFORE PREVIOUS POINT
STBLIM: CAMLE T,STUBX
CAMLE TT,STUBY
CAMGE T,STUBX
CAMGE TT,STUBY
CAMGE T,STUBX
CAMGE TT,STUBY
CAMLE T,STUBX
CAMLE TT,STUBY
STBNXT: 3 ;NEXT DIR, CW
0
1
2
4+1 ;NEXT DIR, CCW
4+2
4+3
4+0
MOVSTB: SUB TT,STBSIZ ;DOWN
ADD T,STBSIZ ;RIGHT
ADD TT,STBSIZ ;UP
SUB T,STBSIZ ;LEFT
>;MD
;PNTPLC, PN2DEL
PNTPLC: TRNE INMOV!INLIN
JRST PERRET
MOVE T,CURSE ;GET CURSOR POSITION
PUSHJ P,PNTPUT ;MAKE A POINT
MOVE T,LSTPNT ;GET NEW POINT AND PREVIOUS POINTER
JRST SCLOSE
;DELETE POINT, MERGE LINE IF POSSIBLE
PN2DEL: PUSHJ P,GETCLS
POPJ P,
MOVE B,CLAST
EXCH B,A ;ThePoint in B, back-pointer in A
MD,<
MOVE T,ADDR(B,PND)
MOVE TT,ADDR(B,PNL)
JUMPE T,[JUMPE TT,DELPNT ;NO NEIGHBORS
TLNE TT,-1 ;NO VERT LINE THRU POINT
TRNN TT,-1 ;HORIZ LINE GOES THRU?
JRST PERRET
PUSHJ P,LMER1 ;YES MERGE
SETOM CLOSUP
JRST DELPNT]
TLNE T,-1
TRNN T,-1
JRST PERRET ;NO VERT LINE THRU POINT
JUMPE TT,[PUSHJ P,LMER0 ;ONLY VERT LINE
SETOM CLOSUP
JRST DELPNT]
TLNE TT,-1
TRNN TT,-1
JRST PERRET
SETOM CLOSUP ;BOTH HORIZ AND VERT
PUSHJ P,LMER0
PUSHJ P,LMER1
JRST DELPNT
;MERGE TWO VERT LINES
;B = POINT
LMER0: FETCH(D,B,PNU) ;D = POINT TO TOP
FETCH(T,B,PND) ;T = POINT TO BOTTOM
STORE(D,T,PNU)
STORE(T,D,PND)
POPJ P,
;MERGE TWO HORIZ LINES
;B = POINT
LMER1: FETCH(D,B,PNL) ;D = POINT TO LEFT
FETCH(T,B,PNR) ;T = POINT TO RIGHT
STORE(D,T,PNL)
STORE(T,D,PNR)
POPJ P,
>;MD
;DELETE POINT, MERGE LINES (PC)
;FALLS THRU
MPC,< FETCH(C,B,PNEB)
JUMPE C,PERRET
;Look for two lines leaving from this point, error if not exactly 2
SETZM 1(P)
SETZM 2(P)
D2LIN: MOVEI E,2
D2LIN1: XCT (E)DELTAB ;Fetch(D,C,PNx)
JUMPE D,D2LIN2
EXCH D,1(P) ;ADVANCE THE WORLD
EXCH D,2(P)
JUMPN D,PERRET ;NON-ZERO IF TOO MANY
D2LIN2: SOJGE E,D2LIN1
HRRZ C,(C)
JUMPN C,D2LIN
SKIPN 2(P) ;FIND 2?
JRST PERRET ;NO
;Link left and right neighbors, omiting current point
AOBJN P,.+1 ;Save first neigbor
MOVE D,1(P) ;The second "
PUSH P,A ;(Save back-pointer of point for DELPNT)
MOVE A,B ;Current point
MOVE B,-1(P) ;Link first neighbor (B) to second (D)
PUSHJ P,D2LIN4
MOVE B,D
MOVE D,-1(P) ;Now the other way
PUSHJ P,D2LIN4
;Then delete the point
POP P,B ;Restore back-pointer
POP P,(P)
EXCH A,B ;Get a and b in right places
SETOM CLOSUP
JRST DELPNT ;AND DELETE
;Link point (B) to (D), using slot that contained D
D2LIN4: FETCH(B,B,PNEB)
PUSHJ P,FNDLNK
PUSHJ P,FUCKUP
XCT (T)PUTAB
POPJ P,
>;MPC
;DELPNT
;PNTDEL - DELETE CLOSEST POINT
PNTDEL: PUSHJ P,GETCLS ;GET POINTER TO CLOSEST POINT
JRST PERRET
MOVE B,CLAST ;ALSO LAST POINTER
EXCH B,A ;INTO CORRECT AC'S
TRZ TFLG ;DON'T DELETE PINS
TRZE INMOV
TRO NEEDCL
JRST DELPNT ;THEN LEAP IN
;DELPNL - DELETE POINT
;B = POINT
;DELPNT - DELETE POINT
;B = POINT
;A = PREVIOUS
DELPNL: PUSHJ P,LNKSET ;SETUP A WITH LAST POINTER
DELPNT: TRO MCHG
TRZ INMOV
PUSH P,A ;SAVE LAST
FETCH(T,A,PNXT)
CAME T,B ;LAST SHOULD POINT TO THIS
PUSHJ P,FUCKUP
PUSHJ P,REMPNT ;REMOVE POINT FROM ANY SETS
PUSHJ P,KILPNT ;KILL LINES, TEXT
POP P,A ;RESTORE LAST
FETCHL(F,B,PBIT)
TRNE TFLG ;DELETE PINS?
JRST DELPOK ;YES
TLNE F,MPC,<CPIN!>ISPIN ;IS IT A PIN?
POPJ P, ;YES, DON'T DELETE
DELPOK: TRO NEEDCL
FETCH(T,B,PNXT)
STORE(T,A,PNXT)
MPC,< FETCH(T,B,PFEED)
HRR F,T ;SAVE FEED THRU
>;MPC
TLNN F,CPIN
JRST NTCPIN
FETCH(T,B,PLOC) ;RETURN CPIN LOC BLOCK
FSTRET(T)
NTCPIN: PUSH P,B
FETCH(B,B,PTXT)
PUSHJ P,PUTFS ;RETURN TEXT
POP P,B
RETBLK(B,POINT) ;RETURN POINT
MPC,< TLNN F,FEEDTH ;IS IT A FEED THROUGH?
POPJ P, ;NO
CLRBIT(FEEDTH,TT,F,PBIT) ;MAKE SURE HE DOESN'T TRY TO GET BACK
HRRZ B,F
SWITCH
PUSHJ P,DELPNL ;DELETE POINT ON OTHER SIDE
SWITCH
>;MPC
POPJ P,
;DELPNT SUBRS
KILPNT: PUSHJ P,KILTXT ;FLUSH TEXT
ROUTE,<MPC,<TLZ M,%ROUTE>> ;MAKE HIM ROUTE AGAIN
MD,<
FOR LINK IN (PND,PNU,PNL,PNR)
< FETCH(D,B,LINK)
JUMPE D,.+3
PUSHJ P,REMLIN
CLEAR(B,LINK)
>
>;MD
;FOR PC, THERE MAY BE MORE THAN 4 NEIGHBORS
MPC,<
MOVE A,B
FETCH(C,B,PNEB)
JUMPE C,DELMER
PUSH P,C
DELIN: MOVEI E,2
DELIN1: XCT (E)[DELTAB: HLRZ D,(C)
HRRZ D,1(C)
HLRZ D,1(C)]
JUMPE D,.+2
PUSHJ P,REMLIN
SOJGE E,DELIN1
HRRZ C,(C)
JUMPN C,DELIN
POP P,C
DELMER: PUSH P,B
CLEAR(B,PNEB)
MOVE B,C
JUMPE B,.+2
PUSHJ P,PUTFS ;RETURN MULTIPLE NEIGHBOR LIST
POP P,B
>;MPC
FETCH(E,B,PNXT)
POPJ P,
;PINPNT - CHANGE PIN TO POINT
;B = PIN
PINPNT: FETCH(T,B,BPBIT)
TRNN T,ISPIN
PUSHJ P,FUCKUP
DBG,< MOVE T,[SIXBIT /POINT/] ;CHANGE STORAGE BLOCK TYPE
MOVEM T,-1(B)
>;DBG
AOS T,PID
STORE(T,B,PID)
MPC,< CLEAR(B,PFEED) >
CLEAR(B,PIN)
CLEAR(B,PLOC)
CLRBIT(<MPC,<PLANES!>ISPIN>,TT,B,PBIT)
POPJ P,
;REMOVE LINE
MPC,<
;A = POINT BEING FLUSHED
;D = POINT TO UNLINK
REMLIN: PUSH P,B
FETCH(B,D,PNEB)
PUSHJ P,FNDLNK
CAIA
XCT (T)[ HRRZS(B)
HLLZS 1(B)
HRRZS 1(B)]
POP P,B
SETOM CLOSUP
POPJ P,
>;MPC
;REMOVE LINE
;B = POINT BEING FLUSHED
;D = POINT TO UNLINK
MD,<
REMLIN:
DEFINE FOO (LINK)
< FETCH(TT,D,LINK)
CAMN TT,B
CLEAR(D,LINK)
>
FOO (PND)
FOO (PNU)
FOO (PNL)
FOO (PNR)
SETOM CLOSUP
POPJ P,
>;MD
;LNKSET - SETUP A TO POINT TO PREVIOUS LINK
;B = POINT
LNKSET:
MPC,< FETCHL(T,B,PBIT)
EQV T,SID
JUMPL T,LNKSTF ;WHICH SIDE IS IT ON??
MOVEI A,PONPN2 ;OTHER SIDE
JRST LNKST1
LNKSTF:
>;MPC
MOVEI A,PONPNT ;CURRENT SIDE
LNKST1: FETCH(T,A,PNXT)
CAIN T,(B) ;DOES THIS GUY POINT TO US?
POPJ P, ;YES, RETURN
MOVE A,T
JUMPN A,LNKST1
PUSHJ P,FUCKUP
MOVE A,B ;LINK BACK TO SELF
POPJ P,
;DELNUL
DELNUL: TRZE INLIN!INMOV
TRO NEEDCL
TRZ TFLG ;DON'T DELETE PINS!!!!!
SETZM COUNT ;ZERO COUNT
TLNN M,DSKACT!MACACT
OUTSTR[ASCIZ/TYPE Y TO MARK NULL POINTS FOR FIND,
(ELSE ALL NULL POINTS WILL BE DELETED)/]
PUSHJ P,YORN
POPJ P, ;ALTMODE
JRST DELALL ;DELETE ALL
TLO ASK
SETZM FIND ;NONE FOUND YET
SKIPE E,PONPNT
PUSHJ P,ACLRP ;CLEAR FIND MARK BITS
MOVEI B,PONPNT
PUSHJ P,DNULL ;NOW MARK NULL POINTS
MPC,< SKIPE E,PONPN2
PUSHJ P,ACLRP
MOVEI B,PONPN2
PUSHJ P,DNULL
>;MPC
JRST FNDCNT
DNULLA: PUSH P,A ;SAVE LAST POINTER
MD,< SKIPN ADDR(B,PND)
SKIPE ADDR(B,PNL)
JRST NODEL
>;MD
MPC,<
FETCH(TT,B,PNEB)
JUMPE TT,DLNCK1
DLINCK: HLRZ TTT,(TT)
JUMPN TTT,NODEL
SKIPE 1(TT)
JRST NODEL
HRRZ TT,(TT)
JUMPN TT,DLINCK
DLNCK1:
>;MPC
FETCHL(TT,B,PBIT)
TDNE TT,[MPC,<FEEDTH!PLANES!CPIN!>ISPIN,,MPC,<-1>]
JRST NODEL
FETCH(TT,B,PTXT)
JUMPN TT,NODEL
TLNN ASK
JRST NOASK
MOVSI TT,FOUNDP ;MARK POINT
IORM TT,ADDR(B,PBIT)
AOS FIND ;COUNT ANOTHER FOUND
JRST NODEL
NOASK: MOVE A,(P) ;SETUP LAST POINTER
PUSHJ P,DELPNT
AOS COUNT
POP P,B
JRST DNULL
NODEL: POP P,B ;PREVIOUS POINT
FETCH(B,B,PNXT) ;BACK TO THIS POINT
DNULL: MOVE A,B ;NOW ADVANCE
FETCH(B,B,PNXT)
JUMPN B,DNULLA
POPJ P,
;DELETE ALL
DELALL: MOVEI T,1
LSH T,@MODE
TDNE T,[1ALTM]
JRST PERRET
TLZ ASK
MOVEI B,PONPNT
PUSHJ P,DNULL
MPC,< MOVEI B,PONPN2
PUSHJ P,DNULL
>;MPC
CNTOUT: TRO NEEDCL
TLNE M,DSKACT!MACACT
POPJ P,
OUTSTR[ASCIZ/
/]
MOVE T,COUNT
PUSHJ P,DECOUT
OUTSTR[ASCIZ/ NULL POINTS DELETED!/]
POPJ P,
;FIND DANGLING POINTS
DANGLE: TRZE INLIN!INMOV
TRO NEEDCL
SETZM COUNT
SETZM FIND
SKIPE E,PONPNT
PUSHJ P,DODANG
MPC,< SKIPE E,PONPN2
PUSHJ P,DODANG
>;MPC
TLNN M,DSKACT!MACACT
SKIPN T,COUNT
JRST FNDCNT
PUSHJ P,DECOUT
OUTSTR[ASCIZ/ COINCIDENT POINTS OUT OF /]
JRST FNDCNT
DODANG: PUSH P,E
PUSHJ P,ACLRP ;CLEAR MARK BITS
POP P,E
DANGA: SETO TTT, ;PREPARE COUNT
FETCHL(T,E,PBIT)
TDNE T,[MPC,<PLANES!CPIN!>ISPIN,,MPC,<-1>]
JRST COINA
TLNE T,MPC,<FEEDTH!>CPIN
AOJG TTT,COINA
MD,< SKIPE ADDR(E,PND) ;ONLY COUNT EACH DIMENSION AS ONE
AOJG TTT,COINA
SKIPE ADDR(E,PNL)
AOJG TTT,COINA
FETCH(T,E,PTXT)
JUMPE T,DANGST ;NO CORNER, AND NO TEXT
AOJLE TTT,DANGST ;NO LINES AT ALL
>;MD
MPC,< FETCH(T,E,PTXT)
JUMPN T,COINA
FETCH(T,E,PNEB)
JUMPE T,DANGST
DANG0: MOVE TT,1(T)
TLNE TT,-1
AOJG TTT,COINA
TRNE TT,-1
AOJG TTT,COINA
MOVE T,(T)
TLNE T,-1
AOJG TTT,COINA
TRNE T,-1
JRST DANG0
JRST DANGST
>;MPC
;APPEARS OK, SEE IF IT IS COINCIDENT WITH ANY OTHER POINT
COINA: FETCH(T,E,PXY)
MOVE TT,E
JRST COINB
COINC: CAMN T,ADDR(TT,PXY)
JRST DANGSC
COINB: FETCH(TT,TT,PNXT)
JUMPN TT,COINC
DANGB: FETCH(E,E,PNXT)
JUMPN E,DANGA
POPJ P,
DANGSC: AOS COUNT ;COINCIDENT POINT
DANGST: AOS FIND ;DANGLING POINT
MOVSI T,FOUNDP
IORM T,ADDR(E,PBIT)
JRST DANGB
;CHANGE PAD TYPES
MPC,<
CPADS: TLNN M,DSKACT!MACACT
OUTSTR[ASCIZ/TYPE PAD NUMBER TO CHANGE.
/]
PUSHJ P,READNC
MOVEM T,COUNT
TLNN M,DSKACT!MACACT
OUTSTR[ASCIZ/TYPE NEW PAD NUMBER.
/]
PUSHJ P,READNC
MOVEM T,COUNT2
TLNN M,DSKACT!MACACT
OUTSTR[ASCIZ/TYPE Y TO BE ASKED ABOUT EACH ONE/]
PUSHJ P,YORN
POPJ P,
TLZA ASK
TLO ASK
MOVEI A,PONPNT
PUSHJ P,CPADSD
POPJ P,
TLNN M,DSKACT!MACACT
OUTSTR[ASCIZ/DO OTHER SIDE/]
PUSHJ P,YORN
POPJ P,
POPJ P,
SWITCH
MOVEI A,PONPNT
PUSHJ P,CPADSD
JFCL
SWITCH
POPJ P,
;COUNT = OLD PAD
;COUNT2 = NEW PAD
CPADS1: FETCH(T,A,PIN)
CAME T,COUNT ;IS THIS ONE TO CHANGE?
JRST CPADSD ;NO
FETCHL(T,A,PBIT)
TLNN T,FEEDTH ;IF DRILL HOLE
SKIPN COUNT ;OR FINDING OTHER THAN TYPE 0
CAIA ;GO AHEAD
JRST CPADSD
TLNN ASK
JRST CPADS2 ;DON'T ASK
FETCH(T,A,PXY)
PUSHJ P,ONSCR ;ON SCREEN
PUSHJ P,PICSET ;NO, GET IT ON
FETCH(T,A,PXY)
MOVEM T,STARLOC ;LOC TO DISPLAY
TLNN M,DSKACT!MACACT
OUTSTR[ASCIZ/THIS ONE/]
MOVEI T,UPSTAR
MOVEM T,SPDISP
MOVE T,[ASCID/CP/]
MOVEM T,SPMODT
MOVEI T,SPM ;SPECIAL POINTER MODE
PUSHJ P,TCHNGM ;TEMPORARY CHANGE
PUSHJ P,YORN
JFCL
JFCL ;IGNORE RETURN, WILL CHECK C AGAIN
PUSHJ P,RCHNGM ;RESTORE MODE
CAIE C,"Y"
CAIN C,"y"
JRST CPADS2
CAIE C,ALTMOD
JRST CPADSD ;JUST SKIP THIS ONE
POPJ P, ;GIVE QUIT RETURN
CPADS2: MOVE T,COUNT2
STORE(T,A,PIN) ;STORE NEW PAD TYPE
TRO MCHG
CPADSD: FETCH(A,A,PNXT)
JUMPN A,CPADS1
JRST CPOPJ1
>;MPC
;MAKE AND BREAK INNER PLANE CONNEX (PC)
MPC,<
PLANE: PUSHJ P,GETCLS
JRST PERRET
FETCHL(B,A,PBIT)
TLNN B,FEEDTH!ISPIN
JRST PERRET
TLNN M,DSKACT!MACACT
OUTSTR[ASCIZ/ PLANE NUMBER?/]
PUSHJ P,READNC
ADDI T,1
CAILE T,7
JRST PERRET ;LOSE
UNPLN1: TRO MCHG!NEEDCL
DPB T,[%%PLANES,,ADDR(A,PBIT)]
TLNN B,ISPIN
JRST CHKFED
;ASSIGN ALL BODY PINS WITH SAME PIN #
FETCH(TTT,A,BPLOC)
FETCH(TTT,TTT,TPID) ;SAME PIN #?
FETCH(B,A,BBODY)
FETCH(B,B,BLNK)
JUMPE B,CPOPJ
PLOOP2: FETCH(C,B,BPLOC)
FETCH(C,C,TPID)
CAMN C,TTT ;SAME PIN NUMBER?
DPB T,[%%PLANES,,ADDR(B,PBIT)] ;YES, SET PLANE NUMBER
PLOOP1: FETCH(B,B,BPLNK)
JUMPN B,PLOOP2
POPJ P,
CHKFED: TLNN B,FEEDTH
POPJ P,
FETCH(TT,A,PFEED)
DPB T,[%%PLANES,,ADDR(TT,PBIT)]
POPJ P,
UNPLAN: PUSHJ P,GETCLS
JRST PERRET
FETCHL(B,A,PBIT)
TLNN B,ISPIN!FEEDTH
JRST PERRET
MOVEI T,0 ;NO PLANE
JRST UNPLN1
;SET PAD TYPE, MAKE AND BREAK FEEDTHROUGHS (PC)
NPFEED: PUSHJ P,GETCLS
JRST PERRET
TLNN M,DSKACT!MACACT
OUTSTR[ASCIZ/PAD TYPE NUMBER?/]
PUSHJ P,READNC
STORE(T,A,PIN) ;SET NEW PAD TYPE
TRO MCHG
POPJ P,
FEED: PUSHJ P,GETCLS
JRST PERRET
MOVE G,A
PUSHJ P,RDFEED
JRST PERRET
POPJ P,
;RDFEED - CREATE FEEDTHROUGH TO OTHER SIDE
;G = POINT
RDFEED: FETCH(A,G,PBIT)
TRNE A,FEEDTH!ISPIN!CPIN
POPJ P,
SWITCH ;MAKE POINT ON OTHER SIDE
FETCH(T,G,PXY)
PUSHJ P,PNTPUT
MOVE A,D
SWITCH
MOVSI T,FEEDTH
IORM T,ADDR(A,PBIT)
IORM T,ADDR(G,PBIT)
FETCH(T,A,PIN)
JUMPN T,.+3
MOVEI T,1 ;DEFAULT PAD TYPE 1
STORE(T,A,PIN)
FETCH(T,G,PIN)
JUMPN T,.+3
MOVEI T,1
STORE(T,G,PIN)
STORE(D,G,PFEED)
STORE(G,D,PFEED)
TRO MCHG
JRST CPOPJ1
UNFEED: PUSHJ P,GETCLS ;UNLINK FEEDTHRU
JRST PERRET
FETCH(B,A,PBIT)
TRNN B,FEEDTH
JRST PERRET
TRZ B,FEEDTH!PLANES
STORE(B,A,PBIT)
CLEAR(A,PIN) ;ZERO PAD#
FETCH(B,A,PFEED)
CLEAR(A,PFEED)
CLEAR(B,PFEED) ;UNLINK OTHER SIDE OF FEEDTHRU
FETCH(A,B,PBIT)
TRZ A,FEEDTH!PLANES
STORE(A,B,PBIT)
CLEAR(B,PIN) ;ZERO PAD#
TRO MCHG!NEEDCL
POPJ P,
>;MPC
;PIN #'S, CONNECTOR AND BODY (D)
MD,<
SETCPN: PUSHJ P,GETCLS
JRST PERRET
FETCH(B,A,PBIT)
TRNE B,ISPIN
JRST STPINN ;BODY PIN
MOVE T,[PUSHJ P,GETLCH]
MOVEM T,GTCHRX
CAGAIN: TLNN M,DSKACT!MACACT
OUTSTR @CPCUE
PUSHJ P,GTCONP
JRST INNERR
JRST [
LAY,< CAIN C,TEXIST
JRST [ PUSHJ P,GETLIN ;SNARF LF
CAIE C,12
JRST INNERR
SKIPG T,LAYLOC ;PICK UP CLOC PASSED FROM PC PROG
JRST [ SKIPN T
OUTSTR[ASCIZ/NO CONNECTOR LOC PASSED FROM PC PROG!
/]
SKIPE T
OUTSTR[ASCIZ/TOO MANY CONNECTOR LOC'S FOUND IN PC PROG!
/]
JRST CAGAIN]
HRRZM T,LETTER
JRST LNNLY]
>;LAY
CAIE C,12
JRST INNERR
FETCH(B,A,PLOC) ;GET CPIN POINTER
JUMPE B,CPOPJ
CLEAR(A,PLOC)
FSTRET (B)
CLRBIT(CPIN!FIXCON!CPNBTS,T,A,PBIT)
CLEAR(A,PIN) ;CLEAR BITS AND BACKUP PIN NAME
SETOM CLOSUP
TRO MCHG
TRNE LMOVE
TRZN INMOV
POPJ P,
TRO NEEDCL
POPJ P,]
MD,< JFCL > ;DON'T CARE ABOUT BRS
CAIE C,12
JRST INNERR
;SETLET - SET LOCATION ONTO POINT
;LETTER = B-R-S,,PIN-LOC
;A = POINT
;FALLS THRU
SETLET:
LNNLY: MOVE TT,LETTER
TLNE TT,-1
SKIPN T,CRDLOC
JRST NOGLBC
XOR T,TT
TLNE T,-1 ;SAME CARD LOC OR NO GLOBAL?
JRST [ OUTSTR[ASCIZ/SORRY, CANNOT CHANGE CARD LOCATION WHILE GLOBAL CARD LOC IS IN FORCE!
/]
POPJ P,]
HRRZS LETTER
NOGLBC: FETCH(B,A,PLOC) ;GET OLD CPIN POINTER
JUMPN B,GOTFST
FETCH(B,A,PBIT)
TRZ B,CPNBTS
TRO B,FIXCON!CPIN ;MAKE IT GET FIXED INTIALLY
STORE(B,A,PBIT)
CLEAR(A,PIN) ;CLEAR BACKUP PIN NAME
GETFS(B)
STORE(B,A,PLOC) ;ADD LOCATION BLOCK
SETZM 1(B) ;CLEAR OFFSET
SETOM CLOSUP
GOTFST: PUSHJ P,UBACK
MOVE T,LETTER
MOVEM T,(B)
PUSHJ P,CPNBCK ;CHECK AND SET BITS
TRO MCHG!NEEDCL
FETCH(T,A,PBIT)
TRNN T,FIXCON ;CON NEED FIXING?
POPJ P,
JRST OFFCON
;UBACK - SAVE BACKUP PIN IF SETTING WILD
;A = POINT
;LETTER = PIN LOCATION
UBACK: PUSH P,A
MOVE A,LETTER
PUSHJ P,QUPIN ;IS NEW PIN NAME WILD?
JRST UBACK0
MOVE A,(P)
FETCH(B,A,PLOC) ;CPIN LOCATION BLOCK
MOVE A,(B)
PUSHJ P,QUPIN
JRST UBACK2
JRST UBACK1
UBACK0: MOVE A,(B)
PUSHJ P,QUPIN
JRST UBACK1 ;OLD ONE NOT WILD, NO BACKUP
UBACK2: MOVE B,(B)
MOVE A,(P)
STORE(B,A,PIN)
UBACK1: POP P,A
POPJ P,
;CPNBCK - CHECK FOR RULE ON WILD PIN
;A = CPIN
;T = PIN LOCATION
CPNBCK: PUSH P,A
MOVE A,T
PUSHJ P,QUPIN
JRST NUPIN
MOVE T,(P) ;THE CPIN
FETCH(T,T,PBIT)
DPB A,[POINT CPNBSZ,T,CPNBPS] ;ALWAYS SET RULE FROM LAST U PIN TYPED
MOVE A,(P)
STORE(T,A,PBIT)
NUPIN: POP P,A
POPJ P,
;SET TERMINATION RULE
STTRUL: PUSHJ P,GETCLS
JRST PERRET
FETCH(T,A,PBIT)
TRNN T,CPIN
JRST PERRET
TLNE M,DSKACT!MACACT
JRST STTRL0
OUTSTR[ASCIZ/CURRENT RULE NUMBER = /]
LDB T,[POINT CPNBSZ,T,CPNBPS]
PUSHJ P,DECOUT
OUTSTR[ASCIZ/
/]
STTRL0: TLNN M,DSKACT!MACACT
OUTSTR[ASCIZ/TYPE RULE NUMBER (0-3)?/]
PUSHJ P,READN
CAIN C,12
JRST STTRL1
CAIE C,"?"
JRST INNERR
PUSHJ P,GETCHR
CAIE C,12
JRST INNERR
TLNN M,DSKACT!MACACT
OUTSTR[ASCIZ/0 NO RULE
1 NO TERMINATION (U001-U199)
2 ?? (U200-U399)
3 TERMINATED (U400-U599)
/]
JRST STTRUL
STTRL1: CAILE T,3
JRST INNERR
PUSH P,A
FETCH(A,A,PBIT)
DPB T,[POINT CPNBSZ,A,CPNBPS]
MOVE T,(P)
STORE(A,T,PBIT)
POP P,A
POPJ P,
;COPY TERMINATION RULE INTO MACRO
CLTRUL: PUSHJ P,GETCLS
JRST PERRET
FETCH(T,A,PBIT)
TRNN T,CPIN
JRST PERRET
MOVE B,A
PUSHJ P,SETTT
FETCH(B,B,PBIT)
LDB B,[POINT CPNBSZ,B,CPNBPS]
PUSHJ P,PUTTTN
JRST ITSTUF
;SET BODY PIN #
;A = BPOINT
STPINN: TLNE M,DSKACT!MACACT
JRST STPIN0
OUTSTR[ASCIZ/PIN NAME(/]
OUTSTR @PINCUE
OUTSTR[ASCIZ/)?/]
STPIN0: MOVE T,[PUSHJ P,GETLCH]
MOVEM T,GTCHRX
PUSHJ P,RPNAM
JRST INNERR
CAIE C,12
JRST INNERR
;CALLED BY SWPPIN, SET PIN NAME
;A = PIN
;T = NEW PIN NAME
STPNN1: TLNE M,PLOCS
TRO MCHG
;Now set all BODY PINs that have same default PIN NAME
FETCH(B,A,BBODY)
MOVEI B,RADDR(B,BLNK,BPLNK)
FETCH(TT,A,BPLOC)
FETCH(TT,TT,TPNAM)
JRST STPIN1
STPIN2: FETCH(D,B,BPLOC)
FETCH(D,D,TPNAM)
CAMN D,TT ;SAME DEFAULT PIN NAME?
STORE(T,B,BPPN)
STPIN1: FETCH(B,B,BPLNK)
JUMPN B,STPIN2
POPJ P,
>;MD
STOCLC: PUSHJ P,GETCLS
JRST PERRET
PUSHJ P,SETTT ;SETUP MACRO TEXT POINTER
PUSHJ P,STFPLC ;STUFF IN CON OR PIN SPEC
JFCL
JRST ITSTUF ;IF NOT CPIN, STUFF A NULL MACRO
;A = POINT
STFPLC: MOVE E,A
FETCHL(B,A,PBIT)
TLNE B,CPIN
JRST STFCLC
TLNN B,ISPIN
POPJ P,
FETCH(D,A,BBODY) ;GET PIN'S BODY
AOS (P)
PUSH P,A
MD,< FETCH(T,D,BLOC) ;ANY LOCN SET?
JUMPE T,NSTFBL
MOVE A,ADDR(D,BSOC)
>;MD
MPC,< FETCH(T,D,BLN) ;LN SET?
JUMPE T,NSTFBL
MOVE A,ADDR(D,BLN)
>;MPC
PUSHJ P,SLTLPN ;STUFF BODY LOCATION
NSTFBL:
MD,< FETCH(A,E,BPPN) ;ANY PIN SET?
JUMPN A,STFPL1
>;MD
FETCH(A,E,BPLOC) ;DEFAULT NAME FROM TYPE
MD,< FETCH(A,A,TPNAM) >
MPC< FETCH(A,A,TNAM) >
STFPL1: PUTBYT "("
PUSHJ P,BPINPN
PUTBYT ")"
POP P,A
POPJ P,
STFCLC: AOS (P)
PUSH P,A
FETCH(A,A,PLOC)
MOVE A,(A)
PUSHJ P,CSLTLP ;PRINT THE BAY/RACK/SLOT/LOC/PIN
POP P,A
POPJ P,
BJUMP: PUSHJ P,GETCLS
JRST PERRET
FETCHL(C,A,PBIT)
TLNN C,ISPIN
JRST PERRET
FETCH(A,A,BBODY)
MOVEI T,BODM
PUSHJ P,CHNGMD ;CHANGE TO BODY MODE
FETCH(T,A,BXY) ;GET LOC OF BODY
JRST CHKON
;MUNGING SUBROUTINES (PC)
MPC,<
MUSH: SKIPE A,DBODPN ;BODY POINTER
PUSHJ P,MUSHB
SKIPE A,PONPNT
PUSHJ P,MUSHP
TRO MCHG!NEEDCL
TRNE BTHSDS ;IF ON BOTH SIDES, MUNG BOTH SIDES
SKIPN A,PONPN2
POPJ P,
; MUSH POINTS
MUSHP1: FETCHL(T,A,PBIT)
TLNE T,ISPIN!CPIN
POPJ P,
FETCH(TTT,A,PXY)
PUSHJ P,MUSHIT
STORE(T,A,PXY)
POPJ P,
MUSHP: PUSHJ P,MUSHP1
FETCH(A,A,PNXT)
JUMPN A,MUSHP
POPJ P,
;MUSH BODIES
MUSHB1: FETCH(F,A,BORI)
FETCH(B,A,BLNK)
JUMPE B,CPOPJ ;NO PINS, NO MUSH
FETCH(TTT,B,BPXY)
PUSHJ P,MUSHIT ;MUSH THE PIN
MOVE TTT,T ;SAVE NEW X,Y OF PIN
FETCH(B,B,BPLOC)
FETCH(T,B,TPXY) ;X,Y FROM PIN TYPE BLOCK
ADDI F,2 ;ROTATE BACK TO BODY CENTER
ANDI F,3 ;MAKE SURE WE DON'T OVERFLOW
PUSHJ P,ORIENT
ADJUST(ADD,T,TTT)
STORE(T,A,BXY) ;STORE AS NEW BODY X,Y
PUSH P,A
PUSHJ P,BODFIX
POP P,A
POPJ P,
MUSHB: PUSHJ P,MUSHB1
FETCH(A,A,BNXT)
JUMPN A,MUSHB
POPJ P,
MUSHIT: HRRE T,TTT
ASH T,-1
IDIV T,STPSIZ
IMUL T,STPSIZ
ASH T,1
HLRE TT,TTT
ASH TT,-1
IDIV TT,STPSIZ
IMUL TT,STPSIZ
ASH TT,1
HRL T,TT
POPJ P,
;SET MUSH
STMUSH: PUSHJ P,GETCLS
JRST PERRET
TRO MCHG!NEEDCL
MOVE G,A
HLRZ G,(G)
STMSH1: HRRZ A,1(G)
JUMPE A,.+2
PUSHJ P,MUSHP1
HLRZ A,1(G)
JUMPE A,.+2
PUSHJ P,MUSHB1
HRRZ G,(G)
JUMPN G,STMSH1
POPJ P,
>;MPC
;LINE EDIT TEXT
STANFO,<
LODED: JUMPE T,CPOPJ ;DONE WHEN WE GET A ZERO
SETZ B,
HLRZ C,(T) ;SIZE
JUMPE C,LODED2
CAIN C,1 ;SIZE 1?
JRST LODED2 ;YES, NO SPECIAL EFFECT
PTWR1S [ 0
"\"]
JFCL
TRZE C,400000
PTWR1S [ 0
"V"]
JFCL
ADDI C,60 ;MAKE IT ASCIZ
PTWR1S B
JFCL
LODED2: ADD T,[POINT 7,1]
LODED1: ILDB C,T
PTWR1S B
JFCL ;IGNORE IF NOT SENT
TLNE T,760000
JRST LODED1
HRR T,-1(T)
TRNE T,-1
JRST LODED1
POPJ P,
LODPNT: HLRZ T,(A) ;TO DATA BLOCK
HRRZ T,1(T) ;TO TEXT BLOCK
HLRZ T,(T) ;TO TEXT
JUMPE T,CPOPJ ;DON'T LOAD NO TEXT!
HRRZ T,(T)
JRST LODED ;LOAD IT
PNTQ: PUSHJ P,GETCLS ;CURRENT POINT
JRST PERRET ;NONE
PUSHJ P,LODPNT ;LOAD IT UP
ZORQ: PUSHJ P,TXREAD ;READ IT BACK
CAIN C,ALTMOD ;END WITH ALTMOD?
JRST PUTFS ;JUST PUT BACK THIS STRING, NO CHANGE
SKIPG T
MOVE T,STDBIG
HRLM T,(B)
SKIPN 1(B)
JRST [ PUSHJ P,PUTFS ;NULL STRING, GIVE IT BACK
JRST PTKIL1] ;AND KILL ANY EXISTING TEXT
PUSH P,B ;SAVE STRING POINTER
HLRZ C,(A)
HRRZ C,1(C)
HLRZ D,(C)
NIL,< FETCH(D,A,PTXT) >
JUMPN D,[HRRZ B,(D)
PUSHJ P,PUTFS
JRST GTTBLK]
GETFS(D)
SETZM 1(D) ;0 INITIAL OFFSET
HRLM D,(C) ;LINK IT IN
NIL,< STORE(D,A,PTXT) >
GTTBLK: POP P,(D) ;STORE NEW STRING POINTER
TRO MCHG!NEEDCL
MD,< JRST FIXEM > ;FIX OFFSETS IF BITS ON
MPC,< POPJ P, >
PNTZ: PUSHJ P,GETCLS ;CURRENT POINT
JRST PERRET ;NONO
PUSHJ P,LODPNT ;LOAD IT UP
PTWRS9 [ 0
[BYTE(9)271,271,271,377,0]] ;CTRL1 999 BACKSPACE
JRST ZORQ ;AND READ IT BACK
>;STANFO
SUBTTL POINT TEXT
; PUT TEXT ON POINT
PNTTXT: PUSHJ P,GETCLS ;GET POINTER TO CLOSEST POINT
JRST PERRET ;NONE
PNTTX3: TRNE INLIN ;DRAWING LINE?
PUSHJ P,[PUSHJ P,PLPNT ;MAKE CORNER
MOVE T,LINING
PUSHJ P,PNALT ;STOP LINE
PUSHJ P,SCLOSP ;AND SET CLOSEST POINT TO LINING
MOVE A,CLOSES
POPJ P,]
TLNN M,DSKACT!MACACT
OUTSTR [ASCIZ /TEXT?
/]
PUSHJ P,TXREAD ;READ IN THE TEXT
CAIN C,ALTMOD
JRST PUTFS ;JUST GIVE BACK FREE STORAGE AND LEAVE
FETCH(D,A,PTXT) ;GET OLD TEXT POINTER
SKIPN 1(B) ;NULL TEXT?
JRST [ PUSHJ P,PUTFS ;GIVE BACK NULL STRING
JRST PTKIL1] ;JUST KILL ORIGINAL TEXT(IF ANY)
TRO MCHG!NEEDCL ;THIS CHANGES SCREEN
JUMPE D,PNTTX1 ;CAN'T COPY IF NO OLD
JUMPGE T,PNTTX1 ;DON'T COPY IF EXPLICIT SIZE TYPED
FETCH(T,D,TCSTR)
FETCH(T,T,TSSIZ) ;GET OLD SIZE
PNTTX1: SKIPG T ;MAKE SURE WE HAVE POSITIVE SIZE
MOVE T,STDBIG
STORE(T,B,TSSIZ) ;STORE SIZE
GETBLK(T,TEXCOF)
STORE(B,T,TCSTR)
CLEAR(T,TCXY) ;0 INITIAL OFFSET
STORE(T,A,PTXT) ;DEPOSIT TEXT POINTER
;DEC, MAYBE DEFAULT THE POLARITY LETTERS
MD,<
DEC,< PUSH P,D ;FIND DEFAULT POLARITY IF NEEDED
PUSH P,A
MOVE A,B
ADD A,[POINT 7,1]
PUSHJ P,PERMUT ;PERMUT SIGNAL TO GET H OR L OR !
SKIPGE POLAR ;GOT H OR L?
JRST PNTTX4 ;YES, DONE
SKIPG POLAR ;IS IT !
JRST NOEXCL ;NO
;Got "!", don't try to default H,L
;Delete the "!" off of the string, though.
MOVE A,(P) ;A = POINT
FETCH(A,A,PTXT)
FETCH(A,A,TCSTR) ;ACTUAL STRING
ADD A,[POINT 7,1]
PNTEX1: MOVE B,A ;REMEMBER 1 BEFORE START OF WHAT WE WANT
PUSHJ P,GETITZ
JRST PNTTX4 ;OH WELL, I THOUGHT IT WAS THERE
CAIE T," " ;FIND FIRST SPACE
JRST PNTEX1
PNTEX3: PUSHJ P,GETITZ
JRST PNTTX4
CAIN T," " ;SKIP OVER SPACES
JRST PNTEX3
CAIE T,"!" ;<SPACES>!
JRST PNTEX1 ;GO BACK AND TRY AGAIN
PUSHJ P,GETITZ
SETZ T,
JUMPN T,PNTEX1 ;SHOULD BE AT END NOW
CAIA
PNTEX4: IDPB T,B
TLNE B,760000
JRST PNTEX4
HRRZ TTT,-1(B)
HLLZS -1(B)
SKIPE B,TTT
PUSHJ P,PUTFS ;RETURN REST OF STRING
JRST PNTTX4
GETITZ: TLNN A,760000
JRST [ HRR A,-1(A)
TRNN A,-1
POPJ P,
JRST .+1]
ILDB T,A
JUMPE T,GETITZ
CAIE T,";" ;THIS IS THE COMMENT CHAR
AOS (P)
POPJ P,
;Default the H,L polarity
NOEXCL: MOVSI C,1 ;CLEAR MARKING BITS FOR DEFPOL
SKIPE A,PONPNT
PUSHJ P,CLRBTS
SETZM WDOLST ;CLEAR DO LIST
MOVE T,(P)
MOVE H,[1,,DEFPOL]
PUSHJ P,RECUR0 ;INSERT THIS PIN IN LIST
PUSHJ P,RECCHK ;NOW CHECK IT AND ITS CONNECTIONS FOR DEFAULT POLARITY
JRST PNTTX4 ;NONE FOUND
MOVE B,(P) ;PTR TO POINT
FETCH(B,B,PTXT)
PNTTX5: HRRZ B,(B) ;TEXT PTR
JUMPE B,PNTTX6 ;FOUND LAST BLOCK?
MOVE C,B
JRST PNTTX5
PNTTX7: TLNE C,760000 ;AT END OF WORD?
JRST PNTTX8 ;NO
GETFS(D) ;YES, TACK ON A NEW BLOCK
SETZM (D)
SETZM 1(D)
HRRM D,-1(C) ;LINK
HRR C,D
PNTTX8: ILDB D,C ;FIND FIRST NULL
JUMPN D,PNTTX7
POPJ P,
PNTTX6: ADD C,[POINT 7,1]
PUSHJ P,PNTTX7 ;FIND WHERE TO PUT IN POLARITY
MOVEI D," "
DPB D,C ;PUT IN SEPERATOR
PUSHJ P,PNTTX7
MOVEI D,"H" ;ASSUME H
TRNN A,ASSH ;H OR L?
MOVEI D,"L" ;L
DPB D,C
PNTTX4: POP P,A
POP P,D
>;DEC
>;MD
;MAYBE CHECK FOR NULL TEXT AND TEXT WITH TABS HERE
JUMPE D,CPOPJ
MOVE B,D ;PUT THE OLD TEXT BACK...
JRST PUTFS ;... ON FREE STORAGE
;STORE TEXT IN MACRO
STOTXT: PUSHJ P,GETCLS
JRST PERRET
FETCH(T,A,PTXT)
SKIPE T
FETCH(T,T,TCSTR)
STOTXB: PUSHJ P,SETTT
JUMPE T,ITSTUF
FETCH(B,T,TSSIZ)
CAMN B,STDBIG ;OR STANDARD
JRST STOTX0 ;WE DON'T NEED ANYTHING IN FRONT
PUTBYT "\"
TRZE B,400000 ;IS IT VERTICAL
PUTBYT "V"
PUSHJ P,PUTTTN ;AND THE SIZE
STOTX0: ADD T,[POINT 7,1]
STOTX1: PUSHJ P,GETTT
JRST ITSTUF
PUTBYT (C)
JRST STOTX1
MD,<
;<META>T
PNTTX2: PUSHJ P,GETCLS
JRST PERRET
PUSHJ P,PNTTX3
JRST PTTOFF ;NOW GO FIX IT
;Z
PUTOFF: PUSHJ P,GETCLS
JRST PERRET
PTTOFF: PUSHJ P,SETFXT
JRST FIXEM
;Q
CONOFF: PUSHJ P,GETCLS
JRST PERRET
CNCOFF: PUSHJ P,SETFXC
JRST OFFCON ;THIS CAN'T AFFECT TEXT
SETFXT: FETCH(TT,A,PTXT)
JUMPE TT,CPOPJ ;CAN'T SET IF NO TEXT
FETCH(TT,A,PBIT)
TRO TT,FIXTXT
SKIPE MOVFLG
TROA TT,FIXRHT
TRZ TT,FIXRHT
STORE(TT,A,PBIT)
POPJ P,
SETFXC: FETCH(TT,A,PBIT)
TRNN TT,CPIN
POPJ P,
TRO TT,FIXCON
STORE(TT,A,PBIT)
POPJ P,
;<META>Z
UNOFFT: PUSHJ P,GETCLS
JRST PERRET
CLRFXT: CLRBIT(FIXTXT!FIXRHT,TT,A,PBIT)
POPJ P,
;<META>Q
UNOFFC: PUSHJ P,GETCLS
JRST PERRET
CLRFXC: CLRBIT(FIXCON,TT,A,PBIT)
POPJ P,
;OFFALL, OFFTXT, OFFCON (D)
OFFRHT: SETOM MOVFLG
POPJ P,
NOFRHT: SETZM MOVFLG
POPJ P,
OFFALL: SKIPN A,PONPNT
POPJ P,
OFFAL1: PUSHJ P,SETFXT
PUSHJ P,SETFXC
PUSHJ P,FIXEM
HRRZ A,(A)
JUMPN A,OFFAL1
POPJ P,
;ROUTINE TO RE-FIX ALL <C><M>Z POINTS
FIXEM0: SKIPN A,PONPNT
POPJ P,
FIXEM1: PUSHJ P,FIXEM
HRRZ A,(A)
JUMPN A,FIXEM1
POPJ P,
;OFFSET TEXT
;A = POINT
OFFTXT: FETCH(B,A,PTXT)
JUMPE B,CPOPJ ;NO TEXT
FETCHL(D,A,PBIT) ;GET BITS FOR LATER
TLNE D,FIXTXT ;FIXING TEXT AT ALL?
PUSHJ P,LINSET ;DIRECTION TO HANG TEXT OFF END OF LINE
POPJ P, ;TOO COMPLEX, DON'T CHANGE IT
PUSHJ P,OFFCAL ;COUNT CHARS, GET MAX WIDTH, # LINES, CHAR SCALE FACTOR
SKIPE ULNFLG ;POSITION SO IT GETS UNDERLINED?
TLNE D,ISPIN ;NOT PINS WE DON'T
JRST NOULN
ADDI C,HMOVU-HMOVE
NOULN: TLNE D,ISPIN ;IS THIS A PIN?
ADDI C,HMOVP-HMOVE
CAIG C,1 ;L OR R? (AND NOT PIN OR UNDERLINE)
MOVE TT,TTT ; MAKE HEIGHT LOOK LIKE ONE LINE
XCT HMOVE(C) ;OFFSET X,Y
XCT MOVEV(C) ;OFFSET X (1 LINE, 1/2 LINE, ...)
SUB TT,TTT ;NORMALIZE VERTICAL DOWN 1 LINE
FETCH(TTT,B,TCSTR)
FETCH(TTT,TTT,TSSIZ) ;TEXT SIZE
MOVE TTT,VIRPTX(TTT) ;PT WIDTH OF ONE CHAR
ASH TTT,-1 ;NOW 1/2
XCT HFUDGE(C) ;POSSIBLY FUDGE X PART
HRL TT,T
SKIPN ISVERT ;VERTICAL TEXT?
JRST NOFVRT
MOVS TT,TT ;YES, MAP TO -Y,X
TLC TT,-1
ADD TT,[1,,0]
NOFVRT: CAMN TT,ADDR(B,TCXY)
POPJ P,
EXCH TT,ADDR(B,TCXY)
TRO MCHG
SKIPE ISVERT
POPJ P, ;QUIT NOW IF VERT
TLNE D,FIXRHT ;DOES HE WANT FIX RIGHT?
CAIE C,1 ;go LEFT? ( WON'T BE 1 IF WAS PIN!!)
POPJ P, ;ALL DONE
;Move point so that left edge of text stays in place
SUB TT,ADDR(B,TCXY) ;TEXT TO LEFT, BUT MOVE POINT, NOT LEFT EDGE OF TEXT
HLRE T,TT ;HOW MUCH MOVED IN X
FETCH(TTT,B,TCSTR)
FETCH(TTT,TTT,TSSIZ) ;SIZE OF TEXT
IMUL T,PLTPTX(TTT)
IDIV T,VIRPTX(TTT) ;ADJUST FOR DEVIATION OF PLOT CHARACTER SIZE
UNSCAL T ;CONVERT TO INTERNAL COORDS
COMMENT 
The character offset (TCXY) is in III display coords (!) that is so
that it doesn't get scaled with the drawing. We have to convert it to
internal drawing coords somehow to adjust the point position. This
conversion is a function of the current drawing scale.
When this is done at the scale where text looks "right", this will
adjust the point so that the left edge of the text stays fixed.

HRLZ T,T
ADD T,ADDR(A,PXY) ;ADJUST X OF POINT
FETCH(TT,A,PNR) ;NOW LOOK AT OTHER END OF WIRE
FETCH(TT,TT,PXY) ;X,Y OF OTHER END!
SUB TT,[4,,0]
CAML T,TT
MOVE T,TT ;TO FAR, LIMIT TO JUST TO LEFT OF RIGHT END
STORE(T,A,PXY)
TRO NEEDCL ;MAYBE CHANGED CLOSEST
POPJ P,
;OFFSET CONNECTOR BOX
;OFFCON - OFFSET CONNECTOR BOX
;A = CONNECTOR PIN
FIXEM: PUSHJ P,OFFTXT
OFFCON: FETCH(D,A,PBIT)
TRNE D,FIXCON ;FIXING CON?
TRNN D,CPIN ;CON?
POPJ P, ;NO, QUIT NOW
FETCH(B,A,PTXT)
PUSHJ P,LINSET ;SEE WHICH WAY LINE GOES
POPJ P, ;TOO COMPLEX, LEAVE IT ALONE
MOVE D,STDBIG
XCT CONTAB(C) ;T gets deltaX,,deltaY
JUMPE B,GOTCOF ;ANY TEXT?
PUSH P,T ;SAVE CON BOX OFFSET
PUSHJ P,OFFCAL ;CALC TEXT LENGTH, HEIGHT
XCT CTOTAB(C)
ADD TTT,(P)
HLRE TT,(P)
ADD T,TT
HRLZS T
HRR T,TTT
POP P,(P)
SKIPN ISVERT ;VETICAL TEXT?
JRST GOTCOF ;NO
MOVS T,T ;YES, MAP TO -Y,X
TLC T,-1
ADD T,[1,,0]
GOTCOF: FETCH(B,A,PLOC)
CAMN T,1(B)
POPJ P,
MOVEM T,1(B) ;SET OFFSET
TRO MCHG
POPJ P,
;
;THESE 3 TABLES MUST MATCH THE ONES FOR PINS
HMOVE: SETZ T, ;go RIGHT no offset X
JFCL ;go LEFT full offset X
ASH T,-1 ;go UP center X
ASH T,-1 ;go DOWN center X
ASH T,-1 ;center center X
MOVEV: ASH TT,-1 ;go RIGHT center Y
ASH TT,-1 ;go LEFT center Y
JFCL ;go UP full offset Y
SETZ TT, ;go down no offset
ASH TT,-1 ;center center Y
HFUDGE: ADD T,TTT ;go RIGHT 1/2 char right fudge
SUB T,TTT ;go LEFT 1/2 char left fudge
JFCL
JFCL
JFCL
;OFFSET TEXT, SO THAT IT IS UNDERLINED
;THESE 3 TABLES MUST MATCH THE ONES FOR POINTS
HMOVU: JFCL ;go RIGHT full offset left
SETZ T, ;go LEFT no offset
ASH T,-1 ;go UP center X
ASH T,-1 ;go DOWN center X
ASH T,-1 ;center center X
VMOVU: JFCL ;go RIGHT full offset up
JFCL ;go LEFT "
JFCL ;go UP "
SETZ TT, ;go DOWN no offset
ASH TT,-1 ;center center Y
HFUDGU: JFCL ;no fudges for underline mode
JFCL
JFCL
JFCL
JFCL
;OFFSET TEXT ON PINS - put on top of line coming in
;THESE 3 TABLE MUST MATCH THE ONE FOR POINTS
HMOVP: JFCL ;go RIGHT left/up, over line coming in
SETZ T, ;go LEFT right/up, over "
SETZ T, ;go UP right, from line coming in
SETZ T, ;go DOWN up/right, next to line coming in
ASH T,-1 ;center
VMOVP: JFCL ;UP 1
JFCL ;UP 1
SETZ TT,
JFCL ;UP 1
ASH TT,-1
HFUDGP: SUB T,TTT ;LEFT ANOTHER HALF CHAR
ADD T,TTT ;RIGHT ANOTHER HALF CHAR
JFCL
JFCL
JFCL
;CONNECTOR OFFSET TABLES FOR NO TEXT
;A = POINT
;D = STDBIG CHAR SIZE
;RETURNS T= deltaX,,deltaY to position connector box
; (positions the first char of the connector string,
; connector boxes are drawn relative to that)
CONTAB: PUSHJ P,CONR ;go RIGHT
PUSHJ P,CONL ;go LEFT
PUSHJ P,CONU ;go UP
PUSHJ P,COND ;go DOWN
PUSHJ P,CONU ;center
;CONNECTOR BOXES ARE DRAWN WITH VECTORS PTY,,PTY SIZE.
;go RIGHT - offset X=CH-Height/2, Y=-CH-Height/2
CONR: MOVE T,VIRPTY(D) ;HEIGHT OF STD CHAR
ASH T,-1
MOVN TTT,T
HRLZ T,T
HRR T,TTT
POPJ P,
;go LEFT - offset X= -Text-Width - CH-Height/2, Y= -CH-Height/2
CONL: PUSHJ P,CONCAL
IMUL T,VIRPTX(D) ;WIDTH OF CONNECTOR NAME IN PTS
MOVNS T
MOVN TT,VIRPTY(D)
ASH TT,-1
ADD T,TT
HRLZ T,T
HRR T,TT
POPJ P,
;go UP - offset X= -Text-Width/2, Y= 0
CONU: PUSHJ P,CONCAL
IMUL T,VIRPTX(D) ;TIMES STD CHAR WIDTH
ASH T,-1
MOVN T,T
HRLZ T,T
POPJ P,
;go DOWN - offset X= -Text-Width/2, Y= -CH-Height
COND: PUSHJ P,CONCAL
IMUL T,VIRPTX(D)
ASH T,-1
MOVN T,T
HRLZ T,T
MOVN TT,VIRPTY(D)
HRR T,TT
POPJ P,
;CONNECTOR BOX OFFSET TABLES, WITH TEXT ON POINT
;T = - WIDTH OF TEXT (IN PTS)
;TT = HEIGHT OF TEXT (IN PTS)
;TTT = HEIGHT OF 1 LINE OF TEXT
;RETURNS
;T = X DELTA
;TTT = Y DELTA
CTOTAB: PUSHJ P,CTOR ;go RIGHT
PUSHJ P,CTOL ;go LEFT
PUSHJ P,CTOU ;go UP
PUSHJ P,CTOD ;go DOWN
PUSHJ P,CTOU ;center
;TEXT-WIDTH+1/2,,0
CTOR: MOVE TT,VIRPTX(D) ;WIDTH OF STANDARD CHAR
ASH TT,-1
MOVNS T
ADD T,TT
SETZ TTT,
POPJ P,
;-TEXT.WIDTH-1/2,,0
CTOL: MOVN TT,VIRPTY(D) ;BOX STICKS OUT PT-Y
ASH TT,-1
ADD T,TT
SETZ TTT,
POPJ P,
;0,,-TEXT.HEIGHT-1/2
CTOD: SETZ T,
MOVNS TTT
ASH TTT,-1
SUB TTT,TT
POPJ P,
;0,,TEXT.HEIGHT+1/2
CTOU: SETZ T,
ASH TTT,-1
ADD TTT,TT
POPJ P,
SUBTTL CALC HEIGHT AND LENGTH OF TEXT IN VIRTUAL CHAR POINTS (D)
;OFFCAL
;B = TEXT STRING WITH OFFSET BLOCK
;COUNT # OF LINES OF TEXT, LENGTH OF LONGEST LINE
;T = - WIDTH OF LONGEST LINE * CHAR SIZE FACTOR
;TT = # OF LINES HIGH * CHAR SIZE FACTOR
;TTT = CHARACTER SIZE FACTOR
OFFCAL: FETCH(TT,B,TCSTR)
ADD TT,[POINT 7,1]
PUSH P,[0]
PUSH P,[1] ;AT LEAST ONE LINE
SETZ T, ;count # lines, max wid line
OFFCL1: TLNN TT,760000
JRST [ HRR TT,-1(TT)
TRNN TT,-1
JRST OFFCL2
JRST .+1]
ILDB TTT,TT
JUMPE TTT,OFFCL1
CAIN TTT,DBLARR ;LINE BREAK?
JRST [ CAMGE T,-1(P)
MOVEM T,-1(P)
SETZ T,
AOS (P)
JRST OFFCL1]
SOJA T,OFFCL1 ;COUNT CHARS IN CURRENT LINE
OFFCL2: CAMGE T,-1(P)
MOVEM T,-1(P)
FETCH(TTT,B,TCSTR)
FETCH(TTT,TTT,TSSIZ) ;CHAR SIZE
TRZ TTT,400000 ;CLEAR VERT BIT
POP P,TT ;# LINES
POP P,T ;WIDTH OF BIGGEST LINE
IMUL TT,VIRPTY(TTT) ;HEIGHT OF TEXT IN PTS
IMUL T,VIRPTX(TTT) ;WIDTH OF TEXT IN PTS
MOVE TTT,VIRPTY(TTT) ;HEIGHT OF ONE LINE
POPJ P,
;CONCAL - CALCULATE CONNECTOR PRINT SIZE
;A = POINT
;RETURNS T = CHARACTER COUNT
CONCAL: SETZM CHRCNT
PUSH P,A
PUSH P,TT
PUSH P,B
PUSH P,PUTCHR
MOVE B,[AOS CHRCNT]
MOVEM B,PUTCHR
FETCH(A,A,PLOC)
MOVE A,(A) ;B-R-S,,PIN-LOC
PUSHJ P,CSLTLP ;PRINT CONN PIN NAME
POP P,PUTCHR
POP P,B
POP P,TT
POP P,A
MOVE T,CHRCNT
POPJ P,
;LINSET - COMPUTE DIRECTION OFF END OF LINE (IF ANY)
;A = POINT
;SKIPS
;RETURNS C = DIRECTION TO PUT CONNECTOR
; 0 - go RIGHT
; 1 - go LEFT
; 2 - go UP
; 3 - go DOWN
; 4 - no lines, center
;ISVERT = FLAG FOR VERT TEXT
LINSET: SETZ C,
MOVEI T,ADDR(A,PNU) ;POINTER TO NEIGHBOR BLOCK
SKIPN TT,1(T) ;L OR R ?
JRST NOLROF
TLNE TT,-1
TRO C,1 ;L
TRNE TT,-1
TRO C,2 ;R
NOLROF: SKIPN TT,(T) ;UP OR DWN ?
JRST NOUDOF
TLNE TT,-1
TRO C,4 ;DWN
TRNE TT,-1
TRO C,10 ;UP
NOUDOF: XCT SETCTB(C)
SETZM ISVERT ;ASSUME NO VERT TEXT
FETCH(B,A,PTXT)
JUMPE B,CPOPJ1 ;LEAVE NOW IF NO TEXT
FETCH(TT,B,TCSTR) ;STRING
SKIPL (TT) ;VERT TEXT?
JRST CPOPJ1 ;NO
SETOM ISVERT ;IT IS VERTICAL
CAIN C,4 ;NO CHANGE IF NO LINES
JRST CPOPJ1
TRCN C,2 ;MAP 90 DEGREES CW
TRC C,1
JRST CPOPJ1
SETCTB: MOVEI C,4
MOVEI C,0 ;LINE TO LEFT, GO RIGHT
MOVEI C,1 ;LINE TO RIGHT, GO LEFT
POPJ P,
MOVEI C,2 ;LINE DOWN, GO UP
POPJ P,
POPJ P,
POPJ P,
MOVEI C,3 ;LINE UP, GO DOWN
POPJ P,
POPJ P,
POPJ P,
POPJ P,
POPJ P,
POPJ P,
POPJ P,
>;MD
;KILL TEXT (D,PC)
PTKILL: PUSHJ P,GETCLS ;GET POINTER TO CLOSEST POINT
JRST PERRET ;NONE
PTKIL1: TRNE TMOVE ;MOVING TEXT OFFSET?
PUSHJ P,CLRMOV ;YES, CLEAR MOVING
MOVE B,A
KILTXT: PUSH P,B
MOVE T,B
FETCH(B,B,PTXT)
JUMPE B,NKLTXT ;LEAVE IF NONE
CLEAR(T,PTXT)
CLRBIT(<MD,<FIXTXT!FIXRHT!>FOUNDP>,TT,T,PBIT)
TRO MCHG!NEEDCL ;CHANGES SCREEN AND BLINKING LETTER
PUSHJ P,PUTFS
MD,< PUSH P,A
PUSH P,C
PUSH P,D
MOVE A,-3(P)
PUSHJ P,OFFCON ;MAYBE FIX CON
POP P,D
POP P,C
POP P,A
>;MD
NKLTXT: POP P,B
POPJ P,
;DELETE LINE (D)
;A = FIRST POINT,,OTHER POINT
MD,<
LINDEL: PUSHJ P,GETCLS ;CLOSEST LINE?
JRST PERRET
TRO MCHG!NEEDCL
HLRZ B,A
DEFINE FOO (PND,PNU)
< FETCH(C,B,PND)
CAIN C,(A)
JRST [ CLEAR(B,PND)
CLEAR(A,PNU)
POPJ P,]
>
FOO(PND,PNU)
FOO(PNU,PND)
FOO(PNL,PNR)
FOO(PNR,PNL)
POPJ P,
;LINES, SET MIDPOINT, MAKE JOG, ATTACH POINT (D)
NIL,<
BENDL1:
BENDL2:
LATTP1:
LATTP2:
>;NIL
DEFINE BENDIT # (CBIT)
<
BENDL#CBIT:
PUSHJ P,GETCLS
JRST PERRET ;NO CLOSEST LINE.
MOVE T,CURSE ;USE CURSOR POS FOR MIDPOINT CALC
LATTP#CBIT: ;ENTRY POINT FOR <META>A IN LINE MODE
MOVEM T,DX3 ;SAVE POS TO BREAK LINE AT
TRO MCHG
HLRZ C,A
FETCH(E,A,PNU)
CAIN E,(C)
JRST BENDY#CBIT ;VERT LINE, C ABOVE A
FETCH(E,A,PNR)
CAIN E,(C)
JRST BENDX#CBIT ;HORZ LINE, C RIGHT OF A
EXCH A,C
FETCH(E,A,PNU)
CAIN E,(C)
JRST BENDY#CBIT
FETCH(E,A,PNR)
CAIN E,(C)
JRST BENDX#CBIT
POPJ P,
; BENDX BENDY
;
; P1 ==== C C
; | |
; | |
; A ==== P2 P2 ==== P1
; |
; |
; A
;
;IN THE CASE OF ONLY ONE MIDPOINT, P2 IS OMITTED
DEFINE GARPLY $ (H1,PND,PNU,PNL,PNR)
< PUSH P,A ;POINT BELOW, OR TO LEFT
PUSH P,C ;POINT ABOVE, OR TO RIGHT
FETCH(T,C,PXY)
H$H1$H1 T,DX3 ;SET Y:(P1 IS DIRECTLY ABOVE C)
PUSHJ P,PNTPUT
IFE CBIT-2,<MOVEM D,SAVP> ;REMEMBER POINT FOR HIGHER UPS!
PUSH P,D ;P1
IFE CBIT-1,<
FETCH(T,A,PXY)
H$H1$H1 T,DX3 ;SET Y:(P1 IS DIRECTLY BELOW A)
PUSHJ P,PNTPUT
MOVE T,D ;T=P2
>
POP P,E ;E=P1
IFN CBIT-1,<
MOVE T,E ;ONLY MAKING ONE POINT
>
POP P,C
POP P,A
STORE(T,A,PNU) ;LINK A - P2
STORE(A,T,PND)
IFE CBIT-1,<
STORE(E,T,PNR) ;LINK P2 - P1
STORE(T,E,PNL)
>
STORE(E,C,PND) ;LINK P1 - C
STORE(C,E,PNU)
POPJ P,
>
BENDX#CBIT:
GARPLY(L,PNL,PNR,PND,PNU)
BENDY#CBIT:
GARPLY(R,PND,PNU,PNL,PNR)
>
BENDIT(1) ;MAKE DOUBLE MIDPOINT
BENDIT(2) ;MAKE SINGLE MIDPOINT
;ATTACH POINT TO LINE (D)
LATT: MOVE A,CLOSES ;IF MOVING
TRZE INMOV ;STOP MOVING
JRST INATT ;BUT USE THE ONE WE WERE MOVING
SETZ A, ;FOR INLIN
TRNE INLIN
JRST INATT
PUSHJ P,GETCLS
JRST PERRET
INATT: MOVEM A,SAVP
MOVEI T,LINM
PUSHJ P,TCHNGM
PUSHJ P,GETCLS ;FIND CLOSEST LINE
JRST [ PUSHJ P,RCHNGM
SKIPN SAVP
TRO INLIN!NEEDCL
JRST PERRET]
TLNN M,DSKACT!MACACT
OUTSTR[ASCIZ/THIS ONE/]
MOVEI T,UPSTAL
MOVEM T,SPDISP
MOVE T,[ASCID/AL/]
MOVEM T,SPMODT
MOVEI T,SPM ;SPECIAL POINTER MODE
PUSHJ P,TCHNGM
MOVE T,IPOINT ;GET INTERSECTION POINT
MOVEM T,STARLOC ;THIS IS LOC OF STAR
PUSHJ P,YORN
JFCL
JFCL
PUSHJ P,RCHNGM ;GET BACK OLD MODE
CAIE C,"Y"
CAIN C,"y"
CAIA
JRST [ SKIPN SAVP ;WERE WE INLIN?
TRO INLIN!NEEDCL;YES, STAY THERE
POPJ P,]
SKIPE T,SAVP ;IS THIS THE INLIN GUY
JRST GOTINT ;ALREADY GOT INTERSECTION POINT
MOVE T,IPOINT ;PUT POINT AT PERPENDICULAR INTERSECTION POINT
PUSHJ P,LATTP2 ;MAKE MIDPOINT
TRO INLIN ;TELL HIM ITS OK
MOVE A,SAVP ;SETUP A FOR LINE CALLS
PUSHJ P,PNMNS1 ;TRY -
CAIA ;LOSE
JRST ATTDON ;THEN IT WORKED
TRC ZIGZAG ;ELSE TRY THE OTHER WAY
MOVE A,SAVP
PUSHJ P,PNMNS1
CAIA ;LOSE
JRST ATTDON ;YES
MOVE A,SAVP
PUSHJ P,PNOT1 ;TRY A STRAIGHT (SLANTED) LINE!
CAIA
JRST ATTDON
OUTSTR[ASCIZ/SORRY, YOU'LL HAVE TO HAVE ANOTHER
TICKET TO MAKE THIS CONNECTION.
/]
TRO INLIN!NEEDCL
POPJ P,
ATTDON: TRO NEEDCL!MCHG
TRZ INMOV!INLIN
POPJ P,
GOTINT: MOVEM T,LINING ;SAVE ORIGINAL POINT HERE
FETCH(T,T,PXY) ;USE THIS AS PLACE TO MAKE NEW POINT
PUSHJ P,LATTP2 ;MAKE A MIDPOINT
MOVE A,SAVP
MOVE T,LINING
FETCHL(T,T,PBIT)
TLNN T,ISPIN ;CAN'T REVERSE IF LINING IS ALREADY PIN
EXCH A,LINING ;MOVE TO LINE!
JRST LATTP ;ATTACH TO POINT WILL DO THE REST
;ATTACH POINT TO POINT (D)
PATT: TRZE INMOV
JRST [ MOVE A,CLOSES ;USE THE ONE WE WERE MOVING
JRST PATT1]
TRNN INLIN
PUSHJ P,GETCLS
JRST PERRET
PATT1: MOVEM A,LINING
TRO INLIN!NEEDCL
PUSHJ P,GETCLS ;FIND CLOSEST(NOT INCLUDING CURRENT CLOSEST)
JRST [ TRZ INLIN
TRO NEEDCL
JRST PERRET] ;NO, JUST ONE POINT ON SCREEN
FETCH(T,A,PXY)
FETCHL(TT,A,PBIT)
TLNE TT,ISPIN
JRST [ EXCH A,LINING ;TRY IT THE OTHER WAY
FETCHL(TT,A,PBIT)
TLNN TT,ISPIN
JRST .+1
OUTSTR[ASCIZ/SORRY, BOTH ARE PINS!
/]
TRZ INLIN
TRO NEEDCL
JRST PERRET]
TLNN M,DSKACT!MACACT
OUTSTR[ASCIZ/THIS ONE/]
TRZ INLIN
MOVEM T,STARLOC
MOVEI T,UPSTAR
MOVEM T,SPDISP
MOVE T,[ASCID/AP/]
MOVEM T,SPMODT
MOVEI T,SPM
PUSHJ P,TCHNGM
PUSHJ P,YORN
JFCL
JFCL
TRO NEEDCL
PUSHJ P,RCHNGM
CAIE C,"Y"
CAIN C,"y"
CAIA
POPJ P,
TRO MCHG
;FALLS THRU
;
LATTP: MOVEM A,DX1
MOVE B,LINING
DEFINE FOO (LINK,OTHER)
< FETCH(C,B,LINK) ;SIFT OUT THE INCESTUOUS LINKS
CAIN C,(A)
SETZ C, ;B pointed to A, flush
JUMPE C,[FETCH(C,A,LINK) ;B's link no good, use A's link
CLEAR(B,LINK)
CAIN C,(B)
SETZ C, ;A pointed to B, flush
JRST .+1]
STORE(C,B,LINK)
SKIPE C
STORE(B,C,OTHER)
>
FOO(PND,PNU) ;DOWN
FOO(PNU,PND) ;UP
FOO(PNL,PNR) ;LEFT
FOO(PNR,PNL) ;RIGHT
;TEXT
MOVE B,DX1 ;OLD
MOVE A,LINING ;NEW
FETCH(T,A,PTXT) ;ANY TEXT ON NEW?
JUMPN T,LGTXT1 ;YES, KEEP IT
FETCH(T,B,PTXT)
CLEAR(B,PTXT)
STORE(T,A,PTXT) ;COPY TEXT TO NEW
MOVSI TTT,FIXTXT!FIXRHT ;COPY BITS ALSO
ANDCAM TTT,ADDR(A,PBIT)
AND TTT,ADDR(B,PBIT)
IORM TTT,ADDR(A,PBIT)
LGTXT1: FETCH(T,A,PLOC) ;ANY CON OR PIN ON NEW?
JUMPN T,LGTXT2 ;YES
MOVSI TTT,CPIN
TDNN TTT,ADDR(B,PBIT) ;CPIN ON OLD?
JRST LGTXT2 ;NO
ANDCAM TTT,ADDR(B,PBIT) ;YES, TURN OFF
IORM TTT,ADDR(A,PBIT) ;AND TURN ON IN NEW
FETCH(T,B,PLOC)
STORE(T,A,PLOC)
CLEAR(B,PLOC)
MOVSI TTT,FIXCON!CPNBTS
ANDCAM TTT,ADDR(A,PBIT)
AND TTT,ADDR(B,PBIT)
IORM TTT,ADDR(A,PBIT)
LGTXT2: PUSHJ P,DELPNL ;DELETE B=OLD POINT
MOVE A,LINING
SETZM LINING
TRO NEEDCL!MCHG
TRZ INLIN!INMOV
FETCH(TT,A,PXY)
PUSHJ P,PMOVX
JRST PMOVY
;BREAK JUNCTION OF 3 OR 4 LINES (D)
BREAKH: TRZA TFLG ;ZERO INDEX FOR HORZ
BREAKV: TRO TFLG ;20 INDEX FOR VERT
TRNN INLIN ;CAN'T BE INLIN
PUSHJ P,GETCLS
JRST PERRET
MOVE B,A
PUSHJ P,SETBTO ;SET MARK BITS FOR NON-EX NEIGHBORS
HLRZ F,F ;GET BITS
ANDI F,17 ;JUST LINE BITS
FETCH(T,B,PXY) ;SETUP FOR LIKELY CALL ON PNTPUT
XCT PERMIT(F) ;CHECK OK AND WHERE TO GO
TRZE INMOV ;SIMPLE CASES
TRO NEEDCL
TRO MCHG
PUSHJ P,PNTPUT ;D=NEW POINT
JRST (F)@[BRKNUP ;NO UP POINT
BRKNDN ;NO DOWN
BRKNRT ;NO RIGHT
BRKNLF] ;NO LEFT
DEFINE FOO(PNU,PND,PNR,PNL)
< FETCH(T,B,PNR) ;PICKUP LINK TO FOLLOW NEW POINT
CLEAR(B,PNR)
STORE(T,D,PNR) ;MAKE IT "RIGHT" OF NEW POINT
STORE(D,T,PNL) ;MAKE NEW "LEFT" OF IT
STORE(D,B,PNU) ;MAKE NEW "UP" OF OLD
STORE(B,D,PND) ;MAKE OLD "DOWN" OF NEW
POPJ P,
>
BRKNUP: FOO(PNU,PND,PNR,PNL) ;PLACE NEW UP OF OLD
BRKNDN: FOO(PND,PNU,PNR,PNL) ;PLACE " DOWN "
BRKNRT: FOO(PNR,PNL,PNU,PND) ;PLACE " RIGHT "
BRKNLF: FOO(PNL,PNR,PNU,PND) ;PLACE " LEFT "
WAY4: TRZE INMOV ;FLAGS
TRO NEEDCL
TRO MCHG
PUSHJ P,PNTPUT ;MAKE ANOTHER POINT THERE
FETCH(T,B,PNR) ;COPY OUR OLD RIGHT
STORE(T,D,PNR) ; MAKE THAT NEW POINT'S RIGHT
STORE(D,T,PNL)
CLEAR(B,PNR)
FETCH(T,B,PNU)
STORE(T,D,PNU) ;MAKE NEW POINT'S UP OUR OLD UP
STORE(D,T,PND)
CLEAR(B,PNU)
TRNN TFLG ;HOW TO CONNECT US?
JRST [ STORE(D,B,PNR) ;PUT NEW TO RIGHT
STORE(B,D,PNL)
POPJ P,]
STORE(D,B,PNU) ;PUT NEW POINT UP
STORE(B,D,PND)
POPJ P,
;CASES FOR BREAKING JUNCTION
PERMIT: JRST WAY4 ;_   ^ CAN'T CALL IT 4WAY
MOVEI F,0 ;_   NO UP
MOVEI F,1 ;_  ^ NO DOWN
MOVEI F,0 ;_  DO LIKE NO UP
MOVEI F,2 ;_  ^ NO RIGHT
JRST PERRET ;_ 
JRST PERRET ;_ ^
JRST PERRET ;_
MOVEI F,3 ;   ^ NO LEFT
JRST PERRET ;  
JRST PERRET ;  ^
JRST PERRET ; 
MOVEI F,2 ;  ^ DO LIKE NO RIGHT
JRST PERRET ; 
JRST PERRET ; ^
JRST PERRET
>;MD
;JUMP LINE TO OTHER SIDE OF CARD (PC)
MPC,<
LJUMP1: TLZA WFLAG ;USE WIRE LIST FLAG HERE
LJUMP2: TLO WFLAG ;AND HERE (WHOLE LINE)
TRZE INLIN!INMOV
TRO NEEDCL
PUSHJ P,GETCLS
JRST PERRET
PUSH P,A
HLRZ B,A
HRRZS A
TRZ TYPNEG
PUSHJ P,LSWITCH ;SWITCH THIS LINE AND IN ONE DIRECTION
POP P,A
TRZ TFLG
TRNE TYPNEG
TRO TFLG ;USE FEED THROUGH IF THERE
PUSHJ P,LSWA
TRO MCHG!NEEDCL
POPJ P,
LSWA: TLNN WFLAG ;ARE WE DOING WHOLE LINE
POPJ P,
FETCHL(T,A,PBIT)
TLNE T,ISPIN!CPIN
POPJ P, ;IMPOSSIBLE
TRNN TFLG
TLNN T,FEEDTH
CAIA
POPJ P,
FETCH(C,A,PNEB) ;CHECK FOR ONLY ONE SEGMENT LEAVING
SETZ B, ;NOW COUNT SEGMENTS FROM THIS POINT
LSWA1: MOVEI T,2
LSWA2: XCT (T)[HLRZ TT,(C)
HLRZ TT,1(C)
HRRZ TT,1(C)]
JUMPE TT,LSWA3
JUMPN B,CPOPJ ;MORE THAN ONE
MOVE B,TT
LSWA3: SOJGE T,LSWA2
HRRZ C,(C)
JUMPN C,LSWA1
JUMPE B,CPOPJ ;NO MORE SEGMENTS?
LSWITCH:PUSH P,A
PUSH P,B
PUSHJ P,KILSEG ;KILL SEGMENT ON THIS SIDE
MOVE A,(P)
MOVE B,-1(P)
PUSHJ P,KILSEG ;BOTH DIRECTIONS
MOVE A,-1(P)
TRZ TFLG
PUSHJ P,OPNT ;MAKE SURE OF POINT ON OTHER SIDE
SETZM -1(P) ;THIS POINT WAS DELETED
PUSH P,B ;SAVE ITS POINTER
MOVE A,-1(P) ;AND OTHER END
TRZE TFLG
TRO TYPNEG
PUSHJ P,OPNT
SETZM -1(P) ;THIS POINT WAS DELETED
PUSH P,B
MOVE D,-1(P)
PUSHJ P,MAKSEG ;NOW MAKE SEGMENT ON NEW SIDE
POP P,D
POP P,B
PUSHJ P,MAKSEG ;BOTH DIRECTIONS
POP P,A
POP P,(P)
JUMPN A,LSWA ;LOOP TO NEXT SEGMENT
POPJ P, ;POINT WAS FEED THROUGH, AND WAS DELETED
;LJUMP SUBRS (PC)
;CLEAR POINTER TO A FROM B
KILSEG: FETCH(B,B,PNEB)
PUSHJ P,FNDLNK
JRST KILLOS
XCT (T)[HRRZS (B)
HLLZS 1(B)
HRRZS 1(B)]
POPJ P,
KILLOS: PUSHJ P,FUCKUP
POPJ P,
;ADD POINTER TO D TO B
MAKSEG: MOVE T,B
PUSHJ P,FRLINK
XCT (T)PUTAB
POPJ P,
;OPNT
;FIND POINT ON OTHER SIDE, OR MAKE ONE, AND POSSIBLY DELETE ONE ONE THIS SIDE
;A = POINT
;RETURNS - SKIPS UNLESS POINT WAS DELETED
;B = POINT ON OTHER SIDE
;TFLG = WE MADE A FEEDTHRU
OPNT: FETCHL(B,A,PBIT)
TLNN B,FEEDTH ;FEEDTHRU TO OTHER SIDE?
JRST OPNT1
FETCH(TT,A,PFEED)
PUSH P,TT ;GET POINT ON OTHER SIDE
FETCH(TT,A,PNEB)
TLNN B,PLANES ;DON'T DELETE IF CONNECTED TO INNER PLANES
OPNTB: SKIPE 1(TT) ;DON'T DELETE IF STILL HAS LINES ON IT
JRST OPNTA
SKIPN TT,(TT)
JRST OPNTC ;ALL NULL SEGMENTS, OK TO DELETE
TLNE TT,-1
JRST OPNTA
JRST OPNTB
OPNTC: TLZ B,FEEDTH
STOREL(B,A,PBIT)
CLEAR(A,PFEED)
CLEAR(A,PIN) ;CLEAR PAD TYPE
HRRZ T,(P) ;POINT ON OTHER SIDE
CLEAR(T,PFEED) ;CLEAR POINTER BACK
CLRBIT(FEEDTH,TT,T,PBIT)
CLEAR(T,PIN) ;CLEAR PAD TYPE
HRRZ B,A
PUSHJ P,DELPNL ;DELETE ONE ON THIS SIDE
OPNTA: POP P,B ;AND RETURN POINTER TO ONE ON OTHER SIDE
POPJ P,
OPNT1: TLNN B,ISPIN
JRST OPNT2 ;GUESS WE HAVE TO MAKE ONE
FETCH(T,A,BPLOC) ;TRY TO FIND COPY OF PIN ON OTHER SIDE
FETCH(B,A,BBODY)
FETCH(B,B,BLNK) ;PIN LIST FROM BODY
OPNT3: CAIN B,(A) ;SKIP THE SAME PIN
JRST OPNT4
FETCH(TTT,B,BPLOC)
CAMN TTT,T
JRST CPOPJ1 ;SAME PIN IN DEF, IT MUST BE THE ONE
OPNT4: FETCH(B,B,BPLNK)
JUMPN B,OPNT3
PUSHJ P,FUCKUP ;NOT THERE?!!
POPJ P,
OPNT2: TLNN B,CPIN
JRST OPNT5
SWITCH
FETCH(TTT,A,PXY)
PUSHJ P,FIND.P ;TRY TO FIND CONNECTOR PIN ON OTHER SIDE
SWITCH
HRRZ B,D
JRST CPOPJ1
OPNT5: MOVE G,A
PUSHJ P,RDFEED ;MAKE FEED THROUGH
PUSHJ P,FUCKUP ;CAN'T BE IMPOSSIBLE
HRRZ B,D
TRO TFLG ;TELL THEM WE MADE THIS FEED THROUGH
JRST CPOPJ1
;DELETE LINE, DELETE WIRE
LINDEL: PUSHJ P,GETCLS ;CLOSEST LINE?
JRST PERRET
TRO MCHG!NEEDCL
FLSHLN: HLRZ B,A
FETCH(B,B,PNEB)
PUSHJ P,FNDLNK
POPJ P,
XCT (T)[CLRTAB:HRRZS (B)
HLLZS 1(B)
HRRZS 1(B)]
MOVS A,A
HLRZ B,A
FETCH(B,B,PNEB)
PUSHJ P,FNDLNK
POPJ P,
XCT (T)CLRTAB
POPJ P,
;DELETE WHOLE WIRE
LINDL2: PUSHJ P,GETCLS
JRST PERRET
TRO MCHG!NEEDCL
PUSHJ P,FLSHLN ;FLUSH LINE
HLRZM A,LINING ;SAVE ONE END HERE
HLLI A, ;CLEAR LEFT HALF
PUSHJ P,DELWIR ;DELETE THE WIRE
SKIPN A,LINING ;NOW THIS ONE
POPJ P,
DELWIR: FETCH(C,A,PNEB)
JUMPE C,DELWR1
SETZ TTT,
DELWRA: MOVEI T,2
DELWRB: XCT (T)[HLRZ TT,(C)
HRRZ TT,1(C)
HLRZ TT,1(C)]
JUMPE TT,DELWRC
JUMPN TTT,CPOPJ ;LEAVE IF SECOND
MOVE TTT,TT
DELWRC: SOJGE T,DELWRB
HRRZ C,(C)
JUMPN C,DELWRA
;DELETE WIRE BETWEEN A,C
MOVE C,TTT
DELWR1: FETCHL(TT,A,PBIT)
TLNN TT,FEEDTH ;FEED THROUGH?
JRST DELWR2
JUMPN C,CPOPJ ;2 THINGS, QUIT HERE
FETCH(C,A,PFEED) ;UNFEEDTHRU THE TWO POINTS
CLEAR(A,PFEED)
CLRBIT(FEEDTH,TTT,A,PBIT)
CLEAR(C,PFEED)
CLRBIT(FEEDTH,TTT,C,PBIT)
DELWR2: CAMN A,LINING
SETZM LINING ;NOTE WE DELETED THIS ONE
PUSH P,C
TRZ TFLG
MOVE B,A
PUSHJ P,DELPNL
POP P,A
JUMPN A,DELWIR
POPJ P,
;PUT MIDPOINT IN LINE (PC)
BENDL: PUSHJ P,GETCLS
JRST PERRET
MOVE T,CURSE ;WHERE TO PUT MIDPOINT
PUSHJ P,BENDLP
JFCL
POPJ P,
;ENTER HERE WITH LOCATION YOU WISH MIDPOINT TO BE PLACED IN T
;A = POINT1,,POINT2
;T = WHERE TO PUT MIDPOINT
BENDLP: PUSH P,A
PUSHJ P,PNTPUT
GETFS(E)
SETZM (E)
SETZM 1(E)
STORE(E,D,PNEB)
PUSH P,D
HLRZ A,-1(P)
HRRZ B,-1(P)
FETCH(B,B,PNEB)
PUSHJ P,FNDLNK ;FIND LINK FROM POINT2 TO POINT1
JRST [ OUTSTR[ASCIZ/MOBY LOSSAGE AT BENDL!
/]
SUB P,[2,,2]
POPJ P,]
TRO MCHG
MOVE D,(P)
XCT (T)PUTAB ;LINK POINT2 TO NEW-POINT
FETCH(B,A,PNEB)
HRRZ A,-1(P) ;FIND LINK FROM POINT1 TO POINT2
PUSHJ P,FNDLNK
PUSHJ P,FUCKUP ;LOSE BIG IF NOT FOUND
POP P,D
XCT (T)PUTAB ;LINK POINT1 TO NEW-POINT
FETCH(T,D,PNEB)
MOVE A,(P)
MOVEM A,1(T) ;LINK NEW-POINT TO BOTH
MOVE T,LSTPNT
PUSHJ P,SCLOSE ;SET CLOSES
POP P,(P) ;LOSE OLD CLOSEST
MOVEI T,PNTM ;MUST BE IN POINT MODE FOR THIS
PUSHJ P,CHNGMD
PUSHJ P,DOPMOV ;START MOVING MID-POINT
MOVEI T,BIGPG
AOS (P) ;INDICATE SUCCESS
JRST HYDPOG
;ATTACH POINT TO POINT (PC)
PATT: TRZE INMOV
JRST [ MOVE A,CLOSES ;USE THE ONE WE WERE MOVING
JRST PATT1]
TRNN INLIN
PUSHJ P,GETCLS
JRST PERRET
PATT1: MOVEM A,LINING
TRO INLIN!NEEDCL
PUSHJ P,GETCLS
JRST [ TRZ INLIN
TRO NEEDCL
JRST PERRET]
FETCH(T,A,PXY)
FETCHL(TT,A,PBIT)
TLNE TT,ISPIN!CPIN!FEEDTH
JRST [ EXCH A,LINING ;TRY IT THE OTHER WAY
FETCHL(TT,A,PBIT)
TLNN TT,ISPIN!CPIN!FEEDTH
JRST .+1
OUTSTR[ASCIZ/SORRY, BOTH ARE PINS OR FEEDTHROUGHS!
/]
TRZ INLIN
TRO NEEDCL
POPJ P,]
TLNN M,DSKACT!MACACT
OUTSTR[ASCIZ/
THIS ONE?/]
TRZ INLIN
MOVEM T,STARLOC
MOVEI T,UPSTAR
MOVEM T,SPDISP
MOVE T,[ASCID/AP/]
MOVEM T,SPMODT
MOVEI T,SPM
PUSHJ P,TCHNGM
PUSHJ P,YORN
JFCL
JFCL
TRO NEEDCL
PUSHJ P,RCHNGM
CAIE C,"Y"
CAIN C,"y"
CAIA
POPJ P,
PATTL: HRLM A,LINING ;POINT-TO-MOVE,,POSSIBLE PIN
HRRZ A,LINING
HLRZ C,LINING
FETCH(D,C,PNEB)
JUMPE D,NOMOVL
MOVE T,D
TLOOPS: SKIPE 1(T) ;CHECK FOR ANY NEIGHBORS TO COPY
JRST TLOOP0
SKIPN T,(T)
JRST NOMOVL
TLNN T,-1
JRST TLOOPS
TLOOP0: CLEAR(C,PNEB) ;MOVE NEIGHBORS ONTO IMMOVABLE POINT
FETCH(T,A,PNEB)
JUMPE T,[STORE(D,A,PNEB) ;WERE NONE, JUST STORE IN
JRST TLOOP9]
MOVE TT,T
HRRZ T,(T) ;NCONC TO OLD NEIGHBOR LIST
JUMPN T,.-2
HRRM D,(TT)
;NOW FIND ANY SEGMENTS BETWEEN THE TWO ATTACHING POINTS
TLOOP9: MOVE C,D ;OLD NEIGHBOR BLOCK
HRRZ D,LINING ;KEPT POINT
HLRZ A,LINING ;POINT GOING AWAY
TLOOP: MOVEI TTT,2
TLOOP1: XCT (TTT)[HLRZ B,(C)
HRRZ B,1(C)
HLRZ B,1(C)]
JUMPE B,TLOOPE
CAMN B,D ;DID THESE 2 POINT TO EACH OTHER?
JRST [ XCT (TTT)[HRRZS (C) ;YES, FLUSH THAT SEGMENT
HLLZS 1(C)
HRRZS 1(C)]
FETCH(B,B,PNEB) ;FIND BACK LINK
PUSHJ P,FNDLNK
JRST TLOOPE
XCT (T)[HRRZS (B)
HLLZS 1(B)
HRRZS 1(B)]
JRST TLOOPE]
FETCH(B,B,PNEB) ;CLOBBER BACK LINK THAT WAS TO OLD POINT
PUSHJ P,FNDLNK
CAIA
XCT (T)PUTAB ;MAKE IT POINT TO KEPT POINT
TLOOPE: SOJGE TTT,TLOOP1
HRRZ C,(C)
JUMPN C,TLOOP
NOMOVL: HRRZ A,LINING ;KEPT POINT
HLRZ B,LINING ;GOING AWAY POINT
FETCH(T,A,PTXT) ;ANY TEXT ALREADY ON KEPT POINT
JUMPN T,LOSTXT ;YES
FETCH(T,B,PTXT)
STORE(T,A,PTXT)
CLEAR(B,PTXT)
LOSTXT: HLRZ B,LINING
PUSHJ P,DELPNL
SETZM LINING
TRO MCHG!NEEDCL
TRZ INLIN!INMOV
POPJ P,
;ATTACH POINT TO LINE (PC)
LATT: MOVE A,CLOSES
TRZE INMOV ;STOP MOVING
JRST INATT
SETZM SAVP
TRNE INLIN
JRST INATT0
PUSHJ P,GETCLS
JRST PERRET
INATT: MOVEM A,SAVP ;THIS IS POINT WE WILL ATTACH TO
JUMPE A,INATT0
FETCHL(T,A,PBIT)
TLNE T,ISPIN!CPIN ;NOT THESE PLEASE!
JRST PERRET
INATT0: MOVEI T,LINM
PUSHJ P,TCHNGM
TRO NEEDCL
PUSHJ P,GETCLS
JRST [ PUSHJ P,RCHNGM
JRST ATTERR]
TLNN M,DSKACT!MACACT
OUTSTR[ASCIZ/THIS ONE/]
MOVEI T,UPSTAL
MOVEM T,SPDISP
MOVE T,[ASCID/AL/]
MOVEM T,SPMODT
MOVEI T,SPM ;SPECIAL POINTER MODE
PUSHJ P,TCHNGM
MOVE T,IPOINT
MOVEM T,STARLOC ;THIS IS LOC OF STAR
PUSHJ P,YORN
JFCL
JFCL
PUSHJ P,RCHNGM ;GET BACK OLD MODE
SKIPN T,SAVP
SKIPA T,IPOINT
MOVE T,1(T)
CAIE C,"y"
CAIN C,"Y"
PUSHJ P,BENDLP
JRST ATTERR
TRZ INMOV
SKIPN A,SAVP
JRST LATTL
MOVEM A,LINING
MOVE A,CLOSES
EXCH A,LINING ;MOVE POINT TO LINE!
JRST PATTL ;PATT DOES THE REST
LATTL: MOVE A,CLOSES
TRZ INLIN
TRO NEEDCL
JRST PNMNS1 ;MINUS TO MIDPOINT
ATTERR: SKIPN SAVP
TRO INLIN!NEEDCL
TRZ INMOV
JRST PERRET
>;MPC