-
Notifications
You must be signed in to change notification settings - Fork 1
/
view.ml
533 lines (500 loc) · 21.5 KB
/
view.ml
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
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
open Graphics
open Model
(* Variant that represents current state of board *)
type trig = AiThink | MoveInvalid | WallInvalid | Blank
type controller = Human | Ai
type player = { (* Represents a player character *)
cont: controller;
color: color;
mutable pos_x: int;
mutable pos_y: int;
}
(* Set up display *)
let graph = open_graph " 880x920"
let _ = auto_synchronize false
let _ = display_mode false
let _ = set_window_title "Quoridor"
(* Function that it utilized with rip and ripColorize to remove either the
height or width of an image for a pbm file and return it
Precondition: channel is currently at the start of either height or width
Postcondition: returns an int representing the height/width and returns
with channel 1 step after '\n' *)
let rec hwrip chan a =
match (input_char chan) with
|'\n' -> int_of_string(a)
| v -> hwrip chan (a^Char.escaped v)
(* Applies a mathematical piecewise function to simulate an overlay effect
of r/g/b channel representing c2 overlaying c1
Precondtion: c1 and c2 are numbers 0-255
Postcondition: Return new value of the effect of overlaying c2 onto c1
Adapted from:
http://www.deepskycolors.com/archive/2010/04/21/formulas-for-Photoshop-blending-modes.html
for 0-255 numbers instead of 0-1*)
let overlay (c1:int) (c2:int) =
if c1 < 128
then int_of_float(float_of_int((c1*c2))/.127.5)
else 255 - int_of_float(float_of_int((255-c1)*(255-c2))/.127.5)
(* Takes in a string for a .pbm file and returns a color array array that
represents the image
Precondition: name is a name.pbm file that exists in standard format of .pbm
Postcondition: returns color array array matching image based on color spec
from graphics library. All "255/0/255" colors are transformed
into a transparent color *)
let rip (name:string) =
let file = name^".pbm" in
let ic = open_in file in
for i = 0 to 2 do (* Rip PBM header *)
ignore(input_char ic);
done;
let w = hwrip ic "" in
let h = hwrip ic "" in
for i = 0 to 3 do (* Rip color header *)
ignore(input_char ic);
done;
let z = Array.make_matrix h w white in
for i = 0 to (h - 1) do
for j = 0 to (w - 1) do
let r = int_of_char(input_char ic) in
let g = int_of_char(input_char ic) in
let b = int_of_char(input_char ic) in
let rgbColor = rgb r g b in
z.(i).(j) <- if rgbColor = 16711935 then (-1) else rgbColor;
done;
done;
close_in ic;
z
(* Takes in a string for a .pbm file and returns a color array array that
represents the image with an overlay of col
Precondition: name is a name.pbm file that exists in standard format of .pbm
and col is a color
Postcondition: returns color array array matching image based on an overlay
effect of col onto the image, based on color spec from
graphics library. All "255/0/255" colors are transformed into
a transparent color) *)
let ripColorize (name:string) (col:color) =
let bb1 = col mod 16 in
let bb2 = (col/16) mod 16 in
let gb1 = (col/256) mod 16 in
let gb2 = (col/4096) mod 16 in
let rb1 = (col/65536) mod 16 in
let rb2 = (col/1048576) mod 16 in
let blue = (bb1*16) + bb2 in
let green = (gb1*16) + gb2 in
let red = (rb1*16) + rb2 in
let file = name^".pbm" in
let ic = open_in file in
for i = 0 to 2 do (* Rip PBM header *)
ignore(input_char ic);
done;
let w = hwrip ic "" in
let h = hwrip ic "" in
for i = 0 to 3 do (* Rip color header *)
ignore(input_char ic);
done;
let z = Array.make_matrix h w white in
for i = 0 to (h - 1) do
for j = 0 to (w - 1) do
let r = int_of_char(input_char ic) in
let g = int_of_char(input_char ic) in
let b = int_of_char(input_char ic) in
let rgbColor = rgb r g b in
let r2 = overlay r red in
let g2 = overlay g green in
let b2 = overlay b blue in
let rgbColor2 = rgb r2 g2 b2 in
z.(i).(j) <- if rgbColor = 16711935 then (-1) else rgbColor2;
done;
done;
close_in ic;
z
(* Set up images based on above specifications*)
let wallH = make_image (rip "images/WallH") (* Horizontal Wall *)
let wallV = make_image (rip "images/WallV") (* Vertical Wall *)
let wallC = make_image (rip "images/WallC") (* Central Wall *)
let boardImg = make_image (rip "images/board") (* Main board *)
let pawnCover = make_image (rip "images/pawnCover") (* Pawn Cover *)
let ban1 = make_image (rip "images/player1") (* Banner player 1:no color *)
let ban2 = make_image (rip "images/player2") (* Banner player 2:no color *)
let banner = make_image (rip "images/banner") (* Banner base *)
let bannerAi = make_image (rip "images/bannerAi") (* Banner AI move *)
let bannerMove = make_image (rip "images/bannerMove") (* Banner invalid move *)
let bannerWall = make_image (rip "images/bannerWall") (* Banner invalid wall *)
let playerMenu = make_image (rip "images/player") (* Player customization img *)
let win = make_image (rip "images/win") (* Win overlay *)
let win1temp = make_image (rip "images/play1Win") (* Winner player 1:no color *)
let win2temp = make_image (rip "images/play2Win") (* Winner player 2:no color *)
let huHi = make_image (rip "images/human") (* Highlight Human player *)
let aiHi = make_image (rip "images/ai") (* Highlight AI player *)
let colorWheel = make_image (rip "images/colorwheel") (* Color Wheel *)
let howTo = make_image (rip "images/howTo") (* How to play Image *)
let menu = make_image (rip "images/menu") (* Main menu Image *)
let img0 = make_image (rip "images/0") (* '0' for walls *)
let img1 = make_image (rip "images/1") (* '1' for walls *)
let img2 = make_image (rip "images/2") (* '2' for walls *)
let img3 = make_image (rip "images/3") (* '3' for walls *)
let img4 = make_image (rip "images/4") (* '4' for walls *)
let img5 = make_image (rip "images/5") (* '5' for walls *)
let img6 = make_image (rip "images/6") (* '6' for walls *)
let img7 = make_image (rip "images/7") (* '7' for walls *)
let img8 = make_image (rip "images/8") (* '8' for walls *)
let img9 = make_image (rip "images/9") (* '9' for walls *)
let img10 = make_image (rip "images/10") (* '10' for walls *)
let enumImg = [img0;img1;img2;img3;img4;img5;img6;img7;img8;img9;img10]
(* Enum for the numbe of walls images *)
(* Set up defaults for view *)
let save = ref (create_board 9)
let button = ref false (* Monitor button status between windows *)
let instance = ref Blank (* Current board action state *)
let play1ban = ref ban1 (* Banner for player 1 *)
let play2ban = ref ban2 (* Banner for player 2 *)
let win1 = ref win1temp (* Winner display player 1 *)
let win2 = ref win2temp (* Winner display player 2 *)
(* Convert an array y marking to pixel coordinate *)
let yf z =
let inv1 = (16 - z)/2 in
let inv = if (16 - z) = -1 then -1 else inv1 in (* compensate for '/' spec *)
match z mod 2 with
| 0 -> inv*100
| _ -> inv*100 + 80
(* Convert an array x marking to pixel coordinates *)
let xf z =
let inv = z/2 in
match z mod 2 with
| 0 -> inv*100
| _ -> inv*100 + 80
(* draw a player's circle and their pawn cover *)
let draw_player player =
set_color (player.color);
fill_circle ((xf player.pos_x) + 40) ((yf player.pos_y) + 40) 30;
draw_image pawnCover (xf player.pos_x) (yf player.pos_y)
(* draw walls based on save ref *)
let draw_walls () =
let board = (!save).board in
for i = 0 to 16 do
if i mod 2 = 0 then
for j = 0 to 7 do
match board.(i).(j*2 + 1) with
| Wall -> draw_image wallV (xf (j*2 + 1)) (yf i) (* Vertical walls *)
| _ -> ()
done
else
for j = 0 to 16 do
match board.(i).(j) with
| Wall -> (match j mod 2 with
| 0 -> draw_image wallH (xf j) (yf i) (*Horizontal walls*)
| _ -> draw_image wallC (xf j) (yf i)) (* Central walls *)
| _ -> ()
done
done
(* draw a ghost wall for the player to see a possible wall on placement, based
upon how a wall would normally be represented in save *)
let rec draw_ghost (walls:loc list) =
set_color (rgb 158 132 101);
match walls with
| [] -> ()
| (y, x)::t -> match y mod 2 with
| 0 -> fill_rect (xf x) (yf y) 20 80; draw_ghost t
| _ -> match x mod 2 with
| 0 -> fill_rect (xf x) (yf y) 80 20; draw_ghost t
| _ -> fill_rect (xf x) (yf y) 20 20; draw_ghost t
(* Main draw function: ghosts are the walls that are supposed to be draw as a
ghost
players is a list of the players in the game
play is an index for one of the players in players
Clears graph and then draws board, players, walls, ghosts, the banner,
current player and player's number of walls, and synchronizes the image
in that order*)
let draw ghosts players play =
clear_graph graph;
draw_image boardImg 0 0;
for i = 0 to ((List.length players) - 1) do
draw_player (List.nth players i)
done;
draw_walls ();
draw_ghost ghosts;
(match !instance with
| WallInvalid -> draw_image bannerWall 0 880
| AiThink -> draw_image bannerAi 0 880
| MoveInvalid -> draw_image bannerMove 0 880
| Blank -> draw_image banner 0 880);
(match play with
| 0 -> draw_image (!play1ban) 100 887
| _ -> draw_image (!play2ban) 100 887);
let num = (snd ((!save).players.(play))) in
draw_image (List.nth enumImg num) 500 894;
synchronize graph
(* Draws main menu screen*)
let rec drawMenu () =
clear_graph graph;
draw_image menu 0 0;
synchronize graph
(* Draws How to Play screen*)
and drawHow () =
clear_graph graph;
draw_image howTo 0 0;
synchronize graph
(* Draws the player customization screen,
c1 and c2 reprsent the controller of player 1 and player 2 respectively,
c and c' represent the colors (based on graphics color spec) of player 1
and play 2 respectively,
cw is a boolean that indicates whether or not the color wheel should be
drawn *)
and drawPlayer (c1:controller) (c2:controller) (c:color) (c':color) (cw:bool) =
clear_graph graph;
draw_image playerMenu 0 0;
(match c1 with
| Human -> draw_image huHi 357 717
| Ai -> draw_image aiHi 692 705);
(match c2 with
| Human -> draw_image huHi 368 440
| Ai -> draw_image aiHi 703 427);
set_color c;
fill_rect 440 575 122 123;
set_color c';
fill_rect 440 299 122 122;
(if cw then draw_image colorWheel 200 220 else ());
synchronize graph
(* Iterates to next player, maintaining that player is always an index of
players *)
and next_player players player =
let num = List.length players in
(player + 1) mod num
(* Checks if either player is in a location of their "winning line", returning
true or false, and then the index of the player that won *)
and checkWin players =
if (List.nth players 0).pos_y = 16 then (true, 0) else
if (List.nth players 1).pos_y = 0 then (true, 1) else
(false, 3)
(* Event handler for the win screen, directs to either
player customization screen or closes game *)
and waitWin () =
let event = try wait_next_event [Poll] with
Graphic_failure _ -> (close_graph graph; exit 0) in
if (event.button && not(!button)) then
let posx = event.mouse_x in
let posy = event.mouse_y in
if (posx >= 220 && posx <= 420 && posy >= 340 && posy <= 420) then
playerInit () (* Player customization *)
else if (posx >= 460 && posx <= 660 && posy >= 340 && posy <= 420) then
ignore(clear_graph graph; exit 0) (* Exit *)
else
button := event.button; waitWin ()
else
button := event.button; waitWin ()
(* Draws the win overlay, indicating who has won *)
and drawWin play =
draw_image win 0 0;
(match play with
| 0 -> draw_image (!win1) 252 467
| _ -> draw_image (!win2) 252 467);
synchronize graph; button := true; waitWin ()
(* Event handler Main game loop
Players: list of all the players
cur_player: index of who's action it currently is *)
and loop (players:player list) (cur_player:int) =
let win = checkWin players in (* Check if someone has won *)
(if (fst win) then drawWin (snd win) else ()); (*If win, then do win actions*)
if (List.nth players cur_player).cont = Human then (* Check if human or ai *)
let event = try wait_next_event [Poll] with
Graphic_failure _ -> (close_graph graph; exit 0)in
let new_player =
if (event.key = '\027') then (close_graph graph; exit 0)
else if event.button && not(!button) then (* Check for button press *)
let modx = event.mouse_x mod 100 in
let mody = event.mouse_y mod 100 in
let my = abs(16 - ((event.mouse_y / 100) * 2)) -
if mody >= 80 then 1 else 0 in
let mx = (event.mouse_x / 100) * 2 + if modx >= 80 then 1 else 0 in
if(modx < 80 && mody < 80) then (* Check if move or wallPlace *)
let mv = validate_move cur_player (Move(my,mx)) (!save) in
if mv then (* Accept move *)
let () = commit_move cur_player (Move(my,mx)) (!save) in
let play = List.nth players cur_player in
play.pos_x <- mx; play.pos_y <- my;
let next = next_player players cur_player in
instance := Blank; draw [] players next; next
else (* Decline move attempt *)
let _ = instance := MoveInvalid; draw [] players cur_player in
cur_player
else
let accept = (* Check for a wall placement *)
if (mody >= 80 && modx >= 80) then false
else if (mody <= 50 && modx > 80) then (* Down *)
let l = [(my, mx);(my+1, mx);(my+2, mx)] in
let mv = validate_move cur_player (PlaceWall(l)) (!save) in
if mv then
let () = commit_move cur_player (PlaceWall(l)) (!save) in
true
else false
else if (modx <= 50 && mody > 80) then (* Left *)
let l = [(my, mx);(my, mx-1);(my, mx-2)] in
let mv = validate_move cur_player (PlaceWall(l)) (!save) in
if mv then
let () = commit_move cur_player (PlaceWall(l)) (!save) in
true
else false
else if (modx > 80 && mody > 50) then (* Up *)
let l = [(my, mx);(my-1, mx);(my-2, mx)] in
let mv = validate_move cur_player (PlaceWall(l)) (!save) in
if mv then
let () = commit_move cur_player (PlaceWall(l)) (!save) in
true
else false
else if (mody > 80 && modx > 50) then (* Right *)
let l = [(my, mx);(my, mx+1);(my, mx+2)] in
let mv = validate_move cur_player (PlaceWall(l)) (!save) in
if mv then
let () = commit_move cur_player (PlaceWall(l)) (!save) in
true
else false
else false
in
if accept (* If accept wall placement *)
then
let next = next_player players cur_player in
instance := Blank;
draw [] players next; next
else (* If deny wall placement *)
let _ = instance := WallInvalid; draw [] players cur_player in
cur_player
else (* Check for a ghost wall display *)
let modx = event.mouse_x mod 100 in
let mody = event.mouse_y mod 100 in
let my = abs(16 - ((event.mouse_y / 100) * 2)) -
if mody >= 80 then 1 else 0 in
let mx = (event.mouse_x / 100) * 2 + if modx >= 80 then 1 else 0 in
let ghosts =
if (mody >= 80 && modx >= 80) then [] (* center square to deny *)
else if (mody <= 50 && modx > 80) then (* Down *)
[(my, mx);(my+1, mx);(my+2, mx)]
else if (modx <= 50 && mody > 80) then (* Left *)
[(my, mx);(my, mx-1);(my, mx-2)]
else if (modx > 80 && mody > 50) then (* Up *)
[(my, mx);(my-1, mx);(my-2, mx)]
else if (mody > 80 && modx > 50) then (* Right *)
[(my, mx);(my, mx+1);(my, mx+2)]
else [] (* Not a wall location *)
in
draw ghosts players cur_player; cur_player (* Display wall *)
in
let _ = button := event.button in
loop players new_player
else (* AI turn, ask model AI for a next move *)
let next = next_player players cur_player in
instance := AiThink; draw [] players cur_player;
let () = commit_move cur_player (Ai.next_move !save cur_player) !save in
let play = List.nth players cur_player in
play.pos_x <- (snd (fst (!save).players.(cur_player)));
play.pos_y <- (fst (fst (!save).players.(cur_player)));
instance := Blank; draw [] players next; loop players next
(* Sets up players and initializes the game loop
c1 and c2 are the controllers of player 1 and player 2 respectively,
c and c' are the colors of player 1 and player 2 respectively *)
and players (c1:controller) (c2:controller) (c:color) (c':color) =
button := true;
play1ban := (make_image (ripColorize "images/player1" c)); (* colorizations *)
play2ban := (make_image (ripColorize "images/player2" c'));
win1 := (make_image (ripColorize "images/play1Win" c));
win2 := (make_image (ripColorize "images/play2Win" c'));
let pl_1 =
{cont = c1; color = c; pos_x = 8; pos_y = 0} in
let pl_2 =
{cont = c2; color = c'; pos_x = 8; pos_y = 16} in
loop [pl_1;pl_2] (Random.int 2) (* Random starting player *)
(* Event handler for instructions menu *)
and howToPlayLoop () =
let event = try wait_next_event [Poll] with
Graphic_failure _ -> (close_graph graph; exit 0) in
if (event.key = '\027') then ignore(close_graph graph; exit 0) else
if (event.button && not(!button)) then
let posx = event.mouse_x in
let posy = event.mouse_y in
if (posy <= 160) then
if (posx <= 220) then
menuInit () (* Main Menu *)
else if (posx >= 660) then
playerInit () (* Player customization *)
else
howToPlayLoop ()
else
howToPlayLoop ()
else button := event.button; howToPlayLoop ()
(* Initializes instructions Loop *)
and howToPlayLoopInit () =
button := true; drawHow (); howToPlayLoop ()
(* Event handler for the main menu *)
and menuLoop () =
let event = try wait_next_event [Poll] with
Graphic_failure _ -> (close_graph graph; exit 0) in
if (event.key = '\027') then ignore(close_graph graph; exit 0) else
if (event.button && not(!button)) then
let posx = event.mouse_x in
let posy = event.mouse_y in
if (posy >= 145 && posy <= 340) then
if (posx >= 97 && posx <= 422) then
playerInit () (* Player customization *)
else if (posx >= 470 && posx <= 784) then
howToPlayLoopInit () (* How to play *)
else
menuLoop ()
else
menuLoop ()
else button := event.button; menuLoop ()
(* Initilization for menu loop *)
and menuInit () = button := true; drawMenu (); menuLoop ()
(* Initilization for player customzation loop *)
and playerInit () =
button := true; drawPlayer Human Human red green false;
save := (create_board 9); playerLoop Human Human red green false 0
(* Handler for player customization
c1 and c2 are the controller types for player 1 and player 2 respectively,
c and c' are the colors for player 1 and player 2 respectively
cw is a boolean indicating whether the color wheel is open or not
id is the index of player that the color wheel applies to
*Only matter if cw is true, otherwise it is not used* *)
and playerLoop
(c1:controller) (c2:controller) (c:color) (c':color) (cw:bool) (id:int) =
drawPlayer c1 c2 c c' cw;
let event = try wait_next_event [Poll] with
Graphic_failure _ -> (close_graph graph; exit 0) in
if (event.key = '\027') then ignore(close_graph graph; exit 0) else
if cw then (* Check if color wheel open *)
if (event.button && not(!button)) then
let posx = event.mouse_x in
let posy = event.mouse_y in
if ((abs(posx - 440) * abs(posx - 440) +
abs(posy - 460) * abs(posy - 460)) < 50625) then
let col = point_color posx posy in
match id with (* Set picke color to id player *)
| 0 -> (button := true; playerLoop c1 c2 col c' false 0)
| _ -> (button := true; playerLoop c1 c2 c col false 1)
else
playerLoop c1 c2 c c' cw id
else
(button := event.button; playerLoop c1 c2 c c' cw id)
else if (event.button && not(!button)) then (* Check for mouse button *)
let posx = event.mouse_x in
let posy = event.mouse_y in
if (posy <= 100) then
if (posx <= 200) then
menuInit () (* Main menu *)
else if (posx >= 700) then
players c1 c2 c c' (* Play game *)
else
playerLoop c1 c2 c c' cw id
else if (posy >= 710 && posy <= 775 && posx >= 358 && posx <= 590) then
playerLoop Human c2 c c' cw id (* Set c1 to Human *)
else if (posy >= 692 && posy <= 772 && posx >= 694 && posx <= 782) then
playerLoop Ai c2 c c' cw id (* Set c1 to AI *)
else if (posy >= 430 && posy <= 498 && posx >= 368 && posx <= 597) then
playerLoop c1 Human c c' cw id (* Set c2 to Human *)
else if (posy >= 415 && posy <= 496 && posx >= 704 && posx <= 793) then
playerLoop c1 Ai c c' cw id (* Set c2 to AI *)
else if (posy >= 574 && posy <= 702 && posx >= 436 && posx <= 565) then
(button := true; playerLoop c1 c2 c c' true 0) (* Open CW for player 1 *)
else if (posy >= 294 && posy <= 426 && posx >= 436 && posx <= 565) then
(button := true; playerLoop c1 c2 c c' true 1) (* Open CW for player 2 *)
else playerLoop c1 c2 c c' cw id
else button := event.button; playerLoop c1 c2 c c' cw id
(* Begins the program at the main menu*)
let _ = menuInit ()