; Next available MSG number is    34 
; MODULE_ID DDATTDEF_LSP_
;;;
;;;    ddattdef.lsp
;;;    
;;;    Copyright (C) 1990, 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
;;;
;;;  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 ;|MSG0|;"ai_utils.lsp"))                     ; find it
        (ai_abort "DDATTDEF"
                  (strcat "Can't locate file AI_UTILS.LSP."
                          "\n Check support directory.")))

     (  (eq ;|MSG0|;"failed" (load "ai_utils" ;|MSG0|;"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            update_rot
                   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 ;|MSG0|;"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 (/ rot_temp)
    (setq tstyle
            (itoa (- (length style_list)
                  (length (member (strcase (getvar "textstyle")) style_list))
                  ))
          cjustif    "0"
          height     (rtos (getvar "textsize"))
          att_exist  (ssget ;|MSG0|;"_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 (= 4 (logand 4 (cdr (assoc '70 (tblsearch "style" (getvar "textstyle"))))))
      (setq rot_temp (/ (* 3 pi) 2))
      (setq rot_temp 0.0)
    )
    (if (not rot) (setq rot (angtos rot_temp)))
  )
  ;;
  ;;  Initialization of tiles. Called in main program loop.
  ;;
  (defun init_tiles ()
    (if att_tag (set_tile ;|MSG0|;"att_tag" att_tag))
    (if att_prompt (set_tile ;|MSG0|;"att_prompt" att_prompt))
    (if def_val (set_tile ;|MSG0|;"def_val" def_val))
    (if (not att_exist)
      (mode_tile ;|MSG0|;"align_prev" 1)
      (set_tile ;|MSG0|;"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 ;|MSG0|;"invisible" i)
    (set_tile ;|MSG0|;"constant" c)
    (set_tile ;|MSG0|;"verify" v)
    (set_tile ;|MSG0|;"preset" p)

    (set_tile ;|MSG0|;"x_pt" x_pt)
    (set_tile ;|MSG0|;"y_pt" y_pt)
    (set_tile ;|MSG0|;"z_pt" z_pt)

    (start_list ;|MSG0|;"tstyle")
    (mapcar 'add_list style_list)
    (end_list)
    (set_tile ;|MSG0|;"tstyle" tstyle)

    (start_list ;|MSG0|;"cjustif")
    (mapcar 'add_list justif_list)
    (end_list)
    (set_tile ;|MSG0|;"cjustif" cjustif)

    (set_tile ;|MSG0|;"height" height)

    (set_tile ;|MSG0|;"rot" rot)

    (cond                                      ; set focus
      ((= 2 what_next)(mode_tile ;|MSG0|;"x_pt" 2))
      ((= 3 what_next)(mode_tile ;|MSG0|;"height" 2))
      ((= 4 what_next)(mode_tile ;|MSG0|;"rot" 2))
      ((= 5 what_next)(mode_tile ;|MSG0|;"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 ;|MSG0|;"style" (nth (atoi tstyle) style_list))
            )))
        )
      (progn 
        (mode_tile ;|MSG0|;"height" 1)
        (mode_tile ;|MSG0|;"bheight" 1)
      )
      (progn 
        (mode_tile ;|MSG0|;"height" 0)
        (mode_tile ;|MSG0|;"bheight" 0)
      )
    )
    (if (or (= 1 (atoi cjustif)) 
            (= 2 (atoi cjustif))
        )
      (progn
        (mode_tile ;|MSG0|;"rot" 1)
        (mode_tile ;|MSG0|;"brot" 1)
      )
      (progn
        (mode_tile ;|MSG0|;"rot" 0)
        (mode_tile ;|MSG0|;"brot" 0)
      )
    )
  )
  (defun update_rot()
    (if (= 4 (logand 4 (cdr (assoc '70 (tblsearch "style" (nth (atoi tstyle) style_list))))))
      (set_tile "rot" (setq rot (angtos (/ (* 3 pi) 2))))
      (set_tile "rot" (setq rot (angtos 0.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 ;|MSG0|;"error" "")
  )
  ;;
  ;;  Get all the actions associated with each tile.
  ;;
  (defun get_actions ()
    (action_tile ;|MSG0|;"invisible"  "(setq i $value)(update_aflags)")
    (action_tile ;|MSG0|;"constant"   "(setq c $value)(prompt_set)(update_aflags)")
    (action_tile ;|MSG0|;"verify"     "(setq v $value)(update_aflags)")
    (action_tile ;|MSG0|;"preset"     "(setq p $value)(update_aflags)")
    (action_tile ;|MSG0|;"att_tag"    "(rs_error)(tag_check (setq att_tag $value))")
    (action_tile ;|MSG0|;"att_prompt" "(rs_error)(setq att_prompt $value)")
    (action_tile ;|MSG0|;"def_val"    "(rs_error)(setq def_val $value)")
    (action_tile ;|MSG0|;"pick_pt" "(get_tag)(done_dialog 2)")

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

    (action_tile ;|MSG0|;"cjustif" "(rs_error)(setq cjustif $value) (grey_height)")
    (action_tile ;|MSG0|;"tstyle"  "(rs_error)(setq tstyle $value)(grey_height)(update_rot)")
    (setq cmd_coor (strcat "(rs_error)(ai_num (setq height $value) \""
		           "Invalid Height."
		           "\" 6)"))
    (action_tile ;|MSG0|;"height" cmd_coor)
    (action_tile ;|MSG0|;"bheight" "(get_tag)(done_dialog 3)")
    (setq cmd_coor (strcat "(rs_error)(ai_angle (setq rot $value) \""
		           "Invalid Rotation angle."
			   "\")"))
    (action_tile ;|MSG0|;"rot" cmd_coor)
    (action_tile ;|MSG0|;"brot" "(get_tag)(done_dialog 4)")
    (action_tile ;|MSG0|;"accept"  "(check_input)")
    (action_tile ;|MSG0|;"cancel"  "(done_dialog 0)")
    (action_tile ;|MSG0|;"help"    "(help \"\" \"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 ;|MSG0|;"att_tag"))
    (setq att_prompt (get_tile ;|MSG0|;"att_prompt"))
    (setq def_val (get_tile ;|MSG0|;"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 (and (= 'STR (type x_pt))
             (not (setq x_temp (distof x_pt))) 
        )
      (setq x_temp 0.0)
    )
    (if (and (= 'STR (type y_pt))
             (not (setq y_temp (distof y_pt))) 
        )
      (setq y_temp 0.0)
    )
    (if (and (= 'STR (type z_pt))
             (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 ;|MSG0|;"pick_pt" 1)
        (mode_tile ;|MSG0|;"x_pt" 1)
        (mode_tile ;|MSG0|;"y_pt" 1)
        (mode_tile ;|MSG0|;"z_pt" 1)
        (mode_tile ;|MSG0|;"cjustif" 1)
        (mode_tile ;|MSG0|;"tstyle" 1)
        (mode_tile ;|MSG0|;"height" 1)
        (mode_tile ;|MSG0|;"bheight" 1)
        (mode_tile ;|MSG0|;"rot" 1)
        (mode_tile ;|MSG0|;"brot" 1)
      )
      (progn
        (mode_tile ;|MSG0|;"pick_pt" 0)
        (mode_tile ;|MSG0|;"x_pt" 0)
        (mode_tile ;|MSG0|;"y_pt" 0)
        (mode_tile ;|MSG0|;"z_pt" 0)
        (mode_tile ;|MSG0|;"cjustif" 0)
        (mode_tile ;|MSG0|;"tstyle" 0)
        (mode_tile ;|MSG0|;"height" 0)
        (mode_tile ;|MSG0|;"bheight" 0)
        (mode_tile ;|MSG0|;"rot" 0)
        (mode_tile ;|MSG0|;"brot" 0)
        (grey_height)                ; Height could still be disabled.
        (update_rot)
      )
    )
  ) 
  ;;
  ;;  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 ;|MSG0|;"att_prompt" 1)
        (mode_tile ;|MSG0|;"verify" 1)
        (mode_tile ;|MSG0|;"preset" 1)
      )
      (progn
        (mode_tile ;|MSG0|;"att_prompt" 0)
        (mode_tile ;|MSG0|;"verify" 0)
        (mode_tile ;|MSG0|;"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 ;|MSG0|;"att_tag"))
    (cond 
      ((not (tag_check (get_tile ;|MSG0|;"att_tag")))(mode_tile ;|MSG0|;"att_tag" 2))
      ((and (= 0 (atoi align_prev))
            (not 
              (ai_num (get_tile ;|MSG0|;"x_pt") "Invalid X coordinate." 0)
            )
       )
        (mode_tile ;|MSG0|;"x_pt" 2)
      )
      ((and (= 0 (atoi align_prev))
            (not 
              (ai_num (get_tile ;|MSG0|;"y_pt") "Invalid Y coordinate." 0)
            )
       )
        (mode_tile ;|MSG0|;"y_pt" 2)
      )
      ((and (= 0 (atoi align_prev))
            (not 
              (ai_num (get_tile ;|MSG0|;"z_pt") "Invalid Z coordinate." 0)
            )
       )
        (mode_tile ;|MSG0|;"z_pt" 2)
      )
      ((and (= 0 (atoi align_prev))
            (not (or (= 1 (atoi cjustif))
                     (/= 0.0 (cdr (cadddr (tblsearch ;|MSG0|;"style" (nth (atoi tstyle) style_list)))))
                 )
            )
            (not 
              (ai_num (get_tile ;|MSG0|;"height") "Invalid Height." 6)
            )
       )(mode_tile ;|MSG0|;"height" 2)
      )
      ((and (= 0 (atoi align_prev))
            (not (or (= 1 (atoi cjustif))
                     (= 2 (atoi cjustif))
            ))
            (not 
              (ai_angle (get_tile ;|MSG0|;"rot") "Invalid Rotation angle.")
            )
       )
        (mode_tile ;|MSG0|;"rot" 2)
      )

      (T (setq pt (list (distof x_pt) (distof y_pt) (distof 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 (distof x_pt) (distof y_pt) (distof 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" "1,1,1")  ;;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 (assoc 40 (tblsearch ;|MSG0|;"style" 
                                            (nth (atoi tstyle) style_list)))
                             )
                     )
                 )
            )
          (command height)
        )
        (if (not (or (= 1 (atoi cjustif))
                     (= 2 (atoi cjustif))
                 )
            )
          (command (distof 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 ;|MSG0|;"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 ;|MSG0|;"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)

