Skip to content

Commit

Permalink
Temporary: put guards into getImplicit*
Browse files Browse the repository at this point in the history
Related to Haskell-Things#441

This will get factored out into canonicalization pass
  • Loading branch information
sorki committed Oct 31, 2023
1 parent 19688d7 commit 02983d1
Show file tree
Hide file tree
Showing 4 changed files with 36 additions and 6 deletions.
15 changes: 14 additions & 1 deletion Graphics/Implicit/ObjectUtil/GetImplicit2.hs
Original file line number Diff line number Diff line change
Expand Up @@ -11,7 +11,7 @@ module Graphics.Implicit.ObjectUtil.GetImplicit2 (getImplicit2) where
import Prelude(cycle, (/=), uncurry, fst, Eq, zip, drop, abs, (-), (/), sqrt, (*), (+), length, fmap, (<=), (&&), (>=), (||), odd, ($), (>), filter, (<), minimum, (.), sin, cos)

import Graphics.Implicit.Definitions
( objectRounding, ObjectContext, SymbolicObj2(Square, Circle, Polygon, Rotate2, Transform2, Shared2), SharedObj (Empty), Obj2, ℝ2, )
( objectRounding, ObjectContext, SymbolicObj2(Square, Circle, Polygon, Rotate2, Transform2, Shared2), SharedObj (Empty), Obj2, ℝ2, , hasZeroComponent )

import Graphics.Implicit.MathUtil
( distFromLineSeg, rmaximum )
Expand All @@ -35,10 +35,15 @@ scanUniqueCircular
circularPairs :: [a] -> [(a,a)]
circularPairs as = zip as $ drop 1 $ cycle as

getEmptySpace :: ObjectContext -> V2 ->
getEmptySpace c = getImplicitShared c (Empty :: SharedObj SymbolicObj2 V2 )

getImplicit2 :: ObjectContext -> SymbolicObj2 -> Obj2
-- Primitives
getImplicit2 ctx (Square vec) | hasZeroComponent vec = getEmptySpace ctx
getImplicit2 ctx (Square (V2 dx dy)) =
\(V2 x y) -> rmaximum (objectRounding ctx) [abs (x-dx/2) - dx/2, abs (y-dy/2) - dy/2]
getImplicit2 c (Circle 0) = getEmptySpace c
getImplicit2 _ (Circle r) =
\(V2 x y) -> sqrt (x * x + y * y) - r
-- FIXME: stop ignoring rounding for polygons.
Expand All @@ -65,6 +70,14 @@ getImplicit2 ctx (Rotate2 θ symbObj) =
obj = getImplicit2 ctx symbObj
in
obj $ V2 (x*cos θ + y*sin θ) (y*cos θ - x*sin θ)
-- ignore if zeroes, TODO(srk): produce warning
-- TODO(srk): produce warning and ignore if we get a non-ivertible matrix
getImplicit2 ctx (Transform2
(V3 (V3 x _ _)
(V3 _ y _)
(V3 _ _ _)
)
symbObj) | hasZeroComponent (V2 x y) = getImplicit2 ctx symbObj
getImplicit2 ctx (Transform2 m symbObj) =
\vin ->
let
Expand Down
19 changes: 17 additions & 2 deletions Graphics/Implicit/ObjectUtil/GetImplicit3.hs
Original file line number Diff line number Diff line change
Expand Up @@ -9,28 +9,34 @@ module Graphics.Implicit.ObjectUtil.GetImplicit3 (getImplicit3) where
import Prelude (id, (||), (/=), either, round, fromInteger, Either(Left, Right), abs, (-), (/), (*), sqrt, (+), atan2, max, cos, minimum, ($), sin, pi, (.), Bool(True, False), ceiling, floor, pure, (==), otherwise)

import Graphics.Implicit.Definitions
( objectRounding, ObjectContext, , SymbolicObj3(Cube, Sphere, Cylinder, Rotate3, Transform3, Extrude, ExtrudeM, ExtrudeOnEdgeOf, RotateExtrude, Shared3), Obj3, ℝ2, , fromℕtoℝ, toScaleFn )
( objectRounding, ObjectContext, , SymbolicObj3(Cube, Sphere, Cylinder, Rotate3, Transform3, Extrude, ExtrudeM, ExtrudeOnEdgeOf, RotateExtrude, Shared3), Obj3, ℝ2, , fromℕtoℝ, toScaleFn, SharedObj(Empty), hasZeroComponent )

import Graphics.Implicit.MathUtil ( rmax, rmaximum )

import qualified Data.Either as Either (either)

-- Use getImplicit for handling extrusion of 2D shapes to 3D.
import Graphics.Implicit.ObjectUtil.GetImplicitShared (getImplicitShared)
import Linear (V2(V2), V3(V3))
import Linear (V2(V2), V3(V3), V4(V4))
import qualified Linear

