;*********************************************************************************************
; Dateiname 		: 	SD_ShowNeighborhood.lsp
; Autor         : 	Stefan Freitag (CoCreate Company)
; Modifiziert		:		Stephan Wörz
; Erstellt      :		2006
; geändert    	:
;*********************************************************************************************
; Description		:  Display neighborhood: Add parts to drawlist
;               	 if they are within a certain distance around
;               	 the object selected. Create configuration
;
;	Optionen			:		-		
;										-		
;										-		
;*********************************************************************************************
; ----------------------------------------------------------------------------------------
; ä Ì	   Ä Ø    ö Î    Ö Ú    ü Ï    Ü Û    ß Þ    ° ³	 µ ó
; ----------------------------------------------------------------------------------------

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

;(sd-hide-console-window)                  
;(sd-show-console-window)                 
;(setf si::*enter-break-handler* t)     

(in-package  :stefans-configurations)
(use-package :oli)

(sd-defdialog 'SD_ShowNeighborhood
	:dialog-title "Nachbarschaft anzeigen"
	:mutual-exclusion '(
				(LOCAL GLOBAL)
				(INSIDE OUTSIDE)
			   )
	:variables
	'(
	  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
	  ;; unsichtbare Variablen
	  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

    (allObjects 	    	:initial-value nil)
    (parent	    				:initial-value nil)
	  (viewport 	    		:initial-value nil)
	  (centerbox 	    		:initial-value nil)
	  (centerboxcenterx 	:initial-value nil)
	  (centerboxcentery 	:initial-value nil)
	  (centerboxcenterz 	:initial-value nil)
	  (feedback						:initial-value nil)

	  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
	  ;; LOCAL bedeudet: die Nachbarschaft bezieht sich nur auf andere Teile derselben Baugruppe
	  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

	  (LOCAL
	  :value-type		:grouped-boolean
	  :title 		"In Baugruppe"
	  )

	  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
	  ;; GLOBAL bedeutet: die Nachbarschaft bezieht sich auf alle geladenen Teile
	  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

       	  (GLOBAL
	  :value-type 		:grouped-boolean
	  :title 		"Global"
	  )

	  ("-")

	  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
	  ;; Das Teil im Zentrum wird selektiert
	  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
	
	  (CENTERPART
	  :title 		"Teil im Zentrum"
    :prompt-text 		"Selektieren Sie das Teil, für welches Sie die Nachbarschaft bestimmen möchten"
	  :value-type 		:part
	  :multiple-items 	nil
	  :modifies		:contents
	  :after-input		(show-feedback)
	  :next-variable	CENTERPART
	  )

	  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
	  ;; Der maximale Abstand wird angegeben
	  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
	
	  (MAX_DISTANCE
	  :title 					"Maximaler Abstand"
    :prompt-text 		"Geben Sie den maximalen Abstand vom Bauteil an [mm]"
	  :value-type 		:distance
	  :after-input		(show-feedback)
	  :next-variable	CENTERPART
	  )

	  ("Nur solche Teile zeigen, die...")

	  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
	  ;; INSIDE bedeutet, daß Teile innerhalb des maximalen Abstandes dargestellt werden sollen
	  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

	  (INSIDE
	  :value-type 		:grouped-boolean
	  :title 		"Im Bereich"
	  )

	  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
	  ;; OUTSIDE bedeutet, daß Teile ausserhalb des maximalen Abstandes dargestellt werden sollen
	  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

    (OUTSIDE
	  :value-type 		:grouped-boolean
	  :title 		"Ausserhalb"
	  )


         )
	:prompt-text "Selektieren Sie das zentrale Bauteile und geben Sie den maximalen Abstand ein"
	:cancel-action
	'(progn
	  (remove-feedback)
	 )
	:ok-action 
	'(progn

	  (remove-feedback)

	  ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
	  ;; wir suchen die Baugruppe oberhalb der benachbarten Teil. Das ist der "parent"
	  ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

	  (set-parent)

	  ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
	  ;; Alle Teile unterhalb des "parents" werden in einer Liste aufgesammelt
	  ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

	  (collect-all-objects-below-parent)

	  ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
	  ;; Für alle Teile wird die Sichtbarkeit berechnet
	  ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

	  (set-drawlist-accordingly)

	  ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
	  ;; Der aktuelle Zustand der Strukturliste wird als Konfiguration abgelegt
	  ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

	  (create-configuration-with-current-drawlist)

         ) ;; progn

	:local-functions
	'(
		;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
		;; Die Sichtbarkeitsberechnung
		;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

		(set-drawlist-accordingly ()

			(setf viewport (sd-inq-current-vp))

			;; Haben wir ein Teil und ist ein Darstellungsfenster geöffnet?
			(when (and CENTERPART viewport)
				(let (
					(box			nil)
					(max_distance_square	(* MAX_DISTANCE MAX_DISTANCE))
					(visibles		nil)
				     )

					(dolist (some-part allobjects)

					  (when (sd-inq-part-p some-part)
					    (setf box (sd-inq-obj-box some-part :mode :graphical) )
					    
					    ;; Ist die Hülle verfügbar? Vielleicht ist das Teil ja leer...
					    (when (should-be-visible box max_distance_square)
					      (push some-part visibles)
					      ) ;; when
					    ) ;; when
					  ) ;; dolist

				(set_vp_drawlist viewport visibles)

				) ;; let
			) ;; when
		)

		;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
		;; Sichtbarkeittest in Abhängigkeit von INSIDE
		;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

		(should-be-visible (box max_distance_square)
			(if (and box (first box))
			    (if INSIDE
				(< (calculate-square-distance-to-part-selected box) max_distance_square)
			      (> (calculate-square-distance-to-part-selected box) max_distance_square)
			      )
			  nil
			 ) ;; if
	        )

		;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
		;; Abstandsberechnung zwischen der Hülle des zentralen Teiles und der übergebenen Hülle
		;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
		
		(calculate-square-distance-to-part-selected (other-box)

			(setf first-other-box  (first  other-box))
			(setf second-other-box (second other-box))

			(setf centerx  (/ (+  (gpnt3d_x first-other-box) (gpnt3d_x second-other-box))  2)   )
			(setf centery  (/ (+  (gpnt3d_y first-other-box) (gpnt3d_y second-other-box))  2)   )
			(setf centerz  (/ (+  (gpnt3d_z first-other-box) (gpnt3d_z second-other-box))  2)   )

			(setf diffx (- centerx centerboxcenterx))
			(setf diffy (- centery centerboxcentery))
			(setf diffz (- centerz centerboxcenterz))

			(+  (* diffx diffx) (* diffy diffy) (* diffz diffz))
		)

		;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
		;; Eine neue Konfiguration mit der Inhalt der gegenwaertigen Darstellungsliste wird angelegt.
		;; Diese darf nicht direkt unter der Wurzel liegen
		;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

		(create-configuration-with-current-drawlist ()
			(setf parent-id (sd-inq-obj-contents-sysid parent))
			(when parent-id
	   			(unless (equal parent-id (sd-inq-obj-contents-sysid (sd-pathname-to-obj "/")))
	    				(progn
					   (if INSIDE
						   (setf name (format nil "Neigbourhood_inside_range_~S" MAX_DISTANCE))
						   (setf name (format nil "Neigbourhood_outside_range_~S" MAX_DISTANCE))
					   )
				   	   (sd-call-cmds (CFN_CREATE_CONFIGURATION :owner parent :name name ))
				 	   (sd-call-cmds (CFN_CAPTURE :CONSIDER_DRAWLIST :ON :CONSIDER_CAMERA :OFF))
					) ;; progn
				) ;; unless
			) ;; when
		) 

		;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
		;; set-parent setzt die variable "parent" auf die Baugruppe des CENTERPARTs oder auf die
		;; Wurzel der Baugruppenstruktur
		;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

		(set-parent ()
			(setf parent nil)

			(when LOCAL
				(setf parent (sd-inq-parent-obj CENTERPART))
			)

			(unless parent
				(setf parent (sd-pathname-to-obj "/"))
				(loop
					(when (> (length (SD-INQ-OBJ-CHILDREN parent)) 1) (return))
					(setf parent (car (SD-INQ-OBJ-CHILDREN parent)))
				)
			)
		)

		;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
		;; Alle Teile oder Baugruppen in einer Liste gesammelt
		;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

		(collect-all-objects-below-parent ()
			(when parent
			 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
			 ;; alle teile unterhalb des "parent"
			 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

			 (setq allObjects (inq-objects-below-assembly parent))
			)
		)

		;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
		;; Abgreifen der "bounding box" des CENTERPARTs und Extraktion der Koordinatenkomponenten
		;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

		(compute-center-box ()
			 (setf centerbox (sd-inq-obj-box CENTERPART :mode :graphical) )
			 (if (and centerbox (first centerbox))
			     (progn
			       (setq centerboxcenterx  (/ (+  (gpnt3d_x (first centerbox))(gpnt3d_x (second centerbox)))  2)   )
			       (setq centerboxcentery  (/ (+  (gpnt3d_y (first centerbox))(gpnt3d_y (second centerbox)))  2)   )
			       (setq centerboxcenterz  (/ (+  (gpnt3d_z (first centerbox))(gpnt3d_z (second centerbox)))  2)   )
			       centerbox
			       )
			   nil
			   ) ;; if
		)

		;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
		;; Rotes Drahtmodell eines Würfels wird erzeugt. Dies ist die grobe Darstellung der eigentlich kugelförmigen Umgebung
		;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

		(show-feedback ()
			(remove-feedback)
			(if (and CENTERPART (compute-center-box))
			    (progn
				(setf dist 0.001)
				(when MAX_DISTANCE (setf dist MAX_DISTANCE))


				(setq c1x (- centerboxcenterx dist ))
				(setq c1y (- centerboxcentery dist ))
				(setq c1z (- centerboxcenterz dist ))
				(setq c2x (+ centerboxcenterx dist ))
				(setq c2y (+ centerboxcentery dist ))
				(setq c2z (+ centerboxcenterz dist ))

				(setq boxvertices (list
						(make-gpnt3d :x c1x :y c1y :z c1z)
						(make-gpnt3d :x c2x :y c1y :z c1z)
						(make-gpnt3d :x c2x :y c2y :z c1z)
						(make-gpnt3d :x c1x :y c2y :z c1z)

						(make-gpnt3d :x c1x :y c1y :z c2z)
						(make-gpnt3d :x c2x :y c1y :z c2z)
						(make-gpnt3d :x c2x :y c2y :z c2z)
						(make-gpnt3d :x c1x :y c2y :z c2z)
						)
				)
				(setq feedback (sd-start-box-feedback boxvertices :color 1,0,0))
				)
			  ;; else
			  (setf CENTERPART nil)
			) ;; if
		)

		(remove-feedback ()
			(when feedback (sd-end-feedback feedback))
			(setf feedback nil)
		)
		;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
		;; Alle Teile und Baugruppen unterhalb eines Objektes werden rekursiv aufgesammelt
		;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

		(inq-objects-below-assembly (obj)
		  (when (and obj (or (sd-inq-part-p obj) (sd-inq-assembly-p obj)))
		        (cons obj
		        	(apply #'nconc (mapcar #'inq-objects-below-assembly (sd-inq-obj-children obj)))
		        )
		  ) ;; when
		)
	) ;; local functions
) ;; dialog