From 8fef6bda06c9f6fb2b9ab0646da1fb317b2bd2ad Mon Sep 17 00:00:00 2001 From: Yann Herklotz Date: Sat, 5 Sep 2020 19:05:32 +0100 Subject: Main rendering of arrows finished --- src/Main.hs | 66 ++++++++++++++++++++++++++++++++++++++++++++++++++++++------- 1 file changed, 59 insertions(+), 7 deletions(-) diff --git a/src/Main.hs b/src/Main.hs index 505d3f4..e1eba52 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -1,18 +1,70 @@ module Main where -newtype Ribbon = Ribbon [Bool] Int +import qualified Data.List as List + +data Ribbon = Ribbon [Bool] Double + deriving (Eq, Show) newtype RawData = RawData [Ribbon] + deriving (Eq, Show) + +data Limits = Limits {limitsLow :: Double, limitsHigh :: Double} + deriving (Eq, Show) + +data Coord = Coord {coordX :: Double, coordY :: Double} + deriving (Eq) + +instance Show Coord where + show (Coord x y) = "(" <> show x <> "," <> show y <> ")" + +boolToCoords :: Limits -> Double -> Bool -> Coord +boolToCoords (Limits _ h) x True = Coord x h +boolToCoords (Limits l _) x False = Coord x l + +moveX :: Double -> Coord -> Coord +moveX d (Coord x y) = Coord (x + d) y + +incrX :: Limits -> Double -> (Double, [Coord]) -> Bool -> (Double, [Coord]) +incrX l len (d, coords) b = (d + len, boolToCoords l d b : coords) + +drawRibbon :: Limits -> Double -> [Bool] -> [Coord] +drawRibbon l len b = + snd $ foldl (incrX l len) (0.0, []) b -newtype Limits = Limits { limitsLow :: Int, limitsHigh :: Int } +drawCoords :: String -> [Coord] -> String +drawCoords connection coords = + mconcat $ List.intersperse connection (show <$> coords) -drawSegment :: Limits -> Bool -> Bool -> Int -> String -drawSegment (Limits _ h) True True i = - show (i,h) <> " -- " <> show ((fromInteger i + 1.0) / 2.0, h) <> " -- " show (i+1,h) +inBetween :: Coord -> Coord -> Coord +inBetween (Coord x1 y1) (Coord x2 y2) = + Coord ((x1 + x2) / 2.0) ((y1 + y2) / 2.0) -drawRibbon :: Ribbon -> String -drawRibbon (Ribbon b i) = +drawArrow :: Double -> Double -> (Double, String) -> Ribbon -> (Double, String) +drawArrow ratio len (start, s) (Ribbon b i) = + ( (limitsHigh lower_limit), + s + <> "\\draw " + <> (drawCoords " to [out=0,in=180] " . reverse $ drawRibbon upper_limit len b) + <> " -- " + <> drawCoords + " -- " + [ mid1, + moveX 2.5 (inBetween mid1 mid2), + mid2 + ] + <> " -- " + <> (drawCoords " to [out=180,in=0] " $ drawRibbon lower_limit len b) + <> ";\n" + ) + where + upper_limit = Limits ((- start) * ratio) (start * ratio) + lower_limit = Limits ((- start - i) * ratio) ((start - i) * ratio) + mid1 = boolToCoords upper_limit ((fromIntegral $ length b) * 5.0) (last b) + mid2 = boolToCoords lower_limit ((fromIntegral $ length b) * 5.0) (last b) +drawRibbons :: [Ribbon] -> String +drawRibbons rs = + undefined main :: IO () main = putStrLn "Hello, Haskell!" -- cgit