;;--------------------------------------------------------------------------*
;;  Modulbeschreibung: Koordinaten-Tabelle im Massstab erstellen            *
;;                                                                          *
;;                                                                          *
;;                                                                          *
;;--------------------------------------------------------------------------*

(in-package :test)
(use-package '(:oli))


(sd-defdialog
 'Kotab
 :dialog-title "Koordinatentabelle"
 :variables
  '(
     ( Masstab :value-type :length
               :title "Massstab"
               ; :initial-value  1
               :prompt-text "Faktor eingeben"
               :after-input (setq mastab (/ 1 Masstab))
     );;Masstab    
                            
     (Tab_row :initial-value 0)
     (Digits  :initial-value 2)
     (Text_size :initial-value (sd-am-text-attributes-struct-size (sd-am-inq-curr-text-attributes)))
     (Tab_pos :value-type :docupoint
              :title "Tab. Pos." 
              :prompt "Position fuer Koordinaten-Tabelle ?"
              :after-input (progn
                             (setq Tab_row 0)
                             (draw-table "Pkt" "X-Koord." "Y-Koord.")
                           
                           )
              :next-variable 'Null_pnt
     )
     (Null_pnt :value-type :docupoint
               :title "Null Pkt."
               :prompt "Nullpunkt fuer Koordinaten?"
               :next-variable 'Null_pos
     )
     (Null_pos :value-type :docupoint
               :prompt "Position fuer Koordinaten-Nullpunkts-Text ?"
               :title "Null Pos."
               :before-input (sd-execute-annotator-command :cmd  "TEXT '1'")
               :after-input (progn
                               (sd-execute-annotator-command :cmd (format nil "~A,~A END"
                                                  (gpnt2d_x Null_pos)
                                                  (gpnt2d_y Null_pos)))
                               (setq Tab_row (+ 1 Tab_row))
                              (draw-table (format nil "~A" Tab_row)
                                          (format nil "~F" (round-digits (- (gpnt2d_x Null_pnt) (gpnt2d_x Null_pnt)) Digits))
                                          (format nil "~F" (round-digits (- (gpnt2d_y Null_pnt) (gpnt2d_y Null_pnt)) Digits))
                               )                              
                            )
               :next-variable 'Koo_pnt
     )
     (Koo_pnt :value-type :docupoint
              :prompt "Koordinaten-Punkt ?"
 
              :title "Koord. Pkt."            
              :next-variable 'Koo_pos
     )
     
     (Koo_pos :value-type :docupoint
              :prompt "Position fuer Koordinaten-Markierung ?"
              :title "Koord. Pos."
              :before-input (sd-execute-annotator-command :cmd (format nil "TEXT '~A' " (+ Tab_row 1)))
              :after-input (progn
                             (sd-execute-annotator-command :cmd (format nil "~A,~A END" 
                                                   (gpnt2d_x Koo_pos)
                                                   (gpnt2d_y Koo_pos)))
                             (setq Tab_row (+ 1 Tab_row))
                             (draw-table (format nil "~A" Tab_row)
                                         (format nil "~F" (* mastab (round-digits (- (gpnt2d_x Koo_pnt) (gpnt2d_x Null_pnt)) Digits)))
                                         (format nil "~F" (* mastab (round-digits (- (gpnt2d_y Koo_pnt) (gpnt2d_y Null_pnt)) Digits)))
                             )
                           )
              :next-variable 'Koo_pnt

    )
  )

 :local-functions
  '(
     (round-digits (value pow)
       (/ (round (* value (expt 10.0 pow)))
       (expt 10.0 pow))
     )
     (draw-table (no x-txt y-txt)
        (when (= Tab_row 0)
          (sd-execute-annotator-command 
              :cmd (format nil "LINE ~A,~A ~A,~A END"
                       (gpnt2d_x Tab_pos)
                       (gpnt2d_y Tab_pos)
                       (+ (gpnt2d_x Tab_pos) (* 20 Text_size))
                       (gpnt2d_y Tab_pos)
                   )
          )
        )
        (sd-execute-annotator-command 
             :cmd (format nil "LINE ~A,~A ~A,~A END"
                      (gpnt2d_x Tab_pos)
                      (- (gpnt2d_y Tab_pos) (* (+ Tab_row 1) 2 Text_size))
                      (+ (gpnt2d_x Tab_pos) (* 20 Text_size))
                      (- (gpnt2d_y Tab_pos) (* (+ Tab_row 1) 2 Text_size))
                  )
        )
        (sd-execute-annotator-command 
             :cmd (format nil "LINE ~A,~A ~A,~A END"
                      (gpnt2d_x Tab_pos)
                      (- (gpnt2d_y Tab_pos) (* (+ Tab_row 1) 2 Text_size))
                      (gpnt2d_x Tab_pos)
                      (- (gpnt2d_y Tab_pos) (* Tab_row 2 Text_size))
                  )
        )
        (sd-execute-annotator-command
             :cmd (format nil "LINE ~A,~A ~A,~A END"
                      (+ (gpnt2d_x Tab_pos) (* 4 Text_size))
                      (- (gpnt2d_y Tab_pos) (* (+ Tab_row 1) 2 Text_size))
                      (+ (gpnt2d_x Tab_pos) (* 4 Text_size))
                      (- (gpnt2d_y Tab_pos) (* Tab_row 2 Text_size))
                  )
        )
        (sd-execute-annotator-command
             :cmd (format nil "LINE ~A,~A ~A,~A END"
                      (+ (gpnt2d_x Tab_pos) (* 12 Text_size))
                      (- (gpnt2d_y Tab_pos) (* (+ Tab_row 1) 2 Text_size))
                      (+ (gpnt2d_x Tab_pos) (* 12 Text_size))
                      (- (gpnt2d_y Tab_pos) (* Tab_row 2 Text_size))
                  )
        )
        (sd-execute-annotator-command :cmd (format nil "LINE ~A,~A ~A,~A END"
                      (+ (gpnt2d_x Tab_pos) (* 20 Text_size))
                      (- (gpnt2d_y Tab_pos) (* (+ Tab_row 1) 2 Text_size))
                      (+ (gpnt2d_x Tab_pos) (* 20 Text_size))
                      (- (gpnt2d_y Tab_pos) (* Tab_row 2 Text_size))
                  )
        )
        (sd-execute-annotator-command
             :cmd (format nil "TEXT '~A' ~A,~A END"
                      no
                      (+ (gpnt2d_x Tab_pos) 2)
                      (- (gpnt2d_y Tab_pos) (* (+ Tab_row 1) 2 Text_size) -2)
                  )
        )
        (sd-execute-annotator-command
             :cmd (format nil "TEXT '~A' ~A,~A END"
                      x-txt
                      (+ (gpnt2d_x Tab_pos) (+ 2 (* 4 Text_size)))
                      (- (gpnt2d_y Tab_pos) (* (+ Tab_row 1) 2 Text_size) -2)
                  )
        )
        (sd-execute-annotator-command
             :cmd (format nil "TEXT '~A' ~A,~A END"
                      y-txt
                      (+ (gpnt2d_x Tab_pos) (+ 2 (* 12 Text_size)))
                      (- (gpnt2d_y Tab_pos) (* (+ Tab_row 1) 2 Text_size) -2)
                  )
        )
       ;;Tab_row  Tab_pos
     )
   )

)