;;;------------------------------------------------------------------------
;;;  DDATTDEF.LSP
;;;  Copyright (C) 1992 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
;;;
;;;  This is an enhancement to the ATTDEF command. It loads up a dialogue box
;;;  which presents the user the set of options for attribute definition.
;;;
;;;------------------------------------------------------------------------
;;;   Prefixes in command and keyword strings: 
;;;      "."  specifies the built-in AutoCAD command in case it has been        
;;;           redefined.
;;;      "_"  denotes an AutoCAD command or keyword in the native language
;;;           version, English.
;;;------------------------------------------------------------------------
;;;
;;; ===================== 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 "DDATTDEF"
                  (strcat "Can't locate file AI_UTILS.LSP."
                          "\n Check support directory.")))

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

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

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

(defun c:ddattdef ( /
                   aflags       def_val      pt2          x_temp
                   align_prev   height       rot          y_pt
                   att_exist    i            style_list   y_temp
                   att_prompt   justif_list  tag          z_pt
                   att_tag      old_cmd      tstyle p     z_temp
                   c            old_error    v            
                   cjustif      p            what_next
                   dcl_id       pt           x_pt         undo_init
                  )

  (setq aflags (getvar "aflags"))  ; Get attribute mode system variable

  ;;
  ;;  This function creates 2 lists. The first one: style_list is a list of 
  ;;  available text styles. The second one: justif_list is a list of text 
  ;;  justifications.
  ;;
  (defun load_list ()
    
    (setq style_list (ai_table "style" 4))
    (if (>= (getvar "maxsort") (length style_list))
      (setq style_list (acad_strlsort style_list))
    )
    (setq justif_list (list "Left"     "Align"     "Fit"       "Center"
                            "Middle"   "Right"     
                            "Top Left"      "Top Center"    "Top Right" 
                            "Middle Left"   "Middle Center" "Middle Right"
                            "Bottom Left"   "Bottom Center" "Bottom Right"
                      )
    )
  )
  ;;
  ;;  Initilization of variables.
  ;;
  (defun init_variables ()
    (setq tstyle
            (itoa (- (length style_list)
                  (length (member (strcase (getvar "textstyle")) style_list))
                  ))
          cjustif    "0"
          height     (rtos (getvar "textsize"))
          att_exist  (ssget "x" (list (cons 0 "attdef")))
          what_next  5
          align_prev "0"
    )
    (if (not pt) (setq pt (list 0.0 0.0 0.0)))

    (setq x_pt (rtos (car pt))
          y_pt (rtos (cadr pt))
          z_pt (rtos (caddr pt))
    )
    (if (not rot) (setq rot (angtos 0.0)))
  )
  ;;
  ;;  Initialization of tiles. Called in main program loop.
  ;;
  (defun init_tiles ()
    (if att_tag (set_tile "att_tag" att_tag))
    (if att_prompt (set_tile "att_prompt" att_prompt))
    (if def_val (set_tile "def_val" def_val))
    (if (not att_exist)
      (mode_tile "align_prev" 1)
      (set_tile "align_prev" align_prev)
    )

    ;parse attribute mode local variable "aflags" in case it changed,
    ;for setting state of mode radio buttons.
    (if (/= 0 (logand 1 aflags))
      (setq i "1") 
      (setq i "0")
    )
    (if (/= 0 (logand 2 aflags)) 
      (progn (setq c "1") (prompt_set))
      (setq c "0")
    )
    (if (/= 0 (logand 4 aflags)) 
      (setq v "1") 
      (setq v "0")
    )
    (if (/= 0 (logand 8 aflags)) 
      (setq p "1") 
      (setq p "0")
    )

    (set_tile "invisible" i)
    (set_tile "constant" c)
    (set_tile "verify" v)
    (set_tile "preset" p)

    (set_tile "x_pt" x_pt)
    (set_tile "y_pt" y_pt)
    (set_tile "z_pt" z_pt)

    (start_list "tstyle")
    (mapcar 'add_list style_list)
    (end_list)
    (set_tile "tstyle" tstyle)

    (start_list "cjustif")
    (mapcar 'add_list justif_list)
    (end_list)
    (set_tile "cjustif" cjustif)

    (set_tile "height" height)

    (set_tile "rot" rot)

    (cond                                      ; set focus
      ((= 2 what_next)(mode_tile "x_pt" 2))
      ((= 3 what_next)(mode_tile "height" 2))
      ((= 4 what_next)(mode_tile "rot" 2))
      ((= 5 what_next)(mode_tile "att_tag" 2))
    )
  )
  ;;
  ;; If the current justification is aligned or if the current text style has
  ;; a non zero height, disable the height button and edit box.  Also 
  ;; disable/enable rotation if justification is fit or align.
  ;;
  (defun grey_height()
    (if (or (= 1 (atoi cjustif))
            (/= 0.0 (cdr (cadddr 
                           (tblsearch "style" (nth (atoi tstyle) style_list))
            )))
        )
      (progn 
        (mode_tile "height" 1)
        (mode_tile "bheight" 1)
      )
      (progn 
        (mode_tile "height" 0)
        (mode_tile "bheight" 0)
      )
    )
    (if (or (= 1 (atoi cjustif)) 
            (= 2 (atoi cjustif))
        )
      (progn
        (mode_tile "rot" 1)
        (mode_tile "brot" 1)
      )
      (progn
        (mode_tile "rot" 0)
        (mode_tile "brot" 0)
      )
    )
  )
  ;;
  ;; Update the local aflags variable (attribute mode).
  ;;
  (defun update_aflags()
    (setq aflags 0)
    (if (= "1" i) (setq aflags (+ 1 aflags)))
    (if (= "1" c) (setq aflags (+ 2 aflags))) 
    (if (= "1" v) (setq aflags (+ 4 aflags))) 
    (if (= "1" p) (setq aflags (+ 8 aflags))) 
  )
  ;;
  ;; Reset the error tile to nil.
  ;;
  (defun rs_error()
    (set_tile "error" "")
  )
  ;;
  ;;  Get all the actions associated with each tile.
  ;;
  (defun get_actions ()
    (action_tile "invisible"  "(setq i $value)(update_aflags)")
    (action_tile "constant"   "(setq c $value)(prompt_set)(update_aflags)")
    (action_tile "verify"     "(setq v $value)(update_aflags)")
    (action_tile "preset"     "(setq p $value)(update_aflags)")
    (action_tile "att_tag"    "(rs_error)(tag_check (setq att_tag $value))")
    (action_tile "att_prompt" "(rs_error)(setq att_prompt $value)")
    (action_tile "def_val"    "(rs_error)(setq def_val $value)")
    (action_tile "pick_pt" "(get_tag)(done_dialog 2)")

    (action_tile "align_prev" 
                 "(rs_error)(setq align_prev $value)(en_dis_able)")
    (action_tile "x_pt" 
                 "(rs_error)(ai_num (setq x_pt $value) \"Invalid X coordinate.\" 0)")
    (action_tile "y_pt" 
                 "(rs_error)(ai_num (setq y_pt $value) \"Invalid Y coordinate.\" 0)")
    (action_tile "z_pt" 
                 "(rs_error)(ai_num (setq z_pt $value) \"Invalid Z coordinate.\" 0)")

    (action_tile "cjustif" "(rs_error)(setq cjustif $value) (grey_height)")
    (action_tile "tstyle"  "(rs_error)(setq tstyle $value)(grey_height)")
    (action_tile "height" 
                 "(rs_error)(ai_num (setq height $value) \"Invalid Height.\" 6)")
    (action_tile "bheight" "(get_tag)(done_dialog 3)")
    (action_tile "rot" 
                 "(rs_error)(ai_angle (setq rot $value) \"Invalid Rotation angle.\")")
    (action_tile "brot" "(get_tag)(done_dialog 4)")
    (action_tile "accept"  "(check_input)")
    (action_tile "cancel"  "(done_dialog 0)")
    (action_tile "help"    "(acad_helpdlg \"acad.hlp\" \"ddattdef\")")

    (setq what_next (start_dialog))
    (cond
      ; Drops dialogue box temporarily and lets user pick a point.
      ((= 2 what_next) 
        (initget 1)
        (setq pt (getpoint "\nStart point: ")
              x_pt (rtos (car pt))
              y_pt (rtos (cadr pt))
              z_pt (rtos (caddr pt))
        )
      )
      ; Drops dialogue box temporarily and lets user pick a height.
      ((= 3 what_next)
        (temp_pt)
        (initget 1)
        (setq height (rtos (getdist pt "\nHeight: ")))
      )
      ; Drops dialogue box temporarily and lets user pick an angle.
      ((= 4 what_next)
        (temp_pt)
        (initget 1)
        (setq rot (angtos (getangle pt "\nRotation angle: ")))
      )
    )
  )
  (defun get_tag ()
    (setq att_tag (get_tile "att_tag"))
    (setq att_prompt (get_tile "att_prompt"))
    (setq def_val (get_tile "def_val"))
  )
  ;;
  ;; When picking height and rotation from the graphics screen a base point
  ;; of the Start Point is used.  However, the X, Y or Z fields could 
  ;; contain invalid information, so these fields have to be checked and
  ;; if the data is invalid, a coordinate of 0.0 is used.
  ;;
  (defun temp_pt()
    (if (not (setq x_temp (distof x_pt))) (setq x_temp 0.0))
    (if (not (setq y_temp (distof y_pt))) (setq y_temp 0.0))
    (if (not (setq z_temp (distof z_pt))) (setq z_temp 0.0))
    (setq pt (list x_temp y_temp z_temp))
  )
  ;;
  ;;  Enables and disables the pick point feature if action_tile
  ;;  "next" is picked. The "next" action tile is enabled only if
  ;;  an attribute has been previously defined. The function of
  ;;  "next" is to place the attribute right under the previously
  ;;  defined attribute.
  ;;
  (defun en_dis_able ()
    (if (= 1 (atoi align_prev))
      (progn
        (mode_tile "pick_pt" 1)
        (mode_tile "x_pt" 1)
        (mode_tile "y_pt" 1)
        (mode_tile "z_pt" 1)
        (mode_tile "cjustif" 1)
        (mode_tile "tstyle" 1)
        (mode_tile "height" 1)
        (mode_tile "bheight" 1)
        (mode_tile "rot" 1)
        (mode_tile "brot" 1)
      )
      (progn
        (mode_tile "pick_pt" 0)
        (mode_tile "x_pt" 0)
        (mode_tile "y_pt" 0)
        (mode_tile "z_pt" 0)
        (mode_tile "cjustif" 0)
        (mode_tile "tstyle" 0)
        (mode_tile "height" 0)
        (mode_tile "bheight" 0)
        (mode_tile "rot" 0)
        (mode_tile "brot" 0)
        (grey_height)                ; Height could still be disabled.
      )
    )
  ) 
  ;;
  ;;  Enables or disables the attribute prompt tile. If constant is turned on
  ;;  then attribute prompt is disabled. If not, attribute prompt is enabled.
  ;;
  (defun prompt_set ()
    (if (= c "1")
      (progn 
        (mode_tile "att_prompt" 1)
        (mode_tile "verify" 1)
        (mode_tile "preset" 1)
      )
      (progn
        (mode_tile "att_prompt" 0)
        (mode_tile "verify" 0)
        (mode_tile "preset" 0)
      )
    )
  )
  ;;
  ;;  Checks the validity of a tag and return the tag name if correct
  ;;  and nil otherwise.  
  ;;
  (defun tag_check (tag)
    (cond 
      ((= "" tag)
        (set_tile "error" "Null Tag not allowed.")
        nil
      )
      ((wcmatch tag "* *")
        (set_tile "error" "Invalid blanks in Tag.")
        nil
      )
      (T tag)
    )
  )
  ;;
  ;;  check_input is called when Ok button is picked. Uses tag_check to check 
  ;;  the tag for invalid values such as a space or an empty string.  Convert
  ;;  strings to reals where necessary.
  ;;
  (defun check_input()
    (setq att_tag (get_tile "att_tag"))
    (cond 
      ((not (tag_check (get_tile "att_tag")))(mode_tile "att_tag" 2))
      ((and (= 0 (atoi align_prev))
            (not (setq x_pt 
                       (ai_num (get_tile "x_pt") "Invalid X coordinate." 0))
            )
       )
        (mode_tile "x_pt" 2)
      )
      ((and (= 0 (atoi align_prev))
            (not (setq y_pt 
                       (ai_num (get_tile "y_pt") "Invalid Y coordinate." 0))
            )
       )
        (mode_tile "y_pt" 2)
      )
      ((and (= 0 (atoi align_prev))
            (not (setq z_pt 
                       (ai_num (get_tile "z_pt") "Invalid Z coordinate." 0))
            )
       )
        (mode_tile "z_pt" 2)
      )
      ((and (= 0 (atoi align_prev))
            (not (or (= 1 (atoi cjustif))
                     (/= 0.0 (cdr (cadddr (tblsearch "style" (nth (atoi tstyle) style_list)))))
                 )
            )
            (not (setq height 
                       (ai_num (get_tile "height") "Invalid Height." 6))
            )
       )(mode_tile "height" 2)
      )
      ((and (= 0 (atoi align_prev))
            (not (or (= 1 (atoi cjustif))
                     (= 2 (atoi cjustif))
            ))
            (not (setq rot 
                       (ai_angle (get_tile "rot") "Invalid Rotation angle."))
            )
       )
        (mode_tile "rot" 2)
      )
      (T (setq pt (list x_pt y_pt z_pt))(done_dialog 1))
    )
  )   
  ;;
  ;;  Function actually starts the attribute definition command.
  ;;
  (defun start_command ()
    (setvar "aflags" aflags)
    (setvar "textstyle" (nth (atoi tstyle) style_list))

    (command "_.attdef" "")
    (command att_tag)
    (if (= c "0") 
      (progn 
        (if att_prompt       
          (command att_prompt)
          (command "")
        )
      )
    )
    (if def_val 
      (command def_val)
      (command "")
    )
    (if (= 0 (atoi align_prev))
      (progn
        (cond 
          ((= (atoi cjustif) 0)  ;  left
            (command (list x_pt y_pt z_pt))
          )
          ((= (atoi cjustif) 1)  ;  aligned
            (setq pt (getpoint "\nFirst text line point: ")
                  pt2 (getpoint pt "\nSecond text line point: ")
            )
            (command "_j" "_a" pt pt2)
          )
          ((= (atoi cjustif) 2)  ;  fit
            (setq pt (getpoint "\nFirst text line point: ")
                  pt2 (getpoint pt "\nSecond text line point: ")
            )
            (command "_j" "_f" pt pt2)
          )
          ((= (atoi cjustif) 3)  ;  center
            (command "_j" "_c" pt)
          )
          ((= (atoi cjustif) 4)  ;  middle
            (command "_j" "_m" pt)
          )
          ((= (atoi cjustif) 5)  ;  right
            (command "_j" "_r" pt)
          )
          ((= (atoi cjustif) 6)  ;  top left
            (command "_j" "_tl" pt)
          )
          ((= (atoi cjustif) 7)  ;  top center
            (command "_j" "_tc" pt)
          )
          ((= (atoi cjustif) 8)  ;  top right
            (command "_j" "_tr" pt)
          )
          ((= (atoi cjustif) 9)  ;  middle left
            (command "_j" "_ml" pt)
          )
          ((= (atoi cjustif) 10)  ;  middle center
            (command "_j" "_mc" pt)
          )
          ((= (atoi cjustif) 11)  ;  middle right
            (command "_j" "_mr" pt)
          )
          ((= (atoi cjustif) 12)  ;  bottom left
            (command "_j" "_bl" pt)
          )
          ((= (atoi cjustif) 13)  ;  bottom center
            (command "_j" "_bc" pt)
          )
          ((= (atoi cjustif) 14)  ;  bottom right
            (command "_j" "_br" pt)
          )
        )
        (if (not (or (= 1 (atoi cjustif))
                     (/= 0.0 (cdr (cadddr (tblsearch "style" 
                                            (nth (atoi tstyle) style_list)))
                             )
                     )
                 )
            )
          (command height)
        )
        (if (not (or (= 1 (atoi cjustif))
                     (= 2 (atoi cjustif))
                 )
            )
          (command rot)
        )
      )
      (command "") ; if user picks next for start point then the
                   ; attribute tag goes to the line below the
                   ; previous tag.
    )
  )
  ;;
  ;; Pop up the dialogue.
  ;;
  (defun ddattdef_main()

    (setq height (rtos (getvar "textsize")))
    (load_list)
    (init_variables)
    (while (> what_next 1)
      (if (not (new_dialog "ddattdef" dcl_id))
        (exit)
      )
      (init_tiles)
      (grey_height)
      (get_actions)
    )
    (if (= 1 what_next) (start_command))
  )

  ;; 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_notrans)))                        ; transparent not OK
     (  (not (ai_acadapp)))                        ; ACADAPP.EXP xloaded?
     (  (not (setq dcl_id (ai_dcl "ddattdef"))))   ; is .DCL file loaded?
     (T (ai_undo_push)
        (ddattdef_main)                            ; proceed!
        (ai_undo_pop)
     )                          
  )

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

;;;---------------------------------------------------------------------------;
(princ "  DDATTDEF loaded.")
(princ)
