{-# OPTIONS_HADDOCK hide #-}
{-# LANGUAGE OverloadedStrings #-}
module Imj.Example.SequentialTextTranslationsAnchored
( exampleOfsequentialTextTranslationsAnchored
, module Imj.Graphics.Text.Animation
) where
import Data.Monoid((<>))
import Data.Text(pack)
import Control.Concurrent(threadDelay)
import Control.Monad.IO.Class(MonadIO, liftIO)
import Control.Monad.Reader.Class(MonadReader)
import Imj.Geo.Discrete
import Imj.Graphics.Class.Render
import Imj.Graphics.Color
import Imj.Graphics.Render.FromMonadReader
import Imj.Graphics.Text.Alignment
import Imj.Graphics.Text.Animation
import Imj.Graphics.Text.ColorString
import Imj.Graphics.UI.RectContainer
exampleOfsequentialTextTranslationsAnchored :: (Render e, MonadReader e m, MonadIO m)
=> m ()
exampleOfsequentialTextTranslationsAnchored = do
let (Examples es') = allExamples
es = accumHeights es' 0
animate es
accumHeights :: [Example] -> Length Height -> [Example]
accumHeights [] _ = []
accumHeights ((Example a h _ b c):es) acc =
(Example a h acc b c):accumHeights es (acc + h)
width :: Length Width
width = 30
upperLeft :: Coords Pos
upperLeft = Coords 4 50
data Examples = Examples [Example]
data Example = Example {
_exampleInputData :: ![([ColorString], Coords Pos, Coords Pos)]
, _exampleSelfHeight :: !(Length Height)
, _exampleStartHeight :: !(Length Height)
, _exampleName :: !String
, _exampleComment :: !String
}
runExampleCharAnchored :: (Render e, MonadReader e m, MonadIO m)
=> [([ColorString], Coords Pos, Coords Pos)]
-> Coords Pos
-> (Frame, (Frame -> m ()))
runExampleCharAnchored input ref =
let anim@(TextAnimation _ _ (EaseClock (Evolution _ lastFrame _ _))) =
mkSequentialTextTranslationsCharAnchored (translateInput ref input) 1
in (lastFrame, (renderAnimatedTextCharAnchored anim))
runExampleStringAnchored :: (Render e, MonadReader e m, MonadIO m)
=> [([ColorString], Coords Pos, Coords Pos)]
-> Coords Pos
-> (Frame, (Frame -> m ()))
runExampleStringAnchored input ref =
let anim@(TextAnimation _ _ (EaseClock (Evolution _ lastFrame _ _))) =
mkSequentialTextTranslationsStringAnchored (translateInput ref input) 1
in (lastFrame, (renderAnimatedTextStringAnchored anim))
translateInput :: Coords Pos
-> [([ColorString], Coords Pos, Coords Pos)]
-> [([ColorString], Coords Pos, Coords Pos)]
translateInput tr input =
map (\(l, c1, c2) -> (l, translate tr c1, translate tr c2)) input
allExamples :: Examples
allExamples =
Examples
[ Example exampleDownTranslationDuo 7 0
"DownTranslationDuo"
"Char and String anchors give different results because there is a move"
, Example exampleDownTranslationMono 7 0
"DownTranslationMono"
"Char and String anchors give different results because there is a move"
, Example exampleIntermediateCharAdditions 6 0
"IntermediateCharAdditions"
"When the chars are inserted in the middle, their color is a gradual interpolation between neighbour colors."
, Example exampleIntermediateCharRemovals 6 0
"IntermediateCharRemovals"
""
, Example exampleExtremeCharAdditions 6 0
"ExtremeCharAdditions"
"When the chars are inserted at an extremity, they match the neighbour color."
, Example exampleExtremeCharRemovals 6 0
"ExtremeCharRemovals"
""
]
exampleDownTranslationDuo :: [([ColorString], Coords Pos, Coords Pos)]
exampleDownTranslationDuo =
let a = colored "ABC" green <> colored "DEF" (rgb 2 2 2)
b = colored "ABC" white <> colored "DEF" yellow
txt1 = [a, b]
from1 = Coords 0 0
to1 = Coords 1 0
from2 = Coords 0 10
to2 = Coords 1 10
in [(txt1, from1, to1)
, (txt1, from2, to2)]
exampleDownTranslationMono :: [([ColorString], Coords Pos, Coords Pos)]
exampleDownTranslationMono =
let a = colored "ABC" green <> colored "DEF" (rgb 2 2 2)
b = colored "ABC" white <> colored "DEF" yellow
txt1 = [a, b]
from1 = Coords 0 0
to1 = Coords 1 0
in [(txt1, from1, to1)]
exampleIntermediateCharAdditions :: [([ColorString], Coords Pos, Coords Pos)]
exampleIntermediateCharAdditions =
let a = colored "A" green <> colored "O" white
b = colored "ABCDEFGHIJKLMNO" white
txt1 = [a, b]
from1 = Coords 0 0
to1 = Coords 0 0
in [(txt1, from1, to1)]
exampleIntermediateCharRemovals :: [([ColorString], Coords Pos, Coords Pos)]
exampleIntermediateCharRemovals =
let a = colored "ABCDEFGHIJKLMNO" white
b = colored "A" green <> colored "O" white
txt1 = [a, b]
from1 = Coords 0 0
to1 = Coords 0 0
in [(txt1, from1, to1)]
exampleExtremeCharAdditions :: [([ColorString], Coords Pos, Coords Pos)]
exampleExtremeCharAdditions =
let a = colored "ABC" green
b = colored "ABC" green <> colored "DEF" white
txt1 = [a, b]
from1 = Coords 0 0
to1 = Coords 0 0
in [(txt1, from1, to1)]
exampleExtremeCharRemovals :: [([ColorString], Coords Pos, Coords Pos)]
exampleExtremeCharRemovals =
let a = colored "ABC" green <> colored "DEF" white
b = colored "ABC" green
txt1 = [a, b]
from1 = Coords 0 0
to1 = Coords 0 0
in [(txt1, from1, to1)]
animate :: (Render e, MonadReader e m, MonadIO m)
=> [Example]
-> m ()
animate examples = do
let listActions = concatMap (\ex@(Example e _ startHeight _ _) ->
let (a,b) = runExampleCharAnchored e ref
(c,d) = runExampleStringAnchored e (move (fromIntegral width) RIGHT ref)
ref = getRef startHeight
in [(a,b,ex,0),(c,d,ex,1)]) examples
frames = replicate (length listActions) (Frame 0)
colTitles = ["Char anchored", "String anchored"]
animate' listActions examples frames colTitles
getRef :: Length Height -> Coords Pos
getRef startHeight =
translate upperLeft $ Coords (fromIntegral startHeight) 0
animate' :: (Render e, MonadReader e m, MonadIO m)
=> [(Frame, (Frame -> m ()), Example, Int)]
-> [Example]
-> [Frame]
-> [String]
-> m ()
animate' listActions examples frames colTitles = do
let newFrames = zipWith (\count (lastFrame, _, _, _) ->
if count >= lastFrame
then Frame 0
else succ count) frames listActions
drawActions listActions frames
drawExamples examples
drawColTitles colTitles
renderToScreen
liftIO $ threadDelay 1000000
animate' listActions examples newFrames colTitles
myDarkGray :: LayeredColor
myDarkGray = onBlack $ gray 6
myLightGray :: LayeredColor
myLightGray = onBlack $ gray 10
drawActions :: (Render e, MonadReader e m, MonadIO m)
=> [(Frame, (Frame -> m ()), Example, Int)]
-> [Frame]
-> m ()
drawActions listActions frames =
mapM_ (\(frame, (lastFrame, action, (Example _ height startHeight _ _), wIdx)) -> do
let r = RectContainer (Size (height-2) (width-3)) (translate (Coords (-2) (-2)) ref)
ref = move (wIdx * fromIntegral width) RIGHT (getRef startHeight)
drawUsingColor r myDarkGray
action frame
drawColorStr (progress frame lastFrame) (translate ref $ Coords (fromIntegral height - 4) 0)
) $ zip frames listActions
drawExamples :: (Render e, MonadReader e m, MonadIO m)
=> [Example]
-> m ()
drawExamples examples =
mapM_ (\(Example _ height startHeight leftTitle rightComment) -> do
let down = (quot (fromIntegral height) 2) + fromIntegral startHeight - 2
at = translate upperLeft (Coords down (-8))
at' = translate upperLeft (Coords down $ 2 * (fromIntegral width))
drawAlignedTxt_ (pack leftTitle) myDarkGray (mkRightAlign at)
drawStr rightComment at' myDarkGray
) examples
drawColTitles :: (Render e, MonadReader e m, MonadIO m)
=> [String]
-> m ()
drawColTitles l =
mapM_ (\(i,colTitle) -> do
let right = quot (fromIntegral width) 2 + fromIntegral (i*width) - 3
at = translate upperLeft (Coords (-3) right)
drawAlignedTxt_ (pack colTitle) myDarkGray (mkCentered at)
) $ zip [0..] l
progress :: Frame -> Frame -> ColorString
progress (Frame cur) (Frame total) =
let points = replicate cur '-' ++ replicate (total - cur) ' '
in colored' "[" myLightGray <> colored' (pack points) myDarkGray <> colored' "]" myLightGray