perm filename CMPARE[GEM,BGB] blob
sn#050720 filedate 1973-08-08 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00016 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00004 00002 TITLE CMPARE - COMPARE IMAGES - BGB - APRIL 1973.
C00006 00003 SUBR(CMCNII)IMG1,IMG2 I. COMPARE & CONNECT IMAGE IMAGE.
C00011 00004 SUBR(CMCNLL)LEV1,LEV2 I. COMPARE & CONNECT LEVEL LEVEL.
C00013 00005 SUBR(CMCNPP)L1,L2 I. COMPARE & CONNECT POLYGONS POLYGONS.
C00015 00006 SUBR(CMCNSP)SL,PL,FLG I. COMPARE & CONNECT SHAPES POLYGONS.
C00017 00007 SUBR(MKSHAP)LEVEL II. MAKE PGN SHAPE NODES FOR A LEVEL.
C00022 00008 SUBR(FUSION)S1,S2 II. MAKE A FUSION SHAPE NODE.
C00025 00009 SUBR(MKFURN)LEVEL,FLG II. MAKE FUSION RING OF A LEVEL.
C00027 00010 SUBR(KLFURN)LEVEL,FLG II. KILL FUSION RING OF A LEVEL.
C00028 00011 SUBR(CMPARE)S1,S2 III. COMPARE SHAPE SHAPE PASS FAIL.
C00030 00012 SUBR(CNNECT)S1,S2 III. CONNECT SHAPE SHAPE.
C00032 00013 SUBR(CMCNVV)P1,P2 IV. COMPARE AND CONNECT VERTICES.
C00035 00014 SUBR(SPLIT)WINDOW IV. WINDOW SPLIT.
C00039 00015 SUBR(MATE1)WINDOW IV. MATE VERTICES IN WINDOW.
C00040 00016 SUBR(MATE2)PTR1,PTR2 IV. FIND VERTEX MATES PTR1 PTR2.
C00053 ENDMK
C⊗;
TITLE CMPARE - COMPARE IMAGES - BGB - APRIL 1973.
EXTERN AV,AI,DPYSET,DPYBUF,DPYOUT,GETXY,AIVECT,DTYO
EXTERN MKNODE,KLNODE
EXTERN ECOMP ;ENABLE COMPARE AND ATTACH ROUTINES.
EXTERN ASIN,SIN,ACOS,COS
;VERTEX COMPARE WINDOW.
EPSILN: 6⊗6 ;SHAPE CENTER OF MASS DELTA MATCH.
EPSLN2: 36⊗=12 ;VERTEX LOCUS DELTA MATCH.
↓LINK ←←0 ;POINTER TO PREVIOUS WINDOW.
↓RMIN ←←1
↓RMAX ←←2
↓CMIN ←←3
↓CMAX ←←4
↓FLAG ←←5 ;0 FOR ROW. -1 FOR COL.
↓M ←←6 ;NUMBER OF POLYGON-1 VERTICES.
↓N ←←7 ;NUMBER OF POLYGON-2 VERTICES.
;SHAPE NODE LINK NAMES.
DEFINE PERM.(A,Q){HLLM A,1(Q)} ↔ DEFINE PERM(A,Q){HLLE A,1(Q)}
DEFINE AREA.(A,Q){HLRM A,1(Q)} ↔ DEFINE AREA(A,Q){HRLE A,1(Q)}
DEFINE PXY. (A,Q){HLLM A,4(Q)} ↔ DEFINE PXY (A,Q){HLLE A,4(Q)}
DEFINE MZZ. (A,Q){HLRM A,4(Q)} ↔ DEFINE MZZ (A,Q){HRLE A,4(Q)}
DEFINE MXX. (A,Q){HLLM A,6(Q)} ↔ DEFINE MXX (A,Q){HLLE A,6(Q)}
DEFINE MYY. (A,Q){HLRM A,6(Q)} ↔ DEFINE MYY (A,Q){HRLE A,6(Q)}
↓SHPREL←←300030
;COMPARE QUALIFING QUANTIES:
INTERN QQCNTR,QQPRAX,QQMZZ,QQAREA,QQPERM
QQCNTR: 8.0
QQPRAX: 0
QQMZZ: 0.06 ;SIX PER CENT.
QQAREA: 0
QQPERM: 0
;ULTRA-FUNCTIONAL DATA TRANSMISSIONS.
DECLARE{ROWDEL,COLDEL} ;PASS SHAPE ALLIGNMENT FROM CMPARE TO CMCNVV.
SUBR(CMCNII)IMG1,IMG2 ;I. COMPARE & CONNECT IMAGE IMAGE.
BEGIN CMCNII;_____________________________________________________
COMMENT ⊗
Main outer loop. CMCNII compares the polygons of two images
and connects polygons and vertices that correspond. CMCNII itself is
merely a MAPC thru the level rings of the two images. ⊗
;INITIAL LEVELS OF THE IMAGES.
LAC 1,ARG2 ;IMAGE 1.
LAC 2,ARG1 ;IMAGE 2.
CAMN 1,2↔POP2J ;DON'T CONNECT AN IMAGE TO ITSELF.
SON 1,1↔SON 2,2 ;FIRST LEVELS OF THESE IMAGES.
DAC 1,LEV0#
;RING AROUND THE LEVELS OF EACH IMAGE.
L1: DAC 1,LEV1#↔DAC 2,LEV2#
CALL(CMCNLL,LEV1,LEV2)
LAC 1,LEV1↔CCW 1,1
LAC 2,LEV2↔CCW 2,2
CAME 1,LEV0↔GO L1
;CLEAR DIAGONOSTIC GLASS 5 AND 14.
SETZB 0,1↔UPGIOT 14,0↔UPGIOT 5,0
POP2J
BEND CMCNII; BGB 13 APRIL 1973 ___________________________________
SUBR(CMCNLL)LEV1,LEV2 ;I. COMPARE & CONNECT LEVEL LEVEL.
BEGIN CMCNLL;_____________________________________________________
COMMENT ⊗ Make polygon shapes for the current level. Compare all the
polygon shapes of the previous level with all the polygon shapes of
the current level and connect polygons on exact compare true. Then
make fusion shape ring of previous level's p-unmated polygons and
compare with the n-unmated polygons of the current level and connect
polygons two to one on compare true. Then make fusion shape ring of
current level's n-unmated polygons and compare with the p-unmated
polygons of the previous level. ⊗
LAC ARG2↔DAC LEVEL1
LAC ARG1↔DAC LEVEL2
CALL(MKSHAP,LEVEL1) ;NOP IF SHAPES ALREADY EXIST.
CALL(MKSHAP,LEVEL2)
CALL(CMCNPP,LEVEL1,LEVEL2) ;FOR EXACT MATCHS.
CALL(MKFURN,LEVEL1,[0])
CALL(CMCNSP,LEVEL1,LEVEL2,[0]) ;FOR FUSION MATCHS.
CALL(KLFURN,LEVEL1)
CALL(MKFURN,LEVEL2,[-1])
CALL(CMCNSP,LEVEL2,LEVEL1,[-1]) ;FOR FISSION MATCHS.
CALL(KLFURN,LEVEL2)
POP2J
DECLARE{LEVEL1,LEVEL2}
BEND CMCNLL; BGB 4 MAY 1973 --------------------------------------
SUBR(CMCNPP)L1,L2 ;I. COMPARE & CONNECT POLYGONS POLYGONS.
BEGIN CMCNPP;_____________________________________________________
COMMENT ⊗
Compare all the unmated polygons of one levels with their
exact match polygons of another level. Argument L1 is level previous
time, argument L2 is level current time. ⊗
LAC 1,ARG2↔SON 1,1↔DAC 1,P10↔JUMPE 1,POP2J.
LAC 2,ARG1↔SON 2,2↔DAC 2,P20↔JUMPE 2,POP2J.
L1: DAC 2,P2
NTIME 0,2↔JUMPN L4 ;PAST MATED JUMP.
ALT 0,2↔DAC S2
L2: DAC 1,P1
PTIME 0,1↔JUMPN L3 ;FUTURE MATED JUMP.
ALT 0,1↔DAC S1
;COMPARE AND CONNECT ON A MATCH.
CALL(CMPARE,S1,S2)↔JUMPE 1,L3
CALL(CNNECT,S1,S2)↔GO L4
;NO MATCH - CONTINUE SEARCH.
L3: LAC 1,P1↔CCW 1,1 ;ADVANCE LEVEL1'S POLYGON.
CAME 1,P10↔GO L2
;MATCH FOUND OR SEARCH EXHAUSTED.
L4: LAC 1,P10
LAC 2,P2↔CCW 2,2 ;ADVANCE LEVEL2'S POLYGON.
CAME 2,P20↔GO L1
POP2J
DECLARE{P1,P2,P10,P20,S1,S2}
BEND CMCNPP; BGB 4 MAY 1973 --------------------------------------
SUBR(CMCNSP)SL,PL,FLG ;I. COMPARE & CONNECT SHAPES POLYGONS.
BEGIN CMCNSP;_____________________________________________________
COMMENT ⊗
Compare the fusion shapes of one level with the unmated
polygon shapes of another level. ⊗
LAC 1,ARG3↔ALT 1,1↔DAC 1,S0↔JUMPE 1,POP3J. ;1ST SHAPE.
LAC 2,ARG2↔SON 2,2↔DAC 2,P0↔JUMPE 2,POP3J. ;1ST POLYGON.
L1: DAC 1,S1
L2: DAC 2,P2
SKIPE ARG1↔PTIME 0,2 ;FUTURE MATED JUMP.
SKIPN ARG1↔NTIME 0,2↔JUMPN 0,L3 ;PAST MATED JUMP.
ALT 0,2↔DAC S2 ;FETCH THE SHAPE OF P2.
;CALL THE COMPARE AND CONNECT FOR TWO SHAPES.
SKIPE ARG1↔GO L5
CALL(CMPARE,S1,S2)↔JUMPE 1,L3
CALL(CNNECT,S1,S2)↔GO L4
L5: CALL(CMPARE,S2,S1)↔JUMPE 1,L3
CALL(CNNECT,S2,S1)↔GO L4
;ADVANCE IN EACH OF THE RINGS.
L3: LAC 2,P2↔CCW 2,2 ;ADVANCE A POLYGON.
CAME 2,P0↔GO L2
L4: LAC 2,P0
LAC 1,S1↔CCW 1,1 ;ADVANCE A SHAPE.
CAME 1,S0↔GO L1
POP3J
DECLARE{S0,S1,S2,P0,P2}
BEND CMCNSP; BGB 4 MAY 1973 ______________________________________
SUBR(MKSHAP)LEVEL ;II. MAKE PGN SHAPE NODES FOR A LEVEL.
BEGIN MKSHAP;_____________________________________________________
ACCUMULATORS{DR,DC,A,X,Y,MX,MY,PR,R1,C1,R2,C2,V2}
;FOR ALL THE POLYGONS OF THIS LEVEL.
LAC 1,ARG1
SON 1,1↔DAC 1,PGN0 ;FIRST POLYGON OF THIS LEVEL.
SKIPN 1↔POP1J ;LEVEL AIN'T GOT NO POLYGON.
ALT 2,1↔JUMPE 2,L1 ;LEVEL'S POLYGONS ALREADY GOT SHAPE.
TESTZ 2,SBIT↔POP1J
L1: DAC 1,PGN1
DZM 6(1) ;CLEAR SHIT LEFT BY INTREE NESTING.
SON V2,1↔DAC V2,V0 ;FIRST VECTOR OF THIS POLYGON.
;CLEAR POLYGON TOTALS.
LAC[XWD P0,P0+1]↔DZM P0↔BLT PXY0
COL C2,V2↔FLO C2, ;FIRST VERTEX LOCUS.
ROW R2,V2↔FLO R2,
L2: CCW V2,V2 ;ADVANCE A VERTEX.
LAC C1,C2↔LAC R1,R2
COL C2,V2↔FLO C2,
ROW R2,V2↔FLO R2,
;DELTA ROW & DELTA COLUMN.
LAC DC,C2↔FSBR DC,C1 ;DC ← C2-C1.
LAC DR,R2↔FSBR DR,R1 ;DR ← R2-R1.
CALL(TRI)↔CALL(ACC)
CALL(REC)↔CALL(ACC)
DZM 6(V2) ;CLEAR SHIT LEFT BY INTREE NESTING.
CAME V2,V0↔GO L2
;MAKE AND STUFF A POLYGON SHAPE NODE.
L3: CALL(MKNODE,[SBIT+SHPREL])
LAC[XWD A0,A]↔BLT PR ;FETCH TOTALS TO ACCUMULATORS.
FDVR X,A ;X ← X0/A0.
FDVR Y,A ;Y ← Y0/A0.
LAC Y↔FMPR↔FMPR A↔FSBR MX, ;MXX ← MXX0 - Y*Y*A.
LAC X↔FMPR↔FMPR A↔FSBR MY, ;MYY ← MYY0 - X*X*A.
LAC X↔FMPR Y↔FMPR A↔FADR PR, ;PXY ← PXY0 + X*Y*A.
;STUFF DATA INTO THE SHAPE NODE.
LAC P0↔PERM. 0,1 ;PERIMETER.
AREA. A,1 ;AREA.
FIX X,225000↔COL. X,1 ;CENTER OF MASS.
FIX Y,225000↔ROW. Y,1
PXY. PR,1
MXX. MX,1
MYY. MY,1
FADR MX,MY↔MZZ. MX,1
;STUFF POLYGON LINKS.
LAC 2,PGN1↔ALT. 1,2↔PGON. 2,1
;ADVANCE TO NEXT POLYGON
LAC 1,PGN1↔CCW 1,1
CAME 1,PGN0↔GO L1
POP1J
;ACCUMULATE PORTIONS.
ACC: FADRM A,A0 ;A0 ← A0 + A.
DAC X,0↔FMPR X,A↔FADRM X,X0 ;X0 ← X0 + X*A.
DAC Y,1↔FMPR Y,A↔FADRM Y,Y0 ;Y0 ← Y0 + Y*A.
FMPR X,0↔FADR MY,X↔FADRM MY,MYY0 ;MYY0 ← MYY0 + MY + X*X*A.
FMPR Y,1↔FADR MX,Y↔FADRM MX,MXX0 ;MXX0 ← MXX0 + MX + Y*Y*A.
FMPR 0,1↔FMPR 0,0
FSBR PR,0↔FADRM PR,PXY0 ;PXY0 ← PXY0 + PR - X*Y*A.
POP0J
;TRIANGULAR PORTION.
TRI: LAC A,DC↔FMPR A,DR↔FSC A,-1 ;A ← DC*DR/2
LAC X,C2↔FSC X,1↔FADR X,C1↔FDVRI X,(3.0);X ← (2*C2 + C1)/3
LAC Y,R1↔FSC Y,1↔FADR Y,R2↔FDVRI Y,(3.0);Y ← (2*R1 + C2)/3
LAC DR↔FMPR↔FMPR A↔FDVRI(18.0)↔DAC MX ;MX ← A*DR*DR/18.
LAC DC↔FMPR↔FMPR A↔FDVRI(18.0)↔DAC MY ;MY ← A*DC*DC/18
LACN A↔FMPR A↔FDVRI(18.0)↔DAC PR ;PR ← -A*A/18.
POP0J
;RECTANGULAR PORTION.
REC: LAC A,DC↔FMPR A,R1 ;A ← DC*R1
LAC X,C1↔FADR X,C2↔FSC X,-1 ;X ← (C1+C2)/2
LAC Y,R1↔FSC Y,-1 ;Y ← R1/2
LAC MX,R1↔FMPR MX,MX
FMPR MX,A↔FDVRI MX,(12.0) ;MX ← A*R1*R1/12
LAC MY,DC↔FMPR MY,MY
FMPR MY,A↔FDVRI MY,(12.0) ;MY ← A*DC*DC/12
SETZ PR,
POP0J
DECLARE{P0,A0,X0,Y0,MXX0,MYY0,PXY0}
DECLARE{PGN0,PGN1,V0}
BEND MKSHAP; BGB 4 MAY 1973 ______________________________________
SUBR(FUSION)S1,S2 ;II. MAKE A FUSION SHAPE NODE.
BEGIN FUSION;-----------------------------------------------------
ACCUMULATORS{S1,S2,A0,A1,A2,MX,MY,DR1,DC1,DR2,DC2,R0,C0}
CALL(MKNODE,[SBIT+SHPREL])
LAC S1,ARG2↔PGON 0,S1↔PGON. 0,1
LAC S2,ARG1↔PGON 0,S2↔NGON. 0,1
PERM A1,S1↔PERM A2,S2↔FADR A1,A2↔PERM. A1,1 ;TOTAL PERIMETER.
AREA A1,S1↔AREA A2,S2
LAC A0,A1↔FADR A0,A2↔AREA. A0,1 ;TOTAL AREA.
;FETCH AND FLOAT CENTERS OF MASS OF SHAPES S1 AND S2.
ROW DR1,S1↔FLO DR1,
COL DC1,S1↔FLO DC1,
ROW DR2,S2↔FLO DR2,
COL DC2,S2↔FLO DC2,
;ROW OF COMBINED CENTERS OF MASS.
LAC 0,DR1↔FMPR 0,A1
LAC R0,DR2↔FMPR R0,A2
FADR R0,0↔FDVR R0,A0
LAC R0↔FIX 225000↔ROW. 0,1
;COL OF COMBINED CENTERS OF MASS.
LAC 0,DC1↔FMPR 0,A1
LAC C0,DC2↔FMPR C0,A2
FADR C0,0↔FDVR C0,A0
LAC C0↔FIX 225000↔COL. 0,1
;DELTA ROW AND DELTA COLUMN.
FSBR DR1,R0↔FSBR DC1,C0
FSBR DR2,R0↔FSBR DC2,C0
;MOMENT ABOUT X.
MXX MX,S1↔MXX 0,S2↔FADRM MX
LAC DR1↔FMPR↔FMPR A1↔FADRM MX
LAC DR2↔FMPR↔FMPR A2↔FADRM MX
MXX. MX,1
;MOMENT ABOUT Y AXIS.
MYY MY,S1↔MYY 0,S2↔FADRM MY
LAC DC1↔FMPR↔FMPR A1↔FADRM MY
LAC DC2↔FMPR↔FMPR A2↔FADRM MY
MYY. MY,1
;MOMENT ABOUT Z AXIS.
FADR MX,MY↔MZZ. MX,1
;PRODUCT OF INERTIA XY.
PXY MX,S1↔PXY 0,S2↔FADRM MX
LACN DR1↔FMPR DC1↔FMPR A1↔FADRM MX
LACN DR2↔FMPR DC2↔FMPR A2↔FADRM MX
PXY. MX,1↔POP2J
BEND FUSION; BGB 4 MAY 1973 --------------------------------------
SUBR(MKFURN)LEVEL,FLG ;II. MAKE FUSION RING OF A LEVEL.
BEGIN MKFURN;-----------------------------------------------------
LAC 1,ARG2↔SON 1,1
DAC 1,P0↔JUMPE 1,POP2J. ;FIRST POLYGON.
CW 0,1↔DAC PN ;LAST POLYGON.
L1: DAC 1,P1
SKIPE ARG1↔NTIME 0,1 ;P1'S VIRGINITY TEST.
SKIPN ARG1↔PTIME 0,1↔JUMPN 0,L4
CCW 2,1↔CAMN 2,P0↔POP2J
L2: DAC 2,P2
SKIPE ARG1↔NTIME 0,2 ;P2'S VIRGINITY TEST.
SKIPN ARG1↔PTIME 0,2↔JUMPN 0,L3
;MAKE FUSION SHAPE FOR UNMATED PAIRS OF POLYGONS.
ALT 1,1↔ALT 2,2↔CALL(FUSION,1,2)
LAC 2,ARG2↔ALT 3,2
JUMPE 3,[ALT. 1,2↔CW. 1,1↔CCW. 1,1↔GO L5]↔CW 2,3
CW. 2,1↔CCW. 1,2
CCW. 3,1↔CW. 1,3
L5: LAC 1,P1↔LAC 2,P2
L3: CCW 2,2↔CAME 2,P0↔GO L2 ;ADVANCE P2.
L4: CCW 1,1↔CAME 1,PN↔GO L1 ;ADVANCE P1.
POP2J
DECLARE{P0,P1,P2,PN}
BEND MKFURN; BGB 4 MAY 1973 --------------------------------------
SUBR(KLFURN)LEVEL,FLG ;II. KILL FUSION RING OF A LEVEL.
BEGIN KLFURN;-----------------------------------------------------
LAC 2,ARG1 ;LEVEL.
ALT 1,2↔DAC 1,S0 ;FIRST SHAPE.
JUMPE 1,POP1J.
SETZ↔ALT. 0,2 ;CLEAR FURN POINTER OF LEVEL.
L1: CCW 2,1↔DAC 2,S1 ;NEXT SHAPE.
CALL(KLNODE,1) ;KILL THIS SHPAE.
LAC 1,S1
CAME 1,S0↔GO L1
POP1J
DECLARE{S0,S1}
BEND KLFURN; BGB 4 MAY 1973 --------------------------------------
SUBR(CMPARE)S1,S2 ;III. COMPARE SHAPE SHAPE PASS FAIL.
BEGIN CMPARE;-----------------------------------------------------
COMMENT ⊗
Compare returns the Boolean value of:
(QQCNTR=0 or QQCNT↑2 ≥ (R1-R2)↑2 + (C1-C2)↑2)
and (QQPRAX=0 or QQPRAX ≥ abs(PRAX1-PRAX2))
and (QQMZZ=0 or QQMZZ ≥ abs(MZZ1-MZZ)/(MZZ1+MZZ2))
and (QQAREA=0 or QQAREA ≥ abs(AREA1-AREA2)/(AREA1+AREA2))
and (QQPERM=0 or QQPERM ≥ abs(PERM1-PERM2)/(PERM1+PERM2)). ⊗
ACCUMULATORS{S1,S2,QQ,Q1,Q2,Q}
LAC S1,ARG2↔LAC S2,ARG1
;CRITERION 1; DISTANCE BETWEEN CENTERS OF MASS.
L1: SKIPN QQ,QQCNTR↔GO L2
ROW 0,S1↔ROW 1,S2↔SUB 0,1↔DAC ROWDEL↔IMUL 0,0↔DAC 0,Q
COL 0,S1↔COL 1,S2↔SUB 0,1↔DAC COLDEL↔IMUL 0,0↔ADD Q,0
FLOAT Q,217↔FMPR QQ,QQ
SETZ 1,↔CAMLE Q,QQ↔POP2J ;EXIT FALSE.
;CRITERION 2; DIFFERENCE IN ORIENTATIONS OF PRINCIPLE AXES.
L2:
;CRITERION 3; PER CENT DIFFERENCE IN MOMENTS OF INERTIA ABOUT Z
L3: MZZ Q1,S1↔DAC Q1,Q↔MZZ Q2,S2
FSBR Q1,Q2↔MOVMS Q1
FADR Q2,Q↔FDVR Q1,Q2↔SETZ 1,
CAMLE Q1,QQMZZ↔POP2J ;EXIT FALSE
SETO 1,↔POP2J ;EXIT TRUE.
BEND CMPARE; BGB 4 MAY 1973 --------------------------------------
SUBR(CNNECT)S1,S2 III. CONNECT SHAPE SHAPE.
BEGIN CNNECT
ACCUMULATORS{N1,P1,N2,P2,S1,S2,U1,U2,V1,V2}
LAC S1,ARG2↔LAC S2,ARG1
NGON N1,S1↔NGON N2,S2
PGON P1,S1↔PGON P2,S2
PTIME. P2,P1↔NTIME. P1,P2
JUMPN N1,CASE2
JUMPN N2,CASE3
CASE1: MARK P1,PEXCT↔MARK P2,PEXCT ;EXACT P1 ↔ P2.
CALL(CMCNVV,P1,P2)↔POP2J
CASE2: PTIME. P2,N1 ;FUSION N1 & P1 ↔ P2.
MARK N1,PFUSE
MARK P1,PFUSE
MARK P2,NFISS
SON V1,N1↔CW V2,V1 ;SPLICE N1 & P1.
SON U1,P1↔CW U2,U1
CCW. U1,V2↔CW. V2,U1
CCW. V1,U2↔CW. U2,V1
PUSH P,N1↔PUSH P,P1
CALL(CMCNVV,P1,P2) ;CONNECT VERTICES.
POP P,P1↔POP P,N1
SON V1,N1↔CW U2,V1 ;UNSPLICE N1 & P1.
SON U1,P1↔CW V2,U1
CCW. V1,V2↔CW. V2,V1
CCW. U1,U2↔CW. U2,U1↔POP2J
CASE3: NTIME. P1,N2 ;FISSION P1 ↔ N2 & P2.
MARK P1,PFISS
MARK N2,NFUSE
MARK P2,NFUSE
SON V1,N2↔CW V2,V1 ;SPLICE N2 & P2.
SON U1,P2↔CW U2,U1
CCW. U1,V2↔CW. V2,U1
CCW. V1,U2↔CW. U2,V1
PUSH P,N2↔PUSH P,P2
CALL(CMCNVV,P1,P2) ;CONNECT VERTICES.
POP P,P2↔POP P,N2
SON V1,N2↔CW U2,V1 ;UNSPLICE N2 & V2.
SON U1,P2↔CW V2,U1
CCW. V1,V2↔CW. V2,V1
CCW. U1,U2↔CW. U2,U1↔POP2J
BEND CNNECT; BGB 4 MAY 1973 --------------------------------------
SUBR(CMCNVV)P1,P2 ;IV. COMPARE AND CONNECT VERTICES.
BEGIN CMCNVV;_____________________________________________________
COMMENT ⊗ Connect the corresponding vertices of two polygons,
namely those vertices that are within an epsilon of each other and
are mutually closest, that is each is the other's closest neighbor.⊗
;ALLIGN CENTERS OF MASS.
LAC 1,ARG1 ;PICKUP POLYGON #2.
SON 1,1↔DAC 1,2 ;FIRST VERTEX.
ROW 0,1↔ADD 0,ROWDEL↔ROW. 0,1
COL 0,1↔ADD 0,COLDEL↔COL. 0,1
CCW 1,1↔CAME 1,2↔GO .-8
;DIAGONOSTIC DISPLAY.
EXTERN SKY,DPYGON
ACCUMULATORS{W,PGN,V,V0,PTR}
CALL(DPYSET,DPYBUF)
CALL(DPYGON,ARG1)
CALL(DPYGON,ARG2)
CALL(DPYOUT,[5])
L0: JFCL
;PUSH THE FIRST WINDOW.
LACI W,SKY↔DAC W,WINDOW#
DZM LINK(W) ;LINK TO PREVIOUS WINDOW.
DZM RMIN(W)↔LACI =216⊗6↔DAC RMAX(W)
DZM CMIN(W)↔LACI =288⊗6↔DAC CMAX(W)
LAC PGN,ARG2↔LACI PTR,N(W)
SETZ↔SON V,PGN↔DAC V,V0↔PTIME. 0,V
PUSH PTR,V↔CCW V,V↔CAME V,V0↔GO .-4
HLRZM PTR,M(W)↔ZIP PTR
LAC PGN,ARG1
SETZ↔SON V,PGN↔DAC V,V0↔NTIME. 0,V
PUSH PTR,V↔CCW V,V↔CAME V,V0↔GO .-3
HLRZM PTR,N(W)
;TEST THE WINDOW.
L2: LAC W,WINDOW
SKIPN 1,M(W)↔GO L5
SKIPN 2,N(W)↔GO L5
IMUL 1,2↔CAIG 1,=25↔GO L4
LAC W,WINDOW
LAC RMAX(W)↔SUB RMIN(W)↔MOVMS↔CAIGE 600↔GO L4
LAC CMAX(W)↔SUB CMIN(W)↔MOVMS↔CAIGE 600↔GO L4
L3: SETQ WINDOW,{SPLIT,WINDOW} ;SPLIT THE WINDOW.
GO L2
;SOLVE.
L4: CALL(MATE1,WINDOW) ;SOLVE THE WINDOW.
L5: LAC W,WINDOW ;POP THE WINDOW.
SKIPE W,LINK(W)↔GO[
DAC W,WINDOW↔GO L2]
;"UN" - ALLIGN CENTERS OF MASS.
LAC 1,ARG1 ;PICKUP POLYGON #2.
SON 1,1↔DAC 1,2 ;FIRST VERTEX.
ROW 0,1↔SUB 0,ROWDEL↔ROW. 0,1
COL 0,1↔SUB 0,COLDEL↔COL. 0,1
CCW 1,1↔CAME 1,2↔GO .-8↔POP2J
BEND CMCNVV; BGB 14 APRIL 1973 ___________________________________
SUBR(SPLIT)WINDOW IV. WINDOW SPLIT.
BEGIN SPLIT;______________________________________________________
ACCUMULATORS{U,V,LO,HI,PTR1,PTR2,LOCUT,HICUT,W1,W2}
;GLOBALS{EPSILN,RMATE}
;TEMPORARY WINDOW DIAGONOSTIC.
CALL(DPYSET,DPYBUF)
LAC 1,ARG1
LAC RMIN(1)↔SUBI =108⊗6↔FLO↔DACN YL#
LAC RMAX(1)↔SUBI =108⊗6↔FLO↔DACN YH#
LAC CMIN(1)↔SUBI =144⊗6↔FLO↔DAC XL#
LAC CMAX(1)↔SUBI =144⊗6↔FLO↔DAC XH#
CALL(AI,XL,YL)
CALL(AV,XH,YL)
CALL(AV,XH,YH)
CALL(AV,XL,YH)
CALL(AV,XL,YL)
LAC 16,ARG1↔LACI 15,N+1(16) ;FIRST VERTEX IN WINDOW.
LACN M(16)↔DIP 15 ;FIRST POLYGON'S VERTICES.
L01: CALL(GETXY,{(15)})
POP P,2↔POP P,1↔FMPR 1,[3.5]↔FMPR 2,[3.5]↔FIXX 1,↔FIXX 2,
CALL(AIVECT,1,2)↔CALL(DTYO,["1"])
AOBJN 15,L01
LACN N(16)↔DIP 15 ;SECOND POLYGON'S VERTICES.
L02: CALL(GETXY,{(15)})
POP P,2↔POP P,1↔FMPR 1,[3.5]↔FMPR 2,[3.5]↔FIXX 1,↔FIXX 2,
CALL(AIVECT,1,2)↔CALL(DTYO,["2"])
AOBJN 15,L02
CALL(DPYOUT,[14])
L0:
;SETUP POINTERS AND HEADER'S FOR HI AND LO WINDOW BLOCKS.
LAC W1,ARG1↔LACI PTR1,N+1(W1)↔LACN M(W1)
SUB N(W1)↔DIP PTR1↔DACN V
LACI W2,N+1(W1)↔ADD W2,V ;HI WINDOW.
;SETUP NEW WINDOW HEADER.
SLACI RMIN(W1)↔LAPI RMIN(W2)↔BLT CMAX(W2)
SETCM FLAG(W1)↔DAC FLAG(W2)
DAC W1,LINK(W2)
;YE OLDE INSTRUCTION MODIFICATION.
LACI(<CAR>)↔SKIPE FLAG(W1)↔LACI(<CDR>)
LSH -9
DPB[POINT 9,L2SUBR+1,8]
;MIDPOINT SPLIT THE WINDOW.
SKIPE FLAG(W1)↔GO[
LAC 1,CMAX(W1)↔ADD 1,CMIN(W1)↔ASH 1,-1
DAC 1,CMAX(W1)↔DAC 1,CMIN(W2)↔GO L1]
LAC 1,RMAX(W1)↔ADD 1,RMIN(W1)↔ASH 1,-1
DAC 1,RMAX(W1)↔DAC 1,RMIN(W2)
;ADJUST WINDOW LIMITS TO ALLOW AN OVERLAP.
L1: LAC LOCUT,1↔ADD LOCUT,EPSILN
LAC HICUT,1↔SUB HICUT,EPSILN
L2: LACI PTR1,N+1(W1)
LAC PTR2,PTR1
ADD PTR2,M(W1)
LACN M(W1)↔DIP PTR1
LACN N(W1)↔DIP PTR2
LACI LO,N(W1) ;LO WINDOW VERTICES.
LACI HI,N(W2) ;HI WINDOW VERTICES.
CALL(L2SUBR)
HLRZM LO,M(W1)↔ZIP LO
HLRZM HI,M(W2)↔ZIP HI
LAC PTR1,PTR2
CALL(L2SUBR)
HLRZM LO,N(W1)
HLRZM HI,N(W2)
LAC 1,W2↔POP1J ;RETURN NEW WINDOW.
L2SUBR: CDR U,(PTR1)↔ROW 0,U
CAMGE 0,LOCUT↔PUSH LO,U
CAMLE 0,HICUT↔PUSH HI,U
AOBJN PTR1,L2SUBR↔POP0J
BEND SPLIT; BGB 14 APRIL 1973 ____________________________________
SUBR(MATE1)WINDOW IV. MATE VERTICES IN WINDOW.
BEGIN MATE1;______________________________________________________
ACCUMULATORS{P1,P2,U,V}
LAC 1,ARG1
LACI P1,N+1(1)↔LACN 0,M(1)↔DIP 0,P1↔DAC P1,PTR1#
CDR P2,P1↔ADD P2,M(1)↔LACN 0,N(1)↔DIP 0,P2↔DAC P2,PTR2#
CALL(MATE2,PTR1,PTR2)
CALL(MATE2,PTR2,PTR1)
LAC P1,PTR1
L1: CAR P2,(P1)↔JUMPE P2,L2
CAR 0,(P2)↔CAIE 0,(P1)↔GO L2
CDR U,(P1)↔CDR V,(P2)
PTIME 0,U↔NTIME 1,V
IOR 0,1↔JUMPN 0,L2
PTIME. V,U↔NTIME. U,V
L2: AOBJN P1,L1↔POP1J
BEND MATE1; BGB 15 APRIL 1973 ____________________________________
SUBR(MATE2)PTR1,PTR2 IV. FIND VERTEX MATES PTR1 PTR2.
BEGIN MATE2;______________________________________________________
COMMENT⊗ Arguments are expected to be AOBJN accumulators -M,,U1 and
-N,,V1 of the two sets of vertices of a window. In this window, for
all the vertices of the first polygon find the closest vertex of the
second polygon. If the closest vertex is within an epsilon, a pointer
to the window block position of the second polygon's vertex is DIP'ed
into the window block position of the first polygon's vertex.⊗
ACCUMULATORS{PTR1,PTR2,U,V,R,C,R1,C1,RMINIM,VMIN}
;GLOBALS{EPSLN2}
;FOR ALL VERTICES U OF PTR1.
LAC PTR1,ARG2
L1: LAC U,(PTR1)↔ROW R1,U↔COL C1,U
LAC RMINIM,EPSLN2↔DZM VMIN
;FOR ALL VERTICES V OF PTR2.
LAC PTR2,ARG1
L2: LAC V,(PTR2)
;IS THE DISTANCE BETWEEN U AND V LESS THAN R MINIMUM.
ROW R,V↔SUB R,R1↔IMUL R,R
COL C,V↔SUB C,C1↔IMUL C,C↔ADD R,C
CAML R,RMINIM↔GO .+3
DAC R,RMINIM↔DAPZ PTR2,VMIN
AOBJN PTR2,L2
;SAVE POINTER OF VERTEX V OF CLOSEST APPROACH TO VERTEX U.
DIP VMIN,(PTR1)
AOBJN PTR1,L1
POP2J
BEND MATE2; BGB 15 APRIL 1973 ____________________________________
END