Initial commit: HITO MVP

Heavy Duty I prescriptive training system encoding Mentzer's methodology.

- 4-day split program (Chest & Back, Legs, Shoulders, Arms)
- Prescription engine with pre-exhaust superset structure
- Strict progression logic (+5kg large / +2.5kg small muscles)
- Recovery gating with stall-based extension and override
- Onboarding via experience level (Novice/Intermediate/Advanced)
- Session logging with full progression analysis
- Exercise substitution (33 alternatives for 17 canonical movements)
- Objectivist aesthetic: black/gold, serif, rectilinear

Stack: Hunchentoot, Mito/SQLite, Djula, SBCL

1 files changed, 232 insertions, 0 deletions

diff --git a/src/program.lisp b/src/program.lisp
new file mode 100644
index 0000000..3a03a53
--- /dev/null
+++ b/src/program.lisp
@@ -0,0 +1,232 @@
+(in-package #:hito)
+
+;;; --- Heavy Duty I Program Definition ---
+;;;
+;;; The program is encoded as pure data: a list of workout days, each containing
+;;; ordered exercise entries with superset groupings, set counts, and rep ranges.
+;;; This is the single source of truth for what Mentzer prescribed.
+
+(defparameter *hd1-program*
+  '((:day 1
+     :name "Chest & Back"
+     :exercises
+     ((:superset
+       ((:name "Pec Deck"             :sets 1 :rep-low 6 :rep-high 10)
+        (:name "Incline Barbell Press" :sets 1 :rep-low 6 :rep-high 10)))
+      (:superset
+       ((:name "Straight-Arm Pulldowns"         :sets 1 :rep-low 6 :rep-high 10)
+        (:name "Close-Grip Palms-Up Pulldowns"  :sets 1 :rep-low 6 :rep-high 10)))
+      (:straight
+       ((:name "Bent-Over Barbell Rows" :sets 2 :rep-low 6 :rep-high 10)))))
+
+    (:day 2
+     :name "Legs"
+     :exercises
+     ((:superset
+       ((:name "Leg Extensions" :sets 1 :rep-low 6 :rep-high 10)
+        (:name "Leg Press"      :sets 1 :rep-low 6 :rep-high 10)))
+      (:straight
+       ((:name "Squats"              :sets 1 :rep-low 6 :rep-high 10)))
+      (:straight
+       ((:name "Leg Curls"           :sets 2 :rep-low 6 :rep-high 10)))
+      (:straight
+       ((:name "Standing Calf Raises" :sets 2 :rep-low 6 :rep-high 10)))
+      (:straight
+       ((:name "Toe Presses"         :sets 1 :rep-low 6 :rep-high 10)))))
+
+    (:day 3
+     :name "Shoulders"
+     :exercises
+     ((:superset
+       ((:name "Lateral Raises"  :sets 1 :rep-low 6 :rep-high 10)
+        (:name "Overhead Press"  :sets 1 :rep-low 6 :rep-high 10)))
+      (:straight
+       ((:name "Bent-Over Lateral Raises" :sets 2 :rep-low 6 :rep-high 10)))))
+
+    (:day 4
+     :name "Arms"
+     :exercises
+     ((:straight
+       ((:name "Barbell Curls"     :sets 2 :rep-low 6 :rep-high 10)))
+      (:superset
+       ((:name "Triceps Pushdowns" :sets 1 :rep-low 6 :rep-high 10)
+        (:name "Dips"              :sets 1 :rep-low 6 :rep-high 10))))))
+  "Heavy Duty I: the complete 4-day split as Mentzer prescribed it.
+Each workout day contains exercise groups — either :superset (pre-exhaust)
+or :straight (standalone). Each exercise specifies sets and rep range.")
+
+;;; --- Starting Weight Defaults by Experience Level ---
+;;;
+;;; Conservative starting points. The progression engine will correct these
+;;; within 2-3 sessions. Better to start light and progress than to start
+;;; heavy and stall.
+
+(defparameter *starting-weights*
+  '(;; (exercise-name beginner intermediate advanced) — all in kg
+    ("Pec Deck"                       20   35   55)
+    ("Incline Barbell Press"          40   60   85)
+    ("Straight-Arm Pulldowns"         15   22   32)
+    ("Close-Grip Palms-Up Pulldowns"  27   45   65)
+    ("Bent-Over Barbell Rows"         35   60   85)
+    ("Leg Extensions"                 20   32   45)
+    ("Leg Press"                      60  115  180)
+    ("Squats"                         40   70  100)
+    ("Leg Curls"                      20   32   45)
+    ("Standing Calf Raises"           35   70  100)
+    ("Toe Presses"                    45   90  135)
+    ("Lateral Raises"                  7   11   16)
+    ("Overhead Press"                 25   42   60)
+    ("Bent-Over Lateral Raises"        5    9   14)
+    ("Barbell Curls"                  18   30   40)
+    ("Triceps Pushdowns"              14   22   32)
+    ("Dips"                            0    0   10))
+  "Starting weights by exercise and experience level.
+Dips default to 0 (bodyweight) for beginner/intermediate.")
+
+(defun get-starting-weight (exercise-name level)
+  "Return the starting weight for an exercise at the given level.
+LEVEL is one of :beginner, :intermediate, :advanced."
+  (let ((entry (assoc exercise-name *starting-weights* :test #'string=)))
+    (when entry
+      (case level
+        (:beginner     (second entry))
+        (:intermediate (third entry))
+        (:advanced     (fourth entry))
+        (otherwise     (second entry))))))
+
+;;; --- Program Query Functions ---
+
+(defun get-workout-day (day-number)
+  "Return the program definition for a given day (1-4)."
+  (find day-number *hd1-program* :key (lambda (d) (getf d :day))))
+
+(defun get-workout-day-name (day-number)
+  "Return the human-readable name for a workout day."
+  (let ((day (get-workout-day day-number)))
+    (when day (getf day :name))))
+
+(defun get-day-exercises (day-number)
+  "Return the exercise group list for a given day."
+  (let ((day (get-workout-day day-number)))
+    (when day (getf day :exercises))))
+
+;;; --- Exercise Resolution ---
+
+(defun find-active-exercise-for-slot (canonical-name)
+  "Find the currently active exercise for a program slot.
+If the user has substituted the canonical exercise, return the substitute.
+Otherwise return the canonical exercise itself."
+  (let ((canonical (find-exercise-by-name canonical-name)))
+    (when canonical
+      ;; Check if there's an active substitution pointing to this exercise
+      (let ((substitute (first (mito:select-dao 'exercise
+                                 (sxql:where (:= :substitution-for
+                                                 (mito:object-id canonical)))))))
+        (or substitute canonical)))))
+
+;;; --- Prescription Generation ---
+
+(defstruct exercise-prescription
+  "A single exercise prescription within a session."
+  exercise-id
+  exercise-name
+  set-count
+  rep-low
+  rep-high
+  target-weight
+  group-type      ; :superset or :straight
+  group-position) ; position within superset (0-indexed), nil for straight
+
+(defun get-last-weight-for-exercise (exercise-id workout-day)
+  "Find the most recent actual weight used for this exercise in a completed session
+of the same workout day. Returns nil if no history."
+  (let* ((sessions (mito:select-dao 'training-session
+                     (sxql:where (:and (:= :workout-day workout-day)
+                                       (:= :completed-p 1)))
+                     (sxql:order-by (:desc :session-date))
+                     (sxql:limit 1)))
+         (last-session (first sessions)))
+    (when last-session
+      (let ((records (mito:select-dao 'set-record
+                       (sxql:where (:and (:= :session-id (mito:object-id last-session))
+                                         (:= :exercise-id exercise-id))))))
+        ;; Return the actual weight from the last set of this exercise
+        (when records
+          (let ((last-record (first (sort (copy-list records) #'>
+                                          :key (lambda (r) (set-record-set-number r))))))
+            (set-record-actual-weight last-record)))))))
+
+(defun get-prescribed-weight-for-exercise (exercise-id workout-day)
+  "Get the next prescribed weight for an exercise.
+First checks progression table (computed by progression engine),
+then falls back to last actual weight, then to nil (needs user input)."
+  ;; For now, just use last actual weight. Progression engine (Task 4)
+  ;; will enhance this.
+  (get-last-weight-for-exercise exercise-id workout-day))
+
+(defun prescribe-session (workout-day)
+  "Generate a full session prescription for the given workout day.
+Returns a list of exercise-prescription structs ordered as the program dictates."
+  (let ((day-def (get-workout-day workout-day))
+        (prescriptions '()))
+    (unless day-def
+      (error "Invalid workout day: ~D (must be 1-4)" workout-day))
+    (dolist (group (getf day-def :exercises))
+      (let* ((group-type (first group))
+             (exercises (second group))
+             (position 0))
+        (dolist (ex-def exercises)
+          (let* ((canonical-name (getf ex-def :name))
+                 (active-exercise (find-active-exercise-for-slot canonical-name))
+                 (exercise-id (when active-exercise (mito:object-id active-exercise)))
+                 (exercise-name (if active-exercise
+                                    (exercise-name active-exercise)
+                                    canonical-name))
+                 (target-weight (when exercise-id
+                                  (get-prescribed-weight-for-exercise
+                                   exercise-id workout-day))))
+            (push (make-exercise-prescription
+                   :exercise-id exercise-id
+                   :exercise-name exercise-name
+                   :set-count (getf ex-def :sets)
+                   :rep-low (getf ex-def :rep-low)
+                   :rep-high (getf ex-def :rep-high)
+                   :target-weight target-weight
+                   :group-type group-type
+                   :group-position (when (eq group-type :superset) position))
+                  prescriptions)
+            (incf position)))))
+    (nreverse prescriptions)))
+
+(defun format-prescription (prescription)
+  "Format a single exercise-prescription for display."
+  (let ((weight (exercise-prescription-target-weight prescription)))
+    (format nil "~A: ~@[~A kg × ~]~D-~D reps × ~D set~:P"
+            (exercise-prescription-exercise-name prescription)
+            (when weight (round weight))
+            (exercise-prescription-rep-low prescription)
+            (exercise-prescription-rep-high prescription)
+            (exercise-prescription-set-count prescription))))
+
+(defun format-session-prescription (workout-day)
+  "Format an entire session prescription as a readable string."
+  (let ((day-def (get-workout-day workout-day))
+        (prescriptions (prescribe-session workout-day))
+        (groups (get-day-exercises workout-day)))
+    (with-output-to-string (out)
+      (format out "~%=== Day ~D: ~A ===~%~%"
+              workout-day (getf day-def :name))
+      ;; Walk the groups directly and print prescriptions in order
+      (let ((presc-idx 0))
+        (loop for group in groups
+              for group-idx from 0
+              for group-type = (first group)
+              for group-exercises = (second group)
+              do (when (> group-idx 0) (format out "~%"))
+                 (if (eq group-type :superset)
+                     (format out "[Pre-Exhaust Superset]~%")
+                     (format out "[Straight Set]~%"))
+                 (loop for i below (length group-exercises)
+                       do (format out "  ~A~%"
+                                  (format-prescription (nth presc-idx prescriptions)))
+                          (incf presc-idx)))))))