共一次変換

 投稿者:しばっち  投稿日:2015年 5月30日(土)22時15分5秒
  !'共一次変換(擬似アフィン変換)
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)
ASK PIXEL ARRAY(0,0) M
!' 共一次変換
!' X=A*S*T+B*S+C*T+D (0<=S<=1)(0<=T<=1)
!' Y=E*S*T+F*S+G*T+H
!'S=0,T=0 の時,左上(XA,YA) D=XA,H=YA
!'S=1,T=0 の時,右上(XB,YB) B+XA=XB,F+YA=YB   B=XB-XA,F=YB-YA
!'S=0,T=1 の時,左下(XD,YD) C+XA=XD,G+YA=YD   C=XD-XA,G=YD-YA
!'S=1,T=1 の時,右下(XC,YC) A+XB-XA+XD-XA+XA=XC,E+YB-YA+YD-YA+YA=YC   A=XC+XA-XD-XB,E=YA+YC-YD-YB
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
CLEAR
SET COLOR COLORINDEX(1,0,0)
PLOT AREA : XA,YA;XB,YB;XC,YC;XD,YD
FOR YY=0 TO YSIZE-1
   FOR XX=0 TO XSIZE-1
      LET S=XX/(XSIZE-1)
      LET T=YY/(YSIZE-1)
      LET X=INT((XA+XC-XD-XB)*S*T+(XD-XA)*T+(XB-XA)*S+XA) !'共一次変換
      LET Y=INT((YA+YC-YD-YB)*S*T+(YD-YA)*T+(YB-YA)*S+YA)
      CALL RGB(M(XX,YY),R,G,B)
      CALL PSET(X,Y,R,G,B)
   NEXT XX
NEXT YY
END

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
 

共一次変換

 投稿者:しばっち  投稿日:2015年 5月30日(土)22時16分1秒
  !'共一次変換(擬似アフィン変換)
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
 

戻る