Hieroglyph 3 → 3.1

raw patch · 4 files changed

+65/−51 lines, 4 files

Files

Graphics/Rendering/Hieroglyph/Cache.hs +49/−33
Graphics/Rendering/Hieroglyph/OpenGL.hs +7/−9
Graphics/Rendering/Hieroglyph/OpenGL/Compile.hs +6/−6
Hieroglyph.cabal +3/−3

Graphics/Rendering/Hieroglyph/Cache.hs view

@@ -1,15 +1,15 @@ {-# LANGUAGE NoMonomorphismRestriction #-} ----------------------------------------------------------------------------- ----- Module      :  Graphics.UI.Hieroglyph.Cache--- Copyright   :+-- Module      :  Data.Caching.Memory.LRU+-- Copyright   :  Renaissance Computing Institute -- License     :  BSD3 -- -- Maintainer  :  J.R. Heard--- Stability   :--- Portability :+-- Stability   :  Beta+-- Portability :  GHC  ----- |+-- | A simple in memory LRU cache. -- ----------------------------------------------------------------------------- @@ -17,10 +17,7 @@  import qualified Data.Map as Map import qualified Data.IntMap as IntMap-import Debug.Trace -m ! k = case Map.lookup k m of Just v -> v; Nothing -> error $ "lookup failed for " ++ show k- data Cache k a = Cache      { store :: Map.Map k a     , times :: IntMap.IntMap k@@ -29,8 +26,9 @@     , size :: Int     , decimation :: Int } deriving Show ---- get :: Ord k => k -> Cache k a -> (Cache k a,Maybe a)+-- | @get key cache@ Gets a value out of the cache.  Returns both the value and +--   an updated cache reflecting that the times have been updated.+get :: Ord k => k -> Cache k a -> (Cache k a,Maybe a) get key cache = (cache',value)     where value = Map.lookup key (store cache)           cache' = maybe (cache{ now = now cache + 1 }) @@ -38,10 +36,14 @@                                      , times = IntMap.insert (now cache) key . IntMap.filter (/=key) . times $ cache })                           value --- putList :: Ord k => Cache k a -> [(k,a)] -> Cache k a+-- | @put cache list@. Put a list of key-value pairs in the cache.  Returns the udpated cache.+putList :: Ord k => Cache k a -> [(k,a)] -> Cache k a putList = foldr (\(a,b) m -> put a b m) --- put :: Ord k => k -> a -> Cache k a -> Cache k a+-- | @put key value cache@. Put a value in the cache by key.  If the key already exists, the+--   value for that key will be replaced.  If the cache is full, some values will drop off the+--   end of it silently.+put :: Ord k => k -> a -> Cache k a -> Cache k a put key value cache     | size cache < maxsize cache && (not $ Map.member key (store cache)) = cache          { now = now cache + 1@@ -65,7 +67,10 @@           (lowtimes,lowtimekeys) = unzip . take (decimation cache) . IntMap.toAscList . times $ cache           store' = foldr Map.delete (store cache) lowtimekeys ---  put' :: Ord k => k -> a -> Cache k a -> ([a], Cache k a)+-- | @put' key value cache@. Put a key in the cache.  If the cache is full, then+--   a number of values will be expunged from the cache.  Those values will be +--   returned as the first value in the pair of (values expunged, updated cache)+put' :: Ord k => k -> a -> Cache k a -> ([a], Cache k a) put' key value cache     | size cache < maxsize cache && (not $ Map.member key (store cache)) = ([]   ,cache          { now = now cache + 1@@ -89,39 +94,50 @@           (lowtimes,lowtimekeys) = unzip . take (decimation cache) . IntMap.toAscList . times $ cache           store' = foldr Map.delete (store cache) lowtimekeys           freed = map (store cache Map.!) lowtimekeys--free cache = -    case minval of-        Nothing -> free cache{ times= IntMap.deleteMin (times cache) }-        Just mv -> ((minkey,mv), cache')-    where minkey = IntMap.findMin $ (times cache)-          minval = Map.lookup minkey (store cache)-          cache' = cache{ now = now cache + 1-                        , times = IntMap.deleteMin (times cache)-                        , store = Map.delete minkey (store cache)-                        , size = size cache - 1 }--    -{-    --- free :: Ord k => Cache k a -> ((k,a),Cache k a)+ +-- | @free cache@. Frees a single value from the cache.  If the cache is empty,+--   free will error out, so be sure ot check isEmpty first. +free :: Ord k => Cache k a -> ((k,a),Cache k a) free cache =      ( (minkey,minval)     , cache' )-    where minkey = Map.findMin (times cache)-          minval = store cache ! minkey+    where minkey = IntMap.findMin (times cache)+          minval = store cache Map.! minkey           cache' = cache{ now = now cache + 1-                        , times = Map.deleteMin (times cache)+                        , times = IntMap.deleteMin (times cache)                         , store = Map.delete minkey (store cache)                         , size = size cache - 1 }--}+                        +freeN :: Ord k => Int -> Cache k a -> ([(k,a)], Cache k a)+freeN n cache = (zip lowtimekeys freed, cache{+          now = now cache + 1+        , times = times'+        , store = store'+        , size = size cache - n })+   where times' = foldr IntMap.delete (times cache) lowtimes+         (lowtimes,lowtimekeys) = unzip . take (decimation cache) . IntMap.toAscList . times $ cache+         store' = foldr Map.delete (store cache) lowtimekeys+         freed = map (store cache Map.!) lowtimekeys   +-- | @empty maxsize decimationk@ Creates a new empty cache with maximum size /maxsize/+--   and the number of keys to remove upon /putting/ to a full cache equal to /decimationk/.+empty :: Int -> Int -> Cache k a empty mxsz dec = Cache Map.empty IntMap.empty 0 mxsz 0 dec +-- | membership test for a key member :: Ord k => k -> Cache k a -> Bool member key cache = Map.member key (store cache) +-- | get all keys in the cache+keys :: Ord k => Cache k a -> [k] keys = Map.keys . store++-- | get all values in the cache+elems :: Ord k => Cache k a -> [a] elems = Map.elems . store-isEmpty x = store x == Map.empty++-- | check to see if the cache is empty+null :: Ord k => Cache k a -> Bool+null x = Map.null . store $ x

Graphics/Rendering/Hieroglyph/OpenGL.hs view

@@ -131,16 +131,14 @@                         GL.matrixMode $= GL.Projection                         GL.loadIdentity                         GL.pickMatrix (selx-2, (fromIntegral sy)-sely+2) (6,6) (p, GL.Size sx sy)-                        GL.ortho 0 (fromIntegral sx) 0 (fromIntegral sy) 1 10247680-                        (runtime', recs) <- GL.getHitRecords 5 $ renderObjects [1::Double,2..] (sort drawing) runtime+                        GL.ortho 0 (fromIntegral sx) 0 (fromIntegral sy) 1 2+                        (runtime', recs) <- GL.getHitRecords 16 $ renderObjects [1::Double,2..] (sort drawing) runtime                         selectionEvents <- forM (fromMaybe [] recs) $ \(GL.HitRecord x y names) ->-                            let names' = (fromMaybe "" . ((flip Map.lookup) (namemap runtime')) . (\(GL.Name x) -> x)) <$> names in do-                            --print names-                            print names'-                            Buster.produce "Selection" "Hieroglyph" (concat names') Buster.once-                                [Buster.EDouble . realToFrac $ x-                                , Buster.EDouble . realToFrac $ y-                                , Buster.EStringL $ names']+                            let names' = (fromMaybe "" . ((flip Map.lookup) (namemap runtime')) . (\(GL.Name x) -> x)) <$> names in do  +                               Buster.produce "Selection" "Hieroglyph" (concat names') Buster.once+                                    [Buster.EDouble . realToFrac $ x+                                    , Buster.EDouble . realToFrac $ y+                                    , Buster.EStringL $ names']                          runtimeE' <- Buster.produce "Hieroglyph" "Hieroglyph" "RenderData" Buster.Persistent [Buster.EOther runtime']                         Buster.future bus . return $ [Buster.Deletion sreq , runtimeE'] ++ selectionEvents

Graphics/Rendering/Hieroglyph/OpenGL/Compile.hs view

@@ -124,12 +124,12 @@           hf =  h            getFreeTexture e = if texture_whitelist e /= []-    then return (e{ texture_whitelist = tail $ texture_whitelist e }, head (texture_whitelist e))-    else (if Cache.isEmpty (texture_greylist e) -            then GL.genObjectNames 1 >>= (\obj -> return (e, head obj)) -            else return (e{ texture_greylist = c' }, t))                   +    then (e{ texture_whitelist = tail $ texture_whitelist e }, head (texture_whitelist e))+    else (e{ texture_greylist = c' }, t)                      where ((_,t),c') = Cache.free . texture_greylist $ e          +          +          compileText e txt  | cachetxt txt `Cache.member` texture_greylist e = do     let Point x y = bottomleft txt@@ -138,7 +138,7 @@     return ( e{ texture_greylist = c' }, CompiledImage txt x y w h tex (fromIntegral (sig txt)))   | otherwise = do-    (e', tex) <- getFreeTexture e          +    let (e', tex) = getFreeTexture e                    layout <- layoutEmpty (context e')     layoutSetMarkup layout . Pretty.render . str $ txt@@ -212,7 +212,7 @@         (Left (Point x y)) -> Gtk.pixbufNewFromFile (filename img) >>= copydata         (Right (Rect x y w h)) -> Gtk.pixbufNewFromFileAtScale (filename img) (round w) (round h) (preserveaspect img) >>= copydata -    (e', tex) <- getFreeTexture e+    let (e', tex) = getFreeTexture e          GL.textureBinding GL.Texture2D $= Just tex     GL.textureWrapMode GL.Texture2D GL.S $= (GL.Repeated, GL.Clamp)

Hieroglyph.cabal view

@@ -1,5 +1,5 @@ name: Hieroglyph-version: 3+version: 3.1 cabal-version: >=1.2 build-type: Simple license: BSD3@@ -14,9 +14,9 @@ homepage: http://vis.renci.org/jeff/hieroglyph package-url: bug-reports:-synopsis: Purely functional 2D drawing+synopsis: Purely functional 2D graphics for visualization. description: A purely functional 2D scenegraph library with functionality similar to a barebones Processing.-             Currently entirely implmeneted using Cairo, although I would like to go to OpenGL as well.+             Currently a complete implmentation exists using Cairo and partial implementation in OpenGL as well. category: Graphics author: J.R. Heard tested-with: