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

;;----------------------------------------------------------------------------------------------*
;;Teilemaße (Oberfläche, Masse, Volumen, Dichte auf Zeichnung
;;----------------------------------------------------------------------------------------------*

(sd-defdialog 'st-teilemasse-dialog
	:module "ANNOTATION"
   	:dialog-title "Teilemaße f. Zeichnung" 
   	:variables 
   	'(
	  (ANS_TEIL 		
		    :selection *sd-anno-view-seltype*
			:multiple-items nil
			:modifies nil		
			:initial-value nil
			:title "Ansicht"
			:prompt-text "Ansicht des Teils auswählen, dessen Geometrie-Daten ermittelt werden sollen."
			:next-variable 'Txt_pos
	  )
	  (Besitzer
			:value-type :string
			:initial-value "Blatt aktuell"
			:initial-enable nil
	  )
	  (PROP_Type
			:title "Typ"
			:range ((:area :label "Oberfläche")
					(:mass :label "Masse")
					(:volume :label "Volumen")
					(:density :label "Dichte"))
			:next-variable 'Txt_pos
	  )
	  (Txt_pos
			:value-type :docupntcnp
			:title "Position Hinweis-Text"
			:initial-visible nil
			:before-input (start-txt)
			:after-input (pos-txt)
			:next-variable 'Txt_pos
	  )
	  (Txt 
			:value-type :string
			:title "Text"
			:initial-enable nil
			:initial-value nil
	  )
    ) ;; ende Variablen
   	:local-functions 
   	'(
		(start-txt ()
			(setf Txt (st-get-prop-string (sd-am-view-set-struct-owner (sd-am-inq-view-set (sd-am-view-struct-view-set (sd-am-inq-view ANS_TEIL)))) PROP_Type)) 
			(sd-execute-annotator-command :cmd (format nil "ST_start_text_feedback"))
			(sd-execute-annotator-command :cmd (format nil "ST_text_feedback '~a'" Txt))
		) ;; ende start-txt
		(pos-txt ()
		  (let (part-sysid)
			(sd-execute-annotator-command :cmd "CANCEL")
			(setf part-sysid (sd-inq-obj-sysid (sd-am-view-set-struct-owner (sd-am-inq-view-set (sd-am-view-struct-view-set (sd-am-inq-view ANS_TEIL))))))
			(sd-am-add-curr-info-attributes (list (format nil "ST-PART-PROP: ~a" PROP_Type) (format nil "ST-PART-PROP-PART: ~a" part-sysid)))
			(sd-am-create-text
				:text Txt
				:owner_type :current-sheet
				:position Txt_pos
			)
			(sd-am-change-curr-info-attribute (format nil "ST-PART-PROP: ~a" PROP_Type) "")
			(sd-am-change-curr-info-attribute (format nil "ST-PART-PROP-PART: ~a" part-sysid) "")
			(setf Txt_pos nil)
		  )
		) ;; ende pos-txt
		(clean-action ()
			(let ()
				(sd-execute-annotator-command :cmd "CANCEL")
				(sd-enable-must-variable-check)
			)
		)
   	) ;; ende local-functions
	:ok-action 
	'(clean-action)		
	:cleanup-action
	'(clean-action)		
);;ende st-teilemasse-dialog

(defun st-get-prop-string (part prop-type)
	(let (wert wert)
		(setf wert (sd-call-cmds (get_vol_prop :for_part :part part prop-type)))
		(cond
			((equal prop-type :area)
				(setf wert (format nil "Oberfläche: ~a dm²" (sd-num-to-string (/ wert 10000) 3)))
			)
			((equal prop-type :mass)
				(setf wert (format nil "Masse: ~a kg" (sd-num-to-string (/ wert 1000) 3)))
			)
			((equal prop-type :volume)
				(setf wert (format nil "Volumen: ~a dm³" (sd-num-to-string (/ wert 1000000) 3)))
			)
			((equal prop-type :density)
				(setf wert (format nil "Dichte: ~a kg/dm³" (sd-num-to-string (/ wert 1000) 3)))
			)
		); cond
		wert
	); let
) ;; st-get-prop-string


;;***************************************************************************
;;    EVENT-Registrierung und zugeh. Funktionen                                                   *
;;***************************************************************************

