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

(sd-defdialog 'st-konfig-teilepos
  :dialog-title "Teileposition übernehmen"
  :variables 
  '(
	 (configs
	   :title "Konfig"
       :selection *sd-configuration-seltype*
	   :next-variable 'von_Teil
	   :multiple-items t
     )
	 (von_Teil
	   :title "Kopie von"
	   :selection *sd-object-seltype*
	   :next-variable 'nach_Teil
	 )
	 (nach_Teil
	   :title "Kopie nach"
	   :selection *sd-object-seltype*
	 )
   );variables
  :local-functions
  '(
	(kopiere_teilepos ()
	  (let (conf conf-props conf-items new-part-pos part-pos-list new-conf-items)
		(dolist (conf configs)
			(setf new-part-pos nil)
			(setf new-conf-items nil)
			(setf conf-props (sd-inq-configuration-props conf))
			(setf conf-mode (getf conf-props :mode))
			(sd-call-cmds (cfn_modify_configuration :config conf :new_pos_mode :absolute))
			(setf conf-props (sd-inq-configuration-props conf))
			(setf conf-items (getf conf-props :positions))
			(pprint (list "conf-items" conf-items))
			(dolist (part-pos-list conf-items)
				(when (equal von_Teil (first part-pos-list))
					(setf new-part-pos (second part-pos-list))
				)
				(unless (equal nach_Teil (first part-pos-list))
					(setf new-conf-items (append new-conf-items (list part-pos-list)))
					(pprint (list "Teil unverändert hinzugefügt:" (sd-inq-obj-pathname (first part-pos-list))))
				)
			); dolist
			(when new-part-pos
				(setf new-conf-items (append new-conf-items (list (list nach_Teil new-part-pos))))
				(pprint "neuer Teil hinzugefügt")
			)
			; (loop
				; (pprint (list "conf-items" conf-items))
				; (when (equal conf-items nil)
					; (pprint "Liste leer -> Schleife verlassen")
					; (return)
				; )
				; (setf part-pos-list (pop conf-items))
				; (when (equal von_Teil (first part-pos-list))
					; (setf new-part-pos (second part-pos-list))
				; )
				; (unless (equal nach_Teil (first part-pos-list))
					; (setf new-conf-items (append new-conf-items (list part-pos-list)))
					; (pprint "Teil unverändert hinzugefügt")
				; )
				; (when new-part-pos
					; (setf new-conf-items (append new-conf-items (list (list nach_Teil new-part-pos))))
					; (pprint "neuer Teil hinzugefügt")
				; )
			; ); loop


			(pprint (list "new-part-pos" new-part-pos))
			(pprint (list "new-conf-items" new-conf-items))
			(when new-part-pos
				(sd-create-configuration :owner (getf conf-props :owner)
									:mode :absolute
									:attachment (getf conf-props :attachment)
									:name (getf conf-props :name)
									:name-conflict :delete-old
									:positions new-conf-items
									:drawlist (getf conf-props :drawlist)
									:camera (getf conf-props :camera)
				);;sd-create-configuration
				(display (format nil "Teileposition wurde in Konfiguration ~a gespeichert" (getf conf-props :name)))
			); when
			(when (equal conf-mode :relative)
				(sd-call-cmds (cfn_modify_configuration :config conf :new_pos_mode :relative))
			)
		); dolist
	  ); let
	);;Positionierung

	(Hilfe ()
		(display :clear)
		(display (format nil "Konfigurationsposition eines Teils an einen anderen Teil übergeben~%~%~a~%~a"
					"Die Positionen des unter 'Kopie von' angegebenen Teils wird auf die unter 'Kopie nach' angegebenen Teile/Baugruppenin in den gewählten Konfigurationen kopiert."
					"Name, Kamera und Darstellungsliste der Konfiguration werden nicht verändert."))
		(display :show)
	);Hilfe
  );local-functions
  :cancel-action
	  '(progn
	   );progn

  :ok-action
	  '(progn
			(kopiere_teilepos)
	   );progn  

);dialog