mirror of
https://github.com/Haskell-Things/ImplicitCAD.git
synced 2024-11-04 01:26:48 +03:00
commit
87f2aee4b3
51
.github/workflows/ormolu.yaml
vendored
Normal file
51
.github/workflows/ormolu.yaml
vendored
Normal file
@ -0,0 +1,51 @@
|
|||||||
|
# FUTUREWORK: add this to `ci.dhall`?
|
||||||
|
|
||||||
|
name: Ormolu
|
||||||
|
on:
|
||||||
|
- pull_request
|
||||||
|
|
||||||
|
jobs:
|
||||||
|
ormolu:
|
||||||
|
runs-on: ubuntu-18.04
|
||||||
|
steps:
|
||||||
|
- uses: "actions/checkout@v1"
|
||||||
|
|
||||||
|
- uses: "actions/setup-haskell@v1.1.4"
|
||||||
|
id: setup-haskell-cabal
|
||||||
|
with:
|
||||||
|
cabal-version: "${{ matrix.cabal }}"
|
||||||
|
enable-stack: false
|
||||||
|
ghc-version: "${{ matrix.ghc }}"
|
||||||
|
|
||||||
|
- uses: "actions/cache@v2"
|
||||||
|
name: Cache
|
||||||
|
with:
|
||||||
|
key: "${{ runner.os }}"
|
||||||
|
path: |
|
||||||
|
"${{ steps.setup-haskell-cabal.outputs.cabal-store }}"
|
||||||
|
~/.cabal/packages
|
||||||
|
~/.cabal/store
|
||||||
|
~/.cabal/bin
|
||||||
|
dist-newstyle
|
||||||
|
~/.local/bin
|
||||||
|
|
||||||
|
- name: Install dependencies
|
||||||
|
run: |
|
||||||
|
export PATH=$PATH:$HOME/.cabal/bin:$HOME/.local/bin
|
||||||
|
export ORMOLU_VERSION=$(cat ./layout/ormolu.version)
|
||||||
|
(ormolu -v 2>/dev/null | grep -q $ORMOLU_VERSION) || (cabal update && cabal install ormolu --constraint="ormolu ==$ORMOLU_VERSION")
|
||||||
|
test -e $HOME/.local/bin/yq || pip3 install yq
|
||||||
|
shell: bash
|
||||||
|
|
||||||
|
- name: Ormolu
|
||||||
|
run: |
|
||||||
|
export PATH=$PATH:$HOME/.cabal/bin:$HOME/.local/bin
|
||||||
|
./layout/ormolu.sh -c
|
||||||
|
shell: bash
|
||||||
|
|
||||||
|
strategy:
|
||||||
|
matrix:
|
||||||
|
cabal:
|
||||||
|
- '3.2'
|
||||||
|
ghc:
|
||||||
|
- '8.10.1'
|
@ -1,3 +1,4 @@
|
|||||||
|
{- ORMOLU_DISABLE -}
|
||||||
-- Example 11 - the union of a square and a circle.
|
-- Example 11 - the union of a square and a circle.
|
||||||
import Graphics.Implicit
|
import Graphics.Implicit
|
||||||
|
|
||||||
|
@ -1,3 +1,4 @@
|
|||||||
|
{- ORMOLU_DISABLE -}
|
||||||
-- Example 12 - the rounded union of a square and a circle.
|
-- Example 12 - the rounded union of a square and a circle.
|
||||||
import Control.Applicative (pure)
|
import Control.Applicative (pure)
|
||||||
import Graphics.Implicit
|
import Graphics.Implicit
|
||||||
|
@ -1,3 +1,4 @@
|
|||||||
|
{- ORMOLU_DISABLE -}
|
||||||
-- Example 13 - the rounded union of a cube and a sphere.
|
-- Example 13 - the rounded union of a cube and a sphere.
|
||||||
import Control.Applicative (pure)
|
import Control.Applicative (pure)
|
||||||
import Graphics.Implicit
|
import Graphics.Implicit
|
||||||
|
@ -1,3 +1,4 @@
|
|||||||
|
{- ORMOLU_DISABLE -}
|
||||||
import Control.Applicative (pure)
|
import Control.Applicative (pure)
|
||||||
import Graphics.Implicit
|
import Graphics.Implicit
|
||||||
import Graphics.Implicit.Definitions
|
import Graphics.Implicit.Definitions
|
||||||
|
@ -1,3 +1,4 @@
|
|||||||
|
{- ORMOLU_DISABLE -}
|
||||||
-- Example 17, pulled from our benchmarking suite.
|
-- Example 17, pulled from our benchmarking suite.
|
||||||
import Control.Applicative (pure)
|
import Control.Applicative (pure)
|
||||||
import Prelude ((<$>), ($), zipWith3, fmap, fromIntegral, (*), (/), Bool(..))
|
import Prelude ((<$>), ($), zipWith3, fmap, fromIntegral, (*), (/), Bool(..))
|
||||||
|
@ -1,3 +1,4 @@
|
|||||||
|
{- ORMOLU_DISABLE -}
|
||||||
-- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca)
|
-- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca)
|
||||||
-- Copyright (C) 2014 2015 2016, Julia Longtin (julial@turinglace.com)
|
-- Copyright (C) 2014 2015 2016, Julia Longtin (julial@turinglace.com)
|
||||||
-- Released under the GNU AGPLV3+, see LICENSE
|
-- Released under the GNU AGPLV3+, see LICENSE
|
||||||
@ -195,7 +196,6 @@ writePNG2
|
|||||||
-> IO ()
|
-> IO ()
|
||||||
writePNG2 = Export.writePNG
|
writePNG2 = Export.writePNG
|
||||||
|
|
||||||
|
|
||||||
-- | Export a PNG of the 'SymbolicObj3'. The projection is with a front-facing
|
-- | Export a PNG of the 'SymbolicObj3'. The projection is with a front-facing
|
||||||
-- camera, so the coordinate system is @(left to right, front to back, down to
|
-- camera, so the coordinate system is @(left to right, front to back, down to
|
||||||
-- up)@.
|
-- up)@.
|
||||||
|
@ -1,3 +1,4 @@
|
|||||||
|
{- ORMOLU_DISABLE -}
|
||||||
-- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca)
|
-- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca)
|
||||||
-- Copyright 2014 2015 2016, 2017, 2018, Julia Longtin (julial@turinglace.com)
|
-- Copyright 2014 2015 2016, 2017, 2018, Julia Longtin (julial@turinglace.com)
|
||||||
-- Copyright 2015 2016, Mike MacHenry (mike.machenry@gmail.com)
|
-- Copyright 2015 2016, Mike MacHenry (mike.machenry@gmail.com)
|
||||||
@ -247,7 +248,6 @@ instance (Show obj, Show vec) => Show (SharedObj obj vec) where
|
|||||||
EmbedBoxedObj _ -> showCon "implicit" @| Blackhole
|
EmbedBoxedObj _ -> showCon "implicit" @| Blackhole
|
||||||
WithRounding r obj -> showCon "withRounding" @| r @| obj
|
WithRounding r obj -> showCon "withRounding" @| r @| obj
|
||||||
|
|
||||||
|
|
||||||
------------------------------------------------------------------------------
|
------------------------------------------------------------------------------
|
||||||
-- | A type whose show instance is a hole @_@. Used for giving 'Show' instances
|
-- | A type whose show instance is a hole @_@. Used for giving 'Show' instances
|
||||||
-- to data types which contain functions or other unshowable things.
|
-- to data types which contain functions or other unshowable things.
|
||||||
@ -256,7 +256,6 @@ data Blackhole = Blackhole
|
|||||||
instance Show Blackhole where
|
instance Show Blackhole where
|
||||||
show _ = "_"
|
show _ = "_"
|
||||||
|
|
||||||
|
|
||||||
newtype ObjectContext = ObjectContext
|
newtype ObjectContext = ObjectContext
|
||||||
{ objectRounding :: ℝ
|
{ objectRounding :: ℝ
|
||||||
} deriving (Eq, Ord, Show)
|
} deriving (Eq, Ord, Show)
|
||||||
@ -266,7 +265,6 @@ defaultObjectContext = ObjectContext
|
|||||||
{ objectRounding = 0
|
{ objectRounding = 0
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
-- | A symbolic 2D object format.
|
-- | A symbolic 2D object format.
|
||||||
-- We want to have symbolic objects so that we can
|
-- We want to have symbolic objects so that we can
|
||||||
-- accelerate rendering & give ideal meshes for simple
|
-- accelerate rendering & give ideal meshes for simple
|
||||||
@ -293,13 +291,10 @@ instance Show SymbolicObj2 where
|
|||||||
Rotate2 v obj -> showCon "rotate" @| v @| obj
|
Rotate2 v obj -> showCon "rotate" @| v @| obj
|
||||||
Shared2 obj -> flip showsPrec obj
|
Shared2 obj -> flip showsPrec obj
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
-- | Semigroup under 'Graphic.Implicit.Primitives.union'.
|
-- | Semigroup under 'Graphic.Implicit.Primitives.union'.
|
||||||
instance Semigroup SymbolicObj2 where
|
instance Semigroup SymbolicObj2 where
|
||||||
a <> b = Shared2 (UnionR 0 [a, b])
|
a <> b = Shared2 (UnionR 0 [a, b])
|
||||||
|
|
||||||
|
|
||||||
-- | Monoid under 'Graphic.Implicit.Primitives.union'.
|
-- | Monoid under 'Graphic.Implicit.Primitives.union'.
|
||||||
instance Monoid SymbolicObj2 where
|
instance Monoid SymbolicObj2 where
|
||||||
mempty = Shared2 Empty
|
mempty = Shared2 Empty
|
||||||
@ -352,7 +347,6 @@ instance Show SymbolicObj3 where
|
|||||||
showCon "extrudeOnEdgeOf" @| s @| s1
|
showCon "extrudeOnEdgeOf" @| s @| s1
|
||||||
Shared3 s -> flip showsPrec s
|
Shared3 s -> flip showsPrec s
|
||||||
|
|
||||||
|
|
||||||
infixl 2 @||
|
infixl 2 @||
|
||||||
------------------------------------------------------------------------------
|
------------------------------------------------------------------------------
|
||||||
-- | ImplicitCAD uses the pattern @Either a (b -> c)@ for many of its
|
-- | ImplicitCAD uses the pattern @Either a (b -> c)@ for many of its
|
||||||
@ -365,7 +359,6 @@ showF @|| x = showApp showF $ case x of
|
|||||||
Left a -> showCon "Left" @| a
|
Left a -> showCon "Left" @| a
|
||||||
Right _ -> showCon "Right" @| Blackhole
|
Right _ -> showCon "Right" @| Blackhole
|
||||||
|
|
||||||
|
|
||||||
-- | Semigroup under 'Graphic.Implicit.Primitives.union'.
|
-- | Semigroup under 'Graphic.Implicit.Primitives.union'.
|
||||||
instance Semigroup SymbolicObj3 where
|
instance Semigroup SymbolicObj3 where
|
||||||
a <> b = Shared3 (UnionR 0 [a, b])
|
a <> b = Shared3 (UnionR 0 [a, b])
|
||||||
|
@ -1,3 +1,4 @@
|
|||||||
|
{- ORMOLU_DISABLE -}
|
||||||
-- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca)
|
-- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca)
|
||||||
-- Copyright (C) 2014 2015, Julia Longtin (julial@turinglace.com)
|
-- Copyright (C) 2014 2015, Julia Longtin (julial@turinglace.com)
|
||||||
-- Copyright (C) 2015 2016, Mike MacHenry (mike.machenry@gmail.com)
|
-- Copyright (C) 2015 2016, Mike MacHenry (mike.machenry@gmail.com)
|
||||||
|
@ -1,3 +1,4 @@
|
|||||||
|
{- ORMOLU_DISABLE -}
|
||||||
-- Copyright 2016, Julia Longtin (julial@turinglace.com)
|
-- Copyright 2016, Julia Longtin (julial@turinglace.com)
|
||||||
-- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca)
|
-- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca)
|
||||||
-- Released under the GNU AGPLV3+, see LICENSE
|
-- Released under the GNU AGPLV3+, see LICENSE
|
||||||
|
@ -1,3 +1,4 @@
|
|||||||
|
{- ORMOLU_DISABLE -}
|
||||||
-- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca)
|
-- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca)
|
||||||
-- Copyright (C) 2016 Julia Longtin (julial@turinglace.com)
|
-- Copyright (C) 2016 Julia Longtin (julial@turinglace.com)
|
||||||
-- Released under the GNU AGPLV3+, see LICENSE
|
-- Released under the GNU AGPLV3+, see LICENSE
|
||||||
|
@ -1,3 +1,4 @@
|
|||||||
|
{- ORMOLU_DISABLE -}
|
||||||
-- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca)
|
-- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca)
|
||||||
-- Copyright (C) 2016, Julia Longtin (julial@turinglace.com)
|
-- Copyright (C) 2016, Julia Longtin (julial@turinglace.com)
|
||||||
-- Released under the GNU AGPLV3+, see LICENSE
|
-- Released under the GNU AGPLV3+, see LICENSE
|
||||||
|
@ -1,3 +1,4 @@
|
|||||||
|
{- ORMOLU_DISABLE -}
|
||||||
-- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca)
|
-- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca)
|
||||||
-- Copyright 2016, Julia Longtin (julial@turinglace.com)
|
-- Copyright 2016, Julia Longtin (julial@turinglace.com)
|
||||||
-- Released under the GNU AGPLV3+, see LICENSE
|
-- Released under the GNU AGPLV3+, see LICENSE
|
||||||
@ -172,4 +173,3 @@ traceRay ray@(Ray cameraP cameraV) step box (Scene obj objColor lights defaultCo
|
|||||||
)
|
)
|
||||||
Nothing -> defaultColor
|
Nothing -> defaultColor
|
||||||
|
|
||||||
|
|
||||||
|
@ -1,3 +1,4 @@
|
|||||||
|
{- ORMOLU_DISABLE -}
|
||||||
-- Copyright 2016, Julia Longtin (julial@turinglace.com)
|
-- Copyright 2016, Julia Longtin (julial@turinglace.com)
|
||||||
-- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca)
|
-- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca)
|
||||||
-- Released under the GNU AGPLV3+, see LICENSE
|
-- Released under the GNU AGPLV3+, see LICENSE
|
||||||
|
@ -1,3 +1,4 @@
|
|||||||
|
{- ORMOLU_DISABLE -}
|
||||||
-- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca)
|
-- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca)
|
||||||
-- Released under the GNU AGPLV3+, see LICENSE
|
-- Released under the GNU AGPLV3+, see LICENSE
|
||||||
|
|
||||||
|
@ -1,3 +1,4 @@
|
|||||||
|
{- ORMOLU_DISABLE -}
|
||||||
-- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca)
|
-- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca)
|
||||||
-- Copyright 2014 2015 2016, Julia Longtin (julial@turinglace.com)
|
-- Copyright 2014 2015 2016, Julia Longtin (julial@turinglace.com)
|
||||||
-- Released under the GNU AGPLV3+, see LICENSE
|
-- Released under the GNU AGPLV3+, see LICENSE
|
||||||
|
@ -1,3 +1,4 @@
|
|||||||
|
{- ORMOLU_DISABLE -}
|
||||||
-- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca)
|
-- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca)
|
||||||
-- Copyright (C) 2016, Julia Longtin (julial@turinglace.com)
|
-- Copyright (C) 2016, Julia Longtin (julial@turinglace.com)
|
||||||
-- Released under the GNU AGPLV3+, see LICENSE
|
-- Released under the GNU AGPLV3+, see LICENSE
|
||||||
@ -30,7 +31,6 @@ import Linear (V2(V2))
|
|||||||
To allow data sharing, lots of values we
|
To allow data sharing, lots of values we
|
||||||
could calculate are instead arguments.
|
could calculate are instead arguments.
|
||||||
|
|
||||||
|
|
||||||
positions obj values
|
positions obj values
|
||||||
--------- ----------
|
--------- ----------
|
||||||
|
|
||||||
@ -38,7 +38,6 @@ import Linear (V2(V2))
|
|||||||
: : => : :
|
: : => : :
|
||||||
(x1,y1) .. (x2,y1) x1y1 .. x2y2
|
(x1,y1) .. (x2,y1) x1y1 .. x2y2
|
||||||
|
|
||||||
|
|
||||||
mid points
|
mid points
|
||||||
----------
|
----------
|
||||||
|
|
||||||
|
@ -1,3 +1,4 @@
|
|||||||
|
{- ORMOLU_DISABLE -}
|
||||||
-- Implicit CAD. Copyright (C) 2012, Christopher Olah (chris@colah.ca)
|
-- Implicit CAD. Copyright (C) 2012, Christopher Olah (chris@colah.ca)
|
||||||
-- Copyright (C) 2016, Julia Longtin (julial@turinglace.com)
|
-- Copyright (C) 2016, Julia Longtin (julial@turinglace.com)
|
||||||
-- Released under the GNU AGPLV3+, see LICENSE
|
-- Released under the GNU AGPLV3+, see LICENSE
|
||||||
|
@ -1,3 +1,4 @@
|
|||||||
|
{- ORMOLU_DISABLE -}
|
||||||
-- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca)
|
-- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca)
|
||||||
-- Copyright (C) 2016, Julia Longtin (julial@turinglace.com)
|
-- Copyright (C) 2016, Julia Longtin (julial@turinglace.com)
|
||||||
-- Released under the GNU AGPLV3+, see LICENSE
|
-- Released under the GNU AGPLV3+, see LICENSE
|
||||||
|
@ -1,3 +1,4 @@
|
|||||||
|
{- ORMOLU_DISABLE -}
|
||||||
-- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca)
|
-- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca)
|
||||||
-- Copyright (C) 2016, Julia Longtin (julial@turinglace.com)
|
-- Copyright (C) 2016, Julia Longtin (julial@turinglace.com)
|
||||||
-- Released under the GNU AGPLV3+, see LICENSE
|
-- Released under the GNU AGPLV3+, see LICENSE
|
||||||
|
@ -1,3 +1,4 @@
|
|||||||
|
{- ORMOLU_DISABLE -}
|
||||||
-- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca)
|
-- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca)
|
||||||
-- Copyright (C) 2016, Julia Longtin (julial@turinglace.com)
|
-- Copyright (C) 2016, Julia Longtin (julial@turinglace.com)
|
||||||
-- Released under the GNU AGPLV3+, see LICENSE
|
-- Released under the GNU AGPLV3+, see LICENSE
|
||||||
|
@ -1,3 +1,4 @@
|
|||||||
|
{- ORMOLU_DISABLE -}
|
||||||
-- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca)
|
-- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca)
|
||||||
-- Copyright (C) 2016, Julia Longtin (julial@turinglace.com)
|
-- Copyright (C) 2016, Julia Longtin (julial@turinglace.com)
|
||||||
-- Released under the GNU AGPLV3+, see LICENSE
|
-- Released under the GNU AGPLV3+, see LICENSE
|
||||||
@ -23,7 +24,6 @@ tesselateLoop _ _ [] = []
|
|||||||
|
|
||||||
tesselateLoop _ _ [[a,b],[_,c],[_,_]] = [Tris $ TriangleMesh [Triangle (a,b,c)]]
|
tesselateLoop _ _ [[a,b],[_,c],[_,_]] = [Tris $ TriangleMesh [Triangle (a,b,c)]]
|
||||||
|
|
||||||
|
|
||||||
{-
|
{-
|
||||||
#____# #____#
|
#____# #____#
|
||||||
| | | |
|
| | | |
|
||||||
@ -92,7 +92,6 @@ tesselateLoop res obj pathSides = pure $ Tris $ TriangleMesh $
|
|||||||
then early_tris <> [Triangle (a,b,mid') | (a,b) <- zip path (tail path <> [head path]) ]
|
then early_tris <> [Triangle (a,b,mid') | (a,b) <- zip path (tail path <> [head path]) ]
|
||||||
else early_tris <> [Triangle (a,b,mid) | (a,b) <- zip path (tail path <> [head path]) ]
|
else early_tris <> [Triangle (a,b,mid) | (a,b) <- zip path (tail path <> [head path]) ]
|
||||||
|
|
||||||
|
|
||||||
shrinkLoop :: ℕ -> [ℝ3] -> ℝ -> Obj3 -> ([Triangle], [ℝ3])
|
shrinkLoop :: ℕ -> [ℝ3] -> ℝ -> Obj3 -> ([Triangle], [ℝ3])
|
||||||
|
|
||||||
shrinkLoop _ path@[a,b,c] res obj =
|
shrinkLoop _ path@[a,b,c] res obj =
|
||||||
|
@ -1,3 +1,4 @@
|
|||||||
|
{- ORMOLU_DISABLE -}
|
||||||
-- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca)
|
-- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca)
|
||||||
-- Copyright (C) 2016 Julia Longtin (julial@turinglace.com)
|
-- Copyright (C) 2016 Julia Longtin (julial@turinglace.com)
|
||||||
-- Released under the GNU AGPLV3+, see LICENSE
|
-- Released under the GNU AGPLV3+, see LICENSE
|
||||||
|
@ -1,3 +1,4 @@
|
|||||||
|
{- ORMOLU_DISABLE -}
|
||||||
-- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca)
|
-- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca)
|
||||||
-- Copyright (C) 2016 Julia Longtin (julial@turinglace.com)
|
-- Copyright (C) 2016 Julia Longtin (julial@turinglace.com)
|
||||||
-- Released under the GNU AGPLV3+, see LICENSE
|
-- Released under the GNU AGPLV3+, see LICENSE
|
||||||
|
@ -1,3 +1,4 @@
|
|||||||
|
{- ORMOLU_DISABLE -}
|
||||||
-- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca)
|
-- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca)
|
||||||
-- Copyright (C) 2016 Julia Longtin (julial@turinglace.com)
|
-- Copyright (C) 2016 Julia Longtin (julial@turinglace.com)
|
||||||
-- Released under the GNU AGPLV3+, see LICENSE
|
-- Released under the GNU AGPLV3+, see LICENSE
|
||||||
@ -54,7 +55,6 @@ call = callToken ("[", "]")
|
|||||||
callNaked :: Builder -> [Builder] -> [Reader a Builder] -> Reader a Builder
|
callNaked :: Builder -> [Builder] -> [Reader a Builder] -> Reader a Builder
|
||||||
callNaked = callToken ("", "")
|
callNaked = callToken ("", "")
|
||||||
|
|
||||||
|
|
||||||
------------------------------------------------------------------------------
|
------------------------------------------------------------------------------
|
||||||
-- | Class which allows us to build the contained objects in 'buildShared'.
|
-- | Class which allows us to build the contained objects in 'buildShared'.
|
||||||
class Build obj where
|
class Build obj where
|
||||||
@ -66,7 +66,6 @@ instance Build SymbolicObj2 where
|
|||||||
instance Build SymbolicObj3 where
|
instance Build SymbolicObj3 where
|
||||||
build = buildS3
|
build = buildS3
|
||||||
|
|
||||||
|
|
||||||
------------------------------------------------------------------------------
|
------------------------------------------------------------------------------
|
||||||
-- | Unpack a dimensionality-polymorphic vector into multiple arguments.
|
-- | Unpack a dimensionality-polymorphic vector into multiple arguments.
|
||||||
vectAsArgs :: VectorStuff vec => vec -> [Builder]
|
vectAsArgs :: VectorStuff vec => vec -> [Builder]
|
||||||
@ -77,7 +76,6 @@ vectAsArgs = fmap bf . elements
|
|||||||
bvect :: VectorStuff vec => vec -> Builder
|
bvect :: VectorStuff vec => vec -> Builder
|
||||||
bvect v = "[" <> fold (intersperse "," $ vectAsArgs v) <> "]"
|
bvect v = "[" <> fold (intersperse "," $ vectAsArgs v) <> "]"
|
||||||
|
|
||||||
|
|
||||||
------------------------------------------------------------------------------
|
------------------------------------------------------------------------------
|
||||||
-- | Build the common combinators.
|
-- | Build the common combinators.
|
||||||
buildShared :: forall obj vec. (Build obj, VectorStuff vec) => SharedObj obj vec -> Reader ℝ Builder
|
buildShared :: forall obj vec. (Build obj, VectorStuff vec) => SharedObj obj vec -> Reader ℝ Builder
|
||||||
@ -120,7 +118,6 @@ buildShared(Shell _ _) = error "cannot provide roundness when exporting openscad
|
|||||||
buildShared(EmbedBoxedObj _) = error "cannot provide roundness when exporting openscad; unsupported in target format."
|
buildShared(EmbedBoxedObj _) = error "cannot provide roundness when exporting openscad; unsupported in target format."
|
||||||
buildShared (WithRounding _ _) = error "cannot provide roundness when exporting openscad; unsupported in target format."
|
buildShared (WithRounding _ _) = error "cannot provide roundness when exporting openscad; unsupported in target format."
|
||||||
|
|
||||||
|
|
||||||
-- | First, the 3D objects.
|
-- | First, the 3D objects.
|
||||||
buildS3 :: SymbolicObj3 -> Reader ℝ Builder
|
buildS3 :: SymbolicObj3 -> Reader ℝ Builder
|
||||||
|
|
||||||
@ -143,7 +140,6 @@ buildS3 (Rotate3 q obj) =
|
|||||||
|
|
||||||
buildS3 (Extrude obj h) = callNaked "linear_extrude" ["height = " <> bf h] [buildS2 obj]
|
buildS3 (Extrude obj h) = callNaked "linear_extrude" ["height = " <> bf h] [buildS2 obj]
|
||||||
|
|
||||||
|
|
||||||
-- FIXME: handle scale, center.
|
-- FIXME: handle scale, center.
|
||||||
buildS3 (ExtrudeM twist scale (Left translate) obj (Left height)) |isScaleID scale && translate == V2 0 0 = do
|
buildS3 (ExtrudeM twist scale (Left translate) obj (Left height)) |isScaleID scale && translate == V2 0 0 = do
|
||||||
res <- ask
|
res <- ask
|
||||||
|
@ -1,3 +1,4 @@
|
|||||||
|
{- ORMOLU_DISABLE -}
|
||||||
-- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca)
|
-- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca)
|
||||||
-- Copyright 2016, Julia Longtin (julial@turinglace.com)
|
-- Copyright 2016, Julia Longtin (julial@turinglace.com)
|
||||||
-- Released under the GNU AGPLV3+, see LICENSE
|
-- Released under the GNU AGPLV3+, see LICENSE
|
||||||
|
@ -1,3 +1,4 @@
|
|||||||
|
{- ORMOLU_DISABLE -}
|
||||||
-- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca)
|
-- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca)
|
||||||
-- Copyright 2016, Julia Longtin (julial@turinglace.com)
|
-- Copyright 2016, Julia Longtin (julial@turinglace.com)
|
||||||
-- Released under the GNU AGPLV3+, see LICENSE
|
-- Released under the GNU AGPLV3+, see LICENSE
|
||||||
|
@ -1,3 +1,4 @@
|
|||||||
|
{- ORMOLU_DISABLE -}
|
||||||
-- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca)
|
-- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca)
|
||||||
-- Copyright 2016, Julia Longtin (julial@turinglace.com)
|
-- Copyright 2016, Julia Longtin (julial@turinglace.com)
|
||||||
-- Released under the GNU AGPLV3+, see LICENSE
|
-- Released under the GNU AGPLV3+, see LICENSE
|
||||||
|
@ -1,3 +1,4 @@
|
|||||||
|
{- ORMOLU_DISABLE -}
|
||||||
-- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca)
|
-- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca)
|
||||||
-- Copyright (C) 2014, 2015, 2016 Julia Longtin (julial@turinglace.com)
|
-- Copyright (C) 2014, 2015, 2016 Julia Longtin (julial@turinglace.com)
|
||||||
-- Released under the GNU AGPLV3+, see LICENSE
|
-- Released under the GNU AGPLV3+, see LICENSE
|
||||||
|
@ -1,3 +1,4 @@
|
|||||||
|
{- ORMOLU_DISABLE -}
|
||||||
-- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca)
|
-- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca)
|
||||||
-- Copyright 2016, Julia Longtin (julial@turinglace.com)
|
-- Copyright 2016, Julia Longtin (julial@turinglace.com)
|
||||||
-- Released under the GNU AGPLV3+, see LICENSE
|
-- Released under the GNU AGPLV3+, see LICENSE
|
||||||
|
@ -1,3 +1,4 @@
|
|||||||
|
{- ORMOLU_DISABLE -}
|
||||||
-- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca)
|
-- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca)
|
||||||
-- Copyright (C) 2014 2015 2016, Julia Longtin (julial@turinglace.com)
|
-- Copyright (C) 2014 2015 2016, Julia Longtin (julial@turinglace.com)
|
||||||
-- Released under the GNU AGPLV3+, see LICENSE
|
-- Released under the GNU AGPLV3+, see LICENSE
|
||||||
|
@ -1,3 +1,4 @@
|
|||||||
|
{- ORMOLU_DISABLE -}
|
||||||
-- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca)
|
-- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca)
|
||||||
-- Copyright (C) 2016, Julia Longtin (julial@turinglace.com)
|
-- Copyright (C) 2016, Julia Longtin (julial@turinglace.com)
|
||||||
-- Released under the GNU AGPLV3+, see LICENSE
|
-- Released under the GNU AGPLV3+, see LICENSE
|
||||||
|
@ -1,3 +1,4 @@
|
|||||||
|
{- ORMOLU_DISABLE -}
|
||||||
-- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca)
|
-- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca)
|
||||||
-- Copyright 2016, Julia Longtin (julial@turinglace.com)
|
-- Copyright 2016, Julia Longtin (julial@turinglace.com)
|
||||||
-- Released under the GNU AGPLV3+, see LICENSE
|
-- Released under the GNU AGPLV3+, see LICENSE
|
||||||
|
@ -1,3 +1,4 @@
|
|||||||
|
{- ORMOLU_DISABLE -}
|
||||||
-- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca)
|
-- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca)
|
||||||
-- Copyright (C) 2016, Julia Longtin (julial@turinglace.com)
|
-- Copyright (C) 2016, Julia Longtin (julial@turinglace.com)
|
||||||
-- Released under the GNU AGPLV3+, see LICENSE
|
-- Released under the GNU AGPLV3+, see LICENSE
|
||||||
|
@ -1,3 +1,4 @@
|
|||||||
|
{- ORMOLU_DISABLE -}
|
||||||
-- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca)
|
-- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca)
|
||||||
-- Copyright (C) 2016, Julia Longtin (julial@turinglace.com)
|
-- Copyright (C) 2016, Julia Longtin (julial@turinglace.com)
|
||||||
-- Released under the GNU AGPLV3+, see LICENSE
|
-- Released under the GNU AGPLV3+, see LICENSE
|
||||||
|
@ -1,3 +1,4 @@
|
|||||||
|
{- ORMOLU_DISABLE -}
|
||||||
-- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca)
|
-- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca)
|
||||||
-- Copyright 2014 2015 2016, Julia Longtin (julial@turinglace.com)
|
-- Copyright 2014 2015 2016, Julia Longtin (julial@turinglace.com)
|
||||||
-- Released under the GNU AGPLV3+, see LICENSE
|
-- Released under the GNU AGPLV3+, see LICENSE
|
||||||
|
@ -1,3 +1,4 @@
|
|||||||
|
{- ORMOLU_DISABLE -}
|
||||||
-- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca)
|
-- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca)
|
||||||
-- Copyright (C) 2014-2019 , Julia Longtin (julial@turinglace.com)
|
-- Copyright (C) 2014-2019 , Julia Longtin (julial@turinglace.com)
|
||||||
-- Copyright (C) 2016, Kelvin Cookshaw (kelvin@cookshaw.com)
|
-- Copyright (C) 2016, Kelvin Cookshaw (kelvin@cookshaw.com)
|
||||||
|
@ -1,9 +1,9 @@
|
|||||||
|
{- ORMOLU_DISABLE -}
|
||||||
-- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca)
|
-- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca)
|
||||||
-- Copyright (C) 2016, Kelvin Cookshaw (kelvin@cookshaw.com)
|
-- Copyright (C) 2016, Kelvin Cookshaw (kelvin@cookshaw.com)
|
||||||
-- Copyright 2014 2015 2016, Julia Longtin (julial@turinglace.com)
|
-- Copyright 2014 2015 2016, Julia Longtin (julial@turinglace.com)
|
||||||
-- Released under the GNU AGPLV3+, see LICENSE
|
-- Released under the GNU AGPLV3+, see LICENSE
|
||||||
|
|
||||||
|
|
||||||
-- Allow us to use string literals for Text
|
-- Allow us to use string literals for Text
|
||||||
{-# LANGUAGE OverloadedStrings #-}
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
|
|
||||||
@ -139,7 +139,6 @@ matchCAT = P.reservedOp lexer "++" >> pure "++"
|
|||||||
matchEXP :: GenParser Char st Char
|
matchEXP :: GenParser Char st Char
|
||||||
matchEXP = P.reservedOp lexer "^" >> pure '^'
|
matchEXP = P.reservedOp lexer "^" >> pure '^'
|
||||||
|
|
||||||
|
|
||||||
-- | match something between two ends.
|
-- | match something between two ends.
|
||||||
surroundedBy :: Char -> GenParser Char st a -> Char -> GenParser Char st a
|
surroundedBy :: Char -> GenParser Char st a -> Char -> GenParser Char st a
|
||||||
surroundedBy leftTok middle rightTok = between (matchTok leftTok) (matchTok rightTok) middle
|
surroundedBy leftTok middle rightTok = between (matchTok leftTok) (matchTok rightTok) middle
|
||||||
|
@ -1,3 +1,4 @@
|
|||||||
|
{- ORMOLU_DISABLE -}
|
||||||
-- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca)
|
-- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca)
|
||||||
-- Copyright 2014 2015 2016, Julia Longtin (julial@turinglace.com)
|
-- Copyright 2014 2015 2016, Julia Longtin (julial@turinglace.com)
|
||||||
-- Released under the GNU AGPLV3+, see LICENSE
|
-- Released under the GNU AGPLV3+, see LICENSE
|
||||||
@ -48,7 +49,6 @@ parseProgram = parse program where
|
|||||||
program :: GenParser Char st [StatementI]
|
program :: GenParser Char st [StatementI]
|
||||||
program = removeNoOps <$> (whiteSpace *> many (computation A1) <* eof)
|
program = removeNoOps <$> (whiteSpace *> many (computation A1) <* eof)
|
||||||
|
|
||||||
|
|
||||||
-- | A computable block of code in our openscad-like programming language.
|
-- | A computable block of code in our openscad-like programming language.
|
||||||
computation :: CompIdx -> GenParser Char st StatementI
|
computation :: CompIdx -> GenParser Char st StatementI
|
||||||
computation A1 =
|
computation A1 =
|
||||||
|
@ -1,3 +1,4 @@
|
|||||||
|
{- ORMOLU_DISABLE -}
|
||||||
-- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca)
|
-- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca)
|
||||||
-- Copyright (C) 2016 Julia Longtin (julial@turinglace.com)
|
-- Copyright (C) 2016 Julia Longtin (julial@turinglace.com)
|
||||||
-- Released under the GNU AGPLV3+, see LICENSE
|
-- Released under the GNU AGPLV3+, see LICENSE
|
||||||
|
@ -1,3 +1,4 @@
|
|||||||
|
{- ORMOLU_DISABLE -}
|
||||||
-- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca)
|
-- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca)
|
||||||
-- Copyright 2016, Julia Longtin (julial@turinglace.com)
|
-- Copyright 2016, Julia Longtin (julial@turinglace.com)
|
||||||
-- Released under the GNU AGPLV3+, see LICENSE
|
-- Released under the GNU AGPLV3+, see LICENSE
|
||||||
@ -227,7 +228,6 @@ cylinder = moduleWithoutSuite "cylinder" $ \_ _ -> do
|
|||||||
`doc` "top diameter; overrides d"
|
`doc` "top diameter; overrides d"
|
||||||
pure (diameter/2, diameter1/2, diameter2/2)
|
pure (diameter/2, diameter1/2, diameter2/2)
|
||||||
|
|
||||||
|
|
||||||
h :: Either ℝ ℝ2 <- argument "h"
|
h :: Either ℝ ℝ2 <- argument "h"
|
||||||
`defaultTo` Left 1
|
`defaultTo` Left 1
|
||||||
`doc` "height of cylinder"
|
`doc` "height of cylinder"
|
||||||
@ -485,7 +485,6 @@ rotateExtrude = moduleWithSuite "rotate_extrude" $ \_ children -> do
|
|||||||
. rotateExtrudeDegrees totalRot translateArg rotateArg
|
. rotateExtrudeDegrees totalRot translateArg rotateArg
|
||||||
) children
|
) children
|
||||||
|
|
||||||
|
|
||||||
-- | Like 'Prim.rotateExtrude', but operates in degrees instead of radians.
|
-- | Like 'Prim.rotateExtrude', but operates in degrees instead of radians.
|
||||||
-- This is a shim for scad, which expects this function to operate in degrees.
|
-- This is a shim for scad, which expects this function to operate in degrees.
|
||||||
rotateExtrudeDegrees
|
rotateExtrudeDegrees
|
||||||
|
@ -1,3 +1,4 @@
|
|||||||
|
{- ORMOLU_DISABLE -}
|
||||||
-- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca)
|
-- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca)
|
||||||
-- Copyright (C) 2016, Julia Longtin (julial@turinglace.com)
|
-- Copyright (C) 2016, Julia Longtin (julial@turinglace.com)
|
||||||
-- Released under the GNU AGPLV3+, see LICENSE
|
-- Released under the GNU AGPLV3+, see LICENSE
|
||||||
|
@ -1,3 +1,4 @@
|
|||||||
|
{- ORMOLU_DISABLE -}
|
||||||
-- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca)
|
-- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca)
|
||||||
-- Copyright (C) 2014 2015, Julia Longtin (julial@turinglace.com)
|
-- Copyright (C) 2014 2015, Julia Longtin (julial@turinglace.com)
|
||||||
-- Released under the GNU AGPLV3+, see LICENSE
|
-- Released under the GNU AGPLV3+, see LICENSE
|
||||||
|
@ -1,3 +1,4 @@
|
|||||||
|
{- ORMOLU_DISABLE -}
|
||||||
-- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca)
|
-- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca)
|
||||||
-- Copyright 2016, Julia Longtin (julial@turinglace.com)
|
-- Copyright 2016, Julia Longtin (julial@turinglace.com)
|
||||||
-- Released under the GNU AGPLV3+, see LICENSE
|
-- Released under the GNU AGPLV3+, see LICENSE
|
||||||
|
@ -1,3 +1,4 @@
|
|||||||
|
{- ORMOLU_DISABLE -}
|
||||||
-- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca)
|
-- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca)
|
||||||
-- Copyright 2014-2019, Julia Longtin (julial@turinglace.com)
|
-- Copyright 2014-2019, Julia Longtin (julial@turinglace.com)
|
||||||
-- Released under the GNU AGPLV3+, see LICENSE
|
-- Released under the GNU AGPLV3+, see LICENSE
|
||||||
|
@ -1,3 +1,4 @@
|
|||||||
|
{- ORMOLU_DISABLE -}
|
||||||
-- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca)
|
-- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca)
|
||||||
-- Copyright 2014-2019, Julia Longtin (julial@turinglace.com)
|
-- Copyright 2014-2019, Julia Longtin (julial@turinglace.com)
|
||||||
-- Released under the GNU AGPLV3+, see LICENSE
|
-- Released under the GNU AGPLV3+, see LICENSE
|
||||||
|
@ -1,3 +1,4 @@
|
|||||||
|
{- ORMOLU_DISABLE -}
|
||||||
-- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca)
|
-- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca)
|
||||||
-- Copyright (C) 2014 2015 2016, Julia Longtin (julial@turinglace.com)
|
-- Copyright (C) 2014 2015 2016, Julia Longtin (julial@turinglace.com)
|
||||||
-- Released under the GNU AGPLV3+, see LICENSE
|
-- Released under the GNU AGPLV3+, see LICENSE
|
||||||
@ -133,7 +134,6 @@ pack (dx, dy) sep objs = packSome sortedObjs (dx, dy)
|
|||||||
tmap2 (presObj:) $ packSome otherBoxedObjs box
|
tmap2 (presObj:) $ packSome otherBoxedObjs box
|
||||||
packSome [] _ = ([], [])
|
packSome [] _ = ([], [])
|
||||||
|
|
||||||
|
|
||||||
-- | Reflect a vector across a hyperplane defined by its normal vector.
|
-- | Reflect a vector across a hyperplane defined by its normal vector.
|
||||||
--
|
--
|
||||||
-- From https://en.wikipedia.org/wiki/Reflection_(mathematics)#Reflection_through_a_hyperplane_in_n_dimensions
|
-- From https://en.wikipedia.org/wiki/Reflection_(mathematics)#Reflection_through_a_hyperplane_in_n_dimensions
|
||||||
|
@ -1,3 +1,4 @@
|
|||||||
|
{- ORMOLU_DISABLE -}
|
||||||
-- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca)
|
-- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca)
|
||||||
-- Copyright (C) 2014 2015 2016, Julia Longtin (julial@turinglace.com)
|
-- Copyright (C) 2014 2015 2016, Julia Longtin (julial@turinglace.com)
|
||||||
-- Released under the GNU AGPLV3+, see LICENSE
|
-- Released under the GNU AGPLV3+, see LICENSE
|
||||||
|
@ -1,3 +1,4 @@
|
|||||||
|
{- ORMOLU_DISABLE -}
|
||||||
-- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca)
|
-- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca)
|
||||||
-- Copyright 2016, Julia Longtin (julial@turinglace.com)
|
-- Copyright 2016, Julia Longtin (julial@turinglace.com)
|
||||||
-- Released under the GNU AGPLV3+, see LICENSE
|
-- Released under the GNU AGPLV3+, see LICENSE
|
||||||
@ -21,7 +22,6 @@ import Graphics.Implicit.ObjectUtil.GetBoxShared (emptyBox, corners, outsetBox,
|
|||||||
-- To construct vectors of ℝs.
|
-- To construct vectors of ℝs.
|
||||||
import Linear (V2(V2))
|
import Linear (V2(V2))
|
||||||
|
|
||||||
|
|
||||||
-- Get a Box2 around the given object.
|
-- Get a Box2 around the given object.
|
||||||
getBox2 :: SymbolicObj2 -> Box2
|
getBox2 :: SymbolicObj2 -> Box2
|
||||||
-- Primitives
|
-- Primitives
|
||||||
@ -35,7 +35,6 @@ getBox2 (Rotate2 θ symbObj) =
|
|||||||
in pointsBox $ fmap rotate $ corners $ getBox2 symbObj
|
in pointsBox $ fmap rotate $ corners $ getBox2 symbObj
|
||||||
getBox2 (Shared2 obj) = getBoxShared obj
|
getBox2 (Shared2 obj) = getBoxShared obj
|
||||||
|
|
||||||
|
|
||||||
-- | Define a Box2 around the given object, and the space it occupies while rotating about the center point.
|
-- | Define a Box2 around the given object, and the space it occupies while rotating about the center point.
|
||||||
-- Note: No implementations for Square, Translate2, or Scale2 as they would be identical to the fallthrough.
|
-- Note: No implementations for Square, Translate2, or Scale2 as they would be identical to the fallthrough.
|
||||||
getBox2R :: SymbolicObj2 -> ℝ -> Box2
|
getBox2R :: SymbolicObj2 -> ℝ -> Box2
|
||||||
|
@ -1,3 +1,4 @@
|
|||||||
|
{- ORMOLU_DISABLE -}
|
||||||
-- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca)
|
-- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca)
|
||||||
-- Copyright 2014 2015 2016, Julia Longtin (julial@turinglace.com)
|
-- Copyright 2014 2015 2016, Julia Longtin (julial@turinglace.com)
|
||||||
-- Copyright 2015 2016, Mike MacHenry (mike.machenry@gmail.com)
|
-- Copyright 2015 2016, Mike MacHenry (mike.machenry@gmail.com)
|
||||||
@ -145,7 +146,6 @@ getBox3 (RotateExtrude rot (Right f) rotate symbObj) =
|
|||||||
in
|
in
|
||||||
(V3 (-r) (-r) $ y1 + ymin', V3 r r $ y2 + ymax')
|
(V3 (-r) (-r) $ y1 + ymin', V3 r r $ y2 + ymax')
|
||||||
|
|
||||||
|
|
||||||
unpack :: V2 a -> (a, a)
|
unpack :: V2 a -> (a, a)
|
||||||
unpack (V2 a b) = (a, b)
|
unpack (V2 a b) = (a, b)
|
||||||
|
|
||||||
|
@ -1,3 +1,4 @@
|
|||||||
|
{- ORMOLU_DISABLE -}
|
||||||
-- Copyright 2014 2015 2016, Julia Longtin (julial@turinglace.com)
|
-- Copyright 2014 2015 2016, Julia Longtin (julial@turinglace.com)
|
||||||
-- Copyright 2015 2016, Mike MacHenry (mike.machenry@gmail.com)
|
-- Copyright 2015 2016, Mike MacHenry (mike.machenry@gmail.com)
|
||||||
-- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca)
|
-- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca)
|
||||||
@ -19,7 +20,6 @@ import Linear (Metric, V2(V2), V3(V3))
|
|||||||
import Data.Foldable (Foldable(toList))
|
import Data.Foldable (Foldable(toList))
|
||||||
import Control.Applicative (Applicative(liftA2))
|
import Control.Applicative (Applicative(liftA2))
|
||||||
|
|
||||||
|
|
||||||
------------------------------------------------------------------------------
|
------------------------------------------------------------------------------
|
||||||
-- | Ad-hoc methods we need to share code between 2D and 3D. With the exception
|
-- | Ad-hoc methods we need to share code between 2D and 3D. With the exception
|
||||||
-- of 'corners', these are actually all standard methods of other classes,
|
-- of 'corners', these are actually all standard methods of other classes,
|
||||||
@ -37,7 +37,6 @@ class VectorStuff vec where
|
|||||||
-- | Given a bounding box, produce the points at each corner.
|
-- | Given a bounding box, produce the points at each corner.
|
||||||
corners :: (vec, vec) -> [vec]
|
corners :: (vec, vec) -> [vec]
|
||||||
|
|
||||||
|
|
||||||
instance VectorStuff ℝ2 where
|
instance VectorStuff ℝ2 where
|
||||||
uniformV = pure
|
uniformV = pure
|
||||||
corners (p1@(V2 x1 y1), p2@(V2 x2 y2)) =
|
corners (p1@(V2 x1 y1), p2@(V2 x2 y2)) =
|
||||||
@ -72,7 +71,6 @@ instance VectorStuff ℝ3 where
|
|||||||
{-# INLINABLE elements #-}
|
{-# INLINABLE elements #-}
|
||||||
{-# INLINABLE corners #-}
|
{-# INLINABLE corners #-}
|
||||||
|
|
||||||
|
|
||||||
------------------------------------------------------------------------------
|
------------------------------------------------------------------------------
|
||||||
-- | Compute the intersection of dimensionality-polymorphic bounding boxes.
|
-- | Compute the intersection of dimensionality-polymorphic bounding boxes.
|
||||||
intersectBoxes
|
intersectBoxes
|
||||||
@ -94,7 +92,6 @@ biapp
|
|||||||
biapp f g (a1, b1) (a2, b2) = (f a1 a2, g b1 b2)
|
biapp f g (a1, b1) (a2, b2) = (f a1 a2, g b1 b2)
|
||||||
{-# INLINABLE biapp #-}
|
{-# INLINABLE biapp #-}
|
||||||
|
|
||||||
|
|
||||||
-- | An empty box.
|
-- | An empty box.
|
||||||
emptyBox :: (Applicative f, Num a) => (f a, f a)
|
emptyBox :: (Applicative f, Num a) => (f a, f a)
|
||||||
emptyBox = (pure 0, pure 0)
|
emptyBox = (pure 0, pure 0)
|
||||||
@ -110,7 +107,6 @@ pointsBox :: (Applicative f, Num a, VectorStuff (f a)) => [f a] -> (f a, f a)
|
|||||||
pointsBox [] = emptyBox
|
pointsBox [] = emptyBox
|
||||||
pointsBox (a : as) = (foldr (pointwise min) a as, foldr (pointwise max) a as)
|
pointsBox (a : as) = (foldr (pointwise min) a as, foldr (pointwise max) a as)
|
||||||
|
|
||||||
|
|
||||||
------------------------------------------------------------------------------
|
------------------------------------------------------------------------------
|
||||||
-- | Compute the intersection of dimensionality-polymorphic bounding boxes.
|
-- | Compute the intersection of dimensionality-polymorphic bounding boxes.
|
||||||
unionBoxes :: (VectorStuff (f a), Applicative f, Eq (f a), Num a, Num (f a)) => ℝ -> [(f a, f a)] -> (f a, f a)
|
unionBoxes :: (VectorStuff (f a), Applicative f, Eq (f a), Num a, Num (f a)) => ℝ -> [(f a, f a)] -> (f a, f a)
|
||||||
|
@ -1,3 +1,4 @@
|
|||||||
|
{- ORMOLU_DISABLE -}
|
||||||
-- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca)
|
-- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca)
|
||||||
-- Copyright (C) 2016, Julia Longtin (julial@turinglace.com)
|
-- Copyright (C) 2016, Julia Longtin (julial@turinglace.com)
|
||||||
-- Released under the GNU AGPLV3+, see LICENSE
|
-- Released under the GNU AGPLV3+, see LICENSE
|
||||||
@ -19,8 +20,6 @@ import Data.List (nub)
|
|||||||
import Graphics.Implicit.ObjectUtil.GetImplicitShared (getImplicitShared)
|
import Graphics.Implicit.ObjectUtil.GetImplicitShared (getImplicitShared)
|
||||||
import Linear (V2(V2))
|
import Linear (V2(V2))
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
------------------------------------------------------------------------------
|
------------------------------------------------------------------------------
|
||||||
-- | Filter out equal consecutive elements in the list. This function will
|
-- | Filter out equal consecutive elements in the list. This function will
|
||||||
-- additionally trim the last element of the list if it's equal to the first.
|
-- additionally trim the last element of the list if it's equal to the first.
|
||||||
@ -30,7 +29,6 @@ scanUniqueCircular
|
|||||||
. filter (uncurry (/=))
|
. filter (uncurry (/=))
|
||||||
. circularPairs
|
. circularPairs
|
||||||
|
|
||||||
|
|
||||||
------------------------------------------------------------------------------
|
------------------------------------------------------------------------------
|
||||||
-- | Given @[a, b, c, ... n]@, return the pairs @[(a, b), (b, c), ... (n, a)]@.
|
-- | Given @[a, b, c, ... n]@, return the pairs @[(a, b), (b, c), ... (n, a)]@.
|
||||||
circularPairs :: [a] -> [(a,a)]
|
circularPairs :: [a] -> [(a,a)]
|
||||||
|
@ -1,3 +1,4 @@
|
|||||||
|
{- ORMOLU_DISABLE -}
|
||||||
-- Copyright 2014 2015 2016, Julia Longtin (julial@turinglace.com)
|
-- Copyright 2014 2015 2016, Julia Longtin (julial@turinglace.com)
|
||||||
-- Copyright 2015 2016, Mike MacHenry (mike.machenry@gmail.com)
|
-- Copyright 2015 2016, Mike MacHenry (mike.machenry@gmail.com)
|
||||||
-- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca)
|
-- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca)
|
||||||
|
@ -1,3 +1,4 @@
|
|||||||
|
{- ORMOLU_DISABLE -}
|
||||||
-- Copyright 2014 2015 2016, Julia Longtin (julial@turinglace.com)
|
-- Copyright 2014 2015 2016, Julia Longtin (julial@turinglace.com)
|
||||||
-- Copyright 2015 2016, Mike MacHenry (mike.machenry@gmail.com)
|
-- Copyright 2015 2016, Mike MacHenry (mike.machenry@gmail.com)
|
||||||
-- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca)
|
-- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca)
|
||||||
@ -23,7 +24,6 @@ import Graphics.Implicit.ObjectUtil.GetBoxShared (VectorStuff(elements, uniformV
|
|||||||
|
|
||||||
import Linear (Metric(dot))
|
import Linear (Metric(dot))
|
||||||
|
|
||||||
|
|
||||||
------------------------------------------------------------------------------
|
------------------------------------------------------------------------------
|
||||||
-- | Normalize a dimensionality-polymorphic vector.
|
-- | Normalize a dimensionality-polymorphic vector.
|
||||||
normalize
|
normalize
|
||||||
@ -35,7 +35,6 @@ normalize v =
|
|||||||
let all1s = uniformV @(f ℝ) 1
|
let all1s = uniformV @(f ℝ) 1
|
||||||
in abs (product (elements v)) ** (1 / (all1s `dot` all1s))
|
in abs (product (elements v)) ** (1 / (all1s `dot` all1s))
|
||||||
|
|
||||||
|
|
||||||
-- Get a function that describes the surface of the object.
|
-- Get a function that describes the surface of the object.
|
||||||
getImplicitShared
|
getImplicitShared
|
||||||
:: forall obj f
|
:: forall obj f
|
||||||
|
@ -1,3 +1,4 @@
|
|||||||
|
{- ORMOLU_DISABLE -}
|
||||||
-- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca)
|
-- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca)
|
||||||
-- Copyright (C) 2014 2015 2016, Julia Longtin (julial@turinglace.com)
|
-- Copyright (C) 2014 2015 2016, Julia Longtin (julial@turinglace.com)
|
||||||
-- Released under the GNU AGPLV3+, see LICENSE
|
-- Released under the GNU AGPLV3+, see LICENSE
|
||||||
@ -116,7 +117,6 @@ cube
|
|||||||
cube False size = Cube size
|
cube False size = Cube size
|
||||||
cube True size = translate (fmap (negate . (/ 2)) size) $ Cube size
|
cube True size = translate (fmap (negate . (/ 2)) size) $ Cube size
|
||||||
|
|
||||||
|
|
||||||
-- | A conical frustum --- ie. a cylinder with different radii at either end.
|
-- | A conical frustum --- ie. a cylinder with different radii at either end.
|
||||||
cylinder2 ::
|
cylinder2 ::
|
||||||
ℝ -- ^ Radius of the cylinder
|
ℝ -- ^ Radius of the cylinder
|
||||||
@ -205,7 +205,6 @@ pattern Shared v <- (preview _Shared -> Just v)
|
|||||||
where
|
where
|
||||||
Shared v = _Shared # v
|
Shared v = _Shared # v
|
||||||
|
|
||||||
|
|
||||||
-- | Translate an object by a vector of appropriate dimension.
|
-- | Translate an object by a vector of appropriate dimension.
|
||||||
translate
|
translate
|
||||||
:: Object obj vec
|
:: Object obj vec
|
||||||
@ -332,7 +331,6 @@ implicit
|
|||||||
-> obj -- ^ Resulting object
|
-> obj -- ^ Resulting object
|
||||||
implicit a b = Shared $ EmbedBoxedObj (a, b)
|
implicit a b = Shared $ EmbedBoxedObj (a, b)
|
||||||
|
|
||||||
|
|
||||||
instance Object SymbolicObj2 ℝ2 where
|
instance Object SymbolicObj2 ℝ2 where
|
||||||
_Shared = prism' Shared2 $ \case
|
_Shared = prism' Shared2 $ \case
|
||||||
Shared2 x -> Just x
|
Shared2 x -> Just x
|
||||||
@ -347,7 +345,6 @@ instance Object SymbolicObj3 ℝ3 where
|
|||||||
getBox = getBox3
|
getBox = getBox3
|
||||||
getImplicit' = getImplicit3
|
getImplicit' = getImplicit3
|
||||||
|
|
||||||
|
|
||||||
union :: Object obj vec => [obj] -> obj
|
union :: Object obj vec => [obj] -> obj
|
||||||
union = unionR 0
|
union = unionR 0
|
||||||
|
|
||||||
@ -378,7 +375,6 @@ extrudeM
|
|||||||
-> SymbolicObj3
|
-> SymbolicObj3
|
||||||
extrudeM = ExtrudeM
|
extrudeM = ExtrudeM
|
||||||
|
|
||||||
|
|
||||||
rotateExtrude
|
rotateExtrude
|
||||||
:: ℝ -- ^ Angle to sweep to (in rad)
|
:: ℝ -- ^ Angle to sweep to (in rad)
|
||||||
-> Either ℝ2 (ℝ -> ℝ2) -- ^ translate
|
-> Either ℝ2 (ℝ -> ℝ2) -- ^ translate
|
||||||
|
1
Setup.hs
1
Setup.hs
@ -1,3 +1,4 @@
|
|||||||
|
{- ORMOLU_DISABLE -}
|
||||||
import Distribution.Simple
|
import Distribution.Simple
|
||||||
main :: IO ()
|
main :: IO ()
|
||||||
main = defaultMain
|
main = defaultMain
|
||||||
|
92
layout/ormolu.sh
Executable file
92
layout/ormolu.sh
Executable file
@ -0,0 +1,92 @@
|
|||||||
|
#!/usr/bin/env bash
|
||||||
|
|
||||||
|
set -e
|
||||||
|
|
||||||
|
cd "$( dirname "${BASH_SOURCE[0]}" )"
|
||||||
|
|
||||||
|
command -v grep >/dev/null 2>&1 || { echo >&2 "grep is not installed, aborting."; exit 1; }
|
||||||
|
command -v awk >/dev/null 2>&1 || { echo >&2 "awk is not installed, aborting."; exit 1; }
|
||||||
|
command -v sed >/dev/null 2>&1 || { echo >&2 "sed is not installed, aborting."; exit 1; }
|
||||||
|
command -v yq >/dev/null 2>&1 || { echo >&2 "yq is not installed, aborting. See https://github.com/mikefarah/yq"; exit 1; }
|
||||||
|
|
||||||
|
ORMOLU_VERSION=$(cat ormolu.version)
|
||||||
|
( ormolu -v 2>/dev/null | grep -q $ORMOLU_VERSION ) || ( echo "please install ormolu $ORMOLU_VERSION (eg., run 'cabal install ormolu' and ensure ormolu is on your PATH.)"; exit 1 )
|
||||||
|
echo "ormolu version: $ORMOLU_VERSION"
|
||||||
|
|
||||||
|
ARG_ALLOW_DIRTY_WC="0"
|
||||||
|
ARG_ORMOLU_MODE="inplace"
|
||||||
|
|
||||||
|
USAGE="
|
||||||
|
This bash script can either (a) apply ormolu formatting in-place to
|
||||||
|
all haskell modules in your working copy, or (b) check all modules for
|
||||||
|
formatting and fail if ormolu needs to be applied.
|
||||||
|
|
||||||
|
(a) is mostly for migrating from manually-formatted projects to
|
||||||
|
ormolu-formatted ones; (b) can be run in by a continuous integration
|
||||||
|
service to make sure no branches with non-ormolu formatting make get
|
||||||
|
merged.
|
||||||
|
|
||||||
|
For every-day dev work, consider using one of the ormolu editor
|
||||||
|
integrations (see https://github.com/tweag/ormolu#editor-integration).
|
||||||
|
|
||||||
|
USAGE: $0
|
||||||
|
-h: show this help.
|
||||||
|
-f: run even if working copy is dirty. default: ${ARG_ALLOW_DIRTY_WC}
|
||||||
|
-c: set ormolu mode to 'check'. default: 'inplace'
|
||||||
|
|
||||||
|
"
|
||||||
|
|
||||||
|
# Option parsing:
|
||||||
|
# https://sookocheff.com/post/bash/parsing-bash-script-arguments-with-shopts/
|
||||||
|
while getopts ":fch" opt; do
|
||||||
|
case ${opt} in
|
||||||
|
f ) ARG_ALLOW_DIRTY_WC="1"
|
||||||
|
;;
|
||||||
|
c ) ARG_ORMOLU_MODE="check"
|
||||||
|
;;
|
||||||
|
h ) echo "$USAGE" 1>&2
|
||||||
|
exit 0
|
||||||
|
;;
|
||||||
|
esac
|
||||||
|
done
|
||||||
|
shift $((OPTIND -1))
|
||||||
|
|
||||||
|
if [ "$#" -ne 0 ]; then
|
||||||
|
echo "$USAGE" 1>&2
|
||||||
|
exit 1
|
||||||
|
fi
|
||||||
|
|
||||||
|
cd ".."
|
||||||
|
|
||||||
|
if [ "$(git status -s | grep -v \?\?)" != "" ]; then
|
||||||
|
echo "working copy not clean."
|
||||||
|
if [ "$ARG_ALLOW_DIRTY_WC" == "1" ]; then
|
||||||
|
echo "running with -f. this will mix ormolu and other changes."
|
||||||
|
else
|
||||||
|
echo "run with -f if you want to force mixing ormolu and other changes."
|
||||||
|
exit 1
|
||||||
|
fi
|
||||||
|
fi
|
||||||
|
|
||||||
|
echo "ormolu mode: $ARG_ORMOLU_MODE"
|
||||||
|
|
||||||
|
FAILURES=0
|
||||||
|
|
||||||
|
for hsfile in $(git ls-files | grep '\.hsc\?$'); do
|
||||||
|
FAILED=0
|
||||||
|
ormolu --mode $ARG_ORMOLU_MODE --check-idempotence $LANGUAGE_EXTS "$hsfile" || FAILED=1
|
||||||
|
if [ "$FAILED" == "1" ]; then
|
||||||
|
((++FAILURES))
|
||||||
|
echo "$hsfile... *** FAILED"
|
||||||
|
else
|
||||||
|
echo "$hsfile... ok"
|
||||||
|
fi
|
||||||
|
done
|
||||||
|
|
||||||
|
if [ "$FAILURES" != 0 ]; then
|
||||||
|
echo "ormolu failed on $FAILURES files."
|
||||||
|
if [ "$ARG_ORMOLU_MODE" == "check" ]; then
|
||||||
|
echo -en "\n\nyou can fix this by running 'make format' from the git repo root.\n\n"
|
||||||
|
fi
|
||||||
|
exit 1
|
||||||
|
fi
|
1
layout/ormolu.version
Normal file
1
layout/ormolu.version
Normal file
@ -0,0 +1 @@
|
|||||||
|
0.1.4.1
|
125
layout/rebase-onto-formatter.sh
Normal file
125
layout/rebase-onto-formatter.sh
Normal file
@ -0,0 +1,125 @@
|
|||||||
|
#!/usr/bin/env bash
|
||||||
|
|
||||||
|
# written by mheinzel
|
||||||
|
|
||||||
|
set -euo pipefail
|
||||||
|
|
||||||
|
command -v sed >/dev/null 2>&1 || { echo >&2 "sed is not installed, aborting."; exit 1; }
|
||||||
|
|
||||||
|
BASE_COMMIT=${1:-}
|
||||||
|
TARGET_COMMIT=${2:-}
|
||||||
|
FORMATTING_COMMAND='make formatf'
|
||||||
|
USAGE="
|
||||||
|
USAGE: $0 BASE_COMMIT TARGET_COMMIT
|
||||||
|
|
||||||
|
BASE_COMMIT:
|
||||||
|
A commit that contains the changes to formatting version and
|
||||||
|
config already from TARGET_COMMIT, but not the automatically
|
||||||
|
applied formatting changes. Must be the first commit on the
|
||||||
|
branch you are about to rebase (not the one returned by
|
||||||
|
git-merge-base). It will be removed from the resulting branch.
|
||||||
|
TARGET_COMMIT:
|
||||||
|
The commit introducing the formatting that you want to rebase onto.
|
||||||
|
|
||||||
|
Rebase a branch onto changes created by an automated formatter. The script
|
||||||
|
will keep the (linear) history of the branch intact and make the commits appear
|
||||||
|
as if the changes had been applied onto the newly-formatted version all along.
|
||||||
|
|
||||||
|
INSTRUCTIONS:
|
||||||
|
1. Make a copy of your branch (or be prepared to salvage it from reflog).
|
||||||
|
$ git branch mybranch-backup
|
||||||
|
2. Find out what the base commit is.
|
||||||
|
3. Rebase onto the base commit yourself.
|
||||||
|
$ git rebase \$BASE_COMMIT
|
||||||
|
4. Make sure the formatting tool is installed with the correct version and settings.
|
||||||
|
$ stack install ormolu
|
||||||
|
5. Run this script.
|
||||||
|
$ $0 \$BASE_COMMIT \$TARGET_COMMIT
|
||||||
|
|
||||||
|
"
|
||||||
|
|
||||||
|
if [ -z "$BASE_COMMIT" ] || [ -z "$TARGET_COMMIT" ] || [ -z "$FORMATTING_COMMAND" ]
|
||||||
|
then
|
||||||
|
echo "$USAGE" 1>&2
|
||||||
|
exit 1
|
||||||
|
fi
|
||||||
|
|
||||||
|
echo "Running the script now. This might take a while..."
|
||||||
|
|
||||||
|
# The general idea is the following:
|
||||||
|
#
|
||||||
|
# We have a branch consisting of commits C1, C2, ... on top of our BASE_COMMIT C0.
|
||||||
|
# Also, from C0 an automated formatting change f was made on some branch (e.g. develop).
|
||||||
|
#
|
||||||
|
# C0 ----> C1 ----> C2 ----> ... ----> Cn
|
||||||
|
# |
|
||||||
|
# f
|
||||||
|
# |
|
||||||
|
# v
|
||||||
|
# C0'
|
||||||
|
#
|
||||||
|
# Now, how do we obtain versions of our commits operating on the formatted code (let's call them Ci')?
|
||||||
|
#
|
||||||
|
# C0 ----> C1 ----> C2 ----> ... ----> Cn
|
||||||
|
# |
|
||||||
|
# f
|
||||||
|
# |
|
||||||
|
# v
|
||||||
|
# C0' ---> C1' ---> C2' ---> ... ----> Cn'
|
||||||
|
#
|
||||||
|
# One useful thing is that since f is defined by an automated tool,
|
||||||
|
# we know f applied at every commit Ci, resulting in a hypothetical Ci'.
|
||||||
|
#
|
||||||
|
# C0 ----> C1 ----> C2 ----> ... ----> Cn
|
||||||
|
# | | | |
|
||||||
|
# f f f f
|
||||||
|
# | | | |
|
||||||
|
# v v v v
|
||||||
|
# C0' C1' C2' Cn'
|
||||||
|
#
|
||||||
|
# And we can also get its inverse g (applied at Ci') by reverting the commit.
|
||||||
|
#
|
||||||
|
# C0 ----> C1 ----> C2 ----> ... ----> Cn
|
||||||
|
# |^ |^ |^ |^
|
||||||
|
# f| f| f| f|
|
||||||
|
# |g |g |g |g
|
||||||
|
# v| v| v| v|
|
||||||
|
# C0' C1' C2' Cn'
|
||||||
|
#
|
||||||
|
# Finally, we can get from C(i-1)' to Ci' by composing three arrows:
|
||||||
|
# - g at C(i-1)
|
||||||
|
# - Ci
|
||||||
|
# - f at C1
|
||||||
|
#
|
||||||
|
# C0 ----> C1 ----> C2 ----> ... ----> Cn
|
||||||
|
# |^ |^ |^ |^
|
||||||
|
# f| f| f| f|
|
||||||
|
# |g |g |g |g
|
||||||
|
# v| v| v| v|
|
||||||
|
# C0' ---> C1' ---> C2' ---> ... ----> Cn'
|
||||||
|
|
||||||
|
set -x
|
||||||
|
|
||||||
|
# edit every commit Ci, adding new commits representing f at Ci and it's inverse g
|
||||||
|
git rebase $BASE_COMMIT~1 --exec "$FORMATTING_COMMAND && git commit -am format && git revert HEAD --no-edit"
|
||||||
|
|
||||||
|
# drop last commit (do not revert formatting at the end of the branch)
|
||||||
|
git reset HEAD~1 --hard
|
||||||
|
|
||||||
|
# now for every Ci, squash with the previous and next commit (i.e. g at C(i-1) and f at Ci).
|
||||||
|
# However, we want to use Ci's commit message and author.
|
||||||
|
# To do this, we run the following command after each group of these 3 commits:
|
||||||
|
# Ci=$(git rev-parse HEAD~1); git reset --soft HEAD~3; git commit --reuse-message $Ci
|
||||||
|
# We do an interactive rebase, but instead of editing the commit sequence manually,
|
||||||
|
# we use sed for that, inserting an `exec` command after every 3 commits.
|
||||||
|
GIT_SEQUENCE_EDITOR='sed -i -e "4~3s/^\(pick \S* format\)$/\1\nexec Ci=\$(git rev-parse HEAD~1); git reset --soft HEAD~3; git commit --reuse-message \$Ci/"' \
|
||||||
|
git rebase --interactive $BASE_COMMIT
|
||||||
|
|
||||||
|
# rebase onto TARGET_COMMIT.
|
||||||
|
# Annoyingly, we still have this first "format" commit that should already be
|
||||||
|
# part of the TARGET_COMMIT. So we drop it.
|
||||||
|
GIT_SEQUENCE_EDITOR='sed -i "1s/pick/drop/"' \
|
||||||
|
git rebase --interactive $BASE_COMMIT --onto $TARGET_COMMIT
|
||||||
|
|
||||||
|
echo "Done."
|
||||||
|
echo "Please check that the history looks as it should and all expected commits are there."
|
@ -1,3 +1,4 @@
|
|||||||
|
{- ORMOLU_DISABLE -}
|
||||||
-- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca)
|
-- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca)
|
||||||
-- Copyright (C) 2014 2015 2016, Julia Longtin (julial@turinglace.com)
|
-- Copyright (C) 2014 2015 2016, Julia Longtin (julial@turinglace.com)
|
||||||
-- Released under the GNU AGPLV3+, see LICENSE
|
-- Released under the GNU AGPLV3+, see LICENSE
|
||||||
|
@ -1,3 +1,4 @@
|
|||||||
|
{- ORMOLU_DISABLE -}
|
||||||
-- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca)
|
-- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca)
|
||||||
-- Released under the GNU GPL, see LICENSE
|
-- Released under the GNU GPL, see LICENSE
|
||||||
|
|
||||||
|
@ -1,3 +1,4 @@
|
|||||||
|
{- ORMOLU_DISABLE -}
|
||||||
-- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca)
|
-- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca)
|
||||||
-- Copyright (C) 2014 2015, Julia Longtin (julial@turinglace.com)
|
-- Copyright (C) 2014 2015, Julia Longtin (julial@turinglace.com)
|
||||||
-- Copyright (C) 2014 2016, Mike MacHenry (mike.machenry@gmail.com)
|
-- Copyright (C) 2014 2016, Mike MacHenry (mike.machenry@gmail.com)
|
||||||
|
@ -1,3 +1,4 @@
|
|||||||
|
{- ORMOLU_DISABLE -}
|
||||||
-- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca)
|
-- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca)
|
||||||
-- Copyright (C) 2014 2015, Julia Longtin (julial@turinglace.com)
|
-- Copyright (C) 2014 2015, Julia Longtin (julial@turinglace.com)
|
||||||
-- Released under the GNU AGPLV3+, see LICENSE
|
-- Released under the GNU AGPLV3+, see LICENSE
|
||||||
@ -236,4 +237,3 @@ executeAndExport content callback maybeFormat =
|
|||||||
([], [] , _) -> callbackF False False 1 $ scadMessages <> "\n" <> "Nothing to render."
|
([], [] , _) -> callbackF False False 1 $ scadMessages <> "\n" <> "Nothing to render."
|
||||||
_ -> callbackF False False 1 $ scadMessages <> "\n" <> "ERROR: File contains a mixture of 2D and 3D objects, what do you want to render?"
|
_ -> callbackF False False 1 $ scadMessages <> "\n" <> "ERROR: File contains a mixture of 2D and 3D objects, what do you want to render?"
|
||||||
|
|
||||||
|
|
||||||
|
@ -1,3 +1,4 @@
|
|||||||
|
{- ORMOLU_DISABLE -}
|
||||||
-- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca)
|
-- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca)
|
||||||
-- Copyright (C) 2016, Kelvin Cookshaw (kelvin@cookshaw.com)
|
-- Copyright (C) 2016, Kelvin Cookshaw (kelvin@cookshaw.com)
|
||||||
-- Copyright 2014-2019, Julia Longtin (julial@turinglace.com)
|
-- Copyright 2014-2019, Julia Longtin (julial@turinglace.com)
|
||||||
|
@ -1,3 +1,4 @@
|
|||||||
|
{- ORMOLU_DISABLE -}
|
||||||
-- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca)
|
-- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca)
|
||||||
-- Copyright (C) 2014-2017, Julia Longtin (julial@turinglace.com)
|
-- Copyright (C) 2014-2017, Julia Longtin (julial@turinglace.com)
|
||||||
-- Released under the GNU AGPLV3+, see LICENSE
|
-- Released under the GNU AGPLV3+, see LICENSE
|
||||||
|
@ -1,3 +1,4 @@
|
|||||||
|
{- ORMOLU_DISABLE -}
|
||||||
-- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca)
|
-- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca)
|
||||||
-- Copyright 2014 2015 2016, Julia Longtin (julial@turinglace.com)
|
-- Copyright 2014 2015 2016, Julia Longtin (julial@turinglace.com)
|
||||||
-- Copyright 2015 2016, Mike MacHenry (mike.machenry@gmail.com)
|
-- Copyright 2015 2016, Mike MacHenry (mike.machenry@gmail.com)
|
||||||
@ -18,7 +19,6 @@ import Graphics.Implicit.Definitions (ℝ)
|
|||||||
-- Expressions, symbols, and values in the OpenScad language.
|
-- Expressions, symbols, and values in the OpenScad language.
|
||||||
import Graphics.Implicit.ExtOpenScad.Definitions (OVal(ONum))
|
import Graphics.Implicit.ExtOpenScad.Definitions (OVal(ONum))
|
||||||
|
|
||||||
|
|
||||||
import Graphics.Implicit.ExtOpenScad.Eval.Constant (runExpr)
|
import Graphics.Implicit.ExtOpenScad.Eval.Constant (runExpr)
|
||||||
|
|
||||||
import Test.Hspec (Expectation, shouldBe)
|
import Test.Hspec (Expectation, shouldBe)
|
||||||
|
@ -1,3 +1,4 @@
|
|||||||
|
{- ORMOLU_DISABLE -}
|
||||||
{-# OPTIONS_GHC -fno-warn-missing-import-lists #-}
|
{-# OPTIONS_GHC -fno-warn-missing-import-lists #-}
|
||||||
{-# OPTIONS_GHC -fno-warn-type-defaults #-}
|
{-# OPTIONS_GHC -fno-warn-type-defaults #-}
|
||||||
|
|
||||||
@ -105,7 +106,6 @@ spec = describe "golden tests" $ do
|
|||||||
])
|
])
|
||||||
]
|
]
|
||||||
|
|
||||||
|
|
||||||
-- These tests were generated by the Arbitrary instance
|
-- These tests were generated by the Arbitrary instance
|
||||||
golden "arbitrary1" 1 $
|
golden "arbitrary1" 1 $
|
||||||
cylinder 16.76324 21.02933
|
cylinder 16.76324 21.02933
|
||||||
|
@ -1,3 +1,4 @@
|
|||||||
|
{- ORMOLU_DISABLE -}
|
||||||
{-# LANGUAGE BangPatterns #-}
|
{-# LANGUAGE BangPatterns #-}
|
||||||
{-# LANGUAGE LambdaCase #-}
|
{-# LANGUAGE LambdaCase #-}
|
||||||
|
|
||||||
@ -10,7 +11,6 @@ import System.Directory (getTemporaryDirectory, doesFileExist)
|
|||||||
import System.IO (hClose, openTempFile)
|
import System.IO (hClose, openTempFile)
|
||||||
import Test.Hspec (it, shouldBe, SpecWith)
|
import Test.Hspec (it, shouldBe, SpecWith)
|
||||||
|
|
||||||
|
|
||||||
------------------------------------------------------------------------------
|
------------------------------------------------------------------------------
|
||||||
-- | Construct a golden test for rendering the given 'SymbolicObj3' at the
|
-- | Construct a golden test for rendering the given 'SymbolicObj3' at the
|
||||||
-- specified resolution. On the first run of this test, it will render the
|
-- specified resolution. On the first run of this test, it will render the
|
||||||
@ -41,7 +41,6 @@ golden name resolution sym = it (name <> " (golden)") $ do
|
|||||||
then pure ()
|
then pure ()
|
||||||
else False `shouldBe` True
|
else False `shouldBe` True
|
||||||
|
|
||||||
|
|
||||||
------------------------------------------------------------------------------
|
------------------------------------------------------------------------------
|
||||||
-- | Get a temporary filepath with the desired extension. On unix systems, this
|
-- | Get a temporary filepath with the desired extension. On unix systems, this
|
||||||
-- is a file under @/tmp@. Useful for tests that need to write files.
|
-- is a file under @/tmp@. Useful for tests that need to write files.
|
||||||
|
@ -1,3 +1,4 @@
|
|||||||
|
{- ORMOLU_DISABLE -}
|
||||||
-- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca)
|
-- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca)
|
||||||
-- Copyright (C) 2014 2015 2016, Julia Longtin (julia.longtin@gmail.com)
|
-- Copyright (C) 2014 2015 2016, Julia Longtin (julia.longtin@gmail.com)
|
||||||
-- Released under the GNU AGPLV3+, see LICENSE
|
-- Released under the GNU AGPLV3+, see LICENSE
|
||||||
@ -81,7 +82,6 @@ instance Arbitrary SymbolicObj2 where
|
|||||||
, pure emptySpace
|
, pure emptySpace
|
||||||
]
|
]
|
||||||
|
|
||||||
|
|
||||||
-- TODO(sandy): Also generate all of the extrusion variants.
|
-- TODO(sandy): Also generate all of the extrusion variants.
|
||||||
instance Arbitrary SymbolicObj3 where
|
instance Arbitrary SymbolicObj3 where
|
||||||
shrink = genericShrink
|
shrink = genericShrink
|
||||||
@ -131,7 +131,6 @@ instance CoArbitrary ℝ2 where
|
|||||||
instance CoArbitrary ℝ3 where
|
instance CoArbitrary ℝ3 where
|
||||||
coarbitrary (V3 a b c) = coarbitrary (a, b, c)
|
coarbitrary (V3 a b c) = coarbitrary (a, b, c)
|
||||||
|
|
||||||
|
|
||||||
instance Arbitrary ExtrudeMScale where
|
instance Arbitrary ExtrudeMScale where
|
||||||
shrink = genericShrink
|
shrink = genericShrink
|
||||||
arbitrary = oneof
|
arbitrary = oneof
|
||||||
@ -140,7 +139,6 @@ instance Arbitrary ExtrudeMScale where
|
|||||||
, Fn <$> arbitrary
|
, Fn <$> arbitrary
|
||||||
]
|
]
|
||||||
|
|
||||||
|
|
||||||
instance Arbitrary (Quaternion ℝ) where
|
instance Arbitrary (Quaternion ℝ) where
|
||||||
arbitrary = do
|
arbitrary = do
|
||||||
q <- arbitrary
|
q <- arbitrary
|
||||||
@ -149,21 +147,18 @@ instance Arbitrary (Quaternion ℝ) where
|
|||||||
then discard
|
then discard
|
||||||
else pure $ axisAngle v q
|
else pure $ axisAngle v q
|
||||||
|
|
||||||
|
|
||||||
------------------------------------------------------------------------------
|
------------------------------------------------------------------------------
|
||||||
-- | Two 'SymbolicObj2's are the same if their 'getImplicit' functions agree at
|
-- | Two 'SymbolicObj2's are the same if their 'getImplicit' functions agree at
|
||||||
-- all points (up to an error term of 'epsilon')
|
-- all points (up to an error term of 'epsilon')
|
||||||
instance Observe (ℝ2, ()) Insidedness SymbolicObj2 where
|
instance Observe (ℝ2, ()) Insidedness SymbolicObj2 where
|
||||||
observe p = insidedness . observe p . getImplicit
|
observe p = insidedness . observe p . getImplicit
|
||||||
|
|
||||||
|
|
||||||
------------------------------------------------------------------------------
|
------------------------------------------------------------------------------
|
||||||
-- | Two 'SymbolicObj3's are the same if their 'getImplicit' functions agree at
|
-- | Two 'SymbolicObj3's are the same if their 'getImplicit' functions agree at
|
||||||
-- all points (up to an error term of 'epsilon')
|
-- all points (up to an error term of 'epsilon')
|
||||||
instance Observe (ℝ3, ()) Insidedness SymbolicObj3 where
|
instance Observe (ℝ3, ()) Insidedness SymbolicObj3 where
|
||||||
observe p = insidedness . observe p . getImplicit
|
observe p = insidedness . observe p . getImplicit
|
||||||
|
|
||||||
|
|
||||||
-- | Generate a small list of 'Arbitrary' elements, splitting the current
|
-- | Generate a small list of 'Arbitrary' elements, splitting the current
|
||||||
-- complexity budget between all of them.
|
-- complexity budget between all of them.
|
||||||
decayedList :: Arbitrary a => Gen [a]
|
decayedList :: Arbitrary a => Gen [a]
|
||||||
|
@ -1,9 +1,9 @@
|
|||||||
|
{- ORMOLU_DISABLE -}
|
||||||
module Graphics.Implicit.Test.Utils where
|
module Graphics.Implicit.Test.Utils where
|
||||||
|
|
||||||
import Prelude (drop, (<*>), (<$>), take, length, pure)
|
import Prelude (drop, (<*>), (<$>), take, length, pure)
|
||||||
import Test.QuickCheck ( choose, Gen )
|
import Test.QuickCheck ( choose, Gen )
|
||||||
|
|
||||||
|
|
||||||
randomGroups :: [a] -> Gen [[a]]
|
randomGroups :: [a] -> Gen [[a]]
|
||||||
randomGroups [] = pure []
|
randomGroups [] = pure []
|
||||||
randomGroups as = do
|
randomGroups as = do
|
||||||
|
@ -1,3 +1,4 @@
|
|||||||
|
{- ORMOLU_DISABLE -}
|
||||||
{-# LANGUAGE ExplicitNamespaces #-}
|
{-# LANGUAGE ExplicitNamespaces #-}
|
||||||
{-# LANGUAGE AllowAmbiguousTypes #-}
|
{-# LANGUAGE AllowAmbiguousTypes #-}
|
||||||
{-# LANGUAGE ConstraintKinds #-}
|
{-# LANGUAGE ConstraintKinds #-}
|
||||||
@ -41,7 +42,6 @@ import Graphics.Implicit (extrude)
|
|||||||
import Graphics.Implicit (cylinder2)
|
import Graphics.Implicit (cylinder2)
|
||||||
import Graphics.Implicit (mirror)
|
import Graphics.Implicit (mirror)
|
||||||
|
|
||||||
|
|
||||||
------------------------------------------------------------------------------
|
------------------------------------------------------------------------------
|
||||||
-- Tests showing equivalencies between algebraic formulations of symbolic
|
-- Tests showing equivalencies between algebraic formulations of symbolic
|
||||||
-- objects, in both 2d and 3d. Equality is observational, based on random
|
-- objects, in both 2d and 3d. Equality is observational, based on random
|
||||||
@ -67,7 +67,6 @@ spec = do
|
|||||||
rotation3dSpec
|
rotation3dSpec
|
||||||
misc3dSpec
|
misc3dSpec
|
||||||
|
|
||||||
|
|
||||||
------------------------------------------------------------------------------
|
------------------------------------------------------------------------------
|
||||||
-- All the constraints we need in scope to parameterize tests by both 2d and
|
-- All the constraints we need in scope to parameterize tests by both 2d and
|
||||||
-- 3d symbolic objects.
|
-- 3d symbolic objects.
|
||||||
@ -83,7 +82,6 @@ type TestInfrastructure obj vec test outcome =
|
|||||||
, Arbitrary vec
|
, Arbitrary vec
|
||||||
)
|
)
|
||||||
|
|
||||||
|
|
||||||
------------------------------------------------------------------------------
|
------------------------------------------------------------------------------
|
||||||
-- Tests proving that symbolic objects form a monoid.
|
-- Tests proving that symbolic objects form a monoid.
|
||||||
monoidSpec
|
monoidSpec
|
||||||
@ -100,7 +98,6 @@ monoidSpec = describe "monoid laws" $ do
|
|||||||
prop "(a <> b) <> c = a <> (b <> c)" $ \a b (c :: obj) ->
|
prop "(a <> b) <> c = a <> (b <> c)" $ \a b (c :: obj) ->
|
||||||
(a <> b) <> c =~= a <> (b <> c)
|
(a <> b) <> c =~= a <> (b <> c)
|
||||||
|
|
||||||
|
|
||||||
------------------------------------------------------------------------------
|
------------------------------------------------------------------------------
|
||||||
-- Tests showing that 'translate' is a no-op for both 'emptySpace' and
|
-- Tests showing that 'translate' is a no-op for both 'emptySpace' and
|
||||||
-- 'fullSpace'. Additionally, that 'scale' is a no-op on 'emptySpace' (but not
|
-- 'fullSpace'. Additionally, that 'scale' is a no-op on 'emptySpace' (but not
|
||||||
@ -124,7 +121,6 @@ idempotenceSpec = describe "idempotence" $ do
|
|||||||
withRounding r . withRounding r'
|
withRounding r . withRounding r'
|
||||||
=~= withRounding @obj r'
|
=~= withRounding @obj r'
|
||||||
|
|
||||||
|
|
||||||
------------------------------------------------------------------------------
|
------------------------------------------------------------------------------
|
||||||
-- Proofs of the invertability of operations.
|
-- Proofs of the invertability of operations.
|
||||||
inverseSpec
|
inverseSpec
|
||||||
@ -148,7 +144,6 @@ inverseSpec = describe "inverses" $ do
|
|||||||
-- -- scale @obj xyz . scale (invert xyz)
|
-- -- scale @obj xyz . scale (invert xyz)
|
||||||
-- -- =~= id
|
-- -- =~= id
|
||||||
|
|
||||||
|
|
||||||
------------------------------------------------------------------------------
|
------------------------------------------------------------------------------
|
||||||
-- Proofs that 'fullSpace' is an annhilative element with respect to union.
|
-- Proofs that 'fullSpace' is an annhilative element with respect to union.
|
||||||
annihilationSpec
|
annihilationSpec
|
||||||
@ -163,7 +158,6 @@ annihilationSpec = describe "annihilation" $ do
|
|||||||
obj <> fullSpace
|
obj <> fullSpace
|
||||||
=~= fullSpace @obj
|
=~= fullSpace @obj
|
||||||
|
|
||||||
|
|
||||||
------------------------------------------------------------------------------
|
------------------------------------------------------------------------------
|
||||||
-- Misc proofs regarding 2d rotation.
|
-- Misc proofs regarding 2d rotation.
|
||||||
rotation2dSpec :: Spec
|
rotation2dSpec :: Spec
|
||||||
@ -188,7 +182,6 @@ rotation2dSpec = describe "2d rotation" $ do
|
|||||||
rotate rads emptySpace
|
rotate rads emptySpace
|
||||||
=~= emptySpace
|
=~= emptySpace
|
||||||
|
|
||||||
|
|
||||||
------------------------------------------------------------------------------
|
------------------------------------------------------------------------------
|
||||||
-- Misc proofs regarding 3d rotation.
|
-- Misc proofs regarding 3d rotation.
|
||||||
rotation3dSpec :: Spec
|
rotation3dSpec :: Spec
|
||||||
@ -226,7 +219,6 @@ rotation3dSpec = describe "3d rotation" $ do
|
|||||||
rotate3 xyz emptySpace
|
rotate3 xyz emptySpace
|
||||||
=~= emptySpace
|
=~= emptySpace
|
||||||
|
|
||||||
|
|
||||||
------------------------------------------------------------------------------
|
------------------------------------------------------------------------------
|
||||||
-- Misc tests that make sense only in 3d
|
-- Misc tests that make sense only in 3d
|
||||||
misc3dSpec :: Spec
|
misc3dSpec :: Spec
|
||||||
@ -238,7 +230,6 @@ misc3dSpec = describe "misc 3d tests" $ do
|
|||||||
prop "cylinder with negative height is a flipped cylinder with positive height" $ \r1 r2 h ->
|
prop "cylinder with negative height is a flipped cylinder with positive height" $ \r1 r2 h ->
|
||||||
cylinder2 r1 r2 h =~= mirror (V3 0 0 1) (cylinder2 r1 r2 (-h))
|
cylinder2 r1 r2 h =~= mirror (V3 0 0 1) (cylinder2 r1 r2 (-h))
|
||||||
|
|
||||||
|
|
||||||
------------------------------------------------------------------------------
|
------------------------------------------------------------------------------
|
||||||
-- Misc identity proofs that should hold for all symbolic objects.
|
-- Misc identity proofs that should hold for all symbolic objects.
|
||||||
identitySpec
|
identitySpec
|
||||||
@ -269,7 +260,6 @@ identitySpec = describe "identity" $ do
|
|||||||
prop "union [a] = a" $ \obj ->
|
prop "union [a] = a" $ \obj ->
|
||||||
union @obj [obj] =~= obj
|
union @obj [obj] =~= obj
|
||||||
|
|
||||||
|
|
||||||
------------------------------------------------------------------------------
|
------------------------------------------------------------------------------
|
||||||
-- Functions proving symbolic objects form homomorphisms with respect to
|
-- Functions proving symbolic objects form homomorphisms with respect to
|
||||||
-- translate and scale.
|
-- translate and scale.
|
||||||
@ -298,7 +288,6 @@ homomorphismSpec = describe "homomorphism" $ do
|
|||||||
withRounding @obj r_obj . intersectR r_combo
|
withRounding @obj r_obj . intersectR r_combo
|
||||||
=~= intersectR r_combo . fmap (withRounding r_obj)
|
=~= intersectR r_combo . fmap (withRounding r_obj)
|
||||||
|
|
||||||
|
|
||||||
------------------------------------------------------------------------------
|
------------------------------------------------------------------------------
|
||||||
-- | Like 'prop', but for tests that are currently expected to fail.
|
-- | Like 'prop', but for tests that are currently expected to fail.
|
||||||
failingProp :: Testable prop => String -> prop -> SpecWith ()
|
failingProp :: Testable prop => String -> prop -> SpecWith ()
|
||||||
|
@ -1,3 +1,4 @@
|
|||||||
|
{- ORMOLU_DISABLE -}
|
||||||
-- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca)
|
-- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca)
|
||||||
-- Copyright (C) 2018, Julia Longtin (julial@turinglace.com)
|
-- Copyright (C) 2018, Julia Longtin (julial@turinglace.com)
|
||||||
-- Released under the GNU AGPLV3+, see LICENSE
|
-- Released under the GNU AGPLV3+, see LICENSE
|
||||||
|
@ -1,3 +1,4 @@
|
|||||||
|
{- ORMOLU_DISABLE -}
|
||||||
-- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca)
|
-- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca)
|
||||||
-- Copyright (C) 2014-2017, Julia Longtin (julial@turinglace.com)
|
-- Copyright (C) 2014-2017, Julia Longtin (julial@turinglace.com)
|
||||||
-- Released under the GNU AGPLV3+, see LICENSE
|
-- Released under the GNU AGPLV3+, see LICENSE
|
||||||
|
@ -1,3 +1,4 @@
|
|||||||
|
{- ORMOLU_DISABLE -}
|
||||||
-- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca)
|
-- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca)
|
||||||
-- Copyright 2014 2015 2016, Julia Longtin (julial@turinglace.com)
|
-- Copyright 2014 2015 2016, Julia Longtin (julial@turinglace.com)
|
||||||
-- Copyright 2015 2016, Mike MacHenry (mike.machenry@gmail.com)
|
-- Copyright 2015 2016, Mike MacHenry (mike.machenry@gmail.com)
|
||||||
|
@ -1,3 +1,4 @@
|
|||||||
|
{- ORMOLU_DISABLE -}
|
||||||
-- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca)
|
-- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca)
|
||||||
-- Copyright (C) 2014-2017, Julia Longtin (julial@turinglace.com)
|
-- Copyright (C) 2014-2017, Julia Longtin (julial@turinglace.com)
|
||||||
-- Released under the GNU AGPLV3+, see LICENSE
|
-- Released under the GNU AGPLV3+, see LICENSE
|
||||||
|
@ -1,3 +1,4 @@
|
|||||||
|
{- ORMOLU_DISABLE -}
|
||||||
-- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca)
|
-- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca)
|
||||||
-- Copyright (C) 2014-2017, Julia Longtin (julial@turinglace.com)
|
-- Copyright (C) 2014-2017, Julia Longtin (julial@turinglace.com)
|
||||||
-- Released under the GNU AGPLV3+, see LICENSE
|
-- Released under the GNU AGPLV3+, see LICENSE
|
||||||
|
@ -1,3 +1,4 @@
|
|||||||
|
{- ORMOLU_DISABLE -}
|
||||||
-- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca)
|
-- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca)
|
||||||
-- Copyright 2014 2015 2016, Julia Longtin (julial@turinglace.com)
|
-- Copyright 2014 2015 2016, Julia Longtin (julial@turinglace.com)
|
||||||
-- Copyright 2015 2016, Mike MacHenry (mike.machenry@gmail.com)
|
-- Copyright 2015 2016, Mike MacHenry (mike.machenry@gmail.com)
|
||||||
|
@ -1,3 +1,4 @@
|
|||||||
|
{- ORMOLU_DISABLE -}
|
||||||
module PropertySpec
|
module PropertySpec
|
||||||
( propSpec
|
( propSpec
|
||||||
) where
|
) where
|
||||||
@ -5,7 +6,7 @@ module PropertySpec
|
|||||||
import Test.Hspec (Spec)
|
import Test.Hspec (Spec)
|
||||||
import PropertySpec.Exec (additionSpec, subtractionSpec, multiplicationSpec, divisionSpec)
|
import PropertySpec.Exec (additionSpec, subtractionSpec, multiplicationSpec, divisionSpec)
|
||||||
|
|
||||||
propSpec :: Spec
|
propSpec :: Spec
|
||||||
propSpec = do
|
propSpec = do
|
||||||
additionSpec
|
additionSpec
|
||||||
subtractionSpec
|
subtractionSpec
|
||||||
|
@ -1,3 +1,4 @@
|
|||||||
|
{- ORMOLU_DISABLE -}
|
||||||
module PropertySpec.Exec
|
module PropertySpec.Exec
|
||||||
( additionSpec
|
( additionSpec
|
||||||
, subtractionSpec
|
, subtractionSpec
|
||||||
@ -33,7 +34,7 @@ instance Show Op where
|
|||||||
show Mul = "*"
|
show Mul = "*"
|
||||||
show Div = "/"
|
show Div = "/"
|
||||||
|
|
||||||
opName :: Op -> String
|
opName :: Op -> String
|
||||||
opName Add = "addition"
|
opName Add = "addition"
|
||||||
opName Sub = "subttraction"
|
opName Sub = "subttraction"
|
||||||
opName Mul = "multiplication"
|
opName Mul = "multiplication"
|
||||||
|
@ -1,3 +1,4 @@
|
|||||||
|
{- ORMOLU_DISABLE -}
|
||||||
{-# LANGUAGE BangPatterns #-}
|
{-# LANGUAGE BangPatterns #-}
|
||||||
{-# LANGUAGE DeriveGeneric #-}
|
{-# LANGUAGE DeriveGeneric #-}
|
||||||
{-# LANGUAGE ImplicitPrelude #-}
|
{-# LANGUAGE ImplicitPrelude #-}
|
||||||
@ -21,7 +22,6 @@ import Graphics.Implicit.Test.Instances ()
|
|||||||
import Control.Monad (join)
|
import Control.Monad (join)
|
||||||
import Control.Lens (Ixed(ix), (&), (.~) )
|
import Control.Lens (Ixed(ix), (&), (.~) )
|
||||||
|
|
||||||
|
|
||||||
spec :: Spec
|
spec :: Spec
|
||||||
spec = do
|
spec = do
|
||||||
describe "getLoops" $ do
|
describe "getLoops" $ do
|
||||||
@ -74,8 +74,6 @@ spec = do
|
|||||||
-- 'fail', but let's make sure they have the same number of segments too.
|
-- 'fail', but let's make sure they have the same number of segments too.
|
||||||
length loop `shouldBe` length loop'
|
length loop `shouldBe` length loop'
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
------------------------------------------------------------------------------
|
------------------------------------------------------------------------------
|
||||||
-- | Show that the given loop exists somewhere in the discovered loops.
|
-- | Show that the given loop exists somewhere in the discovered loops.
|
||||||
-- Correctly deals with the case where the two loops start at different places.
|
-- Correctly deals with the case where the two loops start at different places.
|
||||||
@ -83,7 +81,6 @@ proveLoop :: (Show a, Eq a) => [a] -> [[a]] -> Expectation
|
|||||||
proveLoop v loops =
|
proveLoop v loops =
|
||||||
join (replicate 2 v) `shouldContain` unloop loops
|
join (replicate 2 v) `shouldContain` unloop loops
|
||||||
|
|
||||||
|
|
||||||
------------------------------------------------------------------------------
|
------------------------------------------------------------------------------
|
||||||
-- | Generate a loop and random segments that should produce it. The defining
|
-- | Generate a loop and random segments that should produce it. The defining
|
||||||
-- equation of this generator is tested by "getLoops > loops a loop".
|
-- equation of this generator is tested by "getLoops > loops a loop".
|
||||||
@ -99,7 +96,6 @@ genLoop start = do
|
|||||||
shuffled_segs <- shuffle segs
|
shuffled_segs <- shuffle segs
|
||||||
pure (v, shuffled_segs)
|
pure (v, shuffled_segs)
|
||||||
|
|
||||||
|
|
||||||
------------------------------------------------------------------------------
|
------------------------------------------------------------------------------
|
||||||
-- | Like 'genLoop', but produces several loops, tagged with an index number.
|
-- | Like 'genLoop', but produces several loops, tagged with an index number.
|
||||||
-- For best results, you should call @shuffle . join@ on the resulting segments
|
-- For best results, you should call @shuffle . join@ on the resulting segments
|
||||||
@ -117,21 +113,18 @@ genManyLoops start n = do
|
|||||||
-- and tag it with the index
|
-- and tag it with the index
|
||||||
pure (fmap (idx,) v, fmap (fmap (idx,)) segs)
|
pure (fmap (idx,) v, fmap (fmap (idx,)) segs)
|
||||||
|
|
||||||
|
|
||||||
------------------------------------------------------------------------------
|
------------------------------------------------------------------------------
|
||||||
-- | Given a list of lists, insert elements into the 'head' and 'last' of each
|
-- | Given a list of lists, insert elements into the 'head' and 'last' of each
|
||||||
-- sub-list so that the 'last' of one list is the 'head' of the next.
|
-- sub-list so that the 'last' of one list is the 'head' of the next.
|
||||||
loopify :: [[a]] -> [[a]]
|
loopify :: [[a]] -> [[a]]
|
||||||
loopify as = zipWith (\a -> mappend a . take 1) as $ drop 1 $ join $ repeat as
|
loopify as = zipWith (\a -> mappend a . take 1) as $ drop 1 $ join $ repeat as
|
||||||
|
|
||||||
|
|
||||||
------------------------------------------------------------------------------
|
------------------------------------------------------------------------------
|
||||||
-- | Remove sequential elements in a list. Additionally, this function removes
|
-- | Remove sequential elements in a list. Additionally, this function removes
|
||||||
-- the 'head' of the list, because conceptully it is also the 'last'.
|
-- the 'head' of the list, because conceptully it is also the 'last'.
|
||||||
unloop :: Eq a => [[a]] -> [a]
|
unloop :: Eq a => [[a]] -> [a]
|
||||||
unloop = drop 1 . fmap head . group . join
|
unloop = drop 1 . fmap head . group . join
|
||||||
|
|
||||||
|
|
||||||
------------------------------------------------------------------------------
|
------------------------------------------------------------------------------
|
||||||
-- | Insert an element into the middle (not 'head' or 'last') of a list.
|
-- | Insert an element into the middle (not 'head' or 'last') of a list.
|
||||||
insertMiddle :: [a] -> a -> Gen [a]
|
insertMiddle :: [a] -> a -> Gen [a]
|
||||||
@ -142,7 +135,6 @@ insertMiddle as a = do
|
|||||||
i <- choose (1, n - 1)
|
i <- choose (1, n - 1)
|
||||||
pure $ insertAt i a as
|
pure $ insertAt i a as
|
||||||
|
|
||||||
|
|
||||||
------------------------------------------------------------------------------
|
------------------------------------------------------------------------------
|
||||||
-- | Helper function to insert an element into a list at a given position.
|
-- | Helper function to insert an element into a list at a given position.
|
||||||
--
|
--
|
||||||
|
Loading…
Reference in New Issue
Block a user