; -*-Lisp-*-
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
;
; Beschreibung:  
; Mit diesem Makro kann der Abstand zwischen zwei Punkten gemessen werden. Die Ausgabe enthält die globalen
; Koordinaten der beiden Messpunkte sowei die Abstände zwischen den Messpunkten in Bezug auf ein wählbares Koordinatensystem.
;
; Autor:        Stephan Dürr
; erstellt:      März 2010
; geändert:   2/2017 -> Nachkommastellen von 6 auf 10 erhöht.
;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(use-package :oli)
(setq Nachkommastellen 10)


(sd-defdialog 'Abstand_2P
  :dialog-title "Abstand 2er Punkte"
  ;:toolbox-button t
  :dialog-type :interrupt
  :mutual-exclusion '()
  :after-initialization '(sd-disable-must-variable-check)
  :trace nil
  :variables 
  '(
		(X-Achse
			:value-type :measure-direction
			:built-in-feedback nil
			:initial-value (list 1,0,0 RefPunkt nil)
			:next-variable (seq-input)
			:check-function #'(lambda (dir)
									(if Z-Achse
										(if (< -0.00000001 (sd-vec-scalar-product (first dir) (first Z-Achse)) 0.0000000001)
											:ok
											(values :error "Z- und X-Achse müssen normal zueinander sein!")
										)
										:ok
									)
								)
			:after-input (start-fback)
		)
		(Z-Achse
			:value-type :measure-direction
			:built-in-feedback nil
			:initial-value (list 0,0,1 RefPunkt nil)
			:next-variable (seq-input)
			:check-function #'(lambda (dir)
									(if X-Achse
										(if (< -0.0000000001 (sd-vec-scalar-product (first dir) (first X-Achse)) 0.0000000001)
												 :ok
											 (values :error "Z- und X-Achse müssen normal zueinander sein!")
										)
									:ok
									)
								)
			:after-input (start-fback)
		)
		(Achsen_entf
			:push-action (Achsen_loeschen)
			:toggle-type :wide-toggle
			:title "beide Achsen neu"
			:next-variable (seq-input)
		)
	("-")
		(RefPunkt
			:value-type :point-3d
			:built-in-feedback nil
			:next-variable (seq-input)
			:after-input (start-fback)
		)
		
		(X-Wert1 :value-type :display-only
			:title "X Global"
			:digits Nachkommastellen
			:size :third
		)
		(Y-Wert1 :value-type :display-only
			:title "Y Global"
			:digits Nachkommastellen
			:size :third
		)
		(Z-Wert1 :value-type :display-only
			:title "Z Global"
			:digits Nachkommastellen
			:size :third
		)

		("-")
		(Punkt
			:value-type :point-3d
			:built-in-feedback nil
			:next-variable (seq-input)
			:after-input (start-fback)
		)
		(X-Wert2 :value-type :display-only
			:title "X Global"
			:digits Nachkommastellen
			:size :third
		)
		(Y-Wert2 :value-type :display-only
			:title "Y Global"
			:digits Nachkommastellen
			:size :third
		)
		(Z-Wert2 :value-type :display-only
			:title "Z Global"
			:digits Nachkommastellen
			:size :third
		)
 
		("Abstand:")
		(rueckmeldung 
			:value-type :boolean
			:title "XYZ Linien anzeigen"
			:initial-value  t
			:toggle-type :wide-toggle
			:next-variable (seq-input)
			:after-input (start-fback)
		)

		(X-coord
			:title "X   (rot)"
			:value-type :display-only
			:size :third
			:digits Nachkommastellen
			:size :third
		)
		(Y-coord
			:title "Y   (grün)"
			:value-type :display-only
			:size :third
			:digits Nachkommastellen
			:size :third
		)
		(Z-coord
			:title "Z   (blau)"
			:value-type :display-only
			:size :third
			:digits Nachkommastellen
			:size :third
		)
		(abstand 	:value-type :display-only
			:title "Abstand"
			:size :third
			:digits Nachkommastellen
			:size :third
		)
		
		(ueb-x	:push-action (ueb-x-action)
			:toggle-type :wide-toggle
			:title  "Abstand X übernehmen "
		)
		(ueb-y	:push-action (ueb-y-action)
			:toggle-type :wide-toggle
			:title  "Abstand Y übernehmen"
		)
		(ueb-z	:push-action (ueb-z-action)
			:toggle-type :wide-toggle
			:title  "Abstand Z übernehmen"
		)
		(ueb-abs	:push-action (ueb-abs-action)
			:toggle-type :wide-toggle
			:title  "Abstand übernehmen"
		)
		
	(pnt-fback :initial-value nil)
	(refpnt-fback :initial-value nil)
    (z-fback :initial-value nil) ; Messrichtung Z
    (y-fback :initial-value nil)
    (x-fback :initial-value nil)
    (zmw-fback :initial-value nil) ; Messwert Z
    (ymw-fback :initial-value nil)
    (xmw-fback :initial-value nil)
	(rline-RefPnt-fback :initial-value nil)
	(Abstand-fback :initial-value nil)
	
	);variables
	
	:prompt-text ""
	;format nil ~% - Zeilenumbruch
	:help-action '(sd-display-message (format nil "Mit dieser Funktion wird der Abstand zwischen zwei Punkten gemessen. 
 Es werden für jeden Punkt die Koordintan im globalen Koordinatensystem ausgegeben. 
 Der Abstand wird in Abhängigkeit eines frei wählbaren Koordinatensystems berechnet. 
 Die einzelnen Werte können für die weitere Verwendung übergeben werden.") 
	:title "Hilfe: Abstand 2er Punkte"
	)

	:cancel-action
	'(progn
		(cleanup)
		(sd-enable-must-variable-check)
	);progn

	:ok-action
	'(progn
		(cleanup)
		(sd-enable-must-variable-check)
	);progn  
	:local-functions
	'(
		(seq-input ()
			(if (not X-Achse)
				'X-Achse
				(if (not Z-Achse)
				 'Z-Achse
					(if (not RefPunkt)
						'RefPunkt
						(if (not Punkt)
								'Punkt
								(measure-action)))))
	);;seq-input
	
	;Achen löschen
	(Achsen_loeschen ()
		(setq X-Achse nil)
		(setq Z-Achse nil)
		(start-fback)

		;(seq-input)
	)
	;-----------------------------------------------------fback------------------------------------------------------------------------
		(start-fback ()
			(cleanup)
			(start-pnt-fback)
			(start-refpnt-fback)
			(start-x-fback)
			(start-y-fback)
			(start-z-fback)
		)
		
		(start-pnt-fback ()
			(let ()
				(when Punkt
				(setq pnt-fback (sd-start-point-feedback Punkt :color 1,0,0))

				);;when
			);;let
		)
		(start-refpnt-fback ()
			(let ()
				(when RefPunkt
				(setq refpnt-fback (sd-start-point-feedback RefPunkt :color 0,1,0))
				(setq rline-RefPnt-fback (sd-start-rubberline-3d-feedback RefPunkt))

				(setf x-wert1 (gpnt3d_x Refpunkt))
				(setf y-wert1 (gpnt3d_y Refpunkt))
				(setf z-wert1 (gpnt3d_z Refpunkt))

				);;when
			);;let
		)
		(start-x-fback ()
			(let ()
				(when (and RefPunkt X-Achse)
					(setq x-fback (sd-start-direction-feedback
							:point RefPunkt
							:direction (first X-Achse)
							:disc nil
							:color 1,0,0)
					)
				);;when
			);;let
		)
		(start-y-fback ()
			(let ()
				(when (and RefPunkt X-Achse Z-Achse)
					(setq y-fback (sd-start-direction-feedback
							:point RefPunkt
							:direction (sd-vec-cross-product (first Z-Achse) (first X-Achse))
							:disc nil
							:color 0,1,0)
					)
				);;when
			);;let
		)
		(start-z-fback ()
			(let ()
				(when (and RefPunkt Z-Achse)
					(setq z-fback (sd-start-direction-feedback
							:point RefPunkt
							:direction (first Z-Achse)
							:disc t
							:color 0,0,1)
					)
				);;when
			);;let
		)
	
	;-------------------------------------------------------------measure action---------------------------------------------------
	(measure-action ()
			
			(setf x-wert2 (gpnt3d_x Punkt))
			(setf y-wert2 (gpnt3d_y Punkt))
			(setf z-wert2 (gpnt3d_z Punkt))
			
			(setq Messvektor (sd-vec-subtract Punkt Refpunkt))
			
			(setq x-coord (sd-vec-scalar-product Messvektor (first X-Achse)))
			(setq Y-coord (sd-vec-scalar-product Messvektor (sd-vec-cross-product (first Z-Achse) (first X-Achse))))
			(setq Z-coord (sd-vec-scalar-product Messvektor (first Z-Achse)))
			(setq Abstand (sd-vec-length Messvektor))

			(setq Abstand-fback (sd-start-polyline-feedback  (list Refpunkt Punkt)  :color .8,0.8,0.8))
			
			;Anzeige der Messung mit Lininen in den Messrichtungen
			(setq zwischenpunkt-x (sd-vec-add Refpunkt (sd-vec-scale (first X-Achse) x-coord) ))
			(setq zwischenpunkt-y (sd-vec-add zwischenpunkt-x (sd-vec-scale (sd-vec-cross-product (first Z-Achse) (first X-Achse)) y-coord)))

			
			;(let ()
			(when rueckmeldung 
			(setq xmw-fback (sd-start-polyline-feedback  (list Refpunkt zwischenpunkt-x) :color 1,0,0))
			(setq ymw-fback (sd-start-polyline-feedback  (list zwischenpunkt-x zwischenpunkt-y) :color 0,1,0))
			(setq zmw-fback (sd-start-polyline-feedback  (list zwischenpunkt-y Punkt) :color 0,0,1))
			)
			;)
		'Punkt
	)
		

