GIF ファイルの解析ツール Ver.2（画像付）

 投稿者：SECOND  投稿日：2009年 7月31日(金)00時29分15秒
  !Page-2 の始め
!------------------- 画像データ LZW$ から、原画を見る。------------------
SUB decomp_data
   PRINT "******************* 復元( LZW デコード )"
   LET obits0=ORD(LZW$(1:1))
   CALL prthex(CHR$(obits0),"最小データービット長") !モニター
   LET N000=2^obits0
   LET li=2                               !start input pointer
   LET blkend=0                           !clear input block pointer
   LET iacc$=""                           !clear input bit buffer
   LET pdata$=""                          !clear output byte buffer
   CALL LZW_decoder
   PRINT "Last_code LEN(LZW$) LEN(pdata$)=";bx;LEN(LZW$);LEN(pdata$) !モニター
   !---
   IF tmod=3 THEN MAT m3=m
   LET ii=1
   IF interl=0 THEN
      CALL intlace( 0, 1) ! start_raster, step !---NO interlace
   ELSE
      CALL intlace( 0, 8) ! start_raster, step !---0~7step8
      WAIT DELAY .5
      CALL intlace( 4, 8) ! start_raster, step !---4~7step8
      WAIT DELAY .5
      CALL intlace( 2, 4) ! start_raster, step !---2~3step4
      WAIT DELAY .5
      CALL intlace( 1, 2) ! start_raster, step !---1~1step2
   END IF
   IF tmod=2 THEN MAT m=ncp(256)*CON ! 256= システム背景色
   IF tmod=3 THEN MAT m=m3
   !--- check block_end
   CALL prthex( LZW$(li:li),"block size") !モニター
   PRINT "******************* 復元終り"
END SUB

SUB intlace( ss, stp)
   FOR j=Yp0 TO Yp0+Ypw-1
      IF MOD(j-Yp0, stp) >=ss THEN
         IF MOD(j-Yp0, stp) >ss THEN LET ii=ii-Xpw
         FOR i=Xp0 TO Xp0+Xpw-1
            WHEN EXCEPTION IN
               LET col=ORD(pdata$(ii:ii))
               IF t_on<>1 OR tcol<>col THEN LET m(i,j)=ncp(col)
               LET ii=ii+1
            USE
            END WHEN
         NEXT i
      END IF
   NEXT j
   MAT PLOT CELLS,IN 0,0; Xsw-1,Ysw-1 :m
END SUB

!-------------
SUB LZW_decoder
   DO
      LET dicnum=N000+2-1                   !start dic.number-1
      DO
         LET iwidth=LEN( BSTR$(dicnum,2) )  !remake iwidth
         IF  bitfull< iwidth THEN LET iwidth=bitfull !to handle BAD file
         LET dicnum=dicnum+1
         CALL inpcode                       !data on bx
         IF bx=-1 OR bx=N000+1 THEN
            EXIT SUB
         ELSEIF bx=N000 THEN
            EXIT DO
         ELSE
            IF bx< N000 THEN
               LET dic$(dicnum)=CHR$(bx)
            ELSE
               LET dic$(dicnum)=dic$(bx)
               LET dic$(dicnum)=dic$(dicnum)& dic$(bx+1)(1:1)
            END IF
            LET pdata$=pdata$& dic$(dicnum)
         END IF
      LOOP
   LOOP
END SUB

SUB inpcode
   LET bx=-1
   DO WHILE LEN(iacc$)< iwidth
      IF blkend<=li THEN
         LET blksize=ORD(LZW$(li:li))
         CALL prthex(CHR$(blksize),"block size") !モニター
         IF blksize=0 THEN EXIT SUB
         LET li=li+1
         LET blkend=li+blksize
      END IF
      LET iacc$=right$("0000000"& BSTR$(ORD(LZW$(li:li)),2),8)& iacc$
      LET li=li+1
   LOOP
   LET bx=BVAL(right$(iacc$,iwidth),2)
   LET iacc$=iacc$(1:LEN(iacc$)-iwidth)
END SUB

SUB prthex(d$,w$)
   LET ww$=""
   FOR ii=1 TO LEN(d$)
      LET ww$=ww$& right$("0"& BSTR$(ORD(d$(ii:ii)),16),2)& " "
   NEXT ii
   IF w$>"" THEN LET ww$=ww$& "; "& w$
   PRINT ww$
END SUB

END
 		 

GIF ファイルの解析ツール Ver.2（画像付）

 投稿者：SECOND  投稿日：2009年 7月31日(金)00時31分57秒
  > No.463[元記事へ]

