Develop and Download Open Source Software

Browse Subversion Repository

Contents of /affine.pas

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1 - (show annotations) (download) (as text)
Mon Nov 7 12:03:00 2011 UTC (12 years, 4 months ago) by shiraishikazuo
File MIME type: text/x-pascal
File size: 12740 byte(s)


1 unit affine;
2 {$IFDEF FPC}
3 {$MODE DELPHI}{$H+}
4 {$ENDIF}
5
6 (***************************************)
7 (* Copyright (C) 2009, SHIRAISHI Kazuo *)
8 (***************************************)
9
10 {$T+}
11 interface
12 uses math2sub,mathc,Arrays,ArraysC;
13 (*
14 class Affine means:
15 x'= xx * x + xy * y + xo
16 y'= yx * x + yy * y + yo
17 *)
18 type
19 TAffine=class
20 {$A4}
21 xx, yx, zx, ox:double;
22 xy, yy, zy, oy:double;
23 xz, yz, zz, oz:double;
24 xo, yo, zo, oo:double;
25 {$A+}
26 next:TAffine;
27 class function NewInstance: TObject;override;
28 procedure FreeInstance;override;
29 constructor Create;overload;
30 constructor Create(a:TArray2N); overload;
31 constructor Create(a:TArray2C); overload;
32 //procedure make(transform:TObjectList);
33 procedure scale1(a:double); overload;
34 procedure scale1(a:complex); overload;
35 procedure scale(a,b:double);
36 procedure shift(a,b:double);overload;
37 procedure shift(c:complex);overload;
38 procedure rotate(t:double);
39 procedure rotate2(ct,st:double);
40 procedure shear(t:double);
41 procedure revmlt(m:TAffine);
42 procedure mlt(m:TAffine);overload;
43 procedure mlt(a:TArray2N);overload;
44 procedure mlt(a:TArray2C);overload;
45 procedure store(a:TArray2N); overload;
46 procedure store(a:TArray2C); overload;
47 procedure cmlt(const c:complex);
48 function transform(var x,y:extended):boolean; overload;
49 function transform(var x,y:double):boolean; overload;
50 function InvTransform(var x,y:extended):boolean; overload;
51 function InvTransform(var x,y:double):boolean; overload;
52 procedure push;
53 function det:double;
54 function IsAffine:boolean;
55 function IsSimilarPositive:boolean;
56 private
57 end;
58
59 var
60 currenttransform:TAffine=nil;
61 {currenttransformInv:TAffine=nil;}
62
63 //procedure push(a:TAffine);
64 procedure pop;
65
66
67 implementation
68 uses objlist,math,base,vstack;
69
70 procedure push(a:TAffine);
71 begin
72 a.next:=currenttransform;
73 currenttransform:=a;
74 end;
75
76 procedure pop;
77 var
78 temp:TAffine;
79 begin
80 with currenttransform do
81 begin
82 temp:=next ;
83 free;
84 end;
85 currenttransform:=temp;
86 end;
87
88 procedure TAffine.push;
89 begin
90 next:=currenttransform;
91 currenttransform:=self
92 end;
93
94
95
96 class function TAffine.NewInstance: TObject;
97 begin
98 result:=InitInstance(getMemory(instancesize));
99 end;
100
101 procedure TAffine.FreeInstance;
102 begin
103 freeMemory(instanceSize)
104 end;
105
106
107 constructor TAffine.create;
108 begin
109 inherited create;
110 xx := 1.0;
111 yy := 1.0;
112 zz := 1.0;
113 oo := 1.0;
114 end;
115
116 {
117 procedure TAffine.make(transform:TObjectList);
118 var
119 i:integer;
120 p:TTransformTerm;
121 begin
122 i:=0;
123 while (i<transform.count) do
124 begin
125 TObject(p):=transform.items[i];
126 p.exec(self);
127 inc(i)
128 end;
129 end;
130 }
131
132 function TAffine.transform(var x,y:extended):boolean; overload;
133 var
134 cx,cy, c:extended;
135 begin
136 result:=true;
137 if self=nil then exit;
138 try
139 cx := xx * x + xy * y + xo;
140 cy := yx * x + yy * y + yo;
141 c := ox * x + oy * y + oo;
142 x:=cx / c;
143 y:=cy / c;
144 except
145 {$IFNDEF Windows} asm finit end; set8087cw(controlword); {$ENDIF}
146 //x:=cx;
147 //y:=cy;
148 result:=false;
149 //setexception(-3009)
150 end;
151 end;
152
153 function TAffine.transform(var x,y:double):boolean; overload;
154 var
155 cx,cy, c:double;
156 begin
157 result:=true;
158 if self=nil then exit;
159 try
160 cx := xx * x + xy * y + xo;
161 cy := yx * x + yy * y + yo;
162 c := ox * x + oy * y + oo;
163 x:=cx / c;
164 y:=cy / c;
165 except
166 {$IFNDEF Windows} asm finit end; set8087cw(controlword); {$ENDIF}
167 //x:=cx;
168 //y:=cy;
169 result:=false;
170 //setexception(-3009)
171 end;
172 end;
173
174 function TAffine.InvTransform(var x,y:extended):boolean; overload;
175 var
176 cx,cy,c:extended;
177 dx,dy,dd:extended;
178 begin
179 result:=true;
180 if self=nil then exit;
181 try
182 {
183 cx:= x*(yy * oo - oy * yo) -y*(xy * oo - oy * xo) +(xy * yo - yy * xo);
184 cy:=-x*(yx * oo - ox * yo) +y*(xx * oo - ox * xo) -(xx * yo - yx * xo);
185 c:= x*(yx * oy - ox * yy) -y*(xx * oy - ox * xy) +(xx * yy - yx * xy);
186 }
187
188 dx:= oo * x - xo;
189 dy:= oo * y - yo;
190 dd:= x * yo - y * xo;
191 cx:= yy * dx - xy * dy - oy * dd;
192 cy:= xx * dy - yx * dx + ox * dd;
193 c := (xx * yy - yx * xy) - ox * (x * yy - y * xy) + oy * ( x * yx - y * xx);
194
195 x:=cx/c;
196 y:=cy/c;
197
198 except
199 {$IFNDEF Windows} asm finit end; set8087cw(controlword); {$ENDIF}
200 result:=false;
201 end;
202 end;
203
204 function TAffine.InvTransform(var x,y:double):boolean; overload;
205 var
206 cx,cy,c:double;
207 dx,dy,dd:double;
208 begin
209 result:=true;
210 if self=nil then exit;
211 try
212 {
213 cx:= x*(yy * oo - oy * yo) -y*(xy * oo - oy * xo) +(xy * yo - yy * xo);
214 cy:=-x*(yx * oo - ox * yo) +y*(xx * oo - ox * xo) -(xx * yo - yx * xo);
215 c:= x*(yx * oy - ox * yy) -y*(xx * oy - ox * xy) +(xx * yy - yx * xy);
216 }
217
218 dx:= oo * x - xo;
219 dy:= oo * y - yo;
220 dd:= x * yo - y * xo;
221 cx:= yy * dx - xy * dy - oy * dd;
222 cy:= xx * dy - yx * dx + ox * dd;
223 c := (xx * yy - yx * xy) - ox * (x * yy - y * xy) + oy * ( x * yx - y * xx);
224
225 x:=cx/c;
226 y:=cy/c;
227
228 except
229 {$IFNDEF Windows} asm finit end; set8087cw(controlword); {$ENDIF}
230 result:=false;
231 end;
232 end;
233
234 procedure TAffine.scale1(a:double);
235 begin
236 xx:=xx*a;
237 xy:=xy*a;
238 xz:=xz*a;
239 xo:=xo*a;
240
241 yx:=yx*a;
242 yy:=yy*a;
243 yz:=yz*a;
244 yo:=yo*a;
245
246 zx:=zx*a;
247 zy:=zy*a;
248 zz:=zz*a;
249 zo:=zo*a;
250
251 end;
252
253
254 procedure TAffine.scale(a,b:double) ;
255 begin
256 xx:=xx*a;
257 xy:=xy*a;
258 xz:=xz*a;
259 xo:=xo*a;
260
261 yx:=yx*b;
262 yy:=yy*b;
263 yz:=yz*b;
264 yo:=yo*b;
265 end;
266
267
268 procedure TAffine.shift(a,b:double) ;
269 begin
270 xx:= xx + ox * a;
271 xy:= xy + oy * a;
272 xz:= xz + oz * a;
273 xo:= xo + oo * a;
274
275 yx:= yx + ox * b;
276 yy:= yy + oy * b;
277 yz:= yz + oz * b;
278 yo:= yo + oo * b;
279 end;
280
281 procedure TAffine.shift(c:complex);overload;
282 begin
283 shift(c.x, c.y)
284 end;
285
286 procedure TAffine.rotate(t:double);
287 begin
288 rotate2(cos(t),sin(t))
289 end;
290
291 procedure TAffine.rotate2(ct,st:double);
292 var
293 Nxx,Nxy,Nxz,Nxo,Nyx,Nyy,Nyz,Nyo:double;
294 begin
295 Nxx := xx * ct - yx * st;
296 Nxy := xy * ct - yy * st;
297 Nxz := xz * ct - yz * st;
298 Nxo := xo * ct - yo * st;
299
300 Nyx := yx * ct + xx * st;
301 Nyy := yy * ct + xy * st;
302 Nyz := yz * ct + xz * st;
303 Nyo := yo * ct + xo * st;
304
305 xx := Nxx;
306 xy := Nxy;
307 xz := Nxz;
308 xo := Nxo;
309
310 yx := Nyx;
311 yy := Nyy;
312 yz := Nyz;
313 yo := Nyo;
314 end;
315
316 procedure TAffine.cmlt(const c:complex);
317 begin
318 rotate2(c.x,c.y)
319 end ;
320
321 procedure TAffine.shear(t:double);
322 var
323 tt:double;
324 begin
325 tt:=math.tan(t);
326 xx := xx + yx * tt;
327 xy := xy + yy * tt;
328 xz := xz + yz * tt;
329 xo := xo + yo * tt;
330 end;
331
332 procedure TAffine.revmlt(m:TAffine);
333 var
334 Nxx,Nxy,Nxz,Nyx,Nyy,Nyz,Nzx,Nzy,Nzz,Nxo,Nyo,Nzo,Nox,Noy,Noz,Noo: double;
335 begin
336 Nxx := m.xx * xx + m.yx * xy + m.zx * xz + m.ox * xo;
337 Nxy := m.xy * xx + m.yy * xy + m.zy * xz + m.oy * xo;
338 Nxz := m.xz * xx + m.yz * xy + m.zz * xz + m.oz * xo;
339 Nxo := m.xo * xx + m.yo * xy + m.zo * xz + m.oo * xo;
340
341 Nyx := m.xx * yx + m.yx * yy + m.zx * yz + m.ox * yo;
342 Nyy := m.xy * yx + m.yy * yy + m.zy * yz + m.oy * yo;
343 Nyz := m.xz * yx + m.yz * yy + m.zz * yz + m.oz * yo;
344 Nyo := m.xo * yx + m.yo * yy + m.zo * yz + m.oo * yo;
345
346 Nzx := m.xx * zx + m.yx * zy + m.zx * zz + m.ox * zo;
347 Nzy := m.xy * zx + m.yy * zy + m.zy * zz + m.oy * zo;
348 Nzz := m.xz * zx + m.yz * zy + m.zz * zz + m.oz * zo;
349 Nzo := m.xo * zx + m.yo * zy + m.zo * zz + m.oo * zo;
350
351 Nox := m.xx * ox + m.yx * oy + m.zx * oz + m.ox * oo;
352 Noy := m.xy * ox + m.yy * oy + m.zy * oz + m.oy * oo;
353 Noz := m.xz * ox + m.yz * oy + m.zz * oz + m.oz * oo;
354 Noo := m.xo * ox + m.yo * oy + m.zo * oz + m.oo * oo;
355
356 xx := Nxx;
357 xy := Nxy;
358 xz := Nxz;
359 xo := Nxo;
360
361 yx := Nyx;
362 yy := Nyy;
363 yz := Nyz;
364 yo := Nyo;
365
366 zx := Nzx;
367 zy := Nzy;
368 zz := Nzz;
369 zo := Nzo;
370
371 ox := Nox;
372 oy := Noy;
373 oz := Noz;
374 oo := Noo;
375 end ;
376
377 procedure TAffine.mlt(m:TAffine);
378 var
379 Nxx,Nxy,Nxz,Nyx,Nyy,Nyz,Nzx,Nzy,Nzz,Nxo,Nyo,Nzo,Nox,Noy,Noz,Noo:double;
380 begin
381 Nxx := xx * m.xx + yx * m.xy + zx * m.xz + ox * m.xo;
382 Nxy := xy * m.xx + yy * m.xy + zy * m.xz + oy * m.xo;
383 Nxz := xz * m.xx + yz * m.xy + zz * m.xz + oz * m.xo;
384 Nxo := xo * m.xx + yo * m.xy + zo * m.xz + oo * m.xo;
385
386 Nyx := xx * m.yx + yx * m.yy + zx * m.yz + ox * m.yo;
387 Nyy := xy * m.yx + yy * m.yy + zy * m.yz + oy * m.yo;
388 Nyz := xz * m.yx + yz * m.yy + zz * m.yz + oz * m.yo;
389 Nyo := xo * m.yx + yo * m.yy + zo * m.yz + oo * m.yo;
390
391 Nzx := xx * m.zx + yx * m.zy + zx * m.zz + ox * m.zo;
392 Nzy := xy * m.zx + yy * m.zy + zy * m.zz + oy * m.zo;
393 Nzz := xz * m.zx + yz * m.zy + zz * m.zz + oz * m.zo;
394 Nzo := xo * m.zx + yo * m.zy + zo * m.zz + oo * m.zo;
395
396 Nox := xx * m.ox + yx * m.oy + zx * m.oz + ox * m.oo;
397 Noy := xy * m.ox + yy * m.oy + zy * m.oz + oy * m.oo;
398 Noz := xz * m.ox + yz * m.oy + zz * m.oz + oz * m.oo;
399 Noo := xo * m.ox + yo * m.oy + zo * m.oz + oo * m.oo;
400
401 xx := Nxx;
402 xy := Nxy;
403 xz := Nxz;
404 xo := Nxo;
405
406 yx := Nyx;
407 yy := Nyy;
408 yz := Nyz;
409 yo := Nyo;
410
411 zx := Nzx;
412 zy := Nzy;
413 zz := Nzz;
414 zo := Nzo;
415
416 ox := Nox;
417 oy := Noy;
418 oz := Noz;
419 oo := Noo;
420 end ;
421
422 constructor TAffine.create(a:Tarray2N);overload;
423 begin
424 inherited create;
425 if (a.size1=4) and (a.size2=4) then
426 with a do
427 begin
428 xx:=elements^[0];
429 xy:=elements^[1*size2];
430 xz:=elements^[2*size2];
431 xo:=elements^[3*size2];
432 yx:=elements^[ 1];
433 yy:=elements^[1*size2+1];
434 yz:=elements^[2*size2+1];
435 yo:=elements^[3*size2+1];
436 zx:=elements^[ 2];
437 zy:=elements^[1*size2+2];
438 zz:=elements^[2*size2+2];
439 zo:=elements^[3*size2+2];
440 ox:=elements^[ 3];
441 oy:=elements^[1*size2+3];
442 oz:=elements^[2*size2+3];
443 oo:=elements^[3*size2+3];
444 end
445 else
446 setexception(6201);
447 end;
448
449 procedure TAffine.store(a:TArray2N);
450 begin
451 if a.maxsize<4*4 then setexception(5002);
452 with a do
453 begin
454 resize(4,4);
455
456 elements^[0] := xx;
457 elements^[1*size2] := xy;
458 elements^[2*size2] := xz;
459 elements^[3*size2] := xo;
460 elements^[ 1] := yx;
461 elements^[1*size2+1] := yy;
462 elements^[2*size2+1] := yz;
463 elements^[3*size2+1] := yo;
464 elements^[ 2] := zx;
465 elements^[1*size2+2] := zy;
466 elements^[2*size2+2] := zz;
467 elements^[3*size2+2] := zo;
468 elements^[ 3] := ox;
469 elements^[1*size2+3] := oy;
470 elements^[2*size2+3] := oz;
471 elements^[3*size2+3] := oo;
472 end;
473
474 end;
475
476 procedure TAffine.mlt(a:TArray2N);overload;
477 var
478 m:TAffine;
479 begin
480 m:=Taffine.create(a);
481 mlt(m);
482 m.free;
483 end;
484
485
486 function TAffine.IsAffine:boolean;
487 begin
488 result:=(ox=0) and (oy=0) and (oz=0)
489 end;
490
491 function TAffine.det:double;
492 begin
493 det:=oo*(xx*yy - xy*yx) +ox*(xy*yo - yy*xo) + oy*(yx*xo - xx*yo) ;
494 end ;
495
496 function TAffine.IsSimilarPositive:boolean;
497 var
498 s,t,u:double;
499 begin
500 result:=true;
501 if self = nil then exit;
502
503 s:=xx*xx + yx*yx;
504 t:=yy*yy + xy*xy;
505 u:=xx*xy + yx*yy;
506 result:=isAffine and (s=t)and (abs(u/t)<1e-2) and (det>0)
507
508 end;
509
510 Constructor TAffine.Create(a:TArray2C); overload;
511 var
512 b:TArray2N;
513 begin
514 b:=a.Array2N;
515 try
516 Create(b);
517 finally
518 b.free;
519 end;
520 end;
521
522
523 procedure TAffine.scale1(a:complex); overload;
524 begin
525 scale1(abs(a));
526 rotate(arg(a))
527 end;
528
529 procedure TAffine.mlt(a:TArray2C);overload;
530 var
531 m:TAffine;
532 begin
533 m:=Taffine.create(a);
534 mlt(m);
535 m.free;
536 end;
537
538 procedure TAffine.store(a:TArray2C); overload;
539 var
540 n:TArray2N;
541 i:integer;
542 begin
543 with a do
544 n:=TArray2N.create(Lbound(1), Ubound(1), Lbound(2), Ubound(2));
545 try
546 store(n);
547 with a do
548 for i:=0 to size -1 do
549 elements^[i]:=n.elements^[i];
550 finally
551 n.free;
552 end;
553 end;
554
555 end.
556
557

Back to OSDN">Back to OSDN
ViewVC Help
Powered by ViewVC 1.1.26