/* simple IFF chunk-dump program */

ENUM ER_NONE, ER_FILE, ER_MEM, ER_USAGE, ER_BREAK, ER_FILETYPE, ER_CORRUPT

OBJECT bmhd
  w:INT,h:INT,x:INT,y:INT
  planes:CHAR
  masking:CHAR
  compression:CHAR
  transcolour:INT
  xaspect:CHAR,yaspect:CHAR
  pagew:INT,pageh:INT
ENDOBJECT

OBJECT dbhd
  firstindex:INT
  recordsize:INT
ENDOBJECT

DEF flen,o:PTR TO LONG,mem,handle=NIL,chunkid,ifftype,size,off=-1

PROC main()
  WriteF('ShowChunk v0.1 (c) 1992 $#%!\n')
  IF StrCmp(arg,'',1) OR StrCmp(arg,'?',2)
    error(ER_USAGE)
  ELSE
    flen:=FileLength(arg)
    handle:=Open(arg,1005)
    IF (flen<1) OR (handle=NIL)
      error(ER_FILE)
    ELSE
      IF (mem:=New(flen))=NIL
        error(ER_MEM)
      ELSE
        IF Read(handle,mem,flen)<>flen THEN error(ER_FILE) ELSE process()
      ENDIF
    ENDIF
  ENDIF
  error(ER_NONE)
ENDPROC

PROC process()
  DEF end
  o:=mem
  end:=o+flen
  IF (o[]++<>"FORM") THEN error(ER_FILETYPE)
  IF flen-8<>o[]++ THEN error(ER_CORRUPT)
  WriteF('IFF Chunk layout of file "\s" (\d bytes)\n\n',arg,flen)
  form(end)
ENDPROC

PROC form(end)
  DEF itype
  INC off
  itype:=ifftype
  sp(); writetype(); WriteF('\n')
  WHILE o<end
    IF CtrlC() THEN error(ER_BREAK)
    chunkid:=o[]++
    size:=o[]++
    legal({chunkid})
    sp(); WriteF('"\s[4]" (\d[7] bytes) ',{chunkid},size)
    SELECT ifftype
      CASE "ILBM"
        SELECT chunkid
          CASE "BMHD"; WriteF('Bitmapheader\n'); showbmhd()
          CASE "CMAP"; WriteF('Colourmap\n')
          CASE "CAMG"; WriteF('Amiga specific graphic mode\n')
          CASE "BODY"; WriteF('Bitmap data\n')
          CASE "CRNG"; WriteF('Colour range\n')
          CASE "CCRT"; WriteF('Colour cycling and timing\n')
          CASE "GRAB"; WriteF('Grab position of brush\n')
          CASE "DEST"; WriteF('Destination bitplanes\n')
          CASE "SPRT"; WriteF('Sprite definition\n')
          CASE "GRAB"; WriteF('Grab position of brush\n')
          CASE "DPAN"; WriteF('DpaintAnim infos\n')
          CASE "DPPS"; WriteF('Dpaint\n')
          CASE "ANHD"; WriteF('Animation header\n')
          CASE "DLTA"; WriteF('Delta\n')
          CASE "PTXT"; WriteF('Picture text\n')
          CASE "ATXT"; WriteF('Anim text\n')
          CASE "ANFR"; WriteF('Anim frame\n')
          CASE "MAHD"; WriteF('Multiple anim header (?)\n')
          CASE "MFHD"; WriteF('Multiple frame header (?)\n')
          CASE "CM16"; WriteF('Colourmap 16\n')
          CASE "SHAK"; WriteF('Shakespeare chunk (?)\n')
          CASE "FORM"; WriteF('Embedded IFF in anim: \n\n'); form(o+size); WriteF('\n')
          DEFAULT; errorid()
        ENDSELECT
      CASE "ANIM"
        errorid()
      CASE "8SVX"
        SELECT chunkid
          CASE "VHDR"; WriteF('Voice Header\n')
          CASE "(c) "; WriteF('Copyright notice: '); pstr();
          CASE "AUTH"; WriteF('Owner of the digitizer: '); pstr();
          CASE "ANNO"; WriteF('Annotations: '); pstr()
          CASE "ATAK"; WriteF('Attack\n')
          CASE "RLSE"; WriteF('Release\n')
          CASE "BODY"; WriteF('Sample data\n')
          CASE "NAME"; WriteF('Title of sample: '); pstr()
          DEFAULT; errorid()
        ENDSELECT
      CASE "SMUS"
        SELECT chunkid
          CASE "SHDR"; WriteF('Score Header\n')
          CASE "(c) "; WriteF('Copyright notice: '); pstr()
          CASE "AUTH"; WriteF('Author of the score: '); pstr()
          CASE "ANNO"; WriteF('Annotations: '); pstr()
          CASE "INS1"; WriteF('Instrument definition\n')
          CASE "TRAK"; WriteF('The actual score\n')
          CASE "IREV"; WriteF('Huh?\n')
          CASE "NAME"; WriteF('Title of score: '); pstr()
          CASE "SNX1"; WriteF('Sonix data\n')
          DEFAULT; errorid()
        ENDSELECT
      CASE "FTXT"
        SELECT chunkid
          CASE "FONS"; WriteF('Font definition\n')
          CASE "CHRS"; WriteF('Text characters\n')
          DEFAULT; errorid()
        ENDSELECT
      CASE "PREF"
        SELECT chunkid
          CASE "PRHD"; WriteF('Prefs header\n')
          CASE "FONT"; WriteF('Font prefs\n')
          CASE "INPT"; WriteF('Input prefs\n')
          DEFAULT; errorid()
        ENDSELECT
      CASE "MDBI"
        SELECT chunkid
          CASE "STRG"; WriteF('Strings\n'); dbstrings()
          CASE "TYPE"; WriteF('Type infos of idents/funcs etc.\n'); dbtype()
          CASE "ILST"; WriteF('Object infos\n')
          CASE "ENUM"; WriteF('Enum ascii equivalents\n')
          CASE "SCOP"; WriteF('Scope infos\n')
          CASE "HUNK"; WriteF('Hunk infos\n')
          CASE "SRCS"; WriteF('Source filename\n')
          CASE "POSN"; WriteF('Code to source pointers\n')
          DEFAULT; errorid()
        ENDSELECT
      CASE "GXUI"; gtbchunks()
      CASE "GXWD"; gtbchunks()
      CASE "GXGA"; gtbchunks()
      CASE "GXBX"; gtbchunks()
      CASE "GXTX"; gtbchunks()
      CASE "GXMN"; gtbchunks()
      DEFAULT; errorid()
    ENDSELECT
    o:=o+size
    IF o AND 1 THEN INC o
  ENDWHILE
  size:=0
  ifftype:=itype
  DEC off
