http://mathling.com/noise/noise-map  library module

Imports

import module namespace arr="http://mathling.com/core/array"
       at "../core/array.xqy"

import module namespace ann="http://mathling.com/noise/annotations"
       at "../noise/annotations.xqy"

import module namespace dist="http://mathling.com/type/distribution"
       at "../types/distributions.xqy"

import module namespace box="http://mathling.com/geometric/rectangle"
       at "../geo/rectangle.xqy"

import module namespace geom="http://mathling.com/geometric"
       at "../geo/euclidean.xqy"

import module namespace matrix="http://mathling.com/geometric/matrix"
       at "../geo/point-matrix.xqy"

import module namespace space="http://mathling.com/type/space"
       at "../types/space.xqy"

import module namespace point="http://mathling.com/geometric/point"
       at "../geo/point.xqy"

import module namespace rand="http://mathling.com/core/random"
       at "../core/random.xqy"

import module namespace util="http://mathling.com/core/utilities"
       at "../core/utilities.xqy"

import module namespace v="http://mathling.com/core/vector"
       at "../core/vector.xqy"

import module namespace noise="http://mathling.com/noise/modifiers"
       at "../noise/modifiers.xqy"

import module namespace errors="http://mathling.com/core/errors"
       at "../core/errors.xqy"

Functions

declare function this:flat(
  $space as map(xs:string,item()*), 
  $noise as item() 
) as map(*)
{
  if (not(ann:is-noise($noise))) then errors:error("ML-BADARGS", ("noise", $noise)) else (),
  this:flat($space, $noise, box:rectangle(-1.0, -1.0, 1.0, 1.0), false())
}

declare function this:flat(
  $space as map(xs:string,item()*),  (: height X width :)
  $noise as item(), (: 2D noise function :)
  $bounds as map(xs:string,item()*) (: scaled :)
) as map(*)
{
  if (not(ann:is-noise($noise))) then errors:error("ML-BADARGS", ("noise", $noise)) else (),
  this:flat($space, $noise, $bounds, false())
}

declare function this:flat(
  $space as map(xs:string,item()*),
  $noise as item(),
  $bounds as map(xs:string,item()*),
  $seamless as xs:boolean
) as map(*)
{
  if (not(ann:is-noise($noise))) then errors:error("ML-BADARGS", ("noise", $noise)) else (),
  if (not($space("kind")=("space","box"))) then errors:error("ML-BADARGS", ("space", $space)) else (),
  if (not($bounds("kind")=("space","box"))) then errors:error("ML-BADARGS", ("bounds", $bounds)) else (),
  let $noisefn := noise:as-vector($noise)=>ann:function()
  let $width := space:width($space) cast as xs:integer
  let $height := space:height($space) cast as xs:integer
  let $x-extent := box:width($bounds)
  let $y-extent := box:height($bounds)
  let $x-step := $x-extent div $width
  let $y-step := $y-extent div $height
  let $min-x := box:min-px($bounds)
  let $min-y := box:min-py($bounds)
  return (
    fold-left(
      0 to $height,
      matrix:matrix($space),
      function($matrix as map(*), $y as xs:integer) {
        let $curr-y := $min-y + $y-step * $y
        return (
          fold-left(
            0 to $width,
            $matrix,
            function($matrix as map(*), $x as xs:integer) {
              let $curr-x := $min-x + $x-step * $x
              let $final-value :=
                if ($seamless) then (
                  let $sw-value := $noisefn(($curr-x, $curr-y))
                  let $se-value := $noisefn(($curr-x + $x-extent, $curr-y))
                  let $nw-value := $noisefn(($curr-x, $curr-y + $y-extent))
                  let $ne-value := $noisefn(($curr-x + $x-extent, $curr-y + $y-extent))
                  let $x-blend := 1 - ($curr-x - $min-x) div $x-extent
                  let $y-blend := 1 - ($curr-y - $min-y) div $y-extent
                  return
                    noise:linear(
                      noise:linear($sw-value, $se-value, $x-blend),
                      noise:linear($nw-value, $ne-value, $x-blend),
                      $y-blend
                    )
                ) else (
                  $noisefn(($curr-x, $curr-y))
                )
              return $matrix=>matrix:put(point:point($x,$y), $final-value)
            }
          )
        )
      }
    )
  )
}

