;;; DDUNITS.LSP
;;; Copyright (C) 1992-94 by Autodesk, Inc.
;;;
;;; Permission to use, copy, modify, and distribute this software
;;; for any purpose and without fee is hereby granted, provided
;;; that the above copyright notice appears in all copies and that
;;; both that copyright notice and this permission notice appear in
;;; all supporting documentation.
;;;
;;; THIS SOFTWARE IS PROVIDED "AS IS" WITHOUT EXPRESS OR IMPLIED
;;; WARRANTY.  ALL IMPLIED WARRANTIES OF FITNESS FOR ANY PARTICULAR
;;; PURPOSE AND OF MERCHANTABILITY ARE HEREBY DISCLAIMED.
;;;
;;;---------------------------------------------------------------------
;;;   DESCRIPTION
;;;
;;;   DDUNITS.LSP is designed to provide a quick and easy interface to the
;;;   existing AutoCAD UNITS command. DDUNITS.LSP utilizes DDUNITS.DCL to
;;;   provide a layout for the DDUNITS dialogue box.
;;;
;;;   The routine affects the following system variables:
;;;       LUNITS, LUPREC, AUNITS, AUPREC, ANGBASE, and ANGDIR.
;;;
;;;--------------------------------------------------------------------
;;;   OPERATION
;;;
;;;   After loading the routine, it is started by typing DDUNITS. This will
;;;   load up the Proteus Dialogue interface. The current settings are
;;;   displayed in the dialogue.
;;;
;;;   Any or all aspects of the units command can be changed and the new
;;;   value will take affect when the OK button is pressed. The Units
;;;   modes are selected by selecting the appropriate radio buttons. Each
;;;   time a setting is chosen an example is shown in a popup list, which
;;;   also is used to change the precision of the units. To choose the
;;;   angle direction (ANGDIR), press the "Direction..." button. Another
;;;   dialogue appears; standard choices are listed in a radio cluster and
;;;   an option for "Other" is given to allow for a screen picked angle or
;;;   a keyed in angle.
;;;
;;;   Choosing the OK button accepts the currently displayed settings and
;;;   sets the appropriate system variables. Choosing the CANCEL button
;;;   will abort the dialogue and leave the system "as-is." A Help button
;;;   is available to display the AutoCAD help information on the units
;;;   command.
;;;----------------------------------------------------------------------
;;;
;;; Version 1.01 - 13-08-97 - Corrected a basic programming technique
;;;                           error where some bright spark decided to
;;;                           do the calculation for pi and then round
;;;                           things.  This when AutoCAD has a perfectly
;;;                           good constant defined as pi.
;;;
;;;
;;;==================== load-time error checking ========================

  (defun ai_abort (app msg)
     (defun *error* (s)
        (if old_error (setq *error* old_error))
        (princ)
     )
     (if msg
       (alert (strcat " Application error: "
                      app
                      " \n\n  "
                      msg
                      "  \n"
              )
       )
     )
     (exit)
  )

;;; Check to see if AI_UTILS is loaded, If not, try to find it,
;;; and then try to load it.
;;;
;;; If it can't be found or it can't be loaded, then abort the
;;; loading of this file immediately, preserving the (autoload)
;;; stub function.

  (cond
     (  (and ai_dcl (listp ai_dcl)))          ; it's already loaded.

     (  (not (findfile "ai_utils.lsp"))                     ; find it
        (ai_abort "DDUNITS"
                  (strcat "Can't locate file AI_UTILS.LSP."
                          "\n Check support directory.")))

     (  (eq "failed" (load "ai_utils" "failed"))            ; load it
        (ai_abort "DDUNITS" "Can't load file AI_UTILS.LSP"))
  )

  (if (not (ai_acadapp))               ; defined in AI_UTILS.LSP
      (ai_abort "DDUNITS" nil)         ; a Nil <msg> supresses
  )                                    ; ai_abort's alert box dialog.

;;;==================== end load-time operations ========================

