perm filename GEOMED[LSP,BGB] blob sn#043275 filedate 1973-05-19 generic text, type T, neo UTF8
COMMENT ⊗   VALID 00039 PAGES 
RECORD PAGE   DESCRIPTION
 00001 00001
 00006 00002	TITLE GEOMED  -  GEOMETRIC EDITOR  -  BGB  -  JANUARY 1973.
 00008 00003	START ADDRESS INITIALIZATION-------------------------------------
 00010 00004	SUBR(UNDERFLOW)---------------------------------------------------
 00013 00005	SUBR(GEODPY)------------------------------------------------------
 00014 00006	SUBR(STADPY)------------------------------------------------------
 00016 00007	TRANSLATION STRENGTH.
 00018 00008	DISPLAY THE SCRATCH PAD PDL.
 00020 00009	SUBR(NTYPE)NODE --------------------------------------------------
 00022 00010	NODE RELLOCATION BITS.
 00024 00011	SUBR(DPYNODE)NODE ------------------------------------------------
 00025 00012	L1:
 00027 00013	SUBR(GEOMED)------------------------------------------------------
 00029 00014	ASCII 00 TO 37--------------------------------------------------
 00032 00015	ASCII 40 TO 100-------------------------------------------------
 00035 00016	ASCII 101 TO 132 UPPER CASE-------------------------------------
 00038 00017
 00039 00018	1. "V"-COMMAND.  MAKE VERTEX BODY.
 00040 00019	SUBR(MIDPOI)------------------------------------------------------
 00042 00020	2. "E"-COMMAND. SWEEP WIRE.
 00043 00021	3. "J"-COMMAND. JOIN VERTICES.
 00045 00022	4. ":()-*" COMMANDS. EUCLIDEAN TRANSFORMATION COMMANDS.
 00047 00023	MAKE REFERENCE FRAME.
 00049 00024	APPLY THE TRANSFORMATION.
 00050 00025	WINDOW TRANFORMATION.
 00051 00026	5. SWITCH MODIFYING COMMANDS.
 00053 00027	6. STACK MODIFYING COMMANDS.
 00055 00028	"/" COMMAND.-----------------------------------------------------
 00057 00029	XFOCAL:	OUTSTR[ASCIZ/	FOCAL = /]↔CALL(REALIN)
 00058 00030	REALIN: ---------------------------------------------------------
 00060 00031	8. SWEEP COMMANDS.
 00062 00032	SUBR(XKILL)-------------------------------------------------------
 00064 00033	9. LINK FOLLOWING COMANDS.
 00066 00034	OTHER LINK COMMANDS.
 00068 00035	SUBR(XNAME) ------------------------------------------------------
 00071 00036	SUBR(MACRO)-------------------------------------------------------
 00073 00037	XDPY: -----------------------------------------------------------
 00075 00038	XBIN: -----------------------------------------------------------
 00077 00039	XTEXT:	CDR 1,PDLPTR
 00078 ENDMK
⊗;
TITLE GEOMED  -  GEOMETRIC EDITOR  -  BGB  -  JANUARY 1973.

;EDITOR STATUS.

	INTERNAL PDL,PDLPTR
	PDL:BLOCK =500		;GEOMED'S INTERNAL STACK.
	PAT:BLOCK 40↔INTERN PAT
	PDLPTR:XWD -100,PADPDL	;GEOMED'S GRAPHICS STACK.
	PADPDL:BLOCK 100
	↓PTR←←16		;PADPDL STACK POINTER AC.

;JUMP TABLE COMMAND SCANNER STATUS.

	DECLARE{CHR,MCBITS,CTRL,META,MTCT,ALPHA,BETA}

;STRENGTH OF EUCLIDEAN TRANSFORMATION.

	TDEL:	1.0	;TRANSLATION DELTA STRENGTH.
	RDEL:	0.785398;ROTATION DELTA STRENGTH.
	DDEL:	0↔0.75	;DILATION DELTA STRENGTH.

	OPERAT:	0	;DEFAULT EUCLIDEAN OPERATION.
	FRAAM:	0	;FRAME OF REFERENCE.
	FRMORG:	0	;USE FRAME OF REFERENCE ORIGIN.
	AXECNT:	1	;NUMBER OF AXES TO USE.
	ITERAT:	0	;NUMBER OF ITERATIONS.

	FLAGL:	-1	;"L" COMMAND SWITCH. LABEL LIGHTS.
	FLAGD:	0	;"∂" NODE DISPLAY.
	DPYFLG:	2	;GEODPY STICKY DISPLAY MODE.

;WING OPERATIONS.
	EXTERN MKB,MKF,MKE,MKV,MKFRAME
	EXTERN KLB,KLF,KLE,KLV,WING
	EXTERN WING,LINKED
	EXTERN ECW,ECCW,OTHER,OTHER.
	EXTERN BGET,FCW,FCCW,VCW,VCCW
;EULER OPERATIONS.
	EXTERN MKEV,MKFE
	INTERN CAMERA↔CAMERA:0
	WORLD:0
	WINDOW:0
	EXTERN KLNODE,UNIVER,OLD44,AVAIL
;START ADDRESS INITIALIZATION-------------------------------------
SA:	JFCL↔SETOM ALONE#
	SKIPE 1,OLD44↔CORE 1,↔JFCL↔SETZM OLD44
	SKIPA 17,[IOWD =500,PDL]
GEONIT:	SETZM ALONE↔INTERN GEONIT	;GEOMETRIC MODEL INIT.

;CREATE A GEOMED UNIVERSE.
	EXTERN MKWORLD,MKCAMERA,MKWINDOW
	SETZB AVAIL	;...SO THAT @AVAIL IS ZERO.
	SETQ(WORLD,{MKWORLD})
	SETQ(CAMERA,{MKCAMERA})
	SETQ(WINDOW,{MKWINDOW})
	LAC 2,CAMERA↔ALT. 2,1
	LAC 2,WORLD↔ALT2. 2,1

;SETUP STRENGTH OF TRANSFORMATION VALUES.
	LAC[1.0]↔DAC TDEL	;TRANSLATION STRENGTH.
	LAC[0.75]↔DAC DDEL	;DILATION STRENGTH.
	LAC[0.785398]↔DAC RDEL	;ROTATION STRENGTH π/4.
	SETZM FRAAM		;SELECT WORLD FRAME.
	SETZM FRMORG
	SETOM FLAGL		;TURN ON THE LIGHTS.
	LACI 1↔DAC AXECNT	;ONE AXIS SELECT.
	SETZM OPERAT		;TRANSLATION DEFAULT.
	LAC[XWD -100,PADPDL]↔DAC PDLPTR
	SKIPN ALONE↔POP0J

;RE-ENTRY ADDRESS INITIALIZATION----------------------------------
REE:	LACI .↔DAC 124
	LAC 17,[IOWD =500,PDL]
	OPDEF PPIOT[702B8]
	PPIOT 2,-=250↔PPIOT 3,3003
	CALL(CRLF20)
	CALL(GEODPY)
	CALL(UNDERFLOW)
	CALL(GEOMED)
	CALLI 12

;2/4/73-----------------------------------------------------------
SUBR(UNDERFLOW)---------------------------------------------------
BEGIN "UNDERFLOW"; ENABLE & SERVICE ARITHMETIC INTERRUPTS.
	EXTERNAL JOBTPC,JOBAPR

;ENABLE INTERRUPT ROUTINE.
	MOVEI 2,10	;17
	JFCL 17,.+1;	CLEAR ANY PREVIOUSLY SET FLAGS
	SUB 17,[1(1)]
	MOVEI 1,FLTOV
	MOVEM 1,JOBAPR
	CALLI 2,16	;SET APR FLAGS
	MOVE 1,1(17)
	TLZ 1,440140	;CLEAR PREV FLAGS
	JRST 2,@1	;JUMP AND REALLY RESET.

;JOB APR USER INTERRUPT ROUTINE.
FLTOV:	MOVEM 1,SAVE1
	MOVE 1,JOBTPC
	TLNN 1,100↔JRST OV	;SKIP ON FLOATING UNDERFLOW.
	MOVE 1,-1(1)	;get opcode which caused it
	TLNN 1,40000	;test for standard flt pt opcode
	TLZ 1,2000	;change for FSC
	DPB 1,[POINT 29,.+2,35]	;modify the SETZ 
	MOVE 1,SAVE1	;restore ACs
	SETZ 0,		;zero ac and/or memory
	MOVEM 1,SAVE1
WO:	MOVE 1,JOBTPC
	TLZ 1,440140	;zero the error bits
	MOVEM 1,JOBTPC
	MOVE 1,SAVE1	
	JRST 2,@JOBTPC	;return
	
