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