;;; ---------------------------------------------------------------------------
;;; UnitSpan.lsp
;;; code compiled by YZ August 2026
;;; ---------------------------------------------------------------------------
;;; ONE MEASUREMENT, EVERY UNIT FORMAT, SIDE BY SIDE
;;;
;;; PURPOSE
;;;   Measures between two points and shows the result simultaneously in decimal,
;;;   fractional, engineering, architectural and metric notation - and does the
;;;   same for the X and Y components and the bearing.
;;;
;;;   The built-in DIST command answers in whatever format UNITS happens to be
;;;   set to. That is fine until you are reading an architectural drawing while
;;;   filling in a supplier's form that wants millimetres, or checking a
;;;   fractional dimension against a decimal one. This puts all of them on screen
;;;   at once so there is no converting in your head and no changing UNITS back
;;;   and forth.
;;;
;;; HOW IT WORKS
;;;   1. You pick two points. The routine stores the raw distance, plus the pure
;;;      horizontal and pure vertical components, worked out by building two
;;;      corner points from the X of one pick and the Y of the other.
;;;
;;;   2. Every value is normalised to INCHES internally, whatever the drawing is
;;;      actually drawn in. That one decision is what makes the rest simple: the
;;;      four imperial formats read the internal number directly, and the metric
;;;      column is that number times 25.4. Tell the dialog whether the drawing is
;;;      in inches or millimetres and it divides on the way in accordingly.
;;;
;;;   3. Each row has its own precision slider, from 0 to 8 places, and the whole
;;;      table redraws the instant you move one. Precision choices and the unit
;;;      basis are remembered for the rest of the drawing session.
;;;
;;;   4. Results sit in edit boxes rather than plain text so you can select a
;;;      value and copy it straight out with Ctrl+C into an email or a form.
;;;      Nothing you type into them affects the drawing - they are display only.
;;;
;;;   5. "Measure Again" re-picks two points without closing, so checking a run
;;;      of dimensions is pick-pick-read, pick-pick-read.
;;;
;;; NOTHING IS DRAWN
;;;   This routine is purely a read-out. It creates no geometry, no layers and no
;;;   text, and leaves the drawing exactly as it found it.
;;;
;;;   UNITSPAN  - measure two points and read the result in every unit format
;;; ---------------------------------------------------------------------------

;;; ---------------------------------------------------------------------------
;;; SESSION MEMORY
;;;
;;; Kept global on purpose so the precision you chose and the unit basis you set
;;; survive from one measurement to the next. PREC holds the decimal places for
;;; the five distance rows and the angle row, in display order.
;;; ---------------------------------------------------------------------------

(if (null *UnitSpan:Prefs*)
    (setq *UnitSpan:Prefs*
        (list
            (cons "PREC"  (list 4 4 4 4 2 4))  ; dec, frac, eng, arch, metric, angle
            (cons "BASIS" 0)                   ; 0 = drawing is in inches, 1 = mm
            (cons "AFROM" 0)                   ; 0 = angle Pt1->Pt2, 1 = Pt2->Pt1
        )
    )
)

(defun UnitSpan:Get ( key ) (cdr (assoc key *UnitSpan:Prefs*)))

