;;--------------------------------------------------------------------------*
;;  Copyright 2003  DC4 Technisches Büro GmbH                               *
;;                                                                          *
;;--------------------------------------------------------------------------*
;;  Dateiname: bilanz.lsp
;;  Version  : 1.0
;;  Datum    : 20.10.2003
;;  Author   : Gt
;;--------------------------------------------------------------------------*
;; converted to ONE time call get_selection and X times count-if predicate
;;        by der_Wolfgang@forum@Cad.de  05.04.2022
;         used in 20.4.1 und Express 8.0
;;  translated : german/english by der_Wolfgang@forum@Cad.de  04.04.2022
;;--------------------------------------------------------------------------*

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

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

(sd-defdialog 'dc4-teile-bilanz-dialog-fast
:dialog-title '(sd-multi-lang-string "Count Objects" :german "Teile zählen")
;:mutual-exclusion '(instance contents)
:toolbox-button :force
:variables
  '(
    (bgr   :value-type :assembly
           :prompt-text (sd-multi-lang-string "specify assembly" :german "Baugruppe angeben")
           :title (sd-multi-lang-string "Assembly" :german "Baugruppe")
           :initial-value nil
           :after-input (after-bgr-action)
           :modifies nil
    )
    (contents :value-type :boolean
              :toggle-type :wide-toggle
              :title (sd-multi-lang-string "Reduce to Contents too" :german "Auch auf Inhalt reduzieren")
              :persistent-data-storage t
              :after-input (when bgr (after-bgr-action))
              )
    ("-")
    (which  :value-type :display-only
            :title ""
            :initial-value (format nil "~10,' D | ~10,' D"
                             (sd-multi-lang-string "Instance" :german "Exemplar")
                             (sd-multi-lang-string "Contents" :german "Inhalt")
                             )
    )
    (ubgr  :value-type :display-only
           :title (sd-multi-lang-string "Sub-Assembly" :german "Unterbaugr.")
    )
    (total :value-type :display-only
           :title (sd-multi-lang-string "Parts Total" :german "Teile")
    )
    (contains :title (sd-multi-lang-string "including" :german "davon"))
    (vteil :value-type :display-only
           :title (sd-multi-lang-string "Solid Parts" :german "Volumenteile")
    )
    (fteil :value-type :display-only
           :title (sd-multi-lang-string "Face Parts" :german "Flächenteile")
    )
    (dteil :value-type :display-only
           :title (sd-multi-lang-string "Wire Parts" :german "Drahtteile")
    )
    (eteil :value-type :display-only
           :title (sd-multi-lang-string "empty Parts" :german "leere Teile")
    )
    (cntteil :value-type :display-only
           :title (sd-multi-lang-string "Container" :german "Behälter")
    )
    (cntStFi :value-type :display-only
           :title (sd-multi-lang-string "   Stock Finish" :german "   Roh Fertig")
    )
    (lay   :value-type :display-only
           :title (sd-multi-lang-string "View Sets" :german "AnsSätze")
    )
   )
:local-functions
  '((after-bgr-action ()
     (let* ((all-obj (sd-call-cmds (get_selection :focus_type (list *sd-assembly-seltype*
                                                                    *sd-part-seltype*
                                                                    *sd-layout-seltype*)
                                                  :allow_wire_part :allow_face_part
                                                  :no_highlight
                                                  :WITH_STOCK_CONTAINER
                                                  ;:check_function #'(lambda (si)
                                                  ;                (if (sd-inq-stock-container-p si) :filter :ok))
                                                  :select :recursive :in_assembly bgr)))
            (all-obj-uniq)
        )
      (when contents
        (setq all-obj-uniq (remove-duplicates all-obj :test #'equal :key #'sd-inq-obj-contents-sysid))
        )

      (setq ubgr  (list (count-if #'sd-inq-assembly-p all-obj)   (count-if #'sd-inq-assembly-p all-obj-uniq)))
      (setq total (list (count-if #'sd-inq-part-p all-obj)       (count-if #'sd-inq-part-p all-obj-uniq)))
      (setq dteil (list (count-if #'sd-inq-wire-part-p all-obj)  (count-if #'sd-inq-wire-part-p all-obj-uniq)))
      (setq fteil (list (count-if #'sd-inq-face-part-p all-obj)  (count-if #'sd-inq-face-part-p all-obj-uniq)))
      (setq eteil (list (count-if #'sd-inq-empty-part-p all-obj) (count-if #'sd-inq-empty-part-p all-obj-uniq)))

      (setq vteil (format-numbers (list (- (car total) (car dteil) (car fteil) (car eteil))
                                        (- (cadr total)(cadr dteil)(cadr fteil)(cadr eteil))
                                        )))
      (setq ubgr  (format-numbers ubgr ))
      (setq total (format-numbers total))
      (setq dteil (format-numbers dteil))
      (setq fteil (format-numbers fteil))
      (setq eteil (format-numbers eteil))

      (setq cntteil (format-numbers (list (count-if #'sd-inq-container-p all-obj) (count-if #'sd-inq-container-p all-obj-uniq))))
      (setq cntStFi (format-numbers (list (count-if #'sd-inq-stock-container-p all-obj) (count-if #'sd-inq-stock-container-p all-obj-uniq))))
      (setq lay     (format-numbers (list (count-if #'sd-am-view-set-p all-obj)   (count-if #'sd-am-view-set-p all-obj-uniq))))
     );;let
    )
    (format-numbers (list-of-2)
      (format nil "~10,' D | ~10,' D" (car list-of-2) (if contents (cadr list-of-2) "-"))
      )
   )
)