packages feed

spade-0.1.0.9: src/UI/Widgets/LogWidget.hs

module UI.Widgets.LogWidget where

import Data.Text as T
import Common
import UI.Widgets.Common as C
import UI.Widgets.Editor

data LogWidget = LogWidget
  { lwDim     :: Dimensions
  , lwContent :: [Text]
  , lwPos     :: ScreenPos
  , lwVisible :: Bool
  , lwContentWidget :: WRef EditorWidget
  }

insertLog :: WidgetC m => WRef LogWidget -> Text -> m ()
insertLog ref l = do
  timestr <- liftIO getLocalTimeString
  modifyWRef ref (\lw -> lw { lwContent = Prelude.take 20 $ (timestr <> "| " <> l) : lwContent lw  })

instance Moveable LogWidget where
  getPos ref = lwPos <$> readWRef ref
  move ref sp =
    modifyWRef ref (\ww -> ww { lwPos = sp })
  getDim ref =
    lwDim <$> readWRef ref
  resize ref cb =
    modifyWRef ref (\ww -> ww { lwDim = cb $ lwDim ww })

instance Widget LogWidget where
  hasCapability (MoveableCap _)  = Just Dict
  hasCapability (DrawableCap _)  = Just Dict
  hasCapability _            = Nothing

instance Drawable LogWidget where
  setVisibility ref v = modifyWRef ref (\b -> b { lwVisible = v })
  getVisibility ref = lwVisible <$> readWRef ref
  draw ref = do
    w <- readWRef ref
    case lwVisible w of
      False -> pure ()
      True -> do
        move (lwContentWidget w) (lwPos w)
        resize (lwContentWidget w) (\_ -> (lwDim w))
        setContent (lwContentWidget w) (T.intercalate "\n" (Prelude.reverse $ lwContent w))
        scrollToBottom (lwContentWidget w)
        draw (lwContentWidget w)

logWidget
  :: forall m. WidgetC m => m (WRef LogWidget)
logWidget = do
  ew <- editor (\_ -> pure []) Nothing
  modifyWRef ew (\ew' -> ew' { ewParams = (ewParams ew') { epBorder = False, epGutterSize = 0, epLinenumberRightPad = 0, epLineNos = False }})
  newWRef $
    LogWidget
    { lwDim = Dimensions 10 10
    , lwContent = []
    , lwPos = ScreenPos 0 0
    , lwVisible = True
    , lwContentWidget = ew
    }