Commit f07ce646 authored by Dave Cooper's avatar Dave Cooper
Browse files

Starting to remove unneeded clutter.

parent ff5b2c3c
(in-package :aero)
(define-object interior-ref-surf (surface-trimm)
:input-slots
((layer-1 t :settable)
(layer-2 t :settable)
(layer-3 t :settable)
(layer-4 t :settable)
(layer-5 t :settable)
(layer-6 nil :settable)
(root-ribs-clearance 10 :settable)
(tip-ribs-clearance 5 :settable)
(main-body-ribs-angle 15 :settable)
(relaxation-parameters '(0.0 0.05 0.1 0.175 0.25 0.35 0.45 0.57 0.7 0.85 1.0) :settable);; frome 0.0 to 1.0
)
:computed-slots
()
:hidden-objects
()
:objects
((spar-ref-isos :type 'iso-curve
:hidden? (the layer-5)
:sequence (:size 4)
:surface (the ref-surf)
:fixed-parameter :u
:parameter (nth (the-child index)
(list
(* (first (the spars-position)) 0.5)
(- 1 (* (first (the spars-position)) 0.5))
(- 0.5 (* (- 1 (second (the spars-position))) 0.5))
(+ 0.5 (* (- 1 (second (the spars-position))) 0.5)))))
(te-ref-spar :type 'ruled-surface
:hidden? (the layer-6)
:curve-1 (the (spar-ref-isos 0))
:curve-2 (the (spar-ref-isos 1))
:display-controls (list :color :violet))
(le-ref-spar :type 'ruled-surface
:hidden? (the layer-6)
:curve-1 (the (spar-ref-isos 2))
:curve-2 (the (spar-ref-isos 3))
:display-controls (list :color :violet))
(ref-root-rib :type 'ruled-surface
:hidden? (the layer-6)
:curve-1 (first (list-elements (the (main-body 0 )(u-iso-curves ))))
:curve-2 (the-object (first (list-elements (the (main-body 1)(u-iso-curves )))) reverse)
:display-controls (list :color :sienna))
(ref-tip-rib :type 'ruled-surface
:hidden? (the layer-6)
:curve-1 (first (last (list-elements (the (main-body 2 )(u-iso-curves )))))
:curve-2 (the-object (first (last (list-elements (the (main-body 3)(u-iso-curves ))))) reverse)
:display-controls (list :color :sienna))
(root-clearance-point :type 'point
:hidden? (the layer-5)
:center (translate-along-vector
(the-object (first (list-elements (the te-ref-spar u-iso-curves ))) start)
(subtract-vectors (the-object (first (last (list-elements (the te-ref-spar u-iso-curves )))) start)
(the-object (first (list-elements (the te-ref-spar u-iso-curves ))) start))
(the root-ribs-clearance)))
(tip-clearance-point :type 'point
:hidden? (the layer-5)
:center (translate-along-vector
(the-object (first (last (list-elements (the le-ref-spar u-iso-curves )))) start)
(subtract-vectors (the-object (first (list-elements (the le-ref-spar u-iso-curves ))) start)
(the-object (first (last (list-elements (the le-ref-spar u-iso-curves )))) start))
(the tip-ribs-clearance)))
(ribs-ref-axis :type 'linear-curve
:hidden? (the layer-5)
:start (the root-clearance-point center)
:end (the tip-clearance-point center))
(plane-ref-points :type 'point
:hidden? (the layer-5)
:sequence (:size (length (the relaxation-parameters )))
:center (the ribs-ref-axis
(point (nth (the-child index)
(the relaxation-parameters )))))
(ribs-b-curves :type 'planar-section-curve
:hidden? (the layer-5)
:sequence (:size (length (the relaxation-parameters )))
:surface (the ref-surf)
;; It is required the *3d-tolerance-default* tolerance because
;; curve intersection-point up-stream it is based on higher tolerances.
;; I recommend for planar-intersection-cueve (s) tolerance to be set to
;; This adds a lot of disadvantages like: !!! 1200 control-points !!!
;;;:3d-approximation-tolerance *3d-tolerance-default*
:plane-normal (rotate-vector (make-vector 1.0 0.0 0.0)
(degrees-to-radians
(- 90 (the main-body-ribs-angle)))
(make-vector 0.0 -1.0 0.0))
:plane-point (the ribs-ref-axis
(point (nth (the-child index)
(the relaxation-parameters ))))
:display-controls (list :color :red ))
(ribs-bottom-b-curves :type 'trimmed-curve
:hidden? (the layer-5)
:sequence (:size (length (the relaxation-parameters )))
:built-from (the (ribs-b-curves (the-child index)))
:u2 (get-parameter-of (the (ribs-b-curves (the-child index))
(curve-intersection-point (the (spar-ref-isos 0))
:distance-tolerance
*3d-approximation-tolerance-default*)))
:u1 (get-parameter-of (the (ribs-b-curves (the-child index))
(curve-intersection-point (the (spar-ref-isos 2))
:distance-tolerance
*3d-approximation-tolerance-default*)))
:display-controls (list :color :red :line-thickness 1.5))
(ribs-top-curves :type 'trimmed-curve
:hidden? (the layer-5)
:sequence (:size (length (the relaxation-parameters )))
:built-from (the (ribs-b-curves (the-child index)))
:u1 (get-parameter-of (the (ribs-b-curves (the-child index))
(curve-intersection-point (the (spar-ref-isos 1))
:distance-tolerance
*3d-approximation-tolerance-default*)))
:u2 (get-parameter-of (the (ribs-b-curves (the-child index))
(curve-intersection-point (the (spar-ref-isos 3))
:distance-tolerance
*3d-approximation-tolerance-default*)))
:display-controls (list :color :red :line-thickness 1.5))
(interior-rib :type 'ruled-surface
:hidden? (the layer-6)
:sequence (:size (length (the relaxation-parameters )))
:curve-1 (the (ribs-bottom-b-curves (the-child index)))
:curve-2 (the (ribs-top-curves (the-child index)) reverse )
:display-controls (list :color :orange))
))
(in-package :aero)
(define-object material-design (base-object)
;;Note this is based on the surfaces --> control-grid-u --> global-polyline --> vertex-list.
:input-slots
((layer-1 t :settable)
(layer-2 t :settable)
(layer-3 t :settable)
(layer-4 t :settable)
(layer-5 t :settable)
(layer-6 t :settable)
(layer-m-1 t :settable)
(layer-m-2 nil :settable))
:computed-slots
()
:objects
((m-ref-surf :type 'interior-ref-surf
:hidden? (the layer-m-1)
:layer-4 nil
:layer-6 nil)
(test :type 'material-panel
:hidden? (the layer-m-2)
:sequence (:size (length (list-elements (the m-ref-surf))))
:surface-in (nth (the-child index)(list-elements (the m-ref-surf)))
:strings-for-display (the-child surface-in strings-for-display)
:display-controls (the-child surface-in display-controls))))
(define-object material-panel (planar-surface)
:input-slots (surface-in)
:computed-slots ((p00 (the surface-in (point (the surface-in u-min)(the surface-in v-min))))
(p01 (the surface-in (point (the surface-in u-min)(the surface-in v-max))))
(p10 (the surface-in (point (the surface-in u-max)(the surface-in v-min))))
(p11 (the surface-in (point (the surface-in u-max)(the surface-in v-max))))))
1. Revolved surf for end-cap is not implemented as desired in gdl.
\ No newline at end of file
(in-package :gdl-user)
(gwl:define-package :aero)
(in-package :aero)
(defparameter *data-pathname*
(make-pathname :directory (append (pathname-directory (glisp:system-home :gdl-aero-demo-1))
(list "data"))
:device (pathname-device (glisp:system-home :gdl-aero-demo-1))))
(in-package :aero)
(define-object ref-surf (base-object)
:input-slots
((layer-1 t :settable)
(layer-2 nil :settable)
(data-directory *data-pathname*)
(chord-data '(220 80) :settable)
(span-data '(0.0 320) :settable)
(sweep-angle '(0.0 -40) :settable)
(twist-data '(0.0 0.0) ));;;it is not added in this model up-stream
:computed-slots
((sweep-data (* (tan (degrees-to-radians
(the sweep-angle)))
(the span-data))))
:objects
((transform-points
:type 'proces-pints
:hidden? (the layer-1)
:sequence (:size (length (the chord-data)))
:points (read-points-list
(merge-pathnames "naca-0012.dat"
(the data-directory)))
:scale-x (nth (the-child index) (the chord-data))
:scale-y (nth (the-child index) (the chord-data))
:translate-x (* (tan (degrees-to-radians
(nth (the-child index) (the sweep-angle))))
(nth (the-child index) (the span-data)))
:translate-z (nth (the-child index) (the span-data))
:points-data (the-child procesed-points)
:rotate (nth (the-child index)(the twist-data )))
(ref-surf :type 'fitted-surface
:hidden? (the layer-2)
:display-controls (list :color :green-spring)
:v-degree (- (length (the chord-data)) 1)
:points (mapcar #' (lambda (x) (the-object x points-data))
(list-elements (the transform-points))))
;;this approach has a tolerance error "E^-8"
(end-cap-curve :type 'iso-curve
:hidden? (the layer-1)
:fixed-parameter :v
:parameter (the ref-surf v-max)
:surface (the ref-surf))
(ecc-trimmed-curve :type 'trimmed-curve
:hidden? (the layer-1)
:built-from (the end-cap-curve)
:tolerance 0.0001
:u1 (the end-cap-curve u-min)
:u2 (* (the end-cap-curve u-max) 0.5))
(end-cap-surf :type 'revolved-surface
:hidden? (the layer-2)
;;'smlib::revolved-surface-nlib ;;the smlib
;;revolved-surface from GDL has at the moment memory leaks
:display-controls (list :color :green-yellow2)
:curve (the ecc-trimmed-curve)
:arc pi
:axis-point (the ecc-trimmed-curve start)
:axis-vector (make-vector 1.0 0.0 0.0))
;;add the real vector that contains the point
))
(in-package :aero )
(define-object surface-trimm (ref-surf)
:input-slots
((layer-1 t :settable)
(layer-2 t :settable)
(layer-3 t :settable)
(layer-4 nil :settable)
;; !!! Flag !!!
;;the profile is symmetric "naca-0012" in this case it is possible
;;to consider the
;;chord parameterization 1/2 from the surface parameterization
(spars-position '(0.2 0.9) :settable)
;; !!! Flag !!
;;!!! Flag !!!
;;at the moment GDL doesn't have the capability
;;to change the number of children in the tree and update the view accordingly
(elevator-span 300)) ;;;:settable))
;;!!! Flag !!!
:computed-slots
((sub-surface-list (list
(the (surfaces-uuu 0))
(the (surfaces-uuuu 0))
(the (surfaces-uuuu 1))
(the (surfaces-tuuu 0))
(the (surfaces-tuuuu 0))
(the (surfaces-tuuuu 1)))))
:hidden-objects
((split-1
:type 'split-surface
:hidden? (the layer-3)
:u-or-v :v
:display-controls (list :color :red :line-thickness 1)
:surface-in (the ref-surf)
:projection-point (make-point 0.0 0.0 (the elevator-span))
:projection-vector (make-vector 1.0 0.0 0.0))
(surfaces-v
:type 'surface
:hidden? (the layer-3)
:sequence (:size 2)
:native-surface (nth (the-child index)(the split-1 %native-surfaces%)))
(split-2
:type 'split-surface
:hidden? (the layer-3)
:u-or-v :u
:display-controls (list :color :red :line-thickness 1)
:surface-in (the (surfaces-v 0) )
:parameter (* (first (the spars-position)) 0.5))
(surfaces-u
:type 'surface
:sequence (:size 2)
:hidden? (the layer-3)
:native-surface (nth (the-child index)(the split-2 %native-surfaces%)))
(split-3
:type 'split-surface
:u-or-v :u
:display-controls (list :color :red :line-thickness 1)
:surface-in (the (surfaces-u 1) )
:parameter (- 1 (* (first (the spars-position)) 0.5)))
(surfaces-uu
:type 'surface
:sequence (:size 2)
:hidden? (the layer-3)
:native-surface (nth (the-child index)(the split-3 %native-surfaces%)))
(split-4
:type 'split-surface
:hidden? (the layer-3)
:u-or-v :u
:display-controls (list :color :red :line-thickness 1)
:surface-in (the (surfaces-uu 0) )
:parameter (- 0.5 (* (- 1 (second (the spars-position))) 0.5)))
(surfaces-uuu
:type 'surface
:hidden? (the layer-3)
:sequence (:size 2)
:native-surface (nth (the-child index)(the split-4 %native-surfaces%)))
(split-5
:type 'split-surface
:hidden? (the layer-3)
:u-or-v :u
:display-controls (list :color :red :line-thickness 1)
:surface-in (the (surfaces-uuu 1) )
:parameter (+ 0.5 (* (- 1 (second (the spars-position))) 0.5)))
(surfaces-uuuu
:type 'surface
:hidden? (the layer-3)
:sequence (:size 2)
:native-surface (nth (the-child index)(the split-5 %native-surfaces%)))
(split-t4
:type 'split-surface
:hidden? (the layer-3)
:u-or-v :u
:display-controls (list :color :red :line-thickness 1)
:surface-in (the (surfaces-v 1) )
:parameter (- 0.5 (* (- 1 (second (the spars-position))) 0.5)))
(surfaces-tuuu
:type 'surface
:hidden? (the layer-3)
:sequence (:size 2)
:native-surface (nth (the-child index)(the split-t4 %native-surfaces%)))
(split-t5
:type 'split-surface
:hidden? (the layer-3)
:u-or-v :u
:display-controls (list :color :red :line-thickness 1)
:surface-in (the (surfaces-tuuu 1) )
:parameter (+ 0.5 (* (- 1 (second (the spars-position))) 0.5)))
(surfaces-tuuuu
:type 'surface
:hidden? (the layer-3)
:sequence (:size 2)
:native-surface (nth (the-child index)(the split-t5 %native-surfaces%))))
:objects
((flaps-surf
:type 'surface
:hidden? (the layer-4)
:sequence (:size 2)
:display-controls (list :color :red )
:built-from (nth (the-child index)
(list (the (surfaces-u 0)) (the (surfaces-uu 1)))))
(main-body
:type 'surface
:hidden? (the layer-4)
:sequence (:size 4)
:display-controls (list :color :green )
:built-from (nth (the-child index) (list (the (surfaces-uuu 0))
(the (surfaces-uuuu 1))
(the (surfaces-tuuu 0))
(the (surfaces-tuuuu 1)))))
(te-surface
:type 'surface
:sequence (:size 2)
:hidden? (the layer-4)
:display-controls (list :color :blue)
:built-from (nth (the-child index) (list
(the (surfaces-uuuu 0))
(the (surfaces-tuuuu 0))
)))))
(in-package :aero)
(defun read-points-list (file-name)
(with-open-file (in file-name)
(let (result)
(do ((line (read-line in nil nil) (read-line in nil nil)))
((or (null line) (string-equal line "")) (nreverse result))
(let ((xyz-list (read-from-string (string-append "(" line ")"))))
(when (and (= (length xyz-list) 3)
(every #'numberp xyz-list))
(push xyz-list result)))))))
(define-object proces-pints (base-object)
:input-slots
((points-data)
(points)
(scale-x)(scale-y)(scale-z)
(translate-x)(translate-z)
(rotate))
:computed-slots
((scale-points (mapcar #'apply-make-point (mapcar #'(lambda(x)(list (* (first x)(the scale-x))(* (second x) (the scale-y))(third x)))(the points))))
(tranzlate-x (mapcar #'(lambda (point) (translate-along-vector point #(-1.0 0.0 0.0) (the translate-x))) (the scale-points)))
(tranzlate-z (mapcar #'(lambda (point) (translate-along-vector point #(0.0 0.0 1.0) (the translate-z))) (the tranzlate-x)))
(procesed-points (mapcar #'(lambda (point) (rotate-point point #(0.0 0.0 0.0) #(0.0 0.0 1.0) :angle (degree (the rotate)))) (the tranzlate-z)))
))
(define-object p-relaxation (base-object)
:input-slots ((curve-in )
(relaxation-paramete)
(number-of-sample-points 9 ))
:computed-slots ((%curve-in (the curve-in))
(total-length (the %curve-in total-length))
(interval (/ (the total-length) (the number-of-sample-points)))
(pi-factor (/ (degrees-to-radians 180)
;;(the relaxation-parameter)
(the number-of-sample-points)))
(sample-points-list (list-elements (the sample-points) (the-element center))))
:objects
((sample-points :type 'sample-point
:hidden? nil
:sequence (:size (the number-of-sample-points))
:distance
(if (the-child first?)
0
(if (the-child last?) (the total-length)
(let ((increment
(* (the interval)
(- 1
(cos (* (the pi-factor)
(the-child index)))))))
(+ increment (the-child previous distance)))))
:center (the %curve-in
(point (the %curve-in (parameter-at-length (the-child distance))))))))
(define-object sample-point (point)
:input-slots (distance))
(in-package :gwl-user)
(net.aserve:shutdown)
(net.aserve:start :port 80 :listeners 50 :setuid 1002 :setgid 1002)
(dolist (host (list "cl-foundation.com" "cl-foundation.org"
"www.cl-foundation.com" "www.cl-foundation.org"))
(net.aserve:publish-directory
:prefix "/aclu_files/"
:host host
:destination (format nil "~a"
(merge-pathnames "static-old/aclu_files/"
glisp:*gdl-home*)))
(net.aserve:publish-file
:path "/"
:host host
:file (format nil "~a" (merge-pathnames "static-old/aclu.html"
glisp:*gdl-home*))))
(net.aserve:publish-directory :prefix "/downloads/"
:destination (format nil "~a" (merge-pathnames "downloads/" glisp:*gdl-home*)))
;;
;; Initialize SMLib here if available.
;;
;;(smlib::initialize-smlib)
(in-package :gdl-user)
(setq *run-with-dependency-recording?* t)
(defparameter *pairs-hash* nil)
(define-object dep-test ()
:computed-slots ((a (+ (the b) (the c)))
(b (+ (the c) (the d)))
(c (* (the d) (random 10)))
(d (the (kid-1 0) num)))
:objects ((kid-1 :type 'kid
:sequence (:size 1)
:num 42)))
(define-object kid ()
:input-slots (num))
(define-object dep (base-object)
:input-slots ((instance (make-object 'dep-test))
(message :a)
(force-evaluation? t))
:computed-slots
((strings-for-display (format nil "~s"
(cons 'the (append (reverse (the instance root-path))
(list (the message))))))
(dependencies-list (progn (when (the force-evaluation?)
(the instance (evaluate (the message))))
(gdl::find-dependencies (the instance) (the message))))
(dependants-list (progn (when (the force-evaluation?)
(the instance (evaluate (the message))))
(gdl::find-dependants (the instance) (the message))))
(dependency-pairs
(let ((*pairs-hash* (glisp:make-sans-value-hash-table :test #'equalp)))
(the %dependency-pairs%)))
(%dependency-pairs%