perm filename SLICE[GEM,BGB] blob
sn#088704 filedate 1974-03-03 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00012 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00005 00002 TITLE SLICE
C00008 00003 SUBR(MKCUTZ,BODY,NUMBER) MAKE N BODY CUTS ALONG Z AXIS.
C00010 00004 SUBN(BOUNDS,BODY) MAKE BOUNDS CUBE.
C00012 00005 SUBR(SLICE0,BDYSET) SLICE A SET OF BODIES AT ZCUT LEVEL.
C00015 00006 SUBN(VMARK,BODY) MARK THE VERTICES OF A BODY AS PZ OR NZ.
C00017 00007 SUBN(FECUT,BODY) FACE EDGE CUTTING.
C00019 00008
C00021 00009 SUBN(FRCOPY,FACE0) COPY ORIGINAL FACE SET.
C00023 00010 SUBN(EDGCOE,EDGE) EDGE COEFFICIENTS FROM XWC,YWC.
C00025 00011 SUBR(SMOOTH,FACE,EPSILON)
C00026 00012 SUBN(MKGHOST,B)
C00027 ENDMK
C⊗;
TITLE SLICE
COMMENT ⊗------------------------------------------------------------
This code converts a polyhedron into a set of cross section
faces. The process destroys the orginal polyhedron a slice at a time.
The two main intermediate data structures are the set of pieces
remaining of the original body after each slice, BSET1; and the set
of cross sectional face lamina bodies that are generated, BSET2. As
the process runs, BSET1 decreases from the given polyhedron to null,
and BSET2 increases from null into the cross sectional lamina face
set which is returned as the result.
Naturally there are wheels within wheels: the outmost loop is
in MKCUTZ which cycles from ZMIN to ZMAX making slices. The next
significant loop is in SLICE0 which first cycles thru the set of body
pieces marking vertices (using VMARK) and collecting a list of lists
of edges (using FECUT); next SLICE0 cycles thru the list of lists
removing the very short edges (created by FECUT) which results in
UNGLUEing the two sides of a slice, leaving to fresh slice faces, the
upper one of which is then cons into the list FSET1.
--------------------------------------------------------------------⊗
EXTERN ESPLIT,INVERT,OTHER,VCCW,MKFE,ECCW,KLFE,GEODPY
EXTERN BGET,BATT,KLBFEV,MKCOPY,MKCUBE,TRANSL,MKB,KLEV
↓PZ ← 1B28
↓NZ ← 1B29
;--------------------------------------------------------------------
ZCUT: 0 ;CURRENT ZCUT LEVEL.
ZDELTA: 0 ;ZCUT INTERVAL.
BSET1: 0 ;SET OF ORIGINAL BODIES.
BSET2: 0 ;SET OF RESULTING BODIES.
FSET1: 0 ;SET OF ORIGINAL SLICE FACES (PZ) OM CAR8,,CDR8.
ELIST1: 0 ;LIST OF VERY SHORT EDGES IN ALT LINKS.
ELIST2: 0 ;LIST OF LAST SHORT EDGES IN ALT2 LINKS.
SLABFLG:0 ;SLAB PARITY FLAG.
DECLARE{XMIN,XMAX,YMIN,YMAX,ZMIN,ZMAX}
SUBR(MKCUTZ,BODY,NUMBER) ;MAKE N BODY CUTS ALONG Z AXIS.
;--------------------------------------------------------------------
;INITIALIZE BSET1 AND BSET2.
SETQ(BSET1,{MKB,[0]}) ;ORIGINAL BODY (AND ITS PIECES).
CALL(BATT,BODY,BSET1)
SETQ(BSET2,{BOUNDS,BODY}) ;RESULTING BODIES.
;Z SECTION WIDTH.
LAC 0,ZMAX↔LAC 1,ZMIN↔FSBR 0,1↔DAC 1,ZCUT
LAC 1,NUMBER↔DACN 1,COUNT#↔AOS 1
FSC 1,233↔FDVR 0,1↔DAC 0,ZDELTA
;LOOP FOR CUTTING CROSS SECTIONS.
L1: LAC ZDELTA↔FADRM ZCUT
SETQ(FSET1,{SLICE0,BSET1}) ;MAKE SLICE AT ZCUT.
CALL(FRCOPY,FSET1) ;COPY OFF FACE RING.
CALL(BATT,1,BSET2) ;ATTACH SECTIONS TO RESULTS.
CALL(KLNBDY,FSET1) ;KILL PIECES BELOW SLICE LEVEL.
SETCMM SLABFLG ;FLIP SLAB PARITY.
CALL(GEODPY)
AOSGE COUNT↔GO L1
CALL(KLBFEV,BSET1)
LAC 1,BSET2↔POP2J ;RETURN THE CROSS SECTIONS.
ENDR MKCUTZ;1/15/74(BGB)---------------------------------------------
SUBN(BOUNDS,BODY) ;MAKE BOUNDS CUBE.
;--------------------------------------------------------------------
ACCUMULATORS{B,V,XLO,XHI,YLO,YHI,ZLO,ZHI}
;FIND COORDINATE EXTREMA.
HRLOI XLO,377777↔HRLZI 400000
HRLOI YLO,377777↔HRLZI 400000
HRLOI ZLO,377777↔HRLZI 400000
LAC B,BODY↔LAC V,B
L1: PVT V,V↔CAMN V,B↔GO L2
CAMLE XLO,XWC(V)↔LAC XLO,XWC(V)↔CAMGE XHI,XWC(V)↔LAC XHI,XWC(V)
CAMLE YLO,YWC(V)↔LAC YLO,YWC(V)↔CAMGE YHI,YWC(V)↔LAC YHI,YWC(V)
CAMLE ZLO,ZWC(V)↔LAC ZLO,ZWC(V)↔CAMGE ZHI,ZWC(V)↔LAC ZHI,ZWC(V)
GO L1
;MAKE BOUNDS CUBE AND TRANSLATE IT TO PROPER POSITION.
L2: DAC XLO,XMIN↔DAC XHI,XMAX
DAC YLO,YMIN↔DAC YHI,YMAX
DAC ZLO,ZMIN↔DAC ZHI,ZMAX
FSBR XHI,XLO↔FADR XLO,XMAX↔FSC XLO,-1↔PUSH P,XLO
FSBR YHI,YLO↔FADR YLO,YMAX↔FSC YLO,-1↔PUSH P,YLO
FSBR ZHI,ZLO↔FADR ZLO,ZMAX↔FSC ZLO,-1↔PUSH P,ZLO
SETQ(BSET2,{MKCUBE,XHI,YHI,ZHI})
POP P,ZLO↔POP P,YLO↔POP P,XLO
CALL(TRANSLATE,BSET2,XLO,YLO,ZLO)
LAC 1,BSET2↔POP1J
ENDR BOUNDS;1/15/74(BGB)---------------------------------------------
SUBR(SLICE0,BDYSET) ;SLICE A SET OF BODIES AT ZCUT LEVEL.
;--------------------------------------------------------------------
;INITIALIZATION.
DZM ELIST2 ;LIST OF LISTS OF SHORT EDGES.
DZM FSET1 ;LIST OF PZ SLICE FACES.
;LOOP FOR CUTTING BODIES OF THE BODY SET.
LAC 1,BDYSET↔SON 1,1↔DAC 1,B0↔DAC 1,B ;INIT THE LOOP.
L1: CALL(VMARK,B) ;MARK VERTICES PZ & NZ.
SKIPN PZCNT↔GO .+3 ;PIECE FULLY BELOW.
SKIPE NZCNT↔GO[CALL(FECUT,B)↔GO .+1] ;CUT FACES AND EDGES.
LAC 1,B↔BRO 2,1↔DAC 2,B ;ADVANCE ALONG BODY RING.
SKIPN PZCNT↔GO[CALL(KLBFEV,1)↔GO .+1] ;KILL PIECE FULLY BELOW.
LAC 1,B↔CAME 1,B0↔GO L1 ;...AND FALL THRU.
;--------------------------------------------------------------------
;SLICE THE SOLID - MAPCAR UNGLUE DOWN THE ALT2 EDGE LIST 2.
L2: SKIPN 2,ELIST2↔GO L5
ALT2 1,2↔DAC 1,ELIST2
DAC 2,ELIST1
;KILL THE TIES THAT BIND - MAPCAR KLFE DOWN THE ALT EDGE LIST 1.
L3: SKIPN 2,ELIST1↔GO L4
ALT 1,2↔DAC 1,ELIST1
PFACE 0,2↔DAC 0,FACE1
SETQ(FACE2,{KLFE,2})↔GO L3
;PLACE THE NEW FACES OF THE SLICE INTO A RING.
L4: LAC 1,FACE1↔LAC 2,FACE2↔ALT. 1,2↔ALT. 2,1 ;TWO NEW FACES.
TEST 1,PZ↔EXCH 1,2↔SKIPE 4,FSET1↔GO .+5 ;THE PZ FACE.
DIP 1,8(1)↔DAP 1,8(1)↔DAC 1,FSET1↔GO L2 ;SELF RING.
CAR 3,8(4)↔DAP 1,8(3)↔DIP 3,8(1) ;RING IN.
DAP 4,8(1)↔DIP 1,8(4)↔GO L2
;--------------------------------------------------------------------
;UPDATE SET OF POSITIVE BODIES IN BSET1.
L5: LAC 1,FSET1↔DAC 1,FACE1
L6: LAC 1,FACE1↔CDR 1,8(1)↔DAC 1,FACE1 ;ADVANCE CUT-FACE RING.
PED 1,1↔CCW 1,1↔CALL(BATT,1,BSET1)
LAC 1,FACE1↔CAME 1,FSET1↔GO L6↔POP1J
DECLARE{EDGE,FACE1,FACE2,B,B0}
ENDR SLICE0;1/12/74(BGB)---------------------------------------------
SUBN(VMARK,BODY) ;MARK THE VERTICES OF A BODY AS PZ OR NZ.
;--------------------------------------------------------------------
ACCUMULATORS{V,PDEL,NDEL,E,E0}
;CLEAR THE NZ AND PZ BITS OF ALL THE EDGES AND VERTICES.
DZM PZCNT↔DZM NZCNT
LACI PZ+NZ↔LAC 1,BODY
ANDCAM(1)↔PVT 1,1↔CAME 1,BODY↔GO .-3
ANDCAM(1)↔PED 1,1↔CAME 1,BODY↔GO .-3
;POSITIVE AND NEGATIVE EPSILON.
LAC PDEL,ZCUT↔FADR PDEL,[0.01]
LAC NDEL,ZCUT↔FSBR NDEL,[0.01]
;FORCE THE VERTICES TO BE ABOVE OR BELOW THE SLICE PLANE.
LAC V,BODY
L1: PVT V,V↔CAMN V,BODY↔POP1J
L2: LAC ZWC(V)
CAML PDEL↔GO[MARK V,PZ↔AOS PZCNT↔GO L3]
CAMG NDEL↔GO[MARK V,NZ↔AOS NZCNT↔GO L3]
FSBR ZCUT
SKIPL ↔DAC PDEL,ZWC(V)
SKIPGE↔DAC NDEL,ZWC(V)↔GO L2
;MARK THE EDGES OF THIS VERTEX AS PZ OR NZ.
L3: PED E,V↔LAC E0,E
L4: PVT 1,E↔CAME 1,V↔GO .+3↔PCW 1,E↔GO L5 ;AC1 ← ECCW(E,V).
NVT 1,E↔CAME 1,V↔GO L1 ↔NCW 1,E
L5: IORM 0,(E)↔LAC E,1 ;AC0 CONTAINS THE BIT.
CAME E,E0↔GO L4↔GO L1
ENDR VMARK;1/11/74(BGB)---------------------------------------------
DECLARE{PZCNT,NZCNT}
SUBN(FECUT,BODY) ;FACE EDGE CUTTING.
;--------------------------------------------------------------------
ACCUMULATORS{V2,V1,DX,DY,DZ}
;SCAN THE EDGES OF THE BODY FOR ZCUT CROSSINGS.
LAC 1,BODY↔DAC 1,EDGE#
L0: LAC 1,EDGE↔NED 1,1↔DAC 1,EDGE ;ADVANCE ALONG EDGE RING.
CAMN 1,BODY↔POP1J ;TEST FOR END OF EDGE RING.
TEST 1,PZ↔GO L0 ;TEST FOR EDGE CROSSING.
TEST 1,NZ↔GO L0
;INITIALIZATION FOR FACE-EDGE CUT FOR A SINGLE SLICE FACE.
DOM FLAG ;FIRST TIME THRU FLAG -1.
DZM ELIST1 ;LIST OF VERY SHORT EDGES.
LAC 1,EDGE
DAC 1,E↔NVT 2,1↔TEST 2,PZ
GO[CALL(INVERT,E)↔GO .+1] ;FORCE NVT(E) INTO PZ HALF-SPACE.
LAC 1,E↔NFACE 1,1
DAC 1,F0↔DAC 1,F ;FIRST FACE.
;SPLIT EDGE - SO THAT PVT(E) IS IN NZ HALF SPACE.
L1: LAC 1,E↔MARKZ 1,PZ+NZ
NVT V1,1↔PVT V2,1↔PUSH P,V2↔PUSH P,V1 ;SAVE OLDE VERTICES.
TEST V1,PZ↔GO[CALL(INVERT,E)↔GO .+1] ;FORCE NVT(E) INTO PZZ.
SETQ(U2,{ESPLIT,E})↔MARK 1,PZ ;PZ HALFSPACE.
PED 1,1
LAC 2,ELIST1↔ALT. 2,1↔DAC 1,ELIST1 ;CONS EDGE INTO ELIST1.
SETQ(UU2,{ESPLIT,ELIST1})↔MARK 1,NZ ;NZ HALFSPACE.
;COMPUTE LOCUS WHERE E INTERSECTS THE SLICE PLANE.
POP P,V1↔POP P,V2 ;RESTORE OLDE VERTICES.
LAC DX,XWC(V2)↔FSBR DX,XWC(V1)
LAC DY,YWC(V2)↔FSBR DY,YWC(V1)
LAC DZ,ZWC(V2)↔FSBR DZ,ZWC(V1)
LAC ZCUT↔FSBR ZWC(V1)↔FDVR DZ↔LAC 2,U2 ;COEFFICIENT K.
FMPR DX,0↔FADR DX,XWC(V1)↔DAC DX,XWC(1)↔DAC DX,XWC(2)
FMPR DY,0↔FADR DY,YWC(V1)↔DAC DY,YWC(1)↔DAC DY,YWC(2)
FMPR DZ,0↔FADR DZ,ZWC(V1)↔DAC DZ,ZWC(1)↔DAC DZ,ZWC(2)
;FIRST TIME ONLY.
AOSG FLAG↔GO[
LAC U2↔DAC U0
LAC UU2↔DAC UU0↔GO L2]
;DOUBLE FACE SPLIT.
CALL(MKFE,U2,F,U1)
NFACE 1,1
CALL(MKFE,UU2,1,UU1)
;ADVANCE INTO THE NEXT FACE & FIND NEXT CROSSING EDGE.
L2: LAC U2↔DAC U1↔LAC UU2↔DAC UU1
SETQ(F,{OTHER,E,F})
CAMN 1,F0↔GO L4
L3: SETQ(E,{ECCW,E,F})
TEST 1,NZ↔GO L3
GO L1
;DOUBLE CUT LAST (FIRST) FACE.
L4: CALL(MKFE,U0,F,U1)
NFACE 1,1
CALL(MKFE,UU0,1,UU1)
;CONS ELIST1 INTO ELIST
LAC 1,ELIST1↔LAC 2,ELIST2
ALT2. 2,1↔DAC 1,ELIST2↔GO L0
DECLARE{F,E,U0,U1,U2,F0,FLAG,UU0,UU1,UU2}
ENDR FECUT;1/11/74(BGB)---------------------------------------------
SUBN(FRCOPY,FACE0) ;COPY ORIGINAL FACE SET.
;--------------------------------------------------------------------
DZM B0#
LAC 1,FACE0↔DAC 1,FACE#
L1: SETQ(F,{MKCOPY,FACE}) ;MAKE SECTION FACES FROM PZZ CUT FACE.
LAC 2,FACE↔ALT2. 1,2 ;PZZ CUT FACE POINTS AT SECTION FACE.
ALT 2,2↔ALT2. 1,2 ;NZZ CUT FACE POINTS AT SECTION FACE.
CALL(SMOOTH,F,[0.95])
LAC 1,F↔PED 1,1↔CCW 1,1 ;BODY GET.
SKIPN B0↔GO[DAC 1,B0↔GO L2]
CALL(BATT,1,B0)
L2: LAC 1,FACE↔CDR 1,8(1)↔DAC 1,FACE ;ADVANCE FACE RING.
CAME 1,FACE0↔GO L1
LAC 1,B0↔POP1J ;RETURN SET OF NEW FACES.
DECLARE{F}
ENDR FRCOPY;1/15/74(BGB)---------------------------------------------
SUBN(KLNBDY,FACE0) ;KILL NEGATIVE BODIES OF THE FACE RING.
;--------------------------------------------------------------------
ACCUMULATORS{F}
LAC 1,FACE0
L1: DAC 1,F1#↔ALT 1,1↔DAC 1,F2# ;NEGATIVE FACE (OR EMPTY).
CALL(BGET,1)↔CAME 1,F2↔GO[ ;BODY (OR EMPTY)
CALL(MKGHOST,1) ;MAKE GHOST OF THE SLAB.
CALL(KLBFEV,1)↔GO .+1] ;KILL A NEGATIVE SLAB BODY.
LAC 1,F1↔CDR 1,8(1) ;ADVANCE.
CAME 1,FACE0↔GO L1↔POP1J
ENDR KLNBDY;1/15/74(BGB)---------------------------------------------
SUBN(EDGCOE,EDGE) ;EDGE COEFFICIENTS FROM XWC,YWC.
ACCUMULATORS{E,S,V1,V2}
LAC E,EDGE↔NVT V1,E↔PVT V2,E
LAC YWC(V2)↔FSBR YWC(V1)↔DAC AA(E)↔FMPR↔DAC 1
LAC XWC(V1)↔FSBR XWC(V2)↔DAC BB(E)↔FMPR↔FADR 1,0
LAC XWC(V2)↔FMPR YWC(V1)
LAC S,XWC(V1)↔FMPR S,YWC(V2)↔FSBR S↔DAC CC(E)
CALL(SQRT↑,1)↔DAC 1,8(E)↔SLACI(<1.0>)↔FDVR 0,1
FMPRM AA(E)↔FMPRM BB(E)↔FMPRM CC(E)
POP1J
ENDR EDGCOE;7/23/73(BGB)--------------------------------------------
SUBN(QCROSS,EDGE1,EDGE2)
ACCUMULATORS{E1,E2}
LAC E1,EDGE1
LAC E2,EDGE2
LAC 0,AA(E1)↔FMPR 0,AA(E2)
LAC 1,BB(E1)↔FMPR 1,BB(E2)↔FADR 1,0
POP2J
ENDR QCROSS;---------------------------------------------------------
SUBN(VTEST,VERT)
LAC 1,VERT↔PED 2,1↔DAC 2,E1
SETQ(E2,{ECCW,E1,VERT})
CALL(EDGCOE,E1)
CALL(EDGCOE,E2)
LAC 1,[1.0]↔LAC 0,[0.01]
LAC 2,E1↔CAMLE 0,8(2)↔POP1J ;EDGE LENGTH TOO SHORT.
LAC 2,E2↔CAMLE 0,8(2)↔POP1J
CALL(QCROSS,E1,E2)↔POP1J ;ANGLE TOO SHARP OR SMOOTH.
DECLARE{E1,E2}
ENDR VTEST;----------------------------------------------------------
SUBR(SMOOTH,FACE,EPSILON)
LAC 1,FACE↔PED 1,1
DAC 1,EDGE0↔DAC 1,EDGE↔SETZ 4,
L0: SETQ(EDGE,{ECCW,EDGE,FACE})
CAME 1,EDGE0↔AOJA 4,L0
SUBI 4,3↔DAC 4,CNT
LAC 1,FACE↔PED 1,1
DAC 1,EDGE↔GO L2
L1: SETQ(VERTEX,{VCCW,EDGE,FACE})
CALL(VTEST,VERTEX)
MOVMS 1↔CAMG 1,EPSILON↔GO L2
SOSGE CNT↔POP2J
SETQ(EDGE,{KLEV,VERTEX})↔GO L3
L2: SETQ(EDGE,{ECCW,EDGE,FACE})
L3: LAC 2,FACE↔PED 0,2
CAME 0,1↔GO L1
SETQ(VERTEX,{VCCW,EDGE,FACE})
CALL(VTEST,VERTEX)
MOVMS 1↔CAMG 1,EPSILON↔POP2J
SETQ(EDGE,{KLEV,VERTEX})↔POP2J
DECLARE{EDGE,VERTEX,CNT,EDGE0}
ENDR SMOOTH;---------------------------------------------------------
SUBN(MKGHOST,B)
ACCUMULATORS{F,R0,R1,R2}
LAC F,B
DZM R0
L1: PFACE F,F
CAMN F,B↔POP1J
ALT2 R1,F↔JUMPE R1,L1
SKIPE SLABFLG↔GO L2 ;SLAB FLAG.
;EVEN SLABS.
JUMPE R0,[DAC R1,R0 ;FIRST ELEMENT IN RING.
DIP R0,4(R0)↔DAP R0,4(R0)↔GO L1]
CAR R2,4(R0) ;RING R1 INTO R0.
DIP R2,4(R1)↔DAP R1,4(R2)
DAP R0,4(R1)↔DIP R1,4(R0)↔GO L1
;ODD SLABS.
L2: JUMPE R0,[DAC R1,R0 ;FIRST ELEMENT IN RING.
DIP R0,5(R0)↔DAP R0,5(R0)↔GO L1]
CAR R2,5(R0) ;RING R1 INTO R0.
DIP R2,5(R1)↔DAP R1,5(R2)
DAP R0,5(R1)↔DIP R1,5(R0)↔GO L1
ENDR MKGHOST;--------------------------------------------------------
END