;;--------------------------------------------------------------------------*
;;  Copyright 2005  DC4 Technisches Büro GmbH                               *
;;                                                                          *
;;--------------------------------------------------------------------------*

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

;;--------------------------------------------------------------------------*

(sd-defdialog 'dc4-darstellungsfenster-angleichen-dialog
:dialog-title "DF Ausrichten"
;;:dialog-control :sequential
:variables
  '(
    (qvp    :range ("-")
            :title "Bezugsfenster"
            :initial-value
            (let ((new-range (oli::sd-inq-vp-names)))
              (sd-set-range 'qvp new-range)
              (first new-range))
    )
    (zvp    :range ("-")
            :title "Zielfenster"
            :initial-value
            (let ((new-range (oli::sd-inq-vp-names)))
              (sd-set-range 'zvp new-range)
              (first (last new-range)))
    )
    (fit   :value-type :boolean
           :title "mit Einpassen"
           :initial-value nil
           :toggle-type :wide-toggle
    )
   )
:after-initialization '(create-range)
:local-functions
  '(
    (create-range ()
     (sd-set-range 'qvp (oli::sd-inq-vp-names))
     (sd-set-range 'zvp (oli::sd-inq-vp-names))
    )
   )
:ok-action
   '(progn
     (oli::sd-set-vp-camera zvp (oli::sd-inq-vp-camera qvp) :smooth t)
     (when fit (frame2-ui::fit_vp zvp))
     (ui::uic-vp-cmd "redraw_vp")
    );;progn
:help-action '()
)

;;--------------------------------------------------------------------------*

(sd-defdialog 'dc4-darstellungsfenster-begradigen-dialog
:dialog-title "DF Begradigen"
;;:dialog-control :sequential
:variables
  '(
    (axis) (bc) (fc) (proj) (vf)
    (vp     :value-type :string
            :title "Fenster"
    )
    (px     :value-type :number
            :title "X-Koord."
            :next-variable 'py
    )
    (py     :value-type :number
            :title "Y-Koord."
            :next-variable 'pz
    )
    (pz     :value-type :number
            :title "Z-Koord."
    )
    (xup  :value-type :grouped-boolean
           :title "X"
           :size :third
           :initial-value nil
    )
    (yup   :value-type :grouped-boolean
           :title "Y"
           :size :third
           :initial-value nil
    )
    (zup  :value-type :grouped-boolean
           :title "Z"
           :size :third
           :initial-value t
    )
    (fit   :value-type :boolean
           :title "mit Einpassen"
           :initial-value t
           :toggle-type :wide-toggle
    )
   )
:after-initialization '(inquire_vp)
:mutual-exclusion '((xup yup zup))
:prompt-variable 'px
:local-functions
  '(
    (inquire_vp ()
     (let (cam fromp top upd refp nupd rnupd)
      (sd-set-variable-status 'vp :value (oli::sd-inq-current-vp))
      (if (eq (sd-inq-vp-direction-axes vp) :off)
       (progn
        (setf axis nil)
        (uic_global_axes_on_off vp)
       );;progn
       (setf axis t)
      );;if
      (setf cam (oli::sd-inq-vp-camera vp))
      (setf fromp (oli::sd-vp-camera-struct-from-pt cam))
      (setf top (oli::sd-vp-camera-struct-to-pt cam))
      (setf upd (oli::sd-vp-camera-struct-up-dir cam))
      (setf bc (oli::sd-vp-camera-struct-back-clip cam))
      (setf fc (oli::sd-vp-camera-struct-front-clip cam))
      (setf proj (oli::sd-vp-camera-struct-projection cam))
      (setf vf (oli::sd-vp-camera-struct-view-field cam))
      (setf refp (sd-vec-subtract fromp top))
      (setf nupd (sd-vec-subtract upd top))
      (setf px (dc4-round (gpnt3d_x refp) 2))
      (setf py (dc4-round (gpnt3d_y refp) 2))
      (setf pz (dc4-round (gpnt3d_z refp) 2))
     );;let
    )
    (doit ()
     (let (cam rrefp rnupd)
      (setf rrefp (make-gpnt3d :x px :y py :z pz))
      (setf rnupd (make-gpnt3d :x (if xup 1 0) :y (if yup 1 0) :z (if zup 1 0)))
      (setf cam (make-sd-vp-camera-struct :from-pt rrefp :to-pt 0,0,0 :up-dir rnupd :back-clip bc :front-clip fc :projection proj :view-field vf))
      (oli::sd-set-vp-camera vp cam :smooth t)
      (when fit (frame2-ui::fit_vp vp))
      (ui::uic-vp-cmd "redraw_vp")
      (clean-action)
     );;let
    )
    (clean-action ()
     (let ()
      (when
       (or
        (and axis (eq (sd-inq-vp-direction-axes (oli::sd-inq-current-vp)) :off))
        (and (not axis) (eq (sd-inq-vp-direction-axes (oli::sd-inq-current-vp)) :on))
       );;or
       (uic_global_axes_on_off (oli::sd-inq-current-vp))
      );;when
     )
    )
   )
:cancel-action
   '(clean-action)
:ok-action
   '(doit)
:help-action '()
)

;;--------------------------------------------------------------------------*

(sd-defdialog 'dc4-darstellungsfenster-abmessungen-dialog
:dialog-title "DF Abmessungen"
;;:dialog-control :sequential
:variables
  '(
    (zvp    :range ("-")
            :title "Zielfenster"
            :initial-value
            (let ((new-range (oli::sd-inq-vp-names)))
              (sd-set-range 'zvp new-range)
              (first new-range))
    )
    (x      :value-type :number
            :title "X-Koord."
            :initial-value 0
    )
    (y      :value-type :number
            :title "Y-Koord."
            :initial-value 0
    )
    (width  :value-type :number
            :title "Breite"
    )
    (height :value-type :number
            :title "Hoehe"
    )
    (fit   :value-type :boolean
           :title "mit Einpassen"
           :initial-value nil
           :toggle-type :wide-toggle
    )
   )
:after-initialization '(create-range)
:local-functions
  '(
    (create-range ()
     (sd-set-range 'zvp (oli::sd-inq-vp-names))
    )
   )
:ok-action
   '(progn
     (oli::sd-resize-vp zvp
                        :x x
                        :y y
                        :width width
                        :height height)
     (when fit (frame2-ui::fit_vp zvp))
     (ui::uic-vp-cmd "redraw_vp")
    );;progn
:help-action '()
)

;;--------------------------------------------------------------------------*

(defun dc4-round (wert genau)
 (let (dig w1 w2 rest rund)
  (if (/= wert 0)
   (progn
    (setf dig (truncate (log (abs wert) 10)))
    (setf w1 (* wert (expt 10 (- genau dig 1))))
    (setf w2 (truncate w1))
    (setf rest (- w1 w2))
    (if (>= rest 0.5)
     (setf w2 (+ w2 1))
     nil
    );;if
    (setf rund (/ w2 (expt 10 (- genau dig 1))))
   );;progn
   (setf rund 0)
   );;if
  (values rund) ;; returnwert
 );;let
)