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