! GIF ファイルの解析ツール Ver.2（画像付）
!-------
! リスト左端アドレスを５桁にした。リスト注釈を大幅修正。復元画像も、
! 表示する様にした。IE6 は、スクリーン背景色を無視して、ブラウザ背景
! のみを、代用するようなので、ＧＩＦ仕様から外れるが、それに合せた。
! Disposal Method 0,1,2,3 、インタレース画像などが、モニター出来る。
!
OPTION CHARACTER BYTE
LET bitfull=12           ! LZW max.bits (~~ 12)
DIM dic$(0 TO 2^bitfull) ! decoder 辞書
!
FILE GETNAME file$, "gif"
IF file$="" THEN
   PRINT "入力ファイル名が、ありません。"
   STOP
END IF
!
PRINT "入力ファイル："& file$
OPEN #1: NAME file$, ACCESS INPUT
PRINT "---------"
SET COLOR mode "native"
DIM ncp(0 TO 256)              ! native color palette
LET ncp(256)=BVAL("eeeedd",16) ! 256= システム背景色 BGR
SET AREA COLOR ncp(256)
PLOT AREA: 0,0;1,0;1,1;0,1
CALL gif_head
LET i=MAX( Xsw,Ysw )
SET WINDOW -.1*i,1.1*i, 1.1*i,-.1*i
SET LINE STYLE 3
PLOT LINES:-1,-1;Xsw+.5,-1;Xsw+.5,Ysw+.5;-1,Ysw+.5;-1,-1
DIM m(0 TO Xsw-1,0 TO Ysw-1), m3(0 TO Xsw-1,0 TO Ysw-1)
MAT m=ncp(256)*CON
DO
   CALL blocks_main
LOOP UNTIL b1$=CHR$(BVAL("3B",16))
PRINT "GIF 終端ブロック"
CALL dump(b1$,2,"block label")
PRINT "---------"
CLOSE #1

!----
SUB gif_head
   LET h$=""
   CALL readb( h$,13 )
   IF h$(1:3)="GIF" THEN PRINT "GIF ヘッダー" ELSE CALL error
   LET Xsw= ORD(h$( 8: 8))*256+ORD(h$(7:7))
   LET Ysw= ORD(h$(10:10))*256+ORD(h$(9:9))
   LET sflg=ORD(h$(11:11)) ! スクリーン情報のフラグ
   LET BGco=ORD(h$(12:12))
   LET aspect=ORD(h$(13:13))
   LET b$=right$("0000000"& BSTR$(sflg,2) ,8)
   LET colpix=2^(BVAL(b$(2:4),2)+1)
   LET compal=2^(BVAL(b$(6:8),2)+1)
   CALL dump(h$( 1: 6),6,"Asc") ! GIF識別文字
   CALL dump(h$( 7: 8),2,"screen X_width= "& STR$(Xsw))
   CALL dump(h$( 9:10),2,"screen Y_width= "& STR$(Ysw))
   CALL dump(h$(11:11),2,"flags= "& b$ )
   PRINT TAB(13);b$(1:1);":common_palette on=1/off=0"
   PRINT TAB(11);b$(2:4);":colors/pixel 2^(";b$(2:4);"b+1)= ";STR$(colpix)
   PRINT TAB(13);b$(5:5);":sort on=1/off=0 パレットの、重要度 色順ソート"
   PRINT TAB(11);b$(6:8);":common_palette colors 2^(";b$(6:8);"b+1)= ";STR$(compal)
   CALL dump(h$(12:12),2,"back_ground color= "& STR$(BGco))
   IF aspect=0 THEN LET b$=".." ELSE LET b$=STR$(aspect)
   CALL dump(h$(13:13),2,"アスペクト比 H:V=, 0 は 1:1 その他("& b$& "+15):64" )
   CALL palette("common_パレット", c_p$, sflg)
END SUB

!----
SUB blocks_main
   LET b1$=""
   CALL readb( b1$, 1)
   IF     b1$=CHR$(BVAL("21",16)) THEN !追加データ・ブロック
      CALL option_block
   ELSEIF b1$=CHR$(BVAL("2C",16)) THEN !画像ブロック
      CALL picture_block
   ELSEIF b1$=CHR$(BVAL("3B",16)) THEN !GIF 終端ブロック
   ELSE
      CALL error
   END IF
END SUB

