<> <> <> <> <> <<>> DIRECTORY GriffinPoint USING [ObjPt, ObjPtSequence, X, Y], GriffinTransform USING [Axis, XFMDescriptor, XFormMatrix], Real USING [RealException], RealFns USING [Cos, Sin], Rope USING [ROPE]; GriffinTransformImpl: CEDAR PROGRAM IMPORTS Real, RealFns EXPORTS GriffinTransform = BEGIN ProblemWithXForms: PUBLIC SIGNAL[string: Rope.ROPE] = CODE; <> <> <> InitXForms: PUBLIC PROC [matrix: GriffinTransform.XFMDescriptor] = { matrix[1] _ [1, 0]; matrix[2] _ [0, 1]; matrix[3] _ [0, 0]; }; <> Rotate: PUBLIC PROC [theta: REAL, axis: GriffinTransform.Axis, matrix: GriffinTransform.XFMDescriptor] = { rot: ARRAY [1..2] OF GriffinPoint.ObjPt _ [[0, 0], [0, 0]]; sin: REAL _ RealFns.Sin[theta]; cos: REAL _ RealFns.Cos[theta]; tmatrix: GriffinTransform.XFormMatrix; i: INTEGER; FOR i IN [1..3] DO tmatrix[i] _ matrix[i]; ENDLOOP; SELECT axis FROM x =>{ rot[1][GriffinPoint.X] _ 1; rot[2][GriffinPoint.Y] _ cos; }; y =>{ rot[1][GriffinPoint.X] _ cos; rot[2][GriffinPoint.Y] _ 1; }; z =>{ rot[1][GriffinPoint.X] _ cos; rot[2][GriffinPoint.Y] _ cos; rot[1][GriffinPoint.Y] _ sin; rot[2][GriffinPoint.X] _ -sin; }; ENDCASE; FOR i IN [GriffinPoint.X..GriffinPoint.Y] DO matrix[1][i] _ rot[1][GriffinPoint.X]*tmatrix[1][i]+rot[1][GriffinPoint.Y]*tmatrix[2][i]; matrix[2][i] _ rot[2][GriffinPoint.X]*tmatrix[1][i]+rot[2][GriffinPoint.Y]*tmatrix[2][i]; ENDLOOP; TestSingular[matrix]; }; Scale: PUBLIC PROC [scale: ARRAY[GriffinPoint.X..GriffinPoint.Y] OF REAL, matrix: GriffinTransform.XFMDescriptor] = { i: INTEGER; FOR i IN [GriffinPoint.X..GriffinPoint.Y] DO matrix[1][i] _ matrix[1][i]*scale[GriffinPoint.X]; matrix[2][i] _ matrix[2][i]*scale[GriffinPoint.Y]; ENDLOOP; TestSingular[matrix]; }; Translate: PUBLIC PROC [dist: ARRAY[GriffinPoint.X..GriffinPoint.Y] OF REAL, matrix: GriffinTransform.XFMDescriptor] = { i: INTEGER; FOR i IN [GriffinPoint.X..GriffinPoint.Y] DO matrix[3][i] _ matrix[1][i]*dist[GriffinPoint.X]+matrix[2][i]*dist[GriffinPoint.Y]+matrix[3][i]; ENDLOOP; }; <> <> <> <> <> <> <> <> <<>> XForm4Pts: PUBLIC PROC [pts: GriffinPoint.ObjPtSequence, matrix: GriffinTransform.XFMDescriptor] = { tmatrix: GriffinTransform.XFormMatrix; i: INTEGER; x1: REAL _ pts[1][GriffinPoint.X]-pts[0][GriffinPoint.X]; x2: REAL _ pts[3][GriffinPoint.X]-pts[2][GriffinPoint.X]; y1: REAL _ pts[1][GriffinPoint.Y]-pts[0][GriffinPoint.Y]; y2: REAL _ pts[3][GriffinPoint.Y]-pts[2][GriffinPoint.Y]; del: REAL _ x1*x1+y1*y1; tmp: ARRAY [1..3] OF GriffinPoint.ObjPt _ [[0, 0], [0, 0], [0, 0]]; FOR i IN [1..3] DO tmatrix[i] _ matrix[i]; ENDLOOP; tmp[1][GriffinPoint.X] _ (x1*x2+y1*y2)/del; --a tmp[2][GriffinPoint.Y] _ tmp[1][GriffinPoint.X]; --d tmp[1][GriffinPoint.Y] _ (x1*y2-y1*x2)/del; --c tmp[2][GriffinPoint.X] _ -tmp[1][GriffinPoint.Y] ; --b tmp[3] _ [pts[2][GriffinPoint.X]-pts[0][GriffinPoint.X], pts[2][GriffinPoint.Y]-pts[0][GriffinPoint.Y]]; --distX and distY FOR i IN [GriffinPoint.X..GriffinPoint.Y] DO matrix[1][i] _ tmp[1][GriffinPoint.X]*tmatrix[1][i]+tmp[1][GriffinPoint.Y]*tmatrix[2][i]; matrix[2][i] _ tmp[2][GriffinPoint.X]*tmatrix[1][i]+tmp[2][GriffinPoint.Y]*tmatrix[2][i]; matrix[3][i] _ tmp[3][GriffinPoint.X]*tmatrix[1][i]+tmp[3][GriffinPoint.Y]*tmatrix[2][i] + tmatrix[3][i]; ENDLOOP; TestSingular[matrix]; }; <> <> <<>> XForm6Pts: PUBLIC PROC [pts: GriffinPoint.ObjPtSequence, matrix: GriffinTransform.XFMDescriptor] = { i: INTEGER; tmatrix: GriffinTransform.XFormMatrix; tmp: ARRAY [1..3] OF GriffinPoint.ObjPt _ [[0, 0], [0, 0], [0, 0]]; dq1: GriffinPoint.ObjPt _ [pts[1][GriffinPoint.X]-pts[0][GriffinPoint.X], pts[1][GriffinPoint.Y]-pts[0][GriffinPoint.Y]]; dq2: GriffinPoint.ObjPt _ [pts[2][GriffinPoint.X]-pts[0][GriffinPoint.X], pts[2][GriffinPoint.Y]-pts[0][GriffinPoint.Y]]; dp1: GriffinPoint.ObjPt _ [pts[4][GriffinPoint.X]-pts[3][GriffinPoint.X], pts[4][GriffinPoint.Y]-pts[3][GriffinPoint.Y]]; dp2: GriffinPoint.ObjPt _ [pts[5][GriffinPoint.X]-pts[3][GriffinPoint.X], pts[5][GriffinPoint.Y]-pts[3][GriffinPoint.Y]]; del: REAL _ dq1[GriffinPoint.X]*dq2[GriffinPoint.Y]-dq2[GriffinPoint.X]*dq1[GriffinPoint.Y]; IF del=0 THEN SIGNAL ProblemWithXForms["Invalid Map. Colinear q points"]; FOR i IN [1..3] DO tmatrix[i] _ matrix[i]; ENDLOOP; tmp[1][GriffinPoint.X] _ (dp1[GriffinPoint.X]*dq2[GriffinPoint.Y]-dp2[GriffinPoint.X]*dq1[GriffinPoint.Y])/del; --a tmp[2][GriffinPoint.X] _ (dq1[GriffinPoint.X]*dp2[GriffinPoint.X]-dq2[GriffinPoint.X]*dp1[GriffinPoint.X])/del; --b tmp[1][GriffinPoint.Y] _ (dp1[GriffinPoint.Y]*dq2[GriffinPoint.Y]-dp2[GriffinPoint.Y]*dq1[GriffinPoint.Y])/del; --c tmp[2][GriffinPoint.Y] _ (dq1[GriffinPoint.X]*dp2[GriffinPoint.Y]-dq2[GriffinPoint.X]*dp1[GriffinPoint.Y])/del; --d tmp[3] _ [pts[3][GriffinPoint.X]-pts[0][GriffinPoint.X], pts[3][GriffinPoint.Y]-pts[0][GriffinPoint.Y]]; --distX and distY FOR i IN [GriffinPoint.X..GriffinPoint.Y] DO matrix[1][i] _ tmp[1][GriffinPoint.X]*tmatrix[1][i]+tmp[1][GriffinPoint.Y]*tmatrix[2][i]; matrix[2][i] _ tmp[2][GriffinPoint.X]*tmatrix[1][i]+tmp[2][GriffinPoint.Y]*tmatrix[2][i]; matrix[3][i] _ tmp[3][GriffinPoint.X]*tmatrix[1][i]+tmp[3][GriffinPoint.Y]*tmatrix[2][i] + tmatrix[3][i]; ENDLOOP; TestSingular[matrix]; }; XFormPt: PUBLIC PROC [pt: GriffinPoint.ObjPt, matrix: GriffinTransform.XFMDescriptor] RETURNS[GriffinPoint.ObjPt] = { newPt: GriffinPoint.ObjPt; i: INTEGER; FOR i IN [GriffinPoint.X..GriffinPoint.Y] DO newPt[i] _ matrix[1][i]*pt[GriffinPoint.X]+matrix[2][i]*pt[GriffinPoint.Y]+matrix[3][i]; ENDLOOP; RETURN[newPt]; }; TestSingular: PROC [matrix: GriffinTransform.XFMDescriptor] = TRUSTED { ENABLE Real.RealException => IF flags[divisionByZero] THEN SIGNAL ProblemWithXForms["Singular transform"] ELSE SIGNAL ProblemWithXForms["Other problem with transform"]; det: REAL _ matrix[1][GriffinPoint.X]*matrix[2][GriffinPoint.Y]-matrix[2][GriffinPoint.X]*matrix[1][GriffinPoint.Y]; Nest[det]; --well, there's something funny about the signals in the float package }; Nest: PROC [det: REAL] = { test: REAL _ 1/det; --all for the SIGNAL if det is 0 }; END.