#|
Feedback Elements
Note: This is an example file showing concepts of the Integration Kit.
The code itself is not supported and will never be supported.
|#
(in-package :example)
(use-package :oli)
(defvar my-serial1 nil)
(defvar my-serial2 nil)
(sd-defdialog 'FeedbackElements
:toolbox-button t
:dialog-title '"Feedback Elements"
:after-initialization
'(progn
(unless my-serial1
(setf my-serial1 (sd-get-feedback-elem-new-serial-id))
(sd-set-feedback-elem-default-facets NUM-FACETS :serial my-serial1)
(sd-set-feedback-elem-default-color (sd-color-to-rgb COLOR) :serial my-serial1)
)
(unless my-serial2
(setf my-serial2 (sd-get-feedback-elem-new-serial-id))
(sd-set-feedback-elem-default-color 1.0,0.5,0.0 :serial my-serial2)
)
(create-feedback-shapes)
)
:variables
'(
(NAME :initial-value "FeedbackElement")
(feedback-elements-list :initial-value nil)
(shape-id-arrow)
(shape-id-text)
;; ------------------------------------------------------------------------
(TEXT
:value-type :string
:initial-value nil
:after-input (change-text))
(CREATE
:title "(Re)Create"
:toggle-type :left-toggle
:push-action (create-feedback))
("-")
(SHOW
:toggle-type :grouped-toggle
:push-action (show-feedback t))
(HIDE
:toggle-type :grouped-toggle
:push-action (show-feedback nil))
(MOVE-ALL
:toggle-type :grouped-toggle
:push-action (move-feedback))
(MOVE-SHAPE
:toggle-type :grouped-toggle
:push-action (move-feedback shape-id-text))
(SCALE-ALL
:toggle-type :grouped-toggle
:push-action (scale-feedback))
(ROTATE-ALL
:toggle-type :grouped-toggle
:push-action (rotate-feedback))
(CHANGE-NAME
:toggle-type :left-toggle
:push-action (change-name))
(NUM-FACETS
:initial-value 5
:value-type :positive-number
:after-input (create-feedback))
(COLOR
:value-type :rgb-color
:after-input (color-feedback))
(DELETE-ALL
:toggle-type :grouped-toggle
:push-action (delete-feedback NAME)
)
(DELETE-SHAPE
:toggle-type :grouped-toggle
:push-action (delete-shape)
)
("Different Shapes")
(CONE
:toggle-type :grouped-toggle
:push-action (show-feedback-shape "CONE"))
(PYRAMID
:toggle-type :grouped-toggle
:push-action (show-feedback-shape "PYRAMID"))
(FRUSTUM
:toggle-type :grouped-toggle
:push-action (show-feedback-shape "FRUSTUM"))
(FRUSTUM-PYR
:toggle-type :grouped-toggle
:push-action (show-feedback-shape "FRUSTUM_PYRAMID"))
(CYLINDER
:toggle-type :grouped-toggle
:push-action (show-feedback-shape "CYLINDER"))
(CUBOID
:toggle-type :grouped-toggle
:push-action (show-feedback-shape "CUBOID"))
(LINE
:toggle-type :grouped-toggle
:push-action (show-feedback-shape "LINE"))
(LABEL
:toggle-type :grouped-toggle
:push-action (show-feedback-shape "LABEL"))
)
:local-functions
'(
;;---------------------------------
(create-feedback ()
(delete-feedback NAME)
(let (child parent
(shape-id 1)
(pt1 0,0,0)
(pt2 50,50,0)
(pt3 100,80,0)
(dir 50,0,0)
)
(setf parent (sd-create-feedback-elem :serial my-serial1
:name NAME))
(setf shape-id-arrow shape-id)
(setf child (sd-create-feedback-elem-pyramid
pt1 pt2 6.0
parent shape-id-arrow
:facets NUM-FACETS
))
(incf shape-id)
(setf child (sd-create-feedback-elem-line
pt2 pt3
parent shape-id
))
(incf shape-id)
(setf shape-id-text shape-id)
(setf child (sd-create-feedback-elem-label
pt3 dir
10.0
TEXT
parent shape-id-text
:color 0.0,1.0,0.5)) ;fixed color different than default
(sd-call-cmds
(progn
(display (format nil "Feedback element with name '~a' created."
(sd-inq-feedback-elem-name parent)))
(display (format nil "The serial of the feedback element is ~a."
(sd-inq-feedback-elem-serial parent)))
(display (format nil "The serial of the feedback shape is ~a."
(sd-inq-feedback-elem-serial child)))
(display (format nil "The shape id of the last created shape is ~a."
(sd-inq-feedback-elem-shape-id child)))
(display (format nil "The color of the feedback element is ~a."
(sd-inq-feedback-elem-color parent)))
(display (format nil "The color of the last created child is ~a."
(sd-inq-feedback-elem-color parent
:shape shape-id)))
))
))
;;---------------------------------
;; Create a feedback element for every different feedback shape.
;; The shape id is always 1 because the shape is the only shape in the parent
;; feedback element.
(create-feedback-shapes ()
(let (feedback-element shape-name
(shape-id 1)
(pt1 -20,0,30)
(pt2 -20,0,0)
(width1 10)
(width2 20)
(facets 20)
)
;; Cone
(setf shape-name "CONE")
(push shape-name feedback-elements-list)
(setf feedback-element (sd-create-feedback-elem :name shape-name
:serial my-serial2))
(sd-create-feedback-elem-pyramid
pt1 pt2 width1
feedback-element shape-id
:facets facets
)
(sd-hide-feedback-elem feedback-element)
;; Cylinder
(setf shape-name "CYLINDER")
(push shape-name feedback-elements-list)
(setf feedback-element (sd-create-feedback-elem :name shape-name
:serial my-serial2))
(sd-create-feedback-elem-cut-pyramid
pt1 pt2 width1 width1
feedback-element shape-id
:facets facets
)
(sd-hide-feedback-elem feedback-element)
;; 4 sided pyramid
(setf shape-name "PYRAMID")
(push shape-name feedback-elements-list)
(setf feedback-element (sd-create-feedback-elem :name shape-name
:serial my-serial2))
(sd-create-feedback-elem-pyramid
pt1 pt2 width1
feedback-element shape-id
:facets 4
)
(sd-hide-feedback-elem feedback-element)
;; Cuboid
(setf shape-name "CUBOID")
(push shape-name feedback-elements-list)
(setf feedback-element (sd-create-feedback-elem :name shape-name
:serial my-serial2))
(sd-create-feedback-elem-cut-pyramid
pt1 pt2 width1 width1
feedback-element shape-id
:facets 4
)
(sd-hide-feedback-elem feedback-element)
;; Frustum
(setf shape-name "FRUSTUM")
(push shape-name feedback-elements-list)
(setf feedback-element (sd-create-feedback-elem :name shape-name
:serial my-serial2))
(sd-create-feedback-elem-cut-pyramid
pt1 pt2 width1 width2
feedback-element shape-id
:facets facets
)
(sd-hide-feedback-elem feedback-element)
;; Frustum of pyramid
(setf shape-name "FRUSTUM_PYRAMID")
(push shape-name feedback-elements-list)
(setf feedback-element (sd-create-feedback-elem :name shape-name
:serial my-serial2))
(sd-create-feedback-elem-cut-pyramid
pt1 pt2 width1 width2
feedback-element shape-id
:facets 4
)
(sd-hide-feedback-elem feedback-element)
;; Line
(setf shape-name "LINE")
(push shape-name feedback-elements-list)
(setf feedback-element (sd-create-feedback-elem :name shape-name
:serial my-serial2))
(sd-create-feedback-elem-line
pt1 pt2
feedback-element shape-id
)
(sd-hide-feedback-elem feedback-element)
;; Label
(setf shape-name "LABEL")
(push shape-name feedback-elements-list)
(setf feedback-element (sd-create-feedback-elem :name shape-name
:serial my-serial2))
(sd-create-feedback-elem-label
pt1 (sd-vec-subtract pt2 pt1)
10.0
"Label"
feedback-element shape-id
)
(sd-hide-feedback-elem feedback-element)
))
;;---------------------------------
(show-feedback-shape (what)
(let (feedback-element)
(dolist (what feedback-elements-list)
(setf feedback-element (sd-find-named-feedback-elem what))
(sd-hide-feedback-elem feedback-element)
)
(setf feedback-element (sd-find-named-feedback-elem what))
(sd-show-feedback-elem feedback-element)
))
;;---------------------------------
(change-text ()
(let ((feedback-element (sd-find-named-feedback-elem NAME)))
(when feedback-element
(sd-set-feedback-elem-text feedback-element
10.0
TEXT
shape-id-text
))))
;;---------------------------------
(show-feedback (val)
(let ((feedback-element (sd-find-named-feedback-elem NAME))
(vp (sd-inq-current-vp))
)
(when feedback-element
(if val
(sd-show-feedback-elem feedback-element :vp vp)
(sd-hide-feedback-elem feedback-element :vp vp)
))))
;;---------------------------------
(move-feedback (&optional shape-id)
(let ((feedback-element (sd-find-named-feedback-elem NAME)))
(sd-move-feedback-elem feedback-element
10,0,0
:shape shape-id
)))
;;---------------------------------
;; scale by factor 2 around origin
(scale-feedback ()
(let ((feedback-element (sd-find-named-feedback-elem NAME)))
(sd-scale-feedback-elem feedback-element
2.0
0,0,0
)))
;;---------------------------------
(rotate-feedback ()
(let ((feedback-element (sd-find-named-feedback-elem NAME)))
(sd-rotate-feedback-elem feedback-element
1,0,0 ;x-axis
0,1,0 ;y-axis
10,10,10 ;rotation center
)))
;;---------------------------------
(change-name ()
(let ((feedback-element (sd-find-named-feedback-elem NAME))
(new-name "NewName")
)
(sd-set-feedback-elem-name feedback-element new-name)
(sd-call-cmds
(display (format nil "Found feedback element with new name: ~a"
(if (sd-find-named-feedback-elem new-name)
"yes" "no"))))
(sd-set-feedback-elem-name feedback-element NAME)
))
;;---------------------------------
(color-feedback ()
(let ((feedback-element (sd-find-named-feedback-elem NAME)))
(when feedback-element
(sd-set-feedback-elem-color feedback-element (sd-color-to-rgb COLOR))
)))
;;---------------------------------
(delete-feedback (what)
(let ((feedback-element (sd-find-named-feedback-elem what)))
(when feedback-element
(sd-delete-feedback-elem feedback-element)
)))
;;---------------------------------
(delete-all-feedback ()
(delete-feedback NAME)
(dolist (what feedback-elements-list)
(delete-feedback what)
))
;;---------------------------------
(delete-shape ()
(let ((feedback-element (sd-find-named-feedback-elem NAME)))
(when feedback-element
(sd-remove-from-feedback-elem feedback-element shape-id-arrow)
)))
) ;; local-functions
:cleanup-action
'(delete-all-feedback)
)
;;