|
|
!'離散WAVELET変換(多重解像度解析) ※旧バージョン
OPTION BASE 0
PUBLIC NUMERIC XSIZE,YSIZE
FILE GETNAME F$, "BMP,JPG,GIFファイル|*.BMP;*.JPG;*.GIF"
IF F$="" THEN STOP
CALL PICTURELOAD(F$,XSIZE,YSIZE)
LET LEV=2 !'オクターブ分割(1+3*LEV 分割)
LET SIZEX=INT((XSIZE+2^LEV-1)/2^LEV)*2^LEV !'補正
LET SIZEY=INT((YSIZE+2^LEV-1)/2^LEV)*2^LEV
DIM R1(SIZEX,SIZEY),G1(SIZEX,SIZEY),B1(SIZEX,SIZEY)
DIM R2(SIZEX,SIZEY),G2(SIZEX,SIZEY),B2(SIZEX,SIZEY)
FOR X=0 TO XSIZE-1
FOR Y=0 TO YSIZE-1
CALL GETPOINT(X,Y,R1(X,Y),G1(X,Y),B1(X,Y))
NEXT Y
NEXT X
FOR I=1 TO LEV !'オクターブ分割
FOR Y=0 TO SIZEY
FOR X=0 TO SIZEX-1 STEP 2
LET R2(X/2,Y)=(R1(X,Y)+R1(X+1,Y))/2 !'低周波
LET G2(X/2,Y)=(G1(X,Y)+G1(X+1,Y))/2
LET B2(X/2,Y)=(B1(X,Y)+B1(X+1,Y))/2
LET R2(X/2+SIZEX/2,Y)=(R1(X,Y)-R1(X+1,Y))/2 !'高周波
LET G2(X/2+SIZEX/2,Y)=(G1(X,Y)-G1(X+1,Y))/2
LET B2(X/2+SIZEX/2,Y)=(B1(X,Y)-B1(X+1,Y))/2
CALL PSET(X/2,Y,R2(X/2,Y),G2(X/2,Y),B2(X/2,Y))
CALL PSET(X/2+SIZEX/2,Y,R2(X/2+SIZEX/2,Y),G2(X/2+SIZEX/2,Y),B2(X/2+SIZEX/2,Y))
NEXT X
NEXT Y
FOR X=0 TO SIZEX
FOR Y=0 TO SIZEY-1 STEP 2
LET R1(X,Y/2)=(R2(X,Y)+R2(X,Y+1))/2 !'低周波
LET G1(X,Y/2)=(G2(X,Y)+G2(X,Y+1))/2
LET B1(X,Y/2)=(B2(X,Y)+B2(X,Y+1))/2
LET R1(X,Y/2+SIZEY/2)=(R2(X,Y)-R2(X,Y+1))/2 !'高周波
LET G1(X,Y/2+SIZEY/2)=(G2(X,Y)-G2(X,Y+1))/2
LET B1(X,Y/2+SIZEY/2)=(B2(X,Y)-B2(X,Y+1))/2
CALL PSET(X,Y/2,R1(X,Y/2),G1(X,Y/2),B1(X,Y/2))
CALL PSET(X,Y/2+SIZEY/2,R1(X,Y/2+SIZEY/2),G1(X,Y/2+SIZEY/2),B1(X,Y/2+SIZEY/2))
NEXT Y
NEXT X
LET SIZEX=SIZEX/2
LET SIZEY=SIZEY/2
NEXT I
PRINT "マウスでクリアしたい帯域を左クリック"
PRINT "右クリックで再構成します"
DO
LET SIZEX=INT((XSIZE+2^LEV-1)/2^LEV)*2^LEV !'補正
LET SIZEY=INT((YSIZE+2^LEV-1)/2^LEV)*2^LEV
DO
MOUSE POLL XX,YY,L,R
LOOP UNTIL L<>0 OR R<>0
IF L<>0 THEN CALL CLEARAREA(XX,YY,SIZEX,SIZEY,LEV,R1,G1,B1)
LOOP UNTIL R<>0
!'再構成(逆ウェーブレット変換)
LET SIZEX=INT((XSIZE+2^LEV-1)/2^LEV) !'補正
LET SIZEY=INT((YSIZE+2^LEV-1)/2^LEV)
MAT R2=ZER
MAT G2=ZER
MAT B2=ZER
FOR I=1 TO LEV
FOR Y=0 TO SIZEY-1
FOR X=0 TO SIZEX*2-1
LET R2(X,Y*2)=(R1(X,Y)+R1(X,Y+SIZEY))
LET G2(X,Y*2)=(G1(X,Y)+G1(X,Y+SIZEY))
LET B2(X,Y*2)=(B1(X,Y)+B1(X,Y+SIZEY))
LET R2(X,Y*2+1)=(R1(X,Y)-R1(X,Y+SIZEY))
LET G2(X,Y*2+1)=(G1(X,Y)-G1(X,Y+SIZEY))
LET B2(X,Y*2+1)=(B1(X,Y)-B1(X,Y+SIZEY))
CALL PSET(X,Y*2,R2(X,Y*2),G2(X,Y*2),B2(X,Y*2))
CALL PSET(X,Y*2+1,R2(X,Y*2+1),G2(X,Y*2+1),B2(X,Y*2+1))
NEXT X
NEXT Y
FOR X=0 TO SIZEX-1
FOR Y=0 TO SIZEY*2-1
LET R1(X*2,Y)=(R2(X,Y)+R2(X+SIZEX,Y))
LET G1(X*2,Y)=(G2(X,Y)+G2(X+SIZEX,Y))
LET B1(X*2,Y)=(B2(X,Y)+B2(X+SIZEX,Y))
LET R1(X*2+1,Y)=(R2(X,Y)-R2(X+SIZEX,Y))
LET G1(X*2+1,Y)=(G2(X,Y)-G2(X+SIZEX,Y))
LET B1(X*2+1,Y)=(B2(X,Y)-B2(X+SIZEX,Y))
CALL PSET(X*2,Y,R1(X*2,Y),G1(X*2,Y),B1(X*2,Y))
CALL PSET(X*2+1,Y,R1(X*2+1,Y),G1(X*2+1,Y),B1(X*2+1,Y))
NEXT Y
NEXT X
LET SIZEX=SIZEX*2
LET SIZEY=SIZEY*2
NEXT I
END
EXTERNAL SUB CLEARAREA(X,Y,SIZEX,SIZEY,LEV,R1(,),G1(,),B1(,))
IF X<SIZEX/2 AND Y<SIZEY/2 THEN
IF LEV>0 THEN
CALL CLEARAREA(X,Y,SIZEX/2,SIZEY/2,LEV-1,R1,G1,B1)
ELSE
CALL CLEAR(0,0,SIZEX-1,SIZEY-1,R1,G1,B1)
END IF
ELSEIF X>SIZEX/2 AND Y<SIZEY/2 THEN
CALL CLEAR(SIZEX/2,0,SIZEX-1,SIZEY/2,R1,G1,B1)
ELSEIF X>SIZEX/2 AND Y>SIZEY/2 THEN
CALL CLEAR(SIZEX/2,SIZEY/2,SIZEX-1,SIZEY-1,R1,G1,B1)
ELSEIF X<SIZEX/2 AND Y>SIZEY/2 THEN
CALL CLEAR(0,SIZEY/2,SIZEX/2-1,SIZEY-1,R1,G1,B1)
END IF
END SUB
EXTERNAL SUB CLEAR(XS,YS,XE,YE,R(,),G(,),B(,))
FOR XX=XS TO XE
FOR YY=YS TO YE
LET R(XX,YY)=0
LET G(XX,YY)=0
LET B(XX,YY)=0
IF XX<=XSIZE-1 AND YY<=YSIZE-1 THEN CALL PSET(XX,YY,0,0,0)
NEXT YY
NEXT XX
END SUB
EXTERNAL SUB RGB(X,R,G,B)
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)
ASK PIXEL VALUE (X,Y) C
CALL RGB(C,R,G,B)
END SUB
EXTERNAL SUB GINIT(XSIZE,YSIZE)
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)
SET COLOR COLORINDEX(MOD(R+256,256)/255,MOD(G+256,256)/255,MOD(B+256,256)/255)
PLOT POINTS: X , Y
END SUB
EXTERNAL SUB PICTURELOAD(N$,XSIZE,YSIZE)
SET COLOR MODE "NATIVE"
CLEAR
SET POINT STYLE 1
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
|
|