home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: Graphics / Graphics.zip / gif_info.zip / gif_info.cmd next >
OS/2 REXX Batch file  |  1998-02-03  |  14KB  |  457 lines
  1. /**********************/
  2. /* GIF_INFO is called as:
  3.      stuff=GIF_INFO(gif_file,infotype,imgnum,idmess)
  4.  
  5. Parameters:
  6.   GIF_FILE: A fully qualified file name. If no extension, a .GIF is added.
  7.                  OR
  8.             The contents of a gif_file (say, as read with a
  9.             gif_file=charin(afile,1,chars(afile))
  10.   infotype:   Type of output
  11.   imgnum: modifies the type of output (typically, selects nth image)
  12.   idmess: If specified, then GIF_FILE contains the contents of a gif_File
  13.           with a name of idmess. If not specified, GIF_FILE is a file name.
  14.           In the former case, idmess should have no embedded spaces.
  15.  
  16. For details, see GIF_INFO.TXT.
  17.  
  18. Technical info:  For gif89a specs, please see
  19.                  http://member.aol.com/royalef/gif89a.txt
  20. Author: Daniel Hellerstein danielh@econ.ag.gov
  21.  
  22. */
  23.  
  24. gif_info:
  25. parse  arg afile,atype,aval,idmess
  26. atype=translate(atype)
  27. call init1
  28.  
  29. idmess=translate(idmess,'_',' ')
  30. atype=strip(atype)
  31. dodisp=0
  32. delay=-1
  33.  
  34. atype=left(atype,1)
  35. if atype='' | atype='S' then dodisp=1
  36.  
  37. if idmess<>'' then do   /* afile contains the actual gif file */
  38.    ain=afile
  39.    fqn=idmess
  40.    filesize=length(ain)
  41. end /* do */
  42. else do                 /* afile is the name of the gif file */
  43.   fqn=stream(afile,'c','query exists')
  44.   if fqn='' then do
  45.     if dodisp=1 then say  bold 'No Such File:' normal fqn
  46.     return ''
  47.   end
  48.   filesize=chars(afile)
  49.   ain=charin(fqn,1,filesize)
  50.   oo=stream(afile,'c','close')
  51. end
  52.  
  53. gifver=left(ain,6)
  54.  
  55. if abbrev(translate(gifver),'GIF8')=0 then do
  56.    if dodisp=1 then 
  57.          say reverse " Error. ' normal  afile bold ' is not a GIF file (" normal gifver ')' 
  58.    return  fqn' -1'
  59. end /* do */
  60. if dodisp=1 then 
  61.       say " " cy_ye " Examining:" normal bold||fqn||normal ,
  62.           '(size=' filesize ' bytes), version: 'gifver
  63.  
  64. l1=substr(ain,7,2)
  65. g_width=c2d(reverse(l1))
  66. l2=substr(ain,9,2)
  67. g_height=c2d(reverse(l2))
  68.  
  69. l3=substr(ain,11,1)
  70. ctable0=x2b(c2x(l3))
  71.  
  72. global_color_flag=left(ctable0,1)
  73.  
  74. ct1=right(ctable0,3)
  75. ct1=right(ct1,8,0)
  76. ct1=x2d(b2x(ct1))
  77. numcolors=2**(ct1+1)
  78. if dodisp=1 then say   ">>"bold" Header information." normal
  79.  
  80. if dodisp=1 then 
  81.    say " Global color table: existence flag, #colors " global_color_flag ',' numcolors
  82. if dodisp=1 then
  83.    say " Global width x height " g_width ' x ' g_height
  84.  
  85. iat=13          /* 11 bytes used for intro info */
  86.  
  87. gcolortable=''
  88. if global_color_flag=1 then do
  89.    gcolortable=substr(ain,iat+1,3*numcolors)
  90.    iat=iat+(3*numcolors)  /* iat is the Last byte used */
  91. end
  92.  
  93. desc.1='2c'x ; desc.1.!val='image'
  94. desc.2='21'x ; desc.2.!val='extension'
  95. desc.3='3b'x ; desc.3.!val='trailer'
  96.  
  97. ext.1='f9'x ; ext.1.!val='graphic control'
  98. ext.2='fe'x ; ext.2.!val='comment'
  99. ext.3='01'x ; ext.3.!val='plain text'
  100. ext.4='ff'x ; ext.4.!val='application'
  101.  
  102. nimgs=0
  103. ngcs=0
  104. ncmts=0
  105. napps=0
  106. nptxts=0
  107.  
  108. do forever              /* scan the gif file */
  109.  
  110. if (atype='B' | atype='I' | atype='T') & nimgs=aval then leave /* got the nth image */
  111. if atype='C' & ncmts=aval then leave
  112. if atype='P' & nptxts=aval then leave
  113. if atype='A' & napps=aval then leave
  114.  
  115. /* continue processing */
  116. iat=iat+1       
  117. blockid=substr(ain,iat,1)       /* get next block type */
  118.  
  119. select
  120.  
  121.    when blockid='00'x then do
  122.        if dodisp=1 then say  reverse " Warning: null block id, skipping " normal
  123.        ares=0
  124.    end /* do */
  125.    when blockid=desc.1 then do  /* it's an image */
  126.       nimgs=nimgs+1
  127.       call do_image
  128.       ares=result
  129.    end /* do */
  130.  
  131.    when blockid=desc.2 then  do      /* extension */
  132.        iat=iat+1                /* get extention type */
  133.        extype=substr(ain,iat,1)
  134.        select                  
  135.           when extype=ext.1 then do     /*graphics control */
  136.             ngcs=ngcs+1
  137.             call graphics_control
  138.             ares=result
  139.           end
  140.           when extype=ext.3  then do    /*plain text */
  141.               nptxts=nptxts+1
  142.               call plain_text  
  143.               ares=result
  144.           end /* do */
  145.           when extype=ext.2 then do     /*comment */
  146.              ncmts=ncmts+1
  147.              call is_comment
  148.              ares=result
  149.           end
  150.           when extype=ext.4 then do     /* application */
  151.              napps=napps+1
  152.              call application_block
  153.              ares=result
  154.           end /* do */
  155.  
  156.           otherwise  do
  157.              if dodisp=1 then say reverse " Bad Extension label: " c2x(extype) normal
  158.              RETURN 'ERROR -1'
  159.           end
  160.        end      /* extype select */
  161.    end          /* extention descriptor */
  162.  
  163.    when blockid=desc.3 then do
  164.       if dodisp=1 then say " GIF file terminator found. "
  165.       leave      /* terminator */
  166.    end
  167.    otherwise do
  168.         if dodisp=1 then 
  169.             say reverse "Error in GIF file -- bad  descriptor id " normal '('c2x(blockid)'x)'
  170.         return 'ERROR -2'
  171.    end
  172. end  /* select */
  173.  
  174. if ares<0 then return 'ERROR 'ares
  175.  
  176. end     /* forever */
  177.  
  178. /* -------------  package output for return */
  179. select
  180.    when  atype='' | atype='S' then return 1       /* a display option, noting special to return */
  181.  
  182. /* basic image-file info */
  183.    when atype='B' & (aval=''|aval=0) then do
  184.         nn=global_color_flag*numcolors
  185.         oo=fqn' 'nimgs' 'ncmts' 'napps' 'nptxts' 'g_width' 'g_height' 'nn
  186.         return oo
  187.    end /* do */
  188.  
  189.    when atype='B' then do  /* other "basic */
  190.        if nimgs<>aval then return fqn' -2'
  191.        if datatype(aval)<>'NUM' then return fqn' -2'
  192.        tci=-1
  193.        if ngcs=nimgs then tci=tc_index
  194.        lct=lcl_ct_flag*lcl_ct_size
  195.        oo=fqn' 'lcl_width' 'lcl_height' 'tci' 'delay' 'lcl_interlace' 'lct
  196.        return oo
  197.    end
  198.  
  199.    when atype='I' then do  /* other "basic */
  200.        if datatype(aval)<>'NUM' then return fqn' -2'
  201.        if nimgs<>aval | aval=0 then return fqn' -2'
  202.        tci=-1
  203.        if ngcs=nimgs then tci=tc_index
  204.        lct=lcl_ct_flag*lcl_ct_size
  205.        oo=fqn' 'lcl_width' 'lcl_height' 'tci' 'delay' 'lcl_interlace' 'lct' 'imgsize||','||amess
  206.        return oo
  207.    end
  208.  
  209.    when atype='T' & (aval=0 | aval='') then do  /* other "basic */
  210.        n3=numcolors*3
  211.        oo=fqn' 'n3||','||gcolortable
  212.        return oo
  213.    end
  214.  
  215.    when atype='T' then do  /* other "basic */
  216.        if datatype(aval)<>'NUM' then return fqn' -2'
  217.        if nimgs<>aval | aval=0 then return fqn' -2'
  218.        lct=lcl_ct_flag*lcl_ct_size
  219.        oo=fqn' 'lct||','||acolortable
  220.        return oo
  221.    end
  222.  
  223.    when atype='C' then do  /* other "basic */
  224.        if datatype(aval)<>'NUM' then return fqn' -2'
  225.        if ncmts<>aval | aval=0 then return fqn' -2'
  226.        oo=fqn||' '||csize||','||amess
  227.        return oo
  228.    end
  229.  
  230.    when atype='A' then do  /* other "basic */
  231.        if datatype(aval)<>'NUM' then return fqn' -2'
  232.        if napps<>aval | aval=0 then return fqn' -2'
  233.        oo=fqn' 'app_id','app_auth','appsize','amess
  234.        return oo
  235.    end
  236.  
  237.    when atype='P' then do  /* other "basic */
  238.        if datatype(aval)<>'NUM' then return fqn' -2'
  239.        if nptxts<>aval | aval=0 then return fqn' -2'
  240.        oo=fqn' 'pt_left' 'pt_top' 'pt_width' 'pt_height' 'pt_size||','||amess
  241.        return oo
  242.    end
  243.  
  244.    otherwise return 'ERROR 0'
  245. end
  246.  
  247. return ''
  248.  
  249.  
  250.  
  251. /************/
  252. do_image:
  253. if dodisp=1 then say (1+iat)">> " bold " IMAGE DESCRIPTOR  # " nimgs normal
  254.       l1=substr(ain,iat+1,2)
  255.       lcl_left=c2d(reverse(l1))
  256.       l2=substr(ain,iat+3,2)
  257.       lcl_top=c2d(reverse(l2))
  258.  
  259.       l1=substr(ain,iat+5,2)
  260.       lcl_width=c2d(reverse(l1))
  261.       l2=substr(ain,iat+7,2)
  262.       lcl_height=c2d(reverse(l2))
  263.     
  264.       l3=substr(ain,iat+9,1)
  265.       ctable0=x2b(c2x(l3))
  266.       lcl_ct_flag=left(ctable0,1)
  267.       lcl_interlace=substr(ctable0,2,1)
  268.       t1=right(ctable0,3) ; t1=right(t1,8,0)
  269.       lcl_ct_size=x2d(b2x(t1)) ; lcl_ct_size=2**(lcl_ct_size+1)
  270.  
  271.        if dodisp=1 then say " Image: top,left :" lcl_top ', 'lcl_left
  272.        if dodisp=1 then say " Image: width x height: " lcl_width 'x' lcl_height
  273.        if dodisp=1 then 
  274.            say " Interlace flag, local color table flag, local color table size: " ,
  275.                 lcl_interlace', 'lcl_ct_flag', 'lcl_ct_size
  276.  
  277.        skip=lcl_ct_flag*lcl_ct_size*3
  278.        acolortable=''
  279.        if skip>0 then
  280.           acolortable=substr(ain,iat+10,skip)
  281.  
  282.        iat=iat+9+skip    /* iat is now just before the table based image */
  283.  
  284. /* chew up the data block */
  285.        iat=iat+1        /* skip the lzw bits variable */
  286.        imgsize=chew_data()
  287.        if imgsize<0 then return -6
  288.        if dodisp=1 then if dodisp=1 then say " Image size: " imgsize ' (bytes)'
  289.        return 1 
  290.  
  291.  
  292. /*********/
  293. graphics_control:
  294. if dodisp=1 then say (1+iat)">>" bold " GRAPHICS CONTROL Block # " ngcs normal
  295.        iat=iat+2
  296.        pk=substr(ain,iat,1) ; pk=x2b(c2x(pk))
  297.        tc_flag=right(pk,1)
  298.        iat=iat+1
  299.        tmp=reverse(substr(ain,iat,2)) 
  300.        delay=x2d(c2x(tmp))
  301.        iat=iat+2
  302.        tc_index=x2d(c2x(substr(ain,iat,1)))
  303.        iat=iat+1
  304.        term=x2d(c2x(substr(ain,iat,1)))
  305.        if dodisp=1 then 
  306.            say " Transparent flag, transparent index : " tc_flag ', ' tc_index
  307.        if dodisp=1 then 
  308.              say " Delay (0.01 seconds) : " delay
  309.        if term<>0 then return -8
  310. return 1
  311.  
  312. /*********/
  313. application_block:
  314. if dodisp=1 then say  (1+iat)">>" bold " APPLICATION Extension # "  napps normal
  315. iat=iat+1
  316. app_blocksize=x2d(c2x(substr(ain,iat,1)))
  317. if app_blocksize<>11 then do
  318.     if dodisp=1 then 
  319.           say reverse "Error. Bad block application block size: "app_blocksize normal
  320.     return -3
  321. end /* do */
  322.  
  323. iat=iat+1
  324.  
  325. app_id=substr(ain,iat,8)
  326. iat=iat+8
  327. app_auth=substr(ain,iat,3)
  328. iat=iat+2
  329. appsize=chew_data()
  330. if appsize<0 then return -33
  331.  
  332. if dodisp=1 then say " Application ID: " app_id
  333. if dodisp=1 then say " Application authorization:" app_auth
  334. if dodisp=1 then say " # bytes in application block: " appsize
  335. return 1
  336.  
  337. /***********/
  338. plain_text:
  339. if dodisp=1 then say  (1+iat)">> " bold " PLAIN TEXT Extension # " nptxts normal
  340. iat=iat+1
  341. app_blocksize=x2d(c2x(substr(ain,iat,1)))
  342. if ptextblocksize<>12 then do
  343.     if dodisp=1 then say  reverse "Error. Bad plain text block size: "ptext_blocksize normal
  344.     return -4
  345. end /* do */
  346.  
  347.   l1=substr(ain,iat+1,2)
  348. pt_left=c2d(reverse(l1))
  349.   l2=substr(ain,iat+3,2)
  350. pt_top=c2d(reverse(l2))
  351.  
  352.    l1=substr(ain,iat+5,2)
  353. pt_width=c2d(reverse(l1))
  354.    l2=substr(ain,iat+7,2)
  355. pt_height=c2d(reverse(l2))
  356. if dodisp=1 then say " Text location; Left , top : " pt_left ', 'pt_top 
  357. if dodisp=1 then say " Text size; Width x Height in pixels: " pt_width ' x ' pt_height
  358. iat=iat+4
  359. pt_size=chew_data(1)
  360. if pt_size<0 then return -44
  361. if dodisp=1 then say "# bytes in plain text: " pt_size
  362. if dodisp=1 then say bold " Plain text message: " normal amess
  363. return 1
  364.  
  365. /*********/
  366. is_comment:
  367. if dodisp=1 then say  (iat+1)">>" bold " COMMENT Extension # " ncmts normal
  368. csize=chew_data(1)
  369. if csize<0 then return -7
  370.  
  371. if dodisp=1 then say "Size of comment: " csize
  372. if dodisp=1 then say bold "Comment text: " normal amess
  373. return 1
  374.  
  375. /*********/
  376. chew_data:procedure expose iat ain amess filesize
  377. parse arg keep
  378.        totsize=0
  379.        amess=''
  380.        do forever       /* data blocks */
  381.          if iat>filesize then do
  382.              if dodisp=1 then say "Error. Data overrun (no terminator) "
  383.              return -5
  384.          end /* do */
  385.          iat=iat+1      /* size of block */
  386.          ii=substr(ain,iat,1) ; ii=c2d(ii)
  387.          if ii=0 then do 
  388.              leave
  389.          end /* do */
  390.          iat=iat+1
  391.          if keep<>0 then amess=amess||substr(ain,iat,ii)
  392.          totsize=totsize+ii
  393.          iat=iat+ii-1
  394.        end /* do */
  395.    return totsize
  396.  
  397.  
  398. /*************/
  399. init1:
  400.  
  401. ansion=checkansi()
  402. if ansion=1 then do
  403.   aesc='1B'x
  404.   cy_ye=aesc||'[37;46;m'
  405.   normal=aesc||'[0;m'
  406.   bold=aesc||'[1;m'
  407.   re_wh=aesc||'[31;47;m'
  408.   reverse=aesc||'[7;m'
  409. end
  410. else do
  411.   if dodisp=1 then say " Warning: Could not detect ANSI....  output will look ugly ! "
  412.   cy_ye="" ; normal="" ; bold="" ;re_wh="" ;
  413.   reverse=""
  414. end  /* Do */
  415.  
  416. return 1
  417.  
  418.  /* ------------------------------------------------------------------ */
  419.  /* function: Check if ANSI is activated                               */
  420.  /*                                                                    */
  421.  /* call:     CheckAnsi                                                */
  422.  /*                                                                    */
  423.  /* where:    -                                                        */
  424.  /*                                                                    */
  425.  /* returns:  1 - ANSI support detected                                */
  426.  /*           0 - no ANSI support available                            */
  427.  /*          -1 - error detecting ansi                                 */
  428.  /*                                                                    */
  429.  /* note:     Tested with the German and the US version of OS/2 3.0    */
  430.  /*                                                                    */
  431.  /*                                                                    */
  432.  CheckAnsi: PROCEDURE
  433.    thisRC = -1
  434.  
  435.    trace off
  436.                          /* install a local error handler              */
  437.    SIGNAL ON ERROR Name InitAnsiEnd
  438.  
  439.    "@ANSI 2>NUL | rxqueue 2>NUL"
  440.  
  441.    thisRC = 0
  442.  
  443.    do while queued() <> 0
  444.      queueLine = lineIN( "QUEUE:" )
  445.      if pos( " on.", queueLine ) <> 0 | ,                       /* USA */
  446.         pos( " (ON).", queueLine ) <> 0 then                    /* GER */
  447.        thisRC = 1
  448.    end /* do while queued() <> 0 */
  449.  
  450.  InitAnsiEnd:
  451.  signal off error
  452.  RETURN thisRC
  453.  
  454.  
  455.  
  456.  
  457.