;<DRAW>EDIT.FAI.62, 15-NOV-75 18:04:18, EDIT BY HELLIWELL
VERSION(EDIT,6)
;ENTER EDIT MODE, SETDIP
MD,<
ENTEPN:	PUSHJ P,GETCLS
	 JRST PERRET
	FETCH(A,A,BTYP)
	JRST ALREAD		;SKIP "TYPE BODY NAME"

ENTEDC:	MOVEI T,[ASCIZ/TYPE BODY NAME
/]
	PUSHJ P,BODYGT		;GET POINTERS TO BODY STUFF
	 POPJ P,		;IF ALTMODE
	 POPJ P,		;NULL
	 CAIA			;NEW NAME
	  JRST ALREAD		;ALREADY EXISTS
	TLNN M,DSKACT!MACACT
	 OUTSTR[ASCIZ/NEW BODY. Tell me the package=?/]
	MOVEM B,BODNAM
BADPAK:	PUSHJ P,TREADU
	 POPJ P,
	 JRST NULPAK
	MOVE T,B
	PUSHJ P,MATPAK
	 JRST [	PUSHJ P,PUTFS
		OUTSTR [ASCIZ /I don't know that package???
Package=?/]
		JRST BADPAK]
	PUSHJ P,PUTFS
	SKIPA C,A
NULPAK:	 SETZ C,
	PUSHJ P,MAKTYP		;CREATE NEW TYPE BLOCK
	MOVE A,TT
	STORE(C,A,TPAK)
	MOVE B,BODNAM
	STORE(B,A,TNAM)
	MOVE TT,BODPNT
	STORE(TT,A,TNXT)
	MOVEM A,BODPNT		;ADD TO DEFINED TYPE LIST
ALREAD:	FETCH(T,A,TLIB)
	SKIPN MODLIB		;ALLOW MODIFICATION
	 JUMPN T,NOEDIT		;CAN'T EDIT FROM LIBRARY
	MOVEM A,CURBOD		;SAVE POINTER TO CURRENT BODY
	MOVE T,XOFF
	MOVEM T,EDXOFF
	MOVE TT,YOFF
	MOVEM TT,EDYOFF
	MOVE T,CURSE
	MOVEM T,EDCURS
	MOVE T,NSCALE
	MOVEM T,EDSCAL
	PUSHJ P,HOME		;CENTER EVERYTHING
	MOVE T,MODE
	MOVEM T,EDMODS
	MOVEI T,MAINPG-1	;CLEAR ALL THESE
	PUSHJ P,HYDPOG
	SOJG T,.-1
	TRO MCHG
	MOVEI T,EDTM	;GET NEW MODE (EDIT)
	JRST CHNGMD	;CHANGE MODE

NOEDIT:	OUTSTR[ASCIZ/I AM SORRY BUT YOU
CAN'T MODIFY LIBRARY BODIES!
/]
	POPJ P,

;CLEAR MARK BITS IN TYPE DEFINITION
CDFMRK:	SKIPN T,BODPNT
	 POPJ P,
CDFMK1:	FETCH(TTT,T,TYP1)	;ALL THE WAY IN?
	JUMPE TTT,CDFMK2
	CLRBIT(DTMP1,TT,T,TBIT)
CDFMK2:	FETCH(T,T,TNXT)
	JUMPN T,CDFMK1
	POPJ P,

;STUFF EITHER BODY DEF NAME OR DIP TYPE NAME INTO MACRO
STFLNM:	MOVE A,CURBOD
	JRST STTNAM

STFLDP:	MOVE A,CURBOD
	JRST STTDIP

SETDLC:	SKIPA B,[TLZE C,XDISLOC]	;INST TO CLEAR "DON'T DISPLAY" BIT
CLRDLC:	MOVE B,[TLON C,XDISLOC]		;INST TO SET		"
	MOVEI T,1
	LSH T,@MODE
	TDNN T,[ALLEDM!1EDTAM]
	 JRST PERRET
	MOVE A,CURBOD
	FETCHL(C,A,TBIT)
	XCT B			;TURN BIT ON OR OFF AND TEST
	TLNN M,BLOCS		;CHANGED, ARE WE DISPLAYING A01
	 CAIA			;NO
	  TRO MCHG		;YES
	STOREL(C,A,TBIT)
	POPJ P,
;ENTER INSERT MODE (BOTH WAYS)
EDINS2:	PUSHJ P,GETCLS
	 JRST PERRET
	MOVEM A,CLSTPN
	SETZM CRPPNT		;MAKE SURE WE DON'T ADD A POINT.
	FETCH(A,A,QNXT)
	TRZ ATLP!ATFP
	MOVEI T,EDTIM
	PUSHJ P,CHNGMD
	JUMPN A,EDBS
	TRO ATLP
	JRST EDBS		;BACK UP TO THE RIGHT POINT

EDINS:	MOVEI T,EDTIM		;GET NEW MODE (EDIT INSERT)
	PUSHJ P,CHNGMD
	MOVE A,CURBOD		;GET CURRENT BODY POINTER
	MOVEI B,RADDR(A,TLIN,QNXT)
	MOVEM B,CLSTPN		;LAST PTR
	FETCH(B,B,QNXT)		;GET POINTER TO FIRST LINE
	MOVEM B,CRPPNT
	TRO ATFP!TYPNEG!MCHG	;MARK AS AT FIRST POINT, AND MAKE FIRST VECTOR INVIS.
	TRZ ATLP		;ASSUME NOT A LAST POINT YET!
	JUMPN B,EDPOS		;VIRGIN LINE LIST?
	PUSHJ P,EDROT		;YES, MAKE A FIRST POINT
	STORE(T,A,QXY)
	CLEAR(A,QNXT)
	MOVE B,A
	HRRM B,@CLSTPN		;LINK IN
EDPOS:	SKIPN B,CRPPNT		;GET POINTER TO CURRENT POINT
	 POPJ P,		;NONE
	PUSHJ P,CLEAR1		;CLEAR THESE UNTIL DISP!
	PUSHJ P,CLEAR2
	FETCH(T,B,QXY)
	TRZE T,1
	 TRO TYPNEG		;INVISIBLE
	JRST SETPOS		;CENTER CURSOR THERE

EDROT:	MOVE T,CURSE		;GET CURRENT CURSOR POSITION
	TRZE TYPNEG		; - LAST?
	 TRO T,1		;YES
	GETFS (A)
	POPJ P,
EDROT1:	TRZE ATFP		;TURN OFF AT-FIRST-POINT. ARE WE?
	TRO T,1			;YES, MAKE INVISIBLE
	TRO MCHG
	STORE(T,A,QXY)
	MOVE B,CLSTPN		;GET POINTER TO CURRENT "LAST" (PRECEDING) POINT
	FETCH(T,B,QNXT)		;GET LINK TO NEXT
	STORE(T,A,QNXT)
	STORE(A,B,QNXT)		;LINK LAST ONE TO THIS ONE
	MOVEM A,CLSTPN		;MAKE THIS THE "LAST" ONE
	MOVEM T,CRPPNT		;MAKE NEXT ONE CURRENT
	FETCH(A,T,QXY)
	TRZ A,1
	TRNE TYPNEG	;SHOULD THIS ONE BE NEGATIVE?
	 TRO A,1
	STORE(A,T,QXY)
	POPJ P,
;INSERT MODE, PLUS, MINUS, SPACE, BS
EDPLUS:	PUSHJ P,EDROT
	JRST EDROT1

EDMINS:	PUSHJ P,EDROT
	TRO TYPNEG		;MAKE NEXT ONE AN INVISIBLE VECTOR
	JRST EDROT1

