module IGE.Render ( renderEditorState ) where import Protolude import IGE.Types import IGE.Layout import Data.Graph.Inductive.Graph import Data.Graph.Inductive.PatriciaTree import Graphics.Rendering.Cairo import Lens.Micro.Platform import qualified Data.Map.Strict as Map -- Refactoring ideas: -- - Use diagrams instance Renderable Text where render s (x :+ y) = do extents <- textExtents s rectangle (x - textMargin) (y - (textExtentsHeight extents + textMargin)) (textExtentsWidth extents + (2 * textMargin)) (textExtentsHeight extents + (2 * textMargin)) setSourceRGB 0.1 0.1 0.1 fill setSourceRGB 0.9 0.9 0.9 moveTo x y showText s instance Renderable () where render () (x :+ y) = do arc x y nodeSize 0 (2 * pi) fill instance RenderNode Text where instance RenderEdge Text where instance RenderNode () where instance RenderEdge () where renderEdge _ _ = return () nodeSize :: Double nodeSize = 4 renderBackground :: Render () renderBackground = do setSourceRGB 0.1 0.1 0.1 paint setSourceRGB 0.9 0.9 0.9 selectFontFace ("monospace" :: Text) FontSlantNormal FontWeightNormal setFontSize 15 renderNodes :: (RenderNode a) => [(ℂ, a)] -> Render () renderNodes nodes = mapM_ (uncurry $ flip renderNode) nodes renderEdges :: (RenderEdge a) => [(ℂ, ℂ, a)] -> Render () renderEdges edges = forM_ edges $ \(p1@(x0 :+ y0), p2@(x1 :+ y1), label) -> do moveTo x0 y0 lineTo x1 y1 stroke renderEdge label $ (p1 + p2) / (2 :+ 0) renderCommand :: (Int, Int) -> [Char] -> Render () renderCommand (w, h) s = do let s' = reverse s extents <- textExtents s' moveTo 0 ((fromIntegral h) - (textExtentsHeight extents)) showText s' textMargin = 3 renderLabels :: [([Char], ℂ)] -> Render () renderLabels labels = forM_ labels $ \(s, x :+ y) -> do extents <- textExtents s rectangle (x - textMargin) (y - (textExtentsHeight extents + textMargin)) (textExtentsWidth extents + (2 * textMargin)) (textExtentsHeight extents + (2 * textMargin)) setSourceRGB 0.7 0.7 0.2 fill setSourceRGB 0.1 0.1 0.1 moveTo x y showText s renderEditorState :: (RenderNode n, RenderEdge e) => EditorState n e -> (Int, Int) -> Render () renderEditorState es dims = do let rm = es^._rm let graph = es^._graph let labels = es^._labels let nodeMap = (rm ^*) <$> es^._nodeMap renderBackground renderEdges $ ((_1 %~ (nodeMap Map.!)) . (_2 %~ (nodeMap Map.!))) <$> labEdges graph renderNodes $ (_1 %~ (nodeMap Map.!)) <$> labNodes graph renderCommand dims (es^._cmd) renderLabels $ over _2 (nodeMap Map.!) <$> labels