Initial commit

src/dactyl_cave/alternathumb.clj

@@ -0,0 +1,149 @@
+(ns dactyl-cave.alternathumb
+  (:use [scad-clj.scad])
+  (:use [scad-clj.model])
+  (:use [unicode-math.core])
+  (:require [dactyl-cave.key :as key])
+  (:require [dactyl-cave.cave :as cave]))
+
+(defn- scoop [angle radius [x y :as direction] shape]
+  (->> shape
+       (translate [0 0 radius])))
+
+(defn thumb-x+x-column [shape]
+  (let [α (/ π 12)
+        radius (/ (/ key/pillar-depth 2)
+                  (Math/sin (/ α 2)))
+        spin-shape (->> shape
+                        (translate [0 0 (+ (- key/full-height)
+                                           (- radius))]))]
+    (translate
+     [0 0 (+ radius key/full-height)]
+     (union
+      spin-shape
+
+      (->> spin-shape
+           (rotate (- α) [1 0 0]))))))
+
+(defn thumb-2x-column [shape]
+  (let [α (/ π 12)
+        radius (/ (/ key/pillar-depth 2)
+                  (Math/sin (/ α 2)))
+        spin-shape (->> shape
+                        (translate [0 0 (+ (- key/full-height)
+                                           (- radius))]))]
+    (translate
+     [0 0 (+ radius key/full-height)]
+     (union
+      (->> spin-shape
+           (rotate (* α -1/2) [1 0 0]))))))
+
+(defn thumb-2x-row [shape]
+  (let [α (/ π 12)
+        radius (/ (/ key/pillar-depth 2)
+                  (Math/sin (/ α 2)))
+        spin-shape (->> shape
+                        (translate [0 0 (+ (- key/full-height)
+                                           (- radius))]))]
+    (translate
+     [0 0 (+ radius key/full-height)]
+     (union
+      (->> spin-shape
+           (rotate (* α 1) [1 0 0]))))))
+
+
+(defn spin-thumb [column shape]
+  (let [β (/ π 36)
+        radius (/ (/ (+ key/pillar-width 5) 2)
+                  (Math/sin (/ β 2)))]
+    (->>
+     (translate
+      [0 0 (- (- radius key/full-height))]
+      (->> shape
+           (translate [0 0 (- radius key/full-height)])
+           (rotate (* column β) [0 1 0])))
+     (translate [key/pillar-width 0 0])
+     (rotate (/ π 12) [0 0 1])
+     #_(rotate (/ π -12) [0 1 0])
+     #_(rotate (/ π 6) [0 0 1])
+     (translate [-7 -47 35]))))
+
+(defn thumb-layout [shape]
+  (union
+   (spin-thumb 2 (thumb-x+x-column shape))
+   (spin-thumb 1 (thumb-x+x-column shape))
+   (spin-thumb 0 (thumb-2x-column shape))
+   (spin-thumb 1/2 (thumb-2x-row shape))))
+
+(defn support [shape]
+  (hull
+   shape
+   (extrude-linear {:height 10 :twist 0 :convexity 0}
+                   (project (hull shape)))))
+
+(defn thumb-support [shape]
+  (union
+   (support (union
+             (spin-thumb 2 (thumb-x+x-column shape))
+             (spin-thumb 1 (thumb-x+x-column shape))
+             (spin-thumb 0 (thumb-2x-column shape))))
+   (support (union
+             (spin-thumb 0 (thumb-2x-column shape))
+             (spin-thumb 1/2 (thumb-2x-row shape))))
+   
+))
+
+(def bottom
+  (translate [0 0 -100]
+             (cube 2000 2000 200))
+  )
+
+
+#_(def thumb-base
+  (difference
+   (hull
+    (thumb-layout (translate [0 0 (/ key/pillar-height -2)]
+                             (scale [1 1 1/10] key/full-pillar)))
+    (extrude-linear {:height 10 :twist 0 :convexity 0}
+                    (project (hull (thumb-layout key/full-pillar)))))
+   bottom
+   (thumb-layout key/keyswitch-full-hole)))
+
+(def thumb-base
+  (union
+   (thumb-support (scale [1 1 1/10] key/full-pillar))
+   #_(->> (cube 150 150 50)
+        (translate [150 75 25])))
+
+  )
+
+(defn move-to-corner [shape]
+  (translate [-265 -215 0] shape))
+
+(def thumb-cluster
+  (difference
+   (translate [0 0 -20]
+              (difference
+               (union
+                (thumb-layout key/pillar)
+                thumb-base)
+               (thumb-layout key/keyswitch-full-hole)))
+   bottom))
+
+(spit "alternathumb.scad"
+      (write-scad (scale [(/ 25.4 90) (/ 25.4 90) (/ 25.4 90)]
+                         #_thumb-cluster
+                         (union
+                          (mirror [1 0 0] (move-to-corner thumb-cluster))
+                          #_(->> (move-to-corner thumb-cluster)
+                               (mirror [1 0 0]))
+                          #_cave/base
+                          #_cave/fingers
+                          )
+                         
+                         #_(mirror [1 0 0]
+                                 (difference
+                                  (move-to-corner thumb-cluster)
+                                  cave/base
+                                  ))
+                         )))
+

