;;; ---------------------------------------------------------------------------
;;; Ripple.lsp
;;; code compiled by YZ August 2026
;;; ---------------------------------------------------------------------------
;;; DYNAMIC MULTIPLE OFFSET
;;;
;;; Select some curves, then drag. Ripple offsets them live, both sides at
;;; once if you want, as many times as you want, and shows you the whole set
;;; before you commit to it.
;;;
;;; Where the native OFFSET command asks for a distance and then a side, and
;;; does one curve at a time, Ripple does the lot in one gesture: pick the
;;; objects, drag to the outermost line, and every intermediate offset falls
;;; into place. Kerbs, road markings, wall build-ups, contour bands and
;;; setting-out grids all come out in a single move.
;;;
;;; Three things make it more than a faster OFFSET.
;;;
;;;   BOTH SIDES. Press TAB to cycle between outer only, inner only, and
;;;   both. Offsetting a road centreline to both kerb lines is one drag.
;;;
;;;   A SPACING FACTOR. Each successive offset can be a multiple of the last.
;;;   A factor of 1 gives even spacing; 2 doubles the gap each time; 0.5
;;;   halves it. The total always ends exactly at your cursor, so changing
;;;   the factor redistributes the lines without moving the outermost one.
;;;
;;;   PROPERTIES PER SIDE. The inner and outer offsets can be given their own
;;;   layer, colour, linetype and lineweight, set once in a settings dialog
;;;   with a live preview. Offset a centreline and the results land on the
;;;   kerb layer automatically.
;;;
;;; ---------------------------------------------------------------------------
;;; HOW IT WORKS
;;;
;;; The command runs inside a grread loop, which reports mouse movement and
;;; keystrokes continuously without ending.
;;;
;;; On every mouse move:
;;;   1. The selected curves are re-sorted by distance from the cursor, so
;;;      the nearest one becomes the reference.
;;;   2. The distance from that curve to the cursor is divided by the total
;;;      of the spacing series, giving the base offset distance.
;;;   3. Every previous preview object is deleted and a fresh set created at
;;;      the new distances.
;;;
;;; The preview is made of real offset objects rather than temporary
;;; graphics, which is why the properties and linetypes you see are exactly
;;; what you will get. The cost is that they must be cleaned up on every
;;; frame and on every exit path, which is what the error handler is for.
;;;
;;; ---------------------------------------------------------------------------
;;; THE SPACING SERIES
;;;
;;; With N offsets and factor F, the offsets are placed at
;;;
;;;     d, d(1+F), d(1+F+F^2), ... up to N terms
;;;
;;; and the base distance d is chosen so the last one lands under the cursor.
;;; That is why dragging feels natural regardless of how many offsets or what
;;; factor is set: the thing you are pointing at is always the outermost
;;; line.
;;;
;;; ---------------------------------------------------------------------------
;;; OBJECT SNAP
;;;
;;; grread does not show AutoCAD's snap markers, so Ripple draws them itself:
;;; it tests the cursor against every enabled snap mode, picks the nearest
;;; hit, and draws that mode's marker glyph at the point. The marker uses the
;;; colour and size from your own drafting settings, so it looks exactly like
;;; the real thing. Clicking snaps to it.
;;;
;;; ---------------------------------------------------------------------------
;;; CONTROLS
;;;
;;;   drag          set the offset distance
;;;   type a number then Enter, to set it exactly
;;;   TAB           cycle outer / inner / both
;;;   + or =        one more offset
;;;   -             one fewer offset
;;;   N             type an exact number of offsets
;;;   F             set the spacing factor
;;;   C             set the distance by picking two existing objects
;;;   D             toggle deleting the original objects
;;;   S             open the settings dialog
;;;   F3            toggle object snap
;;;   SHIFT         highlight the preview in blue and skip property overrides
;;;   click         accept
;;;   Esc           cancel and remove the preview
;;;
;;; The SHIFT option needs Express Tools; everything else works without it.
;;;
;;; ---------------------------------------------------------------------------
;;;   RIPPLE    - dynamic multiple offset
;;;   RIPPLESET - offset property settings
;;; ---------------------------------------------------------------------------

(vl-load-com)

;;; ---------------------------------------------------------------------------
;;; Persistent preferences. Global so the command comes back the way you left
;;; it, and because the settings dialog is a separate command that has to
;;; reach the same values.
;;;
;;;   *Ripple:Dist*   last offset distance
;;;   *Ripple:Num*    number of offsets per side
;;;   *Ripple:Factor* spacing multiplier between successive offsets
;;;   *Ripple:Mode*   0 outer only, 1 inner only, 2 both
;;;   *Ripple:Del*    delete the original objects afterwards
;;; ---------------------------------------------------------------------------

(or *Ripple:Dist*   (setq *Ripple:Dist*   10.0))
(or *Ripple:Num*    (setq *Ripple:Num*     1  ))
(or *Ripple:Factor* (setq *Ripple:Factor*  1.0))
(or *Ripple:Mode*   (setq *Ripple:Mode*    2  ))
(or *Ripple:Del*    (setq *Ripple:Del*    nil ))

