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

(sd-defdialog 'mip_splines_farbe
  :dialog-title "Splines Faerben"
  :toolbox-button t
  :taskBarPage nil
  :after-initialization '(progn
  
    (sd-disable-must-variable-check)
    
    (setf farben (make-array 12))
    
    (setf (aref farben 0) 1,0,0)
    (setf (aref farben 1) 0,1,0)
    (setf (aref farben 2) 0,0,1)
    (setf (aref farben 3) 1,1,0)
    (setf (aref farben 4) 0,1,1)
    (setf (aref farben 5) 1,1,1)
    (setf (aref farben 6) 1,0,1)
    (setf (aref farben 7) 0.4,0.3,0.6)
    (setf (aref farben 8) 0.8,1,0.2)
    (setf (aref farben 9) 0.1,0.4,0.5)
    (setf (aref farben 10) 0.6,0.9,0.1)
    (setf (aref farben 11) 1,0.3,0.3)
  
  )
  :variables '(
  
   (farben)
   (BAUGRUPPE :value-type :assembly
              :title "Baugruppe"
              :prompt-text "Baugruppe mit Splines selektieren"
              :initial-value nil
              :after-input (block blk1
              
               (let (i j splines kanten list1 name1 tmp1 pos1 color1)
                
               (setf splines (sd-call-cmds (get_selection :NO_HIGHLIGHT :ALLOW_WIRE_PART :focus_type *sd-part-seltype* :select :in_assembly BAUGRUPPE) :failure ()))
               (if (not splines)
                 (progn
                   (sd-display-message "In der Baugruppe keine Drahtteile vorhanden !")
                   (setf BAUGRUPPE nil)
                   (return-from blk1)
                 )
               )
               
               (if (> (length splines) 12)
                 (progn
                   (sd-display-message "In dieser Version hat der Farben-Array nur 12 Werte ! Bitte anpasssen !")
                   (setf BAUGRUPPE nil)
                   (return-from blk1)
                 )
               )
               
               (setf list1 '())
               
               (dolist (i splines)
                  (setf tmp1 (sd-string-split (sd-inq-obj-basename i) "_"))
                  (pop tmp1)
                  (setf name1 "")
                  (dolist (j tmp1)
                    (setf name1 (format nil "~a_~a" name1 j))
                  )
                  (setf pos1 (position name1 list1  :test #'string-equal :key  #'car))
                  (if (not pos1)
                    (progn
                      (setf color1 (aref farben (length list1)))
                      (push (list name1 color1) list1)
                    )
                    ;else
                    (setf color1 (nth 1 (nth pos1 list1)))
                  )

                  (setf kanten (sd-call-cmds (get_selection :NO_HIGHLIGHT :focus_type *sd-edge-3d-seltype* :select :in_part i) :failure ()))
                  (sd-call-cmds (set_edge_color kanten :rgb color1))
               )
               
               ;(setf BAUGRUPPE nil)  ; naechste Baugruppe selektieren lassen !
               
              ))
   
   )
  
  )
)