|
|
!'写像変換
!'マウスで入力用と出力用の四角形を指定
!'四角形にならない時は点順を並べ替える
!'入力用の四角形を出力用の四角形に写像変換する(四角形から四角形へ変換)
OPTION BASE 0
PUBLIC NUMERIC XSIZE,YSIZE
FILE GETNAME F$, "BMP,JPG,GIFファイル|*.BMP;*.JPG;*.GIF"
IF F$="" THEN STOP
CALL PICTURELOAD(F$,XSIZE,YSIZE)
DIM M(XSIZE,YSIZE),X(4),Y(4),U(4),V(4),A(1 TO 8,1 TO 8), D(1 TO 8)
ASK PIXEL ARRAY (0,0) M
PRINT "入力用四角形"
PRINT "マウスで座標を指定してください(4点)" !'四角形を指定する
CALL GETXY(X(1),Y(1),X(2),Y(2),X(3),Y(3),X(4),Y(4)) !'4回左クリックする(クリック順に結ぶ)
IF ISSQUARE(X(1),Y(1),X(2),Y(2),X(3),Y(3),X(4),Y(4))=0 THEN !'四角形でないなら並び替え
PRINT "四角形ではありません"
PRINT "並び替えます"
WAIT DELAY 2
CALL SORT(X(1),Y(1),X(2),Y(2),X(3),Y(3),X(4),Y(4)) !'時計回りに並び替え
MAT PLOT CELLS, IN 0,0;XSIZE-1,YSIZE-1:M !'以下ソート結果の表示
PLOT LINES:X(1),Y(1);
SET COLOR COLORINDEX(0,0,1)
DRAW DISK WITH SCALE(3)*SHIFT(X(1),Y(1))
PLOT LINES:X(2),Y(2);
SET COLOR COLORINDEX(1,0,0)
DRAW DISK WITH SCALE(3)*SHIFT(X(2),Y(2))
PLOT LINES:X(3),Y(3);
SET COLOR COLORINDEX(1,0,1)
DRAW DISK WITH SCALE(3)*SHIFT(X(3),Y(3))
PLOT LINES:X(4),Y(4);
SET COLOR COLORINDEX(0,1,0)
DRAW DISK WITH SCALE(3)*SHIFT(X(4),Y(4))
PLOT LINES:X(1),Y(1)
END IF
WAIT DELAY 1.5
CLEAR
PRINT "出力用四角形"
PRINT "マウスで座標を指定してください(4点)" !'四角形を指定する
CALL GETXY(U(1),V(1),U(2),V(2),U(3),V(3),U(4),V(4)) !'4回左クリックする
IF ISSQUARE(U(1),V(1),U(2),V(2),U(3),V(3),U(4),V(4))=0 THEN !'四角形でないなら並び替え
PRINT "四角形ではありません"
PRINT "並び替えます"
WAIT DELAY 2
CALL SORT(U(1),V(1),U(2),V(2),U(3),V(3),U(4),V(4))
CLEAR
PLOT LINES:U(1),V(1);
SET COLOR COLORINDEX(0,0,1)
DRAW DISK WITH SCALE(3)*SHIFT(U(1),V(1))
PLOT LINES:U(2),V(2);
SET COLOR COLORINDEX(1,0,0)
DRAW DISK WITH SCALE(3)*SHIFT(U(2),V(2))
PLOT LINES:U(3),V(3);
SET COLOR COLORINDEX(1,0,1)
DRAW DISK WITH SCALE(3)*SHIFT(U(3),V(3))
PLOT LINES:U(4),V(4);
SET COLOR COLORINDEX(0,1,0)
DRAW DISK WITH SCALE(3)*SHIFT(U(4),V(4))
PLOT LINES:U(1),V(1)
END IF
!' 変換式 (※ ここではIを1とおく)
!' U=(A*X+B*Y+C)/(G*X+H*Y+I)
!' V=(D*X+E*F+C)/(G*X+H*Y+I)
!' A*X+B*Y+C-U*(G*X+H*Y)=U
!' D*X+E*Y+F-V*(G*X+H*Y)=V
!'8元連立方程式
!'(A)(X1, Y1, 1, 0, 0, 0,-U1*X1,-U1*Y1) (U1)
!'(B)(X2, Y2, 1, 0, 0, 0,-U2*X2,-U2*Y2) (U2)
!'(C)(X3, Y3, 1, 0, 0, 0,-U3*X3,-U3*Y3) (U3)
!'(D)(X4, Y4, 1, 0, 0, 0,-U4*X4,-U4*Y4) (U4)
!'(E)( 0, 0, 0,X1,Y1, 1,-V1*X1,-V1*Y1)=(V1)
!'(F)( 0, 0, 0,X2,Y2, 1,-V2*X2,-V2*Y2) (V2)
!'(G)( 0, 0, 0,X3,Y3, 1,-V3*X3,-V3*Y3) (V3)
!'(H)( 0, 0, 0,X4,Y4, 1,-V4*X4,-V4*Y4) (V4)
LET A(1, 1) = X(1)
LET A(1, 2) = Y(1)
LET A(1, 3) = 1
LET A(1, 7) = -U(1) * X(1)
LET A(1, 8) = -U(1) * Y(1)
LET D(1)=U(1)
LET A(2, 1) = X(2)
LET A(2, 2) = Y(2)
LET A(2, 3) = 1
LET A(2, 7) = -U(2) * X(2)
LET A(2, 8) = -U(2) * Y(2)
LET D(2)=U(2)
LET A(3, 1) = X(3)
LET A(3, 2) = Y(3)
LET A(3, 3) = 1
LET A(3, 7) = -U(3) * X(3)
LET A(3, 8) = -U(3) * Y(3)
LET D(3)=U(3)
LET A(4, 1) = X(4)
LET A(4, 2) = Y(4)
LET A(4, 3) = 1
LET A(4, 7) = -U(4) * X(4)
LET A(4, 8) = -U(4) * Y(4)
LET D(4)=U(4)
LET A(5, 4) = X(1)
LET A(5, 5) = Y(1)
LET A(5, 6) = 1
LET A(5, 7) = -V(1) * X(1)
LET A(5, 8) = -V(1) * Y(1)
LET D(5)=V(1)
LET A(6, 4) = X(2)
LET A(6, 5) = Y(2)
LET A(6, 6) = 1
LET A(6, 7) = -V(2) * X(2)
LET A(6, 8) = -V(2) * Y(2)
LET D(6)=V(2)
LET A(7, 4) = X(3)
LET A(7, 5) = Y(3)
LET A(7, 6) = 1
LET A(7, 7) = -V(3) * X(3)
LET A(7, 8) = -V(3) * Y(3)
LET D(7)=V(3)
LET A(8, 4) = X(4)
LET A(8, 5) = Y(4)
LET A(8, 6) = 1
LET A(8, 7) = -V(4) * X(4)
LET A(8, 8) = -V(4) * Y(4)
LET D(8)=V(4)
MAT A=INV(A)
MAT D=A*D
LET A1 = D(1)
LET B1 = D(2)
LET C1 = D(3)
LET D1 = D(4)
LET E1 = D(5)
LET F1 = D(6)
LET G1 = D(7)
LET H1 = D(8)
LET MODE=2
FOR VV = 0 TO YSIZE-1
FOR UU = 0 TO XSIZE-1
IF AREA4(U(1), V(1), U(2), V(2), U(3), V(3), U(4), V(4), UU,VV)<>0 THEN !'四角形内なら
CALL SOLVE(A1 - G1* UU, B1 - UU * H1, UU - C1, D1- G1 * VV, E1 - VV * H1, VV - F1, XA, YA) !'逆変換
!' XA,YAを求める
!' (A1*XA+B1*YA+C1)/(G1*XA+H1*YA+1)-UU=0
!' (D1*XA+E1*YA+F1)/(G1*XA+H1*YA+1)-VV=0
!' A1*XA+B1*YA+C1-UU*(G1*XA+H1*YA+1)=0
!' D1*XA+E1*YA+F1-VV*(G1*XA+H1*YA+1)=0
!' XA*(A1-G1*UU)+YA*(B1-UU*H1)=UU-C1
!' XA*(D1-G1*VV)+YA*(E1-VV*H1)=VV-F1
IF XA >= 0 AND YA >= 0 AND XA <= XSIZE - 1 AND YA <= YSIZE - 1 THEN
SELECT CASE MODE
CASE 0
CALL NEAR(XA,YA,M,RR,GG,BB)
CASE 1
CALL BILIEAR(XA,YA,M,RR,GG,BB)
CASE 2
CALL BICUBIC(XA,YA,M,RR,GG,BB)
END SELECT
CALL PSET(UU,VV,RR,GG,BB)
END IF
END IF
NEXT UU
NEXT VV
END
EXTERNAL SUB GETXY(XA,YA,XB,YB,XC,YC,XD,YD)
!'正順(左上-->右上-->右下-->左下)時計回りとする
!'クリック順 青--> 赤--> 紫 --> 緑 の順にラインを結ぶ
!'ラインの色は青線(上側)、赤線(右側)、紫線(下側)、緑線(左側)を表す
FOR I=1 TO 4
DO
MOUSE POLL X,Y,LEFT,RIGHT
LOOP UNTIL LEFT=1 OR RIGHT=1
PRINT "(";X;",";Y;")"
IF RIGHT=1 THEN
LET XA=0
LET YA=0
LET XB=XSIZE-1
LET YB=0
LET XC=XSIZE-1
LET YC=YSIZE-1
LET XD=0
LET YD=YSIZE-1
EXIT FOR
END IF
SELECT CASE I
CASE 1
LET XA=X
LET YA=Y
SET COLOR COLORINDEX(0,0,1)
DRAW DISK WITH SCALE(3)*SHIFT(X,Y) !'青点
CASE 2
LET XB=X
LET YB=Y
PLOT LINES:XA,YA;XB,YB
SET COLOR COLORINDEX(1,0,0)
DRAW DISK WITH SCALE(3)*SHIFT(X,Y) !'赤点
CASE 3
LET XC=X
LET YC=Y
PLOT LINES:XB,YB;XC,YC
SET COLOR COLORINDEX(1,0,1)
DRAW DISK WITH SCALE(3)*SHIFT(X,Y) !'紫点
CASE 4
LET XD=X
LET YD=Y
PLOT LINES:XC,YC;XD,YD
SET COLOR COLORINDEX(0,1,0)
DRAW DISK WITH SCALE(3)*SHIFT(X,Y) !'緑点
PLOT LINES:XD,YD;XA,YA
END SELECT
DO
MOUSE POLL DMX,DMY,LEFT,RIGHT
LOOP WHILE LEFT=1
NEXT I
END SUB
EXTERNAL FUNCTION TRIANGLE (X1, Y1, X2, Y2, X3, Y3) !'三角形の面積
LET TRIANGLE = ABS(X1 * Y2 + X2 * Y3 + X3 * Y1 - X2 * Y1 - X3 * Y2 - Y3 * X1) / 2
END FUNCTION
EXTERNAL FUNCTION AREA3 (X1, Y1, X2, Y2, X3, Y3, PX, PY) !'三角形内なら真
LET T = TRIANGLE(X1, Y1, X2, Y2, X3, Y3)
LET A = TRIANGLE(X1, Y1, X2, Y2, PX, PY)
LET B = TRIANGLE(X2, Y2, X3, Y3, PX, PY)
LET C = TRIANGLE(X1, Y1, X3, Y3, PX, PY)
IF ABS(A + B + C - T) < 1 THEN LET AREA3 = -1 ELSE LET AREA3 = 0
END FUNCTION
EXTERNAL FUNCTION AREA4 (X1, Y1, X2, Y2, X3, Y3, X4, Y4, PX, PY) !'四角形内なら真
LET A = AREA3(X1, Y1, X2, Y2, X3, Y3, PX, PY)
LET B = AREA3(X1, Y1, X4, Y4, X3, Y3, PX, PY)
IF A<>0 OR B<>0 THEN LET AREA4 = -1 ELSE LET AREA4 = 0
END FUNCTION
|
|