{-# OPTIONS_HADDOCK hide #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
module Imj.Graphics.Text.ColorString.Interpolation
(
interpolateChars
, insertionColor
) where
import Imj.Prelude
import Data.List(length, splitAt)
import Imj.Graphics.Class.DiscreteInterpolation
import Imj.Graphics.Color.Types
import Imj.Util
interpolateChars :: [(Char, LayeredColor)]
->[(Char, LayeredColor)]
-> Int
-> ([(Char, LayeredColor)], Int)
interpolateChars s1 s2 i =
let n1 = length s1
n2 = length s2
toString = map fst
str1 = toString s1
str2 = toString s2
lPref = length $ commonPrefix str1 str2
lSuff = length $ commonSuffix (drop lPref str1) (drop lPref str2)
(commonPref, s1AfterCommonPref) = splitAt lPref s1
commonSuff = drop (n1 - (lSuff + lPref)) s1AfterCommonPref
totalCD = min n1 n2 - (lPref + lSuff)
nCDReplaced = clamp i 0 totalCD
s2AfterCommonPref = drop lPref s2
cdReplaced =
zipWith
(\(_, color1) (char2, _) -> (char2, color1))
(take nCDReplaced s1AfterCommonPref)
(take nCDReplaced s2AfterCommonPref)
nCDUnchanged = totalCD - nCDReplaced
cdUnchanged = take nCDUnchanged $ drop nCDReplaced s1AfterCommonPref
signedTotalExDiff = n2 - n1
signedNExDiff = signum signedTotalExDiff * clamp (i - totalCD) 0 (abs signedTotalExDiff)
(nExDiff1,nExDiff2) =
if signedTotalExDiff >= 0
then
(0, signedNExDiff)
else
(abs $ signedTotalExDiff - signedNExDiff, 0)
ed1 = take nExDiff1 $ drop totalCD s1AfterCommonPref
ed2 = zipWith
(\idx (char, color) -> (char, fromMaybe color $ insertionColor insertionBounds idx nExDiff2))
[0..]
$ take nExDiff2 $ drop totalCD s2AfterCommonPref
insertionBounds :: [LayeredColor]
insertionBounds = catMaybes
[ if null pre
then
Nothing
else
Just $ snd $ last pre
, if null commonSuff
then
Nothing
else
Just $ snd $ head commonSuff ]
remaining = (totalCD + abs signedTotalExDiff) - i
pre = commonPref ++ cdReplaced ++ cdUnchanged
in ( pre ++ ed1 ++ ed2 ++ commonSuff
, assert (remaining == max n1 n2 - (lPref + lSuff) - i) remaining)
insertionColor :: [LayeredColor] -> Int -> Int -> Maybe LayeredColor
insertionColor insertionBounds n total =
case insertionBounds of
[] -> Nothing
[color] -> Just color
[colorFrom, colorTo] ->
let dist = distance colorFrom colorTo
frame = round (fromIntegral ((n+1) * pred dist) / fromIntegral (total+1) :: Float)
in Just $ interpolate colorFrom colorTo frame
_ -> error "insertionBounds has at more than 2 elements"