;;; ---------------------------------------------------------------------------
;;; StairPan.lsp
;;; code compiled by YZ August 2026
;;; ---------------------------------------------------------------------------
;;; FORMED STEEL STAIR PANS IN SECTION
;;;
;;; PURPOSE
;;;   Draws the folded sheet-metal pans that make up a steel stair, in section,
;;;   to the exact fold geometry of a fabricator's standard details - then works
;;;   out the flat blank length needed to press each one.
;;;
;;;   Twelve profiles are held here: three nosing treatments crossed with four
;;;   positions in the stair.
;;;
;;;     NOSING TREATMENT            POSITION IN THE STAIR
;;;       Square nosing               Riser pan   - the vertical face
;;;       Sloped nosing               Stair pan   - the tread
;;;       Sloped riser                Closing pan - closes off at the top
;;;                                   Landing pan - runs out onto the landing
;;;
;;;   These are CUSTOM profiles. They are not derived from a standard the way a
;;;   rolled steel section is - every fold, return and hem is somebody's shop
;;;   practice. The geometry has therefore been carried across exactly as it was,
;;;   fold for fold. Nothing has been "improved", because a changed fold is a pan
;;;   that will not fit the stair it was detailed for.
;;;
;;; HOW IT WORKS
;;;   1. Set the stair up once: tread width, riser height, pan fill depth,
;;;      landing fill depth, and the sheet gage. Nose-to-nose distance can be
;;;      picked off the drawing instead, and the tread and riser are then derived
;;;      from it.
;;;
;;;   2. Pick the nosing point - the front top corner of the tread, which is the
;;;      point every profile is measured from.
;;;
;;;   3. EVERY PAN IS DRAWN BOTH WAYS AND YOU DRAG TO CHOOSE. A stair pan runs
;;;      left-to-right or right-to-left depending which side of the stair you are
;;;      detailing, so both mirror images are generated and shown live as you
;;;      move the cursor. Move to one side and that version highlights; click to
;;;      take it. There is no separate "left hand / right hand" prompt to get
;;;      wrong.
;;;
;;;   4. The chosen profile is drawn as one closed polyline.
;;;
;;; THE STRETCH-OUT
;;;   After drawing, the routine reports the TOTAL STRETCH-OUT - the length of
;;;   flat sheet the pan is pressed from. That is the number the shop orders and
;;;   cuts to, and getting it from the drawing rather than by hand is most of the
;;;   value of a tool like this.
;;;
;;;   It is computed from the finished profile rather than by adding up folds:
;;;   the outline of a constant-thickness folded strip traces out along one face
;;;   and back along the other, so its perimeter is twice the mid-thickness
;;;   length plus the two square ends. Rearranged:
;;;
;;;       stretch-out  =  (perimeter - 2 x thickness) / 2
;;;
;;;   That is the neutral-axis length at mid-thickness - the standard developed
;;;   length at a K-factor of 0.5 - and it holds for every one of the twelve
;;;   profiles without needing a separate formula for each.
;;;
;;; SHEET GAGE
;;;   Thickness comes from a US sheet steel gage table, 16 gage down to 8 gage.
;;;   Every fold in every profile is offset by that thickness, so changing gage
;;;   changes the whole section correctly rather than just the line weight.
;;;
;;;   STAIRPAN  - draw a formed steel stair pan in section
;;; ---------------------------------------------------------------------------

;;; ---------------------------------------------------------------------------
;;; SHEET GAGE
;;;
;;; US standard gage for sheet steel, in inches. Lower gage number, thicker sheet.
;;; ---------------------------------------------------------------------------

(setq StairPan:Gages
    '(("16 gage" . 0.0598)
      ("15 gage" . 0.0673)
      ("14 gage" . 0.0747)
      ("13 gage" . 0.0897)
      ("12 gage" . 0.1046)
      ("11 gage" . 0.1233)
      ("10 gage" . 0.1345)
      ("9 gage"  . 0.1495)
      ("8 gage"  . 0.1644)))

;;; ---------------------------------------------------------------------------
;;; SESSION MEMORY
;;; ---------------------------------------------------------------------------

(if (null *StairPan:Prefs*)
    (setq *StairPan:Prefs*
        (list (cons "NOSING"  "Square")   ; Square | SlopedNosing | SlopedRiser
              (cons "PAN"     "Riser")    ; Riser | Stair | Closing | Landing
              (cons "TREAD"   11.0)
              (cons "RISER"    7.0)
              (cons "FILL"     1.5)       ; pan fill depth
              (cons "LFILL"    1.5)       ; landing fill depth
              (cons "GAGE"    "12 gage")
              (cons "DIMS"    "No")       ; auto-dimension
              (cons "CFILL"   "No")       ; draw concrete fill
        )
    )
)

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

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

