--
--	rastergraphics: raster graphics primitives
--	Copyright (C) 2007  David Wood <dcw@kent.ac.uk>
--
--	This library is free software; you can redistribute it and/or
--	modify it under the terms of the GNU Lesser General Public
--	License as published by the Free Software Foundation, either
--	version 2 of the License, or (at your option) any later version.
--
--	This library is distributed in the hope that it will be useful,
--	but WITHOUT ANY WARRANTY; without even the implied warranty of
--	MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
--	Lesser General Public License for more details.
--
--	You should have received a copy of the GNU Lesser General Public
--	License along with this library.  If not, see
--	<http://www.gnu.org/licenses/>.
--

--** @module rastergraphics

#INCLUDE "graphics.inc"

--* Maps code value into three [@code BYTEs]
--  representing primary colours (not necessarily RGB),
--  with smooth transitions.
--
--  @param x Value [@code (0.0 <= x < 1.0)]
--  @returns "red", "green", "blue"

BYTE, BYTE, BYTE FUNCTION map.to.components.spectrum (VAL REAL64 x)

  VAL BYTE MAX IS #FF:
  VAL REAL64 MAX64 IS REAL64 ROUND MAX:

  --* Smooth transition.
  --
  --  @param x Argument; [@code 0.0 <= x <= 1.0]
  --  @return [@code 0 <= "colour" <= #FF]

  BYTE INLINE FUNCTION smooth (VAL REAL64 x) IS
  --BYTE ROUND (x * MAX64):			-- linear
    BYTE ROUND ((x * (2.0 - x)) * MAX64):	-- quadratic

  BYTE r, g, b:
  VALOF
    REAL64 f:
    INT i:
    SEQ
      f := x * 8.0				-- 0 <= x < 1.0
      i := INT TRUNC f				-- 0 <= i < 8
      f := f - (REAL64 ROUND i)			-- 0 <= f < 1.0
      CASE i \ 8				-- just in case
        0
          r, g, b := smooth (f), 0, 0		-- black to "red"
        1
          r, g, b := MAX, smooth (f), 0		-- "red" to "yellow"
        2
          r, g, b := smooth (1.0 - f), MAX, 0	-- "yellow" to "green"
        3
          r, g, b := 0, MAX, smooth (f)		-- "green" to "cyan"
        4
          r, g, b := 0, smooth (1.0 - f), MAX	-- "cyan" to "blue"
        5
          r, g, b := smooth (f), 0, MAX		-- "blue" to "magenta"
        6
          r, g, b := MAX, 0, smooth (1.0 - f)	-- "magenta" to "red"
        7
          r, g, b := MAX, smooth (f), smooth(f)	-- "red" to white
    RESULT r, g, b
:

--* As [@ref map.to.components.spectrum], but without mapping through black.

BYTE, BYTE, BYTE FUNCTION map.to.components.wheel (VAL REAL64 x)

  VAL BYTE MAX IS #FF:
  VAL REAL64 MAX64 IS REAL64 ROUND MAX:

  BYTE INLINE FUNCTION smooth (VAL REAL64 x) IS
  --BYTE ROUND (x * MAX64):			-- linear
    BYTE ROUND ((x * (2.0 - x)) * MAX64):	-- quadratic

  BYTE r, g, b:
  VALOF
    REAL64 f:
    INT i:
    SEQ
      f := x * 6.0				-- 0 <= x < 1.0
      i := INT TRUNC f				-- 0 <= i < 8
      f := f - (REAL64 ROUND i)			-- 0 <= f < 1.0
      CASE i \ 6				-- just in case
        0
          r, g, b := MAX, smooth (f), 0		-- "red" to "yellow"
        1
          r, g, b := smooth (1.0 - f), MAX, 0	-- "yellow" to "green"
        2
          r, g, b := 0, MAX, smooth (f)		-- "green" to "cyan"
        3
          r, g, b := 0, smooth (1.0 - f), MAX	-- "cyan" to "blue"
        4
          r, g, b := smooth (f), 0, MAX		-- "blue" to "magenta"
        5
          r, g, b := MAX, 0, smooth (1.0 - f)	-- "magenta" to "red"
    RESULT r, g, b
:

--* Maps three [@code BYTEs] representing colours to an [@code INT],
--  according to the code [@code permute].
--
--  @param r, g, b "red", "green", "blue"
--  @param permute Permutation code
--  @return #rrggbb

INT FUNCTION pack.colour.permuted (VAL BYTE r, g, b, VAL INT permute)

  DATA TYPE COLOUR IS [4]BYTE:

  INT INLINE FUNCTION pack (VAL COLOUR colour)

    VAL INT colour RETYPES colour:
    VALOF
      SKIP
      RESULT colour
  :

  COLOUR colour:
  VALOF
    CASE permute
      PALETTE.RGB
        colour := [b, g, r, 0]
      PALETTE.BGR
        colour := [r, g, b, 0]
      PALETTE.RBG
        colour := [g, b, r, 0]
      PALETTE.GBR
        colour := [r, b, g, 0]
      PALETTE.GRB
        colour := [b, r, g, 0]
      PALETTE.BRG
        colour := [g, r, b, 0]
      ELSE					-- shouldn't happen
        colour := [b, g, r, 0]			-- it has to be something
    RESULT pack (colour)
:

--* Maps [@code x] ([@code 0.0 <= x < 1.0]) to [@code INT]
--  representing a colour, according to the code [@code permute].
--  Shades from black through "red", "yellow", "green", "cyan", "magenta",
--  back to "red", and finally black.
--
--  [@code x >= 1.0] shown as black;
--  [@code x <  0.0] shown as dark grey.
--
--  @param x [@code (0.0 <= x < 1.0)]
--  @param permute Permutation code
--  @return [@code #rrggbb]

INT FUNCTION map.colour.spectrum (VAL REAL64 x, VAL INT permute)

  INT c:
  VALOF
    IF
      x >= 1.0
        c := #FFFFFF				-- white
      x < 0.0
        c := #404040				-- dark grey
      TRUE
        BYTE r, g, b:
        SEQ
          r, g, b := map.to.components.spectrum (x)
          c := pack.colour.permuted (r, g, b, permute)
    RESULT c
:

--* Maps [@code x] ([@code 0.0 <= x < 1.0]) to [@code INT]
--  representing a colour, according to the code [@code permute].
--  Shades from "red" through "yellow", "green", "cyan", "magenta",
--  back to "red".
--
--  [@code x >= 1.0] shown as black;
--  [@code x <  0.0] shown as white.
--
--  @param x [@code (0.0 <= x < 1.0)]
--  @param permute Permutation code
--  @return [@code #rrggbb]

INT FUNCTION map.colour.wheel (VAL REAL64 x, VAL INT permute)

  INT c:
  VALOF
    IF
      x < 0.0
        c := #FFFFFF				-- white
      TRUE
        BYTE r, g, b:
        SEQ
          r, g, b := map.to.components.wheel (x)
          c := pack.colour.permuted (r, g, b, permute)
    RESULT c
:
