Update! | SetSelf
An outdoor staircase built entirely from parametric Gendl code -- adjust the parameters and rebuild live.
14 steps, 96.0 in rise over 144.0 in run (33.7 deg)
| Qty | Stock | Cut (in) | Buy (ft) |
|---|---|---|---|
| 2 | 2x10 | 173.06 | 16 |
| 1 | 2x4 | 172.12 | 16 |
| 28 | 2x6 | 33.00 | 8 |
| 14 | 2x8 rip | 33.00 | 8 |
| 6 | 4x4 | 36.00 | 8 |
The complete Gendl source for this demo: object definitions reconstituted live from the in-memory definitions serving this page, supporting lumber-system functions via the Lisp's own source records.
Want to change it? Open this source in a live Emacs and rebuild your own copy of the page.
Hack this demo →(define-object staircase (base-object)
:documentation
(:description "Parametric outdoor staircase in dimensional deckwood
lumber: two sloped stringers with plumb and level end cuts, treads of
two gapped deck boards, optional risers ripped from 2x8 stock,
optional skirt boards, and a single-side handrail of 4x4 posts under
a plumb-cut 2x4 rail. Geometry and the bill of materials both derive
from the same lumber part objects."
:author "Genworks International")
:input-slots
((total-rise 96)
(total-run 144)
(number-of-steps 14)
(stairs-width 36)
(nosing 1)
(tread-nominal "2x6")
(stringer-nominal "2x10")
(riser-nominal "2x8")
(skirt-nominal "1x12")
(post-nominal "4x4")
(rail-nominal "2x4")
(tread-board-gap 1/4)
(post-every 3)
(handrail-height 36)
(rail-overhang 3)
(include-risers? t :settable)
(include-skirt? nil :settable)
(handrail? t :settable)
(solids? nil :settable))
:computed-slots
((rise-per-step (/ (the total-rise) (the number-of-steps)))
(run-per-step (/ (the total-run) (the number-of-steps)))
(slope-angle (* (/ 180 pi) (atan (the total-rise) (the total-run))))
(slope-length (sqrt (+ (expt (the total-run) 2) (expt (the total-rise) 2))))
(slope-factor (/ (the slope-length) (the total-run)))
(tread-board-width (second (lumber:nominal-section (the tread-nominal))))
(tread-thickness (first (lumber:nominal-section (the tread-nominal))))
(tread-depth (+ (* 2 (the tread-board-width)) (the tread-board-gap)))
(stringer-thickness (first (lumber:nominal-section (the stringer-nominal))))
(stringer-depth (second (lumber:nominal-section (the stringer-nominal))))
(riser-thickness (first (lumber:nominal-section (the riser-nominal))))
(skirt-thickness (first (lumber:nominal-section (the skirt-nominal))))
(post-size (second (lumber:nominal-section (the post-nominal))))
(rail-depth (second (lumber:nominal-section (the rail-nominal))))
(tread-length (- (the stairs-width) (* 2 (the stringer-thickness))))
(stringer-offset (/ (- (the stairs-width) (the stringer-thickness)) 2))
(rail-side-offset (+ (the stringer-offset) (/ (the post-size) 2)))
(post-indices (let (result)
(dotimes (i (the number-of-steps))
(when (or (zerop (mod i (the post-every)))
(= i (1- (the number-of-steps))))
(push i result)))
(nreverse result)))
(bill-of-materials (lumber:bill-of-materials self))
(display-controls (list :color :wood-light)))
:objects
((rail :type (lumber:lumber-type :cut? t :solids? (the solids?))
:hidden? (not (the handrail?))
:nominal (the rail-nominal)
:length (* (+ (* (1- (the number-of-steps)) (the run-per-step))
(the post-size)
(* 2 (the rail-overhang)))
(the slope-factor))
:front-angle-degrees (the slope-angle)
:rear-angle-degrees (- (the slope-angle))
:display-controls (list :color :wood-dark)
:orientation (alignment :rear
(rotate-vector-d
(the (face-normal-vector :rear))
(the slope-angle)
(the (face-normal-vector :right)))
:right
(rotate-vector-d
(the (face-normal-vector :top))
(the slope-angle)
(the (face-normal-vector :right))))
:center (translate (the center)
:rear
(* (1- (the number-of-steps))
(/ (the run-per-step) 2))
:up
(+ (the (post-top-z
(/ (1- (the number-of-steps)) 2)))
(/ (the rail-depth) 2))
:right
(the rail-side-offset)))
(treads :type 'tread
:sequence (:size (the number-of-steps))
:board-nominal (the tread-nominal)
:board-gap (the tread-board-gap)
:solids? (the solids?)
:width (the tread-length)
:length (the tread-depth)
:height (the tread-thickness)
:display-controls (list :color :wood-light)
:center (translate (the center)
:rear
(the (step-y (the-child index)))
:up
(- (the (tread-top-z (the-child index)))
(/ (the tread-thickness) 2))))
(risers :type (lumber:lumber-type :solids? (the solids?))
:sequence (:size (if (the include-risers?) (the number-of-steps) 0))
:nominal (the riser-nominal)
:width (the rise-per-step)
:stock-description (format nil "~a rip" (the riser-nominal))
:length (the tread-length)
:display-controls (list :color :wood-medium)
:orientation (alignment :rear
(the (face-normal-vector :right))
:right
(the (face-normal-vector :top)))
:center (translate (the center)
:rear
(+ (the (step-y (the-child index)))
(- (/ (the tread-depth) 2))
(the nosing)
(/ (the riser-thickness) 2))
:up
(* (+ (the-child index) 1/2) (the rise-per-step))))
(stringers :type 'stringer
:sequence (:size 2)
:nominal (the stringer-nominal)
:slope-length (the slope-length)
:display-controls (list :color :wood-dark)
:projection-vector (the (face-normal-vector :right))
:vertex-list (the (stringer-profile
(- (* (if (zerop (the-child index)) 1 -1)
(the stringer-offset))
(/ (the stringer-thickness) 2))
(the stringer-depth))))
(skirts :type 'stringer
:sequence (:size (if (the include-skirt?) 2 0))
:nominal (the skirt-nominal)
:slope-length (the slope-length)
:display-controls (list :color :wood-medium)
:projection-vector (the (face-normal-vector :right))
:vertex-list (the (stringer-profile
(- (* (if (zerop (the-child index)) 1 -1)
(+ (the stringer-offset)
(/
(+
(the stringer-thickness)
(the skirt-thickness))
2)))
(/ (the skirt-thickness) 2))
(+ (the stringer-depth) 2))))
(posts :type (lumber:lumber-type :solids? (the solids?))
:sequence (:size (if (the handrail?) (length (the post-indices)) 0))
:nominal (the post-nominal)
:length (the handrail-height)
:display-controls (list :color :wood-dark)
:orientation (alignment :rear
(the (face-normal-vector :top))
:top
(the (face-normal-vector :rear)))
:center (let ((tread-index
(nth (the-child index) (the post-indices))))
(translate (the center)
:rear
(the (step-y tread-index))
:up
(- (the (post-top-z tread-index))
(/ (the handrail-height) 2))
:right
(the rail-side-offset)))))
:functions
((step-y (index) (* index (the run-per-step)))
(tread-top-z
(index)
(+ (* (1+ index) (the rise-per-step)) (/ (the tread-thickness) 2)))
(post-top-z (index) (+ (the (tread-top-z index)) (the handrail-height)))
(stringer-profile
(lateral-x depth)
(let* ((m (/ (the total-rise) (the total-run)))
(c-top
(+ (- (the rise-per-step) (/ (the tread-thickness) 2))
(* m (- (/ (the tread-depth) 2) (the nosing)))))
(c-bot (- c-top (* depth (the slope-factor))))
(front-y (- (the nosing) (/ (the tread-depth) 2)))
(level-end-y (max front-y (- (/ c-bot m))))
(top-y
(+ (* (1- (the number-of-steps)) (the run-per-step))
(/ (the tread-depth) 2))))
(mapcar (lambda (yz)
(translate (the center)
:right
lateral-x
:rear
(first yz)
:up
(second yz)))
(list (list front-y 0)
(list level-end-y 0)
(list top-y (+ (* m top-y) c-bot))
(list top-y (+ (* m top-y) c-top))
(list front-y (+ (* m front-y) c-top))
(list front-y 0)))))))(define-object tread (base-object)
:documentation
(:description "One stair tread: two deck boards running across the
stair width, separated by a drainage gap. Width, length, and height
describe the tread's overall envelope and come from the parent."
:author "Genworks International")
:input-slots
(board-nominal
board-gap
(solids? nil))
:computed-slots
((board-width (second (lumber:nominal-section (the board-nominal)))))
:objects
((boards :type (lumber:lumber-type :solids? (the solids?))
:sequence (:size 2)
:nominal (the board-nominal)
:length (the width)
:orientation (alignment :rear
(the (face-normal-vector :right))
:top
(the (face-normal-vector :top)))
:center (translate (the center)
:rear
(* (if (zerop (the-child index)) -1 1)
(/ (+ (the board-width) (the board-gap)) 2))))))(define-object stringer (global-polygon-projection lumber:lumber-mixin)
:documentation
(:description "A stringer or skirt board: stock lumber cut to a
custom side profile (supplied by the parent as a global vertex list)
and extruded through its own thickness. Too shaped for
angle-cut-lumber's single cut per end, but still a lumber part for
bill-of-materials purposes: it reports its stock and its long-point
length along the slope."
:author "Genworks International")
:input-slots
(slope-length)
:computed-slots
((cut-length (the slope-length))
(projection-depth (the height))))(define-object staircase-ui (demos-common:demo-ui-mixin session-control-mixin
base-html-page)
:documentation
(:description "Interactive staircase demo page: parameter form, live
x3dom viewport, and the cut list aggregated from the model's lumber
parts."
:author "Genworks International")
:input-slots
((title "Parametric Staircase Demo")
(demo-slug "staircase")
(objects (list (the model)))
(view-projection-key :staircase-view)
(view-projection-vector (unitize-vector (make-vector 1 -0.6 0.35)))
(total-rise 96 :settable)
(total-run 144 :settable)
(number-of-steps 14 :settable)
(stairs-width 36 :settable)
(nosing 1 :settable)
(post-every 3 :settable)
(handrail-height 36 :settable)
(handrail? t :settable)
(include-risers? t :settable)
(include-skirt? nil :settable))
:computed-slots
((source-pane-objects '(staircase tread stringer staircase-ui
demos-common:demo-ui-mixin))
(source-pane-functions '(lumber:nominal-section
lumber:lumber-type
lumber:bill-of-materials))
(body (with-lhtml-string
nil
(:div :class "max-w-5xl mx-auto p-8"
(str
(the (page-intro "Parametric Staircase"
"An outdoor staircase built entirely from parametric Gendl code -- adjust the parameters and rebuild live.")))
(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: 600px;"
(str (the viewport-area div)))))))
(str (the cut-list-section div))
(str
(the (card :title "Source Code" :subtitle
"The complete Gendl source for this demo: object definitions reconstituted live from the in-memory definitions serving this page, supporting lumber-system functions via the Lisp's own source records."
:content (the source-code-panes)))))))
(cut-list-card (the (card :title "Cut List" :subtitle
(format nil
"~a steps, ~,1f in rise over ~,1f in run (~,1f deg)"
(the number-of-steps-control value)
(float (the total-rise-control value))
(float (the total-run-control value))
(the model slope-angle))
:content
(with-lhtml-string
nil
(:div :class "overflow-x-auto"
(str (the bom-table)))))))
(bom-table (with-lhtml-string
nil
(:table :class
"min-w-full table-fixed divide-y divide-gray-200"
(:thead :class "bg-gray-50"
(:tr
(:th :class
"px-6 py-3 w-24 text-right text-xs font-medium text-gray-500 uppercase tracking-wider"
"Qty")
(:th :class
"px-6 py-3 text-left text-xs font-medium text-gray-500 uppercase tracking-wider"
"Stock")
(:th :class
"px-6 py-3 w-40 text-right text-xs font-medium text-gray-500 uppercase tracking-wider"
"Cut (in)")
(:th :class
"px-6 py-3 w-40 text-right text-xs font-medium text-gray-500 uppercase tracking-wider"
"Buy (ft)")))
(:tbody :class "divide-y divide-gray-100"
(dolist (line (the model bill-of-materials))
(htm
(:tr :class "hover:bg-gray-50"
(:td :class
"px-6 py-3 text-sm text-right tabular-nums text-gray-900"
(fmt "~d" (getf line :count)))
(:td :class "px-6 py-3 text-sm font-medium text-gray-900"
(str (getf line :stock)))
(:td :class
"px-6 py-3 text-sm text-right tabular-nums text-gray-700"
(fmt "~,2f" (float (getf line :cut-length))))
(:td :class
"px-6 py-3 text-sm text-right tabular-nums text-gray-700"
(str
(let ((buy (getf line :buy-length)))
(if buy
(format nil "~d" (floor buy 12))
"special")))))))))))
(control-form (with-form-string
(:class "grid grid-cols-2 md:grid-cols-4 gap-6")
(str
(the (param-field "Total Rise (in)"
(the total-rise-control))))
(str
(the (param-field "Total Run (in)"
(the total-run-control))))
(str
(the (param-field "Number of Steps"
(the number-of-steps-control))))
(str
(the (param-field "Width (in)"
(the stairs-width-control))))
(str (the (param-field "Nosing (in)" (the nosing-control))))
(str
(the (param-field "Post Every (treads)"
(the post-every-control))))
(str
(the (param-field "Rail Height (in)"
(the handrail-height-control))))
(str (the (param-field "Handrail" (the handrail-control))))
(str (the (param-field "Risers" (the risers-control))))
(str
(the (param-field "Skirt / Fascia" (the skirt-control)))))))
:objects
((total-rise-control :type 'number-form-control
:default (the total-rise)
:ajax-submit-on-change? t
:domain :number
:min 48
:max 240
:step 6)
(total-run-control :type 'number-form-control
:default (the total-run)
:ajax-submit-on-change? t
:domain :number
:min 60
:max 360
:step 6)
(number-of-steps-control :type 'number-form-control
:default (the number-of-steps)
:ajax-submit-on-change? t
:domain :number
:min 3
:max 30
:step 1)
(stairs-width-control :type 'number-form-control
:default (the stairs-width)
:ajax-submit-on-change? t
:domain :number
:min 24
:max 72
:step 2)
(nosing-control :type 'number-form-control
:default (the nosing)
:ajax-submit-on-change? t
:domain :number
:min 0
:max 2
:step 0.25)
(post-every-control :type 'number-form-control
:default (the post-every)
:ajax-submit-on-change? t
:domain :number
:min 2
:max 6
:step 1)
(handrail-height-control :type 'number-form-control
:default (the handrail-height)
:ajax-submit-on-change? t
:domain :number
:min 30
:max 42
:step 2)
(handrail-control :type 'menu-form-control
:default (if (the handrail?) :yes :no)
:size 1
:ajax-submit-on-change? t
:choice-plist '(:yes "Yes" :no "No"))
(risers-control :type 'menu-form-control
:default (if (the include-risers?) :yes :no)
:size 1
:ajax-submit-on-change? t
:choice-plist '(:yes "Yes" :no "No"))
(skirt-control :type 'menu-form-control
:default (if (the include-skirt?) :yes :no)
:size 1
:ajax-submit-on-change? t
:choice-plist '(:yes "Yes" :no "No"))
(model :type 'staircase
:total-rise (the total-rise-control value)
:total-run (the total-run-control value)
:number-of-steps (the number-of-steps-control value)
:stairs-width (the stairs-width-control value)
:nosing (the nosing-control value)
:post-every (the post-every-control value)
:handrail-height (the handrail-height-control value)
:handrail? (eq (the handrail-control value) :yes)
:include-risers? (eq (the risers-control value) :yes)
:include-skirt? (eq (the skirt-control value) :yes))
(cut-list-section :type 'base-html-div :inner-html (the cut-list-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)))))))lisp
(defun nominal-section (nominal)
"List of (thickness width) in inches for the nominal size string
NOMINAL, e.g. \"2x6\" -> (3/2 11/2)."
(or (rest (assoc nominal *nominal-sections* :test #'string-equal))
(error "Unknown nominal lumber size ~s." nominal)))
lisp
(defun lumber-type (&key cut? solids?)
"Type symbol for a lumber part: angle-cut or square, wireframe or
solid. Asking for solids falls back to the wireframe type unless a
solids-capable (surf/SMLib) image has defined the solid variants."
(let ((wireframe (if cut? 'angle-cut-lumber 'lumber)))
(if solids?
(let ((solid (and (find-package :surf)
(find-symbol-ci (if cut? "angle-cut-lumber-solid" "lumber-solid")
:lumber))))
(if (and solid (find-class solid nil)) solid wireframe))
wireframe)))
lisp
(defun bill-of-materials (object &key (round-to 1/16))
"List of (:stock ... :cut-length ... :buy-length ... :count ...)
plists aggregating every lumber-mixin leaf in OBJECT's tree. Cut
lengths are rounded to ROUND-TO inch before grouping. Lines sort by
stock name then cut length, longest first."
(let ((table (make-hash-table :test 'equal)))
(dolist (leaf (the-object object leaves))
(when (typep leaf 'lumber-mixin)
(let* ((plist (the-object leaf bom-plist))
(key (list (getf plist :stock)
(round-to-nearest (getf plist :cut-length) round-to)
(getf plist :buy-length))))
(incf (gethash key table 0)))))
(let (lines)
(maphash (lambda (key count)
(push (list :stock (first key)
:cut-length (second key)
:buy-length (third key)
:count count)
lines))
table)
(sort lines
(lambda (a b)
(let ((stock-a (getf a :stock)) (stock-b (getf b :stock)))
(if (string-equal stock-a stock-b)
(> (getf a :cut-length) (getf b :cut-length))
(string-lessp stock-a stock-b))))))))