EDSPC:	TRNN ATLP		;AT LAST POINT?
	SKIPN B,CRPPNT		;GET POINTER TO CURRENT POINT
	POPJ P,			;NONE
	TRO MCHG
	TRZ ATFP!TYPNEG
	FETCH(T,B,QXY)
	ANDI T,1		;GET VISIBLE/INVISIBLE BIT
	IOR T,CURSE		;PUT IN CURRENT POSITION
	STORE(T,B,QXY)
	FETCH(D,B,QNXT)		;GET POINTER TO NEXT POINT
	HRRZM B,CLSTPN		;MAKE THIS POINT THE "LAST" POINT
	MOVEM D,CRPPNT		;MAKE NEXT POINT THE CURRENT POINT
	FETCH(D,D,QNXT)
	JUMPN D,EDPOS
	TRO ATLP		;AT LAST POINT NOW
	JRST EDPOS		;POSITION CURSOR

EDBS:	TRNE ATFP		;AT FIRST POINT?
	POPJ P,			;YES, DO NOTHING
	TRO MCHG
	TRZ ATLP!TYPNEG		;NO LONGER AT LAST POINT.
	MOVE A,CURBOD		;NO, GET POINTER TO BODY
	MOVEI B,RADDR(A,TLIN,QNXT)
	MOVE C,B		;SAVE IT
	MOVE D,B		;SAVE CURRENT ONE
	FETCH(B,B,QNXT)
	CAME B,CLSTPN		;ARE WE THERE?
	 JRST .-3		;NO, LOOP
	CAMN C,D		;NOW AT FIRST?
	 TRO ATFP!TYPNEG	;YES, SET BIT
	EXCH D,CLSTPN		;MAKE NEW ONE "LAST" ONE
	EXCH D,CRPPNT		;MAKE "LAST" ONE CURRENT ONE
	JUMPE D,EDBSOU		;IF FORMER CURRENT ONE DIDN'T EXIST, LEAVE
	FETCH(T,D,QXY)
	ANDI T,1		;GET VISIBLE/INVISIBLE BIT
	IOR T,CURSE		;GET CURRENT POSITION
	STORE(T,D,QXY)
EDBSOU:	HRRZ D,CRPPNT
	FETCH(D,D,QNXT)
	JUMPN D,EDPOS
	TRO ATLP
	JRST EDPOS	;POSITION CURSOR
;D, R+, R-
EDDELE:	PUSHJ P,GETCLS
	 JRST PERRET
	MOVE B,CURBOD
	MOVEI B,RADDR(B,TLIN,QNXT)
	MOVE C,B
	FETCH(B,B,QNXT)
	CAME B,A
	 JRST .-3
	FETCH(B,A,QNXT)
	STORE(B,C,QNXT)
	FSTRET (A)
	TRO MCHG!NEEDCL
	MOVE B,CURBOD
	FETCH(B,B,TLIN)
	JUMPE B,CPOPJ		;IF NO POINTS LEFT AT ALL, LEAVE
	MOVEI T,1
	IORM T,ADDR(B,QXY)	;MAKE SURE FIRST POINT IS STILL INVIS
	POPJ P,

EDDEL:	SKIPN B,CRPPNT		;GET POINTER TO CURRENT POINT
	 POPJ P,		;NONE
	MOVE A,CLSTPN		;GET POINTER TO PRECEDING POINT
	FETCH(D,B,QNXT)		;GET POINTER TO NEXT POINT
	STORE(D,A,QNXT)		;REMOVE CURRENT POINT FROM CONSIDERATION
	MOVEM D,CRPPNT		;....
	FSTRET (B)
	TRO MCHG
	JUMPE D,EDBS		;IF AT END, BACK UP
	MOVEI T,1
	TRNE ATFP		;AT FIRST POINT?
	IORM T,ADDR(D,QXY)	;YES, MAKE IT INVIS
	JRST EDPOS

EDCHNE:	PUSHJ P,GETCLS
	JRST PERRET
	MOVE B,A
	JRST EDCHN1

EDCHNG:	HRRZ B,CRPPNT		;GET POINTER TO CURRENT POINT
	JUMPE B,PERRET		;NONE?
EDCHN1:	PUSHJ P,GETCHR		;GET CHAR
	FETCH(D,B,QNXT)		;GET POINTER TO NEXT POINT
	JUMPE D,CPOPJ		;NONE?
	FETCH(T,D,QXY)
	CAIN C,"+"		;WAS + TYPED?
	 JRST ITPLS		;YES
	CAIE C,"-"		;WAS - TYPED?
	 JRST PERRET		;NO, ERROR
ITMNS:	TROA T,1		;MAKE INVISBLE
ITPLS:	TRZ T,1			;MAKE VISIBLE
	STORE(T,D,QXY)
	TRO MCHG
	POPJ P,
;P, N, EXIT EDIT MODE
EDPENT:	MOVEI T,EDTPM
	JRST CHNGMD

PNUMS:	PUSHJ P,GETCLS		;CURRENT PIN
	 JRST PERRET
	TLNN M,DSKACT!MACACT
	 OUTSTR[ASCIZ/NEW PIN NAME?/]
	FETCH(T,A,TPBIT)
	ANDI T,BASSLH		;DEFAULT L/H TO OLD VALUE
	PUSHJ P,PSET
	 JRST INNERR
	STORE(T,A,TPNAM)
	FETCH(T,A,TPBIT)
	TRZ T,BASSLH
	TRO T,(TT)
	STORE(T,A,TPBIT)
	TLNE M,PINIDS
	 TRO MCHG
	POPJ P,

SETORI:	PUSHJ P,GETCLS
	 JRST PERRET
