Anonymous avatar Anonymous committed 3d5ec7d

first playable memory

Comments (0)

Files changed (2)

 sdlmaze:
 	ocamlbuild -I maze ${SDL_OPTS} sdlmaze.native
 
-memory:
+sdlmemory:
 	ocamlbuild -I memory ${SDL_OPTS} memory.native
 
 sdlmills:
-
 module Image = struct
   open Sdlvideo
   open Sdlloader
     for i = 0 to (Array.length images -1) do
       images.(i) <- Some (load_image ("data/memory/" ^ string_of_int i ^ ".png"))
     done
-    
+  
   let blit dst dst_rect img = match img with
     | None -> failwith "image not initialized"
     | Some image ->
         Sdlvideo.blit_surface ~dst_rect: dst_rect ~src: image ~dst: dst ()
-   
+  
   let draw_img screen x y img =
     let open Sdlvideo in
     let fullrect = rect x y imgsize imgsize in
     blit screen fullrect img;
-    update_rect ~rect: fullrect screen  
+    update_rect ~rect: fullrect screen
 end
 
-let select_video_mode () =
-  let open Sdlvideo in 
-  let flags = [`FULLSCREEN;`HWSURFACE] in
-  let bpp = 32 in
-  let rec first_available = function
-    | [] -> failwith "no available mode"
-    | (w,h)::list -> 
-      let bpp' = video_mode_ok w h bpp flags in
-      if bpp' = bpp then (w, h, bpp)
-      else first_available list
-  in  
-  first_available [(1440,900);(1024,768)]
+let layout = function
+  | 4 -> [2; 2]
+  | 6 -> [3; 3]
+  | 8 -> [4; 4]
+  | 10 -> [3; 4; 3]
+  | 12 -> [4; 4; 4]
+  | 14 -> [5; 4; 5]
+  | 16 -> [4; 4; 4; 4]
+  | 18 -> [4; 5; 5; 4]
+  | 20 -> [5; 5; 5; 5]
+  | 22 -> [5; 6; 6; 5]
+  | 24 -> [6; 6; 6; 6]
+  | _ -> invalid_arg "wrong card number"
 
-              
+let positions width height cards =
+  let open Image in
+  let line_height lines =
+    let whitespace = height - lines * imgsize in
+    (whitespace / (lines +1)) + imgsize
+  in
+  let col_width cols =
+    let whitespace = width - cols * imgsize in
+    (whitespace / (cols +1)) + imgsize
+  in
+  let list = ref [] in
+  let line_h = line_height (List.length cards) in
+  for line = (List.length cards) - 1 downto 0 do
+    let count = List.nth cards line in
+    let col_w = col_width count in
+    for col = count - 1 downto 0 do
+      let x = (col_w - imgsize) + col * col_w
+      and y = (line_h - imgsize) + line * line_h in
+      list := (x, y) :: !list
+    done
+  done;
+  !list
+
+let make_deck size =
+  let max = Array.length Image.images in
+  let shuffle lst = List.sort (fun a b -> (Random.int 3) - 1) lst in
+  let rec select_pairs acc = function
+    | 0 -> acc
+    | x ->
+        let rnd = Random.int max in
+        if List.mem rnd acc then select_pairs acc x
+        else select_pairs (rnd :: rnd :: acc) (pred x)
+  in
+  let cards = select_pairs [] (size /2) in
+  shuffle cards
+
+type card = {
+  img: int;
+  x: int;
+  y: int;
+}
+
+let get_cards width height count =
+  let deck = make_deck count in
+  let positions = positions width height (layout count) in
+  let make_card img (x, y) = { img = img; x = x; y = y } in
+  List.map2 make_card deck positions
+
+module Game = struct
+  open Sdlevent
+  open Sdlkey
+  
+  let rec wait_some_click () =
+    match wait_event() with
+    | QUIT -> raise Exit
+    | KEYDOWN { keysym = KEY_ESCAPE } -> raise Exit
+    | MOUSEBUTTONDOWN _ -> ()
+    | _ -> wait_some_click ()
+  
+  let rec select_card cards =
+    let rec find_card x y = function
+      | [] -> None
+      | card:: list ->
+          if card.x <= x && card.y <= y
+          && card.x + Image.imgsize >= x && card.y + Image.imgsize >= y
+          then Some card
+          else find_card x y list
+    in
+    match wait_event() with
+    | QUIT -> raise Exit
+    | KEYDOWN { keysym = KEY_ESCAPE } -> raise Exit
+    | MOUSEBUTTONDOWN event ->
+        let x, y = event.mbe_x, event.mbe_y in
+        begin match find_card x y cards with
+          | Some (card) -> card
+          | None -> select_card cards
+        end
+    | _ -> select_card cards
+  
+  let rec play screen cards =
+    let show_backgrounds () =
+      let white = Sdlvideo.map_RGB screen Sdlvideo.white in
+      Sdlvideo.fill_rect screen white;
+      List.iter (fun c -> Image.draw_img screen c.x c.y !Image.background) cards;
+      Sdlvideo.flip screen
+    and show_card c =
+      Image.draw_img screen c.x c.y Image.images.(c.img);
+      Sdlvideo.flip screen
+    in
+    match cards with
+    | [] -> () (* victory *)
+    | _ ->
+        show_backgrounds ();
+        let first = select_card cards in
+        show_card first;
+        let second = select_card cards in
+        show_card second;
+        let remaining = 
+          if first.img <> second.img then cards
+          else List.filter (fun c -> c.img <> first.img) cards
+        in
+        Sdltimer.delay 1500; 
+        play screen remaining
+end
 
 let _ =