;------------------------------------------------------------------------------Übergabe der Werte---------------------------------
	(ueb-x-action () ; Übergabe X-Wert 
		(when (AND RefPunkt Punkt)
			(sd-put-buffer (format nil "~F" x-coord))
			cancel
		)
	)

	(ueb-y-action () ; Übergabe Y-Wert 
		(when (AND RefPunkt Punkt)
			(sd-put-buffer (format nil "~F" y-coord))
			cancel
		)
	)

	(ueb-z-action () ; Übergabe Z-Wert 
		(when (AND RefPunkt Punkt)	
			(sd-put-buffer (format nil "~F" z-coord))
			cancel
		)
	)
	
 	(ueb-abs-action () ; Übergabe Abstands-Wert 
		(when (AND RefPunkt Punkt)
			(sd-put-buffer (format nil "~F" Abstand))
			cancel
		)
	)
	
    (cleanup ()
		(sd-end-feedback pnt-fback)
		(sd-end-feedback refpnt-fback)
		(sd-end-feedback z-fback)
		(sd-end-feedback y-fback)
		(sd-end-feedback x-fback)
		(sd-end-feedback zmw-fback)
		(sd-end-feedback ymw-fback)
		(sd-end-feedback xmw-fback)
		(sd-end-feedback rline-RefPnt-fback)
		(sd-end-feedback Abstand-fback)
    );;cleanup
  );local-functions
   
);dialog