OV:	TLNN 1,40000	;was it a floating overflow?
	JRST ZDIV	;no
	MOVE 1,BP2
	JSR NUMOUT
	OUTSTR  MESS2
	JRST WO

ZDIV:	TLNN 1,40	;zero divide?
	JRST NOTIN	;no
	MOVE 1,BP4
	JSR NUMOUT
	OUTSTR  MESS4
	JRST WO

NOTIN:	MOVE 1,BP3
	JSR NUMOUT
 	OUTSTR  MESS3
	JRST WO

NUMOUT:	0
	MOVEM 1,XPTR
	MOVEM 2,SAVE2
	MOVEI 2,6
	MOVE 1,JOBTPC
	HRLZI 1,-1(1)
L1:	ROT 1,3
	IORI 1,60
	IDPB 1,XPTR
	HLRI 1,
	SOJG 2,L1
	MOVE 2,SAVE2
	JRST @NUMOUT

XPTR:	0
SAVE1:	0
SAVE2:	0
BP2:	POINT 7,MESS2+6,13
BP3:	POINT 7,MESS3+4,20
BP4:	POINT 7,MESS4+5,13
MESS2:	ASCIZ/FLOATING OVERFLOW OCCURED, PC = 000000/
MESS3:	ASCIZ/OVERFLOW OCCURED, PC = 000000/
MESS4:	ASCIZ /ZERO DIVIDE OCCURED, PC = 000000/
BEND 
SUBR(GEODPY)------------------------------------------------------
BEGIN GEODPY; GEOMED'S DISPLAY REFRESH - BGB - 12 FEBRUARY 1973.

	EXTERN SHOW1,SHOW2,SHOW3,SHOW4
	LACI 1↔DAC GLASS#
	LAC 1,UNIVERSE
	SON 1,1↔DAC 1,W0↔DAC 1,W
L1:	$TYPE 0,1↔CAIE $WINDOW↔GO L2
	PUSH P,1↔PUSH P,GLASS↔LAC 1,DPYFLG
	PUSHJ P,@[SHOW2↔SHOW3↔SHOW1↔SHOW4](1)
	AOS GLASS
L2:	LAC 1,W↔BRO 1,1↔DAC 1,W
	CAME 1,W0↔GO L1↔POP0J
	DECLARE{W,W0}

BEND GEODPY; BGB 12 MARCH 1973 -----------------------------------
SUBR(STADPY)------------------------------------------------------
BEGIN STADPY;STATUS DISPLAY - BGB - 1/12/73
	EXTERN DECDPY,DPYSTR,FDPY,EDPY,VDPY,DTYO,IDPY
	EXTERN AIVECT,AVECT,BUFDPY,FLODPY,DPYOUT,DPYSET
	EXTERN DPYBUF
	LAC 1,BUFDPY
	SKIPE FLAGL↔LAC 1,DPYBUF
	CALL(DPYSET,1)

;STATUS OF FRAME SELECT.
	CALL(AIVECT,[=180],[=500])
	LAC 1,FRAAM
	PUSH P,[
		[ASCIZ/WORLD/]
		[ASCIZ/BODY/]
		[ASCIZ/RELATIVE/]
		[ASCIZ/CAMERA/]](1)
	CALL(DPYSTR)

;STATUS OF FRAME ORIGIN SWITCH.
	LACI[ASCIZ/ FRAME/]
	SKIPE FRMORG
	LACI[ASCIZ/ FRAME */]
	CALL(DPYSTR,0)

;STATUS OF OPERAT SELECT SWITCH.
	CALL(AIVECT,[=390],[=500])
	LAC 1,OPERAT
	PUSH P,[
		[ASCIZ/TRANSLATION/]
		[ASCIZ/ROTATION/]
		[ASCIZ/DILATION/]
		[ASCIZ/REFLECTION/]](1)
	CALL(DPYSTR)

;TRANSLATION STRENGTH.
	CALL(AIVECT,[=185],[=480])
	CALL(FLODPY,TDEL,[4])
	CALL(DPYSTR,{[[ASCIZ/ FEET/]]})

;ROTATION STRENGTH IN PI FRACTION.
	CALL(AIVECT,[=185],[=460])
L1:	LAC RDEL↔LAC 1,[3.15]
	CAMLE[6.28]↔GO L2
	CAML[2.0]↔GO[FSC 1,1↔PUSH P,1
		CALL(DTYO,["2"])↔POP P,1
		GO .+1]
	FDVR 1,RDEL↔FIX 1,233000↔PUSH P,1
	CALL(DPYSTR,{[[ASCIZ"π/"]]})
	CALL(DECDPY)
L2:

;ROTATION STRENGTH IN RADIANS.
	CALL(AIVECT,[=400],[=460])
	CALL(FLODPY,RDEL,[3])

;RDEL IN DEGREES, MINUTES AND SECONDS.
	CALL(AIVECT,[=270],[=460])
	LAC 1,RDEL
	FMPR 1,[206264.806]
	FIX 1,233000
	AOS 1
	IDIVI 1,=3600
	IDIVI 2,=60
	PUSH P,3
	PUSH P,2
	PUSH P,1
	CALL(DECDPY)↔CALL(DTYO,[" "])
	CALL(DECDPY)↔CALL(DTYO,[" "])
	CALL(DECDPY)

;DILATION STRENGTH.
	CALL(AIVECT,[=390],[=480])
	LAC DDEL↔FMP[100.0]↔FADR[0.001]
	CALL(FLODPY,0,[2])
	CALL(DTYO,["%"])
	CALL(DTYO,[" "])
	LAC AXECNT↔ADDI 60↔CALL(DTYO,0)
;DISPLAY THE SCRATCH PAD PDL.
	CALL(AIVECT,[-=511],[=430])
	CDR 16,PDLPTR
	CAILE 16,PADPDL↔GO[
		CALL(IDPY,{(16)})
		CALL(DTYO,[15])↔CALL(DTYO,[12])
		SOJA 16,.-1]
	SKIPN FLAGL↔GO L3

;DISPLAY TOP OBJECT OF PADPDL.
	CDR 16,PDLPTR
	CAILE 16,PADPDL↔GO[
		LAC 1,(16)
		TESTZ 1,VBIT↔GO[CALL(VDPY,1)↔GO .+1]
		TESTZ 1,EBIT↔GO[CALL(EDPY,1)↔GO .+1]
		TESTZ 1,FBIT↔GO[CALL(FDPY,1)↔GO .+1]
		GO .+1]
;DISPLAY THE SECOND OBJECT WHEN APPROPRIATE.
	CDR 16,PDLPTR
	CAILE 16,PADPDL+1↔GO[
		LAC 1,-1(16)↔LAC 2,(16)
		LAC 0,(1)↔IOR 0,(2)↔LDB[POINT 3,0,16]
		CAIE 6↔CAIN 3↔SKIPA↔GO .+1
		CALL(LINKED,1,2)↔JUMPE 1,.+1
		LAC 1,-1(16)
		TESTZ 1,VBIT↔GO[CALL(VDPY,1)↔GO .+1]
		TESTZ 1,EBIT↔GO[CALL(EDPY,1)↔GO .+1]
		TESTZ 1,FBIT↔GO[CALL(FDPY,1)↔GO .+1]
		GO .+1]

L3:	CDR 1,PDLPTR↔CAIGE 1,PADPDL+1↔GO L4↔LAC 1,(1)
	SKIPE FLAGD↔GO[CALL(DPYNODE,1)↔GO L4]
L4:	CALL(DPYOUT,[0])
	POP0J
BEND;2/4/73-------------------------------------------------------
SUBR(NTYPE)NODE --------------------------------------------------
;NODE TYPE NUMBER 0 TO 17.
	LAC 1,@ARG1		;TYPE BITS WORD.
	SKIPGE 1↔SETZ 1,	;NEGATIVE BIT.
	TLNE 1,(1B9)↔SETZ 1,	;NORMALIZATION BIT.
	ANDI 1,17↔POP1J
;NTYPE BGB 25 MARCH 1973 -----------------------------------------

NNAMES:↔INTERN NNAMES	;NODE NAMES.
   [ASCIZ"FRAME"]↔[ASCIZ"EMPTY"]↔[ASCIZ"UNIVERSE"]↔[ASCIZ"LAMP"]
   [ASCIZ"CAMERA"]↔[ASCIZ"WORLD"]↔[ASCIZ"WINDOW"]↔[ASCIZ"IMAGE"]
   [ASCIZ"TEXT"]↔[ASCIZ"NODE11"]↔[ASCIZ"NODE12"]↔[ASCIZ"NODE13"]
   [ASCIZ"BODY"]↔[ASCIZ"FACE"]↔[ASCIZ"EDGE"]↔[ASCIZ"VERTEX"]

