<commit_before>open Bulletml

let screen_w = 640
let screen_h = 480

let from_deg x =
  let pi = acos (-1.) in
  2. *. pi *. x /. 360.

type position = (float * float)

let (+:) (xa, ya) (xb, yb) =
  (xa +. xb, ya +. yb)

let (-:) (xa, ya) (xb, yb) =
  (xa -. xb, ya -. yb)

let ( *% ) (x, y) l =
  (x *. l, y *. l)

let unit_vec dir =
  (sin dir, cos dir)

let int_pos (x, y) =
  (int_of_float x, int_of_float y)

let rec eval e =
  let ev_op = function
    | Add -> ( +. )
    | Mul -> ( *. )
    | Sub -> ( -. )
    | Div -> ( /. )
    | Mod -> fun x y -> float (int_of_float x mod int_of_float y)
  in
  match e with
  | Num f -> f
  | Op (op, x, y) -> ev_op op (eval x) (eval y)
  | Rand -> Random.float 1.0
  | Param _ -> failwith "Param"
  | Rank -> 0.5

let eval_ind e = function
  | Direct x -> x
  | Indirect n -> List.assoc n e

type 'a linear_map =
  { frame_start : int
  ; frame_end : int
  ; val_start : 'a
  ; val_end : 'a
  }

type opcode =
  | OpRepeatE of expr * action
  | OpWaitE of expr
  | OpWaitN of int
  | OpFire of fire
  | OpSpdE of speed * expr
  | OpSpdN of float linear_map
  | OpDirE of direction * expr
  | OpDirN of float linear_map
  | OpAccelE of expr * expr * expr
  | OpAccelN of unit linear_map
  | OpVanish

type obj =
  { prog : opcode list
  ; speed : float
  ; dir : float
  ; children : obj list
  ; pos : position
  ; prev_dir : float
  ; vanished : bool
  }

type state =
  { frame : int
  ; action_env : (action id * action) list
  ; bullet_env : (bullet id * bullet) list
  ; fire_env : (fire id * fire) list
  ; main : obj
  }

let interp_map st m =
  let frames_done = float (st.frame - m.frame_start) in
  let frames_total = float (m.frame_end - m.frame_start) in
  m.val_start +. frames_done *. (m.val_end -. m.val_start) /. frames_total

let rec replicate n x =
  match n with
  | _ when n < 0 -> assert false
  | 0 -> []
  | _ -> x ::  replicate (n-1) x

let rec build_prog st next = function
  | Repeat (e_n, ai) ->
    let a = eval_ind st.action_env ai in
    OpRepeatE (e_n, a) :: next
  | Wait e_n -> OpWaitE e_n :: next
  | Fire fi ->
    let f = eval_ind st.fire_env fi in
    OpFire f :: next
  | ChangeSpeed (s, e) -> OpSpdE (s, e) :: next
  | ChangeDirection (d, e) -> OpDirE (d, e) :: next
  | Accel (ho, vo, e) ->
    let default = function
      | Some x -> x
      | None -> Num 0.0
    in
    OpAccelE (default ho, default vo, e)::next
  | Vanish -> OpVanish :: next
  | Action ai ->
    let a = eval_ind st.action_env ai in
    seq_prog st a next

and seq_prog st act next =
  List.fold_right
    (fun a k -> build_prog st k a)
    act
    next

let read_prog (BulletML (hv, ts)) =
  let ae = ref [] in
  let be = ref [] in
  let fe = ref [] in
  List.iter (function
      | EAction (l, a) -> ae := (l, a)::!ae
      | EBullet (l, b) -> be := (l, b)::!be
      | EFire (l, f) -> fe := (l, f)::!fe
    ) ts;
  (!ae, !be, !fe)

let initial_state ae be fe k =
  { frame = 0
  ; action_env = ae
  ; bullet_env = be
  ; fire_env = fe
  ; main =
      { prog = k
      ; speed = 0.0
      ; dir = 0.0
      ; children = []
      ; pos = (float screen_w /. 2., float screen_h *. 0.3)
      ; prev_dir = 0.0
      ; vanished = false
      }
  }

let dir_to_ship obj =
  let ship_pos = (float screen_w /. 2., float screen_h *.0.9) in
  let (vx, vy) = (ship_pos -: obj.pos) in
  atan2 vy vx

let dir_to_prev obj =
  obj.prev_dir

let repeat_prog st n act next =
  seq_prog st (List.concat (replicate n act)) next

let eval_dir self = function
  | DirAbs e -> eval e
  | DirAim e -> eval e +. dir_to_ship self
  | DirSeq e -> eval e +. dir_to_prev self
  | DirRel e -> eval e +. self.dir

