|
|
離散ハートレ変換をします。
Hartley変換を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 B(N,N),G(N,N),R(N,N),M(N)
FOR I=0 TO N-1
IF I<N/2 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,R(I,J),G(I,J),B(I,J))
IF COLORMODE=2 THEN LET B(I,J)=(151*B(I,J)+77*G(I,J)+28*R(I,J))/256
END IF
NEXT J
NEXT I
IF COLORMODE=1 THEN
CALL DWT2(B,N)
CALL DWT2(G,N)
CALL DWT2(R,N)
FOR J=0 TO N-1
FOR I=0 TO N-1
SELECT CASE FILTERTYPE
CASE 0
LET F=M(I)*M(J)
CASE 1
LET L=I+J
IF L>N-1 THEN LET L=N-1
LET F=M(L)
CASE 2
LET L=I*J
IF L>N-1 THEN LET L=N-1
LET F=M(L)
CASE 3
LET K=2 !'K=20
LET L=(I^K+J^K)^(1/K)
IF L>N-1 THEN LET L=N-1
LET F=M(L)
CASE 4
LET F=M(MOD(I+J,N))
END SELECT
LET B(I,J)=B(I,J)*F
LET G(I,J)=G(I,J)*F
LET R(I,J)=R(I,J)*F
NEXT I
NEXT J
CALL DWT3(B,N)
CALL DWT3(G,N)
CALL DWT3(R,N)
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,R(I,J),G(I,J),B(I,J))
END IF
NEXT I
NEXT J
ELSE
CALL DWT2(B,N)
FOR J=0 TO N-1
FOR I=0 TO N-1
LET B(I,J)=B(I,J)*M(I)*M(J)
NEXT I
NEXT J
CALL DWT3(B,N)
FOR J=0 TO N-1
FOR I=0 TO N-1
CALL PSET(X+I,Y+J,B(I,J),B(I,J),B(I,J))
NEXT I
NEXT J
END IF
NEXT X
NEXT Y
END
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
EXTERNAL FUNCTION CAS(X)
OPTION ARITHMETIC NATIVE
LET CAS=SIN(X)+COS(X)
END FUNCTION
EXTERNAL SUB DWT1(F(,),N) !'変換/逆変換
OPTION ARITHMETIC NATIVE
OPTION BASE 0
DIM FF(N,N)
FOR U=0 TO N-1
FOR V=0 TO N-1
LET S=0
FOR X=0 TO N-1
FOR Y=0 TO N-1
LET S=S+F(X,Y)*CAS(2*PI*(U*X+V*Y)/N)
NEXT Y
NEXT X
LET FF(U,V)=S/N
NEXT V
NEXT U
MAT F=FF
END SUB
EXTERNAL SUB DWT2(F(,),N) !'変換
OPTION ARITHMETIC NATIVE
OPTION BASE 0
DIM FF(N,N)
FOR U=0 TO N-1
FOR V=0 TO N-1
LET FF(U,V)=0
FOR X=0 TO N-1
FOR Y=0 TO N-1
LET FF(U,V)=FF(U,V)+F(X,Y)*CAS(2*PI*((X+1/2)*U+(Y+1/2)*V)/N)
NEXT Y
NEXT X
LET FF(U,V)=FF(U,V)/N
NEXT V
NEXT U
MAT F=FF
END SUB
EXTERNAL SUB DWT3(F(,),N) !'逆変換
OPTION ARITHMETIC NATIVE
OPTION BASE 0
DIM FF(N,N)
FOR U=0 TO N-1
FOR V=0 TO N-1
LET FF(U,V)=0
FOR X=0 TO N-1
FOR Y=0 TO N-1
LET FF(U,V)=FF(U,V)+F(X,Y)*CAS(2*PI*((U+1/2)*X+(V+1/2)*Y)/N)
NEXT Y
NEXT X
LET FF(U,V)=FF(U,V)/N
NEXT V
NEXT U
MAT F=FF
END SUB
EXTERNAL SUB DWT4(F(,),N) !'変換/逆変換
OPTION ARITHMETIC NATIVE
OPTION BASE 0
DIM FF(N,N)
FOR U=0 TO N-1
FOR V=0 TO N-1
LET FF(U,V)=0
FOR X=0 TO N-1
FOR Y=0 TO N-1
LET FF(U,V)=FF(U,V)+F(X,Y)*CAS(2*PI*((U+1/2)*(X+1/2)+(V+1/2)*(Y+1/2))/N)
NEXT Y
NEXT X
LET FF(U,V)=FF(U,V)/N
NEXT V
NEXT U
MAT F=FF
END SUB
|
|