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 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272
|
(* Js_of_ocaml examples
* http://www.ocsigen.org/js_of_ocaml/
* Copyright (C) 2008 Benjamin Canou
*
* DO WHAT THE FUCK YOU WANT TO PUBLIC LICENSE
* TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION
*
*)
open Js_of_ocaml
module Html = Dom_html
let js = Js.string
let document = Html.window##.document
type config =
{ nbcols : int
; nbrows : int
; nbmines : int
}
let default_config = { nbcols = 10; nbrows = 10; nbmines = 15 }
type cell =
{ mutable mined : bool
; mutable seen : bool
; mutable flag : bool
; mutable nbm : int
}
type board = cell array array
let iter_on_cell cf f =
for i = 0 to cf.nbcols - 1 do
for j = 0 to cf.nbrows - 1 do
f (i, j)
done
done
let random_list_mines lc m =
let cell_list = ref [] in
while List.length !cell_list < m do
let n = Random.int lc in
if not (List.mem n !cell_list) then cell_list := n :: !cell_list
done;
!cell_list
let generate_seed () =
let t = Sys.time () in
let n = int_of_float (t *. 1000.0) in
Random.init (n mod 100000)
let valid cf (i, j) = i >= 0 && i < cf.nbcols && j >= 0 && j < cf.nbrows
let neighbours cf (x, y) =
let ngb =
[ x - 1, y - 1
; x - 1, y
; x - 1, y + 1
; x, y - 1
; x, y + 1
; x + 1, y - 1
; x + 1, y
; x + 1, y + 1
]
in
List.filter (valid cf) ngb
let initialize_board cf =
let cell_init () = { mined = false; seen = false; flag = false; nbm = 0 } in
let copy_cell_init b (i, j) = b.(i).(j) <- cell_init () in
let set_mined b n = b.(n / cf.nbrows).(n mod cf.nbrows).mined <- true in
let count_mined_adj b (i, j) =
let x = ref 0 in
let inc_if_mined (i, j) = if b.(i).(j).mined then incr x in
List.iter inc_if_mined (neighbours cf (i, j));
!x
in
let set_count b (i, j) =
if not b.(i).(j).mined then b.(i).(j).nbm <- count_mined_adj b (i, j)
in
let list_mined = random_list_mines (cf.nbcols * cf.nbrows) cf.nbmines in
let board = Array.make_matrix cf.nbcols cf.nbrows (cell_init ()) in
iter_on_cell cf (copy_cell_init board);
List.iter (set_mined board) list_mined;
iter_on_cell cf (set_count board);
board
let cells_to_see bd cf (i, j) =
let visited = Array.make_matrix cf.nbcols cf.nbrows false in
let rec relevant = function
| [] -> [], []
| ((x, y) as c) :: l ->
let cell = bd.(x).(y) in
if cell.mined || cell.flag || cell.seen || visited.(x).(y)
then relevant l
else
let l1, l2 = relevant l in
visited.(x).(y) <- true;
if cell.nbm = 0 then l1, c :: l2 else c :: l1, l2
in
let rec cells_to_see_rec = function
| [] -> []
| ((x, y) as c) :: l ->
if bd.(x).(y).nbm <> 0
then c :: cells_to_see_rec l
else
let l1, l2 = relevant (neighbours cf c) in
(c :: l1) @ cells_to_see_rec (l2 @ l)
in
visited.(i).(j) <- true;
cells_to_see_rec [ i, j ]
let b0 = 3
let l1 = 15
let l2 = l1
let l4 = 20 + (2 * b0)
let l3 = (l4 * default_config.nbcols) + (2 * b0)
let l5 = 40 + (2 * b0)
let h1 = l1
let h2 = 30
let h3 = l5 + 20 + (2 * b0)
let h4 = h2
let h5 = 20 + (2 * b0)
let h6 = l5 + (2 * b0)
type demin_cf =
{ bd : cell array array
; dom : Html.imageElement Js.t array array
; cf : config
; mutable nb_marked_cells : int
; mutable nb_hidden_cells : int
; mutable flag_switch_on : bool
}
let draw_cell dom bd =
dom##.src :=
js
(if bd.flag
then "sprites/flag.png"
else if bd.mined
then "sprites/bomb.png"
else if bd.seen
then
if bd.nbm = 0
then "sprites/empty.png"
else "sprites/" ^ string_of_int bd.nbm ^ ".png"
else "sprites/normal.png")
let draw_board d =
for y = 0 to d.cf.nbrows - 1 do
for x = 0 to d.cf.nbcols - 1 do
draw_cell d.dom.(y).(x) d.bd.(x).(y)
done
done
let disable_events d =
for y = 0 to d.cf.nbrows - 1 do
for x = 0 to d.cf.nbcols - 1 do
d.dom.(y).(x)##.onclick
:= Html.handler (fun _ ->
Html.window##alert (js "GAME OVER");
Js._false)
done
done
let mark_cell d i j =
if d.bd.(i).(j).flag
then (
d.nb_marked_cells <- d.nb_marked_cells - 1;
d.bd.(i).(j).flag <- false)
else (
d.nb_marked_cells <- d.nb_marked_cells + 1;
d.bd.(i).(j).flag <- true);
draw_cell d.dom.(j).(i) d.bd.(i).(j)
let reveal d i j =
let reveal_cell (i, j) =
d.bd.(i).(j).seen <- true;
draw_cell d.dom.(j).(i) d.bd.(i).(j);
d.nb_hidden_cells <- d.nb_hidden_cells - 1
in
List.iter reveal_cell (cells_to_see d.bd d.cf (i, j));
if d.nb_hidden_cells = 0
then (
draw_board d;
disable_events d;
Html.window##alert (js "YOU WIN"))
let create_demin nb_c nb_r nb_m =
let nbc = max default_config.nbcols nb_c and nbr = max default_config.nbrows nb_r in
let nbm = min (nbc * nbr) (max 1 nb_m) in
let cf = { nbcols = nbc; nbrows = nbr; nbmines = nbm } in
generate_seed ();
{ cf
; bd = initialize_board cf
; dom = Array.make nbr [||]
; nb_marked_cells = 0
; nb_hidden_cells = (cf.nbrows * cf.nbcols) - cf.nbmines
; flag_switch_on = false
}
type mode =
| Normal
| Flag
let init_table d board_div =
let mode = ref Normal in
let buf = document##createDocumentFragment in
Dom.appendChild buf (document##createTextNode (js "Mode : "));
let img = Html.createImg document in
Dom.appendChild buf img;
img##.src := js "sprites/bomb.png";
img##.onclick :=
Html.handler (fun _ ->
(match !mode with
| Normal ->
mode := Flag;
img##.src := js "sprites/flag.png"
| Flag ->
mode := Normal;
img##.src := js "sprites/bomb.png");
Js._false);
Dom.appendChild buf (Html.createBr document);
for y = 0 to d.cf.nbrows - 1 do
let imgs = ref [] in
for x = 0 to d.cf.nbcols - 1 do
let img = Html.createImg document in
imgs := img :: !imgs;
img##.src := js "sprites/normal.png";
img##.onclick :=
Html.handler (fun _ ->
(match !mode with
| Normal ->
if d.bd.(x).(y).seen
then ()
else if d.flag_switch_on
then mark_cell d x y
else if d.bd.(x).(y).flag
then ()
else if d.bd.(x).(y).mined
then (
draw_board d;
disable_events d;
Html.window##alert (js "YOU LOSE"))
else reveal d x y
| Flag ->
d.bd.(x).(y).flag <- not d.bd.(x).(y).flag;
draw_cell img d.bd.(x).(y));
Js._false);
Dom.appendChild buf img
done;
Dom.appendChild buf (Html.createBr document);
d.dom.(y) <- Array.of_list (List.rev !imgs)
done;
board_div##.style##.lineHeight := js "0";
Dom.appendChild board_div buf
let run div nbc nbr nbm =
let d = create_demin nbc nbr nbm in
init_table d div
|