;*********************************************************************************************
; Dateiname 		: 	AM_TeilemasseAufBlatt.lsp
; Autor         : 	unbekannt
; Erstellt      :		
; geändert    	:
;*********************************************************************************************
; Beschreibung	:		- Teilemaße (Oberfläche, Masse, Volumen, Dichte auf Zeichnung	
;										- Kann Teileigenschaften auslesen und als Text aufs Blatt bringen	
;										-	Texte werden nach Geometrieänderung aktualisiert!
;*********************************************************************************************
; ----------------------------------------------------------------------------------------
; ä Ì	   Ä Ø    ö Î    Ö Ú    ü Ï    Ü Û    ß Þ    ° ³	
; ----------------------------------------------------------------------------------------


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


(sd-defdialog 'AM_TeilemasseAufBlatt
		: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")
						);;range
			: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)
		(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-mark-prop-texts (&rest args)
	(let (update-mode anno-part)
		(setf update-mode (getf args :mode))
		(when (getf update-mode :drawing)
			(setf anno-part "")
		)
		(when (getf update-mode :sheet)
			(setf anno-part (sd-am-inq-name (getf update-mode :sheet)))
		)
		(when (getf update-mode :view-list)
			(setf anno-part (sd-am-inq-name (sd-am-view-struct-sheet (sd-am-inq-view (first (getf update-mode :view-list))))))
		)
		(sd-execute-annotator-command :cmd (format nil "St_mark_prop_texts_macro '/~a'" anno-part))
	)
)
(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-execute-annotator-command :cmd "St_highlight_unrelated_prop_texts_macro")
)
(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-item wert part)
		(setf part (sd-inq-parent-obj (sd-inq-parent-obj (getf args :v3d))))
		; (pprint `("part: " ,part))
		(setf textlist (sd-call-cmds (get_selection 
				:focus_type *sd-anno-text-seltype*
				:select :docu_text :by_drawing_docu_rest ;:by_sheet_docu_rest (sd-am-view-struct-sheet (sd-am-inq-view (getf args :v2d)))
				:check_function 
					#'(lambda (text-item) 
						(if (sd-am-inq-info-attributes text-item)
							:ok
							:filter
						)
					)
			))
		)
		; (pprint `("textlist: " ,textlist))
		(dolist (text-item textlist)
			(let (text-infos info text-is-old text-is-son prop-type)
				(setf text-infos (sd-am-inq-info-attributes text-item))
				; (pprint text-infos)
				(dolist (info text-infos)
					; (pprint info)
					(when (sd-string= info "ST-PART-PROP-NOT-UPTODATE")
						(setf text-is-old t)
						; (pprint "text-is-old")
					)
					(when (format nil "ST-PART-PROP-PART: ~a" (sd-inq-obj-sysid part))
						(setf text-is-son t)
						; (pprint "text-is-son")
					)
					(when (sd-string-match-pattern-p "ST-PART-PROP: *" info)
						(setf prop-type (st-prop-type-string-to-keyword (sd-string-replace info "ST-PART-PROP: " "")))
						; (pprint "prop-type")
					)
				)
				; (pprint `("text-is-old: " ,text-is-old "text-is-son: " ,text-is-son "prop-type: " ,prop-type))
				(when (and text-is-old text-is-son)
					(setf wert (st-get-prop-string part prop-type))
					(pprint `("wert: " ,wert))
					(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 (list "in st-mark-prop-texts" (sd-call-action-active-p))) 
		(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                                                          *
;;***************************************************************************

(sd-execute-annotator-command :cmd 
 (format nil "~a ~a ~a ~a ~a ~a ~a ~a ~a ~a"
"DEFINE St_mark_prop_texts_macro"
"PARAMETER Blattname"
"LOCAL Pid"
	"INQ_ENV 0"
	"LET Pid ('~'+(INQ 302))"
	"EDIT_PART Blattname"
	"CHANGE_ELEM_INFO 'ST-PART-PROP-NOT-UPTODATE' '' SELECT GLOBAL INFOS 'ST-PART-PROP-NOT-UPTODATE' CONFIRM END"
	"ADD_ELEM_INFO 'ST-PART-PROP-NOT-UPTODATE' SELECT SUBTREE INFOS 'ST-PART-PROP: *' CONFIRM END"
	"EDIT_PART Pid"
"END_DEFINE"
 )
)

(sd-execute-annotator-command :cmd 
 (format nil "~a ~a ~a ~a"
"DEFINE St_highlight_unrelated_prop_texts_macro"
	"CHANGE_COLOR RED SELECT GLOBAL INFOS 'ST-PART-PROP-NOT-UPTODATE' CONFIRM END"
	"CHANGE_ELEM_INFO 'ST-PART-PROP*' '' SELECT GLOBAL INFOS 'ST-PART-PROP-NOT-UPTODATE' CONFIRM END"
"END_DEFINE"
 )
)


(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"
 )
)