-- | Picture variable types and utilities.
module Data.TI85.Var.Pic (
    -- * TI Bitmap
    TIBitmap,
    emptyBitmap,
    fromBytes,
    toBytes,
    -- * Display utilities
    showAsciiArt,
    writePicPng
    ) where

import Prelude hiding (take, drop)
import Data.Text (Text, pack, intercalate, take, drop)
import Data.Text.Encoding (decodeLatin1)
import Data.ByteString (ByteString)
import qualified Data.ByteString as BS
import Codec.Picture
import Data.Bits
import Data.Word
import Data.Vector.Storable hiding (map,take,drop)
import Numeric (showHex)

import Data.TI85.Encoding (tiDecode)

-- | A TI Picture variable is encoded as a packed bitmap,
-- and is always 128x63 binary pixels.
newtype TIBitmap = TIBitmap ByteString deriving Int -> TIBitmap -> ShowS
[TIBitmap] -> ShowS
TIBitmap -> String
(Int -> TIBitmap -> ShowS)
-> (TIBitmap -> String) -> ([TIBitmap] -> ShowS) -> Show TIBitmap
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TIBitmap -> ShowS
showsPrec :: Int -> TIBitmap -> ShowS
$cshow :: TIBitmap -> String
show :: TIBitmap -> String
$cshowList :: [TIBitmap] -> ShowS
showList :: [TIBitmap] -> ShowS
Show

_bmCols :: Int
_bmCols = Int
128
_bmRows :: Int
_bmRows = Int
63
_bmSizeBytes :: Int
_bmSizeBytes = Int
1008

-- | A blank (all zero) bitmap
emptyBitmap :: TIBitmap
emptyBitmap :: TIBitmap
emptyBitmap = ByteString -> TIBitmap
TIBitmap (Int -> Word8 -> ByteString
BS.replicate Int
_bmSizeBytes Word8
0x0)

-- | Create a bitmap from a packed `ByteString`. If the data
-- is the wrong size, returns `Nothing`.
fromBytes :: ByteString -> Maybe TIBitmap
fromBytes :: ByteString -> Maybe TIBitmap
fromBytes ByteString
bytes = if ByteString -> Int
BS.length ByteString
bytes Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1008
    then TIBitmap -> Maybe TIBitmap
forall a. a -> Maybe a
Just (ByteString -> TIBitmap
TIBitmap ByteString
bytes)
    else Maybe TIBitmap
forall a. Maybe a
Nothing

-- | Extract the raw `ByteString` from a bitmap.
toBytes :: TIBitmap -> ByteString
toBytes :: TIBitmap -> ByteString
toBytes (TIBitmap ByteString
bytes) = ByteString
bytes

-- Expands an 8-bit word into an 8-element ByteString
explodeWord :: Word8 -> ByteString
explodeWord :: Word8 -> ByteString
explodeWord Word8
w =
    let (ByteString
bits,Maybe Word8
_) = Int
-> (Word8 -> Maybe (Word8, Word8))
-> Word8
-> (ByteString, Maybe Word8)
forall a.
Int -> (a -> Maybe (Word8, a)) -> a -> (ByteString, Maybe a)
BS.unfoldrN Int
8 (\Word8
x -> (Word8, Word8) -> Maybe (Word8, Word8)
forall a. a -> Maybe a
Just (Word8
x Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
1, Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
shiftR Word8
x Int
1)) Word8
w
    in ByteString -> ByteString
BS.reverse ByteString
bits

-- Very approximate calculator-like colors
screenColorMap :: Word8 -> Pixel8
screenColorMap :: Word8 -> Word8
screenColorMap Word8
0x0 = Word8
0xc6
screenColorMap Word8
_ = Word8
0x39

