Patch title: Release 93 bulk changes
File: /graphic/filter/escp2.pli
    Removed line
    Added line
# Copyright  Hubert Tonneau
# Writing this driver was possible only thanks to the great work done by
# Robert L Krawitz to gather and document detailed informations about
# Epson inkjet printers.

module "/pliant/language/compiler.pli"
module "/pliant/language/context.pli"
module "/pliant/language/stream.pli"
module "/pliant/math/functions.pli"
module "prototype.pli"
module "/pliant/graphic/color/gamut.pli"
module "/pliant/util/encoding/packbits.pli"
module "/pliant/graphic/image/pixmap.pli"
module "/pliant/graphic/color/spectrum.pli" # defines exposure and correct
module "/pliant/util/crypto/random.pli"
module "/pliant/graphic/color/adjust.pli"
module "/pliant/graphic/color/spectrum.pli" # defines 'exposure' function
module "/pliant/graphic/misc/dither.pli"

constant packbits true
constant heads_count 8
constant matrix_mini 192
constant matrix_maxi 384
constant matrix_release 1
constant top_enhancement true
constant verbose false

gvar Link:Function escp2_generator

# dithering matrix

type DitherMatrix
  field (Array Array:Int) coefs
  field Int size_x size_y

method m resize size_x size_y
  arg_rw DitherMatrix m ; arg Int size_x size_y
  m size_x := size_x ; m size_y := size_y
  m:coefs size := size_y
  for (var Int y) 0 size_y-1
    m:coefs:y size := size_x

method m '' x y -> coef
  arg DitherMatrix m ; arg Int x y ; arg_C Int coef
  check x>=0 and x<m:size_x
  check y>=0 and y<m:size_y
  coef :> m:coefs:y x

method m cell xx yy -> coef
  arg DitherMatrix m ; arg Int xx yy ; arg_C Int coef
  var Int x := xx%m:size_x
  if x<0
    x += m size_x
  var Int y := yy%m:size_y
  if y<0
    y += m size_y
  coef :> m:coefs:y x

method m save filename
  arg_rw DitherMatrix m ; arg Str filename
  (var Stream s) open filename out+mkdir+safe
  s writeline "Pliant dithering matrix"
  s writeline "release "+string:matrix_release
  s writeline "size_x "+(string m:size_x)
  s writeline "size_y "+(string m:size_y)
  s writeline ""
  for (var Int y) 0 m:size_y-1
    s raw_write addressof:(m 0 y) m:size_x*Int:size

method m load filename -> status
  arg_rw DitherMatrix m ; arg Str filename ; arg Status status
  (var Stream s) open filename in+safe
  var Int r := undefined ; var Int sx sy
  while { var Str l := s readline ; l<>"" }
    l parse word:"release" r
    l parse word:"size_x" sx
    l parse word:"size_y" sy
  if r<>matrix_release
    return failure
  m resize sx sy
  for (var Int y) 0 m:size_y-1
    s raw_read addressof:(m 0 y) m:size_x*Int:size
  status := shunt s=success success failure

function random n -> r
  arg Int n r
  memory_strong_random addressof:(var uInt u) uInt:size
  # memory_random addressof:(var uInt u) uInt:size
  r := u%(cast n uInt)

function distance m x y radius x_stretch y_stretch -> d
  arg DitherMatrix m ; arg Int x y radius x_stretch y_stretch ; arg Float d
  var Int radius2 := radius*radius
  d := 0
  for (var Int yy) y-radius y+radius
    var Int dy2 := (yy-y)*(yy-y)*y_stretch*y_stretch
    if dy2<=radius2
      for (var Int xx) x-radius x+radius
        var Int d2 := (xx-x)*(xx-x)*x_stretch*x_stretch+dy2
        if d2<=radius2
          if (m cell xx yy)=defined
            d += 1/d2