!---追加データ・ブロック。
SUB option_block
   PRINT "追加データ・ブロック"
   CALL readb( b1$,1)        ! w9$= readb_last_byte
   IF w9$=CHR$(BVAL("F9",16)) THEN
      LET im$=b1$
      CALL dump(im$,2,"イメージコントロール・ブロック")
      CALL blocks(im$,0,"",1) ! non print (data, byte/行, 注釈, 要求blocks)
      LET iflg=ORD(im$(4:4)) ! フラグ
      LET imtm=ORD(im$(6:6))*256+ORD(im$(5:5))
      LET tcol=ORD(im$(7:7))
      LET b$=right$("0000000"& BSTR$(iflg,2),8)
      LET t_on=VAL(b$(8:8))
      LET tmod=BVAL(b$(4:6),2)
      CALL dump(im$(4:4),2,"flags= "& b$ )
      PRINT TAB(11);b$(1:3);":blank"
      PRINT TAB(11);b$(4:6);":"
      PRINT TAB(15);"000= 描画後、そのまま、次の背景へ渡す"
      PRINT TAB(15);"001= 描画後、そのまま、次の背景へ渡す"
      PRINT TAB(15);"010= 描画後、back_ground color と取替、次の背景へ渡す"
      PRINT TAB(15);"011= 描画後、描画前の画像を、次の背景へ渡す"
      PRINT TAB(13);b$(7:7);":user click on=1/off=0"
      PRINT TAB(13);b$(8:8);":透明色のスイッチ on=1/off=0"
      CALL dump(im$(5:6),2,"フレーム表示時間= "& STR$(imtm)& " x10ms" )
      CALL dump(im$(7:7),2,"透明色= "& STR$(tcol) )
      CALL blocks(im$,16,"",999) ! (data, byte/行, 注釈, 要求blocks)
   ELSEIF w9$=CHR$(BVAL("FE",16)) THEN
      LET co$=b1$
      CALL dump(co$,2,"コメント・ブロック")
      CALL blocks(co$,8,"Asc",999) ! (data, byte/行, 注釈, 要求blocks)
   ELSEIF w9$=CHR$(BVAL("FF",16)) THEN
      LET ap$=b1$
      CALL dump(ap$,2,"アプリケーション・ブロック")
      CALL blocks(ap$,8,"Asc",1) ! (data, byte/行, 注釈, 要求blocks)
      IF ap$(4:11)="NETSCAPE" THEN
         CALL blocks(ap$,0,"",1) ! non print (data, byte/行, 注釈, 要求blocks)
         CALL dump(ap$(16:16),2,"extension code= 01~07 next data type")
         IF MOD(ORD(ap$(16:16)),8)=1 THEN
            LET rept=ORD(ap$(18:18))*256+ORD(ap$(17:17))
            CALL dump(ap$(17:18),2,"繰返し回数= "& STR$(rept)& " (0=endless)")
         ELSE
            CALL dump(ap$(17:LEN(ap$)),2,"02= 32bit buffering size, 03~07= ?")
         END IF
      END IF
      CALL blocks(ap$,8,"Asc",999) ! (data, byte/行, 注釈, 要求blocks)
   ELSEIF w9$=CHR$(BVAL("01",16)) THEN
      LET tx$=b1$
      CALL dump(tx$,2,"テキスト・イメージ・ブロック")
      CALL blocks(d$,8,"Asc",999) ! (data, byte/行, 注釈, 要求blocks)
   ELSE
      CALL error
   END IF
END SUB

!-------
SUB blocks(d$,m,t$,n)     ! d$=data, m=byte/行, t$=注釈, n=要求blocks
   FOR n=1 TO n
      CALL readb(d$,1)             ! w9$= readb_last_byte ! =block Size
      CALL dump(w9$,1,"block size")
      IF w9$=CHR$(0) THEN EXIT SUB ! block End
      LET s=LEN(d$)
      CALL readb(d$,ORD(w9$))      ! block data
      IF 0< m THEN CALL dump(d$(s+1:LEN(d$)),m,t$)
   NEXT n
END SUB

SUB readb(d$,cx) !cx=bytes size
   FOR i=1 TO cx
      CHARACTER INPUT #1,IF MISSING THEN EXIT FOR :w9$
      LET d$=d$& w9$
   NEXT i
   IF i<=cx THEN CALL error
END SUB

