github.com/PDP-10.its
1
0
Fork 0
mirror of https://github.com/PDP-10/its.git synced 2026-01-17 16:53:23 +00:00
Code Issues Releases Wiki Activity
PDP-10.its/src/draw/edit.500
Lars Brinkhoff 33074b453f SUDS - Stanford University Drawing System.
2018-05-05 19:19:09 +02:00

1482 lines
30 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>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
Reference in New Issue View Git Blame Copy Permalink