Created
December 21, 2020 06:44
-
-
Save zr-tex8r/d725f607ccba332cedb83c3e0f0b7e55 to your computer and use it in GitHub Desktop.
SATySFi: To make an animated GIF image of a spinning snowman
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
% scframe.satyh | |
% | |
% Copyright (c) 2020 Takayuki YATO (aka. "ZR") | |
% GitHub: https://github.com/zr-tex8r | |
% Twitter: @zr_tex8r | |
% Distributed under the MIT License. | |
@require: pervasives | |
@require: list | |
%=========================================================== module ZGr0 | |
module ZGr : sig | |
type matrix | |
val identity : matrix | |
val scale : float * float -> matrix | |
val translate : length * length -> matrix | |
val matrix : float * float * float * float * length * length -> matrix | |
type z-pre-path | |
val path-of : z-pre-path -> pre-path | |
val path : matrix -> point -> z-pre-path | |
val line-to : point -> z-pre-path -> z-pre-path | |
val curve-to : point -> point -> point -> z-pre-path -> z-pre-path | |
val close : z-pre-path -> path | |
val line-close : z-pre-path -> path | |
val curve-close : point -> point -> z-pre-path -> path | |
val lines-to : point list -> z-pre-path -> z-pre-path | |
val curves-to : (point * point * point) list -> z-pre-path -> z-pre-path | |
val ellipse : matrix -> point -> (length * length) -> path | |
val circle : matrix -> point -> length -> path | |
type canvas | |
val make-canvas : length -> length -> length -> matrix -> canvas | |
val c-path : canvas -> point -> z-pre-path | |
val c-ellipse : canvas -> point -> (length * length) -> path | |
val c-circle : canvas -> point -> length -> path | |
val fill : color -> path -> canvas -> canvas | |
val stroke : length -> color -> path -> canvas -> canvas | |
val fill-stroke : color -> length -> color -> path -> canvas -> canvas | |
val inline-canvas : canvas -> inline-boxes | |
end = struct | |
type matrix = float * float * float * float * length * length | |
let identity = (1., 0., 0., 1., 0pt, 0pt) | |
let scale (sx, sy) = (sx, 0., 0., sy, 0pt, 0pt) | |
let translate (tx, ty) = (1., 0., 0., 1., tx, ty) | |
let matrix mtx = mtx | |
let trans (a, b, c, d, e, f) (x, y) = | |
(x *' a +' y *' c +' e, x *' b +' y *' d +' f) | |
type z-pre-path = pre-path * matrix | |
let path-of (pth, _) = pth | |
let prim-line-to = line-to | |
let path mtx p = | |
(start-path (trans mtx p), mtx) | |
let line-to p (pth, mtx) = | |
(pth |> prim-line-to (trans mtx p), mtx) | |
let curve-to p1 p2 p3 (pth, mtx) = | |
(pth |> bezier-to (trans mtx p1) (trans mtx p2) (trans mtx p3), mtx) | |
let close (pth, _) = | |
terminate-path pth | |
let line-close (pth, _) = | |
close-with-line pth | |
let curve-close p1 p2 (pth, mtx) = | |
close-with-bezier (trans mtx p1) (trans mtx p2) pth | |
let lines-to ps zpth = | |
List.fold-left (fun zpth p -> zpth |> line-to p) zpth ps | |
let curves-to crvs zpth = | |
List.fold-left (fun zpth (p1, p2, p3) -> zpth |> curve-to p1 p2 p3) zpth crvs | |
let alpha = 0.55228475 | |
let ellipse mtx (cx, cy) (rx, ry) = | |
let (ax, ay) = (rx *' alpha, ry *' alpha) in | |
path mtx (cx +' rx, cy) | |
|> curve-to (cx +' rx, cy +' ay) (cx +' ax, cy +' ry) (cx, cy +' ry) | |
|> curve-to (cx -' ax, cy +' ry) (cx -' rx, cy +' ay) (cx -' rx, cy) | |
|> curve-to (cx -' rx, cy -' ay) (cx -' ax, cy -' ry) (cx, cy -' ry) | |
|> curve-close (cx +' ax, cy -' ry) (cx +' rx, cy -' ay) | |
let circle mtx ctr rds = | |
ellipse mtx ctr (rds, rds) | |
type metrics = length * length * length | |
type canvas = metrics * matrix * (graphics list) | |
let make-canvas wd ht dp mtx = | |
((wd, ht, dp), mtx, []) | |
let c-path (_, mtx, _) = | |
path mtx | |
let c-ellipse (_, mtx, _) = | |
ellipse mtx | |
let c-circle (_, mtx, _) = | |
circle mtx | |
let fill clr pth (mtr, mtx, gs) = | |
(mtr, mtx, (fill clr pth) :: gs) | |
let stroke lwd clr pth (mtr, mtx, gs) = | |
(mtr, mtx, (stroke lwd clr pth) :: gs) | |
let fill-stroke fclr lwd sclr pth cvs = | |
cvs |> fill fclr pth |> stroke lwd sclr pth | |
let inline-canvas ((wd, ht, dp), mtx, gs) = | |
let gs1 = List.reverse gs in | |
inline-graphics wd ht dp (fun p -> List.map (shift-graphics p) gs1) | |
end | |
%=========================================================== module Essential0 | |
module Essential : sig | |
val draw : length -> float -> ZGr.canvas | |
end = struct | |
let base = RGB(0.000, 0.000, 0.000) | |
let muffler = RGB(1.000, 0.000, 0.000) %Red | |
let hat = RGB(0.000, 0.500, 0.000) %Green | |
let arms = RGB(0.648, 0.165, 0.165) %Brown | |
let buttons = RGB(0.255, 0.410, 0.884) %RoyalBlue | |
let snow = RGB(0.530, 0.808, 0.920) %SkyBlue | |
let broom = RGB(0.720, 0.525, 0.044) %DarkGoldenrod | |
let line-width = 0.0139 | |
let descent = 0.0 | |
let strokes lwd clr lins cvs = | |
let prc cvs (p1, p2) = cvs |> | |
ZGr.stroke lwd clr (ZGr.c-path cvs p1 |> ZGr.line-to p2 |> ZGr.close) in | |
List.fold-left prc cvs lins | |
let make-trans siz ang = | |
let (s, c) = (sin ang, cos ang) in | |
let scl = siz /' 1pt in | |
ZGr.matrix (c *. scl, s *. scl, 0. -. s *. scl, c *. scl, | |
siz *' (0.5 *. (1. +. s -. c)), siz *' (0.5 *. (1. -. c -. s))) | |
let draw siz ang = | |
let lwd = siz *' line-width in | |
let (ht, dp) = (siz *' (1. -. descent), siz *' descent) in | |
let cvs = ZGr.make-canvas siz ht dp (make-trans siz ang) in | |
let (path, ellipse) = (ZGr.c-path cvs, ZGr.c-ellipse cvs) in | |
let draw-snow c = | |
ZGr.stroke lwd snow (ellipse c (0.04pt,0.04pt)) in | |
cvs | |
% body | |
|> ZGr.stroke lwd base (path (0.50pt,0.72pt) |> ZGr.curves-to [ | |
((0.64pt,0.72pt), (0.76pt,0.65pt), (0.76pt,0.55pt)); | |
((0.76pt,0.51pt), (0.72pt,0.47pt), (0.67pt,0.44pt)); | |
((0.79pt,0.41pt), (0.84pt,0.32pt), (0.84pt,0.25pt)); | |
((0.84pt,0.13pt), (0.75pt,0.08pt), (0.68pt,0.08pt)); | |
((0.50pt,0.08pt), (0.40pt,0.08pt), (0.32pt,0.08pt)); | |
((0.25pt,0.08pt), (0.16pt,0.13pt), (0.16pt,0.25pt)); | |
((0.16pt,0.32pt), (0.21pt,0.41pt), (0.33pt,0.44pt)); | |
((0.28pt,0.47pt), (0.24pt,0.51pt), (0.24pt,0.55pt)); | |
] |> ZGr.curve-close (0.24pt,0.65pt) (0.36pt,0.72pt)) | |
% eyes | |
|> ZGr.fill base (ellipse (0.40pt,0.56pt) (0.02pt,0.03pt)) | |
|> ZGr.fill base (ellipse (0.60pt,0.56pt) (0.02pt,0.03pt)) | |
% mouth | |
|> ZGr.stroke lwd base (path (0.40pt,0.48pt) | |
|> ZGr.curve-to (0.45pt,0.45pt) (0.55pt,0.45pt) (0.60pt,0.48pt) | |
|> ZGr.close) | |
% broom | |
|> strokes (lwd *' 3.2) broom [((0.03pt,0.06pt), (0.12pt,0.50pt))] | |
|> strokes (lwd *' 1.2) broom [ | |
((0.11pt,0.50pt), (0.06pt,0.75pt)); | |
((0.12pt,0.50pt), (0.12pt,0.72pt)); | |
((0.12pt,0.50pt), (0.18pt,0.76pt)); | |
((0.12pt,0.50pt), (0.21pt,0.70pt)); | |
((0.13pt,0.50pt), (0.27pt,0.74pt))] | |
% hat | |
|> ZGr.fill-stroke hat lwd hat (path (0.58pt,0.90pt) |> ZGr.lines-to [ | |
(0.77pt,0.81pt); (0.74pt,0.61pt); | |
] |> ZGr.curve-to (0.66pt,0.60pt) (0.50pt,0.66pt) (0.46pt,0.72pt) | |
|> ZGr.line-close) | |
% arms | |
|> ZGr.fill-stroke arms lwd arms (path (0.20pt,0.31pt) |> ZGr.curves-to [ | |
((0.19pt,0.33pt), (0.14pt,0.41pt), (0.13pt,0.42pt)); | |
((0.12pt,0.43pt), (0.10pt,0.43pt), (0.07pt,0.44pt)); | |
((0.04pt,0.46pt), (0.06pt,0.46pt), (0.08pt,0.46pt)); | |
((0.09pt,0.46pt), (0.11pt,0.44pt), (0.12pt,0.44pt)); | |
((0.14pt,0.46pt), (0.14pt,0.47pt), (0.15pt,0.49pt)); | |
((0.16pt,0.51pt), (0.16pt,0.49pt), (0.16pt,0.48pt)); | |
((0.16pt,0.46pt), (0.14pt,0.44pt), (0.15pt,0.43pt)); | |
((0.16pt,0.42pt), (0.21pt,0.35pt), (0.22pt,0.33pt)); | |
] |> ZGr.curve-close (0.23pt,0.31pt) (0.21pt,0.30pt)) | |
|> ZGr.fill-stroke arms lwd arms (path (0.80pt,0.31pt) |> ZGr.curves-to [ | |
((0.81pt,0.33pt), (0.86pt,0.41pt), (0.87pt,0.42pt)); | |
((0.88pt,0.43pt), (0.90pt,0.43pt), (0.93pt,0.44pt)); | |
((0.96pt,0.46pt), (0.94pt,0.46pt), (0.92pt,0.46pt)); | |
((0.91pt,0.46pt), (0.89pt,0.44pt), (0.88pt,0.44pt)); | |
((0.86pt,0.46pt), (0.86pt,0.47pt), (0.85pt,0.49pt)); | |
((0.84pt,0.51pt), (0.84pt,0.49pt), (0.84pt,0.48pt)); | |
((0.84pt,0.46pt), (0.86pt,0.44pt), (0.85pt,0.43pt)); | |
((0.84pt,0.42pt), (0.79pt,0.35pt), (0.78pt,0.33pt)); | |
] |> ZGr.curve-close (0.77pt,0.31pt) (0.79pt,0.30pt)) | |
% buttons | |
|> ZGr.fill-stroke buttons lwd buttons | |
(ellipse (0.50pt,0.16pt) (0.03pt,0.03pt)) | |
|> ZGr.fill-stroke buttons lwd buttons | |
(ellipse (0.50pt,0.26pt) (0.03pt,0.03pt)) | |
% muffler | |
|> ZGr.fill-stroke muffler lwd muffler (path (0.27pt,0.48pt) |> ZGr.curves-to [ | |
((0.42pt,0.38pt), (0.58pt,0.38pt), (0.73pt,0.48pt)); | |
((0.75pt,0.46pt), (0.76pt,0.44pt), (0.77pt,0.41pt)); | |
((0.77pt,0.39pt), (0.75pt,0.37pt), (0.73pt,0.36pt)); | |
((0.74pt,0.33pt), (0.74pt,0.31pt), (0.76pt,0.26pt)); | |
((0.75pt,0.25pt), (0.72pt,0.24pt), (0.66pt,0.23pt)); | |
((0.66pt,0.27pt), (0.65pt,0.30pt), (0.63pt,0.34pt)); | |
((0.42pt,0.30pt), (0.32pt,0.35pt), (0.24pt,0.41pt)); | |
] |> ZGr.curve-close (0.25pt,0.45pt) (0.26pt,0.47pt)) | |
% snow | |
|> draw-snow (0.13pt,0.81pt) | |
|> draw-snow (0.42pt,0.89pt) | |
|> draw-snow (0.74pt,0.89pt) | |
|> draw-snow (0.88pt,0.73pt) | |
|> draw-snow (0.92pt,0.53pt) | |
|> draw-snow (0.94pt,0.23pt) | |
end | |
%=========================================================== module SCFrame | |
module SCFrame : sig | |
val frame : int -> int -> document | |
end = struct | |
let image-size = 400pt | |
let essential-size = 280pt | |
let-inline ctx \math _ = inline-nil | |
let frame m n = | |
let ang = 0. -. 2. *. math-pi *. (float m /. float n) in | |
let ctx0 = get-initial-context essential-size (command \math) in | |
let cesnt = Essential.draw essential-size ang in | |
let bbmain = | |
inline-fil ++ (ZGr.inline-canvas cesnt) ++ inline-fil | |
|> form-paragraph ctx0 in | |
let stt = (image-size -' essential-size) *' 0.5 in | |
let paper = UserDefinedPaper(image-size, image-size) in | |
let pglayout _ = (| | |
text-origin = (stt, stt); | |
text-height = essential-size; | |
|) in | |
let pgextra _ = (| | |
header-origin = (0mm, 0mm); header-content = block-nil; | |
footer-origin = (0mm, 0mm); footer-content = block-nil; | |
|) in | |
page-break paper pglayout pgextra bbmain | |
end | |
%=========================================================== global | |
let frame = SCFrame.frame | |
%=========================================================== all done | |
%% EOF |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
#!/bin/bash | |
set -eu | |
if [[ ! ( $# == 2 && -f $1 ) ]]; then | |
exit 1 | |
fi | |
stop=$((${FASTOPTICKS})) | |
all=$((${FAALLTICKS})) | |
ibase=${1%.satyh} | |
obase=${2%.pdf} | |
if [[ ! ( 0 -le $stop && $stop -lt $all &&\ | |
$1 != $ibase && $2 != $obase ) ]]; then | |
exit 1 | |
fi | |
cat <<EOT >$obase.saty | |
@import: $ibase | |
frame $stop $all | |
EOT | |
${SATYSFI:-satysfi} $obase.saty | |
if [[ ! -f $2 ]]; then | |
exit 1 | |
fi | |
rm $obase.saty |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment