{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleInstances #-}
module Graphics.Implicit.Export.DiscreteAproxable (DiscreteAproxable, discreteAprox) where
import Prelude(pure, (-), (/), ($), (<), round, (+), maximum, abs, (*), fromIntegral, max, realToFrac, Int)
import Graphics.Implicit.Definitions (defaultObjectContext, ℝ, ℝ2, SymbolicObj2, SymbolicObj3, Polyline, TriangleMesh(getTriangles), NormedTriangleMesh(NormedTriangleMesh))
import Graphics.Implicit.ObjectUtil (getBox2, getBox3)
import Graphics.Implicit.Export.SymbolicObj3 (symbolicGetMesh)
import Graphics.Implicit.Export.SymbolicObj2 (symbolicGetContour)
import Graphics.Implicit.Export.Util (normTriangle)
import Graphics.Implicit.Export.RayTrace (Color(Color), Camera(Camera), Light(Light), Scene(Scene), average, traceRay, cameraRay)
import Codec.Picture (DynamicImage(ImageRGBA8), PixelRGBA8(PixelRGBA8), generateImage)
import Control.Parallel.Strategies (using, rdeepseq, parBuffer)
import Linear ( V3(V3), V2(V2), (*^), (^/) )
import Linear.Affine ( Affine((.+^), (.-^)) )
import Graphics.Implicit.Primitives (getImplicit)
default (ℝ)
class DiscreteAproxable obj aprox where
discreteAprox :: ℝ -> obj -> aprox
instance DiscreteAproxable SymbolicObj3 TriangleMesh where
discreteAprox :: ℝ -> SymbolicObj3 -> TriangleMesh
discreteAprox = ℝ -> SymbolicObj3 -> TriangleMesh
symbolicGetMesh
instance DiscreteAproxable SymbolicObj3 NormedTriangleMesh where
discreteAprox :: ℝ -> SymbolicObj3 -> NormedTriangleMesh
discreteAprox ℝ
res SymbolicObj3
obj = [NormedTriangle] -> NormedTriangleMesh
NormedTriangleMesh
([ ℝ -> Obj3 -> Triangle -> NormedTriangle
normTriangle ℝ
res (forall obj (f :: * -> *) a. Object obj f a => obj -> f a -> a
getImplicit SymbolicObj3
obj) Triangle
rawMesh
| Triangle
rawMesh <- TriangleMesh -> [Triangle]
getTriangles forall a b. (a -> b) -> a -> b
$ ℝ -> SymbolicObj3 -> TriangleMesh
symbolicGetMesh ℝ
res SymbolicObj3
obj
] forall a. a -> Strategy a -> a
`using` forall a. Int -> Strategy a -> Strategy [a]
parBuffer Int
32 forall a. NFData a => Strategy a
rdeepseq)
instance DiscreteAproxable SymbolicObj3 DynamicImage where
discreteAprox :: ℝ -> SymbolicObj3 -> DynamicImage
discreteAprox ℝ
_ SymbolicObj3
symbObj = Image PixelRGBA8 -> DynamicImage
ImageRGBA8 forall a b. (a -> b) -> a -> b
$ forall px. Pixel px => (Int -> Int -> px) -> Int -> Int -> Image px
generateImage Int -> Int -> PixelRGBA8
pixelRenderer (forall a b. (RealFrac a, Integral b) => a -> b
round ℝ
w) (forall a b. (RealFrac a, Integral b) => a -> b
round ℝ
h)
where
(V2 ℝ
w ℝ
h) = forall a. a -> a -> V2 a
V2 ℝ
150 ℝ
150 :: ℝ2
obj :: Obj3
obj = forall obj (f :: * -> *) a. Object obj f a => obj -> f a -> a
getImplicit SymbolicObj3
symbObj
box :: Box3
box@(V3 ℝ
x1 ℝ
y1 ℝ
z1, V3 ℝ
_ ℝ
y2 ℝ
z2) = SymbolicObj3 -> Box3
getBox3 SymbolicObj3
symbObj
av :: ℝ -> ℝ -> ℝ
av :: ℝ -> ℝ -> ℝ
av ℝ
a ℝ
b = (ℝ
aforall a. Num a => a -> a -> a
+ℝ
b)forall a. Fractional a => a -> a -> a
/ℝ
2
avY :: ℝ
avY = ℝ -> ℝ -> ℝ
av ℝ
y1 ℝ
y2
avZ :: ℝ
avZ = ℝ -> ℝ -> ℝ
av ℝ
z1 ℝ
z2
deviation :: ℝ
deviation = forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [forall a. Num a => a -> a
abs forall a b. (a -> b) -> a -> b
$ ℝ
y1 forall a. Num a => a -> a -> a
- ℝ
avY, forall a. Num a => a -> a
abs forall a b. (a -> b) -> a -> b
$ ℝ
y2 forall a. Num a => a -> a -> a
- ℝ
avY, forall a. Num a => a -> a
abs forall a b. (a -> b) -> a -> b
$ ℝ
z1 forall a. Num a => a -> a -> a
- ℝ
avZ, forall a. Num a => a -> a
abs forall a b. (a -> b) -> a -> b
$ ℝ
z2 forall a. Num a => a -> a -> a
- ℝ
avZ]
camera :: Camera
camera = V3 ℝ -> V3 ℝ -> V3 ℝ -> ℝ -> Camera
Camera (forall a. a -> a -> a -> V3 a
V3 (ℝ
x1forall a. Num a => a -> a -> a
-ℝ
deviationforall a. Num a => a -> a -> a
*ℝ
2.2) ℝ
avY ℝ
avZ) (forall a. a -> a -> a -> V3 a
V3 ℝ
0 (-ℝ
1) ℝ
0) (forall a. a -> a -> a -> V3 a
V3 ℝ
0 ℝ
0 (-ℝ
1)) ℝ
1.0
lights :: [Light]
lights = [V3 ℝ -> ℝ -> Light
Light (forall a. a -> a -> a -> V3 a
V3 (ℝ
x1forall a. Num a => a -> a -> a
-ℝ
deviationforall a. Num a => a -> a -> a
*ℝ
1.5) (ℝ
y1 forall a. Num a => a -> a -> a
- ℝ
0.4forall a. Num a => a -> a -> a
*(ℝ
y2forall a. Num a => a -> a -> a
-ℝ
y1)) ℝ
avZ) (ℝ
0.03forall a. Num a => a -> a -> a
*ℝ
deviation) ]
scene :: Scene
scene = Obj3 -> Color -> [Light] -> Color -> Scene
Scene Obj3
obj (Pixel8 -> Pixel8 -> Pixel8 -> Pixel8 -> Color
Color Pixel8
200 Pixel8
200 Pixel8
230 Pixel8
255) [Light]
lights (Pixel8 -> Pixel8 -> Pixel8 -> Pixel8 -> Color
Color Pixel8
255 Pixel8
255 Pixel8
255 Pixel8
0)
pixelRenderer :: Int -> Int -> PixelRGBA8
pixelRenderer :: Int -> Int -> PixelRGBA8
pixelRenderer Int
a Int
b = ℝ -> ℝ -> PixelRGBA8
renderScreen
(forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
aforall a. Fractional a => a -> a -> a
/ℝ
w forall a. Num a => a -> a -> a
- ℝ
0.5) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
bforall a. Fractional a => a -> a -> a
/ℝ
h forall a. Num a => a -> a -> a
- ℝ
0.5)
renderScreen :: ℝ -> ℝ -> PixelRGBA8
renderScreen :: ℝ -> ℝ -> PixelRGBA8
renderScreen ℝ
a ℝ
b =
Color -> PixelRGBA8
colorToPixelRGBA8 forall a b. (a -> b) -> a -> b
$
[Color] -> Color
average [
Ray -> ℝ -> Box3 -> Scene -> Color
traceRay
(Camera -> ℝ2 -> Ray
cameraRay Camera
camera (forall a. a -> a -> V2 a
V2 ℝ
a ℝ
b forall a. Num a => a -> a -> a
+ forall a. a -> a -> V2 a
V2 ( ℝ
0.25forall a. Fractional a => a -> a -> a
/ℝ
w) (ℝ
0.25forall a. Fractional a => a -> a -> a
/ℝ
h)))
ℝ
2 Box3
box Scene
scene,
Ray -> ℝ -> Box3 -> Scene -> Color
traceRay
(Camera -> ℝ2 -> Ray
cameraRay Camera
camera (forall a. a -> a -> V2 a
V2 ℝ
a ℝ
b forall a. Num a => a -> a -> a
+ forall a. a -> a -> V2 a
V2 (-ℝ
0.25forall a. Fractional a => a -> a -> a
/ℝ
w) (ℝ
0.25forall a. Fractional a => a -> a -> a
/ℝ
h)))
ℝ
0.5 Box3
box Scene
scene,
Ray -> ℝ -> Box3 -> Scene -> Color
traceRay
(Camera -> ℝ2 -> Ray
cameraRay Camera
camera (forall a. a -> a -> V2 a
V2 ℝ
a ℝ
b forall a. Num a => a -> a -> a
+ forall a. a -> a -> V2 a
V2 (ℝ
0.25forall a. Fractional a => a -> a -> a
/ℝ
w) (-ℝ
0.25forall a. Fractional a => a -> a -> a
/ℝ
h)))
ℝ
0.5 Box3
box Scene
scene,
Ray -> ℝ -> Box3 -> Scene -> Color
traceRay
(Camera -> ℝ2 -> Ray
cameraRay Camera
camera (forall a. a -> a -> V2 a
V2 ℝ
a ℝ
b forall a. Num a => a -> a -> a
+ forall a. a -> a -> V2 a
V2 (-ℝ
0.25forall a. Fractional a => a -> a -> a
/ℝ
w) (-ℝ
0.25forall a. Fractional a => a -> a -> a
/ℝ
h)))
ℝ
0.5 Box3
box Scene
scene
]
where
colorToPixelRGBA8 :: Color -> PixelRGBA8
colorToPixelRGBA8 :: Color -> PixelRGBA8
colorToPixelRGBA8 (Color Pixel8
rr Pixel8
gg Pixel8
bb Pixel8
aa) = Pixel8 -> Pixel8 -> Pixel8 -> Pixel8 -> PixelRGBA8
PixelRGBA8 Pixel8
rr Pixel8
gg Pixel8
bb Pixel8
aa
instance DiscreteAproxable SymbolicObj2 [Polyline] where
discreteAprox :: ℝ -> SymbolicObj2 -> [Polyline]
discreteAprox ℝ
res = ℝ -> ObjectContext -> SymbolicObj2 -> [Polyline]
symbolicGetContour ℝ
res ObjectContext
defaultObjectContext
instance DiscreteAproxable SymbolicObj2 DynamicImage where
discreteAprox :: ℝ -> SymbolicObj2 -> DynamicImage
discreteAprox ℝ
_ SymbolicObj2
symbObj = Image PixelRGBA8 -> DynamicImage
ImageRGBA8 forall a b. (a -> b) -> a -> b
$ forall px. Pixel px => (Int -> Int -> px) -> Int -> Int -> Image px
generateImage Int -> Int -> PixelRGBA8
pixelRenderer (forall a b. (RealFrac a, Integral b) => a -> b
round ℝ
w) (forall a b. (RealFrac a, Integral b) => a -> b
round ℝ
h)
where
V2 ℝ
w ℝ
h = forall (f :: * -> *) a. Applicative f => a -> f a
pure ℝ
150 :: ℝ2
obj :: ℝ2 -> ℝ
obj = forall obj (f :: * -> *) a. Object obj f a => obj -> f a -> a
getImplicit SymbolicObj2
symbObj
(p1 :: ℝ2
p1@(V2 ℝ
x1 ℝ
_), p2 :: ℝ2
p2@(V2 ℝ
_ ℝ
y2)) = SymbolicObj2 -> (ℝ2, ℝ2)
getBox2 SymbolicObj2
symbObj
V2 ℝ
dx ℝ
dy = ℝ2
p2 forall a. Num a => a -> a -> a
- ℝ2
p1
dxy :: ℝ
dxy = forall a. Ord a => a -> a -> a
max ℝ
dx ℝ
dy
pixelRenderer :: Int -> Int -> PixelRGBA8
pixelRenderer :: Int -> Int -> PixelRGBA8
pixelRenderer Int
mya Int
myb = PixelRGBA8
mycolor
where
xy :: ℝ -> ℝ -> ℝ2
xy ℝ
a ℝ
b = (forall a. a -> a -> V2 a
V2 ℝ
x1 ℝ
y2 forall (p :: * -> *) a. (Affine p, Num a) => p a -> Diff p a -> p a
.-^ forall a. a -> a -> V2 a
V2 (ℝ
dxyforall a. Num a => a -> a -> a
-ℝ
dx) (ℝ
dyforall a. Num a => a -> a -> a
-ℝ
dxy) forall (f :: * -> *) a.
(Functor f, Fractional a) =>
f a -> a -> f a
^/ℝ
2) forall (p :: * -> *) a. (Affine p, Num a) => p a -> Diff p a -> p a
.+^ ℝ
dxy forall (f :: * -> *) a. (Functor f, Num a) => a -> f a -> f a
*^ forall a. a -> a -> V2 a
V2 (ℝ
aforall a. Fractional a => a -> a -> a
/ℝ
w) (-ℝ
bforall a. Fractional a => a -> a -> a
/ℝ
h)
s :: ℝ
s = ℝ
0.25 :: ℝ
V2 ℝ
a' ℝ
b' = forall a. a -> a -> V2 a
V2 (forall a b. (Real a, Fractional b) => a -> b
realToFrac Int
mya) (forall a b. (Real a, Fractional b) => a -> b
realToFrac Int
myb) :: ℝ2
mycolor :: PixelRGBA8
mycolor = Color -> PixelRGBA8
colorToPixelRGBA8 forall a b. (a -> b) -> a -> b
$ [Color] -> Color
average [ℝ2 -> Color
objColor forall a b. (a -> b) -> a -> b
$ ℝ -> ℝ -> ℝ2
xy ℝ
a' ℝ
b', ℝ2 -> Color
objColor forall a b. (a -> b) -> a -> b
$ ℝ -> ℝ -> ℝ2
xy ℝ
a' ℝ
b',
ℝ2 -> Color
objColor forall a b. (a -> b) -> a -> b
$ ℝ -> ℝ -> ℝ2
xy (ℝ
a'forall a. Num a => a -> a -> a
+ℝ
s) (ℝ
b'forall a. Num a => a -> a -> a
+ℝ
s),
ℝ2 -> Color
objColor forall a b. (a -> b) -> a -> b
$ ℝ -> ℝ -> ℝ2
xy (ℝ
a'forall a. Num a => a -> a -> a
-ℝ
s) (ℝ
b'forall a. Num a => a -> a -> a
-ℝ
s),
ℝ2 -> Color
objColor forall a b. (a -> b) -> a -> b
$ ℝ -> ℝ -> ℝ2
xy (ℝ
a'forall a. Num a => a -> a -> a
+ℝ
s) (ℝ
b'forall a. Num a => a -> a -> a
+ℝ
s),
ℝ2 -> Color
objColor forall a b. (a -> b) -> a -> b
$ ℝ -> ℝ -> ℝ2
xy (ℝ
a'forall a. Num a => a -> a -> a
-ℝ
s) (ℝ
b'forall a. Num a => a -> a -> a
-ℝ
s)]
colorToPixelRGBA8 :: Color -> PixelRGBA8
colorToPixelRGBA8 :: Color -> PixelRGBA8
colorToPixelRGBA8 (Color Pixel8
rr Pixel8
gg Pixel8
bb Pixel8
aa) = Pixel8 -> Pixel8 -> Pixel8 -> Pixel8 -> PixelRGBA8
PixelRGBA8 Pixel8
rr Pixel8
gg Pixel8
bb Pixel8
aa
objColor :: ℝ2 -> Color
objColor ℝ2
p = if ℝ2 -> ℝ
obj ℝ2
p forall a. Ord a => a -> a -> Bool
< ℝ
0 then Pixel8 -> Pixel8 -> Pixel8 -> Pixel8 -> Color
Color Pixel8
150 Pixel8
150 Pixel8
160 Pixel8
255 else Pixel8 -> Pixel8 -> Pixel8 -> Pixel8 -> Color
Color Pixel8
255 Pixel8
255 Pixel8
255 Pixel8
0