{-
	Copyright (C) 2021 Dr. Alistair Ward

	This file is part of BishBosh.

	BishBosh is free software: you can redistribute it and/or modify
	it under the terms of the GNU General Public License as published by
	the Free Software Foundation, either version 3 of the License, or
	(at your option) any later version.

	BishBosh 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 General Public License for more details.

	You should have received a copy of the GNU General Public License
	along with BishBosh.  If not, see <http://www.gnu.org/licenses/>.
-}
{- |
 [@AUTHOR@]	Dr. Alistair Ward

 [@DESCRIPTION@]	Defines the encoding of colours for rendering on a terminal; <https://en.wikipedia.org/wiki/ANSI_escape_code>.
-}

module BishBosh.Colour.ANSIColourCode(
-- * Types
-- ** Type-synonyms
--	ANSIColourCode(),
--	IsBold,
	GraphicsRendition,
-- * Functions
	selectGraphicsRendition,
	bracket,
-- ** Constructors
	mkFgColourCode,
	mkBgColourCode
) where

import qualified	BishBosh.Colour.PhysicalColour	as Colour.PhysicalColour
import qualified	Data.Default

-- | A colour-code as used by terminal-emulators.
newtype ANSIColourCode	= MkANSIColourCode {
	ANSIColourCode -> Int
deconstruct	:: Int
}

instance Show ANSIColourCode where
	showsPrec :: Int -> ANSIColourCode -> ShowS
showsPrec Int
precedence MkANSIColourCode { deconstruct :: ANSIColourCode -> Int
deconstruct = Int
i }	= Int -> Int -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
precedence Int
i

instance Data.Default.Default ANSIColourCode where
	def :: ANSIColourCode
def	= Int -> ANSIColourCode
MkANSIColourCode Int
0

-- | The font-weight of a character.
type IsBold	= Bool

-- | An escape-sequence used to control a terminal.
type GraphicsRendition	= String

-- | Constructor: offset the specified colour-code, so that it applies to the foreground.
mkFgColourCode :: Colour.PhysicalColour.PhysicalColour -> ANSIColourCode
mkFgColourCode :: PhysicalColour -> ANSIColourCode
mkFgColourCode	= Int -> ANSIColourCode
MkANSIColourCode (Int -> ANSIColourCode)
-> (PhysicalColour -> Int) -> PhysicalColour -> ANSIColourCode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
30) (Int -> Int) -> (PhysicalColour -> Int) -> PhysicalColour -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PhysicalColour -> Int
forall a. Enum a => a -> Int
fromEnum {-CAVEAT: relies on the PhysicalColour's constructor-order-}

-- | Constructor: offset the specified colour-code, so that it applies to the background.
mkBgColourCode :: Colour.PhysicalColour.PhysicalColour -> ANSIColourCode
mkBgColourCode :: PhysicalColour -> ANSIColourCode
mkBgColourCode	= Int -> ANSIColourCode
MkANSIColourCode (Int -> ANSIColourCode)
-> (PhysicalColour -> Int) -> PhysicalColour -> ANSIColourCode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
40) (Int -> Int) -> (PhysicalColour -> Int) -> PhysicalColour -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PhysicalColour -> Int
forall a. Enum a => a -> Int
fromEnum {-CAVEAT: relies on the PhysicalColour's constructor-order-}

-- | Generate the escape-sequence required to change a terminal to the specified physical colour.
selectGraphicsRendition :: IsBold -> ANSIColourCode -> GraphicsRendition
selectGraphicsRendition :: IsBold -> ANSIColourCode -> String
selectGraphicsRendition IsBold
isBold ANSIColourCode
parameter	= String -> ShowS
showString String
"\x1b[" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ANSIColourCode -> ShowS
forall a. Show a => a -> ShowS
shows ANSIColourCode
parameter ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ (if IsBold
isBold then String -> ShowS
showString String
";1" else ShowS
forall a. a -> a
id) String
"m"

-- | Render the specified string according to instructions, then revert to the default.
bracket :: GraphicsRendition -> String -> ShowS
bracket :: String -> String -> ShowS
bracket String
graphicsRendition String
s	= String -> ShowS
showString String
graphicsRendition ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
s ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString (
	IsBold -> ANSIColourCode -> String
selectGraphicsRendition IsBold
False ANSIColourCode
forall a. Default a => a
Data.Default.def
 )