Patch title: Release 81 bulk changes
Abstract:
File: /pliant/graphic/filter/escp2.pli
Key:
    Removed line
    Added line
# Copyright  Hubert Tonneau  hubert.tonneau@pliant.cx
#
# 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 "/pliant/graphic/misc/float.pli"
module "prototype.pli"
module "/pliant/graphic/color/gamut.pli"
module "/pliant/util/encoding/packbits.pli"

constant packbits true
constant noise_divisor 16
constant heads_count 8


#---------------------------------------------------------------
# rotation


type Rotation
  field Float c1 c2

function rotation angle -> r
  arg Float angle ; arg Rotation r
  var Float a := angle/180*pi
  r c1 := -(tan a/2)
  r c2 := sin a

method r apply x y rx ry
  arg Rotation r ; arg Int x y ; arg_w Int rx ry
  rx := x ; ry := y
  ry += cast r:c1*rx Int
  rx += cast r:c2*ry Int
  ry += cast r:c1*rx Int


gvar Array:Rotation head_rotation
function init_rotation
  check heads_count=8
  head_rotation size := 8
  head_rotation 0 := rotation 55
  head_rotation 1 := rotation 10+90
  head_rotation 2 := rotation 30+180
  head_rotation 3 := rotation 80+270
  for (var Int i) 4 7
    head_rotation i := head_rotation i-4
init_rotation


#---------------------------------------------------------------
# dithering matrix


type DitherMatrix
  field 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_x*size_y

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 x+y*m:size_x

method m cell xx yy -> coef
  arg DitherMatrix m ; arg Int xx yy ; arg 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 x+y*m:size_x


function regular_dither_matrix n -> m
  arg Int n ; arg DitherMatrix m
  if n=1
    m resize 1 1
    m 0 0 := 0
  else
    var DitherMatrix r := regular_dither_matrix n\2
    m resize n n
    for (var Int y) 0 n-1
      for (var Int x) 0 n-1
        var Int d := x\(n\2)+2*(y\(n\2))
        m x y := 4*(r x%(n\2) y%(n\2))+(shunt d=0 0 d=1 2 d=2 3 1)
  
gvar DitherMatrix dither_matrix := regular_dither_matrix 16


#---------------------------------------------------------------
# dot selection


function correct x gg -> y
  arg Float x gg y
  var Float g := -8*gg
  y := ((exp x*g)-1)/(exp:g-1)
  if y=undefined
    y := x


gvar (Array Int 256) light_threshold light_removal big_threshold
function init_dot
  for (var Int l) 0 255
    light_threshold l := cast (correct l/255 0.20)*255 Int
    light_threshold l := cast (correct l/255 0.25)*255 Int
    light_removal l := shunt l<=16 0 (cast ((l-16)/(255-16))^1.25*255 Int)
    big_threshold l := shunt l<=128 0 (cast ((l-128)/(255-128))^2.5*255 Int)
    big_threshold l := shunt l<=128 0 (cast ((l-128)/(255-128))^2*255 Int)
init_dot


#---------------------------------------------------------------
# driving the printer


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


type ImageWriteFilterEpson
  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 space_x space_y heads jets dot_size dot_levels bpc
  field Array:Int shift
  field Array:Int pass ; field Int delta
  field Address output_lines ; field Int output_line_size
  field Int output_y
  field Int left top
  field Link:Function generator
  field Address buffer

