case/deck.rkt

   1 #lang racket
   2 ;; Atreus 2 deck design
   3 ;; Copyright © 2019 Phil Hagelberg and contributors
   4 ;; released under the GPLv3 or later
   5
   6 ;; TODO:
   7 ;; * port notch on bottom plate and spacer
   8 ;; * top layer
   9
  10 (require xml)
  11
  12 ;; glowforge uses 96 dpi, 25.4 mm in an inch
  13 (define scale (/ 96 25.4))
  14 (define width 260)
  15 (define height 232)
  16
  17
  18 (define cols 6) ; per hand
  19 (define rows 4)
  20 (define angle (degrees->radians 10))
  21 (define corner-radius 6.0)
  22
  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)
  27 (define cherry? true)
  28 (define switch-height (if cherry? cherry-switch-height alps-switch-height))
  29 (define switch-width (if cherry? cherry-switch-width alps-switch-width))
  30
  31 (define switch-spacing 19.0)
  32
  33 (define screw-radius 1.4) ; for M3 screws + kerf
  34
  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))
  48
  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))))
  53
  54 (define hull-coords (list (list right-upper-top upper-top)
  55                           (list right-top top)
  56                           (list right bottom)
  57                           (list mid-right mid-bottom)
  58                           (list mid-left mid-bottom)
  59                           (list left bottom)
  60                           (list left-top top)
  61                           (list left-upper-top upper-top)))
  62
  63 ;;; screws
  64 (define screws
  65   `(g () ,@(for/list ([s (append (take hull-coords 3)
  66                                  ;; the bottom middle has only one screw but
  67                                  ;; two hull positions
  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))))))))
  73
  74 ;;; outline
  75 (define outline-coords (append hull-coords (take hull-coords 2)))
  76
  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)))))
  86
  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)))
  99       coords))
 100
 101 (define port-depth 8)
 102
 103 (define port-curve (list (format "~s,~s" mid-right (- top corner-radius))
 104                          (format "~s,~s" (+ mid-x corner-radius)
 105                                  (+ top port-depth
 106                                     (- corner-radius)))
 107                          (format "~s,~s" (- mid-x corner-radius)
 108                                  (+ top port-depth
 109                                     (- corner-radius)))
 110                          (format "~s,~s" mid-left (- top corner-radius))))
 111
 112 (define (outline with-port?)
 113   `(polygon ((points ,(string-join (let ((noport (outline-points '() 90 0)))
 114                                      (if with-port?
 115                                          (append noport port-curve)
 116                                          noport)))))))
 117
 118 ;;; switches
 119
 120 (define column-offsets `(8 5 0 6 11 ,(+ 8 switch-spacing switch-spacing)))
 121
 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))))))
 129
 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))
 134
 135 (define switches
 136   `(g ((transform ,(format "translate(~s, ~s) rotate(~s, ~s, ~s)"
 137                            switch-x-offset switch-y-offset
 138                            (radians->degrees angle)
 139                            0 hand-height)))
 140       ,@(for/list ([col (in-range cols)]
 141                    #:when true
 142                    [row (if (= 5 col) '(0 1) (in-range rows))])
 143           (switch row col))))
 144
 145 (define switches-right
 146   `(g ((transform ,(format "translate(~s,~s) scale(-1, 1)" width 0)))
 147       ,switches))
 148
 149 (define logo-doc (call-with-input-file "logo-fragment.svg" read-xml))
 150
 151 (define pcb-doc (call-with-input-file "pcb-fragment.svg" read-xml))
 152
 153 (define (layer plate)
 154   (document (prolog '() false '())
 155             (xexpr->xml
 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)))
 162                                (stroke "red"))
 163                               ,(xml->xexpr (document-element logo-doc))))
 164                          '())
 165                    ,@(if (eq? plate 'spacer)
 166                          (list (xml->xexpr (document-element pcb-doc)))
 167                          (list))
 168                    (g ((transform ,(format "scale(~s, ~s) translate(0, ~s)"
 169                                            scale scale upper-height))
 170                        (stroke-width "1")
 171                        (stroke "black")
 172                        (fill-opacity "0"))
 173                       ,screws
 174                       ,(outline (not (eq? plate 'switch)))
 175                       ,@(if (eq? plate 'switch)
 176                             (list switches switches-right)
 177                             (list)))))
 178             '()))
 179
 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
 182 ;; them directly.
 183
 184 (define (write-out-layer layer-name)
 185   (call-with-output-file (format "deck-~a.svg" (symbol->string layer-name))
 186     (lambda (out)
 187       (display "<?xml version=\"1.0\" encoding=\"UTF-8\" standalone=\"no\"?>" out)
 188       (display-xml (layer layer-name) out))
 189     #:exists 'replace))
 190
 191 ;; live-reload with:
 192 ;; qiv --watch deck-switch.svg
 193
 194 (write-out-layer 'switch)
 195 ;; (write-out-layer 'bottom)
 196 ;; (write-out-layer 'spacer)