(defun StairPan:Thickness ( / hit )
    (if (setq hit (assoc (StairPan:Get "GAGE") StairPan:Gages)) (cdr hit) 0.1046))

;;; ---------------------------------------------------------------------------
;;; THE TWELVE PROFILES
;;;
;;; Each returns the closed outline as an ordered list of points, ready to be
;;; drawn as one polyline. Arguments are always the same:
;;;
;;;   a    the nosing point
;;;   v    the variant list, which carries the handful of angles that flip the
;;;        profile between its left-hand and right-hand forms
;;;   b c d e f   the stair dimensions, named as in the original so the fold
;;;               geometry below can be checked line for line against it
;;;
;;; The variant list is what makes one function draw both hands. Its first entry
;;; is the direction the pan runs; the rest are quarter-turn multipliers that
;;; flip which way each return and hem folds. Feeding the two variants through
;;; the same expressions is what guarantees the two hands are true mirrors.
;;; ---------------------------------------------------------------------------

;;; --- SQUARE NOSING ---------------------------------------------------------

;;; Square nosing, riser pan. b = riser height, c = pan fill, d = thickness.
(defun StairPan:SqRiser ( a v b c d / p1 p2 p3 p4 p5 p6 p7 p8 p9 p10 p11 p12 )
    (setq p1  (polar a (+ (car v) pi) (+ d 0.75))
          p2  a
          p3  (polar p2 (* pi 1.5) (+ c d))
          p4  (polar p3 (+ (car v) pi) (- 1.0 d))
          p5  (polar p4 (* pi 1.5) (- b (distance p2 p3)))
          p6  (polar p5 (+ (car v) pi) (+ 1.0 d))
          p7  (polar p6 (* pi 0.5) d)
          p8  (polar p5 (* pi (cadr v)) (* d (sqrt 2.0)))
          p9  (polar p4 (* pi (cadr v)) (* d (sqrt 2.0)))
          p10 (polar p3 (* pi (cadr v)) (* d (sqrt 2.0)))
          p11 (polar p2 (* pi (caddr v)) (* d (sqrt 2.0)))
          p12 (polar p1 (* pi 1.5) d))
    (list p1 p2 p3 p4 p5 p6 p7 p8 p9 p10 p11 p12)
)

;;; Square nosing, stair pan. b = tread, c = riser, d = pan fill, e = thickness.
(defun StairPan:SqStair ( a v b c d e / p1 p2 p3 p4 p5 p6 p7 p8 p9 p10 p11 p12 )
    (setq p1  (polar a (caddr v) (+ 0.75 e))
          p2  a
          p3  (polar p2 (* pi 1.5) (+ d e))
          p4  (polar p3 (caddr v) (- 1.0 e))
          p5  (polar p4 (* pi 1.5) (- (+ c d) (distance p2 p3) e))
          p6  (polar p5 (car v) (- (+ b (distance p3 p4)) 0.5))
          p7  (polar p6 (* pi 1.5) e)
          p8  (polar p5 (* pi (cadddr v)) (* e (sqrt 2.0)))
          p9  (polar p4 (* pi (cadr v)) (* e (sqrt 2.0)))
          p10 (polar p3 (* pi (cadr v)) (* e (sqrt 2.0)))
          p11 (polar p2 (* pi (cadddr v)) (* e (sqrt 2.0)))
          p12 (polar p1 (* pi 1.5) e))
    (list p1 p2 p3 p4 p5 p6 p7 p8 p9 p10 p11 p12)
)

;;; Square nosing, closing pan. b = tread, d = pan fill, e = thickness,
;;; f = landing fill.
(defun StairPan:SqClosing ( a v b d e f / p1 p2 p3 p4 p5 p6 )
    (setq p1 (polar a (* pi 1.5) (- d e))
          p1 (polar p1 (car v) 0.5)
          p2 (polar p1 (* pi 1.5) e)
          p3 (polar p2 (car v) (- b 0.5))
          p4 (polar p3 (* pi 1.5) (- f d))
          p5 (polar p4 (car v) e)
          p6 (polar p3 (* pi (cadr v)) (* e (sqrt 2.0))))
    (list p1 p2 p3 p4 p5 p6)
)

;;; Square nosing, landing pan. b = tread, c = riser, d = pan fill,
;;; e = thickness, f = landing fill.
(defun StairPan:SqLanding ( a v b c d e f
                            / p1 p2 p3 p4 p5 p6 p7 p8 p9 p10 p11 p12 p13 p14 )
    (setq p1  (polar a (caddr v) (+ 0.75 e))
          p2  a
          p3  (polar p2 (* pi 1.5) (+ d e))
          p4  (polar p3 (caddr v) (- 1.0 e))
          p5  (polar p4 (* pi 1.5) (- (+ c d) (distance p2 p3) e))
          p6  (polar p5 (car v) (+ (distance p4 p3) b e))
          p7  (polar p6 (* pi 1.5) (+ e (- f d)))
          p8  (polar p7 (caddr v) e)
          p9  (polar p6 (* pi (cadddr v)) (* e (sqrt 2.0)))
          p10 (polar p5 (* pi (cadddr v)) (* e (sqrt 2.0)))
          p11 (polar p4 (* pi (cadr v)) (* e (sqrt 2.0)))
          p12 (polar p3 (* pi (cadr v)) (* e (sqrt 2.0)))
          p13 (polar p2 (* pi (cadddr v)) (* e (sqrt 2.0)))
          p14 (polar p1 (* pi 1.5) e))
    (list p1 p2 p3 p4 p5 p6 p7 p8 p9 p10 p11 p12 p13 p14)
)

;;; --- SLOPED NOSING ---------------------------------------------------------

;;; Sloped nosing, riser pan. b = riser, c = pan fill, d = thickness.
;;; The sloped forms use INTERS to close the last two folds: the nosing runs at
;;; an angle, so the point where a return meets it has to be found by
;;; intersecting rather than by stepping a known distance.
(defun StairPan:SlRiser ( a v b c d / p1 p2 p3 p4 p5 p6 p7 p8 p9 p10 p11 p12 )
    (setq p1  (polar a (caddr v) (+ 0.75 d))
          p2  a
          p12 (polar p1 (* pi 1.5) d)
          p11 (polar p12 (car v) 0.75)
          p10 (polar p11 (* pi 1.5) 0.75)
          p9  (polar p2 (* pi 1.5) c)
          p9  (polar p9 (caddr v) 1.0)
          p8  (polar p9 (* pi 1.5) (- b c d))
          p7  (polar p8 (caddr v) 1.0)
          p6  (polar p7 (* pi 1.5) d)
          p5  (polar p6 (car v) (+ 1.0 d))
          p4  (polar p9 (+ (* pi (cadr v)) (angle p10 p9)) d)
          p3  (polar p10 (+ (* pi (cadr v)) (angle p10 p9)) d)
          p4  (inters p5 (polar p5 (* pi 0.5) 12) p4 p3 nil)
          p3  (inters p2 (polar p2 (* pi 1.5) 12) p4 p3 nil))
    (list p1 p2 p3 p4 p5 p6 p7 p8 p9 p10 p11 p12)
)

;;; Sloped nosing, stair pan. b = tread, c = riser, d = pan fill, e = thickness.
(defun StairPan:SlStair ( a v b c d e
                          / p1 p2 p3 p4 p5 p6 p7 p8 p9 p10 p11 p12 p13 p14 )
    (setq p1  (polar a (caddr v) (+ 0.75 e))
          p2  a
          p14 (polar p1 (* pi 1.5) e)
          p13 (polar p14 (car v) 0.75)
          p12 (polar p13 (* pi 1.5) 0.75)
          p11 (polar p2 (* pi 1.5) d)
          p11 (polar p11 (caddr v) 1.0)
          p10 (polar p11 (* pi 1.5) c)
          p9  (polar p10 (car v) b)
          p5  (polar p10 (angle p13 p2) (distance p13 p2))
          p4  (polar p11 (+ (* pi (cadr v)) (angle p12 p11)) e)
          p3  (polar p12 (+ (* pi (cadr v)) (angle p12 p11)) e)
          p4  (inters p5 (polar p5 (* pi 0.5) 12) p4 p3 nil)
          p3  (inters p2 (polar p2 (* pi 1.5) 12) p4 p3 nil)
          p6  (polar p9 (+ (angle p11 p12) (* pi (cadr v))) e)
          p7  (polar p6 (angle p11 p12) 0.75)
          p6  (inters p5 (polar p5 (car v) 12) p6 p7 nil)
          p7  (polar p6 (angle p11 p12) 0.75)
          p8  (polar p7 (+ (angle p12 p11) (* pi (cadr v))) e))
    (list p1 p2 p3 p4 p5 p6 p7 p8 p9 p10 p11 p12 p13 p14)
)

