/pliant/graphic/filter/gimpprint.pli
 
 1  abstract 
 2    [Gimp-print (free color inkjet printers driver) interface] 
 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   
 20  module "/pliant/language/unsafe.pli" 
 21  module "/pliant/language/context.pli" 
 22  module "/pliant/language/compiler.pli" 
 23  module "/pliant/language/os.pli" 
 24  module "/pliant/language/stream.pli" 
 25  module "prototype.pli" 
 26  module "/pliant/graphic/color/gamut.pli" 
 27   
 28  if (constant (file_query "file:/lib/libgimpprint.so" standard)=defined) 
 29    constant gp_dll "/lib/libgimpprint.so" 
 30  eif (constant (file_query "file:/lib/libgimpprint.so.1" standard)=defined) 
 31    constant gp_dll "/lib/libgimpprint.so.1" 
 32  eif (constant (file_query "file:/usr/lib/libgimpprint.so.1" standard)=defined) 
 33    constant gp_dll "/usr/lib/libgimpprint.so.1" 
 34  else 
 35    constant gp_dll "libgimpprint.so" 
 36  constant trace false 
 37  constant debug false 
 38   
 39   
 40 
 
 41   
 42   
 43  function stp_init 
 44    external gp_dll "stp_init" 
 45  if debug 
 46    console "  Gimp-print stp_init is at " (cast the_function:stp_init:executable Int) eol 
 47   
 48  function stp_get_printer_by_driver driver -> printer 
 49    arg CStr driver ; arg Address printer 
 50    external gp_dll "stp_get_printer_by_driver" 
 51   
 52  function stp_printer_get_printvars printer -> vars 
 53    arg Address printer ; arg Address vars 
 54    external gp_dll "stp_printer_get_printvars" 
 55   
 56  function stp_allocate_copy vars -> newvars 
 57    arg Address vars newvars 
 58    external gp_dll "stp_allocate_copy" 
 59   
 60  function stp_merge_printvars vars printer 
 61    arg Address vars printer 
 62    external gp_dll "stp_merge_printvars" 
 63   
 64  function stp_free_vars vars 
 65    arg Address vars 
 66    external gp_dll "stp_free_vars" 
 67   
 68   
 69  function stp_set_page_width vars val 
 70    arg Address vars ; arg Int val 
 71    external gp_dll "stp_set_page_width" 
 72   
 73  function stp_set_page_height vars val 
 74    arg Address vars ; arg Int val 
 75    external gp_dll "stp_set_page_height" 
 76   
 77  constant ORIENT_PORTRAIT 0 
 78   
 79  function stp_set_orientation vars val 
 80    arg Address vars ; arg Int val 
 81    external gp_dll "stp_set_orientation" 
 82   
 83  function stp_set_left vars val 
 84    arg Address vars ; arg Int val 
 85    external gp_dll "stp_set_left" 
 86   
 87  function stp_set_top vars val 
 88    arg Address vars ; arg Int val 
 89    external gp_dll "stp_set_top" 
 90   
 91   
 92  function stp_set_media_type vars val 
 93    arg Address vars ; arg CStr val 
 94    external gp_dll "stp_set_media_type" 
 95   
 96  function stp_set_media_source vars val 
 97    arg Address vars ; arg CStr val 
 98    external gp_dll "stp_set_media_source" 
 99   
 100  function stp_set_ink_type vars val 
 101    arg Address vars ; arg CStr val 
 102    external gp_dll "stp_set_ink_type" 
 103   
 104  function stp_set_resolution vars val 
 105    arg Address vars ; arg CStr val 
 106    external gp_dll "stp_set_resolution" 
 107   
 108  function stp_set_scaling vars f 
 109    arg Address vars ; arg Int f 
 110    external gp_dll "stp_set_scaling" 
 111   
 112   
 113  function stp_set_dither_algorithm vars val 
 114    arg Address vars ; arg CStr val 
 115    external gp_dll "stp_set_dither_algorithm" 
 116   
 117  constant OUTPUT_COLOR 1 
 118  constant OUTPUT_RAW_CMYK  3 
 119   
 120  function stp_set_output_type vars val 
 121    arg Address vars ; arg Int val 
 122    external gp_dll "stp_set_output_type" 
 123   
 124  constant IMAGE_CONTINUOUS 2 
 125   
 126  function stp_set_image_type vars val 
 127    arg Address vars ; arg Int val 
 128    external gp_dll "stp_set_image_type" 
 129   
 130  function stp_set_brightness vars f 
 131    arg Address vars ; arg Int f 
 132    external gp_dll "stp_set_brightness" 
 133   
 134  function stp_set_contrast vars f 
 135    arg Address vars ; arg Int f 
 136    external gp_dll "stp_set_contrast" 
 137   
 138  function stp_set_cyan vars f 
 139    arg Address vars ; arg Int f 
 140    external gp_dll "stp_set_cyan" 
 141   
 142  function stp_set_magenta vars f 
 143    arg Address vars ; arg Int f 
 144    external gp_dll "stp_set_magenta" 
 145   
 146  function stp_set_yellow vars f 
 147    arg Address vars ; arg Int f 
 148    external gp_dll "stp_set_yellow" 
 149   
 150  function stp_set_saturation vars f 
 151    arg Address vars ; arg Int f 
 152    external gp_dll "stp_set_saturation" 
 153   
 154  function stp_set_density vars f 
 155    arg Address vars ; arg Int f 
 156    external gp_dll "stp_set_density" 
 157   
 158  function stp_set_gamma vars f 
 159    arg Address vars ; arg Int f 
 160    external gp_dll "stp_set_gamma" 
 161   
 162  function stp_set_app_gamma vars f 
 163    arg Address vars ; arg Int f 
 164    external gp_dll "stp_set_app_gamma" 
 165   
 166   
 167  function stp_set_outfunc vars func 
 168    arg Address vars func 
 169    external gp_dll "stp_set_outfunc" 
 170   
 171  function stp_set_outdata vars file 
 172    arg Address vars file 
 173    external gp_dll "stp_set_outdata" 
 174   
 175  function stp_set_errfunc vars func 
 176    arg Address vars func 
 177    external gp_dll "stp_set_errfunc" 
 178   
 179  function stp_set_errdata vars file 
 180    arg Address vars file 
 181    external gp_dll "stp_set_errdata" 
 182   
 183   
 184  type stp_image 
 185    field Address init 
 186    field Address reset 
 187    field Address transpose 
 188    field Address hflip 
 189    field Address vflip 
 190    field Address crop 
 191    field Address rotate_ccw 
 192    field Address rotate_cw 
 193    field Address rotate_180 
 194    field Address bpp 
 195    field Address width 
 196    field Address height 
 197    field Address get_row 
 198    field Address get_appname 
 199    field Address progress_init 
 200    field Address note_progress 
 201    field Address progress_conclude 
 202    field Address notused 
 203    field Int size_x size_y 
 204    field Array:Address lines ; field Int line_size line_count 
 205    field Int line_drop 
 206    field CBool cmyk 
 207    field (Array uInt16 256) cmyk_table 
 208    field Float noise <- 0 
 209   
 210   
 211  type stp_printfuncs 
 212    field Address parameters 
 213    field Address media_size 
 214    field Address imageable_area 
 215    field Address limit 
 216    field Address print 
 217    field Address default_parameters 
 218    field Address describe_resolution 
 219    field Address verify 
 220   
 221  function stp_printer_get_printfuncs printer -> funcs 
 222    arg Address printer ; arg_R stp_printfuncs funcs 
 223    external gp_dll "stp_printer_get_printfuncs" 
 224   
 225  function verify_prototype printer vars f -> ok 
 226    arg Address printer vars ; arg Function f ; arg Function f ; arg CBool ok 
 227    external_calling_convention 
 228    indirect 
 229   
 230  function print_prototype printer image vars f 
 231    arg Address printer ; arg stp_image image ; arg Address vars ; arg Function f 
 232    external_calling_convention 
 233    indirect 
 234   
 235   
 236 
 
 237   
 238   
 239  function image_do_nothing image  
 240    arg stp_image image 
 241    external_calling_convention 
 242   
 243  function image_bpp image -> bpp 
 244    arg stp_image image ; arg Int bpp 
 245    external_calling_convention 
 246    bpp := shunt image:cmyk 8 3 # bytes per pixel 
 247    
 248  function image_width image -> size_x 
 249    arg stp_image image ; arg Int size_x 
 250    external_calling_convention 
 251    size_x := image size_x 
 252   
 253  function image_height image -> size_y 
 254    arg stp_image image ; arg Int size_y 
 255    external_calling_convention 
 256    size_y := image size_y 
 257   
 258  function image_get_row image data y -> err 
 259    arg_rw stp_image image ; arg Address data ; arg Int y ; arg Int err 
 260    external_calling_convention 
 261    check y>=image:line_drop 
 262    while image:line_drop<y 
 263      while (image:lines image:line_drop)=null 
 264        os_yield 
 265      memory_free (image:lines image:line_drop) 
 266      atomic_add image:line_count -1 
 267      image line_drop += 1 
 268    while image:lines:y=null 
 269      os_yield 
 270    if image:cmyk 
 271      var Address src := image:lines y ; var Address stop := src translate Byte image:line_size 
 272      var Address dest := data 
 273      var Pointer:(Array uInt16 256) table :> image cmyk_table 
 274      while src<>stop 
 275        var Int l := src map uInt8 
 276        if image:noise<>0 
 277          memory_random addressof:(var Int r) Int:size 
 278          l += r % (max (cast (min l 255-l)*image:noise Int) 1) 
 279        dest map uInt16 := table l 
 280        src := src translate uInt8 1 ; dest := dest translate uInt16 1 
 281    else 
 282      memory_copy image:lines:y data image:line_size 
 283    err := 0 
 284   
 285  function image_get_appname image -> name 
 286    arg stp_image image ; arg Address name 
 287    external_calling_convention 
 288    name := "Pliant[0]" characters 
 289   
 290  function image_progress_init image 
 291    arg stp_image image 
 292    external_calling_convention 
 293    if trace 
 294      console "(" 
 295   
 296  function image_note_progress image f1 f2 
 297    arg stp_image image ; arg Int f1 f2 
 298    external_calling_convention 
 299    if trace 
 300      console "." 
 301   
 302  function image_progress_conclude image 
 303    arg stp_image image 
 304    external_calling_convention 
 305    if trace 
 306      console ")" eol 
 307   
 308   
 309  function writebytes file buf size 
 310    arg Address file buf ; arg Int size 
 311    external_calling_convention 
 312    (file map Stream) raw_write buf size 
 313   
 314  if debug 
 315    (gvar Stream log) open "file:/tmp/gimpprint.log" out+safe 
 316   
 317  function errorbytes file buf size 
 318    arg Address file buf ; arg Int size 
 319    external_calling_convention 
 320    (var Str s) set buf size false 
 321    if debug 
 322      log writechars s 
 323      log flush anytime 
 324    else 
 325      file map Str += s 
 326   
 327   
 328 
 
 329   
 330   
 331  type ImageWriteFilterGimpPrint 
 332    field stp_image image 
 333    field Address vars 
 334    field FastSem tsem 
 335    field Int current 
 336   
 337  ImageWriteFilter maybe ImageWriteFilterGimpPrint 
 338   
 339  stp_init 
 340   
 341  method o float_option name -> i 
 342    arg Str o name ; arg Int i 
 343    var Float32 float := o option name Float 
 344    if float=undefined 
 345      float := 1 
 346    i := (addressof:float map Int) 
 347   
 348  method f open stream options h -> status 
 349    arg_rw ImageWriteFilterGimpPrint f ; arg_rw Stream stream ; arg Str options ; arg ImagePrototype h ; arg ExtendedStatus status 
 350   
 351    var Address printer := stp_get_printer_by_driver (options option "model" Str (options option "driver" Str)) 
 352    if printer=null 
 353      return failure:"no driver" 
 354    var Address vars := stp_allocate_copy stp_printer_get_printvars:printer 
 355    f vars := vars 
 356   
 357    if not ((options (options option_position "page" options:len) options:len) parse word:"page" (var Float page_x) (var Float page_y) any) 
 358      page_x := 210 ; page_y := 297 
 359    var Float delta_y := 0 
 360    stp_set_page_width vars (cast page_x/25.4*72 Int) 
 361    stp_set_page_height vars (cast (page_y+delta_y)/25.4*72 Int) 
 362    stp_set_orientation vars ORIENT_PORTRAIT 
 363    if not ((options (options option_position "offset" options:len) options:len) parse word:"offset" (var Float offset_x) (var Float offset_y) any) 
 364      offset_x := 0 ; offset_y := 0 
 365    stp_set_left vars (cast offset_x/25.4*72 Int) 
 366    stp_set_top vars (cast (offset_y+delta_y)/25.4*72 Int) 
 367   
 368    stp_set_media_type vars (options option "paper" Str) 
 369    if (options option "roll") 
 370      stp_set_media_source vars "Roll" 
 371    var Str ink_type := options option "gimpprint_ink_type" Str 
 372    if ink_type<>"" 
 373      stp_set_ink_type vars ink_type 
 374    stp_set_resolution vars (options option "resolution" Str) 
 375    var Float scale := options option "scale" Float 
 376    if scale=undefined 
 377      scale := 1 
 378    var Float r := h:size_x/(h:x1-h:x0)*25.4/scale 
 379    var Float32 float := -r ; stp_set_scaling vars (addressof:float map Int) 
 380    var Str dithering := options option "dithering" Str 
 381    if dithering="" 
 382      dithering :=  "Adaptive" # "Ordered" 
 383    stp_set_dither_algorithm vars dithering 
 384   
 385    var CBool cmyk := h:gamut:name<>"rgb" 
 386    stp_set_output_type vars (shunt cmyk OUTPUT_RAW_CMYK OUTPUT_COLOR) 
 387    stp_set_image_type vars IMAGE_CONTINUOUS 
 388    stp_set_brightness vars (options float_option "brightness") 
 389    stp_set_contrast vars (options float_option "contrast") 
 390    stp_set_cyan vars (options float_option "cyan") 
 391    stp_set_magenta vars (options float_option "magenta") 
 392    stp_set_yellow vars (options float_option "yellow") 
 393    stp_set_saturation vars (options float_option "saturation") 
 394    stp_set_density vars (options float_option "density") 
 395    stp_set_gamma vars (options float_option "gamma") 
 396    float := 2.4 ; stp_set_app_gamma vars (addressof:float map Int) 
 397    
 398    stp_set_outfunc vars (the_function writebytes Address Address Int):executable 
 399    stp_set_outdata vars addressof:stream 
 400    stp_set_errfunc vars (the_function errorbytes Address Address Int):executable 
 401    stp_set_errdata vars (addressof status:message) 
 402   
 403    memory_clear (addressof f:image) stp_image:size 
 404    f:image init := (the_function image_do_nothing stp_image) executable 
 405    f:image reset := (the_function image_do_nothing stp_image) executable 
 406    f:image rotate_ccw := (the_function image_do_nothing stp_image) executable 
 407    f:image rotate_cw := (the_function image_do_nothing stp_image) executable 
 408    f:image rotate_180 := (the_function image_do_nothing stp_image) executable 
 409    f:image bpp := (the_function image_bpp stp_image -> Int) executable 
 410    f:image width := (the_function image_width stp_image -> Int) executable 
 411    f:image height := (the_function image_height stp_image -> Int) executable 
 412    f:image get_row := (the_function image_get_row stp_image Address Int -> Int) executable 
 413    f:image get_appname := (the_function image_get_appname stp_image -> Address) executable 
 414    f:image progress_init := (the_function image_progress_init stp_image) executable 
 415    f:image note_progress := (the_function image_note_progress stp_image Int Int) executable 
 416    f:image progress_conclude := (the_function image_progress_conclude stp_image) executable 
 417    f:image size_x := h size_x ; f:image size_y := h size_y 
 418    f:image cmyk := cmyk 
 419    if cmyk 
 420      console "  Gimp-print"+(shunt (options option "roll") " roll" "")+" CMYK output" eol 
 421      for (var Int i) 0 255 
 422        f:image:cmyk_table i := i*i+2*i 
 423    if ((h:gamut query "noise") parse (var Float noise)) 
 424      f:image noise := noise 
 425   
 426    stp_merge_printvars vars stp_printer_get_printvars:printer 
 427    var stp_printfuncs funcs := stp_printer_get_printfuncs printer 
 428    var Function fun ; fun executable := funcs verify 
 429    if (verify_prototype printer vars fun) 
 430      f:image line_size := h line_size 
 431      f:image:lines size := h size_y 
 432      for (var Int i) 0 h:size_y-1 
 433        f:image:lines i := null 
 434      f:image line_drop := 0 
 435      f:image line_count := 0 
 436      f current := 0 
 437      f:tsem request 
 438      thread 
 439        share f 
 440        var Function fun2 ; fun2 executable := funcs print 
 441        print_prototype printer f:image vars fun2 
 442        f:tsem release 
 443      status := success 
 444    else 
 445      stp_free_vars f:vars 
 446      status := failure status:message 
 447   
 448  method f writeline adr -> status 
 449    arg_rw ImageWriteFilterGimpPrint f ; arg Address adr ; arg Status status 
 450    # console f:image:line_count "/" f:current " (" (max 4*2^20\f:image:line_size 16) ")" eol 
 451    var Int forward := max 4*2^20\f:image:line_size 16 
 452    if f:image:line_count>forward 
 453      while f:image:line_count>forward\2 
 454        os_yield 
 455    var Address buf := memory_allocate f:image:line_size (addressof f:image:lines) 
 456    memory_copy adr buf f:image:line_size 
 457    atomic_add f:image:line_count 1 ; f:image:lines f:current := buf 
 458    f current += 1 
 459    status := success 
 460   
 461  method f close -> status 
 462    arg_rw ImageWriteFilterGimpPrint f ; arg ExtendedStatus status 
 463    f:tsem request ; f:tsem release 
 464    for (var Int y) f:image:line_drop f:image:size_y-1 
 465      memory_free f:image:lines:y 
 466    stp_free_vars f:vars 
 467    status := success 
 468     
 469   
 470  image_record_filters ".gimpprint" Void false ImageWriteFilterGimpPrint false 
 471   
 472   
 473 
 
 474   
 475   
 476  type ImageWriteFilterTestPattern 
 477    field Pointer:Stream stream 
 478    field CBool cmyk 
 479    field Int line_size 
 480    field (Array uInt16 256) cmyk_table 
 481   
 482  ImageWriteFilter maybe ImageWriteFilterTestPattern 
 483   
 484  stp_init 
 485   
 486  method o float_option name -> i 
 487    arg Str o name ; arg Int i 
 488    var Float32 float := o option name Float 
 489    if float=undefined 
 490      float := 1 
 491    i := (addressof:float map Int) 
 492   
 493  function gp_float f -> s 
 494    arg Float f ; arg Str s 
 495    s := string f 
 496    if (s search "." -1)=(-1) 
 497      s += ".0" 
 498   
 499  method f open stream options h -> status 
 500    arg_rw ImageWriteFilterTestPattern f ; arg_rw Stream stream ; arg Str options ; arg ImagePrototype h ; arg ExtendedStatus status 
 501    stream writeline "printer "+(options option "model" Str (options option "driver" Str)) 
 502    stream writeline "resolution "+(options option "resolution" Str) 
 503    stream writeline "media_type "+(options option "paper" Str) 
 504   
 505    var Str ink_type := options option "gimpprint_ink_type" Str 
 506    if ink_type<>"" 
 507      stream writeline "ink_type "+ink_type 
 508   
 509    var Float page_x page_y 
 510    if not ((options (options option_position "page" options:len) options:len) parse word:"page" (var Float page_x) (var Float page_y) any) 
 511      page_x := 210 ; page_y := 297 
 512    var Float offset_x offset_y 
 513    if not ((options (options option_position "offset" options:len) options:len) parse word:"offset" (var Float offset_x) (var Float offset_y) any) 
 514      offset_x := 0 ; offset_y := 0 
 515   
 516    stream writeline "media_size A4" ; page_x := 210 ; page_y := 297 
 517    var Str dithering := options option "dithering" Str 
 518    if dithering="" 
 519      dithering :=  "Adaptive" # "Ordered" 
 520    stream writeline "dither_algorithm "+dithering 
 521   
 522    stream writeline "hsize "+(gp_float (h:x1-h:x0)/page_x) 
 523    stream writeline "vsize "+(gp_float (h:y1-h:y0)/page_y) 
 524    stream writeline "left "+(gp_float offset_x/page_x) 
 525    stream writeline "top "+(gp_float offset_y/page_y) 
 526   
 527    stream writeline "density 1.0" 
 528    stream writeline "image "+(string h:size_x)+" "+(string h:size_y) 
 529    f stream :> stream 
 530    f cmyk := h:gamut:name<>"rgb" 
 531    if f:cmyk 
 532      for (var Int i) 0 255 
 533        f:cmyk_table i := i*i+2*i 
 534    f line_size := h line_size 
 535    status := success 
 536   
 537  method f writeline adr -> status 
 538    arg_rw ImageWriteFilterTestPattern f ; arg Address adr ; arg Status status 
 539    if f:cmyk 
 540      var Address ptr := adr 
 541      var Address stop := adr translate Byte f:line_size 
 542      var Pointer:(Array uInt16 256) table :> f cmyk_table 
 543      while ptr<>stop 
 544        var uInt16 v16 := table (ptr map uInt8) 
 545        f:stream raw_write addressof:v16 uInt16:size 
 546        ptr := ptr translate uInt8 1 
 547    else 
 548      f:stream raw_write adr f:line_size 
 549    status := success 
 550   
 551  method f close -> status 
 552    arg_rw ImageWriteFilterTestPattern f ; arg ExtendedStatus status 
 553    status := success 
 554     
 555   
 556  image_record_filters ".gptp" Void false ImageWriteFilterTestPattern false