Commits

Kenji TOKUDOME committed 7b52b93

init.

Comments (0)

Files changed (4)

+.PHONY: all install clean
+
+USE_OCAMLFIND = true
+
+FILES[] =
+	game
+
+PROGRAM = testcase
+
+OCAMLPACKS[] += lwt js_of_ocaml js_of_ocaml.deriving
+# OCAMLPACKS[] += pcre batteries cryptokit
+# OCAMLFLAGS += -thread
+
+# ignore the warning.
+OCAMLFLAGS[] += -w ae
+
+OCAML_LIBS += 
+OCAML_CLIBS +=
+OCAML_OTHER_LIBS +=
+OCAML_LIB_FLAGS +=
+
+OCAMLDEPFLAGS= -syntax camlp4o -package lwt,js_of_ocaml.syntax,js_of_ocaml.deriving.syntax
+OCAMLPPFLAGS= -syntax camlp4o -package lwt,js_of_ocaml.syntax,js_of_ocaml.deriving.syntax
+# public.OCAML_BYTE_LINK_FLAGS = -linkpkg # removes -custom
+
+BYTE_ENABLED = true
+NATIVE_ENABLED = false
+
+clean:
+	rm -f *~ $(PROGRAM) *.run *.opt *.cmi *.cmo *.cmx *.o *.omc *.cmt *.cmti *.annot
+
+.DEFAULT: $(OCamlProgram $(PROGRAM), $(FILES))
+	js_of_ocaml ./$(PROGRAM)
+
+########################################################################
+# Permission is hereby granted, free of charge, to any person
+# obtaining a copy of this file, to deal in the File without
+# restriction, including without limitation the rights to use,
+# copy, modify, merge, publish, distribute, sublicense, and/or
+# sell copies of the File, and to permit persons to whom the
+# File is furnished to do so, subject to the following condition:
+#
+# THE FILE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+# EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES
+# OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
+# IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM,
+# DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR
+# OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE FILE OR
+# THE USE OR OTHER DEALINGS IN THE FILE.
+
+########################################################################
+# The standard OMakeroot file.
+# You will not normally need to modify this file.
+# By default, your changes should be placed in the
+# OMakefile in this directory.
+#
+# If you decide to modify this file, note that it uses exactly
+# the same syntax as the OMakefile.
+#
+
+#
+# Include the standard installed configuration files.
+# Any of these can be deleted if you are not using them,
+# but you probably want to keep the Common file.
+#
+open build/C
+open build/OCaml
+open build/LaTeX
+
+#
+# The command-line variables are defined *after* the
+# standard configuration has been loaded.
+#
+DefineCommandVars()
+
+#
+# Include the OMakefile in this directory.
+#
+.SUBDIRS: .
+(* see alse
+ * http://d.hatena.ne.jp/sunflat/20110305/p1 
+ * http://www2.sunflat.net/files/ocamljs_game1/game1.html *)
+
+let debug f = Printf.ksprintf (fun s -> Firebug.console##log(Js.string s)) f
+let (@@) f x = f x
+let ($) g f = fun x -> g (f x)
+let id x = x
+let tee f x = ignore @@ f x; x
+let (|>) x f = f x
+
+let fint = float_of_int
+let sint = string_of_int
+
+type pos_t = {
+  x : int;
+  y : int;
+}
+
+type gameState = GameInit | GameMain | GameOver
+
+type gameObject =
+| Ship of pos_t
+| Bullet of pos_t
+| Enemy of pos_t
+
+type gameVariable = {
+  canvas : Dom_html.canvasElement Js.t;
+  os : gameObject list;
+  cleft: int;
+  ctop: int;
+  cwidth: int;
+  cheight: int;
+  score : int;
+  mouse : pos_t;
+  mousePressed : bool;
+  state : gameState;
+}
+
+let bulletSpeed g = 5
+
+let enemySpeed g = 1+(g.score / 5)
+
+let getPos = function
+  | Ship pos
+  | Bullet pos
+  | Enemy pos -> pos
+
+let getSize = function
+  | Ship _      -> {x=16; y=16}
+  | Bullet _    -> {x=4; y=4}
+  | Enemy _     -> {x=8; y=8}
+
+let getShip g =
+  let f = function
+    | Ship _ -> true
+    | _ -> false
+  in
+  List.find f g.os
+
+let moveObject g obj =
+  match obj with
+  | Bullet pos -> 
+      Bullet { pos with y = pos.y - (bulletSpeed g) }
+  | Enemy pos ->
+      Enemy { pos with y = pos.y + (enemySpeed g) }
+  | Ship _ ->
+      let {x=sx; y=sy} = getSize obj in
+      Ship {x=min (max g.mouse.x sx) (g.cwidth-sx);
+            y=min (max g.mouse.y sy) (g.cheight-sy) }
+
+let drawObject g ctx obj =
+  match obj with
+  | Bullet pos -> 
+      ctx##fillStyle <- Js.string "rgb(255,255,0)";
+      ctx##fillRect (fint (pos.x - 4), fint (pos.y - 4), 8., 8.)
+  | Enemy pos ->
+      ctx##fillStyle <- Js.string "rgb(0,255,255)";
+      ctx##fillRect (fint (pos.x - 8), fint (pos.y - 8), 16., 16.)
+  | Ship pos ->
+      ctx##fillStyle <- 
+      if g.state <> GameOver then
+        Js.string "rgb(0,255,0)"
+      else
+        Js.string "rgb(255,128,0)";
+      ctx##fillRect (fint (pos.x - 16), fint (pos.y - 16), 32., 32.)
+
+let gcObject g =
+  let check = function
+    | Bullet pos -> pos.y > -4
+    | Enemy pos -> pos.y < (g.cheight + 16)
+    | _ -> true
+  in
+  let os' = List.filter check g.os in
+  { g with os = os' }
+
+let newBullet g =
+  let ship_pos = getPos (getShip g) in
+  Bullet {x=ship_pos.x; y=ship_pos.y}
+
+let newEnemy g =
+  Enemy {x=Random.int g.cwidth; y=(-16)}
+
+let hit src tgt =
+  let {x=aX; y=aY}, {x=bX; y=bY} = getPos src, getPos tgt in
+  let {x=aW; y=aH}, {x=bW; y=bH} = getSize src, getSize tgt in
+  abs (aX-bX) < aW+bW && abs (aY-bY) < aH+bH
+
+let collide g =
+  let score = ref g.score in
+  let gameover = ref false in
+  let affect src tgt =
+    match src, tgt with
+    | Bullet _, Enemy pos ->
+        score := !score + 1;
+        (* delete the enemy *)
+        Enemy {pos with y=g.cheight + 100}
+    | Enemy _, Bullet pos ->
+        (* delete the bullet *)
+        Bullet {pos with y=(-100)}
+    | Ship _, Enemy _
+    | Enemy _, Ship _ ->
+        gameover := true;
+        tgt
+    | _, _ -> tgt
+  in
+  let check obj =
+    let f tgt src = 
+      if hit src tgt then affect src tgt
+      else tgt
+    in
+    List.fold_left f obj g.os
+  in
+  let os' = List.map check g.os in
+  { g with os = os'; score = !score;
+           state = if !gameover then GameOver else g.state }
+
+let update g =
+  match g.state with
+  |GameInit -> 
+      (* move object *)
+      let g = {g with os = List.map (moveObject g) g.os} in
+      (* click to start *)
+      if g.mousePressed then
+        {g with state = GameMain; mousePressed = false }
+      else
+        g
+  |GameMain ->
+      (* shoot *)
+      let g = 
+        if g.mousePressed then 
+          {g with os = newBullet g :: g.os; mousePressed = false}
+        else
+          g
+      in
+      (* update enemies *)
+      let g = 
+        if (Random.int (30 / (enemySpeed g))) == 0 then 
+          {g with os = newEnemy g :: g.os}
+        else
+          g
+      in
+      (* move object *)
+      let g = {g with os = List.map (moveObject g) g.os} in
+      (* collision detection *)
+      let g = collide g in
+      (* delete unnecessary objects *)
+      gcObject g
+  |GameOver -> g
+
+let draw g =
+  let ctx = g.canvas##getContext (Dom_html._2d_) in
+  (* draw the background *)
+  (match g.state with
+   |GameInit |GameMain ->
+       ctx##fillStyle <- Js.string "#000000"
+   |GameOver ->
+       ctx##fillStyle <- Js.string "#FF0000" );
+  ctx##fillRect (0., 0., (fint g.cwidth), (fint g.cheight));
+  (* draw objects *)
+  List.iter (drawObject g ctx) g.os ;
+  (* draw text *)
+  ctx##font <- Js.string "20pt Arial";
+  ctx##fillStyle <- Js.string "#FFFFFF";
+  ctx##fillText (Js.string @@ string_of_int g.score, 10., 30.);
+  (* ctx##fillText (Js.string @@ string_of_int @@ List.length g.os, 10., 60.); *)
+  match g.state with
+  |GameInit ->
+      ctx##fillText (Js.string "Click to Start", 150., 200.)
+  |GameMain ->
+      ()
+  |GameOver ->
+      ctx##fillText (Js.string "Reload the page to restart", 100., 200.)
+
+let onMouseDown rg ev =
+  let pressed = (Dom_html.buttonPressed ev) = Dom_html.Left_button in
+  let gv = {!rg with mousePressed = pressed } in
+  rg := gv;
+  Js._false
+
+let onMouseMove rg ev =
+  let mx, my = Dom_html.eventAbsolutePosition ev in
+  let gv = {!rg with mouse = {x=mx; y=my}; } in
+  rg := gv;
+  Js._false
+
+let onInterval rgv _ =
+  let gv = update !rgv in
+  let gv = update gv in
+  draw gv;
+  rgv := gv
+
+let create_canvas () =
+  let d = Dom_html.window##document in
+  let c = Dom_html.createCanvas d in
+  c##width <- 480;
+  c##height <- 320;
+  c
+
+let initGameVariable () =
+  { canvas = create_canvas ();
+    os = [ Ship {x=0; y=0} ];
+    cleft = 0;
+    ctop = 0;
+    cwidth = 480;
+    cheight = 320;
+    score = 0;
+    mouse = {x=0; y=0};
+    mousePressed = false;
+    state = GameInit }
+
+let start _ =
+  let open Dom_html in
+  let window = window in
+  let document = window##document in
+  let body = document##body in
+  let gv = initGameVariable () in
+  let rgv = ref gv in
+  let interavl = 1000. /. 30. in (* 30fps *)
+  let id = window##setInterval (Js.wrap_callback (onInterval rgv), interavl) in
+  let target = (body :> eventTarget Js.t) in
+  addEventListener target Event.mousemove (handler @@ onMouseMove rgv) Js._false |> ignore;
+  addEventListener target Event.mousedown (handler @@ onMouseDown rgv) Js._false |> ignore;
+  Dom.appendChild body gv.canvas;
+  Js._false
+
+let () =
+  Dom_html.window##onload <- Dom_html.handler start
+<html>
+  <head>
+  </head>
+  <body>
+    <script src='./testcase.js'></script>
+  </body>
+</html>