2 ;; Atreus 2 deck design
3 ;; Copyright © 2019 Phil Hagelberg and contributors
4 ;; released under the GPLv3 or later
7 ;; * port notch on bottom plate and spacer
12 ;; glowforge uses 96 dpi, 25.4 mm in an inch
13 (define scale (/ 96 25.4))
18 (define cols 6) ; per hand
20 (define angle (degrees->radians 10))
21 (define corner-radius 6.0)
23 (define alps-switch-width 15.887)
24 (define alps-switch-height 13.087)
25 (define cherry-switch-width 13.62)
26 (define cherry-switch-height 13.72)
28 (define switch-height (if cherry? cherry-switch-height alps-switch-height))
29 (define switch-width (if cherry? cherry-switch-width alps-switch-width))
31 (define switch-spacing 19.0)
33 (define screw-radius 1.4) ; for M3 screws + kerf
35 (define side-screw-distance (* switch-spacing rows))
36 (define bottom-screw-distance (* switch-spacing cols))
37 (define left corner-radius)
38 (define bottom 95) ; outer bottom
39 (define left-top (+ left (* side-screw-distance (sin angle))))
40 (define top (- bottom (* side-screw-distance (cos angle))))
41 (define right (- width corner-radius))
42 (define right-top (- right (* side-screw-distance (sin angle))))
43 (define mid-bottom (+ bottom (* bottom-screw-distance (sin angle)) -3))
44 (define mid-offset 25)
45 (define mid-x (/ width 2))
46 (define mid-left (- mid-x mid-offset))
47 (define mid-right (+ mid-x mid-offset))
49 (define upper-height 75)
50 (define left-upper-top (+ left-top (* upper-height (sin angle))))
51 (define right-upper-top (- right-top (* upper-height (sin angle))))
52 (define upper-top (- top (* upper-height (cos angle))))
54 (define hull-coords (list (list right-upper-top upper-top)
57 (list mid-right mid-bottom)
58 (list mid-left mid-bottom)
61 (list left-upper-top upper-top)))
65 `(g () ,@(for/list ([s (append (take hull-coords 3)
66 ;; the bottom middle has only one screw but
68 (list (list (/ width 2) mid-bottom))
69 (drop hull-coords 5))])
70 `(circle ((r ,(number->string screw-radius))
71 (cx ,(number->string (first s)))
72 (cy ,(number->string (second s))))))))
75 (define outline-coords (append hull-coords (take hull-coords 2)))
77 (define (to-next-screw? theta current-screw)
78 (let* ([current (list-ref outline-coords current-screw)]
79 [cx (first current)] [cy (second current)]
80 [next (list-ref outline-coords (add1 current-screw))]
81 [nx (first next)] [ny (second next)]
82 [dx (- nx cx)] [dy (- ny cy)]
83 [next-theta (- (radians->degrees (atan dy dx)))])
84 (= (floor (modulo (floor next-theta) 180))
85 (floor (modulo (- theta 90) 180)))))
87 ;; trace the outline by going from screw to screw until you've gone full-circle
88 (define (outline-points coords theta current-screw)
89 (if (< -360 (- theta 90) 360)
90 (let* ([current (list-ref outline-coords current-screw)]
91 [sx (first current)] [sy (second current)]
92 [x (+ sx (* (cos (degrees->radians theta)) corner-radius))]
93 [y (- sy (* (sin (degrees->radians theta)) corner-radius))]
94 [coords (cons (format "~s,~s" x y) coords)])
95 (if (to-next-screw? theta current-screw)
96 (begin (printf "~a~n" current)
97 (outline-points coords theta (add1 current-screw)))
98 (outline-points coords (sub1 theta) current-screw)))
101 (define port-depth 8)
103 (define port-curve (list (format "~s,~s" mid-right (- top corner-radius))
104 (format "~s,~s" (+ mid-x corner-radius)
107 (format "~s,~s" (- mid-x corner-radius)
110 (format "~s,~s" mid-left (- top corner-radius))))
112 (define (outline with-port?)
113 `(polygon ((points ,(string-join (let ((noport (outline-points '() 90 0)))
115 (append noport port-curve)
120 (define column-offsets `(8 5 0 6 11 ,(+ 8 switch-spacing switch-spacing)))
122 (define (switch row col)
123 (let* ([x (* (+ 1 col) switch-spacing)]
124 [y (+ (list-ref column-offsets col) (* switch-spacing row))])
125 `(rect ((height ,(number->string switch-height))
126 (width ,(number->string switch-width))
127 (x ,(number->string x))
128 (y ,(number->string y))))))
130 (define hand-height (+ (* switch-spacing rows) (- switch-spacing switch-height)
131 (list-ref column-offsets 0)))
132 (define switch-x-offset -6.5)
133 (define switch-y-offset (- bottom hand-height -3.5))
136 `(g ((transform ,(format "translate(~s, ~s) rotate(~s, ~s, ~s)"
137 switch-x-offset switch-y-offset
138 (radians->degrees angle)
140 ,@(for/list ([col (in-range cols)]
142 [row (if (= 5 col) '(0 1) (in-range rows))])
145 (define switches-right
146 `(g ((transform ,(format "translate(~s,~s) scale(-1, 1)" width 0)))
149 (define logo-doc (call-with-input-file "logo-fragment.svg" read-xml))
151 (define pcb-doc (call-with-input-file "pcb-fragment.svg" read-xml))
153 (define (layer plate)
154 (document (prolog '() false '())
156 `(svg ((xmlns:svg "http://www.w3.org/2000/svg")
157 (height ,(number->string (* height scale)))
158 (width ,(number->string (* width scale))))
159 ,@(if (eq? plate 'switch)
160 `((g ((transform ,(format "translate(436, ~s)"
161 (+ (* scale upper-height) 115)))
163 ,(xml->xexpr (document-element logo-doc))))
165 ,@(if (eq? plate 'spacer)
166 (list (xml->xexpr (document-element pcb-doc)))
168 (g ((transform ,(format "scale(~s, ~s) translate(0, ~s)"
169 scale scale upper-height))
174 ,(outline (not (eq? plate 'switch)))
175 ,@(if (eq? plate 'switch)
176 (list switches switches-right)
180 ;; to laser cut these, you have to open them in inkscape, then save,
181 ;; and then upload; for some reason the glowforge crashes if you try to cut
184 (define (write-out-layer layer-name)
185 (call-with-output-file (format "deck-~a.svg" (symbol->string layer-name))
187 (display "<?xml version=\"1.0\" encoding=\"UTF-8\" standalone=\"no\"?>" out)
188 (display-xml (layer layer-name) out))
192 ;; qiv --watch deck-switch.svg
194 (write-out-layer 'switch)
195 ;; (write-out-layer 'bottom)
196 ;; (write-out-layer 'spacer)