Fixed bug related to points in halfspaces (#244)

* raytracing stuff + discovered a bug in the hyperplane normal business * fixed one of the testcases since what I watned was too strong * separating onSideTest and verticalSideTest * doctest is now happy * fixing tests :) * adding a progress bar * copied over the camera module from HGeometry 0.X * some extra type annotations; since apparently GHC 9.8 was confused about this * intersecting a ball with a line * halfline ball intersection as well :)
noinia · Aug 25, 2024 · f860138 · f860138
1 parent 35b15e9
commit f860138
Show file tree

Hide file tree

Showing 25 changed files with 924 additions and 174 deletions.
diff --git a/hgeometry-examples/hgeometry-examples.cabal b/hgeometry-examples/hgeometry-examples.cabal
@@ -215,6 +215,20 @@ executable hgeometry-sampler
           -- Paths_hgeometry_examples
   --      Miso.Event.Extra
 
+--------------------------------------------------------------------------------
+-- * Raytracer example
+
+executable hgeometry-raytracer
+  import:         setup, miso-setup
+  build-depends:
+          JuicyPixels               >= 3.3.9  && < 4
+        , terminal-progress-bar     >= 0.4.2  && < 0.5
+  hs-source-dirs: raytracer
+  main-is:        Main.hs
+  other-modules:
+          Paths_hgeometry_examples
+  --      Miso.Event.Extra
+
 
 
 --------------------------------------------------------------------------------

