;;; ---------------------------------------------------------------------------
;;; WeldMark.lsp
;;; code compiled by YZ August 2026
;;; ---------------------------------------------------------------------------
;;; WELD SYMBOL PLACEMENT TO AWS A2.4 CONVENTION
;;;
;;; PURPOSE
;;;   Draws complete welding symbols - leader, arrowhead, reference line, weld
;;;   symbol, size and pitch text, optional backing / weld-all-around / field
;;;   flags, and up to three lines of tail notes - as native AutoCAD geometry.
;;;
;;;   Nothing is inserted as a block. Every symbol is drawn from lines, arcs,
;;;   polylines and solids at the moment you place it. That matters on a
;;;   fabrication drawing because a detailer can explode-free edit any symbol,
;;;   and because there is no block library to ship, bind or lose when the
;;;   drawing goes out to the shop.
;;;
;;; HOW IT WORKS
;;;   1. The command asks for two points. The FIRST is the arrow tip - the spot
;;;      on the joint the symbol is pointing at. The SECOND is the elbow, where
;;;      the sloping leader turns into the horizontal reference line.
;;;
;;;   2. From the angle between those two points the routine works out which way
;;;      the reference line should run. If the leader travels left-to-right the
;;;      reference line extends to the right (internally A1 = 0 radians); if it
;;;      travels right-to-left the reference line extends to the left (A1 = pi).
;;;      Everything downstream - symbol position, text position, tail direction -
;;;      is measured along A1, so the symbol reads correctly whichever way you
;;;      drag it.
;;;
;;;   3. A dialog collects the weld type, which side of the joint it applies to,
;;;      the size and pitch text, the three option toggles and the tail notes.
;;;      The dialog remembers every choice for the rest of the drawing session,
;;;      so placing twenty identical fillet welds means picking two points twenty
;;;      times and pressing Enter - not re-answering the dialog each time.
;;;
;;;   4. The chosen weld symbol is drawn ABOVE the reference line, which is the
;;;      "other side" position in AWS terms. Each entity is collected into a
;;;      selection set as it is created.
;;;
;;;   5. If the weld is on the arrow side ("This Side"), that collected set is
;;;      mirrored below the reference line and the originals deleted. If it is on
;;;      both sides the set is mirrored and the originals kept. If it is on the
;;;      other side nothing is mirrored - it is already in the right place.
;;;
;;;   6. A backing-weld arc, if requested, is deliberately EXCLUDED from that
;;;      mirror set. A backing symbol always sits opposite the main weld symbol,
;;;      so mirroring it would put it on the wrong side.
;;;
;;; SIZING
;;;   Every dimension is a multiple of DIMSCALE, so the symbol comes out at the
;;;   right size for whatever scale the drawing is set up at. Change DIMSCALE and
;;;   the next symbol follows it. Text height is 0.094 x DIMSCALE unless the
;;;   current text style has a fixed height, in which case the style wins.
;;;
;;; SUPPORT FILES
;;;   None. The weld symbols on the dialog buttons are drawn from a table of
;;;   vectors held in this file, so there is no slide library to install and
;;;   nothing that can go missing when the file is copied elsewhere.
;;;
;;;   The dialog definition itself is embedded in this file as text. It is
;;;   written to a temporary .dcl at run time, loaded, then deleted, so there is
;;;   no separate .dcl to install or keep in step.
;;;
;;;   WELDMARK  - place welding symbols, repeating until you press Enter
;;; ---------------------------------------------------------------------------

;;; ---------------------------------------------------------------------------
;;; SESSION MEMORY
;;;
;;; This single global survives between invocations on purpose - it is what makes
;;; the dialog remember your last weld type, side and notes. It is an association
;;; list so new settings can be added later without disturbing existing ones.
;;; ---------------------------------------------------------------------------

(if (null *WeldMark:Prefs*)
    (setq *WeldMark:Prefs*
        (list
            (cons "TYPE"   "fil_weld")   ; key of the selected weld-type button
            (cons "SIDE"   "This")       ; "This" | "Other" | "Both"
            (cons "BACK"   "0")          ; backing weld toggle
            (cons "ROUND"  "0")          ; weld-all-around toggle
            (cons "FIELD"  "0")          ; field weld toggle
            (cons "SIZE"   "")           ; leg / throat size text
            (cons "PITCH"  "")           ; length-pitch text
            (cons "NOTE1"  "")
            (cons "NOTE2"  "")
            (cons "NOTE3"  "")
        )
    )
)

;;; Read one preference. Returns "" rather than nil for a missing key so the
;;; value can always be handed straight to set_tile or the TEXT command.
(defun WeldMark:Get ( key / hit )
    (if (setq hit (assoc key *WeldMark:Prefs*)) (cdr hit) "")
)

