|
|
離散コサイン変換を行います。
DCTを画像サイズで行います。
このプログラムは実行に時間がかかります。
ご注意ください。
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=XSIZE
LET N2=YSIZE
DIM BB(N1,N2),GG(N1,N2),RR(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 DCT2D(N1,N2,BB)
CALL DCT2D(N1,N2,GG)
CALL DCT2D(N1,N2,RR)
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
IF X>=FSX1 OR Y>=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
IF (X>=FSX1 AND X<=FSX2) OR (Y>=FSY1 AND Y<=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
IF X<=FSX1 OR Y<=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
IF (X>=FSX1 AND X<=FSX2) OR (Y>=FSY1 AND Y<=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 IDCT2D(N1,N2,BB)
CALL IDCT2D(N1,N2,GG)
CALL IDCT2D(N1,N2,RR)
CLEAR
FOR Y=0 TO YSIZE-1
FOR X=0 TO XSIZE-1
CALL PSET(X,Y,RR(X,Y),GG(X,Y),BB(X,Y))
NEXT X
NEXT Y
END
EXTERNAL FUNCTION C(X,N)
OPTION ARITHMETIC NATIVE
IF X=0 OR X=N THEN LET C=SQR(.5) ELSE LET C=1
END FUNCTION
EXTERNAL SUB DCT2(A(),N,B())
OPTION ARITHMETIC NATIVE
FOR I=0 TO N-1
LET S=0
FOR K=0 TO N-1
LET S=S+A(K)*COS((2*K+1)*I*PI/2/N)
NEXT K
LET B(I)=S*SQR(2/N)*C(I,N)
NEXT I
END SUB
EXTERNAL SUB DCT3(A(),N,B())
OPTION ARITHMETIC NATIVE
FOR I=0 TO N-1
LET S=0
FOR K=0 TO N-1
LET S=S+C(K,N)*A(K)*COS((2*I+1)*K*PI/2/N)
NEXT K
LET B(I)=INT(S*SQR(2/N)+.5)
NEXT I
END SUB
EXTERNAL SUB DCT2D(M,N,RR(,))
OPTION ARITHMETIC NATIVE
OPTION BASE 0
LET NN=MAX(M,N)
DIM XR(NN),YR(NN)
FOR Y=0 TO N-1
FOR X=0 TO M-1
LET XR(X)=RR(X,Y)
NEXT X
CALL DCT2(XR,M,YR)
FOR X=0 TO M-1
LET RR(X,Y)=YR(X)
NEXT X
NEXT Y
FOR X=0 TO M-1
FOR Y=0 TO N-1
LET XR(Y)=RR(X,Y)
NEXT Y
CALL DCT2(XR,N,YR)
FOR Y=0 TO N-1
LET RR(X,Y)=YR(Y)
NEXT Y
NEXT X
END SUB
EXTERNAL SUB IDCT2D(M,N,RR(,))
OPTION ARITHMETIC NATIVE
OPTION BASE 0
LET NN=MAX(M,N)
DIM XR(NN),YR(NN)
FOR Y=0 TO N-1
FOR X=0 TO M-1
LET XR(X)=RR(X,Y)
NEXT X
CALL DCT3(XR,M,YR)
FOR X=0 TO M-1
LET RR(X,Y)=YR(X)
NEXT X
NEXT Y
FOR X=0 TO M-1
FOR Y=0 TO N-1
LET XR(Y)=RR(X,Y)
NEXT Y
CALL DCT3(XR,N,YR)
FOR Y=0 TO N-1
LET RR(X,Y)=YR(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
|
|