Patch title: Release 92 bulk changes
Abstract:
File: /graphic/filter/gimpprint.pli
Key:
    Removed line
    Added line
abstract
  [Gimp-print (free color inkjet printers driver) interface]

# Copyright  Hubert Tonneau  hubert.tonneau@pliant.cx
#
# This program is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License version 2
# as published by the Free Software Foundation.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# version 2 along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.


module "/pliant/language/unsafe.pli"
module "/pliant/language/context.pli"
module "/pliant/language/compiler.pli"
module "/pliant/language/os.pli"
module "/pliant/language/stream.pli"
module "prototype.pli"
module "/pliant/graphic/color/gamut.pli"

if (constant (file_query "file:/lib/libgimpprint.so" standard)=defined)
  constant gp_dll "/lib/libgimpprint.so"
eif (constant (file_query "file:/lib/libgimpprint.so.1" standard)=defined)
  constant gp_dll "/lib/libgimpprint.so.1"
eif (constant (file_query "file:/usr/lib/libgimpprint.so.1" standard)=defined)
  constant gp_dll "/usr/lib/libgimpprint.so.1"
else
  constant gp_dll "libgimpprint.so"
constant trace false
constant debug false


#-------------------------------------------------------------------------


function stp_init
  external gp_dll "stp_init"
if debug
  console "  Gimp-print stp_init is at " (cast the_function:stp_init:executable Int) eol

function stp_get_printer_by_driver driver -> printer
  arg CStr driver ; arg Address printer
  external gp_dll "stp_get_printer_by_driver"

function stp_printer_get_printvars printer -> vars
  arg Address printer ; arg Address vars
  external gp_dll "stp_printer_get_printvars"

function stp_allocate_copy vars -> newvars
  arg Address vars newvars
  external gp_dll "stp_allocate_copy"

function stp_merge_printvars vars printer
  arg Address vars printer
  external gp_dll "stp_merge_printvars"

function stp_free_vars vars
  arg Address vars
  external gp_dll "stp_free_vars"


function stp_set_page_width vars val
  arg Address vars ; arg Int val
  external gp_dll "stp_set_page_width"

function stp_set_page_height vars val
  arg Address vars ; arg Int val
  external gp_dll "stp_set_page_height"

constant ORIENT_PORTRAIT 0

function stp_set_orientation vars val
  arg Address vars ; arg Int val
  external gp_dll "stp_set_orientation"

function stp_set_left vars val
  arg Address vars ; arg Int val
  external gp_dll "stp_set_left"

function stp_set_top vars val
  arg Address vars ; arg Int val
  external gp_dll "stp_set_top"


function stp_set_media_type vars val
  arg Address vars ; arg CStr val
  external gp_dll "stp_set_media_type"

function stp_set_media_source vars val
  arg Address vars ; arg CStr val
  external gp_dll "stp_set_media_source"

function stp_set_ink_type vars val
  arg Address vars ; arg CStr val
  external gp_dll "stp_set_ink_type"

function stp_set_resolution vars val
  arg Address vars ; arg CStr val
  external gp_dll "stp_set_resolution"

function stp_set_scaling vars f
  arg Address vars ; arg Int f
  external gp_dll "stp_set_scaling"


function stp_set_dither_algorithm vars val
  arg Address vars ; arg CStr val
  external gp_dll "stp_set_dither_algorithm"

constant OUTPUT_COLOR 1
constant OUTPUT_RAW_CMYK  3

function stp_set_output_type vars val
  arg Address vars ; arg Int val
  external gp_dll "stp_set_output_type"

constant IMAGE_CONTINUOUS 2

function stp_set_image_type vars val
  arg Address vars ; arg Int val
  external gp_dll "stp_set_image_type"

function stp_set_brightness vars f
  arg Address vars ; arg Int f
  external gp_dll "stp_set_brightness"

function stp_set_contrast vars f
  arg Address vars ; arg Int f
  external gp_dll "stp_set_contrast"

function stp_set_cyan vars f
  arg Address vars ; arg Int f
  external gp_dll "stp_set_cyan"

function stp_set_magenta vars f
  arg Address vars ; arg Int f
  external gp_dll "stp_set_magenta"

function stp_set_yellow vars f
  arg Address vars ; arg Int f
  external gp_dll "stp_set_yellow"

function stp_set_saturation vars f
  arg Address vars ; arg Int f
  external gp_dll "stp_set_saturation"

function stp_set_density vars f
  arg Address vars ; arg Int f
  external gp_dll "stp_set_density"

function stp_set_gamma vars f
  arg Address vars ; arg Int f
  external gp_dll "stp_set_gamma"

