Description of the page content
Forth toolkit to read information from JPEG files.
I wrote this Forth program because I needed to know the width and height of a given image in my program fhp.
\ --------------------------------------------- cr .( fjpg ) \ Copyright (C) 2006,2007,2009,2013,2014 Marcos Cruz (programandala.net) \ Licencia/License/Permesilo: http://programandala.net/license \ Herramientas para leer información de archivos JPEG. \ Info-legiloj por JPEG-dosieroj. \ Tools to read JPEG files information. \ Programa escrito en Forth con Gforth. \ Programo verkita en Fortho per Gforth. \ Program written in Forth with Gforth. \ --------------------------------------------- \ History \ 2014-02-28: Typo fixed in comment. \ 2014-02-24: Copied to Galope in order to improve it and reuse it. \ Typos fixed in comments. '2+' and '2-' changed to '2 +' and '2 -' \ por Gforth. \ 2013-09-25: Changes in the source: no tabs, no spaces at the end of \ lines, no empty lines... ANS Forth removed from the header. Forth \ words are changed to lowercase. \ 2009-02-20: New word: 'jpg-close'. \ 2007-10-19: Bug found and fixed: The x and y are not found in \ pictures taken with a Nikon Coolpix 3100. The reason was that the \ JPEG size header was after the first 16 KiB, the size of the used \ buffer. But my Forth 5mx 'read-file' word had a limitation \ inherited from the OPL command ioread(): it could not read more than \ 16 KiB in a single operation. So i wrote a new OPL procedure to \ call ioread as many times as needed to read the desired lenght. \ Then I increased the JPEG buffer to 64 KiB, what seems enough... \ 'jpg-search2' and 'jpg-search-xy' were written for debugging this. \ 2006-04-03: '.jpg-data' improved: Now you can 'abort' also *before* \ the dumping. 'jpg-dump' modified: Now it doesn't show the data \ bytes out of the headers. \ 2006-04-02: '.jpg-data' improved: Now it asks for confirmation \ *before* the dumping. \ 2006-04-01: 'jpg-xy' fixed: it returned y x insted of x y. \ 2006-03-30: First working version of 'jpg-xy'. \ 2006-03-29: First working version of 'jpg-dump'. \ 2006-03-28: Start. My first goal is to get the width and height of a \ JPEG image file. i need that to improve my program fhp, a Forth \ HTML Preprocessor. \ --------------------------------------------- marker fjpg : 16@ ( c-addr -- n ) \ Fetch litle-endian 16 bits. dup c@ 256 * swap 1+ c@ + ; 65536 constant #jpg-buffer \ must be enough to hold all JPEG headers we will need create jpg-buffer #jpg-buffer allot : jpg-load ( fileid -- ) \ Fill the buffer with the beginning of the a jpeg image file, to make it the current one. [ base @ hex ] jpg-buffer #jpg-buffer 2dup erase rot read-file abort" Read image file error in jpg-load ." drop jpg-buffer @ ffff and d8ff <> abort" Not a JPEG file in jpg-load ." [ base ! ] ; variable jpg-fileid : jpg-open ( c-addr u -- fileid ) \ Open a JPEG image file and make it the current one. [ base @ hex ] r/o bin open-file abort" JPEG image open file error in jpg-open ." dup jpg-fileid ! dup jpg-load [ base ! ] ; : jpg-close ( -- ) \ Close the current JPEG image. jpg-fileid @ close-file abort" JPEG image close file error in jpg-close ." ; : >jpg-data ( c-addr -- c-addr2 u2 ) \ c-addr = address of a JPEG marker \ c-addr2 u2 = data region of the JPEG header dup 4 + swap 2 + 16@ 2 - ; : >jpg-marker ( c-addr -- u ) \ c-addr = address of a JPEG marker \ u = byte offset from c-addr to the next JPEG marker 2 + 16@ 2 + ; : .jpg-data ( c-addr u -- ) \ Dump the data of a JPEG header. cr ." [d]ump? [a]bort? Any other key to continue" cr key case [char] d of cr dump ." [a]bort? Any other key to continue" cr key [char] a = if abort then endof [char] a of abort endof >r 2drop r> \ discard data, savig the case selector endcase ; : .jpg-header ( c-addr -- u ) \ show a jpeg header. \ c-addr = address of a jpeg marker \ u = byte offset from c-addr to the next marker dup >jpg-data 2dup ." , " . ." bytes from " . ." :" .jpg-data >jpg-marker ; : >jpg-xy ( c-addr -- x y ) \ c-addr = address of the proper jpeg marker \ x y = size of the jpeg image 7 + dup 16@ swap 2 - 16@ ; : .jpg-xy ( c-addr -- ) \ show the jpeg image size. \ c-addr = address of the proper jpeg marker >jpg-xy swap ." x=" . ." y=" . ; : jpg-header ( c-addr -- n ) \ identify and show a new jpeg header. \ c-addr = address of the jpeg marker \ u = byte offset to the next marker, or 0 if the marker found was the end of image [ base @ hex ] dup 1+ c@ dup . ." marker: " case \ marker id c0 of ." frame" dup .jpg-xy .jpg-header endof c1 of ." unknown (frame?)" dup .jpg-xy .jpg-header endof \ xxx debug 2007-10-19 c2 of ." unknown (frame?)" dup .jpg-xy .jpg-header endof c3 of ." unknown (frame?)" dup .jpg-xy .jpg-header endof \ xxx debug 2007-10-19 c4 of ." define huffman table" .jpg-header endof \ from e0 to ef are reserved for applications: e0 of ." jfif" .jpg-header endof e1 of ." exim" .jpg-header endof d8 of ." start of image" drop 2 endof d9 of ." end of image" drop 0 endof da of ." start of scan" .jpg-header endof db of ." define quantization" .jpg-header endof fe of ." comment" .jpg-header endof >r \ preserve case selector for endcase ." unknown" .jpg-header r> endcase [ base ! ] ; : jpg-xy ( -- x y ) \ return the size of the current jpeg file. [ base @ hex ] jpg-buffer dup #jpg-buffer + swap 2 + do i 16@ case ffc0 of i >jpg-xy leave endof ffc2 of i >jpg-xy leave endof endcase i >jpg-marker +loop [ base ! ] ; \ debug tools : jpg-dump ( -- ) \ dump the content of the current jpeg image, header after header, until the buffer end. \ this word was written to learn about the jpeg format and write the other words. [ base @ hex ] jpg-buffer dup #jpg-buffer + swap do i dup cr . ." : " dup c@ dup . ff = if jpg-header else \ ." byte out of header: " c@ . 1 drop 1 then dup 0= abort" end of jpeg image in jpg-dump ." +loop [ base ! ] ; 0 value jpg-searched \ byte : jpg-search ( b -- ) \ search a byte in the current jpeg file. \ this word was written to find out where the image width and height are stored. to jpg-searched cr #jpg-buffer jpg-buffer + jpg-buffer do [char] . emit i c@ jpg-searched = if cr jpg-searched . ." found at " i . i 16 - 32 .jpg-data then loop ; 0 value jpg-searched2 \ byte defer jpg-found2 : (jpg-found2) ( c-addr -- ) \ default action after a successful search of two bytes. 32 .jpg-data ; ' (jpg-found2) is jpg-found2 : jpg-search2 ( b1 b2 -- ) \ Search the current JPEG file for two bytes. to jpg-searched2 to jpg-searched cr #jpg-buffer jpg-buffer + jpg-buffer do [char] . emit i c@ jpg-searched = i 1+ c@ jpg-searched2 = and if jpg-found2 then loop ; : jpg-search-xy ( -- ) \ Search and show any possible frame header in the current JPEG file. \ This word was written to find out why the size \ could not be found in pictures taken with a Nikon Coolpix 3100. [ base @ hex ] ' jpg-xy is jpg-found2 ff c0 jpg-searched2 ' (jpg-found2) is jpg-found2 [ base ! ] ; \ --------------------------------------------- \ Testing false [if] : jpg-test ( c-addr u -- ) \ Test an image \ c-addr u = image file jpg-open jpg-dump jpg-close ; : img1 s" c:\tmp\20071001153657_muestra.jpg" ; : img2 s" c:\tmp\alforja-saco\200709261743_alforjas_saco.jpg" ; : img3 s" c:\tmp\alforja-saco\200709261742_alforjas_saco.jpg" ; img1 jpg-test img2 jpg-test img3 jpg-test [then] .( fjpg ok!)