ENDPROC

PROC writetype()
  DEF type
  type:=o[]++
  legal({type})
  WriteF('Type: ')
  ifftype:=IF type="ANIM" THEN "ILBM" ELSE type
  SELECT type
    CASE "ILBM"; WriteF('Interleaved bitmap\n')
    CASE "FTXT"; WriteF('Formatted text\n')
    CASE "8SVX"; WriteF('8 bit sound sample\n')
    CASE "ANIM"; WriteF('Animation\n')
    CASE "SMUS"; WriteF('Music score\n')
    CASE "PREF"; WriteF('OS 2.0 prefs file\n')
    CASE "MDBI"; WriteF('Maxon Sourcelevel Debugger file\n')
    CASE "GXUI"; WriteF('GadToolsBox GUI file\n')
    CASE "GXWD"; WriteF('GadToolsBox Window file\n')
    CASE "GXGA"; WriteF('GadToolsBox Gadget file\n')
    CASE "GXBX"; WriteF('GadToolsBox BevelBox file\n')
    CASE "GXTX"; WriteF('GadToolsBox Text file\n')
    CASE "GXMN"; WriteF('GadToolsBox Menu file\n')
    DEFAULT
      chunkid:=type
      errorid()
  ENDSELECT
ENDPROC type

PROC dbstrings()
  DEF h:PTR TO dbhd,s,i,c,a
  h:=o; s:=o+4
  i:=h.firstindex
  c:=h.recordsize /* numentries in this case */
  IF c>0
    FOR a:=1 TO c
      sp(); WriteF('  string #\d="\s"\n',i++,s)
      WHILE s[]++ DO NOP
    ENDFOR
  ENDIF
ENDPROC