src/dactyl_cave/cave.clj

@@ -0,0 +1,337 @@
+(ns dactyl-cave.cave
+  (:use [scad-clj.scad])
+  (:use [scad-clj.model])
+  (:use [unicode-math.core])
+  (:use [dactyl-cave.key]))
+
+(defn key-place [column row shape]
+  (let [α (/ π 12)
+        row-radius (+ (/ (/ pillar-depth 2)
+                         (Math/sin (/ α 2)))
+                      full-height)
+        row-placed-shape (->> shape
+                              (translate [0 0 (- row-radius)])
+                              (rotate (* α (- 2 row)) [1 0 0])
+                              (translate [0 0 row-radius]))
+        β (/ π 36)
+        column-radius (+ (/ (/ (+ pillar-width 127/90) 2)
+                            (Math/sin (/ β 2)))
+                         full-height)
+        column-offset (condp = column
+                        2 [0 127/45 -254/45]
+                        4 [0 (/ pillar-depth -3) 254/45]
+                        5 [0 (/ pillar-depth -4) 254/45]
+                        [0 0 0])
+        column-angle (if (<= column 4)
+                       (* β (- 2 column))
+                       (* β -3.25))
+        placed-shape (->> row-placed-shape
+                          (translate [0 0 (- column-radius)])
+                          (rotate column-angle [0 1 0])
+                          (translate [0 0 column-radius])
+                          (translate column-offset))]
+    (translate [0 0 127/18]
+               (rotate (/ π 12) [0 1 0]
+                       placed-shape))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Limits
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(def bottom-limit
+  (->> (cube (* pillar-width 17.75)
+             (* pillar-depth 17)
+             508/9)
+       (translate [(+ (/ pillar-width 2) 127/45)
+                   0 -254/9])))
+
+(def back-limit
+  (->> (cube (* pillar-width 9)
+             (* pillar-depth 2)
+             254/3)
+       (translate [pillar-width
+                   (+ (* pillar-depth 4.1))
+                   254/9])))
+
+(def front-right-limit
+     (->> (cube (* pillar-width 2)
+              (* pillar-depth 2)
+              254/3)
+        (translate [(+ (* pillar-width 4.125))
+                    (+ (* pillar-depth -3.25))])))
+
+(def front-left-limit
+  (->> (cube (* pillar-width 2.5)
+             (* pillar-depth 2)
+             254/3)
+       (translate [(+ (* pillar-width -3))
+                   (+ (* pillar-depth -3))
+                   254/9])))
+
+(def front-limit
+  (->> (cube (* pillar-width 9)
+             (* pillar-depth 2)
+             254/3)
+       (translate [(* pillar-width 1/2) (+ (* pillar-depth -4.25)) 254/9])))
+
+ (* (/ 25.4 90) pillar-depth (- 3.1 -3.2))
+
+
+(def left-limit
+   (->> (cube (* pillar-width 1)
+              (* pillar-depth 8)
+              254/3)
+        (translate [(+ (* pillar-depth -3.25)) 0 254/9])))
+
+(def right-limit
+   (->> (cube (* pillar-width )
+                (* pillar-depth 8)
+                1016/9)
+        (translate [(+ (* pillar-depth 5.5)) 0 254/9]))  )
+
+(*  (/ 25.4 90) (- (- (* pillar-depth 5.4) (* pillar-width 1/2))
+                   (+ (* pillar-depth -3.25) (* pillar-width 1/2))
+                   ))
+
+(def limits
+   (union
+   #_front-right-limit
+   front-left-limit
+   front-limit
+   left-limit
+   right-limit
+   bottom-limit
+   back-limit))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Base
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(def main-sphere
+  (let [radius (/ (/ pillar-depth 2)
+                  (Math/sin (/ (/ π 36) 2)))]
+    (->> (sphere radius)
+         (translate [(* pillar-width 2.5) 0 (+ radius 127/90)])))  )
+
+(def base-cube
+  (->> (cube (* pillar-width 7.75)
+             (* pillar-depth 7)
+             508/9)
+       (translate [(+ (/ pillar-width 2) 2921/450)
+                   0 254/9])))
+
+(def base
+  (difference
+   base-cube
+   main-sphere
+   limits))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Walls
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+#_(def wall-sphere
+  (let [radius (/ (/ pillar-depth 2)
+                  (Math/sin (/ (/ π 36) 2)))]
+    (->> (sphere radius)
+         (scale [1 2/3 1])
+         (translate [(* pillar-width 2.5) 0 (+ radius 5 (* pillar-depth ))]))))
+
+(def wall-sphere
+  (let [radius (/ (/ pillar-depth 2)
+                  (Math/sin (/ (/ π 36) 2)))]
+    (->> (sphere radius)
+         (scale [1 2/3 1])
+         (translate [0 0 radius])
+         (translate [0 0 127/18])
+         (rotate (/ π 12) [0 1 0])
+         (translate [0 0 (* pillar-depth 3/4)]))))
+
+(def wall-thickness 127/30)
+
+(def back-wall
+  (difference
+   (translate [0 (- wall-thickness) 0] back-limit)
+   back-limit
+   right-limit
+   left-limit
+   bottom-limit
+   wall-sphere))
+
+(def walls
+  (difference
+   (union
+    (translate [0 (- wall-thickness) 0] back-limit)
+    (translate [(- wall-thickness) 0 0] right-limit)
+    (translate [0 wall-thickness 0] front-limit)
+    (translate [wall-thickness 0 0] left-limit)    
+    )
+   wall-sphere
+   limits))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Wire holes
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(def teensy-center [(* -1.6 pillar-width)
+                    (* 2.8 pillar-depth)
+                    254/45])
+
+(def teensy-tray-slot
+  (->> (cube (* 1.125 pillar-width)
+             40
+             508/45)
+       (translate teensy-center)))
+
+(def hole-destination
+  (->> (cube 5.7 5.7 5.7)
+       (translate [(first teensy-center)
+                   (second teensy-center)
+                   2.8 #_3.1])))
+
+(defn bottom-cube [column row]
+  (->> (cube 6 6 6)
+       (key-place column row)
+       (project)
+       (extrude-linear {:height 5.7 :twist 0 :convexity 0})
+       (translate [0 0 2.8])))
+
+(defn wire-hole [column row]
+  (union
+   (hull
+    (key-place column row (cube 6 6 keyswitch-height))
+    (bottom-cube column row))
+   (hull
+    hole-destination
+    (bottom-cube column row))))
+
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Full Model
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(def fingers
+  (let [all-key-coords (for [column (range 0 6)
+                         row (range 0 5)
+                         ;; Removing bottom left key
+                         :when (or (not= column 0)
+                                   (not= row 4))]
+                         [column row])
+        middle-key-coords (for [column (range 0 6)
+                                row (range 1 4)
+                                ;; Removing bottom left key
+                                :when (or (not= column 0)
+                                          (not= row 4))]
+                            [column row])
+        top-key-coords (for [column (range 0 6)]
+                         [column 0])
+        bottom-key-coords (conj (for [column (range 1 6)]
+                                  [column 4])
+                                [0 3])        
+
+        ]
+    (difference
+     (union base
+            #_walls
+            (apply union
+                   (map #(key-place (first %) (second %)
+                                    (->> (cube pillar-width  pillar-depth
+                                               (* 3 pillar-height))
+                                         (translate [0 0 (/ pillar-height -2)])))
+                        all-key-coords)))
+     (apply union
+            (concat
+             (map #(key-place (first %) (second %) keyswitch-full-hole)
+                  middle-key-coords)
+             (map #(key-place (first %) (second %) keyswitch-bottom-hole)
+                  top-key-coords)
+             (map #(key-place (first %) (second %) (mirror [0 -1 0] keyswitch-bottom-hole))
+                  bottom-key-coords)
+             ))
+     limits
+     teensy-tray-slot)))
+
+
+(def wire-network
+  (union
+   (wire-hole 0 0)
+   (wire-hole 1 0)
+   (wire-hole 2 0)
+   (wire-hole 3 0)
+   (wire-hole 4 0)
+   (wire-hole 5 0)
+   (wire-hole 0 1)
+   (wire-hole 0 2)
+   (wire-hole 0 3)
+   (wire-hole 0 4)   
+   (wire-hole 1 4)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Actual Output
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+#_(spit "key.scad"
+      (write-scad (difference
+                   pillar
+                   )))
+
+(spit "key.scad"
+      (write-scad (difference
+                   (union
+                    #_walls
+                    #_wall-sphere
+                    #_fingers
+                    (difference fingers wire-network)
+                    #_(mirror [-1 0 0]
+                              (difference fingers wire-network))
+                    )
+                   #_(cube 400 800 800)
+                   )))
+
+#_(spit "key.scad"
+      (write-scad (scale [(/ 25.4 90) (/ 25.4 90) (/ 25.4 90)]
+                         (difference
+                          (union
+                           #_walls
+                           #_wall-sphere
+                           #_fingers
+                           (difference fingers wire-network)
+                           #_(mirror [-1 0 0]
+                                     (difference fingers wire-network))
+                           )
+                          #_(cube 400 800 800)
+                          ))))
+
+
+#_(spit "key.scad"
+      (write-scad (scale [(/ 25.4 90) (/ 25.4 90) (/ 25.4 90)]
+                         (difference
+                          fingers
+                          wire-hole-1
+                          wire-hole-2))))
+
+#_(spit "key.scad"
+      (write-scad (scale [(/ 25.4 90) (/ 25.4 90) (/ 25.4 90)]
+                         (differe
+                          #_wall
+                          #_base
+                          #_rim
+                          #_(mirror [1 0 0] fingers)
+                          fingers
+                          wire-hole-1))))
+
+#_(spit "key.scad"
+      (write-scad (scale [(/ 25.4 90) (/ 25.4 90) (/ 25.4 90)]
+                         (union
+                          fingers
+                          (->> fingers
+                               project
+                               (extrude-linear {:height 1 :twist 0 :convexity 0})
+                               (scale [1.5 1.15 1])
+                               )
+                          )
+                         )))
+

