Gcodehs

Graphics/Slicer/Machine/GCode.hs

@@ -22,15 +22,15 @@
 -- for NFData.
 {-# LANGUAGE DeriveGeneric, DeriveAnyClass #-}
 
-module Graphics.Slicer.Machine.GCode (GCode(GCMarkOuterWallStart, GCMarkInnerWallStart, GCMarkInfillStart, GCMarkLayerStart, GCMarkSupportStart), cookExtrusions, make3DTravelGCode, make2DTravelGCode, addFeedRate, gcodeForContour, gcodeForInfill, gcodeToText) where
+module Graphics.Slicer.Machine.GCode (GCode(GCMarkOuterWallStart, GCMarkInnerWallStart, GCMarkInfillStart, GCMarkLayerStart, GCMarkSupportStart), cookExtrusions, make3DTravelGCode, make2DTravelGCode, addFeedRate, gcodeForContour, gcodeForInfill, gcodeToText, gcodeToCode, gcodeToText') where
 
 import GHC.Generics (Generic)
 
-import Prelude (Eq, Int, ($), tail, init, zipWith, concat, head, last, (<>), show, error, (++), otherwise, (==), length, (>), (/=), fst, pi, (/), (*), pure, toRational, (.), fromRational, (<$>), seq, (+), div)
+import Prelude (id, map, Eq, Int, ($), tail, init, zipWith, concat, head, last, (<>), show, error, (++), otherwise, (==), length, (>), (/=), fst, pi, (/), (*), pure, toRational, (.), fromRational, (<$>), seq, (+), div)
 
 import Data.ByteString (ByteString)
 
-import Data.ByteString.Char8 (spanEnd)
+import Data.ByteString.Char8 (spanEnd, pack)
 
 import Control.Parallel.Strategies (using, rseq, parListChunk)
 
@@ -52,6 +52,9 @@ import Graphics.Slicer.Machine.StateM (StateM, getEPos, setEPos)
 
 import Graphics.Slicer.Mechanics.Definitions (Extruder, filamentWidth)
 
+import Data.GCode hiding (GCode)
+import Data.GCode.Generate
+
 default (ℕ, Fastℕ, ℝ)
 
 ---------------------------------------------------------
@@ -201,3 +204,50 @@ meshStartGCode :: Text
 meshStartGCode = ";MESH:"
 -}
 
+iff cond fn = if cond then fn else id
+
+gcodeToCode :: GCode -> Code
+gcodeToCode (GCFeedRate f m) = (gcodeToCode m) & param F f
+gcodeToCode (GCMove2 (x1,y1) (x2,y2)) =
+      g
+  <#> 0
+    & iff (x1 /= x2) (x x2)
+    & iff (y1 /= y2) (y y2)
+
+gcodeToCode (GCMove3 (x1,y1,z1) (x2,y2,z2)) =
+      g
+  <#> 0
+    & iff (x1 /= x2) (x x2)
+    & iff (y1 /= y2) (y y2)
+    & iff (z1 /= z2) (z z2)
+gcodeToCode (GCExtrude2 (x1,y1) (x2,y2) e) =
+      g
+  <#> 1
+    & iff (x1 /= x2) (x x2)
+    & iff (y1 /= y2) (y y2)
+    & axis E e
+
+gcodeToCode (GCExtrude3 (x1,y1,z1) (x2,y2,z2) e) =
+      g
+  <#> 1
+    & iff (x1 /= x2) (x x2)
+    & iff (y1 /= y2) (y y2)
+    & iff (z1 /= z2) (z z2)
+    & axis E e
+
+gcodeToCode GCRawExtrude2 {} = error "Attempting to generate gcode for a 2D extrude command that has not yet been rendered."
+gcodeToCode GCRawExtrude3 {} = error "Attempting to generate gcode for a 3D extrude command that has not yet been rendered."
+
+-- The current layer count, where 1 == the bottom layer of the object being printed. rafts are represented as negative layers.
+gcodeToCode (GCMarkLayerStart layerNo) =
+  Comment $ "LAYER:" <> fromString (show (fromFastℕ layerNo :: Int))
+-- perimeters on the inside of the object. may contact the infill, or an outer paremeter, but will not be exposed on the outside of the object.
+gcodeToCode GCMarkInnerWallStart = Comment "TYPE:WALL-INNER"
+-- a perimeter on the outside of the object. may contact the infill, or an inside paremeter.
+gcodeToCode GCMarkOuterWallStart = Comment "TYPE:WALL-OUTER"
+-- Marker indicating the following gcode commands are part of the support, and do not touch the object or the build plate. think: the sparsely generated back-and-forth 
+gcodeToCode GCMarkSupportStart = Comment "TYPE:SUPPORT"
+-- The interior of an object. should only contact inner parameters, skin, or outer paremeters.
+gcodeToCode GCMarkInfillStart = Comment "TYPE:FILL"
+
+gcodeToText' = Data.ByteString.Char8.pack . ppGCode . map gcodeToCode

hslice.cabal

@@ -19,9 +19,11 @@ Library
                   data-ordlist,
                   deepseq,
                   double-conversion,
+                  gcodehs >= 0.1.2,
                   implicit,
                   mtl,
                   parallel,
+                  safe,
                   utf8-string
     Ghc-options:
                 -optc-O3
@@ -30,7 +32,7 @@ Library
                 -- for debugging.
                 -Wall
                 -Wextra
-                -Weverything
+--                -Weverything
 		-- for profiling.
     Exposed-Modules:
                     Graphics.Slicer

programs/extcuraengine.hs

@@ -74,7 +74,7 @@ import Graphics.Slicer.Machine.Infill (makeInfill, makeSupport)
 
 import Graphics.Slicer.Machine.Contour (cleanContour, shrinkContour, expandContour)
 
-import Graphics.Slicer.Machine.GCode (GCode(GCMarkOuterWallStart, GCMarkInnerWallStart, GCMarkInfillStart, GCMarkLayerStart, GCMarkSupportStart), cookExtrusions, make3DTravelGCode, make2DTravelGCode, addFeedRate, gcodeForContour, gcodeForInfill, gcodeToText)
+import Graphics.Slicer.Machine.GCode (GCode(GCMarkOuterWallStart, GCMarkInnerWallStart, GCMarkInfillStart, GCMarkLayerStart, GCMarkSupportStart), cookExtrusions, make3DTravelGCode, make2DTravelGCode, addFeedRate, gcodeForContour, gcodeForInfill, gcodeToText, gcodeToText')
 
 default (ℕ, Fastℕ, ℝ)
 
@@ -446,11 +446,12 @@ run rawArgs = do
       allLayers = layers print facets
       object = zip allLayers [(0::Fastℕ)..]
       (gcodes, _) = runState (sliceObject printer print object) (MachineState (EPos 0))
-      gcodesAsText = [gcodeToText gcode | gcode <- gcodes] `using` parListChunk (div (length gcodes) (fromFastℕ threads)) rseq
+      --gcodesAsText = [gcodeToText' gcode | gcode <- gcodes] `using` parListChunk (div (length gcodes) (fromFastℕ threads)) rseq
+      gcodesAsText = gcodeToText' gcodes
       layerCount = length allLayers
       outFile = fromMaybe "out.gcode" $ outputFileOpt args
     --error $ show allLayers
-    writeFile outFile $ startingGCode settings <> (";LAYER_COUNT:" <> fromString (show layerCount) <> "\n") <> unlines gcodesAsText <> endingGCode settings
+    writeFile outFile $ startingGCode settings <> (";LAYER_COUNT:" <> fromString (show layerCount) <> "\n") <> gcodesAsText <> endingGCode settings
       where
         -- The Printer.
         -- FIXME: pull defaults for these values from a curaengine json config.
@@ -541,6 +542,7 @@ run rawArgs = do
                       <> "M107 ;fan off\n"
                       <> "M84 ;steppers off\n"
                       <> "G90 ;absolute positioning\n"
+                      <> "M3"
 
 -- | The entry point. Use the option parser then run the slicer.
 main :: IO ()