;;; Sloped nosing, closing pan. b = tread, c = riser, d = pan fill,
;;; e = thickness, f = landing fill. p9 is a construction point only.
(defun StairPan:SlClosing ( a v b c d e f / p1 p2 p3 p4 p5 p6 p7 p8 p9 )
    (setq p1 (polar a (car v) (+ b e))
          p1 (polar p1 (* pi 1.5) f)
          p2 (polar p1 (* pi 0.5) (- f (- d e)))
          p8 (polar p1 (caddr v) e)
          p7 (polar p8 (* pi 0.5) (- (distance p1 p2) e))
          p6 (polar a (* pi 1.5) d)
          p6 (polar p6 (car v) 1.0)
          p9 (polar a (car v) e)
          p9 (polar p9 (* pi 1.5) (+ e 0.75))
          p3 (polar p6 (+ (angle p9 p6) (* pi (cadr v))) e)
          p4 (polar p3 (angle p6 p9) 1.0)
          p3 (inters p2 (polar p2 (caddr v) 12) p3 p4 nil)
          p4 (polar p3 (angle p6 p9) 0.75)
          p5 (polar p4 (+ (angle p6 p9) (* pi (cadr v))) e))
    (list p1 p2 p3 p4 p5 p6 p7 p8)
)

;;; Sloped nosing, landing pan.
(defun StairPan:SlLanding ( a v b c d e f
                            / p1 p2 p3 p4 p5 p6 p7 p8 p9 p10 p11 p12 p13 p14 )
    (setq p1  (polar a (caddr v) (+ 0.75 e))
          p2  a
          p14 (polar p1 (* pi 1.5) e)
          p13 (polar p14 (car v) 0.75)
          p12 (polar p13 (* pi 1.5) 0.75)
          p11 (polar p2 (* pi 1.5) d)
          p11 (polar p11 (caddr v) 1.0)
          p10 (polar p11 (* pi 1.5) c)
          p9  (polar p10 (car v) (+ b 1.0))
          p5  (polar p10 (* pi (cadr v)) (* e (sqrt 2.0)))
          p6  (polar p9 (* pi (cadr v)) (* e (sqrt 2.0)))
          p8  (polar p9 (* pi 1.5) (- f d))
          p7  (polar p8 (car v) e)
          p3  (polar p12 (+ (angle p11 p12) (* pi (cadddr v))) e)
          p4  (polar p11 (+ (angle p11 p12) (* pi (cadddr v))) e)
          p3  (inters p2 (polar p2 (* pi 1.5) 12) p4 p3 nil)
          p4  (inters p5 (polar p5 (* pi 0.5) 12) p4 p3 nil))
    (list p1 p2 p3 p4 p5 p6 p7 p8 p9 p10 p11 p12 p13 p14)
)

;;; --- SLOPED RISER ----------------------------------------------------------

;;; Sloped riser, riser pan. b = riser, c = pan fill, d = thickness.
(defun StairPan:SrRiser ( a v b c d / p1 p2 p3 p4 p5 p6 p7 p8 )
    (setq p2 a
          p3 (polar p2 (* pi 1.5) b)
          p3 (polar p3 (car v) 1.0)
          p6 (polar p3 (+ (angle p3 p2) (* pi (caddr v))) d)
          p7 (polar p2 (+ (angle p3 p2) (* pi (caddr v))) d)
          p5 (polar p3 (* pi 0.5) d)
          p8 (polar p2 (* pi 1.5) d)
          p7 (inters p7 p6 p8 (polar p8 0 12) nil)
          p6 (inters p7 p6 p5 (polar p5 0 12) nil)
          p8 (polar p7 (car v) 0.75)
          p1 (polar p8 (* pi 0.5) d)
          p5 (polar p6 (car v) 1.0)
          p4 (polar p5 (* pi 1.5) d))
    (list p1 p2 p3 p4 p5 p6 p7 p8)
)