(defun c:ddunits (/
                   abase      auprec     luprec       ulist
                   alist                 old_cmd      what_next
                   angbase    dcl_id     old_error    what_next1
                   angdir     f_done     other
                   aunits     lunits     tmp_base     undo_init
                 )
  ;;
  ;; CHECK_INPUT  - checks input (angle zero direction edit box)
  ;;           called when OK is pressed in Direction child dialog.
  (defun check_input ()
    (if (= 1 (atoi (get_tile "other")))
      (if (not (setq tmp_base (angtof (get_tile "angle_edit") aunits)))
        (progn
          (set_tile "error" "Invalid angle.")
          (mode_tile "angle_edit" 2)
        )
        (progn
          (setq abase (- tmp_base angbase))
          (done_dialog)
        )
      )
      (done_dialog)
    )
  )
  ;;
  ;; S_UNIT - sets the system variables - called when OK is pressed.
  ;;
  (defun s_unit ()
    (if (/= abase angbase)
      (setvar "ANGBASE" abase)
    )
    (setvar "ANGDIR" angdir)
    (setvar "AUNITS" aunits)
    (setvar "AUPREC" auprec)
    (setvar "LUNITS" lunits)
    (setvar "LUPREC" luprec)
  )
  ;;
  ;; GRAB_ANGLE - action function for the Direction/Angle edit box.
  ;;
  (defun grab_angle()
    (set_tile "error" "")
    (if (not (setq tmp_base (angtof (get_tile "angle_edit") aunits)))
      (set_tile "error" "Invalid angle.")
      (progn
        (setq abase (- tmp_base angbase))
        (set_tile "angle_edit" (angtos tmp_base aunits auprec))
      )
    )
  )
  ;;
  ;; SET_ULIST - Sets Units/Precision popup list.
  ;;
  (defun set_ulist ()
    (cond
      ((= lunits 1) ; scientific
        (setq ulist (list "0E+01" "0.0E+01" "0.00E+01" "0.000E+01"
                       "0.0000E+01" "0.00000E+01" "0.000000E+01"
                       "0.0000000E+01" "0.00000000E+01") )
      )
      ((= lunits 2) ; decimal
        (setq ulist (list "0" "0.0" "0.00" "0.000" "0.0000" "0.00000"
                       "0.000000" "0.0000000" "0.00000000") )
      )
      ((= lunits 3) ; engineering
        (if (= (getvar "unitmode") 1)
          (setq ulist (list "0'0\"" "0'0.0\"" "0'0.00\"" "0'0.000\""
                       "0'0.0000\"" "0'0.00000\"" "0'0.000000\""
                       "0'0.0000000\"" "0'0.00000000\"") )
          (setq ulist (list "0'-0\"" "0'-0.0\"" "0'-0.00\"" "0'-0.000\""
                       "0'-0.0000\"" "0'-0.00000\"" "0'-0.000000\""
                       "0'-0.0000000\"" "0'-0.00000000\"") )
        )
      )
      ((= lunits 4) ; architectural
        (if (= (getvar "unitmode") 1)
          (setq ulist (list "0'0\"" "0'0-1/2\"" "0'0-1/4\"" "0'0-1/8\""
                       "0'0-1/16\"" "0'0-1/32\"" "0'0-1/64\""
                       "0'0-1/128\"" "0'0-1/256\"") )
          (setq ulist (list "0'-0\"" "0'-0 1/2\"" "0'-0 1/4\"" "0'-0 1/8\""
                       "0'-0 1/16\"" "0'-0 1/32\"" "0'-0 1/64\""
                       "0'-0 1/128\"" "0'-0 1/256\"") )
        )
      )
      ((= lunits 5) ; fractional
        (if (= (getvar "unitmode") 1)
          (setq ulist (list "0" "0-1/2" "0-1/4" "0-1/8" "0-1/16" "0-1/32"
                       "0-1/64" "0-1/128" "0-1/256") )
          (setq ulist (list "0" "0 1/2" "0 1/4" "0 1/8" "0 1/16" "0 1/32"
                       "0 1/64" "0 1/128" "0 1/256") )
        )
      )
    )
    (start_list "luprec")
    (mapcar 'add_list ulist)
    (end_list)
    (set_tile "luprec" (itoa luprec))
  )
  ;;
  ;; SET_ALIST - Sets Angles/Precision popup list.
  ;;
  (defun set_alist ()
    (cond
      ((= aunits 0) ; decimal degrees
        (setq alist (list "0" "0.0" "0.00" "0.000" "0.0000" "0.00000"
                       "0.000000" "0.0000000" "0.00000000"))
      )
      ((= aunits 1) ; degrees minutes seconds
        (setq alist (list "0d" "0d00'" "0d00'" "0d00'00\"" "0d00'00\""
                       "0d00'00.0\"" "0d00'00.00\"" "0d00'00.000\""
                        "0d00'00.0000\""))
      )
      ((= aunits 2) ; grads
        (setq alist (list "0g" "0.0g" "0.00g" "0.000g" "0.0000g"
                    "0.00000g" "0.000000g" "0.0000000g" "0.00000000g"))
      )
      ((= aunits 3) ; radians
        (setq alist (list "0r" "0.0r" "0.00r" "0.000r" "0.0000r" "0.00000r"
                        "0.000000r" "0.0000000r" "0.00000000r"))
      )
      ((= aunits 4) ; surveyor
        (if (= (getvar "unitmode") 1)
          (setq alist (list "N0dE" "N0d00'E" "N0d00'E"
                  "N0d00'00\"E" "N0d00'00\"E" "N0d00'00.0\"E"
           "N0d00'00.00\"E" "N0d00'00.000\"E" "N0d00'00.0000\"E"))
          (setq alist (list "N 0d E" "N 0d00' E" "N 0d00' E"
                  "N 0d00'00\" E" "N 0d00'00\" E" "N 0d00'00.0\" E"
           "N 0d00'00.00\" E" "N 0d00'00.000\" E" "N 0d00'00.0000\" E"))
        )
      )
    )
    (start_list "auprec")
    (mapcar 'add_list alist)
    (end_list)
    (set_tile "auprec" (itoa auprec))
  )
  ;;
  ;; SHOW_DIRECTION - Displays the Direction child dialog
  ;;
  (defun show_direction ()
    (if (not (new_dialog "direction" dcl_id))
      (exit)
    )
    ;;
    ;; Set appropriate angle zero information. (ANGBASE, ANGDIR)
    ;;
    (setq other 0)
    (cond
      ((equal abase 0.0 0.01)
        (set_tile "east" "1")
      )
;;**************************************************************************
;; Fixed by Ian A. White - WAI Engineering
;;      ((equal abase 1.57 0.01)
      ((equal abase (/ pi 2.0) 0.01)
;;**************************************************************************
        (if (= 1 angdir)
          (set_tile "south" "1")
          (set_tile "north" "1")
        )
      )
;;**************************************************************************
;; Fixed by Ian A. White - WAI Engineering
;;      ((equal abase 3.14 0.01)
      ((equal abase pi 0.01)
;;**************************************************************************
        (set_tile "west" "1")
      )
;;**************************************************************************
;; Fixed by Ian A. White - WAI Engineering
;;      ((equal abase 4.71 0.01)
      ((equal abase (* pi 1.5) 0.01)
;;**************************************************************************
        (if (= 1 angdir)
          (set_tile "north" "1")
          (set_tile "south" "1")
        )
      )
      (T
        (setq other 1)
        (set_tile "other" "1")
      )
    )
    (set_tile "angle_edit" (angtos (+ abase angbase) aunits auprec))
    (if (= other 0)
      (progn
        (mode_tile "angle_edit" 1)
        (mode_tile "angle_pick" 1)
      )
      (progn
        (mode_tile "angle_edit" 0)
        (mode_tile "angle_pick" 0)
      )
    )
    (cond
      ((= aunits 0) ; Decimal degrees
        (set_tile "zero" "  0.0")
        (set_tile "one_eighty" "180.0")
        (if (= 1 angdir)
          (progn
            (set_tile "ninety" "270.0")
            (set_tile "two_seventy" " 90.0")
          )
          (progn
            (set_tile "ninety" " 90.0")
            (set_tile "two_seventy" "270.0")
          )
        )
      )
      ((= aunits 1) ; Degrees minutes seconds
        (set_tile "zero" "  0d0'0''")
        (set_tile "one_eighty" "180d0'0''")
        (if (= 1 angdir)
          (progn
            (set_tile "ninety" "270d0'0''")
            (set_tile "two_seventy" " 90d0'0''")
          )
          (progn
            (set_tile "ninety" " 90d0'0''")
            (set_tile "two_seventy" "270d0'0''")
          )
        )
      )
      ((= aunits 2) ; Grads
        (set_tile "zero" "  0g")
        (set_tile "one_eighty" "200g")
        (if (= 1 angdir)
          (progn
            (set_tile "ninety" "300g")
            (set_tile "two_seventy" "100g")
          )
          (progn
            (set_tile "ninety" "100g")
            (set_tile "two_seventy" "300g")
          )
        )
      )
      ((= aunits 3) ; Radians
        (set_tile "zero" "0.0000r")
        (set_tile "one_eighty" "3.1416r")
        (if (= 1 angdir)
          (progn
            (set_tile "ninety" "4.7124r")
            (set_tile "two_seventy" "1.5708r")
          )
          (progn
            (set_tile "ninety" "1.5708r")
            (set_tile "two_seventy" "4.7124r")
          )
        )
      )
      ((= aunits 4) ; Surveyor
        (set_tile "zero" " E")
        (set_tile "ninety" " N")
        (set_tile "one_eighty" " W")
        (set_tile "two_seventy" " S")
      )
    )
    ;;
    ;; Set clockwise or counter-clockwise radio cluster
    ;;
    (if (= angdir 1)
      (set_tile "angle_dir_cw" "1")
      (set_tile "angle_dir_ccw" "1")
    )
    ;;
    ;; Dialog actions
    ;;
    (action_tile "east" "(news 0.0)")
;;**************************************************************************
;; Fixed by Ian A. White - WAI Engineering
;;    (action_tile "north" "(news 1.570796327)")
    (action_tile "north" "(news (/ pi 2.0))")
;;**************************************************************************
;;**************************************************************************
;; Fixed by Ian A. White - WAI Engineering
;;    (action_tile "west" "(news 3.141592654)")
    (action_tile "west" "(news pi)")
;;**************************************************************************
;;**************************************************************************
;; Fixed by Ian A. White - WAI Engineering
;;    (action_tile "south" "(news 4.71238898)")
;;**************************************************************************
    (action_tile "south" "(news (* pi 1.5))")
    (action_tile "other" "(do_other)")
    (action_tile "angle_edit" "(grab_angle)")
    (action_tile "angle_pick" "(done_dialog 3)")
    (action_tile "angle_dir_cw" "(setq angdir 1)")
    (action_tile "angle_dir_ccw" "(setq angdir 0)")
    (action_tile "accept" "(check_input)")
    (action_tile "cancel" "(done_dialog)")
    (setq what_next1 (start_dialog))
    (if (= 3 what_next1)
      (done_dialog 2)
    )
  )
  (defun news (r)
     (setq other 0)
     (set_tile "error" "")
     (setq abase r)
     (set_tile "angle_edit" (angtos (+ abase angbase) aunits auprec))
     (mode_tile "angle_edit" 1)
     (mode_tile "angle_pick" 1)
  )
  (defun do_other ()
    (setq other 1)
    (mode_tile "angle_pick" 0)
    (mode_tile "angle_edit" 0)
    (mode_tile "angle_edit" 2)
  )
  ;;
  ;;  SHOW_DIALOG - loads, initializes, displays the main dialogue.
  ;;
  (defun show_dialog ()
    (setq what_next 5)
    (setq what_next1 nil)
    ;;
    ;; Loads the dialogue "ddunits" from the id - dcl_id.
    ;;
    (while (< 1 what_next)
      (if (not (new_dialog "ddunits" dcl_id))
        (exit)
      )
      ;;
      ;; Set Units cluster according to value of LUNITS
      ;;
      (eval (nth (1- lunits) '(
              (set_tile "scientific" "1")
              (set_tile "decimal" "1")
              (set_tile "engineering" "1")
              (set_tile "architectural" "1")
              (set_tile "fractional" "1")
                              )
            )
      )
      ;;
      ;; Set Angles cluster according to value of AUNITS.
      ;;
      (eval (nth aunits '(
              (set_tile "decimal_deg" "1")
              (set_tile "dms" "1")
              (set_tile "grads" "1")
              (set_tile "radians" "1")
              (set_tile "surveyor_deg" "1")
                         )
            )
      )
      ;;
      ;; Set units and angles precision popup lists
      ;;
      (set_ulist)
      (set_alist)
      ;;
      ;; Actions for the Units/Angles dialogue.
      ;;
      (action_tile "scientific" "(setq lunits 1)(set_ulist)")
      (action_tile "decimal" "(setq lunits 2)(set_ulist)")
      (action_tile "engineering" "(setq lunits 3)(set_ulist)")
      (action_tile "architectural" "(setq lunits 4)(set_ulist)")
      (action_tile "fractional" "(setq lunits 5)(set_ulist)")
      (action_tile "luprec" "(setq luprec (atoi $value))")
      (action_tile "auprec" "(setq auprec (atoi $value))")
      (action_tile "decimal_deg" "(setq aunits 0)(set_alist)")
      (action_tile "dms" "(setq aunits 1)(set_alist)")
      (action_tile "grads" "(setq aunits 2)(set_alist)")
      (action_tile "radians" "(setq aunits 3)(set_alist)")
      (action_tile "surveyor_deg" "(setq aunits 4)(set_alist)")
      (action_tile "accept" "(s_unit)(setq f_done 1)(done_dialog)")
      (action_tile "cancel" "(done_dialog)(setq f_done 1)")
      (action_tile "dir" "(show_direction)")
      (action_tile "help" "(acad_helpdlg (ai_helpfile) \"ddunits\")")
      ;;
      ;; Display the main dialogue.
      ;;
      (cond
        ((= what_next1 3)
         (show_direction)
         (if (/= 3 what_next1)(setq what_next (start_dialog)))
        )
        (T (setq what_next (start_dialog)))
      )
      (cond
        ((= 2 what_next) (setq abase (getorient "\nPick angle: ")))
      )
    )
  )
  ;;
  ;; Pop up the dialogue.
  ;;
  (defun ddunits_main()
    ;;
    ;; Set initial checking flags.
    ;;
    (setq f_done 0)
    (setq other 0)
    ;;
    ;; Read system variables for program modification.
    ;;
    (setq angbase (getvar "ANGBASE"))
    (setq abase angbase) ; preserve original value of ANGBASE
    (setq angdir (getvar "ANGDIR"))
    (setq aunits (getvar "AUNITS"))
    (setq lunits (getvar "LUNITS"))
    (if (> (setq auprec (getvar "AUPREC")) 8)
      (setq auprec 8)
    )
    (if (> (setq luprec (getvar "LUPREC")) 8)
      (setq luprec 8)
    )
    ;;
    ;; Main loop.
    ;;
    (while (/= f_done 1)
      (show_dialog)
    )
  )

  ;; Set up error function.
  (setq old_cmd (getvar "cmdecho")    ; save current setting of cmdecho
        old_error  *error*            ; save current error function
        *error* ai_error              ; new error function
  )

  (setvar "cmdecho" 0)

  (cond
     (  (not (ai_trans)))                        ; transparent OK
     (  (not (ai_acadapp)))                      ; ACADAPP.EXP xloaded?
     (  (not (setq dcl_id (ai_dcl "ddunits"))))  ; is .DCL file loaded?
     (T
        (if (/= 1 (logand (getvar "cmdactive") 1)) (ai_undo_push))
        (ddunits_main)                           ; proceed!
        (if (/= 1 (logand (getvar "cmdactive") 1)) (ai_undo_pop))
     )
  )

  (setq *error* old_error)
  (setvar "cmdecho" old_cmd)
  (princ)
)

;;;------------------------------------------------------------------------

(princ "  DDUNITS loaded.")
(princ)