プログレッシブ JPG

 投稿者：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 		 

戻る