;;;
;;;
;;;>	Author:	Henry C. Francis
;;;>		425 N. Ashe St.
;;;>		Southern Pines, NC 28387
;;;>		http://paracadd.com
;;;>		All rights reserved.
;;;
;;;>		COPYRIGHT: 
;;;>		   EDITED: 02-06-2006
;;;
(DEFUN linedraw_error (msg / )
  (PRINC "\nERROR: ")
  (PRINC msg)
  (PRINC "\nLINEDRAW cancelled! ")
  (TERM_DIALOG)
  (PRINC)
)
(DEFUN C:LINEDRAW (/ old-idx ltname)
  (SETQ oldlinedraw_error *ERROR*)
  (SETQ *ERROR* linedraw_error)
  (IF c:mklayr NIL (LOAD "MKLAYR" "\nFile MKLAYR.LSP not loaded! "))
  (c:svlayr)
  (IF call_ltname NIL (setq call_ltname ""))
  (IF ln_color NIL (SETQ ln_color 1))
  (IF bg_color NIL (SETQ bg_color 7))
  (SETQ acad_lin_fnd (FINDFILE "acad.lin"))
  (IF acad_lin_fnd
    (PROGN
           (IF (NOT (TBLSEARCH "LTYPE" "BORDER"))
             (COMMAND "linetype" "load" "BORDER" acad_lin_fnd "")
           ) ;_ end of if
           (IF (NOT (TBLSEARCH "LTYPE" "CENTER"))
             (COMMAND "linetype" "load" "CENTER" acad_lin_fnd "")
           ) ;_ end of if
           (IF (NOT (TBLSEARCH "LTYPE" "DASHDOT"))
             (COMMAND "linetype" "load" "DASHDOT" acad_lin_fnd "")
           ) ;_ end of if
           (IF (NOT (TBLSEARCH "LTYPE" "DASHED"))
             (COMMAND "linetype" "load" "DASHED" acad_lin_fnd "")
           ) ;_ end of if
           (IF (NOT (TBLSEARCH "LTYPE" "DIVIDE"))
             (COMMAND "linetype" "load" "DIVIDE" acad_lin_fnd "")
           ) ;_ end of if
           (IF (NOT (TBLSEARCH "LTYPE" "DOT"))
             (COMMAND "linetype" "load" "DOT" acad_lin_fnd "")
           ) ;_ end of if
           (IF (NOT (TBLSEARCH "LTYPE" "HIDDEN"))
             (COMMAND "linetype" "load" "HIDDEN" acad_lin_fnd "")
           ) ;_ end of if
           (IF (NOT (TBLSEARCH "LTYPE" "PHANTOM"))
             (COMMAND "linetype" "load" "PHANTOM" acad_lin_fnd "")
           ) ;_ end of if
    ) ;_ end of PROGN
  ) ;_ end of IF
  (SETQ custom_lin_fnd (FINDFILE "custom.lin"))
  (IF custom_lin_fnd
    (PROGN
           (IF (NOT (TBLSEARCH "LTYPE" "FENCELINE1"))
             (COMMAND "linetype" "load" "FENCELINE1" custom_lin_fnd "")
           ) ;_ end of if
           (IF (NOT (TBLSEARCH "LTYPE" "FENCELINE2"))
             (COMMAND "linetype" "load" "FENCELINE2" custom_lin_fnd "")
           ) ;_ end of if
           (IF (NOT (TBLSEARCH "LTYPE" "WIREFENCE"))
             (COMMAND "linetype" "load" "WIREFENCE" custom_lin_fnd "")
           ) ;_ end of if
           (IF (NOT (TBLSEARCH "LTYPE" "TRACKS"))
             (COMMAND "linetype" "load" "TRACKS" custom_lin_fnd "")
           ) ;_ end of if
           (IF (NOT (TBLSEARCH "LTYPE" "TDR"))
             (COMMAND "linetype" "load" "TDR" custom_lin_fnd "")
           ) ;_ end of if
           (IF (NOT (TBLSEARCH "LTYPE" "TDL"))
             (COMMAND "linetype" "load" "TDL" custom_lin_fnd "")
           ) ;_ end of if
           (IF (NOT (TBLSEARCH "LTYPE" "GLR"))
             (COMMAND "linetype" "load" "GLR" custom_lin_fnd "")
           ) ;_ end of if
           (IF (NOT (TBLSEARCH "LTYPE" "GLL"))
             (COMMAND "linetype" "load" "GLL" custom_lin_fnd "")
           ) ;_ end of if
           (IF (NOT (TBLSEARCH "LTYPE" "SEDFENCE"))
             (COMMAND "linetype" "load" "SEDFENCE" custom_lin_fnd "")
           ) ;_ end of if
           (IF (NOT (TBLSEARCH "LTYPE" "SILTFENCE"))
             (COMMAND "linetype" "load" "SILTFENCE" custom_lin_fnd "")
           ) ;_ end of if
           (IF (NOT (TBLSEARCH "LTYPE" "GUARD_R"))
             (COMMAND "linetype" "load" "GUARD_R" custom_lin_fnd "")
           ) ;_ end of if
           (IF (NOT (TBLSEARCH "LTYPE" "GUARD_L"))
             (COMMAND "linetype" "load" "GUARD_L" custom_lin_fnd "")
           ) ;_ end of if
           (IF (NOT (TBLSEARCH "LTYPE" "STREAMD"))
             (COMMAND "linetype" "load" "STREAMD" custom_lin_fnd "")
           ) ;_ end of if
           (IF (NOT (TBLSEARCH "LTYPE" "STREAMD2"))
             (COMMAND "linetype" "load" "STREAMD2" custom_lin_fnd "")
           ) ;_ end of if
           (IF (NOT (TBLSEARCH "LTYPE" "DEMOL"))
             (COMMAND "linetype" "load" "DEMOL" custom_lin_fnd "")
           ) ;_ end of if
           (IF (NOT (TBLSEARCH "LTYPE" "MATCH"))
             (COMMAND "linetype" "load" "MATCH" custom_lin_fnd "")
           ) ;_ end of if
           (IF (NOT (TBLSEARCH "LTYPE" "CONTOUR"))
             (COMMAND "linetype" "load" "CONTOUR" custom_lin_fnd "")
           ) ;_ end of if
           (IF (NOT (TBLSEARCH "LTYPE" "TREELINE_R"))
             (COMMAND "linetype" "load" "TREELINE_R" custom_lin_fnd "")
           ) ;_ end of if
           (IF (NOT (TBLSEARCH "LTYPE" "TREELINE_L"))
             (COMMAND "linetype" "load" "TREELINE_L" custom_lin_fnd "")
           ) ;_ end of if
    ) ;_ end of PROGN
  ) ;_ end of IF
  (SETQ ltnmlst (LIST "continuous" "border" "center" "dashdot" "dashed"
                      "divide" "dot" "hidden" "phantom" "fenceline1"
		      "fenceline2" "wirefence" "tracks" "tdr" "tdl" "GLR" "GLL"
		      "sedfence" "siltfence" "streamd" "streamd2" "demol"
		      "match" "contour" "treeline_r" "treeline_l"
                )
  ) ;_ end of setq
  (makeltlists)
  ;;; Initialize a dialogue from dialogue file
  (SETQ linedraw_num (LOAD_DIALOG "linedraw"))
  (IF (NOT (NEW_DIALOG "linedraw" linedraw_num "" (IF ltype_loc ltype_loc '(-1 -1))))
    (EXIT)
  ) ;_ end of if
  (SETQ dashdata (NTH 0 mdashlist))
  (ltlist_act "0" "continuous_image" -2 ln_color)
  (SETQ dashdata (NTH 0 mdashlist));existing water - continuous also - was (NTH 1 mdashlist)
  (ltlist_act "0" "border_image" -2 ln_color)
  (SETQ dashdata (NTH 2 mdashlist))
  (ltlist_act "2" "center_image" -2 ln_color)
  (SETQ dashdata (NTH 3 mdashlist))
  (ltlist_act "3" "dashdot_image" -2 ln_color)
  (SETQ dashdata (NTH 4 mdashlist))
  (ltlist_act "4" "dashed_image" -2 ln_color)
  (SETQ dashdata (NTH 5 mdashlist))
  (ltlist_act "5" "divide_image" -2 ln_color)
  (SETQ dashdata (NTH 6 mdashlist))
  (ltlist_act "6" "dot_image" -2 ln_color)
  (SETQ dashdata (NTH 7 mdashlist))
  (ltlist_act "7" "hidden_image" -2 ln_color)
  (SETQ dashdata (NTH 8 mdashlist))
  (ltlist_act "8" "phantom_image" -2 ln_color)
  (SETQ dashdata (NTH 9 mdashlist))
  (ltlist_act "9" "fenceline1_image" -2 ln_color)
  (SETQ dashdata (NTH 10 mdashlist))
  (ltlist_act "10" "wirefence_image" -2 ln_color)
  (SETQ dashdata (NTH 11 mdashlist))
  (ltlist_act "11" "fenceline2_image" -2 ln_color)
  (SETQ dashdata (NTH 12 mdashlist))
  (ltlist_act "12" "tracks_image" -2 ln_color)
  (SETQ dashdata (NTH 13 mdashlist))
  (ltlist_act "13" "tdr_image" -2 ln_color)
  (SETQ dashdata (NTH 14 mdashlist))
  (ltlist_act "14" "tdl_image" -2 ln_color)
  (SETQ dashdata (NTH 15 mdashlist))
  (ltlist_act "15" "GLR_image" -2 ln_color)
  (SETQ dashdata (NTH 16 mdashlist))
  (ltlist_act "16" "GLL_image" -2 ln_color)
  (SETQ dashdata (NTH 17 mdashlist))
  (ltlist_act "17" "sedfence_image" -2 ln_color)
  (SETQ dashdata (NTH 18 mdashlist))
  (ltlist_act "18" "siltfence_image" -2 ln_color)
  (SETQ dashdata (NTH 19 mdashlist))
  (ltlist_act "19" "streamd_image" -2 ln_color)
  (SETQ dashdata (NTH 20 mdashlist))
  (ltlist_act "20" "streamd2_image" -2 ln_color)
  (SETQ dashdata (NTH 21 mdashlist))
  (ltlist_act "21" "demol_image" -2 ln_color)
  (SETQ dashdata (NTH 22 mdashlist))
  (ltlist_act "22" "match_image" -2 ln_color)
  (SETQ dashdata (NTH 23 mdashlist))
  (ltlist_act "23" "contour_image" -2 ln_color)
  (SETQ dashdata (NTH 24 mdashlist))
  (ltlist_act "24" "treeline_r_image" -2 ln_color)
  (SETQ dashdata (NTH 25 mdashlist))
  (ltlist_act "25" "treeline_l_image" -2 ln_color)
  (SET_TILE "edit_lt" call_ltname)
  (ACTION_TILE
    "continuous_image"
    "(setq ltname \"continuous\")(set_tile\"edit_lt\"\"continuous\")(setq mjrg \"C\" llt \"-\" prod \"0OHE\" colr \"6\" modf \"LINE\")(done_dialog)"
  ) ;_ end of action_tile
  (ACTION_TILE
    "border_image"
    "(setq ltname \"continuous\")(set_tile\"edit_lt\"\"continuous\")(setq mjrg \"C\" llt \"-\" prod \"0O0W\" colr \"5\" modf \"LINE\")(done_dialog)"
;;;    "(setq ltname \"border\")(set_tile\"edit_lt\"\"border\")"
  ) ;_ end of action_tile
  (ACTION_TILE
    "center_image"
    "(setq ltname \"center\")(set_tile\"edit_lt\"\"center\")"
  ) ;_ end of action_tile
  (ACTION_TILE
    "dashdot_image"
    "(setq ltname \"dashdot\")(set_tile\"edit_lt\"\"dashdot\")"
  ) ;_ end of action_tile
  (ACTION_TILE
    "dashed_image"
    "(setq ltname \"dashed\")(set_tile\"edit_lt\"\"dashed\")"
  ) ;_ end of action_tile
  (ACTION_TILE
    "divide_image"
    "(setq ltname \"divide\")(set_tile\"edit_lt\"\"divide\")"
  ) ;_ end of action_tile
  (ACTION_TILE
    "dot_image"
    "(setq ltname \"dot\")(set_tile\"edit_lt\"\"dot\")"
  ) ;_ end of action_tile
  (ACTION_TILE
    "hidden_image"
    "(setq ltname \"hidden\")(set_tile\"edit_lt\"\"hidden\")"
  ) ;_ end of action_tile
  (ACTION_TILE
    "phantom_image"
    "(setq ltname \"phantom\")(set_tile\"edit_lt\"\"phantom\")"
  ) ;_ end of action_tile
  (ACTION_TILE
    "fenceline1_image"
    "(setq ltname \"fenceline1\")(set_tile\"edit_lt\"\"fenceline1\")"
  ) ;_ end of action_tile
  (ACTION_TILE
    "fenceline2_image"
    "(setq ltname \"fenceline2\")(set_tile\"edit_lt\"\"fenceline2\")"
  ) ;_ end of action_tile
  (ACTION_TILE
    "wirefence_image"
    "(setq ltname \"wirefence\")(set_tile\"edit_lt\"\"wirefence\")"
  ) ;_ end of action_tile
  (ACTION_TILE
    "tracks_image"
    "(setq ltname \"tracks\")(set_tile\"edit_lt\"\"tracks\")"
  ) ;_ end of action_tile
  (ACTION_TILE
    "tdr_image"
    "(setq ltname \"tdr\")(set_tile\"edit_lt\"\"tdr\")"
  ) ;_ end of action_tile
  (ACTION_TILE
    "tdl_image"
    "(setq ltname \"tdl\")(set_tile\"edit_lt\"\"tdl\")"
  ) ;_ end of action_tile
  (ACTION_TILE
    "GLR_image"
    "(setq ltname \"GLR\")(set_tile\"edit_lt\"\"GLR\")"
  ) ;_ end of action_tile
  (ACTION_TILE
    "GLL_image"
    "(setq ltname \"GLL\")(set_tile\"edit_lt\"\"GLL\")"
  ) ;_ end of action_tile
  (ACTION_TILE
    "sedfence_image"
    "(setq ltname \"sedfence\")(set_tile\"edit_lt\"\"sedfence\")"
  ) ;_ end of action_tile
  (ACTION_TILE
    "siltfence_image"
    "(setq ltname \"siltfence\")(set_tile\"edit_lt\"\"siltfence\")"
  ) ;_ end of action_tile
  (ACTION_TILE
    "streamd_image"
    "(setq ltname \"streamd\")(set_tile\"edit_lt\"\"streamd\")"
  ) ;_ end of action_tile
  (ACTION_TILE
    "streamd2_image"
    "(setq ltname \"streamd2\")(set_tile\"edit_lt\"\"streamd2\")"
  ) ;_ end of action_tile
  (ACTION_TILE
    "demol_image"
    "(setq ltname \"demol\")(set_tile\"edit_lt\"\"demol\")"
  ) ;_ end of action_tile
  (ACTION_TILE
    "match_image"
    "(setq ltname \"match\")(set_tile\"edit_lt\"\"match\")"
  ) ;_ end of action_tile
  (ACTION_TILE
    "contour_image"
    "(setq ltname \"contour\")(set_tile\"edit_lt\"\"contour\")"
  ) ;_ end of action_tile
  (ACTION_TILE
    "treeline_r_image"
    "(setq ltname \"treeline_r\")(set_tile\"edit_lt\"\"treeline_r\")"
  ) ;_ end of action_tile
  (ACTION_TILE
    "treeline_l_image"
    "(setq ltname \"treeline_l\")(set_tile\"edit_lt\"\"treeline_l\")"
  ) ;_ end of action_tile
  (ACTION_TILE "edit_lt" "(ltedit_act)")
  (ACTION_TILE
    "accept"
    "(setq ltname(get_tile\"edit_lt\"))(setq ltype_loc(done_dialog 1))"
  ) ;_ end of action_tile
  (ACTION_TILE "cancel" "(reset-lt)")
  (SET_TILE "part_lbl" "")
;;;  (COND ((EQUAL (SUBSTR return_to 1 3) "dft")
;;;         (SET_TILE "part_lbl" "Pipe Fitting (dbl) line")
;;;        )
;;;        ((EQUAL (SUBSTR return_to 1 3) "sft")
;;;         (SET_TILE "part_lbl" "Pipe Fitting (sgl) line")
;;;        )
;;;        ((EQUAL (SUBSTR return_to 1 3) "dbl")
;;;         (SET_TILE "part_lbl" "     Double Line piping")
;;;        )
;;;        ((EQUAL (SUBSTR return_to 1 3) "sgl")
;;;         (SET_TILE "part_lbl" "     Single Line piping")
;;;        )
;;;        ((EQUAL (SUBSTR return_to 1 3) "ctr")
;;;         (SET_TILE "part_lbl" "     Piping centerline")
;;;        )
;;;  ) ;_ end of cond
  (IF (= (START_DIALOG) 1)
    (PROGN 
      (IF (EQ alllts "1")
        (PROGN
          (SET_TILE "dft_lt_text" ltname)
          (SET_TILE "sft_lt_text" ltname)
          (SET_TILE "dbl_lt_text" ltname)
          (SET_TILE "sgl_lt_text" ltname)
          (SETQ alllt_index (ITOA(getindex ltname ltnmlst)))
          (ltlist_act alllt_index "dft_lt_image" -2 dft_colr)
          (ltlist_act alllt_index "sft_lt_image" -2 sft_colr)
          (ltlist_act alllt_index "dbl_lt_image" -2 dbl_colr)
          (ltlist_act alllt_index "sgl_lt_image" -2 sgl_colr)
          (SETQ dft_ltname ltname)
          (SETQ sft_ltname ltname)
          (SETQ dbl_ltname ltname)
          (SETQ sgl_ltname ltname)
          ltname
        )
        (PROGN
      (SET_TILE return_to ltname)
           (ltlist_act
             (ITOA (getindex ltname ltnmlst))
             (STRCAT (SUBSTR return_to 1 7) "image")
             -2
             ln_color
           ) ;_ end of ltlist_act
           (SET (READ (STRCAT (SUBSTR return_to 1 6) "name")) ltname)
           (SET (READ (STRCAT (SUBSTR return_to 1 4) "colr")) ln_color)
           ltname
        )
      )
    ) ;_ end of progn
    eltype
  ) ;_ end of if
  (c:mklayr)
  (command ".line" pause)
  (SETQ *ERROR* oldlinedraw_error)
  (princ)
) ;_ end of defun

(DEFUN makeltlists (/ ltlist ltname)
  (SETQ mdashlist nil)
  (FOREACH ltname ltnmlst
    (SETQ ltlist (TBLSEARCH "LTYPE" ltname))
    (IF (= ltname "continuous")
      (SETQ mdashlist (APPEND mdashlist (LIST "CONT")))
      (SETQ mdashlist (APPEND mdashlist (LIST (add-mdash ltlist)))) ;_ end of setq
    ) ;_ end of if
  ) ;_ end of foreach
) ;_ end of defun


(DEFUN col_tile (tile color patlist ln_color / image_x image_y)
  (SETQ image_x (DIMX_TILE tile))
  (SETQ image_y (DIMY_TILE tile))
  (START_IMAGE tile)
  (FILL_IMAGE 0 0 image_x image_y color)
  (IF patlist
    (drawpattern image_x (/ image_y 2) patlist ln_color)
    (tile_rect 0 0 image_x image_y 7)
  ) ;_ end of if
  (END_IMAGE)
) ;_ end of defun

(DEFUN drawpattern (boxlength y2 pattern color / x1 x2 dash)
  (SETQ x1 0
        x2 0
  ) ;_ end of setq
  (SETQ patlist pattern)
  (SETQ fx 30)
  (IF (= patlist "CONT")
    (PROGN (SETQ dash boxlength) (vi) (SETQ x1 boxlength)) ;_ end of progn
    (FOREACH dash patlist
      (IF (> (ABS dash) 2.5)
        (SETQ fx 2)
      ) ;_ end of if
    ) ;_ end of foreach
  ) ;_ end of if
  (WHILE (< x1 boxlength)
    (IF (SETQ dash (CAR patlist))
      (PROGN (SETQ dash (FIX (* fx dash)))
             (COND ((= dash 0) (SETQ dash 1) (vi))
                   ((> dash 0) (vi))
                   (T
                    (IF (< (ABS dash) 2)
                      (SETQ dash 2)
                    ) ;_ end of if
                    (SETQ x2 (+ x2 (ABS dash)))
                   )
             ) ;_ end of cond
             (SETQ patlist (CDR patlist))
             (SETQ x1 x2)
      ) ;_ end of progn
      (SETQ patlist pattern)
    ) ;_ end of if
  ) ;_ end of while
) ;_ end of defun

(DEFUN vi () (SETQ x2 (+ x2 dash)) (VECTOR_IMAGE x1 y2 x2 y2 color)) ;_ end of defun

(DEFUN ltlist_act (index tile bg_color ln_color /)
;;; Update the list box, edit box, and color tile
  (SET_TILE "error" "")
  (SETQ lt-idx (ATOI index))
  (SETQ ltname (NTH lt-idx ltnmlst))
  (SETQ dashdata (NTH lt-idx mdashlist))
  (col_tile tile -2 dashdata ln_color)
  (SET_TILE "list_lt" (ITOA lt-idx))
  (SET_TILE "edit_lt" ltname)
) ;_ end of defun

(DEFUN add-mdash (ltlist1 / dashlist assoclist dashsize)
  (SETQ dashlist nil)
  (WHILE (SETQ assoclist (CAR ltlist1))
    (IF (= (CAR assoclist) 49)
      (PROGN (SETQ dashsize (CDR assoclist))
             (SETQ dashlist (CONS dashsize dashlist))
      ) ;_ end of progn
    ) ;_ end of if
    (SETQ ltlist1 (CDR ltlist1))
  ) ;_ end of while
  (SETQ dashlist (REVERSE dashlist))
) ;_ end of defun

(DEFUN tile_rect (x1 y1 x2 y2 color)
  (SETQ x2 (- x2 1))
  (SETQ y2 (- y2 1))
  (VECTOR_IMAGE x1 y1 x2 y1 color)
  (VECTOR_IMAGE x2 y1 x2 y2 color)
  (VECTOR_IMAGE x2 y2 x1 y2 color)
  (VECTOR_IMAGE x1 y2 x1 y1 color)
) ;_ end of defun

(DEFUN reset-lt () (SETQ lt-idx old-idx) (DONE_DIALOG 0)) ;_ end of defun

(DEFUN ltedit_act ()
  (SETQ ltvalue (STRCASE (GET_TILE "edit_lt")))
  (IF (SETQ lt-idx (getindex ltvalue ltnmlst))
    (PROGN (SET_TILE "error" "")
           (ltlist_act (ITOA lt-idx) "show_image" -2 ln_color)
    ) ;_ end of progn
    (PROGN (SET_TILE "error" "Invalid linetype.") (SETQ lt-idx old-idx)) ;_ end of progn
  ) ;_ end of if
) ;_ end of defun

(DEFUN getindex (item itemlist / m n)
  (SETQ n (LENGTH itemlist))
  (IF (> (SETQ m (LENGTH (MEMBER item itemlist))) 0)
    (- n m)
    nil
  ) ;_ end of if
) ;_ end of defun