/pliant/graphic/filter/ppm.pli
 
 1  abstract 
 2    [The popular among free softwares PPM file format interface.] ; eol 
 3    [PPM is not recommended because the header (3 lines) is sadely designed ] 
 4    [(it should be any nomber of lines, followed by a blank line), but it's ] 
 5    [still a trivial file format that you may need in order to pipe an image ] 
 6    [to another software.] 
 7   
 8  # Copyright  Hubert Tonneau  hubert.tonneau@pliant.cx 
 9  # 
 10  # This program is free software; you can redistribute it and/or 
 11  # modify it under the terms of the GNU General Public License version 2 
 12  # as published by the Free Software Foundation. 
 13  # 
 14  # This program is distributed in the hope that it will be useful, 
 15  # but WITHOUT ANY WARRANTY; without even the implied warranty of 
 16  # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the 
 17  # GNU General Public License for more details. 
 18  # 
 19  # You should have received a copy of the GNU General Public License 
 20  # version 2 along with this program; if not, write to the Free Software 
 21  # Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA. 
 22   
 23   
 24  module "/pliant/language/compiler.pli" 
 25  module "/pliant/language/stream.pli" 
 26  module "prototype.pli" 
 27  module "/pliant/graphic/color/gamut.pli" 
 28  module "/pliant/graphic/misc/bytes.pli" 
 29   
 30   
 31  type ImageReadFilterPpm 
 32    field Pointer:Stream stream 
 33    field Int line_size 
 34    field CBool negative 
 35    field Address buffer 
 36   
 37  ImageReadFilter maybe ImageReadFilterPpm 
 38   
 39   
 40  method f open stream options h -> status 
 41    arg_rw ImageReadFilterPpm f ; arg_rw Stream stream ; arg Str options ; arg_w ImagePrototype h ; arg ExtendedStatus status 
 42    stream :> stream 
 43    var Str mode := stream readline ; var Str gamut_name ; var Int pixel_size 
 44    if mode="P6" 
 45      gamut_name := "rgb" ; pixel_size := 3 
 46    eif mode="P5" 
 47      gamut_name := "grey" ; pixel_size := 1 
 48    else 
 49      return (failure "This is not a ppmraw or pgmraw image ("+(mode 0 16)+")") 
 50    stream readline # comment 
 51    if not (stream:readline parse (var Int size_x) (var Int size_y)) 
 52      return failure:"Invalid image header" 
 53    stream readline # maximal value 
 54    var Float rx ry 
 55    if ((options (options option_position "resolution" options:len) options:len) parse word:"resolution" rx ry any) 
 56      void 
 57    eif ((options (options option_position "resolution" options:len) options:len) parse word:"resolution" rx any) 
 58      ry := rx 
 59    else 
 60      rx := 72 ; ry := 72 
 61    := image_prototype 0 0 size_x/rx*25.4 size_y/ry*25.4 size_x size_y color_gamut:gamut_name 
 62    line_size := line_size 
 63    negative := options option "negative" 
 64    if f:negative 
 65      buffer := memory_allocate f:line_size addressof:f 
 66    status := success 
 67   
 68  method f readline adr -> status 
 69    arg_rw ImageReadFilterPpm f ; arg Address adr ; arg Status status 
 70    if f:negative 
 71      f:stream raw_read f:buffer f:line_size 
 72      bytes_copy_255minus f:buffer adr f:line_size 
 73    else 
 74      f:stream raw_read adr f:line_size 
 75    status := success 
 76   
 77  method f close -> status 
 78    arg_rw ImageReadFilterPpm f ; arg ExtendedStatus status 
 79    if f:negative 
 80      memory_free f:buffer 
 81    status := success 
 82   
 83   
 84 
 
 85   
 86   
 87  type ImageWriteFilterPpm 
 88    field Pointer:Stream stream 
 89    field Int line_size 
 90    field CBool negative 
 91    field Address buffer 
 92   
 93  ImageWriteFilter maybe ImageWriteFilterPpm 
 94   
 95   
 96  method f open stream options h -> status 
 97    arg_rw ImageWriteFilterPpm f ; arg_rw Stream stream ; arg Str options ; arg ImagePrototype h ; arg ExtendedStatus status 
 98    if h:gamut:name<>"rgb" and h:gamut:pixel_size<>1 
 99      return failure:"Only RGB or grey images can be saved as .ppm or .pgm" 
 100    stream :> stream 
 101    line_size := line_size 
 102    negative := options option "negative" 
 103    if f:negative 
 104      buffer := memory_allocate f:line_size addressof:f 
 105    stream writeline (shunt h:gamut:pixel_size="P5" "P6") 
 106    stream writeline "# Pliant GhostScript postprocessor" 
 107    stream writeline (string h:size_x)+" "+(string h:size_y) 
 108    stream writeline "255" 
 109    status := success 
 110   
 111  method f writeline adr -> status 
 112    arg_rw ImageWriteFilterPpm f ; arg Address adr ; arg Status status 
 113    if f:negative 
 114      bytes_copy_255minus adr f:buffer f:line_size 
 115      f:stream raw_write f:buffer f:line_size 
 116    else 
 117      f:stream raw_write adr f:line_size 
 118    status := success 
 119   
 120  method f close -> status 
 121    arg_rw ImageWriteFilterPpm f ; arg ExtendedStatus status 
 122    if f:negative 
 123      memory_free f:buffer 
 124    status := success 
 125   
 126  image_record_filters ".ppm" ImageReadFilterPpm false ImageWriteFilterPpm false 
 127  image_record_filters ".pgm" ImageReadFilterPpm false ImageWriteFilterPpm false 
 128   
 129