Update! | SetSelf
Quantified sequences and pattern repetition: bond rules place every brick, and the quantity takeoff falls out for free.
Snapped to whole modules: 91.7 in long, 45.6 in tall.
| Courses | 16 |
| Bricks per course | 11 |
| Full bricks | 168 |
| Cut half-bricks | 16 |
| Wall area | 29.1 sq ft |
| Mortar volume (est.) | 1.56 cu ft |
The complete Gendl source for this demo, reconstituted live from the in-memory object definitions serving this page.
Want to change it? Open this source in a live Emacs and rebuild your own copy of the page.
Hack this demo →(define-object brick-wall (base-object)
:documentation
(:description "Procedural brick wall: courses and bricks are Gendl
quantified sequences whose sizes derive from the wall and brick
dimensions. Running bond staggers alternate courses by half a module
and closes each end with a cut half-brick; the quantity takeoff
(courses, full and half bricks, mortar volume) falls out of the same
rules that place the geometry."
:author "Genworks International")
:input-slots
((wall-length 96 :settable)
(wall-height 48 :settable)
(brick-length 8 :settable)
(brick-height 5/2 :settable)
(brick-depth 4 :settable)
(mortar-joint 3/8 :settable)
("Keyword symbol, :running or :stack. The bond pattern."
bond :running
:settable))
:computed-slots
((module (+ (the brick-length) (the mortar-joint)))
(course-module (+ (the brick-height) (the mortar-joint)))
(bricks-per-course (max 1
(floor (+ (the wall-length) (the mortar-joint))
(the module))))
(number-of-courses (max 1
(floor (+ (the wall-height) (the mortar-joint))
(the course-module))))
(effective-length (- (* (the bricks-per-course) (the module))
(the mortar-joint)))
(effective-height (- (* (the number-of-courses) (the course-module))
(the mortar-joint)))
(half-brick-length (half (- (the brick-length) (the mortar-joint))))
(offset-course-count (ecase (the bond)
(:stack 0)
(:running (floor (the number-of-courses) 2))))
(aligned-course-count (- (the number-of-courses) (the offset-course-count)))
(full-brick-count (+ (* (the aligned-course-count) (the bricks-per-course))
(* (the offset-course-count)
(max 0 (1- (the bricks-per-course))))))
(half-brick-count (* 2 (the offset-course-count)))
(wall-area-square-feet (/ (* (the effective-length) (the effective-height))
144.0))
(mortar-volume-cubic-feet (let ((wall-volume
(* (the effective-length)
(the effective-height)
(the brick-depth)))
(brick-volume
(+ (*
(the full-brick-count)
(*
(the brick-length)
(the brick-height)
(the brick-depth)))
(*
(the half-brick-count)
(*
(the half-brick-length)
(the brick-height)
(the brick-depth))))))
(/ (- wall-volume brick-volume) 1728.0))))
:objects
((mortar-backing :type 'box
:display-controls (list :color :grey-light)
:width (the effective-length)
:height (the effective-height)
:length (- (the brick-depth) 1/2)
:center (translate (the center) :rear 1/2))
(courses :type 'wall-course
:sequence (:size (the number-of-courses))
:offset? (and (eq (the bond) :running) (oddp (the-child index)))
:center (translate (the center)
:up
(+ (* (the-child index) (the course-module))
(- (half (the effective-height)))
(half (the brick-height))))
:pass-down (brick-length brick-height brick-depth mortar-joint
module bricks-per-course half-brick-length
effective-length))))(define-object wall-course (base-object)
:documentation
(:description "One course of bricks. An offset (running-bond) course
starts and ends with a cut half-brick and holds one fewer full brick
than an aligned course."
:author "Genworks International")
:input-slots
(offset?
brick-length
brick-height
brick-depth
mortar-joint
module
bricks-per-course
half-brick-length
effective-length)
:computed-slots
((full-brick-count (if (the offset?)
(max 0 (1- (the bricks-per-course)))
(the bricks-per-course)))
(start-x (- (half (the effective-length))))
(brick-shades (list :firebrick :brown :salmon)))
:objects
((bricks :type 'box
:sequence (:size (the full-brick-count))
:width (the brick-length)
:height (the brick-height)
:length (the brick-depth)
:display-controls (list :color
(nth (mod
(+
(the-child index)
(the index)
(if (the offset?) 2 0))
(length (the brick-shades)))
(the brick-shades)))
:center (translate (the center)
:right
(+ (the start-x)
(if (the offset?)
(+ (the half-brick-length)
(the mortar-joint))
0)
(* (the-child index) (the module))
(half (the brick-length)))))
(half-bricks :type 'box
:sequence (:size (if (the offset?) 2 0))
:width (the half-brick-length)
:height (the brick-height)
:length (the brick-depth)
:display-controls (list :color
(nth
(mod
(+ (the-child index) (the index))
(length (the brick-shades)))
(the brick-shades)))
:center (translate (the center)
:right
(if (zerop (the-child index))
(+
(the start-x)
(half (the half-brick-length)))
(-
(- (the start-x))
(half (the half-brick-length))))))))(define-object brick-wall-ui (demos-common:demo-ui-mixin session-control-mixin
base-html-page)
:documentation
(:description "Interactive brick-wall demo page: bond pattern and
dimensions drive quantified sequences of courses and bricks, with the
quantity takeoff computed from the same declarative rules."
:author "Genworks International")
:input-slots
((title "Brick Wall Demo")
(demo-slug "brick-wall")
(objects (list (the model)))
(view-projection-key :wall-view)
(view-projection-vector (unitize-vector (make-vector 0.45 -1 0.3)))
(wall-length 96 :settable)
(wall-height 48 :settable)
(brick-length 8 :settable)
(brick-height 2.5 :settable)
(mortar-joint 0.375 :settable))
:computed-slots
((source-pane-objects '(brick-wall wall-course brick-wall-ui
demos-common:demo-ui-mixin))
(body (with-lhtml-string
nil
(:div :class "max-w-5xl mx-auto p-8"
(str
(the (page-intro "Brick Wall Pattern"
"Quantified sequences and pattern repetition: bond rules place every brick, and the quantity takeoff falls out for free.")))
(str
(the (card :title "Parameters" :content
(with-lhtml-string
nil
(:div :class "p-6" (str (the control-form)))))))
(str
(the (card :title "3D View" :content
(with-lhtml-string
nil
(:div :class "p-6 relative" :style "height: 520px;"
(str (the viewport-area div)))))))
(str (the takeoff-section div))
(str
(the (card :title "Source Code" :subtitle
"The complete Gendl source for this demo, reconstituted live from the in-memory object definitions serving this page."
:content (the source-code-panes)))))))
(takeoff-card (the (card :title "Quantity Takeoff" :subtitle
(format nil
"Snapped to whole modules: ~,1f in long, ~,1f in tall."
(float (the model effective-length))
(float (the model effective-height)))
:content
(with-lhtml-string
nil
(:div :class "overflow-x-auto"
(str (the quantities-table)))))))
(quantities-table (let ((model (the model)))
(with-lhtml-string
nil
(:table :class
"min-w-full table-fixed divide-y divide-gray-200"
(:tbody :class "divide-y divide-gray-100"
(dolist (row
(list (list
"Courses"
(format
nil
"~d"
(the-object
model
number-of-courses)))
(list
"Bricks per course"
(format
nil
"~d"
(the-object
model
bricks-per-course)))
(list
"Full bricks"
(format
nil
"~d"
(the-object
model
full-brick-count)))
(list
"Cut half-bricks"
(format
nil
"~d"
(the-object
model
half-brick-count)))
(list
"Wall area"
(format
nil
"~,1f sq ft"
(the-object
model
wall-area-square-feet)))
(list
"Mortar volume (est.)"
(format
nil
"~,2f cu ft"
(the-object
model
mortar-volume-cubic-feet)))))
(htm
(:tr :class "hover:bg-gray-50"
(:td :class
"px-6 py-3 text-sm font-medium text-gray-900"
(str (first row)))
(:td :class
"px-6 py-3 w-40 text-sm text-right tabular-nums text-gray-700"
(str (second row)))))))))))
(control-form (with-form-string
(:class "grid grid-cols-2 md:grid-cols-4 gap-6")
(str
(the (param-field "Wall Length (in)"
(the wall-length-control))))
(str
(the (param-field "Wall Height (in)"
(the wall-height-control))))
(str
(the (param-field "Brick Length (in)"
(the brick-length-control))))
(str
(the (param-field "Brick Height (in)"
(the brick-height-control))))
(str
(the (param-field "Mortar Joint (in)"
(the mortar-joint-control))))
(str (the (param-field "Bond Pattern" (the bond-control)))))))
:objects
((wall-length-control :type 'number-form-control
:default (the wall-length)
:ajax-submit-on-change? t
:domain :number
:min 24
:max 240
:step 8)
(wall-height-control :type 'number-form-control
:default (the wall-height)
:ajax-submit-on-change? t
:domain :number
:min 12
:max 96
:step 4)
(brick-length-control :type 'number-form-control
:default (the brick-length)
:ajax-submit-on-change? t
:domain :number
:min 6
:max 16
:step 1)
(brick-height-control :type 'number-form-control
:default (the brick-height)
:ajax-submit-on-change? t
:domain :number
:min 2
:max 5
:step 0.25)
(mortar-joint-control :type 'number-form-control
:default (the mortar-joint)
:ajax-submit-on-change? t
:domain :number
:min 0.25
:max 1
:step 0.125)
(bond-control :type 'menu-form-control
:default :running
:size 1
:ajax-submit-on-change? t
:choice-plist '(:running "Running" :stack "Stack"))
(model :type 'brick-wall
:wall-length (the wall-length-control value)
:wall-height (the wall-height-control value)
:brick-length (the brick-length-control value)
:brick-height (the brick-height-control value)
:mortar-joint (the mortar-joint-control value)
:bond (the bond-control value))
(takeoff-section :type 'base-html-div :inner-html (the takeoff-card))))(define-object demo-ui-mixin nil
:documentation
(:description "Chrome shared by every public demo page: Tailwind
stylesheet hookup, card and parameter-field helpers, source-code panes
reconstituted live from the in-memory definitions, and a standard
viewport driven by the demo's objects list -- one viewport-html-div
whose renderer follows graphics-format: shaded (x3dom), wireframe
(svg) or hidden-line (svg through base-view's hidden-line remover),
switched by the toggle the pane wears -- and whose projection is the
demo's own angle or one of Gendl's standard views, chosen from the
View menu beside it."
:author "Genworks International")
:input-slots
(("List of define-object symbols shown in the Source Code card."
source-pane-objects nil)
("List of supporting defun symbols shown after the object panes."
source-pane-functions nil)
("String or nil. The demo's slug under /demo/ (e.g. \"staircase\"),
which names it to the holodeck; nil renders no Hack-this-demo link."
demo-slug nil)
(view-projection-key :demo-view)
(view-projection-vector (unitize-vector (make-vector 1 -1 0.5)))
("Keyword, :x3dom, :svg or :hidden-line. The viewport's format when the
page opens: shaded (x3dom), wireframe (svg), or hidden-line (svg with the
hidden edges removed). The toggle on the pane switches it."
graphics-format-default :x3dom))
:computed-slots
((use-svgpanzoom? t)
(use-x3dom? t)
(view-key (the view-control value))
(view-vector (if (eql (the view-key) (the view-projection-key))
(the view-projection-vector)
(getf *standard-views* (the view-key))))
(viewport-toolbar-html (with-lhtml-string
nil
(:div :class
"absolute left-1 top-1 z-10 flex items-center rounded bg-white/80 px-2 py-0.5 text-xs shadow backdrop-blur select-none"
(:span :class "text-gray-600" "View")
(str (the view-control form-control)))
(:div :class
"absolute right-1 top-1 z-10 flex overflow-hidden rounded bg-white/80 text-xs shadow backdrop-blur select-none"
(dolist (choice
'((:x3dom "Shaded")
(:svg "Wireframe")
(:hidden-line "Hidden line")))
(let ((active?
(eql (first choice)
(the graphics-format))))
(htm
(:span :class
(if active?
"px-2 py-0.5 bg-indigo-600 text-white"
"px-2 py-0.5 cursor-pointer text-gray-600 hover:text-indigo-700")
:title
(if active?
"The current graphics format"
"Switch the graphics format")
:onclick
(unless active?
(the (gdl-ajax-call
:function-key
:set-graphics-format!
:arguments
(list (first choice)))))
(str (second choice)))))))))
(additional-header-content (string-append
(with-lhtml-string
nil
(:script
(str (the viewport-renderers-js-baseline))))
(call-next-method)
(with-lhtml-string
nil
(:link :href
(format nil
"~a/demo/css/demos-style.css"
*url-prefix*)
:rel "stylesheet" :type "text/css")
(:script (str (the busy-overlay-js))))))
(busy-overlay-js "
(function () {
var count = 0, overlay = null, nonQuiet = false;
function ensureOverlay () {
if (overlay) return overlay;
overlay = document.createElement('div');
overlay.id = 'demo-busy-overlay';
overlay.setAttribute('style',
'position:fixed;inset:0;z-index:9999;display:none;' +
'background:rgba(249,250,251,0.55);backdrop-filter:blur(1px);' +
'transition:opacity 100ms;opacity:0;');
var pill = document.createElement('div');
pill.setAttribute('style',
'position:absolute;top:1.25rem;left:50%;transform:translateX(-50%);' +
'background:#4f46e5;color:#fff;padding:0.4rem 1rem;' +
'border-radius:9999px;font:500 0.875rem system-ui,sans-serif;' +
'box-shadow:0 2px 8px rgba(0,0,0,0.25);');
pill.textContent = 'Rebuilding\\u2026';
overlay.appendChild(pill);
document.body.appendChild(overlay);
return overlay;
}
function show () {
var el = ensureOverlay();
if (document.activeElement && document.activeElement.blur)
document.activeElement.blur();
el.style.display = 'block';
requestAnimationFrame(function () { el.style.opacity = '1'; });
}
function hide () {
if (overlay) { overlay.style.opacity = '0'; overlay.style.display = 'none'; }
}
var origOpen = XMLHttpRequest.prototype.open;
XMLHttpRequest.prototype.open = function (method, url) {
this._gdlAjax = typeof url === 'string' && url.indexOf('/gdlAjax') === 0;
return origOpen.apply(this, arguments);
};
var origSend = XMLHttpRequest.prototype.send;
XMLHttpRequest.prototype.send = function () {
if (this._gdlAjax) {
count++;
if (nonQuiet) { show(); nonQuiet = false; }
this.addEventListener('loadend', function () {
count--;
if (count <= 0) { count = 0; hide(); }
});
}
return origSend.apply(this, arguments);
};
window.addEventListener('DOMContentLoaded', function () {
var orig = window.gdlAjax;
if (!orig) return;
window.gdlAjax = function (evt, params, asynch, quiet) {
if (!quiet) nonQuiet = true;
return orig.apply(this, arguments);
};
});
})();
")
(source-code-panes (apply #'string-append
(the (hack-banner))
(append (mapcar #'(lambda
(sym)
(the (object-source-pane sym)))
(the source-pane-objects))
(mapcar #'(lambda
(sym)
(the (defun-source-pane sym)))
(the source-pane-functions)))))
(graphics-format (the graphics-format-default) :settable))
:objects
((view-control :type 'menu-form-control
:default (the view-projection-key)
:size 1
:ajax-submit-on-change? t
:class "cursor-pointer text-xs text-gray-700"
:style "background:transparent;border:0;padding:0 0 0 0.25rem"
:choice-plist (list (the view-projection-key)
"Default"
:trimetric
"Trimetric"
:front
"Front"
:rear
"Rear"
:left
"Left"
:right
"Right"
:top
"Top"
:bottom
"Bottom"))
(viewport-area :type 'viewport-html-div
:image-format (if (eql (the graphics-format) :hidden-line)
:svg
(the graphics-format))
:hidden-lines (if (eql (the graphics-format) :hidden-line)
:remove
:draw)
:header-html (the viewport-toolbar-html)
:projection-key (the view-key)
:projection-vector (the view-vector)
:display-list-object-roots (the objects)))
:functions
((set-graphics-format! (format) (the (set-slot! :graphics-format format)))
(page-intro
(heading blurb)
(with-lhtml-string
nil
(:div :class "mb-4 flex items-center justify-between"
(:a :href "/demos/index.html" :class
"text-sm font-medium text-indigo-600 hover:text-indigo-500"
"← All demos")
(when *developing?*
(htm
(:div :class
"text-xs text-gray-500 [&_a]:text-indigo-600 [&_a]:font-medium [&_p]:m-0"
(str (the development-links))))))
(:div :class "text-center mb-8"
(:h1 :class "text-4xl font-bold text-gray-900 mb-2" (str heading))
(:p :class "text-lg text-gray-600" (str blurb)))))
(card
(&key title subtitle content)
(with-lhtml-string
nil
(:div :class "bg-white rounded-lg shadow-lg overflow-hidden mb-8"
(:div :class "px-6 py-4 bg-gray-50 border-b border-gray-200"
(:h3 :class "text-lg font-medium text-gray-900" (str title))
(when subtitle
(htm (:p :class "text-sm text-gray-600" (str subtitle)))))
(str content))))
(param-field
(label control)
(with-lhtml-string
nil
(:div :class "space-y-2"
(:label :class "block text-sm font-medium text-gray-700" :for
(the-object control id) (str label))
(:div :class
"param-field block w-full rounded-md border border-gray-300 bg-white px-3 py-2 shadow-sm"
(str (the-object control form-control))))))
(hack-banner
nil
(if (and *hack-base* (the demo-slug))
(with-lhtml-string
nil
(:div :class
"px-6 py-3 bg-indigo-50 border-b border-indigo-100 flex items-center justify-between gap-4"
(:p :class "text-sm text-indigo-900"
"Want to change it? Open this source in a live Emacs and rebuild your own copy of the page.")
(:a :href (format nil "~a/?arg=~a" *hack-base* (the demo-slug))
:target "_blank" :rel "noopener" :class
"shrink-0 inline-flex items-center rounded-md bg-indigo-600 px-3 py-1.5 text-sm font-semibold text-white shadow-sm hover:bg-indigo-700"
"Hack this demo →")))
""))
(object-source-pane
(sym)
(with-lhtml-string
nil
(:details :class "border-b border-gray-100"
(:summary :class
"px-6 py-3 cursor-pointer select-none font-mono text-sm font-medium text-indigo-700 hover:bg-gray-50"
(fmt "(define-object ~a ...)" (the (pane-label sym))))
(:div :class "src-pane"
(wmd (format nil "```lisp~%~a```" (definition-source-string sym)))))))
(defun-source-pane
(sym)
(let ((source (function-source-string sym)))
(if source
(with-lhtml-string
nil
(:details :class "border-b border-gray-100"
(:summary :class
"px-6 py-3 cursor-pointer select-none font-mono text-sm font-medium text-indigo-700 hover:bg-gray-50"
(fmt "(defun ~a ...)" (the (pane-label sym))))
(:div :class "src-pane"
(wmd (format nil "```lisp~%~a```" source)))))
"")))
(pane-label
(sym)
(string-downcase
(if (eq (symbol-package sym) (symbol-package (the type)))
(symbol-name sym)
(format nil
"~a:~a"
(package-name (symbol-package sym))
(symbol-name sym)))))))