/
pdf.lisp
196 lines (165 loc) · 7 KB
/
pdf.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
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
(in-package :gcode)
(defvar *current-x* nil)
(defvar *current-y* nil)
(defun g-to-pdf (moves)
(dolist (move moves)
(move-to-pdf move)))
(defun move-to-to-pdf (move)
(let ((x (or (g-param move :x) *current-x*))
(y (or (g-param move :y) *current-y*)))
(setf *current-x* x *current-y* y)
(pdf:move-to x y)))
(defun line-to-to-pdf (move)
(let ((x (or (g-param move :x) *current-x*))
(y (or (g-param move :y) *current-y*)))
(setf *current-x* x *current-y* y)
(pdf:line-to x y)))
(defun circle-angle (p center)
(let ((angle (angle-2-segments-directed (make-line :a (2dp 0 0) :b (2dp 1 0))
(make-line :a (2dp 0 0) :b (point-- p center)))))
(when (< angle 0)
(setf angle (+ *PI* (+ *PI* angle))))
angle))
(defun arc-cw-to-pdf (move)
(let* ((x (or (g-param move :x) *current-x*))
(y (or (g-param move :y) *current-y*))
(i (g-param move :i))
(j (g-param move :j))
(radius (line-length (make-line :a (2dp x y) :b (2dp i j))))
(start (circle-angle (2dp *current-x* *current-y*) (2dp i j)))
(end (circle-angle (2dp x y) (2dp i j))))
;; (format t "Cw: START ~A END: ~A~%" start end)
(setf *current-x* x *current-y* y)
(if (> start end)
(pdf::arc-to i j radius start (- end start))
(pdf::arc-to i j radius start (- (+ start (- (* 2 *PI*) end)))))))
(defun test-circle-program ()
(with-program ("circle")
(with-named-pass ("foo")
(p5-circle 40 40 40)
(p5-rect :x 10 :y 10 :width 40 :height 40))))
(defun arc-ccw-to-pdf (move)
(let* ((x (or (g-param move :x) *current-x*))
(y (or (g-param move :y) *current-y*))
(i (g-param move :i))
(j (g-param move :j))
(radius (line-length (make-line :a (2dp x y) :b (2dp i j))))
(start (circle-angle (2dp *current-x* *current-y*) (2dp i j)))
(end (circle-angle (2dp x y) (2dp i j))))
;; (format t "CCw: START ~A END: ~A~%" start end)
(setf *current-x* x *current-y* y)
(if (> end start)
(pdf::arc-to i j radius start (- end start))
(pdf::arc-to i j radius start (+ end (- (* 2 *PI*) start))))))
(defun move-to-pdf (move)
(pdf:move-to *current-x* *current-y*)
(case (first move)
(:g00 (move-to-to-pdf move))
(:g01 (line-to-to-pdf move))
(:g02 (arc-cw-to-pdf move))
(:g03 (arc-ccw-to-pdf move)))
(pdf:stroke)
#+nil(format t "move ~A~%" move))
(defun program-to-file-and-pdf (program file &key order)
(program-to-pdf program (make-pathname :type "pdf" :defaults file) :order order)
(program-to-file program (make-pathname :type "nc" :defaults file) :order order))
(defun program-to-pdf (program file &key order)
(let ((*current-x* 0)
(*current-y* 0)
(pdf:*compress-streams* nil))
(unless order
(setf order (mapcar #'pass-name (gcode-program-passes program))))
(unless (pathname-name file)
(setf file (make-pathname :defaults file :name (gcode-program-name program)
:type "pdf")))
(let ((bounds (make-array 4 :initial-element 0)))
(setf (aref bounds 2) (* 2.8346457 (+ 60 (abs (- (program-max-x program)
(program-min-x program)))))
(aref bounds 3) (* 2.8346457 (+ 60 (abs (- (program-max-y program)
(program-min-y program))))))
(format t "bounds: ~A~%" bounds)
(pdf:with-document ()
(pdf:with-page (:bounds bounds)
(pdf:scale 2.8346457 2.8346457)
(pdf:with-outline-level ((gcode-program-name program) (pdf:register-page-reference))
(pdf:set-rgb-stroke 0 0 0)
(pdf:set-rgb-fill 1 1 1)
(pdf:set-line-width 0.1)
(pdf:translate 30 30)
(pdf:set-rgb-stroke 0 0 0)
(pdf:set-rgb-fill 1 1 1)
(pdf:set-line-width 0.1)
;; (move-to-pdf '(:G00 (:X 10) (:Y 10)))
;; (move-to-pdf '(:G02 (:X 10) (:Y -10) (:I 10) (:J 0)))
#|
(move-to-pdf '(:G00 (:X 10) (:Y 10)))
(move-to-pdf '(:G01 (:X 50) (:Y 10) (:F 10)))
(move-to-pdf '(:G01 (:X 50) (:Y 50) (:F 10)))
(move-to-pdf '(:G01 (:X 10) (:Y 50) (:F 10)))
(move-to-pdf '(:G01 (:X 10) (:Y 10) (:F 10)))
(pdf:stroke)
|#
#| (move-to-pdf '(:G00 (:X 40) (:Y 23)))
(MOVE-TO-PDF '(:G02 (:X 23) (:Y 40) (:Z -3) (:I 40) (:J 40) (:K -3) (:F 5)))
(move-to-pdf '(:G02 (:X 40) (:Y 57) (:Z -3) (:I 40) (:J 40) (:K -3)))
(move-to-pdf '(:G02 (:X 57) (:Y 40) (:Z -3) (:I 40) (:J 40) (:K -3)))
(move-to-pdf '(:G02 (:X 40) (:Y 23) (:Z -3) (:I 40) (:J 40) (:K -3)))
|#
(let ((all-moves (loop for name in order
for pass = (program-pass program name)
for moves = (when pass (cons `(:m03) (pass-moves pass)))
appending moves)))
(g-to-pdf all-moves)
(format t "saved ~A to ~A~%" order file))
))
(pdf:write-document file))))
(loop for passname in order
do (program-to-pdf-pass program (make-pathname :defaults file :name (format nil "~A-~A" (pathname-name file)
passname)
:type "pdf")
passname)))
(defun program-to-pdf-pass (program file passname)
(let ((*current-x* 0)
(*current-y* 0)
(pdf:*compress-streams* nil))
(unless (pathname-name file)
(setf file (make-pathname :defaults file :name (format nil "~a-~a" (gcode-program-name program) passname)
:type "pdf")))
(let ((bounds (make-array 4 :initial-element 0)))
(setf (aref bounds 2) (* 2.8346457 (+ 60 (abs (- (program-max-x program)
(program-min-x program)))))
(aref bounds 3) (* 2.8346457 (+ 60 (abs (- (program-max-y program)
(program-min-y program))))))
(format t "bounds: ~A~%" bounds)
(pdf:with-document ()
(pdf:with-page (:bounds bounds)
(pdf:scale 2.8346457 2.8346457)
(pdf:with-outline-level ((gcode-program-name program) (pdf:register-page-reference))
(pdf:set-rgb-stroke 0 0 0)
(pdf:set-rgb-fill 1 1 1)
(pdf:set-line-width 0.1)
(pdf:translate 30 30)
(pdf:set-rgb-stroke 0 0 0)
(pdf:set-rgb-fill 1 1 1)
(pdf:set-line-width 0.1)
;; (move-to-pdf '(:G00 (:X 10) (:Y 10)))
;; (move-to-pdf '(:G02 (:X 10) (:Y -10) (:I 10) (:J 0)))
#|
(move-to-pdf '(:G00 (:X 10) (:Y 10)))
(move-to-pdf '(:G01 (:X 50) (:Y 10) (:F 10)))
(move-to-pdf '(:G01 (:X 50) (:Y 50) (:F 10)))
(move-to-pdf '(:G01 (:X 10) (:Y 50) (:F 10)))
(move-to-pdf '(:G01 (:X 10) (:Y 10) (:F 10)))
(pdf:stroke)
|#
#| (move-to-pdf '(:G00 (:X 40) (:Y 23)))
(MOVE-TO-PDF '(:G02 (:X 23) (:Y 40) (:Z -3) (:I 40) (:J 40) (:K -3) (:F 5)))
(move-to-pdf '(:G02 (:X 40) (:Y 57) (:Z -3) (:I 40) (:J 40) (:K -3)))
(move-to-pdf '(:G02 (:X 57) (:Y 40) (:Z -3) (:I 40) (:J 40) (:K -3)))
(move-to-pdf '(:G02 (:X 40) (:Y 23) (:Z -3) (:I 40) (:J 40) (:K -3)))
|#
(let ((all-moves (cons `(:m03) (pass-moves (program-pass program passname)))))
(g-to-pdf all-moves)
(format t "saved ~A to ~A~%" passname file))
))
(pdf:write-document file)))))