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
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
|
open Core
open Graphics
(* ****************** *)
(* The user interface *)
(* ****************** *)
exception Exit_judge
module UI (C : CORE) : sig
val init : unit -> unit
val close : unit -> unit
val handle_events : unit -> unit
val display : unit -> unit
end = struct
module G = C.G
(* Graphic helpers *)
let grey = rgb 64 64 64
let center () = size_x () / 2, size_y () / 2
let fullscreen_msg m =
clear_graph();
let tx, ty = text_size m in
let cx, cy = center () in
let w, h = tx/2, ty/2 in
set_color black;
let cr d =
draw_rect (cx - w - d) (cy - h - d)
(cx + w + d) (cy + h + d)
in cr 20; cr 22;
moveto (cx - w) (cy - h);
draw_string m
let tw m = fst (text_size m)
let text_l l x c m =
set_color c;
moveto x (size_y() - ((l+1) * 20));
draw_string m
let text1 l c m =
text_l l 20 c m
let text2 l c m =
text_l l (size_x()/2 - 20 - tw m) c m
let text3 l c m =
text_l l (size_x()/2 + 20) c m
let text4 l c m =
text_l l (size_x() - 20 - tw m) c m
let hl () =
draw_poly_line
[| 10, size_y() - 50;
size_x() - 10, size_y() - 50 |]
(* Init/Close *)
let init () =
open_graph " 800x600";
fullscreen_msg "Starting up..."
let close () =
close_graph ()
(* View types *)
type view =
| ScoreBoard
| MatchList of bool
| ViewGame of C.game
| Question of string * (unit -> unit) * view
let rec handle_events () =
while key_pressed () do
match !curr_view, read_key() with
| ScoreBoard, '\t' -> curr_view := MatchList false
| MatchList _, '\t' -> curr_view := ScoreBoard
| MatchList e, 'f' -> curr_view := MatchList (not e)
| Question(_, y, n), 'y' -> y()
| Question(_, y, n), 'n' -> curr_view := n
| v, 'q' ->
curr_view := Question(
"Really quit?",
(fun () ->
fullscreen_msg "Exiting...";
raise Exit_judge),
v)
| _ -> ()
done
and display () =
clear_graph ();
match !curr_view with
| ScoreBoard -> scoreboard_disp ()
| MatchList f -> matchlist_disp f
| ViewGame g -> game_disp g
| Question (q, _, _) -> fullscreen_msg (q ^ " (y/n)")
and curr_view = ref ScoreBoard
(* Scoreboard view *)
and scoreboard_disp () =
text1 2 black "score board";
text4 2 grey "match list >";
hl();
let scores = List.sort
(fun (_, sc) (_, sc') -> sc' - sc)
(C.scores())
in
let xx l (n, s) t =
text1 l black t;
text1 (l+1) black (" "^n);
text2 (l+1) black (string_of_int s)
in
let scores = match scores with
| first::q -> xx 4 first "first place"; q
| [] -> []
in
let scores = match scores with
| sec::q -> xx 7 sec "second place"; q
| [] -> []
in
let scores = match scores with
| thrd::q -> xx 10 thrd "third place"; q
| [] -> []
in
let show_sc i (n, s) =
text3 (i+4) black ((string_of_int (i+3))^". "^n);
text4 (i+1) black (string_of_int s)
in
List.iteri show_sc scores
(* Match list view *)
and matchlist_disp show_only_running =
(* TODO *)
()
(* Game view *)
and game_disp g =
(* TODO *)
()
end
(* ************* *)
(* The main loop *)
(* ************* *)
module Juge (C : CORE) : sig
val run : unit -> unit
end = struct
module UI = UI(C)
let run () =
C.init();
UI.init();
begin try while true do
C.handle_events ();
UI.handle_events ()
done with
Exit_judge ->
C.finish ();
UI.close ()
end
end
|
