<commit_before>{-# LANGUAGE TemplateHaskell #-} -- fclabels

module GUI.Render (
      renderColor
    , render
    , drawNode
    , nodeRenderType
    , defRadius
    , ctrlPoints
    , edgeCenter
    , norm
    , directionVect
    ) where

import Control.Monad (guard)
import Data.Label -- fclabels
import Data.Maybe (fromJust)
--import GUI.Editing (State (..), GraphEditState (..))
import GUI.Editing
import Graphics.Rendering.Cairo as Gtk
import Graphics.UI.Gtk (Color (..))
import qualified Graph.Graph as G
import qualified Abstract.Relation as R
import Prelude hiding ((.))
import Control.Category


defRadius = 20 :: Double
defLineWidth = 2 :: Double
defBorderColor = Color 65535 65535 65535
defLineColor = Color 0 0 0
ctrlPointColor = Color 65535 65535 0
defSpacing = 1

{- Data types for rendering -}
data RNode = RNode GramState GraphEditState G.NodeId
data REdge = REdge GramState GraphEditState G.EdgeId
data RGraph = RGraph Graph

class Renderable a where
    render :: a -> Render ()

instance Renderable RNode where
    render (RNode state gstate n) =
        case G.nodePayload g n of
            Just (coords, renderFunc, checkFunc) -> renderFunc state gstate n
            otherwise -> return ()
      where
        g = _getGraph gstate

instance Renderable REdge where
    render (REdge state gstate e) =
        let gr = get getGraph gstate
            coords = do
                (src, tgt) <- G.nodesConnectedTo gr e
                srcC <- fmap getCoords $ G.nodePayload gr src
                tgtC <- fmap getCoords $ G.nodePayload gr tgt
                p@(_, _, bendVect, _) <- G.edgePayload gr e
                return (srcC, tgtC, bendVect, p)
        in case coords of
            Just (srcC@(x, y), tgtC@(x', y'), bendVect, p) -> do
                let -- Control points coodinates.
                    (ctrlP1@(ctrlX, ctrlY), ctrlP2@(ctrlX', ctrlY')) =
                        ctrlPoints srcC tgtC bendVect
                    (dirX', dirY') = directionVect (ctrlX', ctrlY') (x', y')
                setLineWidth defLineWidth
                renderColor defLineColor

                moveTo x y
                curveTo ctrlX ctrlY ctrlX' ctrlY' x' y'
--                if sel p then strokePreserve >> highlight >> stroke else stroke
                stroke
                setLineWidth defLineWidth
                renderColor defLineColor
                moveTo x' y'
                relMoveTo (- defRadius * dirX') (- defRadius * dirY')
                rotate $ (angle (dirX', dirY'))
                drawHead $ defRadius * 1.5
--                if sel p then fillPreserve >> highlight >> fill else fill
                fill
                identityMatrix<commit_msg>fixed edge head direction<commit_after>{-# LANGUAGE TemplateHaskell #-} -- fclabels

module GUI.Render (
      renderColor
    , render
    , drawNode
    , nodeRenderType
    , defRadius
    , ctrlPoints
    , edgeCenter
    , norm
    , directionVect
    ) where

import Control.Monad (guard)
import Data.Label -- fclabels
import Data.Maybe (fromJust)
--import GUI.Editing (State (..), GraphEditState (..))
import GUI.Editing
import Graphics.Rendering.Cairo as Gtk
import Graphics.UI.Gtk (Color (..))
import qualified Graph.Graph as G
import qualified Abstract.Relation as R
import Prelude hiding ((.))
import Control.Category


defRadius = 20 :: Double
defLineWidth = 2 :: Double
defBorderColor = Color 65535 65535 65535
defLineColor = Color 0 0 0
ctrlPointColor = Color 65535 65535 0
defSpacing = 1

{- Data types for rendering -}
data RNode = RNode GramState GraphEditState G.NodeId
data REdge = REdge GramState GraphEditState G.EdgeId
data RGraph = RGraph Graph

class Renderable a where
    render :: a -> Render ()

instance Renderable RNode where
    render (RNode state gstate n) =
        case G.nodePayload g n of
            Just (coords, renderFunc, checkFunc) -> renderFunc state gstate n
            otherwise -> return ()
      where
        g = _getGraph gstate

instance Renderable REdge where
    render (REdge state gstate e) =
        let gr = get getGraph gstate
            coords = do
                (src, tgt) <- G.nodesConnectedTo gr e
                srcC <- fmap getCoords $ G.nodePayload gr src
                tgtC <- fmap getCoords $ G.nodePayload gr tgt
                p@(_, _, bendVect, _) <- G.edgePayload gr e
                return (srcC, tgtC, bendVect, p)
        in case coords of
            Just (srcC@(x, y), tgtC@(x', y'), bendVect, p) -> do
                let -- Control points coodinates.
                    (ctrlP1@(ctrlX, ctrlY), ctrlP2@(ctrlX', ctrlY')) =
                        ctrlPoints srcC tgtC bendVect
                -- Edge drawing
                setLineWidth defLineWidth
                renderColor defLineColor
                moveTo x y
                curveTo ctrlX ctrlY ctrlX' ctrlY' x' y'
                stroke
                -- Edge head drawing
                setLineWidth defLineWidth
                renderColor defLineColor
                moveTo x' y'
                let (dx, dy) = directionVect ctrlP2 tgtC
                -- move to node borders
                relMoveTo (- defRadius * dx) (- defRadius * dy)
                rotate $
                    let refP =
                            bezierPoints 0.95 srcC tgtC ctrlP1 ctrlP2
                        deriv = directionVect refP tgtC
                    in angle deriv
                drawHead $ defRadius * 1.5
                fill
                identityMatrix
{'fraction_non_alphanumeric': 0.07774750227066303, 'fraction_numerical': 0.014532243415077202, 'mean_word_length': 1.8020356234096693, 'pattern_counts': {'":': 0, '<': 11, '<?xml version=': 0, '>': 19, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '6154837', 'n_tokens_mistral': 1666, 'n_tokens_neox': 1538, 'n_words': 522}