Patch title: Release 85 bulk changes
Abstract:
File: /pliant/graphic/filter/pcl.pli
Key:
    Removed line
    Added line
# Copyright  Hubert Tonneau  hubert.tonneau@pliant.cx
#
# Generic PCL driver
# tested on HP Designjet large format printers

module "/pliant/language/compiler.pli"
module "/pliant/language/context.pli"
module "/pliant/language/stream.pli"
module "/pliant/math/functions.pli"
module "/pliant/graphic/misc/float.pli"
module "prototype.pli"
module "/pliant/graphic/color/gamut.pli"
module "/pliant/util/encoding/packbits.pli"

constant packbits true

function generator_prototype x y head dot density f
  arg Int x y head ; arg_w Int dot density ; arg Function f
  indirect


type ImageWriteFilterPcl
  field Pointer:Stream stream
  field Int line_size
  field Address buffer
  field Address previous_line
  field CBool hpgl
  field CBool seedrow <- false
  field CBool packbits <- false

ImageWriteFilter maybe ImageWriteFilterPcl


function memory_search_difference adr1 adr2 size -> offset
  arg Address adr1 adr2 ; arg Int size ; arg Int offset
  var Address a1 := adr1 ; var Address a2 := adr2
  var Int remain := size
  while remain>=Int:size and (a1 map Int)=(a2 map Int)
    a1 := a1 translate Int 1 ; a2 := a2 translate Int 1 ; remain -= Int size
  while remain>0 and (a1 map Int8)=(a2 map Int8)
    a1 := a1 translate Int8 1 ; a2 := a2 translate Int8 1 ; remain -= 1
  offset := size-remain

function seedrow_encode src dest count previous -> csize
  arg Address src dest ; arg Int count ; arg Address previous ; arg Int csize
  var Address s := src ; var Address stop := src translate Byte count
  var Address d := dest
  var Int delta := (cast previous Int).-.(cast src Int)
  while { var Int offset := memory_search_difference s (s translate Byte delta) (cast stop Int).-.(cast s Int) ; offset<>(cast stop Int).-.(cast s Int) }
    var Address s := s translate Byte offset
    var Address s2 := s translate Byte 1
    while s2<>stop and (s2 map uInt8 delta)<>(s2 map uInt8)
      s2 := s2 translate Byte 1
    var Int replace := (cast s2 Int).-.(cast s Int)
    while replace>0
      var Int r := min replace 8 ; replace -= r
      var Int o := min offset 31 ; offset -= o
      d map uInt8 := (r-1)*2^5 + o ; d := d translate uInt8 1
      if o=31
        o := 255
        while o=255
          o := min offset 255 ; offset -= o
          d map uInt8 := o ; d := d translate uInt8 1
      memory_copy s d r ; s := s translate Byte r ; d := d translate Byte r
  csize := (cast d Int).-.(cast dest Int)

  
constant escape character:27

method f open s options h -> status
  arg_rw ImageWriteFilterPcl f ; arg_rw Stream s ; arg Str options ; arg ImagePrototype h ; arg ExtendedStatus status
  if h:gamut:pixel_size<>3
    return failure:"Only 3 components images can be saved as .pcl"
  f stream :> s
  f line_size := h line_size
  f buffer := memory_allocate 2*f:line_size+4 addressof:f
  f hpgl := options option "hpgl"
  if not (options option "pcl_no_compression")
    if (options option "pcl_seedrow_compression")
      f seedrow := true
    eif (options option "pcl_packbits_compression")
      f packbits := true
    else
      f seedrow := true
  var Float dpi := h:size_x/(abs h:x1-h:x0)*25.4
  s writechars escape+"E" # reset
  if f:hpgl
    s writechars escape+"%-12345X@PJL RESET[cr][lf]@PJL SET RESOLUTION = "+string:dpi+"[cr][lf]@PJL ENTER LANGUAGE = HPGL2[cr][lf]"
    s writechars escape+"%1B" # enter HP GL/2 mode
    s writechars "BP3,1,5,1;" # do not store file on the device disk and do not rotate automatically
    if (options option "hpgl_page")
      var Int nx := cast 1016.0*h:size_x/dpi+0.5 Int
      var Int ny := cast 1016.0*h:size_y/dpi+0.5 Int
      s writechars "PS"+string:ny+","+string:nx+";" # set page size
    else
      s writechars "PS;" # no page clip
    s writechars escape+"%0A" # enter HP RTL mode
  s writechars escape+"&l101A" # custom paper size
  if (options option "no_perforation_skip")
  if not (options option "pcl_no_paper_size")
    # A4 = 26 , A3 = 27 , A3+ = 16, custom = 101
    s writechars escape+"&l"+(options option "pcl_paper_size" Str "101")+"A" # paper size
  if (options option "pcl_no_perforation_skip")
    s writechars escape+"&l0L" # Turn off perforation skip
  s writechars escape+"&a1N" # No negative motion - allow plotting while receiving
  var Int color_model := shunt h:gamut:model<>color_gamut_additive 1 (options option "sRGB") 2 0 # 0 = device RGB, 1 = device CMY, 2 = sRGB
  s writechars escape+"*v6W"+character:color_model+character:3+character:0+character:8+character:8+character:8 # select 3 bytes per pixel trivial encoding
  if h:gamut:dimension=3
    var Int color_model := shunt h:gamut:model<>color_gamut_additive 1 (options option "sRGB") 2 0 # 0 = device RGB, 1 = device CMY, 2 = sRGB
    s writechars escape+"*v6W"+character:color_model+character:3+character:0+character:8+character:8+character:8 # select 3 bytes per pixel trivial encoding
  s writechars escape+"*t"+string:(cast dpi Int)+"R" # set resolution
  s writechars escape+"*r"+(string h:size_x)+"S" # number of pixels per line
  s writechars escape+"*r"+(string h:size_y)+"T" # number of rows
  s writechars escape+"*r1A" # start raster graphics at current position, no scaling requested
  s writechars escape+"*b"+(shunt packbits "2" "0")+"M" # select packbits compression
  s writechars escape+"*b"+(shunt f:seedrow "3" f:packbits "2" "0")+"M" # select compression
  if f:seedrow
    f previous_line := memory_zallocate f:line_size addressof:f
  status := success


method f writeline adr -> status
  arg_rw ImageWriteFilterPcl f ; arg Address adr ; arg Status status
  var Pointer:Stream s :> f stream
  if packbits
  if f:seedrow
    var Int csize := seedrow_encode adr f:buffer f:line_size f:previous_line
    s writechars escape+"*b3m"+string:csize+"W"
    s raw_write f:buffer csize
    memory_copy adr f:previous_line f:line_size
  eif f:packbits
    var Int csize := packbits_encode adr f:buffer f:line_size
    s writechars escape+"*b2m"+string:csize+"W" # one raw ; 2m = packbits encoded
    s writechars escape+"*b2m"+string:csize+"W"
    s raw_write f:buffer csize
  else
    s writechars escape+"*b0m"+(string f:line_size)+"W"
    s raw_write adr f:line_size
  status := success


method f close -> status
  arg_rw ImageWriteFilterPcl f ; arg ExtendedStatus status
  if f:seedrow
    memory_free f:previous_line
  memory_free f:buffer
  var Pointer:Stream s :> f stream
  s writechars escape+"*rC" # end raster graphics
  if f:hpgl
    s writechars escape+"%1B" # back to HP GL/2
    s writechars "PG;" # end of job: eject page or advance roll
  s writechars escape+"E" # reset
  status := success


image_record_filters ".pcl" Void ImageWriteFilterPcl