Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
Menu
Open sidebar
gendl
gendl
Commits
ac7e87c5
Commit
ac7e87c5
authored
Jun 15, 2014
by
Dave Cooper
Browse files
Merge branch 'release/1587p004' into devo
parents
c37f014d
774644a6
Changes
25
Hide whitespace changes
Inline
Side-by-side
apps/ta2/ta2.asd
View file @
ac7e87c5
;;;; -*- coding: utf-8 -*-
(
asdf:defsystem
#:ta2
:description
"The Gendl™ (legacy) Testing and Tracking Utility, version 2 (using Ajax but pre-gdlAjax, and no JQuery or CSS)"
:author
"Dave Cooper"
:license
"Affero Gnu Public License (http://www.gnu.org/licenses/)"
:serial
t
:version
"20140602"
:depends-on
(
:gwl-graphics
)
(
asdf:defsystem
#:ta2
:description
"The Gendl\" (legacy) Testing and Tracking Utility, version 2 (using Ajax but pre-gdlAjax, and no JQuery or CSS)"
:author
"John McCarthy"
:license
"Affero Gnu Public License (http://www.gnu.org/licenses/)"
:serial
t
:version
"20140615"
:depends-on
(
:gwl-graphics
)
#-
asdf-unicode
:defsystem-depends-on
#-
asdf-unicode
(
:asdf-encodings
)
#+
asdf-encodings
:encoding
#+
asdf-encodings
:utf-8
:components
((
:file
"source/package"
)
(
:file
"source/parameters"
)
(
:file
"source/javascript"
)
(
:file
"source/action-object"
)
(
:file
"source/ajax"
)
(
:file
"source/assembly"
)
(
:file
"source/click-mode"
)
(
:file
"source/inspector"
)
(
:file
"source/object-tree"
)
(
:file
"source/part-type-form"
)
(
:file
"source/publish"
)
(
:file
"source/viewport"
)))
((
:file
"source/package"
)
(
:file
"source/parameters"
)
(
:file
"source/javascript"
)
(
:file
"source/action-object"
)
(
:file
"source/ajax"
)
(
:file
"source/assembly"
)
(
:file
"source/click-mode"
)
(
:file
"source/inspector"
)
(
:file
"source/object-tree"
)
(
:file
"source/part-type-form"
)
(
:file
"source/publish"
)
(
:file
"source/viewport"
)))
apps/tasty/source/part-type-form.lisp
View file @
ac7e87c5
...
...
@@ -80,9 +80,6 @@
(
dolist
(
slot
(
the
required-input-slots
))
(
let
((
status
(
the
root-object
(
slot-status
slot
))))
(
when
(
eql
status
:unbound
)
(
setq
result
nil
))))
(
print-variables
result
)
result
))))
:objects
...
...
apps/tasty/tasty.asd
View file @
ac7e87c5
;;;; -*- coding: utf-8 -*-
(
asdf:defsystem
#:tasty
:description
"The Gendl™ Web-based Development Environment (tasty)"
:author
"Dave Cooper"
:license
"Affero Gnu Public License (http://www.gnu.org/licenses/)"
:serial
t
:version
"20140602"
:depends-on
(
:tree
:gwl-graphics
)
(
asdf:defsystem
#:tasty
:description
"The Gendl\" Web-based Development Environment (tasty)"
:author
"John McCarthy"
:license
"Affero Gnu Public License (http://www.gnu.org/licenses/)"
:serial
t
:version
"20140615"
:depends-on
(
:tree
:gwl-graphics
)
#-
asdf-unicode
:defsystem-depends-on
#-
asdf-unicode
(
:asdf-encodings
)
#+
asdf-encodings
:encoding
#+
asdf-encodings
:utf-8
:components
((
:file
"source/package"
)
(
:file
"source/parameters"
)
(
:file
"source/assembly"
)
(
:file
"source/initialize"
)
(
:file
"source/inspector"
)
(
:file
"source/menu"
)
(
:file
"source/new-inspector"
)
(
:file
"source/newer-inspector"
)
(
:file
"source/part-type-form"
)
(
:file
"source/publish"
)
(
:file
"source/status-object"
)
(
:file
"source/test-part"
)
(
:file
"source/test-part2"
)
(
:file
"source/two-viewports"
)
(
:file
"source/viewport"
)
(
:file
"source/zzinit"
)))
((
:file
"source/package"
)
(
:file
"source/parameters"
)
(
:file
"source/assembly"
)
(
:file
"source/initialize"
)
(
:file
"source/inspector"
)
(
:file
"source/menu"
)
(
:file
"source/new-inspector"
)
(
:file
"source/newer-inspector"
)
(
:file
"source/part-type-form"
)
(
:file
"source/publish"
)
(
:file
"source/status-object"
)
(
:file
"source/test-part"
)
(
:file
"source/test-part2"
)
(
:file
"source/two-viewports"
)
(
:file
"source/viewport"
)
(
:file
"source/zzinit"
)))
apps/translators/translators.asd
View file @
ac7e87c5
;;;; -*- coding: utf-8 -*-
(
asdf:defsystem
#:translators
:description
"The Gendl™ Translators to/from XML and potentially other high-level KBE and Knowledge formats"
:author
"Dave Cooper"
:license
"Affero Gnu Public License (http://www.gnu.org/licenses/)"
:serial
t
:version
"20140602"
:depends-on
(
:gwl
)
(
asdf:defsystem
#:translators
:description
"The Gendl\" Translators to/from XML and potentially other high-level KBE and Knowledge formats"
:author
"John McCarthy"
:license
"Affero Gnu Public License (http://www.gnu.org/licenses/)"
:serial
t
:version
"20140615"
:depends-on
(
:gwl
)
#-
asdf-unicode
:defsystem-depends-on
#-
asdf-unicode
(
:asdf-encodings
)
#+
asdf-encodings
:encoding
#+
asdf-encodings
:utf-8
:components
((
:file
"xml/source/package"
)
(
:file
"xml/source/genworks"
)
(
:file
"xml/source/definition-tree"
)
(
:file
"xml/source/gdl2xml"
)
((
:file
"xml/source/package"
)
(
:file
"xml/source/genworks"
)
(
:file
"xml/source/definition-tree"
)
(
:file
"xml/source/gdl2xml"
)
(
:file
"xml/source/xml2gdl"
)))
apps/tree/tree.asd
View file @
ac7e87c5
;;;; -*- coding: utf-8 -*-
(
asdf:defsystem
#:tree
:description
"The Gendl™ Tree component used by Tasty and potentially as a UI component on its own"
:author
"Dave Cooper"
:license
"Affero Gnu Public License (http://www.gnu.org/licenses/)"
:serial
t
:version
"20140602"
:depends-on
(
:gwl-graphics
)
(
asdf:defsystem
#:tree
:description
"The Gendl\" Tree component used by Tasty and potentially as a UI component on its own"
:author
"John McCarthy"
:license
"Affero Gnu Public License (http://www.gnu.org/licenses/)"
:serial
t
:version
"20140615"
:depends-on
(
:gwl-graphics
)
#-
asdf-unicode
:defsystem-depends-on
#-
asdf-unicode
(
:asdf-encodings
)
#+
asdf-encodings
:encoding
#+
asdf-encodings
:utf-8
:components
((
:file
"source/package"
)
(
:file
"source/parameters"
)
(
:file
"source/ajax"
)
(
:file
"source/assembly"
)
((
:file
"source/package"
)
(
:file
"source/parameters"
)
(
:file
"source/ajax"
)
(
:file
"source/assembly"
)
(
:file
"source/newertree"
)))
apps/yadd/source/genworks.lisp
View file @
ac7e87c5
...
...
@@ -26,7 +26,9 @@
(
append
(
list
:win
:windows
:regexp
)
(
remove-duplicates
#-
allegro
nil
#+
allegro
(
mapcar
#'
rest
excl::*autoload-package-name-alist*
)
#+
allegro
(
append
(
mapcar
#'
(
lambda
(
name
)
(
glisp:intern
(
glisp:upcase
name
)
:keyword
))
(
mapcar
#'
first
excl::*autoload-package-name-alist*
))
(
mapcar
#'
rest
excl::*autoload-package-name-alist*
))
)))
...
...
apps/yadd/yadd.asd
View file @
ac7e87c5
;;;; -*- coding: utf-8 -*-
(
asdf:defsystem
#:yadd
:description
"The Gendl™ Yet Another Definition Documenter (yadd)"
:author
"Dave Cooper"
:license
"Affero Gnu Public License (http://www.gnu.org/licenses/)"
:serial
t
:version
"20140602"
:depends-on
(
asdf:defsystem
#:yadd
:description
"The Gendl\" Yet Another Definition Documenter (yadd)"
:author
"John McCarthy"
:license
"Affero Gnu Public License (http://www.gnu.org/licenses/)"
:serial
t
:version
"20140615"
:depends-on
(
:gwl-graphics
#-
allegro
:cl-html-parse
)
#-
asdf-unicode
:defsystem-depends-on
#-
asdf-unicode
(
:asdf-encodings
)
#+
asdf-encodings
:encoding
#+
asdf-encodings
:utf-8
:components
((
:file
"source/package"
)
(
:file
"source/genworks"
)
(
:file
"source/parameters"
)
(
:file
"source/mixins"
)
((
:file
"source/package"
)
(
:file
"source/genworks"
)
(
:file
"source/parameters"
)
(
:file
"source/mixins"
)
(
:file
"source/define-object-documentation"
)
(
:file
"source/assembly"
)
(
:file
"source/ass"
)
(
:file
"source/assembly"
)
(
:file
"source/ass"
)
(
:file
"source/format-documentation"
)
(
:file
"source/function-documentation"
)
(
:file
"source/initialize"
)
(
:file
"source/publish"
)
(
:file
"source/test-part"
)
(
:file
"source/variable-documentation"
)
(
:file
"source/zzinit"
)))
(
:file
"source/function-documentation"
)
(
:file
"source/initialize"
)
(
:file
"source/publish"
)
(
:file
"source/test-part"
)
(
:file
"source/variable-documentation"
)
(
:file
"source/zzinit"
)))
base/base.asd
View file @
ac7e87c5
;;;; -*- coding: utf-8 -*-
(
asdf:defsystem
#:base
:description
"The Gendl™ Base Core Kernel Engine"
:author
"Dave Cooper"
:license
"Affero Gnu Public License (http://www.gnu.org/licenses/)"
:serial
t
:version
"20140602"
:depends-on
nil
(
asdf:defsystem
#:base
:description
"The Gendl\" Base Core Kernel Engine"
:author
"John McCarthy"
:license
"Affero Gnu Public License (http://www.gnu.org/licenses/)"
:serial
t
:version
"20140615"
:depends-on
nil
#-
asdf-unicode
:defsystem-depends-on
#-
asdf-unicode
(
:asdf-encodings
)
#+
asdf-encodings
:encoding
#+
asdf-encodings
:utf-8
:components
((
:file
"source/package"
)
(
:file
"source/genworks"
)
(
:file
"source/presets"
)
(
:file
"source/parameters"
)
(
:file
"source/metaclasses"
)
(
:file
"source/utilities"
)
(
:file
"source/start"
)
(
:file
"expanders/source/inputs"
)
((
:file
"source/package"
)
(
:file
"source/genworks"
)
(
:file
"source/presets"
)
(
:file
"source/parameters"
)
(
:file
"source/metaclasses"
)
(
:file
"source/utilities"
)
(
:file
"source/start"
)
(
:file
"expanders/source/inputs"
)
(
:file
"expanders/source/computed-slots"
)
(
:file
"expanders/source/functions"
)
(
:file
"expanders/source/methods"
)
...
...
@@ -36,15 +22,10 @@
(
:file
"macros/source/define-format"
)
(
:file
"rest/source/parameters"
)
(
:file
"rest/source/quantification"
)
(
:file
"rest/source/aggregate"
)
(
:file
"rest/source/utilities"
)
(
:file
"rest/source/null-part"
)
(
:file
"rest/source/vanilla-mixin"
)
(
:file
"rest/source/base-rule-object"
)
(
:file
"rest/source/bodies"
)
(
:file
"rest/source/aggregate"
)
(
:file
"rest/source/utilities"
)
(
:file
"rest/source/null-part"
)
(
:file
"rest/source/vanilla-mixin"
)
(
:file
"rest/source/base-rule-object"
)
(
:file
"rest/source/bodies"
)
(
:file
"rest/source/ignore-errors-with-backtrace"
)
(
:file
"rest/source/init"
)
(
:file
"rest/source/make-part"
)
(
:file
"rest/source/sequence"
)
(
:file
"zzinit/source/initialize"
)
(
:file
"rest/source/init"
)
(
:file
"rest/source/make-part"
)
(
:file
"rest/source/sequence"
)
(
:file
"zzinit/source/initialize"
)
(
:file
"zzinit/source/zzinit"
)))
base/source/parameters.lisp
View file @
ac7e87c5
...
...
@@ -23,7 +23,8 @@
;;(defparameter *gendl-version* "1585p002")
;;(defparameter *gendl-version* "1587devo")
(
defparameter
*gendl-version*
"1587p003"
)
;;(defparameter *gendl-version* "1587p003")
(
defparameter
*gendl-version*
"1587p004"
)
;;(defparameter *gendl-version* "ql-2013-12")
(
defparameter
*gendl-patch-level*
nil
)
...
...
cl-lite/cl-lite.asd
View file @
ac7e87c5
;;;; -*- coding: utf-8 -*-
(
asdf:defsystem
#:cl-lite
:description
"The Gendl™ Compile-and-Load Lite Utility"
:author
"Dave Cooper"
:license
"Affero Gnu Public License (http://www.gnu.org/licenses/)"
:serial
t
:version
"20140602"
:depends-on
(
:glisp
)
(
asdf:defsystem
#:cl-lite
:description
"The Gendl\" Compile-and-Load Lite Utility"
:author
"John McCarthy"
:license
"Affero Gnu Public License (http://www.gnu.org/licenses/)"
:serial
t
:version
"20140615"
:depends-on
(
:glisp
)
#-
asdf-unicode
:defsystem-depends-on
#-
asdf-unicode
(
:asdf-encodings
)
#+
asdf-encodings
:encoding
#+
asdf-encodings
:utf-8
:components
((
:file
"source/package"
)
(
:file
"source/parameters"
)
(
:file
"source/cl-lite"
)
(
:file
"source/initialize"
)
((
:file
"source/package"
)
(
:file
"source/parameters"
)
(
:file
"source/cl-lite"
)
(
:file
"source/initialize"
)
(
:file
"source/zzinit"
)))
demos/bus/bus.asd
View file @
ac7e87c5
;;;; -*- coding: utf-8 -*-
(
asdf:defsystem
#:bus
:description
"The Gendl™ Wireframe School Bus Demo"
:author
"Dave Cooper"
:license
"Affero Gnu Public License (http://www.gnu.org/licenses/)"
:serial
t
:version
"20140602"
:depends-on
(
:gwl-graphics
)
(
asdf:defsystem
#:bus
:description
"The Gendl\" Wireframe School Bus Demo"
:author
"John McCarthy"
:license
"Affero Gnu Public License (http://www.gnu.org/licenses/)"
:serial
t
:version
"20140615"
:depends-on
(
:gwl-graphics
)
#-
asdf-unicode
:defsystem-depends-on
#-
asdf-unicode
(
:asdf-encodings
)
#+
asdf-encodings
:encoding
#+
asdf-encodings
:utf-8
:components
((
:file
"source/package"
)
(
:file
"source/assembly"
)
(
:file
"source/body"
)
(
:file
"source/chassis"
)
(
:file
"source/interior"
)
(
:file
"source/rule-ackermann"
)
(
:file
"source/axle"
)
(
:file
"source/fleet"
)
(
:file
"source/frame-rail"
)
(
:file
"source/frame"
)
((
:file
"source/package"
)
(
:file
"source/assembly"
)
(
:file
"source/body"
)
(
:file
"source/chassis"
)
(
:file
"source/interior"
)
(
:file
"source/rule-ackermann"
)
(
:file
"source/axle"
)
(
:file
"source/fleet"
)
(
:file
"source/frame-rail"
)
(
:file
"source/frame"
)
(
:file
"source/html-writer-assembly"
)
(
:file
"source/html-writer-body"
)
(
:file
"source/html-writer-chassis"
)
(
:file
"source/html-writer-interior"
)
(
:file
"source/html-writer-rule-ackermann"
)
(
:file
"source/inter-seat-clearance-check"
)
(
:file
"source/inter-seat-spacing"
)
(
:file
"source/knuckle"
)
(
:file
"source/parameters"
)
(
:file
"source/publish"
)
(
:file
"source/rear-axle"
)
(
:file
"source/seat"
)
(
:file
"source/seating-section"
)
(
:file
"source/seating-side"
)
(
:file
"source/inter-seat-spacing"
)
(
:file
"source/knuckle"
)
(
:file
"source/parameters"
)
(
:file
"source/publish"
)
(
:file
"source/rear-axle"
)
(
:file
"source/seat"
)
(
:file
"source/seating-section"
)
(
:file
"source/seating-side"
)
(
:file
"source/wheel"
)))
demos/ledger/ledger.asd
View file @
ac7e87c5
;;;; -*- coding: utf-8 -*-
(
asdf:defsystem
#:ledger
:description
"The Gendl™ Ledger Bookkeeping Demo"
:author
"Dave Cooper"
:license
"Affero Gnu Public License (http://www.gnu.org/licenses/)"
:serial
t
:version
"20140602"
:depends-on
(
asdf:defsystem
#:ledger
:description
"The Gendl\" Ledger Bookkeeping Demo"
:author
"John McCarthy"
:license
"Affero Gnu Public License (http://www.gnu.org/licenses/)"
:serial
t
:version
"20140615"
:depends-on
(
#-
gwl
:gwl
)
#-
asdf-unicode
:defsystem-depends-on
#-
asdf-unicode
(
:asdf-encodings
)
#+
asdf-encodings
:encoding
#+
asdf-encodings
:utf-8
:components
((
:file
"source/package"
)
(
:file
"source/assembly"
)
(
:file
"source/html"
)
(
:file
"source/zzinit"
)))
((
:file
"source/package"
)
(
:file
"source/assembly"
)
(
:file
"source/html"
)
(
:file
"source/zzinit"
)))
demos/robot/robot.asd
View file @
ac7e87c5
;;;; -*- coding: utf-8 -*-
(
asdf:defsystem
#:robot
:description
"The Gendl™ Simplified Android Robot example "
:author
"Dave Cooper"
:license
"Affero Gnu Public License (http://www.gnu.org/licenses/)"
:serial
t
:version
"20140602"
:depends-on
(
:gwl-graphics
)
(
asdf:defsystem
#:robot
:description
"The Gendl\" Simplified Android Robot example "
:author
"John McCarthy"
:license
"Affero Gnu Public License (http://www.gnu.org/licenses/)"
:serial
t
:version
"20140615"
:depends-on
(
:gwl-graphics
)
#-
asdf-unicode
:defsystem-depends-on
#-
asdf-unicode
(
:asdf-encodings
)
#+
asdf-encodings
:encoding
#+
asdf-encodings
:utf-8
:components
((
:file
"source/package"
)
(
:file
"source/assembly"
)
(
:file
"source/initialize"
)
(
:file
"source/parameters"
)
((
:file
"source/package"
)
(
:file
"source/assembly"
)
(
:file
"source/initialize"
)
(
:file
"source/parameters"
)
(
:file
"source/zzinit"
)))
demos/wire-world/wire-world.asd
View file @
ac7e87c5
;;;; -*- coding: utf-8 -*-
(
asdf:defsystem
#:wire-world
:description
"The Gendl™ Wire-World demo and test-case for wireframe tessellation and X3D output"
:author
"Dave Cooper"
:license
"Affero Gnu Public License (http://www.gnu.org/licenses/)"
:serial
t
:version
"20140602"
:depends-on
(
asdf:defsystem
#:wire-world
:description
"The Gendl\" Wire-World demo and test-case for wireframe tessellation and X3D output"
:author
"John McCarthy"
:license
"Affero Gnu Public License (http://www.gnu.org/licenses/)"
:serial
t
:version
"20140615"
:depends-on
(
#-
gwl-graphics
:gwl-graphics
)
#-
asdf-unicode
:defsystem-depends-on
#-
asdf-unicode
(
:asdf-encodings
)
#+
asdf-encodings
:encoding
#+
asdf-encodings
:utf-8
:components
((
:file
"source/package"
)
(
:file
"source/assembly"
)))
:components
((
:file
"source/package"
)
(
:file
"source/assembly"
)))
documentation/training/g102-tud/examples/examples.asd
View file @
ac7e87c5
;;;; -*- coding: utf-8 -*-
(
asdf:defsystem
#:examples
:description
"The Gendl™ examples Subsystem"
:author
"Dave Cooper"
:license
"Affero Gnu Public License (http://www.gnu.org/licenses/)"
:serial
t
:version
"20140602"
:depends-on
(
:gwl-graphics
:surf
)
(
asdf:defsystem
#:examples
:description
"The Gendl\" examples Subsystem"
:author
"John McCarthy"
:license
"Affero Gnu Public License (http://www.gnu.org/licenses/)"
:serial
t
:version
"20140615"
:depends-on
(
:gwl-graphics
:surf
)
#-
asdf-unicode
:defsystem-depends-on
#-
asdf-unicode
(
:asdf-encodings
)
#+
asdf-encodings
:encoding
#+
asdf-encodings
:utf-8
:components
((
:file
"source/ch2-examples"
)
(
:file
"source/ch3-examples"
)
(
:gdl
"source/primi-plane"
)
(
:gdl
"source/ui-primi-plane"
)))
((
:file
"source/ch2-examples"
)
(
:file
"source/ch3-examples"
)
(
:gdl
"source/primi-plane"
)
(
:gdl
"source/ui-primi-plane"
)))
emacs/gdl.el
View file @
ac7e87c5
...
...
@@ -312,6 +312,9 @@
(
defun
agdl8e
()
(
interactive
)
(
gdl-devo
(
get-executable
'agdl8
)))
(
defun
agdle
()
(
interactive
)
(
gdl-devo
(
get-executable
'agdl
)))
(
defun
gdle
()
(
interactive
)
(
gdl-devo
(
get-executable
'gdl
)))
...
...
geom-base/drawing/source/lenses.lisp
View file @
ac7e87c5
...
...
@@ -34,7 +34,6 @@
(
: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
))
(
:raphael
`
(
let
((
*raphael-translation*
(
add-vectors
(
subseq
,
center
0
2
)
*raphael-translation*
)))
,@
body
))))
(
define-lens
(
pdf
base-drawing
)()
...
...
@@ -45,12 +44,11 @@
(
let
((
view-center
(
if
(
the
user-center
)
(
scalar*vector
(
the
user-scale
)
(
the
user-center
))
(
make-point
0
0
0
))))
(
pdf:with-saved-state
(
when
view
(
unless
*fixed-scale?*
(
pdf:scale
(
the-object
view
view-scale-total
)
(
the-object
view
view-scale-total
))))
(
mapc
#'
(
lambda
(
child-view
)
(
let
((
width
(
the-object
child-view
width
))
(
length
(
the-object
child-view
length
))
...
...
@@ -261,47 +259,13 @@
(
define-lens
(
jpeg
base-drawing
)()
:output-functions
((
cad-output
()
(
let
((
temp-dir
(
glisp:temporary-folder
))
(
temp-name
(
format
nil
"~a-~a"
(
glisp:get-pid
)
(
gensym
))))
(
let
((
temp-pdf
(
make-pathname
:directory
(
pathname-directory
temp-dir
)
:device
(
pathname-device
temp-dir
)
:name
temp-name
:type
"pdf"
))
(
temp-jpeg
(
make-pathname
:directory
(
pathname-directory
temp-dir
)
:device
(
pathname-device
temp-dir
)
:name
temp-name
:type
"jpg"
)))
(
with-format-slots
(
page-width
page-length
foreground-color
background-color
)
(
with-format
(
pdf
temp-pdf
:page-width
page-width
:page-length
page-length
:foreground-color
foreground-color
:background-color
background-color
)
(
write-the
cad-output
)))
(
let
((
command
(
format
nil
"\"~a\" -q -sDEVICE=~a \"-sOutputFile=~a\" -dTextAlphaBits=~a -dGraphicsAlphaBits=~a -dSAFER -dBATCH -dNOPAUSE \"~a\""
*gs-path*
"jpeg"
temp-jpeg
*gs-text-alpha-bits*
*gs-graphics-alpha-bits*
temp-pdf
)))
(
glisp:run-gs
command
))
(
when
*stream*
(
with-open-file
(
image-stream
temp-jpeg
:element-type
'
(
unsigned-byte
8
))
(
do
((
val
(
read-byte
image-stream
nil
nil
)
(
read-byte
image-stream
nil
nil
)))
((
null
val
))
(
write-byte
val
*stream*
))))
(
delete-file
temp-pdf
)
(
delete-file
temp-jpeg
))))))
(
defparameter
*command*
nil
)
(
define-lens
(
png
base-drawing
)()
(
define-lens
(
raster
base-drawing
)()
:output-functions
((
cad-output
()
...
...
@@ -321,6 +285,39 @@
(
with-format
(
pdf
temp-pdf
:page-width
page-width
:page-length
page-length
:background-color
background-color
:foreground-color
foreground-color
)
(
write-the
cad-output
)))
;;
;; FLAG -- try this list form of the command on all
;; implementations, get it working that way, and remove this
;; compiler conditional.
;;
;;#+clozure
(
let
((
command
(
if
(
or
(
null
*gs-path*
)
(
and
(
or
(
stringp
*gs-path*
)
(
pathnamep
*gs-path*
))
(
not
(
probe-file
*gs-path*
))))
(
error
"Gnu Ghostscript executable not found. It is set to ~s.~%"
*gs-path*
)
(
list
(
format
nil
"~a"
*gs-path*
)
"-q"
(
format
nil
"-sDEVICE=~a"
(
write-the
gs-device
))
(
format
nil
"-sOutputFile=~a"
temp-png
)
(
format
nil
"-dTextAlphaBits=~a"
*gs-text-alpha-bits*
)
(
format
nil
"-dGraphicsAlphaBits=~a"
*gs-graphics-alpha-bits*
)
"-dSAFER"
"-dBATCH"
"-dNOPAUSE"
(
namestring
temp-pdf
)))))
(
multiple-value-bind
(
output
error
result
)