(in-package :custom)
(use-package :oli)


;; --- Subdialog part selection by matching part color ---

(sd-defdialog 'select-by-color-subdialog
 :dialog-type :subaction
 :dialog-title "Color select"
 :variables '(
  (part-assembly
   :title "Part/Assembly"
   :value-type :part-assembly
   :multiple-items t
   :modifies nil
   :initial-value	(sd-pathname-to-obj "/")
   :prompt-text "Select part or assembly")

  (color 
   :title "Color"
   :value-type :rgb-color)

  (kind 
   :persistent-data-storage t
   :range ((:realized :label "As created")
           (:contents :label "Contents")
           (:instance :label "Instance")))

  (selection
   :value-type :list
   :initial-visible nil)

  (select-button
   :title "Select"
   :toggle-type :wide-toggle
   :push-action (let ((matching-parts (select-by-color-fnc part-assembly color kind)))
                 (if matching-parts
                  (progn
                   (setq selection matching-parts)
                   (sd-accept-dialog))
                  (sd-display-message "No matching parts found.")))))

 :ok-action
  'selection)



(defun select-by-color-fnc (part-assembly color kind)
 (let (
  (all-matching-parts (list))
  (all-childs (list)))

   (dolist (pa part-assembly)
    (push (inq-obj-tree-list pa) all-childs))

   (dolist (chld all-childs)
    (dolist (obj chld)
     (when (sd-inq-part-p obj)
      (let ((part-color (sd-inq-part-color obj kind)))
       (when (and part-color (equal (sd-rgb-to-color part-color) color))
        (push obj all-matching-parts))))))

   all-matching-parts))



(defun inq-obj-tree-list (obj)
	(cons obj
		(apply #'nconc
			(mapcar #'inq-obj-tree-list
				(sd-inq-obj-children obj)))))



;; --- Examples how to use color selection subdialog. ---
    
(sd-defdialog 'list-coloured-parts
 :dialog-title "List coloured parts"
 :toolbox-button t
 :variables '(
  (matching-parts 
   :value-type :list
   :title "Selection"
   :subaction-name select-by-color-subdialog
   :default matching-parts
   :after-input (dolist (prt matching-parts)
                 (display (format nil "~a" (sd-inq-obj-basename prt)))))))



(sd-defdialog 'change-part-color
 :dialog-title "Change part color"
 :toolbox-button t
 :variables '(
  (matching-parts 
   :value-type :list
   :title "Selection"
   :subaction-name select-by-color-subdialog
   :default matching-parts)

  (new-color 
   :title "New color"
   :value-type :rgb-color)

  (kind1 
   :persistent-data-storage t
   :range ((:contents :label "Contents")
           (:instance :label "Instance")))

  (change-color-button
   :title "Change color"
   :toggle-type :wide-toggle
   :push-action (dolist (prt matching-parts)
                 (when (equal kind1 :contents)
                  (if (sd-inq-obj-contents-read-only-p prt)
                   (display (format nil "Read only part skipped: ~a" (sd-inq-obj-pathname prt)))
                   (sd-call-cmds (set_part_base_color :parts prt :color new-color))))
                 (when (equal kind1 :instance)
                  (if (sd-inq-obj-instance-read-only-p prt)
                   (display (format nil "Read only part skipped: ~a" (sd-inq-obj-pathname prt)))
                   (sd-call-cmds (set_part_inst_color :parts prt :color new-color))))))))



(sd-defdialog 'vp-drawlist-color-control
 :dialog-title "VP drawlist color control"
 :toolbox-button t
 :precondition '(progn (setq *vp-obj* (sd-inq-vp-drawlist-objects (sd-inq-current-vp))) :ok)
 :variables '(
 
  (matching-parts 
   :value-type :list
   :title "Selection"
   :subaction-name select-by-color-subdialog
   :default matching-parts)

  (show-btn
   :title "Show"
   :toggle-type :wide-toggle
   :push-action (sd-call-cmds 
                 (add_to_vp_drawlist (sd-inq-current-vp) :with-wp matching-parts)))

  (hide-btn
   :title "Hide"
   :toggle-type :wide-toggle
   :push-action (sd-call-cmds 
                 (remove_from_vp_drawlist (sd-inq-current-vp) :with-wp matching-parts)))

  (restore-btn
   :title "Restore drawlist"
   :toggle-type :wide-toggle
   :push-action (progn 
                 (sd-call-cmds 
                  (clear_vp (sd-inq-current-vp)))
                 (sd-call-cmds 
                  (add_to_vp_drawlist (sd-inq-current-vp) :with-wp *vp-obj*))))))