|
|
アダマール変換を行います。
HADAMARD変換により、フィルタ処理を行います。
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 BIT1=INT(LOG2(XSIZE)+.999)
LET N1=2^BIT1
LET BIT2=INT(LOG2(YSIZE)+.999)
LET N2=2^BIT2
DIM RR(N1,N2),GG(N1,N2),BB(N1,N2)
FOR Y=0 TO YSIZE-1
FOR X=0 TO XSIZE-1
CALL GETPOINT(X,Y,RR(X,Y),GG(X,Y),BB(X,Y))
NEXT X
NEXT Y
CALL HADAMARD2D(N1,N2,RR)
CALL HADAMARD2D(N1,N2,GG)
CALL HADAMARD2D(N1,N2,BB)
LOCATE CHOICE(MODE$) : MD
SELECT CASE MD
CASE 1
LOCATE VALUE ,RANGE 2 TO N1-1,AT N1/2:FSX1
LOCATE VALUE ,RANGE 2 TO N2-1,AT N2/2:FSY1
FOR Y=0 TO N2-1
FOR X=0 TO N1-1
LET XX=SEQUENCY(BIT1,X)
LET YY=SEQUENCY(BIT2,Y)
IF XX>=FSX1 OR YY>=FSY1 THEN
LET RR(X,Y)=0
LET GG(X,Y)=0
LET BB(X,Y)=0
END IF
NEXT X
NEXT Y
CASE 2
LOCATE VALUE ,RANGE 2 TO N1-1,AT N1/2:FSX1
LOCATE VALUE ,RANGE FSX1 TO N1-1,AT (FSX1+N1)/2:FSX2
LOCATE VALUE ,RANGE 2 TO N2-1,AT N2/2:FSY1
LOCATE VALUE ,RANGE FSY1 TO N2-1,AT (FSY1+N2)/2:FSY2
FOR Y=0 TO N2-1
FOR X=0 TO N1-1
LET XX=SEQUENCY(BIT1,X)
LET YY=SEQUENCY(BIT2,Y)
IF (XX>=FSX1 AND XX<=FSX2) OR (YY>=FSY1 AND YY<=FSY2) THEN
ELSE
LET RR(X,Y)=0
LET GG(X,Y)=0
LET BB(X,Y)=0
END IF
NEXT X
NEXT Y
CASE 3
LOCATE VALUE ,RANGE 2 TO N1-1,AT N1/2:FSX1
LOCATE VALUE ,RANGE 2 TO N2-1,AT N2/2:FSY1
FOR Y=0 TO N2-1
FOR X=0 TO N1-1
LET XX=SEQUENCY(BIT1,X)
LET YY=SEQUENCY(BIT2,Y)
IF XX<=FSX1 OR YY<=FSY1 THEN
LET RR(X,Y)=0
LET GG(X,Y)=0
LET BB(X,Y)=0
END IF
NEXT X
NEXT Y
CASE 4
LOCATE VALUE ,RANGE 2 TO N1-1,AT N1/2:FSX1
LOCATE VALUE ,RANGE FSX1 TO N1-1,AT (FSX1+N1)/2:FSX2
LOCATE VALUE ,RANGE 2 TO N2-1,AT N2/2:FSY1
LOCATE VALUE ,RANGE FSY1 TO N2-1,AT (FSY1+N2)/2:FSY2
FOR Y=0 TO N2-1
FOR X=0 TO N1-1
LET XX=SEQUENCY(BIT1,X)
LET YY=SEQUENCY(BIT2,Y)
IF (XX>=FSX1 AND XX<=FSX2) OR (YY>=FSY1 AND YY<=FSY2) THEN
LET RR(X,Y)=0
LET GG(X,Y)=0
LET BB(X,Y)=0
END IF
NEXT X
NEXT Y
END SELECT
CALL HADAMARD2D(N1,N2,RR)
CALL HADAMARD2D(N1,N2,GG)
CALL HADAMARD2D(N1,N2,BB)
CLEAR
FOR Y=0 TO YSIZE-1
FOR X=0 TO XSIZE-1
LET RR(X,Y)=RR(X,Y)/N1/N2
LET GG(X,Y)=GG(X,Y)/N1/N2
LET BB(X,Y)=BB(X,Y)/N1/N2
CALL PSET(X,Y,RR(X,Y),GG(X,Y),BB(X,Y))
NEXT X
NEXT Y
END
EXTERNAL SUB FASTHADAMARD(N,X(),A()) !'高速アダマール変換
OPTION ARITHMETIC NATIVE
LET BIT=LOG2(N)
FOR J=1 TO BIT
LET K=0
LET L=0
FOR I=0 TO N-1
IF I<N/2 THEN
LET A(I)=X(2*K)+X(2*K+1)
LET K=K+1
ELSE
LET A(I)=X(2*L)-X(2*L+1)
LET L=L+1
END IF
NEXT I
IF J<BIT THEN MAT X=A
NEXT J
END SUB
EXTERNAL SUB HADAMARD2D(N1,N2,X(,))
OPTION ARITHMETIC NATIVE
OPTION BASE 0
DIM Z1(N1),P1(N1),Z2(N2),P2(N2)
FOR J=0 TO N2-1
FOR I=0 TO N1-1
LET Z1(I)=X(I,J)
NEXT I
CALL FASTHADAMARD(N1,Z1,P1)
FOR I=0 TO N1-1
LET X(I,J)=P1(I)
NEXT I
NEXT J
FOR I=0 TO N1-1
FOR J=0 TO N2-1
LET Z2(J)=X(I,J)
NEXT J
CALL FASTHADAMARD(N2,Z2,P2)
FOR J=0 TO N2-1
LET X(I,J)=P2(J)
NEXT J
NEXT I
END SUB
EXTERNAL FUNCTION SEQUENCY(BIT,N) !'シーケンシー
OPTION ARITHMETIC NATIVE
FOR I=1 TO BIT
LET G=BITAND(N,1)
LET N=INT(N/2)
LET L=BITXOR(G,B)
LET A=A*2+L
LET B=L
NEXT I
LET SEQUENCY=A
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 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
|
|