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
8001f973
Commit
8001f973
authored
Mar 12, 2013
by
Dave Cooper
Browse files
removed site and site-static for factoring and overhaul
parent
093aa360
Changes
214
Expand all
Hide whitespace changes
Inline
Side-by-side
demos/newsite/source/Services.lisp
deleted
100644 → 0
View file @
093aa360
;;
;; Copyright 2002-2011, 2012 Genworks International
;;
;; This source file is part of the General-purpose Declarative
;; Language project (GDL).
;;
;; This source file contains free software: you can redistribute it
;; and/or modify it under the terms of the GNU Affero General Public
;; License as published by the Free Software Foundation, either
;; version 3 of the License, or (at your option) any later version.
;;
;; This source file is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
;; Affero General Public License for more details.
;;
;; You should have received a copy of the GNU Affero General Public
;; License along with this source file. If not, see
;; <http://www.gnu.org/licenses/>.
;;
(
in-package
:www.genworks.com
)
(
define-object
services
(
base-site-sheet
)
:computed-slots
((
title
"Genworks International - Services"
)
(
link-title
"Services"
)
(
right-section-inner-html
(
with-cl-who-string
()
(
:H2
"Our Services"
)
((
:DIV
:ID
"welcome"
))
((
:DIV
:ID
"profile"
)
((
:DIV
:ID
"peop"
)
(
:H3
"Value-added application support "
)
(
:P
"One year Maintenance and Implementation Support (provided by KE-Works, up to 5 events), with the option to renew at any time for a 5 k€ fee."
)
(
:H3
"Remote consultancy "
)
(
:P
"Service scheduled for release Q1 2012."
)
(
:H3
"On-site consultancy "
)
(
:P
"Service scheduled for release Q1 2012."
)))))))
\ No newline at end of file
demos/newsite/source/assembly.lisp
deleted
100644 → 0
View file @
093aa360
;;
;; Copyright 2002-2011, 2012 Genworks International
;;
;; This source file is part of the General-purpose Declarative
;; Language project (GDL).
;;
;; This source file contains free software: you can redistribute it
;; and/or modify it under the terms of the GNU Affero General Public
;; License as published by the Free Software Foundation, either
;; version 3 of the License, or (at your option) any later version.
;;
;; This source file is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
;; Affero General Public License for more details.
;;
;; You should have received a copy of the GNU Affero General Public
;; License along with this source file. If not, see
;; <http://www.gnu.org/licenses/>.
;;
(
in-package
:www.genworks.com
)
(
define-object
assembly
(
base-site-sheet
)
:computed-slots
((
title
"Genworks International - Welcome"
)
(
lang
(
the
language
choice
value
))
(
right-section-inner-html
(
the
current-right-section
right-section-inner-html
))
(
right-section-js-to-eval
(
the
current-right-section
right-section-js-to-eval
))
(
right-section-js-always-to-eval
(
the
current-right-section
right-section-js-to-eval
))
(
link-title
"Home"
)
(
pages
(
the
children
)))
:trickle-down-slots
(
pages
lang
)
:hidden-objects
((
news
:type
'news
)
(
primi-plane
:type
'gdl-user::primi-plane
)
(
robot
:type
'robot:assembly
))
:objects
((
index-html
:type
'index-html
:respondent
self
)
(
products
:type
'products
:respondent
self
)
;;(services :type 'services)
(
documentation
:type
'documentation-and-educational
:respondent
self
)
(
demos
:type
'demos
:respondent
self
)
(
downloads
:type
'downloads
:respondent
self
)
(
people
:type
'people
:respondent
self
)
(
contact-us
:type
'contact-us
:respondent
self
)
(
language
:type
'language
:respondent
self
)
))
\ No newline at end of file
demos/newsite/source/configurator-engine.lisp
deleted
100644 → 0
View file @
093aa360
;;
;; Copyright 2002-2011, 2012 Genworks International
;;
;; This source file is part of the General-purpose Declarative
;; Language project (GDL).
;;
;; This source file contains free software: you can redistribute it
;; and/or modify it under the terms of the GNU Affero General Public
;; License as published by the Free Software Foundation, either
;; version 3 of the License, or (at your option) any later version.
;;
;; This source file is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
;; Affero General Public License for more details.
;;
;; You should have received a copy of the GNU Affero General Public
;; License along with this source file. If not, see
;; <http://www.gnu.org/licenses/>.
;;
(
in-package
:www.genworks.com
)
(
define-object
configurator
(
base-site-sheet
)
:computed-slots
((
link-title
"Configurator"
)
(
right-section-js-to-eval
"hide_all();$j('#product-image').show(200);"
)
(
right-section-inner-html
(
with-cl-who-string
()
((
:a
:name
"Top"
))
(
:h1
"Estimated Pricing: $"
(
fmt
"~:d"
(
ceiling
(
the
current-price
))))
(
str
(
the
current-choice-screen
inner-html
))
(
str
(
the
summary
inner-html
))
(
when
(
the
current-choice-screen
explanation-html
)
(
htm
(
:p
(
str
(
the
current-choice-screen
explanation-html
)))))
))
;;
;; FLAG -- figure out how to make this whole thing into an object tree instead of this hairy-calc.
;;
(
current-price
(
+
(
the
gendl-license
selected-price
)
(
the
cl-engine
selected-price
)
(
the
geometry-kernel
selected-price
)
(
the
support-level
selected-price
)
(
the
training-level
selected-price
)))
(
current-choice-screen
(
the
gendl-license
)
:settable
)
(
selected-gendl-license
(
the
gendl-license
choice
value
))
(
selected-cl-engine
(
the
cl-engine
choice
value
))
(
selected-geometry-kernel
(
the
geometry-kernel
choice
value
))
(
selected-support-level
(
the
support-level
choice
value
))
(
selected-training-level
(
the
training-level
choice
value
))
(
academic?
(
the
gendl-license
academic-input?
value
))
(
set-current-sheet-function
#'
(
lambda
(
sheet
)
(
the
(
set-slot!
:current-choice-screen
sheet
))))
)
:trickle-down-slots
(
respondent
set-current-sheet-function
)
:objects
((
gendl-license
:type
'gendl-license-choice
:pass-down
(
selected-gendl-license
selected-cl-engine
selected-geometry-kernel
selected-support-level
selected-training-level
academic?
)
:next-sheet
(
the
cl-engine
))
(
cl-engine
:type
'cl-engine-choice
:pass-down
(
selected-gendl-license
selected-cl-engine
selected-geometry-kernel
selected-support-level
selected-training-level
academic?
)
:previous-sheet
(
the
gendl-license
)
:next-sheet
(
the
geometry-kernel
))
(
geometry-kernel
:type
'geometry-kernel-choice
:pass-down
(
selected-gendl-license
selected-cl-engine
selected-geometry-kernel
selected-support-level
selected-training-level
academic?
)
:previous-sheet
(
the
cl-engine
)
:next-sheet
(
the
support-level
))
(
support-level
:type
'support-level-choice
:pass-down
(
selected-gendl-license
selected-cl-engine
selected-geometry-kernel
selected-support-level
selected-training-level
academic?
)
:previous-sheet
(
the
geometry-kernel
)
:next-sheet
(
the
training-level
))
(
training-level
:type
'training-level-choice
:pass-down
(
selected-gendl-license
selected-cl-engine
selected-geometry-kernel
selected-support-level
selected-training-level
academic?
)
:previous-sheet
(
the
support-level
))
(
summary
:type
'quotation-summary
:selected-items
(
list
(
the
gendl-license
selected-item
)
(
the
cl-engine
selected-item
)
(
the
geometry-kernel
selected-item
)
(
the
support-level
selected-item
)
(
the
training-level
selected-item
))
:current-total
(
the
current-price
))))
(
define-object
quotation-summary
()
:input-slots
(
selected-items
current-total
)
:computed-slots
((
inner-html
(
with-cl-who-string
()
((
:div
:class
"quotation-summary"
)
(
:table
(
:tr
(
:th
(
str
(
locale-string
:gendl-component
)))
(
:th
(
str
(
locale-string
:your-selection
)))
(
:th
(
str
(
locale-string
:price
))))
(
dolist
(
item
(
the
selected-items
))
(
htm
(
:tr
((
:td
:class
"clickme"
)
(
str
(
the-object
item
go-to-link
)))
(
:td
(
str
(
the-object
item
string
)))
((
:td
:class
"right-justify"
)
(
fmt
"$~:d"
(
ceiling
(
the-object
item
selected-price
)))))))
(
:tr
(
:th
:br
)
((
:th
:class
"right-justify"
)
"Total"
)
((
:td
:class
"look-at-me right-justify"
)
(
fmt
"$~:d"
(
the
current-total
))))))))))
(
define-object
wizard-screen
(
sheet-section
)
:input-slots
((
previous-sheet
nil
)
(
next-sheet
nil
)
(
extra-controls-html
nil
)
set-current-sheet-function
selected-gendl-license
selected-cl-engine
selected-geometry-kernel
selected-support-level
selected-training-level
academic?
(
discount-func
(
if
(
the
academic?
)
#'
(
lambda
(
num
)
(
half
num
))
#'
identity
))
(
explanation
nil
)
;; override with child object
(
explanation-html
(
when
(
and
(
the
explanation
)
(
typep
(
the
explanation
)
'sheet-section
))
(
the
explanation
inner-html
))))
:computed-slots
((
inner-html
(
with-cl-who-string
()
(
:p
(
:h2
(
str
(
the
heading
)))
(
:fieldset
(
str
(
the
choice
html-string
))
(
when
(
the
extra-controls-html
)
(
str
(
the
extra-controls-html
)))))
(
when
(
the
money-saving-tip
)
(
htm
((
:p
:class
"helpful-tip"
)
(
str
(
locale-string
:tip
))
": "
(
str
(
the
money-saving-tip
)))))
(
:p
(
when
(
the
previous-sheet
)
(
str
(
the
previous-button
form-control-string
)))
(
when
(
the
next-sheet
)
(
str
(
the
next-button
form-control-string
))))))
(
current-choice-object
self
)
(
selected-price
(
the
selected-item
current-price
))
(
radio-price-choices
(
remove-if-not
#'
(
lambda
(
child
)
(
typep
child
'radio-price-choice
))
(
the
children
)))
(
choice-plist
(
mapcan
#'
(
lambda
(
radio
)
(
list
(
make-keyword
(
the-object
radio
strings-for-display
))
(
the-object
radio
choice-price-string
)))
(
the
radio-price-choices
)))
(
selected-item
(
dolist
(
object
(
the
radio-price-choices
))
(
when
(
eql
(
the-object
object
key
)
(
the
choice
value
))
(
return
object
))))
(
money-saving-tip
nil
)
)
:trickle-down-slots
(
selected-item
selected-price
heading
current-choice-object
)
:objects
((
previous-button
:type
'button-form-control
:label
(
format
nil
"<-~a"
(
locale-string
:previous
))
:onclick
(
the
(
gdl-ajax-call
:function-key
:set-current-sheet
:arguments
(
list
(
the
previous-sheet
)))))
(
next-button
:type
'button-form-control
:label
(
format
nil
"~a->"
(
locale-string
:next
))
:onclick
(
the
(
gdl-ajax-call
:function-key
:set-current-sheet
:arguments
(
list
(
the
next-sheet
)))))
(
choice
:type
'radio-form-control
:choice-plist
(
the
choice-plist
)
:prompt
""
:default
(
make-keyword
(
the
default
strings-for-display
))
:disabled-keys
nil
:disabled-keys
(
remove-if-not
#'
(
lambda
(
key
)
(
the
(
evaluate
key
)
disabled?
))
(
plist-keys
(
the-child
choice-plist
)))
:ajax-submit-on-change?
t
))
:functions
((
set-current-sheet
(
sheet
)
(
funcall
(
the
set-current-sheet-function
)
sheet
))))
(
define-object
radio-price-choice
(
sheet-section
)
:input-slots
(
string
current-price
(
disabled?
nil
)
(
disabled-message
""
)
heading
current-choice-object
)
:computed-slots
((
key
(
make-keyword
(
the
strings-for-display
)))
(
selected?
(
eql
(
the
selected-item
)
self
))
(
delta
(
-
(
the
current-price
)
(
the
selected-price
)))
(
go-to-link
(
let
((
choice-object
(
the
current-choice-object
)))
(
with-cl-who-string
()
((
:span
:onclick
(
the
(
gdl-ajax-call
:function-key
:set-current-sheet
:arguments
(
list
choice-object
))))
(
str
(
the
heading
))))))
(
choice-price-string
(
if
(
the
disabled?
)
(
with-cl-who-string
()
((
:span
:class
"disabled"
)
(
str
(
the
string
)))
" "
(
unless
(
string-equal
(
the
disabled-message
)
""
)
(
htm
:br
" "
(
:i
(
str
(
the
disabled-message
))))))
(
format
nil
"~a ~a"
(
the
string
)
(
if
(
the
selected?
)
""
(
format
nil
"(~a$~:d)"
(
cond
((
zerop
(
the
delta
))
"+"
)
((
plusp
(
the
delta
))
"+"
)
((
minusp
(
the
delta
))
"-"
))
(
abs
(
ceiling
(
the
delta
)))))))))
:functions
((
set-current-sheet
(
object
)
(
funcall
(
the
set-current-sheet-function
)
object
))))
demos/newsite/source/configurator.lisp
deleted
100644 → 0
View file @
093aa360
;;
;; Copyright 2002-2011, 2012 Genworks International
;;
;; This source file is part of the General-purpose Declarative
;; Language project (GDL).
;;
;; This source file contains free software: you can redistribute it
;; and/or modify it under the terms of the GNU Affero General Public
;; License as published by the Free Software Foundation, either
;; version 3 of the License, or (at your option) any later version.
;;
;; This source file is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
;; Affero General Public License for more details.
;;
;; You should have received a copy of the GNU Affero General Public
;; License along with this source file. If not, see
;; <http://www.gnu.org/licenses/>.
;;
(
in-package
:www.genworks.com
)
(
defun
info-anchor
(
string
)
(
with-cl-who-string
()
((
:a
:href
(
format
nil
"#~a"
string
))
((
:img
:src
"/newsite-static/images/information.png"
:width
12
)))))
(
define-object
gendl-license-choice
(
wizard-screen
)
:computed-slots
((
heading
(
locale-string
:gendl-licensing-level
))
(
default
(
the
agpl
))
(
extra-controls-html
(
with-cl-who-string
()
(
str
(
the
academic-input?
html-string
)))))
:objects
((
agpl
:type
'radio-price-choice
:string
(
string-append
(
locale-string
:open-source-agpl
)
(
info-anchor
"agpl-license"
))
:disabled?
(
eql
(
the
selected-geometry-kernel
)
:smlib
)
:disabled-message
(
locale-string
:please-select-basic-geom
)
:current-price
0
)
(
trial
:type
'radio-price-choice
:string
(
string-append
(
locale-string
:evaluation
)
(
info-anchor
"trial-license"
))
:current-price
0
)
(
student
:type
'radio-price-choice
:string
(
string-append
(
locale-string
:student
)
(
info-anchor
"student-license"
))
:current-price
49
)
(
professional
:type
'radio-price-choice
:string
(
string-append
(
locale-string
:professional
)
(
info-anchor
"professional-license"
))
:current-price
(
funcall
(
the
discount-func
)
1990
))
(
enterprise
:type
'radio-price-choice
:string
(
string-append
(
locale-string
:enterprise
)
(
info-anchor
"enterprise-license"
))
:current-price
(
funcall
(
the
discount-func
)
4990
))
(
academic-input?
:type
'checkbox-form-control
:ajax-submit-on-change?
t
:default
(
eql
(
the
selected-gendl-license
)
:student
)
:label-position
:table-td-append
:prompt
(
string-append
(
locale-string
:order-qualifies-for-academic
)
(
info-anchor
"academic-pricing"
)))
(
explanation
:type
'license-choice-explanation
)))
(
define-object
cl-engine-choice
(
wizard-screen
)
:computed-slots
((
heading
(
locale-string
:common-lisp-engine
))
(
default
(
case
(
the
selected-gendl-license
)
(
:agpl
(
the
none
))
(
:professional
(
the
lw-32-base
))
(
otherwise
(
the
acl-32
))))
(
lw-uplift
1
)
(
acl-uplift
1
)
(
discount-func
#'
(
lambda
(
price
key
)
(
ecase
key
(
:none
price
)
(
:sbcl
price
)
(
:acl-32
(
*
(
the
acl-uplift
)
price
))
(
:acl-64
(
*
(
the
acl-uplift
)
price
))
(
:lw-32-base
(
*
(
the
lw-uplift
)
price
))
(
:lw-32-full
(
*
(
the
lw-uplift
)
price
))
(
:lw-64-full
(
*
(
the
lw-uplift
)
price
))))))
:objects
((
none
:type
'radio-price-choice
:string
(
string-append
(
locale-string
:none
)
" ("
(
locale-string
:i-e
)
(
locale-string
:space
)
(
locale-string
:self-provided-or-third-party
)
")"
)
:current-price
(
funcall
(
the
discount-func
)
0
(
first
(
the-child
root-path
)))
:disabled?
(
or
(
eql
(
the
selected-geometry-kernel
)
:smlib
)
(
eql
(
the
selected-gendl-license
)
:trial
)
(
not
(
eql
(
the
selected-support-level
)
:none
)))
:disabled-message
(
format
nil
"~a ~a~a~a~a~a ~a."
(
locale-string
:please-select
)
(
if
(
eql
(
the
selected-geometry-kernel
)
:smlib
)
(
locale-string
:the-basic-geometry-kernel
)
""
)
(
cond
((
and
(
eql
(
the
selected-geometry-kernel
)
:smlib
)
(
eql
(
the
selected-gendl-license
)
:trial
))
(
string-append
(
locale-string
:space
)
(
locale-string
:and
)
(
locale-string
:space
)))
(
t
(
locale-string
:space
)))
(
if
(
eql
(
the
selected-gendl-license
)
:trial
)
(
locale-string
:a-non-evaluation-gendl-license
)
""
)
(
cond
((
and
(
not
(
eql
(
the
selected-support-level
)
:none
))
(
or
(
eql
(
the
selected-gendl-license
)
:trial
)
(
eql
(
the
selected-geometry-kernel
)
:smlib
)))
(
string-append
(
locale-string
:space
)
(
locale-string
:and
)
(
locale-string
:space
)))
((
not
(
eql
(
the
selected-support-level
)
:none
))
(
locale-string
:space
))
(
t
""
))
(
if
(
not
(
eql
(
the
selected-support-level
)
:none
))
(
string-append
"\""
(
locale-string
:none
)
"\""
(
locale-string
:space
)
(
locale-string
:for
)
(
locale-string
:space
)
(
locale-string
:technical-support-level
))
""
)
(
locale-string
:to-enable-this-option
)))
(
sbcl
:type
'radio-price-choice
:string
"SBCL"
:current-price
(
funcall
(
the
discount-func
)
0
(
first
(
the-child
root-path
)))
:disabled?
(
or
(
eql
(
the
selected-geometry-kernel
)
:smlib
)
(
eql
(
the
selected-gendl-license
)
:trial
))
:disabled-message
(
the
none
disabled-message
))
(
acl-32
:type
'radio-price-choice
:string
(
locale-string
:franz-allegro-cl-32
)
:current-price
(
funcall
(
the
discount-func
)
(
ecase
(
the
selected-gendl-license
)
(
:agpl
(
if
(
the
academic?
)
4500
6000
))
(
:trial
0
)
(
:student
100
)
(
:professional
(
if
(
the
academic?
)
3000
4500
))
(
:enterprise
(
if
(
the
academic?
)
4500
6000
)))
(
first
(
the-child
root-path
))))
(
acl-64
:type
'radio-price-choice
:string
(
locale-string
:franz-allegro-cl-64
)
:disabled?
(
or
(
eql
(
the
selected-gendl-license
)
:trial
)
(
eql
(
the
selected-gendl-license
)
:student
))
:disabled-message
(
string-append
(
locale-string
:please-select
)
(
locale-string
:space
)
(
locale-string
:a
)
(
locale-string
:space
)
(
locale-string
:gendl-license
)
(
locale-string
:space
)
(
locale-string
:other-than
)
(
locale-string
:space
)
(
locale-string
:student
)
" or "
(
locale-string
:evaluation
)
(
locale-string
:space
)
(
locale-string
:to-enable-this-option
))
:current-price
(
funcall
(
the
discount-func
)
(
ecase
(
the
selected-gendl-license
)
(
:agpl
(
if
(
the
academic?
)
(
*
4500
1.2
)
(
*
6000
1.2
)))
(
:trial
0
)
(
:student
(
*
100
1.2
))
(
:professional
(
if
(
the
academic?
)
(
*
3000
1.2
)
(
*
4500
1.2
)))
(
:enterprise
(
if
(
the
academic?
)
(
*
4500
1.2
)
(
*
6000
1.2
))))
(
first
(
the-child
root-path
))))
(
lw-32-base
:type
'radio-price-choice
:string
(
locale-string
:lispworks-32-basic
)
:disabled?
(
eql
(
the
selected-gendl-license
)
:trial
)
:current-price
(
funcall
(
the
discount-func
)
(
if
(
the
academic?
)
1100
1700
)
(
first
(
the-child
root-path
))))
(
lw-32-full
:type
'radio-price-choice
:string
(
locale-string
:lispworks-32-expanded
)
:disabled?
(
eql
(
the
selected-gendl-license
)
:trial
)
:current-price
(
funcall
(
the
discount-func
)
(
if
(
the
academic?
)
3300
5100
)
(
first
(
the-child
root-path
))))
(
lw-64-full
:type
'radio-price-choice
:string
(
locale-string
:lispworks-64-expanded
)
:disabled?
(
eql
(
the
selected-gendl-license
)
:trial
)
:current-price
(
funcall
(
the
discount-func
)
(
if
(
the
academic?
)
3300
5100
)
(
first
(
the-child
root-path
))))
(
explanation
:type
'cl-engine-explanation
)))
(
define-object
geometry-kernel-choice
(
wizard-screen
)