;; ;; Copyright 2002, 2009 Genworks International and Genworks BV ;; ;; 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 ;; . ;; (in-package :genworks.demos.bus) (define-object chassis (application-mixin) :input-slots (wheelbase track datum height (turn-angle 0 :settable) ) :computed-slots ((ui-display-list-objects (remove-if #'(lambda (item) (typep item 'base-rule-object)) (the :children))) (frame-width (the :frame :width)) (frame-height (the :frame :height)) (left-rotation (- (ecase (the :turn-type) (:left (the :turn-angle)) (:right (if (the :left-hit-point) (angle-between-vectors-d (the (:knuckles-straight 0) :tie-rod-arm-vector) (subtract-vectors (the :left-hit-point) (the (:knuckles-straight 0) :tie-rod-arm-axis-point)) (the (:knuckles-straight 0) :top-vector) t) 0))) (the :toe-in-angle))) (right-rotation (+ (ecase (the :turn-type) (:right (the :turn-angle)) (:left (if (the :right-hit-point) (angle-between-vectors-d (the (:knuckles-straight 1) :tie-rod-arm-vector) (subtract-vectors (the :right-hit-point) (the (:knuckles-straight 1) :tie-rod-arm-axis-point)) (the (:knuckles-straight 1) :top-vector) t) 0))) (the :toe-in-angle))) (tie-rod-length (3d-distance (the (:knuckles-straight 0) :tie-rod-arm-end) (the (:knuckles-straight 1) :tie-rod-arm-end))) (left-hit-point (let ((circle (the (:knuckles-straight 0) :tie-rod-arm-circle)) (sphere (the (:knuckles 1) :tie-rod-sphere))) (inter-circle-sphere (getf circle :center) (getf circle :radius) (getf circle :axis-vector) (getf sphere :center) (getf sphere :radius) nil))) (right-hit-point (let ((circle (the (:knuckles-straight 1) :tie-rod-arm-circle)) (sphere (the (:knuckles 0) :tie-rod-sphere))) (inter-circle-sphere (getf circle :center) (getf circle :radius) (getf circle :axis-vector) (getf sphere :center) (getf sphere :radius) t))) (front-overhang 25 :settable) (rear-overhang 72 :settable) (frame-rail-height 6 :settable) (frame-rail-thickness 2.5 :settable) (turn-type :left :settable) (toe-in-angle 0.5 :settable) (camber-angle 1.0 :settable) (caster-angle -1.0 :settable) (kingpin-inclination-angle 7 :settable) (tie-rod-arm-length :medium :settable) (tie-rod-arm-setting :medium :settable) (ackermann-data (let ((chassis (make-object 'chassis :wheelbase (the wheelbase) :track (the track) :datum (the datum) :height (the height))) (left-angles (list-of-numbers 1 35)) right-angles) (the-object chassis (set-slots! (list :front-overhang (the front-overhang) :rear-overhang (the rear-overhang) :frame-rail-height (the frame-rail-height) :frame-rail-thickness (the frame-rail-thickness) :toe-in-angle 0 :camber-angle (the camber-angle) :caster-angle (the caster-angle) :kingpin-inclination-angle (the kingpin-inclination-angle) :tie-rod-arm-length (the tie-rod-arm-length) :tie-rod-arm-setting (the tie-rod-arm-setting) :turn-type :left))) (setq right-angles (let (result ideal-result) (dolist (left-angle left-angles (list (nreverse result) (nreverse ideal-result))) (the-object chassis (set-slot! :turn-angle left-angle)) (push (the-object chassis right-rotation) result) (let ((rear-axle-intersect (inter-line-plane (the (axles 1) center) (the (face-normal-vector :rear)) (the-object chassis (knuckles 0) center) (the-object chassis (knuckles 0) (face-normal-vector :right))))) (push (angle-between-vectors-d (the (face-normal-vector :rear)) (subtract-vectors (the (knuckles 1) center) rear-axle-intersect)) ideal-result))))) (list :left (cons 0 left-angles) :right (cons 0 (first right-angles)) :ideal-right (cons 0 (second right-angles))))) ) :objects ((knuckles :type 'knuckle :sequence (:size 2) :side (ecase (the-child :index) (0 :left) (1 :right)) :top-vector (getf (the (:axles 0) :kingpin-vectors) (the-child :side)) :front-vector (cross-vectors (the-child :top-vector) (the (:face-normal-vector (the-child :side)))) :left-vector (cross-vectors (the-child :top-vector) (ecase (the-child :side) (:left (reverse-vector (the-child :front-vector))) (:right (the-child :front-vector)))) :pass-down (:tie-rod-length :tie-rod-arm-length :tie-rod-arm-setting) :spindle-downward-pitch (+ (the :kingpin-inclination-angle) (the :camber-angle)) :center (the (:axles 0) (:kingpins (the-child :index)) :center) :transformation-matrix (alignment :top (the-child :top-vector) :front (rotate-vector-d (the-child :front-vector) (ecase (the-child :side) (:left (the :left-rotation)) (:right (the :right-rotation))) (the-child :top-vector)) :left (rotate-vector-d (the-child :left-vector) (ecase (the-child :side) (:left (the :left-rotation)) (:right (the :right-rotation))) (the-child :top-vector))) :orientation (the-child :transformation-matrix)) (tie-rod :type 'c-cylinder :radius 1.5 :start (the (:knuckles 0) :tie-rod-arm-end) :end (the (:knuckles 1) :tie-rod-arm-end)) (frame :type 'frame :width (+ (the :wheelbase) (the :front-overhang) (the :rear-overhang)) :length (* 4/9 (the :track)) :height (the :frame-rail-height) :thickness (the :frame-rail-thickness) :center (translate (the :datum) :right (half (the-child :width)))) (axles :type (:sequence '(axle rear-axle)) :sequence (:size 2) :center (translate (the :datum) :down (+ (half (the :frame :height)) (half (the-child :height))) :right (ecase (the-child :index) (0 (the :front-overhang)) (1 (+ (the :front-overhang) (the :wheelbase))))) :transformation-matrix (alignment :left (rotate-vector-d (the (:face-normal-vector :left)) (the :caster-angle) (the (:face-normal-vector :front)))) :orientation (the-child :transformation-matrix) :height 10 :length (- (the :track) (ecase (the-child :index) (0 (twice (the (:wheels-front 0) :length))) (1 (twice (the (:wheels-rear 0) :length))))) :pass-down (:kingpin-inclination-angle) :width 10 :display-controls (list :color :black :line-thickness 2)) (wheels-front :type 'wheel :sequence (:size 2) :center (the (:knuckles (the-child :index)) :spindle-center) :transformation-matrix (alignment :front (the (:knuckles (the-child :index)) :spindle-vector)) :orientation (the-child :transformation-matrix) :length 9 :radius 19 :inner-radius 7 :display-controls (list :color "#333333" :shininess 0.6 :specular-color "#999999") ) (wheels-rear :type 'wheel :sequence (:size 2) :center (translate (getf (the (:axles 1) :wheel-centers) (ecase (the-child :index) (0 :left) (1 :right))) (ecase (the-child :index) (0 :front) (1 :rear)) (half (the-child :length))) :transformation-matrix (alignment :front (the (:face-normal-vector (ecase (the-child :index) (0 :front) (1 :rear))))) :orientation (the-child :transformation-matrix) :display-controls (list :color "#333333" :shininess 0.6 :specular-color "#999999") :length 15 :radius 19 :inner-radius 7) (rule-ackermann :type 'rule-ackermann :ackermann-data (list :left (getf (the ackermann-data) :left) :right (getf (the ackermann-data) :right)) :ackermann-data-ideal (list :left (getf (the ackermann-data) :left) :right (getf (the ackermann-data) :ideal-right)))) :hidden-objects ((knuckles-straight :type 'knuckle :sequence (:size 2) :center (the (:axles 0) (:kingpins (the-child :index)) :center) :side (ecase (the-child :index) (0 :left) (1 :right)) :top-vector (getf (the (:axles 0) :kingpin-vectors) (the-child :side)) :front-vector (cross-vectors (the-child :top-vector) (the (:face-normal-vector (the-child :side)))) :left-vector (cross-vectors (the-child :top-vector) (ecase (the-child :side) (:left (reverse-vector (the-child :front-vector))) (:right (the-child :front-vector)))) :spindle-downward-pitch (+ (the :kingpin-inclination-angle) (the :camber-angle)) :pass-down (:tie-rod-arm-length :tie-rod-arm-setting) :transformation-matrix (alignment :top (the-child :top-vector) :front (rotate-vector-d (the-child :front-vector) (the :toe-in-angle) (ecase (the-child :side) (:left (reverse-vector (the-child :top-vector))) (:right (the-child :top-vector)))) :left (rotate-vector-d (the-child :left-vector) (the :toe-in-angle) (ecase (the-child :side) (:left (reverse-vector (the-child :top-vector))) (:right (the-child :top-vector))))) :orientation (the-child :transformation-matrix))))