;;; Sloped riser, stair pan. b = tread, c = riser, d = pan fill, e = thickness.
;;; p13 is deliberately reused as a DISTANCE partway through - it is a
;;; construction value, not a vertex, and the profile only uses p1 to p12.
(defun StairPan:SrStair ( a v b c d e
                          / p1 p2 p3 p4 p5 p6 p7 p8 p9 p10 p11 p12 p13 p14 )
    (setq p2  a
          p3  (polar p2 (* pi 1.5) c)
          p3  (polar p3 (caddr v) 1.0)
          p4  (polar p3 (* pi 1.5) (- d e))
          p9  (polar p4 (* pi (cadddr v)) (* e (sqrt 2.0)))
          p11 (polar p2 (+ (angle p3 p2) (* pi (cadr v))) e)
          p10 (polar p3 (+ (angle p3 p2) (* pi (cadr v))) e)
          p12 (polar p2 (* pi 1.5) e)
          p11 (inters p10 p11 p12 (polar p12 (caddr v) 12) nil)
          p12 (polar p11 (caddr v) 0.75)
          p1  (polar p12 (* pi 0.5) e)
          p10 (inters p10 p11 p9 (polar p9 (* pi (cadr v)) 12) nil)
          p13 (polar p2 (* pi 1.5) d)
          p14 (polar p13 (caddr v) 3.0)
          p13 (inters p10 p11 p13 p14 nil)
          p14 (inters p3 p4 p13 p14 nil)
          p13 (distance p13 p14)
          p8  (polar p2 (* pi 1.5) (+ c d))
          p8  (polar p8 (car v) (+ p13 (- b 1.0)))
          p5  (polar p8 (+ (angle p3 p2) (* pi (cadr v))) e)
          p6  (polar p5 (angle p3 p2) 1.0)
          p5  (inters p5 p6 p4 (polar p4 (caddr v) 12.0) nil)
          p6  (polar p5 (angle p3 p2) 0.75)
          p7  (polar p6 (+ (angle p2 p3) (* pi (cadr v))) e))
    (list p1 p2 p3 p4 p5 p6 p7 p8 p9 p10 p11 p12)
)

;;; Sloped riser, closing pan.
(defun StairPan:SrClosing ( a v b c d e f / p1 p2 p3 p4 p5 p6 p7 p8 )
    (setq p1 (polar a (car v) (+ b e))
          p1 (polar p1 (* pi 1.5) f)
          p2 (polar p1 (* pi 0.5) (- f (- d e)))
          p8 (polar p1 (caddr v) e)
          p7 (polar p8 (* pi 0.5) (- (distance p1 p2) e))
          p3 (polar a (* pi 1.5) c)
          p3 (polar p3 (car v) 1.0)
          p4 (polar a (* pi 1.5) d)
          p3 (inters a p3 p4 (polar p4 0 12) nil)
          p5 (polar a (+ (angle a p3) (* pi (cadr v))) e)
          p6 (polar p3 (+ (angle a p3) (* pi (cadr v))) e)
          p6 (inters p5 p6 p3 p4 nil)
          p4 p3
          p3 (polar p6 (+ (angle a p4) (* pi (cadr v))) e)
          p4 (polar p3 (angle p4 a) 3.0)
          p3 (inters p2 (polar p2 (caddr v) 12.0) p3 p4 nil)
          p4 (polar p3 (angle p3 p4) 0.75)
          p5 (polar p4 (+ (angle p3 p4) (* pi (cadr v))) e))
    (list p1 p2 p3 p4 p5 p6 p7 p8)
)

;;; Sloped riser, landing pan.
(defun StairPan:SrLanding ( a v b c d e f
                            / p1 p2 p3 p4 p5 p6 p7 p8 p9 p10 p11 p12 )
    (setq p2  a
          p3  (polar p2 (* pi 1.5) c)
          p3  (polar p3 (caddr v) 1.0)
          p4  (polar p3 (* pi 1.5) (- d e))
          p9  (polar p4 (* pi (cadddr v)) (* e (sqrt 2.0)))
          p11 (polar p2 (+ (angle p3 p2) (* pi (cadr v))) e)
          p10 (polar p3 (+ (angle p3 p2) (* pi (cadr v))) e)
          p12 (polar p2 (* pi 1.5) e)
          p11 (inters p10 p11 p12 (polar p12 (caddr v) 12) nil)
          p12 (polar p11 (caddr v) 0.75)
          p1  (polar p12 (* pi 0.5) e)
          p10 (inters p10 p11 p9 (polar p9 (* pi (cadr v)) 12) nil)
          p5  (polar p4 (car v) (+ 1.0 b e))
          p8  (polar p9 (car v) (+ 1.0 b e))
          p7  (polar p8 (* pi 1.5) (- f d))
          p6  (polar p7 (car v) e))
    (list p1 p2 p3 p4 p5 p6 p7 p8 p9 p10 p11 p12)
)

;;; ---------------------------------------------------------------------------
;;; PROFILE REGISTRY
;;;
;;; Each entry is:
;;;   nosing  pan  builder  (variant-A variant-B)  handle-index-A  handle-index-B
;;;
;;; The two handle indices name the pair of points whose connecting segment the
;;; drag test measures against - they are the free edge of the pan, which is what
;;; the cursor is effectively pointing at when you choose a hand.
;;; ---------------------------------------------------------------------------

