Commit 59c6dc0c authored by Dave Cooper's avatar Dave Cooper

added spline support for DXF (apparently working now).

parent 802bcc2c
......@@ -124,52 +124,91 @@
((:wedge :double-wedge :triangle)
;;(write-the line-thickness-setting)
;;(write-the rgb-stroke-setting)
(destructuring-bind (p0 p1 p2 p3)
(mapcar #'(lambda(point)
(add-vectors *dxf-translation* (subseq point 0 2)))
(if view (mapcar #'(lambda(point) (the-object view (view-point point))) (the outline-points))
(the outline-points)))
(format *stream* " 0~%LINE~% 10~%~3,16f~% 20~%~3,16f~% 11~%~3,16f~% 21~%~3,16f~%"
(get-x p0) (get-y p0) (get-x p1) (get-y p1))
(write-the line-thickness-setting)
(write-the rgb-stroke-setting)
(format *stream* " 0~%LINE~% 10~%~3,16f~% 20~%~3,16f~% 11~%~3,16f~% 21~%~3,16f~%"
(get-x p1) (get-y p1) (get-x p2) (get-y p2))
(write-the line-thickness-setting)
(write-the rgb-stroke-setting)
(format *stream* " 0~%LINE~% 10~%~3,16f~% 20~%~3,16f~% 11~%~3,16f~% 21~%~3,16f~%"
(get-x p2) (get-y p2) (get-x p3) (get-y p3))
(write-the line-thickness-setting)
(write-the rgb-stroke-setting)
(format *stream* " 0~%LINE~% 10~%~3,16f~% 20~%~3,16f~% 11~%~3,16f~% 21~%~3,16f~%"
(get-x p3) (get-y p3) (get-x p0) (get-y p0))
(write-the line-thickness-setting)
(write-the rgb-stroke-setting))
(let ((line-format-string " 0~%LINE~% 5~%~a~% 100~%AcDbEntity~% 100~%AcDbLine~% 10~%~3,16f~% 20~%~3,16f~% 11~%~3,16f~% 21~%~3,16f~%"))
(destructuring-bind (p0 p1 p2 p3)
(mapcar #'(lambda(point)
(add-vectors *dxf-translation* (subseq point 0 2)))
(if view (mapcar #'(lambda(point) (the-object view (view-point point))) (the outline-points))
(the outline-points)))
#+nil
(format *stream* " 0~%LINE~% 10~%~3,16f~% 20~%~3,16f~% 11~%~3,16f~% 21~%~3,16f~%"
(get-x p0) (get-y p0) (get-x p1) (get-y p1))
(format *stream* line-format-string (incf *dxf-entity-id*)
(get-x p0) (get-y p0) (get-x p1) (get-y p1))
(write-the line-thickness-setting)
(write-the rgb-stroke-setting)
#+nil
(format *stream* " 0~%LINE~% 10~%~3,16f~% 20~%~3,16f~% 11~%~3,16f~% 21~%~3,16f~%"
(get-x p1) (get-y p1) (get-x p2) (get-y p2))
(format *stream* line-format-string (incf *dxf-entity-id*)
(get-x p1) (get-y p1) (get-x p2) (get-y p2))
(write-the line-thickness-setting)
(write-the rgb-stroke-setting)
#+nil
(format *stream* " 0~%LINE~% 10~%~3,16f~% 20~%~3,16f~% 11~%~3,16f~% 21~%~3,16f~%"
(get-x p2) (get-y p2) (get-x p3) (get-y p3))
(format *stream* line-format-string (incf *dxf-entity-id*)
(get-x p2) (get-y p2) (get-x p3) (get-y p3))
(write-the line-thickness-setting)
(write-the rgb-stroke-setting)
#+nil
(format *stream* " 0~%LINE~% 10~%~3,16f~% 20~%~3,16f~% 11~%~3,16f~% 21~%~3,16f~%"
(get-x p3) (get-y p3) (get-x p0) (get-y p0))
(format *stream* line-format-string (incf *dxf-entity-id*)
(get-x p3) (get-y p3) (get-x p0) (get-y p0))
(write-the line-thickness-setting)
(write-the rgb-stroke-setting))
(when (the second-outline-points)
(destructuring-bind (p0 p1 p2 p3)
(mapcar #'(lambda(point)
(add-vectors *dxf-translation* (subseq point 0 2)))
(if view
(mapcar #'(lambda(point) (the-object view (view-point point))) (the second-outline-points))
(the second-outline-points)))
(write-the line-thickness-setting)
(write-the rgb-stroke-setting)
(format *stream* " 0~%LINE~% 10~%~3,16f~% 20~%~3,16f~% 11~%~3,16f~% 21~%~3,16f~%"
(get-x p0) (get-y p0) (get-x p1) (get-y p1))
(write-the line-thickness-setting)
(write-the rgb-stroke-setting)
(format *stream* " 0~%LINE~% 10~%~3,16f~% 20~%~3,16f~% 11~%~3,16f~% 21~%~3,16f~%"
(get-x p1) (get-y p1) (get-x p2) (get-y p2))
(write-the line-thickness-setting)
(write-the rgb-stroke-setting)
(format *stream* " 0~%LINE~% 10~%~3,16f~% 20~%~3,16f~% 11~%~3,16f~% 21~%~3,16f~%"
(get-x p2) (get-y p2) (get-x p3) (get-y p3))
(write-the line-thickness-setting)
(write-the rgb-stroke-setting)
(format *stream* " 0~%LINE~% 10~%~3,16f~% 20~%~3,16f~% 11~%~3,16f~% 21~%~3,16f~%"
(get-x p3) (get-y p3) (get-x p0) (get-y p0))
(write-the line-thickness-setting)
(write-the rgb-stroke-setting)))))))))
(when (the second-outline-points)
(destructuring-bind (p0 p1 p2 p3)
(mapcar #'(lambda(point)
(add-vectors *dxf-translation* (subseq point 0 2)))
(if view
(mapcar #'(lambda(point) (the-object view (view-point point))) (the second-outline-points))
(the second-outline-points)))
(write-the line-thickness-setting)
(write-the rgb-stroke-setting)
#+nil
(format *stream* " 0~%LINE~% 10~%~3,16f~% 20~%~3,16f~% 11~%~3,16f~% 21~%~3,16f~%"
(get-x p0) (get-y p0) (get-x p1) (get-y p1))
(format *stream* line-format-string (incf *dxf-entity-id*)
(get-x p0) (get-y p0) (get-x p1) (get-y p1))
(write-the line-thickness-setting)
(write-the rgb-stroke-setting)
#+nil
(format *stream* " 0~%LINE~% 10~%~3,16f~% 20~%~3,16f~% 11~%~3,16f~% 21~%~3,16f~%"
(get-x p1) (get-y p1) (get-x p2) (get-y p2))
(format *stream* line-format-string (incf *dxf-entity-id*)
(get-x p1) (get-y p1) (get-x p2) (get-y p2))
(write-the line-thickness-setting)
(write-the rgb-stroke-setting)
#+nil
(format *stream* " 0~%LINE~% 10~%~3,16f~% 20~%~3,16f~% 11~%~3,16f~% 21~%~3,16f~%"
(get-x p2) (get-y p2) (get-x p3) (get-y p3))
(format *stream* line-format-string (incf *dxf-entity-id*)
(get-x p2) (get-y p2) (get-x p3) (get-y p3))
(write-the line-thickness-setting)
(write-the rgb-stroke-setting)
#+nil
(format *stream* " 0~%LINE~% 10~%~3,16f~% 20~%~3,16f~% 11~%~3,16f~% 21~%~3,16f~%"
(get-x p3) (get-y p3) (get-x p0) (get-y p0))
(format *stream* line-format-string (incf *dxf-entity-id*)
(get-x p3) (get-y p3) (get-x p0) (get-y p0))
(write-the line-thickness-setting)
(write-the rgb-stroke-setting))))))))))
......@@ -23,6 +23,8 @@
(defparameter *fixed-scale?* nil)
(defparameter *dxf-entity-id* nil)
(eval-when (compile load eval) (export '*fixed-scale?*))
;;
......@@ -32,7 +34,8 @@
(defmacro with-translated-state ((format center) &body body)
(ecase format
(:pdf `(pdf:with-saved-state (pdf:translate (get-x ,center) (get-y ,center)) ,@body))
(:dxf `(let ((*dxf-translation* (add-vectors (subseq ,center 0 2) *dxf-translation*))) ,@body))
(:dxf `(let ((*dxf-translation* (add-vectors (subseq ,center 0 2) *dxf-translation*)))
,@body))
(:raphael `(let ((*raphael-translation* (add-vectors (subseq ,center 0 2) *raphael-translation*))) ,@body))))
......@@ -70,10 +73,11 @@
(with-translated-state (:pdf (make-point (- (get-x view-center)) (- (get-y view-center))))
(write-the-object child-view cad-output)))))) (the views))))))))
(define-lens (dxf base-drawing)()
:output-functions
((cad-output () (mapc #'(lambda(view) (write-the-object view cad-output)) (the views)))))
((cad-output ()
(let ((*dxf-entity-id* 107))
(mapc #'(lambda(view) (write-the-object view cad-output)) (the views))))))
(define-lens (pdf base-view)()
......@@ -174,7 +178,6 @@
(dolist (item path-info)
(if (keywordp item)
(progn
(print-variables mode coords)
(when (and mode coords) (write-the (pdf-command mode (nreverse coords))))
(setq mode item) (setq coords nil))
(push item coords)))
......@@ -234,7 +237,8 @@
(mapc #'(lambda(line-index-pair)
(destructuring-bind (start-index end-index) line-index-pair
(let ((start (svref 2d-vertices start-index)) (end (svref 2d-vertices end-index)))
(format *stream* " 0~%LINE~% 10~%~3,16f~% 20~%~3,16f~% 11~%~3,16f~% 21~%~3,16f~%"
(format *stream* " 0~%LINE~% 5~%~a~% 100~%AcDbEntity~% 100~%AcDbLine~% 10~%~3,16f~% 20~%~3,16f~% 11~%~3,16f~% 21~%~3,16f~%"
(incf *dxf-entity-id*)
(get-x start) (get-y start) (get-x end) (get-y end))))
(write-the object line-thickness-setting)
......@@ -243,7 +247,6 @@
line-index-pairs)))
(mapc #'(lambda(curve)
(let ((control-points (mapcar #'(lambda(point) (add-vectors *dxf-translation* point)) (getf curve :control-points)))
(knots (getf curve :knot-vector))
......@@ -256,10 +259,10 @@
" 0
SPLINE
5
~a
100
AcDbEntity
8
0
100
AcDbSpline
210
......@@ -284,6 +287,7 @@ AcDbSpline
0.0000001
~{ 40~%~,7f~^~%~}
~{~a~%~}"
(incf *dxf-entity-id*)
degree
(length knots)
(length control-points)
......@@ -291,7 +295,13 @@ AcDbSpline
(mapcar #'(lambda(point)
(format nil " 10~%~,7f~% 20~%~,7f~% 30~%0.0"
(get-x point) (get-y point)))
control-points))))
control-points))
(write-the object line-thickness-setting)
(write-the object dash-pattern-setting)
(write-the object rgb-stroke-setting)))
(the curves-2d-scaled))
......@@ -401,8 +411,6 @@ AcDbSpline
(read-byte image-stream nil nil)))
((null val))
;;(print-variables *stream* val)
(write-byte val *stream*))))
(delete-file temp-pdf)
......
......@@ -23,8 +23,3847 @@
(defparameter *dxf-header*
" 0
SECTION
2
HEADER
9
$ACADVER
1
AC1015
9
$HANDSEED
5
FFFF
9
$DIMADEC
70
0
9
$DIMASZ
40
0.18
9
$DIMAUNIT
70
0
9
$DIMAZIN
70
0
9
$DIMDEC
70
4
9
$DIMDSEP
70
46
9
$DIMEXE
40
0.18
9
$DIMEXO
40
0.0625
9
$DIMGAP
40
0.09
9
$DIMLUNIT
70
2
9
$DIMSCALE
40
1.0
9
$DIMTSZ
40
0.0
9
$DIMTXT
40
0.18
9
$DIMZIN
70
0
9
$DWGCODEPAGE
3
ANSI_1252
9
$INSUNITS
70
0
9
$LTSCALE
40
1.0
9
$MAXACTVP
70
32
9
$MEASUREMENT
70
0
9
$PDMODE
70
0
9
$PDSIZE
40
0
0
ENDSEC
0
SECTION
2
TABLES
0
TABLE
2
VPORT
5
8
100
AcDbSymbolTable
70
1
0
VPORT
5
30
100
AcDbSymbolTableRecord
100
AcDbViewportTableRecord
2
*Active
70
0
10
0.0
20
0.0
11
1.0
21
1.0
12
286.3055555555554861
22
148.5
13
0.0
23
0.0
14
10.0
24
10.0
15
10.0
25
10.0
16
0.0
26
0.0
36
1.0
17
0.0
27
0.0
37
0.0
40
297.0
41
1.92798353909465
42
50.0
43
0.0
44
0.0
50
0.0
51
0.0
71
0
72
100
73
1
74
3
75
1
76
1
77
0
78
0
281
0
65
1
110
0.0
120
0.0
130
0.0
111
1.0
121
0.0
131
0.0
112
0.0
122
1.0
132
0.0
79
0
146
0.0
0
ENDTAB
0
TABLE
2
LTYPE
5
5
100
AcDbSymbolTable
70
50
0
LTYPE
5
16
100
AcDbSymbolTableRecord
100
AcDbLinetypeTableRecord
2
Continuous
70
0
3
Solid line
72
65
73
0
40
0.0
0
LTYPE
5
15
100
AcDbSymbolTableRecord
100
AcDbLinetypeTableRecord
2
BYLAYER
70
0
3
72
65
73
0
40
0.0
0
LTYPE
5
31
100
AcDbSymbolTableRecord
100
AcDbLinetypeTableRecord
2
ACAD_ISO15W100
70
0
3
ISO double-dash triple-dot __ __ . . . __ __ . .
72
65
73
10
40
39.0
49
12.0
74
0
49
-3.0
74
0
49
12.0
74
0
49
-3.0
74
0
49
0.0
74
0
49
-3.0
74
0
49
0.0
74
0
49
-3.0
74
0
49
0.0
74
0
49
-3.0
74
0
0
LTYPE
5
32
100
AcDbSymbolTableRecord
100
AcDbLinetypeTableRecord
2
CENTER2
70
0
3
Center (.5x) ___ _ ___ _ ___ _ ___ _ ___ _ ___
72
65
73
4
40
28.5750000000000028
49
19.0500000000000007
74
0
49
-3.1749999999999998
74
0
49
3.1749999999999998
74
0
49
-3.1749999999999998
74
0
0
LTYPE
5
33
100
AcDbSymbolTableRecord
100
AcDbLinetypeTableRecord
2
ACAD_ISO07W100
70
0
3
ISO dot . . . . . . . . . . . . . . . . . . . .
72
65
73
2
40
3.0
49
0.0
74
0
49
-3.0
74
0
0
LTYPE
5
34
100
AcDbSymbolTableRecord
100
AcDbLinetypeTableRecord
2
BORDERX2
70
0
3