Commit cb3c7913 authored by Teodor Gelu Chiciudean's avatar Teodor Gelu Chiciudean
Browse files

Merge remote-tracking branch 'upstream/master'

Conflicts:
	documentation/unified-doc/gdl-documentation.pdf
parents 161f1dbb 2428c141
1. (load "~/yadd-auto-doc.lisp")
2. (setq self (make-object 'yadd::document-yadd))
2. (make-self 'yadd::document-yadd)
3. (the generate-documentation)
4. at shell level:
texi2pdf gdl-documentation.texi
\ No newline at end of file
texi2pdf gdl-documentation.texi
......@@ -45,7 +45,8 @@
(sub-dir (concatenate 'string "yadd/"
(getf
(first (the part-documentation-plist)) :packager) "/"))
(directory-name (merge-pathnames (the sub-dir) (the data-directory)))
(directory-name (ensure-directories-exist (merge-pathnames (the sub-dir) (the data-directory))))
(doc (make-object 'yadd::assy))
......
......@@ -65,7 +65,7 @@
:computed-slots
((strings-for-display (format nil "~a" (the symbol)))
(doc-string (glisp:function-documentation symbol))
(doc-string (glisp:function-documentation (the symbol)))
(macro? (macro-function (the symbol))))
:functions
......@@ -79,7 +79,7 @@
(format nil "~a: ~s" (if (the macro?) "Macro" "Function")
(the :symbol)))))
(:body (when *developing?* (html (:p (the (write-development-links)))))
(when *adsense?* (html (:p (:princ *adsense-code*))))
;;(when *adsense?* (html (:p (:princ *adsense-code*))))
(:p (when (the :return-object) (the (:write-back-link :display-string "<-Back"))))
(:h2
(:princ
......
......@@ -30,8 +30,11 @@ supports a full range of output options such as page dimensions, view transforms
(gdl::with-format (pdf \"/tmp/box.pdf\" :view-transform (getf *standard-views* :trimetric))
(write-the-object (make-instance 'box :length 100 :width 100 :height 100) cad-output))
</pre>"
(let ((flag (gensym)))
(let ((external-format (getf args :external-format))
(let (;;(external-format (getf args :external-format))
(args (remove-plist-keys args (list :external-format))))
`(let ((*%format%* (make-instance ',format ,@args)))
(let ((*stream* (if (or (stringp ,stream-or-file) (pathnamep ,stream-or-file))
......@@ -41,6 +44,7 @@ supports a full range of output options such as page dimensions, view transforms
)
,stream-or-file))
(,flag t))
(unwind-protect
(progn (multiple-value-prog1
,(case format
......@@ -62,7 +66,24 @@ supports a full range of output options such as page dimensions, view transforms
(pdf:translate (half page-width) (half page-length)))
,@body)
(when *stream* (pdf:write-document *stream*))))
(pdf-multipage `(pdf:with-document() ,@body (when *stream* (pdf:write-document *stream*))))
(pdf-multipage `(let ((path (glisp:temporary-file)))
(with-open-file (out path :direction :output
:if-exists :supersede
:if-does-not-exist :create)
(pdf:with-document() ,@body
(pdf:write-document out)))
(when *stream*
(with-open-file (in path :element-type '(unsigned-byte 8))
(do ((val (read-byte in nil nil) (read-byte in nil nil)))
((null val))
(write-byte val *stream*))))
(delete-file path)))
#+nil
(pdf-multipage `(pdf:with-document() ,@body
(when *stream* (pdf:write-document *stream*))))
;;
;; FLAG -- consider having default
;; initialize-output and finalize-output
......
......@@ -5,14 +5,19 @@
(in-package :pdf)
(defmethod write-object ((obj indirect-object) &optional root-level)
(gdl:print-variables *pdf-stream*)
(if root-level
(progn
(vector-push-extend (format nil "~10,'0d ~5,'0d n "
;;FLAG -- DJC added conditional for allegro to handle aserve streams
#+allegro (if (typep *pdf-stream* 'excl::hiper-socket-stream)
(progn (force-output *pdf-stream*)
(excl::socket-bytes-written *pdf-stream*))
(file-position *pdf-stream*))
#+allegro (typecase *pdf-stream*
((excl::hiper-socket-stream
net.aserve::chunking-stream)
(force-output *pdf-stream*)
(excl::socket-bytes-written *pdf-stream*))
(otherwise (file-position *pdf-stream*)))
#+lispworks (if (typep *pdf-stream* 'acl-compat.socket::bidirectional-binary-socket-stream)
(progn (force-output *pdf-stream*)
(acl-compat.socket::stream-file-position *pdf-stream*))
......@@ -28,41 +33,58 @@
(defmethod write-document ((s stream) &optional (document *document*))
(let ((*xrefs* (make-array 10 :adjustable t :fill-pointer 0))
startxref
(*pdf-stream* s))
;;(with-standard-io-syntax
#+lispworks (if (typep s 'acl-compat.socket::bidirectional-binary-socket-stream)
(setf acl-compat.socket::*socket-bytes-written* 0))
(gdl:print-variables s)
(let ((*xrefs* (make-array 10 :adjustable t :fill-pointer 0))
startxref
(*pdf-stream* s))
;;(with-standard-io-syntax
#+lispworks (if (typep s 'acl-compat.socket::bidirectional-binary-socket-stream)
(setf acl-compat.socket::*socket-bytes-written* 0))
(let ((*read-default-float-format* 'double-float))
(process-outlines document)
(vector-push-extend "0000000000 65535 f " *xrefs*)
(write-line +pdf-header+ *pdf-stream*)
(loop for obj across (objects document)
for first = t then nil
if obj do (write-object obj t)
else do (unless first (vector-push-extend "0000000000 00001 f " *xrefs*)))
(let ((*read-default-float-format* 'double-float))
(process-outlines document)
(vector-push-extend "0000000000 65535 f " *xrefs*)
(write-line +pdf-header+ *pdf-stream*)
(loop for obj across (objects document)
for first = t then nil
if obj do (write-object obj t)
else do (unless first (vector-push-extend "0000000000 00001 f " *xrefs*)))
;;(setf startxref (file-position s))
;;(setf startxref (file-position s))
(setf startxref #+allegro (if (typep s 'excl::hiper-socket-stream)
(progn (force-output s)
(excl::socket-bytes-written s))
(file-position s))
#+lispworks (if (typep s 'acl-compat.socket::bidirectional-binary-socket-stream)
(progn (force-output s)
(acl-compat.socket::stream-file-position s))
(file-position s))
#-(or allegro lispworks) (file-position s))
(format *pdf-stream* "xref~%0 ~d~%" (length *xrefs*))
(loop for xref across *xrefs*
do (write-line xref s))
(format s "trailer~%<< /Size ~d~%/Root " (length *xrefs*));(1- (length (objects document))))
(write-object (catalog document))
(when (docinfo document)
(format s " /Info ")
(write-object (docinfo document)))
(format s "~%>>~%startxref~%~d~%%%EOF~%" startxref))))
(gdl:print-variables (excl:device-file-position *pdf-stream*))
(setf startxref #+allegro (typecase *pdf-stream*
((excl::hiper-socket-stream net.aserve::chunking-stream)
(force-output *pdf-stream*)
(excl::socket-bytes-written *pdf-stream*))
(otherwise (file-position *pdf-stream*)))
#+nil
(if (typep s 'excl::hiper-socket-stream)
(progn (force-output s)
(excl::socket-bytes-written s))
(file-position s))
#+lispworks (if (typep s 'acl-compat.socket::bidirectional-binary-socket-stream)
(progn (force-output s)
(acl-compat.socket::stream-file-position s))
(file-position s))
#-(or allegro lispworks) (file-position s))
(unless startxref (setf startxref (file-position s)))
(format *pdf-stream* "xref~%0 ~d~%" (length *xrefs*))
(loop for xref across *xrefs*
do (write-line xref s))
(format s "trailer~%<< /Size ~d~%/Root " (length *xrefs*)) ;(1- (length (objects document))))
(write-object (catalog document))
(when (docinfo document)
(format s " /Info ")
(write-object (docinfo document)))
(format s "~%>>~%startxref~%~d~%%%EOF~%" startxref))))
......@@ -25,7 +25,6 @@
;;
;; FLAG -- have to get rid of raw smlib call in here.
;;
#+nil
(define-object compatible-curves (base-object)
:documentation (:description "Experimental. This primitive takes in a list of GDL
......@@ -66,11 +65,10 @@ to be compatible in terms of number of control points, knot vectors, and degree.
:computed-slots ((%native-curves-list%
(if (the tolerance)
(smlib::approximated-compatible-curves *geometry-kernel*
(the curve-list) :tolerance (the tolerance))
(return-compatible-curves *geometry-kernel*
(mapsend (the curve-list) :copy-new)))))
(approximated-compatible-curves *geometry-kernel*
(the curve-list) :tolerance (the tolerance))
(return-compatible-curves *geometry-kernel*
(mapsend (the curve-list) :copy-new)))))
:objects (("Sequence of GDL Curve objects. These are the resultant curves which
are supposed to be compatible."
......
......@@ -742,3 +742,5 @@
(define-smlib-wrapper reduce-surface-knot (surface &key tolerance direction))
(define-smlib-wrapper make-extend-curve (curve &key distance distance-type extending-from continuity))
(define-smlib-wrapper approximated-compatible-curves (curve-list &key length tolerance))
\ No newline at end of file
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment