|
|
離散フーリエ変換を行います。
DFTを8×8～32×32程度の小プロックで計算します。
フィルタ係数を入力し、フィルタ処理をします。
このプログラムは実行に時間がかかります。
ご注意ください。
OPTION ARITHMETIC NATIVE
OPTION BASE 0
FILE GETNAME N$,"BMP,JPG,GIF,PNGファイル|*.BMP;*.JPG;*.GIF;*.PNG"
CALL PICTURELOAD(N$,XSIZE,YSIZE)
DIM COL$(1)
MAT READ COL$
DATA "RGB","GRAY"
LOCATE CHOICE(COL$) :COLORMODE
INPUT PROMPT "SIZE (3 - 5) =":SIZE
LET N=2^SIZE
DIM BR(N,N),BI(N,N),GR(N,N),GI(N,N),RR(N,N),RI(N,N),M(N)
FOR I=0 TO N/2-1
IF I<N/4 THEN LET MES$="低域 " ELSE LET MES$="高域 "
INPUT PROMPT "フィルタ係数 "& MES$ & STR$(I)&" (遮断(0) or 通過(1)) =":M(I)
NEXT I
FOR Y=0 TO YSIZE-1 STEP N
FOR X=0 TO XSIZE-1 STEP N
FOR I=0 TO N-1
FOR J=0 TO N-1
IF X+I<=XSIZE-1 AND Y+J<=YSIZE-1 THEN
CALL GETPOINT(X+I,Y+J,RR(I,J),GR(I,J),BR(I,J))
IF COLORMODE=2 THEN LET BR(I,J)=(151*BR(I,J)+77*GR(I,J)+28*RR(I,J))/256
ELSE
LET RR(I,J)=0
LET GR(I,J)=0
LET BR(I,J)=0
END IF
NEXT J
NEXT I
IF COLORMODE=1 THEN
CALL DFT2(N,BR,BI,1)
CALL DFT2(N,GR,GI,1)
CALL DFT2(N,RR,RI,1)
FOR J=0 TO N/2-1
FOR I=0 TO N/2-1
LET BR(I,J)=BR(I,J)*M(I)*M(J)
LET BI(I,J)=BI(I,J)*M(I)*M(J)
LET GR(I,J)=GR(I,J)*M(I)*M(J)
LET GI(I,J)=GI(I,J)*M(I)*M(J)
LET RR(I,J)=RR(I,J)*M(I)*M(J)
LET RI(I,J)=RI(I,J)*M(I)*M(J)
LET BR(I,N-1-J)=BR(I,N-1-J)*M(I)*M(J)
LET BI(I,N-1-J)=BI(I,N-1-J)*M(I)*M(J)
LET GR(I,N-1-J)=GR(I,N-1-J)*M(I)*M(J)
LET GI(I,N-1-J)=GI(I,N-1-J)*M(I)*M(J)
LET RR(I,N-1-J)=RR(I,N-1-J)*M(I)*M(J)
LET RI(I,N-1-J)=RI(I,N-1-J)*M(I)*M(J)
LET BR(N-1-I,J)=BR(N-1-I,J)*M(I)*M(J)
LET BI(N-1-I,J)=BI(N-1-I,J)*M(I)*M(J)
LET GR(N-1-I,J)=GR(N-1-I,J)*M(I)*M(J)
LET GI(N-1-I,J)=GI(N-1-I,J)*M(I)*M(J)
LET RR(N-1-I,J)=RR(N-1-I,J)*M(I)*M(J)
LET RI(N-1-I,J)=RI(N-1-I,J)*M(I)*M(J)
LET BR(N-1-I,N-1-J)=BR(N-1-I,N-1-J)*M(I)*M(J)
LET BI(N-1-I,N-1-J)=BI(N-1-I,N-1-J)*M(I)*M(J)
LET GR(N-1-I,N-1-J)=GR(N-1-I,N-1-J)*M(I)*M(J)
LET GI(N-1-I,N-1-J)=GI(N-1-I,N-1-J)*M(I)*M(J)
LET RR(N-1-I,N-1-J)=RR(N-1-I,N-1-J)*M(I)*M(J)
LET RI(N-1-I,N-1-J)=RI(N-1-I,N-1-J)*M(I)*M(J)
NEXT I
NEXT J
CALL DFT2(N,BR,BI,-1)
CALL DFT2(N,GR,GI,-1)
CALL DFT2(N,RR,RI,-1)
FOR I=0 TO N-1
FOR J=0 TO N-1
IF X+I<=XSIZE-1 AND Y+J<=YSIZE-1 THEN
CALL PSET(X+I,Y+J,RR(I,J),GR(I,J),BR(I,J))
END IF
NEXT J
NEXT I
ELSE
CALL DFT2(N,BR,BI,1)
FOR J=0 TO N/2-1
FOR I=0 TO N/2-1
LET BR(I,J)=BR(I,J)*M(I)*M(J)
LET BI(I,J)=BI(I,J)*M(I)*M(J)
LET BR(I,N-1-J)=BR(I,N-1-J)*M(I)*M(J)
LET BI(I,N-1-J)=BI(I,N-1-J)*M(I)*M(J)
LET BR(N-1-I,J)=BR(N-1-I,J)*M(I)*M(J)
LET BI(N-1-I,J)=BI(N-1-I,J)*M(I)*M(J)
LET BR(N-1-I,N-1-J)=BR(N-1-I,N-1-J)*M(I)*M(J)
LET BI(N-1-I,N-1-J)=BI(N-1-I,N-1-J)*M(I)*M(J)
NEXT I
NEXT J
CALL DFT2(N,BR,BI,-1)
FOR J=0 TO N-1
FOR I=0 TO N-1
IF X+I<=XSIZE-1 AND Y+J<=YSIZE-1 THEN
CALL PSET(X+I,Y+J,BR(I,J),BR(I,J),BR(I,J))
END IF
NEXT I
NEXT J
END IF
NEXT X
NEXT Y
END
EXTERNAL SUB DFT(M,XR(),XI())
OPTION ARITHMETIC NATIVE
OPTION BASE 0
DIM RR(M),II(M)
LET P=8*ATN(1)/M
FOR J=0 TO M-1
FOR I=0 TO M-1
LET RR(J)=RR(J)+XR(I)*COS(P*J*I)-XI(I)*SIN(P*J*I)
LET II(J)=II(J)+XR(I)*SIN(P*J*I)+XI(I)*COS(P*J*I)
NEXT I
NEXT J
MAT XR=RR
MAT XI=II
END SUB
EXTERNAL SUB IDFT(M,XR(),XI())
OPTION ARITHMETIC NATIVE
OPTION BASE 0
DIM RR(M),II(M)
LET P=8*ATN(1)/M
FOR J=0 TO M-1
FOR I=0 TO M-1
LET RR(J)=RR(J)+XR(I)*COS(-P*J*I)-XI(I)*SIN(-P*J*I)
LET II(J)=II(J)+XR(I)*SIN(-P*J*I)+XI(I)*COS(-P*J*I)
NEXT I
NEXT J
FOR I=0 TO M-1
LET XR(I)=INT(RR(I)/M+.5)
LET XI(I)=INT(II(I)/M+.5)
NEXT I
END SUB
EXTERNAL SUB DFT2(M,RR(,),II(,),FL)
OPTION ARITHMETIC NATIVE
OPTION BASE 0
DIM XR(M),XI(M)
FOR Y=0 TO M-1
FOR X=0 TO M-1
LET XR(X)=RR(X,Y)
LET XI(X)=II(X,Y)
NEXT X
IF FL>0 THEN CALL DFT(M,XR,XI) ELSE CALL IDFT(M,XR,XI)
FOR X=0 TO M-1
LET RR(X,Y)=XR(X)
LET II(X,Y)=XI(X)
NEXT X
NEXT Y
FOR X=0 TO M-1
FOR Y=0 TO M-1
LET XR(Y)=RR(X,Y)
LET XI(Y)=II(X,Y)
NEXT Y
IF FL>0 THEN CALL DFT(M,XR,XI) ELSE CALL IDFT(M,XR,XI)
FOR Y=0 TO M-1
LET RR(X,Y)=XR(Y)
LET II(X,Y)=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
|
|