; #|

Thread Extension - Additional Example

Note: This is an example file showing concepts of the Integration Kit. The code itself is not supported and will never be supported.
|#

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

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;Begin of page;;
;; 
;; example how to use the functions sd-define-thread
;;                                  sd-inq-thread
;;                                  sd-destroy-thread
;; 
;; the following Integration Kit Functions are also used inside this example
;;                                  sd-defdialog
;;                                  sd-inq-geo-props
;;                                  sd-cylinder-*
;;                                  sd-multi-lang-string
;;                                  sd-end-point-feedback
;;                                  sd-start-direction-feedback
;;                                  sd-set-variable-status
;;                                  sd-vec-equal-p
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(sd-defdialog 'thread_extension
 :dialog-title (sd-multi-lang-string "Thread Define" :german "Gewinde Def.")
 :toolbox-button t
 :after-initialization
 '(progn
    (trace oli::sd-define-thread
	   oli::sd-inq-thread
	   oli::sd-destroy-thread
	   )
    (setf profile nil)
    )
 :mutual-exclusion '( (nomi-dia nomi-dia-inch) (pitch TPI))
 :variables
 `(
   (t-feedbacks :initial-value nil) ;; all feedbacks shown
   (result      :initial-value nil) ;; saved return value of sd-*-thread functions
   (props       :initial-value nil) ;; cylinder face properties
   (a-cyl-face
    :selection  *sd-cylinder-seltype*
    :title (sd-multi-lang-string "Cyl Face" :german "Zyl. Flaeche")
    :check-function
    #'(lambda (this-face)
	(if (sd-cylinder-p (SD-INQ-GEO-PROPS this-face))
	    :ok
	  (values :error
          (sd-multi-lang-string
            "No cylindrical face selected. Thread Information is only valid for a cylindrical face."
            :german "Keine Zylinderflaeche gewaehlt. Gewindedefinition nur bei zylindrischen Flaechen moeglich.")
            )))
    :after-input
    (let (center axis start radius)
      (dolist (a-fb t-feedbacks) (sd-end-point-feedback a-fb)) ;; remove old feedback

      (setf props (sd-inq-geo-props a-cyl-face :dest-space :global))
      (setf center (sd-cylinder-center    props))  ;; really the center , also in axis direction!
      (setf axis   (sd-cylinder-axis-dir  props))
      (setf start  (sd-cylinder-start-dir props))  ;; this is for rotaion,
      (setf radius (sd-cylinder-radius    props))

      (push ;; center of cylinder
       (sd-start-direction-feedback
	:point center :direction axis :disc t  :color 0,0,1)
       t-feedbacks)

      (sd-set-variable-status 't-define  :enable t)
      (sd-set-variable-status 't-inq     :enable t)
      (sd-set-variable-status 't-destroy :enable t)
      ) ;; end after-input
    ) ;; end a-cylface
   ;; -------------------------------------------------------------------
   (ruler1 :title (sd-multi-lang-string "metric" :german "metrisch"))
   (nomi-dia
    :title (sd-multi-lang-string "Nomi Dia." :german "Nenn-Dm.")
    :value-type :positive-length
    :proposals '("6" "8" "10" "12")
    )
   (pitch
    :title (sd-multi-lang-string "Pitch" :german "Steigung")
    :value-type :positive-length
    :proposals '("1" "1.25" "1.5" "1.75")
    )
   (ruler2 :title (sd-multi-lang-string "inch" :german "zoll"))
   (nomi-dia-inch
    :title (sd-multi-lang-string "Nomi Dia." :german "Nenn-Dm.")
    :value-type :string
    :proposals '("#12" "1/4" "3/8" "1" "1 1/2")
    )
   (TPI
    :title (sd-multi-lang-string "TPI" :german "Steigung")
    :value-type :positive-integer
    :proposals '("28" "24" "20" "18" "14")
    )
   ("-")
   (core-dia
    :title (sd-multi-lang-string "Core Dia." :german "Kern-Dm.")
    :toggle-type  :indicator-toggle-data
    :value-type :positive-length
    )
   (profile
    :toggle-type  :indicator-toggle-data
    :title (sd-multi-lang-string "Profile" :german "Gew.-Art")
    :range (
	(:BSW 		:label ,(sd-multi-lang-string "BSW"))	; British Standard Whithworth Thread 
	(:BSF 		:label ,(sd-multi-lang-string "BSF"))	; British Standard Fine Thread 
	(:BSP 		:label ,(sd-multi-lang-string "BSP"))	; British Standard Pipe Thread
	(:UNC 		:label ,(sd-multi-lang-string "UNC"))	; Unified National Coarse Screw Thread (US) 
	(:UNF 		:label ,(sd-multi-lang-string "UNF"))	; Unified National Fine Screw Thread (US) 
	(:NPT 		:label ,(sd-multi-lang-string "NPT"))	; National Pipe Thread
	(:M 		:label ,(sd-multi-lang-string "M"))	; metric
	(:MF 		:label ,(sd-multi-lang-string "M (fine)" :german "M (fein)"))	; metric fine
	(:TR 		:label ,(sd-multi-lang-string "Tr"       :german "Tr (DIN 103)"))	; Tr (DIN 103)
	(:flat_trapezoid :label ,(sd-multi-lang-string "flatTr"  :german "Tr (DIN 380)")) ; Tr (DIN 380)
	(:S 		:label ,(sd-multi-lang-string "S"        :german "S (DIN 513)"))	; S  (DIN 513) 
	(:R 		:label ,(sd-multi-lang-string "R"        :german "Rd (DIN 405)"))	; Rd (DIN 405)
	(:E		:label ,(sd-multi-lang-string "E"))	; Edison
	(:PIPE_RP	:label ,(sd-multi-lang-string "Rp"       :german "Rp (DIN EN 10226)"))	; Pipe Thread DIN EN 10226
	(:PIPE_G	:label ,(sd-multi-lang-string "G"        :german "G (DIN ISO 228)"))	; Pipe Thread DIN ISO 228
	)
    )
   (thread-type
    :title (sd-multi-lang-string "Type" :german "Typ")
    :range ( :inner :outer))
   (chamfer
    :title (sd-multi-lang-string "Include adjacent Cone" :german "Fase einbeziehen")
    :value-type :boolean
    :toggle-type :wide-toggle
    :initial-value T
    )
   (thread-name
    :title (sd-multi-lang-string "Name" :german "Name")
    :value-type :string
    :initial-value ""
    )
   (a-dir-reverse
    :title (sd-multi-lang-string "Reverse Dir" :german "Umkehren")
    :value-type :boolean
    :toggle-type :wide-toggle
    )
   ;; -------------------------------------------------------------------
   (reset
    :title (sd-multi-lang-string "Clear" :german "Neu")
    :toggle-type :right-toggle
    :push-action
    (setf nomi-dia nil
	  pitch nil
	  nomi-dia-inch nil
	  TPI nil
	  core-dia NIL
	  thread-type :inner
	  chamfer nil
	  profile nil
	  thread-name nil
	  a-dir-reverse nil
	  )
    ) ;; end clear
   (t-define
    :initial-enable NIL
    :toggle-type :wide-toggle
    :title (sd-multi-lang-string "Define" :german "Anwenden")
    :push-action
    (progn
      (setf result
	    (oli::sd-define-thread a-cyl-face
				   :nominal-diameter nomi-dia
				   :nominal-diameter-inch nomi-dia-inch
				   :core-diameter    core-dia
				   :pitch            pitch
				   :TPI              TPI
				   :thread-type      thread-type
				   :thread-unit      (if nomi-dia :metric :inch)
				   :thread-profile   profile
				   :thread-color     1,0,0
				   :include-chamfer  chamfer
				   :thread-direction (if a-dir-reverse :REVERSE-CYL-AXIS :CYL-AXIS)
				   :thread-name      thread-name
				   )
	    )
      (unless result (display (sd-multi-lang-string "no thread created - look to trace output in concole"
                                                    :german "Kein Gewinde erzeugt - siehe trace Ausgaben")))
      )
    ) ;; end t-define
   ;; -------------------------------------------------------------------
   (ruler3 :title (sd-multi-lang-string "Thread Inquire" :german "Gewinde abfragen"))
   (t-inq
    :initial-enable NIL
    :toggle-type :wide-toggle
    :title (sd-multi-lang-string "Inquire" :german "Abfragen")
    :push-action
    (progn
      (setf result
	    (oli::sd-inq-thread a-cyl-face))
      (if result
	  (progn
	    (display (format nil "thread detected~%~%~{:~A ~A~%~}~%look also to trace output in concole~%" (nthcdr 2 result)))
	    (if (getf result :nominal-diameter-inch)
		(setf nomi-dia-inch      (getf result :nominal-diameter-inch))
	      (setf nomi-dia      (getf result :nominal-diameter))
	      )
	    (setf core-dia      (getf result :core-diameter))
	    (if (getf result :TPI)
		 (setf TPI         (getf result :tpi))
	      (setf pitch         (getf result :pitch))
	      )
	    (setf thread-type   (getf result :thread-type))
	    (setf profile       (getf result :thread-profile))
	    (setf chamfer       (getf result :include-chamfer))
	    (setf a-dir-reverse (NOT (sd-vec-equal-p (getf result :thread-direction) (sd-cylinder-axis-dir props))))
	    (setf thread-name   (getf result :thread-name))
	    ) ; end progn
	(display (sd-multi-lang-string "no sd-define-thread information available"
                                       :german "Keine sd-define-thread Information vorhanden")))
      )
    ) ;; end t-inq
   ;; -------------------------------------------------------------------
   (ruler4 :title (sd-multi-lang-string "Thread Destroy" :german "Gewinde entfernen"))
   (t-destroy
    :initial-enable NIL
    :toggle-type :wide-toggle
    :title (sd-multi-lang-string "Destroy" :german "Entfernen")
    :push-action
    (progn
      (setf result
	    (oli::sd-destroy-thread a-cyl-face))
      (if result
	  (display "thread deleted")
	(display "no thread information available or no thread deleted - look to trace output in concole"))
      )
    ) ;; end t-destroy
   ) ;; end variables
 :cleanup-action
 '(progn
    (dolist (a-fb t-feedbacks) (sd-end-point-feedback a-fb)) ;; remove old feedback
    (untrace oli::sd-define-thread
	     oli::sd-inq-thread
	     oli::sd-destroy-thread
	 )
    )
 ) ;; end


;  END of Example