[Fencommits] fenfire-hs: LaTeX vob
Tuukka Hastrup
Tuukka.Hastrup at iki.fi
Fri Mar 9 21:03:24 EET 2007
Fri Mar 9 21:01:04 EET 2007 Tuukka Hastrup <Tuukka.Hastrup at iki.fi>
* LaTeX vob
diff -rN -u old-fenfire-hs-1/Cairo.fhs new-fenfire-hs-1/Cairo.fhs
--- old-fenfire-hs-1/Cairo.fhs 2007-03-09 21:03:22.000000000 +0200
+++ new-fenfire-hs-1/Cairo.fhs 2007-03-09 21:03:22.000000000 +0200
@@ -108,8 +108,9 @@
C.save; renderPath p'; C.clip; ren; C.restore
withSurface :: Cairo cx r => cx C.Surface -> Endo r
-withSurface s = cxWrap $ \ren -> ffor s $ \s' -> do
- C.save; C.setSourceSurface s' 0 0; ren; C.restore
+withSurface s = cxWrap $ \ren -> #(C.save >> C.getMatrix >>= \m' ->
+ C.setMatrix !cxMatrix >> C.setSourceSurface !s 0 0 >> C.setMatrix m' >>
+ ren >> C.restore)
withColor :: Cairo cx r => cx Color -> Endo r
withColor c = cxWrap $ \ren -> ffor c $ \(Color r g b a) -> do
diff -rN -u old-fenfire-hs-1/Fenfire.fhs new-fenfire-hs-1/Fenfire.fhs
--- old-fenfire-hs-1/Fenfire.fhs 2007-03-09 21:03:22.000000000 +0200
+++ new-fenfire-hs-1/Fenfire.fhs 2007-03-09 21:03:22.000000000 +0200
@@ -115,7 +115,7 @@
setText n t = update (n, rdfs_label, PlainLiteral t)
nodeView :: (?graph :: Graph) => Node -> Vob Node
-nodeView n = useFgColor $ multiline False 20 $ getTextOrURI n
+nodeView n = useFgColor $ latex $ getTextOrURI n
propView :: (?graph :: Graph) => Node -> Vob Node
propView n = (useFadeColor $ fill extents)
diff -rN -u old-fenfire-hs-1/Latex2Png.hs new-fenfire-hs-1/Latex2Png.hs
--- old-fenfire-hs-1/Latex2Png.hs 2007-03-09 21:03:22.000000000 +0200
+++ new-fenfire-hs-1/Latex2Png.hs 2007-03-09 21:03:23.000000000 +0200
@@ -21,9 +21,9 @@
import System.Cmd (rawSystem)
import System.Environment (getArgs)
-import System.Directory (getTemporaryDirectory, setCurrentDirectory,
- createDirectory, getDirectoryContents, removeFile, removeDirectory,
- doesFileExist)
+import System.Directory (getTemporaryDirectory, getCurrentDirectory,
+ setCurrentDirectory, createDirectory, getDirectoryContents, removeFile,
+ removeDirectory, doesFileExist)
import System.IO (openTempFile, openFile, hPutStr, hClose, IOMode(..))
import System.Exit (ExitCode(..))
@@ -38,9 +38,9 @@
"\\end{document}"
]
-main = do
- [code,outfile] <- getArgs
- handle <- openFile outfile WriteMode
+withLatexPng :: String -> (Maybe FilePath -> IO a) -> IO a
+withLatexPng code block = do
+ oldCurrentDirectory <- getCurrentDirectory
tmp <- getTemporaryDirectory
let dir = tmp ++ "/latex2png" -- FIXME / and predictable name
createDirectory dir
@@ -49,18 +49,32 @@
let latexFile = "latex2png-temp"
writeFile (latexFile++".tex") $ latex code
-- FIXME set environment variables necessary for security, use rlimit
- ExitSuccess <- rawSystem "latex" ["--interaction=nonstopmode", latexFile++".tex"]
- ExitSuccess <- rawSystem "dvipng" ["-bgTransparent", "-Ttight", "", "--noghostscript", "-l1", latexFile++".dvi"]
+ ret1 <- rawSystem "latex" ["--interaction=nonstopmode", latexFile++".tex"]
- png <- readFile $ latexFile++"1.png"
+ ret2 <- rawSystem "dvipng" ["-bgTransparent", "-Ttight", "", "--noghostscript", "-l1", latexFile++".dvi"]
+
+ let resultname = latexFile++"1.png"
+
+ haveResult <- doesFileExist resultname
+ let resultfile = if haveResult then Just resultname else Nothing
+ result <- block $ resultfile
setCurrentDirectory tmp
files <- getDirectoryContents dir
flip mapM_ files $ \filename -> do
let file = dir ++ "/" ++ filename -- FIXME /
- exists <- doesFileExist file
+ exists <- doesFileExist file -- XXX to ignore . and ..
when exists $ removeFile $ file
removeDirectory dir
+ setCurrentDirectory oldCurrentDirectory
+ return result
+
+main = do
+ [code,outfile] <- getArgs
+ handle <- openFile outfile WriteMode
+
+ png <- withLatexPng code $ maybe (return "") readFile
+
hPutStr handle png
hClose handle
diff -rN -u old-fenfire-hs-1/Main.hs new-fenfire-hs-1/Main.hs
--- old-fenfire-hs-1/Main.hs 2007-03-09 21:03:22.000000000 +0200
+++ new-fenfire-hs-1/Main.hs 2007-03-09 21:03:23.000000000 +0200
@@ -708,8 +708,8 @@
, containerBorderWidth := 6
, dialogHasSeparator := False
]
- image <- imageNewFromStock stockDialogError iconSizeDialog
- set image [ miscYalign := 0.0 ]
+ image' <- imageNewFromStock stockDialogError iconSizeDialog
+ set image' [ miscYalign := 0.0 ]
label' <- labelNew $ Just $ "<span weight=\"bold\" size=\"larger\">"++
escapeMarkup primary++"</span>\n\n"++escapeMarkup secondary
set label' [ labelUseMarkup := True
@@ -721,7 +721,7 @@
set hBox [ boxSpacing := 12
, containerBorderWidth := 6
]
- boxPackStart hBox image PackNatural 0
+ boxPackStart hBox image' PackNatural 0
boxPackStart hBox label' PackNatural 0
vBox <- dialogGetUpper dialog
diff -rN -u old-fenfire-hs-1/Vobs.fhs new-fenfire-hs-1/Vobs.fhs
--- old-fenfire-hs-1/Vobs.fhs 2007-03-09 21:03:21.000000000 +0200
+++ new-fenfire-hs-1/Vobs.fhs 2007-03-09 21:03:22.000000000 +0200
@@ -23,6 +23,9 @@
import Cairo
+import Latex2Png
+import Cache
+
import Data.IORef
import System.IO.Unsafe (unsafePerformIO)
import qualified System.Time
@@ -209,14 +212,39 @@
h = maximum [h1, h2, h3]
return $ renderable (realToFrac w, realToFrac h) $ showLayout layout
-
-image :: Ord k => FilePath -> Vob k
-image file = unsafePerformIO $ C.withImageSurfaceFromPNG file $ \surface -> do
+getSurfaceSize :: C.Surface -> IO (Int,Int)
+getSurfaceSize surface = do
w <- C.renderWith surface $ C.imageSurfaceGetWidth surface
h <- C.renderWith surface $ C.imageSurfaceGetHeight surface
+ return (w,h)
+
+createImageSurfaceFromPNG :: FilePath -> IO C.Surface
+createImageSurfaceFromPNG file =
+ C.withImageSurfaceFromPNG file $ \surface -> do
+ (w,h) <- getSurfaceSize surface
+ surface' <- C.createImageSurface C.FormatARGB32 w h
+ C.renderWith surface' $ do
+ C.setSourceSurface surface 0 0
+ C.rectangle 0 0 (realToFrac w) (realToFrac h)
+ C.fill
+ return surface'
+
+-- image :: Ord k => FilePath -> Vob k
+image file = {- unsafePerformIO $ -} do
+ surface <- createImageSurfaceFromPNG file
+ (w,h) <- getSurfaceSize surface
return $ changeSize (const (realToFrac w, realToFrac h)) $
withSurface #surface $ fill extents
+latexCache :: Cache.Cache String (Vob k)
+latexCache = Cache.newCache 10000
+
+latex :: Ord k => String -> Vob k
+latex code = Cache.cached code latexCache $ unsafePerformIO $ do
+ withLatexPng code $ maybe (return $ setFgColor (Color 0.7 0.5 0.1 1)
+ $ useFgColor $ multiline False 20 code)
+ ({- return . -} image)
+
fadedColor :: Ord k => Endo (Cx k Color)
fadedColor c = liftM3 interpolate (asks rcFade) (asks rcFadeColor) c
More information about the Fencommits
mailing list