function random_matrix sx sy try radius x_stretch y_stretch -> m
  arg Int sx sy try radius x_stretch y_stretch ; arg DitherMatrix m
  m resize sx sy
  var Int count := sx*sy
  (var Array:Int buffer_x) size := count
  (var Array:Int buffer_y) size := count
  for (var Int y) 0 sy-1
    for (var Int x) 0 sx-1
      m x y := undefined
      buffer_x x+y*sx := x
      buffer_y x+y*sx := y
  for (var Int index) 1 sx*sy
    part point "point "+string:index+"/"+(string sx*sy)
      var Int selected ; var Float best := undefined
      for (var Int lap) 1 (min (count+1)\2 try)
        var Int i := random count
        var Float d := distance m buffer_x:i buffer_y:i radius x_stretch y_stretch
        if best=undefined or d<best
          selected := i ; best := d
      m buffer_x:selected buffer_y:selected := index
      count -= 1
      buffer_x selected := buffer_x count
      buffer_y selected := buffer_y count

function is_prime n -> p
  arg Int n ; arg CBool p
  if n<2
    return false
  var Int i := 2
  while i*i<=n
    if n%i=0
      return false
    i += 1
  p := true

# driving the printer

function generator_prototype x y head level f -> dot
  arg Int x y head level ; arg Function f ; arg Int dot

type Escp2Level
  field uInt16 dot0 dot1
  field uInt32 remain

type Escp2Lut
  field Int light_threshold
  field Int light_removal
  field Int small
  field Int big_threshold

type Escp2Channel
  field (Array Escp2Level 256) level
  field (Array Escp2Lut 256) lut
  field DitherMatrix dither

type ImageWriteFilterEscp2
  field Pointer:Stream stream
  field Array:Address input_line
  field Int dim
  field Int size_x size_y
  field Int input_y input_line_size
  field Int dpi_x dpi_y space_x space_y heads jets dot_size bpc dot_levels
  field Array:Int shift
  field Array:Int pass ; field Int delta
  field CBool old coord4 job_ticket
  field Str command options
  field CBool advanced
  field Address output_lines ; field Int output_line_size
  field Int output_y
  field Int left top
  field Address buffer
  field (Array Escp2Channel heads_count) head
  if top_enhancement
    field (Array List:Str) top_lines

ImageWriteFilter maybe ImageWriteFilterEscp2

constant escape character:27

function num1 i -> s
  arg Int i ; arg Str s
  s := "1" ; s:characters map uInt8 := i

function num2 i -> s
  arg Int i ; arg Str s
  s := "12" ; s:characters map uInt16_li := i

function num4 i -> s
  arg Int i ; arg Str s
  s := "1234" ; s:characters map uInt32_li := i

function num2_or_4 coord4 i -> s
  arg CBool coord4 ; arg Int i ; arg Str s
  if coord4
    s := num4 i
    s := num2 i

function escp2 command parameters -> s
  arg Str command parameters s
  s := escape+"("+command+(num2 parameters:len)+parameters

function remote command parameters -> s
  arg Str command parameters s
  s := command+(num2 parameters:len)+parameters

