1 (* A server-rendered SVG line chart with two data series on independent axes: 2 weight on the left, reps on the right. No client script and no charting 3 dependency -- the data is small and the shape is simple, so static SVG built 4 from dream-html nodes fits the app's no-JS-first design and stays testable. 5 6 SVG elements are built with [Dream_html.std_tag]; SVG in HTML5 needs no 7 explicit namespace. Coordinates are plain floats in a fixed viewBox, so the 8 chart scales to its container. *) 9 10 open Dream_html 11 12 let svg = std_tag "svg" 13 let polyline = std_tag "polyline" 14 let line = std_tag "line" 15 let text = std_tag "text" 16 let sattr = string_attr 17 let fattr = float_attr 18 19 (* Fixed drawing surface. The viewBox scales to the container width via CSS. A 20 golden rectangle: the 640×396 surface is a 1.618:1 width:height ratio, which 21 also keeps sparse two-point series from looking empty. The side gutters are 22 fixed, so every chart's plot area starts at the same x and the stacked charts 23 share one clean left edge. *) 24 let width = 640. 25 let height = 396. 26 let pad_left = 52. 27 let pad_right = 52. 28 let pad_top = 30. 29 let pad_bottom = 34. 30 let plot_w = width -. pad_left -. pad_right 31 let plot_h = height -. pad_top -. pad_bottom 32 33 (* Map a value in [lo, hi] to a y pixel, inverted so larger is higher. A flat 34 series (lo = hi) pins to the vertical middle rather than dividing by zero. *) 35 let scale_y ~lo ~hi v = 36 if Float.equal lo hi then pad_top +. (plot_h /. 2.) 37 else pad_top +. (plot_h *. (1. -. ((v -. lo) /. (hi -. lo)))) 38 39 (* Evenly spaced x for [n] points across the plot; a single point sits centre. *) 40 let scale_x ~n i = 41 if n <= 1 then pad_left +. (plot_w /. 2.) 42 else pad_left +. (plot_w *. float_of_int i /. float_of_int (n - 1)) 43 44 let bounds values = 45 match values with 46 | [] -> (0., 1.) 47 | first :: _ -> 48 let lo = List.fold_left Float.min first values in 49 let hi = List.fold_left Float.max first values in 50 (* Pad a flat or tiny range so the line is not glued to an edge. *) 51 if Float.equal lo hi then (lo -. 1., hi +. 1.) else (lo, hi) 52 53 let points_attr coords = 54 coords 55 |> List.map (fun (x, y) -> Printf.sprintf "%.1f,%.1f" x y) 56 |> String.concat " " 57 58 (* A plain stroked line: no markers, no area fill. *) 59 let series ~css_class coords = 60 polyline 61 [ 62 sattr "class" "%s" css_class; 63 sattr "fill" "none"; 64 sattr "points" "%s" (points_attr coords); 65 ] 66 [] 67 68 let axis_line ~x1 ~y1 ~x2 ~y2 = 69 line 70 [ 71 sattr "class" "chart-axis"; 72 fattr "x1" x1; 73 fattr "y1" y1; 74 fattr "x2" x2; 75 fattr "y2" y2; 76 ] 77 [] 78 79 (* A faint full-width horizontal rule at fraction [f] of the plot height, to 80 anchor the lines without competing with them. *) 81 let gridline f = 82 let y = pad_top +. (plot_h *. f) in 83 line 84 [ 85 sattr "class" "chart-grid"; 86 fattr "x1" pad_left; 87 fattr "y1" y; 88 fattr "x2" (pad_left +. plot_w); 89 fattr "y2" y; 90 ] 91 [] 92 93 let axis_label ~x ~y ~anchor ~css_class s = 94 text 95 [ 96 sattr "class" "%s" css_class; 97 fattr "x" x; 98 fattr "y" y; 99 sattr "text-anchor" "%s" anchor; 100 ] 101 [ txt "%s" s ] 102 103 (* Render the chart for a series of (weight, reps) points in time order. The 104 caller guarantees at least two points. *) 105 let render (chart : View_model.Progress_page.chart) = 106 let points = chart.points in 107 let n = List.length points in 108 let weights = 109 List.map (fun (p : View_model.Progress_page.point) -> p.weight) points 110 in 111 let reps = 112 List.map 113 (fun (p : View_model.Progress_page.point) -> float_of_int p.reps) 114 points 115 in 116 let w_lo, w_hi = bounds weights in 117 let r_lo, r_hi = bounds reps in 118 let weight_coords = 119 List.mapi 120 (fun i (p : View_model.Progress_page.point) -> 121 (scale_x ~n i, scale_y ~lo:w_lo ~hi:w_hi p.weight)) 122 points 123 in 124 let rep_coords = 125 List.mapi 126 (fun i (p : View_model.Progress_page.point) -> 127 (scale_x ~n i, scale_y ~lo:r_lo ~hi:r_hi (float_of_int p.reps))) 128 points 129 in 130 svg 131 [ 132 sattr "class" "progress-chart"; 133 sattr "viewBox" "0 0 %g %g" width height; 134 sattr "role" "img"; 135 sattr "aria-label" "Line chart of weight and reps over time for %s" 136 chart.exercise_name; 137 sattr "preserveAspectRatio" "xMidYMid meet"; 138 ] 139 (let first_date = 140 match points with p :: _ -> p.View_model.Progress_page.date | [] -> "" 141 in 142 let last_date = 143 match List.rev points with 144 | p :: _ -> p.View_model.Progress_page.date 145 | [] -> "" 146 in 147 [ 148 (* Faint gridlines first, so axes and series sit on top. *) 149 gridline 0.25; 150 gridline 0.5; 151 gridline 0.75; 152 (* Axes: left (weight), right (reps), and a baseline. *) 153 axis_line ~x1:pad_left ~y1:pad_top ~x2:pad_left ~y2:(pad_top +. plot_h); 154 axis_line ~x1:(pad_left +. plot_w) ~y1:pad_top ~x2:(pad_left +. plot_w) 155 ~y2:(pad_top +. plot_h); 156 axis_line ~x1:pad_left ~y1:(pad_top +. plot_h) ~x2:(pad_left +. plot_w) 157 ~y2:(pad_top +. plot_h); 158 (* Axis titles, anchored just above their axis, clear of the top edge. *) 159 axis_label ~x:pad_left ~y:(pad_top -. 10.) ~anchor:"middle" 160 ~css_class:"chart-axis-title weight" "kg"; 161 axis_label ~x:(pad_left +. plot_w) ~y:(pad_top -. 10.) ~anchor:"middle" 162 ~css_class:"chart-axis-title reps" "reps"; 163 (* Left axis bounds (weight, kg). *) 164 axis_label ~x:(pad_left -. 6.) ~y:(pad_top +. 4.) ~anchor:"end" 165 ~css_class:"chart-tick weight" (Printf.sprintf "%g" w_hi); 166 axis_label ~x:(pad_left -. 6.) ~y:(pad_top +. plot_h) ~anchor:"end" 167 ~css_class:"chart-tick weight" (Printf.sprintf "%g" w_lo); 168 (* Right axis bounds (reps). *) 169 axis_label 170 ~x:(pad_left +. plot_w +. 6.) 171 ~y:(pad_top +. 4.) ~anchor:"start" ~css_class:"chart-tick reps" 172 (Printf.sprintf "%g" r_hi); 173 axis_label 174 ~x:(pad_left +. plot_w +. 6.) 175 ~y:(pad_top +. plot_h) ~anchor:"start" ~css_class:"chart-tick reps" 176 (Printf.sprintf "%g" r_lo); 177 (* X-axis: first and last dates. *) 178 axis_label ~x:pad_left 179 ~y:(pad_top +. plot_h +. 20.) 180 ~anchor:"start" ~css_class:"chart-tick date" first_date; 181 axis_label ~x:(pad_left +. plot_w) 182 ~y:(pad_top +. plot_h +. 20.) 183 ~anchor:"end" ~css_class:"chart-tick date" last_date; 184 (* The two series. *) 185 series ~css_class:"chart-series weight" weight_coords; 186 series ~css_class:"chart-series reps" rep_coords; 187 ]) 188