(sd-unsubscribe-event "DOCU-PRE-UPDATE-ALL-EVENT" 'st-mark-prop-texts)

(defun st-check-is-prop-text (item)
	(pprint item)
	(if (find "ST-PART-PROP: " (sd-am-inq-info-attributes item) :test #'sd-string-match-pattern-p) 
		:ok 
		:filter
	)
)

(defun st-mark-prop-texts (&rest args)
	(let (text-item textlist)
		;(pprint (getf args :mode))
		(setf textlist (sd-call-cmds
			(get_selection 
				:focus_type *sd-anno-text-seltype*
				:select :by_sheet_docu_rest (sd-am-inq-curr-sheet)
				:check_function #'st-check-is-prop-text
			))
		)
		; (pprint textlist)
		(dolist (text-item textlist)
			(sd-am-add-info-attributes (list "ST-PART-PROP-NOT-UPTODATE") text-item)
		)
		; (pprint (list "in st-mark-prop-texts" (sd-call-action-active-p)))
		; (pprint "Ende DOCU-PRE-UPDATE-ALL-EVENT")
	)
)

(sd-subscribe-event "DOCU-PRE-UPDATE-ALL-EVENT" 'st-mark-prop-texts)

(sd-unsubscribe-event "DOCU-POST-UPDATE-ALL-EVENT" 'st-highlight-unrelated-prop-texts)

(defun st-highlight-unrelated-prop-texts (&rest args)
	(sd-call-cmds (AM_TEXT_MODIFY :sel_list
		(get_selection 
			:focus_type *sd-anno-text-seltype* 
			:check_function #'(lambda (text-item) (if (find "ST-PART-PROP-NOT-UPTODATE" (sd-am-inq-info-attributes text-item) :test #'sd-string=) :ok :filter))
			:select :docu_text :by_sheet_docu_rest (sd-am-inq-curr-sheet)
		)
		:color 16711680)
	)
	(pprint "Ende DOCU-POST-UPDATE-ALL-EVENT")
)

;(sd-subscribe-event "DOCU-POST-UPDATE-ALL-EVENT" 'st-highlight-unrelated-prop-texts)

(sd-unsubscribe-event "DOCU-POST-UPDATE-VIEW-EVENT" 'st-update-prop-texts)

(defun st-update-prop-texts (&rest args)
	(let (textlist text wert part)
		(setf part (sd-inq-parent-obj (sd-inq-parent-obj (getf args :v3d))))
		(setf textlist (sd-call-cmds 
			(get_selection 
				:focus_type *sd-anno-text-seltype* 
				:check_function 
					#'(lambda (text-item) 
						(if (and
								(find "ST-PART-PROP-NOT-UPTODATE" (sd-am-inq-info-attributes text-item) :test #'sd-string=)
								(find (format nil "ST-PART-PROP-PART: ~a" (sd-inq-obj-sysid part)) (sd-am-inq-info-attributes text-item) :test #'sd-string=)
							)
							:ok 
							:filter
						)
					)
				:select :docu_text :by_sheet_docu_rest (sd-am-inq-curr-sheet)
			)
		))
		(dolist (text-item textlist)
			(setf prop-type (st-prop-type-string-to-keyword (sd-string-replace (find "ST-PART-PROP: " (sd-am-inq-info-attributes text-item) :test #'sd-string-match-pattern-p) "ST-PART-PROP: " "")))
			(setf wert (st-get-prop-string part text-item))
			(when wert
				(sd-call-cmds (AM_MOD_TEXT_EDIT :sel_text text-item wert))
				(sd-am-change-info-attribute "ST-PART-PROP-NOT-UPTODATE" "" text-item)
			)
		)
		(pprint "Ende DOCU-POST-UPDATE-VIEW-EVENT")
	)
)

;(sd-subscribe-event "DOCU-POST-UPDATE-VIEW-EVENT" 'st-update-prop-texts)

(defun st-prop-type-string-to-keyword (prop-string)
	(cond
		((sd-string= (sd-string-downcase prop-string) "area") :area)
		((sd-string= (sd-string-downcase prop-string) "mass") :mass)
		((sd-string= (sd-string-downcase prop-string) "volume") :volume)
		((sd-string= (sd-string-downcase prop-string) "density") :density)
	)
)

;;***************************************************************************
;;     ME10-Makros       Allgemein verwendbar                                                   *
;;***************************************************************************

(sd-execute-annotator-command :cmd
 (format nil "~a ~a ~a "
   "DEFINE ST_start_text_feedback"
     "TEXT ASSIST"
   "END_DEFINE"
 )
)

(sd-execute-annotator-command :cmd
 (format nil "~a ~a ~a ~a "
   "DEFINE ST_text_feedback"
     "PARAMETER Txt"
     "Txt"
   "END_DEFINE"
 )
)