declare function this:flat-static(
  $space as map(xs:string,item()*), 
  $noise as item() 
) as map(*)
{
  if (not(ann:is-noise($noise))) then errors:error("ML-BADARGS", ("noise", $noise)) else (),
  this:flat-static($space, $noise, box:rectangle(-1.0, -1.0, 1.0, 1.0), false())
}

declare function this:flat-static(
  $space as map(xs:string,item()*),  (: height X width :)
  $noise as item(), (: 2D noise function :)
  $bounds as map(xs:string,item()*) (: scaled :)
) as map(*)
{
  if (not(ann:is-noise($noise))) then errors:error("ML-BADARGS", ("noise", $noise)) else (),
  this:flat-static($space, $noise, $bounds, false())
}

declare function this:flat-static(
  $space as map(xs:string,item()*),
  $noise as item(),
  $bounds as map(xs:string,item()*),
  $seamless as xs:boolean
) as map(*)
{
  if (not(ann:is-noise($noise))) then errors:error("ML-BADARGS", ("noise", $noise)) else (),
  if (not($space("kind")=("space","box"))) then errors:error("ML-BADARGS", ("space", $space)) else (),
  if (not($bounds("kind")=("space","box"))) then errors:error("ML-BADARGS", ("bounds", $bounds)) else (),
  let $noisefn := noise:as-vector($noise)=>ann:function()
  let $width := space:width($space) cast as xs:integer
  let $height := space:height($space) cast as xs:integer
  let $x-extent := box:width($bounds)
  let $y-extent := box:height($bounds)
  let $x-step := $x-extent div $width
  let $y-step := $y-extent div $height
  let $min-x := box:min-px($bounds)
  let $min-y := box:min-py($bounds)
  let $data := (
    for $y in 0 to $height
    let $curr-y := $min-y + $y-step * $y
    for $x in 0 to $width
    let $curr-x := $min-x + $x-step * $x
    let $final-value :=
      if ($seamless) then (
        let $sw-value := $noisefn(($curr-x, $curr-y))
        let $se-value := $noisefn(($curr-x + $x-extent, $curr-y))
        let $nw-value := $noisefn(($curr-x, $curr-y + $y-extent))
        let $ne-value := $noisefn(($curr-x + $x-extent, $curr-y + $y-extent))
        let $x-blend := 1 - ($curr-x - $min-x) div $x-extent
        let $y-blend := 1 - ($curr-y - $min-y) div $y-extent
        return
          noise:linear(
            noise:linear($sw-value, $se-value, $x-blend),
            noise:linear($nw-value, $ne-value, $x-blend),
            $y-blend
          )
      ) else (
        $noisefn(($curr-x, $curr-y))
      )
    return $final-value
  )
  return arr:array($height + 1, $width + 1, $data)
}