method f open s options h -> status
  arg_rw ImageWriteFilterEscp2 f ; arg_rw Stream s ; arg Str options ; arg ImagePrototype h ; arg ExtendedStatus status
  # send printer setup commands, and copy the values we will need in the 'writeline' method
  if h:gamut:dimension<>1 and h:gamut:dimension<>3 and h:gamut:dimension<>4
    return failure:"Only black and white or CMY or CMYK images can be saved as .epson"
  var Int dpi_x dpi_y base_unit page_unit
  var Int heads jets dot_size bpc dot_levels space_x space_y
  var Int dpi_shift ; var Array:Int shift
  var Float page_x := undefined ; var Float page_y := undefined
  var Str command
  dpi_x := options option "escp2_dpi_x" Int (cast h:size_x/(abs h:x1-h:x0)*25.4 Int)
  dpi_y := options option "escp2_dpi_y" Int (cast h:size_y/(abs h:y1-h:y0)*25.4 Int)
  if (dpi_x%360<>0 or dpi_y%360<>0) and not (options option "escp2_force_resolution")
    return (failure "Incorrect resolution "+string:dpi_x+" x "+string:dpi_y+" dpi")
  base_unit := options option "escp2_base_unit" Int (max (max dpi_x dpi_y) 1440)
  page_unit := options option "escp2_page_unit" Int (max (max dpi_x dpi_y) 720)
  var Str model := options option "model" Str
  if model=""
    return failure:"You must specify the printer model"
  if model="Epson C80" or model="Epson C82"
    heads := 0Fh
    jets := shunt h:gamut:dimension=1 180 60
    dot_size := 12h
    if h:gamut:dimension<>1
      dpi_shift := 180 ; shift += 120 ; shift += 60 ; shift += 0 ; shift += 120
    space_x := dpi_x\360
    space_y := dpi_y\180
    page_x := 210
    page_y := 297
    command := ""
  eif model="Epson 750"
    heads := 3Fh
    jets := 48
    dot_size := 10h
    space_x := dpi_x\360
    space_y := dpi_y\120
    page_x := 210
    page_y := 297
    command := ""
  eif model="Epson 1280" or model="Epson 1290"
    heads := 3Fh
    jets := 48
    dot_size := 10h
    space_x := dpi_x\360
    space_y := dpi_y\120
    page_x := 13*25.4
    page_y := 19*25.4
    command := "coord4 zero_margin roll"
  eif model="Epson 2100" or model="Epson 2200"
    heads := 0BFh
    jets := 96
    dot_size := 10h
    if h:gamut:dimension<>1
      dpi_shift := 360 ; shift += 0 ; shift += 0 ; shift += 0 ; shift += 0 ; shift += 1 ; shift += 1 ; shift += 0 ; shift += 1
    space_x := dpi_x\360
    space_y := dpi_y\180
    page_x := 13*25.4
    page_y := 19*25.4
    command := "coord4 zero_margin roll co_cutter"
  eif model="Epson 3000"
    heads := 0Fh
    jets := shunt h:gamut:dimension=1 128 64
    dot_size := 1
    space_x := dpi_x\360
    space_y := dpi_y\180
    page_x := 17*25.4
    page_y := 44*25.4
    command := "old"
  eif model="Epson 4000"
    heads := 0BFh
    jets := 1
    dot_size := 12h
    space_x := 1
    space_y := 1
    page_x := 17*25.4
    page_y := 44*25.4
    command := "coord4 roll ac_cutter"
  eif model="Epson 7600" or model="Epson 9600" or model="Epson 10600"
    heads := shunt model="Epson 10600" 03Fh 0BFh
    jets := 1
    dot_size := 10h
    space_x := 1
    space_y := 1
    command := "coord4 roll ac_cutter"
    return (failure "'"+model+"' is not a valid printer model")
  command := options option "escp2_command" Str command
  var CBool old := command option "old"
  var CBool coord4 := command option "coord4"
  var CBool job_ticket := shunt (options option "escp2_job_ticket") true (options option "escp2_no_job_ticket") false not old
  heads := options option "escp2_heads" Int heads
  jets := options option "escp2_jets" Int jets
  dot_size := options option "escp2_dot_size" Int dot_size
  space_x := options option "escp2_space_x" Int space_x
  space_y := options option "escp2_space_y" Int space_y
  bpc := options option "escp2_bpc" Int (shunt old 1 2)
  dot_levels := options option "escp2_dot_levels" Int (shunt dpi_x>=1440 or dpi_y>=1440 1 2^bpc-1)
  var CBool roll := options option "roll"
  if not ((options (options option_position "margin" 0) options:len) parse word:"margin" (var Float margin_left) (var Float margin_top) (var Float margin_right) (var Float margin_bottom) any)
    margin_right := 0 ; margin_bottom := 0
    if not ((options (options option_position "offset" 0) options:len) parse word:"offset" (var Float margin_left) (var Float margin_top) any)
      margin_left := 0 ; margin_top := 0
  if not ((options (options option_position "page" options:len) options:len) parse word:"page" (var Float page_x) (var Float page_y) any)
    if roll or page_x=undefined or page_y=undefined
      page_x := margin_left+(abs h:x1-h:x0)+margin_right
      page_y := margin_top+(abs h:y1-h:y0)+margin_bottom
  margin_right := page_x-(abs h:x1-h:x0)-margin_left
  margin_bottom := page_y-(abs h:y1-h:y0)-margin_top
  if job_ticket and not (options option "esp2_no_ejl")
    s writechars "[0][0][0]"
    s writechars escape+character:1+"@EJL 1284.4[lf]@EJL     [lf]"
    s writechars escape+"@"
  s writechars escape+"@"
  if job_ticket
    s writechars (escp2 "R" "[0]REMOTE1")
    if (options option "escp2_paper")
      s writechars (remote "SN" "[0][0]"+character:(options option "escp2_paper" Int 0)) # paper 0=default, 1=plain, 3=glossy photo, 5=plain (fast load), 6=heavyweight matte, 7=coated, 8=photo
    if (options option "escp2_load")
      s writechars (remote "SN" "[0]"+character:2+character:(options option "escp2_load" Int 0)) # 0=normal, 1=fast, 2=slow
    if (command option "duplex") and ( (options option "front") or (options option "back"))
      s writechars (remote "SN" "[0]"+character:7+character:(shunt (options option "front") 1 2))
    if (command option "zero_margin")
      s writechars (remote "FP" "[0]"+character:B0h+character:0FFh) # zero margin
    if (command option "ac_cutter")
      s writechars (remote "AC" "[0]"+character:(shunt (options option "cutter") 1 0)) # cutter
    if (command option "co_cutter") and (options option "cutter")
      var Int cutter_unit := shunt page_unit=360 0 page_unit=720 1 page_unit=1440 2 (cast undefined Int)
      if cutter_unit=defined
        if (options option "double_cut")
          s writechars (remote "CO" "[0][0]"+character:1+character:cutter_unit+"[0][0][0][0]")
        s writechars (remote "CO" "[0][0]"+character:0+character:cutter_unit+num4:(cast page_y*page_unit/25.4 Int))
    if (options option "escp2_dry")
      s writechars (remote "DR" "[0][0]"+num2:(cast (options option "escp_dry" Float 0)*1000 Int)) # dry time between scan lines
    if (options option "escp2_pause")
      s writechars (remote "DR" "[0]"+character:1+num2:(cast (options option "escp_dry" Float 0) Int)) # dry time between page
    if (options option "escp2_ink")
      s writechars (remote "IK" "[0]"+character:(options option "escp2_ink" Int 0))
    if (command option "roll")
      s writechars (remote "EX"  "[0][0][0][0]"+character:5+character:(shunt roll 1 0)) # roll
    if (options option "escp2_thickness")
      s writechars (remote "PH" "[0]"+character:(cast (options option "escp2_thickness" Float 0)*10 Int))
    s writechars escape+"[0][0][0]"
  s writechars (escp2 "G" character:1) # graphic mode
  if not old
    s writechars (escp2 "U" (num1 base_unit\page_unit)+(num1 base_unit\dpi_y)+(num1 base_unit\dpi_x)+num2:base_unit)
    s writechars (escp2 "U" (num1 3600\dpi_y))
  s writechars (escp2 "K" "[0]"+character:2) # color mode
  s writechars (escp2 "i" character:(options option "escp2_microweave" Int 0)) # microweave
  s writechars escape+"U"+character:(shunt (options option "unidirectional") 1 0) # unidirectional
  s writechars (escp2 "e" "[0]"+character:dot_size) # set dots size
  if not old
    s writechars (escp2 "D" num2:14400+(num1 14400\dpi_y*space_y)+(num1 14400\dpi_x*space_x)) # dots spacing
  if not (options option "escp2_no_page")
    s writechars (escp2 "C" (num2_or_4 coord4 (cast page_y*page_unit/25.4 Int))) # page length
    # desable vertical margin in order to allow vertical units to start right at the top of the page
    s writechars (escp2 "c" (num2_or_4 coord4 0)+(num2_or_4 coord4 (cast page_y*page_unit/25.4 Int))) # vertical margin
  if (options option "escp2_sheet") and ((options (options option_position "sheet" options:len) options:len) parse word:"sheet" (var Float sheet_x) (var Float sheet_y) any)
    s writechars (escp2 "S" num4:(cast sheet_x*page_unit/25.4 Int)+num4:(cast sheet_y*page_unit/25.4 Int)) # sheet size
  f stream :> s
  f:input_line size := h size_y
  for (var Int y) 0 f:input_line:size-1
    f:input_line y := null
  f dim := h:gamut dimension
  f size_x := h size_x
  f size_y := h size_y
  f input_y := 0 ; f input_line_size := h line_size
  f dpi_x := dpi_x
  f dpi_y := dpi_y
  f space_x := space_x
  f space_y := space_y
  f heads := heads
  f jets := jets
  f dot_size := dot_size
  f dot_levels := dot_levels
  f bpc := bpc
  f:shift size := heads_count
  var Int sm := 0
  for (var Int i) 0 heads_count-1
    if i<shift:size
      f:shift i := shift:i*dpi_y\dpi_shift
      sm := max sm f:shift:i
      f:shift i := 0
  f delta := jets*space_y+sm
  f old := old
  f coord4 := coord4
  f job_ticket := job_ticket
  f command := command ; f options := options
  f advanced := options option "escp2_advanced"
  f:pass size := h:size_y+2*f:delta
  for (var Int y) 0 f:pass:size-1
    f:pass y := 0
  f output_line_size := (h:size_x\space_x*bpc+7)\8
  f output_lines := memory_allocate f:output_line_size*jets addressof:f
  f output_y := -(f delta)
  f left := cast margin_left*dpi_x/25.4 Int
  if top_enhancement
    f top := cast margin_top*dpi_y/25.4 Int
    f top := max (cast margin_top*dpi_y/25.4 Int) f:delta
  f buffer := memory_allocate 2*f:output_line_size*jets+4 addressof:f
  for (var Int i) 0 heads_count-1
    if (heads .and. 2^i)<>0
      var Pointer:Escp2Channel ch :> f:head i
      var Float middle := options option "escp2_middle"+(string i%4) Float (options option "escp2_middle" Float 0)
      var Float density := options option "escp2_density"+(string i%4) Float (options option "escp2_density" Float 1)
      if i<4
        if (ch:dither load "file:/pliant_data/pliant/graphic/dithering/matrix"+string:i+(shunt dpi_x>dpi_y "x" "")+(shunt dpi_y>dpi_x "y" "")+".bin")=failure
          var Int m1 := options option "escp2_matrix_mini" Int matrix_mini
          var Int m2 := options option "escp2_matrix_maxi" Int matrix_maxi
          part shake "select dithering pattern size for channel "+string:i
            part shake_x
              var Int sx := m1+(random m2-m1+1)
              if not is_prime:sx
                restart shake_x
            part shake_y
              var Int sy := m1+(random m2-m1+1)
              if not is_prime:sy
                restart shake_y
            for (var Int j) 0 i-1
              if f:head:j:dither:size_x=sx or f:head:j:dither:size_y=sy
                restart shake
          part matrix "compute "+string:sx+" x "+string:sy+" dithering matrix for channel "+string:i
            ch dither := random_matrix sx sy 64 16 (shunt dpi_y>dpi_x 2 1) (shunt dpi_x>dpi_y 2 1)
          ch:dither save "file:/pliant_data/pliant/graphic/dithering/matrix"+string:i+(shunt dpi_x>dpi_y "x" "")+(shunt dpi_y>dpi_x "y" "")+".bin"
        ch dither := dither_matrix i "dpi_x "+string:dpi_x+" dpi_y "+string:dpi_y
      var CBool light_available := (heads .and. 2^(i%4+4))<>0
      var Int nb := f:head:(i%4):dither:size_x*f:head:(i%4):dither:size_y
      if not f:advanced
        var Float light_gain := options option "escp2_light_gain"+(string i%4) Float (options option "escp2_light_gain" Float 0.25)
        var Float light_removal_start := options option "escp2_light_removal_start"+(string i%4) Float (options option "escp2_light_removal_start" Float 0.0625)
        var Float light_removal_power := options option "escp2_light_removal_power"+(string i%4) Float (options option "escp2_light_removal_power" Float 1.25)
        var Float big_start := options option "escp2_big_start"+(string i%4) Float (options option "escp2_big_start" Float 0.5)
        var Float big_power := options option "escp2_big_power"+(string i%4) Float (options option "escp2_big_power" Float 2)
        var CBool oops := false
        for (var Int j) 0 255
          var Pointer:Escp2Lut ll :> ch:lut j
          var Float d := j/255
          d := (exposure d middle)*density
          d := dot_adjust d "header [dq]escp2_head"+(string i%4)+"_[dq] header2 [dq]escp2_[dq] "+options
          ll light_threshold := shunt not light_available 0 (cast (exposure d light_gain)*nb Int)
          ll light_removal := shunt d<=light_removal_start 0 (cast ((d-light_removal_start)/(1-light_removal_start))^light_removal_power*nb Int)
          ll small := cast d*nb Int
          ll big_threshold := shunt dot_levels=1 0 d<=big_start 0 (cast ((d-big_start)/(1-big_start))^big_power*nb Int)
          if ll:light_threshold>0 and ll:light_removal<ll:big_threshold
            oops := true
        if oops
          console "Light/big point selection conflict in ESCP2 driver" eol
        var Str bend := string (options option "escp2_bend"+(string i%4) Float (options option "escp2_bend" Float -0.1))
        var Str ident := shunt (options option "escp2_dot"+(string i%4)) "escp2_dot"+(string i%4) "escp2_dot"
        var Str opt := shunt (options option ident) options bpc=1 "escp2_dot -1 0.5 "+bend+" escp2_dot 1 1 "+bend "escp2_dot -1 0.333 "+bend+" escp2_dot 1 0.667 "+bend+" escp2_dot 3 1 "+bend
        var Array:Int dot ; var Array:Float dot_density ; var Array:Float dot_bend
        dot size := 0 ; dot_density size := 0 ; dot_bend size := 0
        dot += 0 ; dot_density += 0 ; dot_bend += 0
        var Int j := 0
        while (opt option_position ident j -1)>=0
          if not ((opt (opt option_position ident j opt:len) opt:len) parse word:ident (var Int dot0) (var Float density0) (var Float bend0) any)
            return (failure "Icorrect '"+ident+"' parameter")
          if light_available or dot0>=0
            dot += shunt i<4 and dot0>0 dot0 i>=4 and dot0<0 -dot0 0 ; dot_density += density0 ; dot_bend += bend0
          j += 1
        for (var Int j) 0 255
          var Float d := j/255
          d := (exposure d middle)*density
          d := dot_adjust d "header [dq]escp2_head"+(string i%4)+"_[dq] header2 [dq]escp2_[dq] "+options
          var Int k := 0
          while k+2<dot_density:size and d>=(dot_density k+1)
            k += 1
          var Pointer:Escp2Level l :> ch:level j
          l dot0 := dot k
          l dot1 := dot k+1
          l remain := cast (exposure (d-dot_density:k)/(dot_density:(k+1)-dot_density:k) dot_bend:(k+1))*nb Int
  status := success

