hubigraph (empty) → 0.3.1
raw patch · 7 files changed
+373/−0 lines, 7 filesdep +basedep +containersdep +haxrsetup-changed
Dependencies added: base, containers, haxr, mtl
Files
- Graphics/Ubigraph.hs +99/−0
- Graphics/Ubigraph/Base.hs +96/−0
- Graphics/Ubigraph/Style.hs +84/−0
- LICENSE +30/−0
- README.markdown +41/−0
- Setup.lhs +3/−0
- hubigraph.cabal +20/−0
+ Graphics/Ubigraph.hs view
@@ -0,0 +1,99 @@+module Graphics.Ubigraph (+ module Graphics.Ubigraph.Base,+ module Graphics.Ubigraph.Style,+ clear,+ newVertex, removeVertex,+ newEdge, removeEdge,+ newVertexWithID, newEdgeWithID,+ setVAttr, setEAttr,+) where++import Control.Monad.Reader (ReaderT(..), runReaderT, asks, liftIO, lift)+import Network.XmlRpc.Client (remote)+import Data.Char (toLower)+import Graphics.Ubigraph.Base+import Graphics.Ubigraph.Style++toBool :: IO Int -> IO Bool+toBool x = do+ x' <- x+ return $ if x' == 0 then True else False++{-+/* Delete all vertices and edges */+void ubigraph_clear();+-}++clear :: Hubigraph Bool+clear =+ do serv <- asks server+ liftIO . toBool $ remote serv "ubigraph.clear"++{-+/* Basic API methods */+vertex_id_t ubigraph_new_vertex();+edge_id_t ubigraph_new_edge(vertex_id_t x, vertex_id_t y);+result_t ubigraph_remove_vertex(vertex_id_t x);+result_t ubigraph_remove_edge(edge_id_t e);+-}++newVertex :: Hubigraph VertexID+newVertex =+ do serv <- asks server+ liftIO $ remote serv "ubigraph.new_vertex"++removeVertex :: VertexID -> Hubigraph Bool+removeVertex vid =+ do serv <- asks server+ liftIO . toBool $ remote serv "ubigraph.remove_vertex" vid++newEdge :: Edge -> Hubigraph EdgeID+newEdge (src,dst) =+ do serv <- asks server+ liftIO $ remote serv "ubigraph.new_edge" src dst++removeEdge :: EdgeID -> Hubigraph Bool+removeEdge eid =+ do serv <- asks server+ liftIO . toBool $ remote serv "ubigraph.remove_edge" eid++{-+/* Vertex/edge creation when user wants to use their own id's */+result_t ubigraph_new_vertex_w_id(vertex_id_t x);+result_t ubigraph_new_edge_w_id(edge_id_t e, vertex_id_t x, vertex_id_t y);+-}++newVertexWithID :: VertexID -> Hubigraph Bool+newVertexWithID node =+ do serv <- asks server+ liftIO . toBool $ remote serv "ubigraph.new_vertex_w_id" node++newEdgeWithID :: EdgeID -> Edge -> Hubigraph Bool+newEdgeWithID eid (src,dst) =+ do serv <- asks server+ liftIO . toBool $ remote serv "ubigraph.new_edge_w_id" eid src dst+++-- ################# ATTRIBUTE++{-+/* Set a vertex attribute */+result_t ubigraph_set_vertex_attribute(vertex_id_t x,+ const char* attribute, const char* value);++/* Set an edge attribute */+result_t ubigraph_set_edge_attribute(edge_id_t x,+ const char* attribute, const char* value);+-}++setVAttr :: VAttr -> VertexID -> Hubigraph Bool+setVAttr va vid =+ do serv <- asks server+ liftIO . toBool $ remote serv "ubigraph.set_vertex_attribute" vid k v+ where (k, v) = toPair va++setEAttr :: EAttr -> EdgeID -> Hubigraph Bool+setEAttr ea eid =+ do serv <- asks server+ liftIO . toBool $ remote serv "ubigraph.set_edge_attribute" eid k v+ where (k, v) = toPair ea
+ Graphics/Ubigraph/Base.hs view
@@ -0,0 +1,96 @@+module Graphics.Ubigraph.Base (+ Hubigraph, Ubigraph(..), VertexID, EdgeID, Edge, Color, Shape(..), Stroke(..),+ Attr(..), VAttr(..), EAttr(..), StyleID,+ runHubigraph, initHubigraph,+ ) where++import Control.Monad.Reader (ReaderT(..), runReaderT, asks, liftIO, lift)++runHubigraph = runReaderT++initHubigraph :: (Monad m) => String -> m Ubigraph+initHubigraph serv = return ( Ubigraph { server = serv } )++toBool :: IO Int -> IO Bool+toBool x = do+ x' <- x+ return $ if x' == 0 then True else False++type Hubigraph = ReaderT Ubigraph IO+data Ubigraph = Ubigraph { server :: String }++type VertexID = Int+type EdgeID = Int+type StyleID = Int+type Edge = (VertexID, VertexID)++type Color = String++data Shape = Cone | Cube | Dodecahedron | Icosahedron+ | Octahedron | Sphere | Tetrahedron+ | Torus deriving Show++data Stroke = Solid | Dashed | Dotted+ | None deriving Show++type VStyle = String+type EStyle = String++data VAttr = VColor Color+ | VShape Shape+ | VShapedetail Int+ {- only meaningful for sphere, cone, torus+ Useful range 4-40. Default: 0 (auto-adjust) -}+ | VLabel String+ | VSize Float+ | VFontcolor Color+ | VFontfamily String+ | VFontsize Int+ | VVisible Bool+ | VCallback String++data EAttr = EColor Color+ | ELabel String+ | EFontcolor Color+ | EFontfamily String+ | EFontsize Int+ | ESpline Bool+ | EStrength Float+ {- Default: 1.0, Use 0.0 for edge+ that do not affect layout -}+ | EOriented Bool+ | EStroke Stroke+ | EWidth Float -- default: 1.0+ | EArrow Bool -- default: false+ | EShowstrain Bool -- default: false+ | EVisible Bool++class Attr a where+ toPair :: a -> (String, String)++instance Attr VAttr where+ toPair (VColor c) = ("color", c)+ toPair (VShape a) = ("shape", show a)+ toPair (VShapedetail i) = ("shapedetail", show i)+ toPair (VLabel s) = ("label", s)+ toPair (VSize f) = ("size", show f)+ toPair (VFontcolor c) = ("fontcolor", c)+ toPair (VFontfamily s) = ("fontfamily", s)+ toPair (VFontsize sz) = ("fontsize", show sz)+ toPair (VVisible b) = ("visible", show b)+ toPair (VCallback url) = ("callback_left_doubleclick", url)++instance Attr EAttr where+ toPair (EColor c) = ("color", c)+ toPair (ELabel s) = ("label", s)+ toPair (EFontcolor c) = ("fontcolor", c)+ toPair (EFontsize sz) = ("fontsize", show sz)+ toPair (ESpline b) = ("spline", show b)+ toPair (EStrength f) = ("strength", show f)+ toPair (EOriented b) = ("oriented", show b)+ toPair (EStroke st) = ("stroke", show st)+ toPair (EWidth f) = ("width", show f)+ toPair (EArrow b) = ("arrow", show b)+ toPair (EShowstrain b)= ("showstrain", show b)+ toPair (EVisible b) = ("visible", show b)+
+ Graphics/Ubigraph/Style.hs view
@@ -0,0 +1,84 @@+module Graphics.Ubigraph.Style (+ changeVStyle, newVStyle, newVStyleWithID, setVStyleAttr,+ changeEStyle, newEStyle, newEStyleWithID, setEStyleAttr,+) where++import Control.Monad.Reader (asks, liftIO)+import Network.XmlRpc.Client (remote)+import Graphics.Ubigraph.Base++toBool :: IO Int -> IO Bool+toBool x = do+ x' <- x+ return $ if x' == 0 then True else False++-- ################# STYLE+{-+/* Vertex styles */+result_t ubigraph_change_vertex_style(vertex_id_t x, style_id_t s);+style_id_t ubigraph_new_vertex_style(style_id_t parent_style);+result_t ubigraph_new_vertex_style_w_id(style_id_t s, + style_id_t parent_style);+result_t ubigraph_set_vertex_style_attribute(style_id_t s,+ const char* attribute, const char* value);+-}++-- ubigraph_change_vertex_style+changeVStyle :: StyleID -> VertexID -> Hubigraph Bool+changeVStyle sid vid =+ do serv <- asks server+ liftIO . toBool $ remote serv "ubigraph.change_vertex_style" vid sid++-- ubigraph_new_vertex_style+newVStyle :: StyleID -> Hubigraph StyleID+newVStyle sid =+ do serv <- asks server+ liftIO $ remote serv "ubigraph.new_vertex_style" sid++-- ubigraph_new_vertex_style_w_id+newVStyleWithID :: StyleID -> StyleID -> Hubigraph Bool+newVStyleWithID newid parentid =+ do serv <- asks server+ liftIO $ remote serv "ubigraph.new_vertex_style_w_id" newid parentid++-- ubigraph_set_vertex_style_attribute+setVStyleAttr :: VAttr -> StyleID -> Hubigraph Bool+setVStyleAttr va sid =+ do serv <- asks server+ liftIO . toBool $ remote serv "ubigraph.set_vertex_style_attribute" sid k v+ where (k, v) = toPair va++{-+/* Edge styles */+result_t ubigraph_change_edge_style(edge_id_t x, style_id_t s);+style_id_t ubigraph_new_edge_style(style_id_t parent_style);+result_t ubigraph_new_edge_style_w_id(style_id_t s,+ style_id_t parent_style);+result_t ubigraph_set_edge_style_attribute(style_id_t s,+ const char* attribute, const char* value);+-}++-- ubigraph_change_edge_style+changeEStyle :: StyleID -> EdgeID -> Hubigraph Bool+changeEStyle sid eid =+ do serv <- asks server+ liftIO . toBool $ remote serv "ubigraph.change_edge_style" eid sid++-- ubigraph_new_edge_style+newEStyle :: StyleID -> Hubigraph StyleID+newEStyle sid =+ do serv <- asks server+ liftIO $ remote serv "ubigraph.new_edge_style" sid++-- ubigraph_new_edge_style_w_id+newEStyleWithID :: StyleID -> StyleID -> Hubigraph Bool+newEStyleWithID newid parentid =+ do serv <- asks server+ liftIO $ remote serv "ubigraph.new_edge_style_w_id" newid parentid++-- ubigraph_set_style_attribute+setEStyleAttr :: EAttr -> StyleID -> Hubigraph Bool+setEStyleAttr ea sid =+ do serv <- asks server+ liftIO . toBool $ remote serv "ubigraph.set_edge_style_attribute" sid k v+ where (k, v) = toPair ea
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2008 Kohei Ozaki+ +All rights reserved.+ +Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions+are met:+ +1. Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.+ +2. Redistributions in binary form must reproduce the above copyright+ notice, this list of conditions and the following disclaimer in the+ documentation and/or other materials provided with the distribution.+ +3. Neither the name of the author nor the names of his contributors+ may be used to endorse or promote products derived from this software+ without specific prior written permission.+ +THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``AS IS'' AND ANY EXPRESS OR+IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED+WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE+DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR+ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS+OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)+HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,+STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN+ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE+POSSIBILITY OF SUCH DAMAGE.
+ README.markdown view
@@ -0,0 +1,41 @@+# Hubigraph++http://ooxo.org/hubigraph/++## DESCRIPTION++a Haskell wrap for Ubigraph (http://www.ubietylab.net/ubigraph)++## FEATURES/PROBLEMS++It provides a shortcut to draw a graph in ubigraph (by calling XML-RPC internally.)++## SYNOPSIS++Make sure Ubigraph server is started before using this library.++ import Graphics.Ubigraph++ u x = initHubigraph "http://localhost:20738/RPC2" >>= runHubigraph x++ main = u $ mkRing 10++ mkRing n = do mapM_ (newVertexWithID) [0..(n-1)]+ mapM_ (newEdge') [0..(n-1)]+ sid <- newVStyle 0+ setVStyleAttr (VColor "#ff0000") sid+ setVStyleAttr (VShape Sphere) sid+ mapM_ (changeVStyle sid) [0..(n-1)]+ where newEdge' e = newEdge (e, (e+1) `mod` n)++## REQUIREMENTS++Ubigraph (http://www.ubietylab.net/ubigraph).++## INSTALL++$ cabal install hubigraph++## LICENSE++The BSD3 License
+ Setup.lhs view
@@ -0,0 +1,3 @@+#!/usr/bin/env runhaskell+> import Distribution.Simple+> main = defaultMain
+ hubigraph.cabal view
@@ -0,0 +1,20 @@+name: hubigraph+version: 0.3.1+homepage: http://ooxo.org/hubigraph/+synopsis: A haskell wrap for Ubigraph+description: Hubigraph is a Haskell wrapper for Ubigraph, which is a tool for visualizing dynamic graphs.+category: Graphics+license: BSD3+license-file: LICENSE+author: Kohei Ozaki+maintainer: Kohei Ozaki <eowner@gmail.com>+cabal-version: >= 1.2+build-type: Simple+stability: experimental+data-files: README.markdown+library+ exposed-modules: Graphics.Ubigraph,+ Graphics.Ubigraph.Base,+ Graphics.Ubigraph.Style+ build-depends: base >=3 && < 5, mtl >= 1.1.0.1, containers >= 0.2.0.0,+ haxr >= 3000.2.1