Commit 6246454c authored by Dave Cooper's avatar Dave Cooper

reset to open-source@genworks.com

parent 03dbcf87
......@@ -19,7 +19,7 @@
;; <http://www.gnu.org/licenses/>.
;;
(in-package :user)
(in-package :common-lisp-user)
(gwl:define-package :yadd
......
......@@ -25,8 +25,12 @@
(define-object foo ()
:computed-slots ((a "a")))
:computed-slots ((length 10 :settable)
(width (* (the length) 2))
(height (+ (the width) (the length)))
(a "a")))
(define-object bar ()
......
......@@ -21,7 +21,7 @@
(in-package :com.genworks.lisp)
(eval-when (compile load eval)
(eval-when (:compile-toplevel :load-toplevel :execute)
(defpackage :com.genworks.lisp
(:use :common-lisp)
(:export #:*fasl-extension*
......
(:cl-lite :cl-typesetting)
(:gdl-cl-lite :cl-typesetting)
(asdf:defsystem #:gdl-geom-base :description
"Auto-generated asdf defsys from Genworks GDL cl-lite."
:author
"Genworks and Dave Cooper unless otherwise indicated"
:license "AGPL unless otherwise indicated" :serial t
:version "2011101700" :depends-on
(:gdl-base :cl-typesetting) :components
(:gdl-cl-lite :cl-typesetting) :components
((:file "prereqs/source/cl-pdf-patches")
(:file "prereqs/source/matrix")
(:file "prereqs/source/genworks")
......
(in-package :com.genworks.lisp)
(eval-when (compile load eval)
(eval-when (:compile-toplevel :load-toplevel :execute)
(defpackage :com.genworks.lisp
(:use :common-lisp)
(:export #:get-pid
#:run-gs
#:run-shell-command
#:set-gs-path
)))
#:set-gs-path)))
#-(or allegro lispworks sbcl) (error "Need implementation of featurep for currently running lisp.~%")
(defun featurep (x)
#+allegro (excl:featurep x)
#+lispworks (system:featurep x)
#+clozure (ccl::featurep x)
#-(or allegro lispworks clozure)
(error "Need implementation of featurep for currently running lisp.~%"))
(#+allegro excl:featurep #+lispworks system:featurep #+sbcl sb-int:featurep x))
#-(or allegro lispworks sbcl) (error "Need implementation for get-pid for currently running lisp~%")
(defun get-pid ()
#+allegro (excl.osi:getpid)
#+lispworks (multiple-value-bind (status pid)
......@@ -28,15 +21,14 @@
:show-cmd nil :output-stream nil)
(declare (ignore status))
(read-from-string pid))
#-(or allegro lispworks)
(error "Need implementation for get-pid for currently running lisp~%"))
#+sbcl (sb-posix:getpid))
(defun run-gs (command)
"Shell out a ghostscript command and handle errors."
#-allegro (let ((result (asdf-utilities:run-shell-command command)))
(unless (zerop result) (error "Ghostscript threw error")))
#-allegro
(let ((result (asdf-utilities:run-shell-command command)))
(unless (zerop result) (error "Ghostscript threw error")))
#+allegro
(multiple-value-bind (output error return)
(excl.osi:command-output command)
......@@ -46,42 +38,26 @@ output: ~a
return: ~a"
output error return))))
(defun run-shell-command (command &rest args)
;;
;; FLAG -- add specific keyword args e.g. for hide-window?
;;
(asdf-utilities:run-shell-command command))
(apply #'asdf-utilities:run-shell-command command args))
(defun set-gs-path (&optional gs-path)
(if (featurep :mswindows)
(let (found-path)
(if (and gs-path (probe-file gs-path)) (setq found-path gs-path)
(block :gotit
(dolist (toplevel (list
(pathname-directory (translate-logical-pathname "sys:gpl;"))
(pathname-directory (translate-logical-pathname "sys:"))
(append (pathname-directory (user-homedir-pathname)) (list "bin"))
(list :absolute "program files")
(list :absolute)))
(dolist (directory (list "gs" "ghostscript"))
(dolist (subdir (list "gs8.63" "gs7.06" "gs6.52"))
(let ((candidate (make-pathname :directory (append toplevel (list directory subdir "bin"))
:name "gswin32c" :type "exe")))
(when (and candidate (probe-file candidate)) (setq found-path candidate)
(return-from :gotit))))))))
(setq gdl:*gs-path* found-path)
(when gdl:*gs-path*
(format t "~%~%Gnu GhostScript was detected at ~a and registered with GDL.~%~%" (probe-file gdl:*gs-path*))))
(progn
(setq gdl:*gs-path*
(or (probe-file #p"~/bin/gs")
(probe-file #p"/usr/local/bin/gs")
(probe-file #p"/sw/bin/gs")
(probe-file #p"/opt/local/bin/gs")
(probe-file #p"/usr/bin/gs") "gs"))
(when (and (stringp gdl:*gs-path*) (string-equal gdl:*gs-path* "gs")) (warn "Gnu Ghostscript (\"gs\") was not found
in either /usr/local/bin or /usr/bin -- we assume it is elsewhere in your execution path
so we are setting it simply to \"gs\". If Gnu Ghostscript is not installed on your Unix/Linux
system, please contact Genworks for assistance in installing it.")))))
\ No newline at end of file
(setq gdl:*gs-path*
(or (and gs-path (probe-file gs-path))
(if (featurep :mswindows)
(probe-file (merge-pathnames "gpl/gs/gs8.63/bin/gswin32c.exe" glisp:*gdl-home*))
(or (probe-file #p"~/bin/gs")
(probe-file #p"/usr/local/bin/gs")
(probe-file #p"/sw/bin/gs")
(probe-file #p"/opt/local/bin/gs")
(probe-file #p"/usr/bin/gs") "gs"))))
(if gdl:*gs-path*
(format t "~%~%Gnu GhostScript was detected at ~a and registered with GDL.~%~%" (probe-file gdl:*gs-path*))
(warn "Gnu Ghostscript was not found. PNG and JPEG output will not function.
You can set it manually with (glisp:set-gs-path <path-to-gs-executable>).~%")))
\ No newline at end of file
......@@ -6,11 +6,12 @@
;;
;;
(eval-when (compile load eval)
(defpackage :matrix (:export #:matrixp #:num-rows #:num-cols #:square-matrix? #:make-matrix
#:make-identity-matrix #:copy-matrix #:print-matrix
#:transpose-matrix #:multiply-matrix #:add-matrix #:subtract-matrix
#:invert-matrix #:solve-matrix)))
(eval-when (:compile-toplevel :load-toplevel :execute)
(defpackage :matrix (:use :common-lisp)
(:export #:matrixp #:num-rows #:num-cols #:square-matrix? #:make-matrix
#:make-identity-matrix #:copy-matrix #:print-matrix
#:transpose-matrix #:multiply-matrix #:add-matrix #:subtract-matrix
#:invert-matrix #:solve-matrix)))
(in-package :matrix)
......
......@@ -19,177 +19,178 @@
;; <http://www.gnu.org/licenses/>.
;;
(in-package :user)
(in-package :common-lisp-user)
(gdl:define-package :geom-base
(:documentation "GDL Base Geometry Module")
(eval-when (:compile-toplevel :load-toplevel :execute)
(gdl:define-package :geom-base
(:documentation "GDL Base Geometry Module")
(:export #:keyed-transform*vector
#:with-translated-state
#:raphael
#:*raphael-translation*
#:make-vector
#:make-point
#:apply-make-point
#:merge-display-controls
#:*nominal-x-vector*
#:*nominal-y-vector*
#:*nominal-z-vector*
#:*nominal-x-vector-r*
#:*nominal-y-vector-r*
#:*nominal-z-vector-r*
#:*trimetric-normal-vector*
#:*trimetric-normal-vector-left*
#:*trimetric-normal-vector-right-rear*
#:*trimetric-normal-vector-left-rear*
#:*left-handed-transform?*
#:+lh-identity-matrix+
#:+nominal-origin+
#:*standard-views*
#:point-expression
#:+postnet-bits+
#:*hash-transforms?*
#:get-x
#:get-y
#:get-z
#:get-w
#:get-u
#:get-v
#:determinant
#:subtract-vectors
#:add-vectors
#:3d-distance
#:scalar*vector
#:matrix*vector
#:transpose-matrix
#:multiply-matrices
#:dot-vectors
#:alignment
#:make-transform
#:angle-between-vectors-d
#:angle-between-vectors
#:unitize-vector
#:orthogonal-component
#:same-direction-vectors?
#:parallel-vectors?
#:reverse-vector
#:cross-vectors
#:length-vector
#:zero-vector?
#:degree
#:radians-to-degrees
#:radians-to-grads
#:translate-along-vector
#:array-to-list
#:coincident-point?
#:projected-vector
#:rotate-point-d
#:rotate-point
#:rotate-vector
#:rotate-vector-d
#:inter-circle-sphere
#:inter-line-sphere
#:inter-line-plane
#:translate
#:create-obliqueness
#:proj-point-on-line
#:pythagorize
#:roll
#:rotation
#:transform-and-translate-point
#:transform-numeric-point
#:quaternion-to-rotation
#:quaternion-to-matrix
#:matrix-to-quaternion
#:normalize-quaternion
#:degrees-to-radians
#:acosd
#:asind
#:atand
#:midpoint
#:between?
#:curve-parameter-<
#:roughly-aligned-vectors?
#:distance-to-line
#:equi-space-points
#:sort-points-along-vector
#:bounding-box-from-points
#:flatten-lines
#:flatten-curves
(:export #:keyed-transform*vector
#:with-translated-state
#:raphael
#:*raphael-translation*
#:make-vector
#:make-point
#:apply-make-point
#:merge-display-controls
#:*nominal-x-vector*
#:*nominal-y-vector*
#:*nominal-z-vector*
#:*nominal-x-vector-r*
#:*nominal-y-vector-r*
#:*nominal-z-vector-r*
#:*trimetric-normal-vector*
#:*trimetric-normal-vector-left*
#:*trimetric-normal-vector-right-rear*
#:*trimetric-normal-vector-left-rear*
#:*left-handed-transform?*
#:+lh-identity-matrix+
#:+nominal-origin+
#:*standard-views*
#:point-expression
#:+postnet-bits+
#:*hash-transforms?*
#:get-x
#:get-y
#:get-z
#:get-w
#:get-u
#:get-v
#:determinant
#:subtract-vectors
#:add-vectors
#:3d-distance
#:scalar*vector
#:matrix*vector
#:transpose-matrix
#:multiply-matrices
#:dot-vectors
#:alignment
#:make-transform
#:angle-between-vectors-d
#:angle-between-vectors
#:unitize-vector
#:orthogonal-component
#:same-direction-vectors?
#:parallel-vectors?
#:reverse-vector
#:cross-vectors
#:length-vector
#:zero-vector?
#:degree
#:radians-to-degrees
#:radians-to-grads
#:translate-along-vector
#:array-to-list
#:coincident-point?
#:projected-vector
#:rotate-point-d
#:rotate-point
#:rotate-vector
#:rotate-vector-d
#:inter-circle-sphere
#:inter-line-sphere
#:inter-line-plane
#:translate
#:create-obliqueness
#:proj-point-on-line
#:pythagorize
#:roll
#:rotation
#:transform-and-translate-point
#:transform-numeric-point
#:quaternion-to-rotation
#:quaternion-to-matrix
#:matrix-to-quaternion
#:normalize-quaternion
#:degrees-to-radians
#:acosd
#:asind
#:atand
#:midpoint
#:between?
#:curve-parameter-<
#:roughly-aligned-vectors?
#:distance-to-line
#:equi-space-points
#:sort-points-along-vector
#:bounding-box-from-points
#:flatten-lines
#:flatten-curves
#:arc
#:base-object
#:base-geometry-object
#:bezier-curve
#:box
#:bbox
#:c-cylinder
#:circle
#:cone
#:cylinder
#:ellipse
#:global-filleted-polygon-projection
#:global-filleted-polyline
#:global-polygon-projection
#:global-polyline
#:graph
#:l-line
#:null-geometric-object
#:outline-specialization-mixin
#:point
#:route-pipe
#:sphere
#:spherical-cap
#:torus
#:cut-cylinder ;;do later
#:filleted-polyline ;; do later
#:line ;;do later
#:point
#:polyline ;; do later
#:polygon-projection ;;do later
#:arc
#:base-object
#:base-geometry-object
#:bezier-curve
#:box
#:bbox
#:c-cylinder
#:circle
#:cone
#:cylinder
#:ellipse
#:global-filleted-polygon-projection
#:global-filleted-polyline
#:global-polygon-projection
#:global-polyline
#:graph
#:l-line
#:null-geometric-object
#:outline-specialization-mixin
#:point
#:route-pipe
#:sphere
#:spherical-cap
#:torus
#:cut-cylinder ;;do later
#:filleted-polyline ;; do later
#:line ;;do later
#:point
#:polyline ;; do later
#:polygon-projection ;;do later
#:points-display
#:points-display
#:note
#:text-block
#:text-lines
#:typeset-block
#:typeset-blocks
#:base-drawing
#:base-view
#:document
#:horizontal-dimension
#:parallel-dimension
#:vertical-dimension
#:label
#:linear-dimension
#:leader-line
#:note
#:text-block
#:text-lines
#:typeset-block
#:typeset-blocks
#:base-drawing
#:base-view
#:document
#:horizontal-dimension
#:parallel-dimension
#:vertical-dimension
#:label
#:linear-dimension
#:leader-line
#:dxf
#:obj
#:pdf-multipage
#:pdf
#:pdf-raw
#:png
#:jpeg
#:vrml
#:x3d
#:vector-graphics
#:dxf
#:obj
#:pdf-multipage
#:pdf
#:pdf-raw
#:png
#:jpeg
#:vrml
#:x3d
#:vector-graphics
#:pie-chart
#:pie-chart
#:*gs-text-alpha-bits*
#:*gs-graphics-alpha-bits*
#:*gs-text-alpha-bits*
#:*gs-graphics-alpha-bits*
;;
;;
;; FLAG -- consider exporting these if requested.
;;
;;#:3d-vector-to-array
;;#:array-to-3d-vector
;;
;;
;; FLAG -- consider exporting these if requested.
;;
;;#:3d-vector-to-array
;;#:array-to-3d-vector
))
)))
(pushnew (find-package :geom-base) gdl:*reserved-word-protected-packages*)
......
......@@ -50,37 +50,37 @@
(defvar *debug?* nil)
(defconstant *nominal-x-vector* (make-vector 1 0 0))
(defconstant *nominal-y-vector* (make-vector 0 1 0))
(defconstant *nominal-z-vector* (make-vector 0 0 1))
(glisp:define-constant *nominal-x-vector* (make-vector 1 0 0))
(glisp:define-constant *nominal-y-vector* (make-vector 0 1 0))
(glisp:define-constant *nominal-z-vector* (make-vector 0 0 1))
(defconstant *nominal-x-vector-r* (make-vector -1 0 0))
(defconstant *nominal-y-vector-r* (make-vector 0 -1 0))
(defconstant *nominal-z-vector-r* (make-vector 0 0 -1))
(glisp:define-constant *nominal-x-vector-r* (make-vector -1 0 0))
(glisp:define-constant *nominal-y-vector-r* (make-vector 0 -1 0))
(glisp:define-constant *nominal-z-vector-r* (make-vector 0 0 -1))
(defconstant *nominal-x-array* #2a((1.0d0 0.0d0 0.0d0)))
(defconstant *nominal-y-array* #2a((0.0d0 1.0d0 0.0d0)))
(defconstant *nominal-z-array* #2a((0.0d0 0.0d0 1.0d0)))
(glisp:define-constant *nominal-x-array* #2a((1.0d0 0.0d0 0.0d0)))
(glisp:define-constant *nominal-y-array* #2a((0.0d0 1.0d0 0.0d0)))
(glisp:define-constant *nominal-z-array* #2a((0.0d0 0.0d0 1.0d0)))
(defconstant *nominal-x-array-r* #2a((-1.0d0 0.0d0 0.0d0)))
(defconstant *nominal-y-array-r* #2a((0.0d0 -1.0d0 0.0d0)))
(defconstant *nominal-z-array-r* #2a((0.0d0 0.0d0 -1.0d0)))
(glisp:define-constant *nominal-x-array-r* #2a((-1.0d0 0.0d0 0.0d0)))
(glisp:define-constant *nominal-y-array-r* #2a((0.0d0 -1.0d0 0.0d0)))
(glisp:define-constant *nominal-z-array-r* #2a((0.0d0 0.0d0 -1.0d0)))
(defconstant *trimetric-normal-vector* (make-vector 0.8342367128320977 -0.4377640254359154 0.3352786378480434))
(glisp:define-constant *trimetric-normal-vector* (make-vector 0.8342367128320977 -0.4377640254359154 0.3352786378480434))
;;(make-vector 0.83425635 -0.43777433 0.33528653)
(defconstant *trimetric-normal-vector-left* (make-vector -0.8342367128320977 -0.4377640254359154 0.3352786378480434))
(glisp:define-constant *trimetric-normal-vector-left* (make-vector -0.8342367128320977 -0.4377640254359154 0.3352786378480434))
;;(make-vector -0.83425635 -0.43777433 0.33528653)
(defconstant *trimetric-normal-vector-right-rear* (make-vector 0.8342367128320977 0.4377640254359154 0.3352786378480434))
(glisp:define-constant *trimetric-normal-vector-right-rear* (make-vector 0.8342367128320977 0.4377640254359154 0.3352786378480434))
;;(make-vector 0.83425635 0.43777433 0.33528653)
(defconstant *trimetric-normal-vector-left-rear* (make-vector -0.8342367128320977 0.4377640254359154 0.3352786378480434))
(glisp:define-constant *trimetric-normal-vector-left-rear* (make-vector -0.8342367128320977 0.4377640254359154 0.3352786378480434))
;;(make-vector -0.83425635 0.43777433 0.33528653)
(defconstant +nominal-origin+ (make-point 0 0 0))
(glisp:define-constant +nominal-origin+ (make-point 0 0 0))
(defparameter *standard-face-hts* (make-hash-table :test #'equalp))
......@@ -110,7 +110,7 @@ to graphics when making PNG or JPEG images. Defaults to 4. Set to 0 for no antia
(defun point-expression (point)
`(make-point ,(get-x point) ,(get-y point) ,(get-z point)))
(defconstant +postnet-bits+
(glisp:define-constant +postnet-bits+
(make-array 10 :initial-contents '((t t nil nil nil) ;;0
(nil nil nil t t) ;;1
(nil nil t nil t) ;;2
......@@ -146,7 +146,7 @@ disabled, so this parameter will have no effect.</i> Defaults to T.")
(defconstant +identity-3x3+
(glisp:define-constant +identity-3x3+
(make-array (list 3 3)
:initial-contents '((1d0 0d0 0d0)
(0d0 1d0 0d0)
......@@ -164,8 +164,8 @@ the value of this parameter at your own risk.")
(defparameter *dxf-translation* (make-vector 0 0))
(defparameter *raphael-translation* (make-vector 0 0))
(defconstant +rear-vector+ (make-vector 0 1 0))
(defconstant +top-vector+ (make-vector 0 0 1))
(glisp:define-constant +rear-vector+ (make-vector 0 1 0))
(glisp:define-constant +top-vector+ (make-vector 0 0 1))
(defparameter +lh-identity-matrix+ #2A((-1.0 0.0 0.0)(0.0 1.0 0.0)(0.0 0.0 1.0)))
......
......@@ -6,8 +6,7 @@
:license "AGPL unless otherwise indicated" :serial t
:version "2011102000" :depends-on
(:gdl-geom-base :gdl-gwl) :components
((:file "gwl/source/package")
(:file "gwl/source/parameters")
((:file "gwl/source/parameters")
(:file "gwl/source/application-mixin")
(:file "gwl/source/base-ajax-graphics-sheet")
(:file "gwl/source/base-html-graphics-sheet")
......
(in-package :gdl-user)
(gdl:define-package :gwl
(:shadow #:define-package))
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