|
|
! GIF ファイルの解析ツール
!-------
OPTION CHARACTER BYTE
!
FILE GETNAME file$, "gif"
IF file$="" THEN
PRINT "入力ファイル名が、ありません。"
STOP
END IF
PRINT "入力ファイル："& file$
!
OPEN #1: NAME file$, ACCESS INPUT
PRINT "---------"
CALL gif_head
DO
CALL blocks_main
LOOP UNTIL b1$=CHR$(BVAL("3B",16))
PRINT "GIF 終端ブロック"
CALL dump(b1$,16,"block label")
PRINT "---------"
CLOSE #1
IF c_p$>"" OR p_p$="" OR im$>"" OR ap$>"" OR co$>"" OR tx$>"" THEN STOP
PRINT "十進BASIC 出力の GIF ファイルのようです。"
!----
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 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 dumpASC(h$(1:6),8) ! GIF識別文字
CALL dump(h$( 7: 8),16,"screen X_width "& STR$(Xsw))
CALL dump(h$( 9:10),16,"screen Y_width "& STR$(Ysw))
CALL dump(h$(11:11),16,"flags "& b$ )
PRINT TAB(12);b$(1:1);":common_palette on=1/off=0"
PRINT TAB(10);b$(2:4);":colors/pixel 2^(";b$(2:4);"b+1)= ";STR$(colpix)
PRINT TAB(12);b$(5:5);":sort on=1/off=0 頻度の色順( outer use)"
PRINT TAB(10);b$(6:8);":common_palette colors 2^(";b$(6:8);"b+1)= ";STR$(compal)
CALL dump(h$(12:12),16,"back_ground color_code")
IF aspect=0 THEN LET b$=".." ELSE LET b$=STR$(aspect)
CALL dump(h$(13:13),16,"アスペクト比 pixel H:V=("& b$& "+15):64 =1:1( 00)" )
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$,16,"イメージコントロール・ブロック")
CALL blocksNP1(im$)
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)
CALL dump(im$(4:4),16,"flags "& b$ )
PRINT TAB(10);b$(1:3);":blank"
PRINT TAB(10);b$(4:6);":"
PRINT TAB(14);"000=none( OR )"
PRINT TAB(14);"001= OR( same as 000)"
PRINT TAB(14);"010=remove all before( paint screen_BG before)"
PRINT TAB(14);"011=remove last picture before"
PRINT TAB(12);b$(7:7);":user click on=1/off=0"
PRINT TAB(12);b$(8:8);":透過GIFの透明色のスイッチ on=1/off=0"
CALL dump(im$(5:6),16,"アニメーションGIFのフレーム表示時間(10ms単位) "& STR$(imtm) )
CALL dump(im$(7:7),16,"透過GIFの透明色 "& STR$(tcol) )
CALL blocks(im$)
ELSEIF w9$=CHR$(BVAL("FE",16)) THEN
LET co$=b1$
CALL dump(co$,16,"コメント・ブロック")
CALL blocksASC(co$,100)
ELSEIF w9$=CHR$(BVAL("FF",16)) THEN
LET ap$=b1$
CALL dump(ap$,16,"アプリケーション・ブロック")
CALL blocksASC(ap$,1)
IF ap$(4:11)="NETSCAPE" THEN
CALL blocksNP1(ap$)
CALL dump(ap$(16:16),16,"constant 1")
LET rept=ORD(ap$(18:18))*256+ORD(ap$(17:17))
CALL dump(ap$(17:18),16,"animation repeat number "& STR$(rept)& " (0=endless)" )
END IF
CALL blocksASC(ap$,100)
ELSEIF w9$=CHR$(BVAL("01",16)) THEN
LET tx$=b1$
CALL dump(tx$,16,"テキスト・イメージ・ブロック")
CALL blocksASC(tx$,100)
ELSE
CALL error
END IF
END SUB
SUB blocksNP1(d$)
CALL readb(d$,1) ! w9$= readb_last_byte ! =block Size
CALL dump(w9$,16,"block size")
IF w9$=CHR$(0) THEN EXIT SUB ! block End
CALL readb(d$,ORD(w9$)) ! block data
END SUB
SUB blocks(d$)
DO
CALL readb(d$,1) ! w9$= readb_last_byte ! =block Size
CALL dump(w9$,16,"block size")
IF w9$=CHR$(0) THEN EXIT SUB ! block End
LET s=LEN(d$)
CALL readb(d$,ORD(w9$)) ! block data
CALL dump(d$(s+1:LEN(d$)),16,"")
LOOP
END SUB
SUB blocksASC(d$,n) !n=ブロック数の上限
FOR n=1 TO n
CALL readb(d$,1) ! w9$= readb_last_byte ! =block Size
CALL dump(w9$,16,"block size")
IF w9$=CHR$(0) THEN EXIT SUB ! block End
LET s=LEN(d$)
CALL readb(d$,ORD(w9$)) ! block data
CALL dumpASC(d$(s+1:LEN(d$)),8)
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 picture_block
PRINT "画像ブロック"
LET pi$=b1$
CALL readb( pi$,9) ! w9$= readb_last_byte
CALL dump(pi$(1:1),16,"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),16,"picture.X0_position left "& STR$(Xp0))
CALL dump(pi$(4:5),16,"picture.Y0_position top "& STR$(Yp0))
CALL dump(pi$(6:7),16,"picture.X_width "& STR$(Xpw))
CALL dump(pi$(8:9),16,"picture.Y_width "& STR$(Ypw))
LET pflg=ORD(pi$(10:10)) ! 画像情報のフラグ
LET b$=right$("0000000"& BSTR$(pflg,2),8)
LET pripal=2^(BVAL(b$(6:8),2)+1)
CALL dump(pi$(10:10),16,"flags "& b$ )
PRINT TAB(12);b$(1:1);":private_palette on=1/off=0"
PRINT TAB(12);b$(2:2);":interrace on=1/off=0, 1~step8 5~step8 3~step4 2~step2"
PRINT TAB(12);b$(3:3);":sort on=1/off=0 頻度の色順( outer use)"
PRINT TAB(11);b$(4:5);":blank"
PRINT TAB(10);b$(6:8);":private_palette colors 2^(";b$(6:8);"b+1)= ";STR$(pripal)
CALL palette("private_パレット", p_p$, pflg)
!---
PRINT "画像データ"
LET pda$=""
CALL readb( pda$,1)
CALL dump(pda$,16,"最小データ・ビット長")
!--- LZW データ（size:data, size:data, … 0 ）
CALL blocks(pda$)
END SUB
SUB palette(n$, p$, pf)
PRINT n$;
LET p$=""
IF INT(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")
ELSE
PRINT "は、有りません。"
END IF
END SUB
SUB error
beep
PRINT "File Error Stop"
STOP
END SUB
!-------
FUNCTION bitand8(a,b)
LET b9$="00000000"
LET b8$=right$("0000000"& BSTR$(a,2),8)
LET b7$=right$("0000000"& BSTR$(b,2),8)
FOR b9=1 TO 8
IF b8$(b9:b9)="1" AND b7$(b9:b9)="1" THEN LET b9$(b9:b9)="1"
NEXT b9
LET bitand8=BVAL(b9$,2)
END FUNCTION
FUNCTION bitor8(a,b)
LET b9$="00000000"
LET b8$=right$("0000000"& BSTR$(a,2),8)
LET b7$=right$("0000000"& BSTR$(b,2),8)
FOR b9=1 TO 8
IF b8$(b9:b9)="1" OR b7$(b9:b9)="1" THEN LET b9$(b9:b9)="1"
NEXT b9
LET bitor8=BVAL(b9$,2)
END FUNCTION
!-------
SUB dump(d$,m,t$)
FOR j=1 TO LEN(d$) STEP m
LET ww$=right$("000"& BSTR$(adr,16),4)& " "
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$>"" AND j<=m THEN LET ww$=ww$& " ;"& t$
PRINT ww$ !行単位、テキスト画面のピカつき減少、高速。
NEXT j
END SUB
SUB dumpASC(d$,m)
FOR j=1 TO LEN(d$) STEP m
LET ww$=right$("000"& BSTR$(adr,16),4)& " "
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
LET ww$=ww$& REPEAT$(" ",3*m+6-LEN(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$& """"
PRINT ww$
NEXT j
END SUB
END
|
|