NLETTER:	↔INTERN NLETTER		;NODE INITIALS.
	"R" ↔ "M" ↔ "U" ↔ "L"
	"C" ↔ "W" ↔ "D" ↔ "I"
	"T" ↔ "X" ↔ "Y" ↔ "Z"
	"B" ↔ "F" ↔ "E" ↔ "V"

SUBR(JDPY)NODE ---------------------------------------------------
BEGIN
	SKIPN 1,ARG1↔GO[CALL(DPYSTR,{[[ASCIZ/NIL/]]})↔POP1J]
	CAMGE 1,UNIVERSE↔GO L
	CAML  1,44↔GO L
	CALL(NTYPE,1)
	CALL(DTYO,{NLETTER(1)})
L:	CALL({OCTDPY+1},ARG1)
	POP1J
BEND;BGB 25 MARCH 1973 -------------------------------------------


;NODE RELLOCATION BITS.
; 0  1  2| 3  4  5| 6  7  8| 9 10 11|12 13 14|15 16 17|  ← BIT.
; 0  0  0| 0  0  0| 8  7  6| 5  4  3| 2  1  0|-1 -2 -3|	← WORD.
;

REL:	XWD	0000,	0000	;FRAME.
	XWD	0000,	0001	;EMPTY.
	XWD	0000,	0202	;UNIVERSE.
	XWD	0000,	0000	;LAMP.

	XWD	0600,	1600	;CAMERA.
	XWD	2640,	3660	;WORLD.
	XWD	1600,	1600	;WINDOW.
	XWD	0760,	0760	;IMAGE.

	XWD	0000,	0000	;TEXT.
	XWD	0000,	0000	;XNODE.
	XWD	0000,	0000	;YNODE.
	XWD	0000,	0000	;ZNODE.

	XWD	3760,	3760	;BODY.
	XWD	1020,	1060	;FACE.
	XWD	3760,	3760	;EDGE.
	XWD	0160,	0160	;VERTEX.

;NODE CONTENT TYPES.

CONTYP:	BYTE(9)333,333,333,333	;FRAME.
	BYTE(9)000,000,000,000	;EMPTY.
	BYTE(9)000,040,001,000	;UNIVERSE.
	BYTE(9)000,000,001,000	;LAMP.

	0			;CAMERA.
	0			;WORLD.
	0			;WINDOW.
	0			;IMAGE.

	0			;TEXT.
	0			;XNODE.
	0			;YNODE.
	0			;ZNODE.

	BYTE(9)044,444,441,220	;BODY.
	BYTE(9)004,033,041,333	;FACE.
	BYTE(9)044,444,441,000	;EDGE.
	BYTE(9)003,334,411,333	;VERTEX.
SUBR(DPYNODE)NODE ------------------------------------------------
BEGIN DPYNODE; DISPLAY CONTENTS OF NODE LOWER RIGHT OF SCREEN.
	EXTERN AIVECT,AVECT,DPYBIG
	EXTERN DTYO,IDPY,DPYSTR,FLODPY,DECDPY,OCTDPY

	CALL(AIVECT,[=300],[-=70])
	CALL(AVECT,[=300],[-=380])
	CALL(AVECT,[=508],[-=380])
	CALL(AVECT,[=508],[-=70])
	CALL(AVECT,[=300],[-=70])

	CALL(DPYBIG,[1])
	CALL(JDPY,ARG1)
	CALL(DPYSTR,{[[ASCIZ"   "]]})
	SETQ(KIND,{NTYPE,ARG1})
	LAC REL(1)↔DAC RELTMP		;RELLOCATION.
	LAC CONTYP(1)↔DAC CONTMP	;CONTENT TYPE.
	LAC NNAMES(1)↔CALL(DPYSTR,0)

	HRREI -3↔DAC WRD
L1:
	LACN WRD↔IMULI =25↔SUBI =170↔DAC Y
	CALL(AIVECT,[=305],Y)
	SKIPGE WRD↔GO .+3↔CALL(DTYO,[" "])
	CALL(DECDPY,WRD)

;FULL WORD.
	CALL(AIVECT,[=345],Y)
	LACN 2,WRD↔LAC CONTMP
	ROT(2)↔ROT(2)↔ROT(2)↔ANDI 7000
	CAIN 3000↔GO[LAC 1,ARG1↔ADD 1,WRD
		CALL(FLODPY,{(1)},[4])↔GO L2]

;LEFT HALF.
	CALL(AIVECT,[=345],Y)
	LAC 1,ARG1↔ADD 1,WRD↔CAR(1)↔PUSH P,0
	LACN 2,WRD↔CAR RELTMP↔ROT(2)
	TRNE 10↔GO[CALL(JDPY)↔GO .+2]↔CALL({OCTDPY+1})

;RIGHT HALF.
	CALL(AIVECT,[=425],Y)
	LAC 1,ARG1↔ADD 1,WRD↔CDR(1)↔PUSH P,0
	LACN 2,WRD↔CDR RELTMP↔ROT(2)
	TRNE 10↔GO[CALL(JDPY)↔GO .+2]↔CALL({OCTDPY+1})

L2:	AOS 1,WRD↔CAIG 1,8↔GO L1
	CALL(DPYBIG,[2])
	POP1J
DECLARE{WRD,X,Y,KIND,RELTMP,CONTMP}
BEND DPYNODE; BGB 25 MARCH 1973 ----------------------------------
SUBR(GEOMED)------------------------------------------------------
BEGIN GEOMED; TELETYPE COMMAND JUMP TABLE - BGB - NOVEMBER 1972.
L0:	CRLF
L1:	OUTCHR["*"]
L2:	CALL(STADPY)
	LAC ALPHA↔DAC CTRL↔SETZM ALPHA
	LAC BETA ↔DAC META↔SETZM BETA
	INCHRW
	TRZE 200↔SETOM CTRL
	TRZE 400↔SETOM META
	CAIN 0,40↔GO L2
	CAIN 0,15↔GO[SETZM ITERAT↔GO L2]
	CAIN 0,12↔GO L1
	DAC 0,CHR
	LAC CTRL↔AND META↔DAC MTCT
	SETZ↔SKIPE CTRL↔IORI 1
	SKIPE META↔IORI 2↔DAC MCBITS

;READ JUMP TABLE.
	LAC CHR↔DAC 1
	CAIG 0,140↔GO[CAR 1,A00(1)↔GO L3]
	CAIG 0,172↔GO[CAR 1,A00-40(1)↔GO L3]
	CAR 1,A173-173(1)
L3:	PUSHJ P,(1)	;CALL GEOMED COMMAND CHARACTER SUBR.
	GO L2		;NO-SKIP IMMEDIATE COMMAND.
	GO L0		;SKIP CRLF-STAR COMMAND.
	LIT
BEND;2/4/73-------------------------------------------------------

NOP:	OUTCHR CHR↔OUTSTR[ASCIZ/ NO OPERATION./]↔CRLF↔POP0J
QMARK:	INCHRW↔DAC 1
	CAIG 0,140↔GO[CDR 1,A00(1)↔GO L4]
	CAIG 0,172↔GO[CDR 1,A00-40(1)↔GO L4]
	CDR 1,A173-173(1)
L4:	CRLF↔OUTCHR["	"]
	OUTSTR(1)	;PRINT GEOMED COMMAND CHARACTER COMMENT.
	CRLF↔OUTCHR["*"]↔POP0J

DEFINE $$(Q,A,B){XWD A,[ASCIZ"B"]}
;ASCII 00 TO 37--------------------------------------------------

A00:	NOP   	;null.
$$("↓",PADPSH,{	↓ COPY PUSH. α↓ ROTATE PUSH.})
$$("α",{[SETOM ALPHA↔POP0J]},{α CONTROL KEY PREFIX.})
$$("β",{[SETOM BETA↔POP0J]},{β META KEY PREFIX.})

$$("∧",LINKER,{	∧ FETCH PVT LINK})
$$("¬",XEVERT,{	¬ BODY EVERT. α¬ BODY SUBTRACTION.})
$$("ε",{[SETOM ALPHA↔SETOM BETA↔POP0J]},{ε META-CONTROL PREFIX.})
$$("π",XRDEL,{	π ACCEPT ROTATION DELTA.})

$$("λ",XTDEL,{	λ ACCEPT TRANSLATION DELTA.})
$$(" ",NOP,{	TAB.})
$$(" ",NOP,{	LF.})
$$(" ",NOP,{	VT.})

