;;--------------------------------------------------------------------------*
;;  Copyright 2006  DC4 Technisches Büro GmbH                               *
;;                                                                          *
;;--------------------------------------------------------------------------*

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

;;--------------------------------------------------------------------------*

(sd-defdialog 'dc4-teil-vervielfaeltigen-dialog
:dialog-title "Vervielfaeltigen 2 Punkte"
:variables
  '(
    ;;local
    (back-states :initial-value nil)
    ;;dialog
    (teil  :selection
              (*sd-object-seltype*)
           :multiple-items t
           :show-select-menu t
           :prompt-text "Teile oder Baugruppen angeben"
           :title "Teile"
           ;;:initial-value nil
           :next-variable (if (not startp) 'startp 'zielp)
           :after-input (after-teil-action)
    )
    (bgr   :value-type :assembly
           :prompt-text "Besitzer-Baugruppe angeben"
           :title "Besitzer"
           :next-variable (if (not teil) 'teil (if (not startp) 'startp 'zielp))
    )
    (startp :value-type :point-3d
           :title "Startpunkt"
           :prompt-text "Startpunkt fuer Vervielfaeltigung angeben"
           :next-variable (if (not teil) 'teil 'zielp)
    )
    (zielp :value-type :point-3d
           :multiple-items t
           :show-select-menu t
           :prompt-text "Zielpunkt angeben"
           :title "Zielpunkt"
           ;;:initial-value nil
           :next-variable (if (not teil) 'teil (if (not startp) 'startp 'zielp))
           :after-input (next-action)
    )
    (share :value-type :grouped-boolean
           :title "Exemplar"
           :initial-value t
    )
    (copy  :value-type :grouped-boolean
           :title "Kopie 1 Eb."
           :initial-value nil
    )
    (back  :title "Zurueck"
           :push-action (back-action)
    )
   )
:mutual-exclusion '((copy share))
:local-functions
  '(
    (after-teil-action ()
     (let ()
      (sd-set-variable-status 'bgr :value (sd-inq-parent-obj (first teil)))
     );;let
    )
    (next-action ()
     (let (et)
      (if (and teil bgr startp)
       (progn
        ;; remember current model state:
        (push (sd-set-model-checkpoint) back-states)
        (if share
         (progn
          (dolist (et teil)
           (sd-call-cmds (create_multiple_pa :share
                         :owner (sd-inq-obj-pathname bgr)
                         :source (sd-inq-obj-pathname et)
                         :keep_attr :on
                         :translate :two_ptv  startp zielp
                         :next)
           )
          );;dolist
         );;progn
         (progn
          (dolist (et teil)
           (sd-call-cmds (create_multiple_pa :copy :onelevel :on
                         :owner (sd-inq-obj-pathname bgr)
                         :source (sd-inq-obj-pathname et)
                         :translate :two_ptv  startp zielp
                         :next)
           )
          );;dolist
         );;progn
        );;if
        (setf zielp nil)
        (when back-states (sd-set-variable-status 'back :enable t))
       );;progn
       (progn
        (sd-display-error "Zielpunkt zuletzt angeben!")
        (setf zielp nil)
       );;progn
      );;if
     );;let
    )
    (back-action ()
     (let ()
      (when back-states
       (progn
        (sd-return-to-model-checkpoint (pop back-states))
        (unless back-states (sd-set-variable-status 'back :enable nil))
       );;progn
      );;when
     );;let
    )
   )
:ok-action
   '()
:help-action '()
)

;;--------------------------------------------------------------------------*