;;; ---------------------------------------------------------------------------
;;; *Ripple:Props*
;;;
;;; The per-side property settings, in this fixed order:
;;;
;;;    0  inner: use the source object's colour   ("1" or "0")
;;;    1  outer: use the source object's colour
;;;    2  inner colour   (integer ACI, or 256 meaning "take from source")
;;;    3  outer colour
;;;    4  inner layer    ("*Source*" to keep the source object's layer)
;;;    5  outer layer
;;;    6  inner linetype ("*Source*" to keep the source object's linetype)
;;;    7  outer linetype
;;;    8  inner lineweight
;;;    9  outer lineweight
;;;
;;; A single flat list is used rather than named variables because the
;;; settings dialog reads and writes it as a unit.
;;; ---------------------------------------------------------------------------

(or *Ripple:Props*
    (setq *Ripple:Props*
       '("1" "1"                    ;; use source colour, both sides
         256 256                    ;; colours
         "*Source*" "*Source*"      ;; layers
         "ByLayer"  "ByLayer"       ;; linetypes
         "ByLayer"  "ByLayer"       ;; lineweights
        )
    )
)

;;; ---------------------------------------------------------------------------
;;; *Ripple:Marker*
;;;
;;; The object snap marker glyph vectors, built once per run from the user's
;;; drafting settings. Global because the marker-drawing function is called
;;; from inside the drag loop and has no other way to reach them.
;;; ---------------------------------------------------------------------------

(setq *Ripple:Marker* nil)

;;; ---------------------------------------------------------------------------
;;; Ripple:Doc
;;;
;;; Returns the active document, caching itself after the first call.
;;; ---------------------------------------------------------------------------

(defun Ripple:Doc nil
    (eval (list 'defun 'Ripple:Doc 'nil (vla-get-activedocument (vlax-get-acad-object))))
    (Ripple:Doc)
)

;;; ---------------------------------------------------------------------------
;;; Ripple:Validate
;;;
;;; Repairs the stored property settings against the current drawing.
;;;
;;; A layer or linetype named in the settings may not exist in the drawing
;;; that is open now -- the settings are shared across every drawing. Rather
;;; than failing when the offset is created, any name that is not defined
;;; falls back to taking that property from the source object.
;;; ---------------------------------------------------------------------------

(defun Ripple:Validate ( / idx )
    (setq idx -1)
    (setq *Ripple:Props*
        (mapcar
           '(lambda ( val )
                (setq idx (1+ idx))
                (cond
                    ;;  Positions 4 and 5 are layer names.
                    (   (<= 4 idx 5)
                        (if (or (= "*Source*" val) (tblsearch "LAYER" val)) val "*Source*")
                    )
                    ;;  Positions 6 and 7 are linetype names.
                    (   (<= 6 idx 7)
                        (if (or (member val '("*Source*" "ByLayer" "ByBlock"))
                                (tblsearch "LTYPE" val)
                            )
                            val
                            "ByLayer"
                        )
                    )
                    (   val)
                )
            )
            *Ripple:Props*
        )
    )
    (princ)
)

;;; ===========================================================================
;;; RIPPLE
;;; ===========================================================================

(defun c:Ripple

    ( /
        *error* Ripple:Clean Ripple:Offset Ripple:Restore Ripple:Str2Num
        Ripple:SeriesTotal Ripple:Build Ripple:SnapPoint
        base buf code data draft ents e1 e2 express gr made mode msg objs
        pt1 pt2 quit snap vals vars
    )

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

    ;;; -----------------------------------------------------------------------
    ;;; Ripple:Clean
    ;;;
    ;;; Deletes every preview object in the supplied list and returns nil.
    ;;;
    ;;; Returning nil is deliberate: callers write
    ;;;     (setq made (Ripple:Clean made))
    ;;; which both erases the preview and empties the list in one step, so the
    ;;; list can never hold a reference to something already deleted.
    ;;;
    ;;; Each delete is guarded because an object may have been erased by an
    ;;; undo, or may sit on a layer that has since been locked.
    ;;; -----------------------------------------------------------------------

    (defun Ripple:Clean ( lst )
        (foreach obj lst
            (if (and (= 'vla-object (type obj)) (not (vlax-erased-p obj)))
                (vl-catch-all-apply 'vla-delete (list obj))
            )
        )
        nil
    )

    ;;; -----------------------------------------------------------------------
    ;;; Ripple:Restore
    ;;; -----------------------------------------------------------------------

    (defun Ripple:Restore ( )
        (redraw)
        (mapcar 'setvar vars vals)
        (while (= 8 (logand 8 (getvar 'undoctl)))
            (vla-endundomark (Ripple:Doc))
        )
        (princ)
    )

    (defun *error* ( msg )
        ;; The preview is made of real objects, so a cancel must actively
        ;; remove them or they are left in the drawing.
        (setq made (Ripple:Clean made))
        (Ripple:Restore)
        (if (and msg (not (wcmatch (strcase msg t) "*break*,*cancel*,*exit*")))
            (princ (strcat "\n** RIPPLE error: " msg " **"))
        )
        (princ)
    )

    ;;; -----------------------------------------------------------------------
    ;;; Ripple:Str2Num
    ;;;
    ;;; Converts typed text to a number, trying every AutoCAD distance format
    ;;; in turn: decimal, engineering, scientific, architectural, fractional.
    ;;; Returns nil if it is not a valid distance in any of them.
    ;;;
    ;;; The grread loop collects keystrokes itself and so cannot use getdist,
    ;;; which would end the drag.
    ;;; -----------------------------------------------------------------------

    (defun Ripple:Str2Num ( str )
        (cond
            ((distof str 5)) ((distof str 2)) ((distof str 1))
            ((distof str 4)) ((distof str 3))
        )
    )

    ;;; -----------------------------------------------------------------------
    ;;; Ripple:SeriesTotal
    ;;;
    ;;; Returns the sum  1 + F + F^2 + ... + F^(N-1).
    ;;;
    ;;; This is the total of the spacing series in units of the base offset.
    ;;; Dividing the cursor distance by it gives the base offset that makes
    ;;; the outermost line land exactly under the cursor -- which is what
    ;;; makes dragging feel right whatever the count and factor.
    ;;;
    ;;;   num - number of offsets
    ;;;   fac - spacing factor
    ;;; -----------------------------------------------------------------------

    (defun Ripple:SeriesTotal ( num fac / total )
        (setq total 0.0)
        (while (not (minusp (setq num (1- num))))
            (setq total (+ total (expt fac num)))
        )
        ;; Guard against a zero total, which a factor of zero would produce
        ;; and which would then divide by zero.
        (if (equal 0.0 total 1e-10) 1.0 total)
    )

    ;;; -----------------------------------------------------------------------
    ;;; Ripple:Offset
    ;;;
    ;;; Offsets one object by one distance, on whichever sides the mode calls
    ;;; for, and applies the configured properties.
    ;;;
    ;;; A positive distance offsets one way, a negative distance the other;
    ;;; which is "inner" and which "outer" depends on the object's own
    ;;; direction, which is why the mode is expressed as bit flags rather
    ;;; than as a side.
    ;;;
    ;;; The whole thing is caught: Offset fails outright on a curve too tight
    ;;; to offset by that much -- a small arc offset inwards past its own
    ;;; radius, for instance -- and during a drag that happens constantly.
    ;;; Failure returns nil and the caller simply shows nothing that frame.
    ;;;
    ;;;   src - the source VLA object
    ;;;   off - offset distance
    ;;;
    ;;; Returns a list of the new objects, or nil.
    ;;; -----------------------------------------------------------------------

    (defun Ripple:Offset ( src off / inner outer result )
        (setq result
            (vl-catch-all-apply
               '(lambda ( )
                    ;; Bit 1 of the mode means "outer".
                    (if (= 1 (logand 1 mode))
                        (progn
                            (setq outer (vlax-invoke src 'offset off))
                            ;; Holding SHIFT skips the property overrides, so
                            ;; the offsets come out identical to the source --
                            ;; useful when the configured properties are wrong
                            ;; for this one case.
                            (if (not (and express (acet-sys-shift-down)))
                                (foreach obj outer
                                    (Ripple:ApplyProps src obj
                                        (nth 1 *Ripple:Props*)   ;; use source colour
                                        (nth 3 *Ripple:Props*)   ;; colour
                                        (nth 5 *Ripple:Props*)   ;; layer
                                        (nth 7 *Ripple:Props*)   ;; linetype
                                        (nth 9 *Ripple:Props*)   ;; lineweight
                                    )
                                )
                            )
                        )
                    )
                    ;; Bit 2 of the mode means "inner": the same offset the
                    ;; other way.
                    (if (= 2 (logand 2 mode))
                        (progn
                            (setq inner (vlax-invoke src 'offset (- off)))
                            (if (not (and express (acet-sys-shift-down)))
                                (foreach obj inner
                                    (Ripple:ApplyProps src obj
                                        (nth 0 *Ripple:Props*)
                                        (nth 2 *Ripple:Props*)
                                        (nth 4 *Ripple:Props*)
                                        (nth 6 *Ripple:Props*)
                                        (nth 8 *Ripple:Props*)
                                    )
                                )
                            )
                        )
                    )
                    (append outer inner)
                )
            )
        )
        (if (vl-catch-all-error-p result)
            ;; Partial results must still be removed, or a failed frame
            ;; leaves stray geometry behind.
            (progn (Ripple:Clean (append outer inner)) nil)
            result
        )
    )

    ;;; -----------------------------------------------------------------------
    ;;; Ripple:Build
    ;;;
    ;;; Creates the whole set of offsets, at every distance in the spacing
    ;;; series, for every selected object.
    ;;;
    ;;; The running distance accumulates the series terms, so offset K sits at
    ;;;     base * (1 + F + F^2 + ... + F^(K-1))
    ;;; which spaces them by a constantly-scaling gap rather than evenly.
    ;;;
    ;;;   base - the base offset distance
    ;;;
    ;;; Returns the list of created objects.
    ;;; -----------------------------------------------------------------------

    (defun Ripple:Build ( base / made pow run set )
        (foreach src objs
            (setq pow -1
                  run 0.0
            )
            (repeat *Ripple:Num*
                (setq run (+ run (expt *Ripple:Factor* (setq pow (1+ pow)))))
                (if (setq set (Ripple:Offset src (* run base)))
                    (setq made (append made set))
                    ;; A failure part-way through means the remaining
                    ;; distances will fail too; discard the lot rather than
                    ;; leaving a half-drawn set on screen.
                    (setq made (Ripple:Clean made))
                )
            )
        )
        made
    )

    ;;; -----------------------------------------------------------------------
    ;;; Ripple:SnapPoint
    ;;;
    ;;; Returns (point mode-string) for the nearest active object snap to the
    ;;; cursor, or nil.
    ;;;
    ;;; Every enabled snap mode is tested and the closest hit wins, which is
    ;;; how AutoCAD itself resolves competing snaps. OSMODE bit 16384 means
    ;;; snapping is switched off entirely, so nothing is tested then.
    ;;;
    ;;;   pnt - the cursor position
    ;;; -----------------------------------------------------------------------

    (defun Ripple:SnapPoint ( pnt / hits )
        (if (< 0 (getvar 'osmode) 16384)
            (if (setq hits
                    (vl-remove-if 'null
                        (mapcar
                           '(lambda ( md / p )
                                (if (setq p (osnap pnt md))
                                    (list (distance pnt p) p md)
                                )
                            )
                            (Ripple:ActiveSnaps)
                        )
                    )
                )
                (cdar (vl-sort hits '(lambda ( a b ) (< (car a) (car b)))))
            )
        )
    )

    ;;; =======================================================================
    ;;;                       M A I N   R O U T I N E
    ;;; =======================================================================

    (setvar 'cmdecho 0)
    (Ripple:Validate)
    (setq mode (nth *Ripple:Mode* '(1 2 3)))

    ;; ---- Express Tools shift detection --------------------------------------
    (setq express
        (not (vl-catch-all-error-p
                 (vl-catch-all-apply 'acet-sys-shift-down '())
             )
        )
    )
    (or express (princ "\nExpress Tools not loaded - the SHIFT option is unavailable."))

    ;; ---- build the snap marker glyphs ---------------------------------------
    ;; Taken from the user's own drafting preferences so the marker matches
    ;; the one AutoCAD would draw.
    (setq draft (vla-get-drafting (vla-get-preferences (vlax-get-acad-object)))
          *Ripple:Marker*
              (Ripple:MarkerVectors
                  (vla-get-autosnapmarkercolor draft)
                  (vla-get-autosnapmarkersize  draft)
              )
    )

    (princ "\nSelect objects to offset...")
    (if (null (setq objs (ssget "_:L" '((0 . "ARC,CIRCLE,ELLIPSE,*LINE")))))
        (princ "\nNothing selected.")
        (progn
            (vla-startundomark (Ripple:Doc))

            ;; ssnamex is used rather than a plain ssname loop because it
            ;; returns the entities without the sub-entity noise, and the
            ;; entity names are needed as well as the objects: the sort by
            ;; distance below works on entity names through the curve
            ;; functions.
            (setq ents (vl-remove-if 'listp (mapcar 'cadr (ssnamex objs)))
                  objs (mapcar 'vlax-ename->vla-object ents)
                  buf  ""
            )

            (setq msg
               '(strcat
                    "\n[TAB] mode, [+/-] offset [N]umber, offset [F]actor"
                    "\n[C]entre between two objects, [S]ettings"
                    (if express ", [SHIFT] plain offsets" "")
                    ", [D]elete original = " (if *Ripple:Del* "Yes" "No")
                    "\nSpecify offset <" (vl-princ-to-string *Ripple:Dist*) ">: "
                )
            )
            (princ (eval msg))

            ;; ---- the drag loop ------------------------------------------
            (while
                (progn
                    (setq gr   (grread t 15 0)
                          code (car  gr)
                          data (cadr gr)
                    )
                    (redraw)
                    (cond

                        ;;  ---- mouse moved: rebuild the preview ----
                        (   (and (= 5 code) (listp data))

                            ;; The nearest curve becomes the reference, so
                            ;; the offset distance is measured from whichever
                            ;; object the user is actually pointing near.
                            (setq ents
                                (vl-sort ents
                                   '(lambda ( a b )
                                        (< (distance data (vlax-curve-getclosestpointto a data))
                                           (distance data (vlax-curve-getclosestpointto b data))
                                        )
                                    )
                                )
                            )
                            (setq pt1  (vlax-curve-getclosestpointto (car ents) data)
                                  base (/ (distance pt1 data)
                                          (Ripple:SeriesTotal *Ripple:Num* *Ripple:Factor*))
                            )
                            (grdraw pt1 data 3 1)

                            (setq made (Ripple:Clean made))

                            ;; Draw the snap marker, if any snap is in range.
                            (if (setq snap (Ripple:SnapPoint data))
                                (Ripple:DrawMarker snap)
                            )

                            (setq made (Ripple:Build base))

                            ;; With SHIFT held the preview is tinted blue, so
                            ;; it is obvious at a glance that the property
                            ;; overrides are being skipped.
                            (if (and made express (acet-sys-shift-down))
                                (foreach obj made (vla-put-color obj acblue))
                            )
                            t
                        )

                        ;;  ---- right-click: cancel ----
                        (   (= 25 code)
                            (setq made (Ripple:Clean made))
                            (setq quit t)
                            nil
                        )

                        ;;  ---- click: accept ----
                        (   (and (= 3 code) (listp data))
                            (setq made (Ripple:Clean made))
                            (setq pt1 (vlax-curve-getclosestpointto (car ents) data))

                            ;; If a snap was showing, the click takes the
                            ;; snapped point rather than the raw cursor
                            ;; position -- which is the whole point of drawing
                            ;; the marker.
                            (if (setq snap (Ripple:SnapPoint data))
                                (setq data (osnap (car snap) (cadr snap))
                                      *Ripple:Dist*
                                          (/ (distance
                                                 (vlax-curve-getclosestpointto (car ents) data)
                                                 data)
                                             (Ripple:SeriesTotal *Ripple:Num* *Ripple:Factor*))
                                )
                                (setq *Ripple:Dist* base)
                            )
                            (setq made (Ripple:Build *Ripple:Dist*))
                            nil
                        )

                        ;;  ---- a key was pressed ----
                        (   (= 2 code)
                            (cond
                                ;;  A digit or a decimal point: buffer it.
                                (   (or (= 46 data) (< 47 data 58))
                                    (setq buf (strcat buf (chr data)))
                                    (princ (chr data))
                                    t
                                )

                                ;;  C: set the distance from two existing
                                ;;  objects, so a new set can be matched to
                                ;;  spacing already in the drawing.
                                (   (vl-position data '(67 99))
                                    (setq made (Ripple:Clean made))
                                    (setq e1 (entsel "\nSelect first object: "))
                                    (if (and (vl-consp e1)
                                             (wcmatch (cdr (assoc 0 (entget (car e1))))
                                                      "ARC,CIRCLE,ELLIPSE,*LINE")
                                             (setq e2 (car (entsel "\nSelect second object: ")))
                                             (wcmatch (cdr (assoc 0 (entget e2)))
                                                      "ARC,CIRCLE,ELLIPSE,*LINE")
                                        )
                                        (progn
                                            (setq pt1 (vlax-curve-getclosestpointto (car e1) (cadr e1))
                                                  pt2 (vlax-curve-getclosestpointto e2 pt1)
                                            )
                                            ;; The series total uses one MORE
                                            ;; than the offset count here,
                                            ;; because the two picked objects
                                            ;; bracket the whole set rather
                                            ;; than one end of it.
                                            (setq *Ripple:Dist*
                                                (/ (distance pt1 pt2)
                                                   (Ripple:SeriesTotal (1+ *Ripple:Num*)
                                                                       *Ripple:Factor*))
                                            )
                                            (setq made (Ripple:Build *Ripple:Dist*))
                                            nil
                                        )
                                        (progn
                                            (princ "\nInvalid object selected.")
                                            (princ (eval msg))
                                            t
                                        )
                                    )
                                )

                                ;;  + or = : one more offset.
                                (   (vl-position data '(43 61))
                                    (setq *Ripple:Num* (1+ *Ripple:Num*))
                                    t
                                )

                                ;;  - : one fewer.
                                (   (= 45 data)
                                    (if (= 1 *Ripple:Num*)
                                        (princ (strcat "\nMinimum of one offset." (eval msg)))
                                        (setq *Ripple:Num* (1- *Ripple:Num*))
                                    )
                                    t
                                )

                                ;;  D: delete the originals afterwards.
                                (   (vl-position data '(68 100))
                                    (setq *Ripple:Del* (not *Ripple:Del*))
                                    (princ (strcat "\nOriginal objects "
                                                   (if *Ripple:Del* "will" "will not")
                                                   " be deleted" (eval msg)))
                                    t
                                )

                                ;;  N: type an exact count.
                                (   (vl-position data '(78 110))
                                    (initget 6)     ;; positive, non-zero
                                    (setq *Ripple:Num*
                                        (cond
                                            (   (getint (strcat "\nNumber of offsets <"
                                                                (itoa *Ripple:Num*) ">: ")))
                                            (   *Ripple:Num*)
                                        )
                                    )
                                    (princ (eval msg))
                                    t
                                )

                                ;;  F3: toggle object snap, by flipping the
                                ;;  16384 bit that means "snapping off".
                                (   (= 6 data)
                                    (if (< 0 (getvar 'osmode) 16384)
                                        (progn
                                            (setvar 'osmode (+ 16384 (getvar 'osmode)))
                                            (princ "\n<Osnap off>")
                                        )
                                        (progn
                                            (setvar 'osmode (- (getvar 'osmode) 16384))
                                            (princ "\n<Osnap on>")
                                        )
                                    )
                                    (princ (eval msg))
                                    t
                                )

                                ;;  TAB: cycle outer / inner / both.
                                (   (= 9 data)
                                    (setq *Ripple:Mode* (rem (1+ *Ripple:Mode*) 3)
                                          mode          (nth *Ripple:Mode* '(1 2 3))
                                    )
                                    t
                                )

                                ;;  F: spacing factor.
                                (   (vl-position data '(70 102))
                                    (initget 6)
                                    (setq *Ripple:Factor*
                                        (cond
                                            (   (getreal (strcat "\nSpacing factor <"
                                                                 (vl-princ-to-string *Ripple:Factor*)
                                                                 ">: ")))
                                            (   *Ripple:Factor*)
                                        )
                                    )
                                    (princ (eval msg))
                                    t
                                )

                                ;;  S: settings dialog.
                                (   (vl-position data '(83 115))
                                    (setq made (Ripple:Clean made))
                                    (Ripple:Settings (vlax-ename->vla-object (car ents)))
                                    (princ (eval msg))
                                    t
                                )

                                ;;  Backspace.
                                (   (and (< 0 (strlen buf)) (= 8 data))
                                    (setq buf (substr buf 1 (1- (strlen buf))))
                                    (princ (vl-list->string '(8 32 8)))
                                    t
                                )

                                ;;  Enter or Space: accept what was typed, or
                                ;;  the stored default if nothing was.
                                (   (vl-position data '(13 32))
                                    (cond
                                        (   (zerop (strlen buf))
                                            (setq made (Ripple:Clean made))
                                            (setq made (Ripple:Build *Ripple:Dist*))
                                            nil
                                        )
                                        (   (setq base (Ripple:Str2Num buf))
                                            (setq made (Ripple:Clean made))
                                            (setq *Ripple:Dist* base
                                                  made (Ripple:Build base)
                                            )
                                            nil
                                        )
                                        (   t
                                            (princ "\nInvalid offset entered.")
                                            (princ (eval msg))
                                            (setq buf "")
                                            t
                                        )
                                    )
                                )

                                (   t t)
                            )
                        )

                        (   t t)
                    )
                )
            )

            (if quit
                (princ "\nCancelled.")
                (progn
                    (if *Ripple:Del*
                        (foreach obj objs
                            (vl-catch-all-apply 'vla-delete (list obj))
                        )
                    )
                    (princ (strcat "\n" (itoa (length made)) " offset"
                                   (if (= 1 (length made)) "" "s") " created."))
                )
            )

            (vla-endundomark (Ripple:Doc))
        )
    )

    (Ripple:Restore)
    (princ)
)

;;; ---------------------------------------------------------------------------
;;; Ripple:ApplyProps
;;;
;;; Applies one side's configured properties to a newly created offset.
;;;
;;; Every property has a "take it from the source object" setting, which is
;;; what makes the defaults sensible: with everything set to source, Ripple
;;; behaves exactly like OFFSET, and each property can then be overridden
;;; individually.
;;;
;;;   src    - the source object
;;;   obj    - the new offset object
;;;   srccol - "1" if the colour should come from the source regardless
;;;   col    - colour setting; 256 also means "from source"
;;;   lay    - layer name, or "*Source*"
;;;   lin    - linetype name, or "*Source*"
;;;   wgt    - lineweight suffix, or "*Source*"
;;;
;;; Each assignment is guarded: a layer or linetype can be deleted between
;;; the settings being saved and the offset being made, and one bad property
;;; must not abort the whole drag.
;;; ---------------------------------------------------------------------------

(defun Ripple:ApplyProps ( src obj srccol col lay lin wgt )

    (vl-catch-all-apply 'vla-put-color
        (list obj
            (if (or (= "1" srccol) (= 256 col))
                (vla-get-color src)
                col
            )
        )
    )

    (vl-catch-all-apply 'vla-put-layer
        (list obj (if (= "*Source*" lay) (vla-get-layer src) lay))
    )

    (vl-catch-all-apply 'vla-put-linetype
        (list obj (if (= "*Source*" lin) (vla-get-linetype src) lin))
    )

    ;; Lineweights are stored as VLA constants named acLnWt followed by the
    ;; value in hundredths of a millimetre -- acLnWt050 is 0.5mm. The setting
    ;; holds just the suffix, so the constant is assembled and evaluated.
    (vl-catch-all-apply 'vla-put-lineweight
        (list obj
            (if (= "*Source*" wgt)
                (vla-get-lineweight src)
                (eval (read (strcat "acLnWt" wgt)))
            )
        )
    )
    (princ)
)

;;; ===========================================================================
;;;                  O B J E C T   S N A P   M A R K E R S
;;; ===========================================================================

;;; ---------------------------------------------------------------------------
;;; Ripple:ActiveSnaps
;;;
;;; Returns the snap mode keywords currently enabled in OSMODE, as the
;;; strings the osnap function expects.
;;;
;;; OSMODE is a bit field; each mode has its own bit, and the underscore
;;; prefix makes the keywords language-independent so the routine works in a
;;; localised AutoCAD.
;;; ---------------------------------------------------------------------------

(defun Ripple:ActiveSnaps ( )
    (mapcar 'cdr
        (vl-remove-if
           '(lambda ( x ) (zerop (logand (getvar 'osmode) (car x))))
           '(
                (1    . "_end")     (2    . "_mid")     (4    . "_cen")
                (8    . "_nod")     (16   . "_qua")     (32   . "_int")
                (64   . "_ins")     (128  . "_per")     (256  . "_tan")
                (512  . "_nea")     (2048 . "_app")
            )
        )
    )
)

;;; ---------------------------------------------------------------------------
;;; Ripple:DrawMarker
;;;
;;; Draws the object snap marker glyph at a snapped point.
;;;
;;; The glyph vectors are defined in screen units, so they are scaled by the
;;; ratio of view height to screen height -- which keeps the marker a
;;; constant size on screen however far the user has zoomed. The 4x4 matrix
;;; passed to grvecs applies that scale and moves the glyph to the point.
;;;
;;; The point is transformed from the current UCS to the display coordinate
;;; system, because grvecs works in display coordinates.
;;;
;;;   snap - (point mode-string) from Ripple:SnapPoint
;;; ---------------------------------------------------------------------------

(defun Ripple:DrawMarker ( snap / pnt scale )
    (setq scale (/ (getvar 'viewsize) (cadr (getvar 'screensize)))
          pnt   (trans (car snap) 1 3)
    )
    (grvecs (cdr (assoc (cadr snap) *Ripple:Marker*))
        (list (list scale 0.0   0.0   (car   pnt))
              (list 0.0   scale 0.0   (cadr  pnt))
              (list 0.0   0.0   scale 0.0)
              (list 0.0   0.0   0.0   1.0)
        )
    )
)

;;; ---------------------------------------------------------------------------
;;; Ripple:MarkerVectors
;;;
;;; Builds the marker glyph for every snap mode, as grvecs vector lists.
;;;
;;; Each entry is a mode keyword followed by alternating colour and
;;; point-pair values -- the format grvecs expects. Every glyph is drawn
;;; twice, once at the nominal size and once one unit larger, which is what
;;; gives the markers their characteristic heavy outline.
;;;
;;; The shapes reproduce AutoCAD's own markers: a square for endpoint, a
;;; triangle for midpoint, a circle for centre, a diamond for quadrant, a
;;; cross for intersection, and so on. Centre and node have a small cross at
;;; the middle, drawn in colour 7 so it stays visible against the ring.
;;;
;;;   col - marker colour from the drafting settings
;;;   siz - marker size from the drafting settings
;;; ---------------------------------------------------------------------------

(defun Ripple:MarkerVectors ( col siz / neg )
    (setq neg (- siz))
    (list
        (list "_end"
              col (list neg neg) (list neg siz)
              col (list (1- neg) (1- neg)) (list (1- neg) (1+ siz))
              col (list neg siz) (list siz siz)
              col (list (1- neg) (1+ siz)) (list (1+ siz) (1+ siz))
              col (list siz siz) (list siz neg)
              col (list (1+ siz) (1+ siz)) (list (1+ siz) (1- neg))
              col (list siz neg) (list neg neg)
              col (list (1+ siz) (1- neg)) (list (1- neg) (1- neg))
        )
        (list "_mid"
              col (list neg neg) (list 0. siz)
              col (list (1- neg) (1- neg)) (list 0. (1+ siz))
              col (list 0. siz) (list siz neg)
              col (list 0. (1+ siz)) (list (1+ siz) (1- neg))
              col (list siz neg) (list neg neg)
              col (list (1+ siz) (1- neg)) (list (1- neg) (1- neg))
        )
        (list "_cen"
              7   (list (* neg 0.2) 0.) (list (* siz 0.2) 0.)
              7   (list 0. (* neg 0.2)) (list 0. (* siz 0.2))
              col (list neg 0.) (list (* neg 0.86) (* siz 0.5))
              col (list (* neg 0.86) (* siz 0.5)) (list (* neg 0.5) (* siz 0.86))
              col (list (* neg 0.5) (* siz 0.86)) (list 0. siz)
              col (list 0. siz) (list (* siz 0.5) (* siz 0.86))
              col (list (* siz 0.5) (* siz 0.86)) (list (* siz 0.86) (* siz 0.5))
              col (list (* siz 0.86) (* siz 0.5)) (list siz 0.)
              col (list siz 0.) (list (* siz 0.86) (* neg 0.5))
              col (list (* siz 0.86) (* neg 0.5)) (list (* siz 0.5) (* neg 0.86))
              col (list (* siz 0.5) (* neg 0.86)) (list 0. neg)
              col (list 0. neg) (list (* neg 0.5) (* neg 0.86))
              col (list (* neg 0.5) (* neg 0.86)) (list (* neg 0.86) (* neg 0.5))
              col (list (* neg 0.86) (* neg 0.5)) (list neg 0.)
        )
        (list "_nod"
              col (list neg neg) (list siz siz)
              col (list neg siz) (list siz neg)
              col (list neg 0.) (list (* neg 0.86) (* siz 0.5))
              col (list (* neg 0.86) (* siz 0.5)) (list (* neg 0.5) (* siz 0.86))
              col (list (* neg 0.5) (* siz 0.86)) (list 0. siz)
              col (list 0. siz) (list (* siz 0.5) (* siz 0.86))
              col (list (* siz 0.5) (* siz 0.86)) (list (* siz 0.86) (* siz 0.5))
              col (list (* siz 0.86) (* siz 0.5)) (list siz 0.)
              col (list siz 0.) (list (* siz 0.86) (* neg 0.5))
              col (list (* siz 0.86) (* neg 0.5)) (list (* siz 0.5) (* neg 0.86))
              col (list (* siz 0.5) (* neg 0.86)) (list 0. neg)
              col (list 0. neg) (list (* neg 0.5) (* neg 0.86))
              col (list (* neg 0.5) (* neg 0.86)) (list (* neg 0.86) (* neg 0.5))
              col (list (* neg 0.86) (* neg 0.5)) (list neg 0.)
        )
        (list "_qua"
              col (list 0. neg) (list neg 0.)
              col (list 0. (1- neg)) (list (1- neg) 0.)
              col (list neg 0.) (list 0. siz)
              col (list (1- neg) 0.) (list 0. (1+ siz))
              col (list 0. siz) (list siz 0.)
              col (list 0. (1+ siz)) (list (1+ siz) 0.)
              col (list siz 0.) (list 0. neg)
              col (list (1+ siz) 0.) (list 0. (1- neg))
        )
        (list "_int"
              col (list neg neg) (list siz siz)
              col (list neg (1+ neg)) (list siz (1+ siz))
              col (list (1+ neg) neg) (list (1+ siz) siz)
              col (list neg siz) (list siz neg)
              col (list neg (1+ siz)) (list siz (1+ neg))
              col (list (1+ neg) siz) (list (1+ siz) neg)
        )
        (list "_ins"
              col (list (* neg 0.1) (* neg 0.1)) (list neg (* neg 0.1))
              col (list neg (* neg 0.1)) (list neg siz)
              col (list neg siz) (list (* siz 0.1) siz)
              col (list (* siz 0.1) siz) (list (* siz 0.1) (* siz 0.1))
              col (list (* siz 0.1) (* siz 0.1)) (list siz (* siz 0.1))
              col (list siz (* siz 0.1)) (list siz neg)
              col (list siz neg) (list (* neg 0.1) neg)
              col (list (* neg 0.1) neg) (list (* neg 0.1) (* neg 0.1))
              col (list (1- (* neg 0.1)) (1- (* neg 0.1))) (list (1- neg) (1- (* neg 0.1)))
              col (list (1- neg) (1- (* neg 0.1))) (list (1- neg) (1+ siz))
              col (list (1- neg) (1+ siz)) (list (1+ (* siz 0.1)) (1+ siz))
              col (list (1+ (* siz 0.1)) (1+ siz)) (list (1+ (* siz 0.1)) (1+ (* siz 0.1)))
              col (list (1+ (* siz 0.1)) (1+ (* siz 0.1))) (list (1+ siz) (1+ (* siz 0.1)))
              col (list (1+ siz) (1+ (* siz 0.1))) (list (1+ siz) (1- neg))
              col (list (1+ siz) (1- neg)) (list (1- (* neg 0.1)) (1- neg))
              col (list (1- (* neg 0.1)) (1- neg)) (list (1- (* neg 0.1)) (1- (* neg 0.1)))
        )
        (list "_tan"
              col (list neg siz) (list siz siz)
              col (list (1- neg) (1+ siz)) (list (1+ siz) (1+ siz))
              col (list neg 0.) (list (* neg 0.86) (* siz 0.5))
              col (list (* neg 0.86) (* siz 0.5)) (list (* neg 0.5) (* siz 0.86))
              col (list (* neg 0.5) (* siz 0.86)) (list 0. siz)
              col (list 0. siz) (list (* siz 0.5) (* siz 0.86))
              col (list (* siz 0.5) (* siz 0.86)) (list (* siz 0.86) (* siz 0.5))
              col (list (* siz 0.86) (* siz 0.5)) (list siz 0.)
              col (list siz 0.) (list (* siz 0.86) (* neg 0.5))
              col (list (* siz 0.86) (* neg 0.5)) (list (* siz 0.5) (* neg 0.86))
              col (list (* siz 0.5) (* neg 0.86)) (list 0. neg)
              col (list 0. neg) (list (* neg 0.5) (* neg 0.86))
              col (list (* neg 0.5) (* neg 0.86)) (list (* neg 0.86) (* neg 0.5))
              col (list (* neg 0.86) (* neg 0.5)) (list neg 0.)
        )
        (list "_per"
              col (list neg neg) (list neg siz)
              col (list (1- neg) (1- neg)) (list (1- neg) (1+ siz))
              col (list siz neg) (list neg neg)
              col (list (1+ siz) (1- neg)) (list (1- neg) (1- neg))
              col (list neg 0.) (list 0. 0.)
              col (list neg -1.) (list 0. -1.)
              col (list 0. 0.) (list 0. neg)
              col (list -1. 0.) (list -1. neg)
        )
        (list "_nea"
              col (list neg neg) (list siz siz)
              col (list neg siz) (list siz siz)
              col (list (1- neg) (1+ siz)) (list (1+ siz) (1+ siz))
              col (list neg siz) (list siz neg)
              col (list siz neg) (list neg neg)
              col (list (1+ siz) (1- neg)) (list (1- neg) (1- neg))
        )
        (list "_app"
              col (list neg neg) (list siz siz)
              col (list siz neg) (list neg siz)
              col (list neg neg) (list neg siz)
              col (list (1- neg) (1- neg)) (list (1- neg) (1+ siz))
              col (list neg siz) (list siz siz)
              col (list (1- neg) (1+ siz)) (list (1+ siz) (1+ siz))
              col (list siz siz) (list siz neg)
              col (list (1+ siz) (1+ siz)) (list (1+ siz) (1- neg))
              col (list siz neg) (list neg neg)
              col (list (1+ siz) (1- neg)) (list (1- neg) (1- neg))
        )
    )
)

;;; ===========================================================================
;;;                    S E T T I N G S   D I A L O G
;;; ===========================================================================

;;; ---------------------------------------------------------------------------
;;; RIPPLESET / Ripple:Settings
;;;
;;; Sets the layer, colour, linetype and lineweight for the inner and outer
;;; offsets, with a live preview showing how the result will look against the
;;; source object.
;;;
;;; The preview is a small vector drawing of a curve with an offset either
;;; side, redrawn every time a setting changes. Working out what colour to
;;; show is the fiddly part: a setting of "from source" or of ByLayer means
;;; the actual colour has to be traced through to whichever layer will end up
;;; being used.
;;;
;;;   src - the source object to preview against; nil to prompt for one
;;; ---------------------------------------------------------------------------

(defun c:RippleSet ( / ent )
    (setq ent (car (entsel "\nSelect an object to preview against: ")))
    (if (and ent (wcmatch (cdr (assoc 0 (entget ent))) "ARC,CIRCLE,ELLIPSE,*LINE"))
        (Ripple:Settings (vlax-ename->vla-object ent))
        (princ "\nSelect a line, arc, circle, ellipse or polyline.")
    )
    (princ)
)

(defun Ripple:Settings

    ( src /
        *error* Ripple:Swatch Ripple:Fill Ripple:LayerColour Ripple:Preview
        basecol bylayer dch dcl des layers lays lins result wgts
        inCols outCols inCol outCol inLay outLay inLin outLin inWgt outWgt
    )

    (defun *error* ( msg )
        (if (= 'file (type des)) (close des))
        (if (and (= 'int (type dch)) (< 0 dch)) (unload_dialog dch))
        (if (and (= 'str (type dcl)) (findfile dcl)) (vl-file-delete dcl))
        (if (and msg (not (wcmatch (strcase msg t) "*break*,*cancel*,*exit*")))
            (princ (strcat "\n** RIPPLESET error: " msg " **"))
        )
        (princ)
    )

    (Ripple:Validate)

    ;; Unpack the stored settings into working variables. They are locals, so
    ;; cancelling simply discards them.
    (mapcar 'set
       '(inCols outCols inCol outCol inLay outLay inLin outLin inWgt outWgt)
        *Ripple:Props*
    )

    (setq layers (vla-get-layers (Ripple:Doc)))

    ;;; -----------------------------------------------------------------------
    ;;; Ripple:LayerColour
    ;;;
    ;;; Returns the colour of a named layer, which is what an object set to
    ;;; ByLayer will actually appear as.
    ;;; -----------------------------------------------------------------------

    (defun Ripple:LayerColour ( lay / r )
        (setq r (vl-catch-all-apply 'vla-get-color (list (vla-item layers lay))))
        (if (vl-catch-all-error-p r) 7 r)
    )

    ;;; -----------------------------------------------------------------------
    ;;; Ripple:Fill / Ripple:Swatch
    ;;;
    ;;; Load a popup list, and fill a colour swatch button.
    ;;; -----------------------------------------------------------------------

    (defun Ripple:Fill ( key lst )
        (start_list key)
        (foreach x lst (add_list x))
        (end_list)
        (princ)
    )

    (defun Ripple:Swatch ( key col )
        (start_image key)
        (fill_image 0 0 (dimx_tile key) (dimy_tile key) col)
        (end_image)
        (princ)
    )

    ;; The source object's own display colour. If it is set to ByLayer (256)
    ;; or ByBlock (0), the real colour comes from its layer, and that fact is
    ;; remembered so the preview can follow the layer as it is changed.
    (setq basecol
        (cond
            (   (vl-position (setq basecol (vla-get-color src)) '(256 0))
                (setq bylayer t)
                (Ripple:LayerColour (vla-get-layer src))
            )
            (   basecol)
        )
    )

    ;;; -----------------------------------------------------------------------
    ;;; Ripple:Preview
    ;;;
    ;;; Redraws the preview image, resolving each side's colour setting to the
    ;;; colour it will actually appear as.
    ;;;
    ;;; The resolution goes: if the "use source colour" toggle is on, follow
    ;;; the source (through its layer if the source is ByLayer); otherwise if
    ;;; the colour is 256 the offset will be ByLayer, so follow whichever
    ;;; layer that side is set to; otherwise use the explicit colour.
    ;;; -----------------------------------------------------------------------

    (defun Ripple:Preview ( )
        (Ripple:DrawPreview
            ;; inner
            (if (= "1" inCols)
                (if bylayer
                    (Ripple:LayerColour
                        (if (= "*Source*" inLay) (vla-get-layer src) inLay))
                    basecol
                )
                (if (= 256 inCol)
                    (if (= "*Source*" inLay) basecol (Ripple:LayerColour inLay))
                    inCol
                )
            )
            ;; source
            basecol
            ;; outer
            (if (= "1" outCols)
                (if bylayer
                    (Ripple:LayerColour
                        (if (= "*Source*" outLay) (vla-get-layer src) outLay))
                    basecol
                )
                (if (= 256 outCol)
                    (if (= "*Source*" outLay) basecol (Ripple:LayerColour outLay))
                    outCol
                )
            )
        )
    )

    ;; ---- build the dialog ---------------------------------------------------

    (cond
        (   (not
                (and
                    (setq dcl (vl-filename-mktemp nil nil ".dcl"))
                    (setq des (open dcl "w"))
                    (progn
                        (foreach line
                           '(
                                "pop : popup_list   { fixed_width = false; alignment = centered; }"
                                "col : image_button { alignment = centered; height = 1.5; width = 4.0;"
                                "                     fixed_width = true; fixed_height = true; color = 2; }"
                                ""
                                "dsett : dialog { label = \"Ripple Offset Settings\";"
                                "  spacer;"
                                "  : row {"
                                "    : boxed_column { label = \"Offset Preview\"; fixed_width = false;"
                                "      : boxed_row { label = \"Outer Colour\"; fixed_width = true;"
                                "                    alignment = centered;"
                                "        spacer;"
                                "        : col  { key = \"ocol\"; }"
                                "        spacer;"
                                "        : toggle { key = \"ocols\"; label = \"Source\"; }"
                                "        spacer;"
                                "      }"
                                "      : image { key = \"dimage\"; alignment = centered;"
                                "                width = 24.64 ; fixed_width  = true;"
                                "                height = 11.39; fixed_height = true; color = -2; }"
                                "      : boxed_row { label = \"Inner Colour\"; fixed_width = true;"
                                "                    alignment = centered;"
                                "        spacer;"
                                "        : col  { key = \"icol\"; }"
                                "        spacer;"
                                "        : toggle { key = \"icols\"; label = \"Source\"; }"
                                "        spacer;"
                                "      }"
                                "    }"
                                "    : column {"
                                "      : boxed_column { label = \"Outer Offset\";"
                                "        : pop { label = \"Layer:\";      key = \"olay\"; }"
                                "        : pop { label = \"Linetype:\";   key = \"olin\"; }"
                                "        : pop { label = \"Lineweight:\"; key = \"olw\" ; }"
                                "        spacer;"
                                "      }"
                                "      spacer;"
                                "      : boxed_column { label = \"Inner Offset\";"
                                "        : pop { label = \"Layer:\";      key = \"ilay\"; }"
                                "        : pop { label = \"Linetype:\";   key = \"ilin\"; }"
                                "        : pop { label = \"Lineweight:\"; key = \"ilw\" ; }"
                                "        spacer;"
                                "      }"
                                "    }"
                                "  }"
                                "  spacer;"
                                "  ok_cancel;"
                                "}"
                            )
                            (write-line line des)
                        )
                        (setq des (close des))
                        (< 0 (setq dch (load_dialog dcl)))
                    )
                    (new_dialog "dsett" dch)
                )
            )
            (princ "\nUnable to create the settings dialog.")
        )

        (   t
            ;; ---- populate the lists ----------------------------------------
            (vlax-for lay layers (setq lays (cons (vla-get-name lay) lays)))
            (setq lays (cons "*Source*" (acad_strlsort lays)))

            (vlax-for lin (vla-get-linetypes (Ripple:Doc))
                (setq lins (cons (vla-get-name lin) lins))
            )
            ;; ByLayer and ByBlock are always the first two entries of the
            ;; linetype table; they are dropped from the sorted list and put
            ;; back at the top, where users expect them.
            (setq lins (append '("*Source*" "ByLayer")
                               (acad_strlsort (cddr (reverse lins)))))

            ;; The standard lineweight values, as the suffixes of the VLA
            ;; constants they map to.
            (setq wgts
               '("*Source*" "ByLayer"
                 "000" "005" "009" "013" "015" "018" "020" "025" "030"
                 "035" "040" "050" "053" "060" "070" "080" "090" "100"
                 "106" "120" "140" "158" "200" "211")
            )

            (mapcar 'Ripple:Fill
                   '("ilay" "olay" "ilin" "olin" "ilw" "olw")
                    (list lays lays lins lins wgts wgts)
            )

            ;; Popup lists take an index, so each stored name is converted to
            ;; its position in the list just loaded. Anything not found falls
            ;; back to the first entry.
            (mapcar 'set_tile
                   '("ilay" "olay" "ilin" "olin" "ilw" "olw")
                    (mapcar
                       '(lambda ( val lst ) (itoa (cond ((vl-position val lst)) (0))))
                        (list inLay outLay inLin outLin inWgt outWgt)
                        (list lays  lays   lins  lins   wgts   wgts)
                    )
            )

            (set_tile "icols" inCols)
            (set_tile "ocols" outCols)
            ;; The explicit colour buttons are greyed out while the matching
            ;; "Source" toggle is on, because they would have no effect.
            (mode_tile "icol" (atoi inCols))
            (mode_tile "ocol" (atoi outCols))

            (Ripple:Preview)
            (Ripple:Swatch "icol" inCol)
            (Ripple:Swatch "ocol" outCol)

            ;; ---- callbacks --------------------------------------------------
            ;; Written as quoted lists and converted with vl-prin1-to-string,
            ;; which produces correct quoting every time where hand-escaped
            ;; strings do not.

            (action_tile "ilay"
                (vl-prin1-to-string
                   '(progn (setq inLay (nth (atoi $value) lays)) (Ripple:Preview))))
            (action_tile "olay"
                (vl-prin1-to-string
                   '(progn (setq outLay (nth (atoi $value) lays)) (Ripple:Preview))))
            (action_tile "ilin"
                (vl-prin1-to-string '(setq inLin  (nth (atoi $value) lins))))
            (action_tile "olin"
                (vl-prin1-to-string '(setq outLin (nth (atoi $value) lins))))
            (action_tile "ilw"
                (vl-prin1-to-string '(setq inWgt  (nth (atoi $value) wgts))))
            (action_tile "olw"
                (vl-prin1-to-string '(setq outWgt (nth (atoi $value) wgts))))

            (action_tile "icol"
                (vl-prin1-to-string
                   '(progn
                        (setq inCol (cond ((acad_colordlg inCol)) (inCol)))
                        (Ripple:Swatch "icol" inCol)
                        (Ripple:Preview)
                    )
                )
            )
            (action_tile "ocol"
                (vl-prin1-to-string
                   '(progn
                        (setq outCol (cond ((acad_colordlg outCol)) (outCol)))
                        (Ripple:Swatch "ocol" outCol)
                        (Ripple:Preview)
                    )
                )
            )

            (action_tile "icols"
                (vl-prin1-to-string
                   '(progn
                        (mode_tile "icol" (atoi (setq inCols $value)))
                        (Ripple:Preview)
                    )
                )
            )
            (action_tile "ocols"
                (vl-prin1-to-string
                   '(progn
                        (mode_tile "ocol" (atoi (setq outCols $value)))
                        (Ripple:Preview)
                    )
                )
            )

            (action_tile "accept" "(done_dialog 1)")
            (action_tile "cancel" "(done_dialog 0)")

            (setq result (start_dialog))
            (if (= 1 result)
                (progn
                    (setq *Ripple:Props*
                        (list inCols outCols inCol outCol inLay outLay
                              inLin outLin inWgt outWgt)
                    )
                    (princ "\nRipple settings saved.")
                )
            )
        )
    )

    (if (and (= 'int (type dch)) (< 0 dch)) (unload_dialog dch))
    (if (and (= 'str (type dcl)) (findfile dcl)) (vl-file-delete dcl))
    (princ)
)

;;; ---------------------------------------------------------------------------
;;; Ripple:DrawPreview
;;;
;;; Draws the settings dialog preview: a curved source line with one offset
;;; inside it and one outside, each in its resolved colour.
;;;
;;; The coordinates are a fixed hand-plotted path in the dialog image tile's
;;; own pixel space. vector_image takes four parallel lists -- start X, start
;;; Y, end X, end Y -- plus a colour per segment, which is why each curve is
;;; drawn as one long run of short straight segments.
;;;
;;;   incol  - resolved colour of the inner offset
;;;   srccol - resolved colour of the source curve
;;;   outcol - resolved colour of the outer offset
;;; ---------------------------------------------------------------------------

(defun Ripple:DrawPreview ( incol srccol outcol )

    (start_image "dimage")

    ;; ---- inner offset ----
    (mapcar 'vector_image
       '(0 48 48 48 48 47 46 45 44 43 42 40 39 37 35 33 31 29 26 24 21 19 16 14 11 8 5 2)
       '(0 146 143 141 138 135 132 130 127 124 122 119 117 115 113 111 109 107 105 104 103 101 100 99 99 98 98 97)
       '(0 48 48 48 47 46 45 44 43 42 40 39 37 35 33 31 29 26 24 21 19 16 14 11 8 5 2 0)
       '(0 143 141 138 135 132 130 127 124 122 119 117 115 113 111 109 107 105 104 103 101 100 99 99 98 98 97 97)
        (mapcar '(lambda ( x ) incol)
               '(0 48 48 48 48 47 46 45 44 43 42 40 39 37 35 33 31 29 26 24 21 19 16 14 11 8 5 2))
    )

    ;; ---- source curve ----
    (mapcar 'vector_image
       '(0 42 39 35 32 28 25 21 18 14 10 7 3 42 39 35 32 28 25 21 18 14 10 7 3 71 69 66 63
         60 58 55 52 48 45 71 69 66 63 60 58 55 52 48 45 93 92 90 89 88 86 84 82 80 78 76
         74 93 92 90 89 88 86 84 82 80 78 76 74 97 97 97 97 96 96 95 94 97 97 97 97 96 96 95 94)
       '(0 58 57 55 54 53 52 51 50 50 49 49 49 58 57 55 54 53 52 51 50 50 49 49 49 80 77 75
         72 70 68 65 63 62 60 80 77 75 72 70 68 65 63 62 60 117 114 111 107 104 101 97 94 91
         88 85 82 117 114 111 107 104 101 97 94 91 88 85 82 146 143 139 135 132 128 125 121
         146 143 139 135 132 128 125 121)
       '(0 39 35 32 28 25 21 18 14 10 7 3 0 39 35 32 28 25 21 18 14 10 7 3 0 69 66 63 60 58
         55 52 48 45 42 69 66 63 60 58 55 52 48 45 42 92 90 89 88 86 84 82 80 78 76 74 71 92
         90 89 88 86 84 82 80 78 76 74 71 97 97 97 96 96 95 94 93 97 97 97 96 96 95 94 93)
       '(0 57 55 54 53 52 51 50 50 49 49 49 48 57 55 54 53 52 51 50 50 49 49 49 48 77 75 72
         70 68 65 63 62 60 58 77 75 72 70 68 65 63 62 60 58 114 111 107 104 101 97 94 91 88
         85 82 80 114 111 107 104 101 97 94 91 88 85 82 80 143 139 135 132 128 125 121 117 143
         139 135 132 128 125 121 117)
        (mapcar '(lambda ( x ) srccol)
           '(0 42 39 35 32 28 25 21 18 14 10 7 3 42 39 35 32 28 25 21 18 14 10 7 3 71 69 66 63
             60 58 55 52 48 45 71 69 66 63 60 58 55 52 48 45 93 92 90 89 88 86 84 82 80 78 76
             74 93 92 90 89 88 86 84 82 80 78 76 74 97 97 97 97 96 96 95 94 97 97 97 97 96 96 95 94))
    )

    ;; ---- outer offset ----
    (mapcar 'vector_image
       '(56 51 47 43 39 35 30 26 22 17 13 8 4 0 106 103 100 97 93 90 86 83 79 75 72 68 64 60
         146 146 146 146 145 144 144 143 142 141 139 138 137 135 133 131 129 127 125 123 120
         118 115 112 109)
       '(11 9 8 6 5 4 3 2 1 1 0 0 0 0 46 42 39 36 34 31 28 25 23 21 18 16 14 12 146 142 137 133
         129 124 120 115 111 107 103 98 94 90 86 82 78 74 70 67 63 59 56 52 49)
       '(51 47 43 39 35 30 26 22 17 13 8 4 0 0 103 100 97 93 90 86 83 79 75 72 68 64 60 56 146
         146 146 145 144 144 143 142 141 139 138 137 135 133 131 129 127 125 123 120 118 115 112 109 106)
       '(9 8 6 5 4 3 2 1 1 0 0 0 0 0 42 39 36 34 31 28 25 23 21 18 16 14 12 11 142 137 133 129
         124 120 115 111 107 103 98 94 90 86 82 78 74 70 67 63 59 56 52 49 46)
        (mapcar '(lambda ( x ) outcol)
           '(56 51 47 43 39 35 30 26 22 17 13 8 4 0 106 103 100 97 93 90 86 83 79 75 72 68 64 60
             146 146 146 146 145 144 144 143 142 141 139 138 137 135 133 131 129 127 125 123 120
             118 115 112 109))
    )

    (end_image)
    (princ)
)

(princ "\nRipple loaded. RIPPLE for dynamic multiple offset, RIPPLESET for offset properties.")
(princ)

;;; ---------------------------------------------------------------------------
;;; End of file
;;; ---------------------------------------------------------------------------