|
|
スプライン法による解像度変換をします。
参考
OPTION ARITHMETIC NATIVE
OPTION BASE 0
PUBLIC NUMERIC XSIZE,YSIZE
FILE GETNAME N$,"BMP,JPG,GIF,PNGファイル|*.BMP;*.JPG;*.GIF;*.PNG"
CALL PICTURELOAD(N$,XSIZE,YSIZE)
DIM VM(XSIZE,YSIZE),S$(4)
ASK PIXEL ARRAY(0,0) VM
PRINT "元画像サイズ ";XSIZE;"＊";YSIZE
DATA SPLINE2,SPLINE3,SPLINE4,SPLINE5,SPLINE6
MAT READ S$
LOCATE CHOICE(S$) : MODE
LOCATE VALUE ,RANGE 0.1 TO 3,AT 1 : SCALE
LET BIWIDTH=INT(XSIZE*SCALE)
LET BIHEIGHT=INT(YSIZE*SCALE)
PRINT "画像サイズ ";BIWIDTH;"＊";BIHEIGHT
PRINT S$(MODE-1)
PRINT "倍率 ";SCALE
CLEAR
SET BITMAP SIZE BIWIDTH,BIHEIGHT
SET WINDOW 0,BIWIDTH-1,BIHEIGHT-1,0
FOR Y=0 TO BIHEIGHT-1
FOR X=0 TO BIWIDTH-1
LET XX=X/SCALE
LET YY=Y/SCALE
SELECT CASE MODE+1
CASE 2
CALL SPLINE2(XX,YY,VM,RR,GG,BB) !'スプライン法
CASE 3
CALL SPLINE3(XX,YY,VM,RR,GG,BB)
CASE 4
CALL SPLINE4(XX,YY,VM,RR,GG,BB)
CASE 5
CALL SPLINE5(XX,YY,VM,RR,GG,BB)
CASE 6
CALL SPLINE6(XX,YY,VM,RR,GG,BB)
END SELECT
CALL PSET(X,Y,RR,GG,BB)
NEXT X
NEXT Y
END
EXTERNAL SUB SPLINE2(X,Y,IMAGE(,),RR,GG,BB)
OPTION ARITHMETIC NATIVE
LET XX=X-INT(X)
LET YY=Y-INT(Y)
LET X0=INT(X)
LET Y0=INT(Y)
FOR L=-1 TO 2
LET R0=0
LET G0=0
LET B0=0
FOR K=-1 TO 2
IF X0+K<XSIZE AND Y0+L<YSIZE AND X0+K>=0 AND Y0+L>=0 THEN LET C=IMAGE(X0+K,Y0+L) ELSE LET C=0
CALL RGB(C,R,G,B)
LET R0=R0+SPLINE16(ABS(K)-XX*SGN_(K))*R
LET G0=G0+SPLINE16(ABS(K)-XX*SGN_(K))*G
LET B0=B0+SPLINE16(ABS(K)-XX*SGN_(K))*B
NEXT K
LET R1=R1+SPLINE16(ABS(L)-YY*SGN_(L))*R0
LET G1=G1+SPLINE16(ABS(L)-YY*SGN_(L))*G0
LET B1=B1+SPLINE16(ABS(L)-YY*SGN_(L))*B0
NEXT L
LET RR=MAX(0,MIN(255,R1))
LET GG=MAX(0,MIN(255,G1))
LET BB=MAX(0,MIN(255,B1))
END SUB
EXTERNAL FUNCTION SPLINE16(X)
OPTION ARITHMETIC NATIVE
LET X=ABS(X)
IF X<=1 THEN
LET SPLINE16=X^3 - 9/5*X^2 - 1/ 5*X + 1
ELSEIF X<=2 THEN
LET SPLINE16=-1/3*X^3 + 9/5*X^2 - 46/15*X + 8/5
ELSE
LET SPLINE16=0
END IF
END FUNCTION
EXTERNAL SUB SPLINE3(X,Y,IMAGE(,),RR,GG,BB)
OPTION ARITHMETIC NATIVE
LET XX=X-INT(X)
LET YY=Y-INT(Y)
LET X0=INT(X)
LET Y0=INT(Y)
FOR L=-2 TO 3
LET R0=0
LET G0=0
LET B0=0
FOR K=-2 TO 3
IF X0+K<XSIZE AND Y0+L<YSIZE AND X0+K>=0 AND Y0+L>=0 THEN LET C=IMAGE(X0+K,Y0+L) ELSE LET C=0
CALL RGB(C,R,G,B)
LET R0=R0+SPLINE36(ABS(K)-XX*SGN_(K))*R
LET G0=G0+SPLINE36(ABS(K)-XX*SGN_(K))*G
LET B0=B0+SPLINE36(ABS(K)-XX*SGN_(K))*B
NEXT K
LET R1=R1+SPLINE36(ABS(L)-YY*SGN_(L))*R0
LET G1=G1+SPLINE36(ABS(L)-YY*SGN_(L))*G0
LET B1=B1+SPLINE36(ABS(L)-YY*SGN_(L))*B0
NEXT L
LET RR=MAX(0,MIN(255,R1))
LET GG=MAX(0,MIN(255,G1))
LET BB=MAX(0,MIN(255,B1))
END SUB
EXTERNAL FUNCTION SPLINE36(X)
OPTION ARITHMETIC NATIVE
LET X=ABS(X)
IF X<=1 THEN
LET SPLINE36=13/11*X^3 - 453/209*X^2 - 3/209*X + 1
ELSEIF X<=2 THEN
LET SPLINE36=-6/11*X^3 + 612/209*X^2 - 1038/209*X + 540/209
ELSEIF X<=3 THEN
LET SPLINE36=1/11*X^3 - 159/209*X^2 + 434/209*X - 384/209
ELSE
LET SPLINE36=0
END IF
END FUNCTION
EXTERNAL SUB SPLINE4(X,Y,IMAGE(,),RR,GG,BB)
OPTION ARITHMETIC NATIVE
LET XX=X-INT(X)
LET YY=Y-INT(Y)
LET X0=INT(X)
LET Y0=INT(Y)
FOR L=-3 TO 4
LET R0=0
LET G0=0
LET B0=0
FOR K=-3 TO 4
IF X0+K<XSIZE AND Y0+L<YSIZE AND X0+K>=0 AND Y0+L>=0 THEN LET C=IMAGE(X0+K,Y0+L) ELSE LET C=0
CALL RGB(C,R,G,B)
LET R0=R0+SPLINE64(ABS(K)-XX*SGN_(K))*R
LET G0=G0+SPLINE64(ABS(K)-XX*SGN_(K))*G
LET B0=B0+SPLINE64(ABS(K)-XX*SGN_(K))*B
NEXT K
LET R1=R1+SPLINE64(ABS(L)-YY*SGN_(L))*R0
LET G1=G1+SPLINE64(ABS(L)-YY*SGN_(L))*G0
LET B1=B1+SPLINE64(ABS(L)-YY*SGN_(L))*B0
NEXT L
LET RR=MAX(0,MIN(255,R1))
LET GG=MAX(0,MIN(255,G1))
LET BB=MAX(0,MIN(255,B1))
END SUB
EXTERNAL FUNCTION SPLINE64(X)
OPTION ARITHMETIC NATIVE
LET X=ABS(X)
IF X<=1 THEN
LET SPLINE64=49/41*X^3 - 6387/2911*X^2 - 3/2911*X + 1
ELSEIF X<=2 THEN
LET SPLINE64=-24/41*X^3 + 9144/2911*X^2 - 15504/2911*X + 8064/2911
ELSEIF X<=3 THEN
LET SPLINE64=6/41*X^3 - 3564/2911*X^2 + 9726/2911*X - 8604/2911
ELSEIF X<=4 THEN
LET SPLINE64=-1/41*X^3 + 807/2911*X^2 - 3022/2911*X + 3720/2911
ELSE
LET SPLINE64=0
END IF
END FUNCTION
EXTERNAL SUB SPLINE5(X,Y,IMAGE(,),RR,GG,BB)
OPTION ARITHMETIC NATIVE
LET XX=X-INT(X)
LET YY=Y-INT(Y)
LET X0=INT(X)
LET Y0=INT(Y)
FOR L=-4 TO 5
LET R0=0
LET G0=0
LET B0=0
FOR K=-4 TO 5
IF X0+K<XSIZE AND Y0+L<YSIZE AND X0+K>=0 AND Y0+L>=0 THEN LET C=IMAGE(X0+K,Y0+L) ELSE LET C=0
CALL RGB(C,R,G,B)
LET R0=R0+SPLINE100(ABS(K)-XX*SGN_(K))*R
LET G0=G0+SPLINE100(ABS(K)-XX*SGN_(K))*G
LET B0=B0+SPLINE100(ABS(K)-XX*SGN_(K))*B
NEXT K
LET R1=R1+SPLINE100(ABS(L)-YY*SGN_(L))*R0
LET G1=G1+SPLINE100(ABS(L)-YY*SGN_(L))*G0
LET B1=B1+SPLINE100(ABS(L)-YY*SGN_(L))*B0
NEXT L
LET RR=MAX(0,MIN(255,R1))
LET GG=MAX(0,MIN(255,G1))
LET BB=MAX(0,MIN(255,B1))
END SUB
EXTERNAL FUNCTION SPLINE100(X)
OPTION ARITHMETIC NATIVE
LET X=ABS(X)
IF X<=1 THEN
LET SPLINE100= 61/ 51*X^3 - 9893/4505*X^2 - 1/13515*X + 1
ELSEIF X<=2 THEN
LET SPLINE100=-10/ 17*X^3 + 2844/ 901*X^2 - 4822/ 901*X + 2508/ 901
ELSEIF X<=3 THEN
LET SPLINE100=8/ 51*X^3 - 5912/4505*X^2 + 9680/ 2703*X - 14272/4505
ELSEIF X<=4 THEN
LET SPLINE100=-2/ 51*X^3 + 2008/4505*X^2 - 22558/13515*X + 9256/4505
ELSEIF X<=5 THEN
LET SPLINE100=1/153*X^3 - 423/4505*X^2 + 18098/40545*X - 632/ 901
ELSE
LET SPLINE100=0
END IF
END FUNCTION
EXTERNAL SUB SPLINE6(X,Y,IMAGE(,),RR,GG,BB)
OPTION ARITHMETIC NATIVE
LET XX=X-INT(X)
LET YY=Y-INT(Y)
LET X0=INT(X)
LET Y0=INT(Y)
FOR L=-5 TO 6
LET R0=0
LET G0=0
LET B0=0
FOR K=-5 TO 6
IF X0+K<XSIZE AND Y0+L<YSIZE AND X0+K>=0 AND Y0+L>=0 THEN LET C=IMAGE(X0+K,Y0+L) ELSE LET C=0
CALL RGB(C,R,G,B)
LET R0=R0+SPLINE144(ABS(K)-XX*SGN_(K))*R
LET G0=G0+SPLINE144(ABS(K)-XX*SGN_(K))*G
LET B0=B0+SPLINE144(ABS(K)-XX*SGN_(K))*B
NEXT K
LET R1=R1+SPLINE144(ABS(L)-YY*SGN_(L))*R0
LET G1=G1+SPLINE144(ABS(L)-YY*SGN_(L))*G0
LET B1=B1+SPLINE144(ABS(L)-YY*SGN_(L))*B0
NEXT L
LET RR=MAX(0,MIN(255,R1))
LET GG=MAX(0,MIN(255,G1))
LET BB=MAX(0,MIN(255,B1))
END SUB
EXTERNAL FUNCTION SPLINE144(X)
OPTION ARITHMETIC NATIVE
LET X=ABS(X)
IF X<=1 THEN
LET SPLINE144=683/571*X^3 - 1240203/564719*X^2 - 3/564719*X + 1
ELSEIF X<=2 THEN
LET SPLINE144=-336/571*X^3 + 1783152/564719*X^2 - 3023328/564719*X + 1572480/564719
ELSEIF X<=3 THEN
LET SPLINE144=90/571*X^3 - 744660/564719*X^2 + 2032110/564719*X - 1797660/564719
ELSEIF X<=4 THEN
LET SPLINE144=-24/571*X^3 + 269784/564719*X^2 - 1010256/564719*X + 1243584/564719
ELSEIF X<=5 THEN
LET SPLINE144=6/571*X^3 - 85248/564719*X^2 + 405258/564719*X - 636840/564719
ELSEIF X<=6 THEN
LET SPLINE144=-1/571*X^3 + 17175/564719*X^2 - 98926/564719*X + 188880/564719
ELSE
LET SPLINE144=0
END IF
END FUNCTION
EXTERNAL FUNCTION SGN_(X)
OPTION ARITHMETIC NATIVE
IF X<=0 THEN LET SGN_=-1 ELSE LET SGN_=1
END FUNCTION
EXTERNAL SUB RGB(X,R,G,B)
OPTION ARITHMETIC NATIVE
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)
OPTION ARITHMETIC NATIVE
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 PSET(X,Y,R,G,B)
OPTION ARITHMETIC NATIVE
LET RR=MIN(255,MAX(0,INT(R)))
LET GG=MIN(255,MAX(0,INT(G)))
LET BB=MIN(255,MAX(0,INT(B)))
SET COLOR COLORINDEX(RR/255,GG/255,BB/255)
PLOT POINTS:X,Y
END SUB
EXTERNAL SUB PICTURELOAD(N$,XSIZE,YSIZE)
OPTION ARITHMETIC NATIVE
CLEAR
SET COLOR MODE "NATIVE"
SET POINT STYLE 1
IF N$="" THEN STOP
GLOAD N$
LET XSIZE=PIXELX(1)+1
LET YSIZE=PIXELY(1)+1
SET BITMAP SIZE XSIZE,YSIZE
SET WINDOW 0,XSIZE-1,YSIZE-1,0
END SUB
|
|