|
|
!'写像変換(回転)
PUBLIC NUMERIC XSIZE,YSIZE
OPTION BASE 0
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 ALPHA=40 !'回転角
LET ALPHA = ALPHA * PI/180
LET MODE=1
LET OX=XSIZE/2
LET OY=YSIZE/2
!'極座標(r,θ)で表す
LET X=0 !'左上
LET Y=0
!'LET TH=ATAN2(Y-OY,X-OX)
LET TH=ANGLE(X-OX,Y-OY)
LET RR=SQR((X-OX)^2+(Y-OY)^2)
LET XA=RR*COS(TH+ALPHA)+OX !'回転後の座標(XA,YA)
LET YA=RR*SIN(TH+ALPHA)+OY
LET X=XSIZE-1 !'右上
LET Y=0
!'LET TH=ATAN2(Y-OY,X-OX)
LET TH=ANGLE(X-OX,Y-OY)
LET RR=SQR((X-OX)^2+(Y-OY)^2)
LET XB=RR*COS(TH+ALPHA)+OX !'回転後の座標(XB,YB)
LET YB=RR*SIN(TH+ALPHA)+OY
LET X=XSIZE-1 !'右下
LET Y=YSIZE-1
!'LET TH=ATAN2(Y-OY,X-OX)
LET TH=ANGLE(X-OX,Y-OY)
LET RR=SQR((X-OX)^2+(Y-OY)^2)
LET XC=RR*COS(TH+ALPHA)+OX !'回転後の座標(XC,YC)
LET YC=RR*SIN(TH+ALPHA)+OY
LET X=0 !'左下
LET Y=YSIZE-1
!'LET TH=ATAN2(Y-OY,X-OX)
LET TH=ANGLE(X-OX,Y-OY)
LET RR=SQR((X-OX)^2+(Y-OY)^2)
LET XD=RR*COS(TH+ALPHA)+OX !'回転後の座標(XD,YD)
LET YD=RR*SIN(TH+ALPHA)+OY
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 PX=(XA+XB+XC+XD)/4 !'4点の中心
LET PY=(YA+YB+YC+YD)/4
LET XE=INT(MAX(MAX(XA,XB),MAX(XC,XD)))
LET YE=INT(MAX(MAX(YA,YB),MAX(YC,YD)))
CLEAR
CALL GINIT(XE,YE) !'画像サイズの変更
FOR Y = -PY+OY TO YE
FOR X = -PX+OX TO XE
!'LET TH=ATAN2(Y-OY,X-OX)
LET TH=ANGLE(X-OX,Y-OY)
LET RR=SQR((X-OX)^2+(Y-OY)^2)
LET XX=RR*COS(TH+ALPHA)+OX
LET YY=RR*SIN(TH+ALPHA)+OY
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,R,G,B)
CASE 1
CALL BILIEAR(XX,YY,M,R,G,B)
CASE 2
CALL BICUBIC(XX,YY,M,R,G,B)
END SELECT
CALL PSET(X-OX+PX,Y-OY+PY,R,G,B)
END IF
NEXT X
NEXT Y
END
EXTERNAL FUNCTION ATAN2(Y,X)
IF X<>0 THEN
LET TH=ATN(Y/X)
IF Y<>0 THEN
IF X>0 AND Y<0 THEN LET TH=TH+PI*2
IF X<0 THEN LET TH=TH+PI
ELSE !' Y=0
IF X<0 THEN LET TH=PI ELSE LET TH=0
END IF
ELSE !' X=0
LET TH=PI/2
END IF
LET ATAN2=TH
END FUNCTION
!'以下共通ルーチン
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 PSET(X,Y,R,G,B)
SET COLOR COLORINDEX(R/255,G/255,B/255)
PLOT POINTS: X , Y
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 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 FRAC(X)
LET FRAC=X-INT(X)
END FUNCTION
!'参考文献「C言語で学ぶ 実践CG・映像合成」オーム社
EXTERNAL SUB BILIEAR(X,Y,IMAGE(,),R,G,B)
LET XX=FRAC(X)
LET YY=FRAC(Y)
LET X0=INT(X)
LET Y0=INT(Y)
LET C1=IMAGE(X0,Y0)
IF X0+1<=XSIZE-1 THEN LET C2=IMAGE(X0+1,Y0)
IF Y0+1<=YSIZE-1 THEN LET C3=IMAGE(X0,Y0+1)
IF X0+1<=XSIZE-1 AND Y0+1<=YSIZE-1 THEN LET C4=IMAGE(X0+1,Y0+1)
CALL RGB(C1,R1,G1,B1)
CALL RGB(C2,R2,G2,B2)
CALL RGB(C3,R3,G3,B3)
CALL RGB(C4,R4,G4,B4)
LET R=(1-YY)*((1-XX)*R1+XX*R2)+YY*((1-XX)*R3+XX*R4)
LET G=(1-YY)*((1-XX)*G1+XX*G2)+YY*((1-XX)*G3+XX*G4)
LET B=(1-YY)*((1-XX)*B1+XX*B2)+YY*((1-XX)*B3+XX*B4)
LET R=MAX(0,MIN(255,R))
LET G=MAX(0,MIN(255,G))
LET B=MAX(0,MIN(255,B))
END SUB
EXTERNAL SUB BICUBIC(X,Y,IMAGE(,),R,G,B)
LET XX=FRAC(X)
LET YY=FRAC(Y)
LET X0=INT(X)
LET Y0=INT(Y)
IF X0-1>=0 AND Y0-1>=0 THEN LET C1=IMAGE(X0-1,Y0-1)
IF X0-1>=0 THEN LET C2=IMAGE(X0-1,Y0)
IF X0-1>=0 AND Y0+1<=YSIZE-1 THEN LET C3=IMAGE(X0-1,Y0+1)
IF X0-1>=0 AND Y0+2<=YSIZE-1 THEN LET C4=IMAGE(X0-1,Y0+2)
IF Y0-1>=0 THEN LET C5=IMAGE(X0,Y0-1)
LET C6=IMAGE(X0,Y0)
IF Y0+1<=YSIZE-1 THEN LET C7=IMAGE(X0,Y0+1)
IF Y0+2<=YSIZE-1 THEN LET C8=IMAGE(X0,Y0+2)
IF X0+1<=XSIZE-1 AND Y0-1>=0 THEN LET C9=IMAGE(X0+1,Y0-1)
IF X0+1<=XSIZE-1 THEN LET C10=IMAGE(X0+1,Y0)
IF X0+1<=XSIZE-1 AND Y0+1<=YSIZE-1 THEN LET C11=IMAGE(X0+1,Y0+1)
IF X0+1<=XSIZE-1 AND Y0+2<=YSIZE-1 THEN LET C12=IMAGE(X0+1,Y0+2)
IF X0+2<=XSIZE-1 AND Y0-1>=0 THEN LET C13=IMAGE(X0+2,Y0-1)
IF X0+2<=XSIZE-1 THEN LET C14=IMAGE(X0+2,Y0)
IF X0+2<=XSIZE-1 AND Y0+1<=YSIZE-1 THEN LET C15=IMAGE(X0+2,Y0+1)
IF X0+2<=XSIZE-1 AND Y0+2<=YSIZE-1 THEN LET C16=IMAGE(X0+2,Y0+2)
CALL RGB(C1,R1,G1,B1)
CALL RGB(C2,R2,G2,B2)
CALL RGB(C3,R3,G3,B3)
CALL RGB(C4,R4,G4,B4)
CALL RGB(C5,R5,G5,B5)
CALL RGB(C6,R6,G6,B6)
CALL RGB(C7,R7,G7,B7)
CALL RGB(C8,R8,G8,B8)
CALL RGB(C9,R9,G9,B9)
CALL RGB(C10,R10,G10,B10)
CALL RGB(C11,R11,G11,B11)
CALL RGB(C12,R12,G12,B12)
CALL RGB(C13,R13,G13,B13)
CALL RGB(C14,R14,G14,B14)
CALL RGB(C15,R15,G15,B15)
CALL RGB(C16,R16,G16,B16)
LET RR0=SINC(1+XX)*R1+SINC(XX)*R2+SINC(1-XX)*R3+SINC(2-XX)*R4
LET RR1=SINC(1+XX)*R5+SINC(XX)*R6+SINC(1-XX)*R7+SINC(2-XX)*R8
LET RR2=SINC(1+XX)*R9+SINC(XX)*R10+SINC(1-XX)*R11+SINC(2-XX)*R12
LET RR3=SINC(1+XX)*R13+SINC(XX)*R14+SINC(1-XX)*R15+SINC(2-XX)*R16
LET R=SINC(1+YY)*RR0+SINC(YY)*RR1+SINC(1-YY)*RR2+SINC(2-YY)*RR3
LET GG0=SINC(1+XX)*G1+SINC(XX)*G2+SINC(1-XX)*G3+SINC(2-XX)*G4
LET GG1=SINC(1+XX)*G5+SINC(XX)*G6+SINC(1-XX)*G7+SINC(2-XX)*G8
LET GG2=SINC(1+XX)*G9+SINC(XX)*G10+SINC(1-XX)*G11+SINC(2-XX)*G12
LET GG3=SINC(1+XX)*G13+SINC(XX)*G14+SINC(1-XX)*G15+SINC(2-XX)*G16
LET G=SINC(1+YY)*GG0+SINC(YY)*GG1+SINC(1-YY)*GG2+SINC(2-YY)*GG3
LET BB0=SINC(1+XX)*B1+SINC(XX)*B2+SINC(1-XX)*B3+SINC(2-XX)*B4
LET BB1=SINC(1+XX)*B5+SINC(XX)*B6+SINC(1-XX)*B7+SINC(2-XX)*B8
LET BB2=SINC(1+XX)*B9+SINC(XX)*B10+SINC(1-XX)*B11+SINC(2-XX)*B12
LET BB3=SINC(1+XX)*B13+SINC(XX)*B14+SINC(1-XX)*B15+SINC(2-XX)*B16
LET B=SINC(1+YY)*BB0+SINC(YY)*BB1+SINC(1-YY)*BB2+SINC(2-YY)*BB3
LET R=MAX(0,MIN(255,R))
LET G=MAX(0,MIN(255,G))
LET B=MAX(0,MIN(255,B))
END SUB
EXTERNAL FUNCTION SINC(XX)
!'SINC(X)=SIN(X*PI)/(X*PI)
LET X=ABS(XX)
IF X<1 THEN
LET SINC=1-2*X*X+X*X*X
ELSEIF X<2 THEN
LET SINC=4-8*X+5*X*X-X*X*X
ELSE
LET SINC=0
END IF
END FUNCTION
EXTERNAL SUB NEAR(X,Y,IMAGE(,),R,G,B)
IF X>=0 AND X<=XSIZE-1 THEN
LET XX=INT(X+.5)
ELSE
LET XX=MAX(0,MIN(XSIZE-1,X))
END IF
IF Y>=0 AND Y<=YSIZE-1 THEN
LET YY=INT(Y+.5)
ELSE
LET YY=MAX(0,MIN(YSIZE-1,Y))
END IF
LET C=IMAGE(XX,YY)
CALL RGB(C,R,G,B)
LET R=MAX(0,MIN(255,R))
LET G=MAX(0,MIN(255,G))
LET B=MAX(0,MIN(255,B))
END SUB
|
|