-- Convert a `ByteString`, where each bit represents a pixel into
-- a vector of pixels suitable for use in a `DynamicImage`.
-- Bits are mapped to pixels using a vaguely calculator-like
-- color map (light gray background, dark gray foreground).
bytesToPixels :: ByteString -> Vector Pixel8
bytesToPixels :: ByteString -> Vector Word8
bytesToPixels =  [Word8] -> Vector Word8
forall a. Storable a => [a] -> Vector a
fromList ([Word8] -> Vector Word8)
-> (ByteString -> [Word8]) -> ByteString -> Vector Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word8 -> Word8) -> [Word8] -> [Word8]
forall a b. (a -> b) -> [a] -> [b]
map Word8 -> Word8
screenColorMap ([Word8] -> [Word8])
-> (ByteString -> [Word8]) -> ByteString -> [Word8]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [Word8]
BS.unpack (ByteString -> [Word8])
-> (ByteString -> ByteString) -> ByteString -> [Word8]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word8 -> ByteString) -> ByteString -> ByteString
BS.concatMap Word8 -> ByteString
explodeWord

-- Create an image out of a packed `ByteString`.
-- See `bytesToPixels`
bytesToImage :: ByteString -> Int -> Int -> DynamicImage
bytesToImage :: ByteString -> Int -> Int -> DynamicImage
bytesToImage ByteString
bytes Int
width Int
height =
    let pixels :: Vector Word8
pixels = ByteString -> Vector Word8
bytesToPixels ByteString
bytes
    in Image Word8 -> DynamicImage
ImageY8 (Int -> Int -> Vector (PixelBaseComponent Word8) -> Image Word8
forall a. Int -> Int -> Vector (PixelBaseComponent a) -> Image a
Image Int
width Int
height Vector Word8
Vector (PixelBaseComponent Word8)
pixels)

-- | Create a text-based representation of a picture.
-- Background pixels are rendered as spaces, while
-- foreground are rendered as full block glyphs (█).
showAsciiArt :: TIBitmap -> Text
showAsciiArt :: TIBitmap -> Text
showAsciiArt (TIBitmap ByteString
bytes) =
    let bits :: ByteString
bits = (Word8 -> ByteString) -> ByteString -> ByteString
BS.concatMap Word8 -> ByteString
explodeWord ByteString
bytes
        --hexChars = pack $ BS.foldr' showHex "" bits
        --imgChars = chunk _bmCols hexChars []
        glyphs :: Text
glyphs = ByteString -> Text
tiDecode (ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$ (Word8 -> Word8) -> ByteString -> ByteString
BS.map Word8 -> Word8
toGlyph ByteString
bits
        imgChars :: [Text]
imgChars = Int -> Text -> [Text] -> [Text]
chunk Int
_bmCols Text
glyphs []
    in Text -> [Text] -> Text
intercalate Text
"\n" [Text]
imgChars
  where
    toGlyph :: Word8 -> Word8
    toGlyph :: Word8 -> Word8
toGlyph Word8
0x0 = Word8
0x20
    toGlyph Word8
_ = Word8
0xdf

    chunk :: Int -> Text -> [Text] -> [Text]
    chunk :: Int -> Text -> [Text] -> [Text]
chunk Int
n Text
"" [Text]
chunks = [Text]
chunks
    chunk Int
n Text
xs [Text]
chunks = Int -> Text -> Text
take Int
n Text
xs Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: Int -> Text -> [Text] -> [Text]
chunk Int
n (Int -> Text -> Text
drop Int
n Text
xs) [Text]
chunks

-- | Save a bitmap as a PNG image.
-- Bits are mapped to pixels using a vaguely calculator-like
-- color map (light gray background, dark gray foreground).
writePicPng :: FilePath -> TIBitmap -> IO ()
writePicPng :: String -> TIBitmap -> IO ()
writePicPng String
path (TIBitmap ByteString
bitmap) =
    let img :: DynamicImage
img = ByteString -> Int -> Int -> DynamicImage
bytesToImage ByteString
bitmap Int
_bmCols Int
_bmRows
    in String -> DynamicImage -> IO ()
savePngImage String
path DynamicImage
img