{- ORMOLU_DISABLE -}
-- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca)
-- Copyright 2016, Julia Longtin (julial@turinglace.com)
-- Released under the GNU AGPLV3+, see LICENSE

-- This file symbolicaly renders contours and contour fillings.
-- If it can't, it passes the puck to a marching-squares-like
-- algorithm...

module Graphics.Implicit.Export.SymbolicObj2 (symbolicGetContour) where

import Prelude((==), pure, fmap, ($), (/), (+), (*), cos, pi, sin, max, ceiling)

import Graphics.Implicit.Definitions (objectRounding, ObjectContext, ℝ, ℝ2, Fastℕ, SymbolicObj2(Square, Circle, Shared2), SharedObj(Translate, Scale, WithRounding), Polyline(Polyline), (⋯*), fromFastℕtoℝ)

import Linear ( V2(V2) )

import Graphics.Implicit.Export.Render (getContour)

symbolicGetContour :: ℝ -> ObjectContext ->  SymbolicObj2 -> [Polyline]
symbolicGetContour :: ℝ -> ObjectContext -> SymbolicObj2 -> [Polyline]
symbolicGetContour ℝ
_ ObjectContext
ctx (Square (V2 ℝ
dx ℝ
dy))
  | ObjectContext -> ℝ
objectRounding ObjectContext
ctx forall a. Eq a => a -> a -> Bool
== ℝ
0 = [[V2 ℝ] -> Polyline
Polyline [forall a. a -> a -> V2 a
V2 ℝ
0 ℝ
0, forall a. a -> a -> V2 a
V2 ℝ
dx ℝ
0, forall a. a -> a -> V2 a
V2 ℝ
dx ℝ
dy, forall a. a -> a -> V2 a
V2 ℝ
0 ℝ
dy, forall a. a -> a -> V2 a
V2 ℝ
0 ℝ
0]]
-- FIXME: magic number.
symbolicGetContour ℝ
res ObjectContext
_ (Circle ℝ
r) =
  [ [V2 ℝ] -> Polyline
Polyline
    [ forall a. a -> a -> V2 a
V2 (ℝ
rforall a. Num a => a -> a -> a
*forall a. Floating a => a -> a
cos(ℝ
2forall a. Num a => a -> a -> a
*forall a. Floating a => a
piforall a. Num a => a -> a -> a
*Fastℕ -> ℝ
fromFastℕtoℝ Fastℕ
mforall a. Fractional a => a -> a -> a
/Fastℕ -> ℝ
fromFastℕtoℝ Fastℕ
n)) (ℝ
rforall a. Num a => a -> a -> a
*forall a. Floating a => a -> a
sin(ℝ
2forall a. Num a => a -> a -> a
*forall a. Floating a => a
piforall a. Num a => a -> a -> a
*Fastℕ -> ℝ
fromFastℕtoℝ Fastℕ
mforall a. Fractional a => a -> a -> a
/Fastℕ -> ℝ
fromFastℕtoℝ Fastℕ
n))
    | Fastℕ
m <- [Fastℕ
0.. Fastℕ
n]
    ]
  ]
  where
    n :: Fastℕ
    n :: Fastℕ
n = forall a. Ord a => a -> a -> a
max Fastℕ
5 forall a b. (a -> b) -> a -> b
$ forall a b. (RealFrac a, Integral b) => a -> b
ceiling forall a b. (a -> b) -> a -> b
$ ℝ
2forall a. Num a => a -> a -> a
*forall a. Floating a => a
piforall a. Num a => a -> a -> a
*ℝ
rforall a. Fractional a => a -> a -> a
/ℝ
res
symbolicGetContour ℝ
res ObjectContext
ctx (Shared2 (WithRounding ℝ
r SymbolicObj2
obj)) = ℝ -> ObjectContext -> SymbolicObj2 -> [Polyline]
symbolicGetContour ℝ
res (ObjectContext
ctx { objectRounding :: ℝ
objectRounding = ℝ
r }) SymbolicObj2
obj
symbolicGetContour ℝ
res ObjectContext
ctx (Shared2 (Translate V2 ℝ
v SymbolicObj2
obj)) = (V2 ℝ -> V2 ℝ) -> [Polyline] -> [Polyline]
appOpPolylines (forall a. Num a => a -> a -> a
+ V2 ℝ
v) forall a b. (a -> b) -> a -> b
$ ℝ -> ObjectContext -> SymbolicObj2 -> [Polyline]
symbolicGetContour ℝ
res ObjectContext
ctx SymbolicObj2
obj
symbolicGetContour ℝ
res ObjectContext
ctx (Shared2 (Scale s :: V2 ℝ
s@(V2 ℝ
a ℝ
b) SymbolicObj2
obj)) = (V2 ℝ -> V2 ℝ) -> [Polyline] -> [Polyline]
appOpPolylines (forall a. ComponentWiseMultable a => a -> a -> a
⋯* V2 ℝ
s) forall a b. (a -> b) -> a -> b
$ ℝ -> ObjectContext -> SymbolicObj2 -> [Polyline]
symbolicGetContour (ℝ
resforall a. Fractional a => a -> a -> a
/ℝ
sc) ObjectContext
ctx SymbolicObj2
obj
    where sc :: ℝ
sc = forall a. Ord a => a -> a -> a
max ℝ
a ℝ
b
symbolicGetContour ℝ
res ObjectContext
_ SymbolicObj2
obj = V2 ℝ -> SymbolicObj2 -> [Polyline]
getContour (forall (f :: * -> *) a. Applicative f => a -> f a
pure ℝ
res) SymbolicObj2
obj

appOpPolylines :: (ℝ2 -> ℝ2) -> [Polyline] -> [Polyline]
appOpPolylines :: (V2 ℝ -> V2 ℝ) -> [Polyline] -> [Polyline]
appOpPolylines V2 ℝ -> V2 ℝ
op = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((V2 ℝ -> V2 ℝ) -> Polyline -> Polyline
appOpPolyline V2 ℝ -> V2 ℝ
op)
appOpPolyline :: (ℝ2 -> ℝ2) -> Polyline -> Polyline
appOpPolyline :: (V2 ℝ -> V2 ℝ) -> Polyline -> Polyline
appOpPolyline V2 ℝ -> V2 ℝ
op (Polyline [V2 ℝ]
xs) = [V2 ℝ] -> Polyline
Polyline forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap V2 ℝ -> V2 ℝ
op [V2 ℝ]
xs