method f writeline adr -> status
  arg_rw ImageWriteFilterEscp2 f ; arg Address adr ; arg Status status
  var Pointer:Stream s :> f stream
  implicit f

    # record the newly provided line
    input_line input_y := memory_allocate input_line_size addressof:f
    memory_copy adr input_line:input_y input_line_size
    input_y += 1

    while output_y<size_y
      if (pass output_y+delta)=2^space_x-1
        output_y -= 1
      while (pass output_y+delta)=2^space_x-1
        output_y += 1
      var Int p := 0
      while ((pass output_y+delta) .and. 2^p)<>0
        p += 1
      # 'first_line' and 'lines_count' is specifying the limits of the pass we are planing to send
      for (var Int h) 0 heads_count-1
        for (var Int j) 0 jets-1
          var Int y := output_y+shift:h+j*space_y
          if y>=0 and y<size_y and input_line:y=null
            # one input line is missing: wait until the input data is received
            return success
      if verbose
        console "escp2 line " output_y "/" size_y "   [cr]"
      # everything is fine for the pass: let's send it to the printer
      var CBool vpos := true
      for (var Int h) 0 heads_count-1
        var Int first_line := output_y+shift:h
        var Int lines_count := min (size_y-first_line+space_y-1)\space_y jets
        if (heads .and. 2^h)<>0 and lines_count>0 and (shunt dim=1 h%4=3 h%4<dim)
          memory_clear f:output_lines output_line_size*lines_count ; var CBool some := false
          for (var Int j) 0 lines_count-1
            var Int y := first_line+j*space_y
            if y>=0
              var Address src := input_line:y translate uInt8 p*dim+(shunt dim=1 0 h%4)
              var Int src_step := space_x*dim
              if exists:escp2_generator
                for (var Int x) p size_x-1 step space_x
                  var Int l := src map uInt8
                  var Int d := generator_prototype x y h l escp2_generator
                  if d<>0
                    output_lines map uInt8 j*output_line_size+(x\space_x)*bpc\8 += d*2^(8-bpc-(x\space_x)*bpc%8)
                    some := true
                  src := src translate uInt8 src_step
              eif not f:advanced
                var Address dest := output_lines translate uInt8 j*output_line_size+(p\space_x)*bpc\8
                var Int shift := 8-bpc-(p\space_x)*bpc%8
                var Int shift_step := bpc
                var Pointer:(Array Escp2Lut 256) lut :> f:head:h:lut
                var Pointer:DitherMatrix dither_matrix :> f:head:(h%4):dither
                var Address dither := addressof (dither_matrix 0 y%dither_matrix:size_y)
                var Int modulus := dither_matrix size_x
                if false # unoptimised version
                  for (var Int x) p size_x-1 step space_x
                    var Int l := src map uInt8
                    # handle pixel 'x' 'y' on head 'h' , which level is 'l'
                    if l<>0
                      var Int d # 'd' will be the dot size
                      var Pointer:Escp2Lut ll :> lut l  
                      var Int t := dither map Int x%modulus
                      var CBool light := ll:light_threshold>=t and not ll:light_removal>=t
                      var CBool big := ll:big_threshold>=t
                      var CBool small := ll:small>=t and not light and not big
                      if h<4
                        d := shunt big 3 small 1 0
                        d := shunt light 1 0
                      if d<>0
                        dest map uInt8 += d*2^shift
                        some := true
                    src := src translate uInt8 src_step
                    if shift>0
                      shift -= shift_step
                      dest := dest translate uInt8 1 ; shift += 8-shift_step
                eif h<4 and (heads .and. 2^(h+4))=0
                  for (var Int x) p size_x-1 step space_x
                    var Int l := src map uInt8
                    if l<>0
                      var Pointer:Escp2Lut ll :> lut l  
                      var Int t := dither map Int x%modulus
                      if ll:big_threshold>=t
                        dest map uInt8 += 3*2^shift
                        some := true
                      eif ll:small>=t
                        dest map uInt8 += 2^shift
                        some := true
                    src := src translate uInt8 src_step
                    if shift>0
                      shift -= shift_step
                      dest := dest translate uInt8 1 ; shift += 8-shift_step
                eif h<4
                  for (var Int x) p size_x-1 step space_x
                    var Int l := src map uInt8
                    if l<>0
                      var Pointer:Escp2Lut ll :> lut l  
                      var Int t := dither map Int x%modulus
                      if ll:big_threshold>=t
                        dest map uInt8 += 3*2^shift
                        some := true
                      eif ll:small>=t and not (ll:light_threshold>=t and not ll:light_removal>=t)
                        dest map uInt8 += 2^shift
                        some := true
                    src := src translate uInt8 src_step
                    if shift>0
                      shift -= shift_step
                      dest := dest translate uInt8 1 ; shift += 8-shift_step
                else # h>=4
                  for (var Int x) p size_x-1 step space_x
                    var Int l := src map uInt8
                    if l<>0
                      var Pointer:Escp2Lut ll :> lut l  
                      var Int t := dither map Int x%modulus
                      if ll:light_threshold>=t and not ll:light_removal>=t
                        dest map uInt8 += 2^shift
                        some := true
                    src := src translate uInt8 src_step
                    if shift>0
                      shift -= shift_step
                      dest := dest translate uInt8 1 ; shift += 8-shift_step
              else # advanced
                var Address dest := output_lines translate uInt8 j*output_line_size+(p\space_x)*bpc\8
                var Int shift := 8-bpc-(p\space_x)*bpc%8
                var Int shift_step := bpc
                var Pointer:(Array Escp2Level 256) levels :> f:head:h:level
                var Pointer:DitherMatrix dither_matrix :> f:head:(h%4):dither
                var Address dither := addressof (dither_matrix 0 y%dither_matrix:size_y)
                var Int modulus := dither_matrix size_x
                for (var Int x) p size_x-1 step space_x
                  var Int l := src map uInt8
                  if l<>0
                    var Pointer:Escp2Level level :> levels l  
                    var Int d := shunt level:remain>=(dither map Int x%modulus) level:dot1 level:dot0
                    if d<>0
                      dest map uInt8 += d*2^shift
                      some := true
                  src := src translate uInt8 src_step
                  if shift>0
                    shift -= shift_step
                    dest := dest translate uInt8 1 ; shift += 8-shift_step
          var Address lines_buffer := output_lines
          if top_enhancement
            var Int delta_y := 0
            while top+output_y+delta_y*space_y<0
              delta_y += 1
            lines_buffer := lines_buffer translate Byte delta_y*output_line_size
            lines_count -= delta_y
          if lines_count>0 and some
            if (options option "escp2_fill") and lines_count<jets
              memory_move lines_buffer output_lines lines_count*output_line_size
              lines_buffer := output_lines
              memory_clear (lines_buffer translate Byte lines_count*output_line_size) (jets-lines_count)*output_line_size
              lines_count := jets
            var Str cmd := ""
            if vpos
              if top_enhancement
                cmd += escp2 "V" (num2_or_4 coord4 top+output_y+delta_y*space_y)
                cmd += escp2 "V" (num2_or_4 coord4 top+output_y)
              vpos := false
            if coord4
              cmd += escp2 "$" (num4 left+p)
              cmd += escape+"$"+(num2 left+p)
            if not f:old
              cmd += escape+"i"+character:(shunt h=0 2 h=1 1 h=2 4 h=3 0 h=4 18 h=5 17 h=6 20 h=7 16 0)+character:(shunt packbits 1 0)+character:bpc+num2:output_line_size+num2:lines_count
              cmd += escape+"r"+character:(shunt h=0 2 h=1 1 h=2 4 h=3 0 h=4 18 h=5 17 h=6 20 h=7 16 0)
              cmd += escape+"."+character:(shunt packbits 1 0)+(num1 3600\(dpi_y\space_y))+(num1 3600\(dpi_x\space_x))+num1:lines_count+(num2 output_line_size*8\bpc)
            var Address data ; var Int length
            if packbits
              data := buffer
              length := packbits_encode lines_buffer buffer lines_count*output_line_size
              data := lines_buffer
              length := lines_count*output_line_size
            if top_enhancement and delta_y<>0
              var Int i := top+output_y+delta_y*space_y
              if i>=top_lines:size
                top_lines size := i+1
              top_lines i += cmd
              (var Str lbuf) set data length false
              top_lines i += lbuf
              top_lines i += "[cr]"
              if top_enhancement and top_lines:size>0
                for (var Int i) 0 (min top+output_y top_lines:size-1)
                  if (exists top_lines:i:first)
                    var Pointer:Str ptr :> top_lines:i first
                    while exists:ptr
                      s writechars ptr
                      ptr :> top_lines:i next ptr
                    top_lines i := var List:Str empty_list
                if top+output_y>=top_lines:size
                  top_lines size := 0
              s writechars cmd
              s raw_write data length
              s writechars "[cr]"
      # ajust the number of pass already done for each line, then drop the input lines we will not use anymore
      for (var Int j) 0 jets-1
        var Int y := output_y+j*space_y
        check ((pass y+delta) .and. 2^p)=0
        pass y+delta += 2^p
      for (var Int y) output_y-2 output_y+jets\space_x-2 # -2 instead of -1 because output_y may later be decreased by one
        if y>=0 and y<size_y
          memory_free f:input_line:y
          f:input_line y := null
      output_y := output_y+jets\space_x
  status := success

method f close -> status
  arg_rw ImageWriteFilterEscp2 f ; arg ExtendedStatus status
  # send printer termination commands
  implicit f
    for (var Int y) 0 size_y-1
      check (pass y+delta)=2^space_x-1
      if f:input_line:y<>null
        memory_free f:input_line:y
  var Pointer:Stream s :> f stream
  s writechars character:0Ch
  s writechars escape+"@"
  if f:job_ticket
    s writechars (escp2 "R" "[0]REMOTE1")
    if (f:options option "escp2_je")
      s writechars (remote "JE" "[0]") # job end
    s writechars (remote "LD" "")
    s writechars escape+"[0][0][0]"
  memory_free f:output_lines
  memory_free f:buffer
  if verbose
    console (repeat 60 " ")+"[cr]"
  status := success

image_record_filters ".escp2" Void false ImageWriteFilterEscp2 false
export escp2_generator