|
|
!'共一次変換(擬似アフィン変換)
PUBLIC NUMERIC XSIZE,YSIZE
FILE GETNAME F$,"BMP,JPG,GIF,PNGファイル|*.BMP;*.JPG;*.GIF;*.PNG"
IF F$="" THEN STOP
CALL PICTURELOAD(F$,XSIZE,YSIZE)
DIM M(0 TO XSIZE-1,0 TO YSIZE-1),A(4,4),D(4)
ASK PIXEL ARRAY(0,0) M
!'入力画像
LET XA=XSIZE*.3 !'任意の四角形 左上(XA,YA)-右上(XB,YB)-右下(XC,YC)-左下(XD,YD)
LET YA=YSIZE*.1
LET XB=XSIZE*.8
LET YB=YSIZE*.05
LET XC=XSIZE*.9
LET YC=YSIZE*.8
LET XD=XSIZE*.1
LET YD=YSIZE*.9
FOR Y=0 TO YSIZE-1
FOR X=0 TO XSIZE-1
IF AREA4(XA,YA,XB,YB,XC,YC,XD,YD,X,Y)=0 THEN CALL PSET(X,Y,0,0,0)
NEXT X
NEXT Y
!'出力画像
LET X1=XSIZE*.1 !'任意の四角形 左上(X1,Y1)- 右上(X2,Y2)-右下(X3,Y3)-左下(X4,Y4)
LET Y1=YSIZE*.3
LET X2=XSIZE*.9
LET Y2=YSIZE*.1
LET X3=XSIZE*.7
LET Y3=YSIZE*.8
LET X4=XSIZE*.2
LET Y4=YSIZE*.9
!'INPUT PROMPT "ROTATE (0 - 3)=":N
!'CALL ROTATE(N,X1,X2,X3,X4) !'座標回転 (X1,Y1)-(X2,Y2)-(X3,Y3)-(X4,Y4) → (X2,Y2)-(X3,Y3)-(X4,Y4)-(X1,Y1) →
!'CALL ROTATE(N,Y1,Y2,Y3,Y4) !' (X3,Y3)-(X4,Y4)-(X1,Y1)-(X2,Y2) → (X4,Y4)-(X1,Y1)-(X2,Y2)-(X3,Y3)
WAIT DELAY 2
CLEAR
SET COLOR COLORINDEX (1,0,0)
PLOT AREA : X1,Y1;X2,Y2;X3,Y3;X4,Y4
!'共一次変換(擬似アフィン変換)
!' X'=A*X*Y+B*X+C*Y+D
!' Y'=E*X*Y+F*X+G*Y+H
!'4元連立方程式
!'A*XA*YA+B*XA+C*YA+D=X1
!'A*XB*YB+B*XB+C*YB+D=X2
!'A*XC*YC+B*XC+C*YC+D=X3
!'A*XD*YD+B*XD+C*YD+D=X4
LET A(1,1)=XA*YA
LET A(1,2)=XA
LET A(1,3)=YA
LET A(1,4)=1
LET D(1)=X1
LET A(2,1)=XB*YB
LET A(2,2)=XB
LET A(2,3)=YB
LET A(2,4)=1
LET D(2)=X2
LET A(3,1)=XC*YC
LET A(3,2)=XC
LET A(3,3)=YC
LET A(3,4)=1
LET D(3)=X3
LET A(4,1)=XD*YD
LET A(4,2)=XD
LET A(4,3)=YD
LET A(4,4)=1
LET D(4)=X4
MAT A=INV(A)
MAT D=A*D
LET A1=D(1)
LET B1=D(2)
LET C1=D(3)
LET D1=D(4)
!'4元連立方程式
!'E*XA*YA+F*XA+G*YA+H=Y1
!'E*XB*YB+F*XB+G*YB+H=Y2
!'E*XC*YC+F*XC+G*YC+H=Y3
!'E*XD*YD+F*XD+G*YD+H=Y4
LET A(1,1)=XA*YA
LET A(1,2)=XA
LET A(1,3)=YA
LET A(1,4)=1
LET D(1)=Y1
LET A(2,1)=XB*YB
LET A(2,2)=XB
LET A(2,3)=YB
LET A(2,4)=1
LET D(2)=Y2
LET A(3,1)=XC*YC
LET A(3,2)=XC
LET A(3,3)=YC
LET A(3,4)=1
LET D(3)=Y3
LET A(4,1)=XD*YD
LET A(4,2)=XD
LET A(4,3)=YD
LET A(4,4)=1
LET D(4)=Y4
MAT A=INV(A)
MAT D=A*D
LET E1=D(1)
LET F1=D(2)
LET G1=D(3)
LET H1=D(4)
FOR YY=0 TO YSIZE-1
FOR XX=0 TO XSIZE-1
IF AREA4(X1,Y1,X2,Y2,X3,Y3,X4,Y4,XX,YY)<>0 THEN
CALL SOLVE(A1,B1,C1,D1-XX,E1,F1,G1,H1-YY,XA,YA)
IF XA>=0 AND XA<=XSIZE-1 AND YA>=0 AND YA<=YSIZE-1 THEN
CALL RGB(M(XA,YA),R,G,B)
CALL PSET(XX,YY,R,G,B)
END IF
END IF
NEXT XX
NEXT YY
END
EXTERNAL SUB SOLVE(A,B,C,D,E,F,G,H,XA,YA)
!' X,Yについて解く(逆変換)
!' A*X*Y+B*X+C*Y+D=0...(1)
!' E*X*Y+F*X+G*Y+H=0...(2)
!' X*(A*Y+B)=-C*Y-D (1)の式より...(3)
!' E*X*Y*(A*Y+B)+F*X*(A*Y+B)+G*Y*(A*Y+B)+H*(A*Y+B)=0 (2)の式に(A*Y+B)を掛ける
!' E*Y*(-C*Y-D) +F*(-C*Y-D) +G*Y*(A*Y+B)+H*(A*Y+B)=0 (3)の式を代入
!' Y^2*(-E*C+A*G)+Y*(-E*D-F*C+G*B+A*H)+(-F*D+H*B)=0 Yについての2次方程式
!' X=(-C*Y-D)/(A*Y+B) (3)の式より変形
LET AA=-E*C+A*G
LET BB=-E*D-F*C+G*B+A*H
LET CC=-F*D+H*B
LET DD=BB*BB-4*AA*CC
IF DD<0 THEN
LET XA=-1
LET YA=-1
EXIT SUB
END IF
LET YA=INT((-BB+SQR(DD))/(2*AA))
LET XA=INT((-C*YA-D)/(A*YA+B))
IF XA>=0 AND XA<=XSIZE-1 AND YA>=0 AND YA<=YSIZE-1 THEN EXIT SUB
LET YA=INT((-BB-SQR(DD))/(2*AA))
LET XA=INT((-C*YA-D)/(A*YA+B))
IF XA>=0 AND XA<=XSIZE-1 AND YA>=0 AND YA<=YSIZE-1 THEN EXIT SUB
LET XA=-1
LET YA=-1
END SUB
EXTERNAL SUB RGB(X,R,G,B)
LET B=MOD(INT(X/65536),256)
LET G=MOD(INT(X/256),256)
LET R=MOD(X,256)
END SUB
EXTERNAL SUB GINIT(XSIZE,YSIZE)
SET BITMAP SIZE XSIZE,YSIZE
CLEAR
SET COLOR MODE "NATIVE"
SET POINT STYLE 1
SET WINDOW 0,XSIZE-1,YSIZE-1,0
END SUB
EXTERNAL SUB PSET(X,Y,R,G,B)
SET COLOR COLORINDEX(R/255,G/255,B/255)
PLOT POINTS:X,Y
END SUB
EXTERNAL SUB PICTURELOAD(N$,XSIZE,YSIZE)
CLEAR
SET COLOR MODE "NATIVE"
SET POINT STYLE 1
GLOAD N$
LET XSIZE=PIXELX(1)
LET YSIZE=PIXELY(1)
SET BITMAP SIZE XSIZE,YSIZE
SET WINDOW 0,XSIZE-1,YSIZE-1,0
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) !'点(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) !'点(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
EXTERNAL SUB ROTATE(N,A,B,C,D)
FOR I=1 TO N
LET T=B
LET B=A
LET A=D
LET D=C
LET C=T
NEXT I
END SUB
|
|