declare function this:sphere(
  $space as map(xs:string,item()*),  (: height X width :)
  $noise as item(), (: 3D noise function :)
  $bounds as map(xs:string,item()*) (: scaled :)
) as map(*)
{
  if (not(ann:is-noise($noise))) then errors:error("ML-BADARGS", ("noise", $noise)) else (),
  if (not($space("kind")=("space","box"))) then errors:error("ML-BADARGS", ("space", $space)) else (),
  if (not($bounds("kind")=("space","box"))) then errors:error("ML-BADARGS", ("bounds", $bounds)) else (),
  let $noisefn := noise:as-vector($noise)=>ann:function()
  let $width := box:width($space) cast as xs:integer
  let $height := box:height($space) cast as xs:integer
  let $x-extent := box:width($bounds)
  let $y-extent := box:height($bounds)
  let $x-step := $x-extent div $width
  let $y-step := $y-extent div $height
  let $min-x := box:min-px($bounds)
  let $min-y := box:min-py($bounds)
  return (
    fold-left(
      0 to $height,
      matrix:matrix($space),
      function($matrix as map(*), $y as xs:integer) {
        let $curr-y := $min-y + $y-step * $y
        return (
          fold-left(
            0 to $width,
            $matrix,
            function($matrix as map(*), $x as xs:integer) {
              let $curr-x := $min-x + $x-step * $x
              let $xyz-point := this:to-xyz(($curr-x, $curr-y))
              let $final-value := $noisefn($xyz-point)
              return $matrix=>matrix:put(point:point($x,$y), $final-value)
            }
          )
        )
      }
    )
  )
}

declare function this:sphere-array(
  $space as map(xs:string,item()*),  (: height X width :)
  $noise as item(), (: 3D noise function :)
  $bounds as map(xs:string,item()*) (: scaled :)
) as map(*)
{
  if (not(ann:is-noise($noise))) then errors:error("ML-BADARGS", ("noise", $noise)) else (),
  if (not($space("kind")=("space","box"))) then errors:error("ML-BADARGS", ("space", $space)) else (),
  if (not($bounds("kind")=("space","box"))) then errors:error("ML-BADARGS", ("bounds", $bounds)) else (),
  let $noisefn := noise:as-vector($noise)=>ann:function()
  let $width := box:width($space) cast as xs:integer
  let $height := box:height($space) cast as xs:integer
  let $x-extent := box:width($bounds)
  let $y-extent := box:height($bounds)
  let $x-step := $x-extent div $width
  let $y-step := $y-extent div $height
  let $min-x := box:min-px($bounds)
  let $min-y := box:min-py($bounds)
  let $data := (
    for $y in 0 to $height
    let $curr-y := $min-y + $y-step * $y
    let $x := 0 to $width
    let $curr-x := $min-x + $x-step * $x
    let $xyz-point := this:to-xyz(($curr-x, $curr-y))
    return $noisefn($xyz-point)
  )
  return (
    arr:array($height + 1, $width + 1, $data)
  )
}

Original Source Code