let eval_speed self = function
  | SpdAbs e -> eval e
  | SpdRel e -> eval e +. self.speed
  | SpdSeq e -> eval e (* FIXME *)

let make_bullet st self spd dir = function
  | Bullet (None, None, ais) ->
    let sas: action = List.map (fun ai -> Action ai) ais in
    let ops: opcode list = seq_prog st sas [] in
    { self with
      speed = spd
    ; dir = dir
    ; prog = ops
    ; children = []
    }

let rec next_prog st self :obj = match self.prog with
  | [] -> self
  | OpRepeatE (n_e, a)::k ->
    let n = int_of_float (eval n_e) in
    next_prog st { self with prog = repeat_prog st n a k }
  | OpWaitE n_e::k ->
    let n = int_of_float (eval n_e) in
    next_prog st { self with prog = OpWaitN n::k }
  | OpWaitN 0::k -> next_prog st { self with prog = k }
  | OpWaitN 1::k -> { self with prog = k }
  | OpWaitN n::k -> { self with prog = OpWaitN (n-1)::k }
  | OpFire (dir_o, spd_o, bi)::k ->
    let d =
      match dir_o with
      | Some dir -> eval_dir self dir
      | None -> self.dir
    in
    let s = match spd_o with
      | Some spd -> eval_speed self spd
      | None -> self.speed
    in
    let bullet = eval_ind st.bullet_env bi in
    let o = make_bullet st self s d bullet in
    { self with prog = k ; children = o::self.children }
  | OpSpdE (sp_e, t_e)::k ->
    let sp = match sp_e with
      | SpdAbs e -> eval e
      | _ -> assert false
    in
    let t = int_of_float (eval t_e) in
    let m =
      { frame_start = st.frame
      ; frame_end = st.frame + t
      ; val_start = self.speed
      ; val_end = sp
      }
    in
    next_prog st { self with prog = OpSpdN m::k }
  | OpSpdN m::k ->
    if st.frame > m.frame_end then
      { self with prog = k }
    else
      { self with speed = interp_map st m }<commit_msg>Allow spd/dir override in bullet<commit_after>open Bulletml

let screen_w = 640
let screen_h = 480

let from_deg x =
  let pi = acos (-1.) in
  2. *. pi *. x /. 360.

type position = (float * float)

let (+:) (xa, ya) (xb, yb) =
  (xa +. xb, ya +. yb)

let (-:) (xa, ya) (xb, yb) =
  (xa -. xb, ya -. yb)

let ( *% ) (x, y) l =
  (x *. l, y *. l)

let unit_vec dir =
  (sin dir, cos dir)

let int_pos (x, y) =
  (int_of_float x, int_of_float y)

let rec eval e =
  let ev_op = function
    | Add -> ( +. )
    | Mul -> ( *. )
    | Sub -> ( -. )
    | Div -> ( /. )
    | Mod -> fun x y -> float (int_of_float x mod int_of_float y)
  in
  match e with
  | Num f -> f
  | Op (op, x, y) -> ev_op op (eval x) (eval y)
  | Rand -> Random.float 1.0
  | Param _ -> failwith "Param"
  | Rank -> 0.5

let eval_ind e = function
  | Direct x -> x
  | Indirect n -> List.assoc n e

type 'a linear_map =
  { frame_start : int
  ; frame_end : int
  ; val_start : 'a
  ; val_end : 'a
  }

type opcode =
  | OpRepeatE of expr * action
  | OpWaitE of expr
  | OpWaitN of int
  | OpFire of fire
  | OpSpdE of speed * expr
  | OpSpdN of float linear_map
  | OpDirE of direction * expr
  | OpDirN of float linear_map
  | OpAccelE of expr * expr * expr
  | OpAccelN of unit linear_map
  | OpVanish

type obj =
  { prog : opcode list
  ; speed : float
  ; dir : float
  ; children : obj list
  ; pos : position
  ; prev_dir : float
  ; vanished : bool
  }

type state =
  { frame : int
  ; action_env : (action id * action) list
  ; bullet_env : (bullet id * bullet) list
  ; fire_env : (fire id * fire) list
  ; main : obj
  }

let interp_map st m =
  let frames_done = float (st.frame - m.frame_start) in
  let frames_total = float (m.frame_end - m.frame_start) in
  m.val_start +. frames_done *. (m.val_end -. m.val_start) /. frames_total

let rec replicate n x =
  match n with
  | _ when n < 0 -> assert false
  | 0 -> []
  | _ -> x ::  replicate (n-1) x