SUB dump(d$,m,t$)   ! t$="comment" →;comment  t$="Asc" →;"ascii.dump"
   FOR j=1 TO LEN(d$) STEP m
      LET ww$=right$("0000"& BSTR$(adr,16),5)& " "
      FOR i=j TO MIN(j+m-1, LEN(d$))
         LET ww$=ww$& " "& right$("0"& BSTR$( ORD(d$(i:i)),16),2)
         LET adr=adr+1
      NEXT i
      IF t$>"" THEN
         LET ww$=ww$& REPEAT$(" ",6+3*m-LEN(ww$))
         IF t$="Asc" THEN                                ! ascii.dump
            LET ww$=ww$& " ;"""
            FOR i=j TO MIN(j+m-1, LEN(d$))
               IF " "<=d$(i:i) THEN LET ww$=ww$& d$(i:i) ELSE LET ww$=ww$& "."
            NEXT i
            LET ww$=ww$& """"
         ELSE
            IF m=3 THEN LET ww$=ww$& " ;"& STR$(IP(j/3)) ! パレット色番号
            IF j=1 THEN LET ww$=ww$& " ;"& t$            ! comment
         END IF
      END IF
      PRINT ww$ ! 行単位、テキスト画面のピカつき減少、高速。
   NEXT j
END SUB

!-------
SUB picture_block
   PRINT "画像ブロック"
   LET pi$=b1$
   CALL readb( pi$,9)
   CALL dump(pi$(1:1),2,"block label")
   LET Xp0=ORD(pi$(3:3))*256+ORD(pi$(2:2))
   LET Yp0=ORD(pi$(5:5))*256+ORD(pi$(4:4))
   LET Xpw=ORD(pi$(7:7))*256+ORD(pi$(6:6))
   LET Ypw=ORD(pi$(9:9))*256+ORD(pi$(8:8))
   CALL dump(pi$(2:3),2,"picture.X0_position left= "& STR$(Xp0))
   CALL dump(pi$(4:5),2,"picture.Y0_position top= "& STR$(Yp0))
   CALL dump(pi$(6:7),2,"picture.X_width= "& STR$(Xpw))
   CALL dump(pi$(8:9),2,"picture.Y_width= "& STR$(Ypw))
   LET pflg=ORD(pi$(10:10)) ! 画像情報のフラグ
   LET b$=right$("0000000"& BSTR$(pflg,2),8)
   CALL dump(pi$(10:10),2,"flags= "& b$ )
   LET interl=VAL(b$(2:2))
   LET pripal=2^(BVAL(b$(6:8),2)+1)
   PRINT TAB(13);b$(1:1);":private_palette on=1/off=0"
   PRINT TAB(13);b$(2:2);":interlace on=1/off=0, 1~step8 5~step8 3~step4 2~step2"
   PRINT TAB(13);b$(3:3);":sort on=1/off=0 パレットの、重要度 色順ソート"
   PRINT TAB(12);b$(4:5);":blank"
   PRINT TAB(11);b$(6:8);":private_palette colors 2^(";b$(6:8);"b+1)= ";STR$(pripal)
   CALL palette("private_パレット", p_p$, pflg)
   !---
   PRINT "画像データ"
   LET LZW$=""
   CALL readb( LZW$,1)
   CALL dump(LZW$,1,"最小データ・ビット長")
   !--- LZW データ（size:data, size:data, … 0 ）
   CALL blocks(LZW$,16,"",9999) ! (data, byte/行, 注釈, 要求blocks)
   CALL decomp_data
END SUB

SUB palette(n$, p$, pf)
   PRINT n$;
   LET p$=""
   IF IP(pf/128)>0 THEN ! pf AND 0x80
      PRINT
      CALL readb(p$, 3*2^(MOD(pf,8)+1)) ! pf AND 0x07
      CALL dump(p$,3,"R G B")
      CALL palette10(n$, p$, pf)
   ELSE
      LET ww$=" 無し。"
      IF n$(1:1)="p" AND c_p$>"" THEN
         LET ww$=ww$& "→ common_パレット 使用。"
         IF bk_p$(1:1)<>"c" THEN CALL palette10("common", c_p$, sflg)
      END IF
      PRINT ww$
   END IF
END SUB

SUB palette10(n$, p$, pf)
   FOR i=1 TO 3*2^(MOD(pf,8)+1) STEP 3
      LET ncp(IP(i/3))= ORD(p$(i:i))+256*ORD(p$(i+1:i+1))+65536*ORD(p$(i+2:i+2))
   NEXT i
   LET bk_p$=n$
END SUB

SUB error
   beep
   PRINT "File Error Stop"
   STOP
END SUB

!Page-2 へ続く 		 

戻る