;;; ---------------------------------------------------------------------------
;;; RafterCut.lsp
;;; code compiled by YZ August 2026
;;; ---------------------------------------------------------------------------
;;; CUT RAFTERS AND TRUSS RAFTERS IN SECTION
;;;
;;; PURPOSE
;;;   Draws a rafter as it is actually cut - the sloping member, the birdsmouth
;;;   seat where it sits on the wall plate, the tail overhang, and the blocking
;;;   behind the seat.
;;;
;;;     RAFTER       a single cut rafter
;;;     RAFTERTRUSS  a truss rafter, with separate top and bottom cords
;;;
;;;   Both will mirror about the ridge to give you the opposite side in the same
;;;   operation.
;;;
;;; PITCH IS GIVEN AS RISE AND RUN
;;;   Because that is how a roof is specified and how a framing square is set.
;;;   Give 6 and 12 for a 6-in-12 roof; the routine works out the angle.
;;;
;;; THE TRIGONOMETRY, SAID PLAINLY
;;;   The routine this replaces carried two helper functions that between them
;;;   ran to nine lines of nested POLAR and SQRT calls, building right triangles
;;;   out of unit vectors to recover an angle. They compute, in full:
;;;
;;;       pitch angle          = (atan rise run)
;;;       vertical depth of a
;;;       rafter cut square    = depth / (cos pitch)
;;;
;;;   Both are written that way here. They are the same numbers - the second one
;;;   is just the standard result that a member of perpendicular depth D, laid at
;;;   a pitch, measures D over cos(pitch) when you measure it vertically. That is
;;;   the dimension the tail cut is set out from.
;;;
;;; WHICH WAY THE ROOF SLOPES
;;;   Pick the seat point first and the ridge second. Drawing right to left is
;;;   as valid as left to right, and everything - the seat, the blocking, the
;;;   tail - flips with it. The baseline must be horizontal, because a wall plate
;;;   is, and the routine says so rather than drawing a nonsense rafter.
;;;
;;;   RAFTER       - a cut rafter with seat, tail and blocking
;;;   RAFTERTRUSS  - a truss rafter with top and bottom cords
;;; ---------------------------------------------------------------------------

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

(if (null *RafterCut:Prefs*)
    (setq *RafterCut:Prefs*
        (list (cons "WIDTH"  2.0)    ; rafter thickness on plan
              (cons "DEPTH" 12.0)    ; rafter depth
              (cons "RISE"   6.0)    ; pitch, rise
              (cons "RUN"   12.0)    ; pitch, run
              (cons "SEAT"   1.0)    ; birdsmouth seat height
              (cons "OVER"  24.0)    ; tail overhang
              (cons "TDEPTH" 4.0)    ; truss cord depth
              (cons "TRISE1" 6.0)    ; top cord rise
              (cons "TRUN1" 12.0)    ; top cord run
              (cons "TRISE2" 0.0)    ; bottom cord rise, 0 for a level cord
              (cons "TRUN2" 12.0)    ; bottom cord run
              (cons "BLOCK"  "Yes")
              (cons "MIRROR" "Yes")
        )
    )
)

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

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

(defun RafterCut:AskDist ( key prompt / v )
    (initget 6)
    (setq v (getdist (strcat "\n" prompt " <" (rtos (RafterCut:Get key) 2 3) ">: ")))
    (if v (RafterCut:Put key v) (RafterCut:Get key))
)

;;; A rise may legitimately be zero - that is a level bottom cord.
(defun RafterCut:AskRise ( key prompt / v )
    (initget 4)
    (setq v (getdist (strcat "\n" prompt " <" (rtos (RafterCut:Get key) 2 3) ">: ")))
    (if v (RafterCut:Put key v) (RafterCut:Get key))
)

(defun RafterCut:AskYN ( key prompt / v )
    (initget "Yes No")
    (setq v (getkword (strcat "\n" prompt " [Yes/No] <" (RafterCut:Get key) ">: ")))
    (if v (RafterCut:Put key v) (RafterCut:Get key))
)

;;; ---------------------------------------------------------------------------
;;; SHARED
;;; ---------------------------------------------------------------------------