(setq StairPan:Profiles
    (list
        (list "Square" "Riser"   StairPan:SqRiser
              (list (list 0 0.75 1.25) (list pi 0.25 1.75)) 5 6)
        (list "Square" "Stair"   StairPan:SqStair
              (list (list 0 0.75 pi 1.25) (list pi 0.25 0 1.75)) 5 6)
        (list "Square" "Closing" StairPan:SqClosing
              (list (list pi 0.75) (list 0 0.25)) 4 5)
        (list "Square" "Landing" StairPan:SqLanding
              (list (list 0 0.75 pi 1.25) (list pi 0.25 0 1.75)) 5 6)

        (list "SlopedNosing" "Riser"   StairPan:SlRiser
              (list (list 0 0.5 pi) (list pi 1.5 0)) 5 6)
        (list "SlopedNosing" "Stair"   StairPan:SlStair
              (list (list 0 0.5 pi 1.25) (list pi 1.5 0 1.75)) 5 6)
        (list "SlopedNosing" "Closing" StairPan:SlClosing
              (list (list pi 1.5 0) (list 0 0.5 pi)) 0 1)
        (list "SlopedNosing" "Landing" StairPan:SlLanding
              (list (list 0 0.25 pi 1.5) (list pi 0.75 0 0.5)) 5 6)

        (list "SlopedRiser" "Riser"   StairPan:SrRiser
              (list (list pi 0 0.5) (list 0 pi 1.5)) 3 4)
        (list "SlopedRiser" "Stair"   StairPan:SrStair
              (list (list 0 0.5 pi 1.25) (list pi 1.5 0 1.75)) 6 7)
        (list "SlopedRiser" "Closing" StairPan:SrClosing
              (list (list pi 1.5 0) (list 0 0.5 pi)) 0 1)
        (list "SlopedRiser" "Landing" StairPan:SrLanding
              (list (list 0 0.5 pi 1.25) (list pi 1.5 0 1.75)) 4 5)
    )
)

;;; Find the registry entry for a nosing/pan combination.
(defun StairPan:Lookup ( nosing pan / hit )
    (foreach p StairPan:Profiles
        (if (and (null hit) (= (car p) nosing) (= (cadr p) pan))
            (setq hit p)))
    hit
)

;;; Call one profile builder with the arguments its shape actually needs. The
;;; twelve builders take different subsets of the stair dimensions, so this is
;;; the one place that knows which wants which.
(defun StairPan:Build ( entry v tread riser fill lfill thk base / fn pan )
    (setq fn  (caddr entry)
          pan (cadr entry))
    (cond
        ((= pan "Riser")   (apply fn (list base v riser fill thk)))
        ((= pan "Stair")   (apply fn (list base v tread riser fill thk)))
        ((= pan "Closing")
         (if (= (car entry) "Square")
             (apply fn (list base v tread fill thk lfill))
             (apply fn (list base v tread riser fill thk lfill))))
        ((= pan "Landing") (apply fn (list base v tread riser fill thk lfill)))
    )
)

;;; ---------------------------------------------------------------------------
;;; LIVE MIRROR PICKING
;;;
;;; Both hands are drawn as temporary vectors and swapped as the cursor moves,
;;; so you see the pan you are about to get. GRVECS draws in XOR, so redrawing
;;; the same vector list erases it - which is why swapping is always "rub out the
;;; one showing, then draw the other".
;;;
;;; Returns the chosen point list, or nil if the user cancelled.
;;; ---------------------------------------------------------------------------

;;; Turn a point list into the vector list GRVECS wants: a colour, then every
;;; segment as a pair of points, closed back to the start.
(defun StairPan:Vecs ( pts / out prev first )
    (setq first (car pts) prev first out nil)
    (foreach p (cdr pts)
        (setq out (cons p (cons prev out)) prev p))
    (setq out (cons first (cons prev out)))
    (cons 256 (reverse out))
)

