/pliant/graphic/image/prototype.pli
 
 1  abstract 
 2    ['ImagePrototype' is defining the API to deal with pixels in a Pliant image.] 
 3   
 4  # Copyright  Hubert Tonneau  hubert.tonneau@pliant.cx 
 5  # 
 6  # This program is free software; you can redistribute it and/or 
 7  # modify it under the terms of the GNU General Public License version 2 
 8  # as published by the Free Software Foundation. 
 9  # 
 10  # This program is distributed in the hope that it will be useful, 
 11  # but WITHOUT ANY WARRANTY; without even the implied warranty of 
 12  # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the 
 13  # GNU General Public License for more details. 
 14  # 
 15  # You should have received a copy of the GNU General Public License 
 16  # version 2 along with this program; if not, write to the Free Software 
 17  # Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA. 
 18   
 19  module "/pliant/language/compiler.pli" 
 20  module "/pliant/graphic/color/gamut.pli" 
 21   
 22  constant optimize true 
 23   
 24   
 25  public 
 26   
 27   
 28  type ImagePrototype 
 29    field Int size_x size_y pixel_size 
 30    field Link:ColorGamut gamut 
 31    field Float x0 y0 x1 y1 
 32    field Str options 
 33   
 34   
 35  method p setup proto options -> status 
 36    oarg_rw ImagePrototype p ; arg ImagePrototype proto ; arg Str options ; arg ExtendedStatus status 
 37    generic 
 38    status := failure "unsupported" 
 39   
 40  method p read x y count adr 
 41    oarg_rw ImagePrototype p ; arg Int count ; arg Address adr 
 42    generic 
 43    error error_id_missing "Not implemented for "+(entry_type addressof:p):name 
 44   
 45  method p write x y count adr 
 46    oarg_rw ImagePrototype p ; arg Int count ; arg Address adr 
 47    generic 
 48    error error_id_missing "Not implemented for "+(entry_type addressof:p):name 
 49   
 50  method p read_map x y mini maxi count -> adr 
 51    oarg_rw ImagePrototype p ; arg Int mini maxi ; arg_w Int count ; arg Address adr 
 52    generic 
 53    count := 0 ; adr := null 
 54   
 55  method p read_unmap x y count adr 
 56    oarg_rw ImagePrototype p ; arg Int count ; arg Address adr 
 57    generic 
 58   
 59  method p write_map x y mini maxi count -> adr 
 60    oarg_rw ImagePrototype p ; arg Int mini maxi ; arg_w Int count ; arg Address adr 
 61    generic 
 62    count := 0 ; adr := null 
 63   
 64  method p write_unmap x y count adr 
 65    oarg_rw ImagePrototype p ; arg Int count ; arg Address adr 
 66    generic 
 67   
 68  method p fill x y count pixel 
 69    oarg_rw ImagePrototype p ; arg Int count ; arg Address pixel 
 70    generic 
 71    check count>and x>=and x+count<=p:size_x and y>=and y<p:size_y 
 72    function fill buf count psize pixel 
 73      arg Address buf ; arg Int count psize ; arg Address pixel 
 74      if optimize and psize=1 
 75        var uInt color := pixel map uInt8 ; color := color+color*2^8 
 76        fill buf count\2 2 addressof:color 
 77        if count%2=1 
 78          buf map uInt8 count-:= pixel map uInt8 
 79      eif optimize and psize=2 
 80        var uInt color := pixel map uInt16 ; color := color+color*2^16 
 81        fill buf count\2 4 addressof:color 
 82        if count%2=1 
 83          buf map uInt16 count-:= pixel map uInt16 
 84      eif optimize and psize=3 
 85        var uInt color := pixel map uInt32 
 86        var Address dest := buf ; var Address stop := dest translate Byte (count-1)*3 
 87        while dest<>stop 
 88          dest map uInt32 := color 
 89          dest := dest translate Byte psize 
 90        memory_copy pixel dest psize 
 91      eif optimize and psize=4 
 92        var uInt color := pixel map uInt32 
 93        var Address dest := buf ; var Address stop := dest translate uInt32 count 
 94        while dest<>stop 
 95          dest map uInt32 := color 
 96          dest := dest translate uInt32 
 97      else 
 98        var Address dest := buf ; var Address stop := dest translate Byte count*psize 
 99        while dest<>stop 
 100          memory_copy pixel dest psize 
 101          dest := dest translate Byte psize 
 102    var Int done := 0 
 103    while done<count 
 104      var Address start := write_map x+done count-done (var Int step) 
 105      if start<>null 
 106        fill start step p:pixel_size pixel 
 107        write_unmap x+done step start 
 108        done += step 
 109      else 
 110        var Address buf := memory_allocate (count-done)*p:pixel_size null 
 111        fill buf count-done p:pixel_size pixel 
 112        write x+done count-done buf 
 113        memory_free buf 
 114        done := count 
 115   
 116   
 117  method p clip x0 y0 x1 y1 
 118    oarg ImagePrototype p ; arg_rw Int x0 y0 x1 y1 
 119    generic 
 120    x0 := max x0 0 
 121    y0 := max y0 0 
 122    x1 := min x1 p:size_x 
 123    y1 := min y1 p:size_y 
 124   
 125   
 126  method p rectangle_read_map x y x0 y0 x1 y1 step_x step_y -> adr 
 127    oarg_rw ImagePrototype p ; arg Int y ; arg_w Int x0 y0 x1 y1 step_x step_y ; arg Address adr 
 128    generic 
 129    adr := read_map p:size_x-x (var Int count) 
 130    if adr<>null 
 131      x0 := x ; y0 := y ; x1 := x+count ; y1 := y+1 
 132      step_x := pixel_size ; step_y := undefined 
 133   
 134  method p rectangle_read_unmap x0 y0 x1 y1 adr 
 135    oarg_rw ImagePrototype p ; arg Int x0 y0 x1 y1 ; arg Address adr 
 136    generic 
 137   
 138   
 139  method p query command -> answer 
 140    oarg_rw ImagePrototype p ; arg Str command answer 
 141    generic 
 142    answer := "" 
 143   
 144  method p configure command -> status 
 145    oarg_rw ImagePrototype p ; arg Str command ; arg ExtendedStatus status 
 146    generic 
 147    status := failure "unkown command" 
 148   
 149   
 150  method p line_size -> ls 
 151    arg ImagePrototype p ; arg Int ls 
 152    ls := p:pixel_size*p:size_x 
 153   
 154   
 155  method p complete 
 156    arg_rw ImagePrototype p 
 157    pixel_size := p:gamut pixel_size 
 158   
 159  function image_prototype x0 y0 x1 y1 size_x size_y gamut -> p 
 160    arg Float x0 y0 x1 y1 ; arg Int size_x size_y ; oarg ColorGamut gamut ; arg ImagePrototype p 
 161    check exists:gamut 
 162    size_x := size_x 
 163    size_y := size_y 
 164    gamut :> gamut 
 165    x0 := x0 
 166    y0 := y0 
 167    x1 := x1 
 168    y1 := y1 
 169    options := "" 
 170    complete 
 171   
 172  constant image_adjust_extend 1001 
 173  constant image_adjust_reduce 1002 
 174  constant image_adjust_resolution 1003 
 175   
 176  function image_prototype x0 y0 x1 y1 rx ry aa_x aa_y adjust gamut -> p 
 177    arg Float x0 y0 x1 y1 rx ry ; arg Int aa_x aa_y adjust ; oarg ColorGamut gamut ; arg ImagePrototype p 
 178    check adjust>=image_adjust_extend and adjust<=image_adjust_resolution 
 179    var Int size_x := (max (cast (abs x1-x0)*(rx/25.4)/aa_x+(shunt adjust=image_adjust_extend 0.5 adjust=image_adjust_reduce -0.5 0) Int) 1)*aa_x 
 180    var Int size_y := (max (cast (abs y1-y0)*(ry/25.4)/aa_y+(shunt adjust=image_adjust_extend 0.5 adjust=image_adjust_reduce -0.5 0) Int) 1)*aa_y 
 181    := image_prototype x0 y0 x0+size_x/(rx/25.4)*((x1-x0)/(abs x1-x0)) y0+size_y/(ry/25.4)*((y1-y0)/(abs y1-y0)) size_x size_y gamut 
 182   
 183  function image_prototype p options -> p2 
 184    arg ImagePrototype p2 ; arg Str options 
 185    var Float margin := options option "margin" Float 0 
 186    var Float x0 := options option "x0" Float p:x0-margin 
 187    var Float y0 := options option "y0" Float p:y0-margin 
 188    var Float x1 := options option "x1" Float p:x1+margin 
 189    var Float y1 := options option "y1" Float p:y1+margin 
 190    var Link:ColorGamut :> gamut 
 191    if g:transparency>and (options option "drop_transparency") 
 192      var Link:ColorGamut g2 :> color_gamut (shunt g:name="rgba" "rgb" (replace g:name "+transparencies" "")) 
 193      if g2=success 
 194        :> g2 
 195    var Int size_x := options option "size_x" Int 
 196    var Int size_y := options option "size_y" Int 
 197    if size_x<>undefined and size_y<>undefined and not (options option "resolution") 
 198      p2 := image_prototype x0 y0 x1 y1 size_x size_y g 
 199    else 
 200      if not ((options (options option_position "resolution" 0) options:len) parse word:"resolution" (var Float dpi_x) (var Float dpi_y) any) 
 201        dpi_x := options option "resolution" Float undefined ; dpi_y := dpi_x 
 202        if dpi_x=undefined and p:size_x<>undefined 
 203          dpi_x := p:size_x/(abs p:x1-p:x0)*25.4 
 204        if dpi_y=undefined and p:size_y<>undefined 
 205          dpi_y := p:size_y/(abs p:y1-p:y0)*25.4 
 206      if not ((options (options option_position "antialiasing" 0) options:len) parse word:"antialiasing" (var Int aa_x) (var Int aa_y) any) 
 207        aa_x := options option "antialiasing" Int 1 ; aa_y := aa_x 
 208      p2 := image_prototype x0 y0 x1 y1 dpi_x dpi_y aa_x aa_y image_adjust_extend g