perm filename GEOMED.FAI[GEM,BGB]2 blob
sn#046307 filedate 1973-05-31 generic text, type T, neo UTF8
COMMENT ⊗ VALID 00041 PAGES
RECORD PAGE DESCRIPTION
00001 00001
00011 00002 TITLE GEOMED - GEOMETRIC EDITOR - BGB - JANUARY 1973.
00014 00003 START ADDRESS INITIALIZATION-------------------------------------
00016 00004 NSUBR UNDERFLOW ENABLE & SERVICE ARITHMETIC INTERRUPTS.
00019 00005 NSUBR GEODPY GEOMED'S DISPLAY REFRESH
00020 00006 NSUBR STADPY STATUS DISPLAY
00022 00007 ----- STADPY TRANSLATION STRENGTH.
00024 00008 ----- STADPY DISPLAY THE SCRATCH PAD PDL.
00026 00009 SUBRS NTYPE,JDPY Node Type number, Display pointer
00027 00010 TABLES REL,CONTYP,NNAMES,NLETTER Node Info. Tables
00030 00011 NSUBR DPYNODE,NODE DISPLAY CONTENTS OF NODE LOWER RIGHT OF SCREEN.
00033 00012 NSUBR GEOMED TELETYPE COMMAND JUMP TABLE
00035 00013 ASCII 00 TO 37--------------------------------------------------
00038 00014 ASCII 40 TO 100-------------------------------------------------
00041 00015 ASCII 101 TO 132 UPPER CASE-------------------------------------
00044 00016 NSUBR COMHLP
00045 00017 NSUBR VBODY 1. "V"-COMMAND. MAKE VERTEX BODY.
00046 00018 NSUBR MIDPOI MIDPOINT AN EDGE PROPORTIONAL TO DDEL
00047 00019 COMMANDS XINVERT,XEVERT "|","¬"
00049 00020 NSUBR SWIRE 2. "E"-COMMAND. SWEEP WIRE.
00050 00021 NSUBR JOINVV 3. "J"-COMMAND. JOIN VERTICES.
00052 00022 NSUBR EUTRAN 4. ":()-*" COMMANDS. EUCLIDEAN TRANSFORMATION COMMANDS.
00054 00023 ----- EUTRAN MAKE REFERENCE FRAME.
00056 00024 ----- EUTRAN APPLY THE TRANSFORMATION.
00057 00025 ----- EUTRAN WINDOW TRANFORMATION.
00058 00026 5. SWITCH MODIFYING COMMANDS. "|@∃=QE"
00060 00027 6. STACK MODIFYING COMMANDS. "↔↓↑"
00062 00028 STRENGTH COMMANDS "/\0123456789"
00064 00029 COMMAND XFOCAL
00065 00030 COMMANDS XTDEL,XDDEL,XRDEL "λπ%"
00067 00031 8. SWEEP COMMANDS. "SG"
00069 00032 NSUBR XKILL "K"
00070 00033 NSUBR LINKER 9. LINK FOLLOWING COMANDS.
00072 00034 ----- LINKER OTHER LINK COMMANDS.
00075 00035 COMMANDS XNAME,XBODY "B","N"
00079 00036 SUBRS MACRO,ATTDET "∞","AD"
00081 00037 COMMANDS XDPY,XCOPY,XIN,XOUT "_",<ALT>,"C","I","O"
00084 00038 COMMANDS XBIN,XWMAKE,XPLOTO "α∩","α∪","¬","W","P"
00086 00039 COMMAND XTEXT "T" MAKE A TEXT NODE
00089 00040 COMMAND XCONVEX
00092 00041 TAIL
00093 ENDMK
⊗;
TITLE GEOMED - GEOMETRIC EDITOR - BGB - JANUARY 1973.
;EDITOR STATUS.
INTERNAL PDL
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.
ODPYFLG: 2 ;OLD GEODPY STICKY DISPLAY MODE.
DDSTA: 0 ;DD CHANNEL FOR STATUS
DDGEO: 0 ;DD CHANNEL FOR POLYGON DISPLAY
;IO OPERATIONS
EXTERN GETCHW ;GET A CHARACTER (IN CHARACTER MODE FOR TTY)
EXTERN GETCHL ;GET A CHARACTER (IN LINE MODE FOR TTY)
EXTERN GETCL0,GETCW0 ;SAME EXCEPT RETURNS RESULT IN 0 INSTEAD 1.
;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
;DISPLAY
EXTERN DDSET
BITDEFS {,PZZ,TMPBIT,JUTBIT,JOTBIT,NORTH,SOUTH,EAST,WEST,,NZZ,FOLDED,VISIBLE,POTENT,VBIT,EBIT,FBIT,BBIT,TBIT1,TBIT2,TBIT3}
;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.
CALL(DOINIT) ;DO INITIALIZATION CODE
;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]
PGIOT 2, ;CLEAR PIECES OF GLASS
PPIOT 2,-=250↔PPIOT 3,3003
CALL(CRLF20)
CALL(UNDERFLOW)
CALL(GEODPY)
CALL(GEOMED)
CALLI 12
;2/4/73-----------------------------------------------------------
NSUBR UNDERFLOW ;ENABLE & SERVICE ARITHMETIC INTERRUPTS.
EXTERNAL JOBTPC,JOBAPR
;ENABLE INTERRUPT ROUTINE.
EXTERNAL TRAPINIT
JRST TRAPINIT
COMMENT ⊗
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,SETZOP,35] ;modify the SETZ
MOVE 1,SAVE1 ;restore ACs
XCT SETZOP ;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↔GO ZDIV ;SKIP ON FLOATING OVERFLOW.
MOVE 1,BP2↔JSR NUMOUT
;OUTSTR MESS2
JRST WO
ZDIV: TLNN 1,40↔GO NOTIN ;SKIP ON ZERO DIVIDE.
LAC 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
SETZOP: SETZ 0,
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/
⊗;
SUBREND UNDERFLOW;
NSUBR GEODPY ;GEOMED'S DISPLAY REFRESH
EXTERN SHOW1,SHOW2,SHOW3,SHOW4
LACI 1↔DAC GLASS#
CALL(DDSET,[DDGEO])
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}
SUBREND GEODPY;12-FEB-73(BGB),12-MAR-73(BGB)
NSUBR STADPY ;STATUS DISPLAY
EXTERN DECDPY,DPYSTR,FDPY,EDPY,VDPY,DTYO,IDPY
EXTERN AIVECT,AVECT,BUFDPY,FLODPY,DPYOUT,DPYSET
EXTERN DPYBUF
CALL(DDSET,[DDSTA])
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)
;----- STADPY ;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)
;----- STADPY 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
SUBREND STADPY;2-FEB-73(BGB),1-DEC,73(BGB)
;SUBRS NTYPE,JDPY ;Node Type number, Display pointer
;____________________________________________________________________
;
NSUBR NTYPE,NODE ;NODE TYPE NUMBER 0 TO 17.
LAC 1,@NODE ;TYPE BITS WORD.
SKIPGE 1↔SETZ 1, ;NEGATIVE BIT.
TLNE 1,(1B9)↔SETZ 1, ;NORMALIZATION BIT.
ANDI 1,17↔POP1J
SUBREND NTYPE;25-MAR-73(BGB)
;____________________________________________________________________
;
NSUBR JDPY,NODE
SKIPN 1,NODE↔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},NODE)
POP1J
SUBREND JDPY;25-MAR-73(BGB)
;TABLES REL,CONTYP,NNAMES,NLETTER ;Node Info. Tables
;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.
;
INTERNAL REL
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 0004, 0004 ;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 0140, 0140 ;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.
BYTE(9)000,000,001,000 ;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.
;NODE NAMES.
INTERN NNAMES
NNAMES:
[ASCIZ"FRAME"]↔[ASCIZ"EMPTY"]↔[ASCIZ"UNIVERSE"]↔[ASCIZ"LAMP"]
[ASCIZ"CAMERA"]↔[ASCIZ"WORLD"]↔[ASCIZ"WINDOW"]↔[ASCIZ"IMAGE"]
[ASCIZ"TEXT"]↔[ASCIZ"XNODE"]↔[ASCIZ"YNODE"]↔[ASCIZ"ZNODE"]
[ASCIZ"BODY"]↔[ASCIZ"FACE"]↔[ASCIZ"EDGE"]↔[ASCIZ"VERTEX"]
;NODE INITIALS.
INTERN NLETTER
NLETTER:
"R" ↔ "M" ↔ "U" ↔ "L"
"C" ↔ "W" ↔ "D" ↔ "I"
"T" ↔ "X" ↔ "Y" ↔ "Z"
"B" ↔ "F" ↔ "E" ↔ "V"
NSUBR DPYNODE,NODE ;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,NODE)
CALL(DPYSTR,{[[ASCIZ" "]]})
SETQ(KIND,{NTYPE,NODE})
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,NODE↔ADD 1,WRD
CALL(FLODPY,{(1)},[4])↔GO L2]
;LEFT HALF.
CALL(AIVECT,[=345],Y)
LAC 1,NODE↔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,NODE↔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}
SUBREND DPYNODE; BGB 25 MARCH 1973
NSUBR SEENODE,NODE
PUSHACS
CALL(DPYSET,[DPYBUF])
CALL(DPYNODE,NODE)
CALL(DPYOUT,[0])
POPACS
POP1J
SUBREND SEENODE;4-MAY-73(TVR)
NSUBR GEOMED ;TELETYPE COMMAND JUMP TABLE
L0: CRLF
L1: OUTCHR["*"]
L2: CALL(STADPY)
LAC ALPHA↔DAC CTRL↔SETZM ALPHA
LAC BETA ↔DAC META↔SETZM BETA
CALL(GETCW0)
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
SUBREND GEOMED;2/4/73(BGB)
NOP: OUTCHR CHR↔OUTSTR[ASCIZ/ NO OPERATION./]↔CRLF↔POP0J
QMARK: CALL(GETCW0)↔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-------------------------------------------------
$$(" ",XREDPY,{ 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",NEWMAC,{ Z MACRO CALL, αZ EDIT MACRO.})
;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})
;----------------------------------------------------------------
NSUBR COMHLP
EXTERNAL TVHELP
CALL(TVHELP,[[SIXBIT/GEOMEDHLP/↔0↔SIXBIT/DOCBGB/]])
POP0J
SUBREND
NSUBR VBODY ;1. "V"-COMMAND. MAKE VERTEX BODY.
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
SUBREND;2/4/73(BGB)
NSUBR MIDPOI ;MIDPOINT AN EDGE PROPORTIONAL TO DDEL
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
SUBREND MIDPOI;2/8/73(BGB)
;COMMANDS XINVERT,XEVERT ;"|","¬"
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(BGB)------------------------------------------------------
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(BGB)-----------------------------------------------------
NSUBR SWIRE ;2. "E"-COMMAND. SWEEP WIRE.
;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.
SUBREND SWIRE;2/4/73(BGB)
NSUBR JOINVV ;3. "J"-COMMAND. JOIN VERTICES.
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
SUBREND JOINVV;2/5/73(BGB)
NSUBR EUTRAN ;4. ":;()-*" COMMANDS. EUCLIDEAN TRANSFORMATION COMMANDS.
;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
;----- EUTRAN ;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.
;----- EUTRAN ;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}
;----- EUTRAN ;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
SUBREND EUTRAN;2/4/73(BGB)
;5. SWITCH MODIFYING COMMANDS. ;"|@∃=QE"
; ! 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
;STRENGTH COMMANDS ;"/\0123456789"
;"/" 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)
;-----------------------------------------------------------------
;COMMAND XFOCAL
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
;COMMANDS XTDEL,XDDEL,XRDEL ;"λπ%"
COMMENT⊗REALIN MOVED TO ARITH.FAI
NSUBR 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: CALL(GETCHL)
CAIN 1,15↔CALL(GETCHL)
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
SUBREND REALIN;12/16/72(BGB)
⊗;
EXTERNAL REALIN
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. ;"SG"
NSUBR 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
SUBREND;2/10/73(BGB)
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
NSUBR XKILL ;"K"
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
SUBREND XKILL;2/10/73------------------------------------------------------
NSUBR LINKER ;9. LINK FOLLOWING COMANDS.
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
;----- LINKER ;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]
ANDI 0,17 ;GET TYPE NUMBER
CAIN 0,$TEXT
GO [LAC CHR ;SPECIAL HACK FOR TEXT LIST
CAIN"."↔GO[TCCW 2,2↔SKIPE 2↔DAC 2,(1)↔POP0J] ;CCW TEXT
CAIN","↔GO[ TCW 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
SUBREND LINKER;2/9/73(BGB)
;COMMANDS XNAME,XBODY ;"B","N"
NSUBR XNAME ;NAME A BODY
CDR 1,PDLPTR↔CAIGE 1,PADPDL+1↔POP0J
LAC 1,(1)↔TEST 1,BBIT↔POP0J
CALL(RDNAME)
JUMPE 6,[ OUTSTR[ASCIZ/ILLEGAL NAME.
*/]↔ POP0J]
CALL(FNDNAME)
GO [ LAC 1,PDLPTR↔LAC 1,(1)
DAC 4,-2(1)↔DAC 5,-1(1)
OUTSTR[ASCIZ/*/]↔POP0J ]
OUTSTR[ASCIZ/NAME ALREADY IN USE.
*/]↔ POP0J
SUBREND XNAME;2/9/73(BGB)
;____________________________________________________________________
;
NSUBR 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]
CALL(RDNAME)↔JUMPN 6,L2
;FETCH BODY BY ITS SERIAL NUMBER.
LAC 1,WORLD↔CCW 1,1
CAME 1,WORLD↔SOJG 3,.-2
CAME 1,WORLD↔GO RET
LOSE: OUTSTR[ASCIZ/BODY NOT FOUND.
*/]↔ POP0J
;FETCH BODY BY ITS PNAME.
L2: CALL(FNDNAME)
GO LOSE
RET: PUSH PTR,1
DAC PTR,PDLPTR
OUTSTR[ASCIZ/*/]↔POP0J
SUBREND XBODY;2/9/73(BGB)
NSUBR RDNAME
OUTSTR[ASCIZ/ :/]
LACI 2,=10 ;TEN CHARACTERS TO A NAME.
LAC 1,[POINT 7,4,-1]
SETZB 3,6 ;BODY SERIAL NUMBER.
SETZB 4,5
L: CALL(GETCL0)↔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
CALL(GETCL0)↔CAIE 15↔GO .-2
CRLF
SKIPA
EOL: CALL(GETCL0)↔POP0J
SUBREND RDNAME;
NSUBR FNDNAME
;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↔AOS(P)
POP0J
SUBREND FNDNAME;2/9/73(BGB)
;SUBRS MACRO,ATTDET ;"∞","AD"
NSUBR(MACRO)
OPDEF PTO[711440B17]
MOVE 1,MCBITS
PTO @[[0↔MACRO0]
[0↔MACRO1]
[0↔MACRO2]
[0↔MACRO3]] (1)
POP0J
MACRO0: ASCIZ"V\:)\E;E(E:J↑/*S--↑/@/:)\!"
MACRO1: ASCIZ"V:7@S*J!↑8/:\@S)↓>G↑:)!"
MACRO2: ASCIZ"⊗αW↔∪A⊃⊃↔βWA↑βAβAβ/β-λ256
):↔β-);//β\β*(↔β*(λ.25
⊃:↔⊂;\\↑↑βA"
MACRO3: 0
LIT
SUBREND MACRO;2/9/73(BGB)
;____________________________________________________________________
;
NSUBR 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 META↔GO[CALL(FVDUAL,1)↔CALL(GEODPY)↔POP0J]
CALL(BDET,1)↔POP0J
L3: TEST 1,EBIT↔POP0J
SLACI 0,(DARKEN)↔IORM(1)↔SKIPE META↔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
SUBREND ATTDET;2/9/73(BGB)
;COMMANDS XDPY,XCOPY,XIN,XOUT ;"_",<ALT>,"C","I","O"
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↔DAC ODPYFLG
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,IFORM0,IFORM1 ;INPUT FORMAT TYPE-1.
SKIPE CTRL↔GO[SKIPE META
GO [ CALL(IFORM0)↔CALL(GEODPY)↔POP0J]
CALL(ICAM)↔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,OFORM0,OFORM1 ;OUTPUT FORMAT TYPE-1.
SKIPE CTRL↔GO[SKIPE META
GO [ CALL(OFORM0)↔POP0J]
CALL(OCAM)↔POP0J]
CDR 1,PDLPTR↔CAIGE 1,PADPDL+1↔POP0J
CALL(OFORM1,{(1)})
POP0J
;COMMANDS XBIN,XWMAKE,XPLOTO ;"α∩","α∪","¬","W","P"
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
CALL(PLOTO)↔OUTCHR["*"]↔POP0J
;COMMAND XTEXT ;"T" MAKE A TEXT NODE
BEGIN XTEXT
EXTERNAL MKNODE
↑XTEXT:
ACCUMULATORS{V,TXTPTR,CWNODE,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
CALL(EDTEXT,V)
JCALL GEODPY
BEND XTEXT;25-APR-73(TVR)
NSUBR NEWMAC
EXTERNAL MACPTR,MACCNT,MACNOD,IFORM2
↑NEWMAC:SKIPE META
JCALL IFORM2
SKIPN CTRL
GO [ CALL(RDNAME)
CALL(FNDNAM) ;Is there a macro by that name?
GO [ OUTSTR[ASCIZ/NO SUCH MACRO
*/] ;No, return
POP0J ]
PVT 1,1 ;Get vertex of body
JUMPE 1,[FATAL(BODY WITHOUT VERTEX!)] ;Nothing there!
PTEXT 1,1 ;Text of vertex
JUMPE 1,[OUTSTR[ASCIZ/NOT A MACRO.
*/]↔ POP0J] ;Nothing there!
TESTZ 1,VBIT ;Better not be a TJOINT
POP0J ;Oops!
OUTSTR[ASCIZ/<ENTERING MACRO>
/]
MOVEM 1,MACNOD
HRLI 1,000700 ;Make a byte pointer
MOVEM 1,MACPTR
MOVEI 0,5*8-1 ;And a count
MOVEM 0,MACCNT
POP0J ] ;Now, return
CALL(RDNAME)
CALL(FNDNAM)
SKIPA
GO [ OUTSTR[ASCIZ/Name already in use/]
PVT 1,1 ;Get vertex of body
PTEXT 0,1
JUMPN 0,[ OUTSTR[ASCIZ/. Will edit.
/]↔ CALL(EDTEXT,1)
POP0J ]
OUTSTR[ASCIZ/ and not a macro.
*/]↔ POP0J ]
PUSHP 4 ;Save print name
PUSHP 5
SETQ(BNEW,{MKB,WORLD}) ;Make a new body
POPP -1(1) ;Set print name
POPP -2(1)
CALL(MKV,BNEW) ;Make a vertex
EDIT: CALL(EDTEXT,1) ;Put text on it
POP0J
DECLARE{BNEW}
SUBREND NEWMAC
;COMMAND XCONVEX
XCONVEX:CDR 1,PDLPTR
CAIGE 1,PADPDL+1↔POP0J
LAC(1)
EXTERN MKCVEX↔CALL(MKCVEX,0)↔CALL(GEODPY)↔POP0J
XREDPY: CALL(STADPY)
PUSH P,DPYFLG
MOVE ODPYFLG
MOVEM DPYFLG
CALL(GEODPY)
POP P,DPYFLG
POP0J
TAIL
END SA