簡単なゲームをOCamlで作ります。

OCaml OCaml

この記事はML Advent Calendar 2014の5日目の記事です。

そういうことで(どういう事だ？)、OCamlでゲームを作ってみました。 ボス的な動きを作り込もうという事で、色々弄ってみてたってだけですけど。

ビルド方法

$ ocamlopt -I `ocamlfind query lablgl` lablgl.cmxa lablglut.cmxa d.ml -o d
$ ./d

lablglとlablglutがインストールされていれば、上のように書いていろいろできます。

遊び方

    let enemy = Enemy.new_ ()
      
    let enemy = Boss.new_ ()
      
    let enemy = Enemy3.new_ ()
      
    let enemy = Boss2.new_ ()
      
    let enemy = Boss3.new_ ()

ソースのこの辺を弄ると、表示される敵が変わります。

ソースコード

d.ml

open Printf
  
let width = 400.0
  
let height = 400.0
  
let pi = 4.0 *. (atan 1.0)
  
let normalize v =
  v +.
    ((2.0 *. pi) *.
       (if v > pi then (-1.) else if v < (-. pi) then 1. else 0.))
  
type state = | Title | GameOver | Game

let state = ref Title
  
let gstring str x y size =
  let getChar t1' =
    match t1' with
    | '0' ->
        [ "0000000 "; "0     0 "; "0  0  0 "; "0     0 "; "0     0 ";
          "0000000 " ]
    | '1' ->
        [ "      0 "; "      0 "; "      0 "; "      0 "; "      0 ";
          "      0 " ]
    | '2' ->
        [ "0000000 "; "      0 "; "0000000 "; "0       "; "0       ";
          "0000000 " ]
    | '3' ->
        [ "0000000 "; "      0 "; "0000000 "; "      0 "; "      0 ";
          "0000000 " ]
    | '4' ->
        [ "0     0 "; "0     0 "; "0000000 "; "      0 "; "      0 ";
          "      0 " ]
    | '5' ->
        [ "0000000 "; "0       "; "0000000 "; "      0 "; "      0 ";
          "0000000 " ]
    | '6' ->
        [ "0000000 "; "0       "; "0000000 "; "0     0 "; "0     0 ";
          "0000000 " ]
    | '7' ->
        [ "0000000 "; "      0 "; "      0 "; "      0 "; "      0 ";
          "      0 " ]
    | '8' ->
        [ "0000000 "; "0     0 "; "0000000 "; "0     0 "; "0     0 ";
          "0000000 " ]
    | '9' ->
        [ "0000000 "; "0     0 "; "0000000 "; "      0 "; "      0 ";
          "      0 " ]
    | 'a' ->
        [ "   0000 "; "  0   0 "; " 000000 "; "0     0 "; "0     0 ";
          "0     0 " ]
    | 'b' ->
        [ "000000  "; "0     0 "; "000000  "; "0     0 "; "0     0 ";
          "000000  " ]
    | 'c' ->
        [ "  00000 "; " 0      "; "0       "; "0     0 "; "0     0 ";
          " 00000  " ]
    | 'd' ->
        [ "000000  "; "0     0 "; "0     0 "; "0     0 "; "0    0  ";
          "00000   " ]
    | 'e' ->
        [ "0000000 "; "0       "; "000000  "; "0       "; "0       ";
          "0000000 " ]
    | 'f' ->
        [ "0000000 "; "0       "; "000000  "; "0       "; "0       ";
          "0       " ]
    | 'g' ->
        [ "  00000 "; " 0      "; "0  0000 "; "0     0 "; "0     0 ";
          " 00000  " ]
    | 'h' ->
        [ "0     0 "; "0     0 "; "0000000 "; "0     0 "; "0     0 ";
          "0     0 " ]
    | 'i' ->
        [ " 00000  "; "   0    "; "   0    "; "   0    "; "   0    ";
          " 00000  " ]
    | 'j' ->
        [ "    000 "; "      0 "; "      0 "; "      0 "; "0    0  ";
          " 0000   " ]
    | 'k' ->
        [ "0    00 "; "0  00   "; "000     "; "0  0    "; "0   0   ";
          "0    00 " ]
    | 'l' ->
        [ "0       "; "0       "; "0       "; "0       "; "0       ";
          "0000000 " ]
    | 'm' ->
        [ "0     0 "; "000 000 "; "0  0  0 "; "0     0 "; "0     0 ";
          "0     0 " ]
    | 'n' ->
        [ "000   0 "; "0  0  0 "; "0   0 0 "; "0    00 "; "0     0 ";
          "0     0 " ]
    | 'o' ->
        [ " 00000  "; "0     0 "; "0     0 "; "0     0 "; "0    0  ";
          " 0000   " ]
    | 'p' ->
        [ "0000000 "; "0     0 "; "000000  "; "0       "; "0       ";
          "0       " ]
    | 'q' ->
        [ " 00000  "; "0     0 "; "0     0 "; "0   0 0 "; "0    0  ";
          " 0000 0 " ]
    | 'r' ->
        [ "0000000 "; "0     0 "; "000000  "; "0   0   "; "0    0  ";
          "0     0 " ]
    | 's' ->
        [ " 000000 "; "0       "; "000000  "; "      0 "; "0    0  ";
          " 0000   " ]
    | 't' ->
        [ "0000000 "; "0  0  0 "; "   0    "; "   0    "; "   0    ";
          " 00000  " ]
    | 'u' ->
        [ "0     0 "; "0     0 "; "0     0 "; "0     0 "; "0    0  ";
          " 0000   " ]
    | 'v' ->
        [ "0     0 "; "0     0 "; "0    0  "; "0   0   "; "0  0    ";
          "000     " ]
    | 'w' ->
        [ "0     0 "; "0     0 "; "0  0  0 "; "0 0 0 0 "; "00   00 ";
          "0     0 " ]
    | 'x' ->
        [ "00   00 "; "  0 0   "; "   0    "; "  0 0   "; " 0   0  ";
          "0     0 " ]
    | 'y' ->
        [ "00   00 "; "  0 0   "; "   0    "; "   0    "; "   0    ";
          "  000   " ]
    | 'z' ->
        [ "0000000 "; "    0   "; " 00000  "; "  0     "; " 0      ";
          "0000000 " ]
    | _ ->
        [ "        "; "        "; "        "; "        "; "        ";
          "        " ] in
  let gchar c x y size =
    ignore
      (List.fold_left
         (fun t1' t2' ->
            match (t1', t2') with
            | (n, s) ->
                let num = ref 0
                in
                  (String.iteri
                     (fun t1' t2' ->
                        match (t1', t2') with
                        | (i, c) ->
                            if c = '0'
                            then incr num
                            else
                              if !num > 0
                              then
                                (let i = float_of_int (x + (i * size)) in
                                 let n = float_of_int (y + (n * size)) in
                                 let s = float_of_int size
                                 in
                                   (GlDraw.rect
                                      ((i -. ((float_of_int (!num - 1)) *. s)),
                                       n)
                                      ((i +. s), (n +. s));
                                    num := 0))
                              else ())
                     s;
                   n + 1))
         0 (getChar c))
  in
    String.iteri
      (fun t1' t2' ->
         match (t1', t2') with
         | (i, c) -> gchar c ((i * size) * 7) size (size - 1))
      str
  
module Key =
  struct
    let up = ref false
      
    let down = ref false
      
    let left = ref false
      
    let right = ref false
      
    let z = ref false
      
    let tz = ref false
      
    let onSpKeyDown ~key ~x ~y =
      match key with
      | Glut.KEY_UP -> up := true
      | Glut.KEY_DOWN -> down := true
      | Glut.KEY_LEFT -> left := true
      | Glut.KEY_RIGHT -> right := true
      | _ -> ()
      
    let onSpKeyUp ~key ~x ~y =
      match key with
      | Glut.KEY_UP -> up := false
      | Glut.KEY_DOWN -> down := false
      | Glut.KEY_LEFT -> left := false
      | Glut.KEY_RIGHT -> right := false
      | _ -> ()
      
    let onKeyDown ~key ~x ~y =
      match char_of_int key with | 'z' -> (tz := true; z := true) | _ -> ()
      
    let onKeyUp ~key ~x ~y =
      match char_of_int key with | 'z' -> z := false | _ -> ()
      
    let reset () = tz := false
      
    let init () =
      (Glut.specialFunc onSpKeyDown;
       Glut.specialUpFunc onSpKeyUp;
       Glut.keyboardFunc onKeyDown;
       Glut.keyboardUpFunc onKeyUp)
      
  end
  