ImageWriteFilter maybe ImageWriteFilterEpson


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 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 ImageWriteFilterEpson 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
  var Int heads jets dot_size dot_levels bpc space_x space_y ; var Array:Int shift
  var Float page_x page_y
  var Float page_x := undefined ; var Float page_y := undefined
  var Str command
  var Str model := options option "model" Str
  if model=""
    return failure:"You must specify the printer model"
  dpi_x := cast h:size_x/(h:x1-h:x0)*25.4 Int
  dpi_y := cast h:size_y/(h:y1-h:y0)*25.4 Int
  bpc := options option "escp2_bpc" Int 2
  if 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 := "margin4 zero_margin roll"
  eif model="Epson C80"
    heads := 0Fh
    jets := shunt h:gamut:dimension=1 180 60
    dot_size := 12h
    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 2100" or model="Epson 2200"
    heads := 0BFh
    jets := 96
    dot_size := 10h
    space_x := dpi_x\360
    space_y := dpi_y\180
    page_x := 13*25.4
    page_y := 19*25.4
    command := "margin4 roll"
  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 := "margin4 roll"
  else
    return (failure "'"+model+"' is not a valid printer model")
  dot_size := options option "escp2_dot_size" Int dot_size
  dot_levels := options option "escp2_dot_levels" Int (shunt dpi_x>=1440 or dpi_y>=1440 1 2^bpc-1)
  if ((options (options option_position "page" options:len) options:len) parse word:"page" (var Float px) (var Float py) any)
    page_x := px ; page_y := py
  if not ((options (options option_position "offset" 0) options:len) parse word:"offset" (var Float offset_x) (var Float offset_y) any)
    offset_x := 0 ; offset_y := 0
  s writechars "[0][0][0]"
  s writechars escape+character:1+"@EJL 1284.4[lf]@EJL     [lf]"
  s writechars escape+"@"
  s writechars escape+"@"
  s writechars (escp2 "R" character:0+"REMOTE1")
  # s writechars (remote "PM" "[0][0]") # unknown
  s writechars (remote "SN" "[0][0]"+character:0) # paper 0=default, 1=plain, 3=glossy photo, 5=plain (fast load), 6=heavyweight matte, 7=coated, 8=photo
  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
  # s writechars (remote "IR" "[0]"+character:3) # unkown
  if (command+" "+options option "roll")
    s writechars (remote "EX"  "[0][0][0][0]"+character:5+character:(shunt (options option "roll") 1 0)) # roll
  s writechars escape+"[0][0][0]"
  s writechars (escp2 "G" character:1) # graphic mode
  var Int base := 2880 ; var Int page_unit := 720
  s writechars (escp2 "U" (num1 base\page_unit)+(num1 base\dpi_y)+(num1 base\dpi_x)+num2:base)
  s writechars (escp2 "K" character:0+character:2) # color mode
  s writechars (escp2 "i" character:0) # no microweave
  s writechars escape+"U"+character:(shunt (options option "bidirectional") 0 1) # unidirectional
  s writechars escape+"U"+character:(shunt (options option "unidirectional") 1 0) # unidirectional
  # s writechars (escp2 "s" character:2) # head speed: not recommended by Robert L Krawitz
  s writechars (escp2 "e" character:0+character:dot_size) # set dots size
  s writechars (escp2 "D" num2:14400+(num1 14400\dpi_y*space_y)+(num1 14400\dpi_x*space_x)) # dots spacing
  s writechars (escp2 "C" num4:(cast page_y/25.4*page_unit Int)) # page length
  if (command option "margin4")
    s writechars (escp2 "c" num4:0+num4:(cast page_y/25.4*page_unit Int)) # vertical margin
  else
    s writechars (escp2 "c" num2:0+num2:(cast page_y/25.4*page_unit Int))
  s writechars (escp2 "s" num4:(cast page_x/25.4*page_unit Int)+num4:(cast page_y/25.4*page_unit Int)) # page size
  if page_x=defined
    s writechars (escp2 "s" num4:(cast page_x/25.4*page_unit Int)+num4:(cast page_y/25.4*page_unit Int)) # page 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 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 := shift
  while f:shift:size<heads_count
    f shift += 0
  var Int sm := 0
  for (var Int i) 0 heads_count-1
    sm := max sm f:shift:i
  f delta := (jets+sm)*space_y 
  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 offset_x/25.4*dpi_x Int
  f top := max (cast offset_y/25.4*dpi_y Int) f:delta
  f buffer := memory_allocate 2*f:output_line_size*jets+4 addressof:f
  status := success


method f writeline adr -> status
  arg_rw ImageWriteFilterEpson 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
      console "epson line " output_y "/" size_y "   [cr]"
      # everything is fine for the pass: let's send it to the printer
      s writechars (escp2 "V" (num4 top+output_y))
      var CBool vpos := true
      for (var Int h) 0 heads_count-1
        var Int first_line := output_y+shift:h*space_y
        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)
          s writechars (escp2 "$" (num4 left+p))
          s writechars 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
          memory_clear f:output_lines output_line_size*lines_count
          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)
              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
                  if noise_divisor>0
                    memory_random addressof:(var Int r) Int:size
                    l += r % (((min l 255-l)+(noise_divisor-1))\noise_divisor+1)
                  head_rotation:h apply x y (var Int rx) (var Int ry)
                  var Int t := dither_matrix cell rx ry # 't' is the threshold for the point in the dither matrix
                  if exists:generator
                    generator_prototype x y h d l generator
                    if l<=t
                      d := 0
                  else
                    var CBool light := (heads .and. 2^(4+(h%4)))<>0 and light_threshold:l>t and not light_removal:l>t
                    var CBool big := dot_levels>1 and big_threshold:l>t
                    var CBool small := l>t and not light and not big
                    if h<4
                      d := shunt big 3 small 1 0
                    else
                      d := shunt light 1 0
                  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 space_x*dim
          if packbits
            var Int csize := packbits_encode output_lines buffer lines_count*output_line_size
            s raw_write buffer csize
          else
            s raw_write output_lines lines_count*output_line_size
          s writechars "[cr]"
          if some
            if vpos
              s writechars (escp2 "V" (num4 top+output_y))
              vpos := false
            s writechars (escp2 "$" (num4 left+p))
            s writechars 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
            if packbits
              var Int csize := packbits_encode output_lines buffer lines_count*output_line_size
              s raw_write buffer csize
            else
              s raw_write output_lines lines_count*output_line_size
            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
        if (pass y+delta)=2^space_x-1 and y>=0 and y<size_y
          memory_free f:input_line:y
          f:input_line y := cast -1 Address
      output_y += jets\space_x
  status := success


method f close -> status
  arg_rw ImageWriteFilterEpson 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
  var Pointer:Stream s :> f stream
  s writechars character:0Ch
  s writechars escape+"@"
  s writechars (escp2 "R" character:0+"REMOTE1")
  s writechars (remote "IR" "[0]"+character:2)
  s writechars (remote "LD" "")
  s writechars (remote "JE" "[0]")
  s writechars escape+"[0][0][0]"
  memory_free f:output_lines
  memory_free f:buffer
  console (repeat 60 " ")+"[cr]"
  status := success


image_record_filters ".escp2" Void ImageWriteFilterEpson