xquery version "3.1";
(:~
 : Noise map builder. A noise map is a point matrix populated with values
 : from a noise function. Alternatively if you don't need point-based access
 : and you can contruct a static point map which is a simple array.
 :
 : Port/refactor/expansion of https://github.com/razaekel/noise-rs
 :
 : Copyright© Mary Holstege 2020-2023
 : CC-BY (https://creativecommons.org/licenses/by/4.0/)
 : @since April 2021
 : @custom:Status Stable
 :)
module namespace this="http://mathling.com/noise/noise-map";

declare namespace art="http://mathling.com/art";
declare namespace map="http://www.w3.org/2005/xpath-functions/map";
declare namespace array="http://www.w3.org/2005/xpath-functions/array";
declare namespace math="http://www.w3.org/2005/xpath-functions/math";

import module namespace errors="http://mathling.com/core/errors"
       at "../core/errors.xqy";
import module namespace v="http://mathling.com/core/vector"
       at "../core/vector.xqy";
import module namespace arr="http://mathling.com/core/array"
       at "../core/array.xqy";
import module namespace rand="http://mathling.com/core/random"
       at "../core/random.xqy";
import module namespace dist="http://mathling.com/type/distribution"
       at "../types/distributions.xqy";
import module namespace space="http://mathling.com/type/space"
       at "../types/space.xqy";
import module namespace util="http://mathling.com/core/utilities"
       at "../core/utilities.xqy";
import module namespace geom="http://mathling.com/geometric"
       at "../geo/euclidean.xqy";
import module namespace point="http://mathling.com/geometric/point"
       at "../geo/point.xqy";
import module namespace box="http://mathling.com/geometric/rectangle"
       at "../geo/rectangle.xqy";
import module namespace matrix="http://mathling.com/geometric/matrix"
       at "../geo/point-matrix.xqy";
import module namespace ann="http://mathling.com/noise/annotations"
       at "../noise/annotations.xqy";
import module namespace noise="http://mathling.com/noise/modifiers"
       at "../noise/modifiers.xqy";

(:~
 : flat()
 : Construct a flat noise map covering the space.
 : @param $space: space to compute noise over (canvas space)
 : @param $noise: 2D noise function
 : @return point map
 :)
declare function this:flat(
  $space as map(xs:string,item()*), 
  $noise as item() 
) as map(*)
{
  if (not(ann:is-noise($noise))) then errors:error("ML-BADARGS", ("noise", $noise)) else (),
  this:flat($space, $noise, box:rectangle(-1.0, -1.0, 1.0, 1.0), false())
};

(:~
 : flat()
 : Construct a flat noise map covering the space within the bounds.
 : @param $space: space to compute noise over (canvas space)
 : @param $bounds: the scaled bounds to map, e.g. generally the double unit square
 : @param $noise: 2D noise function
 : @return point map
 :)
declare function this:flat(
  $space as map(xs:string,item()*),  (: height X width :)
  $noise as item(), (: 2D noise function :)
  $bounds as map(xs:string,item()*) (: scaled :)
) as map(*)
{
  if (not(ann:is-noise($noise))) then errors:error("ML-BADARGS", ("noise", $noise)) else (),
  this:flat($space, $noise, $bounds, false())
};

(:~
 : flat()
 : Construct a flat noise map.
 :
 : @param $space: the point extent height x width
 : @param $noise: the 2D noise function to map
 : @param $bounds: the scaled bounds to map, e.g. generally the double unit square
 : @param $seamless: whether to smooth out the mapping
 :)
declare function this:flat(
  $space as map(xs:string,item()*),
  $noise as item(),
  $bounds as map(xs:string,item()*),
  $seamless as xs:boolean
) as map(*)
{
  if (not(ann:is-noise($noise))) then errors:error("ML-BADARGS", ("noise", $noise)) else (),
  if (not($space("kind")=("space","box"))) then errors:error("ML-BADARGS", ("space", $space)) else (),
  if (not($bounds("kind")=("space","box"))) then errors:error("ML-BADARGS", ("bounds", $bounds)) else (),
  let $noisefn := noise:as-vector($noise)=>ann:function()
  let $width := space:width($space) cast as xs:integer
  let $height := space:height($space) cast as xs:integer
  let $x-extent := box:width($bounds)
  let $y-extent := box:height($bounds)
  let $x-step := $x-extent div $width
  let $y-step := $y-extent div $height
  let $min-x := box:min-px($bounds)
  let $min-y := box:min-py($bounds)
  return (
    fold-left(
      0 to $height,
      matrix:matrix($space),
      function($matrix as map(*), $y as xs:integer) {
        let $curr-y := $min-y + $y-step * $y
        return (
          fold-left(
            0 to $width,
            $matrix,
            function($matrix as map(*), $x as xs:integer) {
              let $curr-x := $min-x + $x-step * $x
              let $final-value :=
                if ($seamless) then (
                  let $sw-value := $noisefn(($curr-x, $curr-y))
                  let $se-value := $noisefn(($curr-x + $x-extent, $curr-y))
                  let $nw-value := $noisefn(($curr-x, $curr-y + $y-extent))
                  let $ne-value := $noisefn(($curr-x + $x-extent, $curr-y + $y-extent))
                  let $x-blend := 1 - ($curr-x - $min-x) div $x-extent
                  let $y-blend := 1 - ($curr-y - $min-y) div $y-extent
                  return
                    noise:linear(
                      noise:linear($sw-value, $se-value, $x-blend),
                      noise:linear($nw-value, $ne-value, $x-blend),
                      $y-blend
                    )
                ) else (
                  $noisefn(($curr-x, $curr-y))
                )
              return $matrix=>matrix:put(point:point($x,$y), $final-value)
            }
          )
        )
      }
    )
  )
};

(:~
 : flat-static()
 : Construct a flat-static noise map covering the space.
 : @param $space: space to compute noise over (canvas space)
 : @param $noise: 2D noise function
 : @return point map
 :)
declare function this:flat-static(
  $space as map(xs:string,item()*), 
  $noise as item() 
) as map(*)
{
  if (not(ann:is-noise($noise))) then errors:error("ML-BADARGS", ("noise", $noise)) else (),
  this:flat-static($space, $noise, box:rectangle(-1.0, -1.0, 1.0, 1.0), false())
};

(:~
 : flat-static()
 : Construct a flat-static noise map covering the space within the bounds.
 : @param $space: space to compute noise over (canvas space)
 : @param $bounds: the scaled bounds to map, e.g. generally the double unit square
 : @param $noise: 2D noise function
 : @return point map
 :)
declare function this:flat-static(
  $space as map(xs:string,item()*),  (: height X width :)
  $noise as item(), (: 2D noise function :)
  $bounds as map(xs:string,item()*) (: scaled :)
) as map(*)
{
  if (not(ann:is-noise($noise))) then errors:error("ML-BADARGS", ("noise", $noise)) else (),
  this:flat-static($space, $noise, $bounds, false())
};

(:~
 : flat-static()
 : Construct a flat  noise array.
 :
 : @param $space: the point extent height x width
 : @param $noise: the 2D noise function to map
 : @param $bounds: the scaled bounds to map, e.g. generally the double unit square
 : @param $seamless: whether to smooth out the mapping
 :)
declare function this:flat-static(
  $space as map(xs:string,item()*),
  $noise as item(),
  $bounds as map(xs:string,item()*),
  $seamless as xs:boolean
) as map(*)
{
  if (not(ann:is-noise($noise))) then errors:error("ML-BADARGS", ("noise", $noise)) else (),
  if (not($space("kind")=("space","box"))) then errors:error("ML-BADARGS", ("space", $space)) else (),
  if (not($bounds("kind")=("space","box"))) then errors:error("ML-BADARGS", ("bounds", $bounds)) else (),
  let $noisefn := noise:as-vector($noise)=>ann:function()
  let $width := space:width($space) cast as xs:integer
  let $height := space:height($space) cast as xs:integer
  let $x-extent := box:width($bounds)
  let $y-extent := box:height($bounds)
  let $x-step := $x-extent div $width
  let $y-step := $y-extent div $height
  let $min-x := box:min-px($bounds)
  let $min-y := box:min-py($bounds)
  let $data := (
    for $y in 0 to $height
    let $curr-y := $min-y + $y-step * $y
    for $x in 0 to $width
    let $curr-x := $min-x + $x-step * $x
    let $final-value :=
      if ($seamless) then (
        let $sw-value := $noisefn(($curr-x, $curr-y))
        let $se-value := $noisefn(($curr-x + $x-extent, $curr-y))
        let $nw-value := $noisefn(($curr-x, $curr-y + $y-extent))
        let $ne-value := $noisefn(($curr-x + $x-extent, $curr-y + $y-extent))
        let $x-blend := 1 - ($curr-x - $min-x) div $x-extent
        let $y-blend := 1 - ($curr-y - $min-y) div $y-extent
        return
          noise:linear(
            noise:linear($sw-value, $se-value, $x-blend),
            noise:linear($nw-value, $ne-value, $x-blend),
            $y-blend
          )
      ) else (
        $noisefn(($curr-x, $curr-y))
      )
    return $final-value
  )
  return arr:array($height + 1, $width + 1, $data)
};

(:~
 : sphere()
 : Construct a spherical noise map.
 :
 : @param $space: the point extent height x width
 : @param $noise: the noise function to map
 : @param $bounds: the scaled bounds to map, e.g. generally the double unit square
 :)
declare function this:sphere(
  $space as map(xs:string,item()*),  (: height X width :)
  $noise as item(), (: 3D noise function :)
  $bounds as map(xs:string,item()*) (: scaled :)
) as map(*)
{
  if (not(ann:is-noise($noise))) then errors:error("ML-BADARGS", ("noise", $noise)) else (),
  if (not($space("kind")=("space","box"))) then errors:error("ML-BADARGS", ("space", $space)) else (),
  if (not($bounds("kind")=("space","box"))) then errors:error("ML-BADARGS", ("bounds", $bounds)) else (),
  let $noisefn := noise:as-vector($noise)=>ann:function()
  let $width := box:width($space) cast as xs:integer
  let $height := box:height($space) cast as xs:integer
  let $x-extent := box:width($bounds)
  let $y-extent := box:height($bounds)
  let $x-step := $x-extent div $width
  let $y-step := $y-extent div $height
  let $min-x := box:min-px($bounds)
  let $min-y := box:min-py($bounds)
  return (
    fold-left(
      0 to $height,
      matrix:matrix($space),
      function($matrix as map(*), $y as xs:integer) {
        let $curr-y := $min-y + $y-step * $y
        return (
          fold-left(
            0 to $width,
            $matrix,
            function($matrix as map(*), $x as xs:integer) {
              let $curr-x := $min-x + $x-step * $x
              let $xyz-point := this:to-xyz(($curr-x, $curr-y))
              let $final-value := $noisefn($xyz-point)
              return $matrix=>matrix:put(point:point($x,$y), $final-value)
            }
          )
        )
      }
    )
  )
};

(:~
 : sphere-static()
 : Construct a spherical noise array
 :
 : @param $space: the point extent height x width
 : @param $noise: the noise function to map
 : @param $bounds: the scaled bounds to map, e.g. generally the double unit square
 : @return noise array
 :)
declare function this:sphere-array(
  $space as map(xs:string,item()*),  (: height X width :)
  $noise as item(), (: 3D noise function :)
  $bounds as map(xs:string,item()*) (: scaled :)
) as map(*)
{
  if (not(ann:is-noise($noise))) then errors:error("ML-BADARGS", ("noise", $noise)) else (),
  if (not($space("kind")=("space","box"))) then errors:error("ML-BADARGS", ("space", $space)) else (),
  if (not($bounds("kind")=("space","box"))) then errors:error("ML-BADARGS", ("bounds", $bounds)) else (),
  let $noisefn := noise:as-vector($noise)=>ann:function()
  let $width := box:width($space) cast as xs:integer
  let $height := box:height($space) cast as xs:integer
  let $x-extent := box:width($bounds)
  let $y-extent := box:height($bounds)
  let $x-step := $x-extent div $width
  let $y-step := $y-extent div $height
  let $min-x := box:min-px($bounds)
  let $min-y := box:min-py($bounds)
  let $data := (
    for $y in 0 to $height
    let $curr-y := $min-y + $y-step * $y
    let $x := 0 to $width
    let $curr-x := $min-x + $x-step * $x
    let $xyz-point := this:to-xyz(($curr-x, $curr-y))
    return $noisefn($xyz-point)
  )
  return (
    arr:array($height + 1, $width + 1, $data)
  )
};

declare %private function this:to-xyz($point as xs:double*) as xs:double*
{
  let $lat-radians := util:radians(v:py($point))
  let $long-radians := util:radians(v:px($point))
  let $r := math:cos($lat-radians)
  return (
    $r * math:cos($long-radians),
    math:sin($lat-radians),
    $r * math:sin($long-radians)
  )
};