Prototype for write and read binary gcode files minimizing file size up to 50%

binarygcode.read.clj

(ns jtk-dvlp.threed-wifi.binarygcode.read
  (:require
   [clojure.java.io :as io]
   [clojure.string :as str]))


(defn bytes-seq
  [x & opts]
  (lazy-seq
    (when-let [stream (if (instance? java.io.InputStream x) x (apply io/input-stream x opts))]
      (try
        (if (> (.available stream) 0)
          (cons (.read stream) (bytes-seq stream))
          (.close stream))
        (catch Throwable e
          (.close stream)
          (throw e))))))

(defn- bits->integer
  [size bits]
  (let [bits (take size bits)]
    (when (>= (count bits) size)
      (->> bits
           (reverse)
           (reduce
            (fn [byte bit]
              (-> byte
                  (bit-shift-left 1)
                  (bit-or (if bit 1 0))))
            0)
           (unchecked-int)))))

(defn- bits->float
  [size bits]
  (->> bits
       (bits->integer size)
       (#(Float/intBitsToFloat %))))

(defn- parse-command-letter
  [{:keys [bits] :as context}]
  (when-let [letter (some->> bits (bits->integer 4) (#(nth ["G" "M" "T"] % nil)))]
    (-> context
        (assoc :letter letter)
        (update :bits #(drop 4 %)))))

(defn- parse-command-number
  [{:keys [bits] :as context}]
  (when-let [number (some->> bits (bits->integer 10))]
    (-> context
        (assoc :number number)
        (update :bits #(drop 10 %)))))

(defn- parse-command
  [context]
  (when-let [{:keys [letter number bits]}
             (some-> context
                     (parse-command-letter)
                     (parse-command-number))]

    (-> context
        (assoc :bits bits)
        (assoc-in [:command :letter] letter)
        (assoc-in [:command :number] number))))

(defn- parse-argument-letter
  [{:keys [bits] :as context}]
  (when-let [letter (some->> bits (bits->integer 4) (#(nth [nil nil nil "F" "X" "Y" "Z" "E" "S"] % nil)))]
    (-> context
        (assoc :letter letter)
        (update :bits #(drop 4 %)))))

(defn- parse-argument-number
  [{:keys [bits] :as context}]
  (if-let [number (some->> bits (bits->float 32))]
    (-> context
        (assoc-in [:number] number)
        (update :bits #(drop 32 %)))
    context))

(defn- parse-argument
  [context]
  (when-let [{:keys [letter number bits]}
             (some-> context
                     (parse-argument-letter)
                     (parse-argument-number))]

    (-> context
        (assoc :bits bits)
        (assoc-in [:argument :letter] letter)
        (assoc-in [:argument :number] number))))

(defn- parse-arguments
  [context]
  (loop [context context]
    (if-let [{:keys [argument bits]} (parse-argument context)]
      (-> context
          (assoc :bits bits)
          (update :arguments conj argument)
          (recur))
      context)))

(defn- bits->gocde-line
  [context]
  (some-> context
          (parse-command)
          (parse-arguments)))

(defn- bits->gcode-lines-seq
  [bits]
  (lazy-seq
    (when-let [stream (if (map? bits) bits (bits->gocde-line {:bits bits}))]
      (cons (dissoc stream :bits)
            (-> stream
                (select-keys [:bits])
                (bits->gocde-line)
                (bits->gcode-lines-seq))))))

(defn- byte->bits
  [byte]
  (map (partial bit-test byte) (range 8)))

(defn gcode-lines-seq
  [x]
  (->> (if (sequential? x) x (bytes-seq x))
       (mapcat byte->bits)
       (bits->gcode-lines-seq)))

(defn ->gcode-str
  [{:keys [command arguments]}]
  (let [->letter-number-str
        #(str (:letter %) (:number %))]

    (->> (reverse arguments)
         (cons command)
         (map ->letter-number-str)
         (str/join " "))))

binarygcode.write.clj

(ns jtk-dvlp.threed-wifi.binarygcode.write
  (:require
   [clojure.java.io :as io]
   [clojure.string :as str]

   [instaparse.core :as insta
    :refer [defparser]]))

(defn apply-parser
  [parser string]
  (let [parsed-data
        (-> string
            (str/trim)
            (parser))]

    (when-not (insta/failure? parsed-data)
      parsed-data)))

(defn ->map [[_group & entries]]
  (into {} entries))

(defparser command-parser
  "<result> = command (space argument)*
   command = letter number
   argument = letter number?
   letter = #'[GMTFXYZES]'
   number = (integer|float)
   integer = #'-?\\d+'
   float = #'-?\\d+(\\.\\d+)?'
   <space> = <#'\\s+'>")

(defn parse-gcode-line
  [string]
  (some->> string
           (apply-parser command-parser)
           (insta/transform {:integer read-string
                             :float read-string})
           ((fn [[command & arguments]]
              {:command (->map command)

               :arguments
               (mapv ->map arguments)}))))

(defn- conj-bits
  [size bits x]
  (->> size
       (range)
       (map (partial bit-test x))
       (concat bits)))

(defn- conj-command-letter
  [bits letter]
  (case letter
    "G" (conj-bits 4 bits 0)
    "M" (conj-bits 4 bits 1)
    "T" (conj-bits 4 bits 2)))

(def ^:private conj-command-number
  (partial conj-bits 10))

(defn- conj-command
  [bits {:keys [letter number]}]
  (-> bits
      (conj-command-letter letter)
      (conj-command-number number)))

(defn- conj-argument-letter
  [bits letter]
  (case letter
    "F" (conj-bits 4 bits 3)
    "X" (conj-bits 4 bits 4)
    "Y" (conj-bits 4 bits 5)
    "Z" (conj-bits 4 bits 6)
    "E" (conj-bits 4 bits 7)
    "S" (conj-bits 4 bits 8)))

(defn- conj-argument-number
  [bits number]
  (->> number
       (#(Float/floatToRawIntBits %))
       (conj-bits 32 bits)))

(defn- conj-argument
  [bits {:keys [letter number]}]
  (-> bits
      (conj-argument-letter letter)
      (conj-argument-number (or number 0))))

(defn- conj-arguments
  [bits arguments]
  (reduce conj-argument bits arguments))

(defn- gcode-line->bits
  [{:keys [command arguments]}]
  (-> []
      (conj-command command)
      (conj-arguments arguments)))

(defn- bits->byte
  [bits]
  (reduce
   (fn [byte bit]
     (-> byte
         (bit-shift-left 1)
         (bit-or (if bit 1 0))))
   0 (reverse (take 8 (concat bits (repeat 0))))))

(defn gcode-bytes-seq
  [x]
  (->> (if (sequential? x) x (line-seq (io/reader x)))
       (map parse-gcode-line)
       (mapcat gcode-line->bits)
       (partition-all 8)
       (map bits->byte)))

see MarlinFirmware/Marlin#20255