|
|
DCTによる解像度変換を行います。
このプログラムは実行に時間がかかります。
ご注意ください。
OPTION ARITHMETIC NATIVE
DECLARE EXTERNAL FUNCTION C
READ NN,BASESIZE
DIM CONVERTSIZE(NN),S$(NN)
FOR I=1 TO NN
READ CONVERTSIZE(I)
IF CONVERTSIZE(I)/BASESIZE<1 THEN
LET S$(I)="縮小 : "&STR$(CONVERTSIZE(I)/BASESIZE)&"倍"
ELSE
LET S$(I)="拡大 : "&STR$(CONVERTSIZE(I)/BASESIZE)&"倍"
END IF
NEXT I
DATA 5,8
DATA 4,6,12,16,24 !,32
!'DATA 6,16
!'DATA 4,8,12,24,32,48 ! ,64
FILE GETNAME N$,"BMP,JPG,GIF,PNGファイル|*.BMP;*.JPG;*.GIF;*.PNG"
CALL PICTURELOAD(N$,XSIZE,YSIZE)
DIM VM(0 TO XSIZE,0 TO YSIZE)
ASK PIXEL ARRAY(0,0) VM
LOCATE CHOICE(S$) : N
LET SCALE=CONVERTSIZE(N)/BASESIZE
IF SCALE<1 THEN LET SIZE=BASESIZE ELSE LET SIZE=CONVERTSIZE(N)
DIM B(0 TO SIZE-1,0 TO SIZE-1),G(0 TO SIZE-1,0 TO SIZE-1),R(0 TO SIZE-1,0 TO SIZE-1)
CALL GINIT(XSIZE*SCALE,YSIZE*SCALE)
FOR Y=0 TO YSIZE-1 STEP BASESIZE
FOR X=0 TO XSIZE-1 STEP BASESIZE
FOR J=0 TO BASESIZE-1
FOR I=0 TO BASESIZE-1
IF X+I<=XSIZE-1 AND Y+J<=YSIZE-1 THEN
LET CC=VM(X+I,Y+J)
CALL RGB(CC,RR,GG,BB)
LET B(I,J)=BB
LET G(I,J)=GG
LET R(I,J)=RR
END IF
NEXT I
NEXT J
CALL DCT2(BASESIZE,B)
MAT B=SCALE*B
CALL DCT2(BASESIZE,G)
MAT G=SCALE*G
CALL DCT2(BASESIZE,R)
MAT R=SCALE*R
CALL DCT3(CONVERTSIZE(N),B)
CALL DCT3(CONVERTSIZE(N),G)
CALL DCT3(CONVERTSIZE(N),R)
FOR J=0 TO CONVERTSIZE(N)-1
FOR I=0 TO CONVERTSIZE(N)-1
IF X+I<=XSIZE-1 AND Y+J<=YSIZE-1 THEN
CALL PSET(X*SCALE+I,Y*SCALE+J,R(I,J),G(I,J),B(I,J))
END IF
NEXT I
NEXT J
MAT R=ZER
MAT G=ZER
MAT B=ZER
NEXT X
NEXT Y
END
EXTERNAL SUB DCT2(NN,X(,))
OPTION ARITHMETIC NATIVE
OPTION BASE 0
DIM Y(NN-1,NN-1)
FOR V=0 TO NN-1
FOR U=0 TO NN-1
LET YY=2/NN*C(U,NN)*C(V,NN)
FOR M=0 TO NN-1
FOR N=0 TO NN-1
LET Y(U,V)=Y(U,V)+YY*X(M,N)*COS((2*M+1)*U*PI/2/NN)*COS((2*N+1)*V*PI/2/NN)
NEXT N
NEXT M
NEXT U
NEXT V
FOR I=0 TO NN-1
FOR J=0 TO NN-1
LET X(I,J)=Y(I,J)
NEXT J
NEXT I
END SUB
EXTERNAL SUB DCT3(NN,X(,))
OPTION ARITHMETIC NATIVE
OPTION BASE 0
DIM Y(NN-1,NN-1)
FOR M=0 TO NN-1
FOR N=0 TO NN-1
LET YY=2/NN
FOR V=0 TO NN-1
FOR U=0 TO NN-1
LET Y(M,N)=Y(M,N)+YY*C(U,NN)*C(V,NN)*X(U,V)*COS((2*M+1)*U*PI/2/NN)*COS((2*N+1)*V*PI/2/NN)
NEXT U
NEXT V
NEXT N
NEXT M
FOR I=0 TO NN-1
FOR J=0 TO NN-1
LET X(I,J)=Y(I,J)
NEXT J
NEXT I
END SUB
EXTERNAL FUNCTION C(X,N)
OPTION ARITHMETIC NATIVE
IF X=0 OR X=N THEN LET C=SQR(2)/2 ELSE LET C=1
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
CLEAR
SET COLOR MODE "NATIVE"
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
CLEAR
SET COLOR MODE "NATIVE"
SET POINT STYLE 1
GLOAD N$
LET XSIZE=PIXELX(1)
LET YSIZE=PIXELY(1)
SET BITMAP SIZE XSIZE,YSIZE
SET WINDOW 0,XSIZE-1,YSIZE-1,0
END SUB
|
|