~tim-ats-d/Faraway

3775e552f4a7006ea31f779aeadbf572bc5a3a10 — Tim-ats-d 1 year, 6 months ago b642e27
Simplify npc behavior and printing routine.
M lib/biome.ml => lib/biome.ml +5 -2
@@ 5,12 5,15 @@ type t = {
  style : Attr.t;
  weight : int;
  cells : Cell.t array;
  npcs : Npc.Dumb.t array;
  npcs : Npc.t array;
  population : int;
}

let repr t = t.repr
let style t = t.style

let pp ppf { repr; style; _ } =
  Format.fprintf ppf "%a" (Img.pp_attr style Format.pp_print_uchar) repr

let cells t = t.cells
let weight t = t.weight
let population t = t.population

M lib/biome.mli => lib/biome.mli +3 -3
@@ 9,7 9,7 @@ type t
val make :
  ?style:Notty.attr ->
  ?weight:int ->
  ?npcs:Npc.Dumb.t array ->
  ?npcs:Npc.t array ->
  ?population:int ->
  repr:Uchar.t ->
  cells:Cell.t array ->


@@ 23,9 23,9 @@ val population : t -> int
(** [population biome] is maximum bound (exclusive) of spawnable npcs in
    [biome]. *)

val npcs : t -> Npc.Dumb.t array
val npcs : t -> Npc.t array
(** [npcs biome] are npcs spawnable in [biome]. *)

include Types.REPR with type t := t
include Types.STYLIZABLE with type t := t
include Types.PP with type t := t
include Types.WEIGHABLE with type t := t

M lib/cell.ml => lib/cell.ml +4 -1
@@ 33,8 33,11 @@ module Action = struct
  let set_player p = [ SetPlayer p ]
end

let repr c = c.repr
let style c = c.style

let pp ppf { repr; style; _ } =
  Format.fprintf ppf "%a" (Img.pp_attr style Format.pp_print_uchar) repr

let cross t = t.cross
let on_hover t = t.on_hover
let dir c = c.dir

M lib/cell.mli => lib/cell.mli +1 -1
@@ 34,8 34,8 @@ val on_hover : t -> Player.t -> action list
val dir : t -> bool Types.Dir.t

include Types.EQUAL with type t := t
include Types.REPR with type t := t
include Types.STYLIZABLE with type t := t
include Types.PP with type t := t
include Types.WEIGHABLE with type t := t

module Action : sig

M lib/faraway.ml => lib/faraway.ml +7 -7
@@ 122,7 122,7 @@ let test =
    ~style:Attr.(fg lightblue ++ bg magenta)
    ~cells:
      [|
        Cell.make (Uchar.of_char ' ') ~weight:30 ~style:Attr.(fg black);
        Cell.make (Uchar.of_char ' ') ~weight:30;
        Cell.make (to_uchar "╭") ~right:true ~down:true ~style
          ~cross:(NeedItem (Inventory.mem iron_barque));
        Cell.make (to_uchar "╮") ~left:true ~down:true ~style


@@ 149,15 149,15 @@ let test =
      |]
    ~npcs:
      [|
        Npc.Dumb.make ~repr:(Uchar.of_char '@')
        Npc.make ~repr:(Uchar.of_char '@')
          ~style:Attr.(fg yellow)
          ~think ~personality:`Extrovert ();
        Npc.Dumb.make ~repr:(Uchar.of_char '8')
          ~personality:`Extrovert ();
        Npc.make ~repr:(Uchar.of_char '8')
          ~style:Attr.(fg magenta)
          ~think ~personality:`Introvert ();
        Npc.Dumb.make ~repr:(Uchar.of_char '$')
          ~personality:`Introvert ();
        Npc.make ~repr:(Uchar.of_char '$')
          ~style:Attr.(fg blue)
          ~think ~personality:`Schizophrenic ();
          ~personality:`Schizophrenic ();
      |]
    ~population:3 ()


M lib/faraway_impl.ml => lib/faraway_impl.ml +2 -2
@@ 146,7 146,7 @@ module Make (Key : Key.S) : S = struct
      Map.Chunk.get map ~global:coord ~local:(Player.coord player)
      |> Option.get |> Cell.style
    in
    Img.uchar Attr.(bg_cell ++ Player.style player) (Player.repr player) 1 1
    Img.strf ~attr:bg_cell "%a" Player.pp player
    |> Img.hpad (Player.coord player).col 0
    |> Img.vpad (Player.coord player).row 0



