urbit/shrub
1
1
Fork 0
mirror of https://github.com/urbit/shrub.git synced 2024-11-24 04:58:08 +03:00
Code Issues Packages Projects Releases Wiki Activity

kh: use Word8 for Tint true color values

Browse Source 
Also does some minor style cleanup.
This commit is contained in:
fang 2020-12-03 01:45:46 +01:00
parent 8758ae9f7a
commit f099ec9505
No known key found for this signature in database
GPG Key ID: EB035760C1BBA972
2 changed files with 9 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
pkg/hs/urbit-king/lib/Urbit/Arvo/Effect.hs
View File

@ -13,6 +13,7 @@ import Urbit.Noun.Time
import Urbit.Prelude
import Control.Monad.Fail (fail)
import Numeric.Natural (Natural)
import Urbit.Arvo.Common (KingId(..), ServId(..))
import Urbit.Arvo.Common (Header, HttpEvent, HttpServerConf, Method, Mime)
import Urbit.Arvo.Common (AmesDest, Turf)
@ -144,7 +145,7 @@ data Tint
| TintK
| TintW
| TintNull
| TintTrue Atom Atom Atom
| TintTrue Word8 Word8 Word8
deriving (Eq, Ord, Show)
data Stye = Stye
@ -184,13 +185,15 @@ instance ToNoun Tint where
TintK -> toNoun $ Cord "k"
TintW -> toNoun $ Cord "w"
TintNull -> Atom 0
TintTrue r g b -> Cell (Atom r) $ Cell (Atom g) (Atom b)
TintTrue r g b -> Cell (atom r) $ Cell (atom g) (atom b)
where atom a = Atom (fromIntegral a :: Natural)
instance FromNoun Tint where
parseNoun = named "Tint" . \case
Atom 0 -> pure TintNull
Cell (Atom r) (Cell (Atom g) (Atom b))
-> pure (TintTrue r g b)
-> pure (TintTrue (word r) (word g) (word b))
where word w = fromIntegral w :: Word8
n -> parseNoun @Cord n <&> unCord >>= \case
"r" -> pure TintR
"g" -> pure TintG

7
pkg/hs/urbit-king/lib/Urbit/Vere/Term.hs
View File

@ -403,8 +403,7 @@ localClient doneSignal = fst <$> mkRAcquire start stop
TintW -> ['7']
TintNull -> ['9']
TintTrue r g b ->
mconcat ["8;2;", bite r, ";", bite g, ";", bite b]
where bite = show . flip mod 256
mconcat ["8;2;", show r, ";", show g, ";", show b]
-- Wraps the appropriate escape sequence around a piece of styled text
termRenderStubSegment :: Stye -> [Char] -> [Char]
@ -420,10 +419,10 @@ localClient doneSignal = fst <$> mkRAcquire start stop
[ intersperse ';' $ fmap termRenderDeco $ toList decoset
, case back of
TintNull -> []
tint -> cons '4' $ termRenderTint tint
tint -> '4' : termRenderTint tint
, case fore of
TintNull -> []
tint -> cons '3' $ termRenderTint tint
tint -> '3' : termRenderTint tint
]
styled = mconcat [escape, styles, "m", tape, escape, "0m"]