carettah 0.3.0 → 0.4.0
raw patch · 4 files changed
+26/−17 lines, 4 filesdep +textdep ~gtk
Dependencies added: text
Dependency ranges changed: gtk
Files
- Carettah.hs +2/−1
- Config.hs +5/−5
- Render.hs +16/−7
- carettah.cabal +3/−4
Carettah.hs view
@@ -11,6 +11,7 @@ import System.Directory (copyFile) import Control.Monad import Control.Monad.Reader+import qualified Data.Text as T import qualified Graphics.UI.Gtk as G import qualified Graphics.Rendering.Cairo as C import qualified Text.Pandoc as P@@ -156,7 +157,7 @@ void $ window `G.on` G.keyPressEvent $ G.tryEvent $ do keyName <- G.eventKeyName liftIO $- case keyName of+ case T.unpack keyName of "f" -> G.windowFullscreen window "F" -> G.windowUnfullscreen window "q" -> G.widgetDestroy window
Config.hs view
@@ -144,15 +144,15 @@ canvasH = 480, alphaBackG = 0.3, textTitleCoverY = 170,- textTitleCoverSize = 30,+ textTitleCoverSize = 28, textContextCoverY = 300,- textContextCoverSize = 28,+ textContextCoverSize = 26, textTitleY = 35,- textTitleSize = 30,+ textTitleSize = 26, textContextX = 40, textContextY = 90,- textContextSize = 22,- textCodeBlockSize = 12,+ textContextSize = 20,+ textCodeBlockSize = 11, textCodeBlockOfs = 10, turtleSize = 40, waveSize = 20,
Render.hs view
@@ -20,10 +20,15 @@ type CXy = (CPosition, CPosition) type CWl = (CSize, CSize) +fontNameP, fontNameM :: String+fontNameP = "Noto Sans CJK JP"+fontNameM = "Noto Sans Mono CJK JP"+ toDouble :: Integral a => a -> Double toDouble = fromIntegral -type LayoutFunc = G.PangoLayout -> G.Markup -> IO ()+-- type LayoutFunc = G.PangoLayout -> G.Markup -> IO ()+type LayoutFunc = G.PangoLayout -> String -> IO () type LayoutFuncGlowing = String -> CXy -> Double -> String -> IO (G.PangoLayout, G.PangoLayout, Double, Double) stringToLayout :: String -> LayoutFunc -> CXy -> Double -> String -> IO (G.PangoLayout, Double, Double)@@ -75,25 +80,29 @@ renderLayoutM :: CXy -> Double -> String -> C.Render Double renderLayoutM = - renderLayout' "IPA P明朝" (stringToLayoutGlowing fb ff)+ renderLayout' fontNameP (stringToLayoutGlowing fb ff) where- fb l t = void $ G.layoutSetMarkup l ("<span foreground=\"white\">" ++ G.escapeMarkup t ++ "</span>")+ fb l t = do _ <- G.layoutSetMarkup l ("<span foreground=\"white\">" ++ G.escapeMarkup t ++ "</span>") :: IO String+ return () ff = G.layoutSetText renderLayoutG' :: LayoutFuncGlowing -> CXy -> Double -> String -> C.Render Double-renderLayoutG' = renderLayout' "IPAゴシック"+renderLayoutG' = renderLayout' fontNameM renderLayoutG :: Attr -> CXy -> Double -> String -> C.Render Double renderLayoutG (_, [], _) = renderLayoutG' (stringToLayoutGlowing fb ff) where- fb l t = void $ G.layoutSetMarkup l ("<span foreground=\"white\">" ++ G.escapeMarkup t ++ "</span>")+ fb l t = do _ <- G.layoutSetMarkup l ("<span foreground=\"white\">" ++ G.escapeMarkup t ++ "</span>") :: IO String+ return () ff = G.layoutSetText renderLayoutG (_, classs, _) = renderLayoutG' (stringToLayoutGlowing fb ff) where- fb l t = void $ G.layoutSetMarkup l (formatPangoMarkupWhite (head classs) t)- ff l t = void $ G.layoutSetMarkup l (formatPangoMarkup (head classs) t)+ fb l t = do _ <- G.layoutSetMarkup l (formatPangoMarkupWhite (head classs) t) :: IO String+ return ()+ ff l t = do _ <- G.layoutSetMarkup l (formatPangoMarkup (head classs) t) :: IO String+ return () renderSurface :: Double -> Double -> Double -> C.Surface -> C.Render () renderSurface x y alpha surface = do
carettah.cabal view
@@ -1,5 +1,5 @@ Name: carettah-Version: 0.3.0+Version: 0.4.0 Author: Kiwamu Okabe <kiwamu@debian.or.jp> Maintainer: Kiwamu Okabe <kiwamu@debian.or.jp> License: GPL-2@@ -19,19 +19,19 @@ hs-source-dirs: . main-is: Carettah.hs build-depends: base >= 4 && < 5,+ text, filepath, time, mtl, directory, pandoc,- gtk,+ gtk >= 0.13, cairo, pango, hcwiid, highlighting-kate other-modules: Paths_carettah Config Render WrapPaths FormatPangoMarkup ghc-options: -Wall -rtsopts- ghc-prof-options: -auto-all -caf-all Executable carettah hs-source-dirs: .@@ -41,7 +41,6 @@ process other-modules: Paths_carettah ghc-options: -Wall- ghc-prof-options: -auto-all -caf-all Source-Repository head Type: git