アフィン変換

 投稿者:しばっち  投稿日:2015年 5月30日(土)22時14分27秒
  !'アフィン変換
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(3,3),B(3),D(3,3)
DIM A1(2),B1(2),C1(2),D1(2),E1(2),F1(2),AX(2),BX(2),CX(2),AY(2),BY(2),CY(2)
ASK PIXEL ARRAY(0,0) M
!'入力画像
LET XA=XSIZE*.3 !'任意の四角形 左上(XA,YA)-右上(XB,YB)-右下(XC,YC)-左下(XD,YD)
LET YA=YSIZE*.1 !'三角形 (XA,YA)-(XB,YB)-(XC,YC)と
LET XB=XSIZE*.8 !'三角形 (XA,YA)-(XC,YC)-(XD,YD)に分割
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 !'三角形 (X1,Y1)-(X2,Y2)-(X3,Y3)と
LET X2=XSIZE*.9 !'三角形 (X1,Y1)-(X3,Y3)-(X4,Y4)に分割
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)
!' アフィン変換
!' X'=A*X+B*Y+C
!' Y'=D*X+E*Y+F
!'三元連立方程式
!' (A)(XA YA 1) (X1)
!' (B)(XB YB 1)=(X2)
!' (C)(XC YC 1) (X3)
LET A(1,1)=XA
LET A(1,2)=YA
LET A(1,3)=1
LET A(2,1)=XB
LET A(2,2)=YB
LET A(2,3)=1
LET A(3,1)=XC
LET A(3,2)=YC
LET A(3,3)=1
LET B(1)=X1
LET B(2)=X2
LET B(3)=X3
LET AX(1)=B(1)
LET BX(1)=B(2)
LET CX(1)=B(3)
MAT D=INV(A)
MAT B=D*B
LET A1(1)=B(1)
LET B1(1)=B(2)
LET C1(1)=B(3)
!'三元連立方程式
!' (D)(XA YA 1) (Y1)
!' (E)(XB YB 1)=(Y2)
!' (F)(XC YC 1) (Y3)
LET B(1)=Y1
LET B(2)=Y2
LET B(3)=Y3
LET AY(1)=B(1)
LET BY(1)=B(2)
LET CY(1)=B(3)
MAT D=INV(A)
MAT B=D*B
LET D1(1)=B(1)
LET E1(1)=B(2)
LET F1(1)=B(3)
!'三元連立方程式
!' (A)(XA YA 1) (X1)
!' (B)(XC YC 1)=(X3)
!' (C)(XD YD 1) (X4)
LET A(1,1)=XA
LET A(1,2)=YA
LET A(1,3)=1
LET A(2,1)=XC
LET A(2,2)=YC
LET A(2,3)=1
LET A(3,1)=XD
LET A(3,2)=YD
LET A(3,3)=1
LET B(1)=X1
LET B(2)=X3
LET B(3)=X4
LET AX(2)=B(1)
LET BX(2)=B(2)
LET CX(2)=B(3)
MAT D=INV(A)
MAT B=D*B
LET A1(2)=B(1)
LET B1(2)=B(2)
LET C1(2)=B(3)
!'三元連立方程式
!' (D)(XA YA 1) (Y1)
!' (E)(XC YC 1)=(Y3)
!' (F)(XD YD 1) (Y4)
LET B(1)=Y1
LET B(2)=Y3
LET B(3)=Y4
LET AY(2)=B(1)
LET BY(2)=B(2)
LET CY(2)=B(3)
MAT D=INV(A)
MAT B=D*B
LET D1(2)=B(1)
LET E1(2)=B(2)
LET F1(2)=B(3)
WAIT DELAY 2
CLEAR
SET COLOR COLORINDEX (1,0,0)
PLOT AREA : X1,Y1;X2,Y2;X3,Y3
SET COLOR COLORINDEX (0,1,0)
PLOT AREA : X1,Y1;X3,Y3;X4,Y4
FOR YY=0 TO YSIZE-1
   FOR XX=0 TO XSIZE-1
      FOR I=1 TO 2
         IF AREA3(AX(I),AY(I),BX(I),BY(I),CX(I),CY(I),XX,YY)<>0 THEN
            CALL SOLVE(A1(I),B1(I),C1(I),D1(I),E1(I),F1(I),XX,YY,X,Y)
            IF X>=0 AND X<=XSIZE-1 AND Y>=0 AND Y<=YSIZE-1 THEN
               LET CC=M(INT(X),INT(Y))
               CALL RGB(CC,RR,GG,BB)
               CALL PSET(XX,YY,RR,GG,BB)
               EXIT FOR
            END IF
         END IF
      NEXT I
   NEXT XX
NEXT YY
END

EXTERNAL SUB SOLVE(A,B,C,D,E,F,XX,YY,X,Y)
!'A*X+B*Y+C=XX
!'D*X+E*Y+F=YY
LET X = -(B*(F-YY)+E*XX-C*E)/(B*D-A*E)
LET Y = (A*(F-YY)+D*XX-C*D)/(B*D-A*E)
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
SET COLOR MODE "NATIVE"
CLEAR
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)
SET COLOR MODE "NATIVE"
CLEAR
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

 

戻る