src/dactyl_cave/core.clj

@@ -0,0 +1,6 @@
+(ns dactyl-cave.core)
+
+(defn foo
+  "I don't do a whole lot."
+  [x]
+  (println x "Hello, World!"))

src/dactyl_cave/key.clj

@@ -0,0 +1,81 @@
+(ns dactyl-cave.key
+  (:use [scad-clj.scad])
+  (:use [scad-clj.model])
+  (:use [unicode-math.core]))
+
+
+(def tw 13.969999999999999)     ;; Top width
+(def smh 0.98044)   ;; Side margin height
+(def pw 0.8128)     ;; Peg width
+(def ph 3.5001199999999995)   ;; Peg height
+(def pgh 5.00888)  ;; Peg gap height
+
+(def keyswitch-height (+ smh ph pgh ph smh))
+(def keyswitch-width (+ pw tw pw))
+(def plate-height 254/45)
+
+(defn- flip-path [points] (map (partial map -) points))
+
+(def keyswitch-plate-hole-shape
+  (polygon [[0.8128 0] [0.8128 0.98044] [0.0 0.98044] [0.0 4.48056] [0.8128 4.48056] [0.8128 9.48944] [0.0 9.48944] [0.0 12.98956] [0.8128 12.98956] [0.8128 13.969999999999999] [14.7828 13.969999999999999] [14.7828 12.98956] [15.5956 12.98956] [15.5956 9.48944] [14.7828 9.48944] [14.7828 4.48056] [15.5956 4.48056] [15.5956 0.98044] [14.7828 0.98044] [14.7828 0]]))
+
+(def keyswitch-plate-hole
+  (->> keyswitch-plate-hole-shape
+       (extrude-linear {:height plate-height :twist 0 :convexity 0})
+       (translate (map #(/ (- %) 2) [keyswitch-width keyswitch-height 0]))
+       (translate [0 0 1])))
+
+(def hole-height 127/18)
+
+(def pillar-width (+ keyswitch-width 127/45))
+(def pillar-height (+ hole-height (/ plate-height 2)))
+(def pillar-depth (+ keyswitch-height 127/30))
+
+(def keyswitch-full-hole
+  (->>
+   (union
+    keyswitch-plate-hole
+    (->> (cube (/ ph 2) pillar-depth (* plate-height 2))
+         (translate [(* tw -1/4) 0 0]))
+    (->> (cube (/ ph 2) pillar-depth (* plate-height 2))
+         (translate [(* tw 1/4) 0 0]))    
+    (translate
+     [0 0 (/ hole-height -2)]
+     (cube keyswitch-width
+           keyswitch-height
+           hole-height)))
+   (translate [0 0 hole-height])))
+
+(def keyswitch-bottom-hole
+  (->>
+   (union
+    keyswitch-plate-hole
+    (->> (cube (/ ph 2) (/ pillar-depth 2) (* plate-height 2))
+         (translate [(* tw -1/4) (/ pillar-depth -2) 0]))
+    (->> (cube (/ ph 2) (/ pillar-depth 2) (* plate-height 2))
+         (translate [(* tw 1/4) (/ pillar-depth -2) 0]))    
+    (translate
+     [0 0 (/ hole-height -2)]
+     (cube keyswitch-width
+           keyswitch-height
+           hole-height)))
+   (translate [0 0 hole-height])))
+
+(def full-pillar
+  (->> (cube pillar-width  pillar-depth
+             pillar-height)
+       (translate [0 0 (/ pillar-height 2)])))
+
+(def pillar
+  (difference
+   full-pillar
+   keyswitch-full-hole))
+
+(def key-height 127/10)
+
+(def pillar-with-fake-key
+  (union pillar
+         (->> (cube (+ -0 pillar-width) (+ -0 pillar-depth) key-height)
+              (translate [0 0 (+ (/ key-height 2) pillar-height 127/450)]))))
+
+(def full-height (+ pillar-height key-height 127/450))

src/dactyl_cave/text.clj

@@ -0,0 +1,134 @@
+(ns dactyl-cave.text
+  (:use [scad-clj.scad])
+  (:use [scad-clj.model])
+  (:import (java.awt Font RenderingHints)
+           (java.awt.font FontRenderContext)
+           (java.awt.geom PathIterator)))
+
+(def segment-type
+  {PathIterator/SEG_CLOSE :close
+   PathIterator/SEG_CUBICTO :cubic-to
+   PathIterator/SEG_LINETO :line-to
+   PathIterator/SEG_MOVETO :move-to
+   PathIterator/SEG_QUADTO :quad-to})
+
+;; How many points are specified for each segment type
+(def segment-length
+  {PathIterator/SEG_CLOSE 0
+   PathIterator/SEG_CUBICTO 3
+   PathIterator/SEG_LINETO 1
+   PathIterator/SEG_MOVETO 1
+   PathIterator/SEG_QUADTO 2})
+
+(defn path-iterator->segments
+  "Converts a PathIterator into a sequence of segments of the form [segment-type [& points]]"
+  [^PathIterator path-iterator]
+  (if (not (.isDone path-iterator))
+    (let [coords (double-array (* 2 (apply max (vals segment-length))))
+          segment-code (.currentSegment path-iterator coords)]
+      (cons [(segment-type segment-code)
+             (take (segment-length segment-code) (partition 2 coords))]
+            (lazy-seq (path-iterator->segments (doto path-iterator (.next))))))))
+
+(defn quad->fn
+  "Returns the parametric control equation f(t), 0 <= t <= 1
+for the quadratic interpolation of 3 points."
+  [cp p1 p2]
+  (fn [t]
+    (letfn [(interp [a b c] (+ (* (Math/pow (- 1 t) 2) a)
+                               (* 2 t (- 1 t) b)
+                               (* (Math/pow t 2) c)))]
+      [(apply interp (map first [cp p1 p2]))
+       (apply interp (map second [cp p1 p2]))])))
+
+(defn cubic->fn
+  "Returns the parametric control equation f(t), 0 <= t <= 1
+for the cubic interpolation of 4 points."  
+  [cp p1 p2 p3]  
+  (fn [t]
+    (letfn [(interp [a b c d]
+              (+ (* (Math/pow (- 1 t) 3) a)
+                 (* 3 t (Math/pow (- 1 t) 2) b)
+                 (* 3 (Math/pow t 2) (- 1 t) c)                                
+                 (* (Math/pow t 3) d)))]
+      [(apply interp (map first [cp p1 p2 p3]))
+       (apply interp (map second [cp p1 p2 p3]))])))
+
+(defn segments->lines
+  "Takes a sequence of segments of the form [segment-type [& points]]
+and transforms each segment into a sequence of interpolated points"
+  [segments]
+  (reductions (fn [prev-line-points [segment-type control-points]]
+                #_(println segment-type)
+                (condp = segment-type
+                  :move-to control-points
+                  :line-to control-points
+                  :quad-to (map (apply quad->fn
+                                       (last prev-line-points)
+                                       control-points)
+                                (range 1/10 11/10 1/10))                    
+                  :cubic-to (map (apply cubic->fn
+                                        (last prev-line-points)
+                                        control-points)
+                                 (range 1/10 11/10 1/10))))
+              (last (rest (first segments)))
+              (rest segments)))
+
+
+(defn path2d [points]
+  (let [path (doto (java.awt.geom.Path2D$Double.)
+               (.moveTo (-> points first first)
+                        (-> points first second)))]
+    (doseq [point (rest points)]
+      (.lineTo path (first point) (second point)))
+    path))
+
+(defn split-intersecting [paths]
+  (let [polygons (map path2d paths)
+        starting-points (map first paths)]
+    (reduce (fn [acc path]
+              (let [polygon (path2d path)]
+                (if (some #(.contains % (-> path first first) (-> path first second))
+                          (:polygons acc))
+                  (merge-with concat acc
+                              {:difference [path]})
+                  (merge-with concat acc
+                              {:polygons [polygon]
+                               :union [path]}))))
+            {:polygons []
+             :union []
+             :difference []}
+            paths)))
+
+(defn text-polygon [font size text]
+  (let [frc (FontRenderContext. nil
+                                RenderingHints/VALUE_TEXT_ANTIALIAS_DEFAULT
+                                RenderingHints/VALUE_FRACTIONALMETRICS_DEFAULT)
+        path-iter (-> (Font. font Font/PLAIN size)
+                      (.createGlyphVector frc text)
+                      (.getOutline)
+                      (.getPathIterator nil))
+        paths (->> (path-iterator->segments path-iter)
+                   (partition-by #(= (first %) :close))
+                   (take-nth 2)
+                   (map segments->lines)
+                   (map flatten)
+                   (map (partial partition 2)))
+        split-paths (split-intersecting paths)]
+    (difference
+     (apply union (map polygon (:union split-paths)))
+     (apply union (map polygon (:difference split-paths))))))
+
+(spit "/Users/madereth/text.scad"
+      (write-scad
+       (->> "Anonymous Pro" #_(str (java.util.Date.))
+        (text-polygon "Anonymous Pro" 12)
+        (extrude-linear {:height 50 :twist 0 :convexity 0}))))
+
+
+
+(spit "/Users/madereth/text.scad"
+      (write-scad
+       (->> "Anonymous Pro" #_(str (java.util.Date.))
+        (text-polygon "Anonymous Pro" 12)
+        (extrude-linear {:height 12 :twist 0 :convexity 0}))))

src/dactyl_cave/thumb.clj

@@ -0,0 +1,173 @@
+(ns dactyl-cave.thumb
+  (:use [scad-clj.scad])
+  (:use [scad-clj.model])
+  (:use [unicode-math.core])
+  (:require [dactyl-cave.key :as key])
+  (:require [dactyl-cave.cave :as cave]))
+
+(defn thumb-place [column row shape]
+  (let [α (/ π 12)
+        row-radius (+ (/ (/ key/pillar-depth 2)
+                         (Math/sin (/ α 2)))
+                      key/full-height)
+        β (/ π 36)
+        column-radius (+ (/ (/ (+ key/pillar-width 5) 2)
+                            (Math/sin (/ β 2)))
+                         key/full-height)]
+    (->> shape
+         (translate [0 0 (- row-radius)])
+         (rotate (* α row) [1 0 0])
+         (translate [0 0 row-radius])
+         (translate [0 0 (- column-radius)])
+         (rotate (* column β) [0 1 0])
+         (translate [0 0 column-radius])
+         (translate [key/pillar-width 0 0])
+         (rotate (/ π 12) [0 1 0])
+         (rotate (* π (- 1/4 1/16)) [0 0 1])
+         (rotate (/ π 12) [1 1 0])
+         (translate [254/45 127/15 1778/45]))))
+
+(defn thumb-2x-column [shape]
+  (thumb-place 0 -1/2 shape))
+
+(defn thumb-2x+1-column [shape]
+  (union (thumb-place 1 -1/2 shape)
+         (thumb-place 1 1 shape)))
+
+(defn thumb-1x-column [shape]
+  (union (thumb-place 2 -1 shape)
+         (thumb-place 2 0 shape)
+         (thumb-place 2 1 shape)))
+
+(defn thumb-layout [shape]
+  (union
+   (thumb-2x-column shape)
+   (thumb-2x+1-column shape)
+   (thumb-1x-column shape)))
+
+(defn support [shape]
+  (hull
+   shape
+   (extrude-linear {:height 127/45 :twist 0 :convexity 0}
+                   (project (hull shape)))))
+
+(defn thumb-support [shape]
+  (let [column-supports
+        (union
+         (support (thumb-2x-column shape))
+         (support (thumb-2x+1-column shape))
+         (support (thumb-1x-column shape)))]
+    (union column-supports
+           (support column-supports))))
+(fn [])
+(def bottom
+  (translate [0 0 -254/9] (cube 5080/9 5080/9 508/9)))
+
+(def thumb-base
+  (thumb-support (scale [1 1 1/10] key/full-pillar)))
+
+#_(defn move-to-corner [shape]
+  (translate [-6731/90 -5461/90 0] shape))
+
+(defn move-to-corner [shape]
+  (translate [(+ -6731/90 10) (- -5461/90 10) 0] shape))
+
+(/ -6731 90.0) -74.78888888888889
+(double -5461/90) -60.67777777777778
+
+(def thumb-cluster
+  (difference
+   (translate [0 0 -254/45]
+              (difference
+               (union
+                (thumb-layout key/pillar)
+                thumb-base)
+               (thumb-layout key/keyswitch-full-hole)))
+   bottom))
+
+(def connection-stems
+  (difference
+   (hull (union
+          (->> (cylinder 127/90 508/9)
+               (translate [-0 -2413/45 0]))
+          (->> (cylinder 127/90 508/9)
+               (translate [-127/3 -0 0]))
+          (->> (cylinder 127/90 508/9)
+               (translate [-2159/30 -127/5 0]))
+          (->> (cylinder 127/90 508/9)
+               (translate [-508/9 -381/5 0]))))
+   bottom
+   cave/main-sphere
+   (translate [0 0 -254/45]
+              (thumb-layout key/keyswitch-full-hole))))
+
+(def wire-network
+  (apply union
+         (for [[column row] [[0 -1/2]
+                             [1 -1/2]
+                             [1 1]
+                             [2 -1]
+                             [2 0]
+                             [2 1]]]
+           (let [middle-hole (->> (thumb-place column row (cube 6 6 6))
+                                  (translate [0 0 -127/9])
+                                  move-to-corner)]
+             #_(thumb-place column row (sphere 127/9))
+             (union (hull (->> (cube 254/45 254/45 key/keyswitch-height)
+                               (thumb-place column row)
+                               move-to-corner)
+                          middle-hole)
+                    (hull middle-hole (cave/bottom-cube 0 4))
+                    (hull (cave/bottom-cube 0 4) cave/hole-destination))))))
+
+
+(spit "thumb.scad"
+      (write-scad (difference
+                   (union
+                    (move-to-corner thumb-cluster)
+                    connection-stems
+                    
+                    #_cave/base
+                    #_cave/fingers)
+                   cave/base
+                   wire-network)))
+
+#_(spit "thumb.scad"
+      (write-scad (scale [(/ 25.4 90) (/ 25.4 90) (/ 25.4 90)]
+                         (mirror [-1 0 0]
+                                 (difference
+                                  (union
+                                   (move-to-corner thumb-cluster)
+                                   connection-stems
+                                   
+                                   #_cave/base
+                                   #_cave/fingers)
+                                  cave/base
+                                  wire-network)))))
+
+#_(spit "thumb.scad"
+      (write-scad (scale [(/ 25.4 90) (/ 25.4 90) (/ 25.4 90)]
+                         (mirror [-1 0 0]
+                                 (difference
+                                  (union
+                                   (move-to-corner thumb-cluster)
+                                   connection-stems
+                                   
+                                   #_cave/base
+                                   #_cave/fingers)
+                                  cave/base
+                                  wire-network)))))
+
+
+
+
+(spit "one-piece.scad"
+      (write-scad
+       (mirror [-1 0 0]
+               (union (difference cave/fingers cave/wire-network)
+                      (difference
+                       (union
+                        (move-to-corner thumb-cluster)
+                        connection-stems)
+                       cave/base
+                       wire-network)))))

src/scad_demo/core.clj

@@ -0,0 +1,11 @@
+(ns scad-demo.core
+  (:use [scad-clj.scad])
+  (:use [scad-clj.model]))
+
+(def primitives
+  (union
+   (union)
+   (->> (sphere 50))))
+
+(spit "post-demo.scad"
+      (write-scad primitives))