--** @module Graphics

#INCLUDE "palette.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 spec (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
:

BYTE, BYTE, BYTE FUNCTION spec2 (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 palette (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 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 := spec (x)
          c := palette (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 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 := spec2 (x)
          c := palette (r, g, b, permute)
    RESULT c
:
