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
774644a6
Commit
774644a6
authored
Jun 15, 2014
by
Dave Cooper
Browse files
cleaning up release 1587p004
parent
c37f014d
Changes
25
Hide whitespace changes
Inline
Side-by-side
apps/ta2/ta2.asd
View file @
774644a6
;;;; -*- 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 @
774644a6
...
...
@@ -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 @
774644a6
;;;; -*- 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 @
774644a6
;;;; -*- 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 @
774644a6
;;;; -*- 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 @
774644a6
...
...
@@ -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 @
774644a6
;;;; -*- 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 @
774644a6
;;;; -*- 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 @
774644a6
...
...
@@ -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 @
774644a6
;;;; -*- 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 @
774644a6
;;;; -*- 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 @
774644a6
;;;; -*- 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 @
774644a6
;;;; -*- 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 @
774644a6
;;;; -*- 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 @
774644a6
;;;; -*- 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 @
774644a6
...
...
@@ -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 @
774644a6
...
...
@@ -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
)