|
投稿者：SECOND
投稿日：2009年10月 4日(日)06時17分42秒
|
|
|
|
!十進 BASIC による プログレッシブ JPG の展開と画像化。
!を見ても、説明が解りにくく、実際の例が、必要です。あくまで、個人的理解の範囲ですが、
!
!具体的、可視的なプログラムで、実行し画像化しますので、詳細事項の追跡と御参考に。
!再生できるファイルは、1000x1000 までの JPG だけで、
! baseline , spectral selection , successive approximation の３種類( web 上の、ほぼ全種)
!
!１）successive approximation AC.subsequence（Y,Cb,Cr 別々、１bit づつの処理）
!
! 0 1 1 0 0 0 0 0 0 ？
! 0 0 0 0 0 1 0 0 0 ？
! 0 1 0 0 0 0 0 1 0 ？
! 0 1 1 0 0 1 0 1 0 ？
! 0 1 1 0 0 1 0 1 0 ？
! --------------------------------------------------------------------------
! ±1 b1 b2 0 0 b3 0 b4 ±1 ？
! 前の終り RRRR RRRR RRRR extend. 次の始め
!
! huffman.
! RRRRssss extend. b1 b2 b3 b4 …
! 3 1 (0 or 1) bit_stream=？何個になるかは、上図で、上位桁 =0 の係数が
! -1 +1 (0 or 1) RRRR 個 になるまでに通過した上位桁 <>0 の個数。
! 0 ±1
! 0 → 無変化。
! 1 → ±符号は上位桁に合せて加算。(絶対値が＋1)
!
!２）successive approximation DC.subsequence（Y,Cb,Cr 別々、１bit づつの処理）
!
! ハフマン・コード RRRRssss 部は、存在せず、
! 頭からの bit_stream.で、１bit づつ、全てのblock の DC係数 に加える。
!
! AC と同様、0 → 無変化。1 → ±符号は上位桁に合せて加算。(絶対値が＋1)
!
!※上記、successive approximation AC, DC とも、加える１は、
! 2^Al 倍の point transfer. としてから、加えます。
!
DEBUG ON
!------------------------
!JPG.decoder
! Baseline
! Progressive( spectral selection )( successive approximation )
!------------------------
OPTION ARITHMETIC NATIVE
OPTION BASE 0
OPTION CHARACTER byte
SET TEXT background "OPAQUE"
ASK BITMAP SIZE bmx,bmy
SET WINDOW 0,bmx, bmy,0
SET ECHO "OFF"
SET COLOR MODE "NATIVE"
!
DIM D8(1000,1000) !GDISP DSPYbr
DIM D2(1000,1000,2) !Y=D2(,,0) Cb=D2(,,1) Cr=D2(,,2)
DIM D1(1000,1000,2) !Y=D2(,,0) Cb=D2(,,1) Cr=D2(,,2)
DIM MH(2),MV(2) !R_BIN31 SOF0 MCU.Ybr.H()V()
DIM HDC(2),HAC(2) !R_BIN31 hT.table selection
DIM QS(2),CoID(255) !R_BIN31 qT.table selection
DIM M3(2)
!
DIM U(63),V(63) !zigzag
DIM DQ(7,7,3) !blk8x8 DQT
DIM DH(16,7),DV(255,7) !DHT
DIM B(255+1,7),L(255,7) !encorder & decorder's pre_table, length, ( MAKE_H2,MAKE_H0)
DIM A(2000,7) !decorder
DIM B2(2) !Ybr D.C.成分 starting & back_level for difference
DIM T(7,7),X(7),XO(7) !DDCT8X8, IDDCT8X8
!
LET BST=2 !huffman decorder's bit step 1=8.5s 2=6.5s 4=8.0s 8=50.0s
LET SHb=2^BST !huffman decorder *SHb(shl BST) /SHb(shr BST)
!LET YDC0=1024 !prediction 128( 50%) * {SQR(2/8)^2 * SQR(1/2)^2 * (8*8)}
!
!---zigzag table
FOR V_=0 TO 7
FOR U_=0 TO 7
READ i
LET U(i)=U_
LET V(i)=V_
NEXT U_
NEXT V_
DATA 0, 1, 5, 6,14,15,27,28
DATA 2, 4, 7,13,16,26,29,42
DATA 3, 8,12,17,25,30,41,43
DATA 9,11,18,24,31,40,44,53
DATA 10,19,23,32,39,45,52,54
DATA 20,22,33,38,46,51,55,60
DATA 21,34,37,47,50,56,59,61
DATA 35,36,48,49,57,58,62,63
!
DO
FILE GETNAME FL$, "jpg"
IF FL$="" THEN
PRINT "入力ファイル名が、ありません。"
STOP
END IF
PRINT "入力ファイル："& FL$
!---
CLEAR
CALL IZZRL0 ! D2()<-- decord JPG
PRINT "次のファイル[ Any key ]"
beep
CHARACTER INPUT CLEAR: w$
LOOP UNTIL w$=CHR$(27) !ESC
!-------- IZZRL0 call here for display D2()
SUB MAIN65
PRINT "画像の準備中、";
CALL IDDCT8X8 ! D1()<-- iDCT<-- iDQT<-- D2()
!---
IF 1< MH(0) OR 1< MV(0) THEN ! Cb_Cr expand Blocks -->MCU scales
FOR V09=0 TO DV_-1 STEP 8*MV(0)
FOR U09=0 TO DU-1 STEP 8*MH(0)
!---MCU part.Cb.Cr
FOR V0=8*MV(0)-1 TO 0 STEP -1
FOR U0=8*MH(0)-1 TO 0 STEP -1
LET D1(U09+U0,V09+V0,1)=D1(U09+IP(U0/MH(0)),V09+IP(V0/MV(0)),1)
LET D1(U09+U0,V09+V0,2)=D1(U09+IP(U0/MH(0)),V09+IP(V0/MV(0)),2)
NEXT U0
NEXT V0
!---
NEXT U09
NEXT V09
END IF
! END SUB
!------ JPG 色空間 ----------------------------
! | Y | | 0.2990 +0.5870 +0.1140 | | R |
! |B-Y| = |-0.1687 -0.3313 +0.5000 | | G |
! |R-Y| | 0.5000 -0.4187 -0.0813 | | B |
!
! | R | | 1 0 +1.40200 | | Y |
! | G | = | 1 -0.34414 -0.71414 | |B-Y|
! | B | | 1 +1.77200 0 | |R-Y|
!----------------------------------------------
! SUB DSPYbr
FOR V0=0 TO DY-1
FOR U0=0 TO DX-1
LET w1=IP(D1(U0,V0,0) +1.40200*D1(U0,V0,2)) !R
LET w2=IP(D1(U0,V0,0) -0.34414*D1(U0,V0,1) -0.71414*D1(U0,V0,2)) !G
LET w3=IP(D1(U0,V0,0) +1.77200*D1(U0,V0,1)) !B
IF w1< 0 THEN
LET w1=0
ELSEIF 255< w1 THEN
LET w1=255
END IF
IF w2< 0 THEN
LET w2=0
ELSEIF 255< w2 THEN
LET w2=255
END IF
IF w3< 0 THEN
LET w3=0
ELSEIF 255< w3 THEN
LET w3=255
END IF
LET D8(U0,V0)=w3*65536+w2*256+w1 !（逆）BGR
NEXT U0
NEXT V0
LET w=TRUNCATE(MIN( (bmx-1)/DX,(bmy-1)/DY),1)
IF 1< w THEN LET w=IP(w)
IF 4< w THEN LET w=4
PRINT "描画の倍率=";w
MAT PLOT CELLS,IN 1,1; DX*w, DY*w :D8
END SUB
!========================
!inverse haffman Transform.
SUB IZZRL0
LET byt=0 !!!
CALL ROPEN ! FL$
!---
CALL R_BIN31(0) !A() B(i,J)L(i,J)<-- DH(), return at img.top
PRINT right$("000"& BSTR$(byt,16),4) !!!
PRINT "(";STR$(DX);"x";STR$(DY);
!---
MAT D8=ZER(DX-1,DY-1) !DSPYbr
LET i=8*MH(0) !MCU Y.Hsize
LET j=8*MV(0) !MCU Y.Vsize
LET DUM=CEIL(DX/i)*i !Uwidth=bound by MCU Y.Hsize
LET DVM=CEIL(DY/j)*j !Vwidth=bound by MCU Y.Vsize
MAT D1=ZER(DUM-1,DVM-1,2) !Y=D1(,,0) Cb=D1(,,1) Cr=D1(,,2)
MAT D2=ZER(DUM-1,DVM-1,2) !Y=D2(,,0) Cb=D2(,,1) Cr=D2(,,2)
LET MH_=MH(0)
LET MV_=MV(0)
LET DU =DUM !Uwidth=bound by MCU Y.Hsize
LET DV_=DVM !Vwidth=bound by MCU Y.Vsize
LET DU8=CEIL(DX/8)*8 !Uwidth=bound by block Y.Hsize
LET DV8=CEIL(DY/8)*8 !Vwidth=bound by block Y.Vsize
!---
PRINT "/ ";STR$(DU8);",";STR$(DV8);"/ ";STR$(DUM);",";STR$(DVM);")"
CALL frame
!---
CALL MAIN65
!---
IF 0< M THEN PRINT " (";STR$(DX);"x";STR$(DY);"/";STR$(U0);",";STR$(V0);") ";debug$;" abort by ";BSTR$(M,16) !!!
PRINT right$("000"& BSTR$(byt-2*SGN(M),16),4) !!!
CALL R_BIN31(M) ! return at img.top, or EOI
!---
DO WHILE M=BVAL("DA",16) !SOS
IF 0<=HAC(0) THEN
LET MV(0)=1
LET MH(0)=1
LET DU=DU8
LET DV_=DV8
END IF
CALL frame
LET MV(0)=MV_
LET MH(0)=MH_
LET DU=DUM
LET DV_=DVM
!---
IF Ss_<>Se_ AND M3(0)=M3(1) AND M3(1)=M3(2) THEN CALL MAIN65
!---
IF 0< M THEN PRINT " (";STR$(DX);"x";STR$(DY);"/";STR$(U0);",";STR$(V0);") ";debug$;" abort by ";BSTR$(M,16) !!!
PRINT right$("000"& BSTR$(byt-2*SGN(M),16),4) !!!
CALL R_BIN31(M) ! return at img.top
LOOP
CLOSE #1 ! FL$
END SUB
SUB reset0
LET B2(0)=0 !ROUND( YDC0/DQ(0,0,QS(0)) ) !prediction YDC.( 1st.reference level)
LET B2(1)=0 !prediction CbDC.
LET B2(2)=0 !prediction CrDC.
LET Hx=0 !bits stream input buffer 0~(7+8)bits, use fraction
LET BC=0 !stored bits in Hx
LET NA=0 !nest adr. in A()
LET EOB=0 !counter( end_of_band)
LET M=0
LET ext=0
END SUB
!Page-2 へ続く
|
|
|
|
投稿者：SECOND
投稿日：2009年10月 4日(日)06時15分40秒
|
|
|
|
!Page-2 の始め
SUB frame
PRINT " Ss Se AhAl: ";Ss_;Se_;STR$(Ah);STR$(Al)
PRINT " Y HDC HAC: ";IP(HDC(0)/2);IP(HAC(0)/2)
PRINT " Cb : ";IP(HDC(1)/2);IP(HAC(1)/2)
PRINT " Cr : ";IP(HDC(2)/2);IP(HAC(2)/2)
CALL reset0
!---
FOR V09=0 TO DV_-1 STEP 8*MV(0)
FOR U09=0 TO DU-1 STEP 8*MH(0)
IF rct=0 THEN
CALL R_BIN31(0) ! read marker
IF rct<>DRI THEN BREAK ! not RST0~7
CALL reset0 ! Restart
END IF
CALL MCUxx11 ! read picture data
LET rct=rct-1
!---
IF 0< ext THEN
IF ext=103001 THEN
PRINT "abort marker ";BSTR$(M,16)
IF BVAL("D0",16)<=M AND M<=BVAL("D7",16) THEN ! RST0~7( restart marker)
LET rct=DRI ! set counter
CALL reset0 ! Restart
ELSE
EXIT SUB ! others marker
END IF
ELSE
PRINT "file error. display fragment"
LET M=BVAL("D9",16) ! EOI
EXIT SUB
END IF
END IF
NEXT U09
NEXT V09
IF 0< EOB THEN PRINT "EOBn over frame";EOB !!!
END SUB
SUB MCUxx11
!---read MCU
FOR P=0 TO CMO
IF 0<=HDC(P) OR 0<=HAC(P) THEN
FOR V0=V09 TO V09+8*MV(P)-1 STEP 8
FOR U0=U09 TO U09+8*MH(P)-1 STEP 8
WHEN EXCEPTION IN
IF EOB=0 THEN CALL R_BLK0 ELSE LET EOB=EOB-1
USE
LET ext=EXTYPE
EXIT SUB
END WHEN
!---extend bitmap
IF 0< Ah AND 0< Se_ THEN
FOR i=A_ TO Se_
IF D2(U0+U(i),V0+V(i),P)<>0 THEN
LET L_=1
WHEN EXCEPTION IN
CALL DEC1_EX
USE
LET ext=EXTYPE
EXIT SUB
END WHEN
LET V_=SGN(D2(U0+U(i),V0+V(i),P))*V_*2^Al
LET D2(U0+U(i),V0+V(i),P)=D2(U0+U(i),V0+V(i),P) +V_
END IF
NEXT i
LET A_=Ss_
END IF
!---
NEXT U0
NEXT V0
END IF
NEXT P
END SUB
!------
SUB R_BLK0
IF Ss_=0 THEN
!---D.C.part
LET debug$="DC.huffman" !!!
IF Ah=0 THEN !-----baseline.progSS.progSA(1st.scan).
LET J=HDC(P) !huffman D.C.table selection P( 0=Y 1=Cb 2=Cr)
CALL DEC1_NS
LET EL=V_ !extent length
!---D.C.extent
LET debug$="DC.huffman extend" !!!
IF 0< EL THEN
LET L_=EL
CALL DEC1_EX !keep EL, V_=extent value( length EL bits)
LET W=2^(EL-1) !minimum in EL bits length
IF V_< W THEN LET V_=V_-(W*2-1) !restore signed value
LET B2(P)=B2(P)+V_*2^Al !point transform, integrate to D.C.
END IF
LET D2(U0+U(0),V0+V(0),P)=B2(P)
ELSE !-----progSA(2st.scan).
LET L_=1
CALL DEC1_EX
LET V_=SGN(D2(U0+U(0),V0+V(0),P))*V_
LET D2(U0+U(0),V0+V(0),P)=D2(U0+U(0),V0+V(0),P) +V_*2^Al
END IF
LET Sa_=1
ELSE
LET Sa_=Ss_
END IF
!---A.C.parts
IF Se_=0 THEN EXIT SUB !band Ss_~Se_
LET J=HAC(P) !huffman A.C.table selection P( 0=Y 1=Cb 2=Cr)
LET debug$="AC.huffman"
FOR A_=Sa_ TO Se_
CALL DEC1_NS
LET EL=MOD(V_,16) !extent length
LET RL= IP(V_/16) !run length
!---
IF RL<=14 AND EL=0 THEN !End Of Block(00). End Of Band(10,20,,E0)
!---EOBn extend
LET debug$="eobn extend"& STR$(RL)
IF 0< RL THEN
LET L_=RL !extend= run_length
CALL DEC1_EX !keep RL, V_=run value( length RL bits)
LET EOB=V_+2^RL-1 !RL= End Of Band(10,20,,E0) run length
END IF
EXIT SUB
!---
END IF
!---RL=(0~15)EL=(1~10), RL=(15)EL=(0)
LET debug$="AC.huffman extend" !!!
IF Ah=0 THEN !-----baseline.progSS.progSA(1st.scan).
LET A_=A_+RL !skip zero_run_length 0~15
!---A.C.extent
IF 0< EL THEN !ZRL(16) only skip
LET L_=EL
CALL DEC1_EX !keep EL, V_=extent value( length EL bits)
LET w=2^(EL-1) !minimum in EL bits length
IF V_< w THEN LET V_=V_-(w*2-1) !restore signed value
!---
LET V_=V_*2^Al !point transform
LET D2(U0+U(A_),V0+V(A_),P)=V_
END IF
ELSE !-----progSA(2st.scan).
IF 0< EL THEN !ZRL(16) only skip
LET L_=EL
CALL DEC1_EX !keep EL, V_=extent value( length EL bits)
IF EL<>1 THEN PRINT "AC.2nd.=";EL;V_ !!!
LET V01=V_
END IF
FOR i=A_ TO Se_
IF D2(U0+U(i),V0+V(i),P)<>0 THEN !zz(k)=xxx_1?/0?
LET L_=1
CALL DEC1_EX
LET V_=SGN(D2(U0+U(i),V0+V(i),P))*V_
LET D2(U0+U(i),V0+V(i),P)=D2(U0+U(i),V0+V(i),P) +V_*2^Al
ELSEIF RL=0 THEN !zz(k)=000_V01
EXIT FOR
ELSE !zz(k)=000_0 ,zero run
LET RL=RL-1
END IF
NEXT i
IF 0< EL THEN !ZRL(16) skip
IF V01=0 THEN LET V01=-1
LET D2(U0+U(i),V0+V(i),P)=V01*2^Al
END IF
LET A_=i
END IF
NEXT A_
END SUB
!========================
! decorder
! J= huffman code table selection ( 0=YDC 1=YAC 2=CDC 3=CAC)
! V_= pickup RRRRssss <-- JPG.file
SUB DEC1_NS
DO
IF BC< BST THEN CALL DEC1_IN
LET W=IP(Hx) ! bits width BST
!----
LET W=A(NA+W,J)
IF 32768<=W THEN EXIT DO
LET NA=W ! nest adr. W=0 table end
LET BC=BC-BST
LET Hx=MOD(Hx*SHb,SHb)
LOOP
LET NA=0 ! DU0L LLLL VVVV VVVV
LET L_=MOD(IP(W/256),128) ! U0L LLLL
LET V_=MOD(W,256) ! VVVV VVVV
IF 16< L_ THEN PRINT "unused code" !BREAK !unused code ! LET V_=BVAL("8000",16)
!----
LET W=MOD(L_,BST)
IF 0< W THEN
LET BC=BC-W
LET Hx=MOD(Hx*2^W,SHb)
ELSE
LET BC=BC-BST
LET Hx=MOD(Hx*SHb,SHb)
END IF
END SUB
SUB DEC1_IN
CALL RED_D
LET W=ORD(D$)
IF W=255 THEN
CALL RED_D
LET M=ORD(D$)
IF M<>0 THEN LET w=1/0 ! EXTYPE=3001, ffxx marker, abnormally break
END IF
LET Hx=Hx+W*2^(BST-8-BC)
LET BC=BC+8
END SUB
!-------
SUB DEC1_EX
LET V_=0
DO
IF L_< 1 THEN EXIT SUB
IF BC< L_ THEN CALL DEC1_IN
LET W=IP(Hx)
!----
IF BST>=L_ THEN EXIT DO
LET V_=V_*SHb+W
LET L_=L_-BST
LET BC=BC-BST
LET Hx=MOD(Hx*SHb,SHb)
LOOP
LET V_=V_*2^L_+IP(W*2^(L_-BST))
!----
LET BC=BC-L_
LET Hx=MOD(Hx*2^L_,SHb)
END SUB
!Page-3 へ続く
|
|
|
|
投稿者：SECOND
投稿日：2009年10月 4日(日)06時13分51秒
|
|
|
|
!Page-3 の始め
!============
! B(,J)L(,J)<-- DH(,J) for decorder table A(,J)
!
SUB makeH0(J)
LET i=0 ! コード生成 順番(短い順)
LET Hx=0
LET Tx=BVAL("8000",16)
FOR L_=1 TO 16
FOR P=1 TO DH(L_,J)
LET L(i,J)=L_
LET B(i,J)=Hx ! コード(生成順), 座標DV(頻度降順) と同順。
LET i=i+1
LET Hx=Hx+Tx
NEXT P
LET Tx=Tx/2
NEXT L_
LET B(256,J)=0
FOR i=i TO 255
LET L(i,J)=0
LET B(i,J)=0
NEXT i
END SUB
!============
!A(,J)=output decorder table<-- B(,J) L(,J) DH(,J) DV(,J)
!
SUB makeD0(J)
FOR LH=16 TO 1 STEP -1
IF DH(LH,J)<>0 THEN EXIT FOR
NEXT LH !length max. in huffman table
LET LM=CEIL(LH/BST)*BST !length max. bound by BST
!---
LET I=0 !start huffman table adr.
LET LA=0 !line adr.
LET P=BST !start Decord code width
LET U_=2^(16-BST) !start Decord code step
LET NC=0 !next start Decord code
DO
LET D_=NC !start Decord code
LET NC=-1
LET LB=LA+(65536-D_)/U_ !1st nest adr.
DO
CALL SERCH
IF 0< L_ THEN
LET A(LA,J)= BVAL("8000",16)+L_*256+DV(I,J) !b15=end. +L.+V.
ELSEIF P=LM THEN
LET A(LA,J)= BVAL("C000",16)+LH*256 !b15=end. b14=Unused. +L.
ELSE
IF NC=-1 THEN LET NC=D_
LET A(LA,J)=LB ! nest adr.
LET LB=LB+SHb ! next nest adr.
END IF
LET D_=D_+U_
LET LA=LA+1
LOOP UNTIL IP(D_)=65536
LET P=P+BST
LET U_=U_/SHb !shr(U_,BST)
LOOP UNTIL P>LM
!---
FOR LA=LA TO 255
LET A(LA,J)=0 !(0),table stop mark
NEXT LA
END SUB
SUB SERCH
FOR I=I TO DH(0,J)-1
LET L_=L(I,J)
IF L_<=P THEN LET w=IP(D_/2^(16-L_))*2^(16-L_) ELSE EXIT FOR
IF w<=B(I,J) THEN
IF w=B(I,J) THEN EXIT SUB ELSE EXIT FOR
END IF
NEXT I
LET L_=-1
END SUB
!===========
! Inverse Fast Cosin Transform.( 8x8, iDCT-2 ) ← Inverse Quantization.DQ()
SUB IDDCT8X8
FOR V0=0 TO DV_-1 STEP 8
FOR U0=0 TO DU-1 STEP 8
FOR P=0 TO CMO ! =0(mono) =2(color)
FOR V_=0 TO 7
FOR U_=0 TO 7
LET X(U_)=D2(U0+U_,V0+V_,P) *DQ(U_,V_,QS(P)) ! Inverse Quantization
NEXT U_
CALL IWANG
FOR X_=0 TO 7
LET T(X_,V_)=X(X_)
NEXT X_
NEXT V_
FOR X_=0 TO 7
FOR V_=0 TO 7
LET X(V_)=T(X_,V_)
NEXT V_
CALL IWANG
FOR Y_=0 TO 7
IF P=0 THEN LET D1(U0+X_,V0+Y_,P)=X(Y_)+128 ELSE LET D1(U0+X_,V0+Y_,P)=X(Y_)
NEXT Y_
NEXT X_
NEXT P
NEXT U0
NEXT V0
END SUB
!----inverse Wang.( 8, iDCT-2 )
SUB IWANG
LET XO(0)=SQR(2/8)*X(0)
LET XO(1)=SQR(2/8)*X(4)
LET XO(2)=SQR(2/8)*X(2)
LET XO(3)=SQR(2/8)*X(6)
LET XO(4)=SQR(1/8)*X(1)
LET XO(5)=SQR(1/8)*X(5)
LET XO(6)=SQR(1/8)*X(3)
LET XO(7)=SQR(1/8)*X(7)
!
LET X(4)=(COS(PI /16)*XO(4)+SIN(PI /16)*XO(7))
LET X(5)=(COS(PI*5/16)*XO(5)+SIN(PI*5/16)*XO(6))
LET X(6)=(SIN(PI*5/16)*XO(5)-COS(PI*5/16)*XO(6))
LET X(7)=(SIN(PI /16)*XO(4)-COS(PI /16)*XO(7))
!
LET XO(4)= X(4)+X(5)
LET XO(5)= X(4)-X(5)
LET XO(6)=-X(6)+X(7)
LET XO(7)= X(6)+X(7)
!
LET X(0)=(COS(PI/4)*XO(0)+COS(PI /4)*XO(1))
LET X(1)=(COS(PI/4)*XO(0)-COS(PI /4)*XO(1))
LET X(2)=(SIN(PI/8)*XO(2)-SIN(PI*3/8)*XO(3))
LET X(3)=(COS(PI/8)*XO(2)+COS(PI*3/8)*XO(3))
LET X(4)=XO(4)
LET X(5)=XO(6)
LET X(6)=XO(5)
LET X(7)=XO(7)
!
LET XO(0)=X(0)+X(3)
LET XO(1)=X(1)+X(2)
LET XO(2)=X(1)-X(2)
LET XO(3)=X(0)-X(3)
LET XO(4)=X(7)*SQR(2)
LET XO(5)=X(6)-X(5)
LET XO(6)=X(6)+X(5)
LET XO(7)=X(4)*SQR(2)
!
LET X(0)=XO(0)+XO(7)
LET X(1)=XO(1)+XO(6)
LET X(2)=XO(2)+XO(5)
LET X(3)=XO(3)+XO(4)
LET X(4)=XO(3)-XO(4)
LET X(5)=XO(2)-XO(5)
LET X(6)=XO(1)-XO(6)
LET X(7)=XO(0)-XO(7)
END SUB
!=============
SUB R_BIN31(M) ! decord(M) before new.search(M)
DO
IF M=BVAL("D8",16) THEN ! SOI
MAT DH=ZER ! clear Huffman Table
LET DRI=0 ! clear Restart Interval.value for RST0~7(restart marker)
LET rct=-1 ! Interval.counter, valid (0<=rct), invalid (rct< 0)
MAT M3=ZER ! clear scan band sum
ELSEIF M=BVAL("D9",16) THEN ! EOI
EXIT DO ! close & end_sub
ELSEIF BVAL("D0",16)<=M AND M<=BVAL("D7",16) THEN ! RST0~7( restart marker)
LET rct=DRI ! set counter with Restart Interval
EXIT SUB
ELSEIF 0< M THEN !M=0 is data"FF" in picture area
CALL RED_D
LET N=ORD(D$)*256
CALL RED_D
LET N=N+ORD(D$)-2 ! N=remain size
!---
IF BVAL("E0",16)<=M AND M<=BVAL("EF",16) THEN ! APP0~APP15
CALL FFE0
ELSEIF M=BVAL("DD",16) THEN
CALL FFDD ! DRI load DRI & rct=DRI
ELSEIF M=BVAL("FE",16) THEN
CALL FFFE ! COMMENT
ELSEIF M=BVAL("C4",16) THEN
CALL FFC4 ! DHT
ELSEIF M=BVAL("DB",16) THEN
CALL FFDB ! DQT
ELSEIF M=BVAL("C0",16) OR M=BVAL("C2",16) THEN
CALL FFC0 ! SOF0 SOF2
ELSEIF M=BVAL("DA",16) THEN
CALL FFDA ! SOS
EXIT SUB ! without close
ELSE
BREAK ! new marker
END IF
END IF
!---
DO
LET M=BVAL("D9",16) ! EOI, 256 ! end of file
CHARACTER INPUT #1,IF MISSING THEN EXIT DO :D$
LET byt=byt+1 !!!
LET M=ORD(D$)
LOOP UNTIL M=255 ! 1st.mark
IF M<>255 THEN EXIT DO ! close & end_sub
CALL RED_D
LET M=ORD(D$)
LOOP
CLOSE #1
END SUB
!DRI
SUB FFDD
CALL RED_D
LET DRI=ORD(D$)*256
CALL RED_D
LET DRI=DRI+ORD(D$)
LET rct=DRI
END SUB
!APP0
SUB FFE0
FOR W=1 TO N
CALL RED_D
NEXT W
END SUB
!COMMENT
SUB FFFE
FOR W=1 TO N
CALL RED_D
NEXT W
END SUB
!Page-4 へ続く
|
|
|
|
投稿者：SECOND
投稿日：2009年10月 4日(日)06時12分22秒
|
|
|
|
!Page-4 の始め
!DQT
SUB FFDB
DO WHILE 0< N
CALL RED_D
LET w= IP(ORD(D$)/16) !p=0(byte) p=1(word)
LET J=MOD(ORD(D$),16) !J=0~3 (QT.number)
FOR i=0 TO 63
CALL RED_D
LET DQ(U(i),V(i),J)=ORD(D$)
IF w=1 THEN
CALL RED_D
LET DQ(U(i),V(i),J)=DQ(U(i),V(i),J)*256+ORD(D$)
END IF
NEXT i
LET N=N-65-64*w ! remain size
LOOP
END SUB
!SOF0
SUB FFC0
CALL RED_D
IF ORD(D$)<>8 THEN BREAK ! 8bit( 24bitColor ) at RGB.dimension
CALL RED_D
LET W=ORD(D$)*256
CALL RED_D
LET DY=W+ORD(D$) !V.pix.
CALL RED_D
LET W=ORD(D$)*256
CALL RED_D
LET DX=W+ORD(D$) !H.pix.
CALL RED_D
FOR i=0 TO ORD(D$)-1 !1~3 scan order items
CALL RED_D
LET CoID(ORD(D$))=i ! (Y=0, Cb=1, Cr=2)<-- CoID( ID=0~255)
CALL RED_D
LET MH(i)= IP(ORD(D$)/16) ! HV Y=11,12,21,22,41 Cb=11,11,11,11,11 Cr=11,11,11,11,11
LET MV(i)=MOD(ORD(D$),16)
CALL RED_D
LET QS(i)=ORD(D$) ! QT.number0~3 <-- QS( Y=0, Cb=1, Cr=2)
NEXT i
IF 2< i THEN LET CMO=2 ELSE LET CMO=0
END SUB
!DHT
SUB FFC4
DO WHILE 0< N
CALL RED_D
LET J=ORD(D$) ! 0?~1?=DC~AC ?0~?3=ID0~ID3
LET J=2*MOD(J,16)+IP(J/16) ! 0~1=ID0.DC~AC 2~3=ID1.DC~AC 4~5=ID2.…
LET DH(0,J)=0 !!!for 2nd.use for clear
FOR i=1 TO 16
CALL RED_D
LET DH(i,J)=ORD(D$)
LET DH(0,J)=DH(0,J)+DH(i,J)
NEXT i
FOR i=0 TO DH(0,J)-1
CALL RED_D
LET DV(i,J)=ORD(D$)
NEXT i
!---
FOR i=i TO 255
LET DV(i,J)=0
NEXT i
CALL makeH0(J) ! make Huffman Code table B() L()
CALL makeD0(J) ! make Huffman Decorder table A()
!---
LET N=N-1-16-DH(0,J) ! remain size
LOOP
END SUB
!SOS
SUB FFDA
CALL RED_D
LET M2=ORD(D$)
MAT HDC=(-2)*CON
MAT HAC=(-2)*CON
FOR i=1 TO M2
CALL RED_D
LET w=ORD(D$) !ID=0~255( normal 01~03)
CALL RED_D ! 00=Y 11=Cb 11=Cr
LET HDC(CoID(w))= IP(ORD(D$)/16)*2 !DC 0~3-->0,2,4,6
LET HAC(CoID(w))=MOD(ORD(D$),16)*2+1 !AC 0~3-->1,3,5,7
NEXT i
CALL RED_D
LET Ss_=ORD(D$) ! low of spectral selection
CALL RED_D
LET Se_=ORD(D$) ! high of spectral selection
CALL RED_D
LET Al=MOD(ORD(D$),16) ! low bit of successive approximation
LET Ah=IP(ORD(D$)/16) !high bit of successive approximation
!--- private controll M3(display timing)
LET w=Ah-Al
IF w=0 THEN LET w=1
FOR i=0 TO 2
IF 0<=HAC(i) THEN LET M3(i)=M3(i)+(Se_-Ss_+1)*w ! M3()= scan band sum
NEXT i
!--- next image data top
END SUB
SUB ROPEN
OPEN #1 :NAME FL$ ,ACCESS INPUT
END SUB
SUB RED_D
CHARACTER INPUT #1 :D$
LET byt=byt+1 !!!
END SUB
END
|
|
|
|
投稿者：SECOND
投稿日：2009年10月 4日(日)06時12分22秒
|
|
|
|
!Page-4 の始め
!DQT
SUB FFDB
DO WHILE 0< N
CALL RED_D
LET w= IP(ORD(D$)/16) !p=0(byte) p=1(word)
LET J=MOD(ORD(D$),16) !J=0~3 (QT.number)
FOR i=0 TO 63
CALL RED_D
LET DQ(U(i),V(i),J)=ORD(D$)
IF w=1 THEN
CALL RED_D
LET DQ(U(i),V(i),J)=DQ(U(i),V(i),J)*256+ORD(D$)
END IF
NEXT i
LET N=N-65-64*w ! remain size
LOOP
END SUB
!SOF0
SUB FFC0
CALL RED_D
IF ORD(D$)<>8 THEN BREAK ! 8bit( 24bitColor ) at RGB.dimension
CALL RED_D
LET W=ORD(D$)*256
CALL RED_D
LET DY=W+ORD(D$) !V.pix.
CALL RED_D
LET W=ORD(D$)*256
CALL RED_D
LET DX=W+ORD(D$) !H.pix.
CALL RED_D
FOR i=0 TO ORD(D$)-1 !1~3 scan order items
CALL RED_D
LET CoID(ORD(D$))=i ! (Y=0, Cb=1, Cr=2)<-- CoID( ID=0~255)
CALL RED_D
LET MH(i)= IP(ORD(D$)/16) ! HV Y=11,12,21,22,41 Cb=11,11,11,11,11 Cr=11,11,11,11,11
LET MV(i)=MOD(ORD(D$),16)
CALL RED_D
LET QS(i)=ORD(D$) ! QT.number0~3 <-- QS( Y=0, Cb=1, Cr=2)
NEXT i
IF 2< i THEN LET CMO=2 ELSE LET CMO=0
END SUB
!DHT
SUB FFC4
DO WHILE 0< N
CALL RED_D
LET J=ORD(D$) ! 0?~1?=DC~AC ?0~?3=ID0~ID3
LET J=2*MOD(J,16)+IP(J/16) ! 0~1=ID0.DC~AC 2~3=ID1.DC~AC 4~5=ID2.…
LET DH(0,J)=0 !!!for 2nd.use for clear
FOR i=1 TO 16
CALL RED_D
LET DH(i,J)=ORD(D$)
LET DH(0,J)=DH(0,J)+DH(i,J)
NEXT i
FOR i=0 TO DH(0,J)-1
CALL RED_D
LET DV(i,J)=ORD(D$)
NEXT i
!---
FOR i=i TO 255
LET DV(i,J)=0
NEXT i
CALL makeH0(J) ! make Huffman Code table B() L()
CALL makeD0(J) ! make Huffman Decorder table A()
!---
LET N=N-1-16-DH(0,J) ! remain size
LOOP
END SUB
!SOS
SUB FFDA
CALL RED_D
LET M2=ORD(D$)
MAT HDC=(-2)*CON
MAT HAC=(-2)*CON
FOR i=1 TO M2
CALL RED_D
LET w=ORD(D$) !ID=0~255( normal 01~03)
CALL RED_D ! 00=Y 11=Cb 11=Cr
LET HDC(CoID(w))= IP(ORD(D$)/16)*2 !DC 0~3-->0,2,4,6
LET HAC(CoID(w))=MOD(ORD(D$),16)*2+1 !AC 0~3-->1,3,5,7
NEXT i
CALL RED_D
LET Ss_=ORD(D$) ! low of spectral selection
CALL RED_D
LET Se_=ORD(D$) ! high of spectral selection
CALL RED_D
LET Al=MOD(ORD(D$),16) ! low bit of successive approximation
LET Ah=IP(ORD(D$)/16) !high bit of successive approximation
!--- private controll M3(display timing)
LET w=Ah-Al
IF w=0 THEN LET w=1
FOR i=0 TO 2
IF 0<=HAC(i) THEN LET M3(i)=M3(i)+(Se_-Ss_+1)*w ! M3()= scan band sum
NEXT i
!--- next image data top
END SUB
SUB ROPEN
OPEN #1 :NAME FL$ ,ACCESS INPUT
END SUB
SUB RED_D
CHARACTER INPUT #1 :D$
LET byt=byt+1 !!!
END SUB
END
|
|
|
戻る