import {-# SOURCE #-} Graphics.Implicit.Primitives (getImplicit)

default ()

getEmptySpace :: ObjectContext -> V3 ->
getEmptySpace c = getImplicitShared c (Empty :: SharedObj SymbolicObj3 V3 )

-- Get a function that describes the surface of the object.
getImplicit3 :: ObjectContext -> SymbolicObj3 -> Obj3
-- Primitives
getImplicit3 ctx (Cube vec) | hasZeroComponent vec = getEmptySpace ctx
getImplicit3 ctx (Cube (V3 dx dy dz)) =
\(V3 x y z) -> rmaximum (objectRounding ctx) [abs (x-dx/2) - dx/2, abs (y-dy/2) - dy/2, abs (z-dz/2) - dz/2]
getImplicit3 c (Sphere 0) = getEmptySpace c
getImplicit3 _ (Sphere r) =
\(V3 x y z) -> sqrt (x*x + y*y + z*z) - r
getImplicit3 c (Cylinder 0 _ _) = getEmptySpace c
getImplicit3 _ (Cylinder h r1 r2) = \(V3 x y z) ->
let
d = sqrt (x*x + y*y) - ((r2-r1)/h*z+r1)
Expand All @@ -40,6 +46,15 @@ getImplicit3 _ (Cylinder h r1 r2) = \(V3 x y z) ->
-- Simple transforms
getImplicit3 ctx (Rotate3 q symbObj) =
getImplicit3 ctx symbObj . Linear.rotate (Linear.conjugate q)
-- ignore if zeroes, TODO(srk): produce warning
-- TODO(srk): produce warning and ignore if we get a non-ivertible matrix
getImplicit3 ctx (Transform3
(V4 (V4 x _ _ _)
(V4 _ y _ _)
(V4 _ _ z _)
(V4 _ _ _ _)
)
symbObj) | hasZeroComponent (V3 x y z) = getImplicit3 ctx symbObj
getImplicit3 ctx (Transform3 m symbObj) =
getImplicit3 ctx symbObj . Linear.normalizePoint . ((Linear.inv44 m) Linear.!*) . Linear.point
-- 2D Based
Expand Down
6 changes: 5 additions & 1 deletion Graphics/Implicit/ObjectUtil/GetImplicitShared.hs
Original file line number Diff line number Diff line change
Expand Up @@ -15,7 +15,7 @@ import {-# SOURCE #-} Graphics.Implicit.Primitives (Object(getImplicit'))
import Prelude (flip, (-), (*), (>), (<), (&&), (/), product, abs, (**), fmap, (.), negate, ($), const)

import Graphics.Implicit.Definitions
( objectRounding, ObjectContext, SharedObj(Empty, Full, Complement, UnionR, IntersectR, DifferenceR, Translate, Scale, Mirror, Shell, Outset, EmbedBoxedObj, WithRounding), ComponentWiseMultable((⋯/)), , minℝ )
( objectRounding, ObjectContext, SharedObj(Empty, Full, Complement, UnionR, IntersectR, DifferenceR, Translate, Scale, Mirror, Shell, Outset, EmbedBoxedObj, WithRounding), ComponentWiseMultable((⋯/)), , minℝ, hasZeroComponent, hasNaNComponent )

import Graphics.Implicit.MathUtil (infty, rmax, rmaximum, rminimum, reflect)

Expand Down Expand Up @@ -75,6 +75,10 @@ getImplicitShared ctx (DifferenceR r symbObj symbObjs) =
-- Simple transforms
getImplicitShared ctx (Translate v symbObj) = \p ->
getImplicit' ctx symbObj (p - v)
-- ignore if zeroes, TODO(srk): produce warning
getImplicitShared ctx (Scale s symbObj) | hasZeroComponent s = getImplicit' ctx symbObj
-- ignore if NaNs, TODO(srk): produce warning
getImplicitShared ctx (Scale s symbObj) | hasNaNComponent s = getImplicit' ctx symbObj
getImplicitShared ctx (Scale s symbObj) = \p ->
normalize s * getImplicit' ctx symbObj (p ⋯/ s)
getImplicitShared ctx (Mirror v symbObj) =
Expand Down
2 changes: 0 additions & 2 deletions Graphics/Implicit/Primitives.hs
Original file line number Diff line number Diff line change
Expand Up @@ -130,8 +130,6 @@ cylinder2 ::
-> -- ^ Second radius of the cylinder
-> -- ^ Height of the cylinder
-> SymbolicObj3 -- ^ Resulting cylinder

cylinder2 _ _ 0 = emptySpace -- necessary to prevent a NaN
cylinder2 r1 r2 h
| h < 0 = mirror (V3 0 0 1) $ cylinder2 r1 r2 (abs h)
| otherwise = Cylinder h r1 r2
Expand Down

0 comments on commit 02983d1

Please sign in to comment.