(defun StairPan:ChooseHand ( ptsA ptsB ia ib / va vb showing input cur da db )

    (setq va (StairPan:Vecs ptsA)
          vb (StairPan:Vecs ptsB))

    (grvecs va)
    (setq showing va)
    (princ "\nDrag to either side to choose the hand, then click: ")

    ;; GRREAD return codes that matter here:
    ;;   5  the pointer moved - update which hand is showing
    ;;   3  a point was picked - take the hand currently showing
    ;;   2  a key was pressed, 11/12 a button - treat both as cancel
    (setq input (grread 5))
    (while (and input
                (/= 3 (car input)) (/= 2 (car input))
                (/= 11 (car input)) (/= 12 (car input)))
        (if (= 5 (car input))
            (progn
                (setq cur (cadr input))
                ;; Measure the cursor horizontally against each hand's free edge.
                ;; Whichever is nearer is the hand being pointed at.
                (setq da (StairPan:Reach cur (nth ia ptsA) (nth ib ptsA))
                      db (StairPan:Reach cur (nth ia ptsB) (nth ib ptsB)))
                (cond
                    ((and da db (< da db))
                     (if (not (equal showing va))
                         (progn (grvecs showing) (grvecs va) (setq showing va))))
                    ((and da db)
                     (if (not (equal showing vb))
                         (progn (grvecs showing) (grvecs vb) (setq showing vb))))
                )
            )
        )
        (setq input (grread 5))
    )

    ;; Rub out whichever preview is on screen before returning.
    (grvecs showing)

    (cond
        ((null input) nil)
        ((/= 3 (car input)) nil)          ; anything but a pick means cancelled
        ((equal showing va) ptsA)
        (t ptsB)
    )
)

;;; Horizontal distance from a point to a segment, or nil when the horizontal
;;; ray from that point misses the segment entirely.
(defun StairPan:Reach ( cur p1 p2 / hit )
    (if (setq hit (inters cur (polar cur 0.0 12.0) p1 p2 nil))
        (distance cur hit))
)

;;; ---------------------------------------------------------------------------
;;; STRETCH-OUT
;;;
;;; See the note in the header: the outline of a constant-thickness folded strip
;;; runs out along one face and back along the other, so
;;;   developed length = (perimeter - 2 x thickness) / 2
;;; ---------------------------------------------------------------------------

(defun StairPan:StretchOut ( pts thk / per prev )
    (setq prev (car pts) per 0.0)
    (foreach p (cdr pts)
        (setq per (+ per (distance prev p)) prev p))
    (setq per (+ per (distance prev (car pts))))
    (/ (- per (* 2.0 thk)) 2.0)
)

;;; ---------------------------------------------------------------------------
;;; DRAWING
;;; ---------------------------------------------------------------------------

(defun StairPan:Layer ( name )
    (if (tblsearch "layer" name)
        (command "_.LAYER" "_ON" name "_THAW" name "_UNLOCK" name "")
        (command "_.LAYER" "_NEW" name ""))
    (setvar "CLAYER" name)
)

(defun StairPan:DrawPan ( pts )
    (StairPan:Layer "STAIRPAN")
    (command "_.PLINE" (car pts) "_W" 0 0)
    (foreach p (cdr pts) (command p))
    (command "_C")
    (entlast)
)

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

