This repository has been archived by the owner on Jan 7, 2021. It is now read-only.
-
Notifications
You must be signed in to change notification settings - Fork 0
/
clockboard.satyh
75 lines (56 loc) · 2.28 KB
/
clockboard.satyh
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
@require: list
@require: gr
@require: color
module ClockBoard : sig
val clock-board : context -> float -> inline-text list -> inline-boxes
direct \clock-board : [float] inline-cmd
end = struct
let arabic-list = {| 01 | 02 | 03 | 04 | 05 | 06 | 07 | 08 | 09 | 10 | 11 | 12 |}
let roman-list = {| I | II | III | IV | V | VI | VII | VIII | IX | X | XI | XII |}
let get-time-number n hour-list =
let get-time = List.nth (n - 1) hour-list in
match get-time with
| None -> {?}
| Some(it) -> it
let pi = 3.14159265359
let clock-board ctx size-ratio hour-list =
let color = get-text-color ctx in
let font-size = get-font-size ctx in
let size = font-size *' size-ratio in
let center (x, y) = (x +' size *' 0.5, y) in
% 外枠
let main-flame-r = size *' 0.5 in
let main-flame-thickness = size *' 0.02 in
% 中心の穴
% 数字を設置
let set-hour-number ctx (x, y) n =
let angle = ((pi *. 2.0) /. 12.0) *. (float n) -. (pi *. 0.5) in
let xp = ((1pt *' cos angle) *' ((size /' 1pt) *. 0.5)) *' 0.8 in
let yp = ((-1pt *' sin angle) *' ((size /' 1pt) *. 0.5)) *' 0.8 in
let text = get-time-number n hour-list in
let ctx-num = set-font-size (size *' 0.08) ctx in
let ib-text = read-inline ctx-num text in
let (w, h, d) = get-natural-metrics ib-text in
draw-text (x +' xp -' (w *' 0.5), y +' yp +' d -' ((d +' h) *' 0.5)) ib-text
in
let (w, h, d) = (size, main-flame-r, main-flame-r) in
inline-graphics w h d (fun (x, y) ->
[
fill color (Gr.circle (center (x, y)) main-flame-r);
fill Color.white (Gr.circle (center (x, y)) (main-flame-r -' main-flame-thickness));
set-hour-number ctx (center (x, y)) 1;
set-hour-number ctx (center (x, y)) 2;
set-hour-number ctx (center (x, y)) 3;
set-hour-number ctx (center (x, y)) 4;
set-hour-number ctx (center (x, y)) 5;
set-hour-number ctx (center (x, y)) 6;
set-hour-number ctx (center (x, y)) 7;
set-hour-number ctx (center (x, y)) 8;
set-hour-number ctx (center (x, y)) 9;
set-hour-number ctx (center (x, y)) 10;
set-hour-number ctx (center (x, y)) 11;
set-hour-number ctx (center (x, y)) 12;
]
)
let-inline ctx \clock-board size-ratio = clock-board ctx size-ratio arabic-list
end