|
|
lanczos(n)による解像度変換をします。
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$(5)
ASK PIXEL ARRAY(0,0) VM
PRINT "元画像サイズ ";XSIZE;"＊";YSIZE
MAT READ S$
LOCATE CHOICE(S$) : N
LOCATE VALUE ,RANGE 0.1 TO 3,AT 1 : SCALE
DATA "lanczos(2)","lanczos(3)","lanczos(4)","lanczos(5)","lanczos(6)","lanczos(7)"
LET BIWIDTH=INT(XSIZE*SCALE)
LET BIHEIGHT=INT(YSIZE*SCALE)
PRINT "画像サイズ ";BIWIDTH;"＊";BIHEIGHT
PRINT S$(N-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
CALL LANCZOS(N+1,XX,YY,VM,RR,GG,BB)
CALL PSET(X,Y,RR,GG,BB)
NEXT X
NEXT Y
END
EXTERNAL SUB LANCZOS(N,X,Y,IMAGE(,),RR,GG,BB) !'ランチョス法 lanczos(n)
OPTION ARITHMETIC NATIVE
LET XX=X-INT(X)
LET YY=Y-INT(Y)
LET X0=INT(X)
LET Y0=INT(Y)
FOR L=-N+1 TO N
LET R0=0
LET G0=0
LET B0=0
FOR K=-N+1 TO N
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+CALC(ABS(K)-XX*SGN_(K),N)*R
LET G0=G0+CALC(ABS(K)-XX*SGN_(K),N)*G
LET B0=B0+CALC(ABS(K)-XX*SGN_(K),N)*B
NEXT K
LET R1=R1+CALC(ABS(L)-YY*SGN_(L),N)*R0
LET G1=G1+CALC(ABS(L)-YY*SGN_(L),N)*G0
LET B1=B1+CALC(ABS(L)-YY*SGN_(L),N)*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 SINC(X)
!OPTION ARITHMETIC NATIVE
!IF X=0 THEN
! LET SINC=1
!ELSE
! LET SINC=SIN(PI*X)/(PI*X)
!END IF
!END FUNCTION
EXTERNAL FUNCTION CALC(X,N)
OPTION ARITHMETIC NATIVE
IF X=0 THEN
LET CALC=1
ELSE
LET CALC=N*SIN(PI*X)*SIN(X*PI/N)/(X*PI)^2
!' LET CALC=SINC(X)*SINC(X/N)
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
|
|