; Next available MSG number is    13 
; MODULE_ID DDUNITS_LSP_
;;;
;;;    ddunits.lsp
;;;
;;;    Copyright (C) 1992, 1994 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 the limited warranty and
;;;    restricted rights notice below appear in all supporting
;;;    documentation.
;;;
;;;    AUTODESK PROVIDES THIS PROGRAM "AS IS" AND WITH ALL FAULTS.
;;;    AUTODESK SPECIFICALLY DISCLAIMS ANY IMPLIED WARRANTY OF
;;;    MERCHANTABILITY OR FITNESS FOR A PARTICULAR USE.  AUTODESK, INC.
;;;    DOES NOT WARRANT THAT THE OPERATION OF THE PROGRAM WILL BE
;;;    UNINTERRUPTED OR ERROR FREE.
;;;
;;;    Use, duplication, or disclosure by the U.S. Government is subject to
;;;    restrictions set forth in FAR 52.227-19 (Commercial Computer
;;;    Software - Restricted Rights) and DFAR 252.227-7013(c)(1)(ii) 
;;;    (Rights in Technical Data and Computer Software), as applicable.
;;;
;;;.
;;;    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.
;;;----------------------------------------------------------------------
;;;
;;;==================== 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 ;|MSG0|;"ai_utils.lsp"))                     ; find it
        (ai_abort "DDUNITS"
                  (strcat "Can't locate file AI_UTILS.LSP."
                          "\n Check support directory.")))

     (  (eq ;|MSG0|;"failed" (load "ai_utils" ;|MSG0|;"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        fix_auprec 
                   aunits     lunits     tmp_base     undo_init
                   temp_angdir  temp_abase
                 )
  ;;
  ;; 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 ;|MSG0|;"other")))
      (if (not (setq tmp_base (angtof (get_tile ;|MSG0|;"angle_edit") aunits)))
        (progn
          (set_tile "error" "Invalid angle.")
          (mode_tile ;|MSG0|;"angle_edit" 2)
        )
        (progn
          (if (= temp_angdir 1)
            (cond 
             ((> 0 (- tmp_base angbase))
              (setq abase (+ (* 2 pi) (- tmp_base angbase)))
             )
             ((< (* 2 pi) (- tmp_base angbase))
              (setq abase (- (- tmp_base angbase) (* 2 pi)))
             )
             (t (setq abase (- tmp_base angbase)))
            )
          )
          (setq angdir temp_angdir)
          (done_dialog 1)
        )
      )
      (progn
        (setq abase temp_abase)
        (setq angdir temp_angdir)
        (done_dialog 1)
      )
    )
  )
  ;;
  ;; S_UNIT - sets the system variables - called when OK is pressed.
  ;;
  (defun s_unit ()
    (setvar "ANGDIR" angdir)
    (if (/= abase angbase)
      (setvar "ANGBASE" abase)
    )
    (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 ;|MSG0|;"error" "")
    (if (not (setq tmp_base (angtof (get_tile ;|MSG0|;"angle_edit") aunits)))
      (set_tile "error" "Invalid angle.")
      (progn
        (setq temp_abase (- tmp_base angbase))
        (set_tile ;|MSG0|;"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 ;|MSG0|;"luprec")
    (mapcar 'add_list ulist)
    (end_list)
    (set_tile ;|MSG0|;"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'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'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'00\" E" "N 0d00'00.0\" E"
           "N 0d00'00.00\" E" "N 0d00'00.000\" E" "N 0d00'00.0000\" E"))
        )
      )
    )
    (start_list ;|MSG0|;"auprec")
    (mapcar 'add_list alist)
    (end_list)
    ;; auprec 1 is equivalent to 2 for DMS and Surveyors.
    ;; likewise for auprec 3 and 4.
    (if (or (= aunits 1) (= 4 aunits))
      (progn
        (cond
          ((= 0 auprec)
            (set_tile ;|MSG0|;"auprec" "0")
          )
          ((or (= 1 auprec) (= 2 auprec))
            (set_tile ;|MSG0|;"auprec" "1")
          )
          ((or (= 3 auprec) (= 4 auprec))
            (set_tile ;|MSG0|;"auprec" "2")
          )
          ((> auprec 4)
            (set_tile ;|MSG0|;"auprec" (itoa (- auprec 2)))
          )
        )
      )
    ;else
      (set_tile ;|MSG0|;"auprec" (itoa auprec))
    )
  )
  ;;
  ;; Function to update the radio button states.
  ;;
  (defun do_news_buttons()
    (cond
      ((equal temp_abase 0.0 0.01)
        (set_tile ;|MSG0|;"east" "1")
      )
      ((equal temp_abase 1.57 0.01)
          (set_tile ;|MSG0|;"north" "1")
      )
      ((equal temp_abase 3.14 0.01)
        (set_tile ;|MSG0|;"west" "1")
      )
      ((equal temp_abase 4.71 0.01)
          (set_tile ;|MSG0|;"south" "1")
      )
      (T
        (setq other 1)
        (set_tile ;|MSG0|;"other" "1")
      )
    )
    (set_tile ;|MSG0|;"angle_edit" (angtos (+ temp_abase angbase) aunits auprec))

    (if (= other 0)
      (progn
        (mode_tile ;|MSG0|;"angle_edit" 1)
        (mode_tile ;|MSG0|;"angle_pick" 1)
      )
      (progn
        (mode_tile ;|MSG0|;"angle_edit" 0)
        (mode_tile ;|MSG0|;"angle_pick" 0)
      )
    )
    
  )
  ;;
  ;; Function to udate the radion button "angle" text.  Only North/South 
  ;; switch.
  ;;
  (defun do_text_update()
    (set_tile ;|MSG0|;"angle_edit" (angtos (+ temp_abase angbase) aunits auprec))

    (if (= other 0)
      (progn
        (mode_tile ;|MSG0|;"angle_edit" 1)
        (mode_tile ;|MSG0|;"angle_pick" 1)
      )
      (progn
        (mode_tile ;|MSG0|;"angle_edit" 0)
        (mode_tile ;|MSG0|;"angle_pick" 0)
      )
    )
    (cond
      ((= aunits 0) ; Decimal degrees
        (set_tile ;|MSG0|;"zero" "  0.0")
        (set_tile ;|MSG0|;"one_eighty" "180.0")
        (if (= 1 temp_angdir)
          (progn
            (set_tile ;|MSG0|;"ninety" "270.0")
            (set_tile ;|MSG0|;"two_seventy" " 90.0")
          )
          (progn
            (set_tile ;|MSG0|;"ninety" " 90.0")
            (set_tile ;|MSG0|;"two_seventy" "270.0")
          )
        )
      )
      ((= aunits 1) ; Degrees minutes seconds
        (set_tile ;|MSG0|;"zero" "  0d0'0''")
        (set_tile ;|MSG0|;"one_eighty" "180d0'0''")
        (if (= 1 temp_angdir)
          (progn
            (set_tile ;|MSG0|;"ninety" "270d0'0''")
            (set_tile ;|MSG0|;"two_seventy" " 90d0'0''")
          )
          (progn
            (set_tile ;|MSG0|;"ninety" " 90d0'0''")
            (set_tile ;|MSG0|;"two_seventy" "270d0'0''")
          )
        )
      )
      ((= aunits 2) ; Grads
        (set_tile ;|MSG0|;"zero" "  0g")
        (set_tile ;|MSG0|;"one_eighty" "200g")
        (if (= 1 temp_angdir)
          (progn
            (set_tile ;|MSG0|;"ninety" "300g")
            (set_tile ;|MSG0|;"two_seventy" "100g")
          )
          (progn
            (set_tile ;|MSG0|;"ninety" "100g")
            (set_tile ;|MSG0|;"two_seventy" "300g")
          )
        )
      )
      ((= aunits 3) ; Radians
        (set_tile ;|MSG0|;"zero" "0.0000r")
        (set_tile ;|MSG0|;"one_eighty" "3.1416r")
        (if (= 1 temp_angdir)
          (progn
            (set_tile ;|MSG0|;"ninety" "4.7124r")
            (set_tile ;|MSG0|;"two_seventy" "1.5708r")
          )
          (progn
            (set_tile ;|MSG0|;"ninety" "1.5708r")
            (set_tile ;|MSG0|;"two_seventy" "4.7124r")
          )
        )
      ) 
      ((= aunits 4) ; Surveyor
        (set_tile ;|MSG0|;"zero" " E")
        (set_tile ;|MSG0|;"ninety" " N")
        (set_tile ;|MSG0|;"one_eighty" " W")
        (set_tile ;|MSG0|;"two_seventy" " S")
      ) 
    )
  )
  ;;
  ;; SHOW_DIRECTION - Displays the Direction child dialog
  ;;
  (defun show_direction ()
    (if (not (new_dialog ;|MSG0|;"direction" dcl_id))
      (exit)
    )
    ;; Temp variables in case user cancels.
    (if (not temp_abase)
      (setq temp_abase abase)
    )
    (if (not temp_angdir)
      (setq temp_angdir angdir)
    )
    ;;
    ;; Set appropriate angle zero information. (ANGBASE, ANGDIR)
    ;;
    (setq other 0)
    (do_news_buttons)
    (do_text_update)
    ;;
    ;; Set clockwise or counter-clockwise radio cluster
    ;;
    (if (= temp_angdir 1)
      (set_tile ;|MSG0|;"angle_dir_cw" "1")
      (set_tile ;|MSG0|;"angle_dir_ccw" "1")
    )
    ;;
    ;; Dialog actions
    ;;
    (action_tile ;|MSG0|;"east" "(news 0.0)")
    (action_tile ;|MSG0|;"north" "(news 1.570796327)")
    (action_tile ;|MSG0|;"west" "(news 3.141592654)")
    (action_tile ;|MSG0|;"south" "(news 4.71238898)")
    (action_tile ;|MSG0|;"other" "(do_other)")
    (action_tile ;|MSG0|;"angle_edit" "(grab_angle)")
    (action_tile ;|MSG0|;"angle_pick" "(done_dialog 3)")
    (action_tile ;|MSG0|;"angle_dir_cw" "(setq temp_angdir 1)(do_text_update)")
    (action_tile ;|MSG0|;"angle_dir_ccw" "(setq temp_angdir 0)(do_text_update)")
    (action_tile ;|MSG0|;"accept" "(check_input)") 
    (action_tile ;|MSG0|;"cancel" "(done_dialog 0)")
    (setq what_next1 (start_dialog))
    (if (= 3 what_next1)
      (done_dialog 2)
    )
    (if (= 0 what_next1)
      (progn
        (setq temp_angdir nil)
        (setq temp_abase nil)
      )
    )
  )
  (defun news (r)
     (setq other 0)
     (set_tile ;|MSG0|;"error" "")
     (cond 
       ((and (equal r 1.5707  0.0001)
             (= 1 temp_angdir)
        )
         (setq r 4.71238898)
       )
       ((and (equal r 4.712 0.0001)
            (= 1 temp_angdir)
        )
         (setq r 1.570796327)
       )
       (t)
     )
     (setq temp_abase r)
     (set_tile ;|MSG0|;"angle_edit" (angtos (+ temp_abase angbase) aunits auprec))
     (mode_tile ;|MSG0|;"angle_edit" 1)
     (mode_tile ;|MSG0|;"angle_pick" 1)
  )
  (defun do_other ()
    (setq other 1)
    (mode_tile ;|MSG0|;"angle_pick" 0)
    (mode_tile ;|MSG0|;"angle_edit" 0)
    (mode_tile ;|MSG0|;"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 ;|MSG0|;"ddunits" dcl_id))
        (exit)
      )
      ;;
      ;; Set Units cluster according to value of LUNITS
      ;;
      (eval (nth (1- lunits) '(
              (set_tile ;|MSG0|;"scientific" "1")
              (set_tile ;|MSG0|;"decimal" "1")
              (set_tile ;|MSG0|;"engineering" "1")
              (set_tile ;|MSG0|;"architectural" "1")
              (set_tile ;|MSG0|;"fractional" "1")
                              )
            )
      )
      ;;
      ;; Set Angles cluster according to value of AUNITS.
      ;;
      (eval (nth aunits '(
              (set_tile ;|MSG0|;"decimal_deg" "1")
              (set_tile ;|MSG0|;"dms" "1")
              (set_tile ;|MSG0|;"grads" "1")
              (set_tile ;|MSG0|;"radians" "1")
              (set_tile ;|MSG0|;"surveyor_deg" "1")
                         ) 
            )
      )
      ;;
      ;; Set units and angles precision popup lists
      ;;
      (set_ulist)
      (set_alist)
      ;;
      ;; Actions for the Units/Angles dialogue.
      ;;
      (action_tile ;|MSG0|;"scientific" "(setq lunits 1)(set_ulist)")
      (action_tile ;|MSG0|;"decimal" "(setq lunits 2)(set_ulist)")
      (action_tile ;|MSG0|;"engineering" "(setq lunits 3)(set_ulist)")
      (action_tile ;|MSG0|;"architectural" "(setq lunits 4)(set_ulist)")
      (action_tile ;|MSG0|;"fractional" "(setq lunits 5)(set_ulist)")
      (action_tile ;|MSG0|;"luprec" "(setq luprec (atoi $value))")
      (action_tile ;|MSG0|;"auprec" "(fix_auprec (atoi $value))")
      (action_tile ;|MSG0|;"decimal_deg" "(setq aunits 0)(set_alist)")
      (action_tile ;|MSG0|;"dms" "(setq aunits 1)(set_alist)")
      (action_tile ;|MSG0|;"grads" "(setq aunits 2)(set_alist)")
      (action_tile ;|MSG0|;"radians" "(setq aunits 3)(set_alist)")
      (action_tile ;|MSG0|;"surveyor_deg" "(setq aunits 4)(set_alist)")
      (action_tile ;|MSG0|;"accept" "(s_unit)(setq f_done 1)(done_dialog 1)") 
      (action_tile ;|MSG0|;"cancel" "(done_dialog 0)(setq f_done 1)")
      (action_tile ;|MSG0|;"dir" "(show_direction)")
      (action_tile ;|MSG0|;"help" "(help \"\" \"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 temp_abase (getorient "\nPick angle: "))
        )
      )
    )
  )
  (defun fix_auprec (value)
    (setq auprec value)
    ;; auprec 1 is equivalent to 2 for DMS and Surveyors.
    ;; likewise for auprec 3 and 4.
    (if (or (= aunits 1) (= 4 aunits))
      (progn
        (cond
          ( (= 0 value)
            (setq auprec 0)
          )
          ( (= 1 value) 
            (setq auprec 1)
          )
          ( (= 2 value)
            (setq auprec 3)
          )
          ( (> value 2)
            (setq auprec (+ 2 value))
          )
        )
      )
    ;else
      (set_tile ;|MSG0|;"auprec" (itoa auprec))
    )
  )
  ;;
  ;; 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 ;|MSG0|;"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)

