Patch title: Release 81 bulk changes
Abstract:
File: /pliant/graphic/color/editor.page
Key:
    Removed line
    Added line
module "/pliant/language/unsafe.pli"
module "/pliant/graphic/misc/float.pli"
module "/pliant/admin/file.pli"
module "/pliant/protocol/http/uvar.pli"
module "database.pli"
module "spectrum.pli"
module "color.pli"
module "adjust.pli"
module "gradation.pli"
module "ink.pli"
module "gamut.pli"
module "spectro.pli"

module "/pliant/math/curve.pli"
module "/pliant/graphic/image/prototype.pli"
module "/pliant/graphic/image/pixmap.pli"
module "/pliant/graphic/filter/io.pli"
module "/pliant/util/encoding/http.pli"

requires "color_administrator"

gvar CBool initialized
constant { initialized := false }

if (options option "device") and (options option "channel")
  var Link:ImagePixmap img :> new ImagePixmap
  img setup (image_prototype 0 0 501 501 501 501 color_gamut:"rgb") ""
  var ColorRGB888 black ; black r := 0 ; black g := 0 ; black b := 0
  var ColorRGB888 dark ; dark r := 40h ; dark g := 40h ; dark b := 40h
  var ColorRGB888 middle ; middle r := 80h ; middle g := 80h ; middle b := 80h
  var ColorRGB888 light ; light r := 0C0h ; light g := 0C0h ; light b := 0C0h
  img fill 0 0 501 501 addressof:light
  for (var Int i) 0 500 step 5
    for (var Int j) 0 500 step 5
      (img pixel i j) map ColorRGB888 := shunt i%50=0 or j%50=0 black i%25=0 or j%25=0 dark middle
  for (var Int i) 0 2
    for (var Int j) 0 2
      for (var Int k) -2 2
        var Int xx := i*250+k
        var Int yy := j*250
        if xx>=0 and xx<=500 and yy>=0 and yy<=500
          (img pixel xx yy) map ColorRGB888 := black
        var Int xx := i*250
        var Int yy := j*250+k
        if xx>=0 and xx<=500 and yy>=0 and yy<=500
          (img pixel xx yy) map ColorRGB888 := black
  var Data:ColorChannel ch :> color_database:data:device:(options option "device" Str):channel:(options option "channel" Str)
  var ColorSpectrum32 z_s0 := ch s0
  var ColorSpectrum32 z_s100 := ch s100
  if z_s0=undefined and z_s100=undefined
    return
  var Curve curve := var Curve empty_curve
  var Curve curve1 := var Curve empty_curve
  var Curve curve2 := var Curve empty_curve
  var Curve curve3 := var Curve empty_curve
  var Float range_x := 1
  var Float range_y := 1
  each sample ch:sample filter (keyof:sample parse (var Int i)) sort (right keyof:sample 9 " ")
    keyof:sample parse (var Float x)
    var Float y := ink_density color_spectrum32:sample z_s0 z_s100
    curve through x y
    curve1 through x y
    var Float y := ink_surface color_spectrum32:sample z_s0 z_s100
    curve2 through x y
    var Float y := ink_thickness color_spectrum32:sample z_s0 z_s100
    curve3 through x y
    range_x := max range_x x
    range_y := max range_y y
  curve compute y_from_x
  if curve=success
  curve1 compute y_from_x
  curve2 compute y_from_x
  curve3 compute y_from_x
  if curve3=success
    var ColorRGB888 blue ; blue r := 0 ; blue g := 0 ; blue b := 255
    for (var Int i) 0 500
      var Float y := (curve3 y i/500*range_x 1e-6)/range_y
      if y=defined
        var Int j := cast y*500 Int
        if j>=0 and j<=500
          (img pixel i 500-j) map ColorRGB888 := blue
  if curve2=success
    var ColorRGB888 green ; green r := 0 ; green g := 255 ; green b := 0
    for (var Int u) 0 100
      var Int i := cast (curve x_param u/100)/range_x*500 Int
      var Int j := cast (curve y_param u/100)/range_y*500 Int
      if i>=0 and i<=500 and j>=0 and j<=500
        (img pixel i 500-j) map ColorRGB888 := green
    for (var Int i) 0 500
      var Float y := (curve2 y i/500*range_x 1e-6)/range_y
      if y=defined
        var Int j := cast y*500 Int
        if j>=0 and j<=500
          (img pixel i 500-j) map ColorRGB888 := green
  if curve1=success
    var ColorRGB888 red ; red r := 255 ; red g := 0 ; red b := 0
    for (var Int i) 0 500
      var Float y := (curve y i/500*range_x 1e-6)/range_y
      var Float y := (curve1 y i/500*range_x 1e-6)/range_y
      if y=defined
        var Int j := cast y*500 Int
        if j>=0 and j<=500
          (img pixel i 500-j) map ColorRGB888 := red
  reset_http_answer
  http_request answer_mime_type := "image/png"
  http_request send_header
  img save http_stream "filter [dq].png[dq]"
  http_request send_footer
  return
  