type actor =
  | BG
  | Enemy of (((actor -> actor) ref) * (float ref) * (float ref))
  | Enemy2 of
              (((actor -> actor) ref) * (float ref) * (float ref) *
               ((int ref) * (float ref)))
  | Enemy3 of
              (((actor -> actor) ref) * (float ref) * (float ref) *
               ((int ref) * (float ref)))
  | Child of ((float ref) * (float ref))
  | Boss of
            (((actor -> actor) ref) * (float ref) * (float ref) *
             ((float ref) * (((float * float) list) ref) *
              ((actor list) ref)))
  | Boss2 of
             (((actor -> actor) ref) * (float ref) * (float ref) *
              ((float ref) * (((float * float) list) ref) *
               ((actor list) ref)))
  | Child3 of ((float ref) * (float ref))
  | Boss3 of
             (((actor -> actor) ref) * (float ref) * (float ref) *
              ((float ref) * (((float * float) list) ref) *
               ((actor list) ref)))

module Actor =
  struct
    let move e =
      match e with
      | BG -> (printf "BG\n"; e)
      | Enemy (m, _, _) -> !m e
      | Enemy2 (m, _, _, _) -> !m e
      | Enemy3 (m, _, _, _) -> !m e
      | Child (_, _) -> e
      | Child3 (_, _) -> e
      | Boss (m, _, _, _) | Boss2 (m, _, _, _) -> !m e
      | Boss3 (m, _, _, _) -> !m e
      
    let rec draw e =
      match e with
      | BG -> ()
      | Enemy (m, x, y) ->
          (GlDraw.color (1.0, 0.0, 0.0);
           let rsize = 10.
           in GlDraw.rect ((!x), (!y)) ((!x +. rsize), (!y +. rsize)))
      | Child (x, y) ->
          (GlDraw.color (1.0, 0.0, 0.0);
           let rsize = 10.
           in
             GlDraw.rect ((!x -. rsize), (!y -. rsize))
               ((!x +. rsize), (!y +. rsize)))
      | Enemy2 (m, x, y, _) | Enemy3 (m, x, y, _) ->
          (GlDraw.color (1.0, 0.0, 0.0);
           let rsize = 10.
           in GlDraw.rect ((!x), (!y)) ((!x +. rsize), (!y +. rsize)))
      | Boss (m, x, y, (cnt, _, cs)) ->
          (GlDraw.color (1.0, 0.0, 0.0);
           let rsize = 10.
           in
             (GlDraw.rect ((!x -. rsize), (!y -. rsize))
                ((!x +. rsize), (!y +. rsize));
              List.iter (fun t1' -> match t1' with | c -> draw c) !cs))
      | Boss2 (m, x, y, (cnt, _, cs)) ->
          (GlDraw.color (1.0, 0.0, 0.0);
           let rsize = 20.
           in
             (GlDraw.rect ((!x -. rsize), (!y -. rsize))
                ((!x +. rsize), (!y +. rsize));
              List.iter (fun t1' -> match t1' with | c -> draw c) !cs))
      | Child3 (x, y) ->
          (GlDraw.color (1.0, 0.0, 0.0);
           let rsize = 15.
           in
             GlDraw.rect ((!x -. rsize), (!y -. rsize))
               ((!x +. rsize), (!y +. rsize)))
      | Boss3 (m, x, y, (cnt, _, cs)) ->
          (GlDraw.color (0.7, 0.7, 0.7);
           let h = 10. in
           let w = 240.
           in
             (GlDraw.rect ((!x -. w), (!y -. h)) ((!x +. w), (!y +. h));
              GlDraw.color (0.8, 0.8, 0.8);
              let h = 50. in
              let w = 40.
              in
                (List.iter
                   (fun t1' ->
                      match t1' with
                      | Child3 (x, y) ->
                          GlDraw.rect ((!x -. w), (!y -. h))
                            ((!x +. w), (!y +. h)))
                   !cs;
                 List.iter
                   (fun t1' ->
                      match t1' with | (Child3 (x, y) as c) -> draw c)
                   !cs)))
      
  end
  
module BG = struct let new_ () = BG
                      end
  
module Enemy =
  struct
    let rec new_ () = Enemy ((ref move1), (ref 0.), (ref 0.))
    and move1 e =
      match e with
      | Enemy (m, x, y) ->
          (x := !x +. 5.; if !x > height then m := move2 else (); e)
      | _ -> assert false
    and move2 e =
      match e with
      | Enemy (m, x, y) ->
          (x := !x -. 5.; if !x <= 0. then m := move1 else (); e)
      | _ -> assert false
      
  end
  
module Child = struct let rec new_ x y = Child ((ref x), (ref y))
                         end
  
module Boss =
  struct
    let poses = ref
      
    let rec new_ () =
      let rec list_make t1' t2' t3' =
        match (t1', t2', t3') with
        | (0, ls, v) -> ls
        | (n, ls, v) -> list_make (n - 1) ((v ()) :: ls) v in
      let n = 10 in
      let childs =
        list_make n [] (fun t1' -> match t1' with | () -> Child.new_ 10. 10.) in
      let lasts =
        list_make (3 * n) [] (fun t1' -> match t1' with | () -> (10., 10.))
      in
        Boss ((ref move1), (ref 10.), (ref 10.),
          ((ref 0.), (ref lasts), (ref childs)))
    and moveChilds ls childs =
      let _ =
        List.fold_left
          (fun t1' t2' ->
             match (t1', t2') with
             | (n, Child (x, y)) ->
                 let _ =
                   (match List.nth ls n with | (x1, y1) -> (x := x1; y := y1))
                 in n + 3
             | _ -> assert false)
          0 childs
      in ()
    and move1 this =
      match this with
      | Boss (m, x, y, (c, ls, childs)) ->
          (c := !c +. 0.1;
           ls := (List.tl !ls) @ [ ((!x), (!y)) ];
           x := !x +. 5.;
           y := !y +. ((sin !c) *. 10.);
           if !x > (width -. 20.) then m := move2 else ();
           moveChilds !ls !childs;
           this)
      | _ -> assert false
    and move2 this =
      match this with
      | Boss (m, x, y, (c, ls, childs)) ->
          (c := !c +. 0.1;
           ls := (List.tl !ls) @ [ ((!x), (!y)) ];
           x := !x -. 5.;
           y := !y +. ((sin !c) *. 10.);
           if !x <= 10. then m := move1 else ();
           moveChilds !ls !childs;
           this)
      | _ -> assert false
      
  end
  
module Shots =
  struct
    let shots = ref []
      
    let add x y =
      if (List.length !shots) < 16 then shots := (x, y) :: !shots else ()
      
    let move () =
      let ss =
        List.map (fun t1' -> match t1' with | (x, y) -> (x, (y -. 20.)))
          !shots
      in
        shots :=
          List.filter (fun t1' -> match t1' with | (x, y) -> y > 0.) ss
      
    let draw () =
      let rsize = 2.0
      in
        (GlDraw.color (1.0, 1.0, 0.0);
         List.iter
           (fun t1' ->
              match t1' with
              | (x, y) ->
                  GlDraw.rect ((x -. rsize), (y -. rsize))
                    ((x +. rsize), (y +. rsize)))
           !shots)
      
  end
  
module Child3 = struct let rec new_ x y = Child3 ((ref x), (ref y))
                          end
  
module Boss3 =
  struct
    let rec new_ () =
      let lasts =
        [ ((-80.), (-20.)); ((-30.), 20.); (30., 20.); (80., (-20.)) ] in
      let n = 3 in
      let childs =
        [ Child3.new_ (-0.) 0.; Child3.new_ 0. 0.; Child3.new_ 0. 0.;
          Child3.new_ 0. 0. ]
      in
        Boss3 ((ref move1), (ref 10.), (ref 10.),
          ((ref 0.), (ref lasts), (ref childs)))
    and moveChilds xa ya ls childs =
      let _ =
        List.fold_left
          (fun t1' t2' ->
             match (t1', t2') with
             | (n, Child (x, y)) ->
                 let _ =
                   (match List.nth ls n with
                    | (x1, y1) -> (x := xa +. x1; y := ya +. y1))
                 in n + 1
             | (n, Child3 (x, y)) ->
                 let _ =
                   (match List.nth ls n with
                    | (x1, y1) -> (x := xa +. x1; y := ya +. y1))
                 in n + 1
             | _ -> assert false)
          0 childs
      in ()
    and move1 this =
      match this with
      | Boss3 (m, x, y, (c, ls, childs)) ->
          (c := !c +. 0.1;
           x := !x +. 5.;
           y := !y +. ((sin !c) *. 10.);
           if !x > (width -. 20.) then m := move2 else ();
           moveChilds !x !y !ls !childs;
           this)
      | _ -> assert false
    and move2 this =
      match this with
      | Boss3 (m, x, y, (c, ls, childs)) ->
          (c := !c +. 0.1;
           x := !x -. 5.;
           y := !y +. ((sin !c) *. 10.);
           if !x <= 10. then m := move1 else ();
           moveChilds !x !y !ls !childs;
           this)
      | _ -> assert false
      
  end
  
module Ship =
  struct
    let rsize = 25.
      
    let x = ref ((width -. rsize) /. 2.)
      
    let y = ref (height -. (rsize *. 2.0))
      
    let speed = 5.
      
    let bllets = ref
      
    let move () =
      let m = 5 in
      let m = if !Key.left then m - 1 else m in
      let m = if !Key.right then m + 1 else m in
      let m = if !Key.up then m - 3 else m in
      let m = if !Key.down then m + 3 else m
      in
        (if !Key.z then Shots.add !x !y else ();
         Shots.move ();
         let speed =
           match m with | 1 | 3 | 7 | 9 -> speed /. 1.4 | _ -> speed in
         let (nx, ny) =
           match m with
           | 1 -> ((!x -. speed), (!y -. speed))
           | 2 -> ((!x), (!y -. speed))
           | 3 -> ((!x +. speed), (!y -. speed))
           | 4 -> ((!x -. speed), (!y))
           | 5 -> ((!x), (!y))
           | 6 -> ((!x +. speed), (!y))
           | 7 -> ((!x -. speed), (!y +. speed))
           | 8 -> ((!x), (!y +. speed))
           | 9 -> ((!x +. speed), (!y +. speed))
           | _ -> ((!x), (!y))
         in
           (x := min (max nx 0.) (width -. rsize);
            y := min (max ny 0.) (height -. rsize)))
      
    let draw () =
      (GlDraw.rect ((!x -. (rsize /. 2.)), (!y -. (rsize /. 2.)))
         ((!x +. (rsize /. 2.)), (!y +. (rsize /. 2.)));
       Shots.draw ())
      
  end
  
module Boss2 =
  struct
    let speed = 3.0
      
    let r = 0.025
      
    let span = 15
      
    let fabs a = if a < 0. then -. a else a
      
    let poses = ref
      
    let move m rad x y x1 y1 next =
      let rad2 = atan2 (y1 -. !y) (x1 -. !x) in
      let rad2 =
        if (normalize (!rad -. rad2)) <= 0. then !rad +. r else !rad -. r in
      let rad2 = normalize rad2
      in
        (x := !x +. ((cos rad2) *. speed);
         y := !y +. ((sin rad2) *. speed);
         if ((fabs (!x -. x1)) < 10.) && ((fabs (!y -. y1)) < 10.)
         then m := next
         else ();
         rad := rad2)
      
    let rec new_ () =
      let rec list_make t1' t2' t3' =
        match (t1', t2', t3') with
        | (0, ls, v) -> ls
        | (n, ls, v) -> list_make (n - 1) ((v ()) :: ls) v in
      let x = 200. in
      let y = (-10.) in
      let n = 14 in
      let childs =
        list_make n [] (fun t1' -> match t1' with | () -> Child.new_ x y) in
      let lasts =
        list_make (span * n) [] (fun t1' -> match t1' with | () -> (x, y))
      in
        Boss2 ((ref move1), (ref x), (ref y),
          ((ref 0.), (ref lasts), (ref childs)))
    and moveChilds ls childs =
      let _ =
        List.fold_left
          (fun t1' t2' ->
             match (t1', t2') with
             | (n, Child (x, y)) ->
                 let _ =
                   (match List.nth ls n with | (x1, y1) -> (x := x1; y := y1))
                 in n + span
             | _ -> assert false)
          0 childs
      in ()
    and move1 this =
      match this with
      | Boss2 (m, x, y, (rad, ls, childs)) ->
          (ls := (List.tl !ls) @ [ ((!x), (!y)) ];
           move m rad x y 20. 380. move2;
           moveChilds !ls !childs;
           this)
      | _ -> assert false
    and move2 this =
      match this with
      | Boss2 (m, x, y, (rad, ls, childs)) ->
          (ls := (List.tl !ls) @ [ ((!x), (!y)) ];
           move m rad x y !Ship.x !Ship.y move1;
           moveChilds !ls !childs;
           this)
      | _ -> assert false
      
  end
  
module Enemy3 =
  struct
    let speed = 6.0
      
    let r = 0.15
      
    let fabs a = if a < 0. then -. a else a
      
    let move m rad cnt mx x y x1 y1 next =
      let rad2 = atan2 (y1 -. !y) (x1 -. !x) in
      let rad2 =
        if (normalize (!rad -. rad2)) <= 0. then !rad +. r else !rad -. r in
      let rad2 = normalize rad2
      in
        (x := !x +. ((cos rad2) *. speed);
         y := !y +. ((sin rad2) *. speed);
         cnt := !cnt + 1;
         if
           (!cnt > (mx * 10)) ||
             (((fabs (!x -. x1)) < 10.) && ((fabs (!y -. y1)) < 10.))
         then (cnt := 0; m := next)
         else ();
         rad := rad2)
      
    let rec new_ () =
      Enemy3 ((ref move1), (ref 0.), (ref 300.), ((ref 0), (ref 0.)))
    and move1 e =
      match e with
      | Enemy3 (m, x, y, (cnt, rad)) ->
          (move m rad cnt 60 x y 310. 30. move2; e)
      | _ -> assert false
    and move2 e =
      match e with
      | Enemy3 (m, x, y, (cnt, rad)) ->
          (move m rad cnt 50 x y 200. 300. move3; e)
      | _ -> assert false
    and move3 e =
      match e with
      | Enemy3 (m, x, y, (cnt, rad)) ->
          (move m rad cnt 50 x y (-20.) (-20.) move4; e)
      | _ -> assert false
    and move4 e =
      match e with
      | Enemy3 (m, x, y, (cnt, rad)) ->
          (x := 0.; y := 300.; rad := 0.; cnt := 0; m := move1; e)
      | _ -> assert false
      
  end
  
module Enemy2 =
  struct
    let speed = 6.0
      
    let r = 0.15
      
    let fabs a = if a < 0. then -. a else a
      
    let move m rad cnt mx x y x1 y1 next =
      let rad2 = atan2 (y1 -. !y) (x1 -. !x) in
      let rad2 =
        if (normalize (!rad -. rad2)) <= 0. then !rad +. r else !rad -. r in
      let rad2 = normalize rad2
      in
        (x := !x +. ((cos rad2) *. speed);
         y := !y +. ((sin rad2) *. speed);
         cnt := !cnt + 1;
         if
           (!cnt > (mx * 10)) ||
             (((fabs (!x -. x1)) < 10.) && ((fabs (!y -. y1)) < 10.))
         then (cnt := 0; m := next)
         else ();
         rad := rad2)
      
    let rec new_ () =
      Enemy2 ((ref move1), (ref 0.), (ref (-30.)), ((ref 0), (ref 0.)))
    and move1 e =
      match e with
      | Enemy2 (m, x, y, (cnt, rad)) ->
          (move m rad cnt 60 x y 10. 350. move2; e)
      | _ -> assert false
    and move2 e =
      match e with
      | Enemy2 (m, x, y, (cnt, rad)) ->
          (move m rad cnt 50 x y 300. 30. move3; e)
      | _ -> assert false
    and move3 e =
      match e with
      | Enemy2 (m, x, y, (cnt, rad)) ->
          (move m rad cnt 50 x y 300. 400. move4; e)
      | _ -> assert false
    and move4 e =
      match e with
      | Enemy2 (m, x, y, (cnt, rad)) ->
          (x := 0.; y := (-30.); rad := 0.; cnt := 0; m := move1; e)
      | _ -> assert false
      
  end
  
module Game =
  struct
    let enemy = Enemy.new_ ()
      
    let enemy = Boss.new_ ()
      
    let enemy = Enemy3.new_ ()
      
    let enemy = Boss2.new_ ()
      
    let enemy = Boss3.new_ ()
      
    let draw () =
      (GlClear.clear [ `color ];
       GlDraw.color (1.0, 0.0, 0.0);
       (match !state with
        | Game -> (Actor.draw enemy; Ship.draw ())
        | Title -> gstring "push z" 0. 0. 6
        | _ -> ());
       Glut.swapBuffers ())
      
    let rec move ~value =
      (Glut.postRedisplay ();
       (match !state with
        | Title -> if !Key.z then state := Game else ()
        | _ -> (Ship.move (); let _ = Actor.move enemy in ()));
       Glut.timerFunc ~ms: 15 ~cb: move ~value: 1)
      
    let resize ~w ~h =
      let h = max h 1
      in
        (GlDraw.viewport ~x: 0 ~y: 0 ~w: w ~h: h;
         GlMat.mode `projection;
         GlMat.load_identity ();
         let ortho = GlMat.ortho ~z: (1.0, (-1.0)) in
         let x = (0.0, width) in
         let y = (height, (-0.0))
         in
           (ortho ~x: x ~y: y; GlMat.mode `modelview; GlMat.load_identity ()))
      
    let main =
      let _ = Glut.init Sys.argv
      in
        (Glut.initDisplayMode ~double_buffer: true ~alpha: true ();
         Glut.initWindowSize ~w: (int_of_float width)
           ~h: (int_of_float height);
         let _ = Glut.createWindow "Game01"
         in
           (Glut.displayFunc draw;
            Glut.reshapeFunc resize;
            Key.init ();
            Glut.timerFunc ~ms: 33 ~cb: move ~value: 1;
            GlClear.color ~alpha: 1.0 (0.1, 0.1, 0.1);
            Glut.mainLoop ()))
      
  end

明日は、masquerade0324さんのSMLの記事です。

OCamlでオブジェクト指向を使ったゲームのアクター

OCaml

この記事はML Advent Calendar 2014の3日目の記事です。

昨日は代数データ型を使ってみましたが、今日はオブジェクト指向を使ってみます。 オブジェクト指向自体の説明はもっと良い記事があると思うので、複数のキャラクターを同じリストに入れて動かしたり、親子関係を持たせて、動かすオブジェクトを書いてみます。

open Printf

class actor =
  object(this)
    val mutable move = fun()->()
    method move = move()
  end

まずは、actorクラスを書いてみます。moveというmutableな関数を持つメンバ変数とmoveメソッドを定義します。OCamlのオブジェクト指向はRubyのオブジェクト指向に近いので、メンバ変数は使えないんですよね。そんな事は知ってるって気もしますけど、、、。

type actor = <move: unit>

で、型をかいてみると、こんな感じになります。moveメソッドだけがあります。<>でオブジェクトは括るようです。

class enemy_a =
  object(this)
    val mutable move = fun()->()
    method move = move()
    method private move1() = printf("a1\n"); move <- this#move2
    method private move2() = printf("a2\n"); move <- this#move1
    method init = move <- this#move1; this
  end

敵を定義してみます。initメソッドで初期化して、move1を入れるというように書きました。 コンストラクタのような物の書き方があるのかないのか、わからなかったので、initメソッドを作りました。 これ、ヘーって思うかもしれないんですが、メソッドを関数として取り出す方法で１時間とか結構悩んだんです。 ちょっとググっても、見つからないし、、、。という事で、これを見ればもう悩まないはずです。

class enemy_b =
  object(this) 
    inherit actor
    method private move1() = printf("b1\n"); move <- this#move2
    method private move2() = printf("b2\n"); move <- this#move1
    method init = move <- this#move1;this
  end

inheritで継承を使う事も出来るんですね。 enemy_aより短く書けました。

type e_parent = < move : unit; init : e_parent; k :unit >
type e_child = < move : unit; init: e_child >

次にe_parentとe_childの型を作っておきます。 このオブジェクトの型も見慣れないので辛かった。 色んなメソッドだけを<>で括ったものが型になります。

class enemy_child(parent:e_parent) =
  object(this) 
    inherit actor
    method private move1() =
      printf("c2\n");
      parent#k
    method init =
      move <- this#move1;
      (this :> e_child)
  end

enemy_childクラスを定義します。enemy_childは親を受け取る形になります。initはe_childと明示する必要があって苦労しました。何処をどう、型合わせたら良いんじゃ！っていう。

class enemy_c =
  object(this) 
    inherit actor
    val mutable childs: e_child list = []
    method private move1() =
      printf("c1\n");
      List.iter(fun e->e#move) childs

    method k =
      printf("c1 k\n")

    method init =
      move <- this#move1;
      childs <- [
        (new enemy_child(this :> e_parent))#init ;
        (new enemy_child(this :> e_parent))#init
      ];
      (this :> e_parent)
  end

enemy_cという親のクラスを定義して、childs(childrenって書けよ)リストに子供を入れてみました。 この辺型合わせるのが、最初大変でした。相互参照させるの難しくありません？って感じでした。 何回も大変大変って書くなよw

let _ =
  let f =
    let a = new enemy_a in
    (fun()-> a#init)
  in
  (f())#move;
  
  let ls = [
    (new enemy_a#init :> actor);
    (new enemy_b#init :> actor);
    (new enemy_c#init :> actor)] in
  for i = 0 to 3-1 do
    List.iter(fun l-> l#move) ls; printf"--\n"
  done

で、リストに入れて動かせます。 とりあえず、OCamlはJavaのインターフェイスを書く感じで型を定義しておいて、その型でリストを作れば様々な型のオブジェクトを１つのリストに登録して使う事が出来ました。

でも、<>でオブジェクトの型を書かなくても、出来ないのでしょうか？と思って書いてみたのが次のプログラムです。できるんですね。

open Printf

(* 動くだけ *)
class actor =
  object(this) 
    method move = ()
  end

動くだけのクラスを定義します。

class actor_a =
  object(this) 
    method move = printf("move a\n")
  end

同じ型のクラスを書きます。型が同じ形なので１つにまとめられます。

(* 状態を持ったアクター *)
class actor_m =
  object(this) 
    val mutable move = fun()->()
    method move = move()
    method private move1() = ()
    method init = move<-this#move1;(this :> actor_m)
  end

次に初期か関数があるオブジェクトを作ってみます。

(* メッセージを受け取るアクター *)
class actor2 =
  object(this) 
    val mutable move = fun()->()
    method move = move()
    method private move1() = ()
    method msg = ()
    method init = (this :> actor2)
  end

actor2はmsgメソッドがあるアクターとします。微妙に違うクラス並んでるだけですけど。

(* 子供 *)
class actor2_c(parent:actor2) =
  object(this) 
    val mutable move = fun()->()
    method move = move()
    method init =
      move <- this#move1;
      this
    method private move1() =
      printf("child move1\n");
      parent#msg;
      move <- this#move2
    method private move2() =
      printf("child move2\n");
      parent#msg
    method msg =
      printf("child msg ok\n")
  end

(* 親 *)
class actor2_p =
  object(this) 
    val mutable move = fun()->()
    method move = move()
    val mutable childs: actor2 list = []
    method private move1() =
      printf("parent move\n");
      List.iter(fun e->e#move; e#msg) childs

    method msg =
      printf("parent msg ok\n")

    method init =
      move <- this#move1;
      childs <- [
        (new actor2_c(this:>actor2))#init ;
        (new actor2_c(this:>actor2))#init
      ];
      (this :> actor2)
  end

親子関係のあるオブジェクトはこんな感じで書けます。

let _ =
  let actors = [
    new actor_a;
    (((new actor2_p)#init) :> actor);
    new actor_a;
  ] in
  List.iter(fun a->a#move) actors

で、アクターを１つのリストにまとめて書く事が出来ました。特に型は書かなくても出来ましたね。 型は書いてないけど、インターフェイスになるようなclassを作れば型を作ったのと同じというような気持で書けます。 こんな風に、OCamlのオブジェクトは使えるんですねぇ。っという話でした。

明日は@master_qさんの「禅問答的に #ATS2 の型理論を説明してみたよ」です。

Javaを出力するトランスレータ言語 gomaj

Java OCaml

この記事は JVM Advent Calendar 3日目 の記事です。

gomajとは

gomajとはOCamlで書いた、Javaを出力するオモチャのトランスレータ言語です。AltJSに対抗するならば、AltJと言えるような言語です。名前は忘れたのですけど(ほんとに忘れたのですいません)、トランスレータ書く技術が欲しいですとtwitterで言っている人がいたので書いてみました。ちょうどgomaというC++のトランスレータを書いていたので、勢いで書いてみたわけです。

gomaという、c++を出力する型システムがGoLangに似た言語を作って遊んでいたのですが、そのJava番です。 gomajを使えばぁ、あんな事やこんな事が簡単に出来ます。多分。＜どんな事だ？笑

JVM関係ないじゃないか！っと思うかもしれませんが、大きな目で見れば、JVM上で動く言語で、Javaでもないのでここで紹介させていただきます。

ビルド方法

https://github.com/hsk/gomaj

あらかじめ、OCamlとmakeが使える環境を用意します。ググってインストールしてください。 git cloneしてmakeするだけです。

$ make

ハローワールド

package example
Hello class {
  + ^ main():void = {
    System.out.println("hello world")
  }
}

こんなファイルを作って、Hello.gomajで保存します。 見た目、;がなくて何か変な、+とか^がついている、型を後ろにかくような言語になってますね。 Scalaっぽいけど、Scalaではありません。

+は実はpublicです。^はstaticの意味です。そういわれてもう一度見れば、ああ、単なるマクロみたいなもんかと思えるかもしれません。-はprivateで*はprotectedです。

このプログラムをコンパイルしてjavaに変換し、javacでコンパイルして実行します。

$ ./gomajc example/hello.gomaj example/Hello.java
$ javac example/Hello.java
$ ./java example.Hello
hello world!

動きました。出力されたHello.javaは以下のようになります:

package example;
class Hello {
  static public void main(String[] argv) {
    System.out.println("hello world");
  }
}

奇麗なJavaが出力されてますね。

フィボナッチをオブジェクト指向を使ったケースと、スタティックなケースで書いてみましょう。

package example

+ Fib class {

  ^ fib(a:int):int = 
    if (a == 0)
      return 0
    else if (a == 1)
      return 1
    else
      return fib(a - 2) + fib(a - 1);

  ^ + main(argv:Array[String]):void = {
    System.out.println("fib 10 = " + fib(10))
    System.out.println("Int.fib 10 = " + new Int(10).fib())
  }

  ^ Int class (x:int) {
    + fib():int =
      if (@x == 0) {
        return 0
      } else if (@x == 1)
        return 1
      else
        return new Int(@x - 1).fib()
             + new Int(@x - 2).fib()
  }

}

変換されたJavaは以下のようになります:

package example;
public class Fib {
  static int fib(int a) {
    if (a==0)
      return 0;
    else if (a==1)
      return 1;
    else
      return fib(a-2)+fib(a-1);
  }
  static public void main(String[] argv) {
    System.out.println("fib 10 = "+fib(10));
    System.out.println("Int.fib 10 = "+ new Int(10).fib());
  }
  static class Int {
    Int(int x) {
      this.x=x;
    }
    int x;
    public int fib() {
      if (this.x==0) {
        return 0;
      } else if (this.x==1)
        return 1;
      else
        return  new Int(this.x-1).fib()+ new Int(this.x-2).fib();
    }
  }
}

Intクラスのコンストラクタはありませんが、Int class (x:int) {...}と書くだけで自動生成されています。また、ブロックの省略もできてます。this.xは@xとRubyのように書けています。アノテーションは、、、考慮に入れてません＜え”、、、っということで、@は@@にすると良いでしょう。@@は@@@にすれば、、、。

他にも以下のような色々な機能を付けてみました:

package example

+ Test class {
  
  - a:int;
  - b:int = 1;
  - c():int = return 1;

  + ^ main(argv:Array[String]):void = {

    System.out.println("c()="+new Test().c())
    a:int=0
    b:int=0
    System.out.println("1+2+3="+(a=b=1+2+3))
    System.out.println("1+2+3="+(a=(b=1)+2+3))
    System.out.println("1*2+3="+(1*2+3))
    System.out.println("(1+2)*3="+((1+2)*3))
    System.out.println("-(1+2*3)="+ -(1+2*3))
    System.out.println("(-1+2*3)="+ (-1+2*3))

    System.out.println("eq="+new Test().eval(new Int(1)))
    System.out.println("eq="+new Test().eval(new Add(new Int(1),new Int(2))))
  }

  - eval(e:E):int = {
    e match {
      | Int => return $._1
      | Add =>
        a:int = eval($._1)
        b:int = eval($._2)
        return a + b
    }
    return 0
  }

  ^ Point class(x:int, y:int);
  ^ Point3D class(x:int, y:int, z:int);
  ^ E class();
  ^ E :> Int class(int);
  ^ E :> Add class(E,E);

}

Test.gomaj

match構文はswitchの変わりですが、instanceofでの分岐を短く書く事が可能です。 値のバインディングはないですけど、まぁ、単純なトランスレータだとこれくらいが限界です。

  ^ Point class(x:int, y:int);

と書くと、いい感じのクラスが出来たり、

  ^ E :> Int class(int);

って書くと、Eクラスを継承したIntクラスが出来たり、名前の指定が無い場合は、_1というフィールド名になったりします。

変換結果

package example;
public class Test {
  private int a;
  private int b = 1;
  private int c() {
    return 1;
  }
  public static void main(String[] argv) {
    System.out.println("c()="+ new Test().c());
    int a = 0;
    int b = 0;
    System.out.println("1+2+3="+(a=b=1+2+3));
    System.out.println("1+2+3="+(a=(b=1)+2+3));
    System.out.println("1*2+3="+(1*2+3));
    System.out.println("(1+2)*3="+(1+2)*3);
    System.out.println("-(1+2*3)="+ -(1+2*3));
    System.out.println("(-1+2*3)="+( -1+2*3));
    System.out.println("eq="+ new Test().eval( new Int(1)));
    System.out.println("eq="+ new Test().eval( new Add( new Int(1),  new Int(2))));
  }
  private int eval(E e) {
    
    if (e instanceof Int) {
      Int $ = (Int)e;
      return $._1;
    }

    if (e instanceof Add) {
      Add $ = (Add)e;
      int a = eval($._1);
      int b = eval($._2);
      return a+b;
    }

    return 0;
  }
  static class Point {
    Point(int x, int y) {
      this.x=x;
      this.y=y;
    }
    int x;
    int y;
  }
  static class Point3D {
    Point3D(int x, int y, int z) {
      this.x=x;
      this.y=y;
      this.z=z;
    }
    int x;
    int y;
    int z;
  }
  static class E {
    E() {
    }
  }
  static class Int extends E {
    Int(int _1) {
      this._1=_1;
    }
    int _1;
  }
  static class Add extends E {
    Add(E _1, E _2) {
      this._1=_1;
      this._2=_2;
    }
    E _1;
    E _2;
  }
}

Test.java

内部の構成

ここからは、大ざっぱなgomajの内部構造を説明して行きます。

gomajは以下の5つのファイルで構成されています。

  1. ast.ml 構文木を表すデータを定義します。
  2. parser.mly パーサの定義です。OCamlYaccでparser.mlを生成します。
  3. lexer.mli 字句解析の定義です。OCamlLexでlexer.mlを生成してコンパイルします。
  4. gen_java.ml Javaの出力を行います。
  5. main.ml メイン関数です。コマンドライン引数を見てファイルを開いてパースし、gen_javaでjavaを出力します。

それでは、より詳細に見て行きましょう。

ast.ml

まずは構文のデータを作ります。astはAbstract Syntax Treeの抽象構文木略です。 こういう場合は、代数データ型がとても便利です。Scalaだとcase classを使う所ですね。

  • t 型
  • e 式
  • a アクセス属性
  • s 文
  • prog プログラム

という5つの型を作ります。なんで、１文字なんだって？いうと、短い方が慣れると見やすいからです。 普通は意味分かるような名前にすべきですが、何回も同じ物を書くので省略しています。

type t =
  | Ty of string
  | TGen of string * t

まずは、型を表すt型を作ります。Tyがintとか、Stringといった型が入るデータの型です。

Ty("int")

のようにして型を書けます。便利ですね。 TGenのほうは、ジェネリックスです。配列もTGenを使い出力する所で特別扱いします。

TGen("int",Ty("Array"))

で、intの配列という意味にしました。

type e =
  | EInt of int
  | EBin of e * string * e
  | EPre of string * e
  | EPost of e * string
  | ECall of e * e list
  | EArr of e * e list
  | EVar of string
  | EString of string
  | EEmpty
  | ECast of t * e

eは式を表してます。EIntがint,EBinが2項演算子,EPreが前置演算子,EPostが後置演算子,ECallが関数呼び出し，EArrが配列演算子、EVarが変数等の識別子、EStringが文字列、EEmptyは空、ECastはキャスト演算子を表します。Javaで書くと10個のクラスで10ファイルで、コンストラクタを書いてウンタラで大変な所がたった、11行で書けるあたりが関数型言語の強みです。

type a =
  | APublic
  | AProtected
  | APrivate
  | AStatic
  | AFinal

aは属性accessのaで属性です。APublicがpublicでAProtectedがprotectedで、、、。後はわかりますよね。

type s = 
  | SBlock of s list
  | SIf of e * s * s
  | SEmpty
  | SExp of e
  | SRet of e
  | SFun of t * string * (t * string) list * s
  | SPackage of string
  | SLet of t * e * e
  | SClass of string * string * s list
  | SCon of string * (t * string) list * s
  | STrait of  string * s list
  | SAccess of a list * s
  | SMatch of e * (string * s list) list

ここからは早口で行きます。

sはステートメント(文)を表します。SBlockは{}です。中に更に文のリストが入ります。SIfはif文、SEmptyは空の文、SExpは式の文、SRetはreturn文、SFunは関数、そうこれ文じゃないんですけど、文としてます。手抜きです。ちゃんと分析出来てないジャンって所。リファクタリングするポイントでしょう。ただ、パーサ等でチェックをしっかりやれば大丈夫でしょう。 SPackageはpackageを表します。SLetは変数定義です。Letという名前は、SML、Haskell、OCaml、Swift等の関数型言語で良く表れるので、使っています。SClassはクラス、SConはコンストラクタ、STraitはインターフェイスだけど、Scalaっぽくtraitとしました。SAccessはアクセス属性、SMatchはswitch文をScalaに似せてmatchとしました。

ゼーゼー。長いですね。マジメに目を通す必要もないかもしれません。目を通したかた、ありがとうございました。

type prog =
  | Prog of s list

さぁ最後です。progがプログラムを表してて、sつまり、文のリストになってます。ホントは宣言部分をわけるといいんだろうけどまぁ、勢いで作った物なのでお許しを。宣言(declare)を略してdに分けると良いでしょう。

さらっと大量のデータオブジェクトが定義出来ました。 こういうところは関数型言語は強いですね。単純にJavaでまじめに書いたら恐ろしい量になるはずです。

parser.mly

次はパーサを書きましょう。 OCamlは標準で、OCamlYaccというコンパイラコンパイラがついてきます。 yaccという文法定義からパーサのC言語を吐き出すプログラムがあります。コンパイラをコンパイルするのでコンパイラコンパイラと呼ばれているわけですが、OCamlYaccはそのYaccのOCaml版です。 Yaccの作り方は直感的に理解するのは難しいです。理解せずに使うのは気持悪いけど、ま、便利だし速いので使っちゃいましょう。

ocamlyaccはコマンドラインから、

$ ocamlyacc parser.mly

等と書くと、parser.mlyからparser.mlというパーサのコードを出力してくれます。 便利です。

使っていると、文法の定義の衝突が起きて、コンフリクトのメッセージが表示されます。 コンフリクトとか気になると思いますけど、気にしないのが初心者の心構えとして重要です。 コンフリクトがあるから、駄目だみたいな批判もあると思うけど、とりあえずは、動けば良いんです。 そう思うとずっと楽に使えます。時間とコストをかければ、コンフリクトは消せるので、無い方がよいです。 コンフリクトはerrorではなくwarningと思えば、warningあっても動くみたいに思うとよいでしょう。

大ざっぱにソースを見てみましょう。体裁はよろしくないかも知れませんが、バラバラに書くのもと思いまして、ソースのコメントに文章を書いてみましたので、そのまま読んでください。

%{

(* %{と%}の間にyaccで出力されたファイルの先頭に書きたいプログラムをここに書きます *)

(* Astモジュールを読み込んだり、 *)
open Ast

(* 関数定義も書けます。 *)
let addBlock = function
  | (SBlock _ as b) -> b
  | b -> SBlock [b]

%}

/* 次にトークンの定義を%tokenの後ろにずらずらと書きます。１行に複数かけます */
%token STATIC PUBLIC PRIVATE PROTECTED FINAL
%token CLASS THIS TRAIT EXTENDS REXTENDS
:
:

/* トークンには様々なデータを含める事が出来て、<>の中に型を指定出来ます。 */
%token <string> PACKAGE
%token <string> IMPORT
%token <string> STRING
%token <int> INT
%token <string> ID
:
:

/* 演算子の結合の優先順位を指定します。優先順位の順番は上が高くなります。
使えるのは、%left,%right,%noassocの3つです。 */

%right ASSIGN
%right CAST
%left EQ NE
%left LT GT LE GE
:
:


/* パーサの開始位置と型を書きます。この場合はprogのみ定義していてますが、複数書く事が出来ます。 */

%type <Ast.prog> prog
%start prog

%% 

/* ここから文法定義です */

/* progという名前の文法を定義します。 */
prog:
  | defs { Prog($1) }
  /* defsからprogは出来ています。 */
  /* {}の中で、defsに対してアクションを記述します。$1は1個目の要素defsで、それをProgで包んでます */

/* defsの文法要素 */
defs: /* adefか、adefの連続かで、要するに、adefのリストとして返します []はリストを生成し::はリストの結合を表しています */
  | adef { [$1] }
  | adef defs { $1 :: $2 }

/* adefは アクセス属性のリストが付けられて、セミコロンを後ろに書けます */
adef:
  | accesses def { SAccess($1, $2) }
  | def { $1 }
  | adef SEMICOLON { $1 }

:
:

筆者は最初、このyaccの文法がなんか汚いなぁと思っていました。%{ %}の間にプログラム書くとか、%%の後ろが文法定義とか気持悪いなんて思ったのですけど、伝統的にこういう物なのです。受け入れましょう。短く書ければどうだっていいんです。重要なのは文法を気軽に定義出来る事なのですから。

文法定義を作る練習をする場合は、1+2*3みたいな計算式を作ってみて、それから、徐々に育てて行くのが楽しいです。Javaっぽい物であれば、最小限のコードを作ってそれをパースするのがよいわけです。

Test class {
  public static main(argv:Array[String]):void = {
    System.out.println("hello world\n")
  }
}

をパースする事だけ出来る物を作ってそれを徐々に育てて行けば良いかんじです。 いきなりデカい例があると辛いでしょうけどw より細かい例は、ご要望があれば書きたいと思います。

参考文献は、ググってください。

lexer.mll

字句解析を作ります。コンパイラの本では字句解析が先に書かれてますけど、lexerがparserを参照する形になるので、順番逆に書いてます。 字句解析は、テキストデータをトークン列として返すのが仕事です。 正規表現を使う事で、短く定義出来て、高速に動作する字句解析器を作る事が出来ます。

{
(* ここにプログラムを書く *)
open Parser
}

/* 変数定義 */
let space = [' ' '\t' '\n' '\r']
let digit = ['0'-'9']

/* 字句解析ルール */
rule token = parse
| space+ { token lexbuf }
| ..
and comment = parse
| "*/" { token lexbuf }

構造としてはこんな感じで、先頭の{}の中にプログラムを書いて、letで変数を定義して、ruleで字句解析のルールを書けます。ルール内のspace+ とかは正規表現で、+は1個以上の連続です。で、{}の中にルールを書きます。 ま、たぶん、習うより、慣れろです。最初はどこかの例を拾って来て修正してみる。 修正の数が多くなれば、なるほど分かって来ている事になります。

参考文献は、やっぱりググってください。

main.ml

パーサ作ったら、残すは変換部分のgen_java.mlと、main.mlだけです。 先にmain.mlを覗いてみましょう。

let trans input output =

  let inp = open_in input in
  let lexbuf = Lexing.from_channel inp in
  let ast = Parser.prog Lexer.token lexbuf in
  close_in inp;

  let out = open_out output in
  Gen_java.print_prog out ast;
  close_out out

let gomaj2java src =
  let len = String.length src in
  if String.sub src (len - 6) 6 = ".gomaj"
  then
    String.sub src 0 (len - 6) ^ ".java"
  else
    failwith "filename is bad."

let _ =
  let gomaj = Sys.argv.(1) in
  let java = gomaj2java(gomaj) in
  trans gomaj java

一番最後のlet _ = ... という箇所が、javaでいうstatic {} で、プログラムが読み込まれたときに動きます。メイン関数みたいな物です。

で、コマンドライン引数を取り出し、gomaj2javaで原始的な方法で、ファイル名の拡張子を.gomajから.javaに変換し、transでファイルを読み込みパースして、結果をGen_javaのprint_progに渡してファイルに出力してるだけです。簡単ですねw。なに？OCamlが分からないって？それは、失礼しましたー。

gen_java.ml

さて、最後はJavaを出力する所です。いくつかのポイントに絞って説明します。

ポイント1 block

奇麗にネストをつけて出力するためにspっていう変数に先頭の空白を用意しときます。 そして、blockっていう高階関数でその空白を上げ、blockを抜ければ下がるみたいに作っておきます。

そうすると、

        block begin fun () ->
          fprintf !fp "\n";
          print_s e;
          fprintf !fp "%s" ed
        end

等と書くだけで、ネストを書けるようになります。 高階関数使う嬉しさは、まるで構文を作っているように書ける事です。

ポイント2 print_ls

blockもそうですが、複数の出力を間に指定された文字列で区切って出力する高階関数、print_lsを作っておきます。これさえあれば、同じような事を何度も書かなくて済みます。

ポイント3 演算子の優先順位を管理して無駄な括弧を出力しない

面倒なら、全部かっこをつけて出力すればいいのですが、出力したjavaファイルの可読性が下がってしまいます。 人間なら脳内で演算子の優先順位を色々考えていい感じに書いてくれますが、プログラムは指示した事しかやってくれないので、優先順位を考慮して出力する必要があります。

構文木をトラバースして出力して行くのですが、そのときに優先順位を上から降らせて行く感じで書くとうまくいきます。アルゴリズムの詳細についてはOCamlのドキュメントのどこかに書いてあったので、探して見てください。＜参考文献書けよって？お金くれたら書きますw

infixs,prefixs,postfixsという演算子の表に、それぞれ、中置、前置、後置演算子の演算子名と、優先順位、左結合か右結合か等を入れておき、それぞれのトラバースの際にその優先順位を参照して、括弧が必要そうで左結合なら、優先順位がp1 <= pなら括弧を付け、右結合なら優先順位がp1 < pなら括弧を付けます。

以下のプログラムを見て下さい:

  | EBin(e1, op, e2) ->
    let (p1,l) = (M.find op infixs) in
    let paren = paren && (if l then p1 <= p else p1 < p) in
    if paren then fprintf !fp "(";
    print_e e1 ~p:(if l then p1 - 1 else p1 + 1);
    fprintf !fp "%s" op;
    print_e e2 ~p:p1;
    if paren then fprintf !fp ")"

降らせる優先順位は、左結合ならp1 - 1で右結合ならp1 + 1とします。

トラバースして出力

さ、ここまで分かれば後はトラバースするだけです。

また早口ですw

print_progでprog(プログラム)をprintし、print_sでs(文)をprintし、print_aでa(アクセス属性)をプリントし、print_tでt(型)をプリントし、print_eでe(式)をプリントします。疲れた。プリントプリントって言ってるだけじゃんw

コード量の少ないprint_tを見てみましょう:

let rec print_t = function

  | Ty(s) -> fprintf !fp "%s" s

  | TGen(s, t) ->
    begin match s with
      | "Array" ->
        print_t t;
        fprintf !fp "[]"
      | _ ->
        fprintf !fp "%s<" s;
        print_t t;
        fprintf !fp ">"
    end

Tyは型の名前が入っているのでそれを取り出してfprintfで出力するだけです。 TGenの場合は、Arrayなら特別で配列の表記にして書き出し、それ以外はジェネリックスの型として出力します。 それ以外の型はないので、ここに書き加えれば言い訳です。

まとめ

OCamlを使って、Javaに別シンタックスを与えるトランスレータ言語を作ってみました。 それほどたくさんの量を書かずに、トランスレータを書く事が出来ることが分かっていただけたかと思います。（馬鹿に出来る程、簡単ではない事も） パターンマッチングに似た機能を追加したり、publicやstaticを記号で書く事で短く書けるようにしたり、Scalaのようなコンストラクタの自動生成が出来るようにしたりする事が出来ました。

今回作成したトランスレータに型チェック等がありません。 型チェックを入れたり、全、Javaの機能を含めてはいませんので、オモチャレベルの物ですが、拡張して遊んでみてはいかがでしょうか？

明日は @jyukutyo さんの「JITWatchについて」です！

代数データ型を使ったゲームのアクター

OCaml

代数データ型を使ったゲームのアクター

ご挨拶

こんにちは、すっかり寒くなってインフルエンザにやられてしまったh_sakuraiです。 頭もやられて、ここ１週間ほどまったく進捗ありません。が、そろそろ復活したい所です。

昨日の記事ですが、@camloebaさん曰く

ありがとう！Windowsでも動くという情報がありました RT @no_maddo 
OCaml: merlinでcompilerのコードを補完できるようにする - (略)

とのことです。merlin便利そうですね。是非入れてみましょー。

ML Advent Calendar 2014の2日目の今日はOCamlでゲームを代数データ型を使ってゲームのキャラクターを作ってみます。

いくつか記事書こうと思うのでよろしくお願いします。

今日の話しは結論から先に書くとイマイチ良くないという結論になるのですけど、ネガティブキャンペーンをしようというわけではありません。そこはご理解ください。 白骨化した冒険者の日記があれば、次の冒険者は同じ過ちをしなくて済むってぇもんです。

はじめに

UnityではC#のコルーチン使えるのでコルーチンや継続を使った方が奇麗に書けます。でも、8bitのファミコン時代の時代からマルチスレッドでもないのにゲームのキャラクターは複数同時に動いていました。その辺の仕組みを関数型言語で書いてみます。

最初の例

最初は、配列のデータの中にキャラクターは存在しており、それが構造体のデータとして存在するようになったのでしょう。例えば左右に動くキャラクターがいた場合は、今は左に、今は右に動くと言った状態を持って動いていた事でしょう。

OCamlで書くと以下のようになります。

type state = left | right
type actor = Enemy of state
let move = function
  | Enemy(left) ->
    Printf.printf "left\n"; Enemy(right)
  | Enemy(right) ->
    Printf.printf "right\n"; Enemy(left)
let _ =
  let enemy = Enemy(left) in
  let enemy = move enemy in
  let enemy = move enemy in
  let enemy = move enemy in
  enemy

stateが左に動くか右に動くかを表します。 actorはキャラクターの種類を表しています。 move関数で動きを記述します。 最後に動かしてみると、

left
right
left

と表示されます。

関数に処理を分割する

これはこれで良いのですが、状態でswitchやmatchを書くのって関数が長々として気持悪いので、関数として分けたくなるので、以下のように書き換えます。

type state = left | right
type actor = Enemy of state
let move e = match e with
  | Enemy(left) -> move_left e 
  | Enemy(right) -> move_right e

and move_left = function
  | Enemy(_) ->
    Printf.printf "left\n"; Enemy(right)

and move_right = function
  | Enemy(_) ->
    Printf.printf "right\n"; Enemy(left)
let _ =
  let enemy = Enemy(left) in
  let enemy = move enemy in
  let enemy = move enemy in
  let enemy = move enemy in
  enemy

うう、こういう場合は、C言語より長くなって嬉しくないですね。でもまぁ、こうなります。

関数で状態を持つ

状態をイチイチ定義して関数を定義するのは面倒ですね。 関数を状態として持たせましょう。

type actor = Enemy of actor -> actor
let move = match e with
  | Enemy(m) -> m e
let move_left = function
  | Enemy(_) ->
    Printf.printf "left\n"; Enemy(move_right)
and move_right = function
  | Enemy(_) ->
    Printf.printf "right\n"; Enemy(move_left)
let _ =
  let enemy = Enemy(move_left) in
  let enemy = move enemy in
  let enemy = move enemy in
  let enemy = move enemy in
  enemy

短く書けるようになりました。

親子関係とモジュール化

次は、さらに種類を増やして親子関係を持たせてみます。 各、アクターはモジュールに分けてみます。

open Printf

type actor =
  | BG
  | Enemy of (actor -> actor)
  | Child of (actor -> actor) * actor
  | Parent of (actor -> actor) * (int->unit) * actor list ref

module Actor = struct

  let move e =
    match e with
    | BG -> printf("BG\n"); e
    | Enemy(m) -> m(e)
    | Child(m,_) -> m(e)
    | Parent(m,_,_) -> m(e)
end

module BG = struct
  let new_() = BG
end

module Enemy = struct
  let rec new_() = Enemy(move1)
  and move1 e =
    match e with
    | Enemy(m) ->
      printf("enemy move1\n");
      Enemy(move2)
    | _ -> assert false
  and move2 e =
    match e with
    | Enemy(m) ->
      printf("enemy move2\n");
      Enemy(move1)
    | _ -> assert false
end

module Child = struct
  let rec new_ p = Child(move1, p)
  and move1 this =
    match this with
    | Child(m,(Parent(_,msg,_) as p)) ->
      printf("child move1\n");
      msg(10);
      Child(move2,p)
    | _ -> assert false
  and move2 this =
    match this with
    | Child(m,(Parent(_,msg,_) as p)) ->
      printf("child move2\n");
      msg(10);
      Child(move1,p)
    | _ -> assert false
end

module Parent = struct
  let rec new_ () =
    let childs = ref [] in
    let p = Parent(move, msg, childs) in
    childs := [Child.new_ p; Child.new_ p];
    p
  and move this =
    match this with
    | Parent(m,_,childs) ->
      printf("parent\n");
      childs :=
        List.map(fun (child:actor)->
          Actor.move(child)
        ) !childs;
      this
    | _ -> assert false
  and msg i =
    printf "parent msg %d\n" i
end

let _ =
  let e = BG.new_()in
  let _ = Actor.move(e) in
  let e = Enemy.new_()in
  let e = Actor.move(e) in
  let _ = Actor.move(e) in
  let p = Parent.new_() in
  let _ = Actor.move(p) in
  ()

親子関係を持たせたゲームの動きがそれなりにかけました。 でも色々と嬉しくありません。

そうご参照する為に、リファレンスを使わなくては行けなくなるあたり、残念です。

何故嬉しくないのか？

何故嬉しくないのかと言うと、ゲームのアクターは垂直分割したいのに、水平分割するのに便利な機能を使ったからです。残念ながら、このようなケースでは嬉しくないですね。ありがとうございました。

ファンクタを使えばどうなるとかあるのかもしれませんが、あまり良い結果は得られないような気がします。 レコードを使う手もありますが、ま、本命はobjectでしょう。

そしてオブジェクト指向へ

という事で、明日はオブジェクト指向を使ってみます。

Scala Tutorialsを読む 30 Classes - continued

30 Classes - continued

30 クラスの続き

Uniform Access 統一アクセス

  • Scala's getters and setters use the principle of uniform access, e.g. if you change the implementation of a field declared var name to a method def name you will not need to recompile the code

  • Scalaのゲッターとセッターは統一アクセス原理等を使っています。あなたが名前defメソッドにフィールド宣言したVAR名の実装を変更する場合は、コードを再コンパイルする必要はありません

  • Therefore there can't be a variable or method (def, val or var, private or public) that has the same name in a class

  • そのため、そのクラスで同じ名前を持つ変数やメソッドが存在することはできません（def、valまたはvar、プライベートまたはパブリック）

Java style getters and setters Javaスタイルゲッター＆セッター

  • Scala's automatic getters and setters are following the uniform access principle, so the getter and setter name is the same as the field it encapsulates,

  • Scalaの自動ゲッターとセッターは統一アクセス原理をフォローしていて、ゲッターとセッターの名前は同じフィールドを包む。

  • However if you need to have Java client code accessing your Scala class, it's as easy as adding a @BeanProperty annotation to instruct the compiler to automatically add a Java bean style getter and setter.

  • しかしながら、JavaクライアントコードがScalaクラスにアクセスする場合は、簡単に@BeanPropertyアノテーションを追加出来る。指示通りにコンパイラにJavaビーンスタイルのゲッターとセッターを追加出来ます。

  • For boolean properties of style isFlag use @BooleanBeanProperty instead

  • スタイルisFlagのブーリアンプロパティの代わりに@BooleanBeanPropertyを使う。

See Also opens in new page

新しいページを開いて参照

  • More on Uniform Access Principle
  • 統一アクセス原理の詳細

Scala Tutorialsを読む 29 Classes

29 Classes

クラスの話は長いので、11日だけどあるていど書いてしまいます。３０で終わりなのでもう少しです！

29 クラス

http://scalatutorials.com/tour/interactive_tour_of_scala_classes.html

  • classes can be defined with minimal amount of code

  • クラスは最小限のコードで定義出来ます。

  • the class body, is also the default constructor's implementation

  • さらにクラス本体はデフォルトのコンストラクタの実装を含んでいます。

  • automatic getters are generated for the class parameters defined using val e.g.

  • 自動的にゲッターは生成されパラメータはvalを使って定義されます。
class Person(val name:String) //generates a private `name` variable, and a getter with the same name
  • automatic getters and setters are generated for class parameters defined using var e.g.
  • varを使っているクラスパラメータは自動的にゲッターとセッターが生成されます。
class Person(var name:String) //generates a private name variable, a getter and a setter with the same name
  • Important Note: the private variable with the same name as the automatic getter and setter exists only in byte code.
  • 重要なメモ: 自動生成されたゲッターとセッターと同じ名前のプライベート変数がバイトコードにのみ存在する。
  • It's not possible to recreate it using explicit scala getters and setters (having a method and a variable of the same name violates the uniform access principle, and scala's scoping rules).

  • 明示的にscalaのゲッターとセッターを再生成することは出来ません。(同じ名前のメソッドや変数を持つことは均一なアクセスの原則に違反して、Scalaのスコープ規則)

  • To create explicit getters and setters - the private variable must have a different name, some like to add an _ before it to designate it is private and local and avoid naming conflicts with public methods

  • 明示的なゲッターとセッターの生成するには - プライベート変数は別の名前を持っている必要があり、いくつかは、それがプライベートでローカルで指定し、パブリック·メソッドで名前の競合を避けるために前に_を追加したい
  • everything is public by default unless explicitly declared otherwise
  • 明示的に宣言されない限り、すべてのものは、デフォルトではpublicです

Scala Tutorialsを読む 28 Immutable collections with var

http://scalatutorials.com/tour/interactive_tour_of_scala_immutable_collections_with_var.html

28 Immutable collections with var

28 varでのイムータブルコレクション

One thing to note is the difference between the +=, +==, -=, -== etc functions regarding mutable and immutable collections.

１つ注意すべき点は+=,+==,-=,-==等の関数のmutableとimmutableコレクションの違いです。

  • For immutable collections - they are not methods of the collection (since it's not modifiable) but if used on an immutable collection declared with var instead of val then the Scala compiler expands them to variable = variable op param. (see on the left for an example)

  • イムータブルなコレクションでは - これらのメソッドはコレクションにありませんが、もしもimmutableコレクションをvalではなくvarを使って宣言した場合はScalaのコンパイラはvariable = variable op 引数に展開します。(左の例を見てください)

  • For mutable collections - they are actually methods on the collection, and they modify the collection when used.

  • ムータぶるなコレクションでは - これらのメソッドを持っており、使用した場合はコレクションは更新されます。