$$(" ",NOP,{	FF.})
$$(" ",NOP,{	CR.})
$$("∞",MACRO,{	∞ INSTANT CUBE. α∞ INSTANT TORUS.})
$$("∂",SWCD,{	∂ FLIP NODE DISPLAY SWITCH.})

$$("⊂",LINKER,{	⊂ FETCH BRO LINK.})
$$("⊃",LINKER,{	⊃ FETCH SIS LINK.})
$$("∩",LINKER,{	∩ FETCH DAD LINK, α∩ BODY INTERSECTION.})
$$("∪",LINKER,{	∪ FETCH SON LINK, α∪ BODY UNION.})

$$("∀",XDISBL,{	∀ DISABLE BODY OPERATIONS SWITCH.})
$$("∃",SWC4,{	∃ REFLECTION DEFAULT.})
$$("⊗",LINKER,{	⊗ FETCH UNIVERSE NODE.})
$$("↔",PADSWP,{(1ST ↔ 2ND)(1ST α↔ 3RD)(1ST β↔ LAST)(2ND ε↔ 3RD)})

$$("_",XDPY,{	_ STICKY DISPLAY MODE SWITCH.})
$$("→",LINKER,{	→ FETCH ALT2 LINK.})
$$("~",NOP,{	TILDE})
$$("≠",NOP,{	≠})

$$("≤",LINKER,{	≤ FETCH NED LINK.})
$$("≥",LINKER,{	≥ FETCH PED LINK.})
$$("≡",NOP,{	≡})
$$("∨",LINKER,{	∨ FETCH NVT LINK.})

;----------------------------------------------------------------
;ASCII 40 TO 100-------------------------------------------------

