Haskell-Things · julialongtin · Mar 31, 2026
diff --git a/Graphics/Slicer/Formats/STL/Definitions.hs b/Graphics/Slicer/Formats/STL/Definitions.hs
@@ -45,6 +45,8 @@ import Graphics.Slicer.Math.Tri (Tri(Tri))
 
 import Graphics.Slicer.Definitions (Fastℕ, fromFastℕ)
 
+import Linear (V3(V3))
+
 ----------------------------------------------------------------
 ----------- Functions to deal with ASCII STL reading -----------
 ----------------------------------------------------------------
@@ -82,7 +84,7 @@ readVertex s = readVertex' $ words s
     readVertex' :: [ByteString] -> Maybe Point3
     readVertex' [vertex,xs,ys,zs]
       | vertex == "vertex" = case (readMaybe $ unpack xs, readMaybe $ unpack ys, readMaybe $ unpack zs) of
-                               (Just x, Just y, Just z) -> Just $ Point3 (x,y,z)
+                               (Just x, Just y, Just z) -> Just $ Point3 $ V3 x y z
                                (_maybex,_maybey,_maybez) -> error "error reading."
     readVertex' _ = Nothing
 

diff --git a/Graphics/Slicer/Formats/STL/Facets.hs b/Graphics/Slicer/Formats/STL/Facets.hs
@@ -50,6 +50,8 @@ import Text.Read (readMaybe)
 
 import GHC.Base (Int(I#), Char(C#), chr#, ord#, (+#))
 
+import Linear (V3(V3))
+
 import Graphics.Slicer.Math.Definitions (Point3(Point3))
 
 import Graphics.Slicer.Math.Facet (Facet(Facet))
@@ -110,10 +112,10 @@ readVertexOrNormal s = readVertexOrNormal' $ words s
                                    ["endloop"] -> Nothing
                                    ["outer", "loop"] -> Nothing
                                    ["facet", "normal", xs, ys, zs] -> case (readMaybe $ unpack xs, readMaybe $ unpack ys, readMaybe $ unpack zs) of
-                                                                        (Just xv, Just yv, Just zv) -> Just $ Right $ Point3 (xv,yv,zv)
+                                                                        (Just xv, Just yv, Just zv) -> Just $ Right $ Point3 $ V3 xv yv zv
                                                                         (_maybex, _maybey, _maybez) -> error "could not read normal point."
                                    ["vertex" ,xs,ys,zs] -> case (readMaybe $ unpack xs,readMaybe $ unpack ys,readMaybe $ unpack zs) of
-                                                             (Just xv, Just yv, Just zv) -> Just $ Left $ Point3 (xv,yv,zv)
+                                                             (Just xv, Just yv, Just zv) -> Just $ Left $ Point3 $ V3 xv yv zv
                                                              (_maybex, _maybey, _maybez) -> error "error reading vertex point."
                                    xs -> error $ "unexpected input in STL file: " <> concatMap show xs <> "\n"
 
@@ -131,11 +133,11 @@ writeFacet (Facet ((p1,_),(p2,_),(p3,_)) n1) = stringUtf8 "facet " <> writeNorma
 
 -- | Generate the normal for a facet. Note that the caller is assumed to have already placed "facet " on the line of text being generated.
 writeNormal :: Point3 -> Builder
-writeNormal (Point3 (x,y,z)) = "normal " <> formatFloat x <> " " <> formatFloat y <> " " <> formatFloat z <> "\n"
+writeNormal (Point3 (V3 x y z)) = "normal " <> formatFloat x <> " " <> formatFloat y <> " " <> formatFloat z <> "\n"
 
 -- | Generate a vertex of a facet.
 writeVertex :: Point3 -> Builder
-writeVertex (Point3 (x,y,z)) = "vertex " <> formatFloat x <> " " <> formatFloat y <> " " <> formatFloat z <> "\n"
+writeVertex (Point3 (V3 x y z)) = "vertex " <> formatFloat x <> " " <> formatFloat y <> " " <> formatFloat z <> "\n"
 
 -- | Generate a formatted float for placement in an STL file.
 -- Inspired from code in cassava, and the scientific library.

diff --git a/Graphics/Slicer/Machine/GCode.hs b/Graphics/Slicer/Machine/GCode.hs
@@ -48,6 +48,8 @@ import Data.Maybe ( Maybe(Just, Nothing), fromMaybe )
 
 import Control.DeepSeq (NFData)
 
+import Linear (V2(V2), V3(V3))
+
 import Graphics.Slicer.Definitions(ℝ, ℝ2, ℝ3, ℕ, Fastℕ, fromFastℕ)
 
 import Graphics.Slicer.Math.Contour (lastPointOfContour)
@@ -138,15 +140,15 @@ cookGCode printer gcodes threads = do
 
 -- | Construct a GCode to travel to a point without extruding (2D)
 make2DTravelGCode :: Point2 -> Point2 -> GCode
-make2DTravelGCode (Point2 (x1,y1)) (Point2 (x2,y2)) = GCMove2 (x1,y1) (x2,y2)
+make2DTravelGCode (Point2 (V2 x1 y1)) (Point2 (V2 x2 y2)) = GCMove2 (V2 x1 y1) (V2 x2 y2)
 
 -- | Construct a GCode to travel to a point without extruding (3D)
 make3DTravelGCode :: Point3 -> Point3 -> GCode
 make3DTravelGCode (Point3 p1) (Point3 p2) = GCMove3 p1 p2
 
 -- | Construct a GCode to travel to a point while extruding.
 make2DExtrudeGCode :: ℝ -> ℝ -> Point2 -> Point2 -> GCode
-make2DExtrudeGCode pathThickness pathWidth p1@(Point2 (x1,y1)) p2@(Point2 (x2,y2)) = GCRawExtrude2 (x1, y1) (x2, y2) (RawExtrude pathLength pathWidth pathThickness)
+make2DExtrudeGCode pathThickness pathWidth p1@(Point2 (V2 x1 y1)) p2@(Point2 (V2 x2 y2)) = GCRawExtrude2 (V2 x1 y1) (V2 x2 y2) (RawExtrude pathLength pathWidth pathThickness)
   where
     pathLength = distance p1 p2
 
@@ -167,16 +169,16 @@ infixl 9 ~==
 
 -- | Render a GCode into a piece of text, ready to print. Only handles 'cooked' gcode, that has had extrusion values calculated.
 gcodeToText :: GCode -> ByteString
-gcodeToText (GCFeedRate f (GCMove2 (x1,y1) (x2,y2))) = "G0 F" <> posIze f <> " " <> (if x1 ~== x2 then "" else "X" <> posIze x2 <> " ") <> (if y1 ~== y2 then "" else "Y" <> posIze y2 <> " ")
+gcodeToText (GCFeedRate f (GCMove2 (V2 x1 y1) (V2 x2 y2))) = "G0 F" <> posIze f <> " " <> (if x1 ~== x2 then "" else "X" <> posIze x2 <> " ") <> (if y1 ~== y2 then "" else "Y" <> posIze y2 <> " ")
 
-gcodeToText (GCFeedRate f (GCMove3 (x1,y1,z1) (x2,y2,z2))) = "G0 F" <> posIze f <> " " <> (if x1 ~== x2 then "" else "X" <> posIze x2 <> " ") <> (if y1 ~== y2 then "" else "Y" <> posIze y2 <> " ") <> (if z1 ~== z2 then "" else "Z" <> posIze z2)
-gcodeToText (GCFeedRate f (GCExtrude2 (x1,y1) (x2,y2) e)) = "G1 F" <> posIze f <> " " <> (if x1 ~== x2 then "" else "X" <> posIze x2 <> " ") <> (if y1 ~== y2 then "" else "Y" <> posIze y2 <> " ") <> "E" <> posIze e
+gcodeToText (GCFeedRate f (GCMove3 (V3 x1 y1 z1) (V3 x2 y2 z2))) = "G0 F" <> posIze f <> " " <> (if x1 ~== x2 then "" else "X" <> posIze x2 <> " ") <> (if y1 ~== y2 then "" else "Y" <> posIze y2 <> " ") <> (if z1 ~== z2 then "" else "Z" <> posIze z2)
+gcodeToText (GCFeedRate f (GCExtrude2 (V2 x1 y1) (V2 x2 y2) e)) = "G1 F" <> posIze f <> " " <> (if x1 ~== x2 then "" else "X" <> posIze x2 <> " ") <> (if y1 ~== y2 then "" else "Y" <> posIze y2 <> " ") <> "E" <> posIze e
 
-gcodeToText (GCFeedRate f (GCExtrude3 (x1,y1,z1) (x2,y2,z2) e)) = "G1 F" <> posIze f <> " " <> (if x1 ~== x2 then "" else "X" <> posIze x2 <> " ") <> (if y1 ~== y2 then "" else "Y" <> posIze y2 <> " ") <> (if z1 ~== z2 then "" else "Z" <> posIze z2) <> "E" <> posIze e
-gcodeToText (GCMove2 (x1,y1) (x2,y2)) = "G0 " <> (if x1 ~== x2 then "" else "X" <> posIze x2 <> " ") <> (if y1 ~== y2 then "" else "Y" <> posIze y2 <> " ")
-gcodeToText (GCMove3 (x1,y1,z1) (x2,y2,z2)) = "G0 " <> (if x1 ~== x2 then "" else "X" <> posIze x2 <> " ") <> (if y1 ~== y2 then "" else "Y" <> posIze y2 <> " ") <> (if z1 ~== z2 then "" else "Z" <> posIze z2)
-gcodeToText (GCExtrude2 (x1,y1) (x2,y2) e) = "G1 " <> (if x1 ~== x2 then "" else "X" <> posIze x2 <> " ") <> (if y1 ~== y2 then "" else "Y" <> posIze y2 <> " ") <> "E" <> posIze e
-gcodeToText (GCExtrude3 (x1,y1,z1) (x2,y2,z2) e) = "G1 " <> (if x1 ~== x2 then "" else "X" <> posIze x2 <> " ") <> (if y1 ~== y2 then "" else "Y" <> posIze y2 <> " ") <> (if z1 ~== z2 then "" else "Z" <> posIze z2 <> " ") <> "E" <> posIze e
+gcodeToText (GCFeedRate f (GCExtrude3 (V3 x1 y1 z1) (V3 x2 y2 z2) e)) = "G1 F" <> posIze f <> " " <> (if x1 ~== x2 then "" else "X" <> posIze x2 <> " ") <> (if y1 ~== y2 then "" else "Y" <> posIze y2 <> " ") <> (if z1 ~== z2 then "" else "Z" <> posIze z2) <> "E" <> posIze e
+gcodeToText (GCMove2 (V2 x1 y1) (V2 x2 y2)) = "G0 " <> (if x1 ~== x2 then "" else "X" <> posIze x2 <> " ") <> (if y1 ~== y2 then "" else "Y" <> posIze y2 <> " ")
+gcodeToText (GCMove3 (V3 x1 y1 z1) (V3 x2 y2 z2)) = "G0 " <> (if x1 ~== x2 then "" else "X" <> posIze x2 <> " ") <> (if y1 ~== y2 then "" else "Y" <> posIze y2 <> " ") <> (if z1 ~== z2 then "" else "Z" <> posIze z2)
+gcodeToText (GCExtrude2 (V2 x1 y1) (V2 x2 y2) e) = "G1 " <> (if x1 ~== x2 then "" else "X" <> posIze x2 <> " ") <> (if y1 ~== y2 then "" else "Y" <> posIze y2 <> " ") <> "E" <> posIze e
+gcodeToText (GCExtrude3 (V3 x1 y1 z1) (V3 x2 y2 z2) e) = "G1 " <> (if x1 ~== x2 then "" else "X" <> posIze x2 <> " ") <> (if y1 ~== y2 then "" else "Y" <> posIze y2 <> " ") <> (if z1 ~== z2 then "" else "Z" <> posIze z2 <> " ") <> "E" <> posIze e
 gcodeToText (GCFeedRate f wtf) = error $ "applying feedrate " <> show (posIze f) <> " to something other than a GCmove(2,3) or a GCExtrude(2,3): " <> show wtf
 gcodeToText (GCRawFeedRate a b) = error $ "Attempting to generate gcode for a feedrate change command that has not yet been cooked:\nRate: " <> show a <> "\nGCode: " <> show b <> "\n"
 gcodeToText (GCRawExtrude2 a b c) = error $ "Attempting to generate gcode for a 2D extrude command that has not yet been cooked:\nStart: " <> show a <> "\nStop: " <> show b <> "\nExtrude: " <> show c <> "\n"

diff --git a/Graphics/Slicer/Machine/Infill.hs b/Graphics/Slicer/Machine/Infill.hs
@@ -37,6 +37,8 @@ import Data.List.Ordered (sort)
 
 import Data.Maybe (Maybe(Just, Nothing), mapMaybe, fromMaybe)
 
+import Linear (V2(V2))
+
 import Graphics.Slicer.Definitions (ℝ)
 
 import Graphics.Slicer.Math.Definitions (Point2(Point2), Contour, LineSeg, addPoints, distance, lineSegsOfContour, minMaxPoints, xOf, yOf, roundToFifth)
@@ -111,8 +113,8 @@ coveringPLinesPositive contour ls = makeLine <$> [0,lss..(xMax-xMinRaw)+(yMax-yM
     where
       makeLine a = join2EP (f a) $ addPoints (f a) slope
       (minPoint, maxPoint) = minMaxPoints contour
-      slope = Point2 (1,1)
-      f v = Point2 (v-xDiff,0)
+      slope = Point2 $ V2 1 1
+      f v = Point2 $ V2 (v-xDiff) 0
       xDiff = -(xMin - yMax)
       yMin = yOf minPoint
       yMax = yOf maxPoint
@@ -131,8 +133,8 @@ coveringPLinesNegative contour ls = makeLine <$> [0,lss..(xMax-xMin)+(yMax-yMin)
     where
       makeLine a = join2EP (f a) $ addPoints (f a) slope
       (minPoint, maxPoint) = minMaxPoints contour
-      slope =  Point2 (1,-1)
-      f v = Point2 (v+yDiff,0)
+      slope =  Point2 $ V2 1 (-1)
+      f v = Point2 $ V2 (v+yDiff) 0
       yDiff = xMin + yMin
       yMinRaw = yOf minPoint
       yMin = case yMinRaw `compare` 0 of
@@ -151,8 +153,8 @@ coveringPLinesVertical contour ls = makeLine <$> [xMin,xMin+ls..xMax]
     where
       makeLine a = join2EP (f a) $ addPoints (f a) slope
       (minPoint, maxPoint) = minMaxPoints contour
-      slope = Point2 (0,1)
-      f v = Point2 (v,0)
+      slope = Point2 $ V2 0 1
+      f v = Point2 $ V2 v 0
       xMinRaw = xOf minPoint
       xMin = case xMinRaw `compare` 0 of
         GT -> ls * fromIntegral (ceiling (xMinRaw / ls) :: Integer)
@@ -166,8 +168,8 @@ coveringPLinesHorizontal contour ls = makeLine <$> [yMin,yMin+ls..yMax]
     where
       makeLine a = join2EP (f a) $ addPoints (f a) slope
       (minPoint, maxPoint) = minMaxPoints contour
-      slope = Point2 (1,0)
-      f v = Point2 (0,v)
+      slope = Point2 $ V2  1 0
+      f v = Point2 $ V2 0 v
       yMinRaw = yOf minPoint
       yMin = case yMinRaw `compare` 0 of
         GT -> ls * fromIntegral (ceiling (yMinRaw / ls) :: Integer)

diff --git a/Graphics/Slicer/Machine/Support.hs b/Graphics/Slicer/Machine/Support.hs
@@ -31,6 +31,8 @@ import Data.List (concat)
 
 import Data.Maybe(mapMaybe)
 
+import Linear (V2(V2))
+
 import Graphics.Slicer.Definitions (ℝ,ℝ2)
 
 import Graphics.Slicer.Math.Contour (makePointContour)
@@ -45,7 +47,7 @@ shortenLineBy amt (LineSeg p m) = LineSeg newStart newSlope
   where pct = amt / magnitude m
         newStart = addPoints p $ scalePoint pct m
         newSlope = scalePoint (1 - 2 * pct) m
-        magnitude (Point2 (x1,y1)) = sqrt (x1 * x1 + y1 * y1)
+        magnitude (Point2 (V2 x1 y1)) = sqrt (x1 * x1 + y1 * y1)
 
 -- Generate support
 -- FIXME: hard coded infill amount.
@@ -66,25 +68,25 @@ data BBox = BBox !ℝ2 !ℝ2
 
 -- | Check if a bounding box is empty.
 isEmptyBBox :: BBox -> Bool
-isEmptyBBox (BBox (x1,y1) (x2,y2)) = x1 == x2 || y1 == y2
+isEmptyBBox (BBox (V2 x1 y1) (V2 x2 y2)) = x1 == x2 || y1 == y2
 
 -- Get a bounding box of all contours.
 boundingBoxAll :: [Contour] -> BBox
 boundingBoxAll contours = if isEmptyBBox box then error "empty box with a contour" else box
     where
-      box  = BBox (minX, minY) (maxX, maxY)
-      minX = minimum $ (\(BBox (x1,_) _) -> x1) <$> bBoxes
-      minY = minimum $ (\(BBox (_,y1) _) -> y1) <$> bBoxes
-      maxX = maximum $ (\(BBox _ (x2,_)) -> x2) <$> bBoxes
-      maxY = maximum $ (\(BBox _ (_,y2)) -> y2) <$> bBoxes
+      box  = BBox (V2 minX minY) (V2 maxX maxY)
+      minX = minimum $ (\(BBox (V2 x1 _) _) -> x1) <$> bBoxes
+      minY = minimum $ (\(BBox (V2 _ y1) _) -> y1) <$> bBoxes
+      maxX = maximum $ (\(BBox _ (V2 x2 _)) -> x2) <$> bBoxes
+      maxY = maximum $ (\(BBox _ (V2 _ y2)) -> y2) <$> bBoxes
       bBoxes = boundingBox <$> contours
 
 -- Get a bounding box of a contour.
 boundingBox :: Contour -> BBox
 boundingBox contour = if isEmptyBBox box then error "empty box with a contour" else box
   where
     (minPoint, maxPoint) = minMaxPoints contour
-    box  = BBox (minX, minY) (maxX, maxY)
+    box  = BBox (V2 minX minY) (V2 maxX maxY)
     minX = xOf minPoint
     minY = yOf minPoint
     maxX = xOf maxPoint
@@ -93,9 +95,9 @@ boundingBox contour = if isEmptyBBox box then error "empty box with a contour" e
 -- add a bounding box to a list of contours, as the first contour in the list.
 -- FIXME: what is this for?
 addBBox :: [Contour] -> [Contour]
-addBBox contours = makePointContour [Point2 (x1,y1),Point2 (x2,y1),Point2 (x2,y2),Point2 (x1,y2), Point2 (x1,y1)] : contours
+addBBox contours = makePointContour [Point2 (V2 x1 y1),Point2 (V2 x2 y1),Point2 (V2 x2 y2),Point2 (V2 x1 y2), Point2 (V2 x1 y1)] : contours
     where
       bbox = boundingBoxAll contours
-      (BBox (x1, y1) (x2, y2)) = incBBox bbox 1
+      (BBox (V2 x1 y1) (V2 x2 y2)) = incBBox bbox 1
       -- Put a fixed amount around the 2d bounding box.
-      incBBox (BBox (nx1,ny1) (nx2,ny2)) amount = BBox (nx1+amount, ny1+amount) (nx2-amount, ny2-amount)
+      incBBox (BBox (V2 nx1 ny1) (V2 nx2 ny2)) amount = BBox (V2 (nx1+amount) (ny1+amount)) (V2 (nx2-amount) (ny2-amount))
diff --git a/Graphics/Slicer/Math/Contour.hs b/Graphics/Slicer/Math/Contour.hs
@@ -53,6 +53,8 @@ import Data.Maybe (Maybe(Just,Nothing), catMaybes, fromJust, fromMaybe, isJust,
 
 import Data.MemoTrie (memo)
 
+import Linear (V2(V2))
+
 import Slist (len, slist, safeLast, safeLast, safeHead)
 
 import Slist as SL (last)
@@ -314,8 +316,8 @@ mostPerpPointAndLineSeg contour = (resPoint, resSeg)
         lineSegsAndAnglesNeg = [(lineSeg, outsideNegPoint, abs $ fst $ angleBetween2PL (fst $ join2EP outsideNegPoint $ midPoint lineSeg) (eToPLine2 lineSeg)) | lineSeg <- lineSegsOfContour myContour]
         midPoint lineSeg = pointBetweenPoints (startPoint lineSeg) (endPoint lineSeg)
         outsideMidPoint = pointBetweenPoints outsidePosPoint outsideNegPoint
-        outsidePosPoint = Point2 (xOf minPoint - 0.1 , yOf maxPoint + 0.1)
-        outsideNegPoint = Point2 (xOf minPoint - 0.1 , yOf minPoint - 0.1)
+        outsidePosPoint = Point2 $ V2 (xOf minPoint - 0.1) (yOf maxPoint + 0.1)
+        outsideNegPoint = Point2 $ V2 (xOf minPoint - 0.1) (yOf minPoint - 0.1)
         (minPoint, maxPoint) = minMaxPoints contour
 
 -- | Find a point that is guaranteed to be outside of the given contour, and is not on the same line as the first line segment of the contour.
@@ -328,17 +330,17 @@ pointFarOutsideContours contour1 contour2
   where
     (minPoint1, _)= minMaxPoints contour1
     (minPoint2, _)= minMaxPoints contour2
-    minPoint      = Point2 (min (xOf minPoint1) (xOf minPoint2),min (yOf minPoint1) (yOf minPoint2))
+    minPoint      = Point2 $ V2 (min (xOf minPoint1) (xOf minPoint2)) (min (yOf minPoint1) (yOf minPoint2))
     (p1, p2)      = firstPointPairOfContour contour1
     (p3, p4)      = firstPointPairOfContour contour2
     firstLine     = join2EP p1 p2
     secondLine    = join2EP p3 p4
     line1         = join2EP p1 outsidePoint1
     line2         = join2EP p1 outsidePoint2
     line3         = join2EP p1 outsidePoint3
-    outsidePoint1 = Point2 (xOf minPoint - 0.1 , yOf minPoint - 0.1)
-    outsidePoint2 = Point2 (xOf minPoint - 0.2 , yOf minPoint - 0.1)
-    outsidePoint3 = Point2 (xOf minPoint - 0.1 , yOf minPoint - 0.2)
+    outsidePoint1 = Point2 $ V2 (xOf minPoint - 0.1) (yOf minPoint - 0.1)
+    outsidePoint2 = Point2 $ V2 (xOf minPoint - 0.2) (yOf minPoint - 0.1)
+    outsidePoint3 = Point2 $ V2 (xOf minPoint - 0.1) (yOf minPoint - 0.2)
 
 -- | return the number of points in a contour.
 numPointsOfContour :: Contour -> Int
@@ -383,8 +385,8 @@ makePointContour points = case points of
                             [p1,p2] -> error $ "tried to create a contour with only two points:\n" <> show p1 <> "\n" <> show p2 <> "\n"
                             (p1:p2:p3:pts) -> PointContour pL pH p1 p2 p3 (slist pts)
   where
-    pL = Point2 (minimum $ xOf <$> points, minimum $ yOf <$> points)
-    pH = Point2 (maximum $ xOf <$> points, maximum $ yOf <$> points)
+    pL = Point2 $ V2 (minimum $ xOf <$> points) (minimum $ yOf <$> points)
+    pH = Point2 $ V2 (maximum $ xOf <$> points) (maximum $ yOf <$> points)
 
 makeLineSegContour :: [LineSeg] -> Contour
 makeLineSegContour lineSegs = case lineSegs of
@@ -395,8 +397,8 @@ makeLineSegContour lineSegs = case lineSegs of
                                            else LineSegContour pL pH l1 l2 (slist [])
                                 (l1:l2:lns) -> LineSegContour pL pH l1 l2 (slist lns)
   where
-    pL = Point2 (minimum $ xOf <$> allPoints, minimum $ yOf <$> allPoints)
-    pH = Point2 (maximum $ xOf <$> allPoints, maximum $ yOf <$> allPoints)
+    pL = Point2 $ V2 (minimum $ xOf <$> allPoints) (minimum $ yOf <$> allPoints)
+    pH = Point2 $ V2 (maximum $ xOf <$> allPoints) (maximum $ yOf <$> allPoints)
     allPoints = case lineSegs of
                   [] -> error "tried to create an empty contour"
                   (x:xs) -> startPoint x:endPoint x:(endPoint <$> xs)