(defun UnitSpan:Put ( key val )
    (setq *UnitSpan:Prefs*
        (cons (cons key val)
              (vl-remove-if '(lambda (p) (= (car p) key)) *UnitSpan:Prefs*)))
    val
)

;;; Read or write one entry of the precision list by row index (0-based).
(defun UnitSpan:Prec ( idx ) (nth idx (UnitSpan:Get "PREC")))

(defun UnitSpan:SetPrec ( idx val / lst i out )
    (setq lst (UnitSpan:Get "PREC") i 0 out nil)
    (foreach p lst
        (setq out (cons (if (= i idx) val p) out) i (1+ i)))
    (UnitSpan:Put "PREC" (reverse out))
)

;;; ---------------------------------------------------------------------------
;;; FORMATTING
;;;
;;; RTOS mode numbers are not memorable, so they are named here once and used by
;;; name everywhere else:  2 = decimal, 5 = fractional, 3 = engineering,
;;; 4 = architectural. Metric is decimal applied to the inch value scaled by 25.4.
;;;
;;; ANGTOS mode numbers likewise:  0 = decimal degrees, 1 = degrees/minutes/secs.
;;; ---------------------------------------------------------------------------

;;; Format one inch-based value for one row of the table. Row indexes match the
;;; PREC list, so the precision to use comes straight from the row number.
(defun UnitSpan:Fmt ( inches row )
    (cond
        ((= row 0) (strcat (rtos inches 2 (UnitSpan:Prec 0)) "\""))
        ((= row 1) (strcat (rtos inches 5 (UnitSpan:Prec 1)) "\""))
        ((= row 2)         (rtos inches 3 (UnitSpan:Prec 2)))
        ((= row 3)         (rtos inches 4 (UnitSpan:Prec 3)))
        ((= row 4) (strcat (rtos (* inches 25.4) 2 (UnitSpan:Prec 4)) " mm"))
        (t "")
    )
)

;;; ---------------------------------------------------------------------------
;;; THE DIALOG DEFINITION
;;;
;;; Written to a temporary .dcl when needed and deleted afterwards, so this file
;;; is the only thing to install.
;;;
;;; Tile key convention, which the callback wiring below relies on:
;;;   d<row>a / d<row>b / d<row>c   the three value boxes on distance row <row>
;;;   p<row>                        the numeric precision read-out
;;;   s<row>                        the precision slider
;;; ---------------------------------------------------------------------------

(defun UnitSpan:DclText ( / rows out )

    ;; One builder for all five distance rows keeps them identical by
    ;; construction - a label, three read-out boxes, a number and a slider.
    (defun UnitSpan:Row ( n label )
        (list
            "  : row {"
            (strcat "    : text { label = \"" label "\"; width = 14; fixed_width = true; }")
            (strcat "    : edit_box { key = \"d" (itoa n) "a\"; width = 15; }")
            (strcat "    : edit_box { key = \"d" (itoa n) "b\"; width = 15; }")
            (strcat "    : edit_box { key = \"d" (itoa n) "c\"; width = 15; }")
            (strcat "    : text { key = \"p" (itoa n) "\"; width = 2; alignment = centered; }")
            (strcat "    : slider { key = \"s" (itoa n) "\"; min_value = 0; max_value = 8;"
                    " small_increment = 1; big_increment = 2; width = 10; }")
            "  }"
        )
    )

    (setq out
        (append
            (list
            "unitspan : dialog {"
            "  key = \"title\";"
            "  : row {"
            "    : text { label = \"\"; width = 14; fixed_width = true; }"
            "    : text { label = \"Pt1 to Pt2\"; width = 15; alignment = centered; }"
            "    : text { label = \"X component\"; width = 15; alignment = centered; }"
            "    : text { label = \"Y component\"; width = 15; alignment = centered; }"
            "    : text { label = \"\"; width = 2; }"
            "    : text { label = \"- places +\"; width = 10; alignment = centered; }"
            "  }"
            "  : image { color = 8; height = 0.15; }"
            )
            (UnitSpan:Row 0 "Decimal")
            (UnitSpan:Row 1 "Fractional")
            (UnitSpan:Row 2 "Engineering")
            (UnitSpan:Row 3 "Architectural")
            (UnitSpan:Row 4 "Metric")
            (list
            "  : image { color = 8; height = 0.2; }"
            "  : row {"
            "    : text { label = \"Angle\"; width = 14; fixed_width = true; }"
            "    : column { : text { label = \"Nearest degree\"; alignment = centered; }"
            "               : edit_box { key = \"a0\"; width = 15; } }"
            "    : column { : text { label = \"Decimal degrees\"; alignment = centered; }"
            "               : edit_box { key = \"a1\"; width = 15; } }"
            "    : column { : text { label = \"Deg / min / sec\"; alignment = centered; }"
            "               : edit_box { key = \"a2\"; width = 15; } }"
            "    : text { key = \"p5\"; width = 2; alignment = centered; }"
            "    : slider { key = \"s5\"; min_value = 0; max_value = 8;"
            "               small_increment = 1; big_increment = 2; width = 10; }"
            "  }"
            "  : image { color = 8; height = 0.2; }"
            "  : row {"
            "    : boxed_radio_row { label = \"This drawing is drawn in\";"
            "      : radio_button { key = \"basis0\"; label = \"Inches\"; }"
            "      : radio_button { key = \"basis1\"; label = \"Millimetres\"; }"
            "    }"
            "    : boxed_radio_row { label = \"Measure the angle\";"
            "      : radio_button { key = \"afrom0\"; label = \"Pt1 to Pt2\"; }"
            "      : radio_button { key = \"afrom1\"; label = \"Pt2 to Pt1\"; }"
            "    }"
            "  }"
            "  spacer;"
            "  : row {"
            "    : button { key = \"again\"; label = \"Measure Again\"; width = 16; fixed_width = true; }"
            "    : button { key = \"accept\"; label = \"Close\"; is_default = true;"
            "               width = 12; fixed_width = true; }"
            "  }"
            "}"
            )
        )
    )
    out
)

(defun UnitSpan:WriteDcl ( / file handle )
    (if (and (setq file (vl-filename-mktemp "unitspan" nil ".dcl"))
             (setq handle (open file "w")))
        (progn
            (foreach line (UnitSpan:DclText) (write-line line handle))
            (close handle)
            file
        )
    )
)

;;; ---------------------------------------------------------------------------
;;; MEASUREMENT
;;;
;;; Returns a list of three distances, all normalised to inches:
;;;   (straight-line  X-component  Y-component)
;;;
;;; The components are found by building the two corners of the bounding
;;; rectangle the two picks describe, which gives a pure horizontal and a pure
;;; vertical run without any trigonometry.
;;; ---------------------------------------------------------------------------

(defun UnitSpan:Measure ( p1 p2 / corner div )
    (setq corner (list (car p1) (cadr p2))
          ;; Drawn in millimetres? Then convert to the internal inch basis.
          div    (if (= 1 (UnitSpan:Get "BASIS")) 25.4 1.0))
    (list
        (/ (distance p1 p2) div)                                  ; straight line
        (/ (distance corner (list (car p2) (cadr p2))) div)       ; horizontal run
        (/ (distance (list (car p1) (cadr p1)) corner) div)       ; vertical run
    )
)

;;; ---------------------------------------------------------------------------
;;; DIALOG POPULATION
;;;
;;; Held apart from the wiring so it can be called again from every slider and
;;; radio callback - one function is the single source of what the table shows.
;;; ---------------------------------------------------------------------------

(defun UnitSpan:Refresh ( / d ang n )
    (setq d (UnitSpan:Measure *UnitSpan:P1* *UnitSpan:P2*))

    ;; Five distance rows, three columns each.
    (setq n 0)
    (repeat 5
        (set_tile (strcat "d" (itoa n) "a") (UnitSpan:Fmt (car   d) n))
        (set_tile (strcat "d" (itoa n) "b") (UnitSpan:Fmt (cadr  d) n))
        (set_tile (strcat "d" (itoa n) "c") (UnitSpan:Fmt (caddr d) n))
        (set_tile (strcat "p" (itoa n)) (itoa (UnitSpan:Prec n)))
        (set_tile (strcat "s" (itoa n)) (itoa (UnitSpan:Prec n)))
        (setq n (1+ n))
    )

    ;; The bearing, measured in whichever direction is currently selected.
    (setq ang (if (= 1 (UnitSpan:Get "AFROM"))
                  (angle *UnitSpan:P2* *UnitSpan:P1*)
                  (angle *UnitSpan:P1* *UnitSpan:P2*)))
    (set_tile "a0" (angtos ang 0 0))
    (set_tile "a1" (angtos ang 0 (UnitSpan:Prec 5)))
    (set_tile "a2" (angtos ang 1 (UnitSpan:Prec 5)))
    (set_tile "p5" (itoa (UnitSpan:Prec 5)))
    (set_tile "s5" (itoa (UnitSpan:Prec 5)))

    (set_tile "title"
        (strcat "UnitSpan     -     drawing units read as "
                (if (= 1 (UnitSpan:Get "BASIS")) "MILLIMETRES" "INCHES")))
    (princ)
)

;;; Slider callback. Clamped because a slider can report one step outside its
;;; declared range on some platforms, and RTOS rejects a negative precision.
(defun UnitSpan:Slide ( idx val / p )
    (setq p (atoi val))
    (if (< p 0) (setq p 0))
    (if (> p 8) (setq p 8))
    (UnitSpan:SetPrec idx p)
    (UnitSpan:Refresh)
)

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

(defun c:UNITSPAN ( / *error* vars vals file id again p1 p2 n )

    (setq vars '("CMDECHO" "ORTHOMODE")
          vals (mapcar 'getvar vars))

    (defun UnitSpan:Restore ( )
        (mapcar 'setvar vars vals)
        (setq *UnitSpan:P1* nil *UnitSpan:P2* nil)
        (princ)
    )

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

    (setvar "CMDECHO" 0)
    ;; Ortho off so the two picks can be anywhere; there is nothing being drawn
    ;; that would want constraining.
    (setvar "ORTHOMODE" 0)

    ;; No UNDO group here on purpose. This command creates nothing, so wrapping
    ;; it would put an empty step in the undo stack for the user to step back
    ;; through for no reason.

    (setq again t)

    (while again
        (setq again nil)
        (setq p1 (getpoint "\nFirst point: "))
        (if (null p1)
            (princ "\nCancelled.")
            (progn
                (setq p2 (getpoint p1 "\nSecond point: "))
                (if (null p2)
                    (princ "\nCancelled.")
                    (progn
                        ;; Held globally because the dialog callbacks need them
                        ;; and callbacks cannot see this function's locals.
                        (setq *UnitSpan:P1* p1
                              *UnitSpan:P2* p2)

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

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

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

                            (t
                                ;; Restore the remembered radio settings before
                                ;; the first refresh, so the table is drawn on
                                ;; the right basis from the outset.
                                (set_tile (strcat "basis" (itoa (UnitSpan:Get "BASIS"))) "1")
                                (set_tile (strcat "afrom" (itoa (UnitSpan:Get "AFROM"))) "1")

                                (UnitSpan:Refresh)

                                ;; Six sliders, wired by index. Building the
                                ;; callback as text is the only way DCL accepts
                                ;; it, so the index is baked into each string.
                                (setq n 0)
                                (repeat 6
                                    (action_tile (strcat "s" (itoa n))
                                        (strcat "(UnitSpan:Slide " (itoa n) " $value)"))
                                    (setq n (1+ n))
                                )

                                (action_tile "basis0" "(UnitSpan:Put \"BASIS\" 0)(UnitSpan:Refresh)")
                                (action_tile "basis1" "(UnitSpan:Put \"BASIS\" 1)(UnitSpan:Refresh)")
                                (action_tile "afrom0" "(UnitSpan:Put \"AFROM\" 0)(UnitSpan:Refresh)")
                                (action_tile "afrom1" "(UnitSpan:Put \"AFROM\" 1)(UnitSpan:Refresh)")

                                ;; 2 is returned by "Measure Again" and drives
                                ;; the outer loop round for another pair of picks.
                                (action_tile "again"  "(done_dialog 2)")
                                (action_tile "accept" "(done_dialog 1)")

                                (setq again (= 2 (start_dialog)))
                                (unload_dialog id)
                                (vl-file-delete file)
                            )
                        )
                    )
                )
            )
        )
    )

    (UnitSpan:Restore)
    (princ)
)

(princ)