;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;	  Titel: 		Teilepositionen einer Konfiguration in eine andere Konfiguration übernehmen
;
;	Erklärung:		Konfiguration auswaehlen, und deren Positionsdaten in eine andere Konfiguration mit übernehmen
;
;
;  	  Autor:	  	Ulrich Wiedemann
;	Erstellt: 		24.10.2007
;	Version:		1.0
;
;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(in-package :stiwa-tools)
(use-package :OLI)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(
sd-defdialog 'Konfigurationen_Verschmelzen
:dialog-title "Konfigurationsverschmelzung"
:variables
'(	(conf_org	:selection 	(*sd-configuration-seltype*)
			:title	"Kopie von"
			:prompt-text "Ursprungskonfiguration für Positionsuebernahme auswaehlen")
	(conf		:selection 	(*sd-configuration-seltype*)
			:title	"Kopie nach"
			:prompt-text "Zielkonfiguration für Positionsuebernahme auswaehlen")
)
:local-functions
'(
	(Variablen ()
		(setf partsinconf_org (list 1))
		(setf partsinconf (list 1))

		(setf my-conf_org (sd-inq-configuration-props conf_org))
		(setf my-conf_org_pos (getf my-conf_org :Positions))

		(setf my-conf (sd-inq-configuration-props conf))
		(setf my-conf_pos (getf my-conf :Positions))
	);;Variablen

	(Schnittmengenbildung ()
		(dolist (pos my-conf_org_pos) (nconc partsinconf_org (list (SD-INQ-OBJ-SYSID (first pos)))))
		(pop partsinconf_org)

		(dolist (pos my-conf_pos) (nconc partsinconf (list (SD-INQ-OBJ-SYSID (first pos)))))
		(pop partsinconf)

		(setf schnittmenge (intersection partsinconf partsinconf_org :test #'sd-string=))
	);;Schnittmengenbildung


	(Poslistenmanipulation ()
		(dolist (pos my-conf_pos)
			(when (not (eql (member (SD-INQ-OBJ-SYSID (first pos)) schnittmenge :test #'sd-string=) NIL))
				(setf my-conf_pos (delete pos my-conf_pos))))
	);;Poslistenmanipulation


	(Positionierung ()
		(setf new-conf_pos (nconc my-conf_pos my-conf_org_pos))
		(sd-create-configuration :Owner (getf my-conf :Owner)
                            :mode (getf my-conf :mode)
                            :attachment (getf my-conf :attachment)
                            :name (getf my-conf :name)
                            :name-conflict :delete-old
                            :Positions new-conf_pos
                            :drawlist (getf my-conf :drawlist)
                            :camera (getf my-conf :camera)
            );;sd-create-configuration
	);;Positionierung

	(Hilfe ()
		(display :clear)
		(display (format nil "Konfigurationsverschmelzung~%~%~a~%~a"
					"Die Positionen der unter 'Kopie von' angegebenen Konfiguration werden auf die unter 'Kopie nach' angegebene Konfiguration kopiert, etwaige doppelte Positionen werden überschrieben."
					"Name, Kamera und Darstellungsliste der Zielkonfiguration werden beibehalten."))
		(display :show)
	);Hilfe
)
:ok-action
	'(progn (Variablen) (Schnittmengenbildung) (Poslistenmanipulation) (Positionierung))
:help-action
	'(Hilfe)
);sd-defdialog