perm filename GEOMED.OLD[GEM,BGB] blob
sn#038346 filedate 1973-04-27 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00040 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00005 00002 TITLE GEOMED - GEOMETRIC EDITOR - BGB - JANUARY 1973.
C00007 00003 START ADDRESS INITIALIZATION-------------------------------------
C00009 00004 SUBR(UNDERFLOW)---------------------------------------------------
C00012 00005 SUBR(GEODPY)------------------------------------------------------
C00013 00006 SUBR(STADPY)------------------------------------------------------
C00015 00007 TRANSLATION STRENGTH.
C00017 00008 DISPLAY THE SCRATCH PAD PDL.
C00019 00009 SUBR(NTYPE)NODE --------------------------------------------------
C00021 00010 NODE RELLOCATION BITS.
C00023 00011 SUBR(DPYNODE)NODE ------------------------------------------------
C00024 00012 L1:
C00026 00013 SUBR(GEOMED)------------------------------------------------------
C00028 00014 ASCII 00 TO 37--------------------------------------------------
C00031 00015 ASCII 40 TO 100-------------------------------------------------
C00034 00016 ASCII 101 TO 132 UPPER CASE-------------------------------------
C00037 00017 SUBR COMHLP
C00038 00018 1. "V"-COMMAND. MAKE VERTEX BODY.
C00039 00019 SUBR(MIDPOI)------------------------------------------------------
C00041 00020 2. "E"-COMMAND. SWEEP WIRE.
C00042 00021 3. "J"-COMMAND. JOIN VERTICES.
C00044 00022 4. ":()-*" COMMANDS. EUCLIDEAN TRANSFORMATION COMMANDS.
C00046 00023 MAKE REFERENCE FRAME.
C00048 00024 APPLY THE TRANSFORMATION.
C00049 00025 WINDOW TRANFORMATION.
C00050 00026 5. SWITCH MODIFYING COMMANDS.
C00052 00027 6. STACK MODIFYING COMMANDS.
C00054 00028 "/" COMMAND.-----------------------------------------------------
C00056 00029 XFOCAL: OUTSTR[ASCIZ/ FOCAL = /]↔CALL(REALIN)
C00057 00030 SUBR REALIN
C00059 00031 8. SWEEP COMMANDS.
C00061 00032 SUBR(XKILL)-------------------------------------------------------
C00063 00033 9. LINK FOLLOWING COMANDS.
C00065 00034 OTHER LINK COMMANDS.
C00067 00035 SUBR(XNAME) ------------------------------------------------------
C00070 00036 SUBR(MACRO)-------------------------------------------------------
C00072 00037 XDPY: -----------------------------------------------------------
C00074 00038 XBIN: -----------------------------------------------------------
C00076 00039 T MAKE A TEXT NODE
C00078 00040 XCONVEX:CDR 1,PDLPTR
C00079 ENDMK
C⊗;
TITLE GEOMED - GEOMETRIC EDITOR - BGB - JANUARY 1973.
;EDITOR STATUS.
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,[=260],[-=70])
CALL(AVECT,[=260],[-=380])
CALL(AVECT,[=508],[-=380])
CALL(AVECT,[=508],[-=70])
CALL(AVECT,[=260],[-=70])
CALL(DPYBIG,[1])
CALL(JDPY,ARG1)
CALL(DPYSTR,{[[ASCIZ" "]]})
SETQ(KIND,{NTYPE,ARG1})
LAC [POINT 7,LNKCHR]
DAC LNKPTR
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,[=265],Y)
ILDB 1,LNKPTR ;PICK UP LINK CHARACTERS (LEFT HALF)
CALL(DTYO,1)
CALL(DTYO,[" "]) ;A SPACE BETWEEN THEM
ILDB 1,LNKPTR ;(RIGHT HALF)
CALL(DTYO,1)
CALL(DTYO,[" "]) ;A SPACE BEFORE A NUMBER
SKIPGE WRD↔GO .+3↔CALL(DTYO,[" "]) ;AND ANOTHER IF NOT NEGATIVE
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
LNKCHR: ASCIZ/ <>≤≥∨∧∩∪⊂⊃←→.,/
DECLARE{WRD,X,Y,KIND,RELTMP,CONTMP,LNKPTR}
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",COMHLP,{ H HELP})
$$("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})
;----------------------------------------------------------------
SUBR COMHLP
EXTERNAL TVHELP
CALL(TVHELP,[[SIXBIT/GEOMEDHLP/↔0↔SIXBIT/DOCBGB/]])
POP0J
;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
SUBR 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
;-----------------------------------------------------------------
;T MAKE A TEXT NODE
BEGIN XTEXT
EXTERNAL MKNODE
↑XTEXT:
ACCUMULATORS{V,TXTPTR,TXTNODE}
CDR 1,PDLPTR ;GET PDL POINTER
CAIGE 1,PADPDL+1↔POP0J ;IS THERE ANYTHING?, IF NOT RETURN
LAC V,(1) ;GET ARG OFF PDL
TEST V,VBIT↔POP0J ;IF IT ISN'T A VERTEX, RETURN QUICKLY
PTEXT TXTNODE,V
JUMPN TXTNODE,EXISTS
CALL(MKNODE,[$TEXT]) ;MAKE A TEXT NODE
MOVE TXTNODE,1
L1: OUTSTR[ASCIZ/TYPE TEXT: /]
PTEXT. TXTNODE,V ;USE THE TJOINT LINK
MOVE TXTPTR,TXTNODE ;MAKE A BYTE POINTER
HRLI TXTPTR,000700
MOVEI 2,5*8-1 ;MAX. NUMBER OF CHARACTERS PER NODE
CHLOOP: INCHWL 1 ;GET A CHARACTER
CAIN 1,175
POP0J
IDPB 1,TXTPTR
SOJG 2,CHLOOP
OUTSTR[ASCIZ/LINE TOO LONG, TRUNCATED. /]
CLRBFI ;TOO LONG, FLUSH TYPEAHEAD
POP0J
EXISTS: OUTSTR[ASCIZ/TEXT ALREADY EXISTS, DELETE? /]
INCHRW 0
ANDI 0,137
CAIE 0,"Y"
POP0J
GO L1
BEND XTEXT;25-APR-73(TVR)
XCONVEX:CDR 1,PDLPTR
CAIGE 1,PADPDL+1↔POP0J
LAC(1)
EXTERN MKCVEX↔CALL(MKCVEX,0)↔CALL(GEODPY)↔POP0J
END SA