写像変換2

 投稿者:しばっち  投稿日:2011年 5月21日(土)20時01分33秒
  !'写像変換(回転)

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 A(2,2),B(2,2),D(2),M(XSIZE,YSIZE)
ASK PIXEL ARRAY(0,0) M
LET TH=40 !'回転角
LET MODE=2
LET X0=XSIZE/2
LET Y0=YSIZE/2
LET  XMAX = XSIZE - 1
LET  YMAX = YSIZE - 1
LET  XMIN = 0
LET  YMIN = 0
LET  C = COS(TH*PI/180)
LET  S = SIN(TH*PI/180)
LET XA = INT((XMIN - X0) * C - (YMIN - Y0) * S + X0) !'回転後の座標
LET YA = INT((XMIN - X0) * S + (YMIN - Y0) * C + Y0)
LET XB = INT((XMIN - X0) * C - (YMAX - Y0) * S + X0)
LET YB = INT((XMIN - X0) * S + (YMAX - Y0) * C + Y0)
LET XC = INT((XMAX - X0) * C - (YMAX - Y0) * S + X0)
LET YC = INT((XMAX - X0) * S + (YMAX - Y0) * C + Y0)
LET XD = INT((XMAX - X0) * C - (YMIN - Y0) * S + X0)
LET YD = INT((XMAX - X0) * S + (YMIN - Y0) * C + Y0)
LET T=MIN(MIN(0,MIN(XA,XB)),MIN(XC,XD)) !'はみ出す部分を平行移動
LET XA=XA-T
LET XB=XB-T
LET XC=XC-T
LET XD=XD-T
LET T=MIN(MIN(0,MIN(YA,YB)),MIN(YC,YD))
LET YA=YA-T
LET YB=YB-T
LET YC=YC-T
LET YD=YD-T
LET X1=XMIN !'左上
LET Y1=YMIN
LET X2=XMAX !'右上
LET Y2=YMIN
LET X3=XMAX !'右下
LET Y3=YMAX
LET X4=XMIN !'左下
LET Y4=YMAX

!'変換式(アフィン変換)
!'XA=A*X+B*Y+C
!'YA=D*X+E*Y+F

!'3元連立方程式
!'A1*X1+B1*Y1+C1=XA
!'A1*X2+B1*Y2+C1=XB
!'A1*X3+B1*Y3+C1=XC

!'D1*X1+E1*Y1+F1=YA
!'D1*X2+E1*Y2+F1=YB
!'D1*X3+E1*Y3+F1=YC

!'四角形を三角形2つに分割
LET A(0,0)=X1
LET A(0,1)=Y1
LET A(0,2)=1
LET D(0)=XA
LET A(1,0)=X2
LET A(1,1)=Y2
LET A(1,2)=1
LET D(1)=XB
LET A(2,0)=X3
LET A(2,1)=Y3
LET A(2,2)=1
LET D(2)=XC
MAT A=INV(A)
MAT D=A*D !'方程式を解く
LET A1=D(0)
LET B1=D(1)
LET C1=D(2)

LET A(0,0)=X1
LET A(0,1)=Y1
LET A(0,2)=1
LET D(0)=YA
LET A(1,0)=X2
LET A(1,1)=Y2
LET A(1,2)=1
LET D(1)=YB
LET A(2,0)=X3
LET A(2,1)=Y3
LET A(2,2)=1
LET D(2)=YC
MAT A=INV(A)
MAT D=A*D
LET D1=D(0)
LET E1=D(1)
LET F1=D(2)

LET A(0,0)=X1
LET A(0,1)=Y1
LET A(0,2)=1
LET D(0)=XA
LET A(1,0)=X3
LET A(1,1)=Y3
LET A(1,2)=1
LET D(1)=XC
LET A(2,0)=X4
LET A(2,1)=Y4
LET A(2,2)=1
LET D(2)=XD
MAT A=INV(A)
MAT D=A*D
LET A2=D(0)
LET B2=D(1)
LET C2=D(2)
LET A(0,0)=X1
LET A(0,1)=Y1
LET A(0,2)=1
LET D(0)=YA
LET A(1,0)=X3
LET A(1,1)=Y3
LET A(1,2)=1
LET D(1)=YC
LET A(2,0)=X4
LET A(2,1)=Y4
LET A(2,2)=1
LET D(2)=YD
MAT A=INV(A)
MAT D=A*D
LET D2=D(0)
LET E2=D(1)
LET F2=D(2)
LET XE=INT(MAX(MAX(XA,XB),MAX(XC,XD)))
LET YE=INT(MAX(MAX(YA,YB),MAX(YC,YD)))
WAIT DELAY 1
CALL GINIT(XE,YE) !'画像サイズの変更
FOR Y=0 TO YE
   FOR X=0 TO XE
      IF AREA3(XA,YA,XB,YB,XC,YC,X,Y)<>0 THEN !'三角形内なら
         CALL SOLVE(A1,B1,X-C1,D1,E1,Y-F1,XX,YY) !'逆変換
         IF XX>=0 AND XX<=XSIZE-1 AND YY>=0 AND YY<=YSIZE-1 THEN
            SELECT CASE MODE
            CASE 0
               CALL NEAR(XX,YY,M,RR,GG,BB)
            CASE 1
               CALL BILIEAR(XX,YY,M,RR,GG,BB)
            CASE 2
               CALL BICUBIC(XX,YY,M,RR,GG,BB)
            END SELECT
            CALL PSET(X,Y,RR,GG,BB)
         END IF
      END IF
      IF AREA3(XA,YA,XC,YC,XD,YD,X,Y)<>0 THEN
         CALL SOLVE(A2,B2,X-C2,D2,E2,Y-F2,XX,YY)
         IF XX>=0 AND XX<=XSIZE-1 AND YY>=0 AND YY<=YSIZE-1 THEN
            SELECT CASE MODE
            CASE 0
               CALL NEAR(XX,YY,M,RR,GG,BB)
            CASE 1
               CALL BILIEAR(XX,YY,M,RR,GG,BB)
            CASE 2
               CALL BICUBIC(XX,YY,M,RR,GG,BB)
            END SELECT
            CALL PSET(X,Y,RR,GG,BB)
         END IF
      END IF
   NEXT X
NEXT Y
END

EXTERNAL  SUB SOLVE(A1, B1, C1, A2, B2, C2, XA, YA) !'逆変換
!'  XA,YAを求める
!'A1*XA+B1*YA=C1
!'A2*XA+B2*YA=C2
LET  DD = A1 * B2 - A2 * B1
IF DD=0 THEN
   LET XA=-1
   LET YA=-1
ELSE
   LET  XA = (C1 * B2 - C2 * B1) / DD
   LET  YA = (A1 * C2 - A2 * C1) / DD
END IF
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
 

戻る