-- Copyright 2009-2010 Corey O'Connor
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE DisambiguateRecordFields #-}
{-# OPTIONS_GHC -funbox-strict-fields #-}
module Graphics.Vty.Image ( Image(..)
                          , image_width
                          , image_height
                          , (<|>)
                          , (<->)
                          , horiz_cat
                          , vert_cat
                          , background_fill
                          , char
                          , string
                          , iso_10646_string
                          , utf8_string
                          , utf8_bytestring
                          , char_fill
                          , empty_image
                          , translate
                          -- | The possible display attributes used in constructing an `Image`.
                          , module Graphics.Vty.Attributes
                          )
    where

import Graphics.Vty.Attributes

import Codec.Binary.UTF8.Width

import Codec.Binary.UTF8.String ( decode )

import qualified Data.ByteString as BS
import Data.Monoid
import qualified Data.Sequence as Seq
import qualified Data.String.UTF8 as UTF8
import Data.Word

infixr 5 <|>
infixr 4 <->

type StringSeq = Seq.Seq Char

-- | An image in VTY defines:
--
--  * properties required to display the image. These are properties that effect the output image
--    but are independent of position 
--
--  * A set of position-dependent text and attribute regions. The possible regions are:
--
--      * a point. ( char )
--
--      * a horizontal line of characters with a single attribute. (string, utf8_string,
--      utf8_bytestring )
--
--      * a fill of a single character. (char_fill)
--
--      * a fill of the picture's background. (background_fill)
--
-- todo: increase the number of encoded bytestring formats supported.
data Image = 
    -- A horizontal text span is always >= 1 column and has a row height of 1.
      HorizText
      { attr :: !Attr
      -- All character data is stored as Char sequences with the ISO-10646 encoding.
      , text :: StringSeq
      -- in columns
      , output_width :: !Word -- >= 0
      , char_width :: !Word -- >= 1
      }
    -- A horizontal join can be constructed between any two images. However a HorizJoin instance is
    -- required to be between two images of equal height. The horiz_join constructor adds background
    -- filles to the provided images that assure this is true for the HorizJoin value produced.
    | HorizJoin
      { part_left :: Image 
      , part_right :: Image
      , output_width :: !Word -- >= 1
      , output_height :: !Word -- >= 1
      }
    -- A veritical join can be constructed between any two images. However a VertJoin instance is
    -- required to be between two images of equal width. The vert_join constructor adds background
    -- fills to the provides images that assure this is true for the VertJoin value produced.
    | VertJoin
      { part_top :: Image
      , part_bottom :: Image
      , output_width :: !Word -- >= 1
      , output_height :: !Word -- >= 1
      }
    -- A background fill will be filled with the background pattern. The background pattern is
    -- defined as a property of the Picture this Image is used to form. 
    | BGFill
      { output_width :: !Word -- >= 1
      , output_height :: !Word -- >= 1
      }
    -- The combining operators identity constant. 
    -- EmptyImage <|> a = a
    -- EmptyImage <-> a = a
    -- 
    -- Any image of zero size equals the empty image.
    | EmptyImage
    | Translation (Int, Int) Image
    deriving Eq

instance Show Image where
    show ( HorizText { output_width = ow, text = txt } ) 
        = "HorizText [" ++ show ow ++ "] (" ++ show txt ++ ")"
    show ( BGFill { output_width = c, output_height = r } ) 
        = "BGFill (" ++ show c ++ "," ++ show r ++ ")"
    show ( HorizJoin { part_left = l, part_right = r, output_width = c } ) 
        = "HorizJoin " ++ show c ++ " ( " ++ show l ++ " <|> " ++ show r ++ " )"
    show ( VertJoin { part_top = t, part_bottom = b, output_width = c, output_height = r } ) 
        = "VertJoin (" ++ show c ++ ", " ++ show r ++ ") ( " ++ show t ++ " ) <-> ( " ++ show b ++ " )"
    show ( Translation offset i )
        = "Translation ( " ++ show offset ++ ", " ++ show i ++ " )"
    show ( EmptyImage ) = "EmptyImage"

-- | Currently append in the Monoid instance is equivalent to <->. Future versions will just stack
-- the images.
instance Monoid Image where
    mempty = empty_image
    mappend = (<->)
    
-- A horizontal text image of 0 characters in width simplifies to the EmptyImage
horiz_text :: Attr -> StringSeq -> Word -> Image
horiz_text a txt ow
    | ow == 0    = EmptyImage
    | otherwise = HorizText a txt ow (toEnum $ Seq.length txt)

horiz_join :: Image -> Image -> Word -> Word -> Image
horiz_join i_0 i_1 w h
    -- A horiz join of two 0 width images simplifies to the EmptyImage
    | w == 0 = EmptyImage
    -- A horizontal join where either part is 0 columns in width simplifies to the other part.
    -- This covers the case where one part is the EmptyImage.
    | image_width i_0 == 0 = i_1
    | image_width i_1 == 0 = i_0
    -- If the images are of the same height then no BG padding is required
    | image_height i_0 == image_height i_1 = HorizJoin i_0 i_1 w h
    -- otherwise one of the imagess needs to be padded to the right size.
    | image_height i_0 < image_height i_1  -- Pad i_0
        = let pad_amount = image_height i_1 - image_height i_0
          in horiz_join ( vert_join i_0 
                                    ( BGFill ( image_width i_0 ) pad_amount ) 
                                    ( image_width i_0 )
                                    ( image_height i_1 )
                        ) 
                        i_1 
                        w h
    | image_height i_0 > image_height i_1  -- Pad i_1
        = let pad_amount = image_height i_0 - image_height i_1
          in horiz_join i_0 
                        ( vert_join i_1 
                                    ( BGFill ( image_width i_1 ) pad_amount ) 
                                    ( image_width i_1 )
                                    ( image_height i_0 )
                        )
                        w h
horiz_join _ _ _ _ = error "horiz_join applied to undefined values."

vert_join :: Image -> Image -> Word -> Word -> Image
vert_join i_0 i_1 w h
    -- A vertical join of two 0 height images simplifies to the EmptyImage
    | h == 0                = EmptyImage
    -- A vertical join where either part is 0 rows in height simplifies to the other part.
    -- This covers the case where one part is the EmptyImage
    | image_height i_0 == 0 = i_1
    | image_height i_1 == 0 = i_0
    -- If the images are of the same height then no background padding is required
    | image_width i_0 == image_width i_1 = VertJoin i_0 i_1 w h
    -- Otherwise one of the images needs to be padded to the size of the other image.
    | image_width i_0 < image_width i_1
        = let pad_amount = image_width i_1 - image_width i_0
          in vert_join ( horiz_join i_0
                                    ( BGFill pad_amount ( image_height i_0 ) )
                                    ( image_width i_1 )
                                    ( image_height i_0 )
                       )
                       i_1
                       w h
    | image_width i_0 > image_width i_1
        = let pad_amount = image_width i_0 - image_width i_1
          in vert_join i_0
                       ( horiz_join i_1
                                    ( BGFill pad_amount ( image_height i_1 ) )
                                    ( image_width i_0 )
                                    ( image_height i_1 )
                       )
                       w h
vert_join _ _ _ _ = error "vert_join applied to undefined values."

-- | An area of the picture's bacground (See Background) of w columns and h rows.
background_fill :: Word -> Word -> Image
background_fill w h 
    | w == 0    = EmptyImage
    | h == 0    = EmptyImage
    | otherwise = BGFill w h

-- | The width of an Image. This is the number display columns the image will occupy.
image_width :: Image -> Word
image_width HorizText { output_width = w } = w
image_width HorizJoin { output_width = w } = w
image_width VertJoin { output_width = w } = w
image_width BGFill { output_width = w } = w
image_width EmptyImage = 0
image_width ( Translation _v i ) = image_width i

-- | The height of an Image. This is the number of display rows the image will occupy.
image_height :: Image -> Word
image_height HorizText {} = 1
image_height HorizJoin { output_height = r } = r
image_height VertJoin { output_height = r } = r
image_height BGFill { output_height = r } = r
image_height EmptyImage = 0
image_height ( Translation _v i ) = image_height i

-- | Combines two images side by side.
--
-- The result image will have a width equal to the sum of the two images width.  And the height will
-- equal the largest height of the two images.  The area not defined in one image due to a height
-- missmatch will be filled with the background pattern.
(<|>) :: Image -> Image -> Image

-- Two horizontal text spans with the same attributes can be merged.
h0@(HorizText attr_0 text_0 ow_0 _) <|> h1@(HorizText attr_1 text_1 ow_1 _)  
    | attr_0 == attr_1  = horiz_text attr_0 (text_0 Seq.>< text_1) (ow_0 + ow_1)
    | otherwise         = horiz_join h0 h1 (ow_0 + ow_1) 1

-- Anything placed to the right of a join wil be joined to the right sub image.
-- The total columns for the join is the sum of the two arguments columns
h0@( HorizJoin {} ) <|> h1 
    = horiz_join ( part_left h0 ) 
                 ( part_right h0 <|> h1 )
                 ( image_width h0 + image_width h1 )
                 ( max (image_height h0) (image_height h1) )

-- Anything but a join placed to the left of a join wil be joined to the left sub image.
-- The total columns for the join is the sum of the two arguments columns
h0 <|> h1@( HorizJoin {} ) 
    = horiz_join ( h0 <|> part_left h1 ) 
                 ( part_right h1 )
                 ( image_width h0 + image_width h1 )
                 ( max (image_height h0) (image_height h1) )

h0 <|> h1 
    = horiz_join h0 
                 h1 
                 ( image_width h0 + image_width h1 )
                 ( max (image_height h0) (image_height h1) )

-- | Combines two images vertically.
-- The result image will have a height equal to the sum of the heights of both images.
-- The width will equal the largest width of the two images.
-- The area not defined in one image due to a width missmatch will be filled with the background
-- pattern.
(<->) :: Image -> Image -> Image
im_t <-> im_b 
    = vert_join im_t 
                im_b 
                ( max (image_width im_t) (image_width im_b) ) 
                ( image_height im_t + image_height im_b )

-- | Compose any number of images horizontally.
horiz_cat :: [Image] -> Image
horiz_cat = foldr (<|>) EmptyImage

-- | Compose any number of images vertically.
vert_cat :: [Image] -> Image
vert_cat = foldr (<->) EmptyImage

-- | an image of a single character. This is a standard Haskell 31-bit character assumed to be in
-- the ISO-10646 encoding.
char :: Attr -> Char -> Image
char !a !c = HorizText a (Seq.singleton c) (safe_wcwidth c) 1

-- | A string of characters layed out on a single row with the same display attribute. The string is
-- assumed to be a sequence of ISO-10646 characters. 
--
-- Note: depending on how the Haskell compiler represents string literals a string literal in a
-- UTF-8 encoded source file, for example, may be represented as a ISO-10646 string. 
-- That is, I think, the case with GHC 6.10. This means, for the most part, you don't need to worry
-- about the encoding format when outputting string literals. Just provide the string literal
-- directly to iso_10646_string or string.
-- 
iso_10646_string :: Attr -> String -> Image
iso_10646_string !a !str = horiz_text a (Seq.fromList str) (safe_wcswidth str)

-- | Alias for iso_10646_string. Since the usual case is that a literal string like "foo" is
-- represented internally as a list of ISO 10646 31 bit characters.  
--
-- Note: Keep in mind that GHC will compile source encoded as UTF-8 but the literal strings, while
-- UTF-8 encoded in the source, will be transcoded to a ISO 10646 31 bit characters runtime
-- representation.
string :: Attr -> String -> Image
string = iso_10646_string

-- | A string of characters layed out on a single row. The string is assumed to be a sequence of
-- UTF-8 characters.
utf8_string :: Attr -> [Word8] -> Image
utf8_string !a !str = string a ( decode str )

safe_wcwidth :: Char -> Word
safe_wcwidth c = case wcwidth c of
    i   | i < 0 -> 0 -- error "negative wcwidth"
        | otherwise -> toEnum i

safe_wcswidth :: String -> Word
safe_wcswidth str = case wcswidth str of
    i   | i < 0 -> 0 -- error "negative wcswidth"
        | otherwise -> toEnum i

-- | Renders a UTF-8 encoded bytestring. 
utf8_bytestring :: Attr -> BS.ByteString -> Image
utf8_bytestring !a !bs = string a (UTF8.toString $ UTF8.fromRep bs)

-- | creates a fill of the specified character. The dimensions are in number of characters wide and
-- number of rows high.
--
-- Unlike the Background fill character this character can have double column display width.
char_fill :: Enum d => Attr -> Char -> d -> d -> Image
char_fill !a !c w h = 
    vert_cat $ replicate (fromEnum h) $ horiz_cat $ replicate (fromEnum w) $ char a c

-- | The empty image. Useful for fold combinators. These occupy no space nor define any display
-- attributes.
empty_image :: Image 
empty_image = EmptyImage

translate :: (Int, Int) -> Image -> Image
translate v i = Translation v i