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
98ed3335
Commit
98ed3335
authored
Sep 20, 2012
by
Dave Cooper
Browse files
added wind demo and server log to server
parent
ba318fad
Changes
23
Hide whitespace changes
Inline
Side-by-side
demos/gdlinit.cl
View file @
98ed3335
...
...
@@ -28,4 +28,4 @@
;; Initialize SMLib here if available.
;;
;;(smlib::initialize-smlib)
demos/newsite/static/documents/gendl-development.pdf
View file @
98ed3335
No preview for this file type
demos/wind-demo-1/source/wt-demo-1.lisp
View file @
98ed3335
...
...
@@ -8,7 +8,47 @@
((
css-style
"/css-demo-1/style-wind-1.css"
))
:computed-slots
((
additional-header-content
((
use-raphael?
t
)
(
iges-url
(
let
((
url
(
format
nil
"~a/model.iges"
(
the
url
))))
(
publish
:path
url
:function
#'
(
lambda
(
req
ent
)
(
with-http-response
(
req
ent
)
(
with-http-body
(
req
ent
)
(
with-format
(
iges
(
request-reply-stream
req
))
(
write-the
graphics
rotor
cad-output-tree
))))))
url
))
(
step-url
(
let
((
url
(
format
nil
"~a/model.step"
(
the
url
))))
(
publish
:path
url
:function
#'
(
lambda
(
req
ent
)
(
with-http-response
(
req
ent
)
(
with-http-body
(
req
ent
)
(
with-format
(
step
(
request-reply-stream
req
))
(
write-the
graphics
rotor
cad-output-tree
))))))
url
))
(
stl-url
(
let
((
url
(
format
nil
"~a/model.stl"
(
the
url
))))
(
publish
:path
url
:function
#'
(
lambda
(
req
ent
)
(
with-http-response
(
req
ent
)
(
with-http-body
(
req
ent
)
(
with-format
(
stl
(
request-reply-stream
req
))
(
write-the
graphics
rotor
cad-output-tree
))))))
url
))
(
x3d-url
(
let
((
url
(
format
nil
"~a/model.x3d"
(
the
url
))))
(
publish
:path
url
:function
#'
(
lambda
(
req
ent
)
(
with-http-response
(
req
ent
)
(
with-http-body
(
req
ent
)
(
with-format
(
x3d
(
request-reply-stream
req
))
(
write-the
graphics
rotor
cad-output-tree
))))))
url
))
(
additional-header-content
(
with-cl-who-string
()
(
:p
(
when
*developing?*
(
str
(
the
development-links
))))
(
:style
:type
"text/css"
:media
"all"
...
...
@@ -69,7 +109,8 @@
((
general-inputs
:type
'general-inputs
)
(
displayed-component
:type
'displayed-component
)
(
export-section
:type
'export-section
)
(
export-section
:type
'export-section
:pass-down
(
iges-url
step-url
stl-url
x3d-url
))
(
turbine-characteristics-1
:type
'turbine-characteristics-1
)
(
turbine-characteristics-2
:type
'turbine-characteristics-2
)
(
graphics
:type
'graphics
...
...
@@ -124,6 +165,8 @@
(
define-object
export-section
(
sheet-section
)
:input-slots
(
iges-url
step-url
stl-url
x3d-url
)
:computed-slots
((
main-view
(
with-cl-who-string
()
...
...
@@ -132,13 +175,31 @@
(
:tr
(
:td
)
(
:td
))
(
:tr
((
:td
)
"IGES file"
)
((
:td
:align
"right"
)
(
:button
:onClick
"www.ke-works.ro"
(
:i
"Download"
))))
(
:tr
(
:td
"STL file"
)
((
:td
:align
"right"
)
(
:button
:onClick
"www.ke-works.ro"
(
:i
"Download"
))))
(
:tr
(
:td
"VRML file"
)
((
:td
:align
"right"
)
(
:button
:onClick
"www.ke-works.ro"
(
:i
"Download"
))))
((
:td
:align
"right"
)
((
:a
:href
(
the
iges-url
)
:target
"cad-data"
)
"Flat"
))
((
:td
:align
"right"
)
((
:span
:title
"coming soon..."
)
"Assembly"
)))
(
:tr
((
:td
)
"STEP file"
)
((
:td
:align
"right"
)
((
:a
:href
(
the
step-url
)
:target
"cad-data"
)
"Flat"
))
((
:td
:align
"right"
)
((
:span
:title
"coming soon..."
)
"Assembly"
)))
(
:tr
((
:td
)
"STL file"
)
((
:td
:align
"right"
)
((
:a
:href
(
the
stl-url
)
:target
"cad-data"
)
"Flat"
))
((
:td
:align
"right"
)
((
:span
:title
"coming soon..."
)
"Assembly"
)))
(
:tr
((
:td
)
"X3D file"
)
((
:td
:align
"right"
)
((
:span
:title
"not available..."
)
"Flat"
))
((
:td
:align
"right"
)
((
:a
:href
(
the
x3d-url
)
:target
"cad-data"
)
"Assembly"
)))
#+
nil
(
:tr
(
:td
"PNG"
)
((
:td
:align
"right"
)
(
:button
:onClick
"www.ke-works.ro"
(
:i
"Download"
))))))))))
...
...
@@ -232,6 +293,8 @@
(
inner-html
(
the
graphics
inner-html
))
(
js-to-eval
(
the
graphics
js-to-eval
))
)
...
...
@@ -240,10 +303,13 @@
:blade-concepts
(
the
blade-concepts
)
:nr-blades-data
(
the
number-of-blades
))
#+
nil
(
box
:type
'surf::test-b-spline-surface
:sequence
(
:size
30
))
(
graphics
:type
'base-ajax-graphics-sheet
:hidden?
t
:respondent
(
the
respondent
)
:image-format-default
:png
:view-direction-default
:trimetric
:viewport-border-default
0
...
...
@@ -299,3 +365,8 @@
(
publish-directory
:prefix
"/css-demo-1"
:destination
(
format
nil
"~a"
(
merge-pathnames
"css-demo-1"
*data-pathname*
)))
(
defun
init
()
(
setq
*data-pathname*
"~dcooper8/genworks-gdl/demos/wind-demo-1/data/"
)
(
publish-directory
:prefix
"/css-demo-1"
:destination
(
format
nil
"~a"
(
merge-pathnames
"css-demo-1"
*data-pathname*
))))
\ No newline at end of file
dist/emacs/emacs-goodies-el/color-theme-library.el
View file @
98ed3335
...
...
@@ -805,7 +805,7 @@ eshell."
(speedbar-highlight-face ((t (:background "sea green"))))
(font-lock-doc-string-face ((t (:foreground "Plum1" :bold t))))
(font-lock-exit-face ((t (:foreground "green"))))
(ff-paths-non-existant-file-face ((t (:foreground "NavyBlue" :bold t))))
;;
(ff-paths-non-existant-file-face ((t (:foreground "NavyBlue" :bold t))))
(show-paren-match-face ((t (:background "red"))))
(show-paren-mismatch-face ((t (:foreground "white" :background "purple"))))
(message-header-to-face ((t (:foreground "green2" :bold t))))
...
...
@@ -855,42 +855,42 @@ eshell."
(gnus-summary-low-read-face ((t (:foreground "PaleGreen" :italic t))))
(gnus-summary-normal-read-face ((t (:foreground "PaleGreen"))))
(gnus-splash-face ((t (:foreground "Brown"))))
(eshell-ls-directory-face ((t (:foreground "SkyBlue" :bold t))))
(eshell-ls-symlink-face ((t (:foreground "Cyan" :bold t))))
(eshell-ls-executable-face ((t (:foreground "Green" :bold t))))
(eshell-ls-readonly-face ((t (:foreground "Pink"))))
(eshell-ls-unreadable-face ((t (:foreground "DarkGrey"))))
(eshell-ls-special-face ((t (:foreground "Magenta" :bold t))))
(eshell-ls-missing-face ((t (:foreground "Red" :bold t))))
(eshell-ls-archive-face ((t (:foreground "Orchid" :bold t))))
(eshell-ls-backup-face ((t (:foreground "LightSalmon"))))
(eshell-ls-product-face ((t (:foreground "LightSalmon"))))
(eshell-ls-clutter-face ((t (:foreground "OrangeRed" :bold t))))
(eshell-prompt-face ((t (:foreground "Pink" :bold t))))
(term-default-fg ((t (nil))))
(term-default-bg ((t (nil))))
(term-default-fg-inv ((t (nil))))
(term-default-bg-inv ((t (nil))))
(term-bold ((t (:bold t))))
(term-underline ((t (:underline t))))
(term-invisible ((t (nil))))
(term-invisible-inv ((t (nil))))
(term-black ((t (:foreground "black"))))
(term-red ((t (:foreground "red"))))
(term-green ((t (:foreground "green"))))
(term-yellow ((t (:foreground "yellow"))))
(term-blue ((t (:foreground "blue"))))
(term-magenta ((t (:foreground "magenta"))))
(term-cyan ((t (:foreground "cyan"))))
(term-white ((t (:foreground "white"))))
(term-blackbg ((t (:background "black"))))
(term-redbg ((t (:background "red"))))
(term-greenbg ((t (:background "green"))))
(term-yellowbg ((t (:background "yellow"))))
(term-bluebg ((t (:background "blue"))))
(term-magentabg ((t (:background "magenta"))))
(term-cyanbg ((t (:background "cyan"))))
(term-whitebg ((t (:background "white"))))
;;
(eshell-ls-directory-face ((t (:foreground "SkyBlue" :bold t))))
;;
(eshell-ls-symlink-face ((t (:foreground "Cyan" :bold t))))
;;
(eshell-ls-executable-face ((t (:foreground "Green" :bold t))))
;;
(eshell-ls-readonly-face ((t (:foreground "Pink"))))
;;
(eshell-ls-unreadable-face ((t (:foreground "DarkGrey"))))
;;
(eshell-ls-special-face ((t (:foreground "Magenta" :bold t))))
;;
(eshell-ls-missing-face ((t (:foreground "Red" :bold t))))
;;
(eshell-ls-archive-face ((t (:foreground "Orchid" :bold t))))
;;
(eshell-ls-backup-face ((t (:foreground "LightSalmon"))))
;;
(eshell-ls-product-face ((t (:foreground "LightSalmon"))))
;;
(eshell-ls-clutter-face ((t (:foreground "OrangeRed" :bold t))))
;;
(eshell-prompt-face ((t (:foreground "Pink" :bold t))))
;;
(term-default-fg ((t (nil))))
;;
(term-default-bg ((t (nil))))
;;
(term-default-fg-inv ((t (nil))))
;;
(term-default-bg-inv ((t (nil))))
;;
(term-bold ((t (:bold t))))
;;
(term-underline ((t (:underline t))))
;;
(term-invisible ((t (nil))))
;;
(term-invisible-inv ((t (nil))))
;;
(term-black ((t (:foreground "black"))))
;;
(term-red ((t (:foreground "red"))))
;;
(term-green ((t (:foreground "green"))))
;;
(term-yellow ((t (:foreground "yellow"))))
;;
(term-blue ((t (:foreground "blue"))))
;;
(term-magenta ((t (:foreground "magenta"))))
;;
(term-cyan ((t (:foreground "cyan"))))
;;
(term-white ((t (:foreground "white"))))
;;
(term-blackbg ((t (:background "black"))))
;;
(term-redbg ((t (:background "red"))))
;;
(term-greenbg ((t (:background "green"))))
;;
(term-yellowbg ((t (:background "yellow"))))
;;
(term-bluebg ((t (:background "blue"))))
;;
(term-magentabg ((t (:background "magenta"))))
;;
(term-cyanbg ((t (:background "cyan"))))
;;
(term-whitebg ((t (:background "white"))))
(gnus-emphasis-bold ((t (:bold t))))
(gnus-emphasis-italic ((t (:italic t))))
(gnus-emphasis-underline ((t (:underline t))))
...
...
gdl/apps/server-log/.svn/entries
0 → 100644
View file @
98ed3335
10
dir
990
svn://svn.genworks.com/rainforest/trunk/genworks/gdl/apps/server-log
svn://svn.genworks.com/rainforest
2010-09-29T18:40:16.637689Z
26
dcooper8
a8dd3158-16c2-4b09-9e8e-1a0d18a46f2f
source
dir
gdl/apps/server-log/depends-on.isc
0 → 100644
View file @
98ed3335
(:gdl-gwl)
\ No newline at end of file
gdl/apps/server-log/gdl-server-log.asd
0 → 100644
View file @
98ed3335
(
asdf:defsystem
#:gdl-server-log
: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
"2012091800"
:depends-on
(
:gdl-gwl
)
:components
((
:lisp
"source/package"
)
(
:lisp
"source/assembly"
)
(
:lisp
"source/publish"
)))
\ No newline at end of file
gdl/apps/server-log/source/.svn/entries
0 → 100644
View file @
98ed3335
10
dir
990
svn://svn.genworks.com/rainforest/trunk/genworks/gdl/apps/server-log/source
svn://svn.genworks.com/rainforest
2010-09-29T18:40:16.637689Z
26
dcooper8
a8dd3158-16c2-4b09-9e8e-1a0d18a46f2f
package.lisp
file
2011-11-01T23:13:23.459564Z
74b5a1f8a30d814211b9abe5aacf0381
2010-09-29T18:40:16.637689Z
26
dcooper8
has-props
127
file-ordering.isc
file
2011-11-01T23:13:23.459564Z
92d42a124ebbe036708c932bea978229
2010-09-29T18:40:16.637689Z
26
dcooper8
has-props
12
assembly.lisp
file
2011-11-01T23:13:23.459564Z
4c73645cc81572543732f636518487d3
2010-09-29T18:40:16.637689Z
26
dcooper8
has-props
3215
publish.lisp
file
2011-11-01T23:13:23.459564Z
345182a4bfb7efc8642df1c1037f5cb6
2010-09-29T18:40:16.637689Z
26
dcooper8
has-props
392
gdl/apps/server-log/source/.svn/prop-base/assembly.lisp.svn-base
0 → 100644
View file @
98ed3335
K 14
svn:executable
V 0
END
gdl/apps/server-log/source/.svn/prop-base/file-ordering.isc.svn-base
0 → 100644
View file @
98ed3335
K 14
svn:executable
V 0
END
gdl/apps/server-log/source/.svn/prop-base/package.lisp.svn-base
0 → 100644
View file @
98ed3335
K 14
svn:executable
V 0
END
gdl/apps/server-log/source/.svn/prop-base/publish.lisp.svn-base
0 → 100644
View file @
98ed3335
K 14
svn:executable
V 0
END
gdl/apps/server-log/source/.svn/text-base/assembly.lisp.svn-base
0 → 100644
View file @
98ed3335
(in-package :aserve-log)
(define-object assembly (base-html-sheet)
:input-slots
((relevant-headings (list :domain :iso-time :uri-path :user-agent :referrer))
(relevant-hosts (list "www.genworks.com" "www.squeakymail.com")))
:functions
((write-html-sheet
()
(html
(:html
(:head (:title "Log Report"))
(:body (:center (:h2 "Log Report"))
(:p (the (:write-log-table)))))))
(:pass-filter?
(log &key relevant-hosts)
;;
;; FLAG -- make more general and configurable.
;;
(let ((domain (getf log :domain))
(uri-path (getf log :uri-path))
(user-agent (getf log :user-agent)))
(and (or (null relevant-hosts)
(member (getf log :uri-host) relevant-hosts :test #'string-equal))
(or (null user-agent)
(not (or (search "usabestnet" domain)
(search "c-68-40-98-13.hsd1.mi.comcast.net" domain)
(search "msnbot.msn.com" domain)
(search "netsonic.fi" domain)
(search "amiedu.fi" domain)
(search "looksmart" domain)
(search "buildrack" domain)
(search "wwnet.net" domain)
(search "internetseer.net" domain)
(search "googlebot.com" domain)
(search "inktomi" domain)
(search "echo.com" domain)
(search "netcraft.com" domain)
(search "spider" domain)
(string-equal uri-path "/robots.txt")
(string-equal uri-path "/server-log")
(search ".gif" uri-path)
(search ".jpg" uri-path)
(search "formmail" uri-path)
(string-equal user-agent "ia_archiver")
(search "Gozilla" user-agent)
(search "raw.no-ip.com/monitor" user-agent)
(search "grub" user-agent)
(search "Sleuth" user-agent)
(search "Ask Jeeves" user-agent)
(search "crawler" (string-downcase user-agent))
(search "robot" (string-downcase user-agent))
(search "LinkScan" user-agent)
(search "sitecheck.internetseer.com" user-agent)
(search "Googlebot" user-agent)))))))
(:write-log-table
()
(let* ((log-entries (progn (clear-log-buffer) *log-report-buffer*))
(latest-time (getf (first log-entries) :time))
(cut-off-time (- latest-time (* 5 24 60 60)))
(relevant-hosts (the :relevant-hosts))
(entry-hash (make-hash-table :size (length (the :relevant-headings)))))
(html
((:table :bgcolor :black :cellspacing 1 :cellpadding 2)
((:tr :bgcolor :yellow)
(dolist (heading (the :relevant-headings))
(html (:td (:princ (replace-substring (string-capitalize heading) "-" " "))))))
(dolist (log log-entries)
(when (and (> (getf log :time) cut-off-time)
(the (:pass-filter? log :relevant-hosts relevant-hosts)))
(html ((:tr :bgcolor (gethash :quartz *color-table*))
(dolist (heading (the :relevant-headings))
(let* ((value (getf log heading))
(hashed-value (gethash heading entry-hash)))
(if (not (equalp value hashed-value))
(progn (setf (gethash heading entry-hash) value)
(case heading
(:uri-path (html (:td ((:a :href (format nil "~(~a~)://~a~a"
(getf log :uri-scheme) (getf log :uri-host) value))
(:princ value)))))
(otherwise (html (:td (:princ value))))))
(html ((:td :bgcolor (gethash :aquamarine *color-table*)) :br)))))))))))))))
gdl/apps/server-log/source/.svn/text-base/file-ordering.isc.svn-base
0 → 100644
View file @
98ed3335
("package")
gdl/apps/server-log/source/.svn/text-base/package.lisp.svn-base
0 → 100644
View file @
98ed3335
;; -*- mode: common-lisp; package: aserve-log -*-
(
in-package
:user
)
(
gwl:define-package
:aserve-log
(
:export
#:assembly
))
gdl/apps/server-log/source/.svn/text-base/publish.lisp.svn-base
0 → 100644
View file @
98ed3335
(in-package :aserve-log)
(with-all-servers (server)
(publish :path "/iiug-log"
:server server
:function #'(lambda(req ent)
(gwl-make-part req ent "aserve-log:assembly"
:make-object-args (list :relevant-hosts (list "www.iiug.com")))))
(publish :path "/server-log"
:server server
:function #'(lambda(req ent)
(gwl-make-part req ent "aserve-log:assembly"))))
gdl/apps/server-log/source/assembly.lisp
0 → 100755
View file @
98ed3335
(
in-package
:aserve-log
)
(
define-object
assembly
(
base-html-sheet
)
:input-slots
((
relevant-headings
(
list
:domain
:iso-time
:uri-path
:user-agent
:referrer
))
(
relevant-hosts
(
list
"www.genworks.com"
"www.squeakymail.com"
)))
:functions
((
write-html-sheet
()
(
html
(
:html
(
:head
(
:title
"Log Report"
))
(
:body
(
:center
(
:h2
"Log Report"
))
(
:p
(
the
(
:write-log-table
)))))))
(
:pass-filter?
(
log
&key
relevant-hosts
)
(
declare
(
ignore
log
relevant-hosts
))
t
;;
;; FLAG -- make more general and configurable.
;;
#+
nil
(
let
((
domain
(
getf
log
:domain
))
(
uri-path
(
getf
log
:uri-path
))
(
user-agent
(
getf
log
:user-agent
)))
(
and
(
or
(
null
relevant-hosts
)
(
member
(
getf
log
:uri-host
)
relevant-hosts
:test
#'
string-equal
))
(
or
(
null
user-agent
)