fontifier with test-fontification, gui changed a bit
This commit is contained in:
Armin Friedl
parent
ee901c6cc0
commit
f3f19592fc
2 changed files with 56 additions and 27 deletions
|
|
@ -1,6 +1,4 @@
|
|||
{-# LANGUAGE TemplateHaskell #-} -- needed for lenses
|
||||
|
||||
module Fontifier (fontMap, fontify) where
|
||||
module Fontifier (fontMap, fontify, Fontification(..)) where
|
||||
|
||||
{---- Imports ----}
|
||||
|
||||
|
|
@ -10,17 +8,14 @@ import Brick.Util (bg, fg)
|
|||
import qualified Graphics.Vty as Vty
|
||||
|
||||
---- Various ----
|
||||
import Lens.Micro
|
||||
import Lens.Micro.TH (makeLenses)
|
||||
|
||||
|
||||
{---- Type Definitions ----}
|
||||
-- defines an attribute for a text slice
|
||||
data Fontification = FT { _ftStart :: Integer -- start index in string
|
||||
, _ftEnd :: Integer -- end index in string
|
||||
, _ftAttr :: String -- attribute name
|
||||
}
|
||||
makeLenses ''Fontification
|
||||
data Fontification = FT { ftStart :: Int -- start index in string
|
||||
, ftEnd :: Int -- end index in string
|
||||
, ftAttr :: AttrName -- attribute name
|
||||
} deriving (Show)
|
||||
|
||||
{---- Functions ----}
|
||||
|
||||
|
|
@ -28,6 +23,7 @@ fontMap :: [(AttrName, Vty.Attr)]
|
|||
fontMap = [ (attrName "assignment" , fg Vty.blue)
|
||||
, (attrName "return" , fg Vty.green)
|
||||
, (attrName "guard" , fg Vty.yellow)
|
||||
, (attrName "comment" , fg Vty.green)
|
||||
, (attrName "err_braces" , fg Vty.red) -- unbalanced braces
|
||||
, (attrName "err_string" , fg Vty.red) -- unterminated strings
|
||||
]
|
||||
|
|
@ -35,4 +31,13 @@ fontMap = [ (attrName "assignment" , fg Vty.blue)
|
|||
-- calls the fontification functions
|
||||
-- and returns a list of attributes for text slices
|
||||
fontify :: String -> [Fontification]
|
||||
fontify s = []
|
||||
fontify s = testFontify s 0
|
||||
|
||||
|
||||
-- fontifies every occurence of a as error
|
||||
testFontify :: String -> Int -> [Fontification]
|
||||
testFontify [] _ = []
|
||||
testFontify (s:ss) c = if s == 'a'
|
||||
then (FT c (c+1) (attrName "err_string")): testFontify ss (c+1)
|
||||
else testFontify ss (c+1)
|
||||
|
||||
|
|
|
|||
|
|
@ -1,6 +1,7 @@
|
|||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE TemplateHaskell #-}
|
||||
|
||||
module Gui (runEditor) where
|
||||
module Gui (runEditor, fontifyToMarkup) where
|
||||
|
||||
|
||||
{---- Imports ----}
|
||||
|
|
@ -17,7 +18,8 @@ import qualified Graphics.Vty as Vty
|
|||
|
||||
---- Text ----
|
||||
import Data.Text (pack, singleton, unpack)
|
||||
import Data.Text.Markup (Markup, toText, (@@))
|
||||
import Data.Text.Markup (Markup, fromText, markupSet, toText,
|
||||
(@@))
|
||||
|
||||
---- Files ----
|
||||
import System.Directory (doesFileExist)
|
||||
|
|
@ -25,13 +27,14 @@ import System.IO (IOMode (..), hClose, hGetContents,
|
|||
openFile)
|
||||
|
||||
---- Markup ----
|
||||
import qualified Fontifier as Fontifier
|
||||
import Fontifier
|
||||
|
||||
---- Various ----
|
||||
import Control.Monad.IO.Class (liftIO)
|
||||
import Data.List
|
||||
import Data.Maybe
|
||||
import Data.Monoid (mempty, (<>))
|
||||
import Data.String (fromString)
|
||||
import Data.Tuple
|
||||
import Lens.Micro ((^.))
|
||||
import Lens.Micro.TH (makeLenses)
|
||||
|
|
@ -70,36 +73,38 @@ theApp = App { appDraw = drawUI
|
|||
}
|
||||
|
||||
initialState :: FilePath -> String -> HeditState
|
||||
initialState f content = HS (EditWidget.editor Hedit drawContent Nothing content)
|
||||
initialState f content = HS (EditWidget.editor Hedit drawHeditText Nothing content)
|
||||
(f)
|
||||
|
||||
drawContent :: [String] -> Widget n
|
||||
drawContent = markup . (createMarkup []) . unlines
|
||||
|
||||
-- add functions that return [(AttrName,Attr)] lists
|
||||
-- add functions that return [(AttrName,Attr)] lists into foldl list
|
||||
-- for additional attributes
|
||||
getAttrMap :: AttrMap
|
||||
getAttrMap = foldl merge mainMap [Fontifier.fontMap]
|
||||
where merge map list = applyAttrMappings list map -- just reverses arguments of apply
|
||||
mainMap = attrMap Vty.defAttr [
|
||||
(attrName "blackOnWhite", Vty.brightBlack `on` Vty.brightWhite),
|
||||
(attrName "blackOnWhite", Vty.white `on` Vty.brightMagenta),
|
||||
(attrName "title", foldl Vty.withStyle (Vty.blue `on` Vty.brightYellow)
|
||||
[Vty.standout,Vty.bold,
|
||||
Vty.blink])
|
||||
Vty.blink]),
|
||||
(attrName "commands", Vty.white `on` Vty.magenta)
|
||||
]
|
||||
|
||||
drawUI :: HeditState -> [Widget Names]
|
||||
drawUI st = stackTopDown [title, hBorder, commands, hBorder] ++ [editWidget]
|
||||
where editWidget = padTop (Pad 4) $ EditWidget.renderEditor True (st^.hedit)
|
||||
drawUI st = stackTopDown [titleBar, title, titleBar, commands] ++ [editWidget]
|
||||
where editWidget = padTop (Pad 5) $ EditWidget.renderEditor True (st^.hedit)
|
||||
hBorder = BorderWidgets.hBorder
|
||||
commands = hBox [str "Commands: "
|
||||
, withAttr (attrName "blackOnWhite") $ str "^S"
|
||||
commands = withAttr (attrName "commands") $ padLeft Max $ hBox [ str "^S"
|
||||
, str "...Save"
|
||||
, withAttr (attrName "blackOnWhite") $ str "^C/Esc"
|
||||
, str " │ "
|
||||
, str "^C/Esc"
|
||||
, str "...Quit "
|
||||
]
|
||||
title = withAttr (attrName "title") $ CenterWidget.hCenter $
|
||||
str "HEDIT - The Not So Fancy Editor"
|
||||
titleBar = withAttr (attrName "title") $ CenterWidget.hCenter $ str " "
|
||||
stackTopDown widgets = [vBox widgets] -- doesn't work with editor (at least i don't know how)
|
||||
|
||||
appCursor :: HeditState -> [CursorLocation Names] -> Maybe (CursorLocation Names)
|
||||
|
|
@ -119,8 +124,27 @@ appEvent st ev
|
|||
forwardToWidget = handleEventLensed st hedit EditWidget.handleEditorEvent ev
|
||||
|
||||
|
||||
drawHeditText :: [String] -> Widget n
|
||||
drawHeditText lines = makeWidget $ makeMarkup $ getFontification text
|
||||
where makeWidget = markup -- just a synonym for Brick.Markup.markup
|
||||
text = unlinesWA lines -- make a single text junk from splitted lines
|
||||
getFontification = Fontifier.fontify -- just a synonym
|
||||
makeMarkup = fontifyToMarkup text -- curried fontifyToMarkup; needs an additional fontification list only
|
||||
|
||||
fontifyToMarkup :: String -> [Fontification] -> Markup AttrName
|
||||
fontifyToMarkup text fontification = fontifyToMarkup' baseMarkup fontification
|
||||
-- fromText marks the given text with the default markup
|
||||
-- fromString creates a Data.Text from a String (works because of OverloadedStrings extension)
|
||||
where baseMarkup = (fromText $ fromString text)
|
||||
|
||||
-- Workhorse of fontifyToMarkup
|
||||
-- merges all the fontification information into the given Markup and
|
||||
-- returns the merged markup
|
||||
fontifyToMarkup' :: Markup AttrName -> [Fontification] -> Markup AttrName
|
||||
fontifyToMarkup' markup [] = markup
|
||||
fontifyToMarkup' markup (f:ff) = fontifyToMarkup' (markupSet slice attribute markup) ff
|
||||
where slice = ((ftStart f),(ftEnd f)-(ftStart f)) -- slice = (startIndex, length)
|
||||
attribute = ftAttr f
|
||||
|
||||
|
||||
|
||||
|
|
|
|||
Loading…
Reference in a new issue