http://mathling.com/image/ppm  library module

http://mathling.com/image/ppm


PPM image formats

Copyright© Mary Holstege 2021-2023
CC-BY (https://creativecommons.org/licenses/by/4.0/)

April 2021
Status: Stable
Dependencies: EXPath binary, EXPath file

Imports

http://mathling.com/colour/space
import module namespace cs="http://mathling.com/colour/space"
       at "../colourspace/colour-space.xqy"
http://mathling.com/image/matrix
import module namespace cmatrix="http://mathling.com/image/matrix"
       at "../image/matrix.xqy"
http://mathling.com/core/utilities
import module namespace util="http://mathling.com/core/utilities"
       at "../core/utilities.xqy"
http://mathling.com/geometric/matrix
import module namespace matrix="http://mathling.com/geometric/matrix"
       at "../geo/point-matrix.xqy"
http://mathling.com/colour/rgb
import module namespace rgb="http://mathling.com/colour/rgb"
       at "../colourspace/rgb.xqy"
http://mathling.com/core/errors
import module namespace errors="http://mathling.com/core/errors"
       at "../core/errors.xqy"
http://mathling.com/geometric/point
import module namespace point="http://mathling.com/geometric/point"
       at "../geo/point.xqy"
http://mathling.com/type/space
import module namespace space="http://mathling.com/type/space"
       at "../types/space.xqy"

Variables

Variable: $CRLF as xs:string

Functions

Function: p3-extent
declare function p3-extent($file as xs:string) as xs:integer*


p3-extent()
Read the width and height of the image out of the P3 format.

Params
  • file as xs:string: location of PPM file
Returns
  • xs:integer*: image width and height in that order
declare function this:p3-extent(
  $file as xs:string
) as xs:integer*
{
  let $lines := unparsed-text-lines($file)[not(.="") and not(starts-with(.,"#"))]
  let $width := xs:integer(substring-before($lines[2], " "))
  let $height := xs:integer(substring-after($lines[2], " "))
  return ($width, $height)
}

Function: p3-map
declare function p3-map($file as xs:string,
  $options as map(xs:string,item()*),
  $pixel-function as function(xs:integer, xs:integer, xs:integer, xs:integer, xs:integer, xs:integer) as map(xs:string,item()*)) as map(*)


p3-map():
Read a raw PPM file that uses the ASCII format for image values and
return a colour map. If no explicit pixel function is given then
we use a pixel function that creates colour points in the selected
colour space (option "colourspace") by converting from the raw RGB.
The default is RGB points.

Params
  • file as xs:string: location of PPM file
  • options as map(xs:string,item()*): options controlling how to process "colourspace" one of "rgb", "xyz", "hsluv", "lab", "cmyk"
  • pixel-function as function(xs:integer,xs:integer,xs:integer,xs:integer,xs:integer,xs:integer)asmap(xs:string,item()*): function that defines what value we put into each slot Takes the following parameters: x, y coordinates maximum colour value (255, generally) r, g, b raw RGB colour values It returns a colour point Format is: P3 width height # comments, if any 255 (=colour max) r g b r g b ...
Returns
  • map(*)
declare function this:p3-map(
  $file as xs:string,
  $options as map(xs:string,item()*),
  $pixel-function as function(xs:integer, xs:integer, xs:integer, xs:integer, xs:integer, xs:integer) as map(xs:string,item()*)
) as map(*)
{
  let $lines := unparsed-text-lines($file)[not(.="") and not(starts-with(.,"#"))]
  let $width := xs:integer(substring-before($lines[2], " "))
  let $height := xs:integer(substring-after($lines[2], " "))
  let $colour-max := xs:integer($lines[3])
  let $pixels := (
    (: Check format :)
    if ($lines[1] eq "P3") then ()
    else errors:error("IMAGE-BADFORMAT", $lines[1]),
    for $line in $lines[position()>3]
    return (tokenize($line, " ")[not(.="")])!xs:integer(.)
  )
  return (
    fold-left(
      1 to $height,
      matrix:matrix(space:space($width,$height)),
      function($matrix as map(*), $y as xs:integer) as map(*) {
        fold-left(
          1 to $width,
          $matrix,
          function($matrix as map(*), $x as xs:integer) as map(*) {
            let $index := ((($y - 1) * $width + $x) - 1) * 3
            let $r := $pixels[$index + 1]
            let $g := $pixels[$index + 2]
            let $b := $pixels[$index + 3]
            return (
              if ($x <= $width and $y <= $height) then (
                $matrix=>matrix:put($x - 1, $y - 1,
                  $pixel-function($x, $y, $colour-max, $r, $g, $b)
                )
              ) else (
                $matrix
              )
            )
          }
        )
      }
    )
  )
}

Function: p3-map
declare function p3-map($file as xs:string,
  $options as map(xs:string,item()*)) as map(*)

Params
  • file as xs:string
  • options as map(xs:string,item()*)
Returns
  • map(*)
declare function this:p3-map(
  $file as xs:string,
  $options as map(xs:string,item()*)
) as map(*)
{
  let $cs := ($options("colourspace"),"rgb")[1]
  let $make-colour :=
    switch($cs)
    case "rgb" return
      function(
        $x as xs:integer,
        $y as xs:integer,
        $max-value as xs:integer,
        $r as xs:integer,
        $g as xs:integer,
        $b as xs:integer
      ) as map(xs:string,item()*)
      {
        rgb:rgb($r div $max-value, $g div $max-value, $b div $max-value)
      }
    case "xyz" return
      function(
        $x as xs:integer,
        $y as xs:integer,
        $max-value as xs:integer,
        $r as xs:integer,
        $g as xs:integer,
        $b as xs:integer
      ) as map(xs:string,item()*)
      {
        cs:rgb-to-xyz(rgb:rgb($r div $max-value, $g div $max-value, $b div $max-value))
      }
    case "hsluv" return
      function(
        $x as xs:integer,
        $y as xs:integer,
        $max-value as xs:integer,
        $r as xs:integer,
        $g as xs:integer,
        $b as xs:integer
      ) as map(xs:string,item()*)
      {
        cs:rgb-to-hsluv(rgb:rgb($r div $max-value, $g div $max-value, $b div $max-value))
      }
    case "lab" return
      function(
        $x as xs:integer,
        $y as xs:integer,
        $max-value as xs:integer,
        $r as xs:integer,
        $g as xs:integer,
        $b as xs:integer
      ) as map(xs:string,item()*)
      {
        cs:rgb-to-lab(rgb:rgb($r div $max-value, $g div $max-value, $b div $max-value))
      }
    case "cmyk" return
      function(
        $x as xs:integer,
        $y as xs:integer,
        $max-value as xs:integer,
        $r as xs:integer,
        $g as xs:integer,
        $b as xs:integer
      ) as map(xs:string,item()*)
      {
        cs:rgb-to-cmyk(rgb:rgb($r div $max-value, $g div $max-value, $b div $max-value))
      }
    default return 
      function(
        $x as xs:integer,
        $y as xs:integer,
        $max-value as xs:integer,
        $r as xs:integer,
        $g as xs:integer,
        $b as xs:integer
      ) as map(xs:string,item()*)
      {
        rgb:rgb($r div $max-value, $g div $max-value, $b div $max-value)
      }
  return (
    this:p3-map($file, $options, $make-colour)
  )
}

Function: p3-map
declare function p3-map($file as xs:string) as map(*)

Params
  • file as xs:string
Returns
  • map(*)
declare function this:p3-map(
  $file as xs:string
) as map(*)
{
  this:p3-map($file, map {})
}

Function: p3-array
declare function p3-array($file as xs:string,
  $options as map(xs:string,item()*),
  $pixel-function as function(xs:integer, xs:integer, xs:integer, xs:integer, xs:integer, xs:integer) as map(xs:string,item()*)) as map(*)


p3-array():
Read a raw PPM file that uses the ASCII format for image values and
return a colour array. If no explicit pixel function is given then
we use a pixel function that creates colour points in the selected
colour space (option "colourspace") by converting from the raw RGB.
The default is RGB points.

Params
  • file as xs:string: location of PPM file
  • options as map(xs:string,item()*): options controlling how to process "colourspace" one of "rgb", "xyz", "hsluv", "lab", "cmyk"
  • pixel-function as function(xs:integer,xs:integer,xs:integer,xs:integer,xs:integer,xs:integer)asmap(xs:string,item()*): function that defines what value we put into each slot Takes the following parameters: x, y coordinates maximum colour value (255, generally) r, g, b raw RGB colour values It returns a colour point Format is: P3 width height # comments, if any 255 (=colour max) r g b r g b ...
Returns
  • map(*)
declare function this:p3-array(
  $file as xs:string,
  $options as map(xs:string,item()*),
  $pixel-function as function(xs:integer, xs:integer, xs:integer, xs:integer, xs:integer, xs:integer) as map(xs:string,item()*)
) as map(*)
{
  let $lines := unparsed-text-lines($file)[not(.="") and not(starts-with(.,"#"))]
  let $width := xs:integer(substring-before($lines[2], " "))
  let $height := xs:integer(substring-after($lines[2], " "))
  let $colour-max := xs:integer($lines[3])
  let $pixels := (
    (: Check format :)
    if ($lines[1] eq "P3") then ()
    else errors:error("IMAGE-BADFORMAT", $lines[1]),
    for $line in $lines[position()>3]
    return (tokenize($line, " ")[not(.="")])!xs:integer(.)
  )
  let $data := 
    for $y in 1 to $height
    for $x in 1 to $width
    let $index := ((($y - 1) * $width + $x) - 1) * 3
    let $r := $pixels[$index + 1]
    let $g := $pixels[$index + 2]
    let $b := $pixels[$index + 3]
    return $pixel-function($x, $y, $colour-max, $r, $g, $b)
  return cmatrix:array($height, $width, $data)
}

Function: p3-array
declare function p3-array($file as xs:string,
  $options as map(xs:string,item()*)) as map(*)

Params
  • file as xs:string
  • options as map(xs:string,item()*)
Returns
  • map(*)
declare function this:p3-array(
  $file as xs:string,
  $options as map(xs:string,item()*)
) as map(*)
{
  let $cs := ($options("colourspace"),"rgb")[1]
  let $make-colour :=
    switch($cs)
    case "rgb" return
      function(
        $x as xs:integer,
        $y as xs:integer,
        $max-value as xs:integer,
        $r as xs:integer,
        $g as xs:integer,
        $b as xs:integer
      ) as map(xs:string,item()*)
      {
        rgb:rgb($r div $max-value, $g div $max-value, $b div $max-value)
      }
    case "xyz" return
      function(
        $x as xs:integer,
        $y as xs:integer,
        $max-value as xs:integer,
        $r as xs:integer,
        $g as xs:integer,
        $b as xs:integer
      ) as map(xs:string,item()*)
      {
        cs:rgb-to-xyz(rgb:rgb($r div $max-value, $g div $max-value, $b div $max-value))
      }
    case "hsluv" return
      function(
        $x as xs:integer,
        $y as xs:integer,
        $max-value as xs:integer,
        $r as xs:integer,
        $g as xs:integer,
        $b as xs:integer
      ) as map(xs:string,item()*)
      {
        cs:rgb-to-hsluv(rgb:rgb($r div $max-value, $g div $max-value, $b div $max-value))
      }
    case "lab" return
      function(
        $x as xs:integer,
        $y as xs:integer,
        $max-value as xs:integer,
        $r as xs:integer,
        $g as xs:integer,
        $b as xs:integer
      ) as map(xs:string,item()*)
      {
        cs:rgb-to-lab(rgb:rgb($r div $max-value, $g div $max-value, $b div $max-value))
      }
    case "cmyk" return
      function(
        $x as xs:integer,
        $y as xs:integer,
        $max-value as xs:integer,
        $r as xs:integer,
        $g as xs:integer,
        $b as xs:integer
      ) as map(xs:string,item()*)
      {
        cs:rgb-to-cmyk(rgb:rgb($r div $max-value, $g div $max-value, $b div $max-value))
      }
    default return 
      function(
        $x as xs:integer,
        $y as xs:integer,
        $max-value as xs:integer,
        $r as xs:integer,
        $g as xs:integer,
        $b as xs:integer
      ) as map(xs:string,item()*)
      {
        rgb:rgb($r div $max-value, $g div $max-value, $b div $max-value)
      }
  return (
    this:p3-array($file, $options, $make-colour)
  )
}

Function: p3-array
declare function p3-array($file as xs:string) as map(*)

Params
  • file as xs:string
Returns
  • map(*)
declare function this:p3-array(
  $file as xs:string
) as map(*)
{
  this:p3-array($file, map {})
}

Function: p3
declare function p3($file as xs:string,
  $metadata as xs:string?,
  $matrix as map(*), (: point matrix: point to colour :)
  $options as map(xs:string,item()*)) as empty-sequence()


p3()
Write out a document containing a raw PPM format image using the ASCII
format for image values. Can be converted, processed with GIMP, or viewed
in Emacs but not browser.

Params
  • file as xs:string: where the output is going
  • metadata as xs:string?: metadata to embed
  • matrix as map(*): the colour map
  • options as map(xs:string,item()*): processing options "colourspace" one of "rgb", "xyz", "hsluv", "lab", "cmyk" what colour space the point map is to be taken as "flipped": whether to flip the Y coordinate (some algorithms put Y facing the opposite way) Format is: P3 width height # comments, if any 255 (=colour max) r g b r g b ...
Returns
declare function this:p3(
  $file as xs:string,
  $metadata as xs:string?,
  $matrix as map(*), (: point matrix: point to colour :)
  $options as map(xs:string,item()*)
) as empty-sequence()
{
  if ($matrix=>matrix:kind()=("imagearray","array")) then (
    this:p3(
      $file, $metadata,
      $matrix=>cmatrix:rows(), $matrix=>cmatrix:columns(), $matrix=>cmatrix:data(),
      $options
    )
  ) else (
    let $flipped := ($options("flipped"), false())[1]
    let $colourspace := ($options("colourspace"), "rgb")[1]
    let $getrgb :=
      switch($colourspace)
      case "rgb" return function($val as map(xs:string,item()*)) as map(xs:string,item()*) {$val}
      case "xyz" return function($val as map(xs:string,item()*)) as map(xs:string,item()*) {cs:xyz-to-rgb($val)}
      case "hsluv" return function($val as map(xs:string,item()*)) as map(xs:string,item()*) {cs:hsluv-to-rgb($val)}
      case "lab" return function($val as map(xs:string,item()*)) as map(xs:string,item()*) {cs:lab-to-rgb($val)}
      case "cmyk" return function($val as map(xs:string,item()*)) as map(xs:string,item()*) {cs:cmyk-to-rgb($val)}
      default return function($val as map(xs:string,item()*)) as map(xs:string,item()*) {$val}
    let $min-x := $matrix=>matrix:min-x()
    let $min-y := $matrix=>matrix:min-y()
    let $max-x := $matrix=>matrix:max-x()
    let $max-y := $matrix=>matrix:max-y()
    let $header :=
      "P3"||$this:CRLF||
      ($max-x - $min-x + 1)||" "||($max-y - $min-y + 1)||$this:CRLF||
      string-join(
        for $line in tokenize($metadata, "\n")[. ne ""]
        return "#"||$line, $this:CRLF
      )||$this:CRLF||
      255||$this:CRLF
    let $y-range :=
      if ($flipped) then reverse($min-y to $max-y) else ($min-y to $max-y)
    let $bytes :=
      string-join(
        for $y in $y-range
        return (
          string-join(
            for $x in $min-x to $max-x
            let $rgb := $getrgb($matrix=>matrix:get($x, $y))
            return rgb:coordinates($rgb, 3)!string(.),
            " "
          )
        ),
        $this:CRLF
      ) 
    return (
      file:write-text($file, document {$header, $bytes})
    )
  )
}

Function: p3
declare function p3($file as xs:string,
  $metadata as xs:string?,
  $matrix as map(*)) as empty-sequence()

Params
  • file as xs:string
  • metadata as xs:string?
  • matrix as map(*)
Returns
declare function this:p3(
  $file as xs:string,
  $metadata as xs:string?,
  $matrix as map(*) (: point matrix: point to colour :)
) as empty-sequence()
{
  this:p3($file, $metadata, $matrix, map {})
}

Function: p3
declare function p3($file as xs:string,
  $metadata as xs:string?,
  $rows as xs:integer,
  $columns as xs:integer,
  $colours as map(xs:string,item()*)*,
  $options as map(xs:string,item()*))

Params
  • file as xs:string
  • metadata as xs:string?
  • rows as xs:integer
  • columns as xs:integer
  • colours as map(xs:string,item()*)*
  • options as map(xs:string,item()*)
declare function this:p3(
  $file as xs:string,
  $metadata as xs:string?,
  $rows as xs:integer,
  $columns as xs:integer,
  $colours as map(xs:string,item()*)*,
  $options as map(xs:string,item()*)
)
{
  let $flipped := ($options("flipped"), false())[1]
  let $colourspace := ($options("colourspace"), "rgb")[1]
  let $getrgb :=
    switch($colourspace)
    case "rgb" return function($val as map(xs:string,item()*)) as map(xs:string,item()*) {$val}
    case "xyz" return function($val as map(xs:string,item()*)) as map(xs:string,item()*) {cs:xyz-to-rgb($val)}
    case "hsluv" return function($val as map(xs:string,item()*)) as map(xs:string,item()*) {cs:hsluv-to-rgb($val)}
    case "lab" return function($val as map(xs:string,item()*)) as map(xs:string,item()*) {cs:lab-to-rgb($val)}
    case "cmyk" return function($val as map(xs:string,item()*)) as map(xs:string,item()*) {cs:cmyk-to-rgb($val)}
    default return function($val as map(xs:string,item()*)) as map(xs:string,item()*) {$val}
  let $header :=
    "P3"||$this:CRLF||
    $columns||" "||$rows||$this:CRLF||
    string-join(
      for $line in tokenize($metadata, "\n")[. ne ""]
      return "#"||$line, $this:CRLF
    )||$this:CRLF||
    255||$this:CRLF
  (: Some algorithms flip the y coordinates: pure Euclidean vs screen coords :)
  let $colours :=
    if ($flipped) then (
      for $y in reverse(1 to $rows)
      for $x in 1 to $columns
      return $colours[ ($y - 1)*$columns + $x ]
    ) else (
      $colours
    )
  let $n-colours := count($colours)
  let $n-expected := $rows*$columns
  let $colours :=
    if ($n-colours gt $n-expected)
    then $colours[position()<=$n-expected]
    else if ($n-colours lt $n-expected)
    then for $i in 1 to $n-expected - $n-colours return $getrgb(rgb:rgb("black"))
    else $colours
  let $bytes :=
    string-join(
      for $col in $colours return (
        rgb:coordinates($getrgb($col), 3)!string(.)
      ), " "
    )
  return (
    file:write-text($file, document {$header, $bytes})
  )
}

Function: p6-array
declare function p6-array($file as xs:string,
  $options as map(xs:string,item()*),
  $pixel-function as function(xs:integer, xs:integer, xs:integer, xs:integer, xs:integer, xs:integer) as map(xs:string,item()*)) as map(*)


p6-array():
Read a raw PPM file that uses the binary format for image values and
return a colour array. If no explicit pixel function is given then
we use a pixel function that creates colour points in the selected
colour space (option "colourspace") by converting from the raw RGB.
The default is RGB points.

Params
  • file as xs:string: location of PPM file
  • options as map(xs:string,item()*): options controlling how to process "colourspace" one of "rgb", "xyz", "hsluv", "lab", "cmyk"
  • pixel-function as function(xs:integer,xs:integer,xs:integer,xs:integer,xs:integer,xs:integer)asmap(xs:string,item()*): function that defines what value we put into each slot Takes the following parameters: x, y coordinates maximum colour value (255, generally) r, g, b raw RGB colour values It returns a colour point Format is: P6 width height # comments, if any 255 (=colour max) r g b r g b ... (as binary)
Returns
  • map(*)
declare function this:p6-array(
  $file as xs:string,
  $options as map(xs:string,item()*),
  $pixel-function as function(xs:integer, xs:integer, xs:integer, xs:integer, xs:integer, xs:integer) as map(xs:string,item()*)
) as map(*)
{
  let $data := file:read-binary($file)=>binary:to-octets()
  let $linebreaks := (
    (0, for $i in 1 to count($data) where $data[$i]=10 (:CR:) return $i)
  )
  let $lines := (
    for $i in 1 to count($linebreaks) - 1 return (
      if ($linebreaks[$i] + 1 = $linebreaks[$i + 1]) then ()
      else if ($data[$linebreaks[$i]+1] = 35 (:#:)) then ()
      else (
        array {
          $data[position() > $linebreaks[$i] and position() < $linebreaks[$i + 1]]
        }
      )
    )
  )
  let $width := xs:integer(substring-before(codepoints-to-string($lines[2]?*), " "))
  let $height := xs:integer(substring-after(codepoints-to-string($lines[2]?*), " "))
  let $colour-max := xs:integer(codepoints-to-string($lines[3]?*))
  let $start-offset := (
    for $i in 1 to count($linebreaks) - 1 return (
      if ($linebreaks[$i] + 1 = $linebreaks[$i + 1]) then ()
      else if ($data[$linebreaks[$i]+1] = 35 (:#:)) then ()
      else $linebreaks[$i]
    )
  )[4] (: 0 + ^P6 + ^width height + ^255 :)
  let $pixels := (
    (: Check format :)
    if (codepoints-to-string($lines[1]?*) eq "P6") then ()
    else errors:error("IMAGE-BADFORMAT", $lines[1]),
    $data[position() > $start-offset] (: octets :)
  )
  let $data := 
    for $y in 1 to $height
    for $x in 1 to $width
    let $index := ((($y - 1) * $width + $x) - 1) * 3
    let $r := $pixels[$index + 1]
    let $g := $pixels[$index + 2]
    let $b := $pixels[$index + 3]
    return $pixel-function($x, $y, $colour-max, $r, $g, $b)
  return cmatrix:array($height, $width, $data)
}

Function: p6-array
declare function p6-array($file as xs:string,
  $options as map(xs:string,item()*)) as map(*)

Params
  • file as xs:string
  • options as map(xs:string,item()*)
Returns
  • map(*)
declare function this:p6-array(
  $file as xs:string,
  $options as map(xs:string,item()*)
) as map(*)
{
  let $cs := ($options("colourspace"),"rgb")[1]
  let $make-colour :=
    switch($cs)
    case "rgb" return
      function(
        $x as xs:integer,
        $y as xs:integer,
        $max-value as xs:integer,
        $r as xs:integer,
        $g as xs:integer,
        $b as xs:integer
      ) as map(xs:string,item()*)
      {
        rgb:rgb($r div $max-value, $g div $max-value, $b div $max-value)
      }
    case "xyz" return
      function(
        $x as xs:integer,
        $y as xs:integer,
        $max-value as xs:integer,
        $r as xs:integer,
        $g as xs:integer,
        $b as xs:integer
      ) as map(xs:string,item()*)
      {
        cs:rgb-to-xyz(rgb:rgb($r div $max-value, $g div $max-value, $b div $max-value))
      }
    case "hsluv" return
      function(
        $x as xs:integer,
        $y as xs:integer,
        $max-value as xs:integer,
        $r as xs:integer,
        $g as xs:integer,
        $b as xs:integer
      ) as map(xs:string,item()*)
      {
        cs:rgb-to-hsluv(rgb:rgb($r div $max-value, $g div $max-value, $b div $max-value))
      }
    case "lab" return
      function(
        $x as xs:integer,
        $y as xs:integer,
        $max-value as xs:integer,
        $r as xs:integer,
        $g as xs:integer,
        $b as xs:integer
      ) as map(xs:string,item()*)
      {
        cs:rgb-to-lab(rgb:rgb($r div $max-value, $g div $max-value, $b div $max-value))
      }
    case "cmyk" return
      function(
        $x as xs:integer,
        $y as xs:integer,
        $max-value as xs:integer,
        $r as xs:integer,
        $g as xs:integer,
        $b as xs:integer
      ) as map(xs:string,item()*)
      {
        cs:rgb-to-cmyk(rgb:rgb($r div $max-value, $g div $max-value, $b div $max-value))
      }
    default return 
      function(
        $x as xs:integer,
        $y as xs:integer,
        $max-value as xs:integer,
        $r as xs:integer,
        $g as xs:integer,
        $b as xs:integer
      ) as map(xs:string,item()*)
      {
        rgb:rgb($r div $max-value, $g div $max-value, $b div $max-value)
      }
  return (
    this:p6-array($file, $options, $make-colour)
  )
}

Function: p6-array
declare function p6-array($file as xs:string) as map(*)

Params
  • file as xs:string
Returns
  • map(*)
declare function this:p6-array(
  $file as xs:string
) as map(*)
{
  this:p6-array($file, map {})
}

Function: p6
declare function p6($file as xs:string,
  $metadata as xs:string?,
  $matrix as map(*), (: point matrix: point to colour :)
  $options as map(xs:string,item()*)) as empty-sequence()


p6()
Write out a file containing the raw PPM format image using the
binary format for image values.
Can be converted, processed with GIMP, or viewed in Emacs but not browser.

Params
  • file as xs:string: where the output is going
  • metadata as xs:string?: metadata to embed
  • matrix as map(*): the colour map
  • options as map(xs:string,item()*): processing options "colourspace" one of "rgb", "xyz", "hsluv", "lab", "cmyk" what colour space the point map is to be taken as "flipped": whether to flip the Y coordinate (some algorithms put Y facing the opposite way) Format is: P6 width height # comments, if any 255 (=colour max) r g b r g b ... (as binary)
Returns
declare function this:p6(
  $file as xs:string,
  $metadata as xs:string?,
  $matrix as map(*), (: point matrix: point to colour :)
  $options as map(xs:string,item()*)
) as empty-sequence()
{
  if ($matrix=>matrix:kind()=("imagearray","array")) then (
    this:p6(
      $file, $metadata,
      $matrix=>cmatrix:rows(), $matrix=>cmatrix:columns(), $matrix=>cmatrix:data(),
      $options
    )
  ) else (
    let $flipped := ($options("flipped"), false())[1]
    let $colourspace := ($options("colourspace"), "rgb")[1]
    let $getrgb :=
      switch($colourspace)
      case "rgb" return function($val as map(xs:string,item()*)) as map(xs:string,item()*) {$val}
      case "xyz" return function($val as map(xs:string,item()*)) as map(xs:string,item()*) {cs:xyz-to-rgb($val)}
      case "hsluv" return function($val as map(xs:string,item()*)) as map(xs:string,item()*) {cs:hsluv-to-rgb($val)}
      case "lab" return function($val as map(xs:string,item()*)) as map(xs:string,item()*) {cs:lab-to-rgb($val)}
      case "cmyk" return function($val as map(xs:string,item()*)) as map(xs:string,item()*) {cs:cmyk-to-rgb($val)}
      default return function($val as map(xs:string,item()*)) as map(xs:string,item()*) {$val}
    let $min-x := $matrix=>matrix:min-x()
    let $min-y := $matrix=>matrix:min-y()
    let $max-x := $matrix=>matrix:max-x()
    let $max-y := $matrix=>matrix:max-y()
    let $header :=
      "P6"||$this:CRLF||
      ($max-x - $min-x + 1)||" "||($max-y - $min-y + 1)||$this:CRLF||
      string-join(
        for $line in tokenize($metadata, "\n")[. ne ""]
        return "#"||$line, $this:CRLF
      )||$this:CRLF||
      255||$this:CRLF
    (: Some algorithms flip the y coordinates: pure Euclidean vs screen coords :)
    let $y-range :=
      if ($flipped) then reverse($min-y to $max-y) else ($min-y to $max-y)
    let $bytes :=
      binary:from-octets(
        for $y in $y-range
        for $x in $min-x to $max-x
        let $rgb := $getrgb($matrix=>matrix:get($x, $y))
        for $val in rgb:coordinates($rgb, 3)
        return (
          $val
        )
      )
    return (
      file:write-text($file, $header),
      file:append-binary($file, $bytes)
    )
  )
}

Function: p6
declare function p6($file as xs:string,
  $metadata as xs:string?,
  $matrix as map(*)) as empty-sequence()

Params
  • file as xs:string
  • metadata as xs:string?
  • matrix as map(*)
Returns
declare function this:p6(
  $file as xs:string,
  $metadata as xs:string?,
  $matrix as map(*) (: point matrix: point to colour :)
) as empty-sequence()
{
  this:p6($file, $metadata, $matrix, map {})
}

Function: p6
declare function p6($file as xs:string,
  $metadata as xs:string?,
  $rows as xs:integer,
  $columns as xs:integer,
  $colours as map(xs:string,item()*)*,
  $options as map(xs:string,item()*)) as empty-sequence()

Params
  • file as xs:string
  • metadata as xs:string?
  • rows as xs:integer
  • columns as xs:integer
  • colours as map(xs:string,item()*)*
  • options as map(xs:string,item()*)
Returns
declare function this:p6(
  $file as xs:string,
  $metadata as xs:string?,
  $rows as xs:integer,
  $columns as xs:integer,
  $colours as map(xs:string,item()*)*,
  $options as map(xs:string,item()*)
) as empty-sequence()
{
  let $flipped := ($options("flipped"), false())[1]
  let $colourspace := ($options("colourspace"), "rgb")[1]
  let $getrgb :=
    switch($colourspace)
    case "rgb" return function($val as map(xs:string,item()*)) as map(xs:string,item()*) {$val}
    case "xyz" return function($val as map(xs:string,item()*)) as map(xs:string,item()*) {cs:xyz-to-rgb($val)}
    case "hsluv" return function($val as map(xs:string,item()*)) as map(xs:string,item()*) {cs:hsluv-to-rgb($val)}
    case "lab" return function($val as map(xs:string,item()*)) as map(xs:string,item()*) {cs:lab-to-rgb($val)}
    case "cmyk" return function($val as map(xs:string,item()*)) as map(xs:string,item()*) {cs:cmyk-to-rgb($val)}
    default return function($val as map(xs:string,item()*)) as map(xs:string,item()*) {$val}
  let $header :=
    "P6"||$this:CRLF||
    $columns||" "||$rows||$this:CRLF||
    string-join(
      for $line in tokenize($metadata, "\n")[. ne ""]
      return "#"||$line, $this:CRLF
    )||$this:CRLF||
    255||$this:CRLF
  (: Some algorithms flip the y coordinates: pure Euclidean vs screen coords :)
  let $colours :=
    if ($flipped) then (
      for $y in reverse(1 to $rows)
      for $x in 1 to $columns
      return $colours[ ($y - 1)*$columns + $x ]
    ) else (
      $colours
    )
  let $n-colours := count($colours)
  let $n-expected := $rows*$columns
  let $colours :=
    if ($n-colours gt $n-expected)
    then $colours[position()<=$n-expected]
    else if ($n-colours lt $n-expected)
    then for $i in 1 to $n-expected - $n-colours return $getrgb(rgb:rgb("black"))
    else $colours
  let $bytes :=
    binary:from-octets(
      for $col in $colours
      let $rgb := $getrgb($col)
      for $val in rgb:coordinates($rgb, 3)
      return (
        $val
      )
    )
  return (
    file:write-text($file, $header),
    file:append-binary($file, $bytes)
  )
}

Function: pam
declare function pam($file as xs:string,
  $metadata as xs:string?,
  $matrix as map(*), (: point matrix: point to colour :)
  $options as map(xs:string,item()*)) as empty-sequence()


pam()
Write out a file containing raw PAM format image using the binary
format for image values. This format can include alpha values for
each pixel, not just RGB.

Params
  • file as xs:string: where the output is going
  • metadata as xs:string?: metadata to embed
  • matrix as map(*): the colour map
  • options as map(xs:string,item()*): processing options "colourspace" one of "rgb", "xyz", "hsluv", "lab", "cmyk" what colour space the point map is to be taken as "flipped": whether to flip the Y coordinate (some algorithms put Y facing the opposite way) Format is: P7 WIDTH width HEIGHT height DEPTH 4 MAXVAL 255 TUPLTYPE RGB_ALPHA # comments, if any ENDHDR r g b a r g b a ... (as binary) ImageMagick can convert this but Emacs integration, GIMP, and browser all fail on it.
Returns
declare function this:pam(
  $file as xs:string,
  $metadata as xs:string?,
  $matrix as map(*), (: point matrix: point to colour :)
  $options as map(xs:string,item()*)
) as empty-sequence()
{
  if ($matrix=>matrix:kind()=("imagearray","array")) then (
    this:pam(
      $file, $metadata,
      $matrix=>cmatrix:rows(), $matrix=>cmatrix:columns(), $matrix=>cmatrix:data(),
      $options
    )
  ) else (
    let $flipped := ($options("flipped"), false())[1]
    let $colourspace := ($options("colourspace"), "rgb")[1]
    let $getrgba :=
      switch($colourspace)
      case "rgb" return function($val as map(xs:string,item()*)) as map(xs:string,item()*) {$val}
      case "xyz" return function($val as map(xs:string,item()*)) as map(xs:string,item()*) {cs:xyz-to-rgb($val)}
      case "hsluv" return function($val as map(xs:string,item()*)) as map(xs:string,item()*) {cs:hsluv-to-rgb($val)}
      case "lab" return function($val as map(xs:string,item()*)) as map(xs:string,item()*) {cs:lab-to-rgb($val)}
      case "cmyk" return function($val as map(xs:string,item()*)) as map(xs:string,item()*) {cs:cmyk-to-rgb($val)}
      default return function($val as map(xs:string,item()*)) as map(xs:string,item()*) {$val}
    let $min-x := $matrix=>matrix:min-x()
    let $min-y := $matrix=>matrix:min-y()
    let $max-x := $matrix=>matrix:max-x()
    let $max-y := $matrix=>matrix:max-y()
    let $header :=
      "P7"||$this:CRLF||
      "WIDTH "||($max-x - $min-x + 1)||$this:CRLF||
      "HEIGHT "||($max-y - $min-y + 1)||$this:CRLF||
      "DEPTH 4"||$this:CRLF||
      "MAXVAL 255"||$this:CRLF||
      "TUPLTYPE RGB_ALPHA"||$this:CRLF||
      string-join(
        for $line in tokenize($metadata, "\n")[. ne ""]
        return "#"||$line,
        $this:CRLF
      )||
      $this:CRLF||"ENDHDR"||$this:CRLF
    (: Some algorithms flip the y coordinates: pure Euclidean vs screen coords :)
    let $y-range :=
      if ($flipped) then reverse($min-y to $max-y) else ($min-y to $max-y)
    let $bytes :=
      binary:from-octets(
        for $y in $y-range
        for $x in $min-x to $max-x
        let $rgb := $getrgba($matrix=>matrix:get($x, $y))
        for $val in rgb:coordinates($rgb, 4)
        return (
          $val
        )
      )
    return (
      file:write-text($file, $header),
      file:append-binary($file, $bytes)
    )
  )
}

Function: pam
declare function pam($file as xs:string,
  $metadata as xs:string?,
  $matrix as map(*)) as empty-sequence()

Params
  • file as xs:string
  • metadata as xs:string?
  • matrix as map(*)
Returns
declare function this:pam(
  $file as xs:string,
  $metadata as xs:string?,
  $matrix as map(*) (: point matrix: point to colour :)
) as empty-sequence()
{
  this:pam($file, $metadata, $matrix, map {})
}

Function: pam
declare function pam($file as xs:string,
  $metadata as xs:string?,
  $rows as xs:integer,
  $columns as xs:integer,
  $colours as map(xs:string,item()*)*,
  $options as map(xs:string,item()*))

Params
  • file as xs:string
  • metadata as xs:string?
  • rows as xs:integer
  • columns as xs:integer
  • colours as map(xs:string,item()*)*
  • options as map(xs:string,item()*)
declare function this:pam(
  $file as xs:string,
  $metadata as xs:string?,
  $rows as xs:integer,
  $columns as xs:integer,
  $colours as map(xs:string,item()*)*,
  $options as map(xs:string,item()*)
)
{
  let $flipped := ($options("flipped"), false())[1]
  let $colourspace := ($options("colourspace"), "rgb")[1]
  let $getrgb :=
    switch($colourspace)
    case "rgb" return function($val as map(xs:string,item()*)) as map(xs:string,item()*) {$val}
    case "xyz" return function($val as map(xs:string,item()*)) as map(xs:string,item()*) {cs:xyz-to-rgb($val)}
    case "hsluv" return function($val as map(xs:string,item()*)) as map(xs:string,item()*) {cs:hsluv-to-rgb($val)}
    case "lab" return function($val as map(xs:string,item()*)) as map(xs:string,item()*) {cs:lab-to-rgb($val)}
    case "cmyk" return function($val as map(xs:string,item()*)) as map(xs:string,item()*) {cs:cmyk-to-rgb($val)}
    default return function($val as map(xs:string,item()*)) as map(xs:string,item()*) {$val}
    let $header :=
      "P7"||$this:CRLF||
      "WIDTH "||$columns||$this:CRLF||
      "HEIGHT "||$rows||$this:CRLF||
      "DEPTH 4"||$this:CRLF||
      "MAXVAL 255"||$this:CRLF||
      "TUPLTYPE RGB_ALPHA"||$this:CRLF||
      string-join(
        for $line in tokenize($metadata, "\n")[. ne ""]
        return "#"||$line,
        $this:CRLF
      )||
      $this:CRLF||"ENDHDR"||$this:CRLF
  (: Some algorithms flip the y coordinates: pure Euclidean vs screen coords :)
  let $colours :=
    if ($flipped) then (
      for $y in reverse(1 to $rows)
      for $x in 1 to $columns
      return $colours[ ($y - 1)*$columns + $x ]
    ) else (
      $colours
    )
  let $n-colours := count($colours)
  let $n-expected := $rows*$columns
  let $colours :=
    if ($n-colours gt $n-expected)
    then $colours[position()<=$n-expected]
    else if ($n-colours lt $n-expected)
    then for $i in 1 to $n-expected - $n-colours return $getrgb(rgb:rgb("black"))
    else $colours
  let $bytes :=
    string-join(
      for $col in $colours return (
        rgb:coordinates($getrgb($col), 3)!string(.)
      ), " "
    )
  return (
    file:write-text($file, document {$header, $bytes})
  )
}

Original Source Code

xquery version "3.1";
(:~
 : PPM image formats
 :
 : Copyright© Mary Holstege 2021-2023
 : CC-BY (https://creativecommons.org/licenses/by/4.0/)
 : @since April 2021
 : @custom:Status Stable
 : @custom:Dependencies EXPath binary, EXPath file
 :)
module namespace this="http://mathling.com/image/ppm";

import module namespace errors="http://mathling.com/core/errors"
       at "../core/errors.xqy";
import module namespace util="http://mathling.com/core/utilities"
       at "../core/utilities.xqy";
import module namespace point="http://mathling.com/geometric/point"
       at "../geo/point.xqy";
import module namespace matrix="http://mathling.com/geometric/matrix"
       at "../geo/point-matrix.xqy";
import module namespace cmatrix="http://mathling.com/image/matrix"
       at "../image/matrix.xqy";
import module namespace space="http://mathling.com/type/space"
       at "../types/space.xqy";
import module namespace cs="http://mathling.com/colour/space"
       at "../colourspace/colour-space.xqy";
import module namespace rgb="http://mathling.com/colour/rgb"
       at "../colourspace/rgb.xqy";

declare namespace map="http://www.w3.org/2005/xpath-functions/map";
declare namespace saxon="http://saxon.sf.net/";
declare namespace binary="http://expath.org/ns/binary";
declare namespace file="http://expath.org/ns/file";

declare variable $this:CRLF as xs:string := "
";

(:~
 : p3-extent()
 : Read the width and height of the image out of the P3 format.
 : @param $file: location of PPM file
 : @return image width and height in that order
 :)
declare function this:p3-extent(
  $file as xs:string
) as xs:integer*
{
  let $lines := unparsed-text-lines($file)[not(.="") and not(starts-with(.,"#"))]
  let $width := xs:integer(substring-before($lines[2], " "))
  let $height := xs:integer(substring-after($lines[2], " "))
  return ($width, $height)
};

(:~
 : p3-map():
 : Read a raw PPM file that uses the ASCII format for image values and
 : return a colour map. If no explicit pixel function is given then 
 : we use a pixel function that creates colour points in the selected   
 : colour space (option "colourspace") by converting from the raw RGB. 
 : The default is RGB points.
 : 
 : @param $file: location of PPM file
 : @param $options: options controlling how to process
 :   "colourspace" one of "rgb", "xyz", "hsluv", "lab", "cmyk"
 : @param $pixel-function: function that defines what value we put into each slot
 :   Takes the following parameters: 
 :   x, y coordinates
 :   maximum colour value (255, generally)
 :   r, g, b raw RGB colour values
 :   It returns a colour point
 :
 : Format is:
 : P3
 : width height
 : # comments, if any
 : 255 (=colour max)
 : r g b r g b ...
 :)
declare function this:p3-map(
  $file as xs:string,
  $options as map(xs:string,item()*),
  $pixel-function as function(xs:integer, xs:integer, xs:integer, xs:integer, xs:integer, xs:integer) as map(xs:string,item()*)
) as map(*)
{
  let $lines := unparsed-text-lines($file)[not(.="") and not(starts-with(.,"#"))]
  let $width := xs:integer(substring-before($lines[2], " "))
  let $height := xs:integer(substring-after($lines[2], " "))
  let $colour-max := xs:integer($lines[3])
  let $pixels := (
    (: Check format :)
    if ($lines[1] eq "P3") then ()
    else errors:error("IMAGE-BADFORMAT", $lines[1]),
    for $line in $lines[position()>3]
    return (tokenize($line, " ")[not(.="")])!xs:integer(.)
  )
  return (
    fold-left(
      1 to $height,
      matrix:matrix(space:space($width,$height)),
      function($matrix as map(*), $y as xs:integer) as map(*) {
        fold-left(
          1 to $width,
          $matrix,
          function($matrix as map(*), $x as xs:integer) as map(*) {
            let $index := ((($y - 1) * $width + $x) - 1) * 3
            let $r := $pixels[$index + 1]
            let $g := $pixels[$index + 2]
            let $b := $pixels[$index + 3]
            return (
              if ($x <= $width and $y <= $height) then (
                $matrix=>matrix:put($x - 1, $y - 1,
                  $pixel-function($x, $y, $colour-max, $r, $g, $b)
                )
              ) else (
                $matrix
              )
            )
          }
        )
      }
    )
  )
};

declare function this:p3-map(
  $file as xs:string,
  $options as map(xs:string,item()*)
) as map(*)
{
  let $cs := ($options("colourspace"),"rgb")[1]
  let $make-colour :=
    switch($cs)
    case "rgb" return
      function(
        $x as xs:integer,
        $y as xs:integer,
        $max-value as xs:integer,
        $r as xs:integer,
        $g as xs:integer,
        $b as xs:integer
      ) as map(xs:string,item()*)
      {
        rgb:rgb($r div $max-value, $g div $max-value, $b div $max-value)
      }
    case "xyz" return
      function(
        $x as xs:integer,
        $y as xs:integer,
        $max-value as xs:integer,
        $r as xs:integer,
        $g as xs:integer,
        $b as xs:integer
      ) as map(xs:string,item()*)
      {
        cs:rgb-to-xyz(rgb:rgb($r div $max-value, $g div $max-value, $b div $max-value))
      }
    case "hsluv" return
      function(
        $x as xs:integer,
        $y as xs:integer,
        $max-value as xs:integer,
        $r as xs:integer,
        $g as xs:integer,
        $b as xs:integer
      ) as map(xs:string,item()*)
      {
        cs:rgb-to-hsluv(rgb:rgb($r div $max-value, $g div $max-value, $b div $max-value))
      }
    case "lab" return
      function(
        $x as xs:integer,
        $y as xs:integer,
        $max-value as xs:integer,
        $r as xs:integer,
        $g as xs:integer,
        $b as xs:integer
      ) as map(xs:string,item()*)
      {
        cs:rgb-to-lab(rgb:rgb($r div $max-value, $g div $max-value, $b div $max-value))
      }
    case "cmyk" return
      function(
        $x as xs:integer,
        $y as xs:integer,
        $max-value as xs:integer,
        $r as xs:integer,
        $g as xs:integer,
        $b as xs:integer
      ) as map(xs:string,item()*)
      {
        cs:rgb-to-cmyk(rgb:rgb($r div $max-value, $g div $max-value, $b div $max-value))
      }
    default return 
      function(
        $x as xs:integer,
        $y as xs:integer,
        $max-value as xs:integer,
        $r as xs:integer,
        $g as xs:integer,
        $b as xs:integer
      ) as map(xs:string,item()*)
      {
        rgb:rgb($r div $max-value, $g div $max-value, $b div $max-value)
      }
  return (
    this:p3-map($file, $options, $make-colour)
  )
};

declare function this:p3-map(
  $file as xs:string
) as map(*)
{
  this:p3-map($file, map {})
};

(:~
 : p3-array():
 : Read a raw PPM file that uses the ASCII format for image values and
 : return a colour array. If no explicit pixel function is given then 
 : we use a pixel function that creates colour points in the selected   
 : colour space (option "colourspace") by converting from the raw RGB. 
 : The default is RGB points.
 : 
 : @param $file: location of PPM file
 : @param $options: options controlling how to process
 :   "colourspace" one of "rgb", "xyz", "hsluv", "lab", "cmyk"
 : @param $pixel-function: function that defines what value we put into each slot
 :   Takes the following parameters: 
 :   x, y coordinates
 :   maximum colour value (255, generally)
 :   r, g, b raw RGB colour values
 :   It returns a colour point
 :
 : Format is:
 : P3
 : width height
 : # comments, if any
 : 255 (=colour max)
 : r g b r g b ...
 :)
declare function this:p3-array(
  $file as xs:string,
  $options as map(xs:string,item()*),
  $pixel-function as function(xs:integer, xs:integer, xs:integer, xs:integer, xs:integer, xs:integer) as map(xs:string,item()*)
) as map(*)
{
  let $lines := unparsed-text-lines($file)[not(.="") and not(starts-with(.,"#"))]
  let $width := xs:integer(substring-before($lines[2], " "))
  let $height := xs:integer(substring-after($lines[2], " "))
  let $colour-max := xs:integer($lines[3])
  let $pixels := (
    (: Check format :)
    if ($lines[1] eq "P3") then ()
    else errors:error("IMAGE-BADFORMAT", $lines[1]),
    for $line in $lines[position()>3]
    return (tokenize($line, " ")[not(.="")])!xs:integer(.)
  )
  let $data := 
    for $y in 1 to $height
    for $x in 1 to $width
    let $index := ((($y - 1) * $width + $x) - 1) * 3
    let $r := $pixels[$index + 1]
    let $g := $pixels[$index + 2]
    let $b := $pixels[$index + 3]
    return $pixel-function($x, $y, $colour-max, $r, $g, $b)
  return cmatrix:array($height, $width, $data)
};

declare function this:p3-array(
  $file as xs:string,
  $options as map(xs:string,item()*)
) as map(*)
{
  let $cs := ($options("colourspace"),"rgb")[1]
  let $make-colour :=
    switch($cs)
    case "rgb" return
      function(
        $x as xs:integer,
        $y as xs:integer,
        $max-value as xs:integer,
        $r as xs:integer,
        $g as xs:integer,
        $b as xs:integer
      ) as map(xs:string,item()*)
      {
        rgb:rgb($r div $max-value, $g div $max-value, $b div $max-value)
      }
    case "xyz" return
      function(
        $x as xs:integer,
        $y as xs:integer,
        $max-value as xs:integer,
        $r as xs:integer,
        $g as xs:integer,
        $b as xs:integer
      ) as map(xs:string,item()*)
      {
        cs:rgb-to-xyz(rgb:rgb($r div $max-value, $g div $max-value, $b div $max-value))
      }
    case "hsluv" return
      function(
        $x as xs:integer,
        $y as xs:integer,
        $max-value as xs:integer,
        $r as xs:integer,
        $g as xs:integer,
        $b as xs:integer
      ) as map(xs:string,item()*)
      {
        cs:rgb-to-hsluv(rgb:rgb($r div $max-value, $g div $max-value, $b div $max-value))
      }
    case "lab" return
      function(
        $x as xs:integer,
        $y as xs:integer,
        $max-value as xs:integer,
        $r as xs:integer,
        $g as xs:integer,
        $b as xs:integer
      ) as map(xs:string,item()*)
      {
        cs:rgb-to-lab(rgb:rgb($r div $max-value, $g div $max-value, $b div $max-value))
      }
    case "cmyk" return
      function(
        $x as xs:integer,
        $y as xs:integer,
        $max-value as xs:integer,
        $r as xs:integer,
        $g as xs:integer,
        $b as xs:integer
      ) as map(xs:string,item()*)
      {
        cs:rgb-to-cmyk(rgb:rgb($r div $max-value, $g div $max-value, $b div $max-value))
      }
    default return 
      function(
        $x as xs:integer,
        $y as xs:integer,
        $max-value as xs:integer,
        $r as xs:integer,
        $g as xs:integer,
        $b as xs:integer
      ) as map(xs:string,item()*)
      {
        rgb:rgb($r div $max-value, $g div $max-value, $b div $max-value)
      }
  return (
    this:p3-array($file, $options, $make-colour)
  )
};

declare function this:p3-array(
  $file as xs:string
) as map(*)
{
  this:p3-array($file, map {})
};

(:~
 : p3()
 : Write out a document containing a raw PPM format image using the ASCII
 : format for image values. Can be converted, processed with GIMP, or viewed 
 : in Emacs but not browser.
 :
 : @param $file: where the output is going
 : @param $metadata: metadata to embed
 : @param $matrix: the colour map
 : @param $options: processing options
 :   "colourspace" one of "rgb", "xyz", "hsluv", "lab", "cmyk"
 :      what colour space the point map is to be taken as
 :   "flipped": whether to flip the Y coordinate (some algorithms put Y
 :     facing the opposite way)
 : 
 : Format is:
 : P3
 : width height
 : # comments, if any
 : 255 (=colour max)
 : r g b r g b ...
 :)
declare function this:p3(
  $file as xs:string,
  $metadata as xs:string?,
  $matrix as map(*), (: point matrix: point to colour :)
  $options as map(xs:string,item()*)
) as empty-sequence()
{
  if ($matrix=>matrix:kind()=("imagearray","array")) then (
    this:p3(
      $file, $metadata,
      $matrix=>cmatrix:rows(), $matrix=>cmatrix:columns(), $matrix=>cmatrix:data(),
      $options
    )
  ) else (
    let $flipped := ($options("flipped"), false())[1]
    let $colourspace := ($options("colourspace"), "rgb")[1]
    let $getrgb :=
      switch($colourspace)
      case "rgb" return function($val as map(xs:string,item()*)) as map(xs:string,item()*) {$val}
      case "xyz" return function($val as map(xs:string,item()*)) as map(xs:string,item()*) {cs:xyz-to-rgb($val)}
      case "hsluv" return function($val as map(xs:string,item()*)) as map(xs:string,item()*) {cs:hsluv-to-rgb($val)}
      case "lab" return function($val as map(xs:string,item()*)) as map(xs:string,item()*) {cs:lab-to-rgb($val)}
      case "cmyk" return function($val as map(xs:string,item()*)) as map(xs:string,item()*) {cs:cmyk-to-rgb($val)}
      default return function($val as map(xs:string,item()*)) as map(xs:string,item()*) {$val}
    let $min-x := $matrix=>matrix:min-x()
    let $min-y := $matrix=>matrix:min-y()
    let $max-x := $matrix=>matrix:max-x()
    let $max-y := $matrix=>matrix:max-y()
    let $header :=
      "P3"||$this:CRLF||
      ($max-x - $min-x + 1)||" "||($max-y - $min-y + 1)||$this:CRLF||
      string-join(
        for $line in tokenize($metadata, "\n")[. ne ""]
        return "#"||$line, $this:CRLF
      )||$this:CRLF||
      255||$this:CRLF
    let $y-range :=
      if ($flipped) then reverse($min-y to $max-y) else ($min-y to $max-y)
    let $bytes :=
      string-join(
        for $y in $y-range
        return (
          string-join(
            for $x in $min-x to $max-x
            let $rgb := $getrgb($matrix=>matrix:get($x, $y))
            return rgb:coordinates($rgb, 3)!string(.),
            " "
          )
        ),
        $this:CRLF
      ) 
    return (
      file:write-text($file, document {$header, $bytes})
    )
  )
};

declare function this:p3(
  $file as xs:string,
  $metadata as xs:string?,
  $matrix as map(*) (: point matrix: point to colour :)
) as empty-sequence()
{
  this:p3($file, $metadata, $matrix, map {})
};


declare function this:p3(
  $file as xs:string,
  $metadata as xs:string?,
  $rows as xs:integer,
  $columns as xs:integer,
  $colours as map(xs:string,item()*)*,
  $options as map(xs:string,item()*)
)
{
  let $flipped := ($options("flipped"), false())[1]
  let $colourspace := ($options("colourspace"), "rgb")[1]
  let $getrgb :=
    switch($colourspace)
    case "rgb" return function($val as map(xs:string,item()*)) as map(xs:string,item()*) {$val}
    case "xyz" return function($val as map(xs:string,item()*)) as map(xs:string,item()*) {cs:xyz-to-rgb($val)}
    case "hsluv" return function($val as map(xs:string,item()*)) as map(xs:string,item()*) {cs:hsluv-to-rgb($val)}
    case "lab" return function($val as map(xs:string,item()*)) as map(xs:string,item()*) {cs:lab-to-rgb($val)}
    case "cmyk" return function($val as map(xs:string,item()*)) as map(xs:string,item()*) {cs:cmyk-to-rgb($val)}
    default return function($val as map(xs:string,item()*)) as map(xs:string,item()*) {$val}
  let $header :=
    "P3"||$this:CRLF||
    $columns||" "||$rows||$this:CRLF||
    string-join(
      for $line in tokenize($metadata, "\n")[. ne ""]
      return "#"||$line, $this:CRLF
    )||$this:CRLF||
    255||$this:CRLF
  (: Some algorithms flip the y coordinates: pure Euclidean vs screen coords :)
  let $colours :=
    if ($flipped) then (
      for $y in reverse(1 to $rows)
      for $x in 1 to $columns
      return $colours[ ($y - 1)*$columns + $x ]
    ) else (
      $colours
    )
  let $n-colours := count($colours)
  let $n-expected := $rows*$columns
  let $colours :=
    if ($n-colours gt $n-expected)
    then $colours[position()<=$n-expected]
    else if ($n-colours lt $n-expected)
    then for $i in 1 to $n-expected - $n-colours return $getrgb(rgb:rgb("black"))
    else $colours
  let $bytes :=
    string-join(
      for $col in $colours return (
        rgb:coordinates($getrgb($col), 3)!string(.)
      ), " "
    )
  return (
    file:write-text($file, document {$header, $bytes})
  )
};

(:~
 : p6-array():
 : Read a raw PPM file that uses the binary format for image values and
 : return a colour array. If no explicit pixel function is given then 
 : we use a pixel function that creates colour points in the selected   
 : colour space (option "colourspace") by converting from the raw RGB. 
 : The default is RGB points.
 : 
 : @param $file: location of PPM file
 : @param $options: options controlling how to process
 :   "colourspace" one of "rgb", "xyz", "hsluv", "lab", "cmyk"
 : @param $pixel-function: function that defines what value we put into each slot
 :   Takes the following parameters: 
 :   x, y coordinates
 :   maximum colour value (255, generally)
 :   r, g, b raw RGB colour values
 :   It returns a colour point
 :
 : Format is:
 : P6
 : width height
 : # comments, if any
 : 255 (=colour max)
 : r g b r g b ... (as binary)
 :)
declare function this:p6-array(
  $file as xs:string,
  $options as map(xs:string,item()*),
  $pixel-function as function(xs:integer, xs:integer, xs:integer, xs:integer, xs:integer, xs:integer) as map(xs:string,item()*)
) as map(*)
{
  let $data := file:read-binary($file)=>binary:to-octets()
  let $linebreaks := (
    (0, for $i in 1 to count($data) where $data[$i]=10 (:CR:) return $i)
  )
  let $lines := (
    for $i in 1 to count($linebreaks) - 1 return (
      if ($linebreaks[$i] + 1 = $linebreaks[$i + 1]) then ()
      else if ($data[$linebreaks[$i]+1] = 35 (:#:)) then ()
      else (
        array {
          $data[position() > $linebreaks[$i] and position() < $linebreaks[$i + 1]]
        }
      )
    )
  )
  let $width := xs:integer(substring-before(codepoints-to-string($lines[2]?*), " "))
  let $height := xs:integer(substring-after(codepoints-to-string($lines[2]?*), " "))
  let $colour-max := xs:integer(codepoints-to-string($lines[3]?*))
  let $start-offset := (
    for $i in 1 to count($linebreaks) - 1 return (
      if ($linebreaks[$i] + 1 = $linebreaks[$i + 1]) then ()
      else if ($data[$linebreaks[$i]+1] = 35 (:#:)) then ()
      else $linebreaks[$i]
    )
  )[4] (: 0 + ^P6 + ^width height + ^255 :)
  let $pixels := (
    (: Check format :)
    if (codepoints-to-string($lines[1]?*) eq "P6") then ()
    else errors:error("IMAGE-BADFORMAT", $lines[1]),
    $data[position() > $start-offset] (: octets :)
  )
  let $data := 
    for $y in 1 to $height
    for $x in 1 to $width
    let $index := ((($y - 1) * $width + $x) - 1) * 3
    let $r := $pixels[$index + 1]
    let $g := $pixels[$index + 2]
    let $b := $pixels[$index + 3]
    return $pixel-function($x, $y, $colour-max, $r, $g, $b)
  return cmatrix:array($height, $width, $data)
};

declare function this:p6-array(
  $file as xs:string,
  $options as map(xs:string,item()*)
) as map(*)
{
  let $cs := ($options("colourspace"),"rgb")[1]
  let $make-colour :=
    switch($cs)
    case "rgb" return
      function(
        $x as xs:integer,
        $y as xs:integer,
        $max-value as xs:integer,
        $r as xs:integer,
        $g as xs:integer,
        $b as xs:integer
      ) as map(xs:string,item()*)
      {
        rgb:rgb($r div $max-value, $g div $max-value, $b div $max-value)
      }
    case "xyz" return
      function(
        $x as xs:integer,
        $y as xs:integer,
        $max-value as xs:integer,
        $r as xs:integer,
        $g as xs:integer,
        $b as xs:integer
      ) as map(xs:string,item()*)
      {
        cs:rgb-to-xyz(rgb:rgb($r div $max-value, $g div $max-value, $b div $max-value))
      }
    case "hsluv" return
      function(
        $x as xs:integer,
        $y as xs:integer,
        $max-value as xs:integer,
        $r as xs:integer,
        $g as xs:integer,
        $b as xs:integer
      ) as map(xs:string,item()*)
      {
        cs:rgb-to-hsluv(rgb:rgb($r div $max-value, $g div $max-value, $b div $max-value))
      }
    case "lab" return
      function(
        $x as xs:integer,
        $y as xs:integer,
        $max-value as xs:integer,
        $r as xs:integer,
        $g as xs:integer,
        $b as xs:integer
      ) as map(xs:string,item()*)
      {
        cs:rgb-to-lab(rgb:rgb($r div $max-value, $g div $max-value, $b div $max-value))
      }
    case "cmyk" return
      function(
        $x as xs:integer,
        $y as xs:integer,
        $max-value as xs:integer,
        $r as xs:integer,
        $g as xs:integer,
        $b as xs:integer
      ) as map(xs:string,item()*)
      {
        cs:rgb-to-cmyk(rgb:rgb($r div $max-value, $g div $max-value, $b div $max-value))
      }
    default return 
      function(
        $x as xs:integer,
        $y as xs:integer,
        $max-value as xs:integer,
        $r as xs:integer,
        $g as xs:integer,
        $b as xs:integer
      ) as map(xs:string,item()*)
      {
        rgb:rgb($r div $max-value, $g div $max-value, $b div $max-value)
      }
  return (
    this:p6-array($file, $options, $make-colour)
  )
};

declare function this:p6-array(
  $file as xs:string
) as map(*)
{
  this:p6-array($file, map {})
};

(:~
 : p6()
 : Write out a file containing the raw PPM format image using the
 : binary format for image values.
 : Can be converted, processed with GIMP, or viewed in Emacs but not browser.
 :  
 : @param $file: where the output is going
 : @param $metadata: metadata to embed
 : @param $matrix: the colour map
 : @param $options: processing options
 :   "colourspace" one of "rgb", "xyz", "hsluv", "lab", "cmyk"
 :      what colour space the point map is to be taken as
 :   "flipped": whether to flip the Y coordinate (some algorithms put Y
 :     facing the opposite way)
 : 
 : Format is:
 : P6
 : width height
 : # comments, if any
 : 255 (=colour max)
 : r g b r g b ... (as binary)
 :)
declare function this:p6(
  $file as xs:string,
  $metadata as xs:string?,
  $matrix as map(*), (: point matrix: point to colour :)
  $options as map(xs:string,item()*)
) as empty-sequence()
{
  if ($matrix=>matrix:kind()=("imagearray","array")) then (
    this:p6(
      $file, $metadata,
      $matrix=>cmatrix:rows(), $matrix=>cmatrix:columns(), $matrix=>cmatrix:data(),
      $options
    )
  ) else (
    let $flipped := ($options("flipped"), false())[1]
    let $colourspace := ($options("colourspace"), "rgb")[1]
    let $getrgb :=
      switch($colourspace)
      case "rgb" return function($val as map(xs:string,item()*)) as map(xs:string,item()*) {$val}
      case "xyz" return function($val as map(xs:string,item()*)) as map(xs:string,item()*) {cs:xyz-to-rgb($val)}
      case "hsluv" return function($val as map(xs:string,item()*)) as map(xs:string,item()*) {cs:hsluv-to-rgb($val)}
      case "lab" return function($val as map(xs:string,item()*)) as map(xs:string,item()*) {cs:lab-to-rgb($val)}
      case "cmyk" return function($val as map(xs:string,item()*)) as map(xs:string,item()*) {cs:cmyk-to-rgb($val)}
      default return function($val as map(xs:string,item()*)) as map(xs:string,item()*) {$val}
    let $min-x := $matrix=>matrix:min-x()
    let $min-y := $matrix=>matrix:min-y()
    let $max-x := $matrix=>matrix:max-x()
    let $max-y := $matrix=>matrix:max-y()
    let $header :=
      "P6"||$this:CRLF||
      ($max-x - $min-x + 1)||" "||($max-y - $min-y + 1)||$this:CRLF||
      string-join(
        for $line in tokenize($metadata, "\n")[. ne ""]
        return "#"||$line, $this:CRLF
      )||$this:CRLF||
      255||$this:CRLF
    (: Some algorithms flip the y coordinates: pure Euclidean vs screen coords :)
    let $y-range :=
      if ($flipped) then reverse($min-y to $max-y) else ($min-y to $max-y)
    let $bytes :=
      binary:from-octets(
        for $y in $y-range
        for $x in $min-x to $max-x
        let $rgb := $getrgb($matrix=>matrix:get($x, $y))
        for $val in rgb:coordinates($rgb, 3)
        return (
          $val
        )
      )
    return (
      file:write-text($file, $header),
      file:append-binary($file, $bytes)
    )
  )
};

declare function this:p6(
  $file as xs:string,
  $metadata as xs:string?,
  $matrix as map(*) (: point matrix: point to colour :)
) as empty-sequence()
{
  this:p6($file, $metadata, $matrix, map {})
};

declare function this:p6(
  $file as xs:string,
  $metadata as xs:string?,
  $rows as xs:integer,
  $columns as xs:integer,
  $colours as map(xs:string,item()*)*,
  $options as map(xs:string,item()*)
) as empty-sequence()
{
  let $flipped := ($options("flipped"), false())[1]
  let $colourspace := ($options("colourspace"), "rgb")[1]
  let $getrgb :=
    switch($colourspace)
    case "rgb" return function($val as map(xs:string,item()*)) as map(xs:string,item()*) {$val}
    case "xyz" return function($val as map(xs:string,item()*)) as map(xs:string,item()*) {cs:xyz-to-rgb($val)}
    case "hsluv" return function($val as map(xs:string,item()*)) as map(xs:string,item()*) {cs:hsluv-to-rgb($val)}
    case "lab" return function($val as map(xs:string,item()*)) as map(xs:string,item()*) {cs:lab-to-rgb($val)}
    case "cmyk" return function($val as map(xs:string,item()*)) as map(xs:string,item()*) {cs:cmyk-to-rgb($val)}
    default return function($val as map(xs:string,item()*)) as map(xs:string,item()*) {$val}
  let $header :=
    "P6"||$this:CRLF||
    $columns||" "||$rows||$this:CRLF||
    string-join(
      for $line in tokenize($metadata, "\n")[. ne ""]
      return "#"||$line, $this:CRLF
    )||$this:CRLF||
    255||$this:CRLF
  (: Some algorithms flip the y coordinates: pure Euclidean vs screen coords :)
  let $colours :=
    if ($flipped) then (
      for $y in reverse(1 to $rows)
      for $x in 1 to $columns
      return $colours[ ($y - 1)*$columns + $x ]
    ) else (
      $colours
    )
  let $n-colours := count($colours)
  let $n-expected := $rows*$columns
  let $colours :=
    if ($n-colours gt $n-expected)
    then $colours[position()<=$n-expected]
    else if ($n-colours lt $n-expected)
    then for $i in 1 to $n-expected - $n-colours return $getrgb(rgb:rgb("black"))
    else $colours
  let $bytes :=
    binary:from-octets(
      for $col in $colours
      let $rgb := $getrgb($col)
      for $val in rgb:coordinates($rgb, 3)
      return (
        $val
      )
    )
  return (
    file:write-text($file, $header),
    file:append-binary($file, $bytes)
  )
};

(:~
 : pam()
 : Write out a file containing raw PAM format image using the binary
 : format for image values. This format can include alpha values for
 : each pixel, not just RGB.
 : 
 : @param $file: where the output is going
 : @param $metadata: metadata to embed
 : @param $matrix: the colour map
 : @param $options: processing options
 :   "colourspace" one of "rgb", "xyz", "hsluv", "lab", "cmyk"
 :      what colour space the point map is to be taken as
 :   "flipped": whether to flip the Y coordinate (some algorithms put Y
 :     facing the opposite way)
 :
 : Format is:
 : P7
 : WIDTH width
 : HEIGHT height
 : DEPTH 4
 : MAXVAL 255
 : TUPLTYPE RGB_ALPHA
 : # comments, if any
 : ENDHDR
 : r g b a r g b a ... (as binary)
 :
 : ImageMagick can convert this but Emacs integration, GIMP, and browser all
 : fail on it.
 :)
declare function this:pam(
  $file as xs:string,
  $metadata as xs:string?,
  $matrix as map(*), (: point matrix: point to colour :)
  $options as map(xs:string,item()*)
) as empty-sequence()
{
  if ($matrix=>matrix:kind()=("imagearray","array")) then (
    this:pam(
      $file, $metadata,
      $matrix=>cmatrix:rows(), $matrix=>cmatrix:columns(), $matrix=>cmatrix:data(),
      $options
    )
  ) else (
    let $flipped := ($options("flipped"), false())[1]
    let $colourspace := ($options("colourspace"), "rgb")[1]
    let $getrgba :=
      switch($colourspace)
      case "rgb" return function($val as map(xs:string,item()*)) as map(xs:string,item()*) {$val}
      case "xyz" return function($val as map(xs:string,item()*)) as map(xs:string,item()*) {cs:xyz-to-rgb($val)}
      case "hsluv" return function($val as map(xs:string,item()*)) as map(xs:string,item()*) {cs:hsluv-to-rgb($val)}
      case "lab" return function($val as map(xs:string,item()*)) as map(xs:string,item()*) {cs:lab-to-rgb($val)}
      case "cmyk" return function($val as map(xs:string,item()*)) as map(xs:string,item()*) {cs:cmyk-to-rgb($val)}
      default return function($val as map(xs:string,item()*)) as map(xs:string,item()*) {$val}
    let $min-x := $matrix=>matrix:min-x()
    let $min-y := $matrix=>matrix:min-y()
    let $max-x := $matrix=>matrix:max-x()
    let $max-y := $matrix=>matrix:max-y()
    let $header :=
      "P7"||$this:CRLF||
      "WIDTH "||($max-x - $min-x + 1)||$this:CRLF||
      "HEIGHT "||($max-y - $min-y + 1)||$this:CRLF||
      "DEPTH 4"||$this:CRLF||
      "MAXVAL 255"||$this:CRLF||
      "TUPLTYPE RGB_ALPHA"||$this:CRLF||
      string-join(
        for $line in tokenize($metadata, "\n")[. ne ""]
        return "#"||$line,
        $this:CRLF
      )||
      $this:CRLF||"ENDHDR"||$this:CRLF
    (: Some algorithms flip the y coordinates: pure Euclidean vs screen coords :)
    let $y-range :=
      if ($flipped) then reverse($min-y to $max-y) else ($min-y to $max-y)
    let $bytes :=
      binary:from-octets(
        for $y in $y-range
        for $x in $min-x to $max-x
        let $rgb := $getrgba($matrix=>matrix:get($x, $y))
        for $val in rgb:coordinates($rgb, 4)
        return (
          $val
        )
      )
    return (
      file:write-text($file, $header),
      file:append-binary($file, $bytes)
    )
  )
};

declare function this:pam(
  $file as xs:string,
  $metadata as xs:string?,
  $matrix as map(*) (: point matrix: point to colour :)
) as empty-sequence()
{
  this:pam($file, $metadata, $matrix, map {})
};

declare function this:pam(
  $file as xs:string,
  $metadata as xs:string?,
  $rows as xs:integer,
  $columns as xs:integer,
  $colours as map(xs:string,item()*)*,
  $options as map(xs:string,item()*)
)
{
  let $flipped := ($options("flipped"), false())[1]
  let $colourspace := ($options("colourspace"), "rgb")[1]
  let $getrgb :=
    switch($colourspace)
    case "rgb" return function($val as map(xs:string,item()*)) as map(xs:string,item()*) {$val}
    case "xyz" return function($val as map(xs:string,item()*)) as map(xs:string,item()*) {cs:xyz-to-rgb($val)}
    case "hsluv" return function($val as map(xs:string,item()*)) as map(xs:string,item()*) {cs:hsluv-to-rgb($val)}
    case "lab" return function($val as map(xs:string,item()*)) as map(xs:string,item()*) {cs:lab-to-rgb($val)}
    case "cmyk" return function($val as map(xs:string,item()*)) as map(xs:string,item()*) {cs:cmyk-to-rgb($val)}
    default return function($val as map(xs:string,item()*)) as map(xs:string,item()*) {$val}
    let $header :=
      "P7"||$this:CRLF||
      "WIDTH "||$columns||$this:CRLF||
      "HEIGHT "||$rows||$this:CRLF||
      "DEPTH 4"||$this:CRLF||
      "MAXVAL 255"||$this:CRLF||
      "TUPLTYPE RGB_ALPHA"||$this:CRLF||
      string-join(
        for $line in tokenize($metadata, "\n")[. ne ""]
        return "#"||$line,
        $this:CRLF
      )||
      $this:CRLF||"ENDHDR"||$this:CRLF
  (: Some algorithms flip the y coordinates: pure Euclidean vs screen coords :)
  let $colours :=
    if ($flipped) then (
      for $y in reverse(1 to $rows)
      for $x in 1 to $columns
      return $colours[ ($y - 1)*$columns + $x ]
    ) else (
      $colours
    )
  let $n-colours := count($colours)
  let $n-expected := $rows*$columns
  let $colours :=
    if ($n-colours gt $n-expected)
    then $colours[position()<=$n-expected]
    else if ($n-colours lt $n-expected)
    then for $i in 1 to $n-expected - $n-colours return $getrgb(rgb:rgb("black"))
    else $colours
  let $bytes :=
    string-join(
      for $col in $colours return (
        rgb:coordinates($getrgb($col), 3)!string(.)
      ), " "
    )
  return (
    file:write-text($file, document {$header, $bytes})
  )
};

| Generated by XQDoc https://xqdoc.org/ with variants of xquerydoc https://github.com/xquery/xquerydoc scripts. |