function stp_set_app_gamma vars f
  arg Address vars ; arg Int f
  external gp_dll "stp_set_app_gamma"


function stp_set_outfunc vars func
  arg Address vars func
  external gp_dll "stp_set_outfunc"

function stp_set_outdata vars file
  arg Address vars file
  external gp_dll "stp_set_outdata"

function stp_set_errfunc vars func
  arg Address vars func
  external gp_dll "stp_set_errfunc"

function stp_set_errdata vars file
  arg Address vars file
  external gp_dll "stp_set_errdata"


type stp_image
  field Address init
  field Address reset
  field Address transpose
  field Address hflip
  field Address vflip
  field Address crop
  field Address rotate_ccw
  field Address rotate_cw
  field Address rotate_180
  field Address bpp
  field Address width
  field Address height
  field Address get_row
  field Address get_appname
  field Address progress_init
  field Address note_progress
  field Address progress_conclude
  field Address notused
  field Int size_x size_y
  field Array:Address lines ; field Int line_size line_count
  field Int line_drop
  field CBool cmyk
  field (Array uInt16 256) cmyk_table
  field Float noise <- 0


type stp_printfuncs
  field Address parameters
  field Address media_size
  field Address imageable_area
  field Address limit
  field Address print
  field Address default_parameters
  field Address describe_resolution
  field Address verify

function stp_printer_get_printfuncs printer -> funcs
  arg Address printer ; arg_R stp_printfuncs funcs
  external gp_dll "stp_printer_get_printfuncs"

function verify_prototype printer vars f -> ok
  arg Address printer vars ; arg Function f ; arg Function f ; arg CBool ok
  external_calling_convention
  indirect

function print_prototype printer image vars f
  arg Address printer ; arg stp_image image ; arg Address vars ; arg Function f
  external_calling_convention
  indirect


#-------------------------------------------------------------------------


function image_do_nothing image 
  arg stp_image image
  external_calling_convention

function image_bpp image -> bpp
  arg stp_image image ; arg Int bpp
  external_calling_convention
  bpp := shunt image:cmyk 8 3 # bytes per pixel
 
function image_width image -> size_x
  arg stp_image image ; arg Int size_x
  external_calling_convention
  size_x := image size_x

function image_height image -> size_y
  arg stp_image image ; arg Int size_y
  external_calling_convention
  size_y := image size_y

function image_get_row image data y -> err
  arg_rw stp_image image ; arg Address data ; arg Int y ; arg Int err
  external_calling_convention
  check y>=image:line_drop
  while image:line_drop<y
    while (image:lines image:line_drop)=null
      os_yield
    memory_free (image:lines image:line_drop)
    atomic_add image:line_count -1
    image line_drop += 1
  while image:lines:y=null
    os_yield
  if image:cmyk
    var Address src := image:lines y ; var Address stop := src translate Byte image:line_size
    var Address dest := data
    var Pointer:(Array uInt16 256) table :> image cmyk_table
    while src<>stop
      var Int l := src map uInt8
      if image:noise<>0
        memory_random addressof:(var Int r) Int:size
        l += r % (max (cast (min l 255-l)*image:noise Int) 1)
      dest map uInt16 := table l
      src := src translate uInt8 1 ; dest := dest translate uInt16 1
  else
    memory_copy image:lines:y data image:line_size
  err := 0

function image_get_appname image -> name
  arg stp_image image ; arg Address name
  external_calling_convention
  name := "Pliant[0]" characters

function image_progress_init image
  arg stp_image image
  external_calling_convention
  if trace
    console "("

function image_note_progress image f1 f2
  arg stp_image image ; arg Int f1 f2
  external_calling_convention
  if trace
    console "."

function image_progress_conclude image
  arg stp_image image
  external_calling_convention
  if trace
    console ")" eol


function writebytes file buf size
  arg Address file buf ; arg Int size
  external_calling_convention
  (file map Stream) raw_write buf size

if debug
  (gvar Stream log) open "file:/tmp/gimpprint.log" out+safe

function errorbytes file buf size
  arg Address file buf ; arg Int size
  external_calling_convention
  (var Str s) set buf size false
  if debug
    log writechars s
    log flush anytime
  else
    file map Str += s


#-------------------------------------------------------------------------


type ImageWriteFilterGimpPrint
  field stp_image image
  field Address vars
  field FastSem tsem
  field Int current

ImageWriteFilter maybe ImageWriteFilterGimpPrint

stp_init

method o float_option name -> i
  arg Str o name ; arg Int i
  var Float32 float := o option name Float
  if float=undefined
    float := 1
  i := (addressof:float map Int)

