Update! | SetSelf
The classic GDL robot example, reborn in the 2026 demo framework -- pose it live.
This robot first appeared in 2002 as the introductory GDL training example: a handful of box primitives composed with declarative positioning and orientation rules.
The geometry definitions below are essentially the 2002 originals. Only the user interface is new -- form-control objects, an x3dom viewport, and session-controlled instances replace the old html-format lens.
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 robot (base-object)
:documentation
(:description "The classic GDL robot: a poseable figure composed of
box primitives with declarative positioning and orientation rules."
:author "Genworks International")
:input-slots
(head-angle
body-angle
arm-angle-right
arm-angle-left
pincer-distance-right
pincer-distance-left
shininess
transparency
(torso-type 'box :settable))
:computed-slots
((display-controls (list :color
:orange
:line-thickness
2
:transparency
(the transparency)
:shininess
(the shininess))))
:objects
((base :type 'robot-base
:display-controls (merge-display-controls (list :color :orange))
:height (* (the height) 0.4)
:width (* (the width) 0.2)
:length (* (the length) 0.2)
:center (translate (the center) :down (* (the height) 0.3)))
(body :type 'robot-body
:height (* (the height) 0.6)
:center (translate (the center) :up (* (the height) 0.2))
:orientation (alignment :top
(the (face-normal-vector :top))
:right
(rotate-vector-d
(the (face-normal-vector :right))
(the body-angle)
(the (face-normal-vector :top))))
:pass-down (torso-type head-angle arm-angle-right arm-angle-left
pincer-distance-left pincer-distance-right))))(define-object robot-body (base-object)
:input-slots
(head-angle
arm-angle-left
arm-angle-right
pincer-distance-left
pincer-distance-right
(torso-type 'box)
(shoulder-height (* (the torso height) 0.1)))
:objects
((torso :type (the torso-type)
:height (* (the height) 0.85)
:width (* (the width) 0.7)
:radius (half (the-child width))
:display-controls (merge-display-controls
(list :transparency 0 :color :blue))
:center (translate (the center)
:down
(- (half (the height)) (half (the-child height)))))
(head :type 'box
:height (- (the height) (the torso height))
:width (* (the width) 0.25)
:length (half (the length))
:center (translate (the center)
:up
(- (half (the height)) (half (the-child height))))
:display-controls (merge-display-controls
(list :color :cyan :transparency 0))
:orientation (alignment :right
(rotate-vector-d
(the (face-normal-vector :right))
(the head-angle)
(the (face-normal-vector :top)))))
(arms :type 'robot-arm
:sequence (:size 2)
:side (ecase (the-child index) (0 :left) (1 :right))
:display-controls (merge-display-controls
(list :transparency
0
:color
(ecase (the-child index)
(0 :green-spring-medium)
(1 :red))))
:width (half (- (the width) (the torso width)))
:length (/ (the length) 3)
:height (- (the torso height) (twice (the shoulder-height)))
:center (translate-along-vector
(the-child shoulder-point)
(the-child (face-normal-vector :bottom))
(half (the-child height)))
:orientation (alignment :bottom
(rotate-vector-d
(the (face-normal-vector :bottom))
(the-child angle)
(the (face-normal-vector :left)))
:right
(the (face-normal-vector :right)))
:shoulder-point (translate (the torso
(edge-center :top (the-child side)))
(the-child side)
(half (the-child width))
:down
(the shoulder-height))
:angle (ecase (the-child side)
(:left (the arm-angle-left))
(:right (the arm-angle-right)))
:pincer-distance (ecase (the-child side)
(:left (the pincer-distance-left))
(:right (the pincer-distance-right))))))(define-object robot-arm (base-object)
:input-slots
(side
shoulder-point
angle
pincer-distance)
:objects
((arm :type 'box)
(thumb :type 'box
:width (the hand width)
:height (the hand height)
:length (the hand length)
:center (translate (the hand center) (the side) (the pincer-distance)))
(hand :type 'box
:display-controls (merge-display-controls
(list :color :pink :transparency 0))
:center (translate (the center)
:down
(+ (half (the height)) (half (the-child height)))
(the side)
(- (- (half (the width)) (half (the-child width)))))
:height (* (the height) 0.15)
:width (* (the width) 0.2)
:length (half (the length)))))(define-object robot-base (base-object)
:objects
((leg :type 'box
:height (* 0.9 (the height))
:center (translate (the center)
:up
(- (half (the height)) (half (the-child height)))))
(foot :type 'box
:height (* 0.1 (the height))
:width (twice (twice (the width)))
:length (twice (twice (twice (the length))))
:center (translate (the center)
:down
(- (half (the height)) (half (the-child height)))))))(define-object robot-ui (demos-common:demo-ui-mixin session-control-mixin
base-html-page)
:documentation
(:description "Interactive robot demo page: the classic GDL robot
example (2002) hosted in the 2026 demo framework -- pose the robot
live with form controls."
:author "Genworks International")
:input-slots
((title "Robot Assembly Demo")
(demo-slug "robot")
(objects (list (the model)))
(view-projection-key :robot-view)
(view-projection-vector (unitize-vector (make-vector 0.7 -1 0.45)))
(robot-height 10 :settable)
(robot-width 5 :settable)
(robot-length 2 :settable)
(head-angle 0 :settable)
(body-angle 20 :settable)
(arm-angle-left 0 :settable)
(arm-angle-right 0 :settable)
(pincer-distance-left 0.45 :settable)
(pincer-distance-right 0.45 :settable))
:computed-slots
((source-pane-objects '(robot robot-body robot-arm robot-base robot-ui
demos-common:demo-ui-mixin))
(body (with-lhtml-string
nil
(:div :class "max-w-5xl mx-auto p-8"
(str
(the (page-intro "Robot Assembly"
"The classic GDL robot example, reborn in the 2026 demo framework -- pose it 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 (card :title "About This Demo" :content
(with-lhtml-string
nil
(:div :class "px-6 py-4 text-sm text-gray-700 space-y-2"
(:p
"This robot first appeared in 2002 as the introductory GDL
training example: a handful of box primitives composed with declarative
positioning and orientation rules.")
(:p
"The geometry definitions below are essentially the 2002
originals. Only the user interface is new -- form-control objects, an
x3dom viewport, and session-controlled instances replace the old
html-format lens."))))))
(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)))))))
(control-form (with-form-string
(:class "grid grid-cols-2 md:grid-cols-4 gap-6")
(str (the (param-field "Height" (the height-control))))
(str (the (param-field "Width" (the width-control))))
(str (the (param-field "Length" (the length-control))))
(str (the (param-field "Torso" (the torso-control))))
(str
(the (param-field "Head Angle (deg)"
(the head-angle-control))))
(str
(the (param-field "Body Angle (deg)"
(the body-angle-control))))
(str
(the (param-field "Left Arm (deg)"
(the arm-angle-left-control))))
(str
(the (param-field "Right Arm (deg)"
(the arm-angle-right-control))))
(str
(the (param-field "Left Grip" (the pincer-left-control))))
(str
(the (param-field "Right Grip"
(the pincer-right-control)))))))
:objects
((height-control :type 'number-form-control
:default (the robot-height)
:ajax-submit-on-change? t
:domain :number
:min 4
:max 20
:step 1)
(width-control :type 'number-form-control
:default (the robot-width)
:ajax-submit-on-change? t
:domain :number
:min 3
:max 10
:step 0.5)
(length-control :type 'number-form-control
:default (the robot-length)
:ajax-submit-on-change? t
:domain :number
:min 1
:max 4
:step 0.5)
(torso-control :type 'menu-form-control
:default :box
:size 1
:ajax-submit-on-change? t
:choice-plist '(:box "Box" :cylinder "Cylinder"))
(head-angle-control :type 'number-form-control
:default (the head-angle)
:ajax-submit-on-change? t
:domain :number
:min -90
:max 90
:step 5)
(body-angle-control :type 'number-form-control
:default (the body-angle)
:ajax-submit-on-change? t
:domain :number
:min -90
:max 90
:step 5)
(arm-angle-left-control :type 'number-form-control
:default (the arm-angle-left)
:ajax-submit-on-change? t
:domain :number
:min -180
:max 180
:step 5)
(arm-angle-right-control :type 'number-form-control
:default (the arm-angle-right)
:ajax-submit-on-change? t
:domain :number
:min -180
:max 180
:step 5)
(pincer-left-control :type 'number-form-control
:default (the pincer-distance-left)
:ajax-submit-on-change? t
:domain :number
:min 0
:max 1
:step 0.05)
(pincer-right-control :type 'number-form-control
:default (the pincer-distance-right)
:ajax-submit-on-change? t
:domain :number
:min 0
:max 1
:step 0.05)
(model :type 'robot
:height (the height-control value)
:width (the width-control value)
:length (the length-control value)
:torso-type (ecase (the torso-control value)
(:box 'box)
(:cylinder 'cylinder))
:head-angle (the head-angle-control value)
:body-angle (the body-angle-control value)
:arm-angle-left (the arm-angle-left-control value)
:arm-angle-right (the arm-angle-right-control value)
:pincer-distance-left (the pincer-left-control value)
:pincer-distance-right (the pincer-right-control value)
:transparency 0
:shininess 0.8)))(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)))))))