nyx-game-1.0.1.0: app/TextBox.hs

{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE MultiParamTypeClasses  #-}
{-# LANGUAGE DuplicateRecordFields  #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeSynonymInstances  #-}
{-# LANGUAGE FlexibleInstances  #-}
{-# LANGUAGE OverloadedStrings  #-}

module TextBox where

import SDL.Vect (V4(..))
import qualified SDL
import qualified SDL.Font as SDLF
import qualified Play.Engine.MySDL.MySDL as MySDL

import Data.Monoid ((<>))
import Data.Maybe
import Control.Arrow
import Control.Lens
import Control.Monad.Except
import Play.Engine hiding (renderText)
import qualified Control.Monad.State as SM
import qualified Data.Text as T
import qualified Play.Engine.ListZipper as Zip


data Loc
  = Top
  | Bottom
  | All
  deriving (Show, Eq, Ord)

data TextBox
  = TextBox
  { _avatar :: Maybe SDL.Texture
  , _font :: SDLF.Font
  , _text :: Zip.ListZipper (Int, T.Text)
  , _posY :: !Loc
  , _pos :: {-# UNPACK #-} !IPoint
  , _size :: {-# UNPACK #-} !IPoint
  , _textSpeed :: Int
  , _textTimer :: Int
  }

makeFieldsNoPrefix ''TextBox

wantedAssets :: [(String, MySDL.ResourceType FilePath)]
wantedAssets =
  [ ("unispace", MySDL.Font "unispace/unispace.ttf")
  ]

make :: Loc -> Int -> T.Text -> Maybe SDL.Texture -> Maybe SDLF.Font -> Result TextBox
make _ _ _ _ Nothing =
  throwError ["A font was not provided to TextBox."]
make py spd txt mavatar (Just fnt) =
  pure $ TextBox
    { _avatar = mavatar
    , _font = fnt
    , _text =
      uncurry
        (Zip.ListZipper [])
      . (Prelude.head &&& tail)
      . zip (cycle [0])
      . concat
      . fmap (splitLine $ isJust mavatar)
      . T.lines
      $ txt
    , _posY = py
    , _pos = Point 0 0
    , _size = Point 0 0
    , _textSpeed = spd
    , _textTimer = spd
    }

splitLine :: Bool -> T.Text -> [T.Text]
splitLine hasAvatar txt =
  groupWhile (\t1 t2 -> plus1' (T.length t1) + T.length t2 <= (if hasAvatar then 43 else 50)) ""
  . T.words
  $ txt


groupWhile :: (T.Text -> T.Text -> Bool) -> T.Text -> [T.Text] -> [T.Text]
groupWhile test t1 = \case
  t2 : rest
    | test t1 t2 ->
      groupWhile test (t1 <> (if t1 == "" then "" else " ") <> t2) rest
    | otherwise  -> t1 : groupWhile test t2 rest
  [] -> [t1]

plus1' :: Int -> Int
plus1' n
  | n == 0 = 0
  | otherwise = n + 1

update :: Input -> TextBox -> Result (Maybe TextBox)
update input tb
  | keyClicked KeyA input || keyClicked KeyStart input
  , let (l, t) = Zip.last (tb ^. text) in l == T.length t
  = pure Nothing
  | otherwise = do
    wSize <- _windowSize <$> SM.get
    let
      locY = case tb ^. posY of
        Top -> 20
        All -> 20
        Bottom -> (wSize ^. y - 220)

    pure $ pure $ tb
      & set pos (Point 20 locY)
      & set size
        (Point (wSize ^. x - 40) $
          if tb ^. posY == All
            then wSize ^. y - 40
            else 200
        )
      & over text
        (\(txt :: Zip.ListZipper (Int, T.Text)) ->
           if
             | keyClicked KeyA input
             || keyClicked KeyStart input
             || tb ^. textSpeed == 0 ->
               fmap (\(_, t) -> (T.length t, t)) txt
             | tb ^. textTimer == 0
             && fst (Zip.get txt) < T.length (snd $ Zip.get txt) ->
               Zip.overCurr (first (+1)) txt
             | tb ^. textTimer == 0 ->
               Zip.nextStop txt
             | otherwise ->
               txt
        )
      & over textTimer (\t -> if t <= 0 then tb ^. textSpeed else t - 1)


render :: SDL.Renderer -> TextBox -> IO ()
render renderer tb
  | tb ^. size == Point 0 0 =
    pure ()
  | otherwise = do
  let
    rect = toRect (tb ^. pos) (tb ^. size)

  SDL.rendererDrawColor renderer SDL.$= V4 0 0 0 150
  SDL.fillRect renderer (Just rect)
  SDL.rendererDrawColor renderer SDL.$= V4 255 0 160 200
  SDL.drawRect renderer (Just rect)

  loc <- case tb ^. avatar of
    Nothing -> pure (fmap (+20) $ tb ^. pos)
    Just av -> do
      SDL.copy
        renderer
        av
        Nothing
        (Just $ toRect
          (fmap (+20) $ tb ^. pos)
          (Point 96 96)
        )
      pure (Point (20 + tb ^. pos . x + 96 + 20) (tb ^. pos . y + 20))
  void $ traverse (renderText renderer tb loc) $ Zip.addIndex (tb ^. text)

renderText :: SDL.Renderer -> TextBox -> IPoint -> (Int, (Int, T.Text)) -> IO ()
renderText renderer tb loc (idx, (txtPart, txt)) =
  if txtPart == 0
    then pure ()
    else do
      texture <- SDL.createTextureFromSurface renderer
        =<< SDLF.solid
          (tb ^. font)
          (V4 255 255 255 255)
          (T.take txtPart txt)
      ti <- SDL.queryTexture texture
      SDL.copy
        renderer
        texture
        Nothing
        (Just $ toRect
          (over y ((+) (idx * 35)) loc)
          (Point (fromIntegral $ SDL.textureWidth ti) (fromIntegral $ SDL.textureHeight ti))
        )
      SDL.destroyTexture texture