STORI1:	TLNE M,DSKACT!MACACT
	 JRST STORI2
	OUTSTR[ASCIZ/CURRENT PIN POSITION IS /]
	FETCH(T,A,TPPOS)
	LDB T,[POINT POSW,T,POSB]
	PUSHJ P,DECOUT
	OUTSTR[ASCIZ/
NEW PIN POSITION # (0-7)?/]
STORI2:	PUSHJ P,READN
	CAIE C,12		;END WITH CR?
	 JRST [	CAIE C,"?"
		JRST INNERR
		PUSHJ P,GETLIN
		CAIE C,12
		JRST INNERR
		TVOFF
		TLNN M,DSKACT!MACACT
		OUTSTR[ASCIZ/
0	UP AND RIGHT		1	UP
2	UP AND LEFT		3	LEFT
4	DOWN AND LEFT		5	DOWN
6	DOWN AND RIGHT		7	RIGHT
/]
		TVON
		JRST STORI1]
	CAILE T,(1POSW)-1		;LEGAL?
	 JRST INNERR
	SETZ TT,			;CLEAR X,Y OFFSETS
	DPB T,[POINT POSW,TT,POSB]	;STORE HERE
	STORE(TT,A,TPPOS)
	TRO MCHG
	POPJ P,

;XYPOFF - SET PIN OFFSET
;UNITS ARE 1 CURSOR STEP

XYPOFF:	PUSHJ P,GETCLS
	 JRST PERRET
	TLNE M,DSKACT!MACACT
	 JRST XYPOF1
	OUTSTR[ASCIZ/CURRENT X,Y PIN OFFSET IS /]
	FETCH(T,A,TPPOS)
	LDB T,[POINT XOFFW,T,XOFFB]
	TRNE T,1(XOFFW-1)
	 ORCMI T,(1XOFFW)-1
	PUSHJ P,DECOUT
	OUTCHR[","]
	FETCH(T,A,TPPOS)
	LDB T,[POINT YOFFW,T,YOFFB]
	TRNE T,1(YOFFW-1)
	 ORCMI T,(1YOFFW)-1
	PUSHJ P,DECOUT
	OUTSTR[ASCIZ/
NEW X,Y PIN OFFSET?/]
XYPOF1:	PUSHJ P,SREADN
	CAIGE T,1(XOFFW-1)
	 CAMGE T,[-<1(XOFFW-1)>]
	  JRST INNERR
	HRLM T,(P)		;SAVE X
	SETZ T,
	CAIN C,","
	 PUSHJ P,SREADN
	CAIGE T,1(YOFFW-1)
	 CAMGE T,[-<1(YOFFW-1)>]
	  JRST INNERR
	CAIE C,12
	 JRST INNERR		;LOSE
	FETCH(TT,A,TPPOS)
	DPB T,[POINT YOFFW,TT,YOFFB]
	HLRE T,(P)
	DPB T,[POINT XOFFW,TT,XOFFB]
	STORE(TT,A,TPPOS)
	TLNE M,PINIDS		;IF SHOWING DEFAULT PINS
	 TRO MCHG		;THEN REDRAW SCREEN
	POPJ P,

STOBPN:	PUSHJ P,GETCLS
	 JRST PERRET
	MOVE T,A		;BODY PIN
	PUSHJ P,SETTT
	PUSH P,A
	PUSHJ P,OUTPID
	POP P,A
	JRST ITSTUF

EDALT:	TRO MCHG
	MOVEI T,EDTM
	JRST CHNGMD

;EDITE - EXIT BODY EDIT MODE
EDITE:	MOVE A,CURBOD
	FETCH(A,A,TPIN)
	JRST EDITE4

EDITE5:	PUSH P,A
	PUSHJ P,PSPRED		;SPREAD PIN NAMES OVER SAME PIN#S
	POP P,A
	FETCH(A,A,TPNX)
EDITE4:	JUMPN A,EDITE5
	MOVE T,EDMODS		;GET OLD MODE BACK
	PUSHJ P,CHNGMD		;CHANGE NOW IN CASE IN EDIT INSERT MODE
	MOVE T,EDXOFF
	MOVEM T,XOFF
	MOVE T,EDYOFF
	MOVEM T,YOFF
	MOVE T,EDSCALE
	MOVEM T,NSCALE
	TRO MCHG
	MOVE T,EDCURS	;BACK TO WHERE EVER
	JRST CHANGE

EDITP:	TLNN M,DSKACT!MACACT
	 OUTSTR [ASCIZ /PIN NAME?/]
	SETZ T,
	PUSHJ P,PSET
	 JRST INNERR
	TRO MCHG!NEEDCL
	PUSH P,TT
	PUSHJ P,PUTPIN	;MAKE PIN EVERYWHERE
	POP P,TT
	FETCH(T,A,TPBIT)
	TRO T,(TT)
	STORE(T,A,TPBIT)
	MOVE G,A
	JRST FIXPUT	;CALC INITIAL PIN OFFSET

;PSET - GET PIN NAME AND L/H
;T = DEFAULT L/H BIT, BUSSED
;RETURNS
;T = PIN NAME
;TT = NEW BITS

PSET:	HRLM T,(P)
	MOVE T,[PUSHJ P,GETLCH]
	MOVEM T,GTCHRX
	PUSHJ P,RPNAM		;GET PIN NAME INTO T
	 POPJ P,
	JUMPE T,CPOPJ		;DEFAULT PIN = 0 IS ILLEGAL
	HLRZ TT,(P)
DEC,<	CAIE C,"-"		;ASSERTION AFTER PIN NAME?
	 JRST NOASS
	TRZ TT,ASSL!ASSH
	PUSHJ P,GETLIN
	CAIE C,"H"+40
	CAIN C,"H"
	 JRST [	TRO TT,ASSH
		JRST NOASS1]
	CAIE C,"L"
	CAIN C,"L"+40
	CAIA
	 JRST NOASS
	TRO TT,ASSL
NOASS1:	PUSHJ P,GETLIN
NOASS:
>;DEC
	CAIE C,"/"
	 JRST NOBUSS
	TRZ TT,BUSSED
	PUSHJ P,GETLIN
	CAIE C,"B"
	CAIN C,"B"+40
	CAIA
	 JRST NOBUSS
	TRO TT,BUSSED
	PUSHJ P,GETLIN
NOBUSS:	CAIN C,12
	AOS (P)
	POPJ P,
;SPREAD PIN #'S OVER SAME PIN ID'S
;A = PIN
;CURBOD = TYPE

PSPRED:	FETCH(A,A,TPNAM)
	SKIPN B,DBODPN
	 POPJ P,
	PUSH P,A		;SAVE PIN NAME
PSPRD1:	MOVE A,CURBOD
	PUSHJ P,BODFNN
	 JRST PSPRD2
	POP P,(P)
	POPJ P,

PSPRD2:	FETCH(A,B,BLNK)
	SETZ F,
PSPRD3:	FETCH(T,A,BPLOC)	;PIN IN TYPE FROM BPOINT
	FETCH(TT,T,TPNAM)
	CAME TT,(P)		;SAME DEFAULT PIN NAME?
	 JRST PSPRD4
	MOVE F,A		;PIN CORRESPONDING TO DEFAULT NAME
	FETCHL(TT,T,TPBIT)
	TLNN TT,BUSSED		;IS IT BUSSED?
	 JRST PSPRD5
PSPRD4:	FETCH(A,A,BPLNK)	;YES, TRY TO FIND UNBUSSED PIN
	JUMPN A,PSPRD3
	JUMPE F,PSPRD1		;NOT ON THIS BODY?
PSPRD5:	FETCH(F,F,BPPN)		;PIN#
	FETCH(A,B,BLNK)
PSPRD6:	FETCH(TTT,A,BPLOC)	;PIN IN DEF
	FETCH(T,TTT,TPNAM)	;DEF PIN#
	CAMN T,(P)
	 STORE(F,A,BPPN)
	FETCH(A,A,BPLNK)
	JUMPN A,PSPRD6
	JRST PSPRD1
;PUTPIN - PLACE A PIN
;CURBOD = TYPE TO ADD PIN TO
;CURSE = X,Y LOC FOR PIN
;T = PIN NAME
;RETURNS
;A = PIN

PUTPIN:	MOVE A,CURBOD		;GET POINTER TO CURRENT TYPE
	PUSHJ P,MAKTPN		;GET NEW TYPE PINLOC BLOCK
	MOVE B,TT
	PUSH P,B
	FETCH(D,A,TPIN)		;PIN LIST FROM BODY
	STORE(D,B,TPNXT)	;LINK OUT FROM NEW PIN
	STORE(B,A,TPIN)		;LINK IN NEW ONTO TYPE
	STORE(T,B,TPNAM)	;PIN NAME
   ;FIND LARGEST PINID IN THIS TYPE, OR ELSE UNUSED PID
	MOVEI TT,1		;START AT 1
	MOVEI C,1		;FOR LARGEST ALSO
PTPIN1:	FETCH(T,B,TPNXT)
	JUMPE T,PTPIN3
PTPIN2:	FETCH(TTT,T,TPID)
	CAML TTT,C
	 MOVEI C,1(TTT)		;1 MORE THAN LARGEST PID
	CAMN TTT,TT
	 AOJA TT,PTPIN1		;USED, LOOK FOR ANOTHER
	FETCH(T,T,TPNXT)
	JUMPN T,PTPIN2
PTPIN3:
NIL,<	CAIG C,777777		;IS THERE A PIN# 777777 ?
	 MOVE TT,C		; NO, PICK PINID BIGGER THAN ALL OTHERS
				;FOR NOW, JUST REUSE PINIDS
>;NIL
	STORE(TT,B,TPID)
	MOVE T,CURSE		;GET CURRENT POSITION
	STORE(T,B,TPXY)		;DEPOSIT AS POSITION OF PIN

   ;NOW ADD PIN TO ALL BODY INSTANCES

	MOVE C,B		;HOLD POINTER TO PIN ENTRY IN TYPE
	MOVE B,DBODPN		;GET POINTER TO BODIES
BFRT:	PUSHJ P,BODFN		;FIND INSTANCES OF THIS TYPE
	 JRST BFNDD		;FOUND ONE
	POP P,A			;RETURN POINTER TO TYPE PINLOC BLOCK IN A
	POPJ P,			;NONE LEFT

BFNDD:	PUSH P,A		;SAVE TYPE
	FETCH(F,B,BORI)		;ORIENTATION
	FETCH(T,C,TPXY)		;GET PIN X,Y
	PUSHJ P,ORIENT		;ROTATE IT
	ADJUST(ADD,T,<ADDR(B,BXY)>)	;ADD BODY CENTER
	PUSH P,T
	MOVE A,C		;GET POINTER TO NEW TYPIN ENTRY IN TYPE
	HRLI B,ISPIN		;PUT BITS IN WITH BODY POINTER
	PUSHJ P,PUTPNT		;CREATE THE POINT
	POP P,T
	STORE(T,D,BPXY)		;SET X,Y
	FETCH(E,B,BLNK)		;GET PIN LINK
	STORE(E,D,BPLNK)	;OLD PIN LINK ONTO NEW POINT
	STORE(D,B,BLNK)		;NEW PIN
	FETCH(B,B,BNXT)
	FETCH(TT,A,TPNAM)	;DEFAULT NAME FROM TYPE PIN BLOCK
	POP P,A			;TYPE

   ;SCAN OTHER PINS OF BODY, LOOKING FOR ONES WITH SAME DEFAULT PIN NAME??

BFNDD1:	JUMPE E,BFRT
	FETCH(T,E,BPLOC)	;TYPE PINLOC BLOCK
	FETCH(T,T,TPNAM)	;DEFAULT NAME
	CAMN T,TT		;SAME AS NEW PIN?
	JRST BFNND2
	FETCH(E,E,BPLNK)
	JRST BFNDD1

BFNND2:	FETCH(T,E,BPPN)		;ASSIGNED PIN NAME
	STORE(T,D,BPPN)		;ASSIGN ON NEW PIN
	JRST BFRT

;BODFN - FIND BODIES OF A CERTAIN TYPE

BODFNA:	FETCH(T,B,BTYP)		;GET TYPE POINTER
	CAMN T,A		;BODY OF THIS TYPE?
	 POPJ P,			;YES, RETURN IT
BODFNN:	FETCH(B,B,BNXT)		;GET NEXT
BODFN:	JUMPN B,BODFNA
	AOS (P)			;FAIL
	POPJ P,

;UPDATE LOC OFFSET

UPLOFF:	MOVE A,CURBOD
	MOVEI B,DBODPN
UPLOF2:	PUSHJ P,BODFNN
	 JRST UPLOF1
	POPJ P,

UPLOF1:	FETCH(F,B,BORI)
	FETCHL(T,B,BBIT)
	TLNN T,FIXLOC!FIXBLO	;DOES IT WANT TO BE FIXED?
	 JRST UPLOF2
	FETCH(TTT,B,BLOC)
	JUMPE TTT,UPLOF2	;ANY LOCATION?
	TLNN T,FIXLOC		;FIXING LOC?
	 JRST UPLOF3
	FETCH(T,A,TXY)		;DEFAULT LOC OFFSET
	PUSHJ P,ORIENT
	STORE(T,B,BLXY)
UPLOF3:	MOVE T,B
	PUSH P,A
	PUSH P,B
	PUSHJ P,OFFBLO		;ADJUST LOC CHAR OFFSET
	POP P,B
	POP P,A
	JRST UPLOF2

ELCCLR:	TRZ INMOV
	MOVE A,CURBOD
	FETCH(B,A,TYP3)
	JUMPE B,CPOPJ
	CLEAR(A,TYP3)
	TLNE M,BLOCS
	 TRO MCHG
	POPJ P,
;DELETE PIN ON THE TYPE DEFINITION
EDPDEL:	PUSHJ P,GETCLS	;GET POINTER TO CLOSEST PIN
	 JRST PERRET
	MOVE C,A
	MOVE A,CURBOD	;GET POINTER TO CURRENT TYPE
	MOVEI D,RADDR(A,TPIN,TPNX)
			;LET THE POINTER LOSE FIRST TIME
EDPDL2:	CAMN D,C	;IS THIS THE ONE THAT POINTS TO THE CLOSEST ONE?
	 JRST EDPDL1	;YES
	MOVE B,D	;NO, TRY ANOTHER
	FETCH(D,D,TPNX)
	JUMPN D,EDPDL2
	PUSHJ P,FUCKUP
EDPDL1:	FETCH(D,C,TPNX)	;LINK OUT CLOSEST POINT
	STORE(D,B,TPNX)
	MOVEI B,PONPNT	;GET ON-SCREEN POINTER
	PUSHJ P,TPINFN	;FIND INSTANCES OF THIS PIN IN THE WORLD AND REMOVE THEM
	RETBLK(C,TYPIN)
	TRO MCHG!NEEDCL
	TRZ INMOV
	POPJ P,

;DELETE ALL POINTS THAT ARE INSTANCES OF PIN IN TYPE
;B = POINT LIST
;C = PIN IN DEF

TPNFN1:	FETCHL(F,B,PBIT)
	TLNN F,ISPIN
	 JRST TPINFN
	FETCH(F,B,BPLOC)
	CAMN F,C		;SAME AS PIN WE ARE DELETING?
	 PUSHJ P,DELPIN
TPINFN:	MOVE A,B		;SAVE LAST
	FETCH(B,B,PNXT)
	JUMPN B,TPNFN1
	POPJ P,

;DELPIN - DELETE A PIN
;B = BPOINT
;A = LAST PTR TO PREVIOUS POINT
;RETURNS LAST PTR IN B

DELPIN:	PUSH P,C		;SAVE OLD PIN BLOCK POINTER
	FETCH(C,B,BBODY)
	MOVEI C,RADDR(C,BLNK,BPLNK)
GOPN:	CAME C,B		;IS THIS THE POINT IN QUESTION
	 JRST GOPN1		;NO
	FETCH(D,C,BPLNK)
	STORE(D,E,BPLNK)
	TRO TFLG		;DELETE PINS OK!
	PUSH P,A		;LAST POINTER
	PUSHJ P,DELPNT
	POP P,B			;RESTORE LAST AS CURRENT
	JRST NTPNFN

GOPN1:	MOVE E,C
	FETCH(C,C,BPLNK)
	JUMPN C,GOPN
	PUSHJ P,FUCKUP
NTPNFN:	POP P,C			;RESTORE OLD PIN TYPE BLOCK POINTER
	POPJ P,
;GET -- G, SPACE
BODGET:	MOVEI T,[ASCIZ/TYPE BODY NAME
/]
	PUSHJ P,BODYGT	;GET BODY NAME & POINTER
	 POPJ P,		;ALTMODE
	 POPJ P,		;NULL NAME
	 JRST OOPS1
	CAMN A,CURBOD
	 JRST [	OUTSTR[ASCIZ/SORRY YOU CAN'T "GET" THE CURRENT BODY!!!
/]
		POPJ P,]
	MOVEM A,GETBOD	;CURRENT BODY WE ARE GETTING
	SETZM GETORT	;START WITH STANDARD ORIENTATION
	TRO MCHG
	MOVEI T,EDTGM	;SET MODE
	JRST CHNGMD

GETSPC:	AOS T,GETORT
	ANDI T,7
	MOVEM T,GETORT
	TRO MCHG
	POPJ P,
;GET -- Y
GETYES:	PUSH P,CURSE
	TRO MCHG
	MOVE G,GETBOD	;NEW BODY
	MOVE A,CURBOD		;CHECK FOR EMPTY BODY AND COPY NEW LOC
	FETCH(T,A,TLIN)
	JUMPN T,GETY1		;IF LINES, NO COPY
	FETCH(T,A,TPROP)
	JUMPN T,GETY1		;IF PROPS, NO COPY
	FETCH(T,A,TPIN)
	JUMPN T,GETY1		;IF PINS, NO COPY
	FETCH(T,A,TXY)
	JUMPE T,GETY1		;IF LOC OFFSET, NO COPY
	FETCH(T,A,TYP3)
	JUMPN T,GETY1		;IF LOC CHAR OFFSET, NO COPY
	FETCH(TTT,G,TXY)	;COPY LOC OFFSET
	ADJUST(ADD,TTT,<(P)>)	;ADD CURSOR POS
	STORE(TTT,A,TXY)
	FETCH(TT,G,TYP3)
	JUMPE TT,GETY1		;ANY CHAR OFFSET TO COPY?
	FETCH(TT,G,TOXY)
	STORE(TT,A,TOXY)
GETY1:	FETCH(G,G,TPIN)		;ANY PINS TO COPY ?
	JUMPE G,GNOPINS		;NONE
NEWPINS:FETCH(T,G,TPXY)
	MOVE F,GETORT
	PUSHJ P,ORIENT		;ORIENT IT
	ADJUST(ADD,T,<(P)>)	;ADD OFFSET
	MOVEM T,CURSE		;PUTPIN WILL LOOK HERE
	FETCH(T,G,TPNAM)	;COPY DEFAULT PIN NUMBER
	PUSHJ P,PUTPIN		;MAKE A PIN
	FETCH(T,G,TPPOS)
	MOVE TTT,F
	PUSHJ P,PINORI		;ROTATE PIN POS
	STORE(T,A,TPPOS)	;COPY PIN POS
	FETCH(T,G,TPBIT)
	STORE(T,A,TPBIT)	;COPY BITS TOO
	FETCH(G,G,TPNX)
	JUMPN G,NEWPINS		;ANOTHER?
;GET - COPY LINES
;FALLS THRU
GNOPINS:MOVE A,CURBOD		;CURRENT BODY
	MOVEI A,RADDR(A,TLIN,QNXT)
LOOPLN:	FETCH(B,A,QNXT)		;GET END OF LINE LIST
	JUMPE B,LOOPL1
	MOVE A,B
	JRST LOOPLN		;FOLLOW CHAIN

LOOPL1:	MOVE G,GETBOD		;NEW BODY
	FETCH(G,G,TLIN)
	JRST NXTLIN		;JUMP INTO LOOP

GMAKLN:	GETFS(TT)		;GET FREE STORAGE BLOCK FOR NEW LINE
	STORE(TT,A,QNXT)	;LINK ONTO LIST
	MOVE A,TT		;NEW END
	FETCH(T,G,QXY)		;NEW LINE END
	LDB TT,[POINT 1,T,35]	;SAVE VIS OR INVIS
	TRZ T,1
	MOVE F,GETORT
	PUSHJ P,ORIENT
	ADJUST(ADD,T,<(P)>)	;OFFSET IT
	DPB TT,[POINT 1,T,35]	;PUT BACK VIS OR INVIS
	STORE(T,A,QXY)
	FETCH(G,G,QNXT)
NXTLIN:	JUMPN G,GMAKLN
	CLEAR(A,QNXT)		;TERMINATE LIST
;GET TEXT
	MOVE H,CURBOD		;CURRENT BODY
	MOVE G,GETBOD		;NEW BODY
	FETCH(G,G,TPROP)	;COPY BODY TEXT ?
	JUMPE G,GETDON		; NONE
GBTEXT:	FETCH(T,G,TXNAM)
	JUMPE T,NPROP2		;ALWAYS COPY IF JUST TEXT
	FETCH(TTT,H,TPROP)
	JUMPE TTT,NPROP2	;COPY IF NO PROPERTIES YET
	MOVE A,H
	PUSHJ P,FPROPX
	 JRST NPROP2		;DOESN'T EXIST, COPY
	JRST NPROP1		;EXISTS, DON'T COPY

NPROP2:	PUSHJ P,MAKTXT
	MOVE B,TT		;NEW PROP BLOCK
	MOVE A,G		;OLD PROP BLOCK
	PUSHJ P,CPYPRP		;CARRY OVER OLD PROP
	FETCH(T,G,TXXY)
	MOVE F,GETORT
	PUSHJ P,ORIENT		;ORIENT IT
	ADJUST(ADD,T,<(P)>)	;OFFSET IT
	STORE(T,B,TXXY)	
	MOVE A,H		;TYPE
	PUSHJ P,ADDPRT		;ADD PROP, COMPILE, ALSO ADD INDIRECTS TO BODIES
NPROP1:	HRRZ G,(G)		;NEXT NEW BTEXT
	JUMPN G,GBTEXT
GETDON:	POP P,CURSE	;RESTORE CURSOR POS
GETALT:	TRO MCHG
	MOVEI T,EDTM	;BACK TO EDIT MODE
	JRST CHNGMD
;CALC PIN LOC'S AND THUS OFFSET #'S
;FIX ALL BODIES
FIXALL:	SKIPN H,BODPNT
	POPJ P,
FIXAL1:	FETCH(T,H,TLIB)		;LIBRARY POINTER
	SKIPN MODLIB		;ALLOW MODIFICATION?
	SKIPN T			;SKIP THESE, CAN'T FIX THEM
	 PUSHJ P,FIXSOM
	FETCH(H,H,TNXT)
	JUMPN H,FIXAL1
	POPJ P,

;FIX ALL PIN #'S OF THIS BODY
PALL:	MOVE H,CURBOD
;CALL WITH BODY DEF POINTER IN H
FIXSOM:	FETCH(G,H,TYP1)
	JUMPE G,CPOPJ		;QUIT IF BODY NOT IN YET!!!
	FETCH(G,H,TPIN)
	JUMPE G,CPOPJ
	PUSHJ P,CALSET
FIXSM1:	PUSHJ P,CALFIX
	FETCH(G,G,TPNX)
	JUMPN G,FIXSM1
	POPJ P,

;FIX PIN # OFFSET FOR CLOSEST PIN
FIXONE:	PUSHJ P,GETCLS
	 JRST PERRET
	MOVE G,A
FIXPUT:	MOVE H,CURBOD
	PUSHJ P,CALSET		;SET UP PIN CENTERS
;FALL INTO CALFIX

;H = body def pointer 
;G = pin pointer
; and center of mass in DX1, DY1
CALFIX:	PUSHJ P,CALP		;FIND HIS NUMBER
	SETZ T,			;CLEAR X,Y OFFSET FIRST
	DPB E,[POINT POSW,T,POSB]
	STORE(T,G,TPPOS)
	TRO MCHG
	POPJ P,


;CALP - best guess pin offset
;checks if pin is on a line of the definition, then returns L,R,U,D
; based upon pin's position with respect to body center
;H = BODY DEF POINTER  
;G = PIN POINTER 
;DX1 - AVERAGE OF ALL PIN X'S
;DY1 - 		"	  Y'S
;Returns
;F = Stub direction away from pin (only 1,3,5,7)
;E = Direction of pin name from pin

;F	Direction
;-      --------------------
;0	Up Right
;1	Up
;2	Up left
;3	Left
;4	Down left
;5	Down
;6	Down right
;7	Right

;	2  1  0
;	3     7
;	4  5  6

CALP:	FETCH(A,H,TLIN)		;ANY LINES ?
	JUMPE A,CALPQ
	PUSHJ P,CHKLIN
	 JRST CALPQ		;DESPERATION
	 JRST [	MOVE E,F   TRC E,4   JRST CALPA]	;MIDDLE LINE
	PUSH P,F		;SAVE THIS DIR
	PUSHJ P,CHKLI0		;LOOK FOR ANOTHER
	 JRST [ POP P,F   MOVE E,F   JRST CALPA]
	 JFCL
	POP P,E
	JRST CALPA

CALPQ:	MOVEI F,1		;TRY FOR HORIZONTAL STUB
	MOVEI E,5

;The general case : have 2 lines from this pin,
; try to put the stub on the convex side, and also
; away from the center of mass

CALPA:	SKIPN HORVER(F)		;F IS HOR/VERT?
	 JRST [	EXCH E,F
		SKIPN HORVER(F)	;NOW IS?
		 JRST OBLIQUE
		JRST .+1]
;Direction F is hor/ver, check cases of other direction
	SUB E,F
	TRC E,4		;PATCH
	ANDI E,7		;ANGLE BETWEEN LINES
	JRST @(E)[CALHV0
		CALHV1
		CALHV2
		CALHV3
		CALHV4
		CALHV5
		CALHV6
		CALHV7]

;Lines go in opposite directions, pick stub at right
;angles, away from center of mass
CALHV0:	ADDI F,2   	ANDI F,7
	MOVE E,F
	PUSHJ P,CHKMASS
	 TRC F,4	;OOPS, WAS TOWARDS C-MASS
;Pin is other way from stub if INSIDE, otherwise on one side
;or the other
	MOVE E,F
	TRC E,4
	SKIPN OUTSIDE
	 POPJ P,
TOSIDE:	MOVEI T,1(F)
	MOVEI TT,-1(F)
	JRST BESTOF		;PICK PRETTIER SIDE

CALHV1:	ADDI F,2   	ANDI F,7
	MOVE E,F
	PUSHJ P,CHKMASS
	 TRC F,4	;OOPS, WAS TOWARDS C-MASS
	CAMN E,F	;STUB IS ON CONCAVE SIDE?
	 JRST TOSIDE	; NO, BEST CHOICE THEN
	MOVEI E,1(F)	; YES, ONLY ONE CHOICE
	ANDI E,7
	POPJ P,

;Line meeting at 90 degrees, other 2 quadrants get pinname and stub
CALHV2:	MOVEI E,2(F)
	ANDI E,7
	MOVEI F,4(F)
	ANDI F,7
	PUSHJ P,CHKMASS
	 EXCH E,F
	POPJ P,

;Very acute angle
CALHV3:	TRC F,4
	MOVEI E,-2(F)
	ANDI E,7
	POPJ P,

;Both lines point the same way
; (this is also the case of a pin at the end of a single line)
CALHV4:	TRC F,4
	MOVEI T,1(F)
	MOVEI TT,-1(F)
	JRST BESTOF

;Very acute
CALHV5:	TRC F,4
	MOVEI E,2(F)
	ANDI E,7
	POPJ P,

;Lines meeting at 90 degrees
CALHV6:	MOVEI E,4(F)
	ANDI E,7
	MOVEI F,6(F)
	ANDI F,7
	PUSHJ P,CHKMASS
	 EXCH E,F
	POPJ P,

;Almost flat angle, try to put stub on convex side
CALHV7:	MOVEI F,6(F)
	ANDI F,7
	MOVE E,F
	PUSHJ P,CHKMASS
	 TRC F,4
	CAMN E,F
	 JRST TOSIDE
	MOVEI E,-1(F)
	ANDI E,7
	POPJ P,

;OBLIQUE cases, do best you can
OBLIQUE:	
	CAIN F,2		;TRY TO GET 2 DIR IN F
	 JRST OBLIQ1
	EXCH F,E
	CAIN F,2
	 JRST OBLIQ1	
	CAIN E,4		;BUT IF CAN'T AT LEAST THE 4
	 EXCH E,F
OBLIQ1:	SUB E,F
	TRC E,4		;PATCH
	ANDI E,7		;ANGLE BETWEEN LINES
	JRST @(E)[CALHQ0
		CALHQ1
		CALHQ2
		CALHQ3
		CALHQ4
		CALHQ5
		CALHQ6
		CALHQ7]

;Lines are opposed to each other, make stub horizontal
CALHQ0:	MOVEI F,7
	MOVEI E,3
	PUSHJ P,CHKMASS
	 EXCH E,F
	POPJ P,

;shouldn't happen
CALHQ1:
CALHQ3:
CALHQ5:
CALHQ7:	PUSHJ P,FUCKUP
	POPJ P,

;Lines meeting at a Vee, stub goes away from tip
CALHQ2:	MOVEI F,3(F)
	ANDI F,7
	JRST TOSIDE

;Two oblique lines overlapping each other
CALHQ4:	MOVE E,F
	TRC E,4
	CAIE F,2
	CAIN F,4
	 JRST [	MOVEI F,7 	POPJ P,]
	MOVEI F,3
	POPJ P,

;Lines meeting at other Vee
CALHQ6:	MOVEI F,-3(F)
	ANDI F,7
	JRST TOSIDE
	
;Try to get pin position in upper right, as much
;as possible

BESTOF:	ANDI T,7
	ANDI TT,7
	MOVE E,T
	SKIPLE BESDIR(E)
	 POPJ P,
	MOVE E,TT
	SKIPLE BESDIR(E)
	 POPJ P,
	SKIPGE BESDIR(E)
	 MOVE E,T
	POPJ P,

BESDIR:	1
	1
	0
	-1
	-1
	-1
	0
	1

;CHKMASS - see if direction (F) from pin is away from
; the center of mass

CHKMASS:
	FETCH(T,G,TPX)
	FETCH(TT,G,TPY)		;GOING ...
	XCT (F)[CAML T,DX1	; UP, RIGHT
		CAML TT,DY1	; UP
		CAMG T,DX1	; UP, LEFT
		CAMG T,DX1	; LEFT
		CAMG T,DX1	; DOWN, LEFT
		CAMG TT,DY1	; DOWN
		CAML T,DX1	; DOWN, RIGHT
		CAML T,DX1]	; RIGHT
	 AOS (P)
	POPJ P,

; - vertical, + horizontal

HORVER:	0
	-1
	0
	1
	0
	-1
	0
	1
;CHKLIN - see if pin is on a line of body definition
;A = list of body lines
;G = body pin
;RETURNS
;	- fail, not on any line
;	- On vert/horz line (not on ends)
;	- On end of line
;F = direction of line from pin
;A = start of line
;(B = end of line)

CHKLI0:	FETCH(A,A,QNXT)		;CONTINUE SEARCH
	JUMPE A,CPOPJ
CHKLIN:	FETCH(B,A,QNXT)
	JUMPE B,CPOPJ		;SINGLE POINT, NO LINE
	FETCH(T,B,QXY)
	TRNE T,1		;LINE VISIBLE?
	 JRST CHKLI0
	XOR T,ADDR(A,QXY)
	TLNE T,-2		;IS THIS A VERT LINE?
	 JRST NVERT
	TRNN T,-2		;BUT NOT 0 LENGTH
	 JRST CHKLI0
;Line is vertical, check if pin is on it
	FETCH(T,G,TPXY)
	XOR T,ADDR(A,QXY)
	TLNE T,-2		;AND POINT IS ON IT?
	 JRST CHKLI0
	MOVEI F,1		;SAY "UP"
	FETCH(T,A,QY)
	FETCH(TT,B,QY)
	FETCH(TTT,G,TPY)
;Pin is colinear with line, check direction and where on line
CHKHVR:	CAMGE TT,T		;2nd point higher?
	 TRC F,4		; NO, SAY "DOWN"
	CAMN TTT,T
	 JRST CPOPJ2		;AT END OF LINE
	CAMN TTT,TT		;OR AT OTHER END
	 JRST [	TRC F,4  JRST CPOPJ2]
	CAML T,TT
	 EXCH T,TT		;SMALLER COORD IN T
	CAML TTT,T		;OFF BOTTOM?
	CAMLE TTT,TT		;OR OFF TOP?
	 JRST CHKLI0		; TRY ANOTHER
	JRST CPOPJ1		; RETURN "ON THE LINE"

NVERT:	TRNE T,-2		;HORIZ LINE?
	 JRST NHORZ
;Line is horizontal, check if pin is on it.
	FETCH(T,G,TPXY)
	XOR T,ADDR(A,QXY)
	TRNE T,-2		;AND POINT IS ON IT?
	 JRST CHKLI0
	MOVEI F,7		;SAY "RIGHT"
	FETCH(T,A,QX)
	FETCH(TT,B,QX)
	FETCH(TTT,G,TPX)
	JRST CHKHVR

NHORZ:	FETCH(T,A,QXY)
	XOR T,ADDR(G,TPXY)	;PIN ON START OF THIS LINE?
	TDNN T,[-2,,-2]
	 JRST [	PUSHJ P,CHKQUA   JRST CPOPJ2]
	FETCH(T,B,QXY)
	XOR T,ADDR(G,TPXY)	;PIN ON END?
	TDNE T,[-2,,-2]
	 JRST CHKLI0
	EXCH A,B
	PUSHJ P,CHKQUA		;DIRECTION OF LINE FROM POINT
	EXCH A,B
	JRST CPOPJ2

;CHKQUA - compute which direction the line (A) is leaving the point

CHKQUA:	FETCH(T,B,QX)
	FETCH(TTT,G,TPX)
	SUB T,TTT
	FETCH(TT,B,QY)
	FETCH(TTT,G,TPY)
	SUB TT,TTT
	JUMPE T,[		;DEL-X = 0
		MOVEI F,1	; UP
		SKIPG TT
		 MOVEI F,5	;DOWN
		POPJ P,]
	JUMPG T,[		;DEL-X = +
		MOVEI F,7
		JUMPE TT,CPOPJ
		MOVEI F,0
		SKIPG TT
		 MOVEI F,6
		POPJ P,]
	;DEL-X IS -
	MOVEI F,3
	JUMPE TT,CPOPJ
	MOVEI F,2
	SKIPG TT
	 MOVEI F,4
	POPJ P,


ifn 0,<
;old calp
;CALP - best guess pin offset
;checks if pin is on a line of the definition, then returns L,R,U,D
; based upon pin's position with respect to body center
;H = BODY DEF POINTER  
;G = PIN POINTER 
;DX1 - AVERAGE OF ALL PIN X'S
;DY1 - 		"	  Y'S
;Returns (skip if pin was on a line)
;E = Stub direction away from pin
;F = Direction of pin name from pin

;F	Direction
;-      --------------------
;0	Up Right
;1	Up
;2	Up left
;3	Left
;4	Down left
;5	Down
;6	Down right
;7	Right

CALP:	FETCH(B,H,TLIN)
	JUMPN B,CALP1
	POPJ P,

CALP2:	FETCH(T,B,QXY)
	TRNE T,1		;INVIS?
	 JRST CALP1		;YES, TRY ANOTHER
	XOR T,ADDR(A,QXY)	;OTHER END OF LINE
	TLNE T,-2		;VERT?
	 JRST NVERT		;NO
	TRNN T,-2		;ZERO LENGTH SEG?
	 JRST CALP1		;YES, IGNORE IT
	FETCH(T,G,TPXY)		;LINE IS VERT
	XOR T,ADDR(A,QXY)
	TLNE T,-2		;PIN ON SAME LINE?
	 JRST CALP1		;NO
	FETCH(T,G,TPX)
	HRRES T
	CAMLE T,DX1		;COMPARE WITH CENTER OF ALL PINS
	 SKIPA F,[3]		;RIGHT
	 MOVEI F,7		;LEFT
	FETCH(T,A,QY)
	FETCH(TT,G,TPY)
	FETCH(TTT,B,QY)
	JRST DELCAL

NVERT:	TRNE T,-2		;HORZ?
	 JRST CALP1		;ZERO LENGTH
	FETCH(T,G,TPXY)
	XOR T,ADDR(A,QXY)
	TRNE T,-2		;Y'S SAME - PIN ON LINE?
	 JRST CALP1		;NO
	FETCH(T,G,TPY)
	CAMLE T,DY1
	 SKIPA F,[5]		;UP
	 MOVEI F,1		;DOWN
	FETCH(T,A,QX)
	FETCH(TT,G,TPX)
	FETCH(TTT,B,QX)
DELCAL:	SUB T,TTT
	SUB TT,TTT
	JUMPG TT,NNEG
	JUMPGE T,CALP1		;OFF END?
	CAML T,TT
	 JRST CALP1
	JRST CPOPJ1

NNEG:	JUMPLE T,CALP1
	CAMLE T,TT
	 JRST CPOPJ1
CALP1:	MOVE A,B
	FETCH(B,B,QNXT)
	JUMPN B,CALP2
	POPJ P,		;LOSE RETURN
>;ifn 0,


;CALPIN - GET POS OF PIN (G)

CALPIN:	PUSH P,A
	PUSH P,B
	PUSH P,E
	FETCH(H,G,BBODY)
	FETCH(H,H,BTYP)
	FETCH(G,G,BPLOC)
	PUSHJ P,CALP
	POP P,E
	JRST POPBAJ
		
;CALSET - CALCULATE APPROX CENTER OF SET OF PINS
;H = BODY DEF POINTER 
;RETURNS WITH:
;DX1 - (MAX+MIN)/2 OF ALL PIN X'S AND LINE ENDPOINT'S X'S
;DY1 - 		"	      Y'S
CALSET:	HRLOI T,377777
	MOVEM T,DX3
	MOVEM T,DY3
	MOVSI T,400000
	MOVEM T,DX1
	MOVEM T,DY1
	FETCH(T,H,TPIN)		;FIRST CHECK EXISTING PINS
	SKIPE T
	 PUSHJ P,CALST2
	FETCH(T,H,TLIN)		;NOW CHECK LINES
	SKIPE T
	 PUSHJ P,CALST2
	MOVE T,DX1
	ADD T,DX3
	ASH T,-1
	MOVEM T,DX1
	MOVE T,DY1
	ADD T,DY3
	ASH T,-1
	MOVEM T,DY1
	POPJ P,

CALST2:	FETCH(TT,T,QX)
	CAMGE TT,DX3
	 MOVEM TT,DX3
	CAMLE TT,DX1
	 MOVEM TT,DX1
	FETCH(TT,T,QY)
	CAMGE TT,DY3
	 MOVEM TT,DY3
	CAMLE TT,DY1
	 MOVEM TT,DY1
CALST1:	FETCH(T,T,QNXT)
	JUMPN T,CALST2
	POPJ P,
;DELETE TYPE
TYPDEL:	MOVEI T,1
	LSH T,@MODE
	TDNE T,[ALLEDM!1EDTAM]	;ANY EDIT MODE?
	 JRST PERRET		;YES, ILLEGAL
	MOVEI T,[ASCIZ/TYPE BODY NAME
/]
	PUSHJ P,BODYGT
	 POPJ P,		;ALTMODE
	 POPJ P,		;NULL
	 JRST OOPS1		;NO SUCH BODY
	TLZ WFLAG		;DON'T QUIT IF YOU FIND ONE
TYPFLU:	PUSH P,A		;SAVE TYPE POINTER
	MOVEI A,DBODPN
	 JRST TYPDL1
TYPDL2:	FETCH(T,A,BTYP)
	CAME T,(P)
	 JRST TYPDL1
	TLNE WFLAG
	JRST [	POP P,A
		POPJ P,]	;QUIT IF WFLAG SET (WE WANT IT!)
	PUSH P,B
	PUSHJ P,BDELETE		;DELETE BODY
	POP P,A			;RESTORE LAST AS CURRENT
TYPDL1:	MOVE B,A
	FETCH(A,A,BNXT)
	JUMPN A,TYPDL2
	SKIPE MODLIB
	 JRST TCLEAR
	MOVE T,(P)
	FETCH(T,T,TLIB)
	JUMPE T,TCLEAR
	OUTSTR[ASCIZ/ALL INSTANCES OF THIS BODY HAVE BEEN
DELETED, BUT THE TYPE MUST REMAIN
AS IT IS PART OF A LIBRARY!
/]
	POP P,A
	POPJ P,

TCLEAR:	MOVEI A,BODPNT-1
	JRST TYPDL6

TYPDL4:	CAMN A,(P)
	 JRST TYPDL5
TYPDL6:	MOVE B,A
	FETCH(A,A,TNXT)
	JUMPN A,TYPDL4
	POP P,A
	PUSHJ P,FUCKUP
	POPJ P,			;SHOULDN'T HAPPEN.

TYPDL5:	FETCH(C,A,TNXT)
	STORE(C,B,TNXT)		;LINK HIM OUT
	POP P,A			;GET BACK POINTER
	JRST TYPREL		;RELEASE STORAGE
;DELETE LIBRARY
DELLBS:	TLOA WFLAG		;SAVE USED ONES
DELLIB:	TLZ WFLAG		;DON'T SAVE THEM
	TLNN M,DSKACT!MACACT
	 OUTSTR[ASCIZ/LIBRARY /]
	MOVSI T,EXTLIB
	PUSHJ P,SETNAM
	 POPJ P,		;IF HE HOLLER, LET HIM GO!
	ENTPPN
	MOVEI TT,LIBLST
	MOVE A,FILNAM
	HLLZ B,FILEXT
	MOVE C,FILPPN
	JRST LIBLP1
LIBLP2:	CAME A,1(TT)
	 JRST LIBLP1
	HLRZ TTT,(TT)
	CAME C,1(TTT)
	 JRST LIBLP1
	HLLZ TTT,(TTT)
	CAMN TTT,B
	 JRST FNDLIB
LIBLP1:	MOVE T,TT
	HRRZ TT,(TT)
	JUMPN TT,LIBLP2
	OUTSTR[ASCIZ/SORRY, NO SUCH LIBRARY!
/]
	POPJ P,

FNDLIB: HRRZ TTT,(TT)
	HRRM TTT,(T)		;LINK THIS LIBRARY OUT
	PUSH P,TT		;SAVE POINTER
	SKIPN A,BODPNT
	 JRST FNDLBE
FNDLB1:	FETCH(B,A,TNXT)		;GET LINK AHEAD
	FETCH(T,A,TLIB)
	CAME T,(P)		;THIS ONE
	 JRST FNDLB2		;NO
	PUSH P,B
	CLEAR(A,TLIB)		;CLEAR POINTER SO WE CAN DELETE
	PUSHJ P,TYPFLU		;DELETE THIS TYPE
	POP P,B
FNDLB2:	MOVE A,B		;NEXT
	JUMPN A,FNDLB1
FNDLBE:	POP P,A
	HLRZ B,(A)
	FSTRET(A)
	FSTRET(B)
	POPJ P,
;RSPINI	RESET PINIDS CANONICALLY FROM DEFAULT PIN NAMES

RSPINI:	MOVE T,MODE
	CAIE T,EDTM		;MUST BE IN NORMAL EDIT MODE
	 JRST ERRET
	OUTSTR [ASCIZ /
This little known command can royally screw any file using this body,
 do you really wan't to reassign PINID's/]
	PUSHJ P,YORN
	 POPJ P,
	 POPJ P,
  ;CHECK IF TYPE IS IN USE
	MOVE A,DBODPN
	HRRZ C,CURBOD		;POINTER TO BODY DEFINITION
RSPIN2:	FETCH(B,A,BTYP)
	CAIN B,(C)
	 JRST RSPIN1		;TYPE IS IN USE
	FETCH(A,A,BNXT)
	JUMPN A,RSPIN2		;LOOP
	FETCH(C,C,TPIN)
	MOVE D,C		;SAVE IN D
  ;RESET PIN ID'S FROM PIN NAMES
	MOVEI B,100.		;GET LARGEST PIN NAME VALUE IN USE IN B
RSPIN3:	FETCH(T,C,TPBIT)
	TRNE T,BUSSED		;DON'T RESET BUSSED YET
	 JRST [	CLEAR(C,TPID)	;MARK, AND FIX LATER
		JRST RSPIN5]
	FETCH(T,C,TPNAM)
	CAIGE B,(T)		;SKIP IF LE THAN BIGGEST SO FAR
	 MOVEI B,(T)		;NEW BIGGEST PIN NAME
	STORE(T,C,TPID)		;SO COPY PIN NAME TO PIN ID
RSPIN5:	FETCH(C,C,TPNX)
	JUMPN C,RSPIN3		;LOOP IF MORE PINS
  ;BUSSED THRU PINS MUST HAVE DIFFERENT PINIDS, BUT PINID mod OLDMAX = PIN-NAME
RSPIN8:	FETCH(T,D,TPBIT)
	TRNN T,BUSSED		;BUSSED THROUGH PIN ?
	 JRST RSPIN9
	FETCH(TT,D,TPID)
	JUMPN TT,RSPIN9		;ONE WE'VE FIXED ALREADY
	PUSH P,B
	PUSH P,D		;SEE IF THERE IS AN IDENTICAL BUSSED BIN LATER
	FETCH(T,D,TPNAM)
	PUSH P,T
RSPINB:	FETCH(TT,D,TPBIT)
	FETCH(T,D,TPNAM)
	CAMN T,(P)		;SKIP IF NOT SAME PIN NAME
	TRNN TT,BUSSED
	 JRST RSPINC		;NOT BUSSED THROUGH OR NOT SAME PIN NAME
	FETCH(T,D,TPNAM)
	ADD T,B
	STORE(T,D,TPID)
	ADD B,-2(P)		;NEXT MULTIPLE OF 100. (OR MAX)
RSPINC:	FETCH(D,D,TPNX)
	JUMPN D,RSPINB
RSPINA:	SUB P,[1,,1]
	POP P,D
	POP P,B
RSPIN9:	HRRZ D,(D)		;NEXT PIN LIST BLOCK
	JUMPN D,RSPIN8		;LOOP IF MORE PINS
	TRO MCHG		;ALL DONE
	POPJ P,

RSPIN1:	OUTSTR [ASCIZ /CAN'T CHANGE PINIDS - BODY IN USE IN DRAWING
/]
	POPJ P,


>;MD