InterpolatedColorString.hs

{-# LANGUAGE OverloadedStrings #-}

module Test.Imj.InterpolatedColorString(testICS) where

import           Control.Monad.IO.Class(MonadIO)
import           Control.Monad.Reader.Class(MonadReader)
import           Control.Monad(void)

import           Data.Monoid((<>))

import           Imj.Geo.Discrete
import           Imj.Graphics.Color
import           Imj.Graphics.Interpolation
import           Imj.Graphics.Render
import           Imj.Graphics.Text.ColorString

testICS :: (Draw e, MonadReader e m, MonadIO m)
        => m ()
testICS = do

  let from = colored "hello" (rgb 5 0 0) <> colored " world" (rgb 0 5 0) <> colored " :)" (rgb 3 5 1)
      to   = colored "hello" (rgb 5 5 5) <> colored " world" (rgb 1 2 5) <> colored " :)" (rgb 5 1 4)
      e@(Evolution _ (Frame lastFrame) _ _) = mkEvolutionEaseQuart (Successive [from, to]) 1
      from' = colored "travel" (rgb 5 0 0)
      to'   = colored "trail" (rgb 5 5 5)
      e'@(Evolution _ (Frame lastFrame') _ _) = mkEvolutionEaseQuart (Successive [from', to']) 1
      pFrom   = colored "[.]" (rgb 5 5 5)
      pTo   = colored "[......]" (rgb 5 5 5)
      e''@(Evolution _ (Frame lastFrame'') _ _) = mkEvolutionEaseQuart (Successive [pFrom, pTo]) 1
      p1   = colored "[.]" (rgb 5 5 5)
      p2   = colored "[.]" (rgb 5 0 0)
      e'''@(Evolution _ (Frame lastFrame''') _ _) = mkEvolutionEaseQuart (Successive [p1,p2,p1]) 1

  mapM_
    (\i@(Frame c') -> do
      let cs = getValueAt e i
          c = Coord c'
      drawColorString' cs (Coords (c + 10) 3) zeroCoords
    ) $ map Frame [0..lastFrame]

  mapM_
    (\i@(Frame c') -> do
      let cs = getValueAt e' i
          c = Coord c'
      drawColorString' cs (Coords (c + 10) 25) zeroCoords
    ) $ map Frame [0..lastFrame']

  mapM_
    (\i@(Frame c') -> do
      let cs = getValueAt e'' i
          c = Coord c'
      drawColorString' cs (Coords (c + 20) 25) zeroCoords
    ) $ map Frame [0..lastFrame'']

  mapM_
    (\i@(Frame c') -> do
      let cs@(ColorString l) = getValueAt e''' i
          (_,color) = head l
          c = Coord c'
      drawColorString' cs (Coords (c + 30) 25) zeroCoords
      drawStr''' (show color) (Coords (c + 30) 35) zeroCoords
    ) $ map Frame [0..lastFrame''']

drawColorString' :: (Draw e, MonadReader e m, MonadIO m)
             => ColorString
             -> Coords Pos
             -> Coords Pos
             -> m ()
drawColorString' cs pos rs =
  void (drawColorStr cs (translate pos rs))

drawStr''' :: (Draw e, MonadReader e m, MonadIO m)
         => String
         -> Coords Pos
         -> Coords Pos
         -> m (Coords Pos)
drawStr''' cs pos rs =
  drawStr'' cs (translate pos rs) (LayeredColor black white)


drawStr'' :: (Draw e, MonadReader e m, MonadIO m)
          => String
          -> Coords Pos
          -> LayeredColor
          -> m (Coords Pos)
drawStr'' str pos color =
  drawStr str pos color >> return (translateInDir Down pos)