(setq RafterCut:VARS '("CMDECHO" "OSMODE" "BLIPMODE" "ORTHOMODE" "CLAYER" "PLINEWID"))

(defun RafterCut:Save ( ) (mapcar 'getvar RafterCut:VARS))

(defun RafterCut:Restore ( vals )
    (mapcar 'setvar RafterCut:VARS vals)
    (while (= 8 (logand 8 (getvar 'undoctl))) (command "_.UNDO" "_End"))
    (vl-catch-all-apply '(lambda ( ) (*pop-error-mode*)) '())
    (princ)
)

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

;;; Pitch angle from rise over run.
(defun RafterCut:Pitch ( rise run ) (atan rise run))

;;; Vertical measurement of a member whose perpendicular depth is D, laid at a
;;; pitch. Used to set out the plumb cut at the tail.
(defun RafterCut:PlumbDepth ( depth pitch ) (/ depth (cos pitch)))

;;; Ask for the horizontal baseline: the seat point, then the ridge end.
;;; Returns ( seat ridge sign ) where sign is +1 when the roof rises to the
;;; right and -1 when it rises to the left, or nil if cancelled.
(defun RafterCut:Baseline ( / sp ep ok )
    (setvar "ORTHOMODE" 1)
    (setq ok nil)
    (while (not ok)
        (setq sp (getpoint "\nSeat point, where the rafter meets the plate <ortho on>: "))
        (if (null sp)
            (setq ok 'cancel)
            (progn
                (setq ep (getpoint sp "\nRidge end of the rafter: "))
                (cond
                    ((null ep) (setq ok 'cancel))
                    ;; A wall plate is level, so the baseline must be too.
                    ((not (equal (cadr sp) (cadr ep) 1e-8))
                     (princ "\nThe baseline must be horizontal - ortho is on, try again."))
                    ((equal (car sp) (car ep) 1e-8)
                     (princ "\nThose two points are the same."))
                    (t (setq ok t))))))
    (if (eq ok t)
        (list sp ep (if (> (car ep) (car sp)) 1.0 -1.0)))
)

;;; ---------------------------------------------------------------------------
;;; RAFTER
;;; ---------------------------------------------------------------------------

(defun c:RAFTER ( / vals *error* w d rise run seat over blk mir
                    base sp ep sgn pitch ang perp up ridge
                    seatPt topSeat blk1 blk2 tailBot tailTop ss )

    (setq vals (RafterCut:Save))
    (defun *error* ( msg )
        (RafterCut:Restore vals)
        (if (and msg (not (wcmatch (strcase msg t) "*break*,*cancel*,*exit*")))
            (princ (strcat "\n** RAFTER 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.
    (vl-catch-all-apply '(lambda ( ) (*push-error-using-command*)) '())
    (command "_.UNDO" "_Begin")
    (setvar "BLIPMODE" 0)

    (setq w    (RafterCut:AskDist "WIDTH" "Rafter thickness")
          d    (RafterCut:AskDist "DEPTH" "Rafter depth")
          rise (RafterCut:AskDist "RISE"  "Pitch, rise")
          run  (RafterCut:AskDist "RUN"   "Pitch, run")
          seat (RafterCut:AskDist "SEAT"  "Birdsmouth seat height")
          over (RafterCut:AskDist "OVER"  "Tail overhang")
          blk  (RafterCut:AskYN  "BLOCK"  "Draw the blocking behind the seat")
          mir  (RafterCut:AskYN  "MIRROR" "Mirror about the ridge"))

    (cond
        ((>= seat d)
         (princ "\n** The seat cut is as deep as the rafter - there would be nothing left. **"))

        ((null (setq base (RafterCut:Baseline)))
         (princ "\nCancelled."))

        (t
            (setq sp    (car   base)
                  ep    (cadr  base)
                  sgn   (caddr base)
                  pitch (RafterCut:Pitch rise run)
                  ;; Direction the rafter runs, up the slope toward the ridge.
                  ang   (if (> sgn 0.0) pitch (- pi pitch))
                  ;; Perpendicular to the rafter, on its upper side.
                  perp  (+ ang (* sgn (* pi 0.5)))
                  up    (* pi 0.5)
                  ;; The ridge is a plumb line at the far end; the rafter is cut
                  ;; where it meets that line.
                  ridge (polar ep up 1.0))

            (setvar "OSMODE" 0)
            (RafterCut:Layer "RAFTER")

            ;; Bottom of the seat cut, directly below the pick point.
            (setq seatPt  (polar sp (* pi 1.5) seat)
                  topSeat (polar seatPt perp d)
                  blk1    (polar seatPt (+ ang pi) w)
                  blk2    (polar blk1 perp d)
                  tailBot (polar seatPt (+ ang pi) over)
                  tailTop (polar tailBot up (RafterCut:PlumbDepth d pitch)))

            ;; Underside: from the tail, up over the seat cut, then up the slope
            ;; to where it meets the ridge line.
            (command "_.PLINE" tailBot "_W" 0 0 seatPt sp
                     (inters sp (polar sp ang 1.0) ep ridge nil) "")
            (setq ss (ssadd (entlast)))

            ;; Top edge, parallel to the underside, cut at the same ridge line.
            (command "_.LINE" tailTop
                     (inters tailTop (polar tailTop ang 1.0) ep ridge nil) "")
            (setq ss (ssadd (entlast) ss))

            (if (= blk "Yes")
                (progn
                    (command "_.PLINE" seatPt "_W" 0 0 topSeat blk2 blk1 "_C")
                    (setq ss (ssadd (entlast) ss))))

            ;; Mirror about the plumb line at the ridge, keeping the original.
            (if (= mir "Yes")
                (command "_.MIRROR" ss "" ep ridge "_No"))

            (princ (strcat "\nRafter drawn - " (rtos rise 2 2) " in " (rtos run 2 2)
                           " pitch, " (rtos d 2 2) " deep, "
                           (rtos over 2 2) " tail."))))

    (RafterCut:Restore vals)
    (princ)
)

;;; ---------------------------------------------------------------------------
;;; RAFTERTRUSS
;;;
;;; A truss rafter is two cords rather than one solid member: a top cord at the
;;; roof pitch and a bottom cord which may be level or slightly pitched, meeting
;;; over the wall plate. A bottom cord rise of zero gives the usual level ceiling
;;; tie.
;;; ---------------------------------------------------------------------------

(defun c:RAFTERTRUSS ( / vals *error* w d r1 n1 r2 n2 over blk mir
                         base sp ep sgn a1 a2 perp1 up ridge
                         botIn topIn blk1 blk2 tailBot tailTop ss )

    (setq vals (RafterCut:Save))
    (defun *error* ( msg )
        (RafterCut:Restore vals)
        (if (and msg (not (wcmatch (strcase msg t) "*break*,*cancel*,*exit*")))
            (princ (strcat "\n** RAFTERTRUSS error: " msg " **")))
        (princ))

    (setvar "CMDECHO" 0)
    (vl-catch-all-apply '(lambda ( ) (*push-error-using-command*)) '())
    (command "_.UNDO" "_Begin")
    (setvar "BLIPMODE" 0)

    (setq w    (RafterCut:AskDist "WIDTH"  "Cord thickness")
          d    (RafterCut:AskDist "TDEPTH" "Cord depth")
          r1   (RafterCut:AskDist "TRISE1" "Top cord rise")
          n1   (RafterCut:AskDist "TRUN1"  "Top cord run")
          r2   (RafterCut:AskRise "TRISE2" "Bottom cord rise, 0 for level")
          n2   (RafterCut:AskDist "TRUN2"  "Bottom cord run")
          over (RafterCut:AskDist "OVER"   "Tail overhang")
          blk  (RafterCut:AskYN  "BLOCK"   "Draw the blocking at the heel")
          mir  (RafterCut:AskYN  "MIRROR"  "Mirror about the ridge"))

    (if (null (setq base (RafterCut:Baseline)))
        (princ "\nCancelled.")
        (progn
            (setq sp    (car   base)
                  ep    (cadr  base)
                  sgn   (caddr base)
                  ;; Top cord pitch, and bottom cord pitch which is often zero.
                  a1    (RafterCut:Pitch r1 n1)
                  a2    (if (zerop r2) 0.0 (RafterCut:Pitch r2 n2))
                  a1    (if (> sgn 0.0) a1 (- pi a1))
                  a2    (if (> sgn 0.0) a2 (- pi a2))
                  perp1 (+ a1 (* sgn (* pi 0.5)))
                  up    (* pi 0.5)
                  ridge (polar ep up 1.0))

            (setvar "OSMODE" 0)
            (RafterCut:Layer "RAFTER")

            ;; Bottom cord: runs from the heel to the ridge line.
            (command "_.PLINE" (polar sp (+ a1 pi) over) "_W" 0 0 sp
                     (inters sp (polar sp a2 1.0) ep ridge nil) "")
            (setq ss (ssadd (entlast)))

            ;; Top of the bottom cord, closed back onto the top cord underside.
            (setq botIn (polar sp (if (> sgn 0.0) (+ a2 (* pi 0.5)) (- a2 (* pi 0.5))) d))
            (command "_.PLINE"
                     (inters botIn (polar botIn a2 1.0) ep ridge nil)
                     (inters botIn (polar botIn a2 1.0) sp (polar sp a1 1.0) nil)
                     (inters ep ridge sp (polar sp a1 1.0) nil) "")
            (setq ss (ssadd (entlast) ss))

            ;; Top cord upper edge, and its tail.
            (setq tailBot (polar sp (+ a1 pi) over)
                  tailTop (polar tailBot up (RafterCut:PlumbDepth d (RafterCut:Pitch r1 n1))))
            (command "_.PLINE" tailTop "_W" 0 0
                     (inters tailTop (polar tailTop a1 1.0) ep ridge nil) "")
            (setq ss (ssadd (entlast) ss))

            (if (= blk "Yes")
                (progn
                    (setq topIn (polar sp perp1 d)
                          blk1  (polar sp (+ a1 pi) w)
                          blk2  (polar blk1 perp1 d))
                    (command "_.PLINE" sp "_W" 0 0 topIn blk2 blk1 "_C")
                    (setq ss (ssadd (entlast) ss))))

            (if (= mir "Yes")
                (command "_.MIRROR" ss "" ep ridge "_No"))

            (princ (strcat "\nTruss rafter drawn - top cord " (rtos r1 2 2)
                           " in " (rtos n1 2 2)
                           (if (zerop r2) ", level bottom cord"
                               (strcat ", bottom cord " (rtos r2 2 2) " in " (rtos n2 2 2)))
                           "."))))

    (RafterCut:Restore vals)
    (princ)
)

(princ)