let rec build_prog st next = function
  | Repeat (e_n, ai) ->
    let a = eval_ind st.action_env ai in
    OpRepeatE (e_n, a) :: next
  | Wait e_n -> OpWaitE e_n :: next
  | Fire fi ->
    let f = eval_ind st.fire_env fi in
    OpFire f :: next
  | ChangeSpeed (s, e) -> OpSpdE (s, e) :: next
  | ChangeDirection (d, e) -> OpDirE (d, e) :: next
  | Accel (ho, vo, e) ->
    let default = function
      | Some x -> x
      | None -> Num 0.0
    in
    OpAccelE (default ho, default vo, e)::next
  | Vanish -> OpVanish :: next
  | Action ai ->
    let a = eval_ind st.action_env ai in
    seq_prog st a next

and seq_prog st act next =
  List.fold_right
    (fun a k -> build_prog st k a)
    act
    next

let read_prog (BulletML (hv, ts)) =
  let ae = ref [] in
  let be = ref [] in
  let fe = ref [] in
  List.iter (function
      | EAction (l, a) -> ae := (l, a)::!ae
      | EBullet (l, b) -> be := (l, b)::!be
      | EFire (l, f) -> fe := (l, f)::!fe
    ) ts;
  (!ae, !be, !fe)

let initial_state ae be fe k =
  { frame = 0
  ; action_env = ae
  ; bullet_env = be
  ; fire_env = fe
  ; main =
      { prog = k
      ; speed = 0.0
      ; dir = 0.0
      ; children = []
      ; pos = (float screen_w /. 2., float screen_h *. 0.3)
      ; prev_dir = 0.0
      ; vanished = false
      }
  }

let dir_to_ship obj =
  let ship_pos = (float screen_w /. 2., float screen_h *.0.9) in
  let (vx, vy) = (ship_pos -: obj.pos) in
  atan2 vy vx

let dir_to_prev obj =
  obj.prev_dir

let repeat_prog st n act next =
  seq_prog st (List.concat (replicate n act)) next

let eval_dir self = function
  | DirAbs e -> eval e
  | DirAim e -> eval e +. dir_to_ship self
  | DirSeq e -> eval e +. dir_to_prev self
  | DirRel e -> eval e +. self.dir

let eval_speed self = function
  | SpdAbs e -> eval e
  | SpdRel e -> eval e +. self.speed
  | SpdSeq e -> eval e (* FIXME *)

let rec next_prog st self :obj = match self.prog with
  | [] -> self
  | OpRepeatE (n_e, a)::k ->
    let n = int_of_float (eval n_e) in
    next_prog st { self with prog = repeat_prog st n a k }
  | OpWaitE n_e::k ->
    let n = int_of_float (eval n_e) in
    next_prog st { self with prog = OpWaitN n::k }
  | OpWaitN 0::k -> next_prog st { self with prog = k }
  | OpWaitN 1::k -> { self with prog = k }
  | OpWaitN n::k -> { self with prog = OpWaitN (n-1)::k }
  | OpFire (dir_o, spd_o, bi)::k ->
    let Bullet (dir_b, spd_b, ais) = eval_ind st.bullet_env bi in
    let d =
      match dir_b with
      | Some dir -> eval_dir self dir
      | None ->
        match dir_o with
        | Some dir -> eval_dir self dir
        | None -> self.dir
    in
    let s = match spd_b with
      | Some s -> eval_speed self s
      | None ->
        match spd_o with
        | Some spd -> eval_speed self spd
        | None -> self.speed
    in
    let sas: action = List.map (fun ai -> Action ai) ais in
    let ops: opcode list = seq_prog st sas [] in
    let o =
      { self with
        speed = s
      ; dir = d
      ; prog = ops
      ; children = []
      }
    in
    { self with prog = k ; children = o::self.children }
  | OpSpdE (sp_e, t_e)::k ->
    let sp = match sp_e with
      | SpdAbs e -> eval e
      | _ -> assert false
    in
    let t = int_of_float (eval t_e) in
    let m =
      { frame_start = st.frame
      ; frame_end = st.frame + t
      ; val_start = self.speed
      ; val_end = sp
      }
    in
    next_prog st { self with prog = OpSpdN m::k }
  | OpSpdN m::k ->
    if st.frame > m.frame_end then
      { self with prog = k }
    else
      { self with speed = interp_map st m }
{'fraction_non_alphanumeric': 0.1306537264237319, 'fraction_numerical': 0.006775315876213148, 'mean_word_length': 2.0149047750483025, 'pattern_counts': {'":': 0, '<': 5, '<?xml version=': 0, '>': 116, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '6755849', 'n_tokens_mistral': 4433, 'n_tokens_neox': 4294, 'n_words': 1444}