mirror of
https://gitlab.com/sheaf/metabrush.git
synced 2024-11-05 23:03:38 +00:00
use assertions instead of errors, minor linting
This commit is contained in:
parent
1e4bb4bddc
commit
ab3a12c983
|
@ -23,6 +23,11 @@ description:
|
||||||
|
|
||||||
The shape of the brush is allowed to vary along the path.
|
The shape of the brush is allowed to vary along the path.
|
||||||
|
|
||||||
|
flag asserts
|
||||||
|
description: Enable debugging assertions.
|
||||||
|
default: False
|
||||||
|
manual: True
|
||||||
|
|
||||||
common common
|
common common
|
||||||
|
|
||||||
build-depends:
|
build-depends:
|
||||||
|
@ -122,6 +127,7 @@ executable MetaBrush
|
||||||
, MetaBrush.Asset.TickBox
|
, MetaBrush.Asset.TickBox
|
||||||
, MetaBrush.Asset.Tools
|
, MetaBrush.Asset.Tools
|
||||||
, MetaBrush.Asset.WindowIcons
|
, MetaBrush.Asset.WindowIcons
|
||||||
|
, MetaBrush.Assert
|
||||||
, MetaBrush.Brush
|
, MetaBrush.Brush
|
||||||
, MetaBrush.Context
|
, MetaBrush.Context
|
||||||
, MetaBrush.Document
|
, MetaBrush.Document
|
||||||
|
@ -160,6 +166,10 @@ executable MetaBrush
|
||||||
ghc-options:
|
ghc-options:
|
||||||
-threaded -rtsopts
|
-threaded -rtsopts
|
||||||
|
|
||||||
|
if flag(asserts)
|
||||||
|
cpp-options:
|
||||||
|
-DASSERTS
|
||||||
|
|
||||||
build-depends:
|
build-depends:
|
||||||
MetaBrush
|
MetaBrush
|
||||||
, atomic-file-ops
|
, atomic-file-ops
|
||||||
|
|
20
src/app/MetaBrush/Assert.hs
Normal file
20
src/app/MetaBrush/Assert.hs
Normal file
|
@ -0,0 +1,20 @@
|
||||||
|
{-# LANGUAGE CPP #-}
|
||||||
|
|
||||||
|
module MetaBrush.Assert
|
||||||
|
( assert )
|
||||||
|
where
|
||||||
|
|
||||||
|
-- base
|
||||||
|
#ifdef ASSERTS
|
||||||
|
import Control.Exception
|
||||||
|
( AssertionFailed(..), throw )
|
||||||
|
#endif
|
||||||
|
|
||||||
|
--------------------------------------------------------------------------------
|
||||||
|
|
||||||
|
assert :: String -> a -> a
|
||||||
|
#ifdef ASSERTS
|
||||||
|
assert message _ = throw ( AssertionFailed message )
|
||||||
|
#else
|
||||||
|
assert _ a = a
|
||||||
|
#endif
|
|
@ -4,8 +4,6 @@
|
||||||
{-# LANGUAGE OverloadedStrings #-}
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
{-# LANGUAGE PolyKinds #-}
|
{-# LANGUAGE PolyKinds #-}
|
||||||
{-# LANGUAGE ScopedTypeVariables #-}
|
{-# LANGUAGE ScopedTypeVariables #-}
|
||||||
{-# LANGUAGE TypeApplications #-}
|
|
||||||
{-# LANGUAGE TypeOperators #-}
|
|
||||||
|
|
||||||
module MetaBrush.Asset.Brushes where
|
module MetaBrush.Asset.Brushes where
|
||||||
|
|
||||||
|
|
|
@ -59,8 +59,8 @@ drawCloseTabButton ( Colours {..} ) unsavedChanges flags = do
|
||||||
pure True
|
pure True
|
||||||
where
|
where
|
||||||
hover, clicked :: Bool
|
hover, clicked :: Bool
|
||||||
hover = any ( == GTK.StateFlagsPrelight ) flags
|
hover = GTK.StateFlagsPrelight `elem` flags
|
||||||
clicked = any ( == GTK.StateFlagsActive ) flags
|
clicked = GTK.StateFlagsActive `elem` flags
|
||||||
|
|
||||||
drawCross :: Cairo.Render ()
|
drawCross :: Cairo.Render ()
|
||||||
drawCross = do
|
drawCross = do
|
||||||
|
|
|
@ -8,7 +8,6 @@
|
||||||
{-# LANGUAGE FlexibleInstances #-}
|
{-# LANGUAGE FlexibleInstances #-}
|
||||||
{-# LANGUAGE GADTs #-}
|
{-# LANGUAGE GADTs #-}
|
||||||
{-# LANGUAGE LambdaCase #-}
|
{-# LANGUAGE LambdaCase #-}
|
||||||
{-# LANGUAGE MagicHash #-}
|
|
||||||
{-# LANGUAGE MultiParamTypeClasses #-}
|
{-# LANGUAGE MultiParamTypeClasses #-}
|
||||||
{-# LANGUAGE NamedFieldPuns #-}
|
{-# LANGUAGE NamedFieldPuns #-}
|
||||||
{-# LANGUAGE OverloadedStrings #-}
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
|
|
|
@ -65,6 +65,8 @@ import Math.Module
|
||||||
( squaredNorm )
|
( squaredNorm )
|
||||||
import Math.Vector2D
|
import Math.Vector2D
|
||||||
( Point2D(..), Vector2D(..) )
|
( Point2D(..), Vector2D(..) )
|
||||||
|
import MetaBrush.Assert
|
||||||
|
( assert )
|
||||||
import MetaBrush.Brush
|
import MetaBrush.Brush
|
||||||
( BrushReference(NoBrush) )
|
( BrushReference(NoBrush) )
|
||||||
import MetaBrush.Document
|
import MetaBrush.Document
|
||||||
|
@ -205,7 +207,8 @@ addToAnchor anchor newSpline = over ( field' @"documentContent" . field' @"strok
|
||||||
setBrushData = set ( field @"brushParams" ) ( brushParams ( splineEnd prevSpline ) )
|
setBrushData = set ( field @"brushParams" ) ( brushParams ( splineEnd prevSpline ) )
|
||||||
in prevSpline <> fmap setBrushData newSpline
|
in prevSpline <> fmap setBrushData newSpline
|
||||||
| otherwise
|
| otherwise
|
||||||
= error "addToAnchor: trying to add to a closed spline"
|
= assert ( "addToAnchor: trying to add to closed spline " <> show strokeUnique )
|
||||||
|
prevSpline -- should never add to a closed spline
|
||||||
in
|
in
|
||||||
overStrokeSpline updateSpline stroke
|
overStrokeSpline updateSpline stroke
|
||||||
| otherwise
|
| otherwise
|
||||||
|
|
|
@ -176,6 +176,8 @@ import Math.Bezier.Stroke
|
||||||
( CachedStroke(..) )
|
( CachedStroke(..) )
|
||||||
import Math.Vector2D
|
import Math.Vector2D
|
||||||
( Point2D(..), Vector2D(..), Segment )
|
( Point2D(..), Vector2D(..), Segment )
|
||||||
|
import MetaBrush.Assert
|
||||||
|
( assert )
|
||||||
import MetaBrush.Brush
|
import MetaBrush.Brush
|
||||||
( Brush(..), BrushReference(..), newBrushReference
|
( Brush(..), BrushReference(..), newBrushReference
|
||||||
, SomeBrushFields(..), SomeFieldSType(..), reflectBrushFieldsNoDups
|
, SomeBrushFields(..), SomeFieldSType(..), reflectBrushFieldsNoDups
|
||||||
|
@ -656,14 +658,17 @@ encodeStroke brushes = JSON.Encoder.mapLikeObj
|
||||||
mbEncodeBrush = case strokeBrushRef of
|
mbEncodeBrush = case strokeBrushRef of
|
||||||
BrushReference ( _ :: Proxy# brushFields1 ) unique ->
|
BrushReference ( _ :: Proxy# brushFields1 ) unique ->
|
||||||
case Map.lookup unique brushes of
|
case Map.lookup unique brushes of
|
||||||
Nothing -> error ( "encodeStroke: no brush with unique " <> show unique <> "in environment" )
|
Nothing ->
|
||||||
|
assert ( "encodeStroke: no brush with unique " <> show unique <> "in environment" )
|
||||||
|
id
|
||||||
Just ( brush@BrushData { brushName, brushFunction = ( _ :: BrushFunction brushFields2 ) } ) ->
|
Just ( brush@BrushData { brushName, brushFunction = ( _ :: BrushFunction brushFields2 ) } ) ->
|
||||||
case eqTys @brushFields1 @brushFields2 of
|
case eqTys @brushFields1 @brushFields2 of
|
||||||
Nothing -> error
|
Nothing ->
|
||||||
( "encodeStroke: brush '" <> Text.unpack brushName <> "' has unexpected field types.\n\
|
assert ( "encodeStroke: brush '" <> Text.unpack brushName <> "' has unexpected field types.\n\
|
||||||
\Expected: " <> show ( sTypesI @brushFields1 ) <> "\n\
|
\Expected: " <> show ( sTypesI @brushFields1 ) <> "\n\
|
||||||
\ Actual: " <> show ( sTypesI @brushFields2 )
|
\ Actual: " <> show ( sTypesI @brushFields2 )
|
||||||
)
|
)
|
||||||
|
id
|
||||||
Just Refl -> JSON.Encoder.atKey' "brush" encodeBrush brush
|
Just Refl -> JSON.Encoder.atKey' "brush" encodeBrush brush
|
||||||
NoBrush -> id
|
NoBrush -> id
|
||||||
in
|
in
|
||||||
|
|
|
@ -1,7 +1,5 @@
|
||||||
{-# LANGUAGE AllowAmbiguousTypes #-}
|
{-# LANGUAGE AllowAmbiguousTypes #-}
|
||||||
{-# LANGUAGE BangPatterns #-}
|
|
||||||
{-# LANGUAGE DataKinds #-}
|
{-# LANGUAGE DataKinds #-}
|
||||||
{-# LANGUAGE DeriveAnyClass #-}
|
|
||||||
{-# LANGUAGE DeriveGeneric #-}
|
{-# LANGUAGE DeriveGeneric #-}
|
||||||
{-# LANGUAGE DerivingStrategies #-}
|
{-# LANGUAGE DerivingStrategies #-}
|
||||||
{-# LANGUAGE EmptyCase #-}
|
{-# LANGUAGE EmptyCase #-}
|
||||||
|
|
|
@ -6,12 +6,9 @@
|
||||||
{-# LANGUAGE FlexibleContexts #-}
|
{-# LANGUAGE FlexibleContexts #-}
|
||||||
{-# LANGUAGE FlexibleInstances #-}
|
{-# LANGUAGE FlexibleInstances #-}
|
||||||
{-# LANGUAGE GADTs #-}
|
{-# LANGUAGE GADTs #-}
|
||||||
{-# LANGUAGE LambdaCase #-}
|
|
||||||
{-# LANGUAGE MagicHash #-}
|
|
||||||
{-# LANGUAGE MultiParamTypeClasses #-}
|
{-# LANGUAGE MultiParamTypeClasses #-}
|
||||||
{-# LANGUAGE NamedFieldPuns #-}
|
{-# LANGUAGE NamedFieldPuns #-}
|
||||||
{-# LANGUAGE OverloadedStrings #-}
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
{-# LANGUAGE RecursiveDo #-}
|
|
||||||
{-# LANGUAGE ScopedTypeVariables #-}
|
{-# LANGUAGE ScopedTypeVariables #-}
|
||||||
{-# LANGUAGE TypeApplications #-}
|
{-# LANGUAGE TypeApplications #-}
|
||||||
{-# LANGUAGE TypeFamilies #-}
|
{-# LANGUAGE TypeFamilies #-}
|
||||||
|
|
|
@ -2,7 +2,6 @@
|
||||||
{-# LANGUAGE FlexibleContexts #-}
|
{-# LANGUAGE FlexibleContexts #-}
|
||||||
{-# LANGUAGE FlexibleInstances #-}
|
{-# LANGUAGE FlexibleInstances #-}
|
||||||
{-# LANGUAGE GADTs #-}
|
{-# LANGUAGE GADTs #-}
|
||||||
{-# LANGUAGE MagicHash #-}
|
|
||||||
{-# LANGUAGE MultiParamTypeClasses #-}
|
{-# LANGUAGE MultiParamTypeClasses #-}
|
||||||
{-# LANGUAGE PolyKinds #-}
|
{-# LANGUAGE PolyKinds #-}
|
||||||
{-# LANGUAGE ScopedTypeVariables #-}
|
{-# LANGUAGE ScopedTypeVariables #-}
|
||||||
|
@ -24,23 +23,15 @@ import Data.Functor.Identity
|
||||||
( Identity(..) )
|
( Identity(..) )
|
||||||
import Data.Kind
|
import Data.Kind
|
||||||
( Type )
|
( Type )
|
||||||
import Data.List
|
|
||||||
( intercalate )
|
|
||||||
import Data.Monoid
|
import Data.Monoid
|
||||||
( Sum )
|
( Sum )
|
||||||
import GHC.Exts
|
|
||||||
( Proxy#, proxy# )
|
|
||||||
import GHC.TypeLits
|
import GHC.TypeLits
|
||||||
( Symbol, KnownSymbol, symbolVal' )
|
( Symbol )
|
||||||
|
|
||||||
-- acts
|
-- acts
|
||||||
import Data.Act
|
import Data.Act
|
||||||
( Act(..), Torsor(..) )
|
( Act(..), Torsor(..) )
|
||||||
|
|
||||||
-- deepseq
|
|
||||||
import Control.DeepSeq
|
|
||||||
( NFData )
|
|
||||||
|
|
||||||
-- groups
|
-- groups
|
||||||
import Data.Group
|
import Data.Group
|
||||||
( Group(..) )
|
( Group(..) )
|
||||||
|
@ -60,8 +51,6 @@ import Math.Module
|
||||||
( Module(..) )
|
( Module(..) )
|
||||||
import Math.Vector2D
|
import Math.Vector2D
|
||||||
( Point2D, Vector2D )
|
( Point2D, Vector2D )
|
||||||
import MetaBrush.MetaParameter.AST
|
|
||||||
( STypeI(..), STypesI )
|
|
||||||
|
|
||||||
--------------------------------------------------------------------------------
|
--------------------------------------------------------------------------------
|
||||||
|
|
||||||
|
|
|
@ -391,9 +391,8 @@ orientation :: Token -> Orientation
|
||||||
orientation ( TokAlphabetic ori )
|
orientation ( TokAlphabetic ori )
|
||||||
| Text.map Char.toLower ori == "ccw"
|
| Text.map Char.toLower ori == "ccw"
|
||||||
= CCW
|
= CCW
|
||||||
| Text.map Char.toLower ori == "cw"
|
orientation _
|
||||||
= CW
|
= CW
|
||||||
orientation tok = error ( "orientation: unexpected token " <> show tok )
|
|
||||||
|
|
||||||
curveTo
|
curveTo
|
||||||
:: forall clo r
|
:: forall clo r
|
||||||
|
|
|
@ -1,10 +1,8 @@
|
||||||
{-# LANGUAGE BlockArguments #-}
|
{-# LANGUAGE BlockArguments #-}
|
||||||
{-# LANGUAGE ConstraintKinds #-}
|
{-# LANGUAGE ConstraintKinds #-}
|
||||||
{-# LANGUAGE DataKinds #-}
|
{-# LANGUAGE DataKinds #-}
|
||||||
{-# LANGUAGE DeriveAnyClass #-}
|
|
||||||
{-# LANGUAGE DeriveGeneric #-}
|
{-# LANGUAGE DeriveGeneric #-}
|
||||||
{-# LANGUAGE DerivingStrategies #-}
|
{-# LANGUAGE DerivingStrategies #-}
|
||||||
{-# LANGUAGE EmptyCase #-}
|
|
||||||
{-# LANGUAGE FlexibleContexts #-}
|
{-# LANGUAGE FlexibleContexts #-}
|
||||||
{-# LANGUAGE NamedFieldPuns #-}
|
{-# LANGUAGE NamedFieldPuns #-}
|
||||||
{-# LANGUAGE ScopedTypeVariables #-}
|
{-# LANGUAGE ScopedTypeVariables #-}
|
||||||
|
|
|
@ -34,9 +34,9 @@ import Data.Either
|
||||||
import Data.Functor.Compose
|
import Data.Functor.Compose
|
||||||
( Compose(..) )
|
( Compose(..) )
|
||||||
import Data.List
|
import Data.List
|
||||||
( sortBy )
|
( sortOn )
|
||||||
import Data.Ord
|
import Data.Ord
|
||||||
( comparing )
|
( Down(..) )
|
||||||
import Data.Proxy
|
import Data.Proxy
|
||||||
( Proxy )
|
( Proxy )
|
||||||
import Data.Type.Equality
|
import Data.Type.Equality
|
||||||
|
@ -305,7 +305,7 @@ withDeclsRecord decls f = do
|
||||||
-- as these would have been caught by the renamer.
|
-- as these would have been caught by the renamer.
|
||||||
-- Sort in reverse order as we must add elements in decreasing label order.
|
-- Sort in reverse order as we must add elements in decreasing label order.
|
||||||
revSortDecls :: [ Decl Tc ] -> m [ ( Text, ( UniqueName, TypedTerm ) ) ]
|
revSortDecls :: [ Decl Tc ] -> m [ ( Text, ( UniqueName, TypedTerm ) ) ]
|
||||||
revSortDecls = fmap ( sortBy ( flip $ comparing fst ) ) . traverse getDeclName
|
revSortDecls = fmap ( sortOn ( Down . fst ) ) . traverse getDeclName
|
||||||
getDeclName :: Decl Tc -> m ( Text, ( UniqueName, TypedTerm ) )
|
getDeclName :: Decl Tc -> m ( Text, ( UniqueName, TypedTerm ) )
|
||||||
getDeclName ( Decl ( Located loc _ ) pat term ) = case pat of
|
getDeclName ( Decl ( Located loc _ ) pat term ) = case pat of
|
||||||
PName ( Located _ uniq@( UniqueName nm _ ) ) -> pure ( nm, ( uniq, TypedTerm term ) )
|
PName ( Located _ uniq@( UniqueName nm _ ) ) -> pure ( nm, ( uniq, TypedTerm term ) )
|
||||||
|
|
|
@ -12,6 +12,7 @@
|
||||||
{-# LANGUAGE MultiParamTypeClasses #-}
|
{-# LANGUAGE MultiParamTypeClasses #-}
|
||||||
{-# LANGUAGE NamedFieldPuns #-}
|
{-# LANGUAGE NamedFieldPuns #-}
|
||||||
{-# LANGUAGE NegativeLiterals #-}
|
{-# LANGUAGE NegativeLiterals #-}
|
||||||
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
{-# LANGUAGE RecordWildCards #-}
|
{-# LANGUAGE RecordWildCards #-}
|
||||||
{-# LANGUAGE ScopedTypeVariables #-}
|
{-# LANGUAGE ScopedTypeVariables #-}
|
||||||
{-# LANGUAGE TypeApplications #-}
|
{-# LANGUAGE TypeApplications #-}
|
||||||
|
@ -135,7 +136,7 @@ import MetaBrush.MetaParameter.Interpolation
|
||||||
import MetaBrush.UI.ToolBar
|
import MetaBrush.UI.ToolBar
|
||||||
( Mode(..) )
|
( Mode(..) )
|
||||||
import MetaBrush.Unique
|
import MetaBrush.Unique
|
||||||
( Unique )
|
( Unique, unsafeUnique )
|
||||||
import MetaBrush.Util
|
import MetaBrush.Util
|
||||||
( withRGBA )
|
( withRGBA )
|
||||||
|
|
||||||
|
@ -238,8 +239,8 @@ renderDocument
|
||||||
= ( ( Stroke
|
= ( ( Stroke
|
||||||
{ strokeSpline = previewSpline
|
{ strokeSpline = previewSpline
|
||||||
, strokeVisible = True
|
, strokeVisible = True
|
||||||
, strokeUnique = undefined
|
, strokeUnique = unsafeUnique 987654321
|
||||||
, strokeName = undefined
|
, strokeName = "Preview stroke (temporary)"
|
||||||
, strokeBrushRef = NoBrush
|
, strokeBrushRef = NoBrush
|
||||||
}
|
}
|
||||||
)
|
)
|
||||||
|
|
|
@ -103,7 +103,7 @@ class Monad m => MonadUnique m where
|
||||||
|
|
||||||
instance {-# OVERLAPPABLE #-} ( Monad m, MonadReader r m, HasType UniqueSupply r, MonadIO m ) => MonadUnique m where
|
instance {-# OVERLAPPABLE #-} ( Monad m, MonadReader r m, HasType UniqueSupply r, MonadIO m ) => MonadUnique m where
|
||||||
freshUnique = do
|
freshUnique = do
|
||||||
UniqueSupply { uniqueSupplyTVar } <- view ( typed @UniqueSupply ) <$> ask
|
UniqueSupply { uniqueSupplyTVar } <- view ( typed @UniqueSupply )
|
||||||
liftIO $ STM.atomically do
|
liftIO $ STM.atomically do
|
||||||
uniq@( Unique !i ) <- STM.readTVar uniqueSupplyTVar
|
uniq@( Unique !i ) <- STM.readTVar uniqueSupplyTVar
|
||||||
STM.writeTVar uniqueSupplyTVar ( Unique ( succ i ) )
|
STM.writeTVar uniqueSupplyTVar ( Unique ( succ i ) )
|
||||||
|
|
|
@ -8,7 +8,6 @@
|
||||||
{-# LANGUAGE GADTs #-}
|
{-# LANGUAGE GADTs #-}
|
||||||
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
|
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
|
||||||
{-# LANGUAGE InstanceSigs #-}
|
{-# LANGUAGE InstanceSigs #-}
|
||||||
{-# LANGUAGE LambdaCase #-}
|
|
||||||
{-# LANGUAGE NamedFieldPuns #-}
|
{-# LANGUAGE NamedFieldPuns #-}
|
||||||
{-# LANGUAGE PolyKinds #-}
|
{-# LANGUAGE PolyKinds #-}
|
||||||
{-# LANGUAGE QuantifiedConstraints #-}
|
{-# LANGUAGE QuantifiedConstraints #-}
|
||||||
|
@ -16,7 +15,6 @@
|
||||||
{-# LANGUAGE RecordWildCards #-}
|
{-# LANGUAGE RecordWildCards #-}
|
||||||
{-# LANGUAGE ScopedTypeVariables #-}
|
{-# LANGUAGE ScopedTypeVariables #-}
|
||||||
{-# LANGUAGE StandaloneDeriving #-}
|
{-# LANGUAGE StandaloneDeriving #-}
|
||||||
{-# LANGUAGE TupleSections #-}
|
|
||||||
{-# LANGUAGE TypeApplications #-}
|
{-# LANGUAGE TypeApplications #-}
|
||||||
{-# LANGUAGE TypeFamilies #-}
|
{-# LANGUAGE TypeFamilies #-}
|
||||||
{-# LANGUAGE UndecidableInstances #-}
|
{-# LANGUAGE UndecidableInstances #-}
|
||||||
|
|
|
@ -8,12 +8,10 @@
|
||||||
{-# LANGUAGE FlexibleContexts #-}
|
{-# LANGUAGE FlexibleContexts #-}
|
||||||
{-# LANGUAGE FlexibleInstances #-}
|
{-# LANGUAGE FlexibleInstances #-}
|
||||||
{-# LANGUAGE GADTs #-}
|
{-# LANGUAGE GADTs #-}
|
||||||
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
|
|
||||||
{-# LANGUAGE NamedFieldPuns #-}
|
{-# LANGUAGE NamedFieldPuns #-}
|
||||||
{-# LANGUAGE PolyKinds #-}
|
{-# LANGUAGE PolyKinds #-}
|
||||||
{-# LANGUAGE RecordWildCards #-}
|
{-# LANGUAGE RecordWildCards #-}
|
||||||
{-# LANGUAGE ScopedTypeVariables #-}
|
{-# LANGUAGE ScopedTypeVariables #-}
|
||||||
{-# LANGUAGE TupleSections #-}
|
|
||||||
{-# LANGUAGE TypeApplications #-}
|
{-# LANGUAGE TypeApplications #-}
|
||||||
|
|
||||||
module Math.Bezier.Stroke
|
module Math.Bezier.Stroke
|
||||||
|
@ -489,8 +487,8 @@ joinWithBrush
|
||||||
pcs :: Maybe ( SplinePts Open )
|
pcs :: Maybe ( SplinePts Open )
|
||||||
pcs = discardCurveData <$> dropCurves i1 openSpline
|
pcs = discardCurveData <$> dropCurves i1 openSpline
|
||||||
in
|
in
|
||||||
fromMaybe empty
|
maybe empty fst
|
||||||
( fst <$> ( splitFirstPiece t2 =<< snd <$> ( splitFirstPiece t1 =<< pcs ) ) )
|
( splitFirstPiece t2 . snd =<< ( splitFirstPiece t1 =<< pcs ) )
|
||||||
| otherwise
|
| otherwise
|
||||||
= let
|
= let
|
||||||
start, middle, end :: SplinePts Open
|
start, middle, end :: SplinePts Open
|
||||||
|
|
Loading…
Reference in a new issue