|
|
離散フーリエ変換を行います。
FFTにより、フィルタ処理します。
ローパスでは、スライドバーを左側よりへ
ハイパスでは、スライドバーを右側よりに動かしてください。
バンドパス、バンドストップは、低域と高域の中間域でフィルタ処理します。
OPTION ARITHMETIC NATIVE
FILE GETNAME N$,"BMP,JPG,GIF,PNGファイル|*.BMP;*.JPG;*.GIF;*.PNG"
CALL PICTURELOAD(N$,XSIZE,YSIZE)
OPTION BASE 0
DIM MODE$(3)
DATA "LOWPASS","BANDPASS","HIGHPASS","BANDSTOP"
MAT READ MODE$
LET N1=2^INT(LOG2(XSIZE)+.999)
LET N2=2^INT(LOG2(YSIZE)+.999)
DIM BR(N1,N2),BI(N1,N2),GR(N1,N2),GI(N1,N2),RR(N1,N2),RI(N1,N2)
FOR Y=0 TO YSIZE-1
FOR X=0 TO XSIZE-1
CALL GETPOINT(X,Y,RR(X+1,Y+1),GR(X+1,Y+1),BR(X+1,Y+1))
NEXT X
NEXT Y
CALL FFT2D(N1,N2,BR,BI,1,0)
CALL FFT2D(N1,N2,GR,GI,1,0)
CALL FFT2D(N1,N2,RR,RI,1,0)
LOCATE CHOICE(MODE$) : MD
SELECT CASE MD
CASE 1
LOCATE VALUE ,RANGE 2 TO N1/2-1,AT N1/4:FSX1
LOCATE VALUE ,RANGE 2 TO N2/2-1,AT N2/4:FSY1
FOR Y=FSY1+1 TO N2-FSY1-1
FOR X=FSX1+1 TO N1-FSX1-1
LET BR(X,Y)=0
LET BI(X,Y)=0
LET GR(X,Y)=0
LET GI(X,Y)=0
LET RR(X,Y)=0
LET RI(X,Y)=0
NEXT X
NEXT Y
CASE 2
LOCATE VALUE ,RANGE 2 TO N1/2-1,AT N1/4:FSX1
LOCATE VALUE ,RANGE 2 TO N1/2-1,AT N1/4:FSX2
LOCATE VALUE ,RANGE 2 TO N2/2-1,AT N2/4:FSY1
LOCATE VALUE ,RANGE 2 TO N2/2-1,AT N2/4:FSY2
FOR Y=0 TO N2-1
FOR X=0 TO N1-1
IF (X<FSX1 OR X>N1-1-FSX1) AND (Y<FSY1 OR Y>N2-1-FSY1) OR (N1/2-FSX2<X AND N2/2+FSX2>X OR N2/2-FSY2<Y AND N2/2+FSY2>Y) THEN
ELSE
LET BR(X,Y)=0
LET BI(X,Y)=0
LET GR(X,Y)=0
LET GI(X,Y)=0
LET RR(X,Y)=0
LET RI(X,Y)=0
END IF
NEXT X
NEXT Y
CASE 3
LOCATE VALUE ,RANGE 2 TO N1/2-1,AT N1/4:FSX1
LOCATE VALUE ,RANGE 2 TO N2/2-1,AT N2/4:FSY1
FOR Y=0 TO N2-1
FOR X=0 TO N1-1
IF N1/2-FSX1<X AND N1/2+FSX1>X OR N2/2-FSY1<Y AND N2/2+FSY1>Y THEN
ELSE
LET BR(X,Y)=0
LET BI(X,Y)=0
LET GR(X,Y)=0
LET GI(X,Y)=0
LET RR(X,Y)=0
LET RI(X,Y)=0
END IF
NEXT X
NEXT Y
CASE 4
LOCATE VALUE ,RANGE 2 TO N1/2-1,AT N1/4:FSX1
LOCATE VALUE ,RANGE 2 TO N1/2-1,AT N1/4:FSX2
LOCATE VALUE ,RANGE 2 TO N2/2-1,AT N2/4:FSY1
LOCATE VALUE ,RANGE 2 TO N2/2-1,AT N2/4:FSY2
FOR Y=0 TO N2-1
FOR X=0 TO N1-1
IF (X<FSX1 OR X>N1-1-FSX1) AND (Y<FSY1 OR Y>N2-1-FSY1) OR (N1/2-FSX2<X AND N2/2+FSX2>X OR N2/2-FSY2<Y AND N2/2+FSY2>Y) THEN
LET BR(X,Y)=0
LET BI(X,Y)=0
LET GR(X,Y)=0
LET GI(X,Y)=0
LET RR(X,Y)=0
LET RI(X,Y)=0
END IF
NEXT X
NEXT Y
END SELECT
CALL FFT2D(N1,N2,BR,BI,-1,0)
CALL FFT2D(N1,N2,GR,GI,-1,0)
CALL FFT2D(N1,N2,RR,RI,-1,0)
CLEAR
FOR Y=0 TO YSIZE-1
FOR X=0 TO XSIZE-1
CALL PSET(X,Y,RR(X,Y),GR(X,Y),BR(X,Y))
NEXT X
NEXT Y
END
EXTERNAL SUB FFT(N,XR(),XI(),INVERSE,OPT)
OPTION ARITHMETIC NATIVE
LET NN=N
IF BITAND(N,N-1)<>0 THEN
PRINT "ERROR"
STOP
END IF
IF OPT<>0 THEN
FOR I=1 TO N STEP 2
LET XR(I)=-XR(I)
LET XI(I)=-XI(I)
NEXT I
END IF
DO WHILE NN>1
LET NN=NN/2
LET M=M+1
LOOP
LET L=N/2
LET J=L+1
FOR I=2 TO N-2
IF I<J THEN
SWAP XR(I),XR(J)
SWAP XI(I),XI(J)
END IF
LET K=L
DO WHILE K<J
LET J=J-K
LET K=K/2
LOOP
LET J=J+K
NEXT I
IF INVERSE=-1 THEN
LET PX=-PI
FOR I=1 TO N
LET XR(I)=XR(I)/N
LET XI(I)=XI(I)/N
NEXT I
ELSE
LET PX=PI
END IF
LET L=1
FOR K=1 TO M
LET LL=L+L
LET P=PX/L
FOR J=1 TO L
LET W=(J-1)*P
LET WR=COS(W)
LET WI=SIN(W)
FOR I=J TO N STEP LL
LET IL=I+L
LET TR=XR(IL)*WR-XI(IL)*WI
LET TI=XR(IL)*WI+XI(IL)*WR
LET XR(IL)=XR(I)-TR
LET XI(IL)=XI(I)-TI
LET XR(I)=XR(I)+TR
LET XI(I)=XI(I)+TI
NEXT I
NEXT J
LET L=LL
NEXT K
IF OPT<>0 THEN
FOR I=1 TO N STEP 2
LET XR(I)=-XR(I)
LET XI(I)=-XI(I)
NEXT I
END IF
END SUB
EXTERNAL SUB FFT2D(M,N,RR(,),II(,),FL,OPT)
OPTION ARITHMETIC NATIVE
LET NN=MAX(M,N)
DIM XR(NN),XI(NN)
FOR Y=1 TO N
FOR X=1 TO M
LET XR(X)=RR(X-1,Y-1)
LET XI(X)=II(X-1,Y-1)
NEXT X
CALL FFT(M,XR,XI,FL,OPT)
FOR X=1 TO M
LET RR(X-1,Y-1)=XR(X)
LET II(X-1,Y-1)=XI(X)
NEXT X
NEXT Y
MAT XR=ZER
MAT XI=ZER
FOR X=1 TO M
FOR Y=1 TO N
LET XR(Y)=RR(X-1,Y-1)
LET XI(Y)=II(X-1,Y-1)
NEXT Y
CALL FFT(N,XR,XI,FL,OPT)
FOR Y=1 TO N
LET RR(X-1,Y-1)=XR(Y)
LET II(X-1,Y-1)=XI(Y)
NEXT Y
NEXT X
END SUB
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 GETPOINT(X,Y,R,G,B)
OPTION ARITHMETIC NATIVE
ASK PIXEL VALUE(X,Y) C
CALL RGB(C,R,G,B)
END SUB
EXTERNAL SUB GINIT(XSIZE,YSIZE)
OPTION ARITHMETIC NATIVE
SET BITMAP SIZE XSIZE,YSIZE
SET COLOR MODE "NATIVE"
CLEAR
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
SET COLOR MODE "NATIVE"
CLEAR
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
|
|