diff --git a/hgeometry-examples/raytracer/Main.hs b/hgeometry-examples/raytracer/Main.hs
@@ -0,0 +1,102 @@
+{-# LANGUAGE QuasiQuotes #-}
+module Main(main) where
+
+import           Codec.Picture
+import           Control.Lens
+import           Data.Foldable as F
+import           Data.Maybe
+import           Data.Monoid
+import           Data.Word
+import           HGeometry.Ball
+import           HGeometry.Ext
+import           HGeometry.HalfLine
+import           HGeometry.Intersection
+import           HGeometry.Point
+import           HGeometry.Vector
+import           Paths_hgeometry_examples
+import qualified System.File.OsPath as File
+import           System.OsPath
+import           System.ProgressBar
+
+--------------------------------------------------------------------------------
+
+type Color = PixelRGBA8
+
+type Scene = [Ball (Point 3 R) :+ Color]
+
+type R = Double
+
+type Ray = HalfLine (Point 3 R)
+
+rayThrough     :: Int -> Int -> Ray
+rayThrough x y = let q = Point3 x y 0 &coordinates %~ fromIntegral
+                 in HalfLine cameraPos (q .-. cameraPos)
+
+-- | Intersect to try and get the color
+ballColor            :: Ray -> Ball (Point 3 R) :+ Color -> Maybe Color
+ballColor r (b :+ c)
+  | r `intersects` b = Just c
+  | otherwise        = Nothing
+
+shootRay   :: Ray -> Scene -> Color
+shootRay r = fromMaybe backgroundColor . getFirst . foldMap (First . ballColor r)
+
+renderPixel                         :: Vector 2 Int -> Scene -> Int -> Int -> PixelRGBA8
+renderPixel (Vector2 w h) scene x y = shootRay ray scene
+  where
+    ray = rayThrough x y
+
+    -- clamped     :: Int -> Int -> Word8
+    -- clamped x m = fromIntegral $ (255 * x) `div` m
+
+renderWithProgress :: IO () -> Vector 2 Int -> Scene -> IO (Image PixelRGBA8)
+renderWithProgress reportProgress dims@(Vector2 w h) scene =
+    withImage w h $ \x y -> let !pix = renderPixel dims scene x y
+                            in pix <$ reportProgress
+
+--------------------------------------------------------------------------------
+-- * Settings
+
+backgroundColor :: PixelRGBA8
+backgroundColor = PixelRGBA8 maxBound maxBound maxBound 0
+
+theScene :: Scene
+theScene = [ Ball (Point3 128 128 128) 50 :+ PixelRGBA8 200 0 0 255
+           ]
+
+
+cameraPos = Point3 0 0 10000
+
+
+aspectRatio :: Rational
+aspectRatio = 16 / 9
+
+outputWidth :: Int
+outputWidth = 400
+
+outputDimensions :: Vector 2 Int
+outputDimensions = Vector2 outputWidth (ceiling $ fromIntegral outputWidth / aspectRatio)
+
+refreshRate :: Double
+refreshRate = 10
+
+
+viewportDims :: Vector 2 Double
+viewportDims = let Vector2 w h = fromIntegral <$> outputDimensions
+                   desiredHeight = 2
+               in Vector2 desiredHeight (desiredHeight * (h/w))
+
+--------------------------------------------------------------------------------
+
+amountOfWork (Vector2 w h) = w * h
+
+main :: IO ()
+main = do
+  let initialProgress = Progress 0 (amountOfWork outputDimensions) ()
+  progressBar <- newProgressBar defStyle refreshRate initialProgress
+
+  imageData <- renderWithProgress (incProgress progressBar 1)
+                                  outputDimensions theScene
+
+  let bs = encodePng imageData
+  File.writeFile [osp|foo.png|] bs
diff --git a/hgeometry/data/test-with-ipe/golden/ball.ipe b/hgeometry/data/test-with-ipe/golden/ball.ipe
@@ -0,0 +1,156 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<ipe version="70005" creator="HGeometry"><ipestyle name="basic">
+<color name="red" value="1 0 0"/>
+<color name="green" value="0 1 0"/>
+<color name="blue" value="0 0 1"/>
+<color name="yellow" value="1 1 0"/>
+<color name="orange" value="1 0.647 0"/>
+<color name="gold" value="1 0.843 0"/>
+<color name="purple" value="0.627 0.125 0.941"/>
+<color name="gray" value="0.745 0.745 0.745"/>
+<color name="brown" value="0.647 0.165 0.165"/>
+<color name="navy" value="0 0 0.502"/>
+<color name="pink" value="1 0.753 0.796"/>
+<color name="seagreen" value="0.18 0.545 0.341"/>
+<color name="turquoise" value="0.251 0.878 0.816"/>
+<color name="violet" value="0.933 0.51 0.933"/>
+<color name="darkblue" value="0 0 0.545"/>
+<color name="darkcyan" value="0 0.545 0.545"/>
+<color name="darkgray" value="0.663 0.663 0.663"/>
+<color name="darkgreen" value="0 0.392 0"/>
+<color name="darkmagenta" value="0.545 0 0.545"/>
+<color name="darkorange" value="1 0.549 0"/>
+<color name="darkred" value="0.545 0 0"/>
+<color name="lightblue" value="0.678 0.847 0.902"/>
+<color name="lightcyan" value="0.878 1 1"/>
+<color name="lightgray" value="0.827 0.827 0.827"/>
+<color name="lightgreen" value="0.565 0.933 0.565"/>
+<color name="lightyellow" value="1 1 0.878"/>
+<dashstyle name="dashed" value="[4] 0"/>
+<dashstyle name="dotted" value="[1 3] 0"/>
+<dashstyle name="dash dotted" value="[4 2 1 2] 0"/>
+<dashstyle name="dash dot dotted" value="[4 2 1 2 1 2] 0"/>
+<pen name="heavier" value="0.8"/>
+<pen name="fat" value="1.2"/>
+<pen name="ultrafat" value="2"/>
+<textsize name="large" value="\large"/>
+<textsize name="Large" value="\Large"/>
+<textsize name="LARGE" value="\LARGE"/>
+<textsize name="huge" value="\huge"/>
+<textsize name="Huge" value="\Huge"/>
+<textsize name="small" value="\small"/>
+<textsize name="footnote" value="\footnotesize"/>
+<textsize name="tiny" value="\tiny"/>
+<symbolsize name="small" value="2"/>
+<symbolsize name="tiny" value="1.1"/>
+<symbolsize name="large" value="5"/>
+<arrowsize name="small" value="5"/>
+<arrowsize name="tiny" value="3"/>
+<arrowsize name="large" value="10"/>
+<gridsize name="4 pts" value="4"/>
+<gridsize name="8 pts (~3 mm)" value="8"/>
+<gridsize name="16 pts (~6 mm)" value="16"/>
+<gridsize name="32 pts (~12 mm)" value="32"/>
+<gridsize name="10 pts (~3.5 mm)" value="10"/>
+<gridsize name="20 pts (~7 mm)" value="20"/>
+<gridsize name="14 pts (~5 mm)" value="14"/>
+<gridsize name="28 pts (~10 mm)" value="28"/>
+<gridsize name="56 pts (~20 mm)" value="56"/>
+<anglesize name="90 deg" value="90"/>
+<anglesize name="60 deg" value="60"/>
+<anglesize name="45 deg" value="45"/>
+<anglesize name="30 deg" value="30"/>
+<anglesize name="22.5 deg" value="22.5"/>
+<symbol name="mark/circle(sx)" transformations="translations">
+<path fill="sym-stroke">
+0.6 0 0 0.6 0 0 e 0.4 0 0 0.4 0 0 e
+</path></symbol>
+<symbol name="mark/disk(sx)" transformations="translations">
+<path fill="sym-stroke">
+0.6 0 0 0.6 0 0 e
+</path></symbol>
+<symbol name="mark/fdisk(sfx)" transformations="translations">
+<group><path fill="sym-fill">
+0.5 0 0 0.5 0 0 e
+</path><path fill="sym-stroke" fillrule="eofill">
+0.6 0 0 0.6 0 0 e 0.4 0 0 0.4 0 0 e
+</path></group></symbol>
+<symbol name="mark/box(sx)" transformations="translations">
+<path fill="sym-stroke" fillrule="eofill">
+-0.6 -0.6 m 0.6 -0.6 l 0.6 0.6 l -0.6 0.6 l h
+-0.4 -0.4 m 0.4 -0.4 l 0.4 0.4 l -0.4 0.4 l h</path></symbol>
+<symbol name="mark/square(sx)" transformations="translations">
+<path fill="sym-stroke">
+-0.6 -0.6 m 0.6 -0.6 l 0.6 0.6 l -0.6 0.6 l h</path></symbol>
+<symbol name="mark/fsquare(sfx)" transformations="translations">
+<group><path fill="sym-fill">
+-0.5 -0.5 m 0.5 -0.5 l 0.5 0.5 l -0.5 0.5 l h</path>
+<path fill="sym-stroke" fillrule="eofill">
+-0.6 -0.6 m 0.6 -0.6 l 0.6 0.6 l -0.6 0.6 l h
+-0.4 -0.4 m 0.4 -0.4 l 0.4 0.4 l -0.4 0.4 l h</path></group></symbol>
+<symbol name="mark/cross(sx)" transformations="translations">
+<group><path fill="sym-stroke">
+-0.43 -0.57 m 0.57 0.43 l 0.43 0.57 l -0.57 -0.43 l h</path>
+<path fill="sym-stroke">
+-0.43 0.57 m 0.57 -0.43 l 0.43 -0.57 l -0.57 0.43 l h</path>
+</group></symbol>
+<symbol name="arrow/arc(spx)">
+<path pen="sym-pen" stroke="sym-stroke" fill="sym-stroke">
+0 0 m -1.0 0.333 l -1.0 -0.333 l h</path></symbol>
+<symbol name="arrow/farc(spx)">
+<path pen="sym-pen" stroke="sym-stroke" fill="white">
+0 0 m -1.0 0.333 l -1.0 -0.333 l h</path></symbol>
+<symbol name="arrow/ptarc(spx)">
+<path pen="sym-pen" stroke="sym-stroke" fill="sym-stroke">
+0 0 m -1.0 0.333 l -0.8 0 l -1.0 -0.333 l h</path></symbol>
+<symbol name="arrow/fptarc(spx)">
+<path pen="sym-pen" stroke="sym-stroke" fill="white">
+0 0 m -1.0 0.333 l -0.8 0 l -1.0 -0.333 l h</path></symbol>
+<symbol name="arrow/fnormal(spx)">
+<path pen="sym-pen" stroke="sym-stroke" fill="white">
+0 0 m -1.0 0.333 l -1.0 -0.333 l h</path></symbol>
+<symbol name="arrow/pointed(spx)">
+<path pen="sym-pen" stroke="sym-stroke" fill="sym-stroke">
+0 0 m -1.0 0.333 l -0.8 0 l -1.0 -0.333 l h</path></symbol>
+<symbol name="arrow/fpointed(spx)">
+<path pen="sym-pen" stroke="sym-stroke" fill="white">
+0 0 m -1.0 0.333 l -0.8 0 l -1.0 -0.333 l h</path></symbol>
+<symbol name="arrow/linear(spx)">
+<path pen="sym-pen" stroke="sym-stroke">
+-1.0 0.333 m 0 0 l -1.0 -0.333 l</path></symbol>
+<symbol name="arrow/fdouble(spx)">
+<path pen="sym-pen" stroke="sym-stroke" fill="white">
+0 0 m -1.0 0.333 l -1.0 -0.333 l h
+-1 0 m -2.0 0.333 l -2.0 -0.333 l h
+</path></symbol>
+<symbol name="arrow/double(spx)">
+<path pen="sym-pen" stroke="sym-stroke" fill="sym-stroke">
+0 0 m -1.0 0.333 l -1.0 -0.333 l h
+-1 0 m -2.0 0.333 l -2.0 -0.333 l h
+</path></symbol>
+<tiling name="falling" angle="-60" width="1" step="4"/>
+<tiling name="rising" angle="30" width="1" step="4"/>
+<textstyle name="center" begin="\begin{center}" end="\end{center}"/>
+<textstyle name="itemize" begin="\begin{itemize}" end="\end{itemize}"/>
+<textstyle name="item" begin="\begin{itemize}\item{}" end="\end{itemize}"/>
+</ipestyle><page><layer name="HalfLineXBall"/><layer name="LineXBall"/><layer name="alpha"/><layer name="balls"/><layer name="halfLines"/><layer name="lines"/><view layers="HalfLineXBall LineXBall alpha balls halfLines lines" active="alpha"/><path layer="lines">-505.0 -1000.0 m
+495.0 1000.0 l
+</path><path layer="lines">-1000.0 20.0 m
+1000.0 20.0 l
+</path><path layer="lines">-1000.0 8.0 m
+1000.0 8.0 l
+</path><path layer="halfLines" stroke="blue">4.0 0.0 m
+504.0 -1000.0 l
+</path><path layer="halfLines" stroke="blue">-5.0 10.0 m
+197.0 -1000.0 l
+</path><path layer="balls" fill="0.722 0.145 0.137">10.0 0.0 0.0 10.0 0.0 0.0 e</path><path layer="balls" fill="0.722 0.145 0.137">8.0 0.0 0.0 8.0 20.0 28.0 e</path><path layer="balls" fill="0.722 0.145 0.137">16.0 0.0 0.0 16.0 200.0 28.0 e</path><path layer="LineXBall" pen="fat">-8.0 -6.0 m
+0.0 10.0 l
+</path><use layer="LineXBall" pos="20.0 20.0" name="mark/disk(sx)"/><path layer="LineXBall" pen="fat">186.143593539449 20.0 m
+213.856406460551 20.0 l
+</path><path layer="LineXBall" pen="fat">-6.0 8.0 m
+6.0 8.0 l
+</path><path layer="HalfLineXBall" pen="fat">4.0 0.0 m
+7.3761226035642204 -6.752245207128441 l
+</path><path layer="HalfLineXBall" pen="fat">-4.758998912463262 8.794994562316312 m
+-1.0102318567675068 -9.948840716162465 l
+</path></page></ipe>
diff --git a/hgeometry/hgeometry.cabal b/hgeometry/hgeometry.cabal
@@ -340,6 +340,8 @@ library
     exposed-modules:
         HGeometry
 
+        HGeometry.Graphics.Camera
+
         -- HGeometry.DelaunayTriangulation
 
         HGeometry.PlaneGraph
@@ -715,6 +717,7 @@ test-suite hspec
       RangeTreeSpec
       VerticalRayShootingSpec
       LineSegment.BentheyOttmanNeighbourSpec
+      Graphics.CameraSpec
 
   hs-source-dirs: test
   build-depends:
@@ -751,6 +754,8 @@ test-suite with-ipe-hspec
       HalfPlane.CommonIntersectionSpec
       Line.LowerEnvelopeSpec
       Paths_hgeometry
+      BallSpec
+
   autogen-modules:
       Paths_hgeometry
   hs-source-dirs:   test-with-ipe/test