$$(" ",NOP,{	SPACE})
$$("!",SWC1,{	! TRANSLATION DEFAULT SWITCH.})
$$(" ",NOP,{	DOUBLE QUOTE.})
$$("#",CRLF20,{	# TWENTY CRLF'S.})

$$("$",XCONVEX,{	MAKE CONVEX.})
$$("%",XDDEL,{	% SET DILATION DELTA STRENGTH.})
$$("&",NOP,{	&})
$$("'",NOP,{	'})

$$("(",EUTRAN,{	EUCLIDEAN TRANSFORMATION -Y.})
$$(" ",EUTRAN,{	EUCLIDEAN TRANSFORMATION +Y.})
$$("*",EUTRAN,{	EUCLIDEAN TRANSFORMATION +Z.})
$$("+",LINKER,{	OTHER LINK.})

$$(" ",LINKER,{	CLOCKWISE LINK.})
$$("-",EUTRAN,{	EUCLIDEAN TRANSFORMATION -Z.})
$$(".",LINKER,{	COUNTER CLOCKWISE LINK.})
$$("/",HALVE ,{	HALVE STRENGTH.})

$$("0",SETDIG,{	SET-DIGIT COMMAND.})
$$("1",SETDIG,{	SET-DIGIT COMMAND.})
$$("2",SETDIG,{	SET-DIGIT COMMAND.})
$$("3",SETDIG,{	SET-DIGIT COMMAND.})
	
$$("4",SETDIG,{	SET-DIGIT COMMAND.})
$$("5",SETDIG,{	SET-DIGIT COMMAND.})
$$("6",SETDIG,{	SET-DIGIT COMMAND.})
$$("7",SETDIG,{	SET-DIGIT COMMAND.})
	
$$("8",SETDIG,{	SET-DIGIT COMMAND.})
$$("9",SETDIG,{	SET-DIGIT COMMAND.})
$$(":",EUTRAN,{	EUCLIDEAN TRANSFORMATION +X.})
$$(";",EUTRAN,{	EUCLIDEAN TRANSFORMATION -X.})
	
$$("<",LINKER,{	FETCH NFACE LINK.})
$$("=",SWC3,{	DILATION DEFAULT SWITCH.})
$$(">",LINKER,{	FETCH PFACE LINK.})
$$("?",QMARK,{	INFORMATION PREFIX.})

$$("@",SWC2,{	ROTATION DEFAULT SWITCH.})

;----------------------------------------------------------------
;ASCII 101 TO 132 UPPER CASE-------------------------------------
;ASCII 141 TO 172 LOWER CASE.
A101:
$$("A",ATTDET,{	A ATTACH, βAXECNT.})
$$("B",XBODY ,{	B BODY RETRIEVAL.})
$$("C",XCOPY ,{	C COPY})
$$("D",ATTDET,{	D DETACH, αDARKEN, βDUAL, εUNDARKEN.})

$$("E",SWIRE ,{	E SWEEP WIRE.})
$$("F",SWCF,{	F FRAME STEP SWITCH.})
$$("G",XGLUE,{	G GLUE COMMAND.})
$$("H",NOP,{	H })

$$("I",XIN,{	I INPUT B3D. αI INPUT CAMERA. βI INPUT CRE.})
$$("J",JOINVV,{	J JOIN VERTEX-VERTEX.})
$$("K",XKILL,{	K KILL COMMANDS.})
$$("L",SWCL,{	L LABEL LIGHTS SWITCH.})
	
$$("M",MIDPOI,{	M MIDPOINT COMMAND.})
$$("N",XNAME,{	N NAME BODY})
$$("O",XOUT,{	O OUTPUT COMMANDS.})
$$("P",XPLOTO,{	P OUTPUT PLOT FILE})

$$("Q",SWCQ,{	Q FRAME ORIGIN SWITCH.})
$$("R",XROTCM,{	R ROTATION COMPLETION.})
$$("S",XSWEEP,{	S SWEEP COMMANDS.})
$$("T",XTEXT,{	TEXT LABEL.})

$$("U",NOP,{	U})
$$("V",VBODY,{	V MAKE VERTEX BODY.})
$$("W",XWMAKE,{	MAKE: W WORLD. αW WINDOW. βW CAMERA. εW IMAGE.})
$$("X",{[POP P,↔SETZ 1,↔POP0J]},{X EXIT GEOMED.})

$$("Y",NOP,{	Y NOP})
$$("Z",NOP,{	Z})

;ASCII 133 TO 140.
$$("[",NOP,{	[})
$$("\",DOUBLE,{	\ DOUBLE STRENGTH.})
$$("]",NOP,{	]})
$$("↑",PADPOP,{	↑ PADPDL POP. α↑ ROTATE POP.})
$$("←",LINKER,{	← FETCH ALT LINK.})
$$("`",NOP,{	`})

;ASCII 173 TO 177.
A173:
$$("{",NOP,{	LEFT CURLY.})
$$("|",XINVERT,{	| INVERT EDGE PARITY.})
$$(" ",XDPY,{	ALT OCCULT. αALT FRONT FACE. βALT ALL EDGES.})
$$("}",NOP,{	RIGHT CURLY})
$$(" ",NOP,{	RUBOUT})
;----------------------------------------------------------------
;1. "V"-COMMAND.  MAKE VERTEX BODY.
SUBR(VBODY)-------------------------------------------------------
BEGIN VBODY;BGB 13 JANUARY 1973.
	LAC PTR,PDLPTR
	SETQ(BNEW,{MKB,WORLD})↔PUSH PTR,1     ;BODY INTO PADPDL
	SKIPE META↔GO L1		;DIABLE FACE & VERTEX.
	CALL(MKF,BNEW)↔PUSH PTR,1	;FACE INTO PADPDL
	CALL(MKV,BNEW)↔PUSH PTR,1	;VERTEX INTO PADPDL
L1:	DAC PTR,PDLPTR
	SKIPE CTRL↔POP0J		;DISABLE MAKE FRAME.
	CALL(MKFRAME)↔LAC 2,BNEW
	FRAME. 1,2
	POP0J
BNEW:	0
BEND;2/4/73-------------------------------------------------------

SUBR(MIDPOI)------------------------------------------------------
BEGIN MIDPOI;MIDPOINT AN EDGE PROPORTIONAL TO DDEL - 8 FEB 1973.
	EXTERN ESPLIT
	CDR PTR,PDLPTR↔CAIGE PTR,PADPDL+1↔POP0J
	LAC 1,(PTR)↔TEST 1,EBIT↔POP0J
	PVT 0,1↔DAC V1#
	NVT 0,1↔DAC V2#
	CALL(ESPLIT,1)↔DAC 1,(PTR)
	LAC 2,V1↔SLACI XWC(2)↔LAPI XWC(1)↔BLT ZWC(1)
	LAC DDEL↔FMPRM XWC(1)↔FMPRM YWC(1)↔FMPRM ZWC(1)
	LAC 2,V2↔SLACI 3,(1.0)↔FSBR 3,DDEL
	LAC XWC(2)↔FMPR 3↔FADRM XWC(1)
	LAC YWC(2)↔FMPR 3↔FADRM YWC(1)
	LAC ZWC(2)↔FMPR 3↔FADRM ZWC(1)
	CALL(GEODPY)
	POP0J↔VAR
BEND;2/8/73-------------------------------------------------------

XINVERT:;"|" COMMAND.---------------------------------------------
;FLIP THE FACE-VERTEX ORIENTATION OF AN EDGE - BGB - 9 FEB 1973.
	CDR PTR,PDLPTR↔CAIGE PTR,PADPDL+1↔POP0J
	LAC 1,(PTR)↔TEST 1,EBIT↔POP0J
	MOVSS 1(1)↔MOVSS 3(1)↔MOVSS 4(1)↔MOVSS 5(1)
	POP0J
;2/9/73-----------------------------------------------------------

XEVERT:;"¬" COMMAND.----------------------------------------------
	EXTERN EVERT
	SKIPE CTRL↔GO XBIN	;BODY SUBTRACTION "α¬".
	CDR PTR,PDLPTR↔CAIGE PTR,PADPDL+1↔POP0J
	LAC 1,(PTR)↔TEST 1,BBIT↔POP0J
	CALL(EVERT,1)↔CALL(GEODPY)↔POP0J
;3/20/73----------------------------------------------------------
;2. "E"-COMMAND. SWEEP WIRE.
SUBR(SWIRE)-------------------------------------------------------
BEGIN SWIRE;BGB 14 JANUARY 1973.
	CDR PTR,PDLPTR↔CAIGE PTR,PADPDL+2↔POP0J;PADPDL EMPTY TEST.
	CALL(LINKED,{-1(PTR)},{(PTR)})	       ;LEGAL ARGS TEST.
	SKIPN 1↔POP0J↔LAC PTR,PDLPTR
	CALL(MKEV,{-1(PTR)},{(PTR)})	       ;MAKE EDGE VERTEX.
	LAC PTR,PDLPTR↔DAC 1,(PTR)↔POP0J       ;NEW TOP OF PADPDL.
BEND;2/4/73------------------------------------------------------
;3. "J"-COMMAND. JOIN VERTICES.
SUBR(JOINVV)------------------------------------------------------
BEGIN JOINVV;BGB 5 FEBRUARY 1973.
	ACCUMULATORS{F,V1,V2,E1,E2}
	LAC PTR,PDLPTR↔CDR 1,PTR
	CAIGE 1,PADPDL+2↔POP0J	    	;2 OR MORE ARGUMENTS.
	LAC V1,(PTR)
	LAC V2,-1(PTR)
	DAC V2,F

	TEST V1,VBIT↔POP0J	;AT LEAST ONE VERTEX.
	TEST F,FBIT↔GO L1

;JOIN ENDS OF WIRE CASE.
	PED E1,F↔PVT V2,E1↔DAC V2,(PTR)
	CALL(MKFE,V2,F,V1)
	CALL(GEODPY)
	POP0J

;JOIN VERTICES ACROSS A FACE.
L1:	TEST V2,VBIT↔POP0J
	PED E1,V1↔DAC E1,E0#
L2:	SETQ(F,{FCCW,E1,V1})
	PED E2,V2↔DAC E2,EE0#
L3:	CALL(FCCW,E2,V2)↔CAMN 1,F↔GO L4		;FACE IN COMMON.
	SETQ(E2,{ECCW,E2,V2})↔CAME E2,EE0↔GO L3
	SETQ(E1,{ECCW,E1,V1})↔CAME E1,E0↔GO L2↔POP0J
L4:	POP PTR,0
	CALL(MKFE,V1,F,V2)
	DAC 1,(PTR)
	DAC PTR,PDLPTR
	CALL(GEODPY)
	POP0J
BEND;2/5/73------------------------------------------------------
;4. ":;()-*" COMMANDS. EUCLIDEAN TRANSFORMATION COMMANDS.
SUBR(EUTRAN)------------------------------------------------------
BEGIN EUTRAN;BGB 15 JANUARY 1973.
	EXTERN BGET,APTRAN,MKFRAME,MKCOPY,KLNODE
	EXTERN TRANSLATE,ROTATE,SHRINK

;GET TOP OBJECT OF PADPDL.
	CDR 1,PDLPTR↔CAIGE 1,PADPDL+1↔POP0J
	LAC 2,(1)↔DAC 2,OBJECT
	$TYPE 0,2↔CAIN 0,$WINDOW↔GO WNTRAN
	DZM DEL1↔DZM DEL2↔DZM DEL3

;OPERATION.
	SKIPN 1,MCBITS↔LAC 1,OPERAT↔DAC 1,OP
	LAC 2,[TRANSLATE↔ROTATE↔SHRINK↔SHRINK](1)
	DAP 2,L3

;AXIS CODE.
	LAC 1,CHR↔SETZ 3,
	CAIE 1,";"↔CAIN 1,":"↔IORI 3,1		;X-AXIS.
	CAIE 1,"("↔CAIN 1,")"↔IORI 3,2		;Y-AXIS.
	CAIE 1,"-"↔CAIN 1,"*"↔IORI 3,4		;Z-AXIS.
	LAC 1,OP↔CAILE 1,1↔GO[
	SLACI(1.0)↔DAC DEL1↔DAC DEL2↔DAC DEL3
	LAC AXECNT↔CAIN 2↔TRC 3,7
	CAIN 3↔TRO 3,7↔GO .+1]
	
;DELTA ARGUMENT.
	LAC CHR↔LAC 1,OP
	LAC 2,@[TDEL↔RDEL↔DDEL↔[-1.0]](1)

	CAIN"-"↔MOVNS 2
	CAIN"("↔MOVNS 2
	CAIN";"↔MOVNS 2

	GO@[L1↔L1↔[MOVNS 2↔JUMPGE 2,L1	   ;NEGATIVE DILATION.
	SLACI 2,(1.0)↔FDVR 2,DDEL↔GO L1]   ;POSITIVE DILATION.
	[LAC 2,[-1.0]↔GO L1]](1)	   ;REFLECTION DELTA.

L1:	TRNE 3,1↔DAC 2,DEL1
	TRNE 3,2↔DAC 2,DEL2
	TRNE 3,4↔DAC 2,DEL3
;MAKE REFERENCE FRAME.
	LAC 1,FRAAM↔GO@[[GO .+1]		;WORLD FRAME.
	[CALL(BGET,OBJECT)↔GO .+1]		;BODY FRAME.
	[CALL(BGET,OBJECT)↔DAD 1,1↔GO .+1]	;DADDY'S FRAME.
	[LAC 1,CAMERA↔GO .+1]](1)		;CAMERA FRAME.
	SKIPE 1↔FRAME 1,1
	SKIPE 1↔GO[CALL(MKCOPY,1)↔GO .+1]	;COPY OF REFRAM.
	DIPZ 1,REFRAM				;XWD REFRAM,0

;FRAME ORIGIN SWITCH.
	SKIPN FRMORG↔GO[SKIPN OP↔GO .+1		;NON-TRANSLATION.
	CALL(BGET,OBJECT)↔FRAME 1,1
	JUMPE 1,.+1↔PUSH P,1
	CAR 1,REFRAM↔SKIPN 1↔CALL(MKFRAME)↔DIPZ 1,REFRAM
	LAC 2,1↔POP P,1↔SLACI XWC(1)
	LAPI XWC(2)↔BLT ZWC(2)↔GO .+1]

;MAKE EUCLIDEAN TRANSFORMATION MATRIX.
	CALL(,REFRAM,DEL1,DEL2,DEL3)
L3:	CALL(ROTATE)↔DAC 1,TRAN			;MAKE THE TRANSFORM.	
	SKIPE REFRAM↔GO[
	CAR REFRAM↔CALL(KLNODE,0)↔GO .+1]	;FLUSH THE REFRAM.
;APPLY THE TRANSFORMATION.
	LAC ITERAT↔SKIPN↔AOS↔DAC COUNT
L2:	CALL(APTRAN,OBJECT,TRAN)
	CALL(GEODPY)
	SKIPGE COUNT↔GO[
		AOSL COUNT↔GO .+1
		SETZM ITERAT
		CALL(XSWEEP)
		CDR 1,PDLPTR↔LAC(1)↔DAC OBJECT↔GO L2]
	SOSLE COUNT↔GO L2
	SETOM@TRAN
	CALL(KLNODE,TRAN)
	POP0J
	DECLARE{OBJECT,TRAN,REFRAM,COUNT,OP}
	DECLARE{DEL1,DEL2,DEL3}
;WINDOW TRANFORMATION.
WNTRAN:	LAC 1,CHR
	CAIN 1,"-"↔GO[LAC -1(2)↔FMPR DDEL↔DAC -1(2)
		SKIPE CTRL↔GO W2↔GO W1]
	CAIN 1,"*"↔GO[LAC -1(2)↔FDVR DDEL↔DAC -1(2)
		SKIPE CTRL↔GO W2↔GO W1]
	LAC 3,TDEL↔FIXX 3,		;TRANSLATION.
	LACI 4,-2(2)↔SKIPE CTRL↔SOS 4	;ADDRESS.
	CAIN 1,";"↔GO[NIP(4)↔SUB 3↔DIP(4)↔GO W1]
	CAIN 1,":"↔GO[NIP(4)↔ADD 3↔DIP(4)↔GO W1]
	CAIN 1,"("↔GO[NAP(4)↔SUB 3↔DAP(4)↔GO W1]
	CAIN 1,")"↔GO[NAP(4)↔ADD 3↔DAP(4)↔GO W1]
	POP0J
W1:	CALL(CROP,2)↔EXTERN CROP
W2:	CALL(GEODPY)↔POP0J
	LIT
BEND;2/4/73-------------------------------------------------------
;5. SWITCH MODIFYING COMMANDS.
;	!	TRANSLATION DEFAULT.
;	@	ROTATION DEFAULT.
;	∃	REFLECTION DEFAULT.
;	=	DILATION DEFAULT.
;	Q	FLIP FRAME ORIGIN.
;	F	STEP FRAME SELECT SWITCH.

SWC1:	SETZM OPERAT↔POP0J		;"!" TRANSLATION DEFAULT.
SWC2:	LACI 1↔DAC OPERAT↔POP0J		;"@" ROTATION DEFAULT.
SWC3:	LACI 2↔DAC OPERAT↔POP0J		;"=" DILATION DEFAULT.
SWC4:	LACI 3↔DAC OPERAT↔POP0J		;"∃" REFLECTION DEFAULT.

SWCF:	SKIPE CTRL↔GO XFOCAL		;"αF" SET FOCAL.
	AOS 1,FRAAM↔ANDI 1,3
	DAC 1,FRAAM↔POP0J		;FRAME STEP SWITCH.
SWCL:	SETCMM FLAGL↔POP0J		;"L" LABEL LIGHTS SWITCH.
SWCD:	SETCMM FLAGD↔POP0J		;"∂" NODE DISPLAY SWITCH.
SWCQ:	SETCMM FRMORG↔POP0J		;FRAME ORGIN TOGGLE.

CRLF20:	LACI =20↔CRLF↔SOJG .-1↔POP0J	;TWENTY CRLF'S.

XDISBL:	CDR 1,PDLPTR↔CAIGE 1,PADPDL+1↔POP0J
	LAC 1,(1)↔TEST 1,BBIT↔POP0J
	LAC 2,MCBITS↔GO@[
	[MARKZ 1,{BDLBIT+BDVBIT+BDPBIT}↔POP0J]	;ENABLE.
	[MARK 1,BDLBIT↔POP0J]		;FRAME DISABLE
	[MARK 1,BDVBIT↔POP0J]		;VERTEX DISABLE
	[MARK 1,BDPBIT↔POP0J]](2)	;PARTS DISABLE
;6. STACK MODIFYING COMMANDS.

;"↔"	PADPDL SWAP:	PADPDL[1]↔PADPDL[2].
;"α↔"	PADPDL SWAP:	PADPDL[1]↔PADPDL[3].
;"β↔"	PADPDL SWAP:	PADPDL[2]↔PADPDL[3].
;"ε↔"	PADPDL SWAP:	PADPDL[1]↔PADPDL[N].

PADSWP: LAC PTR,PDLPTR↔CDR PTR
	LACM 1,CTRL↔CAIGE PADPDL+2(1)↔POP0J	;ARG ∃ TEST.
	LAC 1,MCBITS↔GO@[
	[LAC(PTR)↔EXCH -1(PTR)↔DAC(PTR)↔POP0J]	;  1ST & 2ND.
	[LAC(PTR)↔EXCH -2(PTR)↔DAC(PTR)↔POP0J]	;α 1ST & 3RD.
	[LAC(PTR)↔EXCH PADPDL+1↔DAC(PTR)↔POP0J]	;β 1ST & LAST.
	[LAC -1(PTR)↔EXCH -2(PTR)
	 DAC -1(PTR)↔POP0J]			;ε 2ND & 3RD.
	](1)↔LIT

;"↓"	PADPDL COPY PUSH DOWN.
;"↓"	PADPDL ROTATE DOWN.

PADPSH:	LAC PTR,PDLPTR↔CDR PTR
	CAIGE PADPDL+1↔POP0J
	SKIPE CTRL↔GO .+4
	PUSH PTR,(PTR)↔DAC PTR,PDLPTR↔POP0J	;COPY PUSH.
	LAC[XWD PADPDL+1,PADPDL]↔BLT -1(PTR)
	LAC PADPDL↔DAC(PTR)↔POP0J		;ROTATE PUSH.

;"↑"	PADPDL POP UP.
;"α↑"	PADPDL ROTATE UP.

PADPOP:	LAC PTR,PDLPTR↔CDR PTR
	CAIGE PADPDL+1↔POP0J
	SKIPE CTRL↔GO .+4
	POP PTR,↔DAC PTR,PDLPTR↔POP0J		;PAD POP.
	SUBI PADPDL↔POP PTR,1(PTR)↔SOJG .-1	;ROTATE POP
	LAC PTR,PDLPTR↔LAC 1(PTR)↔DAC PADPDL+1
	POP0J
;"/" COMMAND.-----------------------------------------------------
HALVE:	SKIPN 1,MCBITS↔LAC 1,OPERAT	;EUCLIDEAN OPERATION.
	LAC TDEL(1)↔FSC -1↔DAC TDEL(1)	;"/" COMMAND.
	POP0J
;"\" COMMAND.-----------------------------------------------------
DOUBLE:	SKIPN 1,MCBITS↔LAC 1,OPERAT	;EUCLIDEAN OPERATION.
	LAC TDEL(1)↔FSC 1↔DAC TDEL(1)	;"\" COMMAND.
	POP0J
;"0123456789" COMMANDS.-------------------------------------------
SETDIG:	LAC 1,CHR↔ANDI 1,17		;DIGIT.
	SKIPN 2,MCBITS↔LAC 2,OPERAT	;EUCLIDEAN OPERATION.
	GO@[
	[LAC ITERAT↔IMULI 12↔ADD 1	;ITERATION COUNT.
	 CAILE=128↔LACI=128
	 DAC ITERAT↔POP0J]
	[SUBI 1,=10↔LAC[3.1415927]	;ROTATION DELTA.
	 FSC(1)↔DAC RDEL↔POP0J]
	[SKIPN 1↔LACI 1,1↔FLOAT 1,	;DILATION DELTA.
	 FMPR 1,[0.1]↔DAC 1,DDEL↔POP0J]
	[SUBI 1,4↔SLACI(1.0)↔FSC(1)	;TRANSLATION DELTA.
	 DAC TDEL↔POP0J]](2)
;-----------------------------------------------------------------
XFOCAL:	OUTSTR[ASCIZ/	FOCAL = /]↔CALL(REALIN)
	LAC 1,CAMERA
	FMPR[3.2808E-3]↔HLLM 0,3(1)
	HLLZ 2,1(1)↔CDR 3,1(1)↔FLOAT 3,↔FMPR 3,0↔FDVR 3,2↔DACN 3,-3(1)
	HLLZ 2,2(1)↔CDR 3,2(1)↔FLOAT 3,↔FMPR 3,0↔FDVR 3,2↔DACN 3,-2(1)
	FMPR[100000.0]↔DAC 0,-1(1)
	CALL(GEODPY)↔POP0J
REALIN: ;---------------------------------------------------------
BEGIN REALIN; INPUT FROM TTY SMALL REAL NUMBER - BGB - 16 DEC 1972.
;AC-0 INTEGER ACCUMULATION.	AC-0 RETURNS REAL NUMBER.
;AC-1 CHARACTER.		AC-1 RETURNS BREAK CHARACTER.
;AC-2 COUNTER OF DIGITS TO RIGHT OF DECIMAL POINT PLUS ONE.
;AC-3 MINUS SIGN FLAG.
	SETZ↔SETZB 2,3
L1:	INCHWL 1
	CAIE 1,"-"↔GO .+3↔SETCMM 3↔GO L1
	CAIE 1,"."↔GO .+3↔JUMPN 2,L2↔AOJA 2,L1
	CAIL 1,"0"↔CAILE 1,"9"↔GO L2
	JUMPN 2,[CAILE 2,4↔GO L1↔AOJA 2,.+1]
	ANDI 1,17↔IMULI =10↔ADD 1↔GO L1
L2:	FLOAT↔SOSLE 2↔FDVR[1.0↔10.0↔100.0↔1000.0↔10000.0](2)
	SKIPE 3↔MOVNS↔POP0J
BEND;12/16/72-----------------------------------------------------

XTDEL:	CALL(REALIN)↔CAIN 1,42↔FDVR[12.0]↔DAC TDEL↔POP0J
XDDEL:	CALL(REALIN)↔FMPR[0.01]↔DAC DDEL↔POP0J
XRDEL:	CALL(REALIN)↔CAIN 1,"/"↔GO[
	SKIPN↔SLACI(1.0)↔DAC RDEL	;NUMERATOR.
	CALL(REALIN)↔SKIPN↔SLACI(1.0)	;DENOMINATOR.
	LAC 1,RDEL↔FMPR 1,[3.1415927]
	FDVR 1,0↔DAC 1,RDEL↔POP0J]	;PI FRACTION.
	CAIN 1,"'"↔FMPR[1.74532925E-2]	;DEGREES.
	DAC RDEL↔POP0J			;RADIANS.
;8. SWEEP COMMANDS.

SUBR(XSWEEP)------------------------------------------------------
BEGIN XSWEEP
	EXTERN SWEEP,PYRAMID
	CDR PTR,PDLPTR↔CAIGE PTR,PADPDL+1↔POP0J	   ;ARG EXISTS.
	LAC 1,(PTR)↔TESTZ 1,FBIT↔GO L2
	TEST 1,VBIT↔POP0J
	PED 2,1↔JUMPE 2,.+4
	MOVS 0,1(2)↔CAME 0,1(2)↔GO L2+1
	CALL(SWIRE)↔GO L3			;SWEEP WIRE.
L2:	SKIPE MTCT↔GO[
		CALL(PYRAMID,1)↔DAC 1,(PTR)
		CALL(GEODPY)↔POP0J]
	SKIPN 2,META↔LACM 2,CTRL     ;0=PRISM ;α+1=CCW ;β-1=CW.
	CALL(SWEEP,1,2)
L3:	CALL(GEODPY)
	MOVNS ITERAT
	POP0J
BEND;2/10/73------------------------------------------------------
XROTCM:	EXTERN ROTCOM
	CDR PTR,PDLPTR↔CAIGE PTR,PADPDL+1↔POP0J
	LAC 1,(PTR)↔TEST 1,FBIT↔POP0J
	CALL(ROTCOM,1)
	CALL(GEODPY)
	POP0J
;-----------------------------------------------------------------
XGLUE:	LAC PTR,PDLPTR↔CDR PTR↔CAIGE PADPDL+2↔POP0J	;TWO ARGS.
	LAC 1,(PTR)↔LAC 2,-1(PTR)
	EXTERN GLUE
	CALL(GLUE,1,2)↔DAC 1,-1(PTR)
	POP PTR,0↔DAC PTR,PDLPTR
	CALL(GEODPY)
	POP0J
SUBR(XKILL)-------------------------------------------------------
BEGIN XKILL;BGB - 10 FEBRUARY 1973.
	EXTERN KLEV,KLVE,KLFE,REMOVF,KLBFEV
	LAC PTR,PDLPTR↔CDR PTR↔CAIGE PADPDL+1↔POP0J	;ONE ARG.
	LAC 1,(PTR)
	TEST  1,VBIT↔GO L2
	DAC 1,2↔PED 3,1
	SETQ(4,{ECCW,3,2})
	SETQ(5,{ECCW,4,2})
	DAC 2,1↔CAME 3,5↔GO L1
	CALL(KLEV,1)↔GO L3
L1:	CALL(KLEV,1)↔CALL(KLFE,1)↔GO L3
L2:	TESTZ 1,EBIT↔GO[SKIPE CTRL↔GO[
		CALL(KLVE,1)↔GO L3]
		CALL(KLFE,1)↔GO L3]
	TESTZ 1,FBIT↔GO[CALL(REMOVF,1)↔GO L3]
	TESTZ 1,BBIT↔GO[CALL(KLBFEV,1)↔POP PTR,0
		DAC PTR,PDLPTR↔CALL(GEODPY)↔POP0J]
	POP0J 	
L3:	DAC 1,(PTR)
	CALL(GEODPY)
	POP0J
BEND;2/10/73------------------------------------------------------
;9. LINK FOLLOWING COMANDS.
SUBR(LINKER)------------------------------------------------------
BEGIN LINKER
	LAC PTR,PDLPTR
	LAC CHR↔CAIN"⊗"↔GO[PUSH PTR,UNIVERSE↔DAC PTR,PDLPTR↔POP0J]
	CDR 1,PTR↔CAIGE 1,PADPDL+1↔POP0J	  ;STACK EMPTY.

	LAC 2,(1)↔LAC CHR
	CAIE"."↔CAIN","↔GO L1		;CLOCK LINK COMMANDS.
	CAIN"+"↔GO L1			;OTHER LINK COMMAND.
	CAIN"∩"↔GO[SKIPE CTRL↔GO XBIN↔TESTZ 2,PBIT↔DAD 2,2↔GO L0]
	CAIN"∪"↔GO[SKIPE CTRL↔GO XBIN↔SON 2,2↔GO L0]
	CAIN"⊂"↔GO[TESTZ 2,PBIT↔BRO 2,2↔GO L0]
	CAIN"⊃"↔GO[TESTZ 2,PBIT↔SIS 2,2↔GO L0]

	CAIE "<"↔CAIN ">"↔ADDI 2,1
	CAIE "≤"↔CAIN "≥"↔ADDI 2,2
	CAIE "∨"↔CAIN "∧"↔ADDI 2,3
	CAIE "←"↔CAIN "→"↔ADDI 2,6

	SKIPE CTRL↔SUBI 2,4	;-3 -2 -1
	SKIPE META↔ADDI 2,5	;6 7 8
	SKIPE MTCT↔ADDI 2,2	;4 5 6

	LAC 2,(2)		;FETCH WORD FROM THE NODE.
	CAIN "≤"↔MOVSS 2
	CAIN "<"↔MOVSS 2
	CAIN "∨"↔MOVSS 2
	CAIN "←"↔MOVSS 2

L0:	CDR 2
	CAML 44↔GO .+3		;LOWER THAN MAX.
	CAML UNIVER↔DAC(1)	;HIGHER THAN MIN.
	POP0J
;OTHER LINK COMMANDS.
L1:	TESTZ 2,PBIT↔GO[LAC CHR		;OBJECT CLOCK LINKS.
	CAIN"."↔GO[CCW 2,2↔DAC 2,(1)↔POP0J]	;CCW BODY.
	CAIN","↔GO[ CW 2,2↔DAC 2,(1)↔POP0J]	; CW BODY.
	POP0J]
	CAIGE 1,PADPDL+2↔POP0J		;TWO ARGUMENTS REQUIRED.
	LAC 1,0(PTR)↔LAC 2,-1(PTR)
	CALL(LINKED,1,2)↔SKIPN 1↔POP0J	;WHICH ARE LINKED.
	LAC 1,0(PTR)↔LAC 2,-1(PTR)
	SETZ 3,↔LAC CHR
	CAIN"+"↔GO L2
	CAIE","↔AOS 3			;DISTINGUISH CW & CCW.
	SKIPN CTRL↔ADDI 3,2
	SKIPE CTRL↔ADDI 3,4		;DISTINGUISH OPERATION.

;EDGE IS IN THE FIRST POSITION OF THE STACK.
L2:	TEST 1,EBIT↔GO L3			 ;EDGE.
	TEST 2,FBIT↔GO[TEST 2,VBIT↔POP0J	;FACE OR VERTEX.
		SKIPE CTRL↔ADDI 3,2↔GO .+1]	;CTRL VERTEX.
	PUSH P,1↔PUSH P,2↔PUSHJ P,@L5(3)
	CAIN 3,2↔AOS PTR↔CAIN 3,3↔AOS PTR
	DAC 1,-1(PTR)↔POP0J

;EDGE IS IN THE SECOND POSITION OF THE STACK.
L3:	TEST 2,EBIT↔POP0J
	TEST 1,FBIT↔GO[TEST 1,VBIT↔POP0J
		SKIPE CTRL↔ADDI 3,2↔GO .+1]
	PUSH P,2↔PUSH P,1↔PUSHJ P,@L5(3)
	CAIN 3,2↔SOS PTR↔CAIN 3,3↔SOS PTR
	DAC 1,0(PTR)↔POP0J

L5:	OTHER↔OTHER↔ECW↔ECCW↔VCW↔VCCW↔FCW↔FCCW

BEND;2/9/73-------------------------------------------------------
SUBR(XNAME) ------------------------------------------------------
BEGIN XNAME; NAME A BODY - BGB - 20 FEBRUARY 1973.
	CDR 1,PDLPTR↔CAIGE 1,PADPDL+1↔POP0J
	LAC 1,(1)↔TEST 1,BBIT↔POP0J
	LACI 3,=10↔LAC 2,[POINT 7,4,-1]↔SETZB 4,5
L:	INCHWL↔CAIN 15↔GO EOL
	IDPB 2↔SOJG 3,L
	INCHWL↔CAIE 15↔GO .-2
	CRLF↔SKIPA
EOL:	INCHWL↔OUTCHR["*"]↔DAC 4,-2(1)↔DAC 5,-1(1)↔POP0J
BEND;2/9/73-------------------------------------------------------

SUBR(XBODY) ------------------------------------------------------
BEGIN XBODY; BODY RETRIEVAL - BGB - 20 FEBRUARY 1973.

	LAC PTR,PDLPTR
	SKIPN CTRL↔GO[CDR 1,PTR↔CAIGE 1,PADPDL+1↔GO .+1
		CALL(BGET,{(PTR)})↔DAC 1,(PTR)↔POP0J]

	LACI 2,=10			;TEN CHARACTERS TO A NAME.
	LAC  1,[POINT 7,4,-1]
	SETZB 3,6			;BODY SERIAL NUMBER.
	SETZB 4,5
L:	INCHWL↔CAIN 15↔GO EOL		;END OF LINE.
	IDPB 1↔CAIGE"0"↔GO .+3↔CAIG"9"↔GO[
	IMULI 3,12↔ANDI 0,17↔ADD 3,0↔GO .+2]
	SETOM 6				;NON-NUMERIC CHR SEEN.
	SOJG 2,L
	INCHWL↔CAIE 15↔GO .-2
	CRLF
	SKIPA
EOL:	INCHWL↔OUTCHR["*"]↔JUMPN 6,L2

;FETCH BODY BY ITS SERIAL NUMBER.
	LAC 1,WORLD↔CCW 1,1
	CAME 1,WORLD↔SOJG 3,.-2
	CAME 1,WORLD↔PUSH PTR,1
	DAC PTR,PDLPTR↔POP0J

;FETCH BODY BY ITS PNAME.
L2:	LAC 1,WORLD↔CCW 1,1
	CAME 1,WORLD
	GO[CAME 4,-2(1)↔GO L2+1
	   CAME 5,-1(1)↔GO L2+1↔GO .+1]
	CAME 1,WORLD↔PUSH PTR,1
	DAC PTR,PDLPTR↔POP0J
BEND;2/9/73-------------------------------------------------------
SUBR(MACRO)-------------------------------------------------------
BEGIN MACRO
	OPDEF PTO[711440B17]
	SKIPE CTRL↔GO L1
	PTO[0↔[ASCIZ"V\:)\E;E(E:J↑/*S--↑/@/:)\!"]]↔POP0J
L1:	PTO[0↔[ASCIZ"V:7@S*J!↑8/:\@S)↓>G↑:)!"]]
	POP0J
	LIT
BEND;2/9/73-------------------------------------------------------

SUBR(ATTDET)------------------------------------------------------
BEGIN ATTDET; ATTACH-DETACH COMMANDS & FRIENDS.
	EXTERN BDET,BATT,FVDUAL
	LAC 1,CHR
	CAIE 1,"D"↔GO L4

;DETACH, αDARKEN, βDUAL, εUNDARKEN.

	CDR 1,PDLPTR↔CAIGE 1,PADPDL+1↔POP0J	;DETACH.
	LAC 1,(1)↔TEST 1,BBIT↔GO L3
	SKIPE CTRL↔GO[CALL(FVDUAL,1)↔CALL(GEODPY)↔POP0J]
	CALL(BDET,1)↔POP0J
L3:	TEST 1,EBIT↔POP0J
	SLACI 0,(DARKEN)↔IORM(1)↔SKIPE CTRL↔ANDCAM(1)
	CALL(GEODPY)↔POP0J


;ATTACH, αNOP, βAXECNT.
L4:	SKIPE META↔GO[AOS 1,AXECNT		;STEP AXECNT.
	CAIL 1,4↔LACI 1,1↔DAC 1,AXECNT
	POP0J]
	CDR 1,PDLPTR↔CAIGE 1,PADPDL+2↔POP0J	;ATTACH.
	LAC 2,-1(1)↔LAC 1,(1)
	CALL(BATT,1,2)↔POP0J

BEND;2/9/73-------------------------------------------------------
XDPY: ;-----------------------------------------------------------
	LAC 1,CHR
	CAIN 1,"_"↔GO[
	LAC MCBITS↔DAC DPYFLG↔CALL(GEODPY)↔POP0J]
	CAIE 1,175↔POP0J
	LAC MCBITS↔PUSH P,DPYFLG↔DAC DPYFLG
	CALL(GEODPY)↔POP P,DPYFLG↔POP0J
XCOPY: ;----------------------------------------------------------
	EXTERN MKCOPY
	SKIPE CTRL↔GO[
	LAC 1,PDLPTR↔PUSH 1,CAMERA↔DAC 1,PDLPTR↔POP0J]
	LAC 16,PDLPTR↔CDR 1,16
	CAIGE 1,PADPDL+1↔POP0J
	LAC(1)↔CALL(MKCOPY,0)
	PUSH 16,1↔DAC 16,PDLPTR
	LACI 2↔DAC DPYFLG↔CALL(GEODPY)
	POP0J
XIN: ;------------------------------------------------------------
	EXTERN ICAM,INCRE,IFORM1	     ;INPUT FORMAT TYPE-1.
	SKIPE CTRL↔GO[CALL(ICAM)↔CALL(GEODPY)↔POP0J]
	SKIPE META↔GO[CALL(INCRE)↔CALL(GEODPY)↔POP0J]
	CALL(IFORM1)↔SKIPN 1↔POP0J
	LAC 16,PDLPTR↔PUSH 16,1↔DAC 16,PDLPTR
	CALL(GEODPY)
	POP0J
XOUT: ;-----------------------------------------------------------
	EXTERN OCAM,OFORM1	;OUTPUT FORMAT TYPE-1.
	SKIPE CTRL↔GO[CALL(OCAM)↔POP0J]
	CDR 1,PDLPTR↔CAIGE 1,PADPDL+1↔POP0J
	CALL(OFORM1,{(1)})
	POP0J
XBIN: ;-----------------------------------------------------------
	EXTERN BIN,BUN,BSUB,KLBFEV,MKCVEX
	CDR 1,PDLPTR↔CAIGE 1,PADPDL+2↔POP0J
	LAC 2,-1(1)↔LAC 1,(1)↔LAC CHR
	CAIN"∩"↔GO[CALL(BIN,2,1)↔GO .+5]
	CAIN"∪"↔GO[CALL(BUN,2,1)↔GO .+3]
	CAIN"¬"↔GO[CALL(BSUB,2,1)↔GO .+1]
	PUSH P,1↔CALL(GEODPY)↔CALL(MKCVEX,{(P)})
	LAC 1,PDLPTR↔POP 1,2↔DAC 1,PDLPTR
	CALL(KLBFEV,2)↔CDR 1,PDLPTR↔LAC 2,(1)↔POP P,(1)
	CALL(KLBFEV,2)↔CALL(GEODPY)↔POP0J
XWMAKE: ;---------------------------------------------------------
	EXTERN MKWORLD,MKWINDOW,MKCAMERA
	LAC 1,MCBITS
	PUSHJ P,@[MKWORLD↔MKWINDOW↔MKCAMERA↔MKCAMERA](1)
	LAC PTR,PDLPTR↔PUSH PTR,1↔DAC PTR,PDLPTR↔POP0J
XPLOTO:;----------------------------------------------------------
	EXTERN PLOTO
	SKIPE FLAGL↔GO[SETZM FLAGL↔OUTSTR[ASCIZ" FLAG L OFF. "]↔POP0J]
	CALL(PLOTO)↔OUTCHR["*"]↔POP0J
;-----------------------------------------------------------------
XTEXT:	CDR 1,PDLPTR
	CAIGE 1,PADPDL+1↔POP0J
	LAC 1,1↔TEST 1,VBIT↔POP0J
	POP0J
XCONVEX:CDR 1,PDLPTR
	CAIGE 1,PADPDL+1↔POP0J
	LAC(1)
	EXTERN MKCVEX↔CALL(MKCVEX,0)↔CALL(GEODPY)↔POP0J
END