写像変換5

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

OPTION BASE 0
PUBLIC NUMERIC XSIZE,YSIZE
DIM XA(5),YA(5),XB(5),YB(5),XC(5),YC(5),XD(5),YD(5)
LET R=35
!'INPUT PROMPT  "縮小率 (0 - 100%)=": R
FILE GETNAME F$, "BMP,JPG,GIFファイル|*.BMP;*.JPG;*.GIF"
IF F$="" THEN STOP
CALL PICTURELOAD(F$,XSIZE,YSIZE)
DIM M(XSIZE,YSIZE)
ASK PIXEL ARRAY(0,0) M
LET  XS = INT(XSIZE * (100 - R) / 200)
LET  YS = INT(YSIZE * (100 - R) / 200)
LET  XE = INT(XS + XSIZE * R / 100)
LET  YE = INT(YS + YSIZE * R / 100)

!'5つの領域に分割
LET  XA(1) = XS !'左
LET  YA(1) = YS
LET  XB(1) = 0
LET  YB(1) = 0
LET  XC(1) = 0
LET  YC(1) = YSIZE - 1
LET  XD(1) = XS
LET  YD(1) = YE

LET  XA(2) = XE !'右
LET  YA(2) = YS
LET  XB(2) = XSIZE - 1
LET  YB(2) = 0
LET  XC(2) = XSIZE - 1
LET  YC(2) = YSIZE - 1
LET  XD(2) = XE
LET  YD(2) = YE

LET  XA(3) = XS !'下
LET  YA(3) = YE
LET  XB(3) = XE
LET  YB(3) = YE
LET  XC(3) = XSIZE - 1
LET  YC(3) = YSIZE - 1
LET  XD(3) = 0
LET  YD(3) = YSIZE - 1

LET  XA(4) = 0 !'上
LET  YA(4) = 0
LET  XB(4) = XSIZE - 1
LET  YB(4) = 0
LET  XC(4) = XE
LET  YC(4) = YS
LET  XD(4) = XS
LET  YD(4) = YS

LET  XA(5) = XS !'正面
LET  YA(5) = YS
LET  XB(5) = XE
LET  YB(5) = YS
LET  XC(5) = XE
LET  YC(5) = YE
LET  XD(5) = XS
LET  YD(5) = YE
LET MODE=1
CLEAR
FOR Y = 0 TO YSIZE - 1
   FOR X = 0 TO XSIZE - 1
      FOR I = 1 TO 5
         CALL SOLVE(XA(I),YA(I),XB(I),YB(I),XC(I),YC(I),XD(I),YD(I),X,Y,S,T) !'逆変換
         IF S >= 0 AND S <= 1 AND T >= 0 AND T <= 1 THEN
            LET  XX = (XSIZE-1) * S
            LET  YY = (YSIZE-1) * T
            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
      NEXT I
   NEXT X
NEXT Y
END

EXTERNAL  SUB SOLVE (XA,YA,XB,YB,XC,YC,XD,YD,X,Y,S,T)
!' (S*A+T*B+C)/(S*G+T*H+1)=XX
!' (S*D+T*E+F)/(S*G+T*H+1)=YY
!' S=0,T=0
!' C=XA F=YA
!' S=1,T=0
!' (A+C)/(G+1)=XB (D+F)/(G+1)=YB A=XB*(G+1)-XA,D=YB*(G+1)-YA
!' S=0,T=1
!' (B+C)/(H+1)=XD (D+F)/(H+1)=YD B=XD*(H+1)-XD,E=YD*(H+1)-YD
!' S=1,T=1
!' (A+B+C)/(G+H+1)=XC (D+E+F)/(G+H+1)=YC
!' G*(XB-XC)+H*(XD-XC)=XA+XC-XD-XB
!' G*(YB-YC)+H*(YD-YC)=YA+YC-YD-YB

!' (S*A+T*B+XA)/(S*G+T*H+1)=X
!' (S*D+T*E+YA)/(S*G+T*H+1)=Y

!' S*(A-X*G)+T*(B-X*H)=X-XA
!' S*(D-Y*G)+T*(E-Y*H)=Y-YA

LET DD=(YD-YC)*(XB-XC)-(XD-XC)*(YB-YC)
LET G=((YD-YC)*(XA+XC-XD-XB)-(XD-XC)*(YA+YC-YD-YB))/DD
LET H=((XB-XC)*(YA+YC-YD-YB)-(YB-YC)*(XA+XC-XD-XB))/DD
LET A=XB*(G+1)-XA
LET D=YB*(G+1)-YA
LET B=XD*(H+1)-XA
LET E=YD*(H+1)-YA
LET DD=(A-X*G)*(E-Y*H)-(B-X*H)*(D-Y*G)
IF DD=0 THEN
   LET S=-1
   LET T=-1
ELSE
   LET S=((X-XA)*(E-Y*H)-(B-X*H)*(Y-YA))/DD
   LET T=((A-X*G)*(Y-YA)-(X-XA)*(D-Y*G))/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

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
 

戻る