SATySFiでチョット（本質的な）文書を作ってみた

something.saty

@require: stdjabook
@require: list

let-block ctx +centering it =
  line-break true true ctx (inline-fil ++ read-inline ctx it ++ inline-fil)

let zr-canvas-size = (125mm, 125mm)
let zr-line-width = 5pt
let zr-stroke = stroke zr-line-width Color.black
let zr-fill = fill Color.black
let zr-muffler-stroke = stroke zr-line-width Color.red
let zr-muffler-fill = fill Color.red
let zr-trans (x0, y0) (w, h) (x, y) =
  (x0 +' w *' x, y0 +' h *' y)
let zr-make-prepath orgn csiz (spt, spls) =
  let t = zr-trans orgn csiz in
    List.fold-left
      (fun pth (p1, p2, p3) -> pth |> (bezier-to (t p1) (t p2) (t p3)))
      (start-path (t spt)) spls
let zr-make-path orgn csiz (spt, spls) =
  zr-make-prepath orgn csiz (spt, spls) |> terminate-path
let zr-make-cycle orgn csiz (spt, spls) =
  zr-make-prepath orgn csiz (spt, spls) |> close-with-line
let zr-circle (cx, cy) (rx, ry) =
  let a r = (0.55228475pt *' r) /' 1pt in
    ((cx +.rx, cy), [
      ((cx +.rx, cy +.a ry), (cx +.a rx, cy +.ry), (cx, cy +.ry));
      ((cx -.a rx, cy +.ry), (cx -.rx, cy +.a ry), (cx -.rx, cy));
      ((cx -.rx, cy -.a ry), (cx -.a rx, cy -.ry), (cx, cy -.ry));
      ((cx +.a rx, cy -.ry), (cx +.rx, cy -.a ry), (cx +.rx, cy));
    ])
let zr-flatten = List.fold-left List.append []
let-inline ctx \essential =
  let csiz = zr-canvas-size in
  let (wd, ht) = csiz in
    inline-graphics wd ht 0pt (fun orgn -> zr-flatten [
      [
        zr-stroke (zr-make-cycle orgn csiz ((0.50, 0.72), [
          ((0.64, 0.72), (0.76, 0.65), (0.76, 0.55));
          ((0.76, 0.51), (0.72, 0.47), (0.67, 0.44));
          ((0.79, 0.41), (0.84, 0.32), (0.84, 0.25));
          ((0.84, 0.13), (0.75, 0.08), (0.68, 0.08));
          ((0.50, 0.08), (0.40, 0.08), (0.32, 0.08));
          ((0.25, 0.08), (0.16, 0.13), (0.16, 0.25));
          ((0.16, 0.32), (0.21, 0.41), (0.33, 0.44));
          ((0.28, 0.47), (0.24, 0.51), (0.24, 0.55));
          ((0.24, 0.65), (0.36, 0.72), (0.50, 0.72));
        ]));
        zr-stroke (zr-make-path orgn csiz ((0.40, 0.48), [
          ((0.45, 0.45), (0.55, 0.45), (0.60, 0.48));
        ]));
        zr-fill (zr-make-cycle orgn csiz ((0.58, 0.90), [
          ((0.637, 0.873), (0.713, 0.837), (0.77, 0.81));
          ((0.761, 0.75),  (0.749, 0.67),  (0.74, 0.61));
          ((0.66,  0.60),  (0.50,  0.66),  (0.46, 0.72));
          ((0.496, 0.774), (0.544, 0.846), (0.58, 0.90));
        ]));
      ];
      List.map (fun p -> zr-fill (zr-make-cycle orgn csiz
                           (zr-circle p (0.02, 0.03))))
        [(0.40, 0.56); (0.60, 0.56)];
      zr-flatten (List.map (fun pth -> [zr-fill pth; zr-stroke pth]) [
        zr-make-cycle orgn csiz ((0.20, 0.31), [
          ((0.19, 0.33), (0.14, 0.41), (0.13, 0.42)); 
          ((0.12, 0.43), (0.10, 0.43), (0.07, 0.44)); 
          ((0.04, 0.46), (0.06, 0.46), (0.08, 0.46)); 
          ((0.09, 0.46), (0.11, 0.44), (0.12, 0.44)); 
          ((0.14, 0.46), (0.14, 0.47), (0.15, 0.49)); 
          ((0.16, 0.51), (0.16, 0.49), (0.16, 0.48)); 
          ((0.16, 0.46), (0.14, 0.44), (0.15, 0.43)); 
          ((0.16, 0.42), (0.21, 0.35), (0.22, 0.33)); 
          ((0.23, 0.31), (0.21, 0.30), (0.20, 0.31)); 
        ]);
        zr-make-cycle orgn csiz ((0.80, 0.31), [
          ((0.81, 0.33), (0.86, 0.41), (0.87, 0.42)); 
          ((0.88, 0.43), (0.90, 0.43), (0.93, 0.44)); 
          ((0.96, 0.46), (0.94, 0.46), (0.92, 0.46)); 
          ((0.91, 0.46), (0.89, 0.44), (0.88, 0.44)); 
          ((0.86, 0.46), (0.86, 0.47), (0.85, 0.49)); 
          ((0.84, 0.51), (0.84, 0.49), (0.84, 0.48)); 
          ((0.84, 0.46), (0.86, 0.44), (0.85, 0.43)); 
          ((0.84, 0.42), (0.79, 0.35), (0.78, 0.33)); 
          ((0.77, 0.31), (0.79, 0.30), (0.80, 0.31)); 
        ]);
        zr-make-cycle orgn csiz (zr-circle (0.50, 0.16) (0.03, 0.03));
        zr-make-cycle orgn csiz (zr-circle (0.50, 0.26) (0.03, 0.03));
      ]);
      zr-flatten (List.map (fun pth -> [
          zr-muffler-fill pth; zr-muffler-stroke pth;
      ]) [
        zr-make-cycle orgn csiz ((0.27,0.48), [
          ((0.42, 0.38), (0.58, 0.38), (0.73, 0.48));
          ((0.75, 0.46), (0.76, 0.44), (0.77, 0.41));
          ((0.77, 0.39), (0.75, 0.37), (0.73, 0.36));
          ((0.74, 0.33), (0.74, 0.31), (0.76, 0.26));
          ((0.75, 0.25), (0.72, 0.24), (0.66, 0.23));
          ((0.66, 0.27), (0.65, 0.30), (0.63, 0.34));
          ((0.42, 0.30), (0.32, 0.35), (0.24, 0.41));
          ((0.25, 0.45), (0.26, 0.47), (0.27, 0.48));
        ]);
      ]);
      List.map (fun p -> zr-stroke (zr-make-cycle orgn csiz
                           (zr-circle p (0.04, 0.04)))) [
        (0.07, 0.28); (0.08, 0.68); (0.13, 0.55);
        (0.23, 0.76); (0.42, 0.89); (0.74, 0.89);
        (0.88, 0.73); (0.92, 0.53); (0.94, 0.23);
      ];
    ])
let-inline ctx \bigskip len =
  inline-graphics 1pt len 0pt (fun orgn -> [])
in

document (|
  title = {\SATySFi;: The Good Parts};
  author = {某ZR};
  show-title = true;
  show-toc = false;
|) '<
  +pn{\bigskip(2cm);}
  +centering{\essential;}
>