Image.hs

{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE DisambiguateRecordFields #-}
module Verify.Graphics.Vty.Image ( module Verify.Graphics.Vty.Image
                                 , module Graphics.Vty.Image
                                 )
    where

import Graphics.Vty.Debug
import Graphics.Vty.Image
import Graphics.Vty.DisplayRegion

import Verify
import Verify.Graphics.Vty.Attributes

import Data.Word

data UnitImage = UnitImage Char Image

instance Arbitrary UnitImage where
    arbitrary = do
        SingleColumnChar c <- arbitrary
        return $ UnitImage c (char def_attr c)

instance Show UnitImage where
    show (UnitImage c _) = "UnitImage " ++ show c

data DefaultImage = DefaultImage Image ImageConstructLog

instance Show DefaultImage where
    show (DefaultImage i image_log) 
        = "DefaultImage (" ++ show i ++ ") " ++ show (image_width i, image_height i) ++ " " ++ show image_log

instance Arbitrary DefaultImage where
    arbitrary = do
        i <- return $ char def_attr 'X' -- elements forward_image_ops >>= return . (\op -> op empty_image)
        return $ DefaultImage i []

data SingleRowSingleAttrImage 
    = SingleRowSingleAttrImage 
      { expected_attr :: Attr
      , expected_columns :: Word
      , row_image :: Image
      }

instance Show SingleRowSingleAttrImage where
    show (SingleRowSingleAttrImage attr columns image) 
        = "SingleRowSingleAttrImage (" ++ show attr ++ ") " ++ show columns ++ " ( " ++ show image ++ " )"

instance Arbitrary SingleRowSingleAttrImage where
    arbitrary = do
        -- The text must contain at least one character. Otherwise the image simplifies to the
        -- IdImage which has a height of 0. If this is to represent a single row then the height
        -- must be 1
        single_column_row_text <- listOf1 arbitrary
        attr <- arbitrary
        return $ SingleRowSingleAttrImage 
                    attr 
                    ( fromIntegral $ length single_column_row_text )
                    ( horiz_cat $ [ char attr c | SingleColumnChar c <- single_column_row_text ] )

data SingleRowTwoAttrImage 
    = SingleRowTwoAttrImage 
    { part_0 :: SingleRowSingleAttrImage
    , part_1 :: SingleRowSingleAttrImage
    , join_image :: Image
    } deriving Show

instance Arbitrary SingleRowTwoAttrImage where
    arbitrary = do
        p0 <- arbitrary
        p1 <- arbitrary
        return $ SingleRowTwoAttrImage p0 p1 (row_image p0 <|> row_image p1)

data SingleAttrSingleSpanStack = SingleAttrSingleSpanStack 
    { stack_image :: Image 
    , stack_source_images :: [SingleRowSingleAttrImage]
    , stack_width :: Word
    , stack_height :: Word
    }
    deriving Show

instance Arbitrary SingleAttrSingleSpanStack where
    arbitrary = do
        NonEmpty image_list <- arbitrary
        let image = vert_cat [ i | SingleRowSingleAttrImage { row_image = i } <- image_list ]
        return $ SingleAttrSingleSpanStack 
                    image 
                    image_list 
                    ( maximum $ map expected_columns image_list )
                    ( toEnum $ length image_list )