lanczos(n)による解像度変換

 投稿者:しばっち  投稿日:2018年 1月26日(金)21時51分43秒
  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
 

戻る