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