-
Notifications
You must be signed in to change notification settings - Fork 5
/
Copy pathpanel.lisp
148 lines (131 loc) · 5.29 KB
/
panel.lisp
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
(in-package :gcode)
(defclass panel ()
((gcode :initarg :gcode :initform nil :reader panel-gcode)
(min-x :initarg :min-x :initform 0 :reader panel-min-x)
(max-x :initarg :max-x :initform 0 :reader panel-max-x)
(min-y :initarg :min-y :initform 0 :reader panel-min-y)
(max-y :initarg :max-y :initform 0 :reader panel-max-y)
(min-z :initarg :min-z :initform 0 :reader panel-min-z)
(max-z :initarg :max-z :initform 0 :reader panel-max-z)
(name :initarg :name :initform "" :reader panel-name)
(code :initarg :code :initform nil :reader panel-code)))
(defmethod print-object ((obj panel) stream)
(print-unreadable-object (obj stream :type t :identity t)
(with-slots (min-x max-x min-y max-y min-z max-z name) obj
(format stream "~S (~A-~A, ~A-~A, ~A-~A)"
name min-x max-x min-y max-y min-z max-z))))
(defmacro with-panel ((name) &rest body)
(let ((res (gensym)))
`(with-new-pass (,name)
(let ((,res (g-program ,@body)))
(make-instance 'panel :name ,name
:gcode ,res
:min-x (min-x) :max-x (max-x)
:min-y (min-y) :max-y (max-y)
:min-z (min-z) :max-z (max-z)
:code '(progn ,@body))))))
(defun calculate-panel (function-name)
;; new program XXX
(let ((*current-program* (make-instance 'gcode-program :name "calculate shit"))
(*current-transform* *unity-matrix*))
(format t "current -program: ~A~%" *current-program*)
(with-named-pass ("foobar")
(funcall (symbol-function function-name)))
(let* ((passes (gcode-program-passes *current-program*))
(min-x (apply #'min (mapcar #'pass-min-x passes)))
(max-x (apply #'max (mapcar #'pass-max-x passes)))
(min-y (apply #'min (mapcar #'pass-min-y passes)))
(max-y (apply #'max (mapcar #'pass-max-y passes)))
(min-z (apply #'min (mapcar #'pass-min-z passes)))
(max-z (apply #'max (mapcar #'pass-max-z passes)))
(res nil))
(format t "passes: ~A~%" passes)
(make-instance 'panel :name function-name
:gcode res
:min-x min-x :max-x max-x
:min-y min-y :max-y max-y
:min-z min-z :max-z max-z
:code `(with-named-pass ("mill") (,function-name))))))
(defun calculate-panel-code (code &key passname)
(let ((*current-program* (make-instance 'gcode-program :name "calculate shit"))
(*current-transform* *unity-matrix*))
(with-new-pass ("calculate pass")
(let* ((*gcode-program* (list))
(*gcode-log* t))
(with-save-xy () (eval `(progn ,@code)))
(make-instance 'panel :name "code"
:gcode (nreverse *gcode-program*)
:min-x (program-min-x) :max-x (program-max-x)
:min-y (program-min-y) :max-y (program-max-y)
:min-z (program-min-z) :max-z (program-max-z)
:code `(with-named-pass (,(if passname passname "mill")) ,@code))))))
(defun calculate-panel-file (filename)
(let ((*current-program* (make-instance 'gcode-program :name "calculate shit"))
(*current-transform* *unity-matrix*))
(with-new-pass ("calculate pass")
(let ((res (with-save-xy () (load-file filename))))
(make-instance 'panel :name (pathname-name filename)
:gcode res
:min-x (min-x) :max-x (max-x)
:min-y (min-y) :max-y (max-y)
:min-z (min-z) :max-z (max-z)
:code `(load-file ,filename))))))
(defmacro with-panel ((name) &rest body)
`(let ((*current-program* (make-instance 'gcode-program :name "calculate shit"))
(*current-transform* *unity-matrix*))
(with-new-pass ("calculate pass")
(let ((res (with-save-xy () ,@body)))
(make-instance 'panel :name ,name
:gcode res
:min-x (min-x) :max-x (max-x)
:min-y (min-y) :max-y (max-y)
:min-z (min-z) :max-z (max-z)
:code '(progn ,@body))))))
(defmethod panel-width ((panel panel))
(- (panel-max-x panel) (panel-min-x panel)))
(defmethod panel-height ((panel panel))
(- (panel-max-y panel) (panel-min-y panel)))
(defmethod schedule-panel ((panel panel) x y)
(with-save-xy ()
(with-transform ((translation-matrix x y))
(mill-abs :z *fly-height*)
(goto-abs :x 0 :y 0)
(eval (panel-code panel)))))
(defmethod execute-panel-gcode ((panel panel))
(with-save-xy ()
(mill-abs :z *fly-height*)
(goto-abs :x 0 :y 0)
(dolist (cmd (panel-gcode panel))
(eval cmd))))
(defun panels-max-width (panels)
(reduce #'max (mapcar #'panel-width panels)))
(defun panels-max-height (panels)
(reduce #'max (mapcar #'panel-height panels)))
(defun panels-by-nums (panels nums)
(loop for i in nums
collect (elt panels (1- i))))
(defun order-panels (panels order gap)
(let ((rpanels (reverse order))
(y 0)
(max-x 0)
(max-y 0)
(schedules (list)))
(loop for row-nums in rpanels
for row-cnt from 0
for x = 0
for row = (panels-by-nums panels row-nums)
for height = (panels-max-height row)
do (let ((pcoords (loop for panel in row
collect (list panel x y)
do (incf x (+ (panel-width panel) gap))
do (when (> x max-x)
(setf max-x x)))))
(setf schedules (append (if (evenp row-cnt)
(reverse pcoords)
pcoords)
schedules)))
do (incf y (+ height gap))
do (when (> y max-y)
(setf max-y y)))
(format t "total dimensions: ~A - ~A~%" max-x max-y)
(nreverse schedules)))