carettah-0.5.1/data/ 0000755 0000000 0000000 00000000000 12527323704 012414 5 ustar 00 0000000 0000000 carettah-0.5.1/Runner.hs 0000644 0000000 0000000 00000000356 12527323704 013314 0 ustar 00 0000000 0000000 import System.FilePath
import System.Environment
import System.Cmd
import Paths_carettah (getBinDir)
main :: IO ()
main = do
as <- getArgs
d <- getBinDir
_ <- rawSystem (d > "_carettah_main_") (as ++ ["+RTS", "-V0"])
return ()
carettah-0.5.1/Carettah.hs 0000644 0000000 0000000 00000021307 12726022606 013573 0 ustar 00 0000000 0000000 module Main where
import System.Environment
import System.Mem
import System.IO
import System.Console.GetOpt
import System.Exit
import Data.Time
import Data.Maybe
import Data.Version (showVersion)
import System.FilePath ((>),(<.>))
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
import System.CWiid
--
import Config
import Render
import WrapPaths
markdown :: String -> P.Pandoc
markdown s = r
where Right r = P.readMarkdown P.def{ P.readerStandalone = True } $ s
splitBlocks :: P.Pandoc -> [[P.Block]]
splitBlocks (P.Pandoc _ blocks) = go blocks
where go (P.Header 1 _ h:xs) =
let (b1, b2) = break check xs
in (P.Header 1 P.nullAttr h:b1):go b2
go _ = []
check (P.Header 1 _ _) = True
check _ = False
backgroundTop :: [P.Block] -> [P.Block]
backgroundTop blocks = filter go blocks ++ filter (not . go) blocks
where go (P.Para [P.Image _ [P.Str "background"] _]) = True
go _ = False
inlinesToString :: [P.Inline] -> String
inlinesToString = foldr go ""
where go (P.Str s) a = s ++ a
go P.Space a = ' ' : a
go x _ = show x
-- 二枚目以降のスライドをRender
blockToSlide :: [P.Block] -> [Double -> C.Render Double]
blockToSlide = map go
where
ag = alphaBackG gCfg
tty = textTitleY gCfg
tts = textTitleSize gCfg
tcx = textContextX gCfg
tcs = textContextSize gCfg
tcbs = textCodeBlockSize gCfg
tcbo = textCodeBlockOfs gCfg
go :: P.Block -> Double -> C.Render Double
go (P.Para [P.Image _ [P.Str "background"] (pngfile, _)]) =
\y -> renderPngFit ag pngfile >> return y
go (P.Para [P.Image _ [P.Str "inline"] (pngfile, _)]) =
\y -> renderPngInline (CCenter, CPosition y) (CFit, CFit)
1 pngfile
go (P.Header 1 _ strs) =
\y -> renderLayoutM (CCenter, CPosition tty) tts (inlinesToString strs) >> return y
go (P.BulletList plains) = \y -> yposSequence y $ map go' plains
where
go' [P.Plain strs] =
\ypos -> renderLayoutM (CPosition tcx, CPosition ypos) tcs ("☆ " ++ inlinesToString strs)
go' x = error $ show x -- 一部のみをサポート
go (P.CodeBlock attr ss) = \y ->
renderLayoutG attr (CPosition $ tcx + tcbo, CPosition y) tcbs ss
go (P.Para strs) =
\y -> renderLayoutM (CPosition tcx, CPosition y) tcs (inlinesToString strs)
go x = error $ show x -- 一部のみをサポート
-- スライド表紙をRender
coverSlide :: [P.Block] -> [Double -> C.Render Double]
coverSlide = map go
where
ag = alphaBackG gCfg
ttcy = textTitleCoverY gCfg
ttcs = textTitleCoverSize gCfg
tccy = textContextCoverY gCfg
tccs = textContextCoverSize gCfg
go :: P.Block -> Double -> C.Render Double
go (P.Para [P.Image _ [P.Str "background"] (pngfile, _)]) =
\y -> renderPngFit ag pngfile >> return y
go (P.Header 1 _ strs) =
\y -> renderLayoutM (CCenter, CPosition ttcy) ttcs (inlinesToString strs) >> return y
go (P.Para strs) =
\y -> renderLayoutM (CCenter, CPosition tccy) tccs (inlinesToString strs) >> return y
go x = error $ show x -- 一部のみをサポート
updateCanvas :: G.DrawingArea -> IO ()
updateCanvas canvas = do
n <- queryCarettahState page
s <- queryCarettahState slides
win <- G.widgetGetDrawWindow canvas
(width, height) <- G.widgetGetSize canvas
G.renderWithDrawable win $
renderSlide s n width height
updateRenderdTime
performGC
options :: [OptDescr (Options -> Options)]
options =
[ Option "w" ["wiimote"]
(NoArg (\ opts -> opts { optWiimote = True }))
"use wiimote"
, Option "o" ["output-filename"]
(OptArg ((\ f opts -> opts { optPdfOutput = Just f }) . fromMaybe "output.pdf")
"FILE")
"output PDF_FILE"
, Option "t" ["time"]
(OptArg ((\ f opts -> opts { optTime = Just $ read f }) . fromMaybe "5")
"TIME(minute)")
"set presentation time with minutes"
, Option "i" ["info"]
(NoArg (\ opts -> opts { optSlideInfo = True }))
"show slide infomation"
, Option "n" ["new-slide"]
(NoArg (\ opts -> opts { optNewTemp = True }))
"create a new slide file and open it"
]
carettahOpts :: [String] -> IO (Options, [String])
carettahOpts argv =
let header = "\ncarettah version " ++ showVersion wrapVersion ++ "\n" ++
"Usage: carettah [OPTION...] FILE"
in case getOpt Permute options argv of
(_,[],[] ) -> hPutStrLn stderr (usageInfo header options) >> exitSuccess
(o,n,[] ) -> return (foldl (flip id) defaultOptions o, n)
(_,_,errs) -> hPutStrLn stderr (concat errs ++ usageInfo header options) >> exitFailure
outputPDF :: String -> IO ()
outputPDF pdf = do
s <- queryCarettahState slides
let iw = canvasW gCfg
ih = canvasH gCfg
dw = toDouble iw
dh = toDouble ih
C.withPDFSurface pdf dw dh $ flip C.renderWith . sequence_ $
fmap (\a -> renderSlide s a iw ih >> C.showPage) [0..(length s - 1)]
startPresentation :: Bool -> Double -> IO ()
startPresentation wiiOn presenTime = do
-- setup
setWiiHandle wiiOn
updateSpeechMinutes $ const presenTime
-- start GUI
void G.initGUI
window <- G.windowNew
canvas <- G.drawingAreaNew
G.widgetSetSizeRequest window (canvasW gCfg) (canvasH gCfg)
-- key event
void $ window `G.on` G.keyPressEvent $ G.tryEvent $ do
keyName <- G.eventKeyName
liftIO $
case T.unpack keyName of
"f" -> G.windowFullscreen window
"F" -> G.windowUnfullscreen window
"q" -> G.widgetDestroy window
"j" -> nextPage >> G.widgetQueueDraw canvas
"k" -> prevPage >> G.widgetQueueDraw canvas
"g" -> topPage >> G.widgetQueueDraw canvas
"G" -> endPage >> G.widgetQueueDraw canvas
"r" -> do md <- queryCarettahState markdownFname
loadMarkdown md
curPage >> G.widgetQueueDraw canvas
_ -> return ()
void $ G.onDestroy window G.mainQuit
void $ G.onExpose canvas $ const (updateCanvas canvas >> return True)
void $ G.timeoutAdd (do rtime <- queryCarettahState renderdTime
ntime <- getCurrentTime
let dtime :: Double
dtime = (fromRational . toRational) $
diffUTCTime ntime rtime
if dtime > 5 then G.widgetQueueDraw canvas >>
return True else do
bf <- queryCarettahState wiiBtnFlag
af <- updateWiiBtnFlag
let bs = af `diffCwiidBtnFlag` bf
go b | b == cwiidBtnA = nextPage >> G.widgetQueueDraw canvas
| b == cwiidBtnB = prevPage >> G.widgetQueueDraw canvas
| b == cwiidBtnUp = topPage >> G.widgetQueueDraw canvas
| b == cwiidBtnDown = endPage >> G.widgetQueueDraw canvas
| b == cwiidBtnPlus = G.windowFullscreen window
| b == cwiidBtnMinus = G.windowUnfullscreen window
| otherwise = return ()
go bs
return True) 50
G.set window [G.containerChild G.:= canvas]
G.widgetShowAll window
updateStartTime
updateRenderdTime
G.mainGUI
loadMarkdown :: String -> IO ()
loadMarkdown fn = do
s <- readFile fn
let z = zip (coverSlide:repeat blockToSlide) (splitBlocks $ markdown s)
updateSlides $ const $ map (\p -> fst p . backgroundTop $ snd p) z
main :: IO ()
main = do
-- init
updateStartTime
updateRenderdTime
-- getopts
(opts, filen:_) <- carettahOpts =<< getArgs
-- create file if -n option
case opts of
(Options {optNewTemp = True}) ->
do tf <- wrapGetDataFileName $ "data" > "turtle" <.> "png"
copyFile tf ("turtle" <.> "png")
df <- wrapGetDataFileName $ "data" > "debian" <.> "png"
copyFile df ("debian" <.> "png")
writeFile filen ns
where ns = "\
\# Presentation Title\n\
\\n\n\
\Your Name\n\n\
\# Slide Title\n\
\* item1\n\
\* item2\n\
\* item3\n\n\
\\n"
_ -> return ()
-- setup slide
updateMarkdownFname $ const filen
loadMarkdown filen
-- start
case opts of
(Options {optSlideInfo = True}) ->
do s <- queryCarettahState slides
putStrLn $ "Page: " ++ show (length s)
(Options {optPdfOutput = Just pdf}) ->
outputPDF pdf
(Options {optWiimote = wiiOn, optTime = Just presenTime}) ->
startPresentation wiiOn presenTime
_ -> error "NOTREACHED"
carettah-0.5.1/Config.hs 0000644 0000000 0000000 00000012527 12634550322 013250 0 ustar 00 0000000 0000000 module Config (Config(..), Options(..), CarettahState(..),
gCfg, defaultOptions,
curPage, nextPage, prevPage, topPage, endPage,
setWiiHandle, updateWiiBtnFlag,
updateSlides, queryCarettahState,
updateStartTime, updateRenderdTime, elapsedSecFromStart,
updateSpeechMinutes, updateMarkdownFname) where
import Data.IORef
import Data.Time
import System.IO.Unsafe (unsafePerformIO)
import Control.Monad
import Control.Monad.Reader
import qualified Graphics.Rendering.Cairo as C
import System.CWiid
data Options = Options { optWiimote :: Bool
, optPdfOutput :: Maybe FilePath
, optTime :: Maybe Double
, optSlideInfo :: Bool
, optNewTemp :: Bool
} deriving Show
defaultOptions :: Options
defaultOptions = Options { optWiimote = False
, optPdfOutput = Nothing
, optTime = Just 5
, optSlideInfo = False
, optNewTemp = False
}
data WiiHandle = NoWiiHandle | WiiHandle CWiidWiimote
data CarettahState = CarettahState {
page :: Int,
slides :: [[Double -> C.Render Double]],
startTime :: UTCTime,
renderdTime :: UTCTime,
wiiHandle :: WiiHandle,
wiiBtnFlag :: CWiidBtnFlag,
speechMinutes :: Double,
markdownFname :: String
}
carettahState :: IORef CarettahState
carettahState = unsafePerformIO $ newIORef CarettahState { page = 0, slides = undefined, startTime = undefined, renderdTime = undefined, wiiHandle = NoWiiHandle, wiiBtnFlag = CWiidBtnFlag 0 , speechMinutes = 5, markdownFname = "notfound.md"}
updateCarettahState :: MonadIO m => (CarettahState -> CarettahState) -> m ()
updateCarettahState fn = liftIO $! atomicModifyIORef carettahState $ \st -> (fn st, ())
queryCarettahState :: MonadIO m => (CarettahState -> a) -> m a
queryCarettahState fn = liftM fn $ liftIO $! readIORef carettahState
updatePage :: MonadIO m => (Int -> Int) -> m ()
updatePage fn = updateCarettahState (\s -> s { page = fn $ page s })
curPage, nextPage, prevPage, topPage, endPage :: MonadIO m => m ()
curPage = do s <- queryCarettahState slides
let maxpage = length s - 1
updatePage (\p -> if p >= maxpage then maxpage else p)
nextPage = do s <- queryCarettahState slides
let maxpage = length s - 1
updatePage (\p -> if p >= maxpage then maxpage else p + 1)
prevPage = updatePage (\p -> if p == 0 then 0 else p - 1)
topPage = updatePage $ const 0
endPage = do s <- queryCarettahState slides
updatePage $ const (length s - 1)
updateSlides :: MonadIO m => ([[Double -> C.Render Double]] -> [[Double -> C.Render Double]]) -> m ()
updateSlides fn = updateCarettahState (\s -> s { slides = fn $ slides s })
updateStartTime :: IO ()
updateStartTime = do
t <- getCurrentTime
updateCarettahState (\s -> s { startTime = t })
updateRenderdTime :: IO ()
updateRenderdTime = do
t <- getCurrentTime
updateCarettahState (\s -> s { renderdTime = t })
elapsedSecFromStart :: IO Double
elapsedSecFromStart = do
n <- getCurrentTime
s <- queryCarettahState startTime
let d = diffUTCTime n s
return $ (fromRational . toRational) d
setWiiHandle :: Bool -> IO ()
setWiiHandle won
| won = do
putStrLn "Put Wiimote in discoverable mode now (press 1+2)..."
wm <- cwiidOpen
case wm of
Nothing -> putStrLn "not found..."
Just wmj -> do
putStrLn "found!"
void $ cwiidSetRptMode wmj 2
void $ cwiidSetLed wmj (combineCwiidLedFlag [cwiidLed1, cwiidLed4])
updateCarettahState (\s -> s { wiiHandle = WiiHandle wmj })
| otherwise = return ()
updateWiiBtnFlag :: IO CWiidBtnFlag
updateWiiBtnFlag = do
wh <- queryCarettahState wiiHandle
let go NoWiiHandle = return $ CWiidBtnFlag 0
go (WiiHandle wm) = do
bs <- cwiidGetBtnState wm
updateCarettahState (\s -> s { wiiBtnFlag = bs })
return bs
go wh
updateSpeechMinutes :: MonadIO m => (Double -> Double) -> m ()
updateSpeechMinutes fn =
updateCarettahState (\s -> s { speechMinutes = fn $ speechMinutes s })
updateMarkdownFname :: MonadIO m => (String -> String) -> m ()
updateMarkdownFname fn =
updateCarettahState (\s -> s { markdownFname = fn $ markdownFname s })
-- constant value
data Config = Config {
--- posX,posY,fsizeの値は640x480の画面サイズが基準
canvasW :: Int,
canvasH :: Int,
alphaBackG :: Double,
textTitleY :: Double,
textTitleSize :: Double,
textContextY :: Double,
textContextSize :: Double,
textTitleCoverY :: Double,
textTitleCoverSize :: Double,
textContextX :: Double,
textContextCoverY :: Double,
textContextCoverSize :: Double,
textCodeBlockSize :: Double,
textCodeBlockOfs :: Double,
turtleSize :: Double,
waveSize :: Double,
waveCharMax :: Double
}
gCfg :: Config
gCfg = Config {
canvasW = 640,
canvasH = 480,
alphaBackG = 0.3,
textTitleCoverY = 170,
textTitleCoverSize = 28,
textContextCoverY = 300,
textContextCoverSize = 26,
textTitleY = 35,
textTitleSize = 26,
textContextX = 40,
textContextY = 90,
textContextSize = 18,
textCodeBlockSize = 11,
textCodeBlockOfs = 10,
turtleSize = 40,
waveSize = 20,
waveCharMax = 42 -- xxxxxx 本来はwaveSizeから検出すべき手で数えんなよwwww
}
carettah-0.5.1/Render.hs 0000644 0000000 0000000 00000020070 12633552676 013267 0 ustar 00 0000000 0000000 module Render (clearCanvas, CPosition(..), CSize(..), toDouble,
renderWave, renderTurtle, renderPngFit, renderPngInline,
renderLayoutG, renderLayoutM,
yposSequence, renderSlide) where
import System.FilePath ((>),(<.>))
import Control.Monad
import Control.Monad.Reader
import Text.Pandoc (Attr)
import qualified Graphics.UI.Gtk as G
import qualified Graphics.Rendering.Cairo as C
--
import FormatPangoMarkup
import Config
import WrapPaths (wrapGetDataFileName)
data CPosition = CPosition Double | CCenter
deriving (Show, Eq, Ord)
data CSize = CSize Double | CFit
deriving (Show, Eq, Ord)
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 -> 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)
stringToLayout fname func (x, _) fsize text = do
lay <- G.cairoCreateContext Nothing >>= G.layoutEmpty
void $ func lay text
G.layoutSetWrap lay G.WrapPartialWords
setAW lay x
fd <- liftIO G.fontDescriptionNew
G.fontDescriptionSetSize fd fsize
G.fontDescriptionSetFamily fd fname
G.layoutSetFontDescription lay (Just fd)
(_, G.PangoRectangle _ _ lw lh) <- G.layoutGetExtents lay
-- xxx inkとlogicalの違いは?
return (lay, lw, lh)
where
screenW = toDouble (canvasW gCfg)
setAW lay CCenter = do
G.layoutSetWidth lay (Just screenW)
G.layoutSetAlignment lay G.AlignCenter
setAW lay (CPosition x') = do
G.layoutSetWidth lay (Just $ screenW - x' * 2)
G.layoutSetAlignment lay G.AlignLeft
truePosition :: Double -> Double -> (CPosition, CPosition) -> (Double, Double)
truePosition fsize _ (CPosition x', CPosition y') = (x', y' + fsize)
truePosition _ _ (CCenter, CPosition y') = (0, y')
truePosition _ _ (x', y') =
error $ "called with x=" ++ show x' ++ " y=" ++ show y'
stringToLayoutGlowing :: LayoutFunc -> LayoutFunc -> LayoutFuncGlowing
stringToLayoutGlowing funcBack funcFront fname xy fsize text = do
(layB, _, _) <- stringToLayout fname funcBack xy fsize text
(lay, lw, lh) <- stringToLayout fname funcFront xy fsize text
return (layB, lay, lw, lh)
renderLayout' :: String -> LayoutFuncGlowing -> CXy -> Double -> String -> C.Render Double
renderLayout' fname func (x, y) fsize text = do
C.save
(layB, lay, lw, lh) <- liftIO $ func fname (x, y) fsize text
let (xt, yt) = truePosition fsize lw (x, y)
mapM_ (moveShowLayout layB)
[(xt + xd, yt + yd) | xd <- [-0.7, 0.7], yd <- [-0.7, 0.7]]
moveShowLayout lay (xt, yt)
C.restore
return $ yt + lh
where
moveShowLayout l (x', y') = C.moveTo x' y' >> G.showLayout l
renderLayoutM :: CXy -> Double -> String -> C.Render Double
renderLayoutM =
renderLayout' fontNameP (stringToLayoutGlowing fb ff)
where
fb l t = do _ <- G.layoutSetMarkup l ("" ++ G.escapeMarkup t ++ "") :: IO String
return ()
ff = G.layoutSetText
renderLayoutG' :: LayoutFuncGlowing -> CXy -> Double -> String -> C.Render Double
renderLayoutG' = renderLayout' fontNameM
renderLayoutG :: Attr -> CXy -> Double -> String -> C.Render Double
renderLayoutG (_, [], _) =
renderLayoutG' (stringToLayoutGlowing fb ff)
where
fb l t = do _ <- G.layoutSetMarkup l ("" ++ G.escapeMarkup t ++ "") :: IO String
return ()
ff = G.layoutSetText
renderLayoutG (_, classs, _) =
renderLayoutG' (stringToLayoutGlowing fb ff)
where
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
C.save
C.setSourceSurface surface x y
C.paintWithAlpha alpha
C.restore
pngSurfaceSize :: FilePath -> C.Render (C.Surface, Int, Int)
pngSurfaceSize file = do
surface <- liftIO $ C.imageSurfaceCreateFromPNG file
w <- C.imageSurfaceGetWidth surface
h <- C.imageSurfaceGetHeight surface
ret surface w h
where
ret _ 0 0 = do
surface' <- liftIO $
wrapGetDataFileName ("data" > "notfound" <.> "png") >>=
C.imageSurfaceCreateFromPNG
w' <- C.imageSurfaceGetWidth surface'
h' <- C.imageSurfaceGetHeight surface'
return (surface', w', h')
ret s w h = return (s, w, h)
renderPngSize :: Double -> Double -> Double -> Double -> Double -> FilePath -> C.Render Double
renderPngSize = f
where f x y w h alpha file = do
C.save
(surface, iw, ih) <- pngSurfaceSize file
let xscale = w / toDouble iw
let yscale = h / toDouble ih
C.scale xscale yscale
renderSurface (x / xscale) (y / yscale) alpha surface
C.surfaceFinish surface
C.restore
return $ y + h
renderPngInline :: CXy -> CWl -> Double -> FilePath -> C.Render Double
renderPngInline = f
where f (CCenter, CPosition y) (CFit, CFit) alpha file = do
C.save
(surface, iw, ih) <- pngSurfaceSize file
let diw = toDouble iw
dih = toDouble ih
cw = toDouble (canvasW gCfg)
ch = toDouble (canvasH gCfg)
wratio = cw / diw
hratio = (ch - y) / dih
scale = if wratio > hratio then hratio * 0.95 else wratio * 0.95
tiw = diw * scale
tih = dih * scale
y' = y + 10
C.scale scale scale
renderSurface ((cw / 2 - tiw / 2) / scale) (y' / scale) alpha surface
C.surfaceFinish surface
C.restore
return $ y' + tih
f _ _ _ _ = return 0 -- xxx renerPngFit統合して一関数にすべき
renderPngFit :: Double -> FilePath -> C.Render ()
renderPngFit = f
where f alpha file = do
C.save
(surface, iw, ih) <- pngSurfaceSize file
let cw = toDouble $ canvasW gCfg
ch = toDouble $ canvasH gCfg
C.scale (cw / toDouble iw) (ch / toDouble ih)
renderSurface 0 0 alpha surface
C.surfaceFinish surface
C.restore
clearCanvas :: Int -> Int -> C.Render ()
clearCanvas w h = do
C.save
C.setSourceRGB 1 1 1
C.rectangle 0 0 (toDouble w) (toDouble h)
C.fill >> C.stroke >> C.restore
-- xxx プレゼン時間に応じて波表示
renderWave :: C.Render ()
renderWave = do
sec <- liftIO elapsedSecFromStart
smin <- queryCarettahState speechMinutes
let ws = waveSize gCfg
ch = toDouble $ canvasH gCfg
speechSec = 60 * smin
charMax = waveCharMax gCfg
numChar = round $ charMax * sec / speechSec
void $ renderLayoutM (CPosition 0, CPosition $ ch - ws * 2) ws $ replicate numChar '>'
return ()
renderTurtle :: Double -> C.Render ()
renderTurtle progress = do
fn <- liftIO . wrapGetDataFileName $ "data" > "turtle" <.> "png"
renderPngSize (ts / 2 + (cw - ts * 2) * progress) (ch - ts) ts ts 1 fn >> return ()
where ts = turtleSize gCfg
cw = toDouble $ canvasW gCfg
ch = toDouble $ canvasH gCfg
yposSequence :: Double -> [Double -> C.Render Double] -> C.Render Double
yposSequence ypos (x:xs) = x ypos >>= (`yposSequence` xs)
yposSequence ypos [] = return ypos
renderSlideFilter :: Int -> Int -> [Double -> C.Render Double] -> C.Render ()
renderSlideFilter w h s = do
clearCanvas w h
let cw = toDouble $ canvasW gCfg
ch = toDouble $ canvasH gCfg
tcy = textContextY gCfg
C.scale (toDouble w / cw) (toDouble h / ch)
void $ yposSequence tcy s
renderWave
renderSlide :: [[Double -> C.Render Double]] -> Int -> Int -> Int -> C.Render ()
renderSlide s p w h = do
renderSlideFilter w h (s !! p)
renderTurtle $ toDouble p / toDouble (length s - 1)
carettah-0.5.1/WrapPaths.hs 0000644 0000000 0000000 00000000403 12527323704 013745 0 ustar 00 0000000 0000000 module WrapPaths (wrapGetDataFileName, wrapVersion) where
import Data.Version
import Paths_carettah (getDataFileName, version)
wrapGetDataFileName :: FilePath -> IO FilePath
wrapGetDataFileName = getDataFileName
wrapVersion :: Version
wrapVersion = version
carettah-0.5.1/FormatPangoMarkup.hs 0000644 0000000 0000000 00000004205 12527323704 015435 0 ustar 00 0000000 0000000 module FormatPangoMarkup (formatPangoMarkup, formatPangoMarkupWhite) where
import Text.Highlighting.Kate
import Graphics.Rendering.Pango
-- TODO: should use blaze-builder
tokColor :: TokenType -> String
tokColor KeywordTok = ""
tokColor DataTypeTok = ""
tokColor DecValTok = ""
tokColor BaseNTok = ""
tokColor FloatTok = ""
tokColor CharTok = ""
tokColor StringTok = ""
tokColor CommentTok = ""
tokColor OtherTok = ""
tokColor AlertTok = ""
tokColor FunctionTok = ""
tokColor RegionMarkerTok = ""
tokColor ErrorTok = ""
tokColor NormalTok = ""
tokShape :: TokenType -> String
tokShape KeywordTok = ""
tokShape DataTypeTok = ""
tokShape DecValTok = ""
tokShape BaseNTok = ""
tokShape FloatTok = ""
tokShape CharTok = ""
tokShape StringTok = ""
tokShape CommentTok = ""
tokShape OtherTok = ""
tokShape AlertTok = ""
tokShape FunctionTok = ""
tokShape RegionMarkerTok = ""
tokShape ErrorTok = ""
tokShape NormalTok = ""
tagTok, tagTokShape :: Token -> String
tagTok (t, s) = tokColor t ++ tokShape t ++ escapeMarkup s ++ ""
tagTokShape (t, s) = tokShape t ++ escapeMarkup s ++ ""
formatPangoMarkup :: String -> String -> String
formatPangoMarkup lang = unlines . fmap (concat . fmap tagTok) . highlightAs lang
formatPangoMarkupWhite :: String -> String -> String
formatPangoMarkupWhite lang text =
"" ++
(unlines . fmap (concat . fmap tagTokShape) . highlightAs lang) text ++
""
carettah-0.5.1/data/turtle.png 0000644 0000000 0000000 00000043513 12527323704 014447 0 ustar 00 0000000 0000000 PNG
IHDR gAMA a PLTE Q$ P' !(*V,r/ a6 7:8A DGO QW\ ] ` o`Ba c5e d jj.OlWvzI|;_~`~bgoav{^hҺȧIJ¦٤Ӝ̒ީǑÊܾsі֚ƓӶwӴoˉŬp˪fʆšW¡`|wyĀ|yvuQWxOHrbiJBAi=Y<::7}6z3y2w1u0t.r-o+o+Vpl(k'j'k*g$f&f