title "Color database editor"

page button "load new parameters in the ripping server"
  color_ink_cache_reset
  color_gamut_cache_reset
  file_tree_delete "data:/pliant/graphic/cache/"
  color_version += 1
  reload_page

uvar Str src_gamut_name densities dest_gamut_name

page note "sample color conversion tool"
  title "Sample color conversion"
  input "Source gamut: " src_gamut_name length 80
  input "Source densities (in %): " densities length 40
  input "Destination gamut: " dest_gamut_name length 80
  button "Compute"
    reload_page
  para
    var Link:ColorGamut src_gamut :> color_gamut src_gamut_name
    var Link:ColorGamut dest_gamut :> color_gamut dest_gamut_name
    if src_gamut=success and dest_gamut=success
      table columns 5 border 0
        var ColorBuffer pixel
        cell
          table columns 2
            var Str all := densities ; var Int i := 0
            while i<gamut_maximum_dimension and i<src_gamut:dimension and (all parse (var Float d) any:(var Str remain))
              cell
                text (src_gamut query "component_name "+string:i)
              cell
                text string:d
              pixel:bytes i := cast d/100*255 Int
              all := remain ; i += 1
        var ColorXYZ color := src_gamut simulate addressof:pixel
        cell
          var ColorXYZn colorn := cast color ColorXYZn
          text "XYZn "+(string colorn:X "fixed 3")+" "+(string colorn:Y "fixed 3")+" "+(string colorn:Z "fixed 3") ; eol
          var ColorLCh lch := cast color ColorLCh
          text "LCh "+(string lch:L "fixed 1")+" "+(string lch:C "fixed 1")+" "+(string lch:h "fixed 0")
        var Str options := dest_gamut query "options"
        color_adjust color options
        cell
          var ColorXYZn colorn := cast color ColorXYZn
          text "XYZn "+(string colorn:X "fixed 3")+" "+(string colorn:Y "fixed 3")+" "+(string colorn:Z "fixed 3") ; eol
          var ColorLCh lch := cast color ColorLCh
          text "LCh "+(string lch:L "fixed 1")+" "+(string lch:C "fixed 1")+" "+(string lch:h "fixed 0")
        dest_gamut formulate color addressof:pixel
        cell
          table columns 2
            for (var Int i) 0 dest_gamut:dimension-1
              cell
                text (dest_gamut query "component_name "+string:i)
              cell
                text (string (cast pixel:bytes:i/255*1000 Int)/10)
        var ColorXYZ color := dest_gamut simulate addressof:pixel
        cell
          var ColorLCh lch := cast color ColorLCh
          text "LCh "+(string lch:L "fixed 1")+" "+(string lch:C "fixed 1")+" "+(string lch:h "fixed 0")

