<commit_before>module App.View where

import Prelude
import App.Geometry (Point(..), Stroke(..), distance, getNearestPoint)
import App.Graph (Cycle(..), findCycles)
import App.Model (Action(..), State)
import Data.Array (fromFoldable)
import Data.List (List, concat)
import Data.Map (keys, values)
import Data.Maybe (Maybe(..))
import Pux.Html (Attribute, Html, circle, g, line, svg)
import Pux.Html.Attributes (cx, cy, height, r, stroke, strokeDasharray, width, x1, x2, y1, y2)
import Pux.Html.Events (onClick, onMouseMove)

drawLine :: Array (Attribute Action) -> Point -> Point -> Html Action
drawLine strokeStyle (Point px1 py1) (Point px2 py2) =
  line ([ x1 $ show px1
       , y1 $ show py1
       , x2 $ show px2
       , y2 $ show py2
       ] <> strokeStyle) []

drawStroke :: Array (Attribute Action) -> Stroke -> Html Action
drawStroke strokeStyle (Line p1 p2) = drawLine strokeStyle p1 p2

drawStrokes :: Array (Attribute Action) -> List Stroke -> Html Action
drawStrokes strokeStyle strokes =
    g [] $ fromFoldable $ drawStroke strokeStyle <$> strokes

drawCycles :: List Cycle -> Html Action
drawCycles cycles =
  g [] $ fromFoldable $ drawCycle <$> cycles
  where
    drawCycle (Cycle strokes) = drawStrokes [stroke "red"] strokes

drawPoint :: Point -> Number -> Html Action
drawPoint (Point x y) size =
  circle [ cx $ show x
         , cy $ show y
         , r $ show size
         ] []

drawSnapPoint :: Point -> List Point -> Html Action
drawSnapPoint p ps =
  case getNearestPoint p ps of
    Nothing -> g [] []
    Just np -> drawPoint np (if distance p np < 20.0 then 3.0 else 2.0)

drawCurrentStroke :: Maybe Point -> Point -> Html Action
drawCurrentStroke Nothing _ = g [] []
drawCurrentStroke (Just p1) p2 =
  drawLine [ stroke "black"
           , strokeDasharray "5 5"
           ] p1 p2

view :: State -> Html Action
view state =
  svg [ (onClick \{pageX, pageY} -> Click (Point pageX pageY))
    , (onMouseMove \{pageX, pageY} -> Move (Point pageX pageY))
    , width "100%"
    , height "100%"
    ]<commit_msg>render cycles using paths<commit_after>module App.View where

import Prelude
import App.Geometry (Point(..), Stroke(..), distance, getNearestPoint)
import App.Graph (Cycle(..), findCycles)
import App.Model (Action(..), State)
import Data.Array (fromFoldable)
import Data.List (List, concat, foldl, (:))
import Data.Map (keys, values)
import Data.Maybe (Maybe(..))
import Pux.Html (Attribute, Html, circle, g, line, svg)
import Pux.Html.Attributes (cx, cy, d, height, r, stroke, strokeDasharray, width, x1, x2, y1, y2)
import Pux.Html.Elements (path)
import Pux.Html.Events (onClick, onMouseMove)

drawLine :: Array (Attribute Action) -> Point -> Point -> Html Action
drawLine strokeStyle (Point px1 py1) (Point px2 py2) =
  line ([ x1 $ show px1
       , y1 $ show py1
       , x2 $ show px2
       , y2 $ show py2
       ] <> strokeStyle) []

drawStroke :: Array (Attribute Action) -> Stroke -> Html Action
drawStroke strokeStyle (Line p1 p2) = drawLine strokeStyle p1 p2

drawStrokes :: Array (Attribute Action) -> List Stroke -> Html Action
drawStrokes strokeStyle strokes =
    g [] $ fromFoldable $ drawStroke strokeStyle <$> strokes

drawCycle :: Array (Attribute Action) -> Cycle -> Html Action
drawCycle attrs (Cycle strokes) =
  path (pathAttrs strokes <> attrs) []

pathAttrs strokes@((Line (Point x0 y0) _): _) =
  [ d (foldl append ("M " <> show x0 <> " " <> show y0 <> " ") (dCommand <$> strokes))
  ]

pathAttrs _ = []

dCommand (Line _ (Point x2 y2)) = "L " <> show x2 <> " " <> show y2 <> " "

drawCycles :: List Cycle -> Html Action
drawCycles cycles =
  g [] $ fromFoldable $ drawCycle [stroke "red"] <$> cycles

drawPoint :: Point -> Number -> Html Action
drawPoint (Point x y) size =
  circle [ cx $ show x
         , cy $ show y
         , r $ show size
         ] []

drawSnapPoint :: Point -> List Point -> Html Action
drawSnapPoint p ps =
  case getNearestPoint p ps of
    Nothing -> g [] []
    Just np -> drawPoint np (if distance p np < 20.0 then 3.0 else 2.0)

drawCurrentStroke :: Maybe Point -> Point -> Html Action
drawCurrentStroke Nothing _ = g [] []
drawCurrentStroke (Just p1) p2 =
  drawLine [ stroke "black"
           , strokeDasharray "5 5"
           ] p1 p2

view :: State -> Html Action
view state =
  svg [ (onClick \{pageX, pageY} -> Click (Point pageX pageY))
    , (onMouseMove \{pageX, pageY} -> Move (Point pageX pageY))
    , width "100%"
    , height "100%"
    ]
{'fraction_non_alphanumeric': 0.130522538685804, 'fraction_numerical': 0.019286835613366225, 'mean_word_length': 3.1799437675726336, 'pattern_counts': {'":': 0, '<': 21, '<?xml version=': 0, '>': 59, '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': '3545757', 'n_tokens_mistral': 1539, 'n_tokens_neox': 1490, 'n_words': 511}