;;; Write one preference back, replacing any existing entry for that key.
(defun WeldMark:Put ( key val )
    (setq *WeldMark:Prefs*
        (cons (cons key val)
              (vl-remove-if '(lambda (p) (= (car p) key)) *WeldMark:Prefs*)))
    val
)

;;; ---------------------------------------------------------------------------
;;; SMALL GEOMETRY HELPERS
;;; ---------------------------------------------------------------------------

;;; Degrees to radians. The weld symbols are described in degrees below because
;;; that is how the AWS standard draws them, and degrees stay readable.
(defun WeldMark:Rad ( deg ) (* pi (/ deg 180.0)))

;;; Offset from a base point by an x/y distance expressed in symbol units, where
;;; one unit is DIMSCALE. Every symbol is built from this one call, which keeps
;;; the geometry descriptions short and makes the proportions obvious at a glance.
;;;   pt  - base point, normally the symbol centre P3
;;;   scl - DIMSCALE
;;;   dx  - distance along the reference line, positive = to the right
;;;   dy  - distance perpendicular, positive = up
(defun WeldMark:Pt ( pt scl dx dy )
    (polar (polar pt 0.0 (* scl dx)) (WeldMark:Rad 90) (* scl dy))
)

;;; Add the entity just drawn to the mirror-collection set. Selection sets are
;;; mutable objects, so adding to the set the caller passed in is visible to the
;;; caller - no need to hand the set back.
(defun WeldMark:Keep ( ss ) (if (entlast) (ssadd (entlast) ss)) ss)

;;; ---------------------------------------------------------------------------
;;; THE WELD SYMBOLS
;;;
;;; Each function draws one AWS weld symbol sitting ON the reference line, with
;;; the symbol rising ABOVE it. Arguments are always the same three things:
;;;   scl - DIMSCALE, the size multiplier
;;;   p3  - the point on the reference line where the symbol is centred
;;;   ss  - selection set that collects what gets drawn, for the later mirror
;;;
;;; Drawing above the line and mirroring later is what lets one set of symbol
;;; definitions serve arrow-side, other-side and both-sides welds.
;;; ---------------------------------------------------------------------------

;;; Square groove - two short uprights with a gap between them.
(defun WeldMark:Square ( scl p3 ss )
    (command "_.PLINE" (WeldMark:Pt p3 scl  0.06 0.0) (WeldMark:Pt p3 scl  0.06 0.25) "")
    (WeldMark:Keep ss)
    (command "_.PLINE" (WeldMark:Pt p3 scl -0.06 0.0) (WeldMark:Pt p3 scl -0.06 0.25) "")
    (WeldMark:Keep ss)
)

;;; V groove - two lines splaying up and out from a single point on the line.
(defun WeldMark:VGroove ( scl p3 ss )
    (command "_.LINE" p3 (WeldMark:Pt p3 scl  0.20 0.20) "")
    (WeldMark:Keep ss)
    (command "_.LINE" p3 (WeldMark:Pt p3 scl -0.20 0.20) "")
    (WeldMark:Keep ss)
)

;;; Bevel groove - one sloping face and one vertical face. The vertical leg
;;; always points toward the member being bevelled.
(defun WeldMark:Bevel ( scl p3 ss )
    (command "_.LINE" p3 (WeldMark:Pt p3 scl 0.20 0.20) "")
    (WeldMark:Keep ss)
    (command "_.LINE" p3 (WeldMark:Pt p3 scl 0.00 0.20) "")
    (WeldMark:Keep ss)
)

;;; U groove - two uprights whose tops curve outward, forming a cup.
(defun WeldMark:UGroove ( scl p3 ss / lft rgt )
    (setq lft (WeldMark:Pt p3 scl -0.12 0.0)
          rgt (WeldMark:Pt p3 scl  0.12 0.0))
    (command "_.LINE" lft (WeldMark:Pt p3 scl -0.12 0.13) "")
    (WeldMark:Keep ss)
    (command "_.LINE" rgt (WeldMark:Pt p3 scl  0.12 0.13) "")
    (WeldMark:Keep ss)
    ;; Three-point arc joining the two uprights, dipping to the symbol centre.
    (command "_.ARC" (WeldMark:Pt p3 scl -0.12 0.13)
                     (WeldMark:Pt p3 scl  0.00 0.02)
                     (WeldMark:Pt p3 scl  0.12 0.13))
    (WeldMark:Keep ss)
)

;;; J groove - half a U groove: one vertical face, one curved face.
(defun WeldMark:JGroove ( scl p3 ss )
    (command "_.LINE" p3 (WeldMark:Pt p3 scl 0.00 0.25) "")
    (WeldMark:Keep ss)
    (command "_.ARC" (WeldMark:Pt p3 scl 0.00 0.25)
                     (WeldMark:Pt p3 scl 0.10 0.16)
                     (WeldMark:Pt p3 scl 0.12 0.00))
    (WeldMark:Keep ss)
)

;;; Flare V groove - two arcs bowing away from each other, representing the
;;; natural groove between two rounded members.
(defun WeldMark:FlareV ( scl p3 ss )
    (command "_.ARC" (WeldMark:Pt p3 scl -0.06 0.00)
                     (WeldMark:Pt p3 scl -0.14 0.13)
                     (WeldMark:Pt p3 scl -0.16 0.25))
    (WeldMark:Keep ss)
    (command "_.ARC" (WeldMark:Pt p3 scl  0.06 0.00)
                     (WeldMark:Pt p3 scl  0.14 0.13)
                     (WeldMark:Pt p3 scl  0.16 0.25))
    (WeldMark:Keep ss)
)

;;; Flare bevel groove - one arc and one straight face: a rounded member welded
;;; against a flat one.
(defun WeldMark:FlareBevel ( scl p3 ss )
    (command "_.LINE" (WeldMark:Pt p3 scl -0.06 0.00) (WeldMark:Pt p3 scl -0.06 0.25) "")
    (WeldMark:Keep ss)
    (command "_.ARC" (WeldMark:Pt p3 scl  0.06 0.00)
                     (WeldMark:Pt p3 scl  0.14 0.13)
                     (WeldMark:Pt p3 scl  0.16 0.25))
    (WeldMark:Keep ss)
)

;;; Fillet - the right triangle, vertical leg always on the left. This is the
;;; commonest symbol on a structural drawing by a wide margin.
(defun WeldMark:Fillet ( scl p3 ss )
    (command "_.PLINE" (WeldMark:Pt p3 scl -0.10 0.00)
                       (WeldMark:Pt p3 scl -0.10 0.20)
                       (WeldMark:Pt p3 scl  0.10 0.00) "")
    (WeldMark:Keep ss)
)

;;; Plug or slot weld - a rectangle sitting on the reference line.
(defun WeldMark:Plug ( scl p3 ss )
    (command "_.PLINE" (WeldMark:Pt p3 scl -0.25 0.00)
                       (WeldMark:Pt p3 scl -0.25 0.25)
                       (WeldMark:Pt p3 scl  0.25 0.25)
                       (WeldMark:Pt p3 scl  0.25 0.00) "")
    (WeldMark:Keep ss)
)

;;; Surfacing - a single convex arc lying on the reference line, indicating
;;; built-up weld metal on a face rather than a joint between members.
(defun WeldMark:Surfacing ( scl p3 ss )
    (command "_.ARC" (WeldMark:Pt p3 scl -0.15 0.00)
                     (WeldMark:Pt p3 scl  0.00 0.16)
                     (WeldMark:Pt p3 scl  0.15 0.00))
    (WeldMark:Keep ss)
)

;;; Edge flange - TWO curved faces side by side, both bowing the same way.
;;; This is what distinguishes it from the corner flange below.
(defun WeldMark:EdgeFlange ( scl p3 ss )
    (command "_.ARC" (WeldMark:Pt p3 scl -0.10 0.00)
                     (WeldMark:Pt p3 scl -0.02 0.13)
                     (WeldMark:Pt p3 scl -0.10 0.25))
    (WeldMark:Keep ss)
    (command "_.ARC" (WeldMark:Pt p3 scl  0.06 0.00)
                     (WeldMark:Pt p3 scl  0.14 0.13)
                     (WeldMark:Pt p3 scl  0.06 0.25))
    (WeldMark:Keep ss)
)

;;; Corner flange - ONE straight face and one curved face.
(defun WeldMark:CornerFlange ( scl p3 ss )
    (command "_.LINE" (WeldMark:Pt p3 scl -0.06 0.00) (WeldMark:Pt p3 scl -0.06 0.25) "")
    (WeldMark:Keep ss)
    (command "_.ARC" (WeldMark:Pt p3 scl  0.06 0.00)
                     (WeldMark:Pt p3 scl  0.14 0.13)
                     (WeldMark:Pt p3 scl  0.06 0.25))
    (WeldMark:Keep ss)
)

;;; ---------------------------------------------------------------------------
;;; DIALOG BUTTON KEY -> DRAWING FUNCTION
;;;
;;; Holding this as data rather than building function names from strings at run
;;; time means a typo is a load-time problem, not a mystery failure halfway
;;; through placing a symbol. The key is also what names the button's picture.
;;; ---------------------------------------------------------------------------

(setq WeldMark:Symbols
    (list
        (list "sq_weld"  WeldMark:Square       "Square")
        (list "v_weld"   WeldMark:VGroove      "V Groove")
        (list "b_weld"   WeldMark:Bevel        "Bevel")
        (list "u_weld"   WeldMark:UGroove      "U Groove")
        (list "j_weld"   WeldMark:JGroove      "J Groove")
        (list "flv_weld" WeldMark:FlareV       "Flare V")
        (list "flb_weld" WeldMark:FlareBevel   "Flare Bevel")
        (list "fil_weld" WeldMark:Fillet       "Fillet")
        (list "pl_weld"  WeldMark:Plug         "Plug/Slot")
        (list "sur_weld" WeldMark:Surfacing    "Surfacing")
        (list "fle_weld" WeldMark:EdgeFlange   "Edge Flange")
        (list "flc_weld" WeldMark:CornerFlange "Corner Flange")
    )
)

;;; ---------------------------------------------------------------------------
;;; DECORATIONS DRAWN AFTER THE MAIN SYMBOL
;;;
;;; None of these are mirrored, so they are drawn once the mirror is finished and
;;; are never added to the collection set.
;;; ---------------------------------------------------------------------------

;;; Weld-all-around - a circle at the elbow, meaning the weld continues around
;;; the full perimeter of the joint.
(defun WeldMark:AllAround ( scl p2 )
    (command "_.CIRCLE" p2 (* scl 0.09))
)

;;; Field weld - a filled triangular flag on a staff at the elbow, meaning the
;;; weld is made on site rather than in the shop.
(defun WeldMark:FieldFlag ( scl p2 a1 / top mid tip )
    (setq top (polar p2 (WeldMark:Rad 90) (* scl 0.375))
          mid (polar p2 (WeldMark:Rad 90) (* scl 0.255))
          tip (polar (polar p2 (WeldMark:Rad 90) (* scl 0.315)) a1 (* scl 0.20)))
    (command "_.LINE" p2 top "")
    ;; SOLID takes three points, a blank for the unused fourth corner to make it
    ;; a triangle, then a second blank because it loops asking for more triangles.
    (command "_.SOLID" top tip mid "" "")
)

;;; Backing weld - an arc on the opposite side of the reference line from the
;;; main symbol. Returns the entity so the caller can exclude it from the mirror.
;;; ARC with a centre draws counter-clockwise from start to end, so the choice of
;;; which end is the start decides whether the arc bows up or down.
(defun WeldMark:Backing ( scl p3 side )
    (if (= side "This")
        ;; Main symbol ends up BELOW the line, so the backing arc bows UP:
        ;; start on the right, sweep anti-clockwise over the top to the left.
        (command "_.ARC" (WeldMark:Pt p3 scl  0.06 0.0) "_C" p3
                         (WeldMark:Pt p3 scl -0.06 0.0))
        ;; Main symbol stays ABOVE the line, so the backing arc bows DOWN:
        ;; start on the left, sweep anti-clockwise under the bottom to the right.
        (command "_.ARC" (WeldMark:Pt p3 scl -0.06 0.0) "_C" p3
                         (WeldMark:Pt p3 scl  0.06 0.0))
    )
    (entlast)
)

;;; ---------------------------------------------------------------------------
;;; TAIL NOTES
;;;
;;; Up to three lines of text in the tail of the symbol, used for process codes,
;;; specifications or references. The tail - two short strokes forming a V - is
;;; only drawn when there is at least one note to put in it, which is the AWS
;;; convention: no tail unless the tail says something.
;;; ---------------------------------------------------------------------------

(defun WeldMark:Notes ( scl p2 a1 notes txtht / live n base just tail y )
    ;; Drop blank lines but keep the order of the ones that were filled in.
    (setq live (vl-remove-if '(lambda (s) (or (null s) (= s ""))) notes))
    (if live
        (progn
            (setq n    (length live)
                  tail (polar p2 a1 (* scl 1.20))
                  ;; Start the block of text just past the end of the reference
                  ;; line, and raise it so the block is vertically centred on the
                  ;; line however many lines it has.
                  base (polar (polar p2 a1 (* scl (+ 1.30 (* 0.0625 (1- n)))))
                              (WeldMark:Rad 90)
                              (* scl 0.0781 (1- n)))
                  ;; Text reads away from the elbow, so it is left-justified when
                  ;; the tail runs right and right-justified when it runs left.
                  just (if (equal a1 0.0 1e-8) "_ML" "_MR")
                  y    0.0)
            (foreach s live
                (if (zerop txtht)
                    (command "_.TEXT" "_J" just (polar base (WeldMark:Rad 270) (* scl y))
                                      (* scl 0.094) 0 s)
                    (command "_.TEXT" "_J" just (polar base (WeldMark:Rad 270) (* scl y))
                                      0 s)
                )
                (setq y (+ y 0.15625))
            )
            ;; The two tail strokes, opening away from the reference line.
            (if (equal a1 0.0 1e-8)
                (command "_.LINE" tail (polar tail (WeldMark:Rad   45) (* scl 0.2828)) ""
                         "_.LINE" tail (polar tail (WeldMark:Rad  -45) (* scl 0.2828)) "")
                (command "_.LINE" tail (polar tail (WeldMark:Rad  135) (* scl 0.2828)) ""
                         "_.LINE" tail (polar tail (WeldMark:Rad -135) (* scl 0.2828)) "")
            )
        )
    )
    (princ)
)

;;; ---------------------------------------------------------------------------
;;; THE DIALOG
;;;
;;; The definition below is held as a list of strings and written to a temporary
;;; file when the dialog is needed. Keeping it here rather than in a separate
;;; .dcl means there is exactly one file to install and no chance of the dialog
;;; and the code drifting out of step.
;;;
;;; Every image button carries a text caption underneath the picture, so the
;;; dialog reads correctly even at a screen resolution where the symbols are too
;;; small to tell apart.
;;; ---------------------------------------------------------------------------

(defun WeldMark:DclText ( / out )
    (setq out
        (list
        "weldmark : dialog {"
        "  label = \"Weld Symbol\";"
        "  : row {"
        "    : boxed_column { label = \"Weld Type\";"
        "      : row {"
        "        : column { : image_button { key=\"sq_weld\";  width=8; height=4; color=5; allow_accept=false; }"
        "                   : text { label=\"Square\"; alignment=centered; } }"
        "        : column { : image_button { key=\"v_weld\";   width=8; height=4; color=5; allow_accept=false; }"
        "                   : text { label=\"V Groove\"; alignment=centered; } }"
        "        : column { : image_button { key=\"b_weld\";   width=8; height=4; color=5; allow_accept=false; }"
        "                   : text { label=\"Bevel\"; alignment=centered; } }"
        "        : column { : image_button { key=\"u_weld\";   width=8; height=4; color=5; allow_accept=false; }"
        "                   : text { label=\"U Groove\"; alignment=centered; } }"
        "      }"
        "      : row {"
        "        : column { : image_button { key=\"j_weld\";   width=8; height=4; color=5; allow_accept=false; }"
        "                   : text { label=\"J Groove\"; alignment=centered; } }"
        "        : column { : image_button { key=\"flv_weld\"; width=8; height=4; color=5; allow_accept=false; }"
        "                   : text { label=\"Flare V\"; alignment=centered; } }"
        "        : column { : image_button { key=\"flb_weld\"; width=8; height=4; color=5; allow_accept=false; }"
        "                   : text { label=\"Flare Bevel\"; alignment=centered; } }"
        "        : column { : image_button { key=\"fil_weld\"; width=8; height=4; color=5; allow_accept=false; }"
        "                   : text { label=\"Fillet\"; alignment=centered; } }"
        "      }"
        "      : row {"
        "        : column { : image_button { key=\"pl_weld\";  width=8; height=4; color=5; allow_accept=false; }"
        "                   : text { label=\"Plug/Slot\"; alignment=centered; } }"
        "        : column { : image_button { key=\"sur_weld\"; width=8; height=4; color=5; allow_accept=false; }"
        "                   : text { label=\"Surfacing\"; alignment=centered; } }"
        "        : column { : image_button { key=\"fle_weld\"; width=8; height=4; color=5; allow_accept=false; }"
        "                   : text { label=\"Edge Flange\"; alignment=centered; } }"
        "        : column { : image_button { key=\"flc_weld\"; width=8; height=4; color=5; allow_accept=false; }"
        "                   : text { label=\"Corner Flange\"; alignment=centered; } }"
        "      }"
        "      : text { key = \"selected\"; label = \"\"; }"
        "    }"
        "    : column {"
        "      : boxed_radio_column { label = \"Weld Side\";"
        "        : radio_button { key=\"this_side\";  label=\"Arrow Side\"; }"
        "        : radio_button { key=\"other_side\"; label=\"Other Side\"; }"
        "        : radio_button { key=\"both_side\";  label=\"Both Sides\"; }"
        "      }"
        "      : boxed_column { label = \"Options\";"
        "        : toggle { key=\"ba_weld\"; label=\"Backing Weld\"; }"
        "        : toggle { key=\"ar_weld\"; label=\"Weld All Around\"; }"
        "        : toggle { key=\"fi_weld\"; label=\"Field Weld\"; }"
        "      }"
        "      : boxed_column { label = \"Dimensions\";"
        "        : edit_box { key=\"fill_size\";  label=\"Size:\";         allow_accept=false; }"
        "        : edit_box { key=\"pitch_size\"; label=\"Length-Pitch:\"; allow_accept=false; }"
        "      }"
        "      : boxed_column { label = \"Tail Notes\";"
        "        : edit_box { key=\"note1\"; label=\"1:\"; allow_accept=false; }"
        "        : edit_box { key=\"note2\"; label=\"2:\"; allow_accept=false; }"
        "        : edit_box { key=\"note3\"; label=\"3:\"; allow_accept=false; }"
        "      }"
        "    }"
        "  }"
        "  spacer;"
        "  ok_cancel;"
        "}"
        )
    )
    out
)

;;; Write the embedded definition to a temporary file and hand back its name.
;;; Returns nil if the file cannot be written, which the caller treats as a
;;; reason to abort rather than press on without a dialog.
(defun WeldMark:WriteDcl ( / file handle )
    (if (and (setq file (vl-filename-mktemp "weldmark" nil ".dcl"))
             (setq handle (open file "w")))
        (progn
            (foreach line (WeldMark:DclText) (write-line line handle))
            (close handle)
            file
        )
    )
)

;;; ---------------------------------------------------------------------------
;;; THE BUTTON PICTURES
;;;
;;; The twelve weld symbols shown on the dialog buttons are drawn as vectors
;;; rather than loaded from a slide library. VECTOR_IMAGE draws a line inside an
;;; image tile, so the whole picture can be built from LISP and there is nothing
;;; to install.
;;;
;;; Each symbol is held as a list of paths in a square from 0 to 1, with y
;;; measured UP from the bottom and the reference line at 0.28. Tile pixels have
;;; y running the other way, which is the one conversion WeldMark:Paint makes.
;;; ---------------------------------------------------------------------------

;;; Points along a bowed line from one point to another - used for the curved
;;; faces of the U, J and flare grooves. The bow is the sideways offset at the
;;; middle, as a fraction of the length, positive to the left of travel.
(defun WeldMark:Bow ( x1 y1 x2 y2 bow steps / out i f dx dy px py )
    (setq dx (- x2 x1) dy (- y2 y1) out nil i 0)
    ;; Perpendicular to the chord, scaled by the bow.
    (setq px (* (- dy) bow) py (* dx bow))
    (while (<= i steps)
        (setq f (/ (float i) steps)
              ;; A parabola through the two ends, pushed out at the middle.
              ;; At thumbnail size this is indistinguishable from a true arc.
              out (cons (list (+ x1 (* dx f) (* px 4.0 f (- 1.0 f)))
                              (+ y1 (* dy f) (* py 4.0 f (- 1.0 f))))
                        out)
              i (1+ i)))
    (reverse out)
)

;;; Key -> the paths that draw it. Built with LIST rather than quoted, because
;;; the curved ones are computed.
(setq WeldMark:Pictures
    (list
        ;; Two uprights with a gap between them.
        (cons "sq_weld"  (list '((0.38 0.28) (0.38 0.72))
                               '((0.62 0.28) (0.62 0.72))))
        ;; A V opening upward.
        (cons "v_weld"   (list '((0.30 0.72) (0.50 0.28) (0.70 0.72))))
        ;; One upright face, one sloping.
        (cons "b_weld"   (list '((0.40 0.72) (0.40 0.28))
                               '((0.40 0.28) (0.64 0.72))))
        ;; A U - two uprights joined by a curved root.
        (cons "u_weld"   (list (append '((0.32 0.72))
                                       (WeldMark:Bow 0.32 0.46 0.68 0.46 -0.30 6)
                                       '((0.68 0.72)))))
        ;; A J - one upright face, one curved.
        (cons "j_weld"   (list '((0.36 0.72) (0.36 0.28))
                               (WeldMark:Bow 0.36 0.42 0.64 0.72 -0.22 6)))
        ;; Two curved faces meeting - two rounded members together.
        (cons "flv_weld" (list (WeldMark:Bow 0.34 0.28 0.34 0.74 -0.30 6)
                               (WeldMark:Bow 0.66 0.28 0.66 0.74  0.30 6)))
        ;; One curved face, one flat.
        (cons "flb_weld" (list (WeldMark:Bow 0.40 0.28 0.40 0.74 -0.30 6)
                               '((0.62 0.28) (0.62 0.74))))
        ;; The right triangle, upright leg on the left.
        (cons "fil_weld" (list '((0.34 0.28) (0.34 0.72) (0.66 0.28))))
        ;; A rectangle standing on the reference line.
        (cons "pl_weld"  (list '((0.33 0.28) (0.33 0.62) (0.67 0.62) (0.67 0.28))))
        ;; A raised bead across the line. The bow is positive here where the
        ;; curved grooves above use a negative one: those run bottom to top, so
        ;; the perpendicular points left, and this one runs left to right, so it
        ;; points up. Same rule, different direction of travel.
        (cons "sur_weld" (list (WeldMark:Bow 0.30 0.28 0.70 0.28 0.42 8)))
        ;; Two upstands splaying apart at the top.
        (cons "fle_weld" (list '((0.44 0.28) (0.44 0.58) (0.37 0.76))
                               '((0.56 0.28) (0.56 0.58) (0.63 0.76))))
        ;; One upstand, one turning over.
        (cons "flc_weld" (list '((0.42 0.28) (0.42 0.76))
                               '((0.56 0.28) (0.56 0.56) (0.68 0.76))))
    )
)

;;; Draw one symbol into its image tile. The colours are the dialog's own
;;; foreground and background numbers, so the buttons follow whatever theme
;;; AutoCAD is running in rather than being fixed light or dark.
(defun WeldMark:Paint ( key / paths w h prev p tx ty px py )
    (setq paths (cdr (assoc key WeldMark:Pictures))
          w     (dimx_tile key)
          h     (dimy_tile key))

    (start_image key)
    (fill_image 0 0 w h -15)          ; -15 is the dialog background

    ;; The reference line every symbol sits on.
    (vector_image (fix (* 0.06 w)) (fix (* (- 1.0 0.28) h))
                  (fix (* 0.94 w)) (fix (* (- 1.0 0.28) h)) -16)

    (foreach path paths
        (setq prev nil)
        (foreach pt path
            ;; y is flipped: the table measures up, the tile measures down.
            (setq tx (fix (* (car pt) w))
                  ty (fix (* (- 1.0 (cadr pt)) h)))
            (if prev
                (vector_image (car prev) (cadr prev) tx ty -16))
            (setq prev (list tx ty))))

    (end_image)
    (princ)
)

;;; Show the dialog and fold the user's answers back into *WeldMark:Prefs*.
;;; Returns T when the user accepted, nil when they cancelled or it failed.
(defun WeldMark:Dialog ( / file id sel ok )

    (cond
        ((null (setq file (WeldMark:WriteDcl)))
         (princ "\n** WeldMark: could not create the temporary dialog file **")
         nil)

        ((<= (setq id (load_dialog file)) 0)
         (vl-file-delete file)
         (princ "\n** WeldMark: the dialog definition would not load **")
         nil)

        ((not (new_dialog "weldmark" id))
         (unload_dialog id)
         (vl-file-delete file)
         (princ "\n** WeldMark: the dialog would not open **")
         nil)

        (t
            (setq sel (WeldMark:Get "TYPE")
                  ok  nil)

            ;; Draw the symbol on each image button. Nothing is loaded from
            ;; disk - every picture is built from the vector table above.
            (foreach item WeldMark:Symbols
                (WeldMark:Paint (car item)))

            ;; A text line under the buttons naming the current pick. Without it
            ;; there is no way to tell which image button is active, because DCL
            ;; image buttons carry no persistent selected state of their own.
            (defun WeldMark:ShowPick ( key / hit )
                (if (setq hit (assoc key WeldMark:Symbols))
                    (set_tile "selected" (strcat "Selected:  " (caddr hit))))
            )

            ;; Clicking any weld-type button records the choice and updates the
            ;; caption. The key is captured per button, so no string building.
            (foreach item WeldMark:Symbols
                (action_tile (car item)
                    (strcat "(WeldMark:Put \"TYPE\" \"" (car item) "\")"
                            "(WeldMark:ShowPick \"" (car item) "\")"))
            )
            (WeldMark:ShowPick sel)

            ;; Restore every remembered setting into the live dialog.
            (set_tile (cond ((= (WeldMark:Get "SIDE") "Other") "other_side")
                            ((= (WeldMark:Get "SIDE") "Both")  "both_side")
                            (t                                 "this_side")) "1")
            (set_tile "ba_weld"    (WeldMark:Get "BACK"))
            (set_tile "ar_weld"    (WeldMark:Get "ROUND"))
            (set_tile "fi_weld"    (WeldMark:Get "FIELD"))
            (set_tile "fill_size"  (WeldMark:Get "SIZE"))
            (set_tile "pitch_size" (WeldMark:Get "PITCH"))
            (set_tile "note1"      (WeldMark:Get "NOTE1"))
            (set_tile "note2"      (WeldMark:Get "NOTE2"))
            (set_tile "note3"      (WeldMark:Get "NOTE3"))

            ;; A backing weld and a both-sides weld are mutually exclusive: there
            ;; is no "other side" left for the backing symbol to occupy. Grey the
            ;; option out rather than letting the user build a nonsense symbol.
            (defun WeldMark:SyncBacking ( on )
                (mode_tile "both_side" (if (= on "1") 1 0))
                (if (and (= on "1") (= (get_tile "both_side") "1"))
                    (progn (set_tile "this_side" "1") (WeldMark:Put "SIDE" "This")))
            )
            (WeldMark:SyncBacking (WeldMark:Get "BACK"))

            (action_tile "this_side"  "(WeldMark:Put \"SIDE\" \"This\")")
            (action_tile "other_side" "(WeldMark:Put \"SIDE\" \"Other\")")
            (action_tile "both_side"  "(WeldMark:Put \"SIDE\" \"Both\")")
            (action_tile "ba_weld"    "(WeldMark:SyncBacking (WeldMark:Put \"BACK\" $value))")
            (action_tile "ar_weld"    "(WeldMark:Put \"ROUND\" $value)")
            (action_tile "fi_weld"    "(WeldMark:Put \"FIELD\" $value)")

            ;; Read the edit boxes at accept time rather than trusting their
            ;; change callbacks. A box the user is still typing in has not fired
            ;; its callback yet, and that is exactly when people press OK.
            (action_tile "accept"
                (strcat "(WeldMark:Put \"SIZE\"  (get_tile \"fill_size\"))"
                        "(WeldMark:Put \"PITCH\" (get_tile \"pitch_size\"))"
                        "(WeldMark:Put \"NOTE1\" (get_tile \"note1\"))"
                        "(WeldMark:Put \"NOTE2\" (get_tile \"note2\"))"
                        "(WeldMark:Put \"NOTE3\" (get_tile \"note3\"))"
                        "(done_dialog 1)"))
            (action_tile "cancel" "(done_dialog 0)")

            (setq ok (= 1 (start_dialog)))
            (unload_dialog id)
            (vl-file-delete file)


            ok
        )
    )
)

;;; ---------------------------------------------------------------------------
;;; LAYER
;;;
;;; Weld symbols belong on their own layer so they can be turned off for a plain
;;; geometry check plot. Created blue on first use; if it already exists it is
;;; left exactly as the drawing standard set it, only thawed, turned on and
;;; unlocked so the geometry can actually be drawn.
;;; ---------------------------------------------------------------------------

(defun WeldMark:EnsureLayer ( name / rec )
    (if (setq rec (tblsearch "layer" name))
        (progn
            (if (minusp (cdr (assoc 62 rec)))
                (command "_.LAYER" "_ON" name ""))
            (if (= 1 (logand 1 (cdr (assoc 70 rec))))
                (command "_.LAYER" "_THAW" name ""))
            (if (= 4 (logand 4 (cdr (assoc 70 rec))))
                (command "_.LAYER" "_UNLOCK" name ""))
        )
        (command "_.LAYER" "_NEW" name "_COLOR" "_BLUE" name "")
    )
    (setvar "CLAYER" name)
)

;;; ---------------------------------------------------------------------------
;;; MAIN COMMAND
;;; ---------------------------------------------------------------------------

(defun c:WELDMARK ( / *error* vars vals scl p1 p2 p3 a1 tp1 tp2 ss
                      txtht sym side backent notes )

    ;; Save the system variables this routine changes so they can be put back
    ;; whatever happens - normal exit, escape, or an unexpected error.
    (setq vars '("CMDECHO" "ORTHOMODE" "MIRRTEXT" "CLAYER" "OSMODE" "BLIPMODE")
          vals (mapcar 'getvar vars))

    ;; Single point of restoration, called by both the clean exit and the error
    ;; handler, so the two can never drift apart.
    (defun WeldMark:Restore ( )
        (mapcar 'setvar vars vals)
        (while (= 8 (logand 8 (getvar 'undoctl))) (command "_.UNDO" "_End"))
        (vl-catch-all-apply '(lambda ( ) (*pop-error-mode*)) '())
        (princ)
    )

    (defun *error* ( msg )
        (WeldMark:Restore)
        (if (and msg (not (wcmatch (strcase msg t) "*break*,*cancel*,*exit*")))
            (princ (strcat "\n** WELDMARK error: " msg " **")))
        (princ)
    )

    (setvar "CMDECHO" 0)
    ;; AutoCAD 2015 and later refuse (command) inside an *error* handler
    ;; unless the routine says up front that it will use one. Restore does,
    ;; to close this undo group. The declaring call is absent on older
    ;; releases, so it is wrapped rather than tested for.
    (vl-catch-all-apply '(lambda ( ) (*push-error-using-command*)) '())
    (command "_.UNDO" "_Begin")

    ;; DIMSCALE drives every dimension in the symbol. A drawing left at 0 would
    ;; produce zero-size geometry, so fall back to 1 and say so.
    (setq scl (getvar "DIMSCALE"))
    (if (zerop scl)
        (progn
            (setq scl 1.0)
            (princ "\nWeldMark: DIMSCALE is 0, so symbols are drawn at size 1.")))

    ;; A fixed-height text style overrides any height we would supply, and the
    ;; TEXT command does not prompt for height in that case. Detect it once here
    ;; so every TEXT call downstream knows which form to use.
    (setq txtht (cdr (assoc 40 (tblsearch "style" (getvar "TEXTSTYLE")))))
    (if (null txtht) (setq txtht 0.0))

    ;; Mirrored text would come out backwards; ortho would stop the leader from
    ;; sloping. Both are restored on exit.
    (setvar "MIRRTEXT" 0)
    (setvar "ORTHOMODE" 0)
    (setvar "BLIPMODE" 0)

    (WeldMark:EnsureLayer "WELD_SYM")

    ;; Place symbols until the user presses Enter at the arrow-tip prompt.
    (while (setq p1 (getpoint "\nArrow tip on the joint <Enter to finish>: "))

        ;; Running osnaps help snap the arrow to the joint but get in the way of
        ;; the elbow, which is free space. Off for the second pick only.
        (setvar "OSMODE" 0)
        (setq p2 (getpoint p1 "\nElbow of the leader: "))
        (setvar "OSMODE" (nth (vl-position "OSMODE" vars) vals))

        (cond
            ((null p2)
             (princ "\nCancelled - no elbow point given."))

            ((not (WeldMark:Dialog))
             (princ "\nCancelled - no weld type chosen."))

            (t
                ;; Reference line runs right when the leader travels rightward,
                ;; left when it travels leftward, so the symbol always reads
                ;; correctly no matter which way the leader was dragged.
                (setq a1 (if (or (<= (angle p1 p2) (WeldMark:Rad 90))
                                 (>= (angle p1 p2) (WeldMark:Rad 270)))
                             0.0
                             (WeldMark:Rad 180)))

                (setq p3   (polar p2 a1 (* scl 0.60))
                      ss   (ssadd)
                      side (WeldMark:Get "SIDE")
                      sym  (cadr (assoc (WeldMark:Get "TYPE") WeldMark:Symbols)))

                ;; Size text goes to the left of the symbol and pitch to the
                ;; right, in reading order - which swaps their distances along
                ;; the reference line when that line runs leftward.
                (if (zerop a1)
                    (setq tp1 (polar p2 a1 (* scl 0.25))
                          tp2 (polar p2 a1 (* scl 0.95)))
                    (setq tp1 (polar p2 a1 (* scl 0.95))
                          tp2 (polar p2 a1 (* scl 0.25))))
                (setq tp1 (polar tp1 (WeldMark:Rad 90) (* scl 0.15))
                      tp2 (polar tp2 (WeldMark:Rad 90) (* scl 0.15)))

                ;; Leader and reference line in one polyline: a tapered segment
                ;; forms the solid arrowhead, then zero width for the rest.
                (command "_.PLINE" p1
                         "_W" 0 (* scl 0.0469)
                         (polar p1 (angle p1 p2) (* scl 0.125))
                         "_W" 0 0
                         p2
                         (polar p2 a1 (* scl 1.20)) "")

                ;; Backing arc first, and kept out of the mirror set on purpose:
                ;; it must stay opposite the main symbol.
                (setq backent nil)
                (if (= (WeldMark:Get "BACK") "1")
                    (setq backent (WeldMark:Backing scl p3 side)))

                ;; The weld symbol itself, collected for the mirror.
                (if sym (apply sym (list scl p3 ss)))

                ;; Size and pitch text, also collected so they follow the symbol
                ;; to whichever side of the line it ends up on.
                (if (/= (WeldMark:Get "SIZE") "")
                    (progn
                        (if (zerop txtht)
                            (command "_.TEXT" "_J" "_MC" tp1 (* scl 0.094) 0 (WeldMark:Get "SIZE"))
                            (command "_.TEXT" "_J" "_MC" tp1 0 (WeldMark:Get "SIZE")))
                        (WeldMark:Keep ss)))
                (if (/= (WeldMark:Get "PITCH") "")
                    (progn
                        (if (zerop txtht)
                            (command "_.TEXT" "_J" "_MC" tp2 (* scl 0.094) 0 (WeldMark:Get "PITCH"))
                            (command "_.TEXT" "_J" "_MC" tp2 0 (WeldMark:Get "PITCH")))
                        (WeldMark:Keep ss)))

                ;; Everything so far was drawn above the reference line, which is
                ;; the "other side" position. Arrow-side welds get mirrored down
                ;; and the originals deleted; both-sides welds get mirrored and
                ;; the originals kept; other-side welds are already correct.
                (if (and (> (sslength ss) 0) (member side '("This" "Both")))
                    (command "_.MIRROR" ss "" p2 (polar p2 a1 (* scl 0.5))
                             (if (= side "This") "_Yes" "_No")))

                ;; Decorations last: never mirrored, never collected.
                (if (= (WeldMark:Get "ROUND") "1") (WeldMark:AllAround scl p2))
                (if (= (WeldMark:Get "FIELD") "1") (WeldMark:FieldFlag scl p2 a1))

                (setq notes (list (WeldMark:Get "NOTE1")
                                  (WeldMark:Get "NOTE2")
                                  (WeldMark:Get "NOTE3")))
                (WeldMark:Notes scl p2 a1 notes txtht)
            )
        )
    )

    (WeldMark:Restore)
    (princ)
)

(princ)
