Skip to content
GitLab
Menu
Projects
Groups
Snippets
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
Menu
Open sidebar
gendl
gendl
Commits
6246454c
Commit
6246454c
authored
Dec 01, 2011
by
Dave Cooper
Browse files
reset to open-source@genworks.com
parent
03dbcf87
Changes
13
Hide whitespace changes
Inline
Side-by-side
gdl/apps/yadd/source/package.lisp
View file @
6246454c
...
...
@@ -19,7 +19,7 @@
;; <http://www.gnu.org/licenses/>.
;;
(
in-package
:user
)
(
in-package
:
common-lisp-
user
)
(
gwl:define-package
:yadd
...
...
gdl/base/tests/source/minimal.lisp
View file @
6246454c
...
...
@@ -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
()
...
...
gdl/cl-lite/source/genworks.lisp
View file @
6246454c
...
...
@@ -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*
...
...
gdl/geom-base/depends-on.isc
View file @
6246454c
(:cl-lite :cl-typesetting)
(:
gdl-
cl-lite :cl-typesetting)
gdl/geom-base/gdl-geom-base.asd
View file @
6246454c
(
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-
bas
e
:cl-typesetting
)
:components
(
:gdl-
cl-lit
e
:cl-typesetting
)
:components
((
:file
"prereqs/source/cl-pdf-patches"
)
(
:file
"prereqs/source/matrix"
)
(
:file
"prereqs/source/genworks"
)
...
...
gdl/geom-base/prereqs/source/genworks.lisp
View file @
6246454c
(
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
gdl/geom-base/prereqs/source/matrix.lisp
View file @
6246454c
...
...
@@ -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
)
...
...
gdl/geom-base/prereqs/source/package.lisp
View file @
6246454c
...
...
@@ -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*
)
...
...
gdl/geom-base/prereqs/source/parameters.lisp
View file @
6246454c
...
...
@@ -50,37 +50,37 @@
(
defvar
*debug?*
nil
)
(
def
constant
*nominal-x-vector*
(
make-vector
1
0
0
))
(
def
constant
*nominal-y-vector*
(
make-vector
0
1
0
))
(
def
constant
*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
))
(
def
constant
*nominal-x-vector-r*
(
make-vector
-1
0
0
))
(
def
constant
*nominal-y-vector-r*
(
make-vector
0
-1
0
))
(
def
constant
*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
))
(
def
constant
*nominal-x-array*
#2a
((
1.0d0
0.0d0
0.0d0
)))
(
def
constant
*nominal-y-array*
#2a
((
0.0d0
1.0d0
0.0d0
)))
(
def
constant
*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
)))
(
def
constant
*nominal-x-array-r*
#2a
((
-1.0d0
0.0d0
0.0d0
)))
(
def
constant
*nominal-y-array-r*
#2a
((
0.0d0
-1.0d0
0.0d0
)))
(
def
constant
*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
)))
(
def
constant
*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)
(
def
constant
*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)
(
def
constant
*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)
(
def
constant
*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)
(
def
constant
+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
)))
(
def
constant
+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.")
(
def
constant
+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
))
(
def
constant
+rear-vector+
(
make-vector
0
1
0
))
(
def
constant
+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
)))
...
...
gdl/geom-nurbs/ignore-list.isc
deleted