(defun c:STAIRPAN ( / *error* vars vals opt v entry thk base
                      ptsA ptsB chosen so txtPt height done )

    (setq vars '("CMDECHO" "OSMODE" "BLIPMODE" "CLAYER" "PLINEWID")
          vals (mapcar 'getvar vars))

    (defun StairPan: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 )
        (StairPan:Restore)
        (if (and msg (not (wcmatch (strcase msg t) "*break*,*cancel*,*exit*")))
            (princ (strcat "\n** STAIRPAN 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")

    ;; --- settings -----------------------------------------------------------
    (setq done nil)
    (while (not done)
        (initget "Nosing Pan Tread Riser Fill Landingfill Gage Dimensions Draw")
        (setq opt (getkword
                      (strcat "\n" (StairPan:Get "NOSING") " / "
                              (StairPan:Get "PAN") " pan"
                              "   tread " (rtos (StairPan:Get "TREAD") 2 3)
                              "  riser " (rtos (StairPan:Get "RISER") 2 3)
                              "  fill " (rtos (StairPan:Get "FILL") 2 3)
                              "  " (StairPan:Get "GAGE")
                              "\n[Nosing/Pan/Tread/Riser/Fill/Landingfill/Gage/Dimensions/Draw] <Draw>: ")))
        (if (null opt) (setq opt "Draw"))

        (cond
            ((= opt "Nosing")
             (initget "Square SlopedNosing SlopedRiser")
             (if (setq v (getkword "\nNosing treatment [Square/SlopedNosing/SlopedRiser]: "))
                 (StairPan:Put "NOSING" v)))

            ((= opt "Pan")
             (initget "Riser Stair Closing Landing")
             (if (setq v (getkword "\nPan type [Riser/Stair/Closing/Landing]: "))
                 (StairPan:Put "PAN" v)))

            ((= opt "Tread")
             (initget 6)
             (if (setq v (getdist (strcat "\nTread width <"
                                          (rtos (StairPan:Get "TREAD") 2 3) ">: ")))
                 (StairPan:Put "TREAD" v)))

            ((= opt "Riser")
             (initget 6)
             (if (setq v (getdist (strcat "\nRiser height <"
                                          (rtos (StairPan:Get "RISER") 2 3) ">: ")))
                 (StairPan:Put "RISER" v)))

            ((= opt "Fill")
             (initget 6)
             (if (setq v (getdist (strcat "\nPan fill depth <"
                                          (rtos (StairPan:Get "FILL") 2 3) ">: ")))
                 (StairPan:Put "FILL" v)))

            ((= opt "Landingfill")
             (initget 6)
             (if (setq v (getdist (strcat "\nLanding fill depth <"
                                          (rtos (StairPan:Get "LFILL") 2 3) ">: ")))
                 (StairPan:Put "LFILL" v)))

            ((= opt "Gage")
             (princ "\nGages: ")
             (foreach g StairPan:Gages (princ (strcat (car g) "  ")))
             (setq v (getstring (strcat "\nSheet gage <" (StairPan:Get "GAGE") ">: ")))
             (if (/= v "")
                 (if (assoc v StairPan:Gages)
                     (StairPan:Put "GAGE" v)
                     (princ "\nNot a listed gage - keeping the previous setting."))))

            ((= opt "Dimensions")
             (initget "Yes No")
             (if (setq v (getkword "\nReport the stretch-out as text on the drawing [Yes/No]: "))
                 (StairPan:Put "DIMS" v)))

            ((= opt "Draw") (setq done t))
        )
    )

    ;; --- draw ---------------------------------------------------------------
    (setq entry (StairPan:Lookup (StairPan:Get "NOSING") (StairPan:Get "PAN"))
          thk   (StairPan:Thickness))

    (if (null entry)
        (princ "\n** No profile for that combination. **")
        (progn
            (setvar "BLIPMODE" 0)

            (while (setq base (getpoint (strcat "\nNosing point for the "
                                                (strcase (StairPan:Get "PAN") t)
                                                " pan <Enter to finish>: ")))
                (setvar "OSMODE" 0)

                ;; Both hands, from the same expressions with mirrored variants.
                (setq ptsA (StairPan:Build entry (car  (cadddr entry))
                                           (StairPan:Get "TREAD") (StairPan:Get "RISER")
                                           (StairPan:Get "FILL")  (StairPan:Get "LFILL")
                                           thk base)
                      ptsB (StairPan:Build entry (cadr (cadddr entry))
                                           (StairPan:Get "TREAD") (StairPan:Get "RISER")
                                           (StairPan:Get "FILL")  (StairPan:Get "LFILL")
                                           thk base))

                (cond
                    ((or (null ptsA) (null ptsB) (vl-some 'null ptsA) (vl-some 'null ptsB))
                     (princ (strcat "\n** Those dimensions do not produce a closed pan."
                                    "\n   Check the tread, riser and fill against the gage. **")))

                    ;; Registry entry is (nosing pan builder variants ia ib), so
                    ;; the two handle indices are elements 4 and 5.
                    ((null (setq chosen (StairPan:ChooseHand ptsA ptsB
                                                             (nth 4 entry)
                                                             (nth 5 entry))))
                     (princ "\nCancelled - nothing drawn."))

                    (t
                        (StairPan:DrawPan chosen)
                        (setq so (StairPan:StretchOut chosen thk))
                        (princ (strcat "\n" (StairPan:Get "NOSING") " "
                                       (strcase (StairPan:Get "PAN") t)
                                       " pan drawn in " (StairPan:Get "GAGE")
                                       ".  Total stretch-out = " (rtos so 2 4)))

                        (if (= (StairPan:Get "DIMS") "Yes")
                            (progn
                                (setq txtPt (getpoint "\nPoint for the stretch-out note: "))
                                (if txtPt
                                    (progn
                                        (setq height (* (getvar "DIMSCALE") (getvar "DIMTXT")))
                                        (if (<= height 0.0) (setq height 0.125))
                                        (StairPan:Layer "STAIRPAN-TEXT")
                                        (command "_.TEXT" txtPt height 0
                                                 (strcat "TOTAL STRETCH-OUT = " (rtos so 2 4)))
                                        (StairPan:Layer "STAIRPAN")))))
                    )
                )
                (setvar "OSMODE" (nth (vl-position "OSMODE" vars) vals))
            )
        )
    )

    (StairPan:Restore)
    (princ)
)

(princ)