table columns 4
table columns 3
  cell header [Device]
  cell void
  cell header [Options]
  cell header [Comment]
  cell header [Description]
  each d color_database:data:device
    cell
      text keyof:d
    cell
      page button "edit"
        title "Color device '"+keyof:d+"'"
        input "Label: " d:label length 60
        input "Options: " d:options length 60 noeol
        page button "Update"
          color_version += 1
          goto_backward
        text_input "Comment: " d:comment columns 60 rows 10
        page note "printer settings used to build this profile"
          title "Printer settings for '"+keyof:d+"' color profile"
          var Data:ColorPrinter p :> d printer
          table columns 3 border 0
            cell [Driver:]
            cell
              input "" p:driver length 10
            cell
              [The filter is the Pliant driver.] ; eol
              [Most common filter are] ; fixed [ escp2 ] ; [for Epson stylus line,]
              fixed [ pcl ] ; [for HP Designjet (does not work on HP Desktop inkjet printers), ]
              [and ] ; fixed [ gimprint ] ; [if the printer will be driven using Gimp-print free software.]
            cell [Model:]
            cell
              input "" p:model length 20
            cell
              [Must be one of the models the driver is awared of.]
            cell [Extra options:]
            cell
              input "" p:options length 40
            cell
              [As an example, the] ; fixed [ escp2 ] ; [driver recognizes] ; fixed [ unidirectional ] ; [option.]
            cell [Paper name:]
            cell
              input "" p:paper length 40 noeol
            cell
              [This is informative only.]
            cell [Paper size:]
            cell
              input "" p:size_x length 4 noeol
              input " x " p:size_y length 4 noeol
              [ mm]
            cell
              void
            cell [Margins:]
            cell
              input "L" p:margin_left length 3 noeol
              input "T" p:margin_top length 3 noeol
              input "R" p:margin_right length 3 noeol
              input "B" p:margin_bottom length 3 noeol
              [ mm]
            cell
              void
            cell [R鳯lution:]
            cell
              input "" p:resolution_x length 4 noeol
              input " x " p:resolution_y length 4 noeol
              [ dpi]
            cell
              void
            cell [Antialiasing:]
            cell
              input "" p:antialiasing length 1
            cell
              [Use no antialiasing if your computer is slow, 2 if your computer is faster than the printer.] 
            cell [Sharpening:]
            cell
              input "" p:sharpening length 5
            cell
              [Leave it blank unless you want to experiment.]
            cell [Maximum density:]
            cell
              input "" p:limit length 5
            cell
              [Leave it blank unless you know what you do: this is not the right way to correct a poor calibration.]
            cell [Middle adjustment:]
            cell
              input "" p:middle length 5
            cell
              [Leave it blank unless you know what you do: this is not the right way to correct a poor calibration.]
            cell [Gamut:]
            cell
              input "" p:gamut length 40
            cell
              void
            cell [Calibration steps:]
            cell
              input "" p:grid_steps length 2
            cell
              [How many steps do we compute on the calibration grid in each dimension. ]
              [33 is perfect but will require several hours of calibration on a fast computer, 17 is high quality, and 9 is correct.]
          button "Update"
            goto_backward
        table columns 2 border 0
          cell [Description:]
          cell
            text_input "" d:comment columns 60 rows 10
          cell [Gamut extra options:]
          cell
            input "" d:options length 60 noeol
            button "Update"
              color_version += 1
              goto_backward
        table columns 5
          cell header [Ink]
          cell header [Sample]
          cell header [Opacity]
          cell void
          cell header [Options]
          each ch d:channel
            cell
              text keyof:ch
            var ColorSpectrum32 a_s0 := ch s0
            var ColorSpectrum32 a_s100 := ch s100
            if a_s0=defined and a_s100=defined
              var ColorRGB888 a_rgb := cast (filter_XYZ a_s100/a_s0) ColorRGB888
              # image "sample/r"+string:(cast a_rgb:r Int)+"g"+string:(cast a_rgb:g Int)+"b"+string:(cast a_rgb:b Int)
              cell color rgb a_rgb:r a_rgb:g a_rgb:b
                fixed [ ]
            else
              cell void
            cell
              if (ch:options option "opacity" Float)=defined
                text string:(ch:options option "opacity" Float)
            cell
              page button "edit"
                title "Ink '"+keyof:ch+"' for device '"+keyof:d+"'"
                var ColorSpectrum32 s0 := ch s0
                var ColorSpectrum32 s100 := ch s100
                var CBool composed := (keyof:ch search "+" -1)<>(-1)
                var Float specular := ch:options+" "+d:options option "specular" Float 0
                if s0=defined and s100=defined
                  para
                    check ColorSpectrum32:size=32*Float32:size
                    var Float mi := 1
                    var Float ma := 0
                    for (var Int w) 0 30
                      mi := min mi ((addressof:s100 translate Float32 w) map Float32)/((addressof:s0 translate Float32 w) map Float32)
                      ma := max ma ((addressof:s100 translate Float32 w) map Float32)/((addressof:s0 translate Float32 w) map Float32)
                    text "Reflexion range: "
                    fixed
                      text (string (cast mi*1000 Int)/1000)+" "+(string (cast ma*1000 Int)/1000)
                    eol
                    var ColorXYZ xyz := filter_XYZ s100/s0
                    text "XYZ: "
                    fixed
                      text (string xyz:X "fixed 3")+" "+(string xyz:Y "fixed 3")+" "+(string xyz:Z "fixed 3")
                    eol
                    var ColorYxy yxy := cast xyz ColorYxy
                    text "Yxy: "
                    fixed
                      text (string yxy:Y "fixed 3")+" "+(string yxy:x "fixed 3")+" "+(string yxy:y "fixed 3")
                    eol
                    var ColorLab lab := cast xyz ColorLab
                    text "L*a*b*: "
                    fixed
                      text (string lab:L "fixed 1")+" "+(string lab:a "fixed 1")+" "+(string lab:b "fixed 1")
                    eol
                    text "Specular: "+(string specular "fixed 3")
                    eol
                input "Options: " ch:options length 60 noeol
                page button "Update"
                  color_version += 1
                  goto_backward
                table columns (shunt composed 8 6)
                  cell header [Color]
                  cell header
                    [Linear[lf]Thickness[lf]Surface]
                  cell header [Density]
                  cell header [Opacity]
                  cell header [Sample]
                  cell header
                    [L*C*h] ; small [ ab]
                  if composed
                    cell header [computation[lf]color]
                    cell header [computation[lf]sample]
                  each sample ch:sample sort (right keyof:sample 3 " ")
                    cell
                      text keyof:sample
                    cell
                      if s0=defined
                        var ColorXYZ wished := filter_XYZ color_spectrum32:sample/s0
                      if s0=defined and s100=defined
                        var Float density := ink_linear color_spectrum32:sample s0 s100
                        text (string density*100 "fixed 1")+"%"
                        var ColorXYZ got := filter_XYZ (ink_linear_simulation density s0 s100)/s0
                        var Float err := lab_distance wished got
                        fixed [ ] ; small { html "&Delta;E " ; text (string err "fixed 1") } 
                        var Float err := cmc_distance wished got
                        fixed [ ] ; small (text "CMC "+(string err "fixed 1"))
                        eol
                        var Float density := ink_thickness color_spectrum32:sample s0 s100
                        text (string density*100 "fixed 1")+"%"
                        var ColorXYZ got := filter_XYZ (ink_thickness_simulation density s0 s100)/s0
                        var Float err := lab_distance wished got
                        fixed [ ] ; small { html "&Delta;E " ; text (string err "fixed 1") } 
                        var Float err := cmc_distance wished got
                        fixed [ ] ; small (text "CMC "+(string err "fixed 1"))
                        eol
                        var Float density := ink_surface color_spectrum32:sample s0 s100
                        text (string (cast density*1000 Int)/10)+"%"
                        var ColorXYZ got := filter_XYZ (ink_surface_simulation density s0 s100)/s0
                        var Float err := lab_distance wished got
                        fixed [ ] ; small { html "&Delta;E " ; text (string err "fixed 1") } 
                        var Float err := cmc_distance wished got
                        fixed [ ] ; small (text "CMC "+(string err "fixed 1"))
                    cell
                      if s0=defined and s100=defined
                        var Float density := ink_density color_spectrum32:sample s0 s100
                        bold (text (string density*100 "fixed 1")+"%")
                    cell
                      text string:(sample option "opacity" Float)
                    cell
                      if s0=defined
                        var ColorRGB888 rgb := cast (filter_XYZ color_spectrum32:sample/s0) ColorRGB888
                        image "sample/r"+string:(cast rgb:r Int)+"g"+string:(cast rgb:g Int)+"b"+string:(cast rgb:b Int)
                    cell
                      if s0=defined
                        var ColorLCh lch := cast wished ColorLCh
                        text (string lch:L "fixed 1") ; fixed [ ] ; text (string lch:C "fixed 1") ; fixed [ ] ; text (string lch:h "fixed 0")
                    if composed
                      cell
                        part compute_mixture
                          var ColorSpectrum32 s1 := cast 1 ColorSpectrum32
                          var Str all := keyof ch
                          while all<>""
                            if not (all parse any:(var Str first) "+" any:(var Str remain))
                              first := all ; remain := ""
                            var ColorSpectrum32 n1 := color_spectrum32 d:channel:first:sample:(keyof sample)
                            var ColorSpectrum32 d1 := color_spectrum32 d:channel:first:sample:"0"
                            if n1=undefined or d1=undefined
                              s1 := cast (cast undefined Float) ColorSpectrum32 ; leave compute_mixture
                            s1 *= (max n1-(cast specular ColorSpectrum32) (cast 0 ColorSpectrum32))/(max d1-(cast specular ColorSpectrum32) (cast 0 ColorSpectrum32))
                            all := remain
                          s1 := (1-specular)*s1+(cast specular ColorSpectrum32)
                          var ColorXYZ wished1 := filter_XYZ s1
                          var ColorLCh lch1 := cast wished1 ColorLCh
                          text (string lch1:L "fixed 1") ; fixed [ ] ; text (string lch1:C "fixed 1") ; fixed [ ] ; text (string lch1:h "fixed 0")
                      cell
                        if s1=defined
                          var ColorRGB888 rgb := cast filter_XYZ:s1 ColorRGB888
                          image "sample/r"+string:(cast rgb:r Int)+"g"+string:(cast rgb:g Int)+"b"+string:(cast rgb:b Int)
                input "Color level: " (var Str l) noeol
                page button "Measure" noeol
                  var Str s
                  if (l parse any:(var Str l1) "=" any:(var Str l2) "/" any:(var Str l3) "/" any:(var Str l4))
                    l := l1
                    s := color_database:data:device:l2:channel:l3:sample:l4
                  else
                    if not initialized
                      console "initializing spectrocolorimeter interface" eol
                      spectro_init
                      initialized := true
                    s := string spectro_spectrum
                  ch:sample create l
                  ch:sample l := s
                  reload_page
                button "Delete" noeol
                  ch:sample delete l
                  reload_page
                if s0=defined
                  para
                    input "Gamut: " (var Str gamut_name) length 40 noeol
                    page button "Formulate"
                      title "Color formultation to '"+gamut_name+"'"
                      var ColorSpectrum32 s0a := ch s0
                      var ColorSpectrum32 s100a := ch s100
                      var Link:ColorGamut gamut :> color_gamut gamut_name
                      table columns 7
                        cell header [Color]
                        cell header
                          [Thickness[lf]Surface[lf]]
                          [L*C*h] ; small [ ab]
                        cell header [Density]
                        cell header [Sample]
                        cell header [Formulation]
                        cell header
                          [L*C*h] ; small [ ab]
                        cell header [Proof color]
                        each sample ch:sample sort (right keyof:sample 3 " ")
                          cell
                            text keyof:sample
                          cell
                            if s100a=defined
                              var Float density := ink_thickness color_spectrum32:sample s0a s100a
                              text (string density*100 "fixed 1")+"%" ; eol
                              var Float density := ink_surface color_spectrum32:sample s0a s100a
                              text (string density*100 "fixed 1")+"%" ; eol
                            var ColorLCh lch2 := cast (filter_XYZ color_spectrum32:sample/s0a) ColorLCh
                            text (string lch2:L "fixed 1") ; fixed [ ] ; text (string lch2:C "fixed 1") ; fixed [ ] ; text (string lch2:h "fixed 0")
                          cell
                            if s100a=defined
                              var Float density := ink_density color_spectrum32:sample s0a s100a
                              text (string density*100 "fixed 1")+"%"
                          cell
                            var ColorRGB888 rgb2 := cast (filter_XYZ color_spectrum32:sample/s0a) ColorRGB888
                            image "sample/r"+string:(cast rgb2:r Int)+"g"+string:(cast rgb2:g Int)+"b"+string:(cast rgb2:b Int)
                          gamut formulate (filter_XYZ color_spectrum32:sample/s0a) addressof:(var ColorBuffer pixel)
                          var ColorXYZ final := gamut simulate addressof:pixel
                          cell
                            fixed
                              for (var Int dim) 0 gamut:dimension-1
                                text (shunt dim=0 "" " ")+(right string:(cast pixel:bytes:dim Int) 3 " ")+" "
                              eol
                              for (var Int dim) 0 gamut:dimension-1
                                void # FIXME: text (shunt dim=0 "" " ")+(right string:(cast (gamut:component:dim:ink:gradation decode pixel:bytes:dim)*100 Int) 3 " ")+"%"
                          cell
                            var Float err := lab_distance (filter_XYZ color_spectrum32:sample/s0a) final
                            small { html "&Delta;E " ; text (string err "fixed 1") } ; eol
                            var Float err := cmc_distance (filter_XYZ color_spectrum32:sample/s0a) final
                            small (text "CMC "+(string err "fixed 1")) ; eol
                            var ColorLCh lch2 := cast final ColorLCh
                            text (string lch2:L "fixed 1") ; fixed [ ] ; text (string lch2:C "fixed 1") ; fixed [ ] ; text (string lch2:h "fixed 0")
                          cell
                            var ColorRGB888 rgb2 := cast final ColorRGB888
                            image "sample/r"+string:(cast rgb2:r Int)+"g"+string:(cast rgb2:g Int)+"b"+string:(cast rgb2:b Int)
                if s0=defined and s100=defined
                  para
                    image "editor.html?"+(http_encode "device "+(string keyof:d)+" channel "+(string keyof:ch))
                    eol ; small [red is density, green is surface,  blue is thickness.]
            cell
              text ch:options
        input "Channel ID: " (var Str cid) noeol
        button "Create new ink" noeol
          d:channel create cid
          reload_page
        button "Delete the ink"
          d:channel delete cid
          reload_page
        table columns 4
          cell header [Color]
          cell header [... is an alias of]
          cell header [Sample]
          cell header [Opacity]
          each a d:alias
            cell
              text keyof:a
            cell
              input "" a
            var Data:ColorChannel ch :> d:channel a
            var ColorSpectrum32 a_s0 := ch s0
            var ColorSpectrum32 a_s100 := ch s100
            if a_s0=defined and a_s100=defined
              var ColorRGB888 a_rgb := cast (filter_XYZ a_s100/a_s0) ColorRGB888
              cell color rgb a_rgb:r a_rgb:g a_rgb:b
                fixed [ ]
            else
              cell void
            cell
              if (ch:options option "opacity" Float)=defined
                text string:(ch:options option "opacity" Float)
        input "Alias ID: " (var Str aid) noeol
        button "Create new alias" noeol
          d:alias create aid
          reload_page
        button "Delete the alias"
          d:alias delete aid
          reload_page
        table columns 2
          cell header [Grid]
          cell header [Steps]
          each g d:grid
            cell
              text keyof:g
            cell
              input "" g length 2
        input "Grid: " (var Str gid) length 40 noeol
        button "Create new grid" noeol
          d:grid create gid
          d:grid gid := undefined
          reload_page
        button "Delete the grid"
          d:grid delete gid
          reload_page
        [A grid value could be 'process_cyan+process_magenta+process_yellow+process_black' specifying that when converting from a gamut using several of these colors, the conversion will use a multidimension grid instead of per channel conversion.]
    cell
      text d:options
    cell
      text d:comment
      if d:printer:model<>""
        text d:printer:model+" with "+d:printer:paper ; eol
      small
        text d:comment
     

input "Color device ID: " (var Str did) noeol
button "Create new color device" noeol
  color_database:data:device create did
  reload_page
button "Delete the color device"
  color_database:data:device delete did
  reload_page