@@ 159,7 159,7 @@ module Make (Key : Key.S) : S = struct
          Map.Chunk.get map ~global:coord ~local:pcoord
          |> Option.get |> Cell.style
        in
        Img.uchar Attr.(bg_cell ++ Npc.style npc) (Npc.repr npc) 1 1
        Img.strf ~attr:bg_cell "%a" Npc.pp npc
        |> Img.hpad pcoord.col 0 |> Img.vpad pcoord.row 0 </> img)
      (Img.void size.row size.col)
      npcs

M lib/import.ml => lib/import.ml +9 -0
@@ 16,6 16,15 @@ module Array = struct
    !r
end

module Format = struct
  include Format

  let pp_print_uchar ppf u =
    let buf = Buffer.create 3 in
    Buffer.add_utf_8_uchar buf u;
    pp_print_string ppf (Buffer.contents buf)
end

module Misc = struct
  let foldi n acc f =
    let rec loop i acc = if i = n then acc else loop (i + 1) (f acc) in

M lib/import.mli => lib/import.mli +8 -0
@@ 23,6 23,14 @@ module Array : sig
  (** [foldi f acc arr] is [Array.fold_left] with current index passed to [f]. *)
end

module Format : sig
  (** Extending [Format] module of stdlib. *)

  include module type of Format

  val pp_print_uchar : Format.formatter -> Uchar.t -> unit
end

module Random : sig
  (** Extending [Random] module of stdlib. *)


M lib/item.ml => lib/item.ml +0 -1
@@ 7,7 7,6 @@ type t = {
  effects : Effect.t list;
}

let style t = t.style
let name t = t.name
let stackable t = t.stackable
let effects t = t.effects

M lib/item.mli => lib/item.mli +1 -3
@@ 10,9 10,7 @@ val name : t -> string
val stackable : t -> bool
val effects : t -> Effect.t list

include Types.STYLIZABLE with type t := t

val make :
  ?effects:Effect.t list -> ?style:Notty.attr -> ?stackable:bool -> string -> t

val pp : Format.formatter -> t -> unit
include Types.PP with type t := t

M lib/map.ml => lib/map.ml +3 -8
@@ 109,15 109,10 @@ let to_image ~(player_coord : Coord.t) ~(player : Player.t) map =
                  ~row:(map.min_y + player_coord.row)
                  ~col:(map.max_x + player_coord.col)
                = coord
              then
                Img.uchar
                  Attr.(Player.style player ++ Biome.style biome)
                  (Player.repr player) 1 1
              else Img.uchar (Biome.style biome) (Biome.repr biome) 1 1
              then Img.strf ~attr:(Biome.style biome) "%a" Player.pp player
              else Img.strf "%a" Biome.pp biome
            in
            Img.between
              (Img.uchar (Biome.style biome) (Biome.repr biome) 1 1)
              middle)
            Img.between (Img.strf "%a" Biome.pp biome) middle)
      in
      line := !line <|> biome
    done;

