diff options
| author | Tom Smeding <tom@tomsmeding.com> | 2026-04-09 22:14:55 +0200 |
|---|---|---|
| committer | Tom Smeding <tom@tomsmeding.com> | 2026-04-09 22:14:55 +0200 |
| commit | b5c5b51792adc4a487554190e730f928574f889b (patch) | |
| tree | d3e060a64463996c7b79953d84e7d276911f10a4 /src/Main.hs | |
| parent | 0710fa9b2cac6a3f3d18de6b303c69b2af606fd5 (diff) | |
Nick colors (only sensible in dark mode so far)nickcolor
Diffstat (limited to 'src/Main.hs')
| -rw-r--r-- | src/Main.hs | 28 |
1 files changed, 27 insertions, 1 deletions
diff --git a/src/Main.hs b/src/Main.hs index cc4ad7e..d315492 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -6,11 +6,12 @@ module Main (main) where import Control.Exception (mask_) import Control.Monad (when, forM, guard) +import Data.Bits (xor, shiftR, (.&.)) import Data.ByteString (ByteString) import Data.ByteString qualified as BS import Data.ByteString.Char8 qualified as BS8 import Data.ByteString.Lazy qualified as BSL -import Data.Char (isDigit, ord) +import Data.Char (isDigit, chr, ord) import Data.Function (on, (&)) import Data.IORef import Data.List.NonEmpty (NonEmpty((:|)), groupBy) @@ -21,6 +22,9 @@ import Data.Text qualified as T import Data.Text.Encoding qualified as TE import Data.Text.IO.Utf8 qualified as T import Data.Time (Day, toGregorian, fromGregorianValid) +import Data.Word +import Graphics.Color.Space +import Graphics.Color.Space.OKLAB.LCH import Network.Wai import Network.HTTP.Types import Network.Wai.Handler.Warp (runSettings, defaultSettings, setFork, setPort) @@ -120,6 +124,7 @@ pageLog conf pages index req alias = ,"nickwrap1" ~> nickw1 ,"nick" ~> nick ,"nickwrap2" ~> nickw2 + ,"nickcolor" ~> nickColor nick ,"message" ~> msg] | ((time, eid, ev), dayidx) <- zip events [0..] , let (classlist, (nickw1, nick, nickw2), msg) = renderEvent ev]] @@ -163,6 +168,7 @@ pageCalendarDay conf pages index req alias datestr = ,"nickwrap1" ~> nickw1 ,"nick" ~> nick ,"nickwrap2" ~> nickw2 + ,"nickcolor" ~> nickColor nick ,"message" ~> msg] | ((time, eid, ev), dayidx) <- zip events [0..] , let (classlist, (nickw1, nick, nickw2), msg) = renderEvent ev]] @@ -207,6 +213,26 @@ renderEvent = \case ParseError -> (j "ev-parseerror", (no, "", no), "<parse error>") where no = Nothing; j = Just +-- | Returns a CSS color string, including the @#@ +nickColor :: Text -> Text +nickColor nick = + let -- mix (just some random odd constants) + n1 = T.foldl' (\n c -> 0x678731a3 * (fromIntegral (ord c) `xor` n) + 0xbc3c0a93) 0xbb115003 nick :: Word32 + -- scramble (two steps from splitmix32) + n2 = let z1 = (n1 `xor` (n1 `shiftR` 16)) * 0x85ebca6b + in (z1 `xor` (z1 `shiftR` 13)) * 0xc2b2ae35 + in T.pack $ "hsl(" ++ show (floor @Double @Int (fromIntegral n2 / 2**32 * 360)) ++ " 60% 70%)" + -- -- construct the OKLCH color + -- clr1 = ColorOKLCH @Double 0.8256 0.0859 (fromIntegral n2 / 2**32 * 360) + -- -- convert to sRGB + -- ColorRGB r g b = convertColor @(SRGB NonLinear) clr1 + -- -- render as css color + -- toHex val = let byte = floor (max 0 (min 1 val) * 255.99) + -- toHexDig v | v < 10 = chr (ord '0' + v) + -- | otherwise = chr (ord 'a' + v - 10) + -- in [toHexDig (byte `shiftR` 4), toHexDig (byte .&. 15)] + -- in T.pack $ '#' : toHex r ++ toHex g ++ toHex b + pageCalendar :: Config -> Pages -> Index -> Text -> IO Response pageCalendar conf pages index alias = case econfAlias2Chan conf Map.!? alias of |