+  Random.self_init();
   Sdl.init [`VIDEO; `AUDIO];
   at_exit Sdl.quit;
   Sdlmixer.open_audio ();
   at_exit Sdlmixer.close_audio;
   
-  Sdlkey.enable_key_repeat ();
-  Sdlwm.set_caption "maze minigame" "";
-  let w, h, bpp = select_video_mode () in
-  Printf.printf "mode: %d %d %d\n%!" w h bpp;
-  let screen = Sdlvideo.set_video_mode ~w:w ~h:h ~bpp:bpp [`FULLSCREEN;`HWSURFACE] in
-  let playground = Sdlvideo.create_RGB_surface_format screen [`HWSURFACE] 1024 768 in
-  let screenrect = Sdlvideo.rect ((w-1024)/2) ((h-768)/2) 1024 768 in
-  let white = Sdlvideo.map_RGB playground Sdlvideo.white in
+  Sdlwm.set_caption "memory minigame" "";
+  
+  let width, height = 1024, 768 in
+  let screen = Sdlvideo.set_video_mode ~w: width ~h: height [`HWSURFACE;`DOUBLEBUF] in
   
   Image.load ();
-  
-  Sdlvideo.fill_rect playground white;
-  for i = 0 to 7 do
-    for j = 0 to 3 do
-      Image.draw_img playground (50 + i*160) (80 + j*160) Image.images.((j*6 + i) mod 12);
-  (*    Image.draw_img playground (50 + i*160) (80 + j*160) !Image.background *)
-    done
-  done;
-
-  Sdlvideo.blit_surface ~src:playground ~dst:screen ~dst_rect:screenrect ();
-  Sdlvideo.flip screen;
-  Sdltimer.delay 5000
+  let count = 10 in
+  let cards = get_cards width height count in
+  try
+    Game.play screen cards
+  with Exit -> ()
Tip: Filter by directory path e.g. /media app.js to search for public/media/app.js.
Tip: Use camelCasing e.g. ProjME to search for ProjectModifiedEvent.java.
Tip: Filter by extension type e.g. /repo .js to search for all .js files in the /repo directory.
Tip: Separate your search with spaces e.g. /ssh pom.xml to search for src/ssh/pom.xml.
Tip: Use ↑ and ↓ arrow keys to navigate and return to view the file.
Tip: You can also navigate files with Ctrl+j (next) and Ctrl+k (previous) and view the file with Ctrl+o.
Tip: You can also navigate files with Alt+j (next) and Alt+k (previous) and view the file with Alt+o.