Commit 0e7bd69e authored by Dave Cooper's avatar Dave Cooper

cleaned up several customer deployment issues

parent 0073c627
......@@ -40,11 +40,12 @@
(ignore-errors (funcall (read-from-string "asdf:system-source-directory") "base"))
(if (typep error 'error)
(warn "~&ASDF is loaded, but :base is not registered. glisp:*genworks-source-home* remains unknown and set to nil.~%")
(setq *genworks-source-home*
(make-pathname :name nil
:type nil
:directory (butlast (butlast (pathname-directory base-home)))
:defaults base-home)))))))
(when base-home
(setq *genworks-source-home*
(make-pathname :name nil
:type nil
:directory (butlast (butlast (pathname-directory base-home)))
:defaults base-home))))))))
(set-genworks-source-home-if-known)
......
......@@ -70,7 +70,7 @@ given as keyword args to this function)."
(remf args :show-redefinition-warnings? )
(with-compilation-unit ()
(let ((object (apply #'make-object 'codebase-directory-node :pathname pathname args)))
(unless (the-object object dry-run?)
(unless nil ;;(the-object object dry-run?)
(the-object object (compile-and-load :package-file-ht package-file-ht)))
(when (the-object object create-asd-file?)
(the-object object (write-asd-file))))))))
......
......@@ -122,28 +122,29 @@
:output-functions
((cad-output
()
(set-format-slot view self)
(let ((center (the center))(view-center (scalar*vector (the view-scale-total)
(keyed-transform*vector (the view-transform)
(the view-center)))))
(with-translated-state (:dxf center)
(with-format-slots (view)
(set-format-slot view nil)
(dolist (cache (list-elements (the annotation-caches)))
(write-the-object cache object cad-output) (write-the-object cache lines-and-curves))
(set-format-slot view view))
(dolist (cache (list-elements (the object-caches)))
(let ((*dxf-entity-id* (or *dxf-entity-id* 107)))
(set-format-slot view self)
(let ((center (the center))(view-center (scalar*vector (the view-scale-total)
(keyed-transform*vector (the view-transform)
(the view-center)))))
(with-translated-state (:dxf center)
(with-format-slots (view)
(set-format-slot view nil)
(dolist (cache (list-elements (the annotation-caches)))
(write-the-object cache object cad-output) (write-the-object cache lines-and-curves))
(set-format-slot view view))
(dolist (cache (list-elements (the object-caches)))
(write-the-object cache object cad-output))
;;
;; FLAG - look into capturing this translate in the
;; vertex-array-2d-scaled in view-object-cache. so it will
;; become unecessary here.
;;
(with-translated-state (:dxf (make-vector (- (get-x view-center))
(- (get-y view-center))))
(dolist (cache (list-elements (the object-caches)))
(write-the-object cache lines-and-curves))))))))
(write-the-object cache object cad-output))
;;
;; FLAG - look into capturing this translate in the
;; vertex-array-2d-scaled in view-object-cache. so it will
;; become unecessary here.
;;
(with-translated-state (:dxf (make-vector (- (get-x view-center))
(- (get-y view-center))))
(dolist (cache (list-elements (the object-caches)))
(write-the-object cache lines-and-curves)))))))))
;;
......
......@@ -23,7 +23,7 @@
(defparameter *dxf-header*
(defparameter *dxf-header-new*
" 0
SECTION
2
......@@ -2547,8 +2547,10 @@ ENTITIES
")
(defparameter *dxf-header* *dxf-header-new*)
(defparameter *dxf-footer*
(defparameter *dxf-footer-new*
" 0
ENDSEC
0
......@@ -3860,11 +3862,10 @@ EOF
")
(defparameter *dxf-footer* *dxf-footer-new*)
#+nil ;; original - currently in 1590
(defparameter *dxf-header*
(defparameter *dxf-header-pre-1592*
" 0
SECTION
2
......@@ -3872,7 +3873,7 @@ HEADER
9
$ACADVER
1
AC1500
AC1009
9
$DWGCODEPAGE
3
......@@ -4052,15 +4053,30 @@ ENTITIES
")
#+nil ;; original - currently in 1590
(defparameter *dxf-footer*
(defparameter *dxf-footer-pre-1592*
" 0
ENDSEC
0
EOF
")
(define-format dxf (2d-output))
(defun legacy-dxf ()
(setq *dxf-header* *dxf-header-pre-1592*
*dxf-footer* *dxf-footer-pre-1592*)
(format t "Switched to legacy DXF header and footer.~%"))
(defun new-dxf ()
(setq *dxf-header* *dxf-header-new*
*dxf-footer* *dxf-footer-new*)
(format t "Switched to new DXF header and footer.~%"))
......@@ -100,7 +100,7 @@ Perhaps a zombie process is holding port ~a?~%" port port))
(ignore-errors
(glisp:with-timeout (2 (error "AllegroServe port probe timed out on port ~a.
Perhaps a zombie process is holding port ~a?~%" port port))
(net.aserve.client:do-http-request (format nil "http://localhost:~a" port))))
(net.aserve.client:do-http-request (format nil "http://127.0.0.1:~a" port))))
(declare (ignore result))
(when (typep error 'error)
port))
......
Markdown is supported
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