method f open stream options h -> status
  arg_rw ImageWriteFilterGimpPrint f ; arg_rw Stream stream ; arg Str options ; arg ImagePrototype h ; arg ExtendedStatus status

  var Address printer := stp_get_printer_by_driver (options option "model" Str (options option "driver" Str))
  if printer=null
    return failure:"no driver"
  var Address vars := stp_allocate_copy stp_printer_get_printvars:printer
  f vars := vars

  if not ((options (options option_position "page" options:len) options:len) parse word:"page" (var Float page_x) (var Float page_y) any)
    page_x := 210 ; page_y := 297
  var Float delta_y := 0
  stp_set_page_width vars (cast page_x/25.4*72 Int)
  stp_set_page_height vars (cast (page_y+delta_y)/25.4*72 Int)
  stp_set_orientation vars ORIENT_PORTRAIT
  if not ((options (options option_position "offset" options:len) options:len) parse word:"offset" (var Float offset_x) (var Float offset_y) any)
    offset_x := 0 ; offset_y := 0
  stp_set_left vars (cast offset_x/25.4*72 Int)
  stp_set_top vars (cast (offset_y+delta_y)/25.4*72 Int)

  stp_set_media_type vars (options option "paper" Str)
  if (options option "roll")
    stp_set_media_source vars "Roll"
  var Str ink_type := options option "gimpprint_ink_type" Str
  if ink_type<>""
    stp_set_ink_type vars ink_type
  stp_set_resolution vars (options option "resolution" Str)
  var Float scale := options option "scale" Float
  if scale=undefined
    scale := 1
  var Float r := h:size_x/(h:x1-h:x0)*25.4/scale
  var Float32 float := -r ; stp_set_scaling vars (addressof:float map Int)
  var Str dithering := options option "dithering" Str
  if dithering=""
    dithering :=  "Adaptive" # "Ordered"
  stp_set_dither_algorithm vars dithering

  var CBool cmyk := h:gamut:name<>"rgb"
  stp_set_output_type vars (shunt cmyk OUTPUT_RAW_CMYK OUTPUT_COLOR)
  stp_set_image_type vars IMAGE_CONTINUOUS
  stp_set_brightness vars (options float_option "brightness")
  stp_set_contrast vars (options float_option "contrast")
  stp_set_cyan vars (options float_option "cyan")
  stp_set_magenta vars (options float_option "magenta")
  stp_set_yellow vars (options float_option "yellow")
  stp_set_saturation vars (options float_option "saturation")
  stp_set_density vars (options float_option "density")
  stp_set_gamma vars (options float_option "gamma")
  float := 2.4 ; stp_set_app_gamma vars (addressof:float map Int)
 
  stp_set_outfunc vars (the_function writebytes Address Address Int):executable
  stp_set_outdata vars addressof:stream
  stp_set_errfunc vars (the_function errorbytes Address Address Int):executable
  stp_set_errdata vars (addressof status:message)

  memory_clear (addressof f:image) stp_image:size
  f:image init := (the_function image_do_nothing stp_image) executable
  f:image reset := (the_function image_do_nothing stp_image) executable
  f:image rotate_ccw := (the_function image_do_nothing stp_image) executable
  f:image rotate_cw := (the_function image_do_nothing stp_image) executable
  f:image rotate_180 := (the_function image_do_nothing stp_image) executable
  f:image bpp := (the_function image_bpp stp_image -> Int) executable
  f:image width := (the_function image_width stp_image -> Int) executable
  f:image height := (the_function image_height stp_image -> Int) executable
  f:image get_row := (the_function image_get_row stp_image Address Int -> Int) executable
  f:image get_appname := (the_function image_get_appname stp_image -> Address) executable
  f:image progress_init := (the_function image_progress_init stp_image) executable
  f:image note_progress := (the_function image_note_progress stp_image Int Int) executable
  f:image progress_conclude := (the_function image_progress_conclude stp_image) executable
  f:image size_x := h size_x ; f:image size_y := h size_y
  f:image cmyk := cmyk
  if cmyk
    console "  Gimp-print"+(shunt (options option "roll") " roll" "")+" CMYK output" eol
    for (var Int i) 0 255
      f:image:cmyk_table i := i*i+2*i
  if ((h:gamut query "noise") parse (var Float noise))
    f:image noise := noise

  stp_merge_printvars vars stp_printer_get_printvars:printer
  var stp_printfuncs funcs := stp_printer_get_printfuncs printer
  var Function fun ; fun executable := funcs verify
  if (verify_prototype printer vars fun)
    f:image line_size := h line_size
    f:image:lines size := h size_y
    for (var Int i) 0 h:size_y-1
      f:image:lines i := null
    f:image line_drop := 0
    f:image line_count := 0
    f current := 0
    f:tsem request
    thread
      share f
      var Function fun2 ; fun2 executable := funcs print
      print_prototype printer f:image vars fun2
      f:tsem release
    status := success
  else
    stp_free_vars f:vars
    status := failure status:message

method f writeline adr -> status
  arg_rw ImageWriteFilterGimpPrint f ; arg Address adr ; arg Status status
  # console f:image:line_count "/" f:current " (" (max 4*2^20\f:image:line_size 16) ")" eol
  var Int forward := max 4*2^20\f:image:line_size 16
  if f:image:line_count>forward
    while f:image:line_count>forward\2
      os_yield
  var Address buf := memory_allocate f:image:line_size (addressof f:image:lines)
  memory_copy adr buf f:image:line_size
  atomic_add f:image:line_count 1 ; f:image:lines f:current := buf
  f current += 1
  status := success

method f close -> status
  arg_rw ImageWriteFilterGimpPrint f ; arg ExtendedStatus status
  f:tsem request ; f:tsem release
  for (var Int y) f:image:line_drop f:image:size_y-1
    memory_free f:image:lines:y
  stp_free_vars f:vars
  status := success
  

image_record_filters ".gimpprint" Void ImageWriteFilterGimpPrint
image_record_filters ".gimpprint" Void false ImageWriteFilterGimpPrint false


#-------------------------------------------------------------------------


type ImageWriteFilterTestPattern
  field Pointer:Stream stream
  field CBool cmyk
  field Int line_size
  field (Array uInt16 256) cmyk_table

ImageWriteFilter maybe ImageWriteFilterTestPattern

stp_init

method o float_option name -> i
  arg Str o name ; arg Int i
  var Float32 float := o option name Float
  if float=undefined
    float := 1
  i := (addressof:float map Int)

function gp_float f -> s
  arg Float f ; arg Str s
  s := string f
  if (s search "." -1)=(-1)
    s += ".0"

method f open stream options h -> status
  arg_rw ImageWriteFilterTestPattern f ; arg_rw Stream stream ; arg Str options ; arg ImagePrototype h ; arg ExtendedStatus status
  stream writeline "printer "+(options option "model" Str (options option "driver" Str))
  stream writeline "resolution "+(options option "resolution" Str)
  stream writeline "media_type "+(options option "paper" Str)

  var Str ink_type := options option "gimpprint_ink_type" Str
  if ink_type<>""
    stream writeline "ink_type "+ink_type

  var Float page_x page_y
  if not ((options (options option_position "page" options:len) options:len) parse word:"page" (var Float page_x) (var Float page_y) any)
    page_x := 210 ; page_y := 297
  var Float offset_x offset_y
  if not ((options (options option_position "offset" options:len) options:len) parse word:"offset" (var Float offset_x) (var Float offset_y) any)
    offset_x := 0 ; offset_y := 0

  stream writeline "media_size A4" ; page_x := 210 ; page_y := 297
  var Str dithering := options option "dithering" Str
  if dithering=""
    dithering :=  "Adaptive" # "Ordered"
  stream writeline "dither_algorithm "+dithering

  stream writeline "hsize "+(gp_float (h:x1-h:x0)/page_x)
  stream writeline "vsize "+(gp_float (h:y1-h:y0)/page_y)
  stream writeline "left "+(gp_float offset_x/page_x)
  stream writeline "top "+(gp_float offset_y/page_y)

  stream writeline "density 1.0"
  stream writeline "image "+(string h:size_x)+" "+(string h:size_y)
  f stream :> stream
  f cmyk := h:gamut:name<>"rgb"
  if f:cmyk
    for (var Int i) 0 255
      f:cmyk_table i := i*i+2*i
  f line_size := h line_size
  status := success

method f writeline adr -> status
  arg_rw ImageWriteFilterTestPattern f ; arg Address adr ; arg Status status
  if f:cmyk
    var Address ptr := adr
    var Address stop := adr translate Byte f:line_size
    var Pointer:(Array uInt16 256) table :> f cmyk_table
    while ptr<>stop
      var uInt16 v16 := table (ptr map uInt8)
      f:stream raw_write addressof:v16 uInt16:size
      ptr := ptr translate uInt8 1
  else
    f:stream raw_write adr f:line_size
  status := success

method f close -> status
  arg_rw ImageWriteFilterTestPattern f ; arg ExtendedStatus status
  status := success
  

image_record_filters ".gptp" Void ImageWriteFilterTestPattern
image_record_filters ".gptp" Void false ImageWriteFilterTestPattern false