kh: improve term code style

Based on feedback during review.
This commit is contained in:
fang 2021-04-14 17:10:50 +02:00
parent 65602198fc
commit 98d48913bf
No known key found for this signature in database
GPG Key ID: EB035760C1BBA972
3 changed files with 23 additions and 28 deletions

View File

@ -309,12 +309,7 @@ instance FromNoun Bolt where
n -> $(deriveFromNounFunc ''Bolt) n
instance FromNoun Belt where
parseNoun = \case
A c -> pure $ Bol $ Key $ C.chr $ fromIntegral c
n -> runParser ($(deriveFromNounFunc ''Bolt) n) [] belt bolt
where
belt p m = $(deriveFromNounFunc ''Belt) n
bolt !b = pure $ Bol b
parseNoun n = Bol <$> parseNoun n <|> $(deriveFromNounFunc ''Belt) n
instance ToNoun Bolt where
toNoun = \case
@ -323,9 +318,7 @@ instance ToNoun Bolt where
instance ToNoun Belt where
toNoun = \case
Bol b -> case b of
Key c -> A $ fromIntegral $ C.ord c
b -> $(deriveToNounFunc ''Bolt) b
Bol b -> toNoun b
n -> $(deriveToNounFunc ''Belt) n
data TermEv

View File

@ -84,15 +84,15 @@ step st@St{..} = \case
EvSlog s -> st & recordSlog s
EvSpin s -> st { sSpinner = s }
EvMove p -> st { sCurPos = p }
EvEdit t -> if fst sCurPos == 0 then st { sLine = t }
else st
EvNewl -> if fst sCurPos == 0 then
st { sLine = "", sCurPos = (0, 0) }
& recordText (sLine <> "\n")
else
st { sCurPos = (((fst sCurPos) - 1), 0) }
EvBell -> st
EvDraw -> st
EvEdit t | (0, _) <- sCurPos -> st { sLine = t }
| otherwise -> st
EvNewl | (0, _) <- sCurPos ->
st { sLine = "", sCurPos = (0, 0) }
& recordText (sLine <> "\n")
| otherwise ->
st { sCurPos = (((fst sCurPos) - 1), 0) }
where
recordText :: Text -> St -> St
recordText !t st@St{..} = st {
@ -113,8 +113,10 @@ drawState :: St -> [Ev]
drawState St{..} = hist <> out <> cur <> spin
where
hist = drawHistory <$> toList sHistory
out = if null sLine then [] else [EvEdit sLine]
cur = if 0 == fst sCurPos then [] else [EvMove sCurPos]
out | null <- sLine = []
| otherwise = [EvEdit sLine]
cur | (0, _) <- sCurPos = []
| otherwise = [EvMove sCurPos]
spin = maybe [] (singleton . EvSpin . Just) sSpinner
drawHistory (HistoryText t) = EvLine t
@ -151,12 +153,12 @@ fromTermEv = \case
toTermEv :: Ev -> Term.Ev
toTermEv = \case
EvLine "" -> Term.Blank
EvLine t -> Term.Trace (Cord t)
EvSlog s -> Term.Slog s
EvSpin s -> Term.Spinr (fromCause <$> s)
EvLine "" -> Term.Blank
EvLine t -> Term.Trace (Cord t)
EvSlog s -> Term.Slog s
EvSpin s -> Term.Spinr (fromCause <$> s)
EvMove (r, c) -> Term.Blits [Arvo.Hop $ Arvo.Roc (fromIntegral r) (fromIntegral c)]
EvBell -> Term.Blits [Arvo.Bel ()]
EvDraw -> Term.Blits [Arvo.Clr ()]
EvEdit t -> Term.Blits [Arvo.Put $ unpack t]
EvNewl -> Term.Blits [Arvo.Nel ()]
EvBell -> Term.Blits [Arvo.Bel ()]
EvDraw -> Term.Blits [Arvo.Clr ()]
EvEdit t -> Term.Blits [Arvo.Put $ unpack t]
EvNewl -> Term.Blits [Arvo.Nel ()]

View File

@ -34,10 +34,10 @@ cursorMove :: MonadIO m => Int -> Int -> m ()
cursorMove r c = liftIO $ ANSI.setCursorPosition r c
cursorSave :: MonadIO m => m ()
cursorSave = liftIO $ ANSI.saveCursor
cursorSave = liftIO ANSI.saveCursor
cursorRestore :: MonadIO m => m ()
cursorRestore = liftIO $ ANSI.restoreCursor
cursorRestore = liftIO ANSI.restoreCursor
putCSI :: MonadIO m => Char -> [Int] -> m ()
putCSI c a = liftIO do