M lib/npc.ml => lib/npc.ml +28 -28
@@ 6,40 6,33 @@ type behavior = [ `ApproachPlayer | `EscapePlayer | `Wait | `Walk ]
let personalities = [| `Extrovert; `Introvert; `Schizophrenic |]
let behaviors = [| `ApproachPlayer; `EscapePlayer; `Wait; `Walk |]

module Dumb = struct
  type t = {
    repr : Uchar.t;
    style : Attr.t;
    think : personality -> behavior -> int;
    personality : personality;
  }
type t = {
  repr : Uchar.t;
  style : Attr.t;
  coord : Coord.t;
  personality : personality;
}

  let make ?personality ~repr ~style ~think () =
    let personality =
      Option.value personality
        ~default:
          (Random.choose ~mode:Element personalities (fun _ -> 1) |> Option.get)
    in

    { repr; style; think; personality }
end

type t = { coord : Coord.t; dumb : Dumb.t; personality : personality }
let make ?personality ~repr ~style () =
  let personality =
    Option.value personality
      ~default:
        (Random.choose ~mode:Element personalities (fun _ -> 1) |> Option.get)
  in
  { repr; style; coord = Types.Coord.null; personality }

let spawn dumb ~range =
let spawn t ~range =
  let coord =
    Types.Coord.make
      ~col:(Random.choose_interval ~default:0 range.Coord.col)
      ~row:(Random.choose_interval ~default:0 range.Coord.row)
  in
  let personality =
    Random.choose ~mode:Element personalities (fun _ -> 1) |> Option.get
  in
  { dumb; coord; personality }
  { t with coord }

let coord t = t.coord
let repr t = t.dumb.repr
let style t = t.dumb.style

let pp ppf { repr; style; _ } =
  Format.fprintf ppf "%a" (Img.pp_attr style Format.pp_print_uchar) repr

let neighborhood range { Coord.col; row } =
  match (col, row) with


@@ 111,10 104,17 @@ let neighborhood range { Coord.col; row } =
        Coord.make ~col:(col + 1) ~row:(row + 1);
      |]

let think = function
  | `Extrovert -> (
      function
      | `ApproachPlayer -> 5 | `EscapePlayer -> 0 | `Walk -> 1 | `Wait -> 5)
  | `Introvert -> (
      function
      | `ApproachPlayer -> 0 | `EscapePlayer -> 5 | `Walk -> 1 | `Wait -> 5)
  | `Schizophrenic -> ( function _ -> 1)

let behave t =
  t.dumb.think t.personality
  |> Random.choose ~mode:Element behaviors
  |> Option.get
  think t.personality |> Random.choose ~mode:Element behaviors |> Option.get

let neighbor cmp range t player =
  let cmp : int -> int -> bool =

M lib/npc.mli => lib/npc.mli +5 -15
@@ 6,20 6,11 @@ type personality = [ `Extrovert | `Introvert | `Schizophrenic ]
type behavior = [ `ApproachPlayer | `EscapePlayer | `Wait | `Walk ]
type t

module Dumb : sig
  type t
val make :
  ?personality:personality -> repr:Uchar.t -> style:Notty.attr -> unit -> t
(** If [personality] is ommited, personality is choosen randomly. *)

  val make :
    ?personality:personality ->
    repr:Uchar.t ->
    style:Notty.attr ->
    think:(personality -> behavior -> int) ->
    unit ->
    t
  (** If [personality] is ommited, personality is choosen randomly. *)
end

val spawn : Dumb.t -> range:Types.Coord.t -> t
val spawn : t -> range:Types.Coord.t -> t
val coord : t -> Types.Coord.t

val move :


@@ 29,5 20,4 @@ val move :
  t ->
  t

include Types.REPR with type t := t
include Types.STYLIZABLE with type t := t
include Types.PP with type t := t

M lib/player.ml => lib/player.ml +3 -2
@@ 9,10 9,11 @@ type t = {
}

let coord t = t.coord
let repr t = t.repr
let style t = t.style
let inventory t = t.inventory

let pp ppf { repr; style; _ } =
  Format.fprintf ppf "%a" (Img.pp_attr style Format.pp_print_uchar) repr

let make ~repr ~style =
  { coord = Coord.null; repr; style; effects = []; inventory = Inventory.empty }


M lib/player.mli => lib/player.mli +1 -2
@@ 9,8 9,7 @@ type t
val coord : t -> Types.Coord.t
val inventory : t -> Inventory.t

include Types.REPR with type t := t
include Types.STYLIZABLE with type t := t
include Types.PP with type t := t

val set_coord : t -> Types.Coord.t -> t
val set_repr : t -> Uchar.t -> t

M lib/procedural.ml => lib/procedural.ml +1 -1
@@ 127,7 127,7 @@ let to_image { delta; matrix; _ } cells =
        match CellBit.loc bit with Default -> cells | Delta -> delta
      in
      let cell = location.!(CellBit.index bit) in
      line := !line <|> Img.uchar (Cell.style cell) (Cell.repr cell) 1 1
      line := !line <|> Img.strf "%a" Cell.pp cell
    done;
    img := !img <-> !line
  done;

M lib/types.ml => lib/types.ml +4 -4
@@ 45,16 45,16 @@ module type EQUAL = sig
  val equal : t -> t -> bool
end

module type REPR = sig
module type STYLIZABLE = sig
  type t

  val repr : t -> Uchar.t
  val style : t -> Notty.attr
end

module type STYLIZABLE = sig
module type PP = sig
  type t

  val style : t -> Notty.attr
  val pp : Format.formatter -> t -> unit
end

module type WEIGHABLE = sig

M lib/types.mli => lib/types.mli +4 -4
@@ 54,16 54,16 @@ module type EQUAL = sig
  val equal : t -> t -> bool
end

module type REPR = sig
module type STYLIZABLE = sig
  type t

  val repr : t -> Uchar.t
  val style : t -> Notty.attr
end

module type STYLIZABLE = sig
module type PP = sig
  type t

  val style : t -> Notty.attr
  val pp : Format.formatter -> t -> unit
end

module type WEIGHABLE = sig