PROC dbtype()
  DEF h:PTR TO dbhd,s,i,c,csize,t
  h:=o; s:=o+4; csize:=size-4
  i:=h.firstindex
  c:=h.recordsize
  WHILE csize>0
    t:=s[]
    sp(); WriteF('  type #\d=\d\n',i++,t)
    csize:=csize-c
  ENDWHILE
ENDPROC

PROC showbmhd()
  DEF b:PTR TO bmhd
  b:=o; WriteF('\n')
  sp(); WriteF('Width,Height=(\d,\d)\n',b.w,b.h)
  sp(); WriteF('ScreenWidth,ScreenHeight=(\d,\d)\n',b.pagew,b.pageh)
  sp(); WriteF('Planes=\d\n',b.planes)
  sp(); WriteF('Xaspect,Yaspect=(\d,\d)\n',b.xaspect,b.yaspect)
  sp(); WriteF('Compression=')
  IF b.compression THEN WriteF('ON\n') ELSE WriteF('OFF\n')
  sp(); WriteF('Transparant colour=\d\n\n',b.transcolour)
ENDPROC

PROC legal(id:PTR TO CHAR)              /* call by reference */
  DEF a
  FOR a:=0 TO 3 DO IF (id[a]<32) OR (id[a]>126) THEN id[a]:="."
ENDPROC

PROC pstr()
  sp(); WriteF('"')
  Write(stdout,o,size)
  WriteF('"\n')
ENDPROC

PROC error(nr)
  IF handle THEN Close(handle)
  WriteF('\n')
  SELECT nr
    CASE ER_FILE;     WriteF('Could not read file "\s" !\n',arg)
    CASE ER_MEM;      WriteF('No memory for chunks!\n')
    CASE ER_USAGE;    WriteF('USAGE: showchunk <ifffile>\n')
    CASE ER_BREAK;    WriteF('** BREAK: ShowChunk\n')
    CASE ER_FILETYPE; WriteF('Not an IFF file.\n')
    CASE ER_CORRUPT;  WriteF('IFF file format corrupt.\n')
  ENDSELECT
  IF nr=ER_USAGE
    WriteF('recognized chunks:\n\n')
    WriteF('ILBM,ANIM Picture and Animation format\n')
    WriteF('- BMHD CMAP CAMG BODY CRNG CCRT GRAB DEST SPRT\n')
    WriteF('  GRAB DPAN DPPS PTXT ATXT ANFR MAHD MFHD CM16\n')
    WriteF('  SHAK ANHD DLTA\n\n')
    WriteF('8SVX Samples\n')
    WriteF('- VHDR NAME AUTH ANNO ATAK RLSE BODY (c)\n\n')
    WriteF('SMUS Score files\n')
    WriteF('- SHDR NAME AUTH ANNO INS1 TRAK IREV SNX1 (c)\n\n')
    WriteF('FTXT Text\n')
    WriteF('- FONT CHRS\n\n')
    WriteF('PREF 2.0 Preferences\n')
    WriteF('- PRHD FONT INPT\n\n')
    WriteF('MDBI Maxon SDB\n')
    WriteF('- STRG TYPE ILST ENUM SCOP HUNK SRCS POSN\n\n')
    WriteF('GXUI,GXMN,GXTX,GXBX,GXGA,GXWD GadToolsBox GUI\n')
    WriteF('- MEDA ITXT BBOX GADA WDDA GGUI VERS\n')
    WriteF('\n')
  ENDIF
  CleanUp(0)
ENDPROC

PROC errorid()
  WriteF('Unknown chunk id: "\s[4]" !\n',{chunkid})
ENDPROC

PROC sp()
  DEF a
  IF off>0 THEN FOR a:=1 TO off DO WriteF('\t')
ENDPROC

PROC gtbchunks()
  SELECT chunkid
    CASE "MEDA"; WriteF('Menu Data\n')
    CASE "ITXT"; WriteF('Intuitext\n')
    CASE "BBOX"; WriteF('BevelBox\n')
    CASE "GADA"; WriteF('Gadget\n')
    CASE "WDDA"; WriteF('Window\n')
    CASE "GGUI"; WriteF('GUI definition\n')
    CASE "VERS"; WriteF('Future version extension\n')
    CASE "FORM"; WriteF('Embedded IFF in file:\n\n'); form(size+o); WriteF('\n')
    DEFAULT; errorid()
  ENDSELECT
ENDPROC