|
!'写像変換
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
|
|