From de081d7b1d0b791b2e61f9cde7369ea11647e0ae Mon Sep 17 00:00:00 2001 From: Griffin Smith Date: Fri, 5 Jul 2019 22:45:57 -0400 Subject: an @-sign in a box --- .gitignore | 3 + Cargo.lock | 1145 +++++++++++++++++++++++++++++ Cargo.toml | 21 + Config.toml | 2 + proptest-regressions/display/draw_box.txt | 12 + proptest-regressions/types/mod.txt | 7 + rustfmt.toml | 1 + src/cli.yml | 14 + src/display/draw_box.rs | 205 ++++++ src/display/mod.rs | 9 + src/display/utils.rs | 9 + src/entities/character.rs | 15 + src/entities/mod.rs | 1 + src/game.rs | 118 +++ src/main.rs | 73 ++ src/settings.rs | 61 ++ src/types/command.rs | 23 + src/types/direction.rs | 9 + src/types/mod.rs | 296 ++++++++ 19 files changed, 2024 insertions(+) create mode 100644 .gitignore create mode 100644 Cargo.lock create mode 100644 Cargo.toml create mode 100644 Config.toml create mode 100644 proptest-regressions/display/draw_box.txt create mode 100644 proptest-regressions/types/mod.txt create mode 100644 rustfmt.toml create mode 100644 src/cli.yml create mode 100644 src/display/draw_box.rs create mode 100644 src/display/mod.rs create mode 100644 src/display/utils.rs create mode 100644 src/entities/character.rs create mode 100644 src/entities/mod.rs create mode 100644 src/game.rs create mode 100644 src/main.rs create mode 100644 src/settings.rs create mode 100644 src/types/command.rs create mode 100644 src/types/direction.rs create mode 100644 src/types/mod.rs diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000000..47c274db4e --- /dev/null +++ b/.gitignore @@ -0,0 +1,3 @@ +/target +**/*.rs.bk +debug.log diff --git a/Cargo.lock b/Cargo.lock new file mode 100644 index 0000000000..5eacba2125 --- /dev/null +++ b/Cargo.lock @@ -0,0 +1,1145 @@ +# This file is automatically @generated by Cargo. +# It is not intended for manual editing. +[[package]] +name = "adler32" +version = "1.0.3" +source = "registry+https://github.com/rust-lang/crates.io-index" + +[[package]] +name = "aho-corasick" +version = "0.7.3" +source = "registry+https://github.com/rust-lang/crates.io-index" +dependencies = [ + "memchr 2.2.0 (registry+https://github.com/rust-lang/crates.io-index)", +] + +[[package]] +name = "ansi_term" +version = "0.11.0" +source = "registry+https://github.com/rust-lang/crates.io-index" +dependencies = [ + "winapi 0.3.7 (registry+https://github.com/rust-lang/crates.io-index)", +] + +[[package]] +name = "antidote" +version = "1.0.0" +source = "registry+https://github.com/rust-lang/crates.io-index" + +[[package]] +name = "arc-swap" +version = "0.3.11" +source = "registry+https://github.com/rust-lang/crates.io-index" + +[[package]] +name = "argon2rs" +version = "0.2.5" +source = "registry+https://github.com/rust-lang/crates.io-index" +dependencies = [ + "blake2-rfc 0.2.18 (registry+https://github.com/rust-lang/crates.io-index)", + "scoped_threadpool 0.1.9 (registry+https://github.com/rust-lang/crates.io-index)", +] + +[[package]] +name = "arrayvec" +version = "0.4.10" +source = "registry+https://github.com/rust-lang/crates.io-index" +dependencies = [ + "nodrop 0.1.13 (registry+https://github.com/rust-lang/crates.io-index)", +] + +[[package]] +name = "atty" +version = "0.2.11" +source = "registry+https://github.com/rust-lang/crates.io-index" +dependencies = [ + "libc 0.2.58 (registry+https://github.com/rust-lang/crates.io-index)", + "termion 1.5.2 (registry+https://github.com/rust-lang/crates.io-index)", + "winapi 0.3.7 (registry+https://github.com/rust-lang/crates.io-index)", +] + +[[package]] +name = "autocfg" +version = "0.1.4" +source = "registry+https://github.com/rust-lang/crates.io-index" + +[[package]] +name = "backtrace" +version = "0.3.32" +source = "registry+https://github.com/rust-lang/crates.io-index" +dependencies = [ + "backtrace-sys 0.1.30 (registry+https://github.com/rust-lang/crates.io-index)", + "cfg-if 0.1.9 (registry+https://github.com/rust-lang/crates.io-index)", + "libc 0.2.58 (registry+https://github.com/rust-lang/crates.io-index)", + "rustc-demangle 0.1.15 (registry+https://github.com/rust-lang/crates.io-index)", +] + +[[package]] +name = "backtrace-sys" +version = "0.1.30" +source = "registry+https://github.com/rust-lang/crates.io-index" +dependencies = [ + "cc 1.0.37 (registry+https://github.com/rust-lang/crates.io-index)", + "libc 0.2.58 (registry+https://github.com/rust-lang/crates.io-index)", +] + +[[package]] +name = "bit-set" +version = "0.5.1" +source = "registry+https://github.com/rust-lang/crates.io-index" +dependencies = [ + "bit-vec 0.5.1 (registry+https://github.com/rust-lang/crates.io-index)", +] + +[[package]] +name = "bit-vec" +version = "0.5.1" +source = "registry+https://github.com/rust-lang/crates.io-index" + +[[package]] +name = "bitflags" +version = "1.1.0" +source = "registry+https://github.com/rust-lang/crates.io-index" + +[[package]] +name = "blake2-rfc" +version = "0.2.18" +source = "registry+https://github.com/rust-lang/crates.io-index" +dependencies = [ + "arrayvec 0.4.10 (registry+https://github.com/rust-lang/crates.io-index)", + "constant_time_eq 0.1.3 (registry+https://github.com/rust-lang/crates.io-index)", +] + +[[package]] +name = "bstr" +version = "0.2.1" +source = "registry+https://github.com/rust-lang/crates.io-index" +dependencies = [ + "lazy_static 1.3.0 (registry+https://github.com/rust-lang/crates.io-index)", + "memchr 2.2.0 (registry+https://github.com/rust-lang/crates.io-index)", + "regex-automata 0.1.7 (registry+https://github.com/rust-lang/crates.io-index)", + "serde 1.0.92 (registry+https://github.com/rust-lang/crates.io-index)", +] + +[[package]] +name = "build_const" +version = "0.2.1" +source = "registry+https://github.com/rust-lang/crates.io-index" + +[[package]] +name = "byteorder" +version = "1.3.1" +source = "registry+https://github.com/rust-lang/crates.io-index" + +[[package]] +name = "cc" +version = "1.0.37" +source = "registry+https://github.com/rust-lang/crates.io-index" + +[[package]] +name = "cfg-if" +version = "0.1.9" +source = "registry+https://github.com/rust-lang/crates.io-index" + +[[package]] +name = "chrono" +version = "0.4.6" +source = "registry+https://github.com/rust-lang/crates.io-index" +dependencies = [ + "num-integer 0.1.41 (registry+https://github.com/rust-lang/crates.io-index)", + "num-traits 0.2.8 (registry+https://github.com/rust-lang/crates.io-index)", + "time 0.1.42 (registry+https://github.com/rust-lang/crates.io-index)", +] + +[[package]] +name = "clap" +version = "2.33.0" +source = "registry+https://github.com/rust-lang/crates.io-index" +dependencies = [ + "ansi_term 0.11.0 (registry+https://github.com/rust-lang/crates.io-index)", + "atty 0.2.11 (registry+https://github.com/rust-lang/crates.io-index)", + "bitflags 1.1.0 (registry+https://github.com/rust-lang/crates.io-index)", + "strsim 0.8.0 (registry+https://github.com/rust-lang/crates.io-index)", + "textwrap 0.11.0 (registry+https://github.com/rust-lang/crates.io-index)", + "unicode-width 0.1.5 (registry+https://github.com/rust-lang/crates.io-index)", + "vec_map 0.8.1 (registry+https://github.com/rust-lang/crates.io-index)", + "yaml-rust 0.3.5 (registry+https://github.com/rust-lang/crates.io-index)", +] + +[[package]] +name = "cloudabi" +version = "0.0.3" +source = "registry+https://github.com/rust-lang/crates.io-index" +dependencies = [ + "bitflags 1.1.0 (registry+https://github.com/rust-lang/crates.io-index)", +] + +[[package]] +name = "config" +version = "0.9.3" +source = "registry+https://github.com/rust-lang/crates.io-index" +dependencies = [ + "lazy_static 1.3.0 (registry+https://github.com/rust-lang/crates.io-index)", + "nom 4.2.3 (registry+https://github.com/rust-lang/crates.io-index)", + "rust-ini 0.13.0 (registry+https://github.com/rust-lang/crates.io-index)", + "serde 1.0.92 (registry+https://github.com/rust-lang/crates.io-index)", + "serde-hjson 0.8.2 (registry+https://github.com/rust-lang/crates.io-index)", + "serde_json 1.0.39 (registry+https://github.com/rust-lang/crates.io-index)", + "toml 0.4.10 (registry+https://github.com/rust-lang/crates.io-index)", + "yaml-rust 0.4.3 (registry+https://github.com/rust-lang/crates.io-index)", +] + +[[package]] +name = "constant_time_eq" +version = "0.1.3" +source = "registry+https://github.com/rust-lang/crates.io-index" + +[[package]] +name = "crc" +version = "1.8.1" +source = "registry+https://github.com/rust-lang/crates.io-index" +dependencies = [ + "build_const 0.2.1 (registry+https://github.com/rust-lang/crates.io-index)", +] + +[[package]] +name = "crc32fast" +version = "1.2.0" +source = "registry+https://github.com/rust-lang/crates.io-index" +dependencies = [ + "cfg-if 0.1.9 (registry+https://github.com/rust-lang/crates.io-index)", +] + +[[package]] +name = "csv" +version = "1.1.1" +source = "registry+https://github.com/rust-lang/crates.io-index" +dependencies = [ + "bstr 0.2.1 (registry+https://github.com/rust-lang/crates.io-index)", + "csv-core 0.1.6 (registry+https://github.com/rust-lang/crates.io-index)", + "itoa 0.4.4 (registry+https://github.com/rust-lang/crates.io-index)", + "ryu 1.0.0 (registry+https://github.com/rust-lang/crates.io-index)", + "serde 1.0.92 (registry+https://github.com/rust-lang/crates.io-index)", +] + +[[package]] +name = "csv-core" +version = "0.1.6" +source = "registry+https://github.com/rust-lang/crates.io-index" +dependencies = [ + "memchr 2.2.0 (registry+https://github.com/rust-lang/crates.io-index)", +] + +[[package]] +name = "dirs" +version = "1.0.5" +source = "registry+https://github.com/rust-lang/crates.io-index" +dependencies = [ + "libc 0.2.58 (registry+https://github.com/rust-lang/crates.io-index)", + "redox_users 0.3.0 (registry+https://github.com/rust-lang/crates.io-index)", + "winapi 0.3.7 (registry+https://github.com/rust-lang/crates.io-index)", +] + +[[package]] +name = "dtoa" +version = "0.4.4" +source = "registry+https://github.com/rust-lang/crates.io-index" + +[[package]] +name = "either" +version = "1.5.2" +source = "registry+https://github.com/rust-lang/crates.io-index" + +[[package]] +name = "encode_unicode" +version = "0.3.5" +source = "registry+https://github.com/rust-lang/crates.io-index" + +[[package]] +name = "failure" +version = "0.1.5" +source = "registry+https://github.com/rust-lang/crates.io-index" +dependencies = [ + "backtrace 0.3.32 (registry+https://github.com/rust-lang/crates.io-index)", + "failure_derive 0.1.5 (registry+https://github.com/rust-lang/crates.io-index)", +] + +[[package]] +name = "failure_derive" +version = "0.1.5" +source = "registry+https://github.com/rust-lang/crates.io-index" +dependencies = [ + "proc-macro2 0.4.30 (registry+https://github.com/rust-lang/crates.io-index)", + "quote 0.6.12 (registry+https://github.com/rust-lang/crates.io-index)", + "syn 0.15.35 (registry+https://github.com/rust-lang/crates.io-index)", + "synstructure 0.10.2 (registry+https://github.com/rust-lang/crates.io-index)", +] + +[[package]] +name = "flate2" +version = "1.0.7" +source = "registry+https://github.com/rust-lang/crates.io-index" +dependencies = [ + "crc32fast 1.2.0 (registry+https://github.com/rust-lang/crates.io-index)", + "libc 0.2.58 (registry+https://github.com/rust-lang/crates.io-index)", + "miniz-sys 0.1.12 (registry+https://github.com/rust-lang/crates.io-index)", + "miniz_oxide_c_api 0.2.1 (registry+https://github.com/rust-lang/crates.io-index)", +] + +[[package]] +name = "fnv" +version = "1.0.6" +source = "registry+https://github.com/rust-lang/crates.io-index" + +[[package]] +name = "fuchsia-cprng" +version = "0.1.1" +source = "registry+https://github.com/rust-lang/crates.io-index" + +[[package]] +name = "humantime" +version = "1.2.0" +source = "registry+https://github.com/rust-lang/crates.io-index" +dependencies = [ + "quick-error 1.2.2 (registry+https://github.com/rust-lang/crates.io-index)", +] + +[[package]] +name = "itertools" +version = "0.8.0" +source = "registry+https://github.com/rust-lang/crates.io-index" +dependencies = [ + "either 1.5.2 (registry+https://github.com/rust-lang/crates.io-index)", +] + +[[package]] +name = "itoa" +version = "0.4.4" +source = "registry+https://github.com/rust-lang/crates.io-index" + +[[package]] +name = "lazy_static" +version = "0.2.11" +source = "registry+https://github.com/rust-lang/crates.io-index" + +[[package]] +name = "lazy_static" +version = "1.3.0" +source = "registry+https://github.com/rust-lang/crates.io-index" + +[[package]] +name = "libc" +version = "0.2.58" +source = "registry+https://github.com/rust-lang/crates.io-index" + +[[package]] +name = "linked-hash-map" +version = "0.3.0" +source = "registry+https://github.com/rust-lang/crates.io-index" +dependencies = [ + "serde 0.8.23 (registry+https://github.com/rust-lang/crates.io-index)", + "serde_test 0.8.23 (registry+https://github.com/rust-lang/crates.io-index)", +] + +[[package]] +name = "linked-hash-map" +version = "0.5.2" +source = "registry+https://github.com/rust-lang/crates.io-index" + +[[package]] +name = "log" +version = "0.4.6" +source = "registry+https://github.com/rust-lang/crates.io-index" +dependencies = [ + "cfg-if 0.1.9 (registry+https://github.com/rust-lang/crates.io-index)", + "serde 1.0.92 (registry+https://github.com/rust-lang/crates.io-index)", +] + +[[package]] +name = "log-mdc" +version = "0.1.0" +source = "registry+https://github.com/rust-lang/crates.io-index" + +[[package]] +name = "log4rs" +version = "0.8.3" +source = "registry+https://github.com/rust-lang/crates.io-index" +dependencies = [ + "antidote 1.0.0 (registry+https://github.com/rust-lang/crates.io-index)", + "arc-swap 0.3.11 (registry+https://github.com/rust-lang/crates.io-index)", + "chrono 0.4.6 (registry+https://github.com/rust-lang/crates.io-index)", + "flate2 1.0.7 (registry+https://github.com/rust-lang/crates.io-index)", + "fnv 1.0.6 (registry+https://github.com/rust-lang/crates.io-index)", + "humantime 1.2.0 (registry+https://github.com/rust-lang/crates.io-index)", + "libc 0.2.58 (registry+https://github.com/rust-lang/crates.io-index)", + "log 0.4.6 (registry+https://github.com/rust-lang/crates.io-index)", + "log-mdc 0.1.0 (registry+https://github.com/rust-lang/crates.io-index)", + "serde 1.0.92 (registry+https://github.com/rust-lang/crates.io-index)", + "serde-value 0.5.3 (registry+https://github.com/rust-lang/crates.io-index)", + "serde_derive 1.0.92 (registry+https://github.com/rust-lang/crates.io-index)", + "serde_json 1.0.39 (registry+https://github.com/rust-lang/crates.io-index)", + "serde_yaml 0.8.9 (registry+https://github.com/rust-lang/crates.io-index)", + "thread-id 3.3.0 (registry+https://github.com/rust-lang/crates.io-index)", + "typemap 0.3.3 (registry+https://github.com/rust-lang/crates.io-index)", + "winapi 0.3.7 (registry+https://github.com/rust-lang/crates.io-index)", +] + +[[package]] +name = "memchr" +version = "2.2.0" +source = "registry+https://github.com/rust-lang/crates.io-index" +dependencies = [ + "libc 0.2.58 (registry+https://github.com/rust-lang/crates.io-index)", +] + +[[package]] +name = "miniz-sys" +version = "0.1.12" +source = "registry+https://github.com/rust-lang/crates.io-index" +dependencies = [ + "cc 1.0.37 (registry+https://github.com/rust-lang/crates.io-index)", + "libc 0.2.58 (registry+https://github.com/rust-lang/crates.io-index)", +] + +[[package]] +name = "miniz_oxide" +version = "0.2.1" +source = "registry+https://github.com/rust-lang/crates.io-index" +dependencies = [ + "adler32 1.0.3 (registry+https://github.com/rust-lang/crates.io-index)", +] + +[[package]] +name = "miniz_oxide_c_api" +version = "0.2.1" +source = "registry+https://github.com/rust-lang/crates.io-index" +dependencies = [ + "cc 1.0.37 (registry+https://github.com/rust-lang/crates.io-index)", + "crc 1.8.1 (registry+https://github.com/rust-lang/crates.io-index)", + "libc 0.2.58 (registry+https://github.com/rust-lang/crates.io-index)", + "miniz_oxide 0.2.1 (registry+https://github.com/rust-lang/crates.io-index)", +] + +[[package]] +name = "nodrop" +version = "0.1.13" +source = "registry+https://github.com/rust-lang/crates.io-index" + +[[package]] +name = "nom" +version = "4.2.3" +source = "registry+https://github.com/rust-lang/crates.io-index" +dependencies = [ + "memchr 2.2.0 (registry+https://github.com/rust-lang/crates.io-index)", + "version_check 0.1.5 (registry+https://github.com/rust-lang/crates.io-index)", +] + +[[package]] +name = "num-integer" +version = "0.1.41" +source = "registry+https://github.com/rust-lang/crates.io-index" +dependencies = [ + "autocfg 0.1.4 (registry+https://github.com/rust-lang/crates.io-index)", + "num-traits 0.2.8 (registry+https://github.com/rust-lang/crates.io-index)", +] + +[[package]] +name = "num-traits" +version = "0.1.43" +source = "registry+https://github.com/rust-lang/crates.io-index" +dependencies = [ + "num-traits 0.2.8 (registry+https://github.com/rust-lang/crates.io-index)", +] + +[[package]] +name = "num-traits" +version = "0.2.8" +source = "registry+https://github.com/rust-lang/crates.io-index" +dependencies = [ + "autocfg 0.1.4 (registry+https://github.com/rust-lang/crates.io-index)", +] + +[[package]] +name = "numtoa" +version = "0.1.0" +source = "registry+https://github.com/rust-lang/crates.io-index" + +[[package]] +name = "ordered-float" +version = "1.0.2" +source = "registry+https://github.com/rust-lang/crates.io-index" +dependencies = [ + "num-traits 0.2.8 (registry+https://github.com/rust-lang/crates.io-index)", +] + +[[package]] +name = "prettytable-rs" +version = "0.8.0" +source = "registry+https://github.com/rust-lang/crates.io-index" +dependencies = [ + "atty 0.2.11 (registry+https://github.com/rust-lang/crates.io-index)", + "csv 1.1.1 (registry+https://github.com/rust-lang/crates.io-index)", + "encode_unicode 0.3.5 (registry+https://github.com/rust-lang/crates.io-index)", + "lazy_static 1.3.0 (registry+https://github.com/rust-lang/crates.io-index)", + "term 0.5.2 (registry+https://github.com/rust-lang/crates.io-index)", + "unicode-width 0.1.5 (registry+https://github.com/rust-lang/crates.io-index)", +] + +[[package]] +name = "proc-macro2" +version = "0.4.30" +source = "registry+https://github.com/rust-lang/crates.io-index" +dependencies = [ + "unicode-xid 0.1.0 (registry+https://github.com/rust-lang/crates.io-index)", +] + +[[package]] +name = "proptest" +version = "0.9.3" +source = "registry+https://github.com/rust-lang/crates.io-index" +dependencies = [ + "bit-set 0.5.1 (registry+https://github.com/rust-lang/crates.io-index)", + "bitflags 1.1.0 (registry+https://github.com/rust-lang/crates.io-index)", + "byteorder 1.3.1 (registry+https://github.com/rust-lang/crates.io-index)", + "lazy_static 1.3.0 (registry+https://github.com/rust-lang/crates.io-index)", + "num-traits 0.2.8 (registry+https://github.com/rust-lang/crates.io-index)", + "quick-error 1.2.2 (registry+https://github.com/rust-lang/crates.io-index)", + "rand 0.6.5 (registry+https://github.com/rust-lang/crates.io-index)", + "rand_chacha 0.1.1 (registry+https://github.com/rust-lang/crates.io-index)", + "rand_xorshift 0.1.1 (registry+https://github.com/rust-lang/crates.io-index)", + "regex-syntax 0.6.6 (registry+https://github.com/rust-lang/crates.io-index)", + "rusty-fork 0.2.2 (registry+https://github.com/rust-lang/crates.io-index)", + "tempfile 3.0.8 (registry+https://github.com/rust-lang/crates.io-index)", +] + +[[package]] +name = "proptest-derive" +version = "0.1.1" +source = "registry+https://github.com/rust-lang/crates.io-index" +dependencies = [ + "proc-macro2 0.4.30 (registry+https://github.com/rust-lang/crates.io-index)", + "quote 0.6.12 (registry+https://github.com/rust-lang/crates.io-index)", + "syn 0.15.35 (registry+https://github.com/rust-lang/crates.io-index)", +] + +[[package]] +name = "quick-error" +version = "1.2.2" +source = "registry+https://github.com/rust-lang/crates.io-index" + +[[package]] +name = "quote" +version = "0.6.12" +source = "registry+https://github.com/rust-lang/crates.io-index" +dependencies = [ + "proc-macro2 0.4.30 (registry+https://github.com/rust-lang/crates.io-index)", +] + +[[package]] +name = "rand" +version = "0.6.5" +source = "registry+https://github.com/rust-lang/crates.io-index" +dependencies = [ + "autocfg 0.1.4 (registry+https://github.com/rust-lang/crates.io-index)", + "libc 0.2.58 (registry+https://github.com/rust-lang/crates.io-index)", + "rand_chacha 0.1.1 (registry+https://github.com/rust-lang/crates.io-index)", + "rand_core 0.4.0 (registry+https://github.com/rust-lang/crates.io-index)", + "rand_hc 0.1.0 (registry+https://github.com/rust-lang/crates.io-index)", + "rand_isaac 0.1.1 (registry+https://github.com/rust-lang/crates.io-index)", + "rand_jitter 0.1.4 (registry+https://github.com/rust-lang/crates.io-index)", + "rand_os 0.1.3 (registry+https://github.com/rust-lang/crates.io-index)", + "rand_pcg 0.1.2 (registry+https://github.com/rust-lang/crates.io-index)", + "rand_xorshift 0.1.1 (registry+https://github.com/rust-lang/crates.io-index)", + "winapi 0.3.7 (registry+https://github.com/rust-lang/crates.io-index)", +] + +[[package]] +name = "rand_chacha" +version = "0.1.1" +source = "registry+https://github.com/rust-lang/crates.io-index" +dependencies = [ + "autocfg 0.1.4 (registry+https://github.com/rust-lang/crates.io-index)", + "rand_core 0.3.1 (registry+https://github.com/rust-lang/crates.io-index)", +] + +[[package]] +name = "rand_core" +version = "0.3.1" +source = "registry+https://github.com/rust-lang/crates.io-index" +dependencies = [ + "rand_core 0.4.0 (registry+https://github.com/rust-lang/crates.io-index)", +] + +[[package]] +name = "rand_core" +version = "0.4.0" +source = "registry+https://github.com/rust-lang/crates.io-index" + +[[package]] +name = "rand_hc" +version = "0.1.0" +source = "registry+https://github.com/rust-lang/crates.io-index" +dependencies = [ + "rand_core 0.3.1 (registry+https://github.com/rust-lang/crates.io-index)", +] + +[[package]] +name = "rand_isaac" +version = "0.1.1" +source = "registry+https://github.com/rust-lang/crates.io-index" +dependencies = [ + "rand_core 0.3.1 (registry+https://github.com/rust-lang/crates.io-index)", +] + +[[package]] +name = "rand_jitter" +version = "0.1.4" +source = "registry+https://github.com/rust-lang/crates.io-index" +dependencies = [ + "libc 0.2.58 (registry+https://github.com/rust-lang/crates.io-index)", + "rand_core 0.4.0 (registry+https://github.com/rust-lang/crates.io-index)", + "winapi 0.3.7 (registry+https://github.com/rust-lang/crates.io-index)", +] + +[[package]] +name = "rand_os" +version = "0.1.3" +source = "registry+https://github.com/rust-lang/crates.io-index" +dependencies = [ + "cloudabi 0.0.3 (registry+https://github.com/rust-lang/crates.io-index)", + "fuchsia-cprng 0.1.1 (registry+https://github.com/rust-lang/crates.io-index)", + "libc 0.2.58 (registry+https://github.com/rust-lang/crates.io-index)", + "rand_core 0.4.0 (registry+https://github.com/rust-lang/crates.io-index)", + "rdrand 0.4.0 (registry+https://github.com/rust-lang/crates.io-index)", + "winapi 0.3.7 (registry+https://github.com/rust-lang/crates.io-index)", +] + +[[package]] +name = "rand_pcg" +version = "0.1.2" +source = "registry+https://github.com/rust-lang/crates.io-index" +dependencies = [ + "autocfg 0.1.4 (registry+https://github.com/rust-lang/crates.io-index)", + "rand_core 0.4.0 (registry+https://github.com/rust-lang/crates.io-index)", +] + +[[package]] +name = "rand_xorshift" +version = "0.1.1" +source = "registry+https://github.com/rust-lang/crates.io-index" +dependencies = [ + "rand_core 0.3.1 (registry+https://github.com/rust-lang/crates.io-index)", +] + +[[package]] +name = "rdrand" +version = "0.4.0" +source = "registry+https://github.com/rust-lang/crates.io-index" +dependencies = [ + "rand_core 0.3.1 (registry+https://github.com/rust-lang/crates.io-index)", +] + +[[package]] +name = "redox_syscall" +version = "0.1.54" +source = "registry+https://github.com/rust-lang/crates.io-index" + +[[package]] +name = "redox_termios" +version = "0.1.1" +source = "registry+https://github.com/rust-lang/crates.io-index" +dependencies = [ + "redox_syscall 0.1.54 (registry+https://github.com/rust-lang/crates.io-index)", +] + +[[package]] +name = "redox_users" +version = "0.3.0" +source = "registry+https://github.com/rust-lang/crates.io-index" +dependencies = [ + "argon2rs 0.2.5 (registry+https://github.com/rust-lang/crates.io-index)", + "failure 0.1.5 (registry+https://github.com/rust-lang/crates.io-index)", + "rand_os 0.1.3 (registry+https://github.com/rust-lang/crates.io-index)", + "redox_syscall 0.1.54 (registry+https://github.com/rust-lang/crates.io-index)", +] + +[[package]] +name = "regex" +version = "1.1.7" +source = "registry+https://github.com/rust-lang/crates.io-index" +dependencies = [ + "aho-corasick 0.7.3 (registry+https://github.com/rust-lang/crates.io-index)", + "memchr 2.2.0 (registry+https://github.com/rust-lang/crates.io-index)", + "regex-syntax 0.6.6 (registry+https://github.com/rust-lang/crates.io-index)", + "thread_local 0.3.6 (registry+https://github.com/rust-lang/crates.io-index)", + "utf8-ranges 1.0.3 (registry+https://github.com/rust-lang/crates.io-index)", +] + +[[package]] +name = "regex-automata" +version = "0.1.7" +source = "registry+https://github.com/rust-lang/crates.io-index" +dependencies = [ + "byteorder 1.3.1 (registry+https://github.com/rust-lang/crates.io-index)", +] + +[[package]] +name = "regex-syntax" +version = "0.6.6" +source = "registry+https://github.com/rust-lang/crates.io-index" +dependencies = [ + "ucd-util 0.1.3 (registry+https://github.com/rust-lang/crates.io-index)", +] + +[[package]] +name = "remove_dir_all" +version = "0.5.1" +source = "registry+https://github.com/rust-lang/crates.io-index" +dependencies = [ + "winapi 0.3.7 (registry+https://github.com/rust-lang/crates.io-index)", +] + +[[package]] +name = "rust-ini" +version = "0.13.0" +source = "registry+https://github.com/rust-lang/crates.io-index" + +[[package]] +name = "rustc-demangle" +version = "0.1.15" +source = "registry+https://github.com/rust-lang/crates.io-index" + +[[package]] +name = "rusty-fork" +version = "0.2.2" +source = "registry+https://github.com/rust-lang/crates.io-index" +dependencies = [ + "fnv 1.0.6 (registry+https://github.com/rust-lang/crates.io-index)", + "quick-error 1.2.2 (registry+https://github.com/rust-lang/crates.io-index)", + "tempfile 3.0.8 (registry+https://github.com/rust-lang/crates.io-index)", + "wait-timeout 0.2.0 (registry+https://github.com/rust-lang/crates.io-index)", +] + +[[package]] +name = "ryu" +version = "0.2.8" +source = "registry+https://github.com/rust-lang/crates.io-index" + +[[package]] +name = "ryu" +version = "1.0.0" +source = "registry+https://github.com/rust-lang/crates.io-index" + +[[package]] +name = "scoped_threadpool" +version = "0.1.9" +source = "registry+https://github.com/rust-lang/crates.io-index" + +[[package]] +name = "serde" +version = "0.8.23" +source = "registry+https://github.com/rust-lang/crates.io-index" + +[[package]] +name = "serde" +version = "1.0.92" +source = "registry+https://github.com/rust-lang/crates.io-index" + +[[package]] +name = "serde-hjson" +version = "0.8.2" +source = "registry+https://github.com/rust-lang/crates.io-index" +dependencies = [ + "lazy_static 0.2.11 (registry+https://github.com/rust-lang/crates.io-index)", + "linked-hash-map 0.3.0 (registry+https://github.com/rust-lang/crates.io-index)", + "num-traits 0.1.43 (registry+https://github.com/rust-lang/crates.io-index)", + "regex 1.1.7 (registry+https://github.com/rust-lang/crates.io-index)", + "serde 0.8.23 (registry+https://github.com/rust-lang/crates.io-index)", +] + +[[package]] +name = "serde-value" +version = "0.5.3" +source = "registry+https://github.com/rust-lang/crates.io-index" +dependencies = [ + "ordered-float 1.0.2 (registry+https://github.com/rust-lang/crates.io-index)", + "serde 1.0.92 (registry+https://github.com/rust-lang/crates.io-index)", +] + +[[package]] +name = "serde_derive" +version = "1.0.92" +source = "registry+https://github.com/rust-lang/crates.io-index" +dependencies = [ + "proc-macro2 0.4.30 (registry+https://github.com/rust-lang/crates.io-index)", + "quote 0.6.12 (registry+https://github.com/rust-lang/crates.io-index)", + "syn 0.15.35 (registry+https://github.com/rust-lang/crates.io-index)", +] + +[[package]] +name = "serde_json" +version = "1.0.39" +source = "registry+https://github.com/rust-lang/crates.io-index" +dependencies = [ + "itoa 0.4.4 (registry+https://github.com/rust-lang/crates.io-index)", + "ryu 0.2.8 (registry+https://github.com/rust-lang/crates.io-index)", + "serde 1.0.92 (registry+https://github.com/rust-lang/crates.io-index)", +] + +[[package]] +name = "serde_test" +version = "0.8.23" +source = "registry+https://github.com/rust-lang/crates.io-index" +dependencies = [ + "serde 0.8.23 (registry+https://github.com/rust-lang/crates.io-index)", +] + +[[package]] +name = "serde_yaml" +version = "0.8.9" +source = "registry+https://github.com/rust-lang/crates.io-index" +dependencies = [ + "dtoa 0.4.4 (registry+https://github.com/rust-lang/crates.io-index)", + "linked-hash-map 0.5.2 (registry+https://github.com/rust-lang/crates.io-index)", + "serde 1.0.92 (registry+https://github.com/rust-lang/crates.io-index)", + "yaml-rust 0.4.3 (registry+https://github.com/rust-lang/crates.io-index)", +] + +[[package]] +name = "strsim" +version = "0.8.0" +source = "registry+https://github.com/rust-lang/crates.io-index" + +[[package]] +name = "syn" +version = "0.15.35" +source = "registry+https://github.com/rust-lang/crates.io-index" +dependencies = [ + "proc-macro2 0.4.30 (registry+https://github.com/rust-lang/crates.io-index)", + "quote 0.6.12 (registry+https://github.com/rust-lang/crates.io-index)", + "unicode-xid 0.1.0 (registry+https://github.com/rust-lang/crates.io-index)", +] + +[[package]] +name = "synstructure" +version = "0.10.2" +source = "registry+https://github.com/rust-lang/crates.io-index" +dependencies = [ + "proc-macro2 0.4.30 (registry+https://github.com/rust-lang/crates.io-index)", + "quote 0.6.12 (registry+https://github.com/rust-lang/crates.io-index)", + "syn 0.15.35 (registry+https://github.com/rust-lang/crates.io-index)", + "unicode-xid 0.1.0 (registry+https://github.com/rust-lang/crates.io-index)", +] + +[[package]] +name = "tempfile" +version = "3.0.8" +source = "registry+https://github.com/rust-lang/crates.io-index" +dependencies = [ + "cfg-if 0.1.9 (registry+https://github.com/rust-lang/crates.io-index)", + "libc 0.2.58 (registry+https://github.com/rust-lang/crates.io-index)", + "rand 0.6.5 (registry+https://github.com/rust-lang/crates.io-index)", + "redox_syscall 0.1.54 (registry+https://github.com/rust-lang/crates.io-index)", + "remove_dir_all 0.5.1 (registry+https://github.com/rust-lang/crates.io-index)", + "winapi 0.3.7 (registry+https://github.com/rust-lang/crates.io-index)", +] + +[[package]] +name = "term" +version = "0.5.2" +source = "registry+https://github.com/rust-lang/crates.io-index" +dependencies = [ + "byteorder 1.3.1 (registry+https://github.com/rust-lang/crates.io-index)", + "dirs 1.0.5 (registry+https://github.com/rust-lang/crates.io-index)", + "winapi 0.3.7 (registry+https://github.com/rust-lang/crates.io-index)", +] + +[[package]] +name = "termion" +version = "1.5.2" +source = "registry+https://github.com/rust-lang/crates.io-index" +dependencies = [ + "libc 0.2.58 (registry+https://github.com/rust-lang/crates.io-index)", + "numtoa 0.1.0 (registry+https://github.com/rust-lang/crates.io-index)", + "redox_syscall 0.1.54 (registry+https://github.com/rust-lang/crates.io-index)", + "redox_termios 0.1.1 (registry+https://github.com/rust-lang/crates.io-index)", +] + +[[package]] +name = "textwrap" +version = "0.11.0" +source = "registry+https://github.com/rust-lang/crates.io-index" +dependencies = [ + "unicode-width 0.1.5 (registry+https://github.com/rust-lang/crates.io-index)", +] + +[[package]] +name = "thread-id" +version = "3.3.0" +source = "registry+https://github.com/rust-lang/crates.io-index" +dependencies = [ + "libc 0.2.58 (registry+https://github.com/rust-lang/crates.io-index)", + "redox_syscall 0.1.54 (registry+https://github.com/rust-lang/crates.io-index)", + "winapi 0.3.7 (registry+https://github.com/rust-lang/crates.io-index)", +] + +[[package]] +name = "thread_local" +version = "0.3.6" +source = "registry+https://github.com/rust-lang/crates.io-index" +dependencies = [ + "lazy_static 1.3.0 (registry+https://github.com/rust-lang/crates.io-index)", +] + +[[package]] +name = "time" +version = "0.1.42" +source = "registry+https://github.com/rust-lang/crates.io-index" +dependencies = [ + "libc 0.2.58 (registry+https://github.com/rust-lang/crates.io-index)", + "redox_syscall 0.1.54 (registry+https://github.com/rust-lang/crates.io-index)", + "winapi 0.3.7 (registry+https://github.com/rust-lang/crates.io-index)", +] + +[[package]] +name = "toml" +version = "0.4.10" +source = "registry+https://github.com/rust-lang/crates.io-index" +dependencies = [ + "serde 1.0.92 (registry+https://github.com/rust-lang/crates.io-index)", +] + +[[package]] +name = "traitobject" +version = "0.1.0" +source = "registry+https://github.com/rust-lang/crates.io-index" + +[[package]] +name = "typemap" +version = "0.3.3" +source = "registry+https://github.com/rust-lang/crates.io-index" +dependencies = [ + "unsafe-any 0.4.2 (registry+https://github.com/rust-lang/crates.io-index)", +] + +[[package]] +name = "ucd-util" +version = "0.1.3" +source = "registry+https://github.com/rust-lang/crates.io-index" + +[[package]] +name = "unicode-width" +version = "0.1.5" +source = "registry+https://github.com/rust-lang/crates.io-index" + +[[package]] +name = "unicode-xid" +version = "0.1.0" +source = "registry+https://github.com/rust-lang/crates.io-index" + +[[package]] +name = "unsafe-any" +version = "0.4.2" +source = "registry+https://github.com/rust-lang/crates.io-index" +dependencies = [ + "traitobject 0.1.0 (registry+https://github.com/rust-lang/crates.io-index)", +] + +[[package]] +name = "utf8-ranges" +version = "1.0.3" +source = "registry+https://github.com/rust-lang/crates.io-index" + +[[package]] +name = "vec_map" +version = "0.8.1" +source = "registry+https://github.com/rust-lang/crates.io-index" + +[[package]] +name = "version_check" +version = "0.1.5" +source = "registry+https://github.com/rust-lang/crates.io-index" + +[[package]] +name = "wait-timeout" +version = "0.2.0" +source = "registry+https://github.com/rust-lang/crates.io-index" +dependencies = [ + "libc 0.2.58 (registry+https://github.com/rust-lang/crates.io-index)", +] + +[[package]] +name = "winapi" +version = "0.3.7" +source = "registry+https://github.com/rust-lang/crates.io-index" +dependencies = [ + "winapi-i686-pc-windows-gnu 0.4.0 (registry+https://github.com/rust-lang/crates.io-index)", + "winapi-x86_64-pc-windows-gnu 0.4.0 (registry+https://github.com/rust-lang/crates.io-index)", +] + +[[package]] +name = "winapi-i686-pc-windows-gnu" +version = "0.4.0" +source = "registry+https://github.com/rust-lang/crates.io-index" + +[[package]] +name = "winapi-x86_64-pc-windows-gnu" +version = "0.4.0" +source = "registry+https://github.com/rust-lang/crates.io-index" + +[[package]] +name = "xanthous" +version = "0.1.0" +dependencies = [ + "clap 2.33.0 (registry+https://github.com/rust-lang/crates.io-index)", + "config 0.9.3 (registry+https://github.com/rust-lang/crates.io-index)", + "itertools 0.8.0 (registry+https://github.com/rust-lang/crates.io-index)", + "lazy_static 1.3.0 (registry+https://github.com/rust-lang/crates.io-index)", + "log 0.4.6 (registry+https://github.com/rust-lang/crates.io-index)", + "log4rs 0.8.3 (registry+https://github.com/rust-lang/crates.io-index)", + "prettytable-rs 0.8.0 (registry+https://github.com/rust-lang/crates.io-index)", + "proptest 0.9.3 (registry+https://github.com/rust-lang/crates.io-index)", + "proptest-derive 0.1.1 (registry+https://github.com/rust-lang/crates.io-index)", + "serde 1.0.92 (registry+https://github.com/rust-lang/crates.io-index)", + "serde_derive 1.0.92 (registry+https://github.com/rust-lang/crates.io-index)", + "termion 1.5.2 (registry+https://github.com/rust-lang/crates.io-index)", +] + +[[package]] +name = "yaml-rust" +version = "0.3.5" +source = "registry+https://github.com/rust-lang/crates.io-index" + +[[package]] +name = "yaml-rust" +version = "0.4.3" +source = "registry+https://github.com/rust-lang/crates.io-index" +dependencies = [ + "linked-hash-map 0.5.2 (registry+https://github.com/rust-lang/crates.io-index)", +] + +[metadata] +"checksum adler32 1.0.3 (registry+https://github.com/rust-lang/crates.io-index)" = "7e522997b529f05601e05166c07ed17789691f562762c7f3b987263d2dedee5c" +"checksum aho-corasick 0.7.3 (registry+https://github.com/rust-lang/crates.io-index)" = "e6f484ae0c99fec2e858eb6134949117399f222608d84cadb3f58c1f97c2364c" +"checksum ansi_term 0.11.0 (registry+https://github.com/rust-lang/crates.io-index)" = "ee49baf6cb617b853aa8d93bf420db2383fab46d314482ca2803b40d5fde979b" +"checksum antidote 1.0.0 (registry+https://github.com/rust-lang/crates.io-index)" = "34fde25430d87a9388dadbe6e34d7f72a462c8b43ac8d309b42b0a8505d7e2a5" +"checksum arc-swap 0.3.11 (registry+https://github.com/rust-lang/crates.io-index)" = "bc4662175ead9cd84451d5c35070517777949a2ed84551764129cedb88384841" +"checksum argon2rs 0.2.5 (registry+https://github.com/rust-lang/crates.io-index)" = "3f67b0b6a86dae6e67ff4ca2b6201396074996379fba2b92ff649126f37cb392" +"checksum arrayvec 0.4.10 (registry+https://github.com/rust-lang/crates.io-index)" = "92c7fb76bc8826a8b33b4ee5bb07a247a81e76764ab4d55e8f73e3a4d8808c71" +"checksum atty 0.2.11 (registry+https://github.com/rust-lang/crates.io-index)" = "9a7d5b8723950951411ee34d271d99dddcc2035a16ab25310ea2c8cfd4369652" +"checksum autocfg 0.1.4 (registry+https://github.com/rust-lang/crates.io-index)" = "0e49efa51329a5fd37e7c79db4621af617cd4e3e5bc224939808d076077077bf" +"checksum backtrace 0.3.32 (registry+https://github.com/rust-lang/crates.io-index)" = "18b50f5258d1a9ad8396d2d345827875de4261b158124d4c819d9b351454fae5" +"checksum backtrace-sys 0.1.30 (registry+https://github.com/rust-lang/crates.io-index)" = "5b3a000b9c543553af61bc01cbfc403b04b5caa9e421033866f2e98061eb3e61" +"checksum bit-set 0.5.1 (registry+https://github.com/rust-lang/crates.io-index)" = "e84c238982c4b1e1ee668d136c510c67a13465279c0cb367ea6baf6310620a80" +"checksum bit-vec 0.5.1 (registry+https://github.com/rust-lang/crates.io-index)" = "f59bbe95d4e52a6398ec21238d31577f2b28a9d86807f06ca59d191d8440d0bb" +"checksum bitflags 1.1.0 (registry+https://github.com/rust-lang/crates.io-index)" = "3d155346769a6855b86399e9bc3814ab343cd3d62c7e985113d46a0ec3c281fd" +"checksum blake2-rfc 0.2.18 (registry+https://github.com/rust-lang/crates.io-index)" = "5d6d530bdd2d52966a6d03b7a964add7ae1a288d25214066fd4b600f0f796400" +"checksum bstr 0.2.1 (registry+https://github.com/rust-lang/crates.io-index)" = "6cc0572e02f76cb335f309b19e0a0d585b4f62788f7d26de2a13a836a637385f" +"checksum build_const 0.2.1 (registry+https://github.com/rust-lang/crates.io-index)" = "39092a32794787acd8525ee150305ff051b0aa6cc2abaf193924f5ab05425f39" +"checksum byteorder 1.3.1 (registry+https://github.com/rust-lang/crates.io-index)" = "a019b10a2a7cdeb292db131fc8113e57ea2a908f6e7894b0c3c671893b65dbeb" +"checksum cc 1.0.37 (registry+https://github.com/rust-lang/crates.io-index)" = "39f75544d7bbaf57560d2168f28fd649ff9c76153874db88bdbdfd839b1a7e7d" +"checksum cfg-if 0.1.9 (registry+https://github.com/rust-lang/crates.io-index)" = "b486ce3ccf7ffd79fdeb678eac06a9e6c09fc88d33836340becb8fffe87c5e33" +"checksum chrono 0.4.6 (registry+https://github.com/rust-lang/crates.io-index)" = "45912881121cb26fad7c38c17ba7daa18764771836b34fab7d3fbd93ed633878" +"checksum clap 2.33.0 (registry+https://github.com/rust-lang/crates.io-index)" = "5067f5bb2d80ef5d68b4c87db81601f0b75bca627bc2ef76b141d7b846a3c6d9" +"checksum cloudabi 0.0.3 (registry+https://github.com/rust-lang/crates.io-index)" = "ddfc5b9aa5d4507acaf872de71051dfd0e309860e88966e1051e462a077aac4f" +"checksum config 0.9.3 (registry+https://github.com/rust-lang/crates.io-index)" = "f9107d78ed62b3fa5a86e7d18e647abed48cfd8f8fab6c72f4cdb982d196f7e6" +"checksum constant_time_eq 0.1.3 (registry+https://github.com/rust-lang/crates.io-index)" = "8ff012e225ce166d4422e0e78419d901719760f62ae2b7969ca6b564d1b54a9e" +"checksum crc 1.8.1 (registry+https://github.com/rust-lang/crates.io-index)" = "d663548de7f5cca343f1e0a48d14dcfb0e9eb4e079ec58883b7251539fa10aeb" +"checksum crc32fast 1.2.0 (registry+https://github.com/rust-lang/crates.io-index)" = "ba125de2af0df55319f41944744ad91c71113bf74a4646efff39afe1f6842db1" +"checksum csv 1.1.1 (registry+https://github.com/rust-lang/crates.io-index)" = "37519ccdfd73a75821cac9319d4fce15a81b9fcf75f951df5b9988aa3a0af87d" +"checksum csv-core 0.1.6 (registry+https://github.com/rust-lang/crates.io-index)" = "9b5cadb6b25c77aeff80ba701712494213f4a8418fcda2ee11b6560c3ad0bf4c" +"checksum dirs 1.0.5 (registry+https://github.com/rust-lang/crates.io-index)" = "3fd78930633bd1c6e35c4b42b1df7b0cbc6bc191146e512bb3bedf243fcc3901" +"checksum dtoa 0.4.4 (registry+https://github.com/rust-lang/crates.io-index)" = "ea57b42383d091c85abcc2706240b94ab2a8fa1fc81c10ff23c4de06e2a90b5e" +"checksum either 1.5.2 (registry+https://github.com/rust-lang/crates.io-index)" = "5527cfe0d098f36e3f8839852688e63c8fff1c90b2b405aef730615f9a7bcf7b" +"checksum encode_unicode 0.3.5 (registry+https://github.com/rust-lang/crates.io-index)" = "90b2c9496c001e8cb61827acdefad780795c42264c137744cae6f7d9e3450abd" +"checksum failure 0.1.5 (registry+https://github.com/rust-lang/crates.io-index)" = "795bd83d3abeb9220f257e597aa0080a508b27533824adf336529648f6abf7e2" +"checksum failure_derive 0.1.5 (registry+https://github.com/rust-lang/crates.io-index)" = "ea1063915fd7ef4309e222a5a07cf9c319fb9c7836b1f89b85458672dbb127e1" +"checksum flate2 1.0.7 (registry+https://github.com/rust-lang/crates.io-index)" = "f87e68aa82b2de08a6e037f1385455759df6e445a8df5e005b4297191dbf18aa" +"checksum fnv 1.0.6 (registry+https://github.com/rust-lang/crates.io-index)" = "2fad85553e09a6f881f739c29f0b00b0f01357c743266d478b68951ce23285f3" +"checksum fuchsia-cprng 0.1.1 (registry+https://github.com/rust-lang/crates.io-index)" = "a06f77d526c1a601b7c4cdd98f54b5eaabffc14d5f2f0296febdc7f357c6d3ba" +"checksum humantime 1.2.0 (registry+https://github.com/rust-lang/crates.io-index)" = "3ca7e5f2e110db35f93b837c81797f3714500b81d517bf20c431b16d3ca4f114" +"checksum itertools 0.8.0 (registry+https://github.com/rust-lang/crates.io-index)" = "5b8467d9c1cebe26feb08c640139247fac215782d35371ade9a2136ed6085358" +"checksum itoa 0.4.4 (registry+https://github.com/rust-lang/crates.io-index)" = "501266b7edd0174f8530248f87f99c88fbe60ca4ef3dd486835b8d8d53136f7f" +"checksum lazy_static 0.2.11 (registry+https://github.com/rust-lang/crates.io-index)" = "76f033c7ad61445c5b347c7382dd1237847eb1bce590fe50365dcb33d546be73" +"checksum lazy_static 1.3.0 (registry+https://github.com/rust-lang/crates.io-index)" = "bc5729f27f159ddd61f4df6228e827e86643d4d3e7c32183cb30a1c08f604a14" +"checksum libc 0.2.58 (registry+https://github.com/rust-lang/crates.io-index)" = "6281b86796ba5e4366000be6e9e18bf35580adf9e63fbe2294aadb587613a319" +"checksum linked-hash-map 0.3.0 (registry+https://github.com/rust-lang/crates.io-index)" = "6d262045c5b87c0861b3f004610afd0e2c851e2908d08b6c870cbb9d5f494ecd" +"checksum linked-hash-map 0.5.2 (registry+https://github.com/rust-lang/crates.io-index)" = "ae91b68aebc4ddb91978b11a1b02ddd8602a05ec19002801c5666000e05e0f83" +"checksum log 0.4.6 (registry+https://github.com/rust-lang/crates.io-index)" = "c84ec4b527950aa83a329754b01dbe3f58361d1c5efacd1f6d68c494d08a17c6" +"checksum log-mdc 0.1.0 (registry+https://github.com/rust-lang/crates.io-index)" = "a94d21414c1f4a51209ad204c1776a3d0765002c76c6abcb602a6f09f1e881c7" +"checksum log4rs 0.8.3 (registry+https://github.com/rust-lang/crates.io-index)" = "100052474df98158c0738a7d3f4249c99978490178b5f9f68cd835ac57adbd1b" +"checksum memchr 2.2.0 (registry+https://github.com/rust-lang/crates.io-index)" = "2efc7bc57c883d4a4d6e3246905283d8dae951bb3bd32f49d6ef297f546e1c39" +"checksum miniz-sys 0.1.12 (registry+https://github.com/rust-lang/crates.io-index)" = "1e9e3ae51cea1576ceba0dde3d484d30e6e5b86dee0b2d412fe3a16a15c98202" +"checksum miniz_oxide 0.2.1 (registry+https://github.com/rust-lang/crates.io-index)" = "c468f2369f07d651a5d0bb2c9079f8488a66d5466efe42d0c5c6466edcb7f71e" +"checksum miniz_oxide_c_api 0.2.1 (registry+https://github.com/rust-lang/crates.io-index)" = "b7fe927a42e3807ef71defb191dc87d4e24479b221e67015fe38ae2b7b447bab" +"checksum nodrop 0.1.13 (registry+https://github.com/rust-lang/crates.io-index)" = "2f9667ddcc6cc8a43afc9b7917599d7216aa09c463919ea32c59ed6cac8bc945" +"checksum nom 4.2.3 (registry+https://github.com/rust-lang/crates.io-index)" = "2ad2a91a8e869eeb30b9cb3119ae87773a8f4ae617f41b1eb9c154b2905f7bd6" +"checksum num-integer 0.1.41 (registry+https://github.com/rust-lang/crates.io-index)" = "b85e541ef8255f6cf42bbfe4ef361305c6c135d10919ecc26126c4e5ae94bc09" +"checksum num-traits 0.1.43 (registry+https://github.com/rust-lang/crates.io-index)" = "92e5113e9fd4cc14ded8e499429f396a20f98c772a47cc8622a736e1ec843c31" +"checksum num-traits 0.2.8 (registry+https://github.com/rust-lang/crates.io-index)" = "6ba9a427cfca2be13aa6f6403b0b7e7368fe982bfa16fccc450ce74c46cd9b32" +"checksum numtoa 0.1.0 (registry+https://github.com/rust-lang/crates.io-index)" = "b8f8bdf33df195859076e54ab11ee78a1b208382d3a26ec40d142ffc1ecc49ef" +"checksum ordered-float 1.0.2 (registry+https://github.com/rust-lang/crates.io-index)" = "18869315e81473c951eb56ad5558bbc56978562d3ecfb87abb7a1e944cea4518" +"checksum prettytable-rs 0.8.0 (registry+https://github.com/rust-lang/crates.io-index)" = "0fd04b170004fa2daccf418a7f8253aaf033c27760b5f225889024cf66d7ac2e" +"checksum proc-macro2 0.4.30 (registry+https://github.com/rust-lang/crates.io-index)" = "cf3d2011ab5c909338f7887f4fc896d35932e29146c12c8d01da6b22a80ba759" +"checksum proptest 0.9.3 (registry+https://github.com/rust-lang/crates.io-index)" = "2afed8cbdc8a64b58a5c021757a782351ec1afee85be374872721c84d5da5d80" +"checksum proptest-derive 0.1.1 (registry+https://github.com/rust-lang/crates.io-index)" = "08b264c54525e760fc1d39c5b2bfc96923b922a752893053b4adaafe33fa9346" +"checksum quick-error 1.2.2 (registry+https://github.com/rust-lang/crates.io-index)" = "9274b940887ce9addde99c4eee6b5c44cc494b182b97e73dc8ffdcb3397fd3f0" +"checksum quote 0.6.12 (registry+https://github.com/rust-lang/crates.io-index)" = "faf4799c5d274f3868a4aae320a0a182cbd2baee377b378f080e16a23e9d80db" +"checksum rand 0.6.5 (registry+https://github.com/rust-lang/crates.io-index)" = "6d71dacdc3c88c1fde3885a3be3fbab9f35724e6ce99467f7d9c5026132184ca" +"checksum rand_chacha 0.1.1 (registry+https://github.com/rust-lang/crates.io-index)" = "556d3a1ca6600bfcbab7c7c91ccb085ac7fbbcd70e008a98742e7847f4f7bcef" +"checksum rand_core 0.3.1 (registry+https://github.com/rust-lang/crates.io-index)" = "7a6fdeb83b075e8266dcc8762c22776f6877a63111121f5f8c7411e5be7eed4b" +"checksum rand_core 0.4.0 (registry+https://github.com/rust-lang/crates.io-index)" = "d0e7a549d590831370895ab7ba4ea0c1b6b011d106b5ff2da6eee112615e6dc0" +"checksum rand_hc 0.1.0 (registry+https://github.com/rust-lang/crates.io-index)" = "7b40677c7be09ae76218dc623efbf7b18e34bced3f38883af07bb75630a21bc4" +"checksum rand_isaac 0.1.1 (registry+https://github.com/rust-lang/crates.io-index)" = "ded997c9d5f13925be2a6fd7e66bf1872597f759fd9dd93513dd7e92e5a5ee08" +"checksum rand_jitter 0.1.4 (registry+https://github.com/rust-lang/crates.io-index)" = "1166d5c91dc97b88d1decc3285bb0a99ed84b05cfd0bc2341bdf2d43fc41e39b" +"checksum rand_os 0.1.3 (registry+https://github.com/rust-lang/crates.io-index)" = "7b75f676a1e053fc562eafbb47838d67c84801e38fc1ba459e8f180deabd5071" +"checksum rand_pcg 0.1.2 (registry+https://github.com/rust-lang/crates.io-index)" = "abf9b09b01790cfe0364f52bf32995ea3c39f4d2dd011eac241d2914146d0b44" +"checksum rand_xorshift 0.1.1 (registry+https://github.com/rust-lang/crates.io-index)" = "cbf7e9e623549b0e21f6e97cf8ecf247c1a8fd2e8a992ae265314300b2455d5c" +"checksum rdrand 0.4.0 (registry+https://github.com/rust-lang/crates.io-index)" = "678054eb77286b51581ba43620cc911abf02758c91f93f479767aed0f90458b2" +"checksum redox_syscall 0.1.54 (registry+https://github.com/rust-lang/crates.io-index)" = "12229c14a0f65c4f1cb046a3b52047cdd9da1f4b30f8a39c5063c8bae515e252" +"checksum redox_termios 0.1.1 (registry+https://github.com/rust-lang/crates.io-index)" = "7e891cfe48e9100a70a3b6eb652fef28920c117d366339687bd5576160db0f76" +"checksum redox_users 0.3.0 (registry+https://github.com/rust-lang/crates.io-index)" = "3fe5204c3a17e97dde73f285d49be585df59ed84b50a872baf416e73b62c3828" +"checksum regex 1.1.7 (registry+https://github.com/rust-lang/crates.io-index)" = "0b2f0808e7d7e4fb1cb07feb6ff2f4bc827938f24f8c2e6a3beb7370af544bdd" +"checksum regex-automata 0.1.7 (registry+https://github.com/rust-lang/crates.io-index)" = "3ed09217220c272b29ef237a974ad58515bde75f194e3ffa7e6d0bf0f3b01f86" +"checksum regex-syntax 0.6.6 (registry+https://github.com/rust-lang/crates.io-index)" = "dcfd8681eebe297b81d98498869d4aae052137651ad7b96822f09ceb690d0a96" +"checksum remove_dir_all 0.5.1 (registry+https://github.com/rust-lang/crates.io-index)" = "3488ba1b9a2084d38645c4c08276a1752dcbf2c7130d74f1569681ad5d2799c5" +"checksum rust-ini 0.13.0 (registry+https://github.com/rust-lang/crates.io-index)" = "3e52c148ef37f8c375d49d5a73aa70713125b7f19095948a923f80afdeb22ec2" +"checksum rustc-demangle 0.1.15 (registry+https://github.com/rust-lang/crates.io-index)" = "a7f4dccf6f4891ebcc0c39f9b6eb1a83b9bf5d747cb439ec6fba4f3b977038af" +"checksum rusty-fork 0.2.2 (registry+https://github.com/rust-lang/crates.io-index)" = "3dd93264e10c577503e926bd1430193eeb5d21b059148910082245309b424fae" +"checksum ryu 0.2.8 (registry+https://github.com/rust-lang/crates.io-index)" = "b96a9549dc8d48f2c283938303c4b5a77aa29bfbc5b54b084fb1630408899a8f" +"checksum ryu 1.0.0 (registry+https://github.com/rust-lang/crates.io-index)" = "c92464b447c0ee8c4fb3824ecc8383b81717b9f1e74ba2e72540aef7b9f82997" +"checksum scoped_threadpool 0.1.9 (registry+https://github.com/rust-lang/crates.io-index)" = "1d51f5df5af43ab3f1360b429fa5e0152ac5ce8c0bd6485cae490332e96846a8" +"checksum serde 0.8.23 (registry+https://github.com/rust-lang/crates.io-index)" = "9dad3f759919b92c3068c696c15c3d17238234498bbdcc80f2c469606f948ac8" +"checksum serde 1.0.92 (registry+https://github.com/rust-lang/crates.io-index)" = "32746bf0f26eab52f06af0d0aa1984f641341d06d8d673c693871da2d188c9be" +"checksum serde-hjson 0.8.2 (registry+https://github.com/rust-lang/crates.io-index)" = "0b833c5ad67d52ced5f5938b2980f32a9c1c5ef047f0b4fb3127e7a423c76153" +"checksum serde-value 0.5.3 (registry+https://github.com/rust-lang/crates.io-index)" = "7a663f873dedc4eac1a559d4c6bc0d0b2c34dc5ac4702e105014b8281489e44f" +"checksum serde_derive 1.0.92 (registry+https://github.com/rust-lang/crates.io-index)" = "46a3223d0c9ba936b61c0d2e3e559e3217dbfb8d65d06d26e8b3c25de38bae3e" +"checksum serde_json 1.0.39 (registry+https://github.com/rust-lang/crates.io-index)" = "5a23aa71d4a4d43fdbfaac00eff68ba8a06a51759a89ac3304323e800c4dd40d" +"checksum serde_test 0.8.23 (registry+https://github.com/rust-lang/crates.io-index)" = "110b3dbdf8607ec493c22d5d947753282f3bae73c0f56d322af1e8c78e4c23d5" +"checksum serde_yaml 0.8.9 (registry+https://github.com/rust-lang/crates.io-index)" = "38b08a9a90e5260fe01c6480ec7c811606df6d3a660415808c3c3fa8ed95b582" +"checksum strsim 0.8.0 (registry+https://github.com/rust-lang/crates.io-index)" = "8ea5119cdb4c55b55d432abb513a0429384878c15dde60cc77b1c99de1a95a6a" +"checksum syn 0.15.35 (registry+https://github.com/rust-lang/crates.io-index)" = "641e117d55514d6d918490e47102f7e08d096fdde360247e4a10f7a91a8478d3" +"checksum synstructure 0.10.2 (registry+https://github.com/rust-lang/crates.io-index)" = "02353edf96d6e4dc81aea2d8490a7e9db177bf8acb0e951c24940bf866cb313f" +"checksum tempfile 3.0.8 (registry+https://github.com/rust-lang/crates.io-index)" = "7dc4738f2e68ed2855de5ac9cdbe05c9216773ecde4739b2f095002ab03a13ef" +"checksum term 0.5.2 (registry+https://github.com/rust-lang/crates.io-index)" = "edd106a334b7657c10b7c540a0106114feadeb4dc314513e97df481d5d966f42" +"checksum termion 1.5.2 (registry+https://github.com/rust-lang/crates.io-index)" = "dde0593aeb8d47accea5392b39350015b5eccb12c0d98044d856983d89548dea" +"checksum textwrap 0.11.0 (registry+https://github.com/rust-lang/crates.io-index)" = "d326610f408c7a4eb6f51c37c330e496b08506c9457c9d34287ecc38809fb060" +"checksum thread-id 3.3.0 (registry+https://github.com/rust-lang/crates.io-index)" = "c7fbf4c9d56b320106cd64fd024dadfa0be7cb4706725fc44a7d7ce952d820c1" +"checksum thread_local 0.3.6 (registry+https://github.com/rust-lang/crates.io-index)" = "c6b53e329000edc2b34dbe8545fd20e55a333362d0a321909685a19bd28c3f1b" +"checksum time 0.1.42 (registry+https://github.com/rust-lang/crates.io-index)" = "db8dcfca086c1143c9270ac42a2bbd8a7ee477b78ac8e45b19abfb0cbede4b6f" +"checksum toml 0.4.10 (registry+https://github.com/rust-lang/crates.io-index)" = "758664fc71a3a69038656bee8b6be6477d2a6c315a6b81f7081f591bffa4111f" +"checksum traitobject 0.1.0 (registry+https://github.com/rust-lang/crates.io-index)" = "efd1f82c56340fdf16f2a953d7bda4f8fdffba13d93b00844c25572110b26079" +"checksum typemap 0.3.3 (registry+https://github.com/rust-lang/crates.io-index)" = "653be63c80a3296da5551e1bfd2cca35227e13cdd08c6668903ae2f4f77aa1f6" +"checksum ucd-util 0.1.3 (registry+https://github.com/rust-lang/crates.io-index)" = "535c204ee4d8434478593480b8f86ab45ec9aae0e83c568ca81abf0fd0e88f86" +"checksum unicode-width 0.1.5 (registry+https://github.com/rust-lang/crates.io-index)" = "882386231c45df4700b275c7ff55b6f3698780a650026380e72dabe76fa46526" +"checksum unicode-xid 0.1.0 (registry+https://github.com/rust-lang/crates.io-index)" = "fc72304796d0818e357ead4e000d19c9c174ab23dc11093ac919054d20a6a7fc" +"checksum unsafe-any 0.4.2 (registry+https://github.com/rust-lang/crates.io-index)" = "f30360d7979f5e9c6e6cea48af192ea8fab4afb3cf72597154b8f08935bc9c7f" +"checksum utf8-ranges 1.0.3 (registry+https://github.com/rust-lang/crates.io-index)" = "9d50aa7650df78abf942826607c62468ce18d9019673d4a2ebe1865dbb96ffde" +"checksum vec_map 0.8.1 (registry+https://github.com/rust-lang/crates.io-index)" = "05c78687fb1a80548ae3250346c3db86a80a7cdd77bda190189f2d0a0987c81a" +"checksum version_check 0.1.5 (registry+https://github.com/rust-lang/crates.io-index)" = "914b1a6776c4c929a602fafd8bc742e06365d4bcbe48c30f9cca5824f70dc9dd" +"checksum wait-timeout 0.2.0 (registry+https://github.com/rust-lang/crates.io-index)" = "9f200f5b12eb75f8c1ed65abd4b2db8a6e1b138a20de009dacee265a2498f3f6" +"checksum winapi 0.3.7 (registry+https://github.com/rust-lang/crates.io-index)" = "f10e386af2b13e47c89e7236a7a14a086791a2b88ebad6df9bf42040195cf770" +"checksum winapi-i686-pc-windows-gnu 0.4.0 (registry+https://github.com/rust-lang/crates.io-index)" = "ac3b87c63620426dd9b991e5ce0329eff545bccbbb34f3be09ff6fb6ab51b7b6" +"checksum winapi-x86_64-pc-windows-gnu 0.4.0 (registry+https://github.com/rust-lang/crates.io-index)" = "712e227841d057c1ee1cd2fb22fa7e5a5461ae8e48fa2ca79ec42cfc1931183f" +"checksum yaml-rust 0.3.5 (registry+https://github.com/rust-lang/crates.io-index)" = "e66366e18dc58b46801afbf2ca7661a9f59cc8c5962c29892b6039b4f86fa992" +"checksum yaml-rust 0.4.3 (registry+https://github.com/rust-lang/crates.io-index)" = "65923dd1784f44da1d2c3dbbc5e822045628c590ba72123e1c73d3c230c4434d" diff --git a/Cargo.toml b/Cargo.toml new file mode 100644 index 0000000000..c08edfe8fd --- /dev/null +++ b/Cargo.toml @@ -0,0 +1,21 @@ +[package] +name = "xanthous" +version = "0.1.0" +authors = ["Griffin Smith "] +edition = "2018" + +[dependencies] +config = "*" +itertools = "*" +lazy_static = "*" +log = "*" +log4rs = "*" +proptest = "0.9.3" +proptest-derive = "*" +serde = "^1.0.8" +serde_derive = "^1.0.8" +termion = "*" +clap = {version = "^2.33.0", features = ["yaml"]} +prettytable-rs = "^0.8" + +[dev-dependencies] diff --git a/Config.toml b/Config.toml new file mode 100644 index 0000000000..30806365d2 --- /dev/null +++ b/Config.toml @@ -0,0 +1,2 @@ +[logging] +level = "debug" diff --git a/proptest-regressions/display/draw_box.txt b/proptest-regressions/display/draw_box.txt new file mode 100644 index 0000000000..03391a696d --- /dev/null +++ b/proptest-regressions/display/draw_box.txt @@ -0,0 +1,12 @@ +# Seeds for failure cases proptest has generated in the past. It is +# automatically read and these particular cases re-run before any +# novel cases are generated. +# +# It is recommended to check this file in to source control so that +# everyone who runs the test benefits from these saved cases. +cc 7aff36a9f7b263e62434a3f61ada1d6aaf6ff4545a463548d96815a0e98cf5f1 # shrinks to dims = Dimensions { w: 0, h: 0 }, style = Thin +cc e4d96a13d6a8c7625e49d3545f6076d58152f3b5eb43fae65f0d407d1d34f96c # shrinks to dims = Dimensions { w: 1, h: 1 }, style = Thin +cc b5f0d7cb409896bd6692544c7c1f781174075c287d3b7a3b9dc73526ea489484 # shrinks to dims = Dimensions { w: 1, h: 1 }, style = Thin +cc 103b62b7c29c22adcbc23153638d3b37bad57aeec685d1eab38c49d0deed937f # shrinks to dims = Dimensions { w: 0, h: 1 }, style = Thin +cc 24c3858a543b0d8ff4966517040ec8c183ed311688d6863fd13facb5cdad7aa0 # shrinks to dims = Dimensions { w: 1, h: 1 }, style = Thin +cc 70a53a8b771937976a08a72d870b355a0995cc0251f45de4393c37a56a789b83 # shrinks to dims = Dimensions { w: 0, h: 0 }, style = Thin diff --git a/proptest-regressions/types/mod.txt b/proptest-regressions/types/mod.txt new file mode 100644 index 0000000000..b185590067 --- /dev/null +++ b/proptest-regressions/types/mod.txt @@ -0,0 +1,7 @@ +# Seeds for failure cases proptest has generated in the past. It is +# automatically read and these particular cases re-run before any +# novel cases are generated. +# +# It is recommended to check this file in to source control so that +# everyone who runs the test benefits from these saved cases. +cc a51cf37623f0e4024f4ba1450195be296d9b9e8ae954dbbf997ce5b57cd26792 # shrinks to a = Position { x: 44, y: 25 }, b = Position { x: 0, y: 25 }, c = Position { x: 0, y: 0 } diff --git a/rustfmt.toml b/rustfmt.toml new file mode 100644 index 0000000000..df99c69198 --- /dev/null +++ b/rustfmt.toml @@ -0,0 +1 @@ +max_width = 80 diff --git a/src/cli.yml b/src/cli.yml new file mode 100644 index 0000000000..7c374e1020 --- /dev/null +++ b/src/cli.yml @@ -0,0 +1,14 @@ +name: xanthous +version: "0.0" +author: Griffin Smith +about: hey, it's a terminal game +args: + - config: + short: c + long: config + value_name: FILE + help: Sets a custom config file + takes_value: true +subcommands: + - debug: + about: Writes debug information to the terminal and exits diff --git a/src/display/draw_box.rs b/src/display/draw_box.rs new file mode 100644 index 0000000000..986f09a49f --- /dev/null +++ b/src/display/draw_box.rs @@ -0,0 +1,205 @@ +use crate::display::utils::clone_times; +use crate::display::utils::times; +use crate::types::Dimensions; +use itertools::Itertools; +use proptest::prelude::Arbitrary; +use proptest::strategy; +use proptest_derive::Arbitrary; + +// Box Drawing +// 0 1 2 3 4 5 6 7 8 9 A B C D E F +// U+250x ─ ━ │ ┃ ┄ ┅ ┆ ┇ ┈ ┉ ┊ ┋ ┌ ┍ ┎ ┏ +// U+251x ┐ ┑ ┒ ┓ └ ┕ ┖ ┗ ┘ ┙ ┚ ┛ ├ ┝ ┞ ┟ +// U+252x ┠ ┡ ┢ ┣ ┤ ┥ ┦ ┧ ┨ ┩ ┪ ┫ ┬ ┭ ┮ ┯ +// U+253x ┰ ┱ ┲ ┳ ┴ ┵ ┶ ┷ ┸ ┹ ┺ ┻ ┼ ┽ ┾ ┿ +// U+254x ╀ ╁ ╂ ╃ ╄ ╅ ╆ ╇ ╈ ╉ ╊ ╋ ╌ ╍ ╎ ╏ +// U+255x ═ ║ ╒ ╓ ╔ ╕ ╖ ╗ ╘ ╙ ╚ ╛ ╜ ╝ ╞ ╟ +// U+256x ╠ ╡ ╢ ╣ ╤ ╥ ╦ ╧ ╨ ╩ ╪ ╫ ╬ ╭ ╮ ╯ +// U+257x ╰ ╱ ╲ ╳ ╴ ╵ ╶ ╷ ╸ ╹ ╺ ╻ ╼ ╽ ╾ ╿ + +static BOX: char = '☐'; + +static BOX_CHARS: [[char; 16]; 8] = [ + [ + // 0 1 2 3 4 5 6 7 8 9 + '─', '━', '│', '┃', '┄', '┅', '┆', '┇', '┈', '┉', + // 10 + '┊', '┋', '┌', '┍', '┎', '┏', + ], + [ + // 0 1 2 3 4 5 6 7 8 9 + '┐', '┑', '┒', '┓', '└', '┕', '┖', '┗', '┘', '┙', + '┚', '┛', '├', '┝', '┞', '┟', + ], + [ + // 0 1 2 3 4 5 6 7 8 9 + '┠', '┡', '┢', '┣', '┤', '┥', '┦', '┧', '┨', '┩', + '┪', '┫', '┬', '┭', '┮', '┯', + ], + [ + // 0 1 2 3 4 5 6 7 8 9 + '┰', '┱', '┲', '┳', '┴', '┵', '┶', '┷', '┸', '┹', + '┺', '┻', '┼', '┽', '┾', '┿', + ], + [ + // 0 1 2 3 4 5 6 7 8 9 + '╀', '╁', '╂', '╃', '╄', '╅', '╆', '╇', '╈', '╉', + '╊', '╋', '╌', '╍', '╎', '╏', + ], + [ + // 0 1 2 3 4 5 6 7 8 9 + '═', '║', '╒', '╓', '╔', '╕', '╖', '╗', '╘', '╙', + '╚', '╛', '╜', '╝', '╞', '╟', + ], + [ + // 0 1 2 3 4 5 6 7 8 9 + '╠', '╡', '╢', '╣', '╤', '╥', '╦', '╧', '╨', '╩', + '╪', '╫', '╬', '╭', '╮', '╯', + ], + [ + // 0 1 2 3 4 5 6 7 8 9 + '╰', '╱', '╲', '╳', '╴', '╵', '╶', '╷', '╸', '╹', + '╺', '╻', '╼', '╽', '╾', '╿', + ], +]; + +#[derive(Clone, Copy, Debug, PartialEq, Eq)] +pub enum BoxStyle { + Thin, + Thick, + Dotted, + ThickDotted, + Dashed, + ThickDashed, + Double, +} + +impl Arbitrary for BoxStyle { + type Parameters = (); + type Strategy = strategy::Just; + fn arbitrary_with(_: Self::Parameters) -> Self::Strategy { + // TODO + strategy::Just(BoxStyle::Thin) + } +} + +trait Stylable { + fn style(self, style: BoxStyle) -> char; +} + +#[derive(Clone, Copy, Debug, PartialEq, Eq, Arbitrary)] +enum Corner { + TopRight, + TopLeft, + BottomRight, + BottomLeft, +} + +impl Stylable for Corner { + fn style(self, style: BoxStyle) -> char { + use BoxStyle::*; + use Corner::*; + + match (self, style) { + (TopRight, Thin) => BOX_CHARS[1][0], + (TopLeft, Thin) => BOX_CHARS[0][12], + (BottomRight, Thin) => BOX_CHARS[1][8], + (BottomLeft, Thin) => BOX_CHARS[1][4], + _ => unimplemented!(), + } + } +} + +#[derive(Clone, Copy, Debug, PartialEq, Eq, Arbitrary)] +enum Line { + H, + V, +} + +impl Stylable for Line { + fn style(self, style: BoxStyle) -> char { + use BoxStyle::*; + use Line::*; + match (self, style) { + (H, Thin) => BOX_CHARS[0][0], + (V, Thin) => BOX_CHARS[0][2], + _ => unimplemented!(), + } + } +} + +#[must_use] +pub fn make_box(style: BoxStyle, dims: Dimensions) -> String { + if dims.h == 0 || dims.w == 0 { + "".to_string() + } else if dims.h == 1 && dims.w == 1 { + BOX.to_string() + } else if dims.h == 1 { + times(Line::H.style(style), dims.w) + } else if dims.w == 1 { + (0..dims.h).map(|_| Line::V.style(style)).join("\n\r") + } else { + let h_line: String = times(Line::H.style(style), dims.w - 2); + let v_line = Line::V.style(style); + let v_walls: String = clone_times( + format!( + "{}{}{}\n\r", + v_line, + times::<_, String>(' ', dims.w - 2), + v_line + ), + dims.h - 2, + ); + + format!( + "{}{}{}\n\r{}{}{}{}", + Corner::TopLeft.style(style), + h_line, + Corner::TopRight.style(style), + v_walls, + Corner::BottomLeft.style(style), + h_line, + Corner::BottomRight.style(style), + ) + } +} + +#[cfg(test)] +mod tests { + use super::*; + use proptest::prelude::*; + + #[test] + fn make_thin_box() { + let res = make_box(BoxStyle::Thin, Dimensions { w: 10, h: 10 }); + assert_eq!( + res, + "┌────────┐ +\r│ │ +\r│ │ +\r│ │ +\r│ │ +\r│ │ +\r│ │ +\r│ │ +\r│ │ +\r└────────┘" + ); + } + + proptest! { + #[test] + fn box_has_height_lines(dims: Dimensions, style: BoxStyle) { + let res = make_box(style, dims); + prop_assume!((dims.w > 0 && dims.h > 0)); + assert_eq!(res.split("\n\r").count(), dims.h as usize); + } + + #[test] + fn box_lines_have_width_length(dims: Dimensions, style: BoxStyle) { + let res = make_box(style, dims); + prop_assume!(dims.w == 0 && dims.h == 0 || (dims.w > 0 && dims.h > 0)); + assert!(res.split("\n\r").all(|l| l.chars().count() == dims.w as usize)); + } + } +} diff --git a/src/display/mod.rs b/src/display/mod.rs new file mode 100644 index 0000000000..5dba48b44d --- /dev/null +++ b/src/display/mod.rs @@ -0,0 +1,9 @@ +pub mod draw_box; +pub mod utils; +pub use draw_box::{make_box, BoxStyle}; +use std::io::{self, Write}; +use termion::{clear, cursor, style}; + +pub fn clear(out: &mut T) -> io::Result<()> { + write!(out, "{}{}{}", clear::All, style::Reset, cursor::Goto(1, 1)) +} diff --git a/src/display/utils.rs b/src/display/utils.rs new file mode 100644 index 0000000000..acd4416cb8 --- /dev/null +++ b/src/display/utils.rs @@ -0,0 +1,9 @@ +use std::iter::FromIterator; + +pub fn times>(elem: A, n: u16) -> B { + (0..n).map(|_| elem).collect() +} + +pub fn clone_times>(elem: A, n: u16) -> B { + (0..n).map(|_| elem.clone()).collect() +} diff --git a/src/entities/character.rs b/src/entities/character.rs new file mode 100644 index 0000000000..e40b7b988e --- /dev/null +++ b/src/entities/character.rs @@ -0,0 +1,15 @@ +use crate::types::{Position, Speed}; + +const DEFAULT_SPEED: Speed = Speed(100); + +pub struct Character { + position: Position, +} + +impl Character { + pub fn speed(&self) -> Speed { + Speed(100) + } +} + +positioned!(Character); diff --git a/src/entities/mod.rs b/src/entities/mod.rs new file mode 100644 index 0000000000..7889122666 --- /dev/null +++ b/src/entities/mod.rs @@ -0,0 +1 @@ +pub mod character; diff --git a/src/game.rs b/src/game.rs new file mode 100644 index 0000000000..a41d7f73fd --- /dev/null +++ b/src/game.rs @@ -0,0 +1,118 @@ +use std::thread; +use crate::settings::Settings; +use crate::types::{BoundingBox, Dimensions, Position}; +use std::io::{self, StdinLock, StdoutLock, Write}; +use termion::cursor; +use termion::input::Keys; +use termion::input::TermRead; +use termion::raw::RawTerminal; + +use crate::display; +use crate::types::command::Command; + +/// The full state of a running Game +pub struct Game<'a> { + settings: Settings, + + /// The box describing the viewport. Generally the size of the terminal, and + /// positioned at 0, 0 + viewport: BoundingBox, + + /// An iterator on keypresses from the user + keys: Keys>, + + stdout: RawTerminal>, + + /// The position of the character + character: Position, +} + +impl<'a> Game<'a> { + pub fn new( + settings: Settings, + stdout: RawTerminal>, + stdin: StdinLock<'a>, + w: u16, + h: u16, + ) -> Game<'a> { + Game { + settings: settings, + viewport: BoundingBox::at_origin(Dimensions { w, h }), + keys: stdin.keys(), + stdout: stdout, + character: Position { x: 1, y: 1 }, + } + } + + /// Returns true if there's a collision in the game at the given Position + fn collision_at(&self, pos: Position) -> bool { + !pos.within(self.viewport.inner()) + } + + /// Run the game + pub fn run(mut self) { + info!("Running game"); + write!( + self, + "{}{}@{}", + display::make_box( + display::BoxStyle::Thin, + self.viewport.dimensions + ), + cursor::Goto(2, 2), + cursor::Left(1), + ) + .unwrap(); + self.flush().unwrap(); + loop { + let mut character_moved = false; + match Command::from_key(self.keys.next().unwrap().unwrap()) { + Some(Command::Quit) => { + info!("Quitting game due to user request"); + break; + } + + Some(Command::Move(direction)) => { + let new_pos = self.character + direction; + if !self.collision_at(new_pos) { + self.character = new_pos; + character_moved = true; + } + } + _ => (), + } + + if character_moved { + debug!("char: {:?}", self.character); + write!( + self, + " {}@{}", + cursor::Goto(self.character.x + 1, self.character.y + 1,), + cursor::Left(1) + ) + .unwrap(); + } + self.flush().unwrap(); + } + } +} + +impl<'a> Drop for Game<'a> { + fn drop(&mut self) { + display::clear(self).unwrap(); + } +} + +impl<'a> Write for Game<'a> { + fn write(&mut self, buf: &[u8]) -> io::Result { + self.stdout.write(buf) + } + + fn flush(&mut self) -> io::Result<()> { + self.stdout.flush() + } + + fn write_all(&mut self, buf: &[u8]) -> io::Result<()> { + self.stdout.write_all(buf) + } +} diff --git a/src/main.rs b/src/main.rs new file mode 100644 index 0000000000..24d1bbba29 --- /dev/null +++ b/src/main.rs @@ -0,0 +1,73 @@ +extern crate termion; +#[macro_use] +extern crate log; +extern crate config; +extern crate log4rs; +#[macro_use] +extern crate serde_derive; +#[macro_use] +extern crate clap; +#[macro_use] +extern crate prettytable; + +mod display; +mod game; +#[macro_use] +mod types; +mod entities; +mod settings; + +use clap::App; +use game::Game; +use prettytable::format::consts::FORMAT_BOX_CHARS; +use settings::Settings; + +use std::io::{self, StdinLock, StdoutLock}; + +use termion::raw::IntoRawMode; +use termion::raw::RawTerminal; + +fn init( + settings: Settings, + stdout: RawTerminal>, + stdin: StdinLock<'_>, + w: u16, + h: u16, +) { + let game = Game::new(settings, stdout, stdin, w, h); + game.run() +} + +fn main() { + let yaml = load_yaml!("cli.yml"); + let matches = App::from_yaml(yaml).get_matches(); + let settings = Settings::load().unwrap(); + settings.logging.init_log(); + let stdout = io::stdout(); + let stdout = stdout.lock(); + + let stdin = io::stdin(); + let stdin = stdin.lock(); + + let termsize = termion::terminal_size().ok(); + // let termwidth = termsize.map(|(w, _)| w - 2).unwrap_or(70); + // let termheight = termsize.map(|(_, h)| h - 2).unwrap_or(40); + let (termwidth, termheight) = termsize.unwrap_or((70, 40)); + + match matches.subcommand() { + ("debug", _) => { + let mut table = table!( + [br->"termwidth", termwidth], + [br->"termheight", termheight], + [br->"logfile", settings.logging.file], + [br->"loglevel", settings.logging.level] + ); + table.set_format(*FORMAT_BOX_CHARS); + table.printstd(); + } + _ => { + let stdout = stdout.into_raw_mode().unwrap(); + init(settings, stdout, stdin, termwidth, termheight); + } + } +} diff --git a/src/settings.rs b/src/settings.rs new file mode 100644 index 0000000000..06f0d4e9d7 --- /dev/null +++ b/src/settings.rs @@ -0,0 +1,61 @@ +use config::{Config, ConfigError}; +use log::LevelFilter; +use log4rs::append::file::FileAppender; +use log4rs::config::{Appender, Root}; +use log4rs::encode::pattern::PatternEncoder; + +#[derive(Debug, Deserialize)] +pub struct Logging { + #[serde(default = "Logging::default_level")] + pub level: LevelFilter, + + #[serde(default = "Logging::default_file")] + pub file: String, +} + +impl Default for Logging { + fn default() -> Self { + Logging { + level: LevelFilter::Off, + file: "debug.log".to_string(), + } + } +} + +impl Logging { + pub fn init_log(&self) { + let logfile = FileAppender::builder() + .encoder(Box::new(PatternEncoder::new("{d} {l} - {m}\n"))) + .build(self.file.clone()) + .unwrap(); + + let config = log4rs::config::Config::builder() + .appender(Appender::builder().build("logfile", Box::new(logfile))) + .build(Root::builder().appender("logfile").build(self.level)) + .unwrap(); + + log4rs::init_config(config).unwrap(); + } + + fn default_level() -> LevelFilter { + Logging::default().level + } + + fn default_file() -> String { + Logging::default().file + } +} + +#[derive(Debug, Deserialize)] +pub struct Settings { + pub logging: Logging, +} + +impl Settings { + pub fn load() -> Result { + let mut s = Config::new(); + s.merge(config::File::with_name("Config").required(false))?; + s.merge(config::Environment::with_prefix("XAN"))?; + s.try_into() + } +} diff --git a/src/types/command.rs b/src/types/command.rs new file mode 100644 index 0000000000..86f83a12c1 --- /dev/null +++ b/src/types/command.rs @@ -0,0 +1,23 @@ +use super::Direction; +use super::Direction::*; +use termion::event::Key; +use termion::event::Key::Char; + +pub enum Command { + Quit, + Move(Direction), +} + +impl Command { + pub fn from_key(k: Key) -> Option { + use Command::*; + match k { + Char('q') => Some(Quit), + Char('h') | Char('a') | Key::Left => Some(Move(Left)), + Char('k') | Char('w') | Key::Up => Some(Move(Up)), + Char('j') | Char('s') | Key::Down => Some(Move(Down)), + Char('l') | Char('d') | Key::Right => Some(Move(Right)), + _ => None, + } + } +} diff --git a/src/types/direction.rs b/src/types/direction.rs new file mode 100644 index 0000000000..5ab660f193 --- /dev/null +++ b/src/types/direction.rs @@ -0,0 +1,9 @@ +use proptest_derive::Arbitrary; + +#[derive(Clone, Copy, Debug, PartialEq, Eq, Arbitrary)] +pub enum Direction { + Left, + Up, + Down, + Right, +} diff --git a/src/types/mod.rs b/src/types/mod.rs new file mode 100644 index 0000000000..331aa236e3 --- /dev/null +++ b/src/types/mod.rs @@ -0,0 +1,296 @@ +use std::cmp::Ordering; +use std::ops; +pub mod command; +pub mod direction; +pub use direction::Direction; +pub use direction::Direction::{Down, Left, Right, Up}; +use proptest_derive::Arbitrary; + +#[derive(Clone, Copy, Debug, PartialEq, Eq, Arbitrary)] +pub struct Dimensions { + #[proptest(strategy = "std::ops::Range::::from(0..100)")] + pub w: u16, + + #[proptest(strategy = "std::ops::Range::::from(0..100)")] + pub h: u16, +} + +pub const ZERO_DIMENSIONS: Dimensions = Dimensions { w: 0, h: 0 }; +pub const UNIT_DIMENSIONS: Dimensions = Dimensions { w: 1, h: 1 }; + +impl ops::Sub for Dimensions { + type Output = Dimensions; + fn sub(self, dims: Dimensions) -> Dimensions { + Dimensions { + w: self.w - dims.w, + h: self.h - dims.h, + } + } +} + +#[derive(Clone, Copy, Debug, PartialEq, Eq, Arbitrary)] +pub struct BoundingBox { + pub dimensions: Dimensions, + pub position: Position, +} + +impl BoundingBox { + pub fn at_origin(dimensions: Dimensions) -> BoundingBox { + BoundingBox { + dimensions, + position: ORIGIN, + } + } + + pub fn lr_corner(self) -> Position { + self.position + + (Position { + x: self.dimensions.w, + y: self.dimensions.h, + }) + } + + /// Returns a bounding box representing the *inside* of this box if it was + /// drawn on the screen. + pub fn inner(self) -> BoundingBox { + self + UNIT_POSITION - UNIT_DIMENSIONS - UNIT_DIMENSIONS + } +} + +impl ops::Add for BoundingBox { + type Output = BoundingBox; + fn add(self, pos: Position) -> BoundingBox { + BoundingBox { + position: self.position + pos, + ..self + } + } +} + +impl ops::Sub for BoundingBox { + type Output = BoundingBox; + fn sub(self, dims: Dimensions) -> BoundingBox { + BoundingBox { + dimensions: self.dimensions - dims, + ..self + } + } +} + +#[derive(Clone, Copy, Debug, PartialEq, Eq, Arbitrary)] +pub struct Position { + /// x (horizontal) position + #[proptest(strategy = "std::ops::Range::::from(0..100)")] + pub x: u16, + + #[proptest(strategy = "std::ops::Range::::from(0..100)")] + /// y (vertical) position + pub y: u16, +} + +pub const ORIGIN: Position = Position { x: 0, y: 0 }; +pub const UNIT_POSITION: Position = Position { x: 1, y: 1 }; + +impl Position { + /// Returns true if this position exists within the bounds of the given box, + /// inclusive + pub fn within(self, b: BoundingBox) -> bool { + (self > b.position - UNIT_POSITION) && self < (b.lr_corner()) + } +} + +impl PartialOrd for Position { + fn partial_cmp(&self, other: &Position) -> Option { + if self.x == other.x && self.y == other.y { + Some(Ordering::Equal) + } else if self.x > other.x && self.y > other.y { + Some(Ordering::Greater) + } else if self.x < other.x && self.y < other.y { + Some(Ordering::Less) + } else { + None + } + } +} + +/// Implements (bounded) addition of a Dimension to a position. +/// +/// # Examples +/// +/// ``` +/// let pos = Position { x: 1, y: 10 } +/// +/// let left_pos = pos + Direction::Left +/// assert_eq!(left, Position { x: 0, y: 10 }) +/// +/// let right_pos = pos + Direction::Right +/// assert_eq!(right_pos, Position { x: 0, y: 10 }) +/// ``` +impl ops::Add for Position { + type Output = Position; + fn add(self, dir: Direction) -> Position { + match dir { + Left => { + if self.x > 0 { + Position { + x: self.x - 1, + ..self + } + } else { + self + } + } + Right => { + if self.x < std::u16::MAX { + Position { + x: self.x + 1, + ..self + } + } else { + self + } + } + Up => { + if self.y > 0 { + Position { + y: self.y - 1, + ..self + } + } else { + self + } + } + Down => { + if self.y < std::u16::MAX { + Position { + y: self.y + 1, + ..self + } + } else { + self + } + } + } + } +} + +impl ops::Add for Position { + type Output = Position; + fn add(self, pos: Position) -> Position { + Position { + x: self.x + pos.x, + y: self.y + pos.y, + } + } +} + +impl ops::Sub for Position { + type Output = Position; + fn sub(self, pos: Position) -> Position { + Position { + x: self.x - pos.x, + y: self.y - pos.y, + } + } +} + +pub trait Positioned { + fn x(&self) -> u16 { + self.position().x + } + + fn y(&self) -> u16 { + self.position().y + } + + fn position(&self) -> Position { + Position { + x: self.x(), + y: self.y(), + } + } +} + +macro_rules! positioned { + ($name:ident) => { + positioned!($name, position); + }; + ($name:ident, $attr:ident) => { + impl crate::types::Positioned for $name { + fn position(&self) -> Position { + self.$attr + } + } + }; +} + +/// A number of ticks +#[derive(Clone, Copy, Debug, PartialEq, Eq, Arbitrary)] +pub struct Ticks(pub u16); + +/// A number of tiles +/// +/// Expressed in terms of a float to allow moving partial tiles in a number of +/// ticks +#[derive(Clone, Copy, Debug, PartialEq, Arbitrary)] +pub struct Tiles(pub f32); + +/// The speed of an entity, expressed in ticks per tile +#[derive(Clone, Copy, Debug, PartialEq, Eq, Arbitrary)] +pub struct Speed(pub u32); + +impl Speed { + pub fn ticks_to_tiles(self, ticks: Ticks) -> Tiles { + Tiles(ticks.0 as f32 / self.0 as f32) + } +} + +#[cfg(test)] +mod tests { + use super::*; + use proptest::prelude::*; + + proptest! { + #[test] + fn position_partialord_lt_transitive( + a: Position, + b: Position, + c: Position + ) { + if a < b && b < c { + assert!(a < c) + } + } + + #[test] + fn position_partialord_eq_transitive( + a: Position, + b: Position, + c: Position + ) { + if a == b && b == c { + assert!(a == c) + } + } + + #[test] + fn position_partialord_gt_transitive( + a: Position, + b: Position, + c: Position, + ) { + if a > b && b > c { + assert!(a > c) + } + } + + #[test] + fn position_partialord_antisymmetric(a: Position, b: Position) { + if a < b { + assert!(!(a > b)) + } else if a > b { + assert!(!(a < b)) + } + } + } +} -- cgit 1.4.1 From 78a52142d191d25a74cb2124d5cca8a69d51ba7f Mon Sep 17 00:00:00 2001 From: Griffin Smith Date: Sat, 6 Jul 2019 15:32:38 -0400 Subject: Make all drawing happen to a viewport We now have an inner and outer viewport, and entity positions are relative to the inner one while drawing happens to the outer one. --- proptest-regressions/display/viewport.txt | 7 ++ src/display/mod.rs | 9 ++ src/display/viewport.rs | 138 ++++++++++++++++++++++++++++++ src/entities/character.rs | 25 +++++- src/entities/mod.rs | 1 + src/game.rs | 94 ++++++++++---------- src/main.rs | 4 +- src/types/mod.rs | 48 ++++++++--- 8 files changed, 267 insertions(+), 59 deletions(-) create mode 100644 proptest-regressions/display/viewport.txt create mode 100644 src/display/viewport.rs diff --git a/proptest-regressions/display/viewport.txt b/proptest-regressions/display/viewport.txt new file mode 100644 index 0000000000..e38056d975 --- /dev/null +++ b/proptest-regressions/display/viewport.txt @@ -0,0 +1,7 @@ +# Seeds for failure cases proptest has generated in the past. It is +# automatically read and these particular cases re-run before any +# novel cases are generated. +# +# It is recommended to check this file in to source control so that +# everyone who runs the test benefits from these saved cases. +cc b84a5a6dbba5cfc69329a119d9e20328c0372e0db2b72e5d71d971e3f13f8749 # shrinks to pos = Position { x: 0, y: 0 }, outer = BoundingBox { dimensions: Dimensions { w: 0, h: 0 }, position: Position { x: 0, y: 0 } } diff --git a/src/display/mod.rs b/src/display/mod.rs index 5dba48b44d..664aaf319c 100644 --- a/src/display/mod.rs +++ b/src/display/mod.rs @@ -1,9 +1,18 @@ pub mod draw_box; pub mod utils; +pub mod viewport; +use crate::types::Positioned; pub use draw_box::{make_box, BoxStyle}; use std::io::{self, Write}; use termion::{clear, cursor, style}; +pub use viewport::Viewport; pub fn clear(out: &mut T) -> io::Result<()> { write!(out, "{}{}{}", clear::All, style::Reset, cursor::Goto(1, 1)) } + +pub trait Draw: Positioned { + /// Draw this entity, assuming the character is already at the correct + /// position + fn do_draw(&self, out: &mut W) -> io::Result<()>; +} diff --git a/src/display/viewport.rs b/src/display/viewport.rs new file mode 100644 index 0000000000..bd2fac0714 --- /dev/null +++ b/src/display/viewport.rs @@ -0,0 +1,138 @@ +use super::Draw; +use super::{make_box, BoxStyle}; +use crate::types::{BoundingBox, Position, Positioned}; +use std::fmt::{self, Debug}; +use std::io::{self, Write}; + +pub struct Viewport { + /// The box describing the visible part of the viewport. + /// + /// Generally the size of the terminal, and positioned at 0, 0 + pub outer: BoundingBox, + + /// The box describing the inner part of the viewport + /// + /// Its position is relative to `outer.inner()`, and its size should generally not + /// be smaller than outer + pub inner: BoundingBox, + + /// The actual screen that the viewport writes to + pub out: W, +} + +impl Debug for Viewport { + fn fmt(&self, f: &mut fmt::Formatter) -> fmt::Result { + write!( + f, + "Viewport {{ outer: {:?}, inner: {:?}, out: }}", + self.outer, self.inner + ) + } +} + +impl Viewport { + /// Returns true if the (inner-relative) position of the given entity is + /// visible within this viewport + fn visible(&self, ent: &E) -> bool { + self.on_screen(ent.position()).within(self.outer.inner()) + } + + /// Convert the given inner-relative position to one on the actual screen + fn on_screen(&self, pos: Position) -> Position { + pos + self.inner.position + self.outer.inner().position + } +} + +impl Viewport { + /// Draw the given entity to the viewport at its position, if visible + pub fn draw(&mut self, entity: &T) -> io::Result<()> { + if !self.visible(entity) { + return Ok(()); + } + write!( + self, + "{}", + (entity.position() + + self.inner.position + + self.outer.inner().position) + .cursor_goto() + )?; + entity.do_draw(self) + } + + /// Clear whatever is drawn at the given inner-relative position, if visible + pub fn clear(&mut self, pos: Position) -> io::Result<()> { + write!(self, "{} ", self.on_screen(pos).cursor_goto(),) + } + + /// Initialize this viewport by drawing its outer box to the screen + pub fn init(&mut self) -> io::Result<()> { + write!(self, "{}", make_box(BoxStyle::Thin, self.outer.dimensions)) + } +} + +impl Positioned for Viewport { + fn position(&self) -> Position { + self.outer.position + } +} + +impl Write for Viewport { + fn write(&mut self, buf: &[u8]) -> io::Result { + self.out.write(buf) + } + + fn flush(&mut self) -> io::Result<()> { + self.out.flush() + } + + fn write_all(&mut self, buf: &[u8]) -> io::Result<()> { + self.out.write_all(buf) + } +} + +#[cfg(test)] +mod tests { + use super::*; + use crate::types::Dimensions; + // use proptest::prelude::*; + + #[test] + fn test_visible() { + assert!(Viewport { + outer: BoundingBox::at_origin(Dimensions { w: 10, h: 10 }), + inner: BoundingBox { + position: Position { x: -10, y: -10 }, + dimensions: Dimensions { w: 15, h: 15 }, + }, + out: (), + } + .visible(&Position { x: 13, y: 13 })); + + assert!(!Viewport { + outer: BoundingBox::at_origin(Dimensions { w: 10, h: 10 }), + inner: BoundingBox { + position: Position { x: -10, y: -10 }, + dimensions: Dimensions { w: 15, h: 15 }, + }, + out: (), + } + .visible(&Position { x: 1, y: 1 })); + } + + // proptest! { + // #[test] + // fn nothing_is_visible_in_viewport_off_screen(pos: Position, outer: BoundingBox) { + // let invisible_viewport = Viewport { + // outer, + // inner: BoundingBox { + // position: Position {x: -(outer.dimensions.w as i16), y: -(outer.dimensions.h as i16)}, + // dimensions: outer.dimensions, + // }, + // out: () + // }; + + // assert!(!invisible_viewport.visible(&pos)); + // } + // } +} diff --git a/src/entities/character.rs b/src/entities/character.rs index e40b7b988e..f436608ea5 100644 --- a/src/entities/character.rs +++ b/src/entities/character.rs @@ -1,15 +1,38 @@ +use proptest_derive::Arbitrary; +use std::io::{self, Write}; +use termion::cursor; + +use crate::display; use crate::types::{Position, Speed}; const DEFAULT_SPEED: Speed = Speed(100); +#[derive(Debug, PartialEq, Eq, Arbitrary)] pub struct Character { - position: Position, + /// The position of the character, relative to the game + pub position: Position, } impl Character { + pub fn new() -> Character { + Character { + position: Position { x: 0, y: 0 }, + } + } + pub fn speed(&self) -> Speed { Speed(100) } } positioned!(Character); + +impl display::Draw for Character { + fn do_draw(&self, out: &mut W) -> io::Result<()> { + write!( + out, + "@{}", + cursor::Left(1), + ) + } +} diff --git a/src/entities/mod.rs b/src/entities/mod.rs index 7889122666..0320f2ddd9 100644 --- a/src/entities/mod.rs +++ b/src/entities/mod.rs @@ -1 +1,2 @@ pub mod character; +pub use character::Character; diff --git a/src/game.rs b/src/game.rs index a41d7f73fd..6274ef573f 100644 --- a/src/game.rs +++ b/src/game.rs @@ -1,30 +1,28 @@ -use std::thread; use crate::settings::Settings; +use crate::types::Positioned; use crate::types::{BoundingBox, Dimensions, Position}; use std::io::{self, StdinLock, StdoutLock, Write}; -use termion::cursor; use termion::input::Keys; use termion::input::TermRead; use termion::raw::RawTerminal; -use crate::display; +use crate::display::{self, Viewport}; +use crate::entities::Character; use crate::types::command::Command; +type Stdout<'a> = RawTerminal>; + /// The full state of a running Game pub struct Game<'a> { settings: Settings, - /// The box describing the viewport. Generally the size of the terminal, and - /// positioned at 0, 0 - viewport: BoundingBox, + viewport: Viewport>, /// An iterator on keypresses from the user keys: Keys>, - stdout: RawTerminal>, - - /// The position of the character - character: Position, + /// The player character + character: Character, } impl<'a> Game<'a> { @@ -37,35 +35,36 @@ impl<'a> Game<'a> { ) -> Game<'a> { Game { settings: settings, - viewport: BoundingBox::at_origin(Dimensions { w, h }), + viewport: Viewport { + outer: BoundingBox::at_origin(Dimensions { w, h }), + inner: BoundingBox::at_origin(Dimensions { + w: w - 2, + h: h - 2, + }), + out: stdout, + }, keys: stdin.keys(), - stdout: stdout, - character: Position { x: 1, y: 1 }, + character: Character::new(), } } /// Returns true if there's a collision in the game at the given Position fn collision_at(&self, pos: Position) -> bool { - !pos.within(self.viewport.inner()) + !pos.within(self.viewport.inner) + } + + fn draw_entities(&mut self) -> io::Result<()> { + self.viewport.draw(&self.character) } /// Run the game - pub fn run(mut self) { + pub fn run(mut self) -> io::Result<()> { info!("Running game"); - write!( - self, - "{}{}@{}", - display::make_box( - display::BoxStyle::Thin, - self.viewport.dimensions - ), - cursor::Goto(2, 2), - cursor::Left(1), - ) - .unwrap(); - self.flush().unwrap(); + self.viewport.init()?; + self.draw_entities()?; + self.flush()?; loop { - let mut character_moved = false; + let mut old_position = None; match Command::from_key(self.keys.next().unwrap().unwrap()) { Some(Command::Quit) => { info!("Quitting game due to user request"); @@ -73,46 +72,51 @@ impl<'a> Game<'a> { } Some(Command::Move(direction)) => { - let new_pos = self.character + direction; + let new_pos = self.character.position + direction; if !self.collision_at(new_pos) { - self.character = new_pos; - character_moved = true; + old_position = Some(self.character.position); + self.character.position = new_pos; } } _ => (), } - if character_moved { - debug!("char: {:?}", self.character); - write!( - self, - " {}@{}", - cursor::Goto(self.character.x + 1, self.character.y + 1,), - cursor::Left(1) - ) - .unwrap(); + match old_position { + Some(old_pos) => { + self.viewport.clear(old_pos)?; + self.viewport.draw(&self.character)?; + } + None => () } - self.flush().unwrap(); + self.flush()?; + debug!("{:?}", self.character); } + Ok(()) } } impl<'a> Drop for Game<'a> { fn drop(&mut self) { - display::clear(self).unwrap(); + display::clear(self).unwrap_or(()); } } impl<'a> Write for Game<'a> { fn write(&mut self, buf: &[u8]) -> io::Result { - self.stdout.write(buf) + self.viewport.write(buf) } fn flush(&mut self) -> io::Result<()> { - self.stdout.flush() + self.viewport.flush() } fn write_all(&mut self, buf: &[u8]) -> io::Result<()> { - self.stdout.write_all(buf) + self.viewport.write_all(buf) + } +} + +impl<'a> Positioned for Game<'a> { + fn position(&self) -> Position { + Position { x: 0, y: 0 } } } diff --git a/src/main.rs b/src/main.rs index 24d1bbba29..f2c3d00f96 100644 --- a/src/main.rs +++ b/src/main.rs @@ -23,6 +23,7 @@ use prettytable::format::consts::FORMAT_BOX_CHARS; use settings::Settings; use std::io::{self, StdinLock, StdoutLock}; +use std::panic; use termion::raw::IntoRawMode; use termion::raw::RawTerminal; @@ -34,8 +35,9 @@ fn init( w: u16, h: u16, ) { + panic::set_hook(Box::new(|info| error!("{}", info))); let game = Game::new(settings, stdout, stdin, w, h); - game.run() + game.run().unwrap() } fn main() { diff --git a/src/types/mod.rs b/src/types/mod.rs index 331aa236e3..146dfac9d9 100644 --- a/src/types/mod.rs +++ b/src/types/mod.rs @@ -5,6 +5,7 @@ pub mod direction; pub use direction::Direction; pub use direction::Direction::{Down, Left, Right, Up}; use proptest_derive::Arbitrary; +use termion::cursor; #[derive(Clone, Copy, Debug, PartialEq, Eq, Arbitrary)] pub struct Dimensions { @@ -42,11 +43,21 @@ impl BoundingBox { } } + pub fn from_corners(top_left: Position, lower_right: Position) -> BoundingBox { + BoundingBox { + position: top_left, + dimensions: Dimensions { + w: (lower_right.x - top_left.x) as u16, + h: (lower_right.y - top_left.y) as u16, + } + } + } + pub fn lr_corner(self) -> Position { self.position + (Position { - x: self.dimensions.w, - y: self.dimensions.h, + x: self.dimensions.w as i16, + y: self.dimensions.h as i16, }) } @@ -80,12 +91,12 @@ impl ops::Sub for BoundingBox { #[derive(Clone, Copy, Debug, PartialEq, Eq, Arbitrary)] pub struct Position { /// x (horizontal) position - #[proptest(strategy = "std::ops::Range::::from(0..100)")] - pub x: u16, + #[proptest(strategy = "std::ops::Range::::from(0..100)")] + pub x: i16, - #[proptest(strategy = "std::ops::Range::::from(0..100)")] + #[proptest(strategy = "std::ops::Range::::from(0..100)")] /// y (vertical) position - pub y: u16, + pub y: i16, } pub const ORIGIN: Position = Position { x: 0, y: 0 }; @@ -97,6 +108,13 @@ impl Position { pub fn within(self, b: BoundingBox) -> bool { (self > b.position - UNIT_POSITION) && self < (b.lr_corner()) } + + /// Returns a sequence of ASCII escape characters for moving the cursor to + /// this Position + pub fn cursor_goto(&self) -> cursor::Goto { + // + 1 because Goto is 1-based, but position is 0-based + cursor::Goto(self.x as u16 + 1, self.y as u16 + 1) + } } impl PartialOrd for Position { @@ -131,7 +149,7 @@ impl ops::Add for Position { fn add(self, dir: Direction) -> Position { match dir { Left => { - if self.x > 0 { + if self.x > std::i16::MIN { Position { x: self.x - 1, ..self @@ -141,7 +159,7 @@ impl ops::Add for Position { } } Right => { - if self.x < std::u16::MAX { + if self.x < std::i16::MAX { Position { x: self.x + 1, ..self @@ -151,7 +169,7 @@ impl ops::Add for Position { } } Up => { - if self.y > 0 { + if self.y > std::i16::MIN { Position { y: self.y - 1, ..self @@ -161,7 +179,7 @@ impl ops::Add for Position { } } Down => { - if self.y < std::u16::MAX { + if self.y < std::i16::MAX { Position { y: self.y + 1, ..self @@ -194,12 +212,18 @@ impl ops::Sub for Position { } } +impl Positioned for Position { + fn position(&self) -> Position { + *self + } +} + pub trait Positioned { - fn x(&self) -> u16 { + fn x(&self) -> i16 { self.position().x } - fn y(&self) -> u16 { + fn y(&self) -> i16 { self.position().y } -- cgit 1.4.1 From c643ee1dfcb8d44b8cd198c768f31dd7659f2ff9 Mon Sep 17 00:00:00 2001 From: Griffin Smith Date: Sun, 7 Jul 2019 12:41:15 -0400 Subject: Add messages, with global lookup map Add support for messages, along with a global lookup map and random choice of messages. --- Cargo.lock | 106 +++++++++++++++++++++++++++ Cargo.toml | 7 +- src/display/draw_box.rs | 17 +++++ src/display/viewport.rs | 107 ++++++++++++++++++---------- src/game.rs | 55 ++++++++++---- src/main.rs | 8 +++ src/messages.rs | 186 ++++++++++++++++++++++++++++++++++++++++++++++++ src/messages.toml | 2 + src/settings.rs | 1 + src/types/mod.rs | 6 ++ 10 files changed, 443 insertions(+), 52 deletions(-) create mode 100644 src/messages.rs create mode 100644 src/messages.toml diff --git a/Cargo.lock b/Cargo.lock index 5eacba2125..562bc2ee33 100644 --- a/Cargo.lock +++ b/Cargo.lock @@ -131,6 +131,15 @@ name = "byteorder" version = "1.3.1" source = "registry+https://github.com/rust-lang/crates.io-index" +[[package]] +name = "c2-chacha" +version = "0.2.2" +source = "registry+https://github.com/rust-lang/crates.io-index" +dependencies = [ + "lazy_static 1.3.0 (registry+https://github.com/rust-lang/crates.io-index)", + "ppv-lite86 0.2.5 (registry+https://github.com/rust-lang/crates.io-index)", +] + [[package]] name = "cc" version = "1.0.37" @@ -296,6 +305,15 @@ name = "fuchsia-cprng" version = "0.1.1" source = "registry+https://github.com/rust-lang/crates.io-index" +[[package]] +name = "getrandom" +version = "0.1.6" +source = "registry+https://github.com/rust-lang/crates.io-index" +dependencies = [ + "lazy_static 1.3.0 (registry+https://github.com/rust-lang/crates.io-index)", + "libc 0.2.58 (registry+https://github.com/rust-lang/crates.io-index)", +] + [[package]] name = "humantime" version = "1.2.0" @@ -326,6 +344,9 @@ source = "registry+https://github.com/rust-lang/crates.io-index" name = "lazy_static" version = "1.3.0" source = "registry+https://github.com/rust-lang/crates.io-index" +dependencies = [ + "spin 0.5.0 (registry+https://github.com/rust-lang/crates.io-index)", +] [[package]] name = "libc" @@ -384,6 +405,11 @@ dependencies = [ "winapi 0.3.7 (registry+https://github.com/rust-lang/crates.io-index)", ] +[[package]] +name = "maplit" +version = "1.0.1" +source = "registry+https://github.com/rust-lang/crates.io-index" + [[package]] name = "memchr" version = "2.2.0" @@ -472,6 +498,11 @@ dependencies = [ "num-traits 0.2.8 (registry+https://github.com/rust-lang/crates.io-index)", ] +[[package]] +name = "ppv-lite86" +version = "0.2.5" +source = "registry+https://github.com/rust-lang/crates.io-index" + [[package]] name = "prettytable-rs" version = "0.8.0" @@ -553,6 +584,19 @@ dependencies = [ "winapi 0.3.7 (registry+https://github.com/rust-lang/crates.io-index)", ] +[[package]] +name = "rand" +version = "0.7.0" +source = "registry+https://github.com/rust-lang/crates.io-index" +dependencies = [ + "getrandom 0.1.6 (registry+https://github.com/rust-lang/crates.io-index)", + "libc 0.2.58 (registry+https://github.com/rust-lang/crates.io-index)", + "rand_chacha 0.2.0 (registry+https://github.com/rust-lang/crates.io-index)", + "rand_core 0.5.0 (registry+https://github.com/rust-lang/crates.io-index)", + "rand_hc 0.2.0 (registry+https://github.com/rust-lang/crates.io-index)", + "rand_pcg 0.2.0 (registry+https://github.com/rust-lang/crates.io-index)", +] + [[package]] name = "rand_chacha" version = "0.1.1" @@ -562,6 +606,16 @@ dependencies = [ "rand_core 0.3.1 (registry+https://github.com/rust-lang/crates.io-index)", ] +[[package]] +name = "rand_chacha" +version = "0.2.0" +source = "registry+https://github.com/rust-lang/crates.io-index" +dependencies = [ + "autocfg 0.1.4 (registry+https://github.com/rust-lang/crates.io-index)", + "c2-chacha 0.2.2 (registry+https://github.com/rust-lang/crates.io-index)", + "rand_core 0.5.0 (registry+https://github.com/rust-lang/crates.io-index)", +] + [[package]] name = "rand_core" version = "0.3.1" @@ -575,6 +629,14 @@ name = "rand_core" version = "0.4.0" source = "registry+https://github.com/rust-lang/crates.io-index" +[[package]] +name = "rand_core" +version = "0.5.0" +source = "registry+https://github.com/rust-lang/crates.io-index" +dependencies = [ + "getrandom 0.1.6 (registry+https://github.com/rust-lang/crates.io-index)", +] + [[package]] name = "rand_hc" version = "0.1.0" @@ -583,6 +645,14 @@ dependencies = [ "rand_core 0.3.1 (registry+https://github.com/rust-lang/crates.io-index)", ] +[[package]] +name = "rand_hc" +version = "0.2.0" +source = "registry+https://github.com/rust-lang/crates.io-index" +dependencies = [ + "rand_core 0.5.0 (registry+https://github.com/rust-lang/crates.io-index)", +] + [[package]] name = "rand_isaac" version = "0.1.1" @@ -623,6 +693,15 @@ dependencies = [ "rand_core 0.4.0 (registry+https://github.com/rust-lang/crates.io-index)", ] +[[package]] +name = "rand_pcg" +version = "0.2.0" +source = "registry+https://github.com/rust-lang/crates.io-index" +dependencies = [ + "autocfg 0.1.4 (registry+https://github.com/rust-lang/crates.io-index)", + "rand_core 0.5.0 (registry+https://github.com/rust-lang/crates.io-index)", +] + [[package]] name = "rand_xorshift" version = "0.1.1" @@ -805,6 +884,11 @@ dependencies = [ "yaml-rust 0.4.3 (registry+https://github.com/rust-lang/crates.io-index)", ] +[[package]] +name = "spin" +version = "0.5.0" +source = "registry+https://github.com/rust-lang/crates.io-index" + [[package]] name = "strsim" version = "0.8.0" @@ -909,6 +993,14 @@ dependencies = [ "serde 1.0.92 (registry+https://github.com/rust-lang/crates.io-index)", ] +[[package]] +name = "toml" +version = "0.5.1" +source = "registry+https://github.com/rust-lang/crates.io-index" +dependencies = [ + "serde 1.0.92 (registry+https://github.com/rust-lang/crates.io-index)", +] + [[package]] name = "traitobject" version = "0.1.0" @@ -997,12 +1089,15 @@ dependencies = [ "lazy_static 1.3.0 (registry+https://github.com/rust-lang/crates.io-index)", "log 0.4.6 (registry+https://github.com/rust-lang/crates.io-index)", "log4rs 0.8.3 (registry+https://github.com/rust-lang/crates.io-index)", + "maplit 1.0.1 (registry+https://github.com/rust-lang/crates.io-index)", "prettytable-rs 0.8.0 (registry+https://github.com/rust-lang/crates.io-index)", "proptest 0.9.3 (registry+https://github.com/rust-lang/crates.io-index)", "proptest-derive 0.1.1 (registry+https://github.com/rust-lang/crates.io-index)", + "rand 0.7.0 (registry+https://github.com/rust-lang/crates.io-index)", "serde 1.0.92 (registry+https://github.com/rust-lang/crates.io-index)", "serde_derive 1.0.92 (registry+https://github.com/rust-lang/crates.io-index)", "termion 1.5.2 (registry+https://github.com/rust-lang/crates.io-index)", + "toml 0.5.1 (registry+https://github.com/rust-lang/crates.io-index)", ] [[package]] @@ -1037,6 +1132,7 @@ dependencies = [ "checksum bstr 0.2.1 (registry+https://github.com/rust-lang/crates.io-index)" = "6cc0572e02f76cb335f309b19e0a0d585b4f62788f7d26de2a13a836a637385f" "checksum build_const 0.2.1 (registry+https://github.com/rust-lang/crates.io-index)" = "39092a32794787acd8525ee150305ff051b0aa6cc2abaf193924f5ab05425f39" "checksum byteorder 1.3.1 (registry+https://github.com/rust-lang/crates.io-index)" = "a019b10a2a7cdeb292db131fc8113e57ea2a908f6e7894b0c3c671893b65dbeb" +"checksum c2-chacha 0.2.2 (registry+https://github.com/rust-lang/crates.io-index)" = "7d64d04786e0f528460fc884753cf8dddcc466be308f6026f8e355c41a0e4101" "checksum cc 1.0.37 (registry+https://github.com/rust-lang/crates.io-index)" = "39f75544d7bbaf57560d2168f28fd649ff9c76153874db88bdbdfd839b1a7e7d" "checksum cfg-if 0.1.9 (registry+https://github.com/rust-lang/crates.io-index)" = "b486ce3ccf7ffd79fdeb678eac06a9e6c09fc88d33836340becb8fffe87c5e33" "checksum chrono 0.4.6 (registry+https://github.com/rust-lang/crates.io-index)" = "45912881121cb26fad7c38c17ba7daa18764771836b34fab7d3fbd93ed633878" @@ -1057,6 +1153,7 @@ dependencies = [ "checksum flate2 1.0.7 (registry+https://github.com/rust-lang/crates.io-index)" = "f87e68aa82b2de08a6e037f1385455759df6e445a8df5e005b4297191dbf18aa" "checksum fnv 1.0.6 (registry+https://github.com/rust-lang/crates.io-index)" = "2fad85553e09a6f881f739c29f0b00b0f01357c743266d478b68951ce23285f3" "checksum fuchsia-cprng 0.1.1 (registry+https://github.com/rust-lang/crates.io-index)" = "a06f77d526c1a601b7c4cdd98f54b5eaabffc14d5f2f0296febdc7f357c6d3ba" +"checksum getrandom 0.1.6 (registry+https://github.com/rust-lang/crates.io-index)" = "e65cce4e5084b14874c4e7097f38cab54f47ee554f9194673456ea379dcc4c55" "checksum humantime 1.2.0 (registry+https://github.com/rust-lang/crates.io-index)" = "3ca7e5f2e110db35f93b837c81797f3714500b81d517bf20c431b16d3ca4f114" "checksum itertools 0.8.0 (registry+https://github.com/rust-lang/crates.io-index)" = "5b8467d9c1cebe26feb08c640139247fac215782d35371ade9a2136ed6085358" "checksum itoa 0.4.4 (registry+https://github.com/rust-lang/crates.io-index)" = "501266b7edd0174f8530248f87f99c88fbe60ca4ef3dd486835b8d8d53136f7f" @@ -1068,6 +1165,7 @@ dependencies = [ "checksum log 0.4.6 (registry+https://github.com/rust-lang/crates.io-index)" = "c84ec4b527950aa83a329754b01dbe3f58361d1c5efacd1f6d68c494d08a17c6" "checksum log-mdc 0.1.0 (registry+https://github.com/rust-lang/crates.io-index)" = "a94d21414c1f4a51209ad204c1776a3d0765002c76c6abcb602a6f09f1e881c7" "checksum log4rs 0.8.3 (registry+https://github.com/rust-lang/crates.io-index)" = "100052474df98158c0738a7d3f4249c99978490178b5f9f68cd835ac57adbd1b" +"checksum maplit 1.0.1 (registry+https://github.com/rust-lang/crates.io-index)" = "08cbb6b4fef96b6d77bfc40ec491b1690c779e77b05cd9f07f787ed376fd4c43" "checksum memchr 2.2.0 (registry+https://github.com/rust-lang/crates.io-index)" = "2efc7bc57c883d4a4d6e3246905283d8dae951bb3bd32f49d6ef297f546e1c39" "checksum miniz-sys 0.1.12 (registry+https://github.com/rust-lang/crates.io-index)" = "1e9e3ae51cea1576ceba0dde3d484d30e6e5b86dee0b2d412fe3a16a15c98202" "checksum miniz_oxide 0.2.1 (registry+https://github.com/rust-lang/crates.io-index)" = "c468f2369f07d651a5d0bb2c9079f8488a66d5466efe42d0c5c6466edcb7f71e" @@ -1079,6 +1177,7 @@ dependencies = [ "checksum num-traits 0.2.8 (registry+https://github.com/rust-lang/crates.io-index)" = "6ba9a427cfca2be13aa6f6403b0b7e7368fe982bfa16fccc450ce74c46cd9b32" "checksum numtoa 0.1.0 (registry+https://github.com/rust-lang/crates.io-index)" = "b8f8bdf33df195859076e54ab11ee78a1b208382d3a26ec40d142ffc1ecc49ef" "checksum ordered-float 1.0.2 (registry+https://github.com/rust-lang/crates.io-index)" = "18869315e81473c951eb56ad5558bbc56978562d3ecfb87abb7a1e944cea4518" +"checksum ppv-lite86 0.2.5 (registry+https://github.com/rust-lang/crates.io-index)" = "e3cbf9f658cdb5000fcf6f362b8ea2ba154b9f146a61c7a20d647034c6b6561b" "checksum prettytable-rs 0.8.0 (registry+https://github.com/rust-lang/crates.io-index)" = "0fd04b170004fa2daccf418a7f8253aaf033c27760b5f225889024cf66d7ac2e" "checksum proc-macro2 0.4.30 (registry+https://github.com/rust-lang/crates.io-index)" = "cf3d2011ab5c909338f7887f4fc896d35932e29146c12c8d01da6b22a80ba759" "checksum proptest 0.9.3 (registry+https://github.com/rust-lang/crates.io-index)" = "2afed8cbdc8a64b58a5c021757a782351ec1afee85be374872721c84d5da5d80" @@ -1086,14 +1185,19 @@ dependencies = [ "checksum quick-error 1.2.2 (registry+https://github.com/rust-lang/crates.io-index)" = "9274b940887ce9addde99c4eee6b5c44cc494b182b97e73dc8ffdcb3397fd3f0" "checksum quote 0.6.12 (registry+https://github.com/rust-lang/crates.io-index)" = "faf4799c5d274f3868a4aae320a0a182cbd2baee377b378f080e16a23e9d80db" "checksum rand 0.6.5 (registry+https://github.com/rust-lang/crates.io-index)" = "6d71dacdc3c88c1fde3885a3be3fbab9f35724e6ce99467f7d9c5026132184ca" +"checksum rand 0.7.0 (registry+https://github.com/rust-lang/crates.io-index)" = "d47eab0e83d9693d40f825f86948aa16eff6750ead4bdffc4ab95b8b3a7f052c" "checksum rand_chacha 0.1.1 (registry+https://github.com/rust-lang/crates.io-index)" = "556d3a1ca6600bfcbab7c7c91ccb085ac7fbbcd70e008a98742e7847f4f7bcef" +"checksum rand_chacha 0.2.0 (registry+https://github.com/rust-lang/crates.io-index)" = "e193067942ef6f485a349a113329140d0ab9e2168ce92274499bb0e9a4190d9d" "checksum rand_core 0.3.1 (registry+https://github.com/rust-lang/crates.io-index)" = "7a6fdeb83b075e8266dcc8762c22776f6877a63111121f5f8c7411e5be7eed4b" "checksum rand_core 0.4.0 (registry+https://github.com/rust-lang/crates.io-index)" = "d0e7a549d590831370895ab7ba4ea0c1b6b011d106b5ff2da6eee112615e6dc0" +"checksum rand_core 0.5.0 (registry+https://github.com/rust-lang/crates.io-index)" = "615e683324e75af5d43d8f7a39ffe3ee4a9dc42c5c701167a71dc59c3a493aca" "checksum rand_hc 0.1.0 (registry+https://github.com/rust-lang/crates.io-index)" = "7b40677c7be09ae76218dc623efbf7b18e34bced3f38883af07bb75630a21bc4" +"checksum rand_hc 0.2.0 (registry+https://github.com/rust-lang/crates.io-index)" = "ca3129af7b92a17112d59ad498c6f81eaf463253766b90396d39ea7a39d6613c" "checksum rand_isaac 0.1.1 (registry+https://github.com/rust-lang/crates.io-index)" = "ded997c9d5f13925be2a6fd7e66bf1872597f759fd9dd93513dd7e92e5a5ee08" "checksum rand_jitter 0.1.4 (registry+https://github.com/rust-lang/crates.io-index)" = "1166d5c91dc97b88d1decc3285bb0a99ed84b05cfd0bc2341bdf2d43fc41e39b" "checksum rand_os 0.1.3 (registry+https://github.com/rust-lang/crates.io-index)" = "7b75f676a1e053fc562eafbb47838d67c84801e38fc1ba459e8f180deabd5071" "checksum rand_pcg 0.1.2 (registry+https://github.com/rust-lang/crates.io-index)" = "abf9b09b01790cfe0364f52bf32995ea3c39f4d2dd011eac241d2914146d0b44" +"checksum rand_pcg 0.2.0 (registry+https://github.com/rust-lang/crates.io-index)" = "3e196346cbbc5c70c77e7b4926147ee8e383a38ee4d15d58a08098b169e492b6" "checksum rand_xorshift 0.1.1 (registry+https://github.com/rust-lang/crates.io-index)" = "cbf7e9e623549b0e21f6e97cf8ecf247c1a8fd2e8a992ae265314300b2455d5c" "checksum rdrand 0.4.0 (registry+https://github.com/rust-lang/crates.io-index)" = "678054eb77286b51581ba43620cc911abf02758c91f93f479767aed0f90458b2" "checksum redox_syscall 0.1.54 (registry+https://github.com/rust-lang/crates.io-index)" = "12229c14a0f65c4f1cb046a3b52047cdd9da1f4b30f8a39c5063c8bae515e252" @@ -1117,6 +1221,7 @@ dependencies = [ "checksum serde_json 1.0.39 (registry+https://github.com/rust-lang/crates.io-index)" = "5a23aa71d4a4d43fdbfaac00eff68ba8a06a51759a89ac3304323e800c4dd40d" "checksum serde_test 0.8.23 (registry+https://github.com/rust-lang/crates.io-index)" = "110b3dbdf8607ec493c22d5d947753282f3bae73c0f56d322af1e8c78e4c23d5" "checksum serde_yaml 0.8.9 (registry+https://github.com/rust-lang/crates.io-index)" = "38b08a9a90e5260fe01c6480ec7c811606df6d3a660415808c3c3fa8ed95b582" +"checksum spin 0.5.0 (registry+https://github.com/rust-lang/crates.io-index)" = "44363f6f51401c34e7be73db0db371c04705d35efbe9f7d6082e03a921a32c55" "checksum strsim 0.8.0 (registry+https://github.com/rust-lang/crates.io-index)" = "8ea5119cdb4c55b55d432abb513a0429384878c15dde60cc77b1c99de1a95a6a" "checksum syn 0.15.35 (registry+https://github.com/rust-lang/crates.io-index)" = "641e117d55514d6d918490e47102f7e08d096fdde360247e4a10f7a91a8478d3" "checksum synstructure 0.10.2 (registry+https://github.com/rust-lang/crates.io-index)" = "02353edf96d6e4dc81aea2d8490a7e9db177bf8acb0e951c24940bf866cb313f" @@ -1128,6 +1233,7 @@ dependencies = [ "checksum thread_local 0.3.6 (registry+https://github.com/rust-lang/crates.io-index)" = "c6b53e329000edc2b34dbe8545fd20e55a333362d0a321909685a19bd28c3f1b" "checksum time 0.1.42 (registry+https://github.com/rust-lang/crates.io-index)" = "db8dcfca086c1143c9270ac42a2bbd8a7ee477b78ac8e45b19abfb0cbede4b6f" "checksum toml 0.4.10 (registry+https://github.com/rust-lang/crates.io-index)" = "758664fc71a3a69038656bee8b6be6477d2a6c315a6b81f7081f591bffa4111f" +"checksum toml 0.5.1 (registry+https://github.com/rust-lang/crates.io-index)" = "b8c96d7873fa7ef8bdeb3a9cda3ac48389b4154f32b9803b4bc26220b677b039" "checksum traitobject 0.1.0 (registry+https://github.com/rust-lang/crates.io-index)" = "efd1f82c56340fdf16f2a953d7bda4f8fdffba13d93b00844c25572110b26079" "checksum typemap 0.3.3 (registry+https://github.com/rust-lang/crates.io-index)" = "653be63c80a3296da5551e1bfd2cca35227e13cdd08c6668903ae2f4f77aa1f6" "checksum ucd-util 0.1.3 (registry+https://github.com/rust-lang/crates.io-index)" = "535c204ee4d8434478593480b8f86ab45ec9aae0e83c568ca81abf0fd0e88f86" diff --git a/Cargo.toml b/Cargo.toml index c08edfe8fd..a9079b5dde 100644 --- a/Cargo.toml +++ b/Cargo.toml @@ -5,17 +5,20 @@ authors = ["Griffin Smith "] edition = "2018" [dependencies] +clap = {version = "^2.33.0", features = ["yaml"]} config = "*" itertools = "*" lazy_static = "*" log = "*" log4rs = "*" +maplit = "^1.0.1" +prettytable-rs = "^0.8" proptest = "0.9.3" proptest-derive = "*" +rand = {version = "^0.7.0", features = ["small_rng"]} serde = "^1.0.8" serde_derive = "^1.0.8" termion = "*" -clap = {version = "^2.33.0", features = ["yaml"]} -prettytable-rs = "^0.8" +toml = "^0.5.1" [dev-dependencies] diff --git a/src/display/draw_box.rs b/src/display/draw_box.rs index 986f09a49f..5dc1627a29 100644 --- a/src/display/draw_box.rs +++ b/src/display/draw_box.rs @@ -1,10 +1,12 @@ use crate::display::utils::clone_times; use crate::display::utils::times; +use crate::types::BoundingBox; use crate::types::Dimensions; use itertools::Itertools; use proptest::prelude::Arbitrary; use proptest::strategy; use proptest_derive::Arbitrary; +use std::io::{self, Write}; // Box Drawing // 0 1 2 3 4 5 6 7 8 9 A B C D E F @@ -164,6 +166,21 @@ pub fn make_box(style: BoxStyle, dims: Dimensions) -> String { } } +/// Draw the box described by the given BoundingBox's position and dimensions to +/// the given output, with the given style +pub fn draw_box( + out: &mut W, + bbox: BoundingBox, + style: BoxStyle, +) -> io::Result<()> { + write!( + out, + "{}{}", + bbox.position.cursor_goto(), + make_box(style, bbox.dimensions) + ) +} + #[cfg(test)] mod tests { use super::*; diff --git a/src/display/viewport.rs b/src/display/viewport.rs index bd2fac0714..24cc5272cb 100644 --- a/src/display/viewport.rs +++ b/src/display/viewport.rs @@ -1,5 +1,8 @@ +use super::BoxStyle; use super::Draw; -use super::{make_box, BoxStyle}; +use crate::display::draw_box::draw_box; +use crate::display::utils::clone_times; +use crate::display::utils::times; use crate::types::{BoundingBox, Position, Positioned}; use std::fmt::{self, Debug}; use std::io::{self, Write}; @@ -10,36 +13,47 @@ pub struct Viewport { /// Generally the size of the terminal, and positioned at 0, 0 pub outer: BoundingBox, + /// The box describing the game part of the viewport. + pub game: BoundingBox, + /// The box describing the inner part of the viewport /// - /// Its position is relative to `outer.inner()`, and its size should generally not - /// be smaller than outer + /// Its position is relative to `outer.inner()`, and its size should + /// generally not be smaller than outer pub inner: BoundingBox, /// The actual screen that the viewport writes to pub out: W, } - -impl Debug for Viewport { - fn fmt(&self, f: &mut fmt::Formatter) -> fmt::Result { - write!( - f, - "Viewport {{ outer: {:?}, inner: {:?}, out: }}", - self.outer, self.inner - ) +impl Viewport { + pub fn new(outer: BoundingBox, inner: BoundingBox, out: W) -> Self { + Viewport { + outer, + inner, + out, + game: outer.move_tr_corner(Position { x: 0, y: 1 }), + } } -} -impl Viewport { /// Returns true if the (inner-relative) position of the given entity is /// visible within this viewport - fn visible(&self, ent: &E) -> bool { - self.on_screen(ent.position()).within(self.outer.inner()) + pub fn visible(&self, ent: &E) -> bool { + self.on_screen(ent.position()).within(self.game.inner()) } /// Convert the given inner-relative position to one on the actual screen fn on_screen(&self, pos: Position) -> Position { - pos + self.inner.position + self.outer.inner().position + pos + self.inner.position + self.game.inner().position + } +} + +impl Debug for Viewport { + fn fmt(&self, f: &mut fmt::Formatter) -> fmt::Result { + write!( + f, + "Viewport {{ outer: {:?}, inner: {:?}, out: }}", + self.outer, self.inner + ) } } @@ -49,25 +63,46 @@ impl Viewport { if !self.visible(entity) { return Ok(()); } - write!( - self, - "{}", - (entity.position() - + self.inner.position - + self.outer.inner().position) - .cursor_goto() - )?; + self.cursor_goto(entity.position())?; entity.do_draw(self) } - /// Clear whatever is drawn at the given inner-relative position, if visible + /// Move the cursor to the given inner-relative position + pub fn cursor_goto(&mut self, pos: Position) -> io::Result<()> { + write!(self, "{}", self.on_screen(pos).cursor_goto()) + } + + /// Clear whatever single character is drawn at the given inner-relative + /// position, if visible pub fn clear(&mut self, pos: Position) -> io::Result<()> { write!(self, "{} ", self.on_screen(pos).cursor_goto(),) } /// Initialize this viewport by drawing its outer box to the screen pub fn init(&mut self) -> io::Result<()> { - write!(self, "{}", make_box(BoxStyle::Thin, self.outer.dimensions)) + draw_box(self, self.game, BoxStyle::Thin) + } + + /// Write a message to the message area on the screen + /// + /// Will overwrite any message already present, and if the given message is + /// longer than the screen will truncate. This means callers should handle + /// message buffering and ellipsisization + pub fn write_message(&mut self, msg: &str) -> io::Result<()> { + write!( + self, + "{}{}{}", + self.outer.position.cursor_goto(), + if msg.len() <= self.outer.dimensions.w as usize { + msg + } else { + &msg[0..self.outer.dimensions.w as usize] + }, + clone_times::<_, String>( + " ".to_string(), + self.outer.dimensions.w - msg.len() as u16 + ), + ) } } @@ -99,24 +134,24 @@ mod tests { #[test] fn test_visible() { - assert!(Viewport { - outer: BoundingBox::at_origin(Dimensions { w: 10, h: 10 }), - inner: BoundingBox { + assert!(Viewport::new( + BoundingBox::at_origin(Dimensions { w: 10, h: 10 }), + BoundingBox { position: Position { x: -10, y: -10 }, dimensions: Dimensions { w: 15, h: 15 }, }, - out: (), - } + () + ) .visible(&Position { x: 13, y: 13 })); - assert!(!Viewport { - outer: BoundingBox::at_origin(Dimensions { w: 10, h: 10 }), - inner: BoundingBox { + assert!(!Viewport::new( + BoundingBox::at_origin(Dimensions { w: 10, h: 10 }), + BoundingBox { position: Position { x: -10, y: -10 }, dimensions: Dimensions { w: 15, h: 15 }, }, - out: (), - } + (), + ) .visible(&Position { x: 1, y: 1 })); } diff --git a/src/game.rs b/src/game.rs index 6274ef573f..b619f13423 100644 --- a/src/game.rs +++ b/src/game.rs @@ -1,17 +1,21 @@ +use crate::display::{self, Viewport}; +use crate::entities::Character; +use crate::messages::message; use crate::settings::Settings; +use crate::types::command::Command; use crate::types::Positioned; use crate::types::{BoundingBox, Dimensions, Position}; +use rand::rngs::SmallRng; +use rand::SeedableRng; use std::io::{self, StdinLock, StdoutLock, Write}; use termion::input::Keys; use termion::input::TermRead; use termion::raw::RawTerminal; -use crate::display::{self, Viewport}; -use crate::entities::Character; -use crate::types::command::Command; - type Stdout<'a> = RawTerminal>; +type Rng = SmallRng; + /// The full state of a running Game pub struct Game<'a> { settings: Settings, @@ -23,6 +27,12 @@ pub struct Game<'a> { /// The player character character: Character, + + /// The messages that have been said to the user, in forward time order + messages: Vec, + + /// A global random number generator for the game + rng: Rng, } impl<'a> Game<'a> { @@ -33,18 +43,21 @@ impl<'a> Game<'a> { w: u16, h: u16, ) -> Game<'a> { + let rng = match settings.seed { + Some(seed) => SmallRng::seed_from_u64(seed), + None => SmallRng::from_entropy(), + }; Game { - settings: settings, - viewport: Viewport { - outer: BoundingBox::at_origin(Dimensions { w, h }), - inner: BoundingBox::at_origin(Dimensions { - w: w - 2, - h: h - 2, - }), - out: stdout, - }, + settings, + rng, + viewport: Viewport::new( + BoundingBox::at_origin(Dimensions { w, h }), + BoundingBox::at_origin(Dimensions { w: w - 2, h: h - 2 }), + stdout, + ), keys: stdin.keys(), character: Character::new(), + messages: Vec::new(), } } @@ -53,15 +66,29 @@ impl<'a> Game<'a> { !pos.within(self.viewport.inner) } + /// Draw all the game entities to the screen fn draw_entities(&mut self) -> io::Result<()> { self.viewport.draw(&self.character) } + /// Get a message from the global map based on the rng in this game + fn message(&mut self, name: &str) -> &'static str { + message(name, &mut self.rng) + } + + /// Say a message to the user + fn say(&mut self, message_name: &str) -> io::Result<()> { + let message = self.message(message_name); + self.messages.push(message.to_string()); + self.viewport.write_message(message) + } + /// Run the game pub fn run(mut self) -> io::Result<()> { info!("Running game"); self.viewport.init()?; self.draw_entities()?; + self.say("global.welcome")?; self.flush()?; loop { let mut old_position = None; @@ -86,7 +113,7 @@ impl<'a> Game<'a> { self.viewport.clear(old_pos)?; self.viewport.draw(&self.character)?; } - None => () + None => (), } self.flush()?; debug!("{:?}", self.character); diff --git a/src/main.rs b/src/main.rs index f2c3d00f96..6b0ae18181 100644 --- a/src/main.rs +++ b/src/main.rs @@ -3,18 +3,26 @@ extern crate termion; extern crate log; extern crate config; extern crate log4rs; +extern crate serde; +extern crate toml; #[macro_use] extern crate serde_derive; #[macro_use] extern crate clap; #[macro_use] extern crate prettytable; +#[macro_use] +extern crate lazy_static; +#[macro_use] +extern crate maplit; + mod display; mod game; #[macro_use] mod types; mod entities; +mod messages; mod settings; use clap::App; diff --git a/src/messages.rs b/src/messages.rs new file mode 100644 index 0000000000..2b9f098f98 --- /dev/null +++ b/src/messages.rs @@ -0,0 +1,186 @@ +use rand::seq::SliceRandom; +use rand::Rng; +use serde::de::MapAccess; +use serde::de::SeqAccess; +use serde::de::Visitor; +use std::collections::HashMap; +use std::fmt; +use std::marker::PhantomData; + +#[derive(Deserialize, Debug, PartialEq, Eq)] +#[serde(untagged)] +enum Message<'a> { + Single(&'a str), + Choice(Vec<&'a str>), +} + +impl<'a> Message<'a> { + fn resolve(&self, rng: &mut R) -> Option<&'a str> { + use Message::*; + match self { + Single(msg) => Some(*msg), + Choice(msgs) => msgs.choose(rng).map(|msg| *msg), + } + } +} + +#[derive(Debug, PartialEq, Eq)] +enum NestedMap<'a> { + Direct(Message<'a>), + Nested(HashMap<&'a str, NestedMap<'a>>), +} + +impl<'a> NestedMap<'a> { + fn lookup(&'a self, path: &str) -> Option<&'a Message<'a>> { + use NestedMap::*; + let leaf = + path.split(".") + .fold(Some(self), |current, key| match current { + Some(Nested(m)) => m.get(key), + _ => None, + }); + match leaf { + Some(Direct(msg)) => Some(msg), + _ => None, + } + } +} + +struct NestedMapVisitor<'a> { + marker: PhantomData NestedMap<'a>>, +} + +impl<'a> NestedMapVisitor<'a> { + fn new() -> Self { + NestedMapVisitor { + marker: PhantomData, + } + } +} + +impl<'de> Visitor<'de> for NestedMapVisitor<'de> { + type Value = NestedMap<'de>; + + fn expecting(&self, formatter: &mut fmt::Formatter) -> fmt::Result { + formatter.write_str( + "A message, a list of messages, or a nested map of messages", + ) + } + + fn visit_borrowed_str(self, v: &'de str) -> Result { + Ok(NestedMap::Direct(Message::Single(v))) + } + + fn visit_seq(self, mut seq: A) -> Result + where + A: SeqAccess<'de>, + { + let mut choices = Vec::with_capacity(seq.size_hint().unwrap_or(0)); + while let Some(choice) = seq.next_element()? { + choices.push(choice); + } + Ok(NestedMap::Direct(Message::Choice(choices))) + } + + fn visit_map(self, mut map: A) -> Result + where + A: MapAccess<'de>, + { + let mut nested = HashMap::with_capacity(map.size_hint().unwrap_or(0)); + while let Some((k, v)) = map.next_entry()? { + nested.insert(k, v); + } + Ok(NestedMap::Nested(nested)) + } +} + +impl<'de> serde::Deserialize<'de> for NestedMap<'de> { + fn deserialize(deserializer: D) -> Result + where + D: serde::Deserializer<'de>, + { + deserializer.deserialize_any(NestedMapVisitor::new()) + } +} + +#[cfg(test)] +mod tests { + use super::*; + + #[test] + fn test_deserialize_nested_map() { + let src = r#" +[global] +hello = "Hello World!" + +[foo.bar] +single = "Single" +choice = ["Say this", "Or this"] +"#; + let result = toml::from_str(src); + assert_eq!( + result, + Ok(NestedMap::Nested(hashmap! { + "global" => NestedMap::Nested(hashmap!{ + "hello" => NestedMap::Direct(Message::Single("Hello World!")), + }), + "foo" => NestedMap::Nested(hashmap!{ + "bar" => NestedMap::Nested(hashmap!{ + "single" => NestedMap::Direct(Message::Single("Single")), + "choice" => NestedMap::Direct(Message::Choice( + vec!["Say this", "Or this"] + )) + }) + }) + })) + ) + } + + #[test] + fn test_lookup() { + let map: NestedMap<'static> = toml::from_str( + r#" +[global] +hello = "Hello World!" + +[foo.bar] +single = "Single" +choice = ["Say this", "Or this"] +"#, + ) + .unwrap(); + + assert_eq!( + map.lookup("global.hello"), + Some(&Message::Single("Hello World!")) + ); + assert_eq!( + map.lookup("foo.bar.single"), + Some(&Message::Single("Single")) + ); + assert_eq!( + map.lookup("foo.bar.choice"), + Some(&Message::Choice(vec!["Say this", "Or this"])) + ); + } +} + +static MESSAGES_RAW: &'static str = include_str!("messages.toml"); + +lazy_static! { + static ref MESSAGES: NestedMap<'static> = + toml::from_str(MESSAGES_RAW).unwrap(); +} + +/// Look up a game message based on the given (dot-separated) name, with the +/// given random generator used to select from choice-based messages +pub fn message(name: &str, rng: &mut R) -> &'static str { + use Message::*; + MESSAGES + .lookup(name) + .and_then(|msg| msg.resolve(rng)) + .unwrap_or_else(|| { + error!("Message not found: {}", name); + "Message not found" + }) +} diff --git a/src/messages.toml b/src/messages.toml new file mode 100644 index 0000000000..04746462d5 --- /dev/null +++ b/src/messages.toml @@ -0,0 +1,2 @@ +[global] +welcome = "Welcome to Xanthous! It's dangerous out there, why not stay inside?" diff --git a/src/settings.rs b/src/settings.rs index 06f0d4e9d7..8444bf80ee 100644 --- a/src/settings.rs +++ b/src/settings.rs @@ -48,6 +48,7 @@ impl Logging { #[derive(Debug, Deserialize)] pub struct Settings { + pub seed: Option, pub logging: Logging, } diff --git a/src/types/mod.rs b/src/types/mod.rs index 146dfac9d9..ab66a50cc2 100644 --- a/src/types/mod.rs +++ b/src/types/mod.rs @@ -66,6 +66,12 @@ impl BoundingBox { pub fn inner(self) -> BoundingBox { self + UNIT_POSITION - UNIT_DIMENSIONS - UNIT_DIMENSIONS } + + /// Moves the top right corner of the bounding box by the offset specified + /// by the given position, keeping the lower right corner in place + pub fn move_tr_corner(self, offset: Position) -> BoundingBox { + self + offset - Dimensions { w: offset.x as u16, h: offset.y as u16 } + } } impl ops::Add for BoundingBox { -- cgit 1.4.1 From 20f1ccb4600b88ac01768e912e6d5837534ca852 Mon Sep 17 00:00:00 2001 From: Griffin Smith Date: Sun, 7 Jul 2019 13:02:50 -0400 Subject: add "Previous message" command ctrl+p, like nethack. Cycles through messages, also like nethack. May want to add some sort of indicator of how many messages there have been. --- src/game.rs | 26 +++++++++++++++++++++++--- src/messages.rs | 1 - src/types/command.rs | 9 ++++++++- 3 files changed, 31 insertions(+), 5 deletions(-) diff --git a/src/game.rs b/src/game.rs index b619f13423..daa5fa575f 100644 --- a/src/game.rs +++ b/src/game.rs @@ -31,6 +31,10 @@ pub struct Game<'a> { /// The messages that have been said to the user, in forward time order messages: Vec, + /// The index of the currently-displayed message. Used to track the index of + /// the currently displayed message when handling PreviousMessage commands + message_idx: usize, + /// A global random number generator for the game rng: Rng, } @@ -50,6 +54,7 @@ impl<'a> Game<'a> { Game { settings, rng, + message_idx: 0, viewport: Viewport::new( BoundingBox::at_origin(Dimensions { w, h }), BoundingBox::at_origin(Dimensions { w: w - 2, h: h - 2 }), @@ -80,6 +85,16 @@ impl<'a> Game<'a> { fn say(&mut self, message_name: &str) -> io::Result<()> { let message = self.message(message_name); self.messages.push(message.to_string()); + self.message_idx = self.messages.len() - 1; + self.viewport.write_message(message) + } + + fn previous_message(&mut self) -> io::Result<()> { + if self.message_idx == 0 { + return Ok(()); + } + self.message_idx -= 1; + let message = &self.messages[self.message_idx]; self.viewport.write_message(message) } @@ -89,23 +104,28 @@ impl<'a> Game<'a> { self.viewport.init()?; self.draw_entities()?; self.say("global.welcome")?; + self.say("somethign else")?; self.flush()?; loop { let mut old_position = None; + use Command::*; match Command::from_key(self.keys.next().unwrap().unwrap()) { - Some(Command::Quit) => { + Some(Quit) => { info!("Quitting game due to user request"); break; } - Some(Command::Move(direction)) => { + Some(Move(direction)) => { let new_pos = self.character.position + direction; if !self.collision_at(new_pos) { old_position = Some(self.character.position); self.character.position = new_pos; } } - _ => (), + + Some(PreviousMessage) => self.previous_message()?, + + None => (), } match old_position { diff --git a/src/messages.rs b/src/messages.rs index 2b9f098f98..03a96b4a0a 100644 --- a/src/messages.rs +++ b/src/messages.rs @@ -175,7 +175,6 @@ lazy_static! { /// Look up a game message based on the given (dot-separated) name, with the /// given random generator used to select from choice-based messages pub fn message(name: &str, rng: &mut R) -> &'static str { - use Message::*; MESSAGES .lookup(name) .and_then(|msg| msg.resolve(rng)) diff --git a/src/types/command.rs b/src/types/command.rs index 86f83a12c1..2a51531c0a 100644 --- a/src/types/command.rs +++ b/src/types/command.rs @@ -1,11 +1,17 @@ use super::Direction; use super::Direction::*; use termion::event::Key; -use termion::event::Key::Char; +use termion::event::Key::{Char, Ctrl}; pub enum Command { + /// Quit the game Quit, + + /// Move the character in a direction Move(Direction), + + /// Display the previous message + PreviousMessage, } impl Command { @@ -17,6 +23,7 @@ impl Command { Char('k') | Char('w') | Key::Up => Some(Move(Up)), Char('j') | Char('s') | Key::Down => Some(Move(Down)), Char('l') | Char('d') | Key::Right => Some(Move(Right)), + Ctrl('p') => Some(PreviousMessage), _ => None, } } -- cgit 1.4.1 From 5af2429ecb5742383cf0798ce23682d316bdb24d Mon Sep 17 00:00:00 2001 From: Griffin Smith Date: Mon, 8 Jul 2019 20:58:51 -0400 Subject: Implement a global map of entities Implement a global map of entities, which allows referencing by either position or ID and updating the positions of existent entities, and put the character in there. --- Cargo.lock | 8 + Cargo.toml | 2 + proptest-regressions/types/entity_map.txt | 7 + src/display/mod.rs | 14 +- src/display/viewport.rs | 1 - src/entities/character.rs | 19 ++- src/entities/mod.rs | 14 ++ src/game.rs | 78 ++++++++-- src/main.rs | 18 ++- src/settings.rs | 12 +- src/types/collision.rs | 8 + src/types/entity_map.rs | 242 ++++++++++++++++++++++++++++++ src/types/mod.rs | 78 +++++++++- src/util/mod.rs | 0 14 files changed, 465 insertions(+), 36 deletions(-) create mode 100644 proptest-regressions/types/entity_map.txt create mode 100644 src/types/collision.rs create mode 100644 src/types/entity_map.rs create mode 100644 src/util/mod.rs diff --git a/Cargo.lock b/Cargo.lock index 562bc2ee33..3b523d247b 100644 --- a/Cargo.lock +++ b/Cargo.lock @@ -249,6 +249,11 @@ dependencies = [ "winapi 0.3.7 (registry+https://github.com/rust-lang/crates.io-index)", ] +[[package]] +name = "downcast-rs" +version = "1.0.4" +source = "registry+https://github.com/rust-lang/crates.io-index" + [[package]] name = "dtoa" version = "0.4.4" @@ -1083,8 +1088,10 @@ source = "registry+https://github.com/rust-lang/crates.io-index" name = "xanthous" version = "0.1.0" dependencies = [ + "backtrace 0.3.32 (registry+https://github.com/rust-lang/crates.io-index)", "clap 2.33.0 (registry+https://github.com/rust-lang/crates.io-index)", "config 0.9.3 (registry+https://github.com/rust-lang/crates.io-index)", + "downcast-rs 1.0.4 (registry+https://github.com/rust-lang/crates.io-index)", "itertools 0.8.0 (registry+https://github.com/rust-lang/crates.io-index)", "lazy_static 1.3.0 (registry+https://github.com/rust-lang/crates.io-index)", "log 0.4.6 (registry+https://github.com/rust-lang/crates.io-index)", @@ -1145,6 +1152,7 @@ dependencies = [ "checksum csv 1.1.1 (registry+https://github.com/rust-lang/crates.io-index)" = "37519ccdfd73a75821cac9319d4fce15a81b9fcf75f951df5b9988aa3a0af87d" "checksum csv-core 0.1.6 (registry+https://github.com/rust-lang/crates.io-index)" = "9b5cadb6b25c77aeff80ba701712494213f4a8418fcda2ee11b6560c3ad0bf4c" "checksum dirs 1.0.5 (registry+https://github.com/rust-lang/crates.io-index)" = "3fd78930633bd1c6e35c4b42b1df7b0cbc6bc191146e512bb3bedf243fcc3901" +"checksum downcast-rs 1.0.4 (registry+https://github.com/rust-lang/crates.io-index)" = "f2b92dfd5c2f75260cbf750572f95d387e7ca0ba5e3fbe9e1a33f23025be020f" "checksum dtoa 0.4.4 (registry+https://github.com/rust-lang/crates.io-index)" = "ea57b42383d091c85abcc2706240b94ab2a8fa1fc81c10ff23c4de06e2a90b5e" "checksum either 1.5.2 (registry+https://github.com/rust-lang/crates.io-index)" = "5527cfe0d098f36e3f8839852688e63c8fff1c90b2b405aef730615f9a7bcf7b" "checksum encode_unicode 0.3.5 (registry+https://github.com/rust-lang/crates.io-index)" = "90b2c9496c001e8cb61827acdefad780795c42264c137744cae6f7d9e3450abd" diff --git a/Cargo.toml b/Cargo.toml index a9079b5dde..58fd93d3f5 100644 --- a/Cargo.toml +++ b/Cargo.toml @@ -5,8 +5,10 @@ authors = ["Griffin Smith "] edition = "2018" [dependencies] +backtrace = "0.3" clap = {version = "^2.33.0", features = ["yaml"]} config = "*" +downcast-rs = "^1.0.4" itertools = "*" lazy_static = "*" log = "*" diff --git a/proptest-regressions/types/entity_map.txt b/proptest-regressions/types/entity_map.txt new file mode 100644 index 0000000000..1549085b6c --- /dev/null +++ b/proptest-regressions/types/entity_map.txt @@ -0,0 +1,7 @@ +# Seeds for failure cases proptest has generated in the past. It is +# automatically read and these particular cases re-run before any +# novel cases are generated. +# +# It is recommended to check this file in to source control so that +# everyone who runs the test benefits from these saved cases. +cc 16afe2473971397314ffa77acf7bad62f0c40bc3f591aff7aa9193c29e5a0921 # shrinks to items = [(Position { x: 92, y: 60 }, ""), (Position { x: 92, y: 60 }, "")] diff --git a/src/display/mod.rs b/src/display/mod.rs index 664aaf319c..9e15a0d97d 100644 --- a/src/display/mod.rs +++ b/src/display/mod.rs @@ -14,5 +14,17 @@ pub fn clear(out: &mut T) -> io::Result<()> { pub trait Draw: Positioned { /// Draw this entity, assuming the character is already at the correct /// position - fn do_draw(&self, out: &mut W) -> io::Result<()>; + fn do_draw(&self, out: &mut Write) -> io::Result<()>; +} + +impl Draw for &T { + fn do_draw(&self, out: &mut Write) -> io::Result<()> { + (**self).do_draw(out) + } +} + +impl Draw for Box { + fn do_draw(&self, out: &mut Write) -> io::Result<()> { + (**self).do_draw(out) + } } diff --git a/src/display/viewport.rs b/src/display/viewport.rs index 24cc5272cb..780eb88714 100644 --- a/src/display/viewport.rs +++ b/src/display/viewport.rs @@ -2,7 +2,6 @@ use super::BoxStyle; use super::Draw; use crate::display::draw_box::draw_box; use crate::display::utils::clone_times; -use crate::display::utils::times; use crate::types::{BoundingBox, Position, Positioned}; use std::fmt::{self, Debug}; use std::io::{self, Write}; diff --git a/src/entities/character.rs b/src/entities/character.rs index f436608ea5..fb5a89591c 100644 --- a/src/entities/character.rs +++ b/src/entities/character.rs @@ -1,13 +1,13 @@ +use crate::display; +use crate::entities::Entity; +use crate::types::{Position, Speed}; use proptest_derive::Arbitrary; use std::io::{self, Write}; use termion::cursor; -use crate::display; -use crate::types::{Position, Speed}; - const DEFAULT_SPEED: Speed = Speed(100); -#[derive(Debug, PartialEq, Eq, Arbitrary)] +#[derive(Debug, PartialEq, Eq, Arbitrary, Clone)] pub struct Character { /// The position of the character, relative to the game pub position: Position, @@ -26,13 +26,12 @@ impl Character { } positioned!(Character); +positioned_mut!(Character); + +impl Entity for Character {} impl display::Draw for Character { - fn do_draw(&self, out: &mut W) -> io::Result<()> { - write!( - out, - "@{}", - cursor::Left(1), - ) + fn do_draw(&self, out: &mut Write) -> io::Result<()> { + write!(out, "@{}", cursor::Left(1),) } } diff --git a/src/entities/mod.rs b/src/entities/mod.rs index 0320f2ddd9..a23b15eef3 100644 --- a/src/entities/mod.rs +++ b/src/entities/mod.rs @@ -1,2 +1,16 @@ pub mod character; +use crate::display::Draw; +use crate::types::{Positioned, PositionedMut}; pub use character::Character; +use downcast_rs::Downcast; +use std::io::{self, Write}; + +pub trait Entity: Positioned + PositionedMut + Draw + Downcast {} + +impl_downcast!(Entity); + +impl Draw for Box { + fn do_draw(&self, out: &mut Write) -> io::Result<()> { + (**self).do_draw(out) + } +} diff --git a/src/game.rs b/src/game.rs index daa5fa575f..90d94dc5f2 100644 --- a/src/game.rs +++ b/src/game.rs @@ -1,10 +1,14 @@ use crate::display::{self, Viewport}; use crate::entities::Character; +use crate::entities::Entity; use crate::messages::message; use crate::settings::Settings; use crate::types::command::Command; -use crate::types::Positioned; -use crate::types::{BoundingBox, Dimensions, Position}; +use crate::types::entity_map::EntityID; +use crate::types::entity_map::EntityMap; +use crate::types::{ + BoundingBox, Collision, Dimensions, Position, Positioned, PositionedMut, +}; use rand::rngs::SmallRng; use rand::SeedableRng; use std::io::{self, StdinLock, StdoutLock, Write}; @@ -16,6 +20,20 @@ type Stdout<'a> = RawTerminal>; type Rng = SmallRng; +type AnEntity<'a> = Box; + +impl<'a> Positioned for AnEntity<'a> { + fn position(&self) -> Position { + (**self).position() + } +} + +impl<'a> PositionedMut for AnEntity<'a> { + fn set_position(&mut self, pos: Position) { + (**self).set_position(pos) + } +} + /// The full state of a running Game pub struct Game<'a> { settings: Settings, @@ -25,8 +43,11 @@ pub struct Game<'a> { /// An iterator on keypresses from the user keys: Keys>, - /// The player character - character: Character, + /// The map of all the entities in the game + entities: EntityMap>, + + /// The entity ID of the player character + character_entity_id: EntityID, /// The messages that have been said to the user, in forward time order messages: Vec, @@ -51,6 +72,7 @@ impl<'a> Game<'a> { Some(seed) => SmallRng::seed_from_u64(seed), None => SmallRng::from_entropy(), }; + let mut entities: EntityMap> = EntityMap::new(); Game { settings, rng, @@ -61,19 +83,34 @@ impl<'a> Game<'a> { stdout, ), keys: stdin.keys(), - character: Character::new(), + character_entity_id: entities.insert(Box::new(Character::new())), messages: Vec::new(), + entities, } } - /// Returns true if there's a collision in the game at the given Position - fn collision_at(&self, pos: Position) -> bool { - !pos.within(self.viewport.inner) + /// Returns a collision, if any, at the given Position in the game + fn collision_at(&self, pos: Position) -> Option { + if !pos.within(self.viewport.inner) { + Some(Collision::Stop) + } else { + None + } + } + + fn character(&self) -> &Character { + debug!("ents: {:?} cid: {:?}", self.entities.ids().map(|id| *id).collect::>(), self.character_entity_id); + (*self.entities.get(self.character_entity_id).unwrap()) + .downcast_ref() + .unwrap() } /// Draw all the game entities to the screen fn draw_entities(&mut self) -> io::Result<()> { - self.viewport.draw(&self.character) + for entity in self.entities.entities() { + self.viewport.draw(entity)?; + } + Ok(()) } /// Get a message from the global map based on the rng in this game @@ -104,7 +141,6 @@ impl<'a> Game<'a> { self.viewport.init()?; self.draw_entities()?; self.say("global.welcome")?; - self.say("somethign else")?; self.flush()?; loop { let mut old_position = None; @@ -116,10 +152,18 @@ impl<'a> Game<'a> { } Some(Move(direction)) => { - let new_pos = self.character.position + direction; - if !self.collision_at(new_pos) { - old_position = Some(self.character.position); - self.character.position = new_pos; + use Collision::*; + let new_pos = self.character().position + direction; + match self.collision_at(new_pos) { + None => { + old_position = Some(self.character().position); + self.entities.update_position( + self.character_entity_id, + new_pos, + ); + } + Some(Combat) => unimplemented!(), + Some(Stop) => (), } } @@ -131,12 +175,14 @@ impl<'a> Game<'a> { match old_position { Some(old_pos) => { self.viewport.clear(old_pos)?; - self.viewport.draw(&self.character)?; + self.viewport.draw( + // TODO this clone feels unnecessary. + &self.character().clone())?; } None => (), } self.flush()?; - debug!("{:?}", self.character); + debug!("{:?}", self.character()); } Ok(()) } diff --git a/src/main.rs b/src/main.rs index 6b0ae18181..8d7222106c 100644 --- a/src/main.rs +++ b/src/main.rs @@ -13,9 +13,12 @@ extern crate clap; extern crate prettytable; #[macro_use] extern crate lazy_static; +#[cfg(test)] #[macro_use] extern crate maplit; - +#[macro_use] +extern crate downcast_rs; +extern crate backtrace; mod display; mod game; @@ -24,12 +27,14 @@ mod types; mod entities; mod messages; mod settings; +mod util; use clap::App; use game::Game; use prettytable::format::consts::FORMAT_BOX_CHARS; use settings::Settings; +use backtrace::Backtrace; use std::io::{self, StdinLock, StdoutLock}; use std::panic; @@ -43,7 +48,16 @@ fn init( w: u16, h: u16, ) { - panic::set_hook(Box::new(|info| error!("{}", info))); + panic::set_hook(if settings.logging.print_backtrace { + Box::new(|info| { + (error!("{}\n{:#?}", info, Backtrace::new())) + }) + } else { + Box::new(|info| { + (error!("{}\n{:#?}", info, Backtrace::new())) + }) + }); + let game = Game::new(settings, stdout, stdin, w, h); game.run().unwrap() } diff --git a/src/settings.rs b/src/settings.rs index 8444bf80ee..1f205814d1 100644 --- a/src/settings.rs +++ b/src/settings.rs @@ -4,13 +4,16 @@ use log4rs::append::file::FileAppender; use log4rs::config::{Appender, Root}; use log4rs::encode::pattern::PatternEncoder; -#[derive(Debug, Deserialize)] +#[derive(Debug, Deserialize, Clone)] pub struct Logging { #[serde(default = "Logging::default_level")] pub level: LevelFilter, #[serde(default = "Logging::default_file")] pub file: String, + + #[serde(default = "Logging::default_print_backtrace")] + pub print_backtrace: bool, } impl Default for Logging { @@ -18,6 +21,7 @@ impl Default for Logging { Logging { level: LevelFilter::Off, file: "debug.log".to_string(), + print_backtrace: true, } } } @@ -44,9 +48,13 @@ impl Logging { fn default_file() -> String { Logging::default().file } + + fn default_print_backtrace() -> bool { + Logging::default().print_backtrace + } } -#[derive(Debug, Deserialize)] +#[derive(Debug, Deserialize, Clone)] pub struct Settings { pub seed: Option, pub logging: Logging, diff --git a/src/types/collision.rs b/src/types/collision.rs new file mode 100644 index 0000000000..f41e30fc51 --- /dev/null +++ b/src/types/collision.rs @@ -0,0 +1,8 @@ +/// Describes a kind of game collision +pub enum Collision { + /// Stop moving - you can't move there! + Stop, + + /// Moving into an entity at the given position indicates combat + Combat, +} diff --git a/src/types/entity_map.rs b/src/types/entity_map.rs new file mode 100644 index 0000000000..2d9f033a79 --- /dev/null +++ b/src/types/entity_map.rs @@ -0,0 +1,242 @@ +use crate::types::Position; +use crate::types::Positioned; +use crate::types::PositionedMut; +use std::collections::hash_map::HashMap; +use std::collections::BTreeMap; +use std::iter::FromIterator; + +pub type EntityID = u32; + +#[derive(Debug)] +pub struct EntityMap { + by_position: BTreeMap>, + by_id: HashMap, + last_id: EntityID, +} + +// impl ArbitraryF1 for EntityMap { +// type Parameters = (); +// fn lift1_with(base: AS, _: Self::Parameters) -> BoxedStrategy +// where +// AS: Strategy + 'static, +// { +// unimplemented!() +// } +// // type Strategy = strategy::Just; +// // fn arbitrary_with(params : Self::Parameters) -> Self::Strategy; +// } + +// impl Arbitrary for EntityMap { +// type Parameters = A::Parameters; +// type Strategy = BoxedStrategy; +// fn arbitrary_with(params: Self::Parameters) -> Self::Strategy { +// let a_strat: A::Strategy = Arbitrary::arbitrary_with(params); +// ArbitraryF1::lift1::(a_strat) +// } +// } + +const BY_POS_INVARIANT: &'static str = + "Invariant: All references in EntityMap.by_position should point to existent references in by_id"; + +impl EntityMap { + pub fn new() -> EntityMap { + EntityMap { + by_position: BTreeMap::new(), + by_id: HashMap::new(), + last_id: 0, + } + } + + pub fn len(&self) -> usize { + self.by_id.len() + } + + /// Returns a list of all entities at the given position + pub fn at<'a>(&'a self, pos: Position) -> Vec<&'a A> { + // self.by_position.get(&pos).iter().flat_map(|eids| { + // eids.iter() + // .map(|eid| self.by_id.get(eid).expect(BY_POS_INVARIANT)) + // }) + // gross. + match self.by_position.get(&pos) { + None => Vec::new(), + Some(eids) => { + let mut res = Vec::new(); + for eid in eids { + res.push(self.by_id.get(eid).expect(BY_POS_INVARIANT)); + } + res + } + } + } + + /// Remove all entities at the given position + pub fn remove_all_at(&mut self, pos: Position) { + self.by_position.remove(&pos).map(|eids| { + eids.iter() + .map(|eid| self.by_id.remove(&eid).expect(BY_POS_INVARIANT)); + }); + } + + pub fn get<'a>(&'a self, id: EntityID) -> Option<&'a A> { + self.by_id.get(&id) + } + + pub fn entities<'a>(&'a self) -> impl Iterator { + self.by_id.values() + } + + pub fn entities_mut<'a>(&'a mut self) -> impl Iterator { + self.by_id.values_mut() + } + + pub fn ids(&self) -> impl Iterator { + self.by_id.keys() + } + + fn next_id(&mut self) -> EntityID { + self.last_id += 1; + self.last_id + } +} + +impl EntityMap { + pub fn insert(&mut self, entity: A) -> EntityID { + let pos = entity.position(); + let entity_id = self.next_id(); + self.by_id.entry(entity_id).or_insert(entity); + self.by_position + .entry(pos) + .or_insert(Vec::new()) + .push(entity_id); + entity_id + } +} + +impl FromIterator for EntityMap { + fn from_iter>(iter: I) -> Self { + let mut em = EntityMap::new(); + for ent in iter { + em.insert(ent); + } + em + } +} + +impl EntityMap { + pub fn update_position( + &mut self, + entity_id: EntityID, + new_position: Position, + ) { + let mut old_pos = None; + if let Some(entity) = self.by_id.get_mut(&entity_id) { + if entity.position() == new_position { + return; + } + old_pos = Some(entity.position()); + entity.set_position(new_position); + } + old_pos.map(|p| { + self.by_position + .get_mut(&p) + .map(|es| es.retain(|e| *e != entity_id)); + + self.by_position + .entry(new_position) + .or_insert(Vec::new()) + .push(entity_id); + }); + } +} + +#[cfg(test)] +mod tests { + use super::*; + use crate::types::PositionedMut; + use proptest::prelude::*; + use proptest_derive::Arbitrary; + + #[derive(Debug, Arbitrary, PartialEq, Eq, Clone)] + struct TestEntity { + position: Position, + name: String, + } + + impl Positioned for TestEntity { + fn position(&self) -> Position { + self.position + } + } + + impl PositionedMut for TestEntity { + fn set_position(&mut self, pos: Position) { + self.position = pos + } + } + + fn gen_entity_map() -> BoxedStrategy> { + any::>() + .prop_map(|ents| { + ents.iter() + .map(|e| e.clone()) + .collect::>() + }) + .boxed() + } + + proptest! { + #![proptest_config(ProptestConfig::with_cases(10))] + + #[test] + fn test_entity_map_len(items: Vec) { + let mut map = EntityMap::new(); + assert_eq!(map.len(), 0); + for ent in &items { + map.insert(ent); + } + assert_eq!(map.len(), items.len()); + } + + #[test] + fn test_entity_map_getset( + mut em in gen_entity_map(), + ent: TestEntity + ) { + em.insert(ent.clone()); + assert!(em.at(ent.position).iter().any(|e| **e == ent)) + } + + #[test] + fn test_entity_map_set_iter_contains( + mut em in gen_entity_map(), + ent: TestEntity + ) { + em.insert(ent.clone()); + assert!(em.entities().any(|e| *e == ent)) + } + + #[test] + fn test_update_position( + mut em in gen_entity_map(), + ent: TestEntity, + new_position: Position, + ) { + let original_position = ent.position(); + let entity_id = em.insert(ent.clone()); + em.update_position(entity_id, new_position); + + if new_position != original_position { + assert_eq!(em.at(original_position).len(), 0); + } + assert_eq!( + em.get(entity_id).map(|e| e.position()), + Some(new_position) + ); + assert_eq!( + em.at(new_position).iter().map(|e| e.name.clone()).collect::>(), + vec![ent.name] + ) + } + } +} diff --git a/src/types/mod.rs b/src/types/mod.rs index ab66a50cc2..c0375a382f 100644 --- a/src/types/mod.rs +++ b/src/types/mod.rs @@ -1,7 +1,11 @@ use std::cmp::Ordering; use std::ops; +use std::rc::Rc; +pub mod collision; pub mod command; pub mod direction; +pub mod entity_map; +pub use collision::Collision; pub use direction::Direction; pub use direction::Direction::{Down, Left, Right, Up}; use proptest_derive::Arbitrary; @@ -43,13 +47,16 @@ impl BoundingBox { } } - pub fn from_corners(top_left: Position, lower_right: Position) -> BoundingBox { + pub fn from_corners( + top_left: Position, + lower_right: Position, + ) -> BoundingBox { BoundingBox { position: top_left, dimensions: Dimensions { w: (lower_right.x - top_left.x) as u16, h: (lower_right.y - top_left.y) as u16, - } + }, } } @@ -70,7 +77,11 @@ impl BoundingBox { /// Moves the top right corner of the bounding box by the offset specified /// by the given position, keeping the lower right corner in place pub fn move_tr_corner(self, offset: Position) -> BoundingBox { - self + offset - Dimensions { w: offset.x as u16, h: offset.y as u16 } + self + offset + - Dimensions { + w: offset.x as u16, + h: offset.y as u16, + } } } @@ -94,7 +105,7 @@ impl ops::Sub for BoundingBox { } } -#[derive(Clone, Copy, Debug, PartialEq, Eq, Arbitrary)] +#[derive(Clone, Copy, Debug, PartialEq, Eq, Arbitrary, Hash, Ord)] pub struct Position { /// x (horizontal) position #[proptest(strategy = "std::ops::Range::::from(0..100)")] @@ -105,6 +116,10 @@ pub struct Position { pub y: i16, } +pub fn pos(x: i16, y: i16) -> Position { + Position { x, y } +} + pub const ORIGIN: Position = Position { x: 0, y: 0 }; pub const UNIT_POSITION: Position = Position { x: 1, y: 1 }; @@ -241,6 +256,47 @@ pub trait Positioned { } } +pub trait PositionedMut: Positioned { + fn set_position(&mut self, pos: Position); +} + +// impl Positioned for A where A : Deref, I: Positioned { +// fn position(&self) -> Position { +// self.position() +// } +// } + +impl Positioned for Box { + fn position(&self) -> Position { + (**self).position() + } +} + +impl<'a, T: Positioned> Positioned for &'a T { + fn position(&self) -> Position { + (**self).position() + } +} + +impl<'a, T: Positioned> Positioned for &'a mut T { + fn position(&self) -> Position { + (**self).position() + } +} + +impl<'a, T: Positioned> Positioned for Rc { + fn position(&self) -> Position { + (**self).position() + } +} + +impl<'a, T: PositionedMut> PositionedMut for &'a mut T { + fn set_position(&mut self, pos: Position) { + (**self).set_position(pos) + } +} + +#[macro_export] macro_rules! positioned { ($name:ident) => { positioned!($name, position); @@ -254,6 +310,20 @@ macro_rules! positioned { }; } +#[macro_export] +macro_rules! positioned_mut { + ($name:ident) => { + positioned_mut!($name, position); + }; + ($name:ident, $attr:ident) => { + impl crate::types::PositionedMut for $name { + fn set_position(&mut self, pos: Position) { + self.$attr = pos; + } + } + }; +} + /// A number of ticks #[derive(Clone, Copy, Debug, PartialEq, Eq, Arbitrary)] pub struct Ticks(pub u16); diff --git a/src/util/mod.rs b/src/util/mod.rs new file mode 100644 index 0000000000..e69de29bb2 -- cgit 1.4.1 From bf03ebc549bfeef38b91110511a56a6cd24dc58d Mon Sep 17 00:00:00 2001 From: Griffin Smith Date: Sat, 13 Jul 2019 09:07:39 -0400 Subject: Add placeholder for game ticks When the character moves, the game ticks forward equal to the character's speed --- proptest-regressions/types/entity_map.txt | 1 + proptest-regressions/types/mod.txt | 1 + src/game.rs | 16 ++++++++++++++-- src/types/entity_map.rs | 19 ++++++++++++++---- src/types/mod.rs | 32 +++++++++++++++++++++++++++++++ 5 files changed, 63 insertions(+), 6 deletions(-) diff --git a/proptest-regressions/types/entity_map.txt b/proptest-regressions/types/entity_map.txt index 1549085b6c..7d85b28bf4 100644 --- a/proptest-regressions/types/entity_map.txt +++ b/proptest-regressions/types/entity_map.txt @@ -5,3 +5,4 @@ # It is recommended to check this file in to source control so that # everyone who runs the test benefits from these saved cases. cc 16afe2473971397314ffa77acf7bad62f0c40bc3f591aff7aa9193c29e5a0921 # shrinks to items = [(Position { x: 92, y: 60 }, ""), (Position { x: 92, y: 60 }, "")] +cc 3a68a382c3bb8fdf60ea150a369abbdd45859e0c54cd6a4f7c75937a6c783b98 # shrinks to mut em = EntityMap { by_position: {Position { x: 25, y: 33 }: [1]}, by_id: {1: TestEntity { position: Position { x: 25, y: 33 }, name: "" }}, last_id: 1 }, ent = TestEntity { position: Position { x: 25, y: 33 }, name: "" }, new_position = Position { x: 0, y: 0 } diff --git a/proptest-regressions/types/mod.txt b/proptest-regressions/types/mod.txt index b185590067..276466965c 100644 --- a/proptest-regressions/types/mod.txt +++ b/proptest-regressions/types/mod.txt @@ -5,3 +5,4 @@ # It is recommended to check this file in to source control so that # everyone who runs the test benefits from these saved cases. cc a51cf37623f0e4024f4ba1450195be296d9b9e8ae954dbbf997ce5b57cd26792 # shrinks to a = Position { x: 44, y: 25 }, b = Position { x: 0, y: 25 }, c = Position { x: 0, y: 0 } +cc 0816b9348c53ef8c8328f0ea72d5ebef215f6764b1cbbd3c5db958e214c5fa3a # shrinks to pos = Position { x: 0, y: 0 }, dir = Down diff --git a/src/game.rs b/src/game.rs index 90d94dc5f2..1a43628b43 100644 --- a/src/game.rs +++ b/src/game.rs @@ -6,6 +6,7 @@ use crate::settings::Settings; use crate::types::command::Command; use crate::types::entity_map::EntityID; use crate::types::entity_map::EntityMap; +use crate::types::Ticks; use crate::types::{ BoundingBox, Collision, Dimensions, Position, Positioned, PositionedMut, }; @@ -99,7 +100,11 @@ impl<'a> Game<'a> { } fn character(&self) -> &Character { - debug!("ents: {:?} cid: {:?}", self.entities.ids().map(|id| *id).collect::>(), self.character_entity_id); + debug!( + "ents: {:?} cid: {:?}", + self.entities.ids().map(|id| *id).collect::>(), + self.character_entity_id + ); (*self.entities.get(self.character_entity_id).unwrap()) .downcast_ref() .unwrap() @@ -113,6 +118,9 @@ impl<'a> Game<'a> { Ok(()) } + /// Step the game forward the given number of ticks + fn tick(&mut self, ticks: Ticks) {} + /// Get a message from the global map based on the rng in this game fn message(&mut self, name: &str) -> &'static str { message(name, &mut self.rng) @@ -174,10 +182,14 @@ impl<'a> Game<'a> { match old_position { Some(old_pos) => { + self.tick(self.character().speed().tiles_to_ticks( + (old_pos - self.character().position).as_tiles(), + )); self.viewport.clear(old_pos)?; self.viewport.draw( // TODO this clone feels unnecessary. - &self.character().clone())?; + &self.character().clone(), + )?; } None => (), } diff --git a/src/types/entity_map.rs b/src/types/entity_map.rs index 2d9f033a79..1846686d11 100644 --- a/src/types/entity_map.rs +++ b/src/types/entity_map.rs @@ -73,8 +73,9 @@ impl EntityMap { /// Remove all entities at the given position pub fn remove_all_at(&mut self, pos: Position) { self.by_position.remove(&pos).map(|eids| { - eids.iter() - .map(|eid| self.by_id.remove(&eid).expect(BY_POS_INVARIANT)); + for eid in eids { + self.by_id.remove(&eid).expect(BY_POS_INVARIANT); + } }); } @@ -227,16 +228,26 @@ mod tests { em.update_position(entity_id, new_position); if new_position != original_position { - assert_eq!(em.at(original_position).len(), 0); + assert!(em.at(original_position).iter().all(|e| e.name != ent.name)); } assert_eq!( em.get(entity_id).map(|e| e.position()), Some(new_position) ); assert_eq!( - em.at(new_position).iter().map(|e| e.name.clone()).collect::>(), + em.at(new_position).iter().map( + |e| e.name.clone()).collect::>(), vec![ent.name] ) } + + #[test] + fn test_remove_all_at( + mut em in gen_entity_map(), + pos: Position, + ) { + em.remove_all_at(pos); + assert_eq!(em.at(pos).len(), 0); + } } } diff --git a/src/types/mod.rs b/src/types/mod.rs index c0375a382f..67c773fdb1 100644 --- a/src/types/mod.rs +++ b/src/types/mod.rs @@ -1,3 +1,4 @@ +use std::cmp::max; use std::cmp::Ordering; use std::ops; use std::rc::Rc; @@ -136,6 +137,13 @@ impl Position { // + 1 because Goto is 1-based, but position is 0-based cursor::Goto(self.x as u16 + 1, self.y as u16 + 1) } + + /// Converts this position to the number of `Tiles` away from the origin it + /// represents. Usually done after subtracting two positions. Gives distance + /// as the crow flies + pub fn as_tiles(&self) -> Tiles { + Tiles(max(self.x.abs(), self.y.abs()).into()) + } } impl PartialOrd for Position { @@ -340,9 +348,17 @@ pub struct Tiles(pub f32); pub struct Speed(pub u32); impl Speed { + /// Returns the number of tiles that would be moved in the given number of + /// ticks at this speed pub fn ticks_to_tiles(self, ticks: Ticks) -> Tiles { Tiles(ticks.0 as f32 / self.0 as f32) } + + /// Returns the number of ticks required to move the given number of tiles + /// at this speed + pub fn tiles_to_ticks(self, tiles: Tiles) -> Ticks { + Ticks(tiles.0 as u16 * self.0 as u16) + } } #[cfg(test)] @@ -392,5 +408,21 @@ mod tests { assert!(!(a < b)) } } + + #[test] + fn test_position_plus_dimension_as_tiles_monoid_action( + pos: Position, + dir: Direction, + ) { + prop_assume!(pos.y > 0 && pos.x > 0); + assert_eq!(((pos + dir) - pos).as_tiles(), Tiles(1.0)); + } + } + + #[test] + fn test_position_as_tiles() { + assert_eq!(pos(0, 0).as_tiles(), Tiles(0.0)); + assert_eq!(pos(1, 1).as_tiles(), Tiles(1.0)); + assert_eq!(pos(1, 2).as_tiles(), Tiles(2.0)); } } -- cgit 1.4.1 From 405dbffe376b05af31dc57f027658c70b4fb9634 Mon Sep 17 00:00:00 2001 From: Griffin Smith Date: Sun, 14 Jul 2019 11:00:44 -0400 Subject: Add commands for diagonal movement Cribbed directly from Nethack This was really, really easy. --- proptest-regressions/types/entity_map.txt | 1 + src/types/command.rs | 5 +++++ src/types/direction.rs | 4 ++++ src/types/entity_map.rs | 5 ++--- src/types/mod.rs | 6 +++++- 5 files changed, 17 insertions(+), 4 deletions(-) diff --git a/proptest-regressions/types/entity_map.txt b/proptest-regressions/types/entity_map.txt index 7d85b28bf4..68be5752f4 100644 --- a/proptest-regressions/types/entity_map.txt +++ b/proptest-regressions/types/entity_map.txt @@ -6,3 +6,4 @@ # everyone who runs the test benefits from these saved cases. cc 16afe2473971397314ffa77acf7bad62f0c40bc3f591aff7aa9193c29e5a0921 # shrinks to items = [(Position { x: 92, y: 60 }, ""), (Position { x: 92, y: 60 }, "")] cc 3a68a382c3bb8fdf60ea150a369abbdd45859e0c54cd6a4f7c75937a6c783b98 # shrinks to mut em = EntityMap { by_position: {Position { x: 25, y: 33 }: [1]}, by_id: {1: TestEntity { position: Position { x: 25, y: 33 }, name: "" }}, last_id: 1 }, ent = TestEntity { position: Position { x: 25, y: 33 }, name: "" }, new_position = Position { x: 0, y: 0 } +cc ffd7181e1c0343ab4c2ac92990f068d24c8663158c1c0a9526cd9edc470f950a # shrinks to mut em = EntityMap { by_position: {Position { x: 64, y: 58 }: [1]}, by_id: {1: TestEntity { position: Position { x: 64, y: 58 }, name: "" }}, last_id: 1 }, ent = TestEntity { position: Position { x: 0, y: 0 }, name: "" }, new_position = Position { x: 64, y: 58 } diff --git a/src/types/command.rs b/src/types/command.rs index 2a51531c0a..15017cde99 100644 --- a/src/types/command.rs +++ b/src/types/command.rs @@ -23,6 +23,11 @@ impl Command { Char('k') | Char('w') | Key::Up => Some(Move(Up)), Char('j') | Char('s') | Key::Down => Some(Move(Down)), Char('l') | Char('d') | Key::Right => Some(Move(Right)), + Char('y') => Some(Move(UpLeft)), + Char('u') => Some(Move(UpRight)), + Char('b') => Some(Move(DownLeft)), + Char('n') => Some(Move(DownRight)), + Ctrl('p') => Some(PreviousMessage), _ => None, } diff --git a/src/types/direction.rs b/src/types/direction.rs index 5ab660f193..9b5c0991da 100644 --- a/src/types/direction.rs +++ b/src/types/direction.rs @@ -6,4 +6,8 @@ pub enum Direction { Up, Down, Right, + UpLeft, + UpRight, + DownRight, + DownLeft, } diff --git a/src/types/entity_map.rs b/src/types/entity_map.rs index 1846686d11..1d58873bb0 100644 --- a/src/types/entity_map.rs +++ b/src/types/entity_map.rs @@ -234,10 +234,9 @@ mod tests { em.get(entity_id).map(|e| e.position()), Some(new_position) ); - assert_eq!( + assert!( em.at(new_position).iter().map( - |e| e.name.clone()).collect::>(), - vec![ent.name] + |e| e.name.clone()).any(|en| en == ent.name), ) } diff --git a/src/types/mod.rs b/src/types/mod.rs index 67c773fdb1..ac44bcc9c8 100644 --- a/src/types/mod.rs +++ b/src/types/mod.rs @@ -8,7 +8,7 @@ pub mod direction; pub mod entity_map; pub use collision::Collision; pub use direction::Direction; -pub use direction::Direction::{Down, Left, Right, Up}; +pub use direction::Direction::*; use proptest_derive::Arbitrary; use termion::cursor; @@ -217,6 +217,10 @@ impl ops::Add for Position { self } } + UpLeft => self + Up + Left, + UpRight => self + Up + Right, + DownLeft => self + Down + Left, + DownRight => self + Down + Right, } } } -- cgit 1.4.1 From 67d18b486c6376c7637b3494722ddf1eb525288c Mon Sep 17 00:00:00 2001 From: Griffin Smith Date: Sun, 14 Jul 2019 12:12:43 -0400 Subject: Factor out static_cfg from static init of messages Factor out a macro for static references to data parsed from config files at compile-time. --- src/main.rs | 11 ++++------- src/messages.rs | 7 ++----- src/util/mod.rs | 2 ++ src/util/static_toml.rs | 37 +++++++++++++++++++++++++++++++++++++ 4 files changed, 45 insertions(+), 12 deletions(-) create mode 100644 src/util/static_toml.rs diff --git a/src/main.rs b/src/main.rs index 8d7222106c..e09563b16c 100644 --- a/src/main.rs +++ b/src/main.rs @@ -25,9 +25,10 @@ mod game; #[macro_use] mod types; mod entities; +#[macro_use] +mod util; mod messages; mod settings; -mod util; use clap::App; use game::Game; @@ -49,13 +50,9 @@ fn init( h: u16, ) { panic::set_hook(if settings.logging.print_backtrace { - Box::new(|info| { - (error!("{}\n{:#?}", info, Backtrace::new())) - }) + Box::new(|info| (error!("{}\n{:#?}", info, Backtrace::new()))) } else { - Box::new(|info| { - (error!("{}\n{:#?}", info, Backtrace::new())) - }) + Box::new(|info| (error!("{}\n{:#?}", info, Backtrace::new()))) }); let game = Game::new(settings, stdout, stdin, w, h); diff --git a/src/messages.rs b/src/messages.rs index 03a96b4a0a..948787f139 100644 --- a/src/messages.rs +++ b/src/messages.rs @@ -165,11 +165,8 @@ choice = ["Say this", "Or this"] } } -static MESSAGES_RAW: &'static str = include_str!("messages.toml"); - -lazy_static! { - static ref MESSAGES: NestedMap<'static> = - toml::from_str(MESSAGES_RAW).unwrap(); +static_cfg! { + static ref MESSAGES: NestedMap<'static> = toml_file("messages.toml"); } /// Look up a game message based on the given (dot-separated) name, with the diff --git a/src/util/mod.rs b/src/util/mod.rs index e69de29bb2..e26eae2b89 100644 --- a/src/util/mod.rs +++ b/src/util/mod.rs @@ -0,0 +1,2 @@ +#[macro_use] +pub mod static_toml; diff --git a/src/util/static_toml.rs b/src/util/static_toml.rs new file mode 100644 index 0000000000..7a930ee023 --- /dev/null +++ b/src/util/static_toml.rs @@ -0,0 +1,37 @@ +macro_rules! __static_cfg_parse { + (toml_file, $e:expr) => { + toml::from_str($e) + }; + + (json_file, $e:expr) => { + json::from_str($e) + }; +} + +macro_rules! __static_cfg_inner { + ($(#[$attr:meta])* ($($vis:tt)*) static ref $N:ident : $T:ty = $kind:ident($filename:expr); $($t:tt)*) => { + static RAW: &'static str = include_str!($filename); + lazy_static! { + $(#[$attr])* static ref $N: $T = __static_cfg_parse!($kind, RAW).unwrap(); + } + + static_cfg!($($t)*); + } +} + +#[macro_export] +macro_rules! static_cfg { + ($(#[$attr:meta])* static ref $N:ident : $T:ty = $kind:ident($filename:expr); $($t:tt)*) => { + __static_cfg_inner!($(#[$attr])* () static ref $N : $T = $kind($filename); $($t)*); + }; + + ($(#[$attr:meta])* pub static ref $N:ident : $T:ty = $kind:ident($filename:expr); $($t:tt)*) => { + __static_cfg_inner!($(#[$attr])* (pub) static ref $N : $T = $kind($filename); $($t)*); + }; + + ($(#[$attr:meta])* pub ($($vis:tt)+) static ref $N:ident : $T:ty = $kind:ident($filename:expr); $($t:tt)*) => { + __static_cfg_inner!($(#[$attr])* (pub ($($vis)+)) static ref $N : $T = $kind($filename); $($t)*); + }; + + () => () +} -- cgit 1.4.1 From 081146da30bcf1a17d9533c3dc9c735a3a558165 Mon Sep 17 00:00:00 2001 From: Griffin Smith Date: Sun, 14 Jul 2019 14:29:11 -0400 Subject: Allow static_cfg to include entire directories Via new "toml_dir" and "json_dir" directives in the macro --- Cargo.lock | 58 +++++++++++++++++++++++++++++++ Cargo.toml | 2 ++ src/main.rs | 6 ++-- src/util/mod.rs | 2 +- src/util/static_cfg.rs | 91 +++++++++++++++++++++++++++++++++++++++++++++++++ src/util/static_toml.rs | 37 -------------------- 6 files changed, 156 insertions(+), 40 deletions(-) create mode 100644 src/util/static_cfg.rs delete mode 100644 src/util/static_toml.rs diff --git a/Cargo.lock b/Cargo.lock index 3b523d247b..b0020c4669 100644 --- a/Cargo.lock +++ b/Cargo.lock @@ -319,6 +319,11 @@ dependencies = [ "libc 0.2.58 (registry+https://github.com/rust-lang/crates.io-index)", ] +[[package]] +name = "glob" +version = "0.2.11" +source = "registry+https://github.com/rust-lang/crates.io-index" + [[package]] name = "humantime" version = "1.2.0" @@ -327,6 +332,28 @@ dependencies = [ "quick-error 1.2.2 (registry+https://github.com/rust-lang/crates.io-index)", ] +[[package]] +name = "include_dir" +version = "0.2.1" +source = "registry+https://github.com/rust-lang/crates.io-index" +dependencies = [ + "glob 0.2.11 (registry+https://github.com/rust-lang/crates.io-index)", + "include_dir_impl 0.2.1 (registry+https://github.com/rust-lang/crates.io-index)", + "proc-macro-hack 0.4.1 (registry+https://github.com/rust-lang/crates.io-index)", +] + +[[package]] +name = "include_dir_impl" +version = "0.2.1" +source = "registry+https://github.com/rust-lang/crates.io-index" +dependencies = [ + "failure 0.1.5 (registry+https://github.com/rust-lang/crates.io-index)", + "proc-macro-hack 0.4.1 (registry+https://github.com/rust-lang/crates.io-index)", + "proc-macro2 0.4.30 (registry+https://github.com/rust-lang/crates.io-index)", + "quote 0.6.12 (registry+https://github.com/rust-lang/crates.io-index)", + "syn 0.14.9 (registry+https://github.com/rust-lang/crates.io-index)", +] + [[package]] name = "itertools" version = "0.8.0" @@ -521,6 +548,19 @@ dependencies = [ "unicode-width 0.1.5 (registry+https://github.com/rust-lang/crates.io-index)", ] +[[package]] +name = "proc-macro-hack" +version = "0.4.1" +source = "registry+https://github.com/rust-lang/crates.io-index" +dependencies = [ + "proc-macro-hack-impl 0.4.1 (registry+https://github.com/rust-lang/crates.io-index)", +] + +[[package]] +name = "proc-macro-hack-impl" +version = "0.4.1" +source = "registry+https://github.com/rust-lang/crates.io-index" + [[package]] name = "proc-macro2" version = "0.4.30" @@ -899,6 +939,16 @@ name = "strsim" version = "0.8.0" source = "registry+https://github.com/rust-lang/crates.io-index" +[[package]] +name = "syn" +version = "0.14.9" +source = "registry+https://github.com/rust-lang/crates.io-index" +dependencies = [ + "proc-macro2 0.4.30 (registry+https://github.com/rust-lang/crates.io-index)", + "quote 0.6.12 (registry+https://github.com/rust-lang/crates.io-index)", + "unicode-xid 0.1.0 (registry+https://github.com/rust-lang/crates.io-index)", +] + [[package]] name = "syn" version = "0.15.35" @@ -1092,6 +1142,7 @@ dependencies = [ "clap 2.33.0 (registry+https://github.com/rust-lang/crates.io-index)", "config 0.9.3 (registry+https://github.com/rust-lang/crates.io-index)", "downcast-rs 1.0.4 (registry+https://github.com/rust-lang/crates.io-index)", + "include_dir 0.2.1 (registry+https://github.com/rust-lang/crates.io-index)", "itertools 0.8.0 (registry+https://github.com/rust-lang/crates.io-index)", "lazy_static 1.3.0 (registry+https://github.com/rust-lang/crates.io-index)", "log 0.4.6 (registry+https://github.com/rust-lang/crates.io-index)", @@ -1103,6 +1154,7 @@ dependencies = [ "rand 0.7.0 (registry+https://github.com/rust-lang/crates.io-index)", "serde 1.0.92 (registry+https://github.com/rust-lang/crates.io-index)", "serde_derive 1.0.92 (registry+https://github.com/rust-lang/crates.io-index)", + "serde_json 1.0.39 (registry+https://github.com/rust-lang/crates.io-index)", "termion 1.5.2 (registry+https://github.com/rust-lang/crates.io-index)", "toml 0.5.1 (registry+https://github.com/rust-lang/crates.io-index)", ] @@ -1162,7 +1214,10 @@ dependencies = [ "checksum fnv 1.0.6 (registry+https://github.com/rust-lang/crates.io-index)" = "2fad85553e09a6f881f739c29f0b00b0f01357c743266d478b68951ce23285f3" "checksum fuchsia-cprng 0.1.1 (registry+https://github.com/rust-lang/crates.io-index)" = "a06f77d526c1a601b7c4cdd98f54b5eaabffc14d5f2f0296febdc7f357c6d3ba" "checksum getrandom 0.1.6 (registry+https://github.com/rust-lang/crates.io-index)" = "e65cce4e5084b14874c4e7097f38cab54f47ee554f9194673456ea379dcc4c55" +"checksum glob 0.2.11 (registry+https://github.com/rust-lang/crates.io-index)" = "8be18de09a56b60ed0edf84bc9df007e30040691af7acd1c41874faac5895bfb" "checksum humantime 1.2.0 (registry+https://github.com/rust-lang/crates.io-index)" = "3ca7e5f2e110db35f93b837c81797f3714500b81d517bf20c431b16d3ca4f114" +"checksum include_dir 0.2.1 (registry+https://github.com/rust-lang/crates.io-index)" = "f41a8bee1894b3fb755d8f09ccd764650476358197a0582555f698fe84b0ae93" +"checksum include_dir_impl 0.2.1 (registry+https://github.com/rust-lang/crates.io-index)" = "0c4b029199aef0fb9921fdc5623843197e6f4a035774523817599a9f55e4bf3b" "checksum itertools 0.8.0 (registry+https://github.com/rust-lang/crates.io-index)" = "5b8467d9c1cebe26feb08c640139247fac215782d35371ade9a2136ed6085358" "checksum itoa 0.4.4 (registry+https://github.com/rust-lang/crates.io-index)" = "501266b7edd0174f8530248f87f99c88fbe60ca4ef3dd486835b8d8d53136f7f" "checksum lazy_static 0.2.11 (registry+https://github.com/rust-lang/crates.io-index)" = "76f033c7ad61445c5b347c7382dd1237847eb1bce590fe50365dcb33d546be73" @@ -1187,6 +1242,8 @@ dependencies = [ "checksum ordered-float 1.0.2 (registry+https://github.com/rust-lang/crates.io-index)" = "18869315e81473c951eb56ad5558bbc56978562d3ecfb87abb7a1e944cea4518" "checksum ppv-lite86 0.2.5 (registry+https://github.com/rust-lang/crates.io-index)" = "e3cbf9f658cdb5000fcf6f362b8ea2ba154b9f146a61c7a20d647034c6b6561b" "checksum prettytable-rs 0.8.0 (registry+https://github.com/rust-lang/crates.io-index)" = "0fd04b170004fa2daccf418a7f8253aaf033c27760b5f225889024cf66d7ac2e" +"checksum proc-macro-hack 0.4.1 (registry+https://github.com/rust-lang/crates.io-index)" = "2c725b36c99df7af7bf9324e9c999b9e37d92c8f8caf106d82e1d7953218d2d8" +"checksum proc-macro-hack-impl 0.4.1 (registry+https://github.com/rust-lang/crates.io-index)" = "2b753ad9ed99dd8efeaa7d2fb8453c8f6bc3e54b97966d35f1bc77ca6865254a" "checksum proc-macro2 0.4.30 (registry+https://github.com/rust-lang/crates.io-index)" = "cf3d2011ab5c909338f7887f4fc896d35932e29146c12c8d01da6b22a80ba759" "checksum proptest 0.9.3 (registry+https://github.com/rust-lang/crates.io-index)" = "2afed8cbdc8a64b58a5c021757a782351ec1afee85be374872721c84d5da5d80" "checksum proptest-derive 0.1.1 (registry+https://github.com/rust-lang/crates.io-index)" = "08b264c54525e760fc1d39c5b2bfc96923b922a752893053b4adaafe33fa9346" @@ -1231,6 +1288,7 @@ dependencies = [ "checksum serde_yaml 0.8.9 (registry+https://github.com/rust-lang/crates.io-index)" = "38b08a9a90e5260fe01c6480ec7c811606df6d3a660415808c3c3fa8ed95b582" "checksum spin 0.5.0 (registry+https://github.com/rust-lang/crates.io-index)" = "44363f6f51401c34e7be73db0db371c04705d35efbe9f7d6082e03a921a32c55" "checksum strsim 0.8.0 (registry+https://github.com/rust-lang/crates.io-index)" = "8ea5119cdb4c55b55d432abb513a0429384878c15dde60cc77b1c99de1a95a6a" +"checksum syn 0.14.9 (registry+https://github.com/rust-lang/crates.io-index)" = "261ae9ecaa397c42b960649561949d69311f08eeaea86a65696e6e46517cf741" "checksum syn 0.15.35 (registry+https://github.com/rust-lang/crates.io-index)" = "641e117d55514d6d918490e47102f7e08d096fdde360247e4a10f7a91a8478d3" "checksum synstructure 0.10.2 (registry+https://github.com/rust-lang/crates.io-index)" = "02353edf96d6e4dc81aea2d8490a7e9db177bf8acb0e951c24940bf866cb313f" "checksum tempfile 3.0.8 (registry+https://github.com/rust-lang/crates.io-index)" = "7dc4738f2e68ed2855de5ac9cdbe05c9216773ecde4739b2f095002ab03a13ef" diff --git a/Cargo.toml b/Cargo.toml index 58fd93d3f5..02464410eb 100644 --- a/Cargo.toml +++ b/Cargo.toml @@ -9,6 +9,7 @@ backtrace = "0.3" clap = {version = "^2.33.0", features = ["yaml"]} config = "*" downcast-rs = "^1.0.4" +include_dir = "0.2.1" itertools = "*" lazy_static = "*" log = "*" @@ -20,6 +21,7 @@ proptest-derive = "*" rand = {version = "^0.7.0", features = ["small_rng"]} serde = "^1.0.8" serde_derive = "^1.0.8" +serde_json = "*" termion = "*" toml = "^0.5.1" diff --git a/src/main.rs b/src/main.rs index e09563b16c..f7257a8896 100644 --- a/src/main.rs +++ b/src/main.rs @@ -19,14 +19,16 @@ extern crate maplit; #[macro_use] extern crate downcast_rs; extern crate backtrace; +#[macro_use] +extern crate include_dir; +#[macro_use] +mod util; mod display; mod game; #[macro_use] mod types; mod entities; -#[macro_use] -mod util; mod messages; mod settings; diff --git a/src/util/mod.rs b/src/util/mod.rs index e26eae2b89..87fd7910f3 100644 --- a/src/util/mod.rs +++ b/src/util/mod.rs @@ -1,2 +1,2 @@ #[macro_use] -pub mod static_toml; +pub mod static_cfg; diff --git a/src/util/static_cfg.rs b/src/util/static_cfg.rs new file mode 100644 index 0000000000..1b4864df72 --- /dev/null +++ b/src/util/static_cfg.rs @@ -0,0 +1,91 @@ +use include_dir::Dir; +use serde::de; + +macro_rules! __static_cfg_include { + (toml_file, $filename:expr) => { + include_str!($filename) + }; + (toml_dir, $filename:expr) => { + include_dir!($filename) + }; + (json_file, $filename:expr) => { + include_str!($filename) + }; + (json_dir, $filename:expr) => { + include_dir!($filename) + }; +} + +macro_rules! __static_cfg_type { + (toml_file) => (&'static str); + (json_file) => (&'static str); + (toml_dir) => (include_dir::Dir<'static>); + (json_dir) => (include_dir::Dir<'static>); +} + +macro_rules! __static_cfg_parse { + (toml_file, $e:expr) => { + toml::from_str($e).unwrap() + }; + + (json_file, $e:expr) => { + serde_json::from_str($e).unwrap() + }; + + (toml_dir, $e:expr) => { + crate::util::static_cfg::parse_toml_dir($e) + }; + + (json_dir, $e:expr) => { + crate::util::static_cfg::parse_json_dir($e) + }; +} + +macro_rules! __static_cfg_inner { + ($(#[$attr:meta])* ($($vis:tt)*) static ref $N:ident : $T:ty = $kind:ident($filename:expr); $($t:tt)*) => { + // static RAW: &'static str = __static_cfg_include!($kind, $filename); + static RAW: __static_cfg_type!($kind) = __static_cfg_include!($kind, $filename); + lazy_static! { + $(#[$attr])* static ref $N: $T = __static_cfg_parse!($kind, RAW); + } + + static_cfg!($($t)*); + } +} + +#[macro_export] +macro_rules! static_cfg { + ($(#[$attr:meta])* static ref $N:ident : $T:ty = $kind:ident($filename:expr); $($t:tt)*) => { + __static_cfg_inner!($(#[$attr])* () static ref $N : $T = $kind($filename); $($t)*); + }; + + ($(#[$attr:meta])* pub static ref $N:ident : $T:ty = $kind:ident($filename:expr); $($t:tt)*) => { + __static_cfg_inner!($(#[$attr])* (pub) static ref $N : $T = $kind($filename); $($t)*); + }; + + ($(#[$attr:meta])* pub ($($vis:tt)+) static ref $N:ident : $T:ty = $kind:ident($filename:expr); $($t:tt)*) => { + __static_cfg_inner!($(#[$attr])* (pub ($($vis)+)) static ref $N : $T = $kind($filename); $($t)*); + }; + + () => () +} + +pub fn parse_toml_dir<'a, T>(d: Dir<'a>) -> Vec +where + T: de::Deserialize<'a>, +{ + d.files() + .iter() + .map(|f| toml::from_str(f.contents_utf8().unwrap()).unwrap()) + .collect() +} + +pub fn parse_json_dir<'a, T>(d: Dir<'a>) -> Vec +where + T: de::Deserialize<'a>, +{ + d.files() + .iter() + .map(|f| serde_json::from_str(f.contents_utf8().unwrap()).unwrap()) + .collect() +} diff --git a/src/util/static_toml.rs b/src/util/static_toml.rs deleted file mode 100644 index 7a930ee023..0000000000 --- a/src/util/static_toml.rs +++ /dev/null @@ -1,37 +0,0 @@ -macro_rules! __static_cfg_parse { - (toml_file, $e:expr) => { - toml::from_str($e) - }; - - (json_file, $e:expr) => { - json::from_str($e) - }; -} - -macro_rules! __static_cfg_inner { - ($(#[$attr:meta])* ($($vis:tt)*) static ref $N:ident : $T:ty = $kind:ident($filename:expr); $($t:tt)*) => { - static RAW: &'static str = include_str!($filename); - lazy_static! { - $(#[$attr])* static ref $N: $T = __static_cfg_parse!($kind, RAW).unwrap(); - } - - static_cfg!($($t)*); - } -} - -#[macro_export] -macro_rules! static_cfg { - ($(#[$attr:meta])* static ref $N:ident : $T:ty = $kind:ident($filename:expr); $($t:tt)*) => { - __static_cfg_inner!($(#[$attr])* () static ref $N : $T = $kind($filename); $($t)*); - }; - - ($(#[$attr:meta])* pub static ref $N:ident : $T:ty = $kind:ident($filename:expr); $($t:tt)*) => { - __static_cfg_inner!($(#[$attr])* (pub) static ref $N : $T = $kind($filename); $($t)*); - }; - - ($(#[$attr:meta])* pub ($($vis:tt)+) static ref $N:ident : $T:ty = $kind:ident($filename:expr); $($t:tt)*) => { - __static_cfg_inner!($(#[$attr])* (pub ($($vis)+)) static ref $N : $T = $kind($filename); $($t)*); - }; - - () => () -} -- cgit 1.4.1 From e7ad87c7301f266dece36e7558c0f212e370aac6 Mon Sep 17 00:00:00 2001 From: Griffin Smith Date: Sun, 14 Jul 2019 14:29:55 -0400 Subject: Add (statically-included) entity raws Add a system for statically-included entity raws (which necessitated making a deserializable existential Color struct) and test it out by initializing the game (for now) with a single on-screen gormlak. --- src/display/color.rs | 149 +++++++++++++++++++++++++++++++++++++++++ src/display/mod.rs | 5 +- src/entities/creature.rs | 43 ++++++++++++ src/entities/entity_char.rs | 22 ++++++ src/entities/mod.rs | 10 ++- src/entities/raws.rs | 57 ++++++++++++++++ src/entities/raws/gormlak.toml | 10 +++ src/game.rs | 12 +++- src/types/mod.rs | 3 +- 9 files changed, 306 insertions(+), 5 deletions(-) create mode 100644 src/display/color.rs create mode 100644 src/entities/creature.rs create mode 100644 src/entities/entity_char.rs create mode 100644 src/entities/raws.rs create mode 100644 src/entities/raws/gormlak.toml diff --git a/src/display/color.rs b/src/display/color.rs new file mode 100644 index 0000000000..7de1f124b7 --- /dev/null +++ b/src/display/color.rs @@ -0,0 +1,149 @@ +use serde::de::{self, Unexpected, Visitor}; +use std::fmt; +use std::marker::PhantomData; +use termion::color; + +#[derive(Debug)] +pub struct Color(Box); + +unsafe impl Sync for Color {} +unsafe impl Send for Color {} + +impl Color { + pub fn new(c: C) -> Self { + Color(Box::new(c)) + } +} + +impl color::Color for Color { + fn write_fg(&self, f: &mut fmt::Formatter) -> fmt::Result { + self.0.write_fg(f) + } + + fn write_bg(&self, f: &mut fmt::Formatter) -> fmt::Result { + self.0.write_bg(f) + } +} + +impl<'a> color::Color for &'a Color { + fn write_fg(&self, f: &mut fmt::Formatter) -> fmt::Result { + self.0.write_fg(f) + } + + fn write_bg(&self, f: &mut fmt::Formatter) -> fmt::Result { + self.0.write_bg(f) + } +} + +pub struct ColorVisitor { + marker: PhantomData Color>, +} + +impl ColorVisitor { + fn new() -> Self { + ColorVisitor { + marker: PhantomData, + } + } +} + +impl<'de> Visitor<'de> for ColorVisitor { + type Value = Color; + + fn expecting(&self, formatter: &mut fmt::Formatter) -> fmt::Result { + formatter.write_str("A color") + } + + fn visit_str(self, v: &str) -> Result + where + E: de::Error, + { + match v.to_lowercase().as_ref() { + "black" => Ok(Color(Box::new(color::Black))), + "blue" => Ok(Color(Box::new(color::Blue))), + "cyan" => Ok(Color(Box::new(color::Cyan))), + "green" => Ok(Color(Box::new(color::Green))), + "light black" | "light_black" => { + Ok(Color(Box::new(color::LightBlack))) + } + "light blue" | "light_blue" => { + Ok(Color(Box::new(color::LightBlue))) + } + "light cyan" | "light_cyan" => { + Ok(Color(Box::new(color::LightCyan))) + } + "light green" | "light_green" => { + Ok(Color(Box::new(color::LightGreen))) + } + "light magenta" | "light_magenta" => { + Ok(Color(Box::new(color::LightMagenta))) + } + "light red" | "light_red" => Ok(Color(Box::new(color::LightRed))), + "light white" | "light_white" => { + Ok(Color(Box::new(color::LightWhite))) + } + "light yellow" | "light_yellow" => { + Ok(Color(Box::new(color::LightYellow))) + } + "magenta" => Ok(Color(Box::new(color::Magenta))), + "magenta" => Ok(Color(Box::new(color::Magenta))), + "red" => Ok(Color(Box::new(color::Red))), + "white" => Ok(Color(Box::new(color::White))), + "yellow" => Ok(Color(Box::new(color::Yellow))), + _ => Err(de::Error::invalid_value( + Unexpected::Str(v), + &"a valid color", + )), + } + } + + fn visit_map(self, mut map: A) -> Result + where + A: de::MapAccess<'de>, + { + let mut red = None; + let mut green = None; + let mut blue = None; + while let Some((k, v)) = map.next_entry()? { + match k { + "red" => { + red = Some(v); + } + "green" => { + green = Some(v); + } + "blue" => { + blue = Some(v); + } + _ => { + return Err(de::Error::unknown_field( + k, + &["red", "green", "blue"], + )); + } + } + } + + match (red, green, blue) { + (Some(r), Some(g), Some(b)) => { + Ok(Color(Box::new(color::Rgb(r, g, b)))) + } + (None, _, _) => Err(de::Error::missing_field("red")), + (_, None, _) => Err(de::Error::missing_field("green")), + (_, _, None) => Err(de::Error::missing_field("blue")), + } + } + + fn visit_u8(self, v: u8) -> Result { + Ok(Color(Box::new(color::AnsiValue(v)))) + } +} + +impl<'de> serde::Deserialize<'de> for Color { + fn deserialize(deserializer: D) -> Result + where + D: serde::Deserializer<'de>, + { + deserializer.deserialize_any(ColorVisitor::new()) + } +} diff --git a/src/display/mod.rs b/src/display/mod.rs index 9e15a0d97d..3e30200ac7 100644 --- a/src/display/mod.rs +++ b/src/display/mod.rs @@ -1,3 +1,4 @@ +pub mod color; pub mod draw_box; pub mod utils; pub mod viewport; @@ -17,13 +18,13 @@ pub trait Draw: Positioned { fn do_draw(&self, out: &mut Write) -> io::Result<()>; } -impl Draw for &T { +impl Draw for &T { fn do_draw(&self, out: &mut Write) -> io::Result<()> { (**self).do_draw(out) } } -impl Draw for Box { +impl Draw for Box { fn do_draw(&self, out: &mut Write) -> io::Result<()> { (**self).do_draw(out) } diff --git a/src/entities/creature.rs b/src/entities/creature.rs new file mode 100644 index 0000000000..6ddeade218 --- /dev/null +++ b/src/entities/creature.rs @@ -0,0 +1,43 @@ +use crate::display; +use crate::entities::raws::CreatureType; +use crate::entities::raws::EntityRaw; +use crate::entities::{raw, Entity}; +use crate::types::Position; +use std::io::{self, Write}; + +pub struct Creature { + pub typ: &'static CreatureType<'static>, + pub position: Position, + pub hitpoints: u16, +} + +impl Creature { + pub fn new_from_raw(name: &'static str, position: Position) -> Self { + match raw(name) { + EntityRaw::Creature(typ) => Self::new_with_type(typ, position), + _ => panic!("Invalid raw type for {:?}, expected Creature", name), + } + } + + pub fn new_with_type( + typ: &'static CreatureType<'static>, + position: Position, + ) -> Self { + Creature { + typ, + position, + hitpoints: typ.max_hitpoints, + } + } +} + +positioned!(Creature); +positioned_mut!(Creature); + +impl Entity for Creature {} + +impl display::Draw for Creature { + fn do_draw(&self, out: &mut Write) -> io::Result<()> { + write!(out, "{}", self.typ.chr) + } +} diff --git a/src/entities/entity_char.rs b/src/entities/entity_char.rs new file mode 100644 index 0000000000..578aaf3da5 --- /dev/null +++ b/src/entities/entity_char.rs @@ -0,0 +1,22 @@ +use crate::display::color::Color; +use std::fmt::{self, Display, Formatter}; +use termion::color; + +#[derive(Debug, Deserialize)] +pub struct EntityChar { + color: Color, + #[serde(rename = "char")] + chr: char, +} + +impl Display for EntityChar { + fn fmt(&self, f: &mut Formatter) -> fmt::Result { + write!( + f, + "{}{}{}", + color::Fg(&self.color), + self.chr, + color::Fg(color::Reset) + ) + } +} diff --git a/src/entities/mod.rs b/src/entities/mod.rs index a23b15eef3..c4f46bf4a7 100644 --- a/src/entities/mod.rs +++ b/src/entities/mod.rs @@ -1,7 +1,15 @@ pub mod character; +pub mod creature; +pub mod entity_char; +pub mod raws; + +pub use character::Character; +pub use creature::Creature; +pub use entity_char::EntityChar; +pub use raws::raw; + use crate::display::Draw; use crate::types::{Positioned, PositionedMut}; -pub use character::Character; use downcast_rs::Downcast; use std::io::{self, Write}; diff --git a/src/entities/raws.rs b/src/entities/raws.rs new file mode 100644 index 0000000000..beeb90a40c --- /dev/null +++ b/src/entities/raws.rs @@ -0,0 +1,57 @@ +use crate::entities::entity_char::EntityChar; +use crate::types::Speed; +use std::collections::HashMap; + +#[derive(Debug, Deserialize)] +pub struct CreatureType<'a> { + /// The name of the creature. Used in raw lookups. + pub name: &'a str, + + /// A description of the entity, used by the "look" command + pub description: &'a str, + + #[serde(rename = "char")] + pub chr: EntityChar, + pub max_hitpoints: u16, + pub speed: Speed, + pub friendly: bool, +} + +#[derive(Debug, Deserialize)] +pub enum EntityRaw<'a> { + Creature(#[serde(borrow)] CreatureType<'a>), +} + +impl<'a> EntityRaw<'a> { + pub fn name(&self) -> &'a str { + match self { + EntityRaw::Creature(typ) => typ.name, + } + } +} + +static_cfg! { + static ref RAWS: Vec> = toml_dir("src/entities/raws"); +} + +lazy_static! { + static ref RAWS_BY_NAME: HashMap<&'static str, &'static EntityRaw<'static>> = { + let mut hm = HashMap::new(); + for er in RAWS.iter() { + if hm.contains_key(er.name()) { + panic!("Duplicate entity: {}", er.name()) + } + + hm.insert(er.name(), er); + } + hm + }; +} + +pub fn raw(name: &'static str) -> &'static EntityRaw<'static> { + debug!("{:?}", RAWS_BY_NAME.keys().collect::>()); + RAWS_BY_NAME + .get(name) + .map(|e| *e) + .expect(format!("Raw not found: {}", name).as_str()) +} diff --git a/src/entities/raws/gormlak.toml b/src/entities/raws/gormlak.toml new file mode 100644 index 0000000000..be30362d25 --- /dev/null +++ b/src/entities/raws/gormlak.toml @@ -0,0 +1,10 @@ +[Creature] +name = "gormlak" +description = """ +A chittering imp-like creature with bright yellow horns. It adores shiny objects +and gathers in swarms. +""" +char = { char = "g", color = "red" } +max_hitpoints = 5 +speed = 120 +friendly = false diff --git a/src/game.rs b/src/game.rs index 1a43628b43..f86d32d046 100644 --- a/src/game.rs +++ b/src/game.rs @@ -1,11 +1,12 @@ use crate::display::{self, Viewport}; use crate::entities::Character; -use crate::entities::Entity; +use crate::entities::{Creature, Entity}; use crate::messages::message; use crate::settings::Settings; use crate::types::command::Command; use crate::types::entity_map::EntityID; use crate::types::entity_map::EntityMap; +use crate::types::pos; use crate::types::Ticks; use crate::types::{ BoundingBox, Collision, Dimensions, Position, Positioned, PositionedMut, @@ -74,6 +75,15 @@ impl<'a> Game<'a> { None => SmallRng::from_entropy(), }; let mut entities: EntityMap> = EntityMap::new(); + + // TODO make this dynamic + { + entities.insert(Box::new(Creature::new_from_raw( + "gormlak", + pos(10, 0), + ))); + } + Game { settings, rng, diff --git a/src/types/mod.rs b/src/types/mod.rs index ac44bcc9c8..1e86fb369e 100644 --- a/src/types/mod.rs +++ b/src/types/mod.rs @@ -348,7 +348,8 @@ pub struct Ticks(pub u16); pub struct Tiles(pub f32); /// The speed of an entity, expressed in ticks per tile -#[derive(Clone, Copy, Debug, PartialEq, Eq, Arbitrary)] +#[derive(Clone, Copy, Debug, PartialEq, Eq, Arbitrary, Deserialize)] +#[serde(transparent)] pub struct Speed(pub u32); impl Speed { -- cgit 1.4.1 From 575a051e6efcd8fd3b0a146f49040e543ae8e5b0 Mon Sep 17 00:00:00 2001 From: Griffin Smith Date: Sun, 14 Jul 2019 16:20:22 -0400 Subject: Implement extremely basic combat There's a gormlak, you can kill it. That's it. --- src/entities/character.rs | 15 +++++--- src/entities/creature.rs | 24 ++++++++++--- src/entities/entity.rs | 87 +++++++++++++++++++++++++++++++++++++++++++++++ src/entities/mod.rs | 18 +++------- src/entities/raws.rs | 1 - src/game.rs | 72 ++++++++++++++++++++++++++++++++------- src/main.rs | 5 +-- src/messages.toml | 4 +++ src/types/entity_map.rs | 42 ++++++++++++++++++----- 9 files changed, 220 insertions(+), 48 deletions(-) create mode 100644 src/entities/entity.rs diff --git a/src/entities/character.rs b/src/entities/character.rs index fb5a89591c..7bcb8b5c87 100644 --- a/src/entities/character.rs +++ b/src/entities/character.rs @@ -1,5 +1,5 @@ use crate::display; -use crate::entities::Entity; +use crate::entities::EntityID; use crate::types::{Position, Speed}; use proptest_derive::Arbitrary; use std::io::{self, Write}; @@ -9,6 +9,8 @@ const DEFAULT_SPEED: Speed = Speed(100); #[derive(Debug, PartialEq, Eq, Arbitrary, Clone)] pub struct Character { + pub id: Option, + /// The position of the character, relative to the game pub position: Position, } @@ -16,6 +18,7 @@ pub struct Character { impl Character { pub fn new() -> Character { Character { + id: None, position: Position { x: 0, y: 0 }, } } @@ -23,12 +26,14 @@ impl Character { pub fn speed(&self) -> Speed { Speed(100) } -} -positioned!(Character); -positioned_mut!(Character); + pub fn damage(&self) -> u16 { + // TODO + 1 + } +} -impl Entity for Character {} +entity!(Character); impl display::Draw for Character { fn do_draw(&self, out: &mut Write) -> io::Result<()> { diff --git a/src/entities/creature.rs b/src/entities/creature.rs index 6ddeade218..55445f951b 100644 --- a/src/entities/creature.rs +++ b/src/entities/creature.rs @@ -1,11 +1,13 @@ use crate::display; use crate::entities::raws::CreatureType; use crate::entities::raws::EntityRaw; -use crate::entities::{raw, Entity}; +use crate::entities::{raw, EntityID}; use crate::types::Position; use std::io::{self, Write}; +#[derive(Debug)] pub struct Creature { + pub id: Option, pub typ: &'static CreatureType<'static>, pub position: Position, pub hitpoints: u16, @@ -24,17 +26,29 @@ impl Creature { position: Position, ) -> Self { Creature { + id: None, typ, position, hitpoints: typ.max_hitpoints, } } -} -positioned!(Creature); -positioned_mut!(Creature); + /// Damage the given creature by the given amount + pub fn damage(&mut self, amount: u16) { + if self.hitpoints <= amount { + self.hitpoints = 0; + } else { + self.hitpoints -= amount; + } + } + + /// Returns true if this creature has died + pub fn dead(&self) -> bool { + self.hitpoints <= 0 + } +} -impl Entity for Creature {} +entity!(Creature); impl display::Draw for Creature { fn do_draw(&self, out: &mut Write) -> io::Result<()> { diff --git a/src/entities/entity.rs b/src/entities/entity.rs new file mode 100644 index 0000000000..30f7ea9a3d --- /dev/null +++ b/src/entities/entity.rs @@ -0,0 +1,87 @@ +use crate::display::Draw; +use crate::entities::EntityID; +use crate::types::{Positioned, PositionedMut}; +use downcast_rs::Downcast; +use std::fmt::Debug; +use std::io::{self, Write}; + +pub trait Identified: Debug { + fn opt_id(&self) -> Option; + fn set_id(&mut self, id: ID); + + fn id(&self) -> ID { + self.opt_id() + .expect(format!("Entity ({:?}) is not in the game", self).as_str()) + } +} + +impl<'a, A, ID> Identified for &'a mut A +where + A: Identified, +{ + fn opt_id(&self) -> Option { + (**self).opt_id() + } + fn set_id(&mut self, id: ID) { + (**self).set_id(id); + } +} + +impl> Identified for Box { + fn opt_id(&self) -> Option { + (**self).opt_id() + } + fn set_id(&mut self, id: ID) { + (**self).set_id(id); + } +} + +pub trait Entity: + Positioned + PositionedMut + Identified + Draw + Downcast +{ +} + +impl Identified for Box { + fn opt_id(&self) -> Option { + (**self).opt_id() + } + fn set_id(&mut self, id: EntityID) { + (**self).set_id(id); + } +} + +#[macro_export] +macro_rules! identified { + ($name: ident, $typ: ident) => { + identified!($name, $typ, id); + }; + ($name: ident, $typ: ident, $attr: ident) => { + impl crate::entities::entity::Identified<$typ> for $name { + fn opt_id(&self) -> Option<$typ> { + self.$attr + } + + fn set_id(&mut self, id: $typ) { + self.$attr = Some(id) + } + } + }; +} + +#[macro_export] +macro_rules! entity { + ($name: ident) => { + positioned!($name); + positioned_mut!($name); + identified!($name, EntityID); + impl crate::entities::entity::Entity for $name {} + }; +} + +impl_downcast!(Entity); + +impl Draw for Box { + fn do_draw(&self, out: &mut Write) -> io::Result<()> { + (**self).do_draw(out) + } +} diff --git a/src/entities/mod.rs b/src/entities/mod.rs index c4f46bf4a7..ed83f2f462 100644 --- a/src/entities/mod.rs +++ b/src/entities/mod.rs @@ -1,3 +1,5 @@ +#[macro_use] +pub mod entity; pub mod character; pub mod creature; pub mod entity_char; @@ -5,20 +7,8 @@ pub mod raws; pub use character::Character; pub use creature::Creature; +pub use entity::{Entity, Identified}; pub use entity_char::EntityChar; pub use raws::raw; -use crate::display::Draw; -use crate::types::{Positioned, PositionedMut}; -use downcast_rs::Downcast; -use std::io::{self, Write}; - -pub trait Entity: Positioned + PositionedMut + Draw + Downcast {} - -impl_downcast!(Entity); - -impl Draw for Box { - fn do_draw(&self, out: &mut Write) -> io::Result<()> { - (**self).do_draw(out) - } -} +pub type EntityID = u32; diff --git a/src/entities/raws.rs b/src/entities/raws.rs index beeb90a40c..da061d89d8 100644 --- a/src/entities/raws.rs +++ b/src/entities/raws.rs @@ -49,7 +49,6 @@ lazy_static! { } pub fn raw(name: &'static str) -> &'static EntityRaw<'static> { - debug!("{:?}", RAWS_BY_NAME.keys().collect::>()); RAWS_BY_NAME .get(name) .map(|e| *e) diff --git a/src/game.rs b/src/game.rs index f86d32d046..57c04cfb88 100644 --- a/src/game.rs +++ b/src/game.rs @@ -1,15 +1,12 @@ use crate::display::{self, Viewport}; -use crate::entities::Character; -use crate::entities::{Creature, Entity}; +use crate::entities::{Character, Creature, Entity, EntityID, Identified}; use crate::messages::message; use crate::settings::Settings; use crate::types::command::Command; -use crate::types::entity_map::EntityID; use crate::types::entity_map::EntityMap; -use crate::types::pos; -use crate::types::Ticks; use crate::types::{ - BoundingBox, Collision, Dimensions, Position, Positioned, PositionedMut, + pos, BoundingBox, Collision, Dimensions, Position, Positioned, + PositionedMut, Ticks, }; use rand::rngs::SmallRng; use rand::SeedableRng; @@ -100,21 +97,29 @@ impl<'a> Game<'a> { } } + /// Returns a list of all creature entities at the given position + fn creatures_at<'b>(&'b self, pos: Position) -> Vec<&'b Creature> { + self.entities + .at(pos) + .iter() + .filter_map(|e| e.downcast_ref()) + .collect() + } + /// Returns a collision, if any, at the given Position in the game fn collision_at(&self, pos: Position) -> Option { if !pos.within(self.viewport.inner) { Some(Collision::Stop) } else { - None + if self.creatures_at(pos).len() > 0 { + Some(Collision::Combat) + } else { + None + } } } fn character(&self) -> &Character { - debug!( - "ents: {:?} cid: {:?}", - self.entities.ids().map(|id| *id).collect::>(), - self.character_entity_id - ); (*self.entities.get(self.character_entity_id).unwrap()) .downcast_ref() .unwrap() @@ -128,6 +133,14 @@ impl<'a> Game<'a> { Ok(()) } + /// Remove the given entity from the game, drawing over it if it's visible + fn remove_entity(&mut self, entity_id: EntityID) -> io::Result<()> { + if let Some(entity) = self.entities.remove(entity_id) { + self.viewport.clear(entity.position())?; + } + Ok(()) + } + /// Step the game forward the given number of ticks fn tick(&mut self, ticks: Ticks) {} @@ -153,6 +166,37 @@ impl<'a> Game<'a> { self.viewport.write_message(message) } + fn attack(&mut self, creature_id: EntityID) -> io::Result<()> { + info!("Attacking creature {:?}", creature_id); + self.say("combat.attack")?; + let damage = self.character().damage(); + let creature = self + .entities + .get_mut(creature_id) + .and_then(|e| e.downcast_mut::()) + .expect( + format!("Creature ID went away: {:?}", creature_id).as_str(), + ); + creature.damage(damage); + if creature.dead() { + self.say("combat.killed")?; + info!("Killed creature {:?}", creature_id); + self.remove_entity(creature_id)?; + } + Ok(()) + } + + fn attack_at(&mut self, pos: Position) -> io::Result<()> { + let creatures = self.creatures_at(pos); + if creatures.len() == 1 { + let creature = creatures.get(0).unwrap(); + self.attack(creature.id()) + } else { + // TODO prompt with a menu of creatures to combat + unimplemented!() + } + } + /// Run the game pub fn run(mut self) -> io::Result<()> { info!("Running game"); @@ -180,7 +224,9 @@ impl<'a> Game<'a> { new_pos, ); } - Some(Combat) => unimplemented!(), + Some(Combat) => { + self.attack_at(new_pos)?; + } Some(Stop) => (), } } diff --git a/src/main.rs b/src/main.rs index f7257a8896..636663e050 100644 --- a/src/main.rs +++ b/src/main.rs @@ -24,11 +24,12 @@ extern crate include_dir; #[macro_use] mod util; -mod display; -mod game; #[macro_use] mod types; +#[macro_use] mod entities; +mod display; +mod game; mod messages; mod settings; diff --git a/src/messages.toml b/src/messages.toml index 04746462d5..a6b795d97e 100644 --- a/src/messages.toml +++ b/src/messages.toml @@ -1,2 +1,6 @@ [global] welcome = "Welcome to Xanthous! It's dangerous out there, why not stay inside?" + +[combat] +attack = "You attack the {{creature_name}}." +killed = "You killed the {{creature_name}}." diff --git a/src/types/entity_map.rs b/src/types/entity_map.rs index 1d58873bb0..12deaa57a6 100644 --- a/src/types/entity_map.rs +++ b/src/types/entity_map.rs @@ -1,3 +1,5 @@ +use crate::entities::entity::Identified; +use crate::entities::EntityID; use crate::types::Position; use crate::types::Positioned; use crate::types::PositionedMut; @@ -5,8 +7,6 @@ use std::collections::hash_map::HashMap; use std::collections::BTreeMap; use std::iter::FromIterator; -pub type EntityID = u32; - #[derive(Debug)] pub struct EntityMap { by_position: BTreeMap>, @@ -83,6 +83,10 @@ impl EntityMap { self.by_id.get(&id) } + pub fn get_mut<'a>(&'a mut self, id: EntityID) -> Option<&'a mut A> { + self.by_id.get_mut(&id) + } + pub fn entities<'a>(&'a self) -> impl Iterator { self.by_id.values() } @@ -101,10 +105,11 @@ impl EntityMap { } } -impl EntityMap { - pub fn insert(&mut self, entity: A) -> EntityID { +impl> EntityMap { + pub fn insert(&mut self, mut entity: A) -> EntityID { let pos = entity.position(); let entity_id = self.next_id(); + entity.set_id(entity_id); self.by_id.entry(entity_id).or_insert(entity); self.by_position .entry(pos) @@ -112,9 +117,19 @@ impl EntityMap { .push(entity_id); entity_id } + + /// Remove the entity with the given ID + pub fn remove(&mut self, id: EntityID) -> Option { + self.by_id.remove(&id).map(|e| { + self.by_position + .get_mut(&e.position()) + .map(|es| es.retain(|e| *e != id)); + e + }) + } } -impl FromIterator for EntityMap { +impl> FromIterator for EntityMap { fn from_iter>(iter: I) -> Self { let mut em = EntityMap::new(); for ent in iter { @@ -160,6 +175,7 @@ mod tests { #[derive(Debug, Arbitrary, PartialEq, Eq, Clone)] struct TestEntity { + _id: Option, position: Position, name: String, } @@ -176,6 +192,16 @@ mod tests { } } + impl Identified for TestEntity { + fn opt_id(&self) -> Option { + self._id + } + + fn set_id(&mut self, id: EntityID) { + self._id = Some(id); + } + } + fn gen_entity_map() -> BoxedStrategy> { any::>() .prop_map(|ents| { @@ -194,7 +220,7 @@ mod tests { let mut map = EntityMap::new(); assert_eq!(map.len(), 0); for ent in &items { - map.insert(ent); + map.insert(ent.clone()); } assert_eq!(map.len(), items.len()); } @@ -205,7 +231,7 @@ mod tests { ent: TestEntity ) { em.insert(ent.clone()); - assert!(em.at(ent.position).iter().any(|e| **e == ent)) + assert!(em.at(ent.position).iter().any(|e| e.name == ent.name)) } #[test] @@ -214,7 +240,7 @@ mod tests { ent: TestEntity ) { em.insert(ent.clone()); - assert!(em.entities().any(|e| *e == ent)) + assert!(em.entities().any(|e| e.name == ent.name)) } #[test] -- cgit 1.4.1 From bc93999cf37a65d48f25e30795c85a0aef97efac Mon Sep 17 00:00:00 2001 From: Griffin Smith Date: Sun, 14 Jul 2019 16:31:36 -0400 Subject: Always reset the cursor back to the character much nicer! --- src/display/viewport.rs | 19 +++++++++++++++---- src/game.rs | 1 + 2 files changed, 16 insertions(+), 4 deletions(-) diff --git a/src/display/viewport.rs b/src/display/viewport.rs index 780eb88714..b510b0504c 100644 --- a/src/display/viewport.rs +++ b/src/display/viewport.rs @@ -2,7 +2,7 @@ use super::BoxStyle; use super::Draw; use crate::display::draw_box::draw_box; use crate::display::utils::clone_times; -use crate::types::{BoundingBox, Position, Positioned}; +use crate::types::{pos, BoundingBox, Position, Positioned}; use std::fmt::{self, Debug}; use std::io::{self, Write}; @@ -23,6 +23,9 @@ pub struct Viewport { /// The actual screen that the viewport writes to pub out: W, + + /// Reset the cursor back to this position after every draw + pub cursor_position: Position, } impl Viewport { pub fn new(outer: BoundingBox, inner: BoundingBox, out: W) -> Self { @@ -31,6 +34,7 @@ impl Viewport { inner, out, game: outer.move_tr_corner(Position { x: 0, y: 1 }), + cursor_position: pos(0, 0), } } @@ -63,7 +67,12 @@ impl Viewport { return Ok(()); } self.cursor_goto(entity.position())?; - entity.do_draw(self) + entity.do_draw(self)?; + self.reset_cursor() + } + + fn reset_cursor(&mut self) -> io::Result<()> { + self.cursor_goto(self.cursor_position) } /// Move the cursor to the given inner-relative position @@ -74,7 +83,8 @@ impl Viewport { /// Clear whatever single character is drawn at the given inner-relative /// position, if visible pub fn clear(&mut self, pos: Position) -> io::Result<()> { - write!(self, "{} ", self.on_screen(pos).cursor_goto(),) + write!(self, "{} ", self.on_screen(pos).cursor_goto(),)?; + self.reset_cursor() } /// Initialize this viewport by drawing its outer box to the screen @@ -101,7 +111,8 @@ impl Viewport { " ".to_string(), self.outer.dimensions.w - msg.len() as u16 ), - ) + )?; + self.reset_cursor() } } diff --git a/src/game.rs b/src/game.rs index 57c04cfb88..48142b6376 100644 --- a/src/game.rs +++ b/src/game.rs @@ -242,6 +242,7 @@ impl<'a> Game<'a> { (old_pos - self.character().position).as_tiles(), )); self.viewport.clear(old_pos)?; + self.viewport.cursor_position = self.character().position; self.viewport.draw( // TODO this clone feels unnecessary. &self.character().clone(), -- cgit 1.4.1 From e2d13bd76b9af9cc2734cdcb9df605afa95cca31 Mon Sep 17 00:00:00 2001 From: Griffin Smith Date: Fri, 19 Jul 2019 11:54:31 -0400 Subject: Add templates for messages Implement a template syntax with a nom parser, and a formatter to render templates to strings. --- Cargo.lock | 80 +++++++++++ Cargo.toml | 1 + src/entities/creature.rs | 2 +- src/game.rs | 64 +++++++-- src/main.rs | 2 + src/messages.rs | 127 ++++++----------- src/messages.toml | 9 +- src/util/mod.rs | 2 + src/util/template.rs | 362 +++++++++++++++++++++++++++++++++++++++++++++++ 9 files changed, 548 insertions(+), 101 deletions(-) create mode 100644 src/util/template.rs diff --git a/Cargo.lock b/Cargo.lock index b0020c4669..9cffdfec18 100644 --- a/Cargo.lock +++ b/Cargo.lock @@ -380,6 +380,18 @@ dependencies = [ "spin 0.5.0 (registry+https://github.com/rust-lang/crates.io-index)", ] +[[package]] +name = "lexical-core" +version = "0.4.2" +source = "registry+https://github.com/rust-lang/crates.io-index" +dependencies = [ + "cfg-if 0.1.9 (registry+https://github.com/rust-lang/crates.io-index)", + "rustc_version 0.2.3 (registry+https://github.com/rust-lang/crates.io-index)", + "ryu 0.2.8 (registry+https://github.com/rust-lang/crates.io-index)", + "stackvector 1.0.6 (registry+https://github.com/rust-lang/crates.io-index)", + "static_assertions 0.2.5 (registry+https://github.com/rust-lang/crates.io-index)", +] + [[package]] name = "libc" version = "0.2.58" @@ -492,6 +504,16 @@ dependencies = [ "version_check 0.1.5 (registry+https://github.com/rust-lang/crates.io-index)", ] +[[package]] +name = "nom" +version = "5.0.0" +source = "registry+https://github.com/rust-lang/crates.io-index" +dependencies = [ + "lexical-core 0.4.2 (registry+https://github.com/rust-lang/crates.io-index)", + "memchr 2.2.0 (registry+https://github.com/rust-lang/crates.io-index)", + "version_check 0.1.5 (registry+https://github.com/rust-lang/crates.io-index)", +] + [[package]] name = "num-integer" version = "0.1.41" @@ -833,6 +855,14 @@ name = "rustc-demangle" version = "0.1.15" source = "registry+https://github.com/rust-lang/crates.io-index" +[[package]] +name = "rustc_version" +version = "0.2.3" +source = "registry+https://github.com/rust-lang/crates.io-index" +dependencies = [ + "semver 0.9.0 (registry+https://github.com/rust-lang/crates.io-index)", +] + [[package]] name = "rusty-fork" version = "0.2.2" @@ -859,6 +889,19 @@ name = "scoped_threadpool" version = "0.1.9" source = "registry+https://github.com/rust-lang/crates.io-index" +[[package]] +name = "semver" +version = "0.9.0" +source = "registry+https://github.com/rust-lang/crates.io-index" +dependencies = [ + "semver-parser 0.7.0 (registry+https://github.com/rust-lang/crates.io-index)", +] + +[[package]] +name = "semver-parser" +version = "0.7.0" +source = "registry+https://github.com/rust-lang/crates.io-index" + [[package]] name = "serde" version = "0.8.23" @@ -934,6 +977,20 @@ name = "spin" version = "0.5.0" source = "registry+https://github.com/rust-lang/crates.io-index" +[[package]] +name = "stackvector" +version = "1.0.6" +source = "registry+https://github.com/rust-lang/crates.io-index" +dependencies = [ + "rustc_version 0.2.3 (registry+https://github.com/rust-lang/crates.io-index)", + "unreachable 1.0.0 (registry+https://github.com/rust-lang/crates.io-index)", +] + +[[package]] +name = "static_assertions" +version = "0.2.5" +source = "registry+https://github.com/rust-lang/crates.io-index" + [[package]] name = "strsim" version = "0.8.0" @@ -1084,6 +1141,14 @@ name = "unicode-xid" version = "0.1.0" source = "registry+https://github.com/rust-lang/crates.io-index" +[[package]] +name = "unreachable" +version = "1.0.0" +source = "registry+https://github.com/rust-lang/crates.io-index" +dependencies = [ + "void 1.0.2 (registry+https://github.com/rust-lang/crates.io-index)", +] + [[package]] name = "unsafe-any" version = "0.4.2" @@ -1107,6 +1172,11 @@ name = "version_check" version = "0.1.5" source = "registry+https://github.com/rust-lang/crates.io-index" +[[package]] +name = "void" +version = "1.0.2" +source = "registry+https://github.com/rust-lang/crates.io-index" + [[package]] name = "wait-timeout" version = "0.2.0" @@ -1148,6 +1218,7 @@ dependencies = [ "log 0.4.6 (registry+https://github.com/rust-lang/crates.io-index)", "log4rs 0.8.3 (registry+https://github.com/rust-lang/crates.io-index)", "maplit 1.0.1 (registry+https://github.com/rust-lang/crates.io-index)", + "nom 5.0.0 (registry+https://github.com/rust-lang/crates.io-index)", "prettytable-rs 0.8.0 (registry+https://github.com/rust-lang/crates.io-index)", "proptest 0.9.3 (registry+https://github.com/rust-lang/crates.io-index)", "proptest-derive 0.1.1 (registry+https://github.com/rust-lang/crates.io-index)", @@ -1222,6 +1293,7 @@ dependencies = [ "checksum itoa 0.4.4 (registry+https://github.com/rust-lang/crates.io-index)" = "501266b7edd0174f8530248f87f99c88fbe60ca4ef3dd486835b8d8d53136f7f" "checksum lazy_static 0.2.11 (registry+https://github.com/rust-lang/crates.io-index)" = "76f033c7ad61445c5b347c7382dd1237847eb1bce590fe50365dcb33d546be73" "checksum lazy_static 1.3.0 (registry+https://github.com/rust-lang/crates.io-index)" = "bc5729f27f159ddd61f4df6228e827e86643d4d3e7c32183cb30a1c08f604a14" +"checksum lexical-core 0.4.2 (registry+https://github.com/rust-lang/crates.io-index)" = "3f8673fab7063c2cac37d299c8a1a7beb720e78f71500098e4a3c137fdf025bf" "checksum libc 0.2.58 (registry+https://github.com/rust-lang/crates.io-index)" = "6281b86796ba5e4366000be6e9e18bf35580adf9e63fbe2294aadb587613a319" "checksum linked-hash-map 0.3.0 (registry+https://github.com/rust-lang/crates.io-index)" = "6d262045c5b87c0861b3f004610afd0e2c851e2908d08b6c870cbb9d5f494ecd" "checksum linked-hash-map 0.5.2 (registry+https://github.com/rust-lang/crates.io-index)" = "ae91b68aebc4ddb91978b11a1b02ddd8602a05ec19002801c5666000e05e0f83" @@ -1235,6 +1307,7 @@ dependencies = [ "checksum miniz_oxide_c_api 0.2.1 (registry+https://github.com/rust-lang/crates.io-index)" = "b7fe927a42e3807ef71defb191dc87d4e24479b221e67015fe38ae2b7b447bab" "checksum nodrop 0.1.13 (registry+https://github.com/rust-lang/crates.io-index)" = "2f9667ddcc6cc8a43afc9b7917599d7216aa09c463919ea32c59ed6cac8bc945" "checksum nom 4.2.3 (registry+https://github.com/rust-lang/crates.io-index)" = "2ad2a91a8e869eeb30b9cb3119ae87773a8f4ae617f41b1eb9c154b2905f7bd6" +"checksum nom 5.0.0 (registry+https://github.com/rust-lang/crates.io-index)" = "e9761d859320e381010a4f7f8ed425f2c924de33ad121ace447367c713ad561b" "checksum num-integer 0.1.41 (registry+https://github.com/rust-lang/crates.io-index)" = "b85e541ef8255f6cf42bbfe4ef361305c6c135d10919ecc26126c4e5ae94bc09" "checksum num-traits 0.1.43 (registry+https://github.com/rust-lang/crates.io-index)" = "92e5113e9fd4cc14ded8e499429f396a20f98c772a47cc8622a736e1ec843c31" "checksum num-traits 0.2.8 (registry+https://github.com/rust-lang/crates.io-index)" = "6ba9a427cfca2be13aa6f6403b0b7e7368fe982bfa16fccc450ce74c46cd9b32" @@ -1274,10 +1347,13 @@ dependencies = [ "checksum remove_dir_all 0.5.1 (registry+https://github.com/rust-lang/crates.io-index)" = "3488ba1b9a2084d38645c4c08276a1752dcbf2c7130d74f1569681ad5d2799c5" "checksum rust-ini 0.13.0 (registry+https://github.com/rust-lang/crates.io-index)" = "3e52c148ef37f8c375d49d5a73aa70713125b7f19095948a923f80afdeb22ec2" "checksum rustc-demangle 0.1.15 (registry+https://github.com/rust-lang/crates.io-index)" = "a7f4dccf6f4891ebcc0c39f9b6eb1a83b9bf5d747cb439ec6fba4f3b977038af" +"checksum rustc_version 0.2.3 (registry+https://github.com/rust-lang/crates.io-index)" = "138e3e0acb6c9fb258b19b67cb8abd63c00679d2851805ea151465464fe9030a" "checksum rusty-fork 0.2.2 (registry+https://github.com/rust-lang/crates.io-index)" = "3dd93264e10c577503e926bd1430193eeb5d21b059148910082245309b424fae" "checksum ryu 0.2.8 (registry+https://github.com/rust-lang/crates.io-index)" = "b96a9549dc8d48f2c283938303c4b5a77aa29bfbc5b54b084fb1630408899a8f" "checksum ryu 1.0.0 (registry+https://github.com/rust-lang/crates.io-index)" = "c92464b447c0ee8c4fb3824ecc8383b81717b9f1e74ba2e72540aef7b9f82997" "checksum scoped_threadpool 0.1.9 (registry+https://github.com/rust-lang/crates.io-index)" = "1d51f5df5af43ab3f1360b429fa5e0152ac5ce8c0bd6485cae490332e96846a8" +"checksum semver 0.9.0 (registry+https://github.com/rust-lang/crates.io-index)" = "1d7eb9ef2c18661902cc47e535f9bc51b78acd254da71d375c2f6720d9a40403" +"checksum semver-parser 0.7.0 (registry+https://github.com/rust-lang/crates.io-index)" = "388a1df253eca08550bef6c72392cfe7c30914bf41df5269b68cbd6ff8f570a3" "checksum serde 0.8.23 (registry+https://github.com/rust-lang/crates.io-index)" = "9dad3f759919b92c3068c696c15c3d17238234498bbdcc80f2c469606f948ac8" "checksum serde 1.0.92 (registry+https://github.com/rust-lang/crates.io-index)" = "32746bf0f26eab52f06af0d0aa1984f641341d06d8d673c693871da2d188c9be" "checksum serde-hjson 0.8.2 (registry+https://github.com/rust-lang/crates.io-index)" = "0b833c5ad67d52ced5f5938b2980f32a9c1c5ef047f0b4fb3127e7a423c76153" @@ -1287,6 +1363,8 @@ dependencies = [ "checksum serde_test 0.8.23 (registry+https://github.com/rust-lang/crates.io-index)" = "110b3dbdf8607ec493c22d5d947753282f3bae73c0f56d322af1e8c78e4c23d5" "checksum serde_yaml 0.8.9 (registry+https://github.com/rust-lang/crates.io-index)" = "38b08a9a90e5260fe01c6480ec7c811606df6d3a660415808c3c3fa8ed95b582" "checksum spin 0.5.0 (registry+https://github.com/rust-lang/crates.io-index)" = "44363f6f51401c34e7be73db0db371c04705d35efbe9f7d6082e03a921a32c55" +"checksum stackvector 1.0.6 (registry+https://github.com/rust-lang/crates.io-index)" = "1c4725650978235083241fab0fdc8e694c3de37821524e7534a1a9061d1068af" +"checksum static_assertions 0.2.5 (registry+https://github.com/rust-lang/crates.io-index)" = "c19be23126415861cb3a23e501d34a708f7f9b2183c5252d690941c2e69199d5" "checksum strsim 0.8.0 (registry+https://github.com/rust-lang/crates.io-index)" = "8ea5119cdb4c55b55d432abb513a0429384878c15dde60cc77b1c99de1a95a6a" "checksum syn 0.14.9 (registry+https://github.com/rust-lang/crates.io-index)" = "261ae9ecaa397c42b960649561949d69311f08eeaea86a65696e6e46517cf741" "checksum syn 0.15.35 (registry+https://github.com/rust-lang/crates.io-index)" = "641e117d55514d6d918490e47102f7e08d096fdde360247e4a10f7a91a8478d3" @@ -1305,10 +1383,12 @@ dependencies = [ "checksum ucd-util 0.1.3 (registry+https://github.com/rust-lang/crates.io-index)" = "535c204ee4d8434478593480b8f86ab45ec9aae0e83c568ca81abf0fd0e88f86" "checksum unicode-width 0.1.5 (registry+https://github.com/rust-lang/crates.io-index)" = "882386231c45df4700b275c7ff55b6f3698780a650026380e72dabe76fa46526" "checksum unicode-xid 0.1.0 (registry+https://github.com/rust-lang/crates.io-index)" = "fc72304796d0818e357ead4e000d19c9c174ab23dc11093ac919054d20a6a7fc" +"checksum unreachable 1.0.0 (registry+https://github.com/rust-lang/crates.io-index)" = "382810877fe448991dfc7f0dd6e3ae5d58088fd0ea5e35189655f84e6814fa56" "checksum unsafe-any 0.4.2 (registry+https://github.com/rust-lang/crates.io-index)" = "f30360d7979f5e9c6e6cea48af192ea8fab4afb3cf72597154b8f08935bc9c7f" "checksum utf8-ranges 1.0.3 (registry+https://github.com/rust-lang/crates.io-index)" = "9d50aa7650df78abf942826607c62468ce18d9019673d4a2ebe1865dbb96ffde" "checksum vec_map 0.8.1 (registry+https://github.com/rust-lang/crates.io-index)" = "05c78687fb1a80548ae3250346c3db86a80a7cdd77bda190189f2d0a0987c81a" "checksum version_check 0.1.5 (registry+https://github.com/rust-lang/crates.io-index)" = "914b1a6776c4c929a602fafd8bc742e06365d4bcbe48c30f9cca5824f70dc9dd" +"checksum void 1.0.2 (registry+https://github.com/rust-lang/crates.io-index)" = "6a02e4885ed3bc0f2de90ea6dd45ebcbb66dacffe03547fadbb0eeae2770887d" "checksum wait-timeout 0.2.0 (registry+https://github.com/rust-lang/crates.io-index)" = "9f200f5b12eb75f8c1ed65abd4b2db8a6e1b138a20de009dacee265a2498f3f6" "checksum winapi 0.3.7 (registry+https://github.com/rust-lang/crates.io-index)" = "f10e386af2b13e47c89e7236a7a14a086791a2b88ebad6df9bf42040195cf770" "checksum winapi-i686-pc-windows-gnu 0.4.0 (registry+https://github.com/rust-lang/crates.io-index)" = "ac3b87c63620426dd9b991e5ce0329eff545bccbbb34f3be09ff6fb6ab51b7b6" diff --git a/Cargo.toml b/Cargo.toml index 02464410eb..3de1dbbe83 100644 --- a/Cargo.toml +++ b/Cargo.toml @@ -15,6 +15,7 @@ lazy_static = "*" log = "*" log4rs = "*" maplit = "^1.0.1" +nom = "^5.0.0" prettytable-rs = "^0.8" proptest = "0.9.3" proptest-derive = "*" diff --git a/src/entities/creature.rs b/src/entities/creature.rs index 55445f951b..9fd8d23c75 100644 --- a/src/entities/creature.rs +++ b/src/entities/creature.rs @@ -5,7 +5,7 @@ use crate::entities::{raw, EntityID}; use crate::types::Position; use std::io::{self, Write}; -#[derive(Debug)] +#[derive(Debug, Clone)] pub struct Creature { pub id: Option, pub typ: &'static CreatureType<'static>, diff --git a/src/game.rs b/src/game.rs index 48142b6376..af9b0ac938 100644 --- a/src/game.rs +++ b/src/game.rs @@ -8,6 +8,7 @@ use crate::types::{ pos, BoundingBox, Collision, Dimensions, Position, Positioned, PositionedMut, Ticks, }; +use crate::util::template::TemplateParams; use rand::rngs::SmallRng; use rand::SeedableRng; use std::io::{self, StdinLock, StdoutLock, Write}; @@ -145,16 +146,24 @@ impl<'a> Game<'a> { fn tick(&mut self, ticks: Ticks) {} /// Get a message from the global map based on the rng in this game - fn message(&mut self, name: &str) -> &'static str { - message(name, &mut self.rng) + fn message<'params>( + &mut self, + name: &'static str, + params: &TemplateParams<'params>, + ) -> String { + message(name, &mut self.rng, params) } /// Say a message to the user - fn say(&mut self, message_name: &str) -> io::Result<()> { - let message = self.message(message_name); + fn say<'params>( + &mut self, + message_name: &'static str, + params: &TemplateParams<'params>, + ) -> io::Result<()> { + let message = self.message(message_name, params); self.messages.push(message.to_string()); self.message_idx = self.messages.len() - 1; - self.viewport.write_message(message) + self.viewport.write_message(&message) } fn previous_message(&mut self) -> io::Result<()> { @@ -166,20 +175,45 @@ impl<'a> Game<'a> { self.viewport.write_message(message) } + fn creature(&self, creature_id: EntityID) -> Option<&Creature> { + self.entities + .get(creature_id) + .and_then(|e| e.downcast_ref::()) + } + + fn expect_creature(&self, creature_id: EntityID) -> &Creature { + self.creature(creature_id).expect( + format!("Creature ID went away: {:?}", creature_id).as_str(), + ) + } + + fn mut_creature(&mut self, creature_id: EntityID) -> Option<&mut Creature> { + self.entities + .get_mut(creature_id) + .and_then(|e| e.downcast_mut::()) + } + + fn expect_mut_creature(&mut self, creature_id: EntityID) -> &mut Creature { + self.mut_creature(creature_id).expect( + format!("Creature ID went away: {:?}", creature_id).as_str(), + ) + } + fn attack(&mut self, creature_id: EntityID) -> io::Result<()> { info!("Attacking creature {:?}", creature_id); - self.say("combat.attack")?; let damage = self.character().damage(); - let creature = self - .entities - .get_mut(creature_id) - .and_then(|e| e.downcast_mut::()) - .expect( - format!("Creature ID went away: {:?}", creature_id).as_str(), - ); + let creature_name = self.expect_creature(creature_id).typ.name; + let tps = template_params!({ + "creature" => { + "name" => creature_name, + }, + }); + self.say("combat.attack", &tps)?; + + let creature = self.expect_mut_creature(creature_id); creature.damage(damage); if creature.dead() { - self.say("combat.killed")?; + self.say("combat.killed", &tps)?; info!("Killed creature {:?}", creature_id); self.remove_entity(creature_id)?; } @@ -202,7 +236,7 @@ impl<'a> Game<'a> { info!("Running game"); self.viewport.init()?; self.draw_entities()?; - self.say("global.welcome")?; + self.say("global.welcome", &template_params!())?; self.flush()?; loop { let mut old_position = None; diff --git a/src/main.rs b/src/main.rs index 636663e050..8bad5c057f 100644 --- a/src/main.rs +++ b/src/main.rs @@ -21,6 +21,8 @@ extern crate downcast_rs; extern crate backtrace; #[macro_use] extern crate include_dir; +#[macro_use] +extern crate nom; #[macro_use] mod util; diff --git a/src/messages.rs b/src/messages.rs index 948787f139..aa0366e786 100644 --- a/src/messages.rs +++ b/src/messages.rs @@ -1,32 +1,33 @@ +use crate::util::template::Template; +use crate::util::template::TemplateParams; use rand::seq::SliceRandom; use rand::Rng; -use serde::de::MapAccess; -use serde::de::SeqAccess; -use serde::de::Visitor; use std::collections::HashMap; -use std::fmt; -use std::marker::PhantomData; #[derive(Deserialize, Debug, PartialEq, Eq)] #[serde(untagged)] enum Message<'a> { - Single(&'a str), - Choice(Vec<&'a str>), + #[serde(borrow)] + Single(Template<'a>), + Choice(Vec>), } impl<'a> Message<'a> { - fn resolve(&self, rng: &mut R) -> Option<&'a str> { + fn resolve(&self, rng: &mut R) -> Option<&Template<'a>> { use Message::*; match self { - Single(msg) => Some(*msg), - Choice(msgs) => msgs.choose(rng).map(|msg| *msg), + Single(msg) => Some(msg), + Choice(msgs) => msgs.choose(rng), } } } -#[derive(Debug, PartialEq, Eq)] +#[derive(Deserialize, Debug, PartialEq, Eq)] +#[serde(untagged)] enum NestedMap<'a> { + #[serde(borrow)] Direct(Message<'a>), + #[serde(borrow)] Nested(HashMap<&'a str, NestedMap<'a>>), } @@ -46,63 +47,6 @@ impl<'a> NestedMap<'a> { } } -struct NestedMapVisitor<'a> { - marker: PhantomData NestedMap<'a>>, -} - -impl<'a> NestedMapVisitor<'a> { - fn new() -> Self { - NestedMapVisitor { - marker: PhantomData, - } - } -} - -impl<'de> Visitor<'de> for NestedMapVisitor<'de> { - type Value = NestedMap<'de>; - - fn expecting(&self, formatter: &mut fmt::Formatter) -> fmt::Result { - formatter.write_str( - "A message, a list of messages, or a nested map of messages", - ) - } - - fn visit_borrowed_str(self, v: &'de str) -> Result { - Ok(NestedMap::Direct(Message::Single(v))) - } - - fn visit_seq(self, mut seq: A) -> Result - where - A: SeqAccess<'de>, - { - let mut choices = Vec::with_capacity(seq.size_hint().unwrap_or(0)); - while let Some(choice) = seq.next_element()? { - choices.push(choice); - } - Ok(NestedMap::Direct(Message::Choice(choices))) - } - - fn visit_map(self, mut map: A) -> Result - where - A: MapAccess<'de>, - { - let mut nested = HashMap::with_capacity(map.size_hint().unwrap_or(0)); - while let Some((k, v)) = map.next_entry()? { - nested.insert(k, v); - } - Ok(NestedMap::Nested(nested)) - } -} - -impl<'de> serde::Deserialize<'de> for NestedMap<'de> { - fn deserialize(deserializer: D) -> Result - where - D: serde::Deserializer<'de>, - { - deserializer.deserialize_any(NestedMapVisitor::new()) - } -} - #[cfg(test)] mod tests { use super::*; @@ -122,13 +66,18 @@ choice = ["Say this", "Or this"] result, Ok(NestedMap::Nested(hashmap! { "global" => NestedMap::Nested(hashmap!{ - "hello" => NestedMap::Direct(Message::Single("Hello World!")), + "hello" => NestedMap::Direct(Message::Single(Template::parse("Hello World!").unwrap())), }), "foo" => NestedMap::Nested(hashmap!{ "bar" => NestedMap::Nested(hashmap!{ - "single" => NestedMap::Direct(Message::Single("Single")), + "single" => NestedMap::Direct(Message::Single( + Template::parse("Single").unwrap() + )), "choice" => NestedMap::Direct(Message::Choice( - vec!["Say this", "Or this"] + vec![ + Template::parse("Say this").unwrap(), + Template::parse("Or this").unwrap() + ] )) }) }) @@ -152,31 +101,43 @@ choice = ["Say this", "Or this"] assert_eq!( map.lookup("global.hello"), - Some(&Message::Single("Hello World!")) + Some(&Message::Single(Template::parse("Hello World!").unwrap())) ); assert_eq!( map.lookup("foo.bar.single"), - Some(&Message::Single("Single")) + Some(&Message::Single(Template::parse("Single").unwrap())) ); assert_eq!( map.lookup("foo.bar.choice"), - Some(&Message::Choice(vec!["Say this", "Or this"])) + Some(&Message::Choice(vec![ + Template::parse("Say this").unwrap(), + Template::parse("Or this").unwrap() + ])) ); } } +// static MESSAGES_RAW: &'static str = include_str!("messages.toml"); + static_cfg! { static ref MESSAGES: NestedMap<'static> = toml_file("messages.toml"); } -/// Look up a game message based on the given (dot-separated) name, with the -/// given random generator used to select from choice-based messages -pub fn message(name: &str, rng: &mut R) -> &'static str { - MESSAGES - .lookup(name) - .and_then(|msg| msg.resolve(rng)) - .unwrap_or_else(|| { +/// Look up and format a game message based on the given (dot-separated) name, +/// with the given random generator used to select from choice-based messages +pub fn message<'a, R: Rng + ?Sized>( + name: &'static str, + rng: &mut R, + params: &TemplateParams<'a>, +) -> String { + match MESSAGES.lookup(name).and_then(|msg| msg.resolve(rng)) { + Some(msg) => msg.format(params).unwrap_or_else(|e| { + error!("Error formatting template: {}", e); + "Template Error".to_string() + }), + None => { error!("Message not found: {}", name); - "Message not found" - }) + "Template Not Found".to_string() + } + } } diff --git a/src/messages.toml b/src/messages.toml index a6b795d97e..d3e0e1de8a 100644 --- a/src/messages.toml +++ b/src/messages.toml @@ -2,5 +2,10 @@ welcome = "Welcome to Xanthous! It's dangerous out there, why not stay inside?" [combat] -attack = "You attack the {{creature_name}}." -killed = "You killed the {{creature_name}}." +attack = "You attack the {{creature.name}}." +killed = [ + "You've killed the {{creature.name}}.", + "The {{creature.name}} dies.", + "The {{creature.name}} kicks it.", + "The {{creature.name}} beefs it." + ] diff --git a/src/util/mod.rs b/src/util/mod.rs index 87fd7910f3..c2b4eecaf5 100644 --- a/src/util/mod.rs +++ b/src/util/mod.rs @@ -1,2 +1,4 @@ #[macro_use] pub mod static_cfg; +#[macro_use] +pub mod template; diff --git a/src/util/template.rs b/src/util/template.rs new file mode 100644 index 0000000000..a3faadc31c --- /dev/null +++ b/src/util/template.rs @@ -0,0 +1,362 @@ +use nom::combinator::rest; +use nom::error::ErrorKind; +use nom::{Err, IResult}; +use std::collections::HashMap; +use std::fmt::{self, Display}; +use std::marker::PhantomData; + +#[derive(Debug, PartialEq, Eq, Clone)] +pub struct Path<'a> { + head: &'a str, + tail: Vec<&'a str>, +} + +impl<'a> Path<'a> { + fn new(head: &'a str, tail: Vec<&'a str>) -> Self { + Path { head, tail } + } +} + +impl<'a> Display for Path<'a> { + fn fmt(&self, f: &mut fmt::Formatter) -> fmt::Result { + write!(f, "{}", self.head)?; + for part in &self.tail { + write!(f, ".{}", part)?; + } + Ok(()) + } +} + +// named!(path_ident, map_res!(is_not!(".}"), std::str::from_utf8)); +fn path_ident<'a>(input: &'a str) -> IResult<&'a str, &'a str> { + take_till!(input, |c| c == '.' || c == '}') +} + +fn path<'a>(input: &'a str) -> IResult<&'a str, Path<'a>> { + map!( + input, + tuple!( + path_ident, + many0!(complete!(preceded!(char!('.'), path_ident))) + ), + |(h, t)| Path::new(h, t) + ) +} + +#[derive(Debug, PartialEq, Eq, Clone)] +pub enum TemplateToken<'a> { + Literal(&'a str), + Substitution(Path<'a>), +} + +fn token_substitution<'a>( + input: &'a str, +) -> IResult<&'a str, TemplateToken<'a>> { + map!( + input, + delimited!(tag!("{{"), path, tag!("}}")), + TemplateToken::Substitution + ) +} + +fn template_token<'a>(input: &'a str) -> IResult<&'a str, TemplateToken<'a>> { + alt!( + input, + token_substitution + | map!( + alt!(complete!(take_until!("{{")) | complete!(rest)), + TemplateToken::Literal + ) + ) +} + +#[derive(Debug, PartialEq, Eq, Clone)] +pub struct Template<'a> { + tokens: Vec>, +} + +impl<'a> Template<'a> { + pub fn new(tokens: Vec>) -> Self { + Template { tokens } + } +} + +pub struct TemplateVisitor<'a> { + marker: PhantomData Template<'a>>, +} + +impl<'a> TemplateVisitor<'a> { + pub fn new() -> Self { + TemplateVisitor { + marker: PhantomData, + } + } +} + +impl<'a> serde::de::Visitor<'a> for TemplateVisitor<'a> { + type Value = Template<'a>; + + fn expecting(&self, formatter: &mut fmt::Formatter) -> fmt::Result { + formatter.write_str("a valid template string") + } + + fn visit_borrowed_str( + self, + v: &'a str, + ) -> Result { + Template::parse(v).map_err(|_| { + serde::de::Error::invalid_value( + serde::de::Unexpected::Str(v), + &"a valid template string", + ) + }) + } +} + +impl<'a> serde::Deserialize<'a> for Template<'a> { + fn deserialize>( + deserializer: D, + ) -> Result { + deserializer.deserialize_str(TemplateVisitor::new()) + } +} + +impl<'a> Template<'a> { + pub fn parse( + input: &'a str, + ) -> Result, Err<(&'a str, ErrorKind)>> { + let (remaining, res) = template(input)?; + if remaining.len() > 0 { + unreachable!(); + } + Ok(res) + } + + pub fn format( + &self, + params: &TemplateParams<'a>, + ) -> Result> { + use TemplateToken::*; + let mut res = String::new(); + for token in &self.tokens { + match token { + Literal(s) => res.push_str(s), + Substitution(p) => match params.get(p.clone()) { + Some(s) => res.push_str(s), + None => return Err(TemplateError::MissingParam(p.clone())), + }, + } + } + Ok(res) + } +} + +#[derive(Debug, PartialEq, Eq)] +pub enum TemplateError<'a> { + MissingParam(Path<'a>), +} + +impl<'a> Display for TemplateError<'a> { + fn fmt(&self, f: &mut fmt::Formatter) -> fmt::Result { + use TemplateError::*; + match self { + MissingParam(path) => { + write!(f, "Missing template parameter: {}", path) + } + } + } +} + +#[derive(Debug, PartialEq, Eq)] +pub enum TemplateParams<'a> { + Direct(&'a str), + Nested(HashMap<&'a str, TemplateParams<'a>>), +} + +impl<'a> TemplateParams<'a> { + fn get(&self, path: Path<'a>) -> Option<&'a str> { + use TemplateParams::*; + match self { + Direct(_) => None, + Nested(m) => m.get(path.head).and_then(|next| { + if path.tail.len() == 0 { + match next { + Direct(s) => Some(*s), + _ => None, + } + } else { + next.get(Path { + head: path.tail[0], + tail: path.tail[1..].to_vec(), + }) + } + }), + } + } +} + +#[macro_export] +macro_rules! template_params { + (@count $head: expr => $hv: tt, $($rest:tt)+) => { 1 + template_params!(@count $($rest)+) }; + (@count $one:expr => $($ov: tt)*) => { 1 }; + (@inner $ret: ident, ($key: expr => {$($v:tt)*}, $($r:tt)*)) => { + $ret.insert($key, template_params!({ $($v)* })); + template_params!(@inner $ret, ($($r)*)); + }; + (@inner $ret: ident, ($key: expr => $value: expr, $($r:tt)*)) => { + $ret.insert($key, template_params!($value)); + template_params!(@inner $ret, ($($r)*)); + }; + (@inner $ret: ident, ()) => {}; + + ({ $($body: tt)* }) => {{ + let _cap = template_params!(@count $($body)*); + let mut _m = ::std::collections::HashMap::with_capacity(_cap); + template_params!(@inner _m, ($($body)*)); + TemplateParams::Nested(_m) + }}; + + ($direct:expr) => { TemplateParams::Direct($direct) }; + + () => { TemplateParams::Nested(::std::collections::HashMap::new()) }; +} + +fn template<'a>(input: &'a str) -> IResult<&'a str, Template<'a>> { + complete!( + input, + map!(many1!(complete!(template_token)), Template::new) + ) +} + +#[cfg(test)] +mod tests { + use super::*; + + #[test] + fn test_parse_path_ident() { + assert_eq!(path_ident("foo}}"), Ok(("}}", "foo"))); + assert_eq!(path_ident("foo.bar}}"), Ok((".bar}}", "foo"))); + } + + #[test] + fn test_parse_path() { + assert_eq!(path("foo}}"), Ok(("}}", Path::new("foo", vec![])))); + assert_eq!( + path("foo.bar}}"), + Ok(("}}", Path::new("foo", vec!["bar"]))) + ); + assert_eq!( + path("foo.bar.baz}}"), + Ok(("}}", Path::new("foo", vec!["bar", "baz"]))) + ); + } + + #[test] + fn test_parse_template_token() { + assert_eq!( + template_token("foo bar"), + Ok(("", TemplateToken::Literal("foo bar"))) + ); + + assert_eq!( + template_token("foo bar {{baz}}"), + Ok(("{{baz}}", TemplateToken::Literal("foo bar "))) + ); + + assert_eq!( + template_token("{{baz}}"), + Ok(( + "", + TemplateToken::Substitution(Path::new("baz", Vec::new())) + )) + ); + + assert_eq!( + template_token("{{baz}} foo bar"), + Ok(( + " foo bar", + TemplateToken::Substitution(Path::new("baz", Vec::new())) + )) + ); + } + + #[test] + fn test_parse_template() { + assert_eq!( + template("foo bar"), + Ok(( + "", + Template { + tokens: vec![TemplateToken::Literal("foo bar")] + } + )) + ); + + assert_eq!( + template("foo bar {{baz}} qux"), + Ok(( + "", + Template { + tokens: vec![ + TemplateToken::Literal("foo bar "), + TemplateToken::Substitution(Path::new( + "baz", + Vec::new() + )), + TemplateToken::Literal(" qux"), + ] + } + )) + ); + } + + #[test] + fn test_template_params_literal() { + // trace_macros!(true); + let expected = template_params!({ + "direct" => "hi", + "other" => "here", + "nested" => { + "one" => "1", + "two" => "2", + "double" => { + "three" => "3", + }, + }, + }); + // trace_macros!(false); + assert_eq!( + TemplateParams::Nested(hashmap! { + "direct" => TemplateParams::Direct("hi"), + "other" => TemplateParams::Direct("here"), + "nested" => TemplateParams::Nested(hashmap!{ + "one" => TemplateParams::Direct("1"), + "two" => TemplateParams::Direct("2"), + "double" => TemplateParams::Nested(hashmap!{ + "three" => TemplateParams::Direct("3"), + }) + }) + }), + expected, + ) + } + + #[test] + fn test_format_template() { + assert_eq!( + "foo bar baz qux", + Template::parse("foo {{x}} {{y.z}} {{y.w.z}}") + .unwrap() + .format(&template_params!({ + "x" => "bar", + "y" => { + "z" => "baz", + "w" => { + "z" => "qux", + }, + }, + })) + .unwrap() + ) + } +} -- cgit 1.4.1 From 4e9138aa6ff72e34392e3467c40d5ddf095f0027 Mon Sep 17 00:00:00 2001 From: Griffin Smith Date: Fri, 19 Jul 2019 12:07:27 -0400 Subject: add a test ensuring messages work --- src/messages.rs | 18 +++++++++++++++++- 1 file changed, 17 insertions(+), 1 deletion(-) diff --git a/src/messages.rs b/src/messages.rs index aa0366e786..9ca78025ec 100644 --- a/src/messages.rs +++ b/src/messages.rs @@ -48,7 +48,7 @@ impl<'a> NestedMap<'a> { } #[cfg(test)] -mod tests { +mod nested_map_tests { use super::*; #[test] @@ -141,3 +141,19 @@ pub fn message<'a, R: Rng + ?Sized>( } } } + +#[cfg(test)] +mod tests { + use super::*; + use rand::rngs::SmallRng; + use rand::SeedableRng; + + #[test] + fn test_static_messages() { + message( + "global.welcome", + &mut SmallRng::from_entropy(), + &template_params!(), + ); + } +} -- cgit 1.4.1 From 29c80ac8ba0d733c6c452d8fd39e9561553495b0 Mon Sep 17 00:00:00 2001 From: Griffin Smith Date: Fri, 19 Jul 2019 21:55:09 -0400 Subject: Add the beginning of item entities Add a new Item raw type and entity type, with preliminary, basic support for food. There's a really frustrating toml-rs bug that prevents writing these nicely as toml right now, so I also added support for mixing JSON and TOML in a single config dir --- Cargo.lock | 8 ++++ Cargo.toml | 2 + src/display/color.rs | 6 +++ src/entities/entity_char.rs | 2 + src/entities/item.rs | 44 +++++++++++++++++ src/entities/mod.rs | 3 ++ src/entities/raw_types.rs | 104 +++++++++++++++++++++++++++++++++++++++++ src/entities/raws.rs | 44 ++++++----------- src/entities/raws/noodles.json | 14 ++++++ src/game.rs | 7 ++- src/main.rs | 3 ++ src/messages.rs | 11 ++++- src/messages.toml | 3 ++ src/util/static_cfg.rs | 58 ++++++++++++++++++++++- 14 files changed, 274 insertions(+), 35 deletions(-) create mode 100644 src/entities/item.rs create mode 100644 src/entities/raw_types.rs create mode 100644 src/entities/raws/noodles.json diff --git a/Cargo.lock b/Cargo.lock index 9cffdfec18..cd08098985 100644 --- a/Cargo.lock +++ b/Cargo.lock @@ -454,6 +454,11 @@ name = "maplit" version = "1.0.1" source = "registry+https://github.com/rust-lang/crates.io-index" +[[package]] +name = "matches" +version = "0.1.8" +source = "registry+https://github.com/rust-lang/crates.io-index" + [[package]] name = "memchr" version = "2.2.0" @@ -1218,6 +1223,7 @@ dependencies = [ "log 0.4.6 (registry+https://github.com/rust-lang/crates.io-index)", "log4rs 0.8.3 (registry+https://github.com/rust-lang/crates.io-index)", "maplit 1.0.1 (registry+https://github.com/rust-lang/crates.io-index)", + "matches 0.1.8 (registry+https://github.com/rust-lang/crates.io-index)", "nom 5.0.0 (registry+https://github.com/rust-lang/crates.io-index)", "prettytable-rs 0.8.0 (registry+https://github.com/rust-lang/crates.io-index)", "proptest 0.9.3 (registry+https://github.com/rust-lang/crates.io-index)", @@ -1226,6 +1232,7 @@ dependencies = [ "serde 1.0.92 (registry+https://github.com/rust-lang/crates.io-index)", "serde_derive 1.0.92 (registry+https://github.com/rust-lang/crates.io-index)", "serde_json 1.0.39 (registry+https://github.com/rust-lang/crates.io-index)", + "serde_yaml 0.8.9 (registry+https://github.com/rust-lang/crates.io-index)", "termion 1.5.2 (registry+https://github.com/rust-lang/crates.io-index)", "toml 0.5.1 (registry+https://github.com/rust-lang/crates.io-index)", ] @@ -1301,6 +1308,7 @@ dependencies = [ "checksum log-mdc 0.1.0 (registry+https://github.com/rust-lang/crates.io-index)" = "a94d21414c1f4a51209ad204c1776a3d0765002c76c6abcb602a6f09f1e881c7" "checksum log4rs 0.8.3 (registry+https://github.com/rust-lang/crates.io-index)" = "100052474df98158c0738a7d3f4249c99978490178b5f9f68cd835ac57adbd1b" "checksum maplit 1.0.1 (registry+https://github.com/rust-lang/crates.io-index)" = "08cbb6b4fef96b6d77bfc40ec491b1690c779e77b05cd9f07f787ed376fd4c43" +"checksum matches 0.1.8 (registry+https://github.com/rust-lang/crates.io-index)" = "7ffc5c5338469d4d3ea17d269fa8ea3512ad247247c30bd2df69e68309ed0a08" "checksum memchr 2.2.0 (registry+https://github.com/rust-lang/crates.io-index)" = "2efc7bc57c883d4a4d6e3246905283d8dae951bb3bd32f49d6ef297f546e1c39" "checksum miniz-sys 0.1.12 (registry+https://github.com/rust-lang/crates.io-index)" = "1e9e3ae51cea1576ceba0dde3d484d30e6e5b86dee0b2d412fe3a16a15c98202" "checksum miniz_oxide 0.2.1 (registry+https://github.com/rust-lang/crates.io-index)" = "c468f2369f07d651a5d0bb2c9079f8488a66d5466efe42d0c5c6466edcb7f71e" diff --git a/Cargo.toml b/Cargo.toml index 3de1dbbe83..b290f6b444 100644 --- a/Cargo.toml +++ b/Cargo.toml @@ -14,6 +14,7 @@ itertools = "*" lazy_static = "*" log = "*" log4rs = "*" +matches = "0.1.8" maplit = "^1.0.1" nom = "^5.0.0" prettytable-rs = "^0.8" @@ -23,6 +24,7 @@ rand = {version = "^0.7.0", features = ["small_rng"]} serde = "^1.0.8" serde_derive = "^1.0.8" serde_json = "*" +serde_yaml = "0.8" termion = "*" toml = "^0.5.1" diff --git a/src/display/color.rs b/src/display/color.rs index 7de1f124b7..7d024a960d 100644 --- a/src/display/color.rs +++ b/src/display/color.rs @@ -35,6 +35,12 @@ impl<'a> color::Color for &'a Color { } } +impl Default for Color { + fn default() -> Self { + Color::new(color::Reset) + } +} + pub struct ColorVisitor { marker: PhantomData Color>, } diff --git a/src/entities/entity_char.rs b/src/entities/entity_char.rs index 578aaf3da5..2f84582002 100644 --- a/src/entities/entity_char.rs +++ b/src/entities/entity_char.rs @@ -4,7 +4,9 @@ use termion::color; #[derive(Debug, Deserialize)] pub struct EntityChar { + #[serde(default)] color: Color, + #[serde(rename = "char")] chr: char, } diff --git a/src/entities/item.rs b/src/entities/item.rs new file mode 100644 index 0000000000..d0ecc090e2 --- /dev/null +++ b/src/entities/item.rs @@ -0,0 +1,44 @@ +use crate::display; +use crate::entities::raws::{raw, EntityRaw, ItemType}; +use crate::entities::EntityID; +use crate::types::Position; +use std::io::{self, Write}; + +#[derive(Debug, Clone)] +pub struct Item { + pub id: Option, + pub typ: &'static ItemType<'static>, + pub position: Position, +} + +impl Item { + pub fn new_from_raw(name: &'static str, position: Position) -> Self { + match raw(name) { + EntityRaw::Item(typ) => Self::new_with_type(typ, position), + _ => panic!("Invalid raw type for {:?}, expected Item", name), + } + } + + pub fn new_with_type( + typ: &'static ItemType<'static>, + position: Position, + ) -> Self { + Item { + id: None, + typ, + position, + } + } + + pub fn is_edible(&self) -> bool { + self.typ.is_edible() + } +} + +entity!(Item); + +impl display::Draw for Item { + fn do_draw(&self, out: &mut Write) -> io::Result<()> { + write!(out, "{}", self.typ.chr) + } +} diff --git a/src/entities/mod.rs b/src/entities/mod.rs index ed83f2f462..c54a587e6a 100644 --- a/src/entities/mod.rs +++ b/src/entities/mod.rs @@ -3,12 +3,15 @@ pub mod entity; pub mod character; pub mod creature; pub mod entity_char; +pub mod item; +pub mod raw_types; pub mod raws; pub use character::Character; pub use creature::Creature; pub use entity::{Entity, Identified}; pub use entity_char::EntityChar; +pub use item::Item; pub use raws::raw; pub type EntityID = u32; diff --git a/src/entities/raw_types.rs b/src/entities/raw_types.rs new file mode 100644 index 0000000000..8f64e60d9c --- /dev/null +++ b/src/entities/raw_types.rs @@ -0,0 +1,104 @@ +use crate::entities::entity_char::EntityChar; +use crate::messages::Message; +use crate::types::Speed; + +#[derive(Debug, Deserialize)] +pub struct CreatureType<'a> { + /// The name of the creature. Used in raw lookups. + pub name: &'a str, + + /// A description of the entity, used by the "look" command + pub description: &'a str, + + #[serde(rename = "char")] + pub chr: EntityChar, + pub max_hitpoints: u16, + pub speed: Speed, + pub friendly: bool, +} + +#[derive(Debug, Deserialize)] +pub struct EdibleItem<'a> { + #[serde(borrow)] + pub eat_message: Option>, + + /// The number of hitpoints that eating this item heals + pub hitpoints_healed: u16, +} + +#[derive(Debug, Deserialize)] +pub struct ItemType<'a> { + pub name: &'a str, + + /// A description of the item, used by the "look" command + pub description: &'a str, + + pub edible_item: Option>, + + #[serde(rename = "char")] + pub chr: EntityChar, +} + +#[cfg(test)] +mod item_type_tests { + use super::*; + + #[test] + fn test_deserialize_item_type() { + let result = serde_json::from_str( + r#"{ + "Item": { + "name": "noodles", + "description": "You know exactly what kind of noodles", + "char": { "char": "n" }, + "edible_item": { + "eat_message": "You slurp up the noodles", + "hitpoints_healed": 2 + } + } + }"#, + ) + .unwrap(); + assert_matches!(result, EntityRaw::Item(_)); + if let EntityRaw::Item(item) = result { + assert_eq!(item.name, "noodles"); + } + + let toml_result = toml::from_str( + r#"[Item] +name = "noodles" +description = "You know exactly what kind of noodles" +char = { char = "🍜" } +edible_item = { eat_message = "You slurp up the noodles", hitpoints_healed = 2 } +"#, + ) + .unwrap(); + + assert_matches!(toml_result, EntityRaw::Item(_)); + if let EntityRaw::Item(item) = toml_result { + assert_eq!(item.name, "noodles"); + } + } +} + +impl<'a> ItemType<'a> { + pub fn is_edible(&self) -> bool { + self.edible_item.is_some() + } +} + +#[derive(Debug, Deserialize)] +pub enum EntityRaw<'a> { + Creature(#[serde(borrow)] CreatureType<'a>), + Item(#[serde(borrow)] ItemType<'a>), +} + +impl<'a> EntityRaw<'a> { + pub fn name(&self) -> &'a str { + use EntityRaw::*; + match self { + Creature(typ) => typ.name, + Item(typ) => typ.name, + } + } +} diff --git a/src/entities/raws.rs b/src/entities/raws.rs index da061d89d8..2c4a8203cb 100644 --- a/src/entities/raws.rs +++ b/src/entities/raws.rs @@ -1,37 +1,8 @@ -use crate::entities::entity_char::EntityChar; -use crate::types::Speed; +pub use crate::entities::raw_types::{CreatureType, EntityRaw, ItemType}; use std::collections::HashMap; -#[derive(Debug, Deserialize)] -pub struct CreatureType<'a> { - /// The name of the creature. Used in raw lookups. - pub name: &'a str, - - /// A description of the entity, used by the "look" command - pub description: &'a str, - - #[serde(rename = "char")] - pub chr: EntityChar, - pub max_hitpoints: u16, - pub speed: Speed, - pub friendly: bool, -} - -#[derive(Debug, Deserialize)] -pub enum EntityRaw<'a> { - Creature(#[serde(borrow)] CreatureType<'a>), -} - -impl<'a> EntityRaw<'a> { - pub fn name(&self) -> &'a str { - match self { - EntityRaw::Creature(typ) => typ.name, - } - } -} - static_cfg! { - static ref RAWS: Vec> = toml_dir("src/entities/raws"); + static ref RAWS: Vec> = cfg_dir("src/entities/raws"); } lazy_static! { @@ -54,3 +25,14 @@ pub fn raw(name: &'static str) -> &'static EntityRaw<'static> { .map(|e| *e) .expect(format!("Raw not found: {}", name).as_str()) } + +#[cfg(test)] +mod tests { + use super::*; + + #[test] + fn test_raws() { + RAWS_BY_NAME.keys(); + assert_eq!(raw("noodles").name(), "noodles"); + } +} diff --git a/src/entities/raws/noodles.json b/src/entities/raws/noodles.json new file mode 100644 index 0000000000..d4b773cac5 --- /dev/null +++ b/src/entities/raws/noodles.json @@ -0,0 +1,14 @@ +{ + "Item": { + "name": "noodles", + "char": { + "char": "🍜" + }, + "description": "You know exactly what kind of noodles", + "edible_item": { + "eat_message": "You slurp up the noodles", + "hitpoints_healed": 2 + }, + "display_name": "big bowl o' noodles" + } +} diff --git a/src/game.rs b/src/game.rs index af9b0ac938..c4fc6d2be1 100644 --- a/src/game.rs +++ b/src/game.rs @@ -1,5 +1,7 @@ use crate::display::{self, Viewport}; -use crate::entities::{Character, Creature, Entity, EntityID, Identified}; +use crate::entities::{ + Character, Creature, Entity, EntityID, Identified, Item, +}; use crate::messages::message; use crate::settings::Settings; use crate::types::command::Command; @@ -80,6 +82,9 @@ impl<'a> Game<'a> { "gormlak", pos(10, 0), ))); + + entities + .insert(Box::new(Item::new_from_raw("noodles", pos(0, 10)))); } Game { diff --git a/src/main.rs b/src/main.rs index 8bad5c057f..69b7304e49 100644 --- a/src/main.rs +++ b/src/main.rs @@ -7,6 +7,7 @@ extern crate serde; extern crate toml; #[macro_use] extern crate serde_derive; +extern crate serde_json; #[macro_use] extern crate clap; #[macro_use] @@ -23,6 +24,8 @@ extern crate backtrace; extern crate include_dir; #[macro_use] extern crate nom; +#[macro_use] +extern crate matches; #[macro_use] mod util; diff --git a/src/messages.rs b/src/messages.rs index 9ca78025ec..719389fa61 100644 --- a/src/messages.rs +++ b/src/messages.rs @@ -6,7 +6,7 @@ use std::collections::HashMap; #[derive(Deserialize, Debug, PartialEq, Eq)] #[serde(untagged)] -enum Message<'a> { +pub enum Message<'a> { #[serde(borrow)] Single(Template<'a>), Choice(Vec>), @@ -123,6 +123,13 @@ static_cfg! { static ref MESSAGES: NestedMap<'static> = toml_file("messages.toml"); } +pub fn get( + name: &'static str, + rng: &mut R, +) -> Option<&'static Template<'static>> { + MESSAGES.lookup(name).and_then(|msg| msg.resolve(rng)) +} + /// Look up and format a game message based on the given (dot-separated) name, /// with the given random generator used to select from choice-based messages pub fn message<'a, R: Rng + ?Sized>( @@ -130,7 +137,7 @@ pub fn message<'a, R: Rng + ?Sized>( rng: &mut R, params: &TemplateParams<'a>, ) -> String { - match MESSAGES.lookup(name).and_then(|msg| msg.resolve(rng)) { + match get(name, rng) { Some(msg) => msg.format(params).unwrap_or_else(|e| { error!("Error formatting template: {}", e); "Template Error".to_string() diff --git a/src/messages.toml b/src/messages.toml index d3e0e1de8a..e7d097a76f 100644 --- a/src/messages.toml +++ b/src/messages.toml @@ -9,3 +9,6 @@ killed = [ "The {{creature.name}} kicks it.", "The {{creature.name}} beefs it." ] + +[defaults.item] +eat = "You eat the {{item.name}}" diff --git a/src/util/static_cfg.rs b/src/util/static_cfg.rs index 1b4864df72..b20456fb3b 100644 --- a/src/util/static_cfg.rs +++ b/src/util/static_cfg.rs @@ -14,6 +14,9 @@ macro_rules! __static_cfg_include { (json_dir, $filename:expr) => { include_dir!($filename) }; + (cfg_dir, $filename:expr) => { + include_dir!($filename) + }; } macro_rules! __static_cfg_type { @@ -21,6 +24,7 @@ macro_rules! __static_cfg_type { (json_file) => (&'static str); (toml_dir) => (include_dir::Dir<'static>); (json_dir) => (include_dir::Dir<'static>); + (cfg_dir) => (include_dir::Dir<'static>); } macro_rules! __static_cfg_parse { @@ -39,6 +43,10 @@ macro_rules! __static_cfg_parse { (json_dir, $e:expr) => { crate::util::static_cfg::parse_json_dir($e) }; + + (cfg_dir, $e:expr) => { + crate::util::static_cfg::parse_cfg_dir($e); + }; } macro_rules! __static_cfg_inner { @@ -70,13 +78,61 @@ macro_rules! static_cfg { () => () } +pub fn parse_cfg_dir<'a, T>(d: Dir<'a>) -> Vec +where + T: de::Deserialize<'a>, +{ + d.files() + .iter() + .filter_map(|f| { + let path = f.path(); + let contents = f.contents_utf8().unwrap(); + match path.extension().and_then(|e| e.to_str()) { + Some("toml") => { + Some(toml::from_str(contents).unwrap_or_else(|e| { + panic!( + "Error parsing TOML file {}: {}", + path.display(), + e + ) + })) + } + Some("json") => { + Some(serde_json::from_str(contents).unwrap_or_else(|e| { + panic!( + "Error parsing JSON file {}: {}", + path.display(), + e + ) + })) + } + // > YAML currently does not support zero-copy deserialization + // Some("yaml") => { + // Some(serde_yaml::from_str(contents).unwrap_or_else(|e| { + // panic!( + // "Error parsing YAML file {}: {}", + // path.display(), + // e + // ) + // })) + // } + _ => None, + } + }) + .collect() +} + pub fn parse_toml_dir<'a, T>(d: Dir<'a>) -> Vec where T: de::Deserialize<'a>, { d.files() .iter() - .map(|f| toml::from_str(f.contents_utf8().unwrap()).unwrap()) + .map(|f| { + toml::from_str(f.contents_utf8().unwrap()).unwrap_or_else(|e| { + panic!("Error parsing TOML file {}: {}", f.path, e) + }) + }) .collect() } -- cgit 1.4.1 From d001b0a017cf4d1a614e636059db257fa75dcc9d Mon Sep 17 00:00:00 2001 From: Griffin Smith Date: Sat, 20 Jul 2019 01:40:09 -0400 Subject: Cellular-automata based cave level generator --- src/cli.yml | 8 ++++ src/level_gen/cave_automata.rs | 85 ++++++++++++++++++++++++++++++++++++++++++ src/level_gen/display.rs | 17 +++++++++ src/level_gen/mod.rs | 3 ++ src/level_gen/util.rs | 31 +++++++++++++++ src/main.rs | 21 +++++++++-- 6 files changed, 162 insertions(+), 3 deletions(-) create mode 100644 src/level_gen/cave_automata.rs create mode 100644 src/level_gen/display.rs create mode 100644 src/level_gen/mod.rs create mode 100644 src/level_gen/util.rs diff --git a/src/cli.yml b/src/cli.yml index 7c374e1020..937b44c9c6 100644 --- a/src/cli.yml +++ b/src/cli.yml @@ -12,3 +12,11 @@ args: subcommands: - debug: about: Writes debug information to the terminal and exits + - generate-level: + about: Generate a level and print it to the screen + args: + - generator: + long: generator + value_name: GEN + help: Select which generator to use + takes_value: true diff --git a/src/level_gen/cave_automata.rs b/src/level_gen/cave_automata.rs new file mode 100644 index 0000000000..e46d542e69 --- /dev/null +++ b/src/level_gen/cave_automata.rs @@ -0,0 +1,85 @@ +use crate::level_gen::util::rand_initialize; +use crate::types::Dimensions; +use rand::Rng; + +pub struct Params { + chance_to_start_alive: f64, + dimensions: Dimensions, + birth_limit: i32, + death_limit: i32, + steps: usize, +} + +impl Default for Params { + fn default() -> Self { + Params { + chance_to_start_alive: 0.45, + dimensions: Dimensions { w: 80, h: 20 }, + birth_limit: 4, + death_limit: 3, + steps: 2, + } + } +} + +pub fn generate( + params: &Params, + rand: &mut R, +) -> Vec> { + let mut cells = + rand_initialize(¶ms.dimensions, rand, params.chance_to_start_alive); + for _ in 0..params.steps { + step_automata(&mut cells, params); + } + cells +} + +fn step_automata(cells: &mut Vec>, params: &Params) { + let orig_cells = (*cells).clone(); + for x in 0..(params.dimensions.h as usize) { + for y in 0..(params.dimensions.w as usize) { + let nbs = num_alive_neighbors(&orig_cells, x as i32, y as i32); + if orig_cells[x][y] { + if nbs < params.death_limit { + cells[x][y] = false; + } else { + cells[x][y] = true; + } + } else { + if nbs > params.birth_limit { + cells[x][y] = true; + } else { + cells[x][y] = false; + } + } + } + } +} + +const COUNT_EDGES_AS_NEIGHBORS: bool = true; + +fn num_alive_neighbors(cells: &Vec>, x: i32, y: i32) -> i32 { + let mut count = 0; + for i in -1..2 { + for j in -1..2 { + if i == 0 && j == 0 { + continue; + } + + let neighbor_x = x + i; + let neighbor_y = y + j; + + if COUNT_EDGES_AS_NEIGHBORS + && (neighbor_x < 0 + || neighbor_y < 0 + || neighbor_x >= (cells.len() as i32) + || neighbor_y >= (cells[0].len()) as i32) + { + count += 1; + } else if cells[neighbor_x as usize][neighbor_y as usize] { + count += 1; + } + } + } + count +} diff --git a/src/level_gen/display.rs b/src/level_gen/display.rs new file mode 100644 index 0000000000..4472bf4fe3 --- /dev/null +++ b/src/level_gen/display.rs @@ -0,0 +1,17 @@ +use std::io::{self, Write}; + +pub fn print_generated_level( + level: &Vec>, + out: &mut W, +) -> io::Result<()> +where + W: Write, +{ + for row in level { + for cell in row { + write!(out, "{}", if *cell { "X" } else { " " })?; + } + write!(out, "\n")?; + } + Ok(()) +} diff --git a/src/level_gen/mod.rs b/src/level_gen/mod.rs new file mode 100644 index 0000000000..4df57a408f --- /dev/null +++ b/src/level_gen/mod.rs @@ -0,0 +1,3 @@ +pub mod cave_automata; +pub mod display; +pub mod util; diff --git a/src/level_gen/util.rs b/src/level_gen/util.rs new file mode 100644 index 0000000000..89a4a6a882 --- /dev/null +++ b/src/level_gen/util.rs @@ -0,0 +1,31 @@ +use crate::types::Dimensions; +use rand::{distributions, Rng}; + +pub fn falses(dims: &Dimensions) -> Vec> { + let mut ret = Vec::with_capacity(dims.h as usize); + for _ in 0..dims.h { + let mut row = Vec::with_capacity(dims.w as usize); + for _ in 0..dims.w { + row.push(false); + } + ret.push(row); + } + ret +} + +pub fn rand_initialize( + dims: &Dimensions, + rng: &mut R, + alive_chance: f64, +) -> Vec> { + let distrib = distributions::Bernoulli::new(alive_chance).unwrap(); + let mut ret = Vec::with_capacity(dims.h as usize); + for _ in 0..dims.h { + let mut row = Vec::with_capacity(dims.w as usize); + for _ in 0..dims.w { + row.push(rng.sample(distrib)); + } + ret.push(row); + } + ret +} diff --git a/src/main.rs b/src/main.rs index 69b7304e49..8479b5fa43 100644 --- a/src/main.rs +++ b/src/main.rs @@ -35,12 +35,15 @@ mod types; mod entities; mod display; mod game; +mod level_gen; mod messages; mod settings; use clap::App; use game::Game; use prettytable::format::consts::FORMAT_BOX_CHARS; +use rand::rngs::SmallRng; +use rand::SeedableRng; use settings::Settings; use backtrace::Backtrace; @@ -73,14 +76,12 @@ fn main() { let settings = Settings::load().unwrap(); settings.logging.init_log(); let stdout = io::stdout(); - let stdout = stdout.lock(); + let mut stdout = stdout.lock(); let stdin = io::stdin(); let stdin = stdin.lock(); let termsize = termion::terminal_size().ok(); - // let termwidth = termsize.map(|(w, _)| w - 2).unwrap_or(70); - // let termheight = termsize.map(|(_, h)| h - 2).unwrap_or(40); let (termwidth, termheight) = termsize.unwrap_or((70, 40)); match matches.subcommand() { @@ -94,6 +95,20 @@ fn main() { table.set_format(*FORMAT_BOX_CHARS); table.printstd(); } + ("generate-level", params) => { + let params = params.unwrap(); + let mut rand = SmallRng::from_entropy(); + let level = match params.value_of("generator") { + None => panic!("Must supply a generator with --generator"), + Some("cave_automata") => level_gen::cave_automata::generate( + &Default::default(), + &mut rand, + ), + Some(gen) => panic!("Unrecognized generator: {}", gen), + }; + level_gen::display::print_generated_level(&level, &mut stdout) + .unwrap(); + } _ => { let stdout = stdout.into_raw_mode().unwrap(); init(settings, stdout, stdin, termwidth, termheight); -- cgit 1.4.1 From 68e8ad8a0e6a5ac38b34658f03807ade603a687c Mon Sep 17 00:00:00 2001 From: Griffin Smith Date: Mon, 22 Jul 2019 20:20:18 -0400 Subject: Add more command-line options for generating caves Add all the necessary params to the CLI options for generating caves --- src/cli.yml | 26 ++++++++++++++++++++- src/level_gen/cave_automata.rs | 48 +++++++++++++++++++++++++++++++++------ src/main.rs | 51 ++++++++++++++++++++++++++++-------------- src/types/mod.rs | 6 +++++ 4 files changed, 106 insertions(+), 25 deletions(-) diff --git a/src/cli.yml b/src/cli.yml index 937b44c9c6..4b2e94e57b 100644 --- a/src/cli.yml +++ b/src/cli.yml @@ -10,7 +10,7 @@ args: help: Sets a custom config file takes_value: true subcommands: - - debug: + - info: about: Writes debug information to the terminal and exits - generate-level: about: Generate a level and print it to the screen @@ -20,3 +20,27 @@ subcommands: value_name: GEN help: Select which generator to use takes_value: true + - width: + long: width + short: w + value_name: WIDTH + takes_value: true + - height: + long: height + short: h + value_name: HEIGHT + takes_value: true + - start-alive-chance: + long: start-alive-chance + takes_value: true + - birth_limit: + long: birth-limit + takes_value: true + - death_limit: + long: death-limit + takes_value: true + - steps: + long: steps + short: s + value_name: STEPS + takes_value: true diff --git a/src/level_gen/cave_automata.rs b/src/level_gen/cave_automata.rs index e46d542e69..6a237c0303 100644 --- a/src/level_gen/cave_automata.rs +++ b/src/level_gen/cave_automata.rs @@ -4,17 +4,46 @@ use rand::Rng; pub struct Params { chance_to_start_alive: f64, - dimensions: Dimensions, birth_limit: i32, death_limit: i32, steps: usize, } +macro_rules! parse_optional { + ($out: ident . $attr: ident, $matches: expr, $arg: expr) => { + if let Some(val_s) = $matches.value_of($arg) { + $out.$attr = val_s.parse().unwrap(); + } + }; +} + +macro_rules! parse_optional_matches { + ($matches: expr) => {}; + ($matches: expr , { $ret: ident . $attr: ident = $arg: expr }) => { + parse_optional!($ret.$attr, $matches, $arg); + }; + ($matches: expr, { $($ret: ident . $attr: ident = $arg: expr ,)* }) => { + $(parse_optional!($ret.$attr, $matches, $arg);)* + }; +} + +impl Params { + pub fn from_matches<'a>(matches: &clap::ArgMatches<'a>) -> Self { + let mut ret: Self = Default::default(); + parse_optional_matches!(matches, { + ret.chance_to_start_alive = "start-alive-chance", + ret.birth_limit = "birth-limit", + ret.death_limit = "death-limit", + ret.steps = "steps", + }); + ret + } +} + impl Default for Params { fn default() -> Self { Params { chance_to_start_alive: 0.45, - dimensions: Dimensions { w: 80, h: 20 }, birth_limit: 4, death_limit: 3, steps: 2, @@ -23,21 +52,26 @@ impl Default for Params { } pub fn generate( + dimensions: &Dimensions, params: &Params, rand: &mut R, ) -> Vec> { let mut cells = - rand_initialize(¶ms.dimensions, rand, params.chance_to_start_alive); + rand_initialize(&dimensions, rand, params.chance_to_start_alive); for _ in 0..params.steps { - step_automata(&mut cells, params); + step_automata(&mut cells, dimensions, params); } cells } -fn step_automata(cells: &mut Vec>, params: &Params) { +fn step_automata( + cells: &mut Vec>, + dimensions: &Dimensions, + params: &Params, +) { let orig_cells = (*cells).clone(); - for x in 0..(params.dimensions.h as usize) { - for y in 0..(params.dimensions.w as usize) { + for x in 0..(dimensions.h as usize) { + for y in 0..(dimensions.w as usize) { let nbs = num_alive_neighbors(&orig_cells, x as i32, y as i32); if orig_cells[x][y] { if nbs < params.death_limit { diff --git a/src/main.rs b/src/main.rs index 8479b5fa43..dc958ca1a1 100644 --- a/src/main.rs +++ b/src/main.rs @@ -39,6 +39,7 @@ mod level_gen; mod messages; mod settings; +use crate::types::Dimensions; use clap::App; use game::Game; use prettytable::format::consts::FORMAT_BOX_CHARS; @@ -59,7 +60,7 @@ fn init( stdin: StdinLock<'_>, w: u16, h: u16, -) { +) -> io::Result<()> { panic::set_hook(if settings.logging.print_backtrace { Box::new(|info| (error!("{}\n{:#?}", info, Backtrace::new()))) } else { @@ -67,10 +68,36 @@ fn init( }); let game = Game::new(settings, stdout, stdin, w, h); - game.run().unwrap() + game.run() } -fn main() { +fn generate_level<'a, W: io::Write>( + stdout: &mut W, + params: &clap::ArgMatches<'a>, +) -> io::Result<()> { + let mut rand = SmallRng::from_entropy(); + + let mut dimensions: Dimensions = Default::default(); + if let Some(h_s) = params.value_of("height") { + dimensions.h = h_s.parse().unwrap(); + } + if let Some(w_s) = params.value_of("width") { + dimensions.w = w_s.parse().unwrap(); + } + + let level = match params.value_of("generator") { + None => panic!("Must supply a generator with --generator"), + Some("cave_automata") => level_gen::cave_automata::generate( + &dimensions, + &level_gen::cave_automata::Params::from_matches(params), + &mut rand, + ), + Some(gen) => panic!("Unrecognized generator: {}", gen), + }; + level_gen::display::print_generated_level(&level, stdout) +} + +fn main() -> io::Result<()> { let yaml = load_yaml!("cli.yml"); let matches = App::from_yaml(yaml).get_matches(); let settings = Settings::load().unwrap(); @@ -85,7 +112,7 @@ fn main() { let (termwidth, termheight) = termsize.unwrap_or((70, 40)); match matches.subcommand() { - ("debug", _) => { + ("info", _) => { let mut table = table!( [br->"termwidth", termwidth], [br->"termheight", termheight], @@ -94,24 +121,14 @@ fn main() { ); table.set_format(*FORMAT_BOX_CHARS); table.printstd(); + Ok(()) } ("generate-level", params) => { - let params = params.unwrap(); - let mut rand = SmallRng::from_entropy(); - let level = match params.value_of("generator") { - None => panic!("Must supply a generator with --generator"), - Some("cave_automata") => level_gen::cave_automata::generate( - &Default::default(), - &mut rand, - ), - Some(gen) => panic!("Unrecognized generator: {}", gen), - }; - level_gen::display::print_generated_level(&level, &mut stdout) - .unwrap(); + generate_level(&mut stdout, params.unwrap()) } _ => { let stdout = stdout.into_raw_mode().unwrap(); - init(settings, stdout, stdin, termwidth, termheight); + init(settings, stdout, stdin, termwidth, termheight) } } } diff --git a/src/types/mod.rs b/src/types/mod.rs index 1e86fb369e..e656048e87 100644 --- a/src/types/mod.rs +++ b/src/types/mod.rs @@ -24,6 +24,12 @@ pub struct Dimensions { pub const ZERO_DIMENSIONS: Dimensions = Dimensions { w: 0, h: 0 }; pub const UNIT_DIMENSIONS: Dimensions = Dimensions { w: 1, h: 1 }; +impl Default for Dimensions { + fn default() -> Self { + Dimensions { w: 80, h: 20 } + } +} + impl ops::Sub for Dimensions { type Output = Dimensions; fn sub(self, dims: Dimensions) -> Dimensions { -- cgit 1.4.1 From f22bcad817ee354b355d29b6b289894e2d15cfaa Mon Sep 17 00:00:00 2001 From: Griffin Smith Date: Sat, 27 Jul 2019 22:16:23 -0400 Subject: Add a generic text-prompt system Add a generic text-prompt system to the Game, and use it to prompt the character for their name on startup. There's also a Promise type in util, which is used for the result of the prompt. --- Cargo.lock | 7 ++ Cargo.toml | 3 +- src/display/color.rs | 1 - src/display/viewport.rs | 97 ++++++++++++++++-- src/entities/character.rs | 13 +++ src/game.rs | 251 ++++++++++++++++++++++++++++++++++++++-------- src/level_gen/util.rs | 2 + src/main.rs | 1 + src/messages.toml | 7 +- src/util/mod.rs | 1 + src/util/promise.rs | 159 +++++++++++++++++++++++++++++ 11 files changed, 488 insertions(+), 54 deletions(-) create mode 100644 src/util/promise.rs diff --git a/Cargo.lock b/Cargo.lock index cd08098985..4c8896cca1 100644 --- a/Cargo.lock +++ b/Cargo.lock @@ -310,6 +310,11 @@ name = "fuchsia-cprng" version = "0.1.1" source = "registry+https://github.com/rust-lang/crates.io-index" +[[package]] +name = "futures" +version = "0.1.28" +source = "registry+https://github.com/rust-lang/crates.io-index" + [[package]] name = "getrandom" version = "0.1.6" @@ -1217,6 +1222,7 @@ dependencies = [ "clap 2.33.0 (registry+https://github.com/rust-lang/crates.io-index)", "config 0.9.3 (registry+https://github.com/rust-lang/crates.io-index)", "downcast-rs 1.0.4 (registry+https://github.com/rust-lang/crates.io-index)", + "futures 0.1.28 (registry+https://github.com/rust-lang/crates.io-index)", "include_dir 0.2.1 (registry+https://github.com/rust-lang/crates.io-index)", "itertools 0.8.0 (registry+https://github.com/rust-lang/crates.io-index)", "lazy_static 1.3.0 (registry+https://github.com/rust-lang/crates.io-index)", @@ -1291,6 +1297,7 @@ dependencies = [ "checksum flate2 1.0.7 (registry+https://github.com/rust-lang/crates.io-index)" = "f87e68aa82b2de08a6e037f1385455759df6e445a8df5e005b4297191dbf18aa" "checksum fnv 1.0.6 (registry+https://github.com/rust-lang/crates.io-index)" = "2fad85553e09a6f881f739c29f0b00b0f01357c743266d478b68951ce23285f3" "checksum fuchsia-cprng 0.1.1 (registry+https://github.com/rust-lang/crates.io-index)" = "a06f77d526c1a601b7c4cdd98f54b5eaabffc14d5f2f0296febdc7f357c6d3ba" +"checksum futures 0.1.28 (registry+https://github.com/rust-lang/crates.io-index)" = "45dc39533a6cae6da2b56da48edae506bb767ec07370f86f70fc062e9d435869" "checksum getrandom 0.1.6 (registry+https://github.com/rust-lang/crates.io-index)" = "e65cce4e5084b14874c4e7097f38cab54f47ee554f9194673456ea379dcc4c55" "checksum glob 0.2.11 (registry+https://github.com/rust-lang/crates.io-index)" = "8be18de09a56b60ed0edf84bc9df007e30040691af7acd1c41874faac5895bfb" "checksum humantime 1.2.0 (registry+https://github.com/rust-lang/crates.io-index)" = "3ca7e5f2e110db35f93b837c81797f3714500b81d517bf20c431b16d3ca4f114" diff --git a/Cargo.toml b/Cargo.toml index b290f6b444..f382bc23d7 100644 --- a/Cargo.toml +++ b/Cargo.toml @@ -9,13 +9,14 @@ backtrace = "0.3" clap = {version = "^2.33.0", features = ["yaml"]} config = "*" downcast-rs = "^1.0.4" +futures = "0.1.28" include_dir = "0.2.1" itertools = "*" lazy_static = "*" log = "*" log4rs = "*" -matches = "0.1.8" maplit = "^1.0.1" +matches = "0.1.8" nom = "^5.0.0" prettytable-rs = "^0.8" proptest = "0.9.3" diff --git a/src/display/color.rs b/src/display/color.rs index 7d024a960d..2a023f1d95 100644 --- a/src/display/color.rs +++ b/src/display/color.rs @@ -92,7 +92,6 @@ impl<'de> Visitor<'de> for ColorVisitor { Ok(Color(Box::new(color::LightYellow))) } "magenta" => Ok(Color(Box::new(color::Magenta))), - "magenta" => Ok(Color(Box::new(color::Magenta))), "red" => Ok(Color(Box::new(color::Red))), "white" => Ok(Color(Box::new(color::White))), "yellow" => Ok(Color(Box::new(color::Yellow))), diff --git a/src/display/viewport.rs b/src/display/viewport.rs index b510b0504c..372c0a2969 100644 --- a/src/display/viewport.rs +++ b/src/display/viewport.rs @@ -2,10 +2,21 @@ use super::BoxStyle; use super::Draw; use crate::display::draw_box::draw_box; use crate::display::utils::clone_times; -use crate::types::{pos, BoundingBox, Position, Positioned}; +use crate::types::{pos, BoundingBox, Direction, Position, Positioned}; use std::fmt::{self, Debug}; use std::io::{self, Write}; +pub enum CursorState { + Game, + Prompt(Position), +} + +impl Default for CursorState { + fn default() -> Self { + CursorState::Game + } +} + pub struct Viewport { /// The box describing the visible part of the viewport. /// @@ -24,9 +35,12 @@ pub struct Viewport { /// The actual screen that the viewport writes to pub out: W, + cursor_state: CursorState, + /// Reset the cursor back to this position after every draw - pub cursor_position: Position, + pub game_cursor_position: Position, } + impl Viewport { pub fn new(outer: BoundingBox, inner: BoundingBox, out: W) -> Self { Viewport { @@ -34,7 +48,8 @@ impl Viewport { inner, out, game: outer.move_tr_corner(Position { x: 0, y: 1 }), - cursor_position: pos(0, 0), + cursor_state: Default::default(), + game_cursor_position: pos(0, 0), } } @@ -72,7 +87,7 @@ impl Viewport { } fn reset_cursor(&mut self) -> io::Result<()> { - self.cursor_goto(self.cursor_position) + self.cursor_goto(self.game_cursor_position) } /// Move the cursor to the given inner-relative position @@ -97,23 +112,85 @@ impl Viewport { /// Will overwrite any message already present, and if the given message is /// longer than the screen will truncate. This means callers should handle /// message buffering and ellipsisization - pub fn write_message(&mut self, msg: &str) -> io::Result<()> { + pub fn write_message(&mut self, msg: &str) -> io::Result { + let msg_to_write = if msg.len() <= self.outer.dimensions.w as usize { + msg + } else { + &msg[0..self.outer.dimensions.w as usize] + }; write!( self, "{}{}{}", self.outer.position.cursor_goto(), - if msg.len() <= self.outer.dimensions.w as usize { - msg - } else { - &msg[0..self.outer.dimensions.w as usize] - }, + msg_to_write, clone_times::<_, String>( " ".to_string(), self.outer.dimensions.w - msg.len() as u16 ), )?; + self.reset_cursor()?; + Ok(msg_to_write.len()) + } + + pub fn clear_message(&mut self) -> io::Result<()> { + write!( + self, + "{}{}", + self.outer.position.cursor_goto(), + clone_times::<_, String>( + " ".to_string(), + self.outer.dimensions.w as u16 + ) + )?; self.reset_cursor() } + + /// Write a prompt requesting text input to the message area on the screen. + /// + /// Will overwrite any message already present, and if the given message is + /// longer than the screen will truncate. This means callers should handle + /// message buffering and ellipsisization + pub fn write_prompt<'a, 'b>(&'a mut self, msg: &'b str) -> io::Result<()> { + let len = self.write_message(msg)? + 1; + let pos = self.outer.position + pos(len as i16, 0); + self.cursor_state = CursorState::Prompt(pos); + write!(self, "{}", pos.cursor_goto())?; + self.flush() + } + + pub fn push_prompt_chr(&mut self, chr: char) -> io::Result<()> { + match self.cursor_state { + CursorState::Prompt(pos) => { + write!(self, "{}", chr)?; + self.cursor_state = CursorState::Prompt(pos + Direction::Right); + } + _ => {} + } + Ok(()) + } + + pub fn pop_prompt_chr(&mut self) -> io::Result<()> { + match self.cursor_state { + CursorState::Prompt(pos) => { + let new_pos = pos + Direction::Left; + write!( + self, + "{} {}", + new_pos.cursor_goto(), + new_pos.cursor_goto() + )?; + self.cursor_state = CursorState::Prompt(new_pos); + } + _ => {} + } + Ok(()) + } + + pub fn clear_prompt(&mut self) -> io::Result<()> { + self.clear_message()?; + self.cursor_state = CursorState::Game; + Ok(()) + } } impl Positioned for Viewport { diff --git a/src/entities/character.rs b/src/entities/character.rs index 7bcb8b5c87..b917f140e6 100644 --- a/src/entities/character.rs +++ b/src/entities/character.rs @@ -13,6 +13,8 @@ pub struct Character { /// The position of the character, relative to the game pub position: Position, + + pub o_name: Option, } impl Character { @@ -20,6 +22,7 @@ impl Character { Character { id: None, position: Position { x: 0, y: 0 }, + o_name: None, } } @@ -31,6 +34,16 @@ impl Character { // TODO 1 } + + pub fn name<'a>(&'a self) -> &'a str { + self.o_name + .as_ref() + .expect("Character name not initialized") + } + + pub fn set_name(&mut self, name: String) { + self.o_name = Some(name); + } } entity!(Character); diff --git a/src/game.rs b/src/game.rs index c4fc6d2be1..49068361b5 100644 --- a/src/game.rs +++ b/src/game.rs @@ -10,6 +10,8 @@ use crate::types::{ pos, BoundingBox, Collision, Dimensions, Position, Positioned, PositionedMut, Ticks, }; +use crate::util::promise::Cancelled; +use crate::util::promise::{promise, Complete, Promise, Promises}; use crate::util::template::TemplateParams; use rand::rngs::SmallRng; use rand::SeedableRng; @@ -36,6 +38,75 @@ impl<'a> PositionedMut for AnEntity<'a> { } } +enum PromptResolution { + Uncancellable(Complete), + Cancellable(Complete>), +} + +impl PromptResolution { + fn is_cancellable(&self) -> bool { + use PromptResolution::*; + match self { + Uncancellable(_) => false, + Cancellable(_) => true, + } + } + + fn fulfill(&mut self, val: String) { + use PromptResolution::*; + match self { + Cancellable(complete) => complete.ok(val), + Uncancellable(complete) => complete.fulfill(val), + } + } + + fn cancel(&mut self) { + use PromptResolution::*; + match self { + Cancellable(complete) => complete.cancel(), + Uncancellable(complete) => {} + } + } +} + +/// The kind of input the game is waiting to receive +enum InputState { + /// The initial input state of the game - we're currently waiting for direct + /// commands. + Initial, + + /// A free text prompt has been shown to the user, and every character + /// besides "escape" is interpreted as a response to that prompt + Prompt { + complete: PromptResolution, + buffer: String, + }, +} + +impl InputState { + fn uncancellable_prompt(complete: Complete) -> Self { + InputState::Prompt { + complete: PromptResolution::Uncancellable(complete), + buffer: String::new(), + } + } + + fn cancellable_prompt( + complete: Complete>, + ) -> Self { + InputState::Prompt { + complete: PromptResolution::Cancellable(complete), + buffer: String::new(), + } + } +} + +impl Default for InputState { + fn default() -> Self { + InputState::Initial + } +} + /// The full state of a running Game pub struct Game<'a> { settings: Settings, @@ -45,6 +116,9 @@ pub struct Game<'a> { /// An iterator on keypresses from the user keys: Keys>, + /// The kind of input the game is waiting to receive + input_state: InputState, + /// The map of all the entities in the game entities: EntityMap>, @@ -60,6 +134,9 @@ pub struct Game<'a> { /// A global random number generator for the game rng: Rng, + + /// A list of promises that are waiting on the game and a result + promises: Promises<'a, Self>, } impl<'a> Game<'a> { @@ -97,9 +174,11 @@ impl<'a> Game<'a> { stdout, ), keys: stdin.keys(), + input_state: Default::default(), character_entity_id: entities.insert(Box::new(Character::new())), messages: Vec::new(), entities, + promises: Promises::new(), } } @@ -131,6 +210,12 @@ impl<'a> Game<'a> { .unwrap() } + fn mut_character(&mut self) -> &mut Character { + (*self.entities.get_mut(self.character_entity_id).unwrap()) + .downcast_mut() + .unwrap() + } + /// Draw all the game entities to the screen fn draw_entities(&mut self) -> io::Result<()> { for entity in self.entities.entities() { @@ -168,7 +253,36 @@ impl<'a> Game<'a> { let message = self.message(message_name, params); self.messages.push(message.to_string()); self.message_idx = self.messages.len() - 1; - self.viewport.write_message(&message) + self.viewport.write_message(&message)?; + Ok(()) + } + + /// Prompt the user for input, returning a Future for the result of the + /// prompt + fn prompt( + &mut self, + name: &'static str, + params: &TemplateParams<'_>, + ) -> io::Result> { + let (complete, promise) = promise(); + self.input_state = InputState::uncancellable_prompt(complete); + let message = self.message(name, params); + self.viewport.write_prompt(&message)?; + self.promises.push(Box::new(promise.clone())); + Ok(promise) + } + + fn prompt_cancellable( + &mut self, + name: &'static str, + params: &TemplateParams<'_>, + ) -> io::Result>> { + let (complete, promise) = promise(); + self.input_state = InputState::cancellable_prompt(complete); + let message = self.message(name, params); + self.viewport.write_prompt(&message)?; + self.promises.push(Box::new(promise.clone())); + Ok(promise) } fn previous_message(&mut self) -> io::Result<()> { @@ -177,7 +291,8 @@ impl<'a> Game<'a> { } self.message_idx -= 1; let message = &self.messages[self.message_idx]; - self.viewport.write_message(message) + self.viewport.write_message(message)?; + Ok(()) } fn creature(&self, creature_id: EntityID) -> Option<&Creature> { @@ -236,60 +351,116 @@ impl<'a> Game<'a> { } } + fn flush_promises(&mut self) { + unsafe { + let game = self as *mut Self; + (*game).promises.give_all(&mut *game); + } + } + /// Run the game pub fn run(mut self) -> io::Result<()> { info!("Running game"); self.viewport.init()?; self.draw_entities()?; - self.say("global.welcome", &template_params!())?; - self.flush()?; + self.flush().unwrap(); + + self.prompt("character.name_prompt", &template_params!())? + .on_fulfill(|game, char_name| { + game.say( + "global.welcome", + &template_params!({ + "character" => { + "name" => char_name, + }, + }), + ) + .unwrap(); + game.flush().unwrap(); + game.mut_character().set_name(char_name.to_string()); + }); + loop { let mut old_position = None; - use Command::*; - match Command::from_key(self.keys.next().unwrap().unwrap()) { - Some(Quit) => { - info!("Quitting game due to user request"); - break; - } + let next_key = self.keys.next().unwrap().unwrap(); + match &mut self.input_state { + InputState::Initial => { + use Command::*; + match Command::from_key(next_key) { + Some(Quit) => { + info!("Quitting game due to user request"); + break; + } - Some(Move(direction)) => { - use Collision::*; - let new_pos = self.character().position + direction; - match self.collision_at(new_pos) { - None => { - old_position = Some(self.character().position); - self.entities.update_position( - self.character_entity_id, - new_pos, - ); + Some(Move(direction)) => { + use Collision::*; + let new_pos = self.character().position + direction; + match self.collision_at(new_pos) { + None => { + old_position = + Some(self.character().position); + self.entities.update_position( + self.character_entity_id, + new_pos, + ); + } + Some(Combat) => { + self.attack_at(new_pos)?; + } + Some(Stop) => (), + } } - Some(Combat) => { - self.attack_at(new_pos)?; + + Some(PreviousMessage) => self.previous_message()?, + + None => (), + } + + match old_position { + Some(old_pos) => { + self.tick( + self.character().speed().tiles_to_ticks( + (old_pos - self.character().position) + .as_tiles(), + ), + ); + self.viewport.clear(old_pos)?; + self.viewport.game_cursor_position = + self.character().position; + self.viewport.draw( + // TODO this clone feels unnecessary. + &self.character().clone(), + )?; } - Some(Stop) => (), + None => (), } } - Some(PreviousMessage) => self.previous_message()?, - - None => (), - } - - match old_position { - Some(old_pos) => { - self.tick(self.character().speed().tiles_to_ticks( - (old_pos - self.character().position).as_tiles(), - )); - self.viewport.clear(old_pos)?; - self.viewport.cursor_position = self.character().position; - self.viewport.draw( - // TODO this clone feels unnecessary. - &self.character().clone(), - )?; + InputState::Prompt { complete, buffer } => { + use termion::event::Key::*; + match next_key { + Char('\n') => { + info!("Prompt complete: \"{}\"", buffer); + self.viewport.clear_prompt()?; + complete.fulfill(buffer.clone()); + self.input_state = InputState::Initial; + } + Char(chr) => { + buffer.push(chr); + self.viewport.push_prompt_chr(chr)?; + } + Esc => complete.cancel(), + Backspace => { + buffer.pop(); + self.viewport.pop_prompt_chr()?; + } + _ => {} + } } - None => (), } + self.flush()?; + self.flush_promises(); debug!("{:?}", self.character()); } Ok(()) diff --git a/src/level_gen/util.rs b/src/level_gen/util.rs index 89a4a6a882..629292c430 100644 --- a/src/level_gen/util.rs +++ b/src/level_gen/util.rs @@ -13,6 +13,8 @@ pub fn falses(dims: &Dimensions) -> Vec> { ret } +/// Randomly initialize a 2-dimensional boolean vector of the given +/// `Dimensions`, using the given random number generator and alive chance pub fn rand_initialize( dims: &Dimensions, rng: &mut R, diff --git a/src/main.rs b/src/main.rs index dc958ca1a1..2f0d1c3ffb 100644 --- a/src/main.rs +++ b/src/main.rs @@ -26,6 +26,7 @@ extern crate include_dir; extern crate nom; #[macro_use] extern crate matches; +extern crate futures; #[macro_use] mod util; diff --git a/src/messages.toml b/src/messages.toml index e7d097a76f..c4a86befff 100644 --- a/src/messages.toml +++ b/src/messages.toml @@ -1,5 +1,5 @@ [global] -welcome = "Welcome to Xanthous! It's dangerous out there, why not stay inside?" +welcome = "Welcome to Xanthous, {{character.name}}! It's dangerous out there, why not stay inside?" [combat] attack = "You attack the {{creature.name}}." @@ -10,5 +10,8 @@ killed = [ "The {{creature.name}} beefs it." ] +[character] +name_prompt = "What's your name?" + [defaults.item] -eat = "You eat the {{item.name}}" +eat = "You eat the {{item.name}}. {{action.result}}" diff --git a/src/util/mod.rs b/src/util/mod.rs index c2b4eecaf5..c55fdfeae2 100644 --- a/src/util/mod.rs +++ b/src/util/mod.rs @@ -2,3 +2,4 @@ pub mod static_cfg; #[macro_use] pub mod template; +pub mod promise; diff --git a/src/util/promise.rs b/src/util/promise.rs new file mode 100644 index 0000000000..41f3d76e77 --- /dev/null +++ b/src/util/promise.rs @@ -0,0 +1,159 @@ +use std::future::Future; +use std::pin::Pin; +use std::sync::{Arc, RwLock}; +use std::task::{Context, Poll, Waker}; + +pub struct Promise { + inner: Arc>>, + waiters: Arc>>>, +} + +pub struct Complete { + inner: Arc>>, +} + +#[derive(Debug, Clone, Copy, PartialEq, Eq)] +pub struct Cancelled; + +struct Inner { + value: Option>, + waker: Option, +} + +pub fn promise() -> (Complete, Promise) { + let inner = Arc::new(RwLock::new(Inner { + value: None, + waker: None, + })); + let promise = Promise { + inner: inner.clone(), + waiters: Arc::new(RwLock::new(Vec::new())), + }; + let complete = Complete { inner: inner }; + (complete, promise) +} + +impl Complete { + pub fn fulfill(&self, val: T) { + let mut inner = self.inner.write().unwrap(); + inner.value = Some(Arc::new(val)); + if let Some(waker) = inner.waker.take() { + waker.wake() + } + } +} + +impl Complete> { + pub fn cancel(&mut self) { + self.fulfill(Err(Cancelled)) + } +} + +impl Complete> { + pub fn ok(&mut self, val: T) { + self.fulfill(Ok(val)) + } + + pub fn err(&mut self, e: E) { + self.fulfill(Err(e)) + } +} + +impl Promise { + pub fn on_fulfill(&mut self, f: F) { + let mut waiters = self.waiters.write().unwrap(); + waiters.push(Box::new(f)); + } +} + +impl Promise> { + pub fn on_cancel(&mut self, f: F) { + self.on_err(move |env, _| f(env)) + } +} + +impl Promise> { + pub fn on_ok(&mut self, f: F) { + self.on_fulfill(move |env, r| { + if let Ok(val) = r { + f(env, val) + } + }) + } + + pub fn on_err(&mut self, f: F) { + self.on_fulfill(move |env, r| { + if let Err(e) = r { + f(env, e) + } + }) + } +} + +pub trait Give { + fn give(&self, env: &mut Env) -> bool; +} + +impl Give for Promise { + fn give(&self, env: &mut Env) -> bool { + let inner = self.inner.read().unwrap(); + if let Some(value) = &inner.value { + let mut waiters = self.waiters.write().unwrap(); + for waiter in waiters.iter() { + waiter(env, value); + } + waiters.clear(); + true + } else { + false + } + } +} + +impl Clone for Promise { + fn clone(&self) -> Self { + Promise { + inner: self.inner.clone(), + waiters: self.waiters.clone(), + } + } +} + +impl> Give for &P { + fn give(&self, env: &mut Env) -> bool { + (*self).give(env) + } +} + +impl Future for Promise { + type Output = Arc; + fn poll(self: Pin<&mut Self>, cx: &mut Context) -> Poll { + let mut inner = self.inner.write().unwrap(); + match inner.value { + Some(ref v) => Poll::Ready(v.clone()), + None => { + inner.waker = Some(cx.waker().clone()); + Poll::Pending + } + } + } +} + +pub struct Promises<'a, Env> { + ps: Vec + 'a>>, +} + +impl<'a, Env> Promises<'a, Env> { + pub fn new() -> Self { + Promises { ps: Vec::new() } + } + + pub fn push(&mut self, p: Box + 'a>) { + self.ps.push(p); + } + + pub fn give_all(&mut self, env: &mut Env) { + debug!("promises: {}", self.ps.len()); + self.ps.retain(|p| !p.give(env)); + } +} -- cgit 1.4.1 From 6c1eba67629504f10fa08ee68fb31f507c99b0d1 Mon Sep 17 00:00:00 2001 From: Griffin Smith Date: Sun, 28 Jul 2019 17:45:43 -0400 Subject: Allow converting generated levels to entities Add a new Wall entity, and allow converting generated levels to entity maps containing them, then finally displaying them using some of the (now expanded) box drawing machinery. --- Cargo.lock | 38 +++++++++++++ Cargo.toml | 1 + src/display/draw_box.rs | 50 +++++++++++++++-- src/display/mod.rs | 20 +++++++ src/display/viewport.rs | 12 +++- src/entities/entity.rs | 29 ++++------ src/entities/environment.rs | 34 ++++++++++++ src/entities/mod.rs | 3 + src/entities/util.rs | 72 ++++++++++++++++++++++++ src/game.rs | 40 +++++++++----- src/level_gen/cave_automata.rs | 4 ++ src/level_gen/display.rs | 17 ------ src/level_gen/mod.rs | 100 ++++++++++++++++++++++++++++++++- src/level_gen/util.rs | 19 +++++++ src/main.rs | 2 +- src/types/entity_map.rs | 123 ++++++++++++++++++++++++++++++++++++++++- src/types/mod.rs | 55 +++++++++++++++++- 17 files changed, 557 insertions(+), 62 deletions(-) create mode 100644 src/entities/environment.rs create mode 100644 src/entities/util.rs delete mode 100644 src/level_gen/display.rs diff --git a/Cargo.lock b/Cargo.lock index 4c8896cca1..214b78f625 100644 --- a/Cargo.lock +++ b/Cargo.lock @@ -13,6 +13,17 @@ dependencies = [ "memchr 2.2.0 (registry+https://github.com/rust-lang/crates.io-index)", ] +[[package]] +name = "alga" +version = "0.9.1" +source = "registry+https://github.com/rust-lang/crates.io-index" +dependencies = [ + "approx 0.3.2 (registry+https://github.com/rust-lang/crates.io-index)", + "libm 0.1.4 (registry+https://github.com/rust-lang/crates.io-index)", + "num-complex 0.2.3 (registry+https://github.com/rust-lang/crates.io-index)", + "num-traits 0.2.8 (registry+https://github.com/rust-lang/crates.io-index)", +] + [[package]] name = "ansi_term" version = "0.11.0" @@ -26,6 +37,14 @@ name = "antidote" version = "1.0.0" source = "registry+https://github.com/rust-lang/crates.io-index" +[[package]] +name = "approx" +version = "0.3.2" +source = "registry+https://github.com/rust-lang/crates.io-index" +dependencies = [ + "num-traits 0.2.8 (registry+https://github.com/rust-lang/crates.io-index)", +] + [[package]] name = "arc-swap" version = "0.3.11" @@ -402,6 +421,11 @@ name = "libc" version = "0.2.58" source = "registry+https://github.com/rust-lang/crates.io-index" +[[package]] +name = "libm" +version = "0.1.4" +source = "registry+https://github.com/rust-lang/crates.io-index" + [[package]] name = "linked-hash-map" version = "0.3.0" @@ -524,6 +548,15 @@ dependencies = [ "version_check 0.1.5 (registry+https://github.com/rust-lang/crates.io-index)", ] +[[package]] +name = "num-complex" +version = "0.2.3" +source = "registry+https://github.com/rust-lang/crates.io-index" +dependencies = [ + "autocfg 0.1.4 (registry+https://github.com/rust-lang/crates.io-index)", + "num-traits 0.2.8 (registry+https://github.com/rust-lang/crates.io-index)", +] + [[package]] name = "num-integer" version = "0.1.41" @@ -1218,6 +1251,7 @@ source = "registry+https://github.com/rust-lang/crates.io-index" name = "xanthous" version = "0.1.0" dependencies = [ + "alga 0.9.1 (registry+https://github.com/rust-lang/crates.io-index)", "backtrace 0.3.32 (registry+https://github.com/rust-lang/crates.io-index)", "clap 2.33.0 (registry+https://github.com/rust-lang/crates.io-index)", "config 0.9.3 (registry+https://github.com/rust-lang/crates.io-index)", @@ -1259,8 +1293,10 @@ dependencies = [ [metadata] "checksum adler32 1.0.3 (registry+https://github.com/rust-lang/crates.io-index)" = "7e522997b529f05601e05166c07ed17789691f562762c7f3b987263d2dedee5c" "checksum aho-corasick 0.7.3 (registry+https://github.com/rust-lang/crates.io-index)" = "e6f484ae0c99fec2e858eb6134949117399f222608d84cadb3f58c1f97c2364c" +"checksum alga 0.9.1 (registry+https://github.com/rust-lang/crates.io-index)" = "d708cb68c7106ed1844de68f50f0157a7788c2909a6926fad5a87546ef6a4ff8" "checksum ansi_term 0.11.0 (registry+https://github.com/rust-lang/crates.io-index)" = "ee49baf6cb617b853aa8d93bf420db2383fab46d314482ca2803b40d5fde979b" "checksum antidote 1.0.0 (registry+https://github.com/rust-lang/crates.io-index)" = "34fde25430d87a9388dadbe6e34d7f72a462c8b43ac8d309b42b0a8505d7e2a5" +"checksum approx 0.3.2 (registry+https://github.com/rust-lang/crates.io-index)" = "f0e60b75072ecd4168020818c0107f2857bb6c4e64252d8d3983f6263b40a5c3" "checksum arc-swap 0.3.11 (registry+https://github.com/rust-lang/crates.io-index)" = "bc4662175ead9cd84451d5c35070517777949a2ed84551764129cedb88384841" "checksum argon2rs 0.2.5 (registry+https://github.com/rust-lang/crates.io-index)" = "3f67b0b6a86dae6e67ff4ca2b6201396074996379fba2b92ff649126f37cb392" "checksum arrayvec 0.4.10 (registry+https://github.com/rust-lang/crates.io-index)" = "92c7fb76bc8826a8b33b4ee5bb07a247a81e76764ab4d55e8f73e3a4d8808c71" @@ -1309,6 +1345,7 @@ dependencies = [ "checksum lazy_static 1.3.0 (registry+https://github.com/rust-lang/crates.io-index)" = "bc5729f27f159ddd61f4df6228e827e86643d4d3e7c32183cb30a1c08f604a14" "checksum lexical-core 0.4.2 (registry+https://github.com/rust-lang/crates.io-index)" = "3f8673fab7063c2cac37d299c8a1a7beb720e78f71500098e4a3c137fdf025bf" "checksum libc 0.2.58 (registry+https://github.com/rust-lang/crates.io-index)" = "6281b86796ba5e4366000be6e9e18bf35580adf9e63fbe2294aadb587613a319" +"checksum libm 0.1.4 (registry+https://github.com/rust-lang/crates.io-index)" = "7fc7aa29613bd6a620df431842069224d8bc9011086b1db4c0e0cd47fa03ec9a" "checksum linked-hash-map 0.3.0 (registry+https://github.com/rust-lang/crates.io-index)" = "6d262045c5b87c0861b3f004610afd0e2c851e2908d08b6c870cbb9d5f494ecd" "checksum linked-hash-map 0.5.2 (registry+https://github.com/rust-lang/crates.io-index)" = "ae91b68aebc4ddb91978b11a1b02ddd8602a05ec19002801c5666000e05e0f83" "checksum log 0.4.6 (registry+https://github.com/rust-lang/crates.io-index)" = "c84ec4b527950aa83a329754b01dbe3f58361d1c5efacd1f6d68c494d08a17c6" @@ -1323,6 +1360,7 @@ dependencies = [ "checksum nodrop 0.1.13 (registry+https://github.com/rust-lang/crates.io-index)" = "2f9667ddcc6cc8a43afc9b7917599d7216aa09c463919ea32c59ed6cac8bc945" "checksum nom 4.2.3 (registry+https://github.com/rust-lang/crates.io-index)" = "2ad2a91a8e869eeb30b9cb3119ae87773a8f4ae617f41b1eb9c154b2905f7bd6" "checksum nom 5.0.0 (registry+https://github.com/rust-lang/crates.io-index)" = "e9761d859320e381010a4f7f8ed425f2c924de33ad121ace447367c713ad561b" +"checksum num-complex 0.2.3 (registry+https://github.com/rust-lang/crates.io-index)" = "fcb0cf31fb3ff77e6d2a6ebd6800df7fdcd106f2ad89113c9130bcd07f93dffc" "checksum num-integer 0.1.41 (registry+https://github.com/rust-lang/crates.io-index)" = "b85e541ef8255f6cf42bbfe4ef361305c6c135d10919ecc26126c4e5ae94bc09" "checksum num-traits 0.1.43 (registry+https://github.com/rust-lang/crates.io-index)" = "92e5113e9fd4cc14ded8e499429f396a20f98c772a47cc8622a736e1ec843c31" "checksum num-traits 0.2.8 (registry+https://github.com/rust-lang/crates.io-index)" = "6ba9a427cfca2be13aa6f6403b0b7e7368fe982bfa16fccc450ce74c46cd9b32" diff --git a/Cargo.toml b/Cargo.toml index f382bc23d7..1ac8853f47 100644 --- a/Cargo.toml +++ b/Cargo.toml @@ -5,6 +5,7 @@ authors = ["Griffin Smith "] edition = "2018" [dependencies] +alga = "0.9.1" backtrace = "0.3" clap = {version = "^2.33.0", features = ["yaml"]} config = "*" diff --git a/src/display/draw_box.rs b/src/display/draw_box.rs index 5dc1627a29..3b2b4aaf4f 100644 --- a/src/display/draw_box.rs +++ b/src/display/draw_box.rs @@ -2,6 +2,7 @@ use crate::display::utils::clone_times; use crate::display::utils::times; use crate::types::BoundingBox; use crate::types::Dimensions; +use crate::types::Neighbors; use itertools::Itertools; use proptest::prelude::Arbitrary; use proptest::strategy; @@ -22,42 +23,50 @@ use std::io::{self, Write}; static BOX: char = '☐'; static BOX_CHARS: [[char; 16]; 8] = [ + // 0 [ // 0 1 2 3 4 5 6 7 8 9 '─', '━', '│', '┃', '┄', '┅', '┆', '┇', '┈', '┉', // 10 '┊', '┋', '┌', '┍', '┎', '┏', ], + // 1 [ // 0 1 2 3 4 5 6 7 8 9 '┐', '┑', '┒', '┓', '└', '┕', '┖', '┗', '┘', '┙', '┚', '┛', '├', '┝', '┞', '┟', ], + // 2 [ // 0 1 2 3 4 5 6 7 8 9 '┠', '┡', '┢', '┣', '┤', '┥', '┦', '┧', '┨', '┩', '┪', '┫', '┬', '┭', '┮', '┯', ], + // 3 [ // 0 1 2 3 4 5 6 7 8 9 '┰', '┱', '┲', '┳', '┴', '┵', '┶', '┷', '┸', '┹', '┺', '┻', '┼', '┽', '┾', '┿', ], + // 4 [ // 0 1 2 3 4 5 6 7 8 9 '╀', '╁', '╂', '╃', '╄', '╅', '╆', '╇', '╈', '╉', '╊', '╋', '╌', '╍', '╎', '╏', ], + // 5 [ // 0 1 2 3 4 5 6 7 8 9 '═', '║', '╒', '╓', '╔', '╕', '╖', '╗', '╘', '╙', '╚', '╛', '╜', '╝', '╞', '╟', ], + // 6 [ // 0 1 2 3 4 5 6 7 8 9 '╠', '╡', '╢', '╣', '╤', '╥', '╦', '╧', '╨', '╩', '╪', '╫', '╬', '╭', '╮', '╯', ], + // 7 [ // 0 1 2 3 4 5 6 7 8 9 '╰', '╱', '╲', '╳', '╴', '╵', '╶', '╷', '╸', '╹', @@ -85,8 +94,8 @@ impl Arbitrary for BoxStyle { } } -trait Stylable { - fn style(self, style: BoxStyle) -> char; +pub trait Stylable { + fn style(&self, style: BoxStyle) -> char; } #[derive(Clone, Copy, Debug, PartialEq, Eq, Arbitrary)] @@ -98,7 +107,7 @@ enum Corner { } impl Stylable for Corner { - fn style(self, style: BoxStyle) -> char { + fn style(&self, style: BoxStyle) -> char { use BoxStyle::*; use Corner::*; @@ -119,7 +128,7 @@ enum Line { } impl Stylable for Line { - fn style(self, style: BoxStyle) -> char { + fn style(&self, style: BoxStyle) -> char { use BoxStyle::*; use Line::*; match (self, style) { @@ -130,6 +139,39 @@ impl Stylable for Line { } } +impl Stylable for Neighbors> { + fn style(&self, style: BoxStyle) -> char { + use BoxStyle::*; + match (self.left, self.right, self.top, self.bottom) { + (None, None, None, None) => BOX, + (Some(Thin), None, None, None) => BOX_CHARS[7][4], + (None, Some(Thin), None, None) => BOX_CHARS[7][6], + (None, None, Some(Thin), None) => BOX_CHARS[7][5], + (None, None, None, Some(Thin)) => BOX_CHARS[7][7], + (Some(Thin), Some(Thin), None, None) => Line::H.style(Thin), + (Some(Thin), None, Some(Thin), None) => { + Corner::BottomRight.style(Thin) + } + (Some(Thin), None, None, Some(Thin)) => { + Corner::TopRight.style(Thin) + } + (None, Some(Thin), Some(Thin), None) => { + Corner::BottomLeft.style(Thin) + } + (None, Some(Thin), None, Some(Thin)) => Corner::TopLeft.style(Thin), + (None, None, Some(Thin), Some(Thin)) => Line::V.style(Thin), + (None, Some(Thin), Some(Thin), Some(Thin)) => BOX_CHARS[1][12], + (Some(Thin), None, Some(Thin), Some(Thin)) => BOX_CHARS[2][4], + (Some(Thin), Some(Thin), None, Some(Thin)) => BOX_CHARS[2][12], + (Some(Thin), Some(Thin), Some(Thin), None) => BOX_CHARS[3][4], + (Some(Thin), Some(Thin), Some(Thin), Some(Thin)) => { + BOX_CHARS[3][12] + } + neighs => panic!("unimplemented: {:?}", neighs), + } + } +} + #[must_use] pub fn make_box(style: BoxStyle, dims: Dimensions) -> String { if dims.h == 0 || dims.w == 0 { diff --git a/src/display/mod.rs b/src/display/mod.rs index 3e30200ac7..10690284f1 100644 --- a/src/display/mod.rs +++ b/src/display/mod.rs @@ -2,6 +2,8 @@ pub mod color; pub mod draw_box; pub mod utils; pub mod viewport; +use crate::entities::entity::Entity; +use crate::types::Neighbors; use crate::types::Positioned; pub use draw_box::{make_box, BoxStyle}; use std::io::{self, Write}; @@ -29,3 +31,21 @@ impl Draw for Box { (**self).do_draw(out) } } + +pub trait DrawWithNeighbors: Positioned { + fn do_draw_with_neighbors<'a, 'b>( + &'a self, + out: &'b mut Write, + neighbors: &'a Neighbors>>, + ) -> io::Result<()>; +} + +impl DrawWithNeighbors for T { + fn do_draw_with_neighbors<'a, 'b>( + &'a self, + out: &'b mut Write, + _neighbors: &'a Neighbors>>, + ) -> io::Result<()> { + self.do_draw(out) + } +} diff --git a/src/display/viewport.rs b/src/display/viewport.rs index 372c0a2969..9ff7db07be 100644 --- a/src/display/viewport.rs +++ b/src/display/viewport.rs @@ -1,7 +1,9 @@ use super::BoxStyle; -use super::Draw; +use super::DrawWithNeighbors; use crate::display::draw_box::draw_box; use crate::display::utils::clone_times; +use crate::entities::entity::Entity; +use crate::types::Neighbors; use crate::types::{pos, BoundingBox, Direction, Position, Positioned}; use std::fmt::{self, Debug}; use std::io::{self, Write}; @@ -77,12 +79,16 @@ impl Debug for Viewport { impl Viewport { /// Draw the given entity to the viewport at its position, if visible - pub fn draw(&mut self, entity: &T) -> io::Result<()> { + pub fn draw<'a, T: DrawWithNeighbors>( + &mut self, + entity: &T, + neighbors: &Neighbors>>, + ) -> io::Result<()> { if !self.visible(entity) { return Ok(()); } self.cursor_goto(entity.position())?; - entity.do_draw(self)?; + entity.do_draw_with_neighbors(self, neighbors)?; self.reset_cursor() } diff --git a/src/entities/entity.rs b/src/entities/entity.rs index 30f7ea9a3d..7fedb77b25 100644 --- a/src/entities/entity.rs +++ b/src/entities/entity.rs @@ -1,5 +1,6 @@ -use crate::display::Draw; +use crate::display::DrawWithNeighbors; use crate::entities::EntityID; +use crate::types::Neighbors; use crate::types::{Positioned, PositionedMut}; use downcast_rs::Downcast; use std::fmt::Debug; @@ -37,7 +38,7 @@ impl> Identified for Box { } pub trait Entity: - Positioned + PositionedMut + Identified + Draw + Downcast + Positioned + PositionedMut + Identified + DrawWithNeighbors + Downcast { } @@ -52,10 +53,10 @@ impl Identified for Box { #[macro_export] macro_rules! identified { - ($name: ident, $typ: ident) => { + ($name: ident, $typ: path) => { identified!($name, $typ, id); }; - ($name: ident, $typ: ident, $attr: ident) => { + ($name: ident, $typ: path, $attr: ident) => { impl crate::entities::entity::Identified<$typ> for $name { fn opt_id(&self) -> Option<$typ> { self.$attr @@ -68,20 +69,14 @@ macro_rules! identified { }; } -#[macro_export] -macro_rules! entity { - ($name: ident) => { - positioned!($name); - positioned_mut!($name); - identified!($name, EntityID); - impl crate::entities::entity::Entity for $name {} - }; -} - impl_downcast!(Entity); -impl Draw for Box { - fn do_draw(&self, out: &mut Write) -> io::Result<()> { - (**self).do_draw(out) +impl DrawWithNeighbors for Box { + fn do_draw_with_neighbors<'a, 'b>( + &'a self, + out: &'b mut Write, + neighbors: &'a Neighbors>>, + ) -> io::Result<()> { + (**self).do_draw_with_neighbors(out, neighbors) } } diff --git a/src/entities/environment.rs b/src/entities/environment.rs new file mode 100644 index 0000000000..64366a5054 --- /dev/null +++ b/src/entities/environment.rs @@ -0,0 +1,34 @@ +use crate::display; +use crate::display::draw_box::{BoxStyle, Stylable}; +use crate::entities::Entity; +use crate::types::{Neighbors, Position}; +use std::io::{self, Write}; + +entity! { + pub struct Wall { + pub style: BoxStyle + } +} + +impl Wall { + pub fn new(position: Position, style: BoxStyle) -> Self { + new_entity!(Wall { position, style }) + } +} + +impl display::DrawWithNeighbors for Wall { + fn do_draw_with_neighbors<'a, 'b>( + &'a self, + out: &'b mut Write, + neighbors: &'a Neighbors>>, + ) -> io::Result<()> { + let neighbor_styles: Neighbors> = + neighbors.map(|es| { + es.iter() + .filter_map(|e| e.downcast_ref::()) + .map(|wall| wall.style) + .next() + }); + write!(out, "{}", neighbor_styles.style(self.style)) + } +} diff --git a/src/entities/mod.rs b/src/entities/mod.rs index c54a587e6a..3fe84c76f8 100644 --- a/src/entities/mod.rs +++ b/src/entities/mod.rs @@ -1,8 +1,11 @@ #[macro_use] pub mod entity; +#[macro_use] +pub mod util; pub mod character; pub mod creature; pub mod entity_char; +pub mod environment; pub mod item; pub mod raw_types; pub mod raws; diff --git a/src/entities/util.rs b/src/entities/util.rs new file mode 100644 index 0000000000..6c11ffadf9 --- /dev/null +++ b/src/entities/util.rs @@ -0,0 +1,72 @@ +#[macro_export] +macro_rules! new_entity { + ($name: ident) => { + new_entity!($name, {}) + }; + + ($name: ident { position: $position:expr $(, $fields:tt)* }) => { + $name { + id: None, + position: $position, + $($fields)* + } + }; + + ($name: ident { $position:expr $(, $fields:tt)* }) => { + $name { + id: None, + position: $position, + $($fields)* + } + }; +} + +#[macro_export] +macro_rules! boring_entity { + ($name:ident) => { + entity! { + pub struct $name {} + } + + impl $name { + #[allow(dead_code)] + pub fn new(position: $crate::types::Position) -> Self { + $name { id: None, position } + } + } + }; + + ($name:ident, char: $char: expr) => { + boring_entity!($name); + + impl $crate::display::Draw for $name { + fn do_draw(&self, out: &mut Write) -> io::Result<()> { + write!(out, "{}", $char) + } + } + }; +} + +#[macro_export] +macro_rules! entity { + ($name: ident) => { + positioned!($name); + positioned_mut!($name); + identified!($name, $crate::entities::EntityID); + impl $crate::entities::entity::Entity for $name {} + }; + + (pub struct $name:ident { $($struct_contents:tt)* } $($rest:tt)*) => { + #[derive(Debug, PartialEq, Eq, Clone)] + pub struct $name { + pub id: Option<$crate::entities::EntityID>, + pub position: $crate::types::Position, + $($struct_contents)* + } + + entity!($name); + entity!($($rest)*); + }; + + () => {}; +} diff --git a/src/game.rs b/src/game.rs index 49068361b5..eee0b7c0d5 100644 --- a/src/game.rs +++ b/src/game.rs @@ -24,15 +24,15 @@ type Stdout<'a> = RawTerminal>; type Rng = SmallRng; -type AnEntity<'a> = Box; +type AnEntity = Box; -impl<'a> Positioned for AnEntity<'a> { +impl Positioned for AnEntity { fn position(&self) -> Position { (**self).position() } } -impl<'a> PositionedMut for AnEntity<'a> { +impl PositionedMut for AnEntity { fn set_position(&mut self, pos: Position) { (**self).set_position(pos) } @@ -120,7 +120,7 @@ pub struct Game<'a> { input_state: InputState, /// The map of all the entities in the game - entities: EntityMap>, + entities: EntityMap, /// The entity ID of the player character character_entity_id: EntityID, @@ -151,7 +151,7 @@ impl<'a> Game<'a> { Some(seed) => SmallRng::seed_from_u64(seed), None => SmallRng::from_entropy(), }; - let mut entities: EntityMap> = EntityMap::new(); + let mut entities: EntityMap = EntityMap::new(); // TODO make this dynamic { @@ -219,11 +219,27 @@ impl<'a> Game<'a> { /// Draw all the game entities to the screen fn draw_entities(&mut self) -> io::Result<()> { for entity in self.entities.entities() { - self.viewport.draw(entity)?; + self.viewport.draw( + entity, + &self.entities.neighbor_entities(entity.position()), + )?; } Ok(()) } + /// Draw the game entity with the given ID, if any, to the screen + fn draw_entity(&mut self, entity_id: EntityID) -> io::Result { + if let Some(entity) = self.entities.get(entity_id) { + self.viewport.draw( + entity, + &self.entities.neighbor_entities(entity.position()), + )?; + Ok(true) + } else { + Ok(false) + } + } + /// Remove the given entity from the game, drawing over it if it's visible fn remove_entity(&mut self, entity_id: EntityID) -> io::Result<()> { if let Some(entity) = self.entities.remove(entity_id) { @@ -418,19 +434,17 @@ impl<'a> Game<'a> { match old_position { Some(old_pos) => { + let character = self.character(); + self.viewport.game_cursor_position = + character.position; + self.viewport.clear(old_pos)?; + self.draw_entity(self.character_entity_id)?; self.tick( self.character().speed().tiles_to_ticks( (old_pos - self.character().position) .as_tiles(), ), ); - self.viewport.clear(old_pos)?; - self.viewport.game_cursor_position = - self.character().position; - self.viewport.draw( - // TODO this clone feels unnecessary. - &self.character().clone(), - )?; } None => (), } diff --git a/src/level_gen/cave_automata.rs b/src/level_gen/cave_automata.rs index 6a237c0303..de584f4111 100644 --- a/src/level_gen/cave_automata.rs +++ b/src/level_gen/cave_automata.rs @@ -1,3 +1,4 @@ +use crate::level_gen::util::fill_outer_edges; use crate::level_gen::util::rand_initialize; use crate::types::Dimensions; use rand::Rng; @@ -61,6 +62,9 @@ pub fn generate( for _ in 0..params.steps { step_automata(&mut cells, dimensions, params); } + + fill_outer_edges(&mut cells); + cells } diff --git a/src/level_gen/display.rs b/src/level_gen/display.rs deleted file mode 100644 index 4472bf4fe3..0000000000 --- a/src/level_gen/display.rs +++ /dev/null @@ -1,17 +0,0 @@ -use std::io::{self, Write}; - -pub fn print_generated_level( - level: &Vec>, - out: &mut W, -) -> io::Result<()> -where - W: Write, -{ - for row in level { - for cell in row { - write!(out, "{}", if *cell { "X" } else { " " })?; - } - write!(out, "\n")?; - } - Ok(()) -} diff --git a/src/level_gen/mod.rs b/src/level_gen/mod.rs index 4df57a408f..df742bb3a1 100644 --- a/src/level_gen/mod.rs +++ b/src/level_gen/mod.rs @@ -1,3 +1,101 @@ +use crate::display::draw_box::BoxStyle; +use crate::display::utils::clone_times; +use crate::display::DrawWithNeighbors; +use crate::entities::entity::Entity; +use crate::entities::environment::Wall; +use crate::types::entity_map::EntityMap; +use crate::types::pos; +use itertools::Itertools; +use std::io; + pub mod cave_automata; -pub mod display; pub mod util; + +pub fn level_to_entities(level: Vec>) -> EntityMap> { + let mut res: EntityMap> = EntityMap::new(); + + let xmax = level.len() as i16; + let ymax = if xmax == 0 { + 0i16 + } else { + level[0].len() as i16 + }; + + let get = |mut x: i16, mut y: i16| { + if x < 0 { + x = 0; + } + if y < 0 { + y = 0; + } + if x >= xmax - 1 { + x = xmax - 1; + } + if y >= ymax - 1 { + y = ymax - 1; + } + level[x as usize][y as usize] + }; + + for x in 0..xmax { + for y in 0..ymax { + if get(x, y) { + // don't output walls that are surrounded on all 8 sides by + // walls + if (x == 0 || get(x - 1, y)) + && (y == 0 || get(x, y - 1)) + && (x == xmax - 1 || get(x + 1, y)) + && (y == ymax - 1 || get(x, y + 1)) + && ((x == 0 && y == 0) || get(x - 1, y - 1)) + && ((x == 0 && y == ymax - 1) || get(x - 1, y + 1)) + && ((x == xmax - 1 && y == 0) || get(x + 1, y - 1)) + && ((x == xmax - 1 && y == ymax - 1) || get(x + 1, y + 1)) + { + continue; + } + res.insert(Box::new(Wall::new( + pos(y as i16, x as i16), + BoxStyle::Thin, + ))); + } + } + } + + res +} + +pub fn draw_level( + level: Vec>, + out: &mut W, +) -> io::Result<()> { + if level.len() == 0 { + return Ok(()); + } + + let mut lines = clone_times::, Vec>>( + clone_times(' ', level[0].len() as u16), + level.len() as u16, + ); + + let em = level_to_entities(level); + + for entity in em.entities() { + let mut buf = Vec::new(); + entity.do_draw_with_neighbors( + &mut buf, + &em.neighbor_entities(entity.position()), + )?; + let buf_s = std::str::from_utf8(&buf).unwrap(); + if let Some(chr) = buf_s.chars().next() { + lines[entity.position().y as usize][entity.position().x as usize] = + chr; + } + } + + let res = lines + .iter() + .map(|line| line.iter().collect::()) + .join("\n"); + + write!(out, "{}", res) +} diff --git a/src/level_gen/util.rs b/src/level_gen/util.rs index 629292c430..c9cd873092 100644 --- a/src/level_gen/util.rs +++ b/src/level_gen/util.rs @@ -31,3 +31,22 @@ pub fn rand_initialize( } ret } + +/// Fill the outer edges of a generated level with walls +pub fn fill_outer_edges(level: &mut Vec>) { + let xmax = level.len(); + if xmax == 0 { + return; + } + let ymax = level[0].len(); + + for x in 0..xmax { + level[x][0] = true; + level[x][ymax - 1] = true; + } + + for y in 0..level[0].len() { + level[0][y] = true; + level[xmax - 1][y] = true; + } +} diff --git a/src/main.rs b/src/main.rs index 2f0d1c3ffb..b322a969a1 100644 --- a/src/main.rs +++ b/src/main.rs @@ -95,7 +95,7 @@ fn generate_level<'a, W: io::Write>( ), Some(gen) => panic!("Unrecognized generator: {}", gen), }; - level_gen::display::print_generated_level(&level, stdout) + level_gen::draw_level(level, stdout) } fn main() -> io::Result<()> { diff --git a/src/types/entity_map.rs b/src/types/entity_map.rs index 12deaa57a6..3a7a982e46 100644 --- a/src/types/entity_map.rs +++ b/src/types/entity_map.rs @@ -1,13 +1,16 @@ use crate::entities::entity::Identified; use crate::entities::EntityID; +use crate::types::Neighbors; use crate::types::Position; use crate::types::Positioned; use crate::types::PositionedMut; -use std::collections::hash_map::HashMap; -use std::collections::BTreeMap; +use alga::general::{ + AbstractMagma, AbstractMonoid, AbstractSemigroup, Additive, Identity, +}; +use std::collections::{BTreeMap, HashMap}; use std::iter::FromIterator; -#[derive(Debug)] +#[derive(Debug, PartialEq, Eq, Clone)] pub struct EntityMap { by_position: BTreeMap>, by_id: HashMap, @@ -127,6 +130,52 @@ impl> EntityMap { e }) } + + /// Moves all elements from `other` into `Self`, leathing `other` empty. + pub fn append(&mut self, other: &mut Self) { + self.by_position.append(&mut other.by_position); + self.by_id.reserve(other.len()); + for (k, v) in other.by_id.drain() { + self.by_id.insert(k, v); + } + self.last_id = self.last_id.max(other.last_id); + other.last_id = 0; + } + + /// Gets all 8 neighbors of the given position. + pub fn neighbors<'a>( + &'a self, + position: Position, + ) -> Neighbors> { + Neighbors::of_position(position) + .map(|pos| self.at(*pos)) + .mapmap(&|e| (e.id(), *e)) + } + + pub fn neighbor_entities<'a>( + &'a self, + position: Position, + ) -> Neighbors> { + self.neighbors(position).mapmap(&|(_eid, ent)| *ent) + } +} + +impl<'a, A: Positioned + Identified> IntoIterator + for &'a EntityMap +{ + type Item = (&'a EntityID, &'a A); + type IntoIter = std::collections::hash_map::Iter<'a, EntityID, A>; + fn into_iter(self) -> Self::IntoIter { + (&self.by_id).into_iter() + } +} + +impl> IntoIterator for EntityMap { + type Item = (EntityID, A); + type IntoIter = std::collections::hash_map::IntoIter; + fn into_iter(self) -> Self::IntoIter { + self.by_id.into_iter() + } } impl> FromIterator for EntityMap { @@ -139,6 +188,44 @@ impl> FromIterator for EntityMap { } } +impl + Eq + Clone> AbstractMagma + for EntityMap +{ + fn operate(&self, right: &Self) -> Self { + let mut by_position = self.by_position.clone(); + by_position.append(&mut right.by_position.clone()); + + let mut by_id = self.by_id.clone(); + for (k, v) in right.by_id.clone() { + by_id.insert(k, v); + } + + EntityMap { + by_position, + by_id, + last_id: self.last_id.max(right.last_id), + } + } +} + +impl + Eq + Clone> + AbstractSemigroup for EntityMap +{ +} + +impl + Eq> Identity + for EntityMap +{ + fn identity() -> Self { + EntityMap::new() + } +} + +impl + Eq + Clone> AbstractMonoid + for EntityMap +{ +} + impl EntityMap { pub fn update_position( &mut self, @@ -274,5 +361,35 @@ mod tests { em.remove_all_at(pos); assert_eq!(em.at(pos).len(), 0); } + + #[test] + fn test_entity_map_semigroup_laws( + em1 in gen_entity_map(), + em2 in gen_entity_map(), + em3 in gen_entity_map(), + ) { + assert!(AbstractSemigroup::prop_is_associative((em1, em2, em3))); + } + + fn test_entity_map_monoid_laws( + em in gen_entity_map(), + ) { + assert!( + AbstractMonoid::prop_operating_identity_element_is_noop((em,)) + ); + } + + #[test] + fn test_entity_map_append( + mut target in gen_entity_map(), + mut source in gen_entity_map(), + ) { + let orig_source = source.clone(); + target.append(&mut source); + assert_eq!(source, EntityMap::new()); + for (eid, e) in orig_source { + assert_eq!(target.get(eid), Some(&e)) + } + } } } diff --git a/src/types/mod.rs b/src/types/mod.rs index e656048e87..95436fc660 100644 --- a/src/types/mod.rs +++ b/src/types/mod.rs @@ -320,8 +320,8 @@ macro_rules! positioned { positioned!($name, position); }; ($name:ident, $attr:ident) => { - impl crate::types::Positioned for $name { - fn position(&self) -> Position { + impl $crate::types::Positioned for $name { + fn position(&self) -> $crate::types::Position { self.$attr } } @@ -335,7 +335,7 @@ macro_rules! positioned_mut { }; ($name:ident, $attr:ident) => { impl crate::types::PositionedMut for $name { - fn set_position(&mut self, pos: Position) { + fn set_position(&mut self, pos: $crate::types::Position) { self.$attr = pos; } } @@ -372,6 +372,55 @@ impl Speed { } } +#[derive(Clone, Copy, Debug, PartialEq, Eq, Arbitrary)] +pub struct Neighbors { + pub top_left: A, + pub top: A, + pub top_right: A, + pub left: A, + pub right: A, + pub bottom_left: A, + pub bottom: A, + pub bottom_right: A, +} + +impl Neighbors { + fn of_position(pos: Position) -> Self { + Neighbors { + top_left: pos + Direction::UpLeft, + top: pos + Direction::Up, + top_right: pos + Direction::UpRight, + left: pos + Direction::Left, + right: pos + Direction::Right, + bottom_left: pos + Direction::DownLeft, + bottom: pos + Direction::Down, + bottom_right: pos + Direction::DownRight, + } + } +} + +impl Neighbors { + /// it's a functor, yo + pub fn map B>(&self, f: F) -> Neighbors { + Neighbors { + top_left: f(&self.top_left), + top: f(&self.top), + top_right: f(&self.top_right), + left: f(&self.left), + right: f(&self.right), + bottom_left: f(&self.bottom_left), + bottom: f(&self.bottom), + bottom_right: f(&self.bottom_right), + } + } +} + +impl Neighbors> { + pub fn mapmap B>(&self, f: &F) -> Neighbors> { + self.map(|xs| xs.iter().map(f).collect()) + } +} + #[cfg(test)] mod tests { use super::*; -- cgit 1.4.1 From ea648cfcdda329f6bc01b3691d450080e060f5b4 Mon Sep 17 00:00:00 2001 From: Griffin Smith Date: Sun, 28 Jul 2019 17:48:25 -0400 Subject: Add some more name prompts for character! and also characters. --- src/messages.toml | 9 ++++++++- 1 file changed, 8 insertions(+), 1 deletion(-) diff --git a/src/messages.toml b/src/messages.toml index c4a86befff..69fd389fac 100644 --- a/src/messages.toml +++ b/src/messages.toml @@ -11,7 +11,14 @@ killed = [ ] [character] -name_prompt = "What's your name?" +name_prompt = [ + "Hey there friend. What's your name?", + "Hey there friend. What should we call you?", + "Howdy. What's your name?", + "Name please!", + "What's your name?", + "Hey, what's your name?", +] [defaults.item] eat = "You eat the {{item.name}}. {{action.result}}" -- cgit 1.4.1 From 24d38cb5899982352fc01415661d0ca0e4187358 Mon Sep 17 00:00:00 2001 From: Griffin Smith Date: Sun, 28 Jul 2019 20:38:39 -0400 Subject: Make EntityMap::append not overwrite entities Rather than overwriting entities with the same ID when appending, make EntityMap::append actually respect the internal invariants of the map and preserve entities from both sides, with no regard for their id. --- src/types/entity_map.rs | 109 +++++++++++++++++++++++++++++++++--------------- 1 file changed, 75 insertions(+), 34 deletions(-) diff --git a/src/types/entity_map.rs b/src/types/entity_map.rs index 3a7a982e46..0f224d15eb 100644 --- a/src/types/entity_map.rs +++ b/src/types/entity_map.rs @@ -7,36 +7,22 @@ use crate::types::PositionedMut; use alga::general::{ AbstractMagma, AbstractMonoid, AbstractSemigroup, Additive, Identity, }; -use std::collections::{BTreeMap, HashMap}; +use std::collections::{hash_map, BTreeMap, HashMap}; use std::iter::FromIterator; -#[derive(Debug, PartialEq, Eq, Clone)] +#[derive(Debug, Clone)] pub struct EntityMap { by_position: BTreeMap>, by_id: HashMap, last_id: EntityID, } -// impl ArbitraryF1 for EntityMap { -// type Parameters = (); -// fn lift1_with(base: AS, _: Self::Parameters) -> BoxedStrategy -// where -// AS: Strategy + 'static, -// { -// unimplemented!() -// } -// // type Strategy = strategy::Just; -// // fn arbitrary_with(params : Self::Parameters) -> Self::Strategy; -// } - -// impl Arbitrary for EntityMap { -// type Parameters = A::Parameters; -// type Strategy = BoxedStrategy; -// fn arbitrary_with(params: Self::Parameters) -> Self::Strategy { -// let a_strat: A::Strategy = Arbitrary::arbitrary_with(params); -// ArbitraryF1::lift1::(a_strat) -// } -// } +impl PartialEq for EntityMap { + fn eq(&self, other: &Self) -> bool { + self.by_position == other.by_position && self.by_id == other.by_id + } +} +impl Eq for EntityMap {} const BY_POS_INVARIANT: &'static str = "Invariant: All references in EntityMap.by_position should point to existent references in by_id"; @@ -98,10 +84,18 @@ impl EntityMap { self.by_id.values_mut() } - pub fn ids(&self) -> impl Iterator { + pub fn ids(&self) -> hash_map::Keys<'_, EntityID, A> { self.by_id.keys() } + pub fn drain<'a>(&'a mut self) -> Drain<'a, A> { + let ids = self.ids().map(|e| *e).collect::>(); + Drain { + map: self, + ids_iter: Box::new(ids.into_iter()), + } + } + fn next_id(&mut self) -> EntityID { self.last_id += 1; self.last_id @@ -124,22 +118,28 @@ impl> EntityMap { /// Remove the entity with the given ID pub fn remove(&mut self, id: EntityID) -> Option { self.by_id.remove(&id).map(|e| { - self.by_position - .get_mut(&e.position()) - .map(|es| es.retain(|e| *e != id)); + let mut empty = false; + let position = e.position(); + self.by_position.get_mut(&position).map(|es| { + es.retain(|e| *e != id); + if es.len() == 0 { + empty = true; + } + }); + if empty { + self.by_position.remove(&position); + } e }) } /// Moves all elements from `other` into `Self`, leathing `other` empty. pub fn append(&mut self, other: &mut Self) { - self.by_position.append(&mut other.by_position); - self.by_id.reserve(other.len()); - for (k, v) in other.by_id.drain() { - self.by_id.insert(k, v); + // TODO there's probably some perf opportunities here by calling + // reserve() on stuff + for (_, entity) in other.drain() { + self.insert(entity); } - self.last_id = self.last_id.max(other.last_id); - other.last_id = 0; } /// Gets all 8 neighbors of the given position. @@ -158,6 +158,19 @@ impl> EntityMap { ) -> Neighbors> { self.neighbors(position).mapmap(&|(_eid, ent)| *ent) } + + pub fn check_invariants(&self) { + for (id, ent) in &self.by_id { + assert_eq!(*id, ent.id()); + } + + for (pos, ents) in &self.by_position { + for eid in ents { + let ent = self.by_id.get(eid).unwrap(); + assert_eq!(*pos, ent.position()) + } + } + } } impl<'a, A: Positioned + Identified> IntoIterator @@ -253,6 +266,21 @@ impl EntityMap { } } +pub struct Drain<'a, A: 'a> { + map: &'a mut EntityMap, + ids_iter: Box + 'a>, +} + +impl> Iterator for Drain<'_, A> { + type Item = (EntityID, A); + + fn next(&mut self) -> Option { + self.ids_iter + .next() + .map(|eid| (eid, self.map.remove(eid).expect(BY_POS_INVARIANT))) + } +} + #[cfg(test)] mod tests { use super::*; @@ -384,11 +412,24 @@ mod tests { mut target in gen_entity_map(), mut source in gen_entity_map(), ) { + let orig_target = target.clone(); let orig_source = source.clone(); + target.append(&mut source); + target.check_invariants(); + assert_eq!(source, EntityMap::new()); - for (eid, e) in orig_source { - assert_eq!(target.get(eid), Some(&e)) + + for ent in orig_source.entities() { + assert!( + target.at(ent.position()).iter().any(|e| e.name == ent.name) + ); + } + + for ent in orig_target.entities() { + assert!( + target.at(ent.position()).iter().any(|e| e.name == ent.name) + ); } } } -- cgit 1.4.1 From 300e14b5fee68f7a70ec16652bbcd047aa304dd7 Mon Sep 17 00:00:00 2001 From: Griffin Smith Date: Sun, 28 Jul 2019 20:44:09 -0400 Subject: Add CircleCI config --- .circleci/config.yml | 3 +++ 1 file changed, 3 insertions(+) create mode 100644 .circleci/config.yml diff --git a/.circleci/config.yml b/.circleci/config.yml new file mode 100644 index 0000000000..5e177bb348 --- /dev/null +++ b/.circleci/config.yml @@ -0,0 +1,3 @@ +version: 2.1 +orbs: + rust: glotrade/rust@0.1.3 -- cgit 1.4.1 From 8f3c83311f13ed28e4d8ad2875c21973ede25b1d Mon Sep 17 00:00:00 2001 From: Griffin Smith Date: Sun, 28 Jul 2019 20:51:01 -0400 Subject: Check rustfmt and run tests in Circle --- .circleci/config.yml | 33 +++++++++++++++++++++++++++++++++ 1 file changed, 33 insertions(+) diff --git a/.circleci/config.yml b/.circleci/config.yml index 5e177bb348..99ed71cfa4 100644 --- a/.circleci/config.yml +++ b/.circleci/config.yml @@ -1,3 +1,36 @@ version: 2.1 orbs: rust: glotrade/rust@0.1.3 +jobs: + build: + executor: rust/default + steps: + - checkout + - rust/update_toolchain + - rust/build + test: + executor: rust/default + steps: + - checkout + - rust/update_toolchain + - rust/test + format: + executor: rust/default + steps: + - checkout + - rust/update_toolchain + - rust/format + lint: + executor: rust/default + steps: + - checkout + - rust/update_toolchain + - rust/clippy +workflows: + default: + jobs: + - format + - build + - test: + requires: + - build -- cgit 1.4.1 From 10fb09eca27991e878bee4a4c63d0ecd6b4a44b3 Mon Sep 17 00:00:00 2001 From: Griffin Smith Date: Sun, 28 Jul 2019 21:16:20 -0400 Subject: Turns out, collect is the answer --- src/types/entity_map.rs | 23 ++++++++--------------- 1 file changed, 8 insertions(+), 15 deletions(-) diff --git a/src/types/entity_map.rs b/src/types/entity_map.rs index 0f224d15eb..bec16cdab2 100644 --- a/src/types/entity_map.rs +++ b/src/types/entity_map.rs @@ -42,21 +42,14 @@ impl EntityMap { /// Returns a list of all entities at the given position pub fn at<'a>(&'a self, pos: Position) -> Vec<&'a A> { - // self.by_position.get(&pos).iter().flat_map(|eids| { - // eids.iter() - // .map(|eid| self.by_id.get(eid).expect(BY_POS_INVARIANT)) - // }) - // gross. - match self.by_position.get(&pos) { - None => Vec::new(), - Some(eids) => { - let mut res = Vec::new(); - for eid in eids { - res.push(self.by_id.get(eid).expect(BY_POS_INVARIANT)); - } - res - } - } + self.by_position + .get(&pos) + .iter() + .flat_map(|eids| { + eids.iter() + .map(|eid| self.by_id.get(eid).expect(BY_POS_INVARIANT)) + }) + .collect() } /// Remove all entities at the given position -- cgit 1.4.1 From ba7bec9a3e36eaf2af65677b02884172241d1b24 Mon Sep 17 00:00:00 2001 From: Griffin Smith Date: Sun, 28 Jul 2019 21:32:24 -0400 Subject: Re-draw entities when you walk over them This also required making the noodles character not actually the emoji, since the emoji being double-width means it still gets overwritten when you walk to the right of it (D:) --- src/entities/character.rs | 2 +- src/entities/raws/noodles.json | 3 ++- src/game.rs | 12 ++++++++++++ src/util/promise.rs | 1 - 4 files changed, 15 insertions(+), 3 deletions(-) diff --git a/src/entities/character.rs b/src/entities/character.rs index b917f140e6..b2da476096 100644 --- a/src/entities/character.rs +++ b/src/entities/character.rs @@ -50,6 +50,6 @@ entity!(Character); impl display::Draw for Character { fn do_draw(&self, out: &mut Write) -> io::Result<()> { - write!(out, "@{}", cursor::Left(1),) + write!(out, "@") } } diff --git a/src/entities/raws/noodles.json b/src/entities/raws/noodles.json index d4b773cac5..6e2ecded75 100644 --- a/src/entities/raws/noodles.json +++ b/src/entities/raws/noodles.json @@ -2,7 +2,8 @@ "Item": { "name": "noodles", "char": { - "char": "🍜" + "char": "n", + "color": "yellow" }, "description": "You know exactly what kind of noodles", "edible_item": { diff --git a/src/game.rs b/src/game.rs index eee0b7c0d5..dd45b3009a 100644 --- a/src/game.rs +++ b/src/game.rs @@ -227,6 +227,17 @@ impl<'a> Game<'a> { Ok(()) } + /// Draw all the game entities to the screen + fn draw_entities_at(&mut self, pos: Position) -> io::Result<()> { + for entity in self.entities.at(pos) { + self.viewport.draw( + entity, + &self.entities.neighbor_entities(entity.position()), + )?; + } + Ok(()) + } + /// Draw the game entity with the given ID, if any, to the screen fn draw_entity(&mut self, entity_id: EntityID) -> io::Result { if let Some(entity) = self.entities.get(entity_id) { @@ -438,6 +449,7 @@ impl<'a> Game<'a> { self.viewport.game_cursor_position = character.position; self.viewport.clear(old_pos)?; + self.draw_entities_at(old_pos)?; self.draw_entity(self.character_entity_id)?; self.tick( self.character().speed().tiles_to_ticks( diff --git a/src/util/promise.rs b/src/util/promise.rs index 41f3d76e77..63fbca1ddc 100644 --- a/src/util/promise.rs +++ b/src/util/promise.rs @@ -153,7 +153,6 @@ impl<'a, Env> Promises<'a, Env> { } pub fn give_all(&mut self, env: &mut Env) { - debug!("promises: {}", self.ps.len()); self.ps.retain(|p| !p.give(env)); } } -- cgit 1.4.1 From 34b20b7786a8f6753bb449425772958e0285c385 Mon Sep 17 00:00:00 2001 From: Griffin Smith Date: Sun, 28 Jul 2019 22:31:07 -0400 Subject: Add functions for making sentences from lists This seems like something I keep having to write --- proptest-regressions/description.txt | 7 +++ src/description.rs | 93 ++++++++++++++++++++++++++++++++++++ src/main.rs | 1 + 3 files changed, 101 insertions(+) create mode 100644 proptest-regressions/description.txt create mode 100644 src/description.rs diff --git a/proptest-regressions/description.txt b/proptest-regressions/description.txt new file mode 100644 index 0000000000..3c4942315b --- /dev/null +++ b/proptest-regressions/description.txt @@ -0,0 +1,7 @@ +# Seeds for failure cases proptest has generated in the past. It is +# automatically read and these particular cases re-run before any +# novel cases are generated. +# +# It is recommended to check this file in to source control so that +# everyone who runs the test benefits from these saved cases. +cc 92b51b5444b913aaa6cb89d7e7175ab6a6af5b5231ba047d123bb55d43d7d272 # shrinks to descriptions = [] diff --git a/src/description.rs b/src/description.rs new file mode 100644 index 0000000000..4c553c746d --- /dev/null +++ b/src/description.rs @@ -0,0 +1,93 @@ +use crate::entities::Describe; + +pub fn list_to_sentence(lst: &Vec) -> String { + let mut buf = String::with_capacity( + lst.iter() + .map(|e| e.len() + 2usize /* ", " */) + .sum::() + + if lst.len() >= 3 { + 3usize /* "and" */ + } else { + 0usize + }, + ); + + match lst.len() { + 0 => {} + 1 => buf.push_str(&lst[0]), + 2 => { + buf.push_str(&lst[0]); + buf.push_str(" and "); + buf.push_str(&lst[1]); + } + _ => { + for desc in &lst[..lst.len() - 1] { + buf.push_str(desc); + buf.push_str(", "); + } + buf.push_str("and "); + buf.push_str(&lst[lst.len() - 1]); + } + } + + buf +} + +pub fn describe_list(lst: &Vec) -> String { + list_to_sentence( + &lst.iter().map(|e| e.description()).collect::>(), + ) +} + +#[cfg(test)] +mod tests { + use super::*; + use proptest::prelude::*; + use proptest_derive::Arbitrary; + + #[derive(Debug, Arbitrary)] + struct Description(String); + + impl Describe for Description { + fn description(&self) -> String { + self.0.clone() + } + } + + proptest! { + #[test] + fn test_describe_list_includes_all_descriptions( + descriptions: Vec + ) { + let res = describe_list(&descriptions); + for Description(desc) in descriptions { + assert!(res.contains(&desc)); + } + } + } + + #[test] + fn test_describe_list() { + assert_eq!( + describe_list(&vec![Description("one".to_string())]), + "one".to_string() + ); + + assert_eq!( + describe_list(&vec![ + Description("one".to_string()), + Description("two".to_string()) + ]), + "one and two".to_string() + ); + + assert_eq!( + describe_list(&vec![ + Description("one".to_string()), + Description("two".to_string()), + Description("three".to_string()) + ]), + "one, two, and three".to_string() + ); + } +} diff --git a/src/main.rs b/src/main.rs index b322a969a1..676d2173e8 100644 --- a/src/main.rs +++ b/src/main.rs @@ -34,6 +34,7 @@ mod util; mod types; #[macro_use] mod entities; +mod description; mod display; mod game; mod level_gen; -- cgit 1.4.1 From 9db5fad2f900732d59f9714ac4517952d26506d7 Mon Sep 17 00:00:00 2001 From: Griffin Smith Date: Mon, 29 Jul 2019 11:22:39 -0400 Subject: Describe what you see when you walk over it If the character walks over any number of entities, describe those entities to the character. --- src/entities/character.rs | 19 +++------ src/entities/creature.rs | 8 +++- src/entities/entity.rs | 45 +++++++++++++++++++- src/entities/environment.rs | 2 + src/entities/item.rs | 8 +++- src/entities/mod.rs | 2 +- src/entities/raw_types.rs | 12 ++++-- src/entities/raws/noodles.json | 6 +-- src/game.rs | 93 ++++++++++++++++++++++++++++++------------ src/messages.toml | 2 + src/util/mod.rs | 2 + src/util/trait_impls.rs | 17 ++++++++ 12 files changed, 168 insertions(+), 48 deletions(-) create mode 100644 src/util/trait_impls.rs diff --git a/src/entities/character.rs b/src/entities/character.rs index b2da476096..59d4d00a4b 100644 --- a/src/entities/character.rs +++ b/src/entities/character.rs @@ -1,22 +1,17 @@ use crate::display; -use crate::entities::EntityID; use crate::types::{Position, Speed}; -use proptest_derive::Arbitrary; use std::io::{self, Write}; -use termion::cursor; const DEFAULT_SPEED: Speed = Speed(100); -#[derive(Debug, PartialEq, Eq, Arbitrary, Clone)] -pub struct Character { - pub id: Option, - - /// The position of the character, relative to the game - pub position: Position, - - pub o_name: Option, +entity! { + pub struct Character { + pub o_name: Option, + } } +static_description!(Character, "yourself"); + impl Character { pub fn new() -> Character { Character { @@ -46,8 +41,6 @@ impl Character { } } -entity!(Character); - impl display::Draw for Character { fn do_draw(&self, out: &mut Write) -> io::Result<()> { write!(out, "@") diff --git a/src/entities/creature.rs b/src/entities/creature.rs index 9fd8d23c75..4cf6f60bdc 100644 --- a/src/entities/creature.rs +++ b/src/entities/creature.rs @@ -1,7 +1,7 @@ use crate::display; use crate::entities::raws::CreatureType; use crate::entities::raws::EntityRaw; -use crate::entities::{raw, EntityID}; +use crate::entities::{raw, Describe, EntityID}; use crate::types::Position; use std::io::{self, Write}; @@ -50,6 +50,12 @@ impl Creature { entity!(Creature); +impl Describe for Creature { + fn description(&self) -> String { + self.typ.description.to_string() + } +} + impl display::Draw for Creature { fn do_draw(&self, out: &mut Write) -> io::Result<()> { write!(out, "{}", self.typ.chr) diff --git a/src/entities/entity.rs b/src/entities/entity.rs index 7fedb77b25..0043a83ecd 100644 --- a/src/entities/entity.rs +++ b/src/entities/entity.rs @@ -1,6 +1,7 @@ use crate::display::DrawWithNeighbors; use crate::entities::EntityID; use crate::types::Neighbors; +use crate::types::Position; use crate::types::{Positioned, PositionedMut}; use downcast_rs::Downcast; use std::fmt::Debug; @@ -37,8 +38,36 @@ impl> Identified for Box { } } +pub trait Describe { + fn description(&self) -> String; +} + +ref_impl! { + impl Describe for &T { + fn description(&self) -> String { + (**self).description() + } + } +} + +#[macro_export] +macro_rules! static_description { + ($name: ident, $description: expr) => { + impl $crate::entities::entity::Describe for $name { + fn description(&self) -> String { + $description.to_string() + } + } + }; +} + pub trait Entity: - Positioned + PositionedMut + Identified + DrawWithNeighbors + Downcast + Positioned + + PositionedMut + + Identified + + DrawWithNeighbors + + Downcast + + Describe { } @@ -80,3 +109,17 @@ impl DrawWithNeighbors for Box { (**self).do_draw_with_neighbors(out, neighbors) } } + +pub type AnEntity = Box; + +impl Positioned for AnEntity { + fn position(&self) -> Position { + (**self).position() + } +} + +impl PositionedMut for AnEntity { + fn set_position(&mut self, pos: Position) { + (**self).set_position(pos) + } +} diff --git a/src/entities/environment.rs b/src/entities/environment.rs index 64366a5054..042873ec5a 100644 --- a/src/entities/environment.rs +++ b/src/entities/environment.rs @@ -10,6 +10,8 @@ entity! { } } +static_description!(Wall, "a wall"); + impl Wall { pub fn new(position: Position, style: BoxStyle) -> Self { new_entity!(Wall { position, style }) diff --git a/src/entities/item.rs b/src/entities/item.rs index d0ecc090e2..6e47a87f5b 100644 --- a/src/entities/item.rs +++ b/src/entities/item.rs @@ -1,6 +1,6 @@ use crate::display; use crate::entities::raws::{raw, EntityRaw, ItemType}; -use crate::entities::EntityID; +use crate::entities::{Describe, EntityID}; use crate::types::Position; use std::io::{self, Write}; @@ -37,6 +37,12 @@ impl Item { entity!(Item); +impl Describe for Item { + fn description(&self) -> String { + self.typ.description.to_string() + } +} + impl display::Draw for Item { fn do_draw(&self, out: &mut Write) -> io::Result<()> { write!(out, "{}", self.typ.chr) diff --git a/src/entities/mod.rs b/src/entities/mod.rs index 3fe84c76f8..a8c39ed8aa 100644 --- a/src/entities/mod.rs +++ b/src/entities/mod.rs @@ -12,7 +12,7 @@ pub mod raws; pub use character::Character; pub use creature::Creature; -pub use entity::{Entity, Identified}; +pub use entity::{AnEntity, Describe, Entity, Identified}; pub use entity_char::EntityChar; pub use item::Item; pub use raws::raw; diff --git a/src/entities/raw_types.rs b/src/entities/raw_types.rs index 8f64e60d9c..59dd19ed2f 100644 --- a/src/entities/raw_types.rs +++ b/src/entities/raw_types.rs @@ -30,9 +30,13 @@ pub struct EdibleItem<'a> { pub struct ItemType<'a> { pub name: &'a str, - /// A description of the item, used by the "look" command + /// A description of the item, used by the "look" command and when walking + /// over the item on the ground pub description: &'a str, + /// A longer description of the item + pub long_description: &'a str, + pub edible_item: Option>, #[serde(rename = "char")] @@ -49,7 +53,8 @@ mod item_type_tests { r#"{ "Item": { "name": "noodles", - "description": "You know exactly what kind of noodles", + "description": "a big bowl o' noodles", + "long_description": "You know exactly what kind of noodles", "char": { "char": "n" }, "edible_item": { "eat_message": "You slurp up the noodles", @@ -67,7 +72,8 @@ mod item_type_tests { let toml_result = toml::from_str( r#"[Item] name = "noodles" -description = "You know exactly what kind of noodles" +description = "a big bowl o' noodles" +long_description = "You know exactly what kind of noodles" char = { char = "🍜" } edible_item = { eat_message = "You slurp up the noodles", hitpoints_healed = 2 } "#, diff --git a/src/entities/raws/noodles.json b/src/entities/raws/noodles.json index 6e2ecded75..dfa2609f5e 100644 --- a/src/entities/raws/noodles.json +++ b/src/entities/raws/noodles.json @@ -5,11 +5,11 @@ "char": "n", "color": "yellow" }, - "description": "You know exactly what kind of noodles", + "description": "a big bowl o' noodles", + "long_description": "You know exactly what kind of noodles", "edible_item": { "eat_message": "You slurp up the noodles", "hitpoints_healed": 2 - }, - "display_name": "big bowl o' noodles" + } } } diff --git a/src/game.rs b/src/game.rs index dd45b3009a..a42edb5537 100644 --- a/src/game.rs +++ b/src/game.rs @@ -1,14 +1,14 @@ +use crate::description::list_to_sentence; use crate::display::{self, Viewport}; use crate::entities::{ - Character, Creature, Entity, EntityID, Identified, Item, + AnEntity, Character, Creature, EntityID, Identified, Item, }; use crate::messages::message; use crate::settings::Settings; use crate::types::command::Command; use crate::types::entity_map::EntityMap; use crate::types::{ - pos, BoundingBox, Collision, Dimensions, Position, Positioned, - PositionedMut, Ticks, + pos, BoundingBox, Collision, Dimensions, Position, Positioned, Ticks, }; use crate::util::promise::Cancelled; use crate::util::promise::{promise, Complete, Promise, Promises}; @@ -24,25 +24,30 @@ type Stdout<'a> = RawTerminal>; type Rng = SmallRng; -type AnEntity = Box; - -impl Positioned for AnEntity { - fn position(&self) -> Position { - (**self).position() - } -} - -impl PositionedMut for AnEntity { - fn set_position(&mut self, pos: Position) { - (**self).set_position(pos) - } -} - enum PromptResolution { Uncancellable(Complete), Cancellable(Complete>), } +/// The mode to use when describing entities on a tile to the user +#[derive(Debug, Clone, Copy, PartialEq, Eq)] +enum EntityDescriptionMode { + /// Describe the entities that the user is walking over. + /// + /// This means: + /// - Skip the character themselves + /// - Describe nothing if there are no items other than the character + Walk, + + /// Describe entities that the user is actively asking about. + /// + /// This means: + /// - Describe the character themselves if they've asked to look at the tile + /// they're standing on + /// - Explicitly say there's nothing there if there's nothing there. + Look, +} + impl PromptResolution { fn is_cancellable(&self) -> bool { use PromptResolution::*; @@ -251,6 +256,43 @@ impl<'a> Game<'a> { } } + /// Describe all the entities at a given position to the user. + /// + /// If `force` is not set to `true`, will not do anything if there are no + /// entities + fn describe_entities_at( + &mut self, + pos: Position, + mode: EntityDescriptionMode, + ) -> io::Result<()> { + use EntityDescriptionMode::*; + let mut entities = self.entities.at(pos); + if mode == Walk { + entities.retain(|e| e.id() != self.character_entity_id); + } + + if entities.len() == 0 { + match mode { + Walk => return Ok(()), + Look => { + return self.say( + "global.describe_no_entities", + &template_params!(), + ) + } + } + } + + let descriptions = list_to_sentence( + &entities.iter().map(|e| e.description()).collect(), + ); + + self.say( + "global.describe_entities", + &template_params!({ "descriptions" => &descriptions, }), + ) + } + /// Remove the given entity from the game, drawing over it if it's visible fn remove_entity(&mut self, entity_id: EntityID) -> io::Result<()> { if let Some(entity) = self.entities.remove(entity_id) { @@ -446,17 +488,18 @@ impl<'a> Game<'a> { match old_position { Some(old_pos) => { let character = self.character(); - self.viewport.game_cursor_position = - character.position; + let char_pos = character.position.clone(); + self.viewport.game_cursor_position = char_pos; self.viewport.clear(old_pos)?; self.draw_entities_at(old_pos)?; self.draw_entity(self.character_entity_id)?; - self.tick( - self.character().speed().tiles_to_ticks( - (old_pos - self.character().position) - .as_tiles(), - ), - ); + self.describe_entities_at( + char_pos, + EntityDescriptionMode::Walk, + )?; + self.tick(self.character().speed().tiles_to_ticks( + (old_pos - char_pos).as_tiles(), + )); } None => (), } diff --git a/src/messages.toml b/src/messages.toml index 69fd389fac..7c6255142d 100644 --- a/src/messages.toml +++ b/src/messages.toml @@ -1,5 +1,7 @@ [global] welcome = "Welcome to Xanthous, {{character.name}}! It's dangerous out there, why not stay inside?" +describe_entities = "You see here {{descriptions}}" +describe_no_entities = "You see nothing here." [combat] attack = "You attack the {{creature.name}}." diff --git a/src/util/mod.rs b/src/util/mod.rs index c55fdfeae2..dd5087a555 100644 --- a/src/util/mod.rs +++ b/src/util/mod.rs @@ -3,3 +3,5 @@ pub mod static_cfg; #[macro_use] pub mod template; pub mod promise; +#[macro_use] +pub mod trait_impls; diff --git a/src/util/trait_impls.rs b/src/util/trait_impls.rs new file mode 100644 index 0000000000..ba15f7119d --- /dev/null +++ b/src/util/trait_impls.rs @@ -0,0 +1,17 @@ +macro_rules! ref_impl { + (impl $traiti:ident for &T { + $($body:tt)* + }) => { + impl<'a, T: $traitb $(+ $bound)*> $traiti for &'a T { + $($body)* + } + + impl<'a, T: $traitb $(+ $bound)*> $traiti for &'a mut T { + $($body)* + } + + impl $traiti for ::std::boxed::Box { + $($body)* + } + }; +} -- cgit 1.4.1 From 7138d9a0b627b64f31558f0f4820dec7e55fdee4 Mon Sep 17 00:00:00 2001 From: Griffin Smith Date: Mon, 29 Jul 2019 11:46:01 -0400 Subject: Add clippy to circleCI and fix all lints --- .circleci/config.yml | 1 + src/description.rs | 4 +-- src/display/mod.rs | 1 + src/display/viewport.rs | 33 ++++++++----------- src/entities/character.rs | 2 +- src/entities/creature.rs | 2 +- src/entities/entity.rs | 2 +- src/entities/raws.rs | 4 +-- src/game.rs | 73 +++++++++++++++++++++++------------------- src/level_gen/cave_automata.rs | 23 ++++++------- src/level_gen/mod.rs | 2 +- src/level_gen/util.rs | 10 +++--- src/main.rs | 2 +- src/messages.rs | 2 +- src/types/collision.rs | 1 + src/types/mod.rs | 10 ++++-- 16 files changed, 89 insertions(+), 83 deletions(-) diff --git a/.circleci/config.yml b/.circleci/config.yml index 99ed71cfa4..08addd5500 100644 --- a/.circleci/config.yml +++ b/.circleci/config.yml @@ -29,6 +29,7 @@ jobs: workflows: default: jobs: + - lint - format - build - test: diff --git a/src/description.rs b/src/description.rs index 4c553c746d..31f39f7578 100644 --- a/src/description.rs +++ b/src/description.rs @@ -1,6 +1,6 @@ use crate::entities::Describe; -pub fn list_to_sentence(lst: &Vec) -> String { +pub fn list_to_sentence(lst: &[String]) -> String { let mut buf = String::with_capacity( lst.iter() .map(|e| e.len() + 2usize /* ", " */) @@ -33,7 +33,7 @@ pub fn list_to_sentence(lst: &Vec) -> String { buf } -pub fn describe_list(lst: &Vec) -> String { +pub fn describe_list(lst: &[A]) -> String { list_to_sentence( &lst.iter().map(|e| e.description()).collect::>(), ) diff --git a/src/display/mod.rs b/src/display/mod.rs index 10690284f1..2df4277f4f 100644 --- a/src/display/mod.rs +++ b/src/display/mod.rs @@ -33,6 +33,7 @@ impl Draw for Box { } pub trait DrawWithNeighbors: Positioned { + #[allow(clippy::borrowed_box)] fn do_draw_with_neighbors<'a, 'b>( &'a self, out: &'b mut Write, diff --git a/src/display/viewport.rs b/src/display/viewport.rs index 9ff7db07be..5ff56be0a9 100644 --- a/src/display/viewport.rs +++ b/src/display/viewport.rs @@ -79,7 +79,8 @@ impl Debug for Viewport { impl Viewport { /// Draw the given entity to the viewport at its position, if visible - pub fn draw<'a, T: DrawWithNeighbors>( + #[allow(clippy::borrowed_box)] + pub fn draw( &mut self, entity: &T, neighbors: &Neighbors>>, @@ -165,29 +166,23 @@ impl Viewport { } pub fn push_prompt_chr(&mut self, chr: char) -> io::Result<()> { - match self.cursor_state { - CursorState::Prompt(pos) => { - write!(self, "{}", chr)?; - self.cursor_state = CursorState::Prompt(pos + Direction::Right); - } - _ => {} + if let CursorState::Prompt(pos) = self.cursor_state { + write!(self, "{}", chr)?; + self.cursor_state = CursorState::Prompt(pos + Direction::Right); } Ok(()) } pub fn pop_prompt_chr(&mut self) -> io::Result<()> { - match self.cursor_state { - CursorState::Prompt(pos) => { - let new_pos = pos + Direction::Left; - write!( - self, - "{} {}", - new_pos.cursor_goto(), - new_pos.cursor_goto() - )?; - self.cursor_state = CursorState::Prompt(new_pos); - } - _ => {} + if let CursorState::Prompt(pos) = self.cursor_state { + let new_pos = pos + Direction::Left; + write!( + self, + "{} {}", + new_pos.cursor_goto(), + new_pos.cursor_goto() + )?; + self.cursor_state = CursorState::Prompt(new_pos); } Ok(()) } diff --git a/src/entities/character.rs b/src/entities/character.rs index 59d4d00a4b..2b1b6efe47 100644 --- a/src/entities/character.rs +++ b/src/entities/character.rs @@ -30,7 +30,7 @@ impl Character { 1 } - pub fn name<'a>(&'a self) -> &'a str { + pub fn name(&self) -> &str { self.o_name .as_ref() .expect("Character name not initialized") diff --git a/src/entities/creature.rs b/src/entities/creature.rs index 4cf6f60bdc..87ffda161e 100644 --- a/src/entities/creature.rs +++ b/src/entities/creature.rs @@ -44,7 +44,7 @@ impl Creature { /// Returns true if this creature has died pub fn dead(&self) -> bool { - self.hitpoints <= 0 + self.hitpoints == 0 } } diff --git a/src/entities/entity.rs b/src/entities/entity.rs index 0043a83ecd..e43175931b 100644 --- a/src/entities/entity.rs +++ b/src/entities/entity.rs @@ -13,7 +13,7 @@ pub trait Identified: Debug { fn id(&self) -> ID { self.opt_id() - .expect(format!("Entity ({:?}) is not in the game", self).as_str()) + .unwrap_or_else(|| panic!("Entity ({:?}) is not in the game", self)) } } diff --git a/src/entities/raws.rs b/src/entities/raws.rs index 2c4a8203cb..061e29a840 100644 --- a/src/entities/raws.rs +++ b/src/entities/raws.rs @@ -22,8 +22,8 @@ lazy_static! { pub fn raw(name: &'static str) -> &'static EntityRaw<'static> { RAWS_BY_NAME .get(name) - .map(|e| *e) - .expect(format!("Raw not found: {}", name).as_str()) + .copied() + .unwrap_or_else(|| panic!("Raw not found: {}", name)) } #[cfg(test)] diff --git a/src/game.rs b/src/game.rs index a42edb5537..2740b5052d 100644 --- a/src/game.rs +++ b/src/game.rs @@ -201,10 +201,10 @@ impl<'a> Game<'a> { if !pos.within(self.viewport.inner) { Some(Collision::Stop) } else { - if self.creatures_at(pos).len() > 0 { - Some(Collision::Combat) - } else { + if self.creatures_at(pos).is_empty() { None + } else { + Some(Collision::Combat) } } } @@ -271,7 +271,7 @@ impl<'a> Game<'a> { entities.retain(|e| e.id() != self.character_entity_id); } - if entities.len() == 0 { + if entities.is_empty() { match mode { Walk => return Ok(()), Look => { @@ -284,7 +284,10 @@ impl<'a> Game<'a> { } let descriptions = list_to_sentence( - &entities.iter().map(|e| e.description()).collect(), + &entities + .iter() + .map(|e| e.description()) + .collect::>(), ); self.say( @@ -371,9 +374,9 @@ impl<'a> Game<'a> { } fn expect_creature(&self, creature_id: EntityID) -> &Creature { - self.creature(creature_id).expect( - format!("Creature ID went away: {:?}", creature_id).as_str(), - ) + self.creature(creature_id).unwrap_or_else(|| { + panic!("Creature ID went away: {:?}", creature_id) + }) } fn mut_creature(&mut self, creature_id: EntityID) -> Option<&mut Creature> { @@ -383,9 +386,9 @@ impl<'a> Game<'a> { } fn expect_mut_creature(&mut self, creature_id: EntityID) -> &mut Creature { - self.mut_creature(creature_id).expect( - format!("Creature ID went away: {:?}", creature_id).as_str(), - ) + self.mut_creature(creature_id).unwrap_or_else(|| { + panic!("Creature ID went away: {:?}", creature_id) + }) } fn attack(&mut self, creature_id: EntityID) -> io::Result<()> { @@ -411,12 +414,17 @@ impl<'a> Game<'a> { fn attack_at(&mut self, pos: Position) -> io::Result<()> { let creatures = self.creatures_at(pos); - if creatures.len() == 1 { - let creature = creatures.get(0).unwrap(); - self.attack(creature.id()) - } else { - // TODO prompt with a menu of creatures to combat - unimplemented!() + match creatures.len() { + 0 => Ok(()), + 1 => { + let creature = creatures.get(0).unwrap(); + let creature_id = creature.id(); + self.attack(creature_id) + } + _ => { + // TODO prompt with a menu of creatures to combat + unimplemented!() + } } } @@ -485,23 +493,22 @@ impl<'a> Game<'a> { None => (), } - match old_position { - Some(old_pos) => { - let character = self.character(); - let char_pos = character.position.clone(); - self.viewport.game_cursor_position = char_pos; - self.viewport.clear(old_pos)?; - self.draw_entities_at(old_pos)?; - self.draw_entity(self.character_entity_id)?; - self.describe_entities_at( - char_pos, - EntityDescriptionMode::Walk, - )?; - self.tick(self.character().speed().tiles_to_ticks( + if let Some(old_pos) = old_position { + let character = self.character(); + let char_pos = character.position; + self.viewport.game_cursor_position = char_pos; + self.viewport.clear(old_pos)?; + self.draw_entities_at(old_pos)?; + self.draw_entity(self.character_entity_id)?; + self.describe_entities_at( + char_pos, + EntityDescriptionMode::Walk, + )?; + self.tick( + self.character().speed().tiles_to_ticks( (old_pos - char_pos).as_tiles(), - )); - } - None => (), + ), + ); } } diff --git a/src/level_gen/cave_automata.rs b/src/level_gen/cave_automata.rs index de584f4111..e5e2807ab2 100644 --- a/src/level_gen/cave_automata.rs +++ b/src/level_gen/cave_automata.rs @@ -53,12 +53,12 @@ impl Default for Params { } pub fn generate( - dimensions: &Dimensions, + dimensions: Dimensions, params: &Params, rand: &mut R, ) -> Vec> { let mut cells = - rand_initialize(&dimensions, rand, params.chance_to_start_alive); + rand_initialize(dimensions, rand, params.chance_to_start_alive); for _ in 0..params.steps { step_automata(&mut cells, dimensions, params); } @@ -70,7 +70,7 @@ pub fn generate( fn step_automata( cells: &mut Vec>, - dimensions: &Dimensions, + dimensions: Dimensions, params: &Params, ) { let orig_cells = (*cells).clone(); @@ -83,12 +83,10 @@ fn step_automata( } else { cells[x][y] = true; } + } else if nbs > params.birth_limit { + cells[x][y] = true; } else { - if nbs > params.birth_limit { - cells[x][y] = true; - } else { - cells[x][y] = false; - } + cells[x][y] = false; } } } @@ -96,7 +94,7 @@ fn step_automata( const COUNT_EDGES_AS_NEIGHBORS: bool = true; -fn num_alive_neighbors(cells: &Vec>, x: i32, y: i32) -> i32 { +fn num_alive_neighbors(cells: &[Vec], x: i32, y: i32) -> i32 { let mut count = 0; for i in -1..2 { for j in -1..2 { @@ -107,15 +105,14 @@ fn num_alive_neighbors(cells: &Vec>, x: i32, y: i32) -> i32 { let neighbor_x = x + i; let neighbor_y = y + j; - if COUNT_EDGES_AS_NEIGHBORS + if (COUNT_EDGES_AS_NEIGHBORS && (neighbor_x < 0 || neighbor_y < 0 || neighbor_x >= (cells.len() as i32) - || neighbor_y >= (cells[0].len()) as i32) + || neighbor_y >= (cells[0].len()) as i32)) + || cells[neighbor_x as usize][neighbor_y as usize] { count += 1; - } else if cells[neighbor_x as usize][neighbor_y as usize] { - count += 1; } } } diff --git a/src/level_gen/mod.rs b/src/level_gen/mod.rs index df742bb3a1..d796a103b1 100644 --- a/src/level_gen/mod.rs +++ b/src/level_gen/mod.rs @@ -68,7 +68,7 @@ pub fn draw_level( level: Vec>, out: &mut W, ) -> io::Result<()> { - if level.len() == 0 { + if level.is_empty() { return Ok(()); } diff --git a/src/level_gen/util.rs b/src/level_gen/util.rs index c9cd873092..4f56fe6c95 100644 --- a/src/level_gen/util.rs +++ b/src/level_gen/util.rs @@ -1,7 +1,7 @@ use crate::types::Dimensions; use rand::{distributions, Rng}; -pub fn falses(dims: &Dimensions) -> Vec> { +pub fn falses(dims: Dimensions) -> Vec> { let mut ret = Vec::with_capacity(dims.h as usize); for _ in 0..dims.h { let mut row = Vec::with_capacity(dims.w as usize); @@ -16,7 +16,7 @@ pub fn falses(dims: &Dimensions) -> Vec> { /// Randomly initialize a 2-dimensional boolean vector of the given /// `Dimensions`, using the given random number generator and alive chance pub fn rand_initialize( - dims: &Dimensions, + dims: Dimensions, rng: &mut R, alive_chance: f64, ) -> Vec> { @@ -40,9 +40,9 @@ pub fn fill_outer_edges(level: &mut Vec>) { } let ymax = level[0].len(); - for x in 0..xmax { - level[x][0] = true; - level[x][ymax - 1] = true; + for row in level.iter_mut() { + row[0] = true; + row[ymax - 1] = true; } for y in 0..level[0].len() { diff --git a/src/main.rs b/src/main.rs index 676d2173e8..2cd0bbc08d 100644 --- a/src/main.rs +++ b/src/main.rs @@ -90,7 +90,7 @@ fn generate_level<'a, W: io::Write>( let level = match params.value_of("generator") { None => panic!("Must supply a generator with --generator"), Some("cave_automata") => level_gen::cave_automata::generate( - &dimensions, + dimensions, &level_gen::cave_automata::Params::from_matches(params), &mut rand, ), diff --git a/src/messages.rs b/src/messages.rs index 719389fa61..b081389efc 100644 --- a/src/messages.rs +++ b/src/messages.rs @@ -35,7 +35,7 @@ impl<'a> NestedMap<'a> { fn lookup(&'a self, path: &str) -> Option<&'a Message<'a>> { use NestedMap::*; let leaf = - path.split(".") + path.split('.') .fold(Some(self), |current, key| match current { Some(Nested(m)) => m.get(key), _ => None, diff --git a/src/types/collision.rs b/src/types/collision.rs index f41e30fc51..59c60e69ee 100644 --- a/src/types/collision.rs +++ b/src/types/collision.rs @@ -1,4 +1,5 @@ /// Describes a kind of game collision +#[derive(Debug, Clone, Copy, PartialEq, Eq)] pub enum Collision { /// Stop moving - you can't move there! Stop, diff --git a/src/types/mod.rs b/src/types/mod.rs index 95436fc660..21748bac90 100644 --- a/src/types/mod.rs +++ b/src/types/mod.rs @@ -1,3 +1,6 @@ +#![allow(clippy::unit_arg)] +#![allow(clippy::identity_conversion)] + use std::cmp::max; use std::cmp::Ordering; use std::ops; @@ -139,7 +142,7 @@ impl Position { /// Returns a sequence of ASCII escape characters for moving the cursor to /// this Position - pub fn cursor_goto(&self) -> cursor::Goto { + pub fn cursor_goto(self) -> cursor::Goto { // + 1 because Goto is 1-based, but position is 0-based cursor::Goto(self.x as u16 + 1, self.y as u16 + 1) } @@ -147,7 +150,7 @@ impl Position { /// Converts this position to the number of `Tiles` away from the origin it /// represents. Usually done after subtracting two positions. Gives distance /// as the crow flies - pub fn as_tiles(&self) -> Tiles { + pub fn as_tiles(self) -> Tiles { Tiles(max(self.x.abs(), self.y.abs()).into()) } } @@ -179,6 +182,7 @@ impl PartialOrd for Position { /// let right_pos = pos + Direction::Right /// assert_eq!(right_pos, Position { x: 0, y: 10 }) /// ``` +#[allow(clippy::suspicious_arithmetic_impl)] impl ops::Add for Position { type Output = Position; fn add(self, dir: Direction) -> Position { @@ -362,7 +366,7 @@ impl Speed { /// Returns the number of tiles that would be moved in the given number of /// ticks at this speed pub fn ticks_to_tiles(self, ticks: Ticks) -> Tiles { - Tiles(ticks.0 as f32 / self.0 as f32) + Tiles(f32::from(ticks.0) / self.0 as f32) } /// Returns the number of ticks required to move the given number of tiles -- cgit 1.4.1 From 929dac06d0a2df78bbeac5a80c994a38901e5f67 Mon Sep 17 00:00:00 2001 From: Griffin Smith Date: Sat, 3 Aug 2019 12:48:38 -0400 Subject: Clear messages every turn Clear messgaes every turn, preserving the ability to ^P to get the previous message --- src/game.rs | 11 +++++++++++ 1 file changed, 11 insertions(+) diff --git a/src/game.rs b/src/game.rs index 2740b5052d..add48e8bfd 100644 --- a/src/game.rs +++ b/src/game.rs @@ -367,6 +367,16 @@ impl<'a> Game<'a> { Ok(()) } + fn clear_message(&mut self) -> io::Result<()> { + debug!("{:?} {:?}", self.message_idx, self.messages); + if self.message_idx == self.messages.len() { + return Ok(()); + } + self.viewport.clear_message()?; + self.message_idx += 1; + Ok(()) + } + fn creature(&self, creature_id: EntityID) -> Option<&Creature> { self.entities .get(creature_id) @@ -500,6 +510,7 @@ impl<'a> Game<'a> { self.viewport.clear(old_pos)?; self.draw_entities_at(old_pos)?; self.draw_entity(self.character_entity_id)?; + self.clear_message()?; self.describe_entities_at( char_pos, EntityDescriptionMode::Walk, -- cgit 1.4.1 From 82cefedab9e44b48f4d3cc08b0f6e002ae383c9d Mon Sep 17 00:00:00 2001 From: Griffin Smith Date: Sat, 3 Aug 2019 13:14:28 -0400 Subject: Fix a bunch more Clippy lints, but disable in Circle The unused error is causing more trouble than it's worth at this point --- .circleci/config.yml | 14 ++++++------- src/description.rs | 6 +++--- src/display/color.rs | 10 ++++----- src/display/draw_box.rs | 2 +- src/display/mod.rs | 10 ++++----- src/display/viewport.rs | 2 +- src/entities/character.rs | 2 +- src/entities/creature.rs | 2 +- src/entities/entity.rs | 2 +- src/entities/entity_char.rs | 2 +- src/entities/environment.rs | 2 +- src/entities/item.rs | 2 +- src/game.rs | 12 +++++------ src/main.rs | 10 ++------- src/types/entity_map.rs | 51 +++++++++++++++++++++++---------------------- src/types/mod.rs | 1 + src/util/promise.rs | 8 ++++--- src/util/template.rs | 10 ++++----- 18 files changed, 72 insertions(+), 76 deletions(-) diff --git a/.circleci/config.yml b/.circleci/config.yml index 08addd5500..ffde5e9854 100644 --- a/.circleci/config.yml +++ b/.circleci/config.yml @@ -20,16 +20,16 @@ jobs: - checkout - rust/update_toolchain - rust/format - lint: - executor: rust/default - steps: - - checkout - - rust/update_toolchain - - rust/clippy + # lint: + # executor: rust/default + # steps: + # - checkout + # - rust/update_toolchain + # - rust/clippy workflows: default: jobs: - - lint + # - lint - format - build - test: diff --git a/src/description.rs b/src/description.rs index 31f39f7578..48c98d76e0 100644 --- a/src/description.rs +++ b/src/description.rs @@ -69,12 +69,12 @@ mod tests { #[test] fn test_describe_list() { assert_eq!( - describe_list(&vec![Description("one".to_string())]), + describe_list(&[Description("one".to_string())]), "one".to_string() ); assert_eq!( - describe_list(&vec![ + describe_list(&[ Description("one".to_string()), Description("two".to_string()) ]), @@ -82,7 +82,7 @@ mod tests { ); assert_eq!( - describe_list(&vec![ + describe_list(&[ Description("one".to_string()), Description("two".to_string()), Description("three".to_string()) diff --git a/src/display/color.rs b/src/display/color.rs index 2a023f1d95..b1e799c5ed 100644 --- a/src/display/color.rs +++ b/src/display/color.rs @@ -16,21 +16,21 @@ impl Color { } impl color::Color for Color { - fn write_fg(&self, f: &mut fmt::Formatter) -> fmt::Result { + fn write_fg(&self, f: &mut fmt::Formatter<'_>) -> fmt::Result { self.0.write_fg(f) } - fn write_bg(&self, f: &mut fmt::Formatter) -> fmt::Result { + fn write_bg(&self, f: &mut fmt::Formatter<'_>) -> fmt::Result { self.0.write_bg(f) } } impl<'a> color::Color for &'a Color { - fn write_fg(&self, f: &mut fmt::Formatter) -> fmt::Result { + fn write_fg(&self, f: &mut fmt::Formatter<'_>) -> fmt::Result { self.0.write_fg(f) } - fn write_bg(&self, f: &mut fmt::Formatter) -> fmt::Result { + fn write_bg(&self, f: &mut fmt::Formatter<'_>) -> fmt::Result { self.0.write_bg(f) } } @@ -56,7 +56,7 @@ impl ColorVisitor { impl<'de> Visitor<'de> for ColorVisitor { type Value = Color; - fn expecting(&self, formatter: &mut fmt::Formatter) -> fmt::Result { + fn expecting(&self, formatter: &mut fmt::Formatter<'_>) -> fmt::Result { formatter.write_str("A color") } diff --git a/src/display/draw_box.rs b/src/display/draw_box.rs index 3b2b4aaf4f..1b3958cefc 100644 --- a/src/display/draw_box.rs +++ b/src/display/draw_box.rs @@ -140,7 +140,7 @@ impl Stylable for Line { } impl Stylable for Neighbors> { - fn style(&self, style: BoxStyle) -> char { + fn style(&self, _style: BoxStyle) -> char { use BoxStyle::*; match (self.left, self.right, self.top, self.bottom) { (None, None, None, None) => BOX, diff --git a/src/display/mod.rs b/src/display/mod.rs index 2df4277f4f..6e37a03d8c 100644 --- a/src/display/mod.rs +++ b/src/display/mod.rs @@ -17,17 +17,17 @@ pub fn clear(out: &mut T) -> io::Result<()> { pub trait Draw: Positioned { /// Draw this entity, assuming the character is already at the correct /// position - fn do_draw(&self, out: &mut Write) -> io::Result<()>; + fn do_draw(&self, out: &mut dyn Write) -> io::Result<()>; } impl Draw for &T { - fn do_draw(&self, out: &mut Write) -> io::Result<()> { + fn do_draw(&self, out: &mut dyn Write) -> io::Result<()> { (**self).do_draw(out) } } impl Draw for Box { - fn do_draw(&self, out: &mut Write) -> io::Result<()> { + fn do_draw(&self, out: &mut dyn Write) -> io::Result<()> { (**self).do_draw(out) } } @@ -36,7 +36,7 @@ pub trait DrawWithNeighbors: Positioned { #[allow(clippy::borrowed_box)] fn do_draw_with_neighbors<'a, 'b>( &'a self, - out: &'b mut Write, + out: &'b mut dyn Write, neighbors: &'a Neighbors>>, ) -> io::Result<()>; } @@ -44,7 +44,7 @@ pub trait DrawWithNeighbors: Positioned { impl DrawWithNeighbors for T { fn do_draw_with_neighbors<'a, 'b>( &'a self, - out: &'b mut Write, + out: &'b mut dyn Write, _neighbors: &'a Neighbors>>, ) -> io::Result<()> { self.do_draw(out) diff --git a/src/display/viewport.rs b/src/display/viewport.rs index 5ff56be0a9..9d17bc87dc 100644 --- a/src/display/viewport.rs +++ b/src/display/viewport.rs @@ -68,7 +68,7 @@ impl Viewport { } impl Debug for Viewport { - fn fmt(&self, f: &mut fmt::Formatter) -> fmt::Result { + fn fmt(&self, f: &mut fmt::Formatter<'_>) -> fmt::Result { write!( f, "Viewport {{ outer: {:?}, inner: {:?}, out: }}", diff --git a/src/entities/character.rs b/src/entities/character.rs index 2b1b6efe47..360478e8be 100644 --- a/src/entities/character.rs +++ b/src/entities/character.rs @@ -42,7 +42,7 @@ impl Character { } impl display::Draw for Character { - fn do_draw(&self, out: &mut Write) -> io::Result<()> { + fn do_draw(&self, out: &mut dyn Write) -> io::Result<()> { write!(out, "@") } } diff --git a/src/entities/creature.rs b/src/entities/creature.rs index 87ffda161e..20071c1d88 100644 --- a/src/entities/creature.rs +++ b/src/entities/creature.rs @@ -57,7 +57,7 @@ impl Describe for Creature { } impl display::Draw for Creature { - fn do_draw(&self, out: &mut Write) -> io::Result<()> { + fn do_draw(&self, out: &mut dyn Write) -> io::Result<()> { write!(out, "{}", self.typ.chr) } } diff --git a/src/entities/entity.rs b/src/entities/entity.rs index e43175931b..01075d298f 100644 --- a/src/entities/entity.rs +++ b/src/entities/entity.rs @@ -103,7 +103,7 @@ impl_downcast!(Entity); impl DrawWithNeighbors for Box { fn do_draw_with_neighbors<'a, 'b>( &'a self, - out: &'b mut Write, + out: &'b mut dyn Write, neighbors: &'a Neighbors>>, ) -> io::Result<()> { (**self).do_draw_with_neighbors(out, neighbors) diff --git a/src/entities/entity_char.rs b/src/entities/entity_char.rs index 2f84582002..88ca8a55a8 100644 --- a/src/entities/entity_char.rs +++ b/src/entities/entity_char.rs @@ -12,7 +12,7 @@ pub struct EntityChar { } impl Display for EntityChar { - fn fmt(&self, f: &mut Formatter) -> fmt::Result { + fn fmt(&self, f: &mut Formatter<'_>) -> fmt::Result { write!( f, "{}{}{}", diff --git a/src/entities/environment.rs b/src/entities/environment.rs index 042873ec5a..8f8a567062 100644 --- a/src/entities/environment.rs +++ b/src/entities/environment.rs @@ -21,7 +21,7 @@ impl Wall { impl display::DrawWithNeighbors for Wall { fn do_draw_with_neighbors<'a, 'b>( &'a self, - out: &'b mut Write, + out: &'b mut dyn Write, neighbors: &'a Neighbors>>, ) -> io::Result<()> { let neighbor_styles: Neighbors> = diff --git a/src/entities/item.rs b/src/entities/item.rs index 6e47a87f5b..aa99fb42e2 100644 --- a/src/entities/item.rs +++ b/src/entities/item.rs @@ -44,7 +44,7 @@ impl Describe for Item { } impl display::Draw for Item { - fn do_draw(&self, out: &mut Write) -> io::Result<()> { + fn do_draw(&self, out: &mut dyn Write) -> io::Result<()> { write!(out, "{}", self.typ.chr) } } diff --git a/src/game.rs b/src/game.rs index add48e8bfd..2c69061516 100644 --- a/src/game.rs +++ b/src/game.rs @@ -69,7 +69,7 @@ impl PromptResolution { use PromptResolution::*; match self { Cancellable(complete) => complete.cancel(), - Uncancellable(complete) => {} + Uncancellable(_complete) => {} } } } @@ -200,12 +200,10 @@ impl<'a> Game<'a> { fn collision_at(&self, pos: Position) -> Option { if !pos.within(self.viewport.inner) { Some(Collision::Stop) + } else if self.creatures_at(pos).is_empty() { + None } else { - if self.creatures_at(pos).is_empty() { - None - } else { - Some(Collision::Combat) - } + Some(Collision::Combat) } } @@ -305,7 +303,7 @@ impl<'a> Game<'a> { } /// Step the game forward the given number of ticks - fn tick(&mut self, ticks: Ticks) {} + fn tick(&mut self, _ticks: Ticks) {} /// Get a message from the global map based on the rng in this game fn message<'params>( diff --git a/src/main.rs b/src/main.rs index 2cd0bbc08d..8004a5739e 100644 --- a/src/main.rs +++ b/src/main.rs @@ -1,13 +1,7 @@ -extern crate termion; #[macro_use] extern crate log; -extern crate config; -extern crate log4rs; -extern crate serde; -extern crate toml; #[macro_use] extern crate serde_derive; -extern crate serde_json; #[macro_use] extern crate clap; #[macro_use] @@ -19,14 +13,13 @@ extern crate lazy_static; extern crate maplit; #[macro_use] extern crate downcast_rs; -extern crate backtrace; #[macro_use] extern crate include_dir; #[macro_use] extern crate nom; +#[cfg(test)] #[macro_use] extern crate matches; -extern crate futures; #[macro_use] mod util; @@ -53,6 +46,7 @@ use backtrace::Backtrace; use std::io::{self, StdinLock, StdoutLock}; use std::panic; +use termion; use termion::raw::IntoRawMode; use termion::raw::RawTerminal; diff --git a/src/types/entity_map.rs b/src/types/entity_map.rs index bec16cdab2..202d8b593e 100644 --- a/src/types/entity_map.rs +++ b/src/types/entity_map.rs @@ -10,7 +10,7 @@ use alga::general::{ use std::collections::{hash_map, BTreeMap, HashMap}; use std::iter::FromIterator; -#[derive(Debug, Clone)] +#[derive(Debug, Clone, Default)] pub struct EntityMap { by_position: BTreeMap>, by_id: HashMap, @@ -24,7 +24,7 @@ impl PartialEq for EntityMap { } impl Eq for EntityMap {} -const BY_POS_INVARIANT: &'static str = +const BY_POS_INVARIANT: &str = "Invariant: All references in EntityMap.by_position should point to existent references in by_id"; impl EntityMap { @@ -54,26 +54,26 @@ impl EntityMap { /// Remove all entities at the given position pub fn remove_all_at(&mut self, pos: Position) { - self.by_position.remove(&pos).map(|eids| { + if let Some(eids) = self.by_position.remove(&pos) { for eid in eids { self.by_id.remove(&eid).expect(BY_POS_INVARIANT); } - }); + } } - pub fn get<'a>(&'a self, id: EntityID) -> Option<&'a A> { + pub fn get(&self, id: EntityID) -> Option<&A> { self.by_id.get(&id) } - pub fn get_mut<'a>(&'a mut self, id: EntityID) -> Option<&'a mut A> { + pub fn get_mut(&mut self, id: EntityID) -> Option<&mut A> { self.by_id.get_mut(&id) } - pub fn entities<'a>(&'a self) -> impl Iterator { + pub fn entities(&self) -> impl Iterator { self.by_id.values() } - pub fn entities_mut<'a>(&'a mut self) -> impl Iterator { + pub fn entities_mut(&mut self) -> impl Iterator { self.by_id.values_mut() } @@ -81,8 +81,8 @@ impl EntityMap { self.by_id.keys() } - pub fn drain<'a>(&'a mut self) -> Drain<'a, A> { - let ids = self.ids().map(|e| *e).collect::>(); + pub fn drain(&mut self) -> Drain<'_, A> { + let ids = self.ids().copied().collect::>(); Drain { map: self, ids_iter: Box::new(ids.into_iter()), @@ -103,7 +103,7 @@ impl> EntityMap { self.by_id.entry(entity_id).or_insert(entity); self.by_position .entry(pos) - .or_insert(Vec::new()) + .or_insert_with(Vec::new) .push(entity_id); entity_id } @@ -113,12 +113,14 @@ impl> EntityMap { self.by_id.remove(&id).map(|e| { let mut empty = false; let position = e.position(); - self.by_position.get_mut(&position).map(|es| { + + if let Some(es) = self.by_position.get_mut(&position) { es.retain(|e| *e != id); - if es.len() == 0 { + if es.is_empty() { empty = true; } - }); + } + if empty { self.by_position.remove(&position); } @@ -172,7 +174,7 @@ impl<'a, A: Positioned + Identified> IntoIterator type Item = (&'a EntityID, &'a A); type IntoIter = std::collections::hash_map::Iter<'a, EntityID, A>; fn into_iter(self) -> Self::IntoIter { - (&self.by_id).into_iter() + (&self.by_id).iter() } } @@ -246,20 +248,21 @@ impl EntityMap { old_pos = Some(entity.position()); entity.set_position(new_position); } - old_pos.map(|p| { - self.by_position - .get_mut(&p) - .map(|es| es.retain(|e| *e != entity_id)); + + if let Some(p) = old_pos { + if let Some(es) = self.by_position.get_mut(&p) { + es.retain(|e| *e != entity_id); + } self.by_position .entry(new_position) - .or_insert(Vec::new()) + .or_insert_with(Vec::new) .push(entity_id); - }); + } } } -pub struct Drain<'a, A: 'a> { +pub struct Drain<'a, A> { map: &'a mut EntityMap, ids_iter: Box + 'a>, } @@ -313,9 +316,7 @@ mod tests { fn gen_entity_map() -> BoxedStrategy> { any::>() .prop_map(|ents| { - ents.iter() - .map(|e| e.clone()) - .collect::>() + ents.iter().cloned().collect::>() }) .boxed() } diff --git a/src/types/mod.rs b/src/types/mod.rs index 21748bac90..31d2ecd297 100644 --- a/src/types/mod.rs +++ b/src/types/mod.rs @@ -427,6 +427,7 @@ impl Neighbors> { #[cfg(test)] mod tests { + #![allow(clippy::unnecessary_operation)] use super::*; use proptest::prelude::*; diff --git a/src/util/promise.rs b/src/util/promise.rs index 63fbca1ddc..22f1e8b47f 100644 --- a/src/util/promise.rs +++ b/src/util/promise.rs @@ -3,9 +3,11 @@ use std::pin::Pin; use std::sync::{Arc, RwLock}; use std::task::{Context, Poll, Waker}; +type Waiter = Box; + pub struct Promise { inner: Arc>>, - waiters: Arc>>>, + waiters: Arc>>>, } pub struct Complete { @@ -29,7 +31,7 @@ pub fn promise() -> (Complete, Promise) { inner: inner.clone(), waiters: Arc::new(RwLock::new(Vec::new())), }; - let complete = Complete { inner: inner }; + let complete = Complete { inner }; (complete, promise) } @@ -127,7 +129,7 @@ impl> Give for &P { impl Future for Promise { type Output = Arc; - fn poll(self: Pin<&mut Self>, cx: &mut Context) -> Poll { + fn poll(self: Pin<&mut Self>, cx: &mut Context<'_>) -> Poll { let mut inner = self.inner.write().unwrap(); match inner.value { Some(ref v) => Poll::Ready(v.clone()), diff --git a/src/util/template.rs b/src/util/template.rs index a3faadc31c..bb77f9b4d6 100644 --- a/src/util/template.rs +++ b/src/util/template.rs @@ -18,7 +18,7 @@ impl<'a> Path<'a> { } impl<'a> Display for Path<'a> { - fn fmt(&self, f: &mut fmt::Formatter) -> fmt::Result { + fn fmt(&self, f: &mut fmt::Formatter<'_>) -> fmt::Result { write!(f, "{}", self.head)?; for part in &self.tail { write!(f, ".{}", part)?; @@ -96,7 +96,7 @@ impl<'a> TemplateVisitor<'a> { impl<'a> serde::de::Visitor<'a> for TemplateVisitor<'a> { type Value = Template<'a>; - fn expecting(&self, formatter: &mut fmt::Formatter) -> fmt::Result { + fn expecting(&self, formatter: &mut fmt::Formatter<'_>) -> fmt::Result { formatter.write_str("a valid template string") } @@ -126,7 +126,7 @@ impl<'a> Template<'a> { input: &'a str, ) -> Result, Err<(&'a str, ErrorKind)>> { let (remaining, res) = template(input)?; - if remaining.len() > 0 { + if !remaining.is_empty() { unreachable!(); } Ok(res) @@ -157,7 +157,7 @@ pub enum TemplateError<'a> { } impl<'a> Display for TemplateError<'a> { - fn fmt(&self, f: &mut fmt::Formatter) -> fmt::Result { + fn fmt(&self, f: &mut fmt::Formatter<'_>) -> fmt::Result { use TemplateError::*; match self { MissingParam(path) => { @@ -179,7 +179,7 @@ impl<'a> TemplateParams<'a> { match self { Direct(_) => None, Nested(m) => m.get(path.head).and_then(|next| { - if path.tail.len() == 0 { + if path.tail.is_empty() { match next { Direct(s) => Some(*s), _ => None, -- cgit 1.4.1 From 48fb3f6624b95e9b18a5ff0a814573445c6bc2ab Mon Sep 17 00:00:00 2001 From: Griffin Smith Date: Sat, 3 Aug 2019 15:59:05 -0400 Subject: Add inventory, and the ability to pick up items Add inventory as a basic vector of items attached to the character, and the ability to pick up a single item where the character stands --- src/display/color.rs | 9 +++++++++ src/entities/character.rs | 3 +++ src/entities/entity_char.rs | 2 +- src/entities/item.rs | 2 +- src/entities/raw_types.rs | 4 ++-- src/game.rs | 42 ++++++++++++++++++++++++++++++++++++++++-- src/messages.toml | 1 + src/types/command.rs | 6 ++++++ 8 files changed, 63 insertions(+), 6 deletions(-) diff --git a/src/display/color.rs b/src/display/color.rs index b1e799c5ed..afe0039998 100644 --- a/src/display/color.rs +++ b/src/display/color.rs @@ -15,6 +15,15 @@ impl Color { } } +impl PartialEq for Color { + fn eq(&self, other: &Self) -> bool { + format!("{}{}", color::Fg(self), color::Bg(self)) + == format!("{}{}", color::Fg(other), color::Bg(other)) + } +} + +impl Eq for Color {} + impl color::Color for Color { fn write_fg(&self, f: &mut fmt::Formatter<'_>) -> fmt::Result { self.0.write_fg(f) diff --git a/src/entities/character.rs b/src/entities/character.rs index 360478e8be..3e8336b129 100644 --- a/src/entities/character.rs +++ b/src/entities/character.rs @@ -1,4 +1,5 @@ use crate::display; +use crate::entities::item::Item; use crate::types::{Position, Speed}; use std::io::{self, Write}; @@ -7,6 +8,7 @@ const DEFAULT_SPEED: Speed = Speed(100); entity! { pub struct Character { pub o_name: Option, + pub inventory: Vec>, } } @@ -18,6 +20,7 @@ impl Character { id: None, position: Position { x: 0, y: 0 }, o_name: None, + inventory: Vec::new(), } } diff --git a/src/entities/entity_char.rs b/src/entities/entity_char.rs index 88ca8a55a8..70f26bfffd 100644 --- a/src/entities/entity_char.rs +++ b/src/entities/entity_char.rs @@ -2,7 +2,7 @@ use crate::display::color::Color; use std::fmt::{self, Display, Formatter}; use termion::color; -#[derive(Debug, Deserialize)] +#[derive(Debug, Deserialize, PartialEq, Eq)] pub struct EntityChar { #[serde(default)] color: Color, diff --git a/src/entities/item.rs b/src/entities/item.rs index aa99fb42e2..5f08780d4f 100644 --- a/src/entities/item.rs +++ b/src/entities/item.rs @@ -4,7 +4,7 @@ use crate::entities::{Describe, EntityID}; use crate::types::Position; use std::io::{self, Write}; -#[derive(Debug, Clone)] +#[derive(Debug, Clone, PartialEq, Eq)] pub struct Item { pub id: Option, pub typ: &'static ItemType<'static>, diff --git a/src/entities/raw_types.rs b/src/entities/raw_types.rs index 59dd19ed2f..4bc291b695 100644 --- a/src/entities/raw_types.rs +++ b/src/entities/raw_types.rs @@ -17,7 +17,7 @@ pub struct CreatureType<'a> { pub friendly: bool, } -#[derive(Debug, Deserialize)] +#[derive(Debug, Deserialize, PartialEq, Eq)] pub struct EdibleItem<'a> { #[serde(borrow)] pub eat_message: Option>, @@ -26,7 +26,7 @@ pub struct EdibleItem<'a> { pub hitpoints_healed: u16, } -#[derive(Debug, Deserialize)] +#[derive(Debug, Deserialize, PartialEq, Eq)] pub struct ItemType<'a> { pub name: &'a str, diff --git a/src/game.rs b/src/game.rs index 2c69061516..c478e0d2f5 100644 --- a/src/game.rs +++ b/src/game.rs @@ -1,5 +1,7 @@ use crate::description::list_to_sentence; use crate::display::{self, Viewport}; +use crate::entities::entity::Describe; +use crate::entities::entity::Entity; use crate::entities::{ AnEntity, Character, Creature, EntityID, Identified, Item, }; @@ -187,8 +189,7 @@ impl<'a> Game<'a> { } } - /// Returns a list of all creature entities at the given position - fn creatures_at<'b>(&'b self, pos: Position) -> Vec<&'b Creature> { + fn downcast_entities_at(&self, pos: Position) -> Vec<&A> { self.entities .at(pos) .iter() @@ -196,6 +197,16 @@ impl<'a> Game<'a> { .collect() } + /// Returns a list of all creature entities at the given position + fn creatures_at(&self, pos: Position) -> Vec<&Creature> { + self.downcast_entities_at(pos) + } + + /// Returns a list of all item entities at the given position + fn items_at(&self, pos: Position) -> Vec<&Item> { + self.downcast_entities_at(pos) + } + /// Returns a collision, if any, at the given Position in the game fn collision_at(&self, pos: Position) -> Option { if !pos.within(self.viewport.inner) { @@ -436,6 +447,31 @@ impl<'a> Game<'a> { } } + fn pick_up(&mut self) -> io::Result<()> { + let pos = self.character().position; + let items = self.items_at(pos); + match items.len() { + 0 => Ok(()), + 1 => { + let item_id = items.get(0).unwrap().id(); + let item: Box = + self.entities.remove(item_id).unwrap().downcast().unwrap(); + let desc = item.description(); + self.mut_character().inventory.push(item); + self.say( + "global.pick_up", + &template_params!({ + "item" => { "name" => &desc, }, + }), + ) + } + _ => { + // TODO prompt with a menu of items to pick up + unimplemented!() + } + } + } + fn flush_promises(&mut self) { unsafe { let game = self as *mut Self; @@ -498,6 +534,8 @@ impl<'a> Game<'a> { Some(PreviousMessage) => self.previous_message()?, + Some(PickUp) => self.pick_up()?, + None => (), } diff --git a/src/messages.toml b/src/messages.toml index 7c6255142d..a9a6b2e009 100644 --- a/src/messages.toml +++ b/src/messages.toml @@ -2,6 +2,7 @@ welcome = "Welcome to Xanthous, {{character.name}}! It's dangerous out there, why not stay inside?" describe_entities = "You see here {{descriptions}}" describe_no_entities = "You see nothing here." +pick_up = "You pick up the {{item.name}}." [combat] attack = "You attack the {{creature.name}}." diff --git a/src/types/command.rs b/src/types/command.rs index 15017cde99..17ca4d280f 100644 --- a/src/types/command.rs +++ b/src/types/command.rs @@ -10,6 +10,9 @@ pub enum Command { /// Move the character in a direction Move(Direction), + /// Pick up any item(s) at the current position + PickUp, + /// Display the previous message PreviousMessage, } @@ -19,6 +22,7 @@ impl Command { use Command::*; match k { Char('q') => Some(Quit), + Char('h') | Char('a') | Key::Left => Some(Move(Left)), Char('k') | Char('w') | Key::Up => Some(Move(Up)), Char('j') | Char('s') | Key::Down => Some(Move(Down)), @@ -29,6 +33,8 @@ impl Command { Char('n') => Some(Move(DownRight)), Ctrl('p') => Some(PreviousMessage), + Char(',') => Some(PickUp), + _ => None, } } -- cgit 1.4.1 From e2d2f011c6373894b3cdcfbdb98fbc783504561a Mon Sep 17 00:00:00 2001 From: Griffin Smith Date: Sat, 3 Aug 2019 20:26:07 -0400 Subject: Add method for writing option menus to viewport Add a method for writing single-choice menus to the viewport, within a box. Unused for now. --- src/display/draw_box.rs | 22 +++++++++++---- src/display/viewport.rs | 74 ++++++++++++++++++++++++++++++++++++++----------- src/types/menu.rs | 31 +++++++++++++++++++++ src/types/mod.rs | 11 ++++++++ 4 files changed, 116 insertions(+), 22 deletions(-) create mode 100644 src/types/menu.rs diff --git a/src/display/draw_box.rs b/src/display/draw_box.rs index 1b3958cefc..e4d34a7acd 100644 --- a/src/display/draw_box.rs +++ b/src/display/draw_box.rs @@ -1,5 +1,6 @@ use crate::display::utils::clone_times; use crate::display::utils::times; +use crate::types::pos; use crate::types::BoundingBox; use crate::types::Dimensions; use crate::types::Neighbors; @@ -215,12 +216,21 @@ pub fn draw_box( bbox: BoundingBox, style: BoxStyle, ) -> io::Result<()> { - write!( - out, - "{}{}", - bbox.position.cursor_goto(), - make_box(style, bbox.dimensions) - ) + let box_str = make_box(style, bbox.dimensions); + if bbox.position.x == 0 { + write!(out, "{}{}", bbox.position.cursor_goto(), box_str)?; + } else { + for (i, line) in box_str.split("\n\r").enumerate() { + debug!("line: {:?}!", line); + write!( + out, + "{}{}", + (bbox.position + pos(0, i as i16)).cursor_goto(), + line + )?; + } + } + Ok(()) } #[cfg(test)] diff --git a/src/display/viewport.rs b/src/display/viewport.rs index 9d17bc87dc..c44316cdaa 100644 --- a/src/display/viewport.rs +++ b/src/display/viewport.rs @@ -3,6 +3,7 @@ use super::DrawWithNeighbors; use crate::display::draw_box::draw_box; use crate::display::utils::clone_times; use crate::entities::entity::Entity; +use crate::types::menu::MenuInfo; use crate::types::Neighbors; use crate::types::{pos, BoundingBox, Direction, Position, Positioned}; use std::fmt::{self, Debug}; @@ -192,6 +193,41 @@ impl Viewport { self.cursor_state = CursorState::Game; Ok(()) } + + pub fn write_menu(&mut self, menu: &MenuInfo) -> io::Result<()> { + let menu_dims = menu.dimensions(); + + // TODO: check if the menu is too big + + let menu_position = self.game.position + pos(1, 1); + + let menu_box = BoundingBox { + dimensions: menu_dims, + position: menu_position, + }; + + debug!("writing menu at: {:?}", menu_box); + + draw_box(self, menu_box, BoxStyle::Thin)?; + + write!( + self, + "{}{}", + (menu_position + pos(2, 2)).cursor_goto(), + menu.prompt + )?; + + for (idx, option) in menu.options.iter().enumerate() { + write!( + self, + "{}{}", + (menu_position + pos(2, 4 + idx as i16)).cursor_goto(), + option + )?; + } + + Ok(()) + } } impl Positioned for Viewport { @@ -218,7 +254,6 @@ impl Write for Viewport { mod tests { use super::*; use crate::types::Dimensions; - // use proptest::prelude::*; #[test] fn test_visible() { @@ -243,19 +278,26 @@ mod tests { .visible(&Position { x: 1, y: 1 })); } - // proptest! { - // #[test] - // fn nothing_is_visible_in_viewport_off_screen(pos: Position, outer: BoundingBox) { - // let invisible_viewport = Viewport { - // outer, - // inner: BoundingBox { - // position: Position {x: -(outer.dimensions.w as i16), y: -(outer.dimensions.h as i16)}, - // dimensions: outer.dimensions, - // }, - // out: () - // }; - - // assert!(!invisible_viewport.visible(&pos)); - // } - // } + #[test] + fn test_write_menu() { + let buf: Vec = Vec::new(); + + let mut viewport = Viewport::new( + BoundingBox::at_origin(Dimensions::default()), + BoundingBox::at_origin(Dimensions::default()), + buf, + ); + + let menu = MenuInfo::new( + "Test menu".to_string(), + vec!["option 1".to_string(), "option 2".to_string()], + ); + + viewport.write_menu(&menu).unwrap(); + + let res = std::str::from_utf8(&viewport.out).unwrap(); + assert!(res.contains("Test menu")); + assert!(res.contains("option 1")); + assert!(res.contains("option 2")); + } } diff --git a/src/types/menu.rs b/src/types/menu.rs new file mode 100644 index 0000000000..63abc83778 --- /dev/null +++ b/src/types/menu.rs @@ -0,0 +1,31 @@ +use crate::types::Dimensions; + +#[derive(Debug, Clone, PartialEq, Eq)] +pub struct MenuInfo { + pub prompt: String, + pub options: Vec, +} + +impl MenuInfo { + pub fn new(prompt: String, options: Vec) -> Self { + MenuInfo { prompt, options } + } + + /// Returns the inner dimensions of a box necessary to draw this menu. Will + /// not trim either dimension to the size of the terminal + pub fn dimensions(&self) -> Dimensions { + Dimensions { + w: self + .options + .iter() + .map(|s| s.len()) + .max() + .unwrap_or(0) + .max(self.prompt.len()) as u16 + + 4, + h: self.options.len() as u16 + + if self.prompt.is_empty() { 0 } else { 2 } + + 4, + } + } +} diff --git a/src/types/mod.rs b/src/types/mod.rs index 31d2ecd297..d417e873d8 100644 --- a/src/types/mod.rs +++ b/src/types/mod.rs @@ -5,10 +5,13 @@ use std::cmp::max; use std::cmp::Ordering; use std::ops; use std::rc::Rc; + pub mod collision; pub mod command; pub mod direction; pub mod entity_map; +pub mod menu; + pub use collision::Collision; pub use direction::Direction; pub use direction::Direction::*; @@ -78,6 +81,14 @@ impl BoundingBox { }) } + pub fn ll_corner(self) -> Position { + self.position + + (Position { + x: 0, + y: self.dimensions.h as i16, + }) + } + /// Returns a bounding box representing the *inside* of this box if it was /// drawn on the screen. pub fn inner(self) -> BoundingBox { -- cgit 1.4.1 From fb0d1b3e66251aa56a3df1d05fd4b82b33380a31 Mon Sep 17 00:00:00 2001 From: Griffin Smith Date: Sun, 25 Aug 2019 13:25:13 -0400 Subject: Wipe Rust project Sorry rust, but you're just not fun to write --- Cargo.lock | 1450 ----------------------------- Cargo.toml | 33 - Config.toml | 2 - proptest-regressions/description.txt | 7 - proptest-regressions/display/draw_box.txt | 12 - proptest-regressions/display/viewport.txt | 7 - proptest-regressions/types/entity_map.txt | 9 - proptest-regressions/types/mod.txt | 8 - rustfmt.toml | 1 - src/cli.yml | 46 - src/description.rs | 93 -- src/display/color.rs | 163 ---- src/display/draw_box.rs | 274 ------ src/display/mod.rs | 52 -- src/display/utils.rs | 9 - src/display/viewport.rs | 303 ------ src/entities/character.rs | 51 - src/entities/creature.rs | 63 -- src/entities/entity.rs | 125 --- src/entities/entity_char.rs | 24 - src/entities/environment.rs | 36 - src/entities/item.rs | 50 - src/entities/mod.rs | 20 - src/entities/raw_types.rs | 110 --- src/entities/raws.rs | 38 - src/entities/raws/gormlak.toml | 10 - src/entities/raws/noodles.json | 15 - src/entities/util.rs | 72 -- src/game.rs | 617 ------------ src/level_gen/cave_automata.rs | 120 --- src/level_gen/mod.rs | 101 -- src/level_gen/util.rs | 52 -- src/main.rs | 130 --- src/messages.rs | 166 ---- src/messages.toml | 27 - src/settings.rs | 70 -- src/types/collision.rs | 9 - src/types/command.rs | 41 - src/types/direction.rs | 13 - src/types/entity_map.rs | 430 --------- src/types/menu.rs | 31 - src/types/mod.rs | 504 ---------- src/util/mod.rs | 7 - src/util/promise.rs | 160 ---- src/util/static_cfg.rs | 147 --- src/util/template.rs | 362 ------- src/util/trait_impls.rs | 17 - 47 files changed, 6087 deletions(-) delete mode 100644 Cargo.lock delete mode 100644 Cargo.toml delete mode 100644 Config.toml delete mode 100644 proptest-regressions/description.txt delete mode 100644 proptest-regressions/display/draw_box.txt delete mode 100644 proptest-regressions/display/viewport.txt delete mode 100644 proptest-regressions/types/entity_map.txt delete mode 100644 proptest-regressions/types/mod.txt delete mode 100644 rustfmt.toml delete mode 100644 src/cli.yml delete mode 100644 src/description.rs delete mode 100644 src/display/color.rs delete mode 100644 src/display/draw_box.rs delete mode 100644 src/display/mod.rs delete mode 100644 src/display/utils.rs delete mode 100644 src/display/viewport.rs delete mode 100644 src/entities/character.rs delete mode 100644 src/entities/creature.rs delete mode 100644 src/entities/entity.rs delete mode 100644 src/entities/entity_char.rs delete mode 100644 src/entities/environment.rs delete mode 100644 src/entities/item.rs delete mode 100644 src/entities/mod.rs delete mode 100644 src/entities/raw_types.rs delete mode 100644 src/entities/raws.rs delete mode 100644 src/entities/raws/gormlak.toml delete mode 100644 src/entities/raws/noodles.json delete mode 100644 src/entities/util.rs delete mode 100644 src/game.rs delete mode 100644 src/level_gen/cave_automata.rs delete mode 100644 src/level_gen/mod.rs delete mode 100644 src/level_gen/util.rs delete mode 100644 src/main.rs delete mode 100644 src/messages.rs delete mode 100644 src/messages.toml delete mode 100644 src/settings.rs delete mode 100644 src/types/collision.rs delete mode 100644 src/types/command.rs delete mode 100644 src/types/direction.rs delete mode 100644 src/types/entity_map.rs delete mode 100644 src/types/menu.rs delete mode 100644 src/types/mod.rs delete mode 100644 src/util/mod.rs delete mode 100644 src/util/promise.rs delete mode 100644 src/util/static_cfg.rs delete mode 100644 src/util/template.rs delete mode 100644 src/util/trait_impls.rs diff --git a/Cargo.lock b/Cargo.lock deleted file mode 100644 index 214b78f625..0000000000 --- a/Cargo.lock +++ /dev/null @@ -1,1450 +0,0 @@ -# This file is automatically @generated by Cargo. -# It is not intended for manual editing. -[[package]] -name = "adler32" -version = "1.0.3" -source = "registry+https://github.com/rust-lang/crates.io-index" - -[[package]] -name = "aho-corasick" -version = "0.7.3" -source = "registry+https://github.com/rust-lang/crates.io-index" -dependencies = [ - "memchr 2.2.0 (registry+https://github.com/rust-lang/crates.io-index)", -] - -[[package]] -name = "alga" -version = "0.9.1" -source = "registry+https://github.com/rust-lang/crates.io-index" -dependencies = [ - "approx 0.3.2 (registry+https://github.com/rust-lang/crates.io-index)", - "libm 0.1.4 (registry+https://github.com/rust-lang/crates.io-index)", - "num-complex 0.2.3 (registry+https://github.com/rust-lang/crates.io-index)", - "num-traits 0.2.8 (registry+https://github.com/rust-lang/crates.io-index)", -] - -[[package]] -name = "ansi_term" -version = "0.11.0" -source = "registry+https://github.com/rust-lang/crates.io-index" -dependencies = [ - "winapi 0.3.7 (registry+https://github.com/rust-lang/crates.io-index)", -] - -[[package]] -name = "antidote" -version = "1.0.0" -source = "registry+https://github.com/rust-lang/crates.io-index" - -[[package]] -name = "approx" -version = "0.3.2" -source = "registry+https://github.com/rust-lang/crates.io-index" -dependencies = [ - "num-traits 0.2.8 (registry+https://github.com/rust-lang/crates.io-index)", -] - -[[package]] -name = "arc-swap" -version = "0.3.11" -source = "registry+https://github.com/rust-lang/crates.io-index" - -[[package]] -name = "argon2rs" -version = "0.2.5" -source = "registry+https://github.com/rust-lang/crates.io-index" -dependencies = [ - "blake2-rfc 0.2.18 (registry+https://github.com/rust-lang/crates.io-index)", - "scoped_threadpool 0.1.9 (registry+https://github.com/rust-lang/crates.io-index)", -] - -[[package]] -name = "arrayvec" -version = "0.4.10" -source = "registry+https://github.com/rust-lang/crates.io-index" -dependencies = [ - "nodrop 0.1.13 (registry+https://github.com/rust-lang/crates.io-index)", -] - -[[package]] -name = "atty" -version = "0.2.11" -source = "registry+https://github.com/rust-lang/crates.io-index" -dependencies = [ - "libc 0.2.58 (registry+https://github.com/rust-lang/crates.io-index)", - "termion 1.5.2 (registry+https://github.com/rust-lang/crates.io-index)", - "winapi 0.3.7 (registry+https://github.com/rust-lang/crates.io-index)", -] - -[[package]] -name = "autocfg" -version = "0.1.4" -source = "registry+https://github.com/rust-lang/crates.io-index" - -[[package]] -name = "backtrace" -version = "0.3.32" -source = "registry+https://github.com/rust-lang/crates.io-index" -dependencies = [ - "backtrace-sys 0.1.30 (registry+https://github.com/rust-lang/crates.io-index)", - "cfg-if 0.1.9 (registry+https://github.com/rust-lang/crates.io-index)", - "libc 0.2.58 (registry+https://github.com/rust-lang/crates.io-index)", - "rustc-demangle 0.1.15 (registry+https://github.com/rust-lang/crates.io-index)", -] - -[[package]] -name = "backtrace-sys" -version = "0.1.30" -source = "registry+https://github.com/rust-lang/crates.io-index" -dependencies = [ - "cc 1.0.37 (registry+https://github.com/rust-lang/crates.io-index)", - "libc 0.2.58 (registry+https://github.com/rust-lang/crates.io-index)", -] - -[[package]] -name = "bit-set" -version = "0.5.1" -source = "registry+https://github.com/rust-lang/crates.io-index" -dependencies = [ - "bit-vec 0.5.1 (registry+https://github.com/rust-lang/crates.io-index)", -] - -[[package]] -name = "bit-vec" -version = "0.5.1" -source = "registry+https://github.com/rust-lang/crates.io-index" - -[[package]] -name = "bitflags" -version = "1.1.0" -source = "registry+https://github.com/rust-lang/crates.io-index" - -[[package]] -name = "blake2-rfc" -version = "0.2.18" -source = "registry+https://github.com/rust-lang/crates.io-index" -dependencies = [ - "arrayvec 0.4.10 (registry+https://github.com/rust-lang/crates.io-index)", - "constant_time_eq 0.1.3 (registry+https://github.com/rust-lang/crates.io-index)", -] - -[[package]] -name = "bstr" -version = "0.2.1" -source = "registry+https://github.com/rust-lang/crates.io-index" -dependencies = [ - "lazy_static 1.3.0 (registry+https://github.com/rust-lang/crates.io-index)", - "memchr 2.2.0 (registry+https://github.com/rust-lang/crates.io-index)", - "regex-automata 0.1.7 (registry+https://github.com/rust-lang/crates.io-index)", - "serde 1.0.92 (registry+https://github.com/rust-lang/crates.io-index)", -] - -[[package]] -name = "build_const" -version = "0.2.1" -source = "registry+https://github.com/rust-lang/crates.io-index" - -[[package]] -name = "byteorder" -version = "1.3.1" -source = "registry+https://github.com/rust-lang/crates.io-index" - -[[package]] -name = "c2-chacha" -version = "0.2.2" -source = "registry+https://github.com/rust-lang/crates.io-index" -dependencies = [ - "lazy_static 1.3.0 (registry+https://github.com/rust-lang/crates.io-index)", - "ppv-lite86 0.2.5 (registry+https://github.com/rust-lang/crates.io-index)", -] - -[[package]] -name = "cc" -version = "1.0.37" -source = "registry+https://github.com/rust-lang/crates.io-index" - -[[package]] -name = "cfg-if" -version = "0.1.9" -source = "registry+https://github.com/rust-lang/crates.io-index" - -[[package]] -name = "chrono" -version = "0.4.6" -source = "registry+https://github.com/rust-lang/crates.io-index" -dependencies = [ - "num-integer 0.1.41 (registry+https://github.com/rust-lang/crates.io-index)", - "num-traits 0.2.8 (registry+https://github.com/rust-lang/crates.io-index)", - "time 0.1.42 (registry+https://github.com/rust-lang/crates.io-index)", -] - -[[package]] -name = "clap" -version = "2.33.0" -source = "registry+https://github.com/rust-lang/crates.io-index" -dependencies = [ - "ansi_term 0.11.0 (registry+https://github.com/rust-lang/crates.io-index)", - "atty 0.2.11 (registry+https://github.com/rust-lang/crates.io-index)", - "bitflags 1.1.0 (registry+https://github.com/rust-lang/crates.io-index)", - "strsim 0.8.0 (registry+https://github.com/rust-lang/crates.io-index)", - "textwrap 0.11.0 (registry+https://github.com/rust-lang/crates.io-index)", - "unicode-width 0.1.5 (registry+https://github.com/rust-lang/crates.io-index)", - "vec_map 0.8.1 (registry+https://github.com/rust-lang/crates.io-index)", - "yaml-rust 0.3.5 (registry+https://github.com/rust-lang/crates.io-index)", -] - -[[package]] -name = "cloudabi" -version = "0.0.3" -source = "registry+https://github.com/rust-lang/crates.io-index" -dependencies = [ - "bitflags 1.1.0 (registry+https://github.com/rust-lang/crates.io-index)", -] - -[[package]] -name = "config" -version = "0.9.3" -source = "registry+https://github.com/rust-lang/crates.io-index" -dependencies = [ - "lazy_static 1.3.0 (registry+https://github.com/rust-lang/crates.io-index)", - "nom 4.2.3 (registry+https://github.com/rust-lang/crates.io-index)", - "rust-ini 0.13.0 (registry+https://github.com/rust-lang/crates.io-index)", - "serde 1.0.92 (registry+https://github.com/rust-lang/crates.io-index)", - "serde-hjson 0.8.2 (registry+https://github.com/rust-lang/crates.io-index)", - "serde_json 1.0.39 (registry+https://github.com/rust-lang/crates.io-index)", - "toml 0.4.10 (registry+https://github.com/rust-lang/crates.io-index)", - "yaml-rust 0.4.3 (registry+https://github.com/rust-lang/crates.io-index)", -] - -[[package]] -name = "constant_time_eq" -version = "0.1.3" -source = "registry+https://github.com/rust-lang/crates.io-index" - -[[package]] -name = "crc" -version = "1.8.1" -source = "registry+https://github.com/rust-lang/crates.io-index" -dependencies = [ - "build_const 0.2.1 (registry+https://github.com/rust-lang/crates.io-index)", -] - -[[package]] -name = "crc32fast" -version = "1.2.0" -source = "registry+https://github.com/rust-lang/crates.io-index" -dependencies = [ - "cfg-if 0.1.9 (registry+https://github.com/rust-lang/crates.io-index)", -] - -[[package]] -name = "csv" -version = "1.1.1" -source = "registry+https://github.com/rust-lang/crates.io-index" -dependencies = [ - "bstr 0.2.1 (registry+https://github.com/rust-lang/crates.io-index)", - "csv-core 0.1.6 (registry+https://github.com/rust-lang/crates.io-index)", - "itoa 0.4.4 (registry+https://github.com/rust-lang/crates.io-index)", - "ryu 1.0.0 (registry+https://github.com/rust-lang/crates.io-index)", - "serde 1.0.92 (registry+https://github.com/rust-lang/crates.io-index)", -] - -[[package]] -name = "csv-core" -version = "0.1.6" -source = "registry+https://github.com/rust-lang/crates.io-index" -dependencies = [ - "memchr 2.2.0 (registry+https://github.com/rust-lang/crates.io-index)", -] - -[[package]] -name = "dirs" -version = "1.0.5" -source = "registry+https://github.com/rust-lang/crates.io-index" -dependencies = [ - "libc 0.2.58 (registry+https://github.com/rust-lang/crates.io-index)", - "redox_users 0.3.0 (registry+https://github.com/rust-lang/crates.io-index)", - "winapi 0.3.7 (registry+https://github.com/rust-lang/crates.io-index)", -] - -[[package]] -name = "downcast-rs" -version = "1.0.4" -source = "registry+https://github.com/rust-lang/crates.io-index" - -[[package]] -name = "dtoa" -version = "0.4.4" -source = "registry+https://github.com/rust-lang/crates.io-index" - -[[package]] -name = "either" -version = "1.5.2" -source = "registry+https://github.com/rust-lang/crates.io-index" - -[[package]] -name = "encode_unicode" -version = "0.3.5" -source = "registry+https://github.com/rust-lang/crates.io-index" - -[[package]] -name = "failure" -version = "0.1.5" -source = "registry+https://github.com/rust-lang/crates.io-index" -dependencies = [ - "backtrace 0.3.32 (registry+https://github.com/rust-lang/crates.io-index)", - "failure_derive 0.1.5 (registry+https://github.com/rust-lang/crates.io-index)", -] - -[[package]] -name = "failure_derive" -version = "0.1.5" -source = "registry+https://github.com/rust-lang/crates.io-index" -dependencies = [ - "proc-macro2 0.4.30 (registry+https://github.com/rust-lang/crates.io-index)", - "quote 0.6.12 (registry+https://github.com/rust-lang/crates.io-index)", - "syn 0.15.35 (registry+https://github.com/rust-lang/crates.io-index)", - "synstructure 0.10.2 (registry+https://github.com/rust-lang/crates.io-index)", -] - -[[package]] -name = "flate2" -version = "1.0.7" -source = "registry+https://github.com/rust-lang/crates.io-index" -dependencies = [ - "crc32fast 1.2.0 (registry+https://github.com/rust-lang/crates.io-index)", - "libc 0.2.58 (registry+https://github.com/rust-lang/crates.io-index)", - "miniz-sys 0.1.12 (registry+https://github.com/rust-lang/crates.io-index)", - "miniz_oxide_c_api 0.2.1 (registry+https://github.com/rust-lang/crates.io-index)", -] - -[[package]] -name = "fnv" -version = "1.0.6" -source = "registry+https://github.com/rust-lang/crates.io-index" - -[[package]] -name = "fuchsia-cprng" -version = "0.1.1" -source = "registry+https://github.com/rust-lang/crates.io-index" - -[[package]] -name = "futures" -version = "0.1.28" -source = "registry+https://github.com/rust-lang/crates.io-index" - -[[package]] -name = "getrandom" -version = "0.1.6" -source = "registry+https://github.com/rust-lang/crates.io-index" -dependencies = [ - "lazy_static 1.3.0 (registry+https://github.com/rust-lang/crates.io-index)", - "libc 0.2.58 (registry+https://github.com/rust-lang/crates.io-index)", -] - -[[package]] -name = "glob" -version = "0.2.11" -source = "registry+https://github.com/rust-lang/crates.io-index" - -[[package]] -name = "humantime" -version = "1.2.0" -source = "registry+https://github.com/rust-lang/crates.io-index" -dependencies = [ - "quick-error 1.2.2 (registry+https://github.com/rust-lang/crates.io-index)", -] - -[[package]] -name = "include_dir" -version = "0.2.1" -source = "registry+https://github.com/rust-lang/crates.io-index" -dependencies = [ - "glob 0.2.11 (registry+https://github.com/rust-lang/crates.io-index)", - "include_dir_impl 0.2.1 (registry+https://github.com/rust-lang/crates.io-index)", - "proc-macro-hack 0.4.1 (registry+https://github.com/rust-lang/crates.io-index)", -] - -[[package]] -name = "include_dir_impl" -version = "0.2.1" -source = "registry+https://github.com/rust-lang/crates.io-index" -dependencies = [ - "failure 0.1.5 (registry+https://github.com/rust-lang/crates.io-index)", - "proc-macro-hack 0.4.1 (registry+https://github.com/rust-lang/crates.io-index)", - "proc-macro2 0.4.30 (registry+https://github.com/rust-lang/crates.io-index)", - "quote 0.6.12 (registry+https://github.com/rust-lang/crates.io-index)", - "syn 0.14.9 (registry+https://github.com/rust-lang/crates.io-index)", -] - -[[package]] -name = "itertools" -version = "0.8.0" -source = "registry+https://github.com/rust-lang/crates.io-index" -dependencies = [ - "either 1.5.2 (registry+https://github.com/rust-lang/crates.io-index)", -] - -[[package]] -name = "itoa" -version = "0.4.4" -source = "registry+https://github.com/rust-lang/crates.io-index" - -[[package]] -name = "lazy_static" -version = "0.2.11" -source = "registry+https://github.com/rust-lang/crates.io-index" - -[[package]] -name = "lazy_static" -version = "1.3.0" -source = "registry+https://github.com/rust-lang/crates.io-index" -dependencies = [ - "spin 0.5.0 (registry+https://github.com/rust-lang/crates.io-index)", -] - -[[package]] -name = "lexical-core" -version = "0.4.2" -source = "registry+https://github.com/rust-lang/crates.io-index" -dependencies = [ - "cfg-if 0.1.9 (registry+https://github.com/rust-lang/crates.io-index)", - "rustc_version 0.2.3 (registry+https://github.com/rust-lang/crates.io-index)", - "ryu 0.2.8 (registry+https://github.com/rust-lang/crates.io-index)", - "stackvector 1.0.6 (registry+https://github.com/rust-lang/crates.io-index)", - "static_assertions 0.2.5 (registry+https://github.com/rust-lang/crates.io-index)", -] - -[[package]] -name = "libc" -version = "0.2.58" -source = "registry+https://github.com/rust-lang/crates.io-index" - -[[package]] -name = "libm" -version = "0.1.4" -source = "registry+https://github.com/rust-lang/crates.io-index" - -[[package]] -name = "linked-hash-map" -version = "0.3.0" -source = "registry+https://github.com/rust-lang/crates.io-index" -dependencies = [ - "serde 0.8.23 (registry+https://github.com/rust-lang/crates.io-index)", - "serde_test 0.8.23 (registry+https://github.com/rust-lang/crates.io-index)", -] - -[[package]] -name = "linked-hash-map" -version = "0.5.2" -source = "registry+https://github.com/rust-lang/crates.io-index" - -[[package]] -name = "log" -version = "0.4.6" -source = "registry+https://github.com/rust-lang/crates.io-index" -dependencies = [ - "cfg-if 0.1.9 (registry+https://github.com/rust-lang/crates.io-index)", - "serde 1.0.92 (registry+https://github.com/rust-lang/crates.io-index)", -] - -[[package]] -name = "log-mdc" -version = "0.1.0" -source = "registry+https://github.com/rust-lang/crates.io-index" - -[[package]] -name = "log4rs" -version = "0.8.3" -source = "registry+https://github.com/rust-lang/crates.io-index" -dependencies = [ - "antidote 1.0.0 (registry+https://github.com/rust-lang/crates.io-index)", - "arc-swap 0.3.11 (registry+https://github.com/rust-lang/crates.io-index)", - "chrono 0.4.6 (registry+https://github.com/rust-lang/crates.io-index)", - "flate2 1.0.7 (registry+https://github.com/rust-lang/crates.io-index)", - "fnv 1.0.6 (registry+https://github.com/rust-lang/crates.io-index)", - "humantime 1.2.0 (registry+https://github.com/rust-lang/crates.io-index)", - "libc 0.2.58 (registry+https://github.com/rust-lang/crates.io-index)", - "log 0.4.6 (registry+https://github.com/rust-lang/crates.io-index)", - "log-mdc 0.1.0 (registry+https://github.com/rust-lang/crates.io-index)", - "serde 1.0.92 (registry+https://github.com/rust-lang/crates.io-index)", - "serde-value 0.5.3 (registry+https://github.com/rust-lang/crates.io-index)", - "serde_derive 1.0.92 (registry+https://github.com/rust-lang/crates.io-index)", - "serde_json 1.0.39 (registry+https://github.com/rust-lang/crates.io-index)", - "serde_yaml 0.8.9 (registry+https://github.com/rust-lang/crates.io-index)", - "thread-id 3.3.0 (registry+https://github.com/rust-lang/crates.io-index)", - "typemap 0.3.3 (registry+https://github.com/rust-lang/crates.io-index)", - "winapi 0.3.7 (registry+https://github.com/rust-lang/crates.io-index)", -] - -[[package]] -name = "maplit" -version = "1.0.1" -source = "registry+https://github.com/rust-lang/crates.io-index" - -[[package]] -name = "matches" -version = "0.1.8" -source = "registry+https://github.com/rust-lang/crates.io-index" - -[[package]] -name = "memchr" -version = "2.2.0" -source = "registry+https://github.com/rust-lang/crates.io-index" -dependencies = [ - "libc 0.2.58 (registry+https://github.com/rust-lang/crates.io-index)", -] - -[[package]] -name = "miniz-sys" -version = "0.1.12" -source = "registry+https://github.com/rust-lang/crates.io-index" -dependencies = [ - "cc 1.0.37 (registry+https://github.com/rust-lang/crates.io-index)", - "libc 0.2.58 (registry+https://github.com/rust-lang/crates.io-index)", -] - -[[package]] -name = "miniz_oxide" -version = "0.2.1" -source = "registry+https://github.com/rust-lang/crates.io-index" -dependencies = [ - "adler32 1.0.3 (registry+https://github.com/rust-lang/crates.io-index)", -] - -[[package]] -name = "miniz_oxide_c_api" -version = "0.2.1" -source = "registry+https://github.com/rust-lang/crates.io-index" -dependencies = [ - "cc 1.0.37 (registry+https://github.com/rust-lang/crates.io-index)", - "crc 1.8.1 (registry+https://github.com/rust-lang/crates.io-index)", - "libc 0.2.58 (registry+https://github.com/rust-lang/crates.io-index)", - "miniz_oxide 0.2.1 (registry+https://github.com/rust-lang/crates.io-index)", -] - -[[package]] -name = "nodrop" -version = "0.1.13" -source = "registry+https://github.com/rust-lang/crates.io-index" - -[[package]] -name = "nom" -version = "4.2.3" -source = "registry+https://github.com/rust-lang/crates.io-index" -dependencies = [ - "memchr 2.2.0 (registry+https://github.com/rust-lang/crates.io-index)", - "version_check 0.1.5 (registry+https://github.com/rust-lang/crates.io-index)", -] - -[[package]] -name = "nom" -version = "5.0.0" -source = "registry+https://github.com/rust-lang/crates.io-index" -dependencies = [ - "lexical-core 0.4.2 (registry+https://github.com/rust-lang/crates.io-index)", - "memchr 2.2.0 (registry+https://github.com/rust-lang/crates.io-index)", - "version_check 0.1.5 (registry+https://github.com/rust-lang/crates.io-index)", -] - -[[package]] -name = "num-complex" -version = "0.2.3" -source = "registry+https://github.com/rust-lang/crates.io-index" -dependencies = [ - "autocfg 0.1.4 (registry+https://github.com/rust-lang/crates.io-index)", - "num-traits 0.2.8 (registry+https://github.com/rust-lang/crates.io-index)", -] - -[[package]] -name = "num-integer" -version = "0.1.41" -source = "registry+https://github.com/rust-lang/crates.io-index" -dependencies = [ - "autocfg 0.1.4 (registry+https://github.com/rust-lang/crates.io-index)", - "num-traits 0.2.8 (registry+https://github.com/rust-lang/crates.io-index)", -] - -[[package]] -name = "num-traits" -version = "0.1.43" -source = "registry+https://github.com/rust-lang/crates.io-index" -dependencies = [ - "num-traits 0.2.8 (registry+https://github.com/rust-lang/crates.io-index)", -] - -[[package]] -name = "num-traits" -version = "0.2.8" -source = "registry+https://github.com/rust-lang/crates.io-index" -dependencies = [ - "autocfg 0.1.4 (registry+https://github.com/rust-lang/crates.io-index)", -] - -[[package]] -name = "numtoa" -version = "0.1.0" -source = "registry+https://github.com/rust-lang/crates.io-index" - -[[package]] -name = "ordered-float" -version = "1.0.2" -source = "registry+https://github.com/rust-lang/crates.io-index" -dependencies = [ - "num-traits 0.2.8 (registry+https://github.com/rust-lang/crates.io-index)", -] - -[[package]] -name = "ppv-lite86" -version = "0.2.5" -source = "registry+https://github.com/rust-lang/crates.io-index" - -[[package]] -name = "prettytable-rs" -version = "0.8.0" -source = "registry+https://github.com/rust-lang/crates.io-index" -dependencies = [ - "atty 0.2.11 (registry+https://github.com/rust-lang/crates.io-index)", - "csv 1.1.1 (registry+https://github.com/rust-lang/crates.io-index)", - "encode_unicode 0.3.5 (registry+https://github.com/rust-lang/crates.io-index)", - "lazy_static 1.3.0 (registry+https://github.com/rust-lang/crates.io-index)", - "term 0.5.2 (registry+https://github.com/rust-lang/crates.io-index)", - "unicode-width 0.1.5 (registry+https://github.com/rust-lang/crates.io-index)", -] - -[[package]] -name = "proc-macro-hack" -version = "0.4.1" -source = "registry+https://github.com/rust-lang/crates.io-index" -dependencies = [ - "proc-macro-hack-impl 0.4.1 (registry+https://github.com/rust-lang/crates.io-index)", -] - -[[package]] -name = "proc-macro-hack-impl" -version = "0.4.1" -source = "registry+https://github.com/rust-lang/crates.io-index" - -[[package]] -name = "proc-macro2" -version = "0.4.30" -source = "registry+https://github.com/rust-lang/crates.io-index" -dependencies = [ - "unicode-xid 0.1.0 (registry+https://github.com/rust-lang/crates.io-index)", -] - -[[package]] -name = "proptest" -version = "0.9.3" -source = "registry+https://github.com/rust-lang/crates.io-index" -dependencies = [ - "bit-set 0.5.1 (registry+https://github.com/rust-lang/crates.io-index)", - "bitflags 1.1.0 (registry+https://github.com/rust-lang/crates.io-index)", - "byteorder 1.3.1 (registry+https://github.com/rust-lang/crates.io-index)", - "lazy_static 1.3.0 (registry+https://github.com/rust-lang/crates.io-index)", - "num-traits 0.2.8 (registry+https://github.com/rust-lang/crates.io-index)", - "quick-error 1.2.2 (registry+https://github.com/rust-lang/crates.io-index)", - "rand 0.6.5 (registry+https://github.com/rust-lang/crates.io-index)", - "rand_chacha 0.1.1 (registry+https://github.com/rust-lang/crates.io-index)", - "rand_xorshift 0.1.1 (registry+https://github.com/rust-lang/crates.io-index)", - "regex-syntax 0.6.6 (registry+https://github.com/rust-lang/crates.io-index)", - "rusty-fork 0.2.2 (registry+https://github.com/rust-lang/crates.io-index)", - "tempfile 3.0.8 (registry+https://github.com/rust-lang/crates.io-index)", -] - -[[package]] -name = "proptest-derive" -version = "0.1.1" -source = "registry+https://github.com/rust-lang/crates.io-index" -dependencies = [ - "proc-macro2 0.4.30 (registry+https://github.com/rust-lang/crates.io-index)", - "quote 0.6.12 (registry+https://github.com/rust-lang/crates.io-index)", - "syn 0.15.35 (registry+https://github.com/rust-lang/crates.io-index)", -] - -[[package]] -name = "quick-error" -version = "1.2.2" -source = "registry+https://github.com/rust-lang/crates.io-index" - -[[package]] -name = "quote" -version = "0.6.12" -source = "registry+https://github.com/rust-lang/crates.io-index" -dependencies = [ - "proc-macro2 0.4.30 (registry+https://github.com/rust-lang/crates.io-index)", -] - -[[package]] -name = "rand" -version = "0.6.5" -source = "registry+https://github.com/rust-lang/crates.io-index" -dependencies = [ - "autocfg 0.1.4 (registry+https://github.com/rust-lang/crates.io-index)", - "libc 0.2.58 (registry+https://github.com/rust-lang/crates.io-index)", - "rand_chacha 0.1.1 (registry+https://github.com/rust-lang/crates.io-index)", - "rand_core 0.4.0 (registry+https://github.com/rust-lang/crates.io-index)", - "rand_hc 0.1.0 (registry+https://github.com/rust-lang/crates.io-index)", - "rand_isaac 0.1.1 (registry+https://github.com/rust-lang/crates.io-index)", - "rand_jitter 0.1.4 (registry+https://github.com/rust-lang/crates.io-index)", - "rand_os 0.1.3 (registry+https://github.com/rust-lang/crates.io-index)", - "rand_pcg 0.1.2 (registry+https://github.com/rust-lang/crates.io-index)", - "rand_xorshift 0.1.1 (registry+https://github.com/rust-lang/crates.io-index)", - "winapi 0.3.7 (registry+https://github.com/rust-lang/crates.io-index)", -] - -[[package]] -name = "rand" -version = "0.7.0" -source = "registry+https://github.com/rust-lang/crates.io-index" -dependencies = [ - "getrandom 0.1.6 (registry+https://github.com/rust-lang/crates.io-index)", - "libc 0.2.58 (registry+https://github.com/rust-lang/crates.io-index)", - "rand_chacha 0.2.0 (registry+https://github.com/rust-lang/crates.io-index)", - "rand_core 0.5.0 (registry+https://github.com/rust-lang/crates.io-index)", - "rand_hc 0.2.0 (registry+https://github.com/rust-lang/crates.io-index)", - "rand_pcg 0.2.0 (registry+https://github.com/rust-lang/crates.io-index)", -] - -[[package]] -name = "rand_chacha" -version = "0.1.1" -source = "registry+https://github.com/rust-lang/crates.io-index" -dependencies = [ - "autocfg 0.1.4 (registry+https://github.com/rust-lang/crates.io-index)", - "rand_core 0.3.1 (registry+https://github.com/rust-lang/crates.io-index)", -] - -[[package]] -name = "rand_chacha" -version = "0.2.0" -source = "registry+https://github.com/rust-lang/crates.io-index" -dependencies = [ - "autocfg 0.1.4 (registry+https://github.com/rust-lang/crates.io-index)", - "c2-chacha 0.2.2 (registry+https://github.com/rust-lang/crates.io-index)", - "rand_core 0.5.0 (registry+https://github.com/rust-lang/crates.io-index)", -] - -[[package]] -name = "rand_core" -version = "0.3.1" -source = "registry+https://github.com/rust-lang/crates.io-index" -dependencies = [ - "rand_core 0.4.0 (registry+https://github.com/rust-lang/crates.io-index)", -] - -[[package]] -name = "rand_core" -version = "0.4.0" -source = "registry+https://github.com/rust-lang/crates.io-index" - -[[package]] -name = "rand_core" -version = "0.5.0" -source = "registry+https://github.com/rust-lang/crates.io-index" -dependencies = [ - "getrandom 0.1.6 (registry+https://github.com/rust-lang/crates.io-index)", -] - -[[package]] -name = "rand_hc" -version = "0.1.0" -source = "registry+https://github.com/rust-lang/crates.io-index" -dependencies = [ - "rand_core 0.3.1 (registry+https://github.com/rust-lang/crates.io-index)", -] - -[[package]] -name = "rand_hc" -version = "0.2.0" -source = "registry+https://github.com/rust-lang/crates.io-index" -dependencies = [ - "rand_core 0.5.0 (registry+https://github.com/rust-lang/crates.io-index)", -] - -[[package]] -name = "rand_isaac" -version = "0.1.1" -source = "registry+https://github.com/rust-lang/crates.io-index" -dependencies = [ - "rand_core 0.3.1 (registry+https://github.com/rust-lang/crates.io-index)", -] - -[[package]] -name = "rand_jitter" -version = "0.1.4" -source = "registry+https://github.com/rust-lang/crates.io-index" -dependencies = [ - "libc 0.2.58 (registry+https://github.com/rust-lang/crates.io-index)", - "rand_core 0.4.0 (registry+https://github.com/rust-lang/crates.io-index)", - "winapi 0.3.7 (registry+https://github.com/rust-lang/crates.io-index)", -] - -[[package]] -name = "rand_os" -version = "0.1.3" -source = "registry+https://github.com/rust-lang/crates.io-index" -dependencies = [ - "cloudabi 0.0.3 (registry+https://github.com/rust-lang/crates.io-index)", - "fuchsia-cprng 0.1.1 (registry+https://github.com/rust-lang/crates.io-index)", - "libc 0.2.58 (registry+https://github.com/rust-lang/crates.io-index)", - "rand_core 0.4.0 (registry+https://github.com/rust-lang/crates.io-index)", - "rdrand 0.4.0 (registry+https://github.com/rust-lang/crates.io-index)", - "winapi 0.3.7 (registry+https://github.com/rust-lang/crates.io-index)", -] - -[[package]] -name = "rand_pcg" -version = "0.1.2" -source = "registry+https://github.com/rust-lang/crates.io-index" -dependencies = [ - "autocfg 0.1.4 (registry+https://github.com/rust-lang/crates.io-index)", - "rand_core 0.4.0 (registry+https://github.com/rust-lang/crates.io-index)", -] - -[[package]] -name = "rand_pcg" -version = "0.2.0" -source = "registry+https://github.com/rust-lang/crates.io-index" -dependencies = [ - "autocfg 0.1.4 (registry+https://github.com/rust-lang/crates.io-index)", - "rand_core 0.5.0 (registry+https://github.com/rust-lang/crates.io-index)", -] - -[[package]] -name = "rand_xorshift" -version = "0.1.1" -source = "registry+https://github.com/rust-lang/crates.io-index" -dependencies = [ - "rand_core 0.3.1 (registry+https://github.com/rust-lang/crates.io-index)", -] - -[[package]] -name = "rdrand" -version = "0.4.0" -source = "registry+https://github.com/rust-lang/crates.io-index" -dependencies = [ - "rand_core 0.3.1 (registry+https://github.com/rust-lang/crates.io-index)", -] - -[[package]] -name = "redox_syscall" -version = "0.1.54" -source = "registry+https://github.com/rust-lang/crates.io-index" - -[[package]] -name = "redox_termios" -version = "0.1.1" -source = "registry+https://github.com/rust-lang/crates.io-index" -dependencies = [ - "redox_syscall 0.1.54 (registry+https://github.com/rust-lang/crates.io-index)", -] - -[[package]] -name = "redox_users" -version = "0.3.0" -source = "registry+https://github.com/rust-lang/crates.io-index" -dependencies = [ - "argon2rs 0.2.5 (registry+https://github.com/rust-lang/crates.io-index)", - "failure 0.1.5 (registry+https://github.com/rust-lang/crates.io-index)", - "rand_os 0.1.3 (registry+https://github.com/rust-lang/crates.io-index)", - "redox_syscall 0.1.54 (registry+https://github.com/rust-lang/crates.io-index)", -] - -[[package]] -name = "regex" -version = "1.1.7" -source = "registry+https://github.com/rust-lang/crates.io-index" -dependencies = [ - "aho-corasick 0.7.3 (registry+https://github.com/rust-lang/crates.io-index)", - "memchr 2.2.0 (registry+https://github.com/rust-lang/crates.io-index)", - "regex-syntax 0.6.6 (registry+https://github.com/rust-lang/crates.io-index)", - "thread_local 0.3.6 (registry+https://github.com/rust-lang/crates.io-index)", - "utf8-ranges 1.0.3 (registry+https://github.com/rust-lang/crates.io-index)", -] - -[[package]] -name = "regex-automata" -version = "0.1.7" -source = "registry+https://github.com/rust-lang/crates.io-index" -dependencies = [ - "byteorder 1.3.1 (registry+https://github.com/rust-lang/crates.io-index)", -] - -[[package]] -name = "regex-syntax" -version = "0.6.6" -source = "registry+https://github.com/rust-lang/crates.io-index" -dependencies = [ - "ucd-util 0.1.3 (registry+https://github.com/rust-lang/crates.io-index)", -] - -[[package]] -name = "remove_dir_all" -version = "0.5.1" -source = "registry+https://github.com/rust-lang/crates.io-index" -dependencies = [ - "winapi 0.3.7 (registry+https://github.com/rust-lang/crates.io-index)", -] - -[[package]] -name = "rust-ini" -version = "0.13.0" -source = "registry+https://github.com/rust-lang/crates.io-index" - -[[package]] -name = "rustc-demangle" -version = "0.1.15" -source = "registry+https://github.com/rust-lang/crates.io-index" - -[[package]] -name = "rustc_version" -version = "0.2.3" -source = "registry+https://github.com/rust-lang/crates.io-index" -dependencies = [ - "semver 0.9.0 (registry+https://github.com/rust-lang/crates.io-index)", -] - -[[package]] -name = "rusty-fork" -version = "0.2.2" -source = "registry+https://github.com/rust-lang/crates.io-index" -dependencies = [ - "fnv 1.0.6 (registry+https://github.com/rust-lang/crates.io-index)", - "quick-error 1.2.2 (registry+https://github.com/rust-lang/crates.io-index)", - "tempfile 3.0.8 (registry+https://github.com/rust-lang/crates.io-index)", - "wait-timeout 0.2.0 (registry+https://github.com/rust-lang/crates.io-index)", -] - -[[package]] -name = "ryu" -version = "0.2.8" -source = "registry+https://github.com/rust-lang/crates.io-index" - -[[package]] -name = "ryu" -version = "1.0.0" -source = "registry+https://github.com/rust-lang/crates.io-index" - -[[package]] -name = "scoped_threadpool" -version = "0.1.9" -source = "registry+https://github.com/rust-lang/crates.io-index" - -[[package]] -name = "semver" -version = "0.9.0" -source = "registry+https://github.com/rust-lang/crates.io-index" -dependencies = [ - "semver-parser 0.7.0 (registry+https://github.com/rust-lang/crates.io-index)", -] - -[[package]] -name = "semver-parser" -version = "0.7.0" -source = "registry+https://github.com/rust-lang/crates.io-index" - -[[package]] -name = "serde" -version = "0.8.23" -source = "registry+https://github.com/rust-lang/crates.io-index" - -[[package]] -name = "serde" -version = "1.0.92" -source = "registry+https://github.com/rust-lang/crates.io-index" - -[[package]] -name = "serde-hjson" -version = "0.8.2" -source = "registry+https://github.com/rust-lang/crates.io-index" -dependencies = [ - "lazy_static 0.2.11 (registry+https://github.com/rust-lang/crates.io-index)", - "linked-hash-map 0.3.0 (registry+https://github.com/rust-lang/crates.io-index)", - "num-traits 0.1.43 (registry+https://github.com/rust-lang/crates.io-index)", - "regex 1.1.7 (registry+https://github.com/rust-lang/crates.io-index)", - "serde 0.8.23 (registry+https://github.com/rust-lang/crates.io-index)", -] - -[[package]] -name = "serde-value" -version = "0.5.3" -source = "registry+https://github.com/rust-lang/crates.io-index" -dependencies = [ - "ordered-float 1.0.2 (registry+https://github.com/rust-lang/crates.io-index)", - "serde 1.0.92 (registry+https://github.com/rust-lang/crates.io-index)", -] - -[[package]] -name = "serde_derive" -version = "1.0.92" -source = "registry+https://github.com/rust-lang/crates.io-index" -dependencies = [ - "proc-macro2 0.4.30 (registry+https://github.com/rust-lang/crates.io-index)", - "quote 0.6.12 (registry+https://github.com/rust-lang/crates.io-index)", - "syn 0.15.35 (registry+https://github.com/rust-lang/crates.io-index)", -] - -[[package]] -name = "serde_json" -version = "1.0.39" -source = "registry+https://github.com/rust-lang/crates.io-index" -dependencies = [ - "itoa 0.4.4 (registry+https://github.com/rust-lang/crates.io-index)", - "ryu 0.2.8 (registry+https://github.com/rust-lang/crates.io-index)", - "serde 1.0.92 (registry+https://github.com/rust-lang/crates.io-index)", -] - -[[package]] -name = "serde_test" -version = "0.8.23" -source = "registry+https://github.com/rust-lang/crates.io-index" -dependencies = [ - "serde 0.8.23 (registry+https://github.com/rust-lang/crates.io-index)", -] - -[[package]] -name = "serde_yaml" -version = "0.8.9" -source = "registry+https://github.com/rust-lang/crates.io-index" -dependencies = [ - "dtoa 0.4.4 (registry+https://github.com/rust-lang/crates.io-index)", - "linked-hash-map 0.5.2 (registry+https://github.com/rust-lang/crates.io-index)", - "serde 1.0.92 (registry+https://github.com/rust-lang/crates.io-index)", - "yaml-rust 0.4.3 (registry+https://github.com/rust-lang/crates.io-index)", -] - -[[package]] -name = "spin" -version = "0.5.0" -source = "registry+https://github.com/rust-lang/crates.io-index" - -[[package]] -name = "stackvector" -version = "1.0.6" -source = "registry+https://github.com/rust-lang/crates.io-index" -dependencies = [ - "rustc_version 0.2.3 (registry+https://github.com/rust-lang/crates.io-index)", - "unreachable 1.0.0 (registry+https://github.com/rust-lang/crates.io-index)", -] - -[[package]] -name = "static_assertions" -version = "0.2.5" -source = "registry+https://github.com/rust-lang/crates.io-index" - -[[package]] -name = "strsim" -version = "0.8.0" -source = "registry+https://github.com/rust-lang/crates.io-index" - -[[package]] -name = "syn" -version = "0.14.9" -source = "registry+https://github.com/rust-lang/crates.io-index" -dependencies = [ - "proc-macro2 0.4.30 (registry+https://github.com/rust-lang/crates.io-index)", - "quote 0.6.12 (registry+https://github.com/rust-lang/crates.io-index)", - "unicode-xid 0.1.0 (registry+https://github.com/rust-lang/crates.io-index)", -] - -[[package]] -name = "syn" -version = "0.15.35" -source = "registry+https://github.com/rust-lang/crates.io-index" -dependencies = [ - "proc-macro2 0.4.30 (registry+https://github.com/rust-lang/crates.io-index)", - "quote 0.6.12 (registry+https://github.com/rust-lang/crates.io-index)", - "unicode-xid 0.1.0 (registry+https://github.com/rust-lang/crates.io-index)", -] - -[[package]] -name = "synstructure" -version = "0.10.2" -source = "registry+https://github.com/rust-lang/crates.io-index" -dependencies = [ - "proc-macro2 0.4.30 (registry+https://github.com/rust-lang/crates.io-index)", - "quote 0.6.12 (registry+https://github.com/rust-lang/crates.io-index)", - "syn 0.15.35 (registry+https://github.com/rust-lang/crates.io-index)", - "unicode-xid 0.1.0 (registry+https://github.com/rust-lang/crates.io-index)", -] - -[[package]] -name = "tempfile" -version = "3.0.8" -source = "registry+https://github.com/rust-lang/crates.io-index" -dependencies = [ - "cfg-if 0.1.9 (registry+https://github.com/rust-lang/crates.io-index)", - "libc 0.2.58 (registry+https://github.com/rust-lang/crates.io-index)", - "rand 0.6.5 (registry+https://github.com/rust-lang/crates.io-index)", - "redox_syscall 0.1.54 (registry+https://github.com/rust-lang/crates.io-index)", - "remove_dir_all 0.5.1 (registry+https://github.com/rust-lang/crates.io-index)", - "winapi 0.3.7 (registry+https://github.com/rust-lang/crates.io-index)", -] - -[[package]] -name = "term" -version = "0.5.2" -source = "registry+https://github.com/rust-lang/crates.io-index" -dependencies = [ - "byteorder 1.3.1 (registry+https://github.com/rust-lang/crates.io-index)", - "dirs 1.0.5 (registry+https://github.com/rust-lang/crates.io-index)", - "winapi 0.3.7 (registry+https://github.com/rust-lang/crates.io-index)", -] - -[[package]] -name = "termion" -version = "1.5.2" -source = "registry+https://github.com/rust-lang/crates.io-index" -dependencies = [ - "libc 0.2.58 (registry+https://github.com/rust-lang/crates.io-index)", - "numtoa 0.1.0 (registry+https://github.com/rust-lang/crates.io-index)", - "redox_syscall 0.1.54 (registry+https://github.com/rust-lang/crates.io-index)", - "redox_termios 0.1.1 (registry+https://github.com/rust-lang/crates.io-index)", -] - -[[package]] -name = "textwrap" -version = "0.11.0" -source = "registry+https://github.com/rust-lang/crates.io-index" -dependencies = [ - "unicode-width 0.1.5 (registry+https://github.com/rust-lang/crates.io-index)", -] - -[[package]] -name = "thread-id" -version = "3.3.0" -source = "registry+https://github.com/rust-lang/crates.io-index" -dependencies = [ - "libc 0.2.58 (registry+https://github.com/rust-lang/crates.io-index)", - "redox_syscall 0.1.54 (registry+https://github.com/rust-lang/crates.io-index)", - "winapi 0.3.7 (registry+https://github.com/rust-lang/crates.io-index)", -] - -[[package]] -name = "thread_local" -version = "0.3.6" -source = "registry+https://github.com/rust-lang/crates.io-index" -dependencies = [ - "lazy_static 1.3.0 (registry+https://github.com/rust-lang/crates.io-index)", -] - -[[package]] -name = "time" -version = "0.1.42" -source = "registry+https://github.com/rust-lang/crates.io-index" -dependencies = [ - "libc 0.2.58 (registry+https://github.com/rust-lang/crates.io-index)", - "redox_syscall 0.1.54 (registry+https://github.com/rust-lang/crates.io-index)", - "winapi 0.3.7 (registry+https://github.com/rust-lang/crates.io-index)", -] - -[[package]] -name = "toml" -version = "0.4.10" -source = "registry+https://github.com/rust-lang/crates.io-index" -dependencies = [ - "serde 1.0.92 (registry+https://github.com/rust-lang/crates.io-index)", -] - -[[package]] -name = "toml" -version = "0.5.1" -source = "registry+https://github.com/rust-lang/crates.io-index" -dependencies = [ - "serde 1.0.92 (registry+https://github.com/rust-lang/crates.io-index)", -] - -[[package]] -name = "traitobject" -version = "0.1.0" -source = "registry+https://github.com/rust-lang/crates.io-index" - -[[package]] -name = "typemap" -version = "0.3.3" -source = "registry+https://github.com/rust-lang/crates.io-index" -dependencies = [ - "unsafe-any 0.4.2 (registry+https://github.com/rust-lang/crates.io-index)", -] - -[[package]] -name = "ucd-util" -version = "0.1.3" -source = "registry+https://github.com/rust-lang/crates.io-index" - -[[package]] -name = "unicode-width" -version = "0.1.5" -source = "registry+https://github.com/rust-lang/crates.io-index" - -[[package]] -name = "unicode-xid" -version = "0.1.0" -source = "registry+https://github.com/rust-lang/crates.io-index" - -[[package]] -name = "unreachable" -version = "1.0.0" -source = "registry+https://github.com/rust-lang/crates.io-index" -dependencies = [ - "void 1.0.2 (registry+https://github.com/rust-lang/crates.io-index)", -] - -[[package]] -name = "unsafe-any" -version = "0.4.2" -source = "registry+https://github.com/rust-lang/crates.io-index" -dependencies = [ - "traitobject 0.1.0 (registry+https://github.com/rust-lang/crates.io-index)", -] - -[[package]] -name = "utf8-ranges" -version = "1.0.3" -source = "registry+https://github.com/rust-lang/crates.io-index" - -[[package]] -name = "vec_map" -version = "0.8.1" -source = "registry+https://github.com/rust-lang/crates.io-index" - -[[package]] -name = "version_check" -version = "0.1.5" -source = "registry+https://github.com/rust-lang/crates.io-index" - -[[package]] -name = "void" -version = "1.0.2" -source = "registry+https://github.com/rust-lang/crates.io-index" - -[[package]] -name = "wait-timeout" -version = "0.2.0" -source = "registry+https://github.com/rust-lang/crates.io-index" -dependencies = [ - "libc 0.2.58 (registry+https://github.com/rust-lang/crates.io-index)", -] - -[[package]] -name = "winapi" -version = "0.3.7" -source = "registry+https://github.com/rust-lang/crates.io-index" -dependencies = [ - "winapi-i686-pc-windows-gnu 0.4.0 (registry+https://github.com/rust-lang/crates.io-index)", - "winapi-x86_64-pc-windows-gnu 0.4.0 (registry+https://github.com/rust-lang/crates.io-index)", -] - -[[package]] -name = "winapi-i686-pc-windows-gnu" -version = "0.4.0" -source = "registry+https://github.com/rust-lang/crates.io-index" - -[[package]] -name = "winapi-x86_64-pc-windows-gnu" -version = "0.4.0" -source = "registry+https://github.com/rust-lang/crates.io-index" - -[[package]] -name = "xanthous" -version = "0.1.0" -dependencies = [ - "alga 0.9.1 (registry+https://github.com/rust-lang/crates.io-index)", - "backtrace 0.3.32 (registry+https://github.com/rust-lang/crates.io-index)", - "clap 2.33.0 (registry+https://github.com/rust-lang/crates.io-index)", - "config 0.9.3 (registry+https://github.com/rust-lang/crates.io-index)", - "downcast-rs 1.0.4 (registry+https://github.com/rust-lang/crates.io-index)", - "futures 0.1.28 (registry+https://github.com/rust-lang/crates.io-index)", - "include_dir 0.2.1 (registry+https://github.com/rust-lang/crates.io-index)", - "itertools 0.8.0 (registry+https://github.com/rust-lang/crates.io-index)", - "lazy_static 1.3.0 (registry+https://github.com/rust-lang/crates.io-index)", - "log 0.4.6 (registry+https://github.com/rust-lang/crates.io-index)", - "log4rs 0.8.3 (registry+https://github.com/rust-lang/crates.io-index)", - "maplit 1.0.1 (registry+https://github.com/rust-lang/crates.io-index)", - "matches 0.1.8 (registry+https://github.com/rust-lang/crates.io-index)", - "nom 5.0.0 (registry+https://github.com/rust-lang/crates.io-index)", - "prettytable-rs 0.8.0 (registry+https://github.com/rust-lang/crates.io-index)", - "proptest 0.9.3 (registry+https://github.com/rust-lang/crates.io-index)", - "proptest-derive 0.1.1 (registry+https://github.com/rust-lang/crates.io-index)", - "rand 0.7.0 (registry+https://github.com/rust-lang/crates.io-index)", - "serde 1.0.92 (registry+https://github.com/rust-lang/crates.io-index)", - "serde_derive 1.0.92 (registry+https://github.com/rust-lang/crates.io-index)", - "serde_json 1.0.39 (registry+https://github.com/rust-lang/crates.io-index)", - "serde_yaml 0.8.9 (registry+https://github.com/rust-lang/crates.io-index)", - "termion 1.5.2 (registry+https://github.com/rust-lang/crates.io-index)", - "toml 0.5.1 (registry+https://github.com/rust-lang/crates.io-index)", -] - -[[package]] -name = "yaml-rust" -version = "0.3.5" -source = "registry+https://github.com/rust-lang/crates.io-index" - -[[package]] -name = "yaml-rust" -version = "0.4.3" -source = "registry+https://github.com/rust-lang/crates.io-index" -dependencies = [ - "linked-hash-map 0.5.2 (registry+https://github.com/rust-lang/crates.io-index)", -] - -[metadata] -"checksum adler32 1.0.3 (registry+https://github.com/rust-lang/crates.io-index)" = "7e522997b529f05601e05166c07ed17789691f562762c7f3b987263d2dedee5c" -"checksum aho-corasick 0.7.3 (registry+https://github.com/rust-lang/crates.io-index)" = "e6f484ae0c99fec2e858eb6134949117399f222608d84cadb3f58c1f97c2364c" -"checksum alga 0.9.1 (registry+https://github.com/rust-lang/crates.io-index)" = "d708cb68c7106ed1844de68f50f0157a7788c2909a6926fad5a87546ef6a4ff8" -"checksum ansi_term 0.11.0 (registry+https://github.com/rust-lang/crates.io-index)" = "ee49baf6cb617b853aa8d93bf420db2383fab46d314482ca2803b40d5fde979b" -"checksum antidote 1.0.0 (registry+https://github.com/rust-lang/crates.io-index)" = "34fde25430d87a9388dadbe6e34d7f72a462c8b43ac8d309b42b0a8505d7e2a5" -"checksum approx 0.3.2 (registry+https://github.com/rust-lang/crates.io-index)" = "f0e60b75072ecd4168020818c0107f2857bb6c4e64252d8d3983f6263b40a5c3" -"checksum arc-swap 0.3.11 (registry+https://github.com/rust-lang/crates.io-index)" = "bc4662175ead9cd84451d5c35070517777949a2ed84551764129cedb88384841" -"checksum argon2rs 0.2.5 (registry+https://github.com/rust-lang/crates.io-index)" = "3f67b0b6a86dae6e67ff4ca2b6201396074996379fba2b92ff649126f37cb392" -"checksum arrayvec 0.4.10 (registry+https://github.com/rust-lang/crates.io-index)" = "92c7fb76bc8826a8b33b4ee5bb07a247a81e76764ab4d55e8f73e3a4d8808c71" -"checksum atty 0.2.11 (registry+https://github.com/rust-lang/crates.io-index)" = "9a7d5b8723950951411ee34d271d99dddcc2035a16ab25310ea2c8cfd4369652" -"checksum autocfg 0.1.4 (registry+https://github.com/rust-lang/crates.io-index)" = "0e49efa51329a5fd37e7c79db4621af617cd4e3e5bc224939808d076077077bf" -"checksum backtrace 0.3.32 (registry+https://github.com/rust-lang/crates.io-index)" = "18b50f5258d1a9ad8396d2d345827875de4261b158124d4c819d9b351454fae5" -"checksum backtrace-sys 0.1.30 (registry+https://github.com/rust-lang/crates.io-index)" = "5b3a000b9c543553af61bc01cbfc403b04b5caa9e421033866f2e98061eb3e61" -"checksum bit-set 0.5.1 (registry+https://github.com/rust-lang/crates.io-index)" = "e84c238982c4b1e1ee668d136c510c67a13465279c0cb367ea6baf6310620a80" -"checksum bit-vec 0.5.1 (registry+https://github.com/rust-lang/crates.io-index)" = "f59bbe95d4e52a6398ec21238d31577f2b28a9d86807f06ca59d191d8440d0bb" -"checksum bitflags 1.1.0 (registry+https://github.com/rust-lang/crates.io-index)" = "3d155346769a6855b86399e9bc3814ab343cd3d62c7e985113d46a0ec3c281fd" -"checksum blake2-rfc 0.2.18 (registry+https://github.com/rust-lang/crates.io-index)" = "5d6d530bdd2d52966a6d03b7a964add7ae1a288d25214066fd4b600f0f796400" -"checksum bstr 0.2.1 (registry+https://github.com/rust-lang/crates.io-index)" = "6cc0572e02f76cb335f309b19e0a0d585b4f62788f7d26de2a13a836a637385f" -"checksum build_const 0.2.1 (registry+https://github.com/rust-lang/crates.io-index)" = "39092a32794787acd8525ee150305ff051b0aa6cc2abaf193924f5ab05425f39" -"checksum byteorder 1.3.1 (registry+https://github.com/rust-lang/crates.io-index)" = "a019b10a2a7cdeb292db131fc8113e57ea2a908f6e7894b0c3c671893b65dbeb" -"checksum c2-chacha 0.2.2 (registry+https://github.com/rust-lang/crates.io-index)" = "7d64d04786e0f528460fc884753cf8dddcc466be308f6026f8e355c41a0e4101" -"checksum cc 1.0.37 (registry+https://github.com/rust-lang/crates.io-index)" = "39f75544d7bbaf57560d2168f28fd649ff9c76153874db88bdbdfd839b1a7e7d" -"checksum cfg-if 0.1.9 (registry+https://github.com/rust-lang/crates.io-index)" = "b486ce3ccf7ffd79fdeb678eac06a9e6c09fc88d33836340becb8fffe87c5e33" -"checksum chrono 0.4.6 (registry+https://github.com/rust-lang/crates.io-index)" = "45912881121cb26fad7c38c17ba7daa18764771836b34fab7d3fbd93ed633878" -"checksum clap 2.33.0 (registry+https://github.com/rust-lang/crates.io-index)" = "5067f5bb2d80ef5d68b4c87db81601f0b75bca627bc2ef76b141d7b846a3c6d9" -"checksum cloudabi 0.0.3 (registry+https://github.com/rust-lang/crates.io-index)" = "ddfc5b9aa5d4507acaf872de71051dfd0e309860e88966e1051e462a077aac4f" -"checksum config 0.9.3 (registry+https://github.com/rust-lang/crates.io-index)" = "f9107d78ed62b3fa5a86e7d18e647abed48cfd8f8fab6c72f4cdb982d196f7e6" -"checksum constant_time_eq 0.1.3 (registry+https://github.com/rust-lang/crates.io-index)" = "8ff012e225ce166d4422e0e78419d901719760f62ae2b7969ca6b564d1b54a9e" -"checksum crc 1.8.1 (registry+https://github.com/rust-lang/crates.io-index)" = "d663548de7f5cca343f1e0a48d14dcfb0e9eb4e079ec58883b7251539fa10aeb" -"checksum crc32fast 1.2.0 (registry+https://github.com/rust-lang/crates.io-index)" = "ba125de2af0df55319f41944744ad91c71113bf74a4646efff39afe1f6842db1" -"checksum csv 1.1.1 (registry+https://github.com/rust-lang/crates.io-index)" = "37519ccdfd73a75821cac9319d4fce15a81b9fcf75f951df5b9988aa3a0af87d" -"checksum csv-core 0.1.6 (registry+https://github.com/rust-lang/crates.io-index)" = "9b5cadb6b25c77aeff80ba701712494213f4a8418fcda2ee11b6560c3ad0bf4c" -"checksum dirs 1.0.5 (registry+https://github.com/rust-lang/crates.io-index)" = "3fd78930633bd1c6e35c4b42b1df7b0cbc6bc191146e512bb3bedf243fcc3901" -"checksum downcast-rs 1.0.4 (registry+https://github.com/rust-lang/crates.io-index)" = "f2b92dfd5c2f75260cbf750572f95d387e7ca0ba5e3fbe9e1a33f23025be020f" -"checksum dtoa 0.4.4 (registry+https://github.com/rust-lang/crates.io-index)" = "ea57b42383d091c85abcc2706240b94ab2a8fa1fc81c10ff23c4de06e2a90b5e" -"checksum either 1.5.2 (registry+https://github.com/rust-lang/crates.io-index)" = "5527cfe0d098f36e3f8839852688e63c8fff1c90b2b405aef730615f9a7bcf7b" -"checksum encode_unicode 0.3.5 (registry+https://github.com/rust-lang/crates.io-index)" = "90b2c9496c001e8cb61827acdefad780795c42264c137744cae6f7d9e3450abd" -"checksum failure 0.1.5 (registry+https://github.com/rust-lang/crates.io-index)" = "795bd83d3abeb9220f257e597aa0080a508b27533824adf336529648f6abf7e2" -"checksum failure_derive 0.1.5 (registry+https://github.com/rust-lang/crates.io-index)" = "ea1063915fd7ef4309e222a5a07cf9c319fb9c7836b1f89b85458672dbb127e1" -"checksum flate2 1.0.7 (registry+https://github.com/rust-lang/crates.io-index)" = "f87e68aa82b2de08a6e037f1385455759df6e445a8df5e005b4297191dbf18aa" -"checksum fnv 1.0.6 (registry+https://github.com/rust-lang/crates.io-index)" = "2fad85553e09a6f881f739c29f0b00b0f01357c743266d478b68951ce23285f3" -"checksum fuchsia-cprng 0.1.1 (registry+https://github.com/rust-lang/crates.io-index)" = "a06f77d526c1a601b7c4cdd98f54b5eaabffc14d5f2f0296febdc7f357c6d3ba" -"checksum futures 0.1.28 (registry+https://github.com/rust-lang/crates.io-index)" = "45dc39533a6cae6da2b56da48edae506bb767ec07370f86f70fc062e9d435869" -"checksum getrandom 0.1.6 (registry+https://github.com/rust-lang/crates.io-index)" = "e65cce4e5084b14874c4e7097f38cab54f47ee554f9194673456ea379dcc4c55" -"checksum glob 0.2.11 (registry+https://github.com/rust-lang/crates.io-index)" = "8be18de09a56b60ed0edf84bc9df007e30040691af7acd1c41874faac5895bfb" -"checksum humantime 1.2.0 (registry+https://github.com/rust-lang/crates.io-index)" = "3ca7e5f2e110db35f93b837c81797f3714500b81d517bf20c431b16d3ca4f114" -"checksum include_dir 0.2.1 (registry+https://github.com/rust-lang/crates.io-index)" = "f41a8bee1894b3fb755d8f09ccd764650476358197a0582555f698fe84b0ae93" -"checksum include_dir_impl 0.2.1 (registry+https://github.com/rust-lang/crates.io-index)" = "0c4b029199aef0fb9921fdc5623843197e6f4a035774523817599a9f55e4bf3b" -"checksum itertools 0.8.0 (registry+https://github.com/rust-lang/crates.io-index)" = "5b8467d9c1cebe26feb08c640139247fac215782d35371ade9a2136ed6085358" -"checksum itoa 0.4.4 (registry+https://github.com/rust-lang/crates.io-index)" = "501266b7edd0174f8530248f87f99c88fbe60ca4ef3dd486835b8d8d53136f7f" -"checksum lazy_static 0.2.11 (registry+https://github.com/rust-lang/crates.io-index)" = "76f033c7ad61445c5b347c7382dd1237847eb1bce590fe50365dcb33d546be73" -"checksum lazy_static 1.3.0 (registry+https://github.com/rust-lang/crates.io-index)" = "bc5729f27f159ddd61f4df6228e827e86643d4d3e7c32183cb30a1c08f604a14" -"checksum lexical-core 0.4.2 (registry+https://github.com/rust-lang/crates.io-index)" = "3f8673fab7063c2cac37d299c8a1a7beb720e78f71500098e4a3c137fdf025bf" -"checksum libc 0.2.58 (registry+https://github.com/rust-lang/crates.io-index)" = "6281b86796ba5e4366000be6e9e18bf35580adf9e63fbe2294aadb587613a319" -"checksum libm 0.1.4 (registry+https://github.com/rust-lang/crates.io-index)" = "7fc7aa29613bd6a620df431842069224d8bc9011086b1db4c0e0cd47fa03ec9a" -"checksum linked-hash-map 0.3.0 (registry+https://github.com/rust-lang/crates.io-index)" = "6d262045c5b87c0861b3f004610afd0e2c851e2908d08b6c870cbb9d5f494ecd" -"checksum linked-hash-map 0.5.2 (registry+https://github.com/rust-lang/crates.io-index)" = "ae91b68aebc4ddb91978b11a1b02ddd8602a05ec19002801c5666000e05e0f83" -"checksum log 0.4.6 (registry+https://github.com/rust-lang/crates.io-index)" = "c84ec4b527950aa83a329754b01dbe3f58361d1c5efacd1f6d68c494d08a17c6" -"checksum log-mdc 0.1.0 (registry+https://github.com/rust-lang/crates.io-index)" = "a94d21414c1f4a51209ad204c1776a3d0765002c76c6abcb602a6f09f1e881c7" -"checksum log4rs 0.8.3 (registry+https://github.com/rust-lang/crates.io-index)" = "100052474df98158c0738a7d3f4249c99978490178b5f9f68cd835ac57adbd1b" -"checksum maplit 1.0.1 (registry+https://github.com/rust-lang/crates.io-index)" = "08cbb6b4fef96b6d77bfc40ec491b1690c779e77b05cd9f07f787ed376fd4c43" -"checksum matches 0.1.8 (registry+https://github.com/rust-lang/crates.io-index)" = "7ffc5c5338469d4d3ea17d269fa8ea3512ad247247c30bd2df69e68309ed0a08" -"checksum memchr 2.2.0 (registry+https://github.com/rust-lang/crates.io-index)" = "2efc7bc57c883d4a4d6e3246905283d8dae951bb3bd32f49d6ef297f546e1c39" -"checksum miniz-sys 0.1.12 (registry+https://github.com/rust-lang/crates.io-index)" = "1e9e3ae51cea1576ceba0dde3d484d30e6e5b86dee0b2d412fe3a16a15c98202" -"checksum miniz_oxide 0.2.1 (registry+https://github.com/rust-lang/crates.io-index)" = "c468f2369f07d651a5d0bb2c9079f8488a66d5466efe42d0c5c6466edcb7f71e" -"checksum miniz_oxide_c_api 0.2.1 (registry+https://github.com/rust-lang/crates.io-index)" = "b7fe927a42e3807ef71defb191dc87d4e24479b221e67015fe38ae2b7b447bab" -"checksum nodrop 0.1.13 (registry+https://github.com/rust-lang/crates.io-index)" = "2f9667ddcc6cc8a43afc9b7917599d7216aa09c463919ea32c59ed6cac8bc945" -"checksum nom 4.2.3 (registry+https://github.com/rust-lang/crates.io-index)" = "2ad2a91a8e869eeb30b9cb3119ae87773a8f4ae617f41b1eb9c154b2905f7bd6" -"checksum nom 5.0.0 (registry+https://github.com/rust-lang/crates.io-index)" = "e9761d859320e381010a4f7f8ed425f2c924de33ad121ace447367c713ad561b" -"checksum num-complex 0.2.3 (registry+https://github.com/rust-lang/crates.io-index)" = "fcb0cf31fb3ff77e6d2a6ebd6800df7fdcd106f2ad89113c9130bcd07f93dffc" -"checksum num-integer 0.1.41 (registry+https://github.com/rust-lang/crates.io-index)" = "b85e541ef8255f6cf42bbfe4ef361305c6c135d10919ecc26126c4e5ae94bc09" -"checksum num-traits 0.1.43 (registry+https://github.com/rust-lang/crates.io-index)" = "92e5113e9fd4cc14ded8e499429f396a20f98c772a47cc8622a736e1ec843c31" -"checksum num-traits 0.2.8 (registry+https://github.com/rust-lang/crates.io-index)" = "6ba9a427cfca2be13aa6f6403b0b7e7368fe982bfa16fccc450ce74c46cd9b32" -"checksum numtoa 0.1.0 (registry+https://github.com/rust-lang/crates.io-index)" = "b8f8bdf33df195859076e54ab11ee78a1b208382d3a26ec40d142ffc1ecc49ef" -"checksum ordered-float 1.0.2 (registry+https://github.com/rust-lang/crates.io-index)" = "18869315e81473c951eb56ad5558bbc56978562d3ecfb87abb7a1e944cea4518" -"checksum ppv-lite86 0.2.5 (registry+https://github.com/rust-lang/crates.io-index)" = "e3cbf9f658cdb5000fcf6f362b8ea2ba154b9f146a61c7a20d647034c6b6561b" -"checksum prettytable-rs 0.8.0 (registry+https://github.com/rust-lang/crates.io-index)" = "0fd04b170004fa2daccf418a7f8253aaf033c27760b5f225889024cf66d7ac2e" -"checksum proc-macro-hack 0.4.1 (registry+https://github.com/rust-lang/crates.io-index)" = "2c725b36c99df7af7bf9324e9c999b9e37d92c8f8caf106d82e1d7953218d2d8" -"checksum proc-macro-hack-impl 0.4.1 (registry+https://github.com/rust-lang/crates.io-index)" = "2b753ad9ed99dd8efeaa7d2fb8453c8f6bc3e54b97966d35f1bc77ca6865254a" -"checksum proc-macro2 0.4.30 (registry+https://github.com/rust-lang/crates.io-index)" = "cf3d2011ab5c909338f7887f4fc896d35932e29146c12c8d01da6b22a80ba759" -"checksum proptest 0.9.3 (registry+https://github.com/rust-lang/crates.io-index)" = "2afed8cbdc8a64b58a5c021757a782351ec1afee85be374872721c84d5da5d80" -"checksum proptest-derive 0.1.1 (registry+https://github.com/rust-lang/crates.io-index)" = "08b264c54525e760fc1d39c5b2bfc96923b922a752893053b4adaafe33fa9346" -"checksum quick-error 1.2.2 (registry+https://github.com/rust-lang/crates.io-index)" = "9274b940887ce9addde99c4eee6b5c44cc494b182b97e73dc8ffdcb3397fd3f0" -"checksum quote 0.6.12 (registry+https://github.com/rust-lang/crates.io-index)" = "faf4799c5d274f3868a4aae320a0a182cbd2baee377b378f080e16a23e9d80db" -"checksum rand 0.6.5 (registry+https://github.com/rust-lang/crates.io-index)" = "6d71dacdc3c88c1fde3885a3be3fbab9f35724e6ce99467f7d9c5026132184ca" -"checksum rand 0.7.0 (registry+https://github.com/rust-lang/crates.io-index)" = "d47eab0e83d9693d40f825f86948aa16eff6750ead4bdffc4ab95b8b3a7f052c" -"checksum rand_chacha 0.1.1 (registry+https://github.com/rust-lang/crates.io-index)" = "556d3a1ca6600bfcbab7c7c91ccb085ac7fbbcd70e008a98742e7847f4f7bcef" -"checksum rand_chacha 0.2.0 (registry+https://github.com/rust-lang/crates.io-index)" = "e193067942ef6f485a349a113329140d0ab9e2168ce92274499bb0e9a4190d9d" -"checksum rand_core 0.3.1 (registry+https://github.com/rust-lang/crates.io-index)" = "7a6fdeb83b075e8266dcc8762c22776f6877a63111121f5f8c7411e5be7eed4b" -"checksum rand_core 0.4.0 (registry+https://github.com/rust-lang/crates.io-index)" = "d0e7a549d590831370895ab7ba4ea0c1b6b011d106b5ff2da6eee112615e6dc0" -"checksum rand_core 0.5.0 (registry+https://github.com/rust-lang/crates.io-index)" = "615e683324e75af5d43d8f7a39ffe3ee4a9dc42c5c701167a71dc59c3a493aca" -"checksum rand_hc 0.1.0 (registry+https://github.com/rust-lang/crates.io-index)" = "7b40677c7be09ae76218dc623efbf7b18e34bced3f38883af07bb75630a21bc4" -"checksum rand_hc 0.2.0 (registry+https://github.com/rust-lang/crates.io-index)" = "ca3129af7b92a17112d59ad498c6f81eaf463253766b90396d39ea7a39d6613c" -"checksum rand_isaac 0.1.1 (registry+https://github.com/rust-lang/crates.io-index)" = "ded997c9d5f13925be2a6fd7e66bf1872597f759fd9dd93513dd7e92e5a5ee08" -"checksum rand_jitter 0.1.4 (registry+https://github.com/rust-lang/crates.io-index)" = "1166d5c91dc97b88d1decc3285bb0a99ed84b05cfd0bc2341bdf2d43fc41e39b" -"checksum rand_os 0.1.3 (registry+https://github.com/rust-lang/crates.io-index)" = "7b75f676a1e053fc562eafbb47838d67c84801e38fc1ba459e8f180deabd5071" -"checksum rand_pcg 0.1.2 (registry+https://github.com/rust-lang/crates.io-index)" = "abf9b09b01790cfe0364f52bf32995ea3c39f4d2dd011eac241d2914146d0b44" -"checksum rand_pcg 0.2.0 (registry+https://github.com/rust-lang/crates.io-index)" = "3e196346cbbc5c70c77e7b4926147ee8e383a38ee4d15d58a08098b169e492b6" -"checksum rand_xorshift 0.1.1 (registry+https://github.com/rust-lang/crates.io-index)" = "cbf7e9e623549b0e21f6e97cf8ecf247c1a8fd2e8a992ae265314300b2455d5c" -"checksum rdrand 0.4.0 (registry+https://github.com/rust-lang/crates.io-index)" = "678054eb77286b51581ba43620cc911abf02758c91f93f479767aed0f90458b2" -"checksum redox_syscall 0.1.54 (registry+https://github.com/rust-lang/crates.io-index)" = "12229c14a0f65c4f1cb046a3b52047cdd9da1f4b30f8a39c5063c8bae515e252" -"checksum redox_termios 0.1.1 (registry+https://github.com/rust-lang/crates.io-index)" = "7e891cfe48e9100a70a3b6eb652fef28920c117d366339687bd5576160db0f76" -"checksum redox_users 0.3.0 (registry+https://github.com/rust-lang/crates.io-index)" = "3fe5204c3a17e97dde73f285d49be585df59ed84b50a872baf416e73b62c3828" -"checksum regex 1.1.7 (registry+https://github.com/rust-lang/crates.io-index)" = "0b2f0808e7d7e4fb1cb07feb6ff2f4bc827938f24f8c2e6a3beb7370af544bdd" -"checksum regex-automata 0.1.7 (registry+https://github.com/rust-lang/crates.io-index)" = "3ed09217220c272b29ef237a974ad58515bde75f194e3ffa7e6d0bf0f3b01f86" -"checksum regex-syntax 0.6.6 (registry+https://github.com/rust-lang/crates.io-index)" = "dcfd8681eebe297b81d98498869d4aae052137651ad7b96822f09ceb690d0a96" -"checksum remove_dir_all 0.5.1 (registry+https://github.com/rust-lang/crates.io-index)" = "3488ba1b9a2084d38645c4c08276a1752dcbf2c7130d74f1569681ad5d2799c5" -"checksum rust-ini 0.13.0 (registry+https://github.com/rust-lang/crates.io-index)" = "3e52c148ef37f8c375d49d5a73aa70713125b7f19095948a923f80afdeb22ec2" -"checksum rustc-demangle 0.1.15 (registry+https://github.com/rust-lang/crates.io-index)" = "a7f4dccf6f4891ebcc0c39f9b6eb1a83b9bf5d747cb439ec6fba4f3b977038af" -"checksum rustc_version 0.2.3 (registry+https://github.com/rust-lang/crates.io-index)" = "138e3e0acb6c9fb258b19b67cb8abd63c00679d2851805ea151465464fe9030a" -"checksum rusty-fork 0.2.2 (registry+https://github.com/rust-lang/crates.io-index)" = "3dd93264e10c577503e926bd1430193eeb5d21b059148910082245309b424fae" -"checksum ryu 0.2.8 (registry+https://github.com/rust-lang/crates.io-index)" = "b96a9549dc8d48f2c283938303c4b5a77aa29bfbc5b54b084fb1630408899a8f" -"checksum ryu 1.0.0 (registry+https://github.com/rust-lang/crates.io-index)" = "c92464b447c0ee8c4fb3824ecc8383b81717b9f1e74ba2e72540aef7b9f82997" -"checksum scoped_threadpool 0.1.9 (registry+https://github.com/rust-lang/crates.io-index)" = "1d51f5df5af43ab3f1360b429fa5e0152ac5ce8c0bd6485cae490332e96846a8" -"checksum semver 0.9.0 (registry+https://github.com/rust-lang/crates.io-index)" = "1d7eb9ef2c18661902cc47e535f9bc51b78acd254da71d375c2f6720d9a40403" -"checksum semver-parser 0.7.0 (registry+https://github.com/rust-lang/crates.io-index)" = "388a1df253eca08550bef6c72392cfe7c30914bf41df5269b68cbd6ff8f570a3" -"checksum serde 0.8.23 (registry+https://github.com/rust-lang/crates.io-index)" = "9dad3f759919b92c3068c696c15c3d17238234498bbdcc80f2c469606f948ac8" -"checksum serde 1.0.92 (registry+https://github.com/rust-lang/crates.io-index)" = "32746bf0f26eab52f06af0d0aa1984f641341d06d8d673c693871da2d188c9be" -"checksum serde-hjson 0.8.2 (registry+https://github.com/rust-lang/crates.io-index)" = "0b833c5ad67d52ced5f5938b2980f32a9c1c5ef047f0b4fb3127e7a423c76153" -"checksum serde-value 0.5.3 (registry+https://github.com/rust-lang/crates.io-index)" = "7a663f873dedc4eac1a559d4c6bc0d0b2c34dc5ac4702e105014b8281489e44f" -"checksum serde_derive 1.0.92 (registry+https://github.com/rust-lang/crates.io-index)" = "46a3223d0c9ba936b61c0d2e3e559e3217dbfb8d65d06d26e8b3c25de38bae3e" -"checksum serde_json 1.0.39 (registry+https://github.com/rust-lang/crates.io-index)" = "5a23aa71d4a4d43fdbfaac00eff68ba8a06a51759a89ac3304323e800c4dd40d" -"checksum serde_test 0.8.23 (registry+https://github.com/rust-lang/crates.io-index)" = "110b3dbdf8607ec493c22d5d947753282f3bae73c0f56d322af1e8c78e4c23d5" -"checksum serde_yaml 0.8.9 (registry+https://github.com/rust-lang/crates.io-index)" = "38b08a9a90e5260fe01c6480ec7c811606df6d3a660415808c3c3fa8ed95b582" -"checksum spin 0.5.0 (registry+https://github.com/rust-lang/crates.io-index)" = "44363f6f51401c34e7be73db0db371c04705d35efbe9f7d6082e03a921a32c55" -"checksum stackvector 1.0.6 (registry+https://github.com/rust-lang/crates.io-index)" = "1c4725650978235083241fab0fdc8e694c3de37821524e7534a1a9061d1068af" -"checksum static_assertions 0.2.5 (registry+https://github.com/rust-lang/crates.io-index)" = "c19be23126415861cb3a23e501d34a708f7f9b2183c5252d690941c2e69199d5" -"checksum strsim 0.8.0 (registry+https://github.com/rust-lang/crates.io-index)" = "8ea5119cdb4c55b55d432abb513a0429384878c15dde60cc77b1c99de1a95a6a" -"checksum syn 0.14.9 (registry+https://github.com/rust-lang/crates.io-index)" = "261ae9ecaa397c42b960649561949d69311f08eeaea86a65696e6e46517cf741" -"checksum syn 0.15.35 (registry+https://github.com/rust-lang/crates.io-index)" = "641e117d55514d6d918490e47102f7e08d096fdde360247e4a10f7a91a8478d3" -"checksum synstructure 0.10.2 (registry+https://github.com/rust-lang/crates.io-index)" = "02353edf96d6e4dc81aea2d8490a7e9db177bf8acb0e951c24940bf866cb313f" -"checksum tempfile 3.0.8 (registry+https://github.com/rust-lang/crates.io-index)" = "7dc4738f2e68ed2855de5ac9cdbe05c9216773ecde4739b2f095002ab03a13ef" -"checksum term 0.5.2 (registry+https://github.com/rust-lang/crates.io-index)" = "edd106a334b7657c10b7c540a0106114feadeb4dc314513e97df481d5d966f42" -"checksum termion 1.5.2 (registry+https://github.com/rust-lang/crates.io-index)" = "dde0593aeb8d47accea5392b39350015b5eccb12c0d98044d856983d89548dea" -"checksum textwrap 0.11.0 (registry+https://github.com/rust-lang/crates.io-index)" = "d326610f408c7a4eb6f51c37c330e496b08506c9457c9d34287ecc38809fb060" -"checksum thread-id 3.3.0 (registry+https://github.com/rust-lang/crates.io-index)" = "c7fbf4c9d56b320106cd64fd024dadfa0be7cb4706725fc44a7d7ce952d820c1" -"checksum thread_local 0.3.6 (registry+https://github.com/rust-lang/crates.io-index)" = "c6b53e329000edc2b34dbe8545fd20e55a333362d0a321909685a19bd28c3f1b" -"checksum time 0.1.42 (registry+https://github.com/rust-lang/crates.io-index)" = "db8dcfca086c1143c9270ac42a2bbd8a7ee477b78ac8e45b19abfb0cbede4b6f" -"checksum toml 0.4.10 (registry+https://github.com/rust-lang/crates.io-index)" = "758664fc71a3a69038656bee8b6be6477d2a6c315a6b81f7081f591bffa4111f" -"checksum toml 0.5.1 (registry+https://github.com/rust-lang/crates.io-index)" = "b8c96d7873fa7ef8bdeb3a9cda3ac48389b4154f32b9803b4bc26220b677b039" -"checksum traitobject 0.1.0 (registry+https://github.com/rust-lang/crates.io-index)" = "efd1f82c56340fdf16f2a953d7bda4f8fdffba13d93b00844c25572110b26079" -"checksum typemap 0.3.3 (registry+https://github.com/rust-lang/crates.io-index)" = "653be63c80a3296da5551e1bfd2cca35227e13cdd08c6668903ae2f4f77aa1f6" -"checksum ucd-util 0.1.3 (registry+https://github.com/rust-lang/crates.io-index)" = "535c204ee4d8434478593480b8f86ab45ec9aae0e83c568ca81abf0fd0e88f86" -"checksum unicode-width 0.1.5 (registry+https://github.com/rust-lang/crates.io-index)" = "882386231c45df4700b275c7ff55b6f3698780a650026380e72dabe76fa46526" -"checksum unicode-xid 0.1.0 (registry+https://github.com/rust-lang/crates.io-index)" = "fc72304796d0818e357ead4e000d19c9c174ab23dc11093ac919054d20a6a7fc" -"checksum unreachable 1.0.0 (registry+https://github.com/rust-lang/crates.io-index)" = "382810877fe448991dfc7f0dd6e3ae5d58088fd0ea5e35189655f84e6814fa56" -"checksum unsafe-any 0.4.2 (registry+https://github.com/rust-lang/crates.io-index)" = "f30360d7979f5e9c6e6cea48af192ea8fab4afb3cf72597154b8f08935bc9c7f" -"checksum utf8-ranges 1.0.3 (registry+https://github.com/rust-lang/crates.io-index)" = "9d50aa7650df78abf942826607c62468ce18d9019673d4a2ebe1865dbb96ffde" -"checksum vec_map 0.8.1 (registry+https://github.com/rust-lang/crates.io-index)" = "05c78687fb1a80548ae3250346c3db86a80a7cdd77bda190189f2d0a0987c81a" -"checksum version_check 0.1.5 (registry+https://github.com/rust-lang/crates.io-index)" = "914b1a6776c4c929a602fafd8bc742e06365d4bcbe48c30f9cca5824f70dc9dd" -"checksum void 1.0.2 (registry+https://github.com/rust-lang/crates.io-index)" = "6a02e4885ed3bc0f2de90ea6dd45ebcbb66dacffe03547fadbb0eeae2770887d" -"checksum wait-timeout 0.2.0 (registry+https://github.com/rust-lang/crates.io-index)" = "9f200f5b12eb75f8c1ed65abd4b2db8a6e1b138a20de009dacee265a2498f3f6" -"checksum winapi 0.3.7 (registry+https://github.com/rust-lang/crates.io-index)" = "f10e386af2b13e47c89e7236a7a14a086791a2b88ebad6df9bf42040195cf770" -"checksum winapi-i686-pc-windows-gnu 0.4.0 (registry+https://github.com/rust-lang/crates.io-index)" = "ac3b87c63620426dd9b991e5ce0329eff545bccbbb34f3be09ff6fb6ab51b7b6" -"checksum winapi-x86_64-pc-windows-gnu 0.4.0 (registry+https://github.com/rust-lang/crates.io-index)" = "712e227841d057c1ee1cd2fb22fa7e5a5461ae8e48fa2ca79ec42cfc1931183f" -"checksum yaml-rust 0.3.5 (registry+https://github.com/rust-lang/crates.io-index)" = "e66366e18dc58b46801afbf2ca7661a9f59cc8c5962c29892b6039b4f86fa992" -"checksum yaml-rust 0.4.3 (registry+https://github.com/rust-lang/crates.io-index)" = "65923dd1784f44da1d2c3dbbc5e822045628c590ba72123e1c73d3c230c4434d" diff --git a/Cargo.toml b/Cargo.toml deleted file mode 100644 index 1ac8853f47..0000000000 --- a/Cargo.toml +++ /dev/null @@ -1,33 +0,0 @@ -[package] -name = "xanthous" -version = "0.1.0" -authors = ["Griffin Smith "] -edition = "2018" - -[dependencies] -alga = "0.9.1" -backtrace = "0.3" -clap = {version = "^2.33.0", features = ["yaml"]} -config = "*" -downcast-rs = "^1.0.4" -futures = "0.1.28" -include_dir = "0.2.1" -itertools = "*" -lazy_static = "*" -log = "*" -log4rs = "*" -maplit = "^1.0.1" -matches = "0.1.8" -nom = "^5.0.0" -prettytable-rs = "^0.8" -proptest = "0.9.3" -proptest-derive = "*" -rand = {version = "^0.7.0", features = ["small_rng"]} -serde = "^1.0.8" -serde_derive = "^1.0.8" -serde_json = "*" -serde_yaml = "0.8" -termion = "*" -toml = "^0.5.1" - -[dev-dependencies] diff --git a/Config.toml b/Config.toml deleted file mode 100644 index 30806365d2..0000000000 --- a/Config.toml +++ /dev/null @@ -1,2 +0,0 @@ -[logging] -level = "debug" diff --git a/proptest-regressions/description.txt b/proptest-regressions/description.txt deleted file mode 100644 index 3c4942315b..0000000000 --- a/proptest-regressions/description.txt +++ /dev/null @@ -1,7 +0,0 @@ -# Seeds for failure cases proptest has generated in the past. It is -# automatically read and these particular cases re-run before any -# novel cases are generated. -# -# It is recommended to check this file in to source control so that -# everyone who runs the test benefits from these saved cases. -cc 92b51b5444b913aaa6cb89d7e7175ab6a6af5b5231ba047d123bb55d43d7d272 # shrinks to descriptions = [] diff --git a/proptest-regressions/display/draw_box.txt b/proptest-regressions/display/draw_box.txt deleted file mode 100644 index 03391a696d..0000000000 --- a/proptest-regressions/display/draw_box.txt +++ /dev/null @@ -1,12 +0,0 @@ -# Seeds for failure cases proptest has generated in the past. It is -# automatically read and these particular cases re-run before any -# novel cases are generated. -# -# It is recommended to check this file in to source control so that -# everyone who runs the test benefits from these saved cases. -cc 7aff36a9f7b263e62434a3f61ada1d6aaf6ff4545a463548d96815a0e98cf5f1 # shrinks to dims = Dimensions { w: 0, h: 0 }, style = Thin -cc e4d96a13d6a8c7625e49d3545f6076d58152f3b5eb43fae65f0d407d1d34f96c # shrinks to dims = Dimensions { w: 1, h: 1 }, style = Thin -cc b5f0d7cb409896bd6692544c7c1f781174075c287d3b7a3b9dc73526ea489484 # shrinks to dims = Dimensions { w: 1, h: 1 }, style = Thin -cc 103b62b7c29c22adcbc23153638d3b37bad57aeec685d1eab38c49d0deed937f # shrinks to dims = Dimensions { w: 0, h: 1 }, style = Thin -cc 24c3858a543b0d8ff4966517040ec8c183ed311688d6863fd13facb5cdad7aa0 # shrinks to dims = Dimensions { w: 1, h: 1 }, style = Thin -cc 70a53a8b771937976a08a72d870b355a0995cc0251f45de4393c37a56a789b83 # shrinks to dims = Dimensions { w: 0, h: 0 }, style = Thin diff --git a/proptest-regressions/display/viewport.txt b/proptest-regressions/display/viewport.txt deleted file mode 100644 index e38056d975..0000000000 --- a/proptest-regressions/display/viewport.txt +++ /dev/null @@ -1,7 +0,0 @@ -# Seeds for failure cases proptest has generated in the past. It is -# automatically read and these particular cases re-run before any -# novel cases are generated. -# -# It is recommended to check this file in to source control so that -# everyone who runs the test benefits from these saved cases. -cc b84a5a6dbba5cfc69329a119d9e20328c0372e0db2b72e5d71d971e3f13f8749 # shrinks to pos = Position { x: 0, y: 0 }, outer = BoundingBox { dimensions: Dimensions { w: 0, h: 0 }, position: Position { x: 0, y: 0 } } diff --git a/proptest-regressions/types/entity_map.txt b/proptest-regressions/types/entity_map.txt deleted file mode 100644 index 68be5752f4..0000000000 --- a/proptest-regressions/types/entity_map.txt +++ /dev/null @@ -1,9 +0,0 @@ -# Seeds for failure cases proptest has generated in the past. It is -# automatically read and these particular cases re-run before any -# novel cases are generated. -# -# It is recommended to check this file in to source control so that -# everyone who runs the test benefits from these saved cases. -cc 16afe2473971397314ffa77acf7bad62f0c40bc3f591aff7aa9193c29e5a0921 # shrinks to items = [(Position { x: 92, y: 60 }, ""), (Position { x: 92, y: 60 }, "")] -cc 3a68a382c3bb8fdf60ea150a369abbdd45859e0c54cd6a4f7c75937a6c783b98 # shrinks to mut em = EntityMap { by_position: {Position { x: 25, y: 33 }: [1]}, by_id: {1: TestEntity { position: Position { x: 25, y: 33 }, name: "" }}, last_id: 1 }, ent = TestEntity { position: Position { x: 25, y: 33 }, name: "" }, new_position = Position { x: 0, y: 0 } -cc ffd7181e1c0343ab4c2ac92990f068d24c8663158c1c0a9526cd9edc470f950a # shrinks to mut em = EntityMap { by_position: {Position { x: 64, y: 58 }: [1]}, by_id: {1: TestEntity { position: Position { x: 64, y: 58 }, name: "" }}, last_id: 1 }, ent = TestEntity { position: Position { x: 0, y: 0 }, name: "" }, new_position = Position { x: 64, y: 58 } diff --git a/proptest-regressions/types/mod.txt b/proptest-regressions/types/mod.txt deleted file mode 100644 index 276466965c..0000000000 --- a/proptest-regressions/types/mod.txt +++ /dev/null @@ -1,8 +0,0 @@ -# Seeds for failure cases proptest has generated in the past. It is -# automatically read and these particular cases re-run before any -# novel cases are generated. -# -# It is recommended to check this file in to source control so that -# everyone who runs the test benefits from these saved cases. -cc a51cf37623f0e4024f4ba1450195be296d9b9e8ae954dbbf997ce5b57cd26792 # shrinks to a = Position { x: 44, y: 25 }, b = Position { x: 0, y: 25 }, c = Position { x: 0, y: 0 } -cc 0816b9348c53ef8c8328f0ea72d5ebef215f6764b1cbbd3c5db958e214c5fa3a # shrinks to pos = Position { x: 0, y: 0 }, dir = Down diff --git a/rustfmt.toml b/rustfmt.toml deleted file mode 100644 index df99c69198..0000000000 --- a/rustfmt.toml +++ /dev/null @@ -1 +0,0 @@ -max_width = 80 diff --git a/src/cli.yml b/src/cli.yml deleted file mode 100644 index 4b2e94e57b..0000000000 --- a/src/cli.yml +++ /dev/null @@ -1,46 +0,0 @@ -name: xanthous -version: "0.0" -author: Griffin Smith -about: hey, it's a terminal game -args: - - config: - short: c - long: config - value_name: FILE - help: Sets a custom config file - takes_value: true -subcommands: - - info: - about: Writes debug information to the terminal and exits - - generate-level: - about: Generate a level and print it to the screen - args: - - generator: - long: generator - value_name: GEN - help: Select which generator to use - takes_value: true - - width: - long: width - short: w - value_name: WIDTH - takes_value: true - - height: - long: height - short: h - value_name: HEIGHT - takes_value: true - - start-alive-chance: - long: start-alive-chance - takes_value: true - - birth_limit: - long: birth-limit - takes_value: true - - death_limit: - long: death-limit - takes_value: true - - steps: - long: steps - short: s - value_name: STEPS - takes_value: true diff --git a/src/description.rs b/src/description.rs deleted file mode 100644 index 48c98d76e0..0000000000 --- a/src/description.rs +++ /dev/null @@ -1,93 +0,0 @@ -use crate::entities::Describe; - -pub fn list_to_sentence(lst: &[String]) -> String { - let mut buf = String::with_capacity( - lst.iter() - .map(|e| e.len() + 2usize /* ", " */) - .sum::() - + if lst.len() >= 3 { - 3usize /* "and" */ - } else { - 0usize - }, - ); - - match lst.len() { - 0 => {} - 1 => buf.push_str(&lst[0]), - 2 => { - buf.push_str(&lst[0]); - buf.push_str(" and "); - buf.push_str(&lst[1]); - } - _ => { - for desc in &lst[..lst.len() - 1] { - buf.push_str(desc); - buf.push_str(", "); - } - buf.push_str("and "); - buf.push_str(&lst[lst.len() - 1]); - } - } - - buf -} - -pub fn describe_list(lst: &[A]) -> String { - list_to_sentence( - &lst.iter().map(|e| e.description()).collect::>(), - ) -} - -#[cfg(test)] -mod tests { - use super::*; - use proptest::prelude::*; - use proptest_derive::Arbitrary; - - #[derive(Debug, Arbitrary)] - struct Description(String); - - impl Describe for Description { - fn description(&self) -> String { - self.0.clone() - } - } - - proptest! { - #[test] - fn test_describe_list_includes_all_descriptions( - descriptions: Vec - ) { - let res = describe_list(&descriptions); - for Description(desc) in descriptions { - assert!(res.contains(&desc)); - } - } - } - - #[test] - fn test_describe_list() { - assert_eq!( - describe_list(&[Description("one".to_string())]), - "one".to_string() - ); - - assert_eq!( - describe_list(&[ - Description("one".to_string()), - Description("two".to_string()) - ]), - "one and two".to_string() - ); - - assert_eq!( - describe_list(&[ - Description("one".to_string()), - Description("two".to_string()), - Description("three".to_string()) - ]), - "one, two, and three".to_string() - ); - } -} diff --git a/src/display/color.rs b/src/display/color.rs deleted file mode 100644 index afe0039998..0000000000 --- a/src/display/color.rs +++ /dev/null @@ -1,163 +0,0 @@ -use serde::de::{self, Unexpected, Visitor}; -use std::fmt; -use std::marker::PhantomData; -use termion::color; - -#[derive(Debug)] -pub struct Color(Box); - -unsafe impl Sync for Color {} -unsafe impl Send for Color {} - -impl Color { - pub fn new(c: C) -> Self { - Color(Box::new(c)) - } -} - -impl PartialEq for Color { - fn eq(&self, other: &Self) -> bool { - format!("{}{}", color::Fg(self), color::Bg(self)) - == format!("{}{}", color::Fg(other), color::Bg(other)) - } -} - -impl Eq for Color {} - -impl color::Color for Color { - fn write_fg(&self, f: &mut fmt::Formatter<'_>) -> fmt::Result { - self.0.write_fg(f) - } - - fn write_bg(&self, f: &mut fmt::Formatter<'_>) -> fmt::Result { - self.0.write_bg(f) - } -} - -impl<'a> color::Color for &'a Color { - fn write_fg(&self, f: &mut fmt::Formatter<'_>) -> fmt::Result { - self.0.write_fg(f) - } - - fn write_bg(&self, f: &mut fmt::Formatter<'_>) -> fmt::Result { - self.0.write_bg(f) - } -} - -impl Default for Color { - fn default() -> Self { - Color::new(color::Reset) - } -} - -pub struct ColorVisitor { - marker: PhantomData Color>, -} - -impl ColorVisitor { - fn new() -> Self { - ColorVisitor { - marker: PhantomData, - } - } -} - -impl<'de> Visitor<'de> for ColorVisitor { - type Value = Color; - - fn expecting(&self, formatter: &mut fmt::Formatter<'_>) -> fmt::Result { - formatter.write_str("A color") - } - - fn visit_str(self, v: &str) -> Result - where - E: de::Error, - { - match v.to_lowercase().as_ref() { - "black" => Ok(Color(Box::new(color::Black))), - "blue" => Ok(Color(Box::new(color::Blue))), - "cyan" => Ok(Color(Box::new(color::Cyan))), - "green" => Ok(Color(Box::new(color::Green))), - "light black" | "light_black" => { - Ok(Color(Box::new(color::LightBlack))) - } - "light blue" | "light_blue" => { - Ok(Color(Box::new(color::LightBlue))) - } - "light cyan" | "light_cyan" => { - Ok(Color(Box::new(color::LightCyan))) - } - "light green" | "light_green" => { - Ok(Color(Box::new(color::LightGreen))) - } - "light magenta" | "light_magenta" => { - Ok(Color(Box::new(color::LightMagenta))) - } - "light red" | "light_red" => Ok(Color(Box::new(color::LightRed))), - "light white" | "light_white" => { - Ok(Color(Box::new(color::LightWhite))) - } - "light yellow" | "light_yellow" => { - Ok(Color(Box::new(color::LightYellow))) - } - "magenta" => Ok(Color(Box::new(color::Magenta))), - "red" => Ok(Color(Box::new(color::Red))), - "white" => Ok(Color(Box::new(color::White))), - "yellow" => Ok(Color(Box::new(color::Yellow))), - _ => Err(de::Error::invalid_value( - Unexpected::Str(v), - &"a valid color", - )), - } - } - - fn visit_map(self, mut map: A) -> Result - where - A: de::MapAccess<'de>, - { - let mut red = None; - let mut green = None; - let mut blue = None; - while let Some((k, v)) = map.next_entry()? { - match k { - "red" => { - red = Some(v); - } - "green" => { - green = Some(v); - } - "blue" => { - blue = Some(v); - } - _ => { - return Err(de::Error::unknown_field( - k, - &["red", "green", "blue"], - )); - } - } - } - - match (red, green, blue) { - (Some(r), Some(g), Some(b)) => { - Ok(Color(Box::new(color::Rgb(r, g, b)))) - } - (None, _, _) => Err(de::Error::missing_field("red")), - (_, None, _) => Err(de::Error::missing_field("green")), - (_, _, None) => Err(de::Error::missing_field("blue")), - } - } - - fn visit_u8(self, v: u8) -> Result { - Ok(Color(Box::new(color::AnsiValue(v)))) - } -} - -impl<'de> serde::Deserialize<'de> for Color { - fn deserialize(deserializer: D) -> Result - where - D: serde::Deserializer<'de>, - { - deserializer.deserialize_any(ColorVisitor::new()) - } -} diff --git a/src/display/draw_box.rs b/src/display/draw_box.rs deleted file mode 100644 index e4d34a7acd..0000000000 --- a/src/display/draw_box.rs +++ /dev/null @@ -1,274 +0,0 @@ -use crate::display::utils::clone_times; -use crate::display::utils::times; -use crate::types::pos; -use crate::types::BoundingBox; -use crate::types::Dimensions; -use crate::types::Neighbors; -use itertools::Itertools; -use proptest::prelude::Arbitrary; -use proptest::strategy; -use proptest_derive::Arbitrary; -use std::io::{self, Write}; - -// Box Drawing -// 0 1 2 3 4 5 6 7 8 9 A B C D E F -// U+250x ─ ━ │ ┃ ┄ ┅ ┆ ┇ ┈ ┉ ┊ ┋ ┌ ┍ ┎ ┏ -// U+251x ┐ ┑ ┒ ┓ └ ┕ ┖ ┗ ┘ ┙ ┚ ┛ ├ ┝ ┞ ┟ -// U+252x ┠ ┡ ┢ ┣ ┤ ┥ ┦ ┧ ┨ ┩ ┪ ┫ ┬ ┭ ┮ ┯ -// U+253x ┰ ┱ ┲ ┳ ┴ ┵ ┶ ┷ ┸ ┹ ┺ ┻ ┼ ┽ ┾ ┿ -// U+254x ╀ ╁ ╂ ╃ ╄ ╅ ╆ ╇ ╈ ╉ ╊ ╋ ╌ ╍ ╎ ╏ -// U+255x ═ ║ ╒ ╓ ╔ ╕ ╖ ╗ ╘ ╙ ╚ ╛ ╜ ╝ ╞ ╟ -// U+256x ╠ ╡ ╢ ╣ ╤ ╥ ╦ ╧ ╨ ╩ ╪ ╫ ╬ ╭ ╮ ╯ -// U+257x ╰ ╱ ╲ ╳ ╴ ╵ ╶ ╷ ╸ ╹ ╺ ╻ ╼ ╽ ╾ ╿ - -static BOX: char = '☐'; - -static BOX_CHARS: [[char; 16]; 8] = [ - // 0 - [ - // 0 1 2 3 4 5 6 7 8 9 - '─', '━', '│', '┃', '┄', '┅', '┆', '┇', '┈', '┉', - // 10 - '┊', '┋', '┌', '┍', '┎', '┏', - ], - // 1 - [ - // 0 1 2 3 4 5 6 7 8 9 - '┐', '┑', '┒', '┓', '└', '┕', '┖', '┗', '┘', '┙', - '┚', '┛', '├', '┝', '┞', '┟', - ], - // 2 - [ - // 0 1 2 3 4 5 6 7 8 9 - '┠', '┡', '┢', '┣', '┤', '┥', '┦', '┧', '┨', '┩', - '┪', '┫', '┬', '┭', '┮', '┯', - ], - // 3 - [ - // 0 1 2 3 4 5 6 7 8 9 - '┰', '┱', '┲', '┳', '┴', '┵', '┶', '┷', '┸', '┹', - '┺', '┻', '┼', '┽', '┾', '┿', - ], - // 4 - [ - // 0 1 2 3 4 5 6 7 8 9 - '╀', '╁', '╂', '╃', '╄', '╅', '╆', '╇', '╈', '╉', - '╊', '╋', '╌', '╍', '╎', '╏', - ], - // 5 - [ - // 0 1 2 3 4 5 6 7 8 9 - '═', '║', '╒', '╓', '╔', '╕', '╖', '╗', '╘', '╙', - '╚', '╛', '╜', '╝', '╞', '╟', - ], - // 6 - [ - // 0 1 2 3 4 5 6 7 8 9 - '╠', '╡', '╢', '╣', '╤', '╥', '╦', '╧', '╨', '╩', - '╪', '╫', '╬', '╭', '╮', '╯', - ], - // 7 - [ - // 0 1 2 3 4 5 6 7 8 9 - '╰', '╱', '╲', '╳', '╴', '╵', '╶', '╷', '╸', '╹', - '╺', '╻', '╼', '╽', '╾', '╿', - ], -]; - -#[derive(Clone, Copy, Debug, PartialEq, Eq)] -pub enum BoxStyle { - Thin, - Thick, - Dotted, - ThickDotted, - Dashed, - ThickDashed, - Double, -} - -impl Arbitrary for BoxStyle { - type Parameters = (); - type Strategy = strategy::Just; - fn arbitrary_with(_: Self::Parameters) -> Self::Strategy { - // TODO - strategy::Just(BoxStyle::Thin) - } -} - -pub trait Stylable { - fn style(&self, style: BoxStyle) -> char; -} - -#[derive(Clone, Copy, Debug, PartialEq, Eq, Arbitrary)] -enum Corner { - TopRight, - TopLeft, - BottomRight, - BottomLeft, -} - -impl Stylable for Corner { - fn style(&self, style: BoxStyle) -> char { - use BoxStyle::*; - use Corner::*; - - match (self, style) { - (TopRight, Thin) => BOX_CHARS[1][0], - (TopLeft, Thin) => BOX_CHARS[0][12], - (BottomRight, Thin) => BOX_CHARS[1][8], - (BottomLeft, Thin) => BOX_CHARS[1][4], - _ => unimplemented!(), - } - } -} - -#[derive(Clone, Copy, Debug, PartialEq, Eq, Arbitrary)] -enum Line { - H, - V, -} - -impl Stylable for Line { - fn style(&self, style: BoxStyle) -> char { - use BoxStyle::*; - use Line::*; - match (self, style) { - (H, Thin) => BOX_CHARS[0][0], - (V, Thin) => BOX_CHARS[0][2], - _ => unimplemented!(), - } - } -} - -impl Stylable for Neighbors> { - fn style(&self, _style: BoxStyle) -> char { - use BoxStyle::*; - match (self.left, self.right, self.top, self.bottom) { - (None, None, None, None) => BOX, - (Some(Thin), None, None, None) => BOX_CHARS[7][4], - (None, Some(Thin), None, None) => BOX_CHARS[7][6], - (None, None, Some(Thin), None) => BOX_CHARS[7][5], - (None, None, None, Some(Thin)) => BOX_CHARS[7][7], - (Some(Thin), Some(Thin), None, None) => Line::H.style(Thin), - (Some(Thin), None, Some(Thin), None) => { - Corner::BottomRight.style(Thin) - } - (Some(Thin), None, None, Some(Thin)) => { - Corner::TopRight.style(Thin) - } - (None, Some(Thin), Some(Thin), None) => { - Corner::BottomLeft.style(Thin) - } - (None, Some(Thin), None, Some(Thin)) => Corner::TopLeft.style(Thin), - (None, None, Some(Thin), Some(Thin)) => Line::V.style(Thin), - (None, Some(Thin), Some(Thin), Some(Thin)) => BOX_CHARS[1][12], - (Some(Thin), None, Some(Thin), Some(Thin)) => BOX_CHARS[2][4], - (Some(Thin), Some(Thin), None, Some(Thin)) => BOX_CHARS[2][12], - (Some(Thin), Some(Thin), Some(Thin), None) => BOX_CHARS[3][4], - (Some(Thin), Some(Thin), Some(Thin), Some(Thin)) => { - BOX_CHARS[3][12] - } - neighs => panic!("unimplemented: {:?}", neighs), - } - } -} - -#[must_use] -pub fn make_box(style: BoxStyle, dims: Dimensions) -> String { - if dims.h == 0 || dims.w == 0 { - "".to_string() - } else if dims.h == 1 && dims.w == 1 { - BOX.to_string() - } else if dims.h == 1 { - times(Line::H.style(style), dims.w) - } else if dims.w == 1 { - (0..dims.h).map(|_| Line::V.style(style)).join("\n\r") - } else { - let h_line: String = times(Line::H.style(style), dims.w - 2); - let v_line = Line::V.style(style); - let v_walls: String = clone_times( - format!( - "{}{}{}\n\r", - v_line, - times::<_, String>(' ', dims.w - 2), - v_line - ), - dims.h - 2, - ); - - format!( - "{}{}{}\n\r{}{}{}{}", - Corner::TopLeft.style(style), - h_line, - Corner::TopRight.style(style), - v_walls, - Corner::BottomLeft.style(style), - h_line, - Corner::BottomRight.style(style), - ) - } -} - -/// Draw the box described by the given BoundingBox's position and dimensions to -/// the given output, with the given style -pub fn draw_box( - out: &mut W, - bbox: BoundingBox, - style: BoxStyle, -) -> io::Result<()> { - let box_str = make_box(style, bbox.dimensions); - if bbox.position.x == 0 { - write!(out, "{}{}", bbox.position.cursor_goto(), box_str)?; - } else { - for (i, line) in box_str.split("\n\r").enumerate() { - debug!("line: {:?}!", line); - write!( - out, - "{}{}", - (bbox.position + pos(0, i as i16)).cursor_goto(), - line - )?; - } - } - Ok(()) -} - -#[cfg(test)] -mod tests { - use super::*; - use proptest::prelude::*; - - #[test] - fn make_thin_box() { - let res = make_box(BoxStyle::Thin, Dimensions { w: 10, h: 10 }); - assert_eq!( - res, - "┌────────┐ -\r│ │ -\r│ │ -\r│ │ -\r│ │ -\r│ │ -\r│ │ -\r│ │ -\r│ │ -\r└────────┘" - ); - } - - proptest! { - #[test] - fn box_has_height_lines(dims: Dimensions, style: BoxStyle) { - let res = make_box(style, dims); - prop_assume!((dims.w > 0 && dims.h > 0)); - assert_eq!(res.split("\n\r").count(), dims.h as usize); - } - - #[test] - fn box_lines_have_width_length(dims: Dimensions, style: BoxStyle) { - let res = make_box(style, dims); - prop_assume!(dims.w == 0 && dims.h == 0 || (dims.w > 0 && dims.h > 0)); - assert!(res.split("\n\r").all(|l| l.chars().count() == dims.w as usize)); - } - } -} diff --git a/src/display/mod.rs b/src/display/mod.rs deleted file mode 100644 index 6e37a03d8c..0000000000 --- a/src/display/mod.rs +++ /dev/null @@ -1,52 +0,0 @@ -pub mod color; -pub mod draw_box; -pub mod utils; -pub mod viewport; -use crate::entities::entity::Entity; -use crate::types::Neighbors; -use crate::types::Positioned; -pub use draw_box::{make_box, BoxStyle}; -use std::io::{self, Write}; -use termion::{clear, cursor, style}; -pub use viewport::Viewport; - -pub fn clear(out: &mut T) -> io::Result<()> { - write!(out, "{}{}{}", clear::All, style::Reset, cursor::Goto(1, 1)) -} - -pub trait Draw: Positioned { - /// Draw this entity, assuming the character is already at the correct - /// position - fn do_draw(&self, out: &mut dyn Write) -> io::Result<()>; -} - -impl Draw for &T { - fn do_draw(&self, out: &mut dyn Write) -> io::Result<()> { - (**self).do_draw(out) - } -} - -impl Draw for Box { - fn do_draw(&self, out: &mut dyn Write) -> io::Result<()> { - (**self).do_draw(out) - } -} - -pub trait DrawWithNeighbors: Positioned { - #[allow(clippy::borrowed_box)] - fn do_draw_with_neighbors<'a, 'b>( - &'a self, - out: &'b mut dyn Write, - neighbors: &'a Neighbors>>, - ) -> io::Result<()>; -} - -impl DrawWithNeighbors for T { - fn do_draw_with_neighbors<'a, 'b>( - &'a self, - out: &'b mut dyn Write, - _neighbors: &'a Neighbors>>, - ) -> io::Result<()> { - self.do_draw(out) - } -} diff --git a/src/display/utils.rs b/src/display/utils.rs deleted file mode 100644 index acd4416cb8..0000000000 --- a/src/display/utils.rs +++ /dev/null @@ -1,9 +0,0 @@ -use std::iter::FromIterator; - -pub fn times>(elem: A, n: u16) -> B { - (0..n).map(|_| elem).collect() -} - -pub fn clone_times>(elem: A, n: u16) -> B { - (0..n).map(|_| elem.clone()).collect() -} diff --git a/src/display/viewport.rs b/src/display/viewport.rs deleted file mode 100644 index c44316cdaa..0000000000 --- a/src/display/viewport.rs +++ /dev/null @@ -1,303 +0,0 @@ -use super::BoxStyle; -use super::DrawWithNeighbors; -use crate::display::draw_box::draw_box; -use crate::display::utils::clone_times; -use crate::entities::entity::Entity; -use crate::types::menu::MenuInfo; -use crate::types::Neighbors; -use crate::types::{pos, BoundingBox, Direction, Position, Positioned}; -use std::fmt::{self, Debug}; -use std::io::{self, Write}; - -pub enum CursorState { - Game, - Prompt(Position), -} - -impl Default for CursorState { - fn default() -> Self { - CursorState::Game - } -} - -pub struct Viewport { - /// The box describing the visible part of the viewport. - /// - /// Generally the size of the terminal, and positioned at 0, 0 - pub outer: BoundingBox, - - /// The box describing the game part of the viewport. - pub game: BoundingBox, - - /// The box describing the inner part of the viewport - /// - /// Its position is relative to `outer.inner()`, and its size should - /// generally not be smaller than outer - pub inner: BoundingBox, - - /// The actual screen that the viewport writes to - pub out: W, - - cursor_state: CursorState, - - /// Reset the cursor back to this position after every draw - pub game_cursor_position: Position, -} - -impl Viewport { - pub fn new(outer: BoundingBox, inner: BoundingBox, out: W) -> Self { - Viewport { - outer, - inner, - out, - game: outer.move_tr_corner(Position { x: 0, y: 1 }), - cursor_state: Default::default(), - game_cursor_position: pos(0, 0), - } - } - - /// Returns true if the (inner-relative) position of the given entity is - /// visible within this viewport - pub fn visible(&self, ent: &E) -> bool { - self.on_screen(ent.position()).within(self.game.inner()) - } - - /// Convert the given inner-relative position to one on the actual screen - fn on_screen(&self, pos: Position) -> Position { - pos + self.inner.position + self.game.inner().position - } -} - -impl Debug for Viewport { - fn fmt(&self, f: &mut fmt::Formatter<'_>) -> fmt::Result { - write!( - f, - "Viewport {{ outer: {:?}, inner: {:?}, out: }}", - self.outer, self.inner - ) - } -} - -impl Viewport { - /// Draw the given entity to the viewport at its position, if visible - #[allow(clippy::borrowed_box)] - pub fn draw( - &mut self, - entity: &T, - neighbors: &Neighbors>>, - ) -> io::Result<()> { - if !self.visible(entity) { - return Ok(()); - } - self.cursor_goto(entity.position())?; - entity.do_draw_with_neighbors(self, neighbors)?; - self.reset_cursor() - } - - fn reset_cursor(&mut self) -> io::Result<()> { - self.cursor_goto(self.game_cursor_position) - } - - /// Move the cursor to the given inner-relative position - pub fn cursor_goto(&mut self, pos: Position) -> io::Result<()> { - write!(self, "{}", self.on_screen(pos).cursor_goto()) - } - - /// Clear whatever single character is drawn at the given inner-relative - /// position, if visible - pub fn clear(&mut self, pos: Position) -> io::Result<()> { - write!(self, "{} ", self.on_screen(pos).cursor_goto(),)?; - self.reset_cursor() - } - - /// Initialize this viewport by drawing its outer box to the screen - pub fn init(&mut self) -> io::Result<()> { - draw_box(self, self.game, BoxStyle::Thin) - } - - /// Write a message to the message area on the screen - /// - /// Will overwrite any message already present, and if the given message is - /// longer than the screen will truncate. This means callers should handle - /// message buffering and ellipsisization - pub fn write_message(&mut self, msg: &str) -> io::Result { - let msg_to_write = if msg.len() <= self.outer.dimensions.w as usize { - msg - } else { - &msg[0..self.outer.dimensions.w as usize] - }; - write!( - self, - "{}{}{}", - self.outer.position.cursor_goto(), - msg_to_write, - clone_times::<_, String>( - " ".to_string(), - self.outer.dimensions.w - msg.len() as u16 - ), - )?; - self.reset_cursor()?; - Ok(msg_to_write.len()) - } - - pub fn clear_message(&mut self) -> io::Result<()> { - write!( - self, - "{}{}", - self.outer.position.cursor_goto(), - clone_times::<_, String>( - " ".to_string(), - self.outer.dimensions.w as u16 - ) - )?; - self.reset_cursor() - } - - /// Write a prompt requesting text input to the message area on the screen. - /// - /// Will overwrite any message already present, and if the given message is - /// longer than the screen will truncate. This means callers should handle - /// message buffering and ellipsisization - pub fn write_prompt<'a, 'b>(&'a mut self, msg: &'b str) -> io::Result<()> { - let len = self.write_message(msg)? + 1; - let pos = self.outer.position + pos(len as i16, 0); - self.cursor_state = CursorState::Prompt(pos); - write!(self, "{}", pos.cursor_goto())?; - self.flush() - } - - pub fn push_prompt_chr(&mut self, chr: char) -> io::Result<()> { - if let CursorState::Prompt(pos) = self.cursor_state { - write!(self, "{}", chr)?; - self.cursor_state = CursorState::Prompt(pos + Direction::Right); - } - Ok(()) - } - - pub fn pop_prompt_chr(&mut self) -> io::Result<()> { - if let CursorState::Prompt(pos) = self.cursor_state { - let new_pos = pos + Direction::Left; - write!( - self, - "{} {}", - new_pos.cursor_goto(), - new_pos.cursor_goto() - )?; - self.cursor_state = CursorState::Prompt(new_pos); - } - Ok(()) - } - - pub fn clear_prompt(&mut self) -> io::Result<()> { - self.clear_message()?; - self.cursor_state = CursorState::Game; - Ok(()) - } - - pub fn write_menu(&mut self, menu: &MenuInfo) -> io::Result<()> { - let menu_dims = menu.dimensions(); - - // TODO: check if the menu is too big - - let menu_position = self.game.position + pos(1, 1); - - let menu_box = BoundingBox { - dimensions: menu_dims, - position: menu_position, - }; - - debug!("writing menu at: {:?}", menu_box); - - draw_box(self, menu_box, BoxStyle::Thin)?; - - write!( - self, - "{}{}", - (menu_position + pos(2, 2)).cursor_goto(), - menu.prompt - )?; - - for (idx, option) in menu.options.iter().enumerate() { - write!( - self, - "{}{}", - (menu_position + pos(2, 4 + idx as i16)).cursor_goto(), - option - )?; - } - - Ok(()) - } -} - -impl Positioned for Viewport { - fn position(&self) -> Position { - self.outer.position - } -} - -impl Write for Viewport { - fn write(&mut self, buf: &[u8]) -> io::Result { - self.out.write(buf) - } - - fn flush(&mut self) -> io::Result<()> { - self.out.flush() - } - - fn write_all(&mut self, buf: &[u8]) -> io::Result<()> { - self.out.write_all(buf) - } -} - -#[cfg(test)] -mod tests { - use super::*; - use crate::types::Dimensions; - - #[test] - fn test_visible() { - assert!(Viewport::new( - BoundingBox::at_origin(Dimensions { w: 10, h: 10 }), - BoundingBox { - position: Position { x: -10, y: -10 }, - dimensions: Dimensions { w: 15, h: 15 }, - }, - () - ) - .visible(&Position { x: 13, y: 13 })); - - assert!(!Viewport::new( - BoundingBox::at_origin(Dimensions { w: 10, h: 10 }), - BoundingBox { - position: Position { x: -10, y: -10 }, - dimensions: Dimensions { w: 15, h: 15 }, - }, - (), - ) - .visible(&Position { x: 1, y: 1 })); - } - - #[test] - fn test_write_menu() { - let buf: Vec = Vec::new(); - - let mut viewport = Viewport::new( - BoundingBox::at_origin(Dimensions::default()), - BoundingBox::at_origin(Dimensions::default()), - buf, - ); - - let menu = MenuInfo::new( - "Test menu".to_string(), - vec!["option 1".to_string(), "option 2".to_string()], - ); - - viewport.write_menu(&menu).unwrap(); - - let res = std::str::from_utf8(&viewport.out).unwrap(); - assert!(res.contains("Test menu")); - assert!(res.contains("option 1")); - assert!(res.contains("option 2")); - } -} diff --git a/src/entities/character.rs b/src/entities/character.rs deleted file mode 100644 index 3e8336b129..0000000000 --- a/src/entities/character.rs +++ /dev/null @@ -1,51 +0,0 @@ -use crate::display; -use crate::entities::item::Item; -use crate::types::{Position, Speed}; -use std::io::{self, Write}; - -const DEFAULT_SPEED: Speed = Speed(100); - -entity! { - pub struct Character { - pub o_name: Option, - pub inventory: Vec>, - } -} - -static_description!(Character, "yourself"); - -impl Character { - pub fn new() -> Character { - Character { - id: None, - position: Position { x: 0, y: 0 }, - o_name: None, - inventory: Vec::new(), - } - } - - pub fn speed(&self) -> Speed { - Speed(100) - } - - pub fn damage(&self) -> u16 { - // TODO - 1 - } - - pub fn name(&self) -> &str { - self.o_name - .as_ref() - .expect("Character name not initialized") - } - - pub fn set_name(&mut self, name: String) { - self.o_name = Some(name); - } -} - -impl display::Draw for Character { - fn do_draw(&self, out: &mut dyn Write) -> io::Result<()> { - write!(out, "@") - } -} diff --git a/src/entities/creature.rs b/src/entities/creature.rs deleted file mode 100644 index 20071c1d88..0000000000 --- a/src/entities/creature.rs +++ /dev/null @@ -1,63 +0,0 @@ -use crate::display; -use crate::entities::raws::CreatureType; -use crate::entities::raws::EntityRaw; -use crate::entities::{raw, Describe, EntityID}; -use crate::types::Position; -use std::io::{self, Write}; - -#[derive(Debug, Clone)] -pub struct Creature { - pub id: Option, - pub typ: &'static CreatureType<'static>, - pub position: Position, - pub hitpoints: u16, -} - -impl Creature { - pub fn new_from_raw(name: &'static str, position: Position) -> Self { - match raw(name) { - EntityRaw::Creature(typ) => Self::new_with_type(typ, position), - _ => panic!("Invalid raw type for {:?}, expected Creature", name), - } - } - - pub fn new_with_type( - typ: &'static CreatureType<'static>, - position: Position, - ) -> Self { - Creature { - id: None, - typ, - position, - hitpoints: typ.max_hitpoints, - } - } - - /// Damage the given creature by the given amount - pub fn damage(&mut self, amount: u16) { - if self.hitpoints <= amount { - self.hitpoints = 0; - } else { - self.hitpoints -= amount; - } - } - - /// Returns true if this creature has died - pub fn dead(&self) -> bool { - self.hitpoints == 0 - } -} - -entity!(Creature); - -impl Describe for Creature { - fn description(&self) -> String { - self.typ.description.to_string() - } -} - -impl display::Draw for Creature { - fn do_draw(&self, out: &mut dyn Write) -> io::Result<()> { - write!(out, "{}", self.typ.chr) - } -} diff --git a/src/entities/entity.rs b/src/entities/entity.rs deleted file mode 100644 index 01075d298f..0000000000 --- a/src/entities/entity.rs +++ /dev/null @@ -1,125 +0,0 @@ -use crate::display::DrawWithNeighbors; -use crate::entities::EntityID; -use crate::types::Neighbors; -use crate::types::Position; -use crate::types::{Positioned, PositionedMut}; -use downcast_rs::Downcast; -use std::fmt::Debug; -use std::io::{self, Write}; - -pub trait Identified: Debug { - fn opt_id(&self) -> Option; - fn set_id(&mut self, id: ID); - - fn id(&self) -> ID { - self.opt_id() - .unwrap_or_else(|| panic!("Entity ({:?}) is not in the game", self)) - } -} - -impl<'a, A, ID> Identified for &'a mut A -where - A: Identified, -{ - fn opt_id(&self) -> Option { - (**self).opt_id() - } - fn set_id(&mut self, id: ID) { - (**self).set_id(id); - } -} - -impl> Identified for Box { - fn opt_id(&self) -> Option { - (**self).opt_id() - } - fn set_id(&mut self, id: ID) { - (**self).set_id(id); - } -} - -pub trait Describe { - fn description(&self) -> String; -} - -ref_impl! { - impl Describe for &T { - fn description(&self) -> String { - (**self).description() - } - } -} - -#[macro_export] -macro_rules! static_description { - ($name: ident, $description: expr) => { - impl $crate::entities::entity::Describe for $name { - fn description(&self) -> String { - $description.to_string() - } - } - }; -} - -pub trait Entity: - Positioned - + PositionedMut - + Identified - + DrawWithNeighbors - + Downcast - + Describe -{ -} - -impl Identified for Box { - fn opt_id(&self) -> Option { - (**self).opt_id() - } - fn set_id(&mut self, id: EntityID) { - (**self).set_id(id); - } -} - -#[macro_export] -macro_rules! identified { - ($name: ident, $typ: path) => { - identified!($name, $typ, id); - }; - ($name: ident, $typ: path, $attr: ident) => { - impl crate::entities::entity::Identified<$typ> for $name { - fn opt_id(&self) -> Option<$typ> { - self.$attr - } - - fn set_id(&mut self, id: $typ) { - self.$attr = Some(id) - } - } - }; -} - -impl_downcast!(Entity); - -impl DrawWithNeighbors for Box { - fn do_draw_with_neighbors<'a, 'b>( - &'a self, - out: &'b mut dyn Write, - neighbors: &'a Neighbors>>, - ) -> io::Result<()> { - (**self).do_draw_with_neighbors(out, neighbors) - } -} - -pub type AnEntity = Box; - -impl Positioned for AnEntity { - fn position(&self) -> Position { - (**self).position() - } -} - -impl PositionedMut for AnEntity { - fn set_position(&mut self, pos: Position) { - (**self).set_position(pos) - } -} diff --git a/src/entities/entity_char.rs b/src/entities/entity_char.rs deleted file mode 100644 index 70f26bfffd..0000000000 --- a/src/entities/entity_char.rs +++ /dev/null @@ -1,24 +0,0 @@ -use crate::display::color::Color; -use std::fmt::{self, Display, Formatter}; -use termion::color; - -#[derive(Debug, Deserialize, PartialEq, Eq)] -pub struct EntityChar { - #[serde(default)] - color: Color, - - #[serde(rename = "char")] - chr: char, -} - -impl Display for EntityChar { - fn fmt(&self, f: &mut Formatter<'_>) -> fmt::Result { - write!( - f, - "{}{}{}", - color::Fg(&self.color), - self.chr, - color::Fg(color::Reset) - ) - } -} diff --git a/src/entities/environment.rs b/src/entities/environment.rs deleted file mode 100644 index 8f8a567062..0000000000 --- a/src/entities/environment.rs +++ /dev/null @@ -1,36 +0,0 @@ -use crate::display; -use crate::display::draw_box::{BoxStyle, Stylable}; -use crate::entities::Entity; -use crate::types::{Neighbors, Position}; -use std::io::{self, Write}; - -entity! { - pub struct Wall { - pub style: BoxStyle - } -} - -static_description!(Wall, "a wall"); - -impl Wall { - pub fn new(position: Position, style: BoxStyle) -> Self { - new_entity!(Wall { position, style }) - } -} - -impl display::DrawWithNeighbors for Wall { - fn do_draw_with_neighbors<'a, 'b>( - &'a self, - out: &'b mut dyn Write, - neighbors: &'a Neighbors>>, - ) -> io::Result<()> { - let neighbor_styles: Neighbors> = - neighbors.map(|es| { - es.iter() - .filter_map(|e| e.downcast_ref::()) - .map(|wall| wall.style) - .next() - }); - write!(out, "{}", neighbor_styles.style(self.style)) - } -} diff --git a/src/entities/item.rs b/src/entities/item.rs deleted file mode 100644 index 5f08780d4f..0000000000 --- a/src/entities/item.rs +++ /dev/null @@ -1,50 +0,0 @@ -use crate::display; -use crate::entities::raws::{raw, EntityRaw, ItemType}; -use crate::entities::{Describe, EntityID}; -use crate::types::Position; -use std::io::{self, Write}; - -#[derive(Debug, Clone, PartialEq, Eq)] -pub struct Item { - pub id: Option, - pub typ: &'static ItemType<'static>, - pub position: Position, -} - -impl Item { - pub fn new_from_raw(name: &'static str, position: Position) -> Self { - match raw(name) { - EntityRaw::Item(typ) => Self::new_with_type(typ, position), - _ => panic!("Invalid raw type for {:?}, expected Item", name), - } - } - - pub fn new_with_type( - typ: &'static ItemType<'static>, - position: Position, - ) -> Self { - Item { - id: None, - typ, - position, - } - } - - pub fn is_edible(&self) -> bool { - self.typ.is_edible() - } -} - -entity!(Item); - -impl Describe for Item { - fn description(&self) -> String { - self.typ.description.to_string() - } -} - -impl display::Draw for Item { - fn do_draw(&self, out: &mut dyn Write) -> io::Result<()> { - write!(out, "{}", self.typ.chr) - } -} diff --git a/src/entities/mod.rs b/src/entities/mod.rs deleted file mode 100644 index a8c39ed8aa..0000000000 --- a/src/entities/mod.rs +++ /dev/null @@ -1,20 +0,0 @@ -#[macro_use] -pub mod entity; -#[macro_use] -pub mod util; -pub mod character; -pub mod creature; -pub mod entity_char; -pub mod environment; -pub mod item; -pub mod raw_types; -pub mod raws; - -pub use character::Character; -pub use creature::Creature; -pub use entity::{AnEntity, Describe, Entity, Identified}; -pub use entity_char::EntityChar; -pub use item::Item; -pub use raws::raw; - -pub type EntityID = u32; diff --git a/src/entities/raw_types.rs b/src/entities/raw_types.rs deleted file mode 100644 index 4bc291b695..0000000000 --- a/src/entities/raw_types.rs +++ /dev/null @@ -1,110 +0,0 @@ -use crate::entities::entity_char::EntityChar; -use crate::messages::Message; -use crate::types::Speed; - -#[derive(Debug, Deserialize)] -pub struct CreatureType<'a> { - /// The name of the creature. Used in raw lookups. - pub name: &'a str, - - /// A description of the entity, used by the "look" command - pub description: &'a str, - - #[serde(rename = "char")] - pub chr: EntityChar, - pub max_hitpoints: u16, - pub speed: Speed, - pub friendly: bool, -} - -#[derive(Debug, Deserialize, PartialEq, Eq)] -pub struct EdibleItem<'a> { - #[serde(borrow)] - pub eat_message: Option>, - - /// The number of hitpoints that eating this item heals - pub hitpoints_healed: u16, -} - -#[derive(Debug, Deserialize, PartialEq, Eq)] -pub struct ItemType<'a> { - pub name: &'a str, - - /// A description of the item, used by the "look" command and when walking - /// over the item on the ground - pub description: &'a str, - - /// A longer description of the item - pub long_description: &'a str, - - pub edible_item: Option>, - - #[serde(rename = "char")] - pub chr: EntityChar, -} - -#[cfg(test)] -mod item_type_tests { - use super::*; - - #[test] - fn test_deserialize_item_type() { - let result = serde_json::from_str( - r#"{ - "Item": { - "name": "noodles", - "description": "a big bowl o' noodles", - "long_description": "You know exactly what kind of noodles", - "char": { "char": "n" }, - "edible_item": { - "eat_message": "You slurp up the noodles", - "hitpoints_healed": 2 - } - } - }"#, - ) - .unwrap(); - assert_matches!(result, EntityRaw::Item(_)); - if let EntityRaw::Item(item) = result { - assert_eq!(item.name, "noodles"); - } - - let toml_result = toml::from_str( - r#"[Item] -name = "noodles" -description = "a big bowl o' noodles" -long_description = "You know exactly what kind of noodles" -char = { char = "🍜" } -edible_item = { eat_message = "You slurp up the noodles", hitpoints_healed = 2 } -"#, - ) - .unwrap(); - - assert_matches!(toml_result, EntityRaw::Item(_)); - if let EntityRaw::Item(item) = toml_result { - assert_eq!(item.name, "noodles"); - } - } -} - -impl<'a> ItemType<'a> { - pub fn is_edible(&self) -> bool { - self.edible_item.is_some() - } -} - -#[derive(Debug, Deserialize)] -pub enum EntityRaw<'a> { - Creature(#[serde(borrow)] CreatureType<'a>), - Item(#[serde(borrow)] ItemType<'a>), -} - -impl<'a> EntityRaw<'a> { - pub fn name(&self) -> &'a str { - use EntityRaw::*; - match self { - Creature(typ) => typ.name, - Item(typ) => typ.name, - } - } -} diff --git a/src/entities/raws.rs b/src/entities/raws.rs deleted file mode 100644 index 061e29a840..0000000000 --- a/src/entities/raws.rs +++ /dev/null @@ -1,38 +0,0 @@ -pub use crate::entities::raw_types::{CreatureType, EntityRaw, ItemType}; -use std::collections::HashMap; - -static_cfg! { - static ref RAWS: Vec> = cfg_dir("src/entities/raws"); -} - -lazy_static! { - static ref RAWS_BY_NAME: HashMap<&'static str, &'static EntityRaw<'static>> = { - let mut hm = HashMap::new(); - for er in RAWS.iter() { - if hm.contains_key(er.name()) { - panic!("Duplicate entity: {}", er.name()) - } - - hm.insert(er.name(), er); - } - hm - }; -} - -pub fn raw(name: &'static str) -> &'static EntityRaw<'static> { - RAWS_BY_NAME - .get(name) - .copied() - .unwrap_or_else(|| panic!("Raw not found: {}", name)) -} - -#[cfg(test)] -mod tests { - use super::*; - - #[test] - fn test_raws() { - RAWS_BY_NAME.keys(); - assert_eq!(raw("noodles").name(), "noodles"); - } -} diff --git a/src/entities/raws/gormlak.toml b/src/entities/raws/gormlak.toml deleted file mode 100644 index be30362d25..0000000000 --- a/src/entities/raws/gormlak.toml +++ /dev/null @@ -1,10 +0,0 @@ -[Creature] -name = "gormlak" -description = """ -A chittering imp-like creature with bright yellow horns. It adores shiny objects -and gathers in swarms. -""" -char = { char = "g", color = "red" } -max_hitpoints = 5 -speed = 120 -friendly = false diff --git a/src/entities/raws/noodles.json b/src/entities/raws/noodles.json deleted file mode 100644 index dfa2609f5e..0000000000 --- a/src/entities/raws/noodles.json +++ /dev/null @@ -1,15 +0,0 @@ -{ - "Item": { - "name": "noodles", - "char": { - "char": "n", - "color": "yellow" - }, - "description": "a big bowl o' noodles", - "long_description": "You know exactly what kind of noodles", - "edible_item": { - "eat_message": "You slurp up the noodles", - "hitpoints_healed": 2 - } - } -} diff --git a/src/entities/util.rs b/src/entities/util.rs deleted file mode 100644 index 6c11ffadf9..0000000000 --- a/src/entities/util.rs +++ /dev/null @@ -1,72 +0,0 @@ -#[macro_export] -macro_rules! new_entity { - ($name: ident) => { - new_entity!($name, {}) - }; - - ($name: ident { position: $position:expr $(, $fields:tt)* }) => { - $name { - id: None, - position: $position, - $($fields)* - } - }; - - ($name: ident { $position:expr $(, $fields:tt)* }) => { - $name { - id: None, - position: $position, - $($fields)* - } - }; -} - -#[macro_export] -macro_rules! boring_entity { - ($name:ident) => { - entity! { - pub struct $name {} - } - - impl $name { - #[allow(dead_code)] - pub fn new(position: $crate::types::Position) -> Self { - $name { id: None, position } - } - } - }; - - ($name:ident, char: $char: expr) => { - boring_entity!($name); - - impl $crate::display::Draw for $name { - fn do_draw(&self, out: &mut Write) -> io::Result<()> { - write!(out, "{}", $char) - } - } - }; -} - -#[macro_export] -macro_rules! entity { - ($name: ident) => { - positioned!($name); - positioned_mut!($name); - identified!($name, $crate::entities::EntityID); - impl $crate::entities::entity::Entity for $name {} - }; - - (pub struct $name:ident { $($struct_contents:tt)* } $($rest:tt)*) => { - #[derive(Debug, PartialEq, Eq, Clone)] - pub struct $name { - pub id: Option<$crate::entities::EntityID>, - pub position: $crate::types::Position, - $($struct_contents)* - } - - entity!($name); - entity!($($rest)*); - }; - - () => {}; -} diff --git a/src/game.rs b/src/game.rs deleted file mode 100644 index c478e0d2f5..0000000000 --- a/src/game.rs +++ /dev/null @@ -1,617 +0,0 @@ -use crate::description::list_to_sentence; -use crate::display::{self, Viewport}; -use crate::entities::entity::Describe; -use crate::entities::entity::Entity; -use crate::entities::{ - AnEntity, Character, Creature, EntityID, Identified, Item, -}; -use crate::messages::message; -use crate::settings::Settings; -use crate::types::command::Command; -use crate::types::entity_map::EntityMap; -use crate::types::{ - pos, BoundingBox, Collision, Dimensions, Position, Positioned, Ticks, -}; -use crate::util::promise::Cancelled; -use crate::util::promise::{promise, Complete, Promise, Promises}; -use crate::util::template::TemplateParams; -use rand::rngs::SmallRng; -use rand::SeedableRng; -use std::io::{self, StdinLock, StdoutLock, Write}; -use termion::input::Keys; -use termion::input::TermRead; -use termion::raw::RawTerminal; - -type Stdout<'a> = RawTerminal>; - -type Rng = SmallRng; - -enum PromptResolution { - Uncancellable(Complete), - Cancellable(Complete>), -} - -/// The mode to use when describing entities on a tile to the user -#[derive(Debug, Clone, Copy, PartialEq, Eq)] -enum EntityDescriptionMode { - /// Describe the entities that the user is walking over. - /// - /// This means: - /// - Skip the character themselves - /// - Describe nothing if there are no items other than the character - Walk, - - /// Describe entities that the user is actively asking about. - /// - /// This means: - /// - Describe the character themselves if they've asked to look at the tile - /// they're standing on - /// - Explicitly say there's nothing there if there's nothing there. - Look, -} - -impl PromptResolution { - fn is_cancellable(&self) -> bool { - use PromptResolution::*; - match self { - Uncancellable(_) => false, - Cancellable(_) => true, - } - } - - fn fulfill(&mut self, val: String) { - use PromptResolution::*; - match self { - Cancellable(complete) => complete.ok(val), - Uncancellable(complete) => complete.fulfill(val), - } - } - - fn cancel(&mut self) { - use PromptResolution::*; - match self { - Cancellable(complete) => complete.cancel(), - Uncancellable(_complete) => {} - } - } -} - -/// The kind of input the game is waiting to receive -enum InputState { - /// The initial input state of the game - we're currently waiting for direct - /// commands. - Initial, - - /// A free text prompt has been shown to the user, and every character - /// besides "escape" is interpreted as a response to that prompt - Prompt { - complete: PromptResolution, - buffer: String, - }, -} - -impl InputState { - fn uncancellable_prompt(complete: Complete) -> Self { - InputState::Prompt { - complete: PromptResolution::Uncancellable(complete), - buffer: String::new(), - } - } - - fn cancellable_prompt( - complete: Complete>, - ) -> Self { - InputState::Prompt { - complete: PromptResolution::Cancellable(complete), - buffer: String::new(), - } - } -} - -impl Default for InputState { - fn default() -> Self { - InputState::Initial - } -} - -/// The full state of a running Game -pub struct Game<'a> { - settings: Settings, - - viewport: Viewport>, - - /// An iterator on keypresses from the user - keys: Keys>, - - /// The kind of input the game is waiting to receive - input_state: InputState, - - /// The map of all the entities in the game - entities: EntityMap, - - /// The entity ID of the player character - character_entity_id: EntityID, - - /// The messages that have been said to the user, in forward time order - messages: Vec, - - /// The index of the currently-displayed message. Used to track the index of - /// the currently displayed message when handling PreviousMessage commands - message_idx: usize, - - /// A global random number generator for the game - rng: Rng, - - /// A list of promises that are waiting on the game and a result - promises: Promises<'a, Self>, -} - -impl<'a> Game<'a> { - pub fn new( - settings: Settings, - stdout: RawTerminal>, - stdin: StdinLock<'a>, - w: u16, - h: u16, - ) -> Game<'a> { - let rng = match settings.seed { - Some(seed) => SmallRng::seed_from_u64(seed), - None => SmallRng::from_entropy(), - }; - let mut entities: EntityMap = EntityMap::new(); - - // TODO make this dynamic - { - entities.insert(Box::new(Creature::new_from_raw( - "gormlak", - pos(10, 0), - ))); - - entities - .insert(Box::new(Item::new_from_raw("noodles", pos(0, 10)))); - } - - Game { - settings, - rng, - message_idx: 0, - viewport: Viewport::new( - BoundingBox::at_origin(Dimensions { w, h }), - BoundingBox::at_origin(Dimensions { w: w - 2, h: h - 2 }), - stdout, - ), - keys: stdin.keys(), - input_state: Default::default(), - character_entity_id: entities.insert(Box::new(Character::new())), - messages: Vec::new(), - entities, - promises: Promises::new(), - } - } - - fn downcast_entities_at(&self, pos: Position) -> Vec<&A> { - self.entities - .at(pos) - .iter() - .filter_map(|e| e.downcast_ref()) - .collect() - } - - /// Returns a list of all creature entities at the given position - fn creatures_at(&self, pos: Position) -> Vec<&Creature> { - self.downcast_entities_at(pos) - } - - /// Returns a list of all item entities at the given position - fn items_at(&self, pos: Position) -> Vec<&Item> { - self.downcast_entities_at(pos) - } - - /// Returns a collision, if any, at the given Position in the game - fn collision_at(&self, pos: Position) -> Option { - if !pos.within(self.viewport.inner) { - Some(Collision::Stop) - } else if self.creatures_at(pos).is_empty() { - None - } else { - Some(Collision::Combat) - } - } - - fn character(&self) -> &Character { - (*self.entities.get(self.character_entity_id).unwrap()) - .downcast_ref() - .unwrap() - } - - fn mut_character(&mut self) -> &mut Character { - (*self.entities.get_mut(self.character_entity_id).unwrap()) - .downcast_mut() - .unwrap() - } - - /// Draw all the game entities to the screen - fn draw_entities(&mut self) -> io::Result<()> { - for entity in self.entities.entities() { - self.viewport.draw( - entity, - &self.entities.neighbor_entities(entity.position()), - )?; - } - Ok(()) - } - - /// Draw all the game entities to the screen - fn draw_entities_at(&mut self, pos: Position) -> io::Result<()> { - for entity in self.entities.at(pos) { - self.viewport.draw( - entity, - &self.entities.neighbor_entities(entity.position()), - )?; - } - Ok(()) - } - - /// Draw the game entity with the given ID, if any, to the screen - fn draw_entity(&mut self, entity_id: EntityID) -> io::Result { - if let Some(entity) = self.entities.get(entity_id) { - self.viewport.draw( - entity, - &self.entities.neighbor_entities(entity.position()), - )?; - Ok(true) - } else { - Ok(false) - } - } - - /// Describe all the entities at a given position to the user. - /// - /// If `force` is not set to `true`, will not do anything if there are no - /// entities - fn describe_entities_at( - &mut self, - pos: Position, - mode: EntityDescriptionMode, - ) -> io::Result<()> { - use EntityDescriptionMode::*; - let mut entities = self.entities.at(pos); - if mode == Walk { - entities.retain(|e| e.id() != self.character_entity_id); - } - - if entities.is_empty() { - match mode { - Walk => return Ok(()), - Look => { - return self.say( - "global.describe_no_entities", - &template_params!(), - ) - } - } - } - - let descriptions = list_to_sentence( - &entities - .iter() - .map(|e| e.description()) - .collect::>(), - ); - - self.say( - "global.describe_entities", - &template_params!({ "descriptions" => &descriptions, }), - ) - } - - /// Remove the given entity from the game, drawing over it if it's visible - fn remove_entity(&mut self, entity_id: EntityID) -> io::Result<()> { - if let Some(entity) = self.entities.remove(entity_id) { - self.viewport.clear(entity.position())?; - } - Ok(()) - } - - /// Step the game forward the given number of ticks - fn tick(&mut self, _ticks: Ticks) {} - - /// Get a message from the global map based on the rng in this game - fn message<'params>( - &mut self, - name: &'static str, - params: &TemplateParams<'params>, - ) -> String { - message(name, &mut self.rng, params) - } - - /// Say a message to the user - fn say<'params>( - &mut self, - message_name: &'static str, - params: &TemplateParams<'params>, - ) -> io::Result<()> { - let message = self.message(message_name, params); - self.messages.push(message.to_string()); - self.message_idx = self.messages.len() - 1; - self.viewport.write_message(&message)?; - Ok(()) - } - - /// Prompt the user for input, returning a Future for the result of the - /// prompt - fn prompt( - &mut self, - name: &'static str, - params: &TemplateParams<'_>, - ) -> io::Result> { - let (complete, promise) = promise(); - self.input_state = InputState::uncancellable_prompt(complete); - let message = self.message(name, params); - self.viewport.write_prompt(&message)?; - self.promises.push(Box::new(promise.clone())); - Ok(promise) - } - - fn prompt_cancellable( - &mut self, - name: &'static str, - params: &TemplateParams<'_>, - ) -> io::Result>> { - let (complete, promise) = promise(); - self.input_state = InputState::cancellable_prompt(complete); - let message = self.message(name, params); - self.viewport.write_prompt(&message)?; - self.promises.push(Box::new(promise.clone())); - Ok(promise) - } - - fn previous_message(&mut self) -> io::Result<()> { - if self.message_idx == 0 { - return Ok(()); - } - self.message_idx -= 1; - let message = &self.messages[self.message_idx]; - self.viewport.write_message(message)?; - Ok(()) - } - - fn clear_message(&mut self) -> io::Result<()> { - debug!("{:?} {:?}", self.message_idx, self.messages); - if self.message_idx == self.messages.len() { - return Ok(()); - } - self.viewport.clear_message()?; - self.message_idx += 1; - Ok(()) - } - - fn creature(&self, creature_id: EntityID) -> Option<&Creature> { - self.entities - .get(creature_id) - .and_then(|e| e.downcast_ref::()) - } - - fn expect_creature(&self, creature_id: EntityID) -> &Creature { - self.creature(creature_id).unwrap_or_else(|| { - panic!("Creature ID went away: {:?}", creature_id) - }) - } - - fn mut_creature(&mut self, creature_id: EntityID) -> Option<&mut Creature> { - self.entities - .get_mut(creature_id) - .and_then(|e| e.downcast_mut::()) - } - - fn expect_mut_creature(&mut self, creature_id: EntityID) -> &mut Creature { - self.mut_creature(creature_id).unwrap_or_else(|| { - panic!("Creature ID went away: {:?}", creature_id) - }) - } - - fn attack(&mut self, creature_id: EntityID) -> io::Result<()> { - info!("Attacking creature {:?}", creature_id); - let damage = self.character().damage(); - let creature_name = self.expect_creature(creature_id).typ.name; - let tps = template_params!({ - "creature" => { - "name" => creature_name, - }, - }); - self.say("combat.attack", &tps)?; - - let creature = self.expect_mut_creature(creature_id); - creature.damage(damage); - if creature.dead() { - self.say("combat.killed", &tps)?; - info!("Killed creature {:?}", creature_id); - self.remove_entity(creature_id)?; - } - Ok(()) - } - - fn attack_at(&mut self, pos: Position) -> io::Result<()> { - let creatures = self.creatures_at(pos); - match creatures.len() { - 0 => Ok(()), - 1 => { - let creature = creatures.get(0).unwrap(); - let creature_id = creature.id(); - self.attack(creature_id) - } - _ => { - // TODO prompt with a menu of creatures to combat - unimplemented!() - } - } - } - - fn pick_up(&mut self) -> io::Result<()> { - let pos = self.character().position; - let items = self.items_at(pos); - match items.len() { - 0 => Ok(()), - 1 => { - let item_id = items.get(0).unwrap().id(); - let item: Box = - self.entities.remove(item_id).unwrap().downcast().unwrap(); - let desc = item.description(); - self.mut_character().inventory.push(item); - self.say( - "global.pick_up", - &template_params!({ - "item" => { "name" => &desc, }, - }), - ) - } - _ => { - // TODO prompt with a menu of items to pick up - unimplemented!() - } - } - } - - fn flush_promises(&mut self) { - unsafe { - let game = self as *mut Self; - (*game).promises.give_all(&mut *game); - } - } - - /// Run the game - pub fn run(mut self) -> io::Result<()> { - info!("Running game"); - self.viewport.init()?; - self.draw_entities()?; - self.flush().unwrap(); - - self.prompt("character.name_prompt", &template_params!())? - .on_fulfill(|game, char_name| { - game.say( - "global.welcome", - &template_params!({ - "character" => { - "name" => char_name, - }, - }), - ) - .unwrap(); - game.flush().unwrap(); - game.mut_character().set_name(char_name.to_string()); - }); - - loop { - let mut old_position = None; - let next_key = self.keys.next().unwrap().unwrap(); - match &mut self.input_state { - InputState::Initial => { - use Command::*; - match Command::from_key(next_key) { - Some(Quit) => { - info!("Quitting game due to user request"); - break; - } - - Some(Move(direction)) => { - use Collision::*; - let new_pos = self.character().position + direction; - match self.collision_at(new_pos) { - None => { - old_position = - Some(self.character().position); - self.entities.update_position( - self.character_entity_id, - new_pos, - ); - } - Some(Combat) => { - self.attack_at(new_pos)?; - } - Some(Stop) => (), - } - } - - Some(PreviousMessage) => self.previous_message()?, - - Some(PickUp) => self.pick_up()?, - - None => (), - } - - if let Some(old_pos) = old_position { - let character = self.character(); - let char_pos = character.position; - self.viewport.game_cursor_position = char_pos; - self.viewport.clear(old_pos)?; - self.draw_entities_at(old_pos)?; - self.draw_entity(self.character_entity_id)?; - self.clear_message()?; - self.describe_entities_at( - char_pos, - EntityDescriptionMode::Walk, - )?; - self.tick( - self.character().speed().tiles_to_ticks( - (old_pos - char_pos).as_tiles(), - ), - ); - } - } - - InputState::Prompt { complete, buffer } => { - use termion::event::Key::*; - match next_key { - Char('\n') => { - info!("Prompt complete: \"{}\"", buffer); - self.viewport.clear_prompt()?; - complete.fulfill(buffer.clone()); - self.input_state = InputState::Initial; - } - Char(chr) => { - buffer.push(chr); - self.viewport.push_prompt_chr(chr)?; - } - Esc => complete.cancel(), - Backspace => { - buffer.pop(); - self.viewport.pop_prompt_chr()?; - } - _ => {} - } - } - } - - self.flush()?; - self.flush_promises(); - debug!("{:?}", self.character()); - } - Ok(()) - } -} - -impl<'a> Drop for Game<'a> { - fn drop(&mut self) { - display::clear(self).unwrap_or(()); - } -} - -impl<'a> Write for Game<'a> { - fn write(&mut self, buf: &[u8]) -> io::Result { - self.viewport.write(buf) - } - - fn flush(&mut self) -> io::Result<()> { - self.viewport.flush() - } - - fn write_all(&mut self, buf: &[u8]) -> io::Result<()> { - self.viewport.write_all(buf) - } -} - -impl<'a> Positioned for Game<'a> { - fn position(&self) -> Position { - Position { x: 0, y: 0 } - } -} diff --git a/src/level_gen/cave_automata.rs b/src/level_gen/cave_automata.rs deleted file mode 100644 index e5e2807ab2..0000000000 --- a/src/level_gen/cave_automata.rs +++ /dev/null @@ -1,120 +0,0 @@ -use crate::level_gen::util::fill_outer_edges; -use crate::level_gen::util::rand_initialize; -use crate::types::Dimensions; -use rand::Rng; - -pub struct Params { - chance_to_start_alive: f64, - birth_limit: i32, - death_limit: i32, - steps: usize, -} - -macro_rules! parse_optional { - ($out: ident . $attr: ident, $matches: expr, $arg: expr) => { - if let Some(val_s) = $matches.value_of($arg) { - $out.$attr = val_s.parse().unwrap(); - } - }; -} - -macro_rules! parse_optional_matches { - ($matches: expr) => {}; - ($matches: expr , { $ret: ident . $attr: ident = $arg: expr }) => { - parse_optional!($ret.$attr, $matches, $arg); - }; - ($matches: expr, { $($ret: ident . $attr: ident = $arg: expr ,)* }) => { - $(parse_optional!($ret.$attr, $matches, $arg);)* - }; -} - -impl Params { - pub fn from_matches<'a>(matches: &clap::ArgMatches<'a>) -> Self { - let mut ret: Self = Default::default(); - parse_optional_matches!(matches, { - ret.chance_to_start_alive = "start-alive-chance", - ret.birth_limit = "birth-limit", - ret.death_limit = "death-limit", - ret.steps = "steps", - }); - ret - } -} - -impl Default for Params { - fn default() -> Self { - Params { - chance_to_start_alive: 0.45, - birth_limit: 4, - death_limit: 3, - steps: 2, - } - } -} - -pub fn generate( - dimensions: Dimensions, - params: &Params, - rand: &mut R, -) -> Vec> { - let mut cells = - rand_initialize(dimensions, rand, params.chance_to_start_alive); - for _ in 0..params.steps { - step_automata(&mut cells, dimensions, params); - } - - fill_outer_edges(&mut cells); - - cells -} - -fn step_automata( - cells: &mut Vec>, - dimensions: Dimensions, - params: &Params, -) { - let orig_cells = (*cells).clone(); - for x in 0..(dimensions.h as usize) { - for y in 0..(dimensions.w as usize) { - let nbs = num_alive_neighbors(&orig_cells, x as i32, y as i32); - if orig_cells[x][y] { - if nbs < params.death_limit { - cells[x][y] = false; - } else { - cells[x][y] = true; - } - } else if nbs > params.birth_limit { - cells[x][y] = true; - } else { - cells[x][y] = false; - } - } - } -} - -const COUNT_EDGES_AS_NEIGHBORS: bool = true; - -fn num_alive_neighbors(cells: &[Vec], x: i32, y: i32) -> i32 { - let mut count = 0; - for i in -1..2 { - for j in -1..2 { - if i == 0 && j == 0 { - continue; - } - - let neighbor_x = x + i; - let neighbor_y = y + j; - - if (COUNT_EDGES_AS_NEIGHBORS - && (neighbor_x < 0 - || neighbor_y < 0 - || neighbor_x >= (cells.len() as i32) - || neighbor_y >= (cells[0].len()) as i32)) - || cells[neighbor_x as usize][neighbor_y as usize] - { - count += 1; - } - } - } - count -} diff --git a/src/level_gen/mod.rs b/src/level_gen/mod.rs deleted file mode 100644 index d796a103b1..0000000000 --- a/src/level_gen/mod.rs +++ /dev/null @@ -1,101 +0,0 @@ -use crate::display::draw_box::BoxStyle; -use crate::display::utils::clone_times; -use crate::display::DrawWithNeighbors; -use crate::entities::entity::Entity; -use crate::entities::environment::Wall; -use crate::types::entity_map::EntityMap; -use crate::types::pos; -use itertools::Itertools; -use std::io; - -pub mod cave_automata; -pub mod util; - -pub fn level_to_entities(level: Vec>) -> EntityMap> { - let mut res: EntityMap> = EntityMap::new(); - - let xmax = level.len() as i16; - let ymax = if xmax == 0 { - 0i16 - } else { - level[0].len() as i16 - }; - - let get = |mut x: i16, mut y: i16| { - if x < 0 { - x = 0; - } - if y < 0 { - y = 0; - } - if x >= xmax - 1 { - x = xmax - 1; - } - if y >= ymax - 1 { - y = ymax - 1; - } - level[x as usize][y as usize] - }; - - for x in 0..xmax { - for y in 0..ymax { - if get(x, y) { - // don't output walls that are surrounded on all 8 sides by - // walls - if (x == 0 || get(x - 1, y)) - && (y == 0 || get(x, y - 1)) - && (x == xmax - 1 || get(x + 1, y)) - && (y == ymax - 1 || get(x, y + 1)) - && ((x == 0 && y == 0) || get(x - 1, y - 1)) - && ((x == 0 && y == ymax - 1) || get(x - 1, y + 1)) - && ((x == xmax - 1 && y == 0) || get(x + 1, y - 1)) - && ((x == xmax - 1 && y == ymax - 1) || get(x + 1, y + 1)) - { - continue; - } - res.insert(Box::new(Wall::new( - pos(y as i16, x as i16), - BoxStyle::Thin, - ))); - } - } - } - - res -} - -pub fn draw_level( - level: Vec>, - out: &mut W, -) -> io::Result<()> { - if level.is_empty() { - return Ok(()); - } - - let mut lines = clone_times::, Vec>>( - clone_times(' ', level[0].len() as u16), - level.len() as u16, - ); - - let em = level_to_entities(level); - - for entity in em.entities() { - let mut buf = Vec::new(); - entity.do_draw_with_neighbors( - &mut buf, - &em.neighbor_entities(entity.position()), - )?; - let buf_s = std::str::from_utf8(&buf).unwrap(); - if let Some(chr) = buf_s.chars().next() { - lines[entity.position().y as usize][entity.position().x as usize] = - chr; - } - } - - let res = lines - .iter() - .map(|line| line.iter().collect::()) - .join("\n"); - - write!(out, "{}", res) -} diff --git a/src/level_gen/util.rs b/src/level_gen/util.rs deleted file mode 100644 index 4f56fe6c95..0000000000 --- a/src/level_gen/util.rs +++ /dev/null @@ -1,52 +0,0 @@ -use crate::types::Dimensions; -use rand::{distributions, Rng}; - -pub fn falses(dims: Dimensions) -> Vec> { - let mut ret = Vec::with_capacity(dims.h as usize); - for _ in 0..dims.h { - let mut row = Vec::with_capacity(dims.w as usize); - for _ in 0..dims.w { - row.push(false); - } - ret.push(row); - } - ret -} - -/// Randomly initialize a 2-dimensional boolean vector of the given -/// `Dimensions`, using the given random number generator and alive chance -pub fn rand_initialize( - dims: Dimensions, - rng: &mut R, - alive_chance: f64, -) -> Vec> { - let distrib = distributions::Bernoulli::new(alive_chance).unwrap(); - let mut ret = Vec::with_capacity(dims.h as usize); - for _ in 0..dims.h { - let mut row = Vec::with_capacity(dims.w as usize); - for _ in 0..dims.w { - row.push(rng.sample(distrib)); - } - ret.push(row); - } - ret -} - -/// Fill the outer edges of a generated level with walls -pub fn fill_outer_edges(level: &mut Vec>) { - let xmax = level.len(); - if xmax == 0 { - return; - } - let ymax = level[0].len(); - - for row in level.iter_mut() { - row[0] = true; - row[ymax - 1] = true; - } - - for y in 0..level[0].len() { - level[0][y] = true; - level[xmax - 1][y] = true; - } -} diff --git a/src/main.rs b/src/main.rs deleted file mode 100644 index 8004a5739e..0000000000 --- a/src/main.rs +++ /dev/null @@ -1,130 +0,0 @@ -#[macro_use] -extern crate log; -#[macro_use] -extern crate serde_derive; -#[macro_use] -extern crate clap; -#[macro_use] -extern crate prettytable; -#[macro_use] -extern crate lazy_static; -#[cfg(test)] -#[macro_use] -extern crate maplit; -#[macro_use] -extern crate downcast_rs; -#[macro_use] -extern crate include_dir; -#[macro_use] -extern crate nom; -#[cfg(test)] -#[macro_use] -extern crate matches; - -#[macro_use] -mod util; -#[macro_use] -mod types; -#[macro_use] -mod entities; -mod description; -mod display; -mod game; -mod level_gen; -mod messages; -mod settings; - -use crate::types::Dimensions; -use clap::App; -use game::Game; -use prettytable::format::consts::FORMAT_BOX_CHARS; -use rand::rngs::SmallRng; -use rand::SeedableRng; -use settings::Settings; - -use backtrace::Backtrace; -use std::io::{self, StdinLock, StdoutLock}; -use std::panic; - -use termion; -use termion::raw::IntoRawMode; -use termion::raw::RawTerminal; - -fn init( - settings: Settings, - stdout: RawTerminal>, - stdin: StdinLock<'_>, - w: u16, - h: u16, -) -> io::Result<()> { - panic::set_hook(if settings.logging.print_backtrace { - Box::new(|info| (error!("{}\n{:#?}", info, Backtrace::new()))) - } else { - Box::new(|info| (error!("{}\n{:#?}", info, Backtrace::new()))) - }); - - let game = Game::new(settings, stdout, stdin, w, h); - game.run() -} - -fn generate_level<'a, W: io::Write>( - stdout: &mut W, - params: &clap::ArgMatches<'a>, -) -> io::Result<()> { - let mut rand = SmallRng::from_entropy(); - - let mut dimensions: Dimensions = Default::default(); - if let Some(h_s) = params.value_of("height") { - dimensions.h = h_s.parse().unwrap(); - } - if let Some(w_s) = params.value_of("width") { - dimensions.w = w_s.parse().unwrap(); - } - - let level = match params.value_of("generator") { - None => panic!("Must supply a generator with --generator"), - Some("cave_automata") => level_gen::cave_automata::generate( - dimensions, - &level_gen::cave_automata::Params::from_matches(params), - &mut rand, - ), - Some(gen) => panic!("Unrecognized generator: {}", gen), - }; - level_gen::draw_level(level, stdout) -} - -fn main() -> io::Result<()> { - let yaml = load_yaml!("cli.yml"); - let matches = App::from_yaml(yaml).get_matches(); - let settings = Settings::load().unwrap(); - settings.logging.init_log(); - let stdout = io::stdout(); - let mut stdout = stdout.lock(); - - let stdin = io::stdin(); - let stdin = stdin.lock(); - - let termsize = termion::terminal_size().ok(); - let (termwidth, termheight) = termsize.unwrap_or((70, 40)); - - match matches.subcommand() { - ("info", _) => { - let mut table = table!( - [br->"termwidth", termwidth], - [br->"termheight", termheight], - [br->"logfile", settings.logging.file], - [br->"loglevel", settings.logging.level] - ); - table.set_format(*FORMAT_BOX_CHARS); - table.printstd(); - Ok(()) - } - ("generate-level", params) => { - generate_level(&mut stdout, params.unwrap()) - } - _ => { - let stdout = stdout.into_raw_mode().unwrap(); - init(settings, stdout, stdin, termwidth, termheight) - } - } -} diff --git a/src/messages.rs b/src/messages.rs deleted file mode 100644 index b081389efc..0000000000 --- a/src/messages.rs +++ /dev/null @@ -1,166 +0,0 @@ -use crate::util::template::Template; -use crate::util::template::TemplateParams; -use rand::seq::SliceRandom; -use rand::Rng; -use std::collections::HashMap; - -#[derive(Deserialize, Debug, PartialEq, Eq)] -#[serde(untagged)] -pub enum Message<'a> { - #[serde(borrow)] - Single(Template<'a>), - Choice(Vec>), -} - -impl<'a> Message<'a> { - fn resolve(&self, rng: &mut R) -> Option<&Template<'a>> { - use Message::*; - match self { - Single(msg) => Some(msg), - Choice(msgs) => msgs.choose(rng), - } - } -} - -#[derive(Deserialize, Debug, PartialEq, Eq)] -#[serde(untagged)] -enum NestedMap<'a> { - #[serde(borrow)] - Direct(Message<'a>), - #[serde(borrow)] - Nested(HashMap<&'a str, NestedMap<'a>>), -} - -impl<'a> NestedMap<'a> { - fn lookup(&'a self, path: &str) -> Option<&'a Message<'a>> { - use NestedMap::*; - let leaf = - path.split('.') - .fold(Some(self), |current, key| match current { - Some(Nested(m)) => m.get(key), - _ => None, - }); - match leaf { - Some(Direct(msg)) => Some(msg), - _ => None, - } - } -} - -#[cfg(test)] -mod nested_map_tests { - use super::*; - - #[test] - fn test_deserialize_nested_map() { - let src = r#" -[global] -hello = "Hello World!" - -[foo.bar] -single = "Single" -choice = ["Say this", "Or this"] -"#; - let result = toml::from_str(src); - assert_eq!( - result, - Ok(NestedMap::Nested(hashmap! { - "global" => NestedMap::Nested(hashmap!{ - "hello" => NestedMap::Direct(Message::Single(Template::parse("Hello World!").unwrap())), - }), - "foo" => NestedMap::Nested(hashmap!{ - "bar" => NestedMap::Nested(hashmap!{ - "single" => NestedMap::Direct(Message::Single( - Template::parse("Single").unwrap() - )), - "choice" => NestedMap::Direct(Message::Choice( - vec![ - Template::parse("Say this").unwrap(), - Template::parse("Or this").unwrap() - ] - )) - }) - }) - })) - ) - } - - #[test] - fn test_lookup() { - let map: NestedMap<'static> = toml::from_str( - r#" -[global] -hello = "Hello World!" - -[foo.bar] -single = "Single" -choice = ["Say this", "Or this"] -"#, - ) - .unwrap(); - - assert_eq!( - map.lookup("global.hello"), - Some(&Message::Single(Template::parse("Hello World!").unwrap())) - ); - assert_eq!( - map.lookup("foo.bar.single"), - Some(&Message::Single(Template::parse("Single").unwrap())) - ); - assert_eq!( - map.lookup("foo.bar.choice"), - Some(&Message::Choice(vec![ - Template::parse("Say this").unwrap(), - Template::parse("Or this").unwrap() - ])) - ); - } -} - -// static MESSAGES_RAW: &'static str = include_str!("messages.toml"); - -static_cfg! { - static ref MESSAGES: NestedMap<'static> = toml_file("messages.toml"); -} - -pub fn get( - name: &'static str, - rng: &mut R, -) -> Option<&'static Template<'static>> { - MESSAGES.lookup(name).and_then(|msg| msg.resolve(rng)) -} - -/// Look up and format a game message based on the given (dot-separated) name, -/// with the given random generator used to select from choice-based messages -pub fn message<'a, R: Rng + ?Sized>( - name: &'static str, - rng: &mut R, - params: &TemplateParams<'a>, -) -> String { - match get(name, rng) { - Some(msg) => msg.format(params).unwrap_or_else(|e| { - error!("Error formatting template: {}", e); - "Template Error".to_string() - }), - None => { - error!("Message not found: {}", name); - "Template Not Found".to_string() - } - } -} - -#[cfg(test)] -mod tests { - use super::*; - use rand::rngs::SmallRng; - use rand::SeedableRng; - - #[test] - fn test_static_messages() { - message( - "global.welcome", - &mut SmallRng::from_entropy(), - &template_params!(), - ); - } -} diff --git a/src/messages.toml b/src/messages.toml deleted file mode 100644 index a9a6b2e009..0000000000 --- a/src/messages.toml +++ /dev/null @@ -1,27 +0,0 @@ -[global] -welcome = "Welcome to Xanthous, {{character.name}}! It's dangerous out there, why not stay inside?" -describe_entities = "You see here {{descriptions}}" -describe_no_entities = "You see nothing here." -pick_up = "You pick up the {{item.name}}." - -[combat] -attack = "You attack the {{creature.name}}." -killed = [ - "You've killed the {{creature.name}}.", - "The {{creature.name}} dies.", - "The {{creature.name}} kicks it.", - "The {{creature.name}} beefs it." - ] - -[character] -name_prompt = [ - "Hey there friend. What's your name?", - "Hey there friend. What should we call you?", - "Howdy. What's your name?", - "Name please!", - "What's your name?", - "Hey, what's your name?", -] - -[defaults.item] -eat = "You eat the {{item.name}}. {{action.result}}" diff --git a/src/settings.rs b/src/settings.rs deleted file mode 100644 index 1f205814d1..0000000000 --- a/src/settings.rs +++ /dev/null @@ -1,70 +0,0 @@ -use config::{Config, ConfigError}; -use log::LevelFilter; -use log4rs::append::file::FileAppender; -use log4rs::config::{Appender, Root}; -use log4rs::encode::pattern::PatternEncoder; - -#[derive(Debug, Deserialize, Clone)] -pub struct Logging { - #[serde(default = "Logging::default_level")] - pub level: LevelFilter, - - #[serde(default = "Logging::default_file")] - pub file: String, - - #[serde(default = "Logging::default_print_backtrace")] - pub print_backtrace: bool, -} - -impl Default for Logging { - fn default() -> Self { - Logging { - level: LevelFilter::Off, - file: "debug.log".to_string(), - print_backtrace: true, - } - } -} - -impl Logging { - pub fn init_log(&self) { - let logfile = FileAppender::builder() - .encoder(Box::new(PatternEncoder::new("{d} {l} - {m}\n"))) - .build(self.file.clone()) - .unwrap(); - - let config = log4rs::config::Config::builder() - .appender(Appender::builder().build("logfile", Box::new(logfile))) - .build(Root::builder().appender("logfile").build(self.level)) - .unwrap(); - - log4rs::init_config(config).unwrap(); - } - - fn default_level() -> LevelFilter { - Logging::default().level - } - - fn default_file() -> String { - Logging::default().file - } - - fn default_print_backtrace() -> bool { - Logging::default().print_backtrace - } -} - -#[derive(Debug, Deserialize, Clone)] -pub struct Settings { - pub seed: Option, - pub logging: Logging, -} - -impl Settings { - pub fn load() -> Result { - let mut s = Config::new(); - s.merge(config::File::with_name("Config").required(false))?; - s.merge(config::Environment::with_prefix("XAN"))?; - s.try_into() - } -} diff --git a/src/types/collision.rs b/src/types/collision.rs deleted file mode 100644 index 59c60e69ee..0000000000 --- a/src/types/collision.rs +++ /dev/null @@ -1,9 +0,0 @@ -/// Describes a kind of game collision -#[derive(Debug, Clone, Copy, PartialEq, Eq)] -pub enum Collision { - /// Stop moving - you can't move there! - Stop, - - /// Moving into an entity at the given position indicates combat - Combat, -} diff --git a/src/types/command.rs b/src/types/command.rs deleted file mode 100644 index 17ca4d280f..0000000000 --- a/src/types/command.rs +++ /dev/null @@ -1,41 +0,0 @@ -use super::Direction; -use super::Direction::*; -use termion::event::Key; -use termion::event::Key::{Char, Ctrl}; - -pub enum Command { - /// Quit the game - Quit, - - /// Move the character in a direction - Move(Direction), - - /// Pick up any item(s) at the current position - PickUp, - - /// Display the previous message - PreviousMessage, -} - -impl Command { - pub fn from_key(k: Key) -> Option { - use Command::*; - match k { - Char('q') => Some(Quit), - - Char('h') | Char('a') | Key::Left => Some(Move(Left)), - Char('k') | Char('w') | Key::Up => Some(Move(Up)), - Char('j') | Char('s') | Key::Down => Some(Move(Down)), - Char('l') | Char('d') | Key::Right => Some(Move(Right)), - Char('y') => Some(Move(UpLeft)), - Char('u') => Some(Move(UpRight)), - Char('b') => Some(Move(DownLeft)), - Char('n') => Some(Move(DownRight)), - - Ctrl('p') => Some(PreviousMessage), - Char(',') => Some(PickUp), - - _ => None, - } - } -} diff --git a/src/types/direction.rs b/src/types/direction.rs deleted file mode 100644 index 9b5c0991da..0000000000 --- a/src/types/direction.rs +++ /dev/null @@ -1,13 +0,0 @@ -use proptest_derive::Arbitrary; - -#[derive(Clone, Copy, Debug, PartialEq, Eq, Arbitrary)] -pub enum Direction { - Left, - Up, - Down, - Right, - UpLeft, - UpRight, - DownRight, - DownLeft, -} diff --git a/src/types/entity_map.rs b/src/types/entity_map.rs deleted file mode 100644 index 202d8b593e..0000000000 --- a/src/types/entity_map.rs +++ /dev/null @@ -1,430 +0,0 @@ -use crate::entities::entity::Identified; -use crate::entities::EntityID; -use crate::types::Neighbors; -use crate::types::Position; -use crate::types::Positioned; -use crate::types::PositionedMut; -use alga::general::{ - AbstractMagma, AbstractMonoid, AbstractSemigroup, Additive, Identity, -}; -use std::collections::{hash_map, BTreeMap, HashMap}; -use std::iter::FromIterator; - -#[derive(Debug, Clone, Default)] -pub struct EntityMap { - by_position: BTreeMap>, - by_id: HashMap, - last_id: EntityID, -} - -impl PartialEq for EntityMap { - fn eq(&self, other: &Self) -> bool { - self.by_position == other.by_position && self.by_id == other.by_id - } -} -impl Eq for EntityMap {} - -const BY_POS_INVARIANT: &str = - "Invariant: All references in EntityMap.by_position should point to existent references in by_id"; - -impl EntityMap { - pub fn new() -> EntityMap { - EntityMap { - by_position: BTreeMap::new(), - by_id: HashMap::new(), - last_id: 0, - } - } - - pub fn len(&self) -> usize { - self.by_id.len() - } - - /// Returns a list of all entities at the given position - pub fn at<'a>(&'a self, pos: Position) -> Vec<&'a A> { - self.by_position - .get(&pos) - .iter() - .flat_map(|eids| { - eids.iter() - .map(|eid| self.by_id.get(eid).expect(BY_POS_INVARIANT)) - }) - .collect() - } - - /// Remove all entities at the given position - pub fn remove_all_at(&mut self, pos: Position) { - if let Some(eids) = self.by_position.remove(&pos) { - for eid in eids { - self.by_id.remove(&eid).expect(BY_POS_INVARIANT); - } - } - } - - pub fn get(&self, id: EntityID) -> Option<&A> { - self.by_id.get(&id) - } - - pub fn get_mut(&mut self, id: EntityID) -> Option<&mut A> { - self.by_id.get_mut(&id) - } - - pub fn entities(&self) -> impl Iterator { - self.by_id.values() - } - - pub fn entities_mut(&mut self) -> impl Iterator { - self.by_id.values_mut() - } - - pub fn ids(&self) -> hash_map::Keys<'_, EntityID, A> { - self.by_id.keys() - } - - pub fn drain(&mut self) -> Drain<'_, A> { - let ids = self.ids().copied().collect::>(); - Drain { - map: self, - ids_iter: Box::new(ids.into_iter()), - } - } - - fn next_id(&mut self) -> EntityID { - self.last_id += 1; - self.last_id - } -} - -impl> EntityMap { - pub fn insert(&mut self, mut entity: A) -> EntityID { - let pos = entity.position(); - let entity_id = self.next_id(); - entity.set_id(entity_id); - self.by_id.entry(entity_id).or_insert(entity); - self.by_position - .entry(pos) - .or_insert_with(Vec::new) - .push(entity_id); - entity_id - } - - /// Remove the entity with the given ID - pub fn remove(&mut self, id: EntityID) -> Option { - self.by_id.remove(&id).map(|e| { - let mut empty = false; - let position = e.position(); - - if let Some(es) = self.by_position.get_mut(&position) { - es.retain(|e| *e != id); - if es.is_empty() { - empty = true; - } - } - - if empty { - self.by_position.remove(&position); - } - e - }) - } - - /// Moves all elements from `other` into `Self`, leathing `other` empty. - pub fn append(&mut self, other: &mut Self) { - // TODO there's probably some perf opportunities here by calling - // reserve() on stuff - for (_, entity) in other.drain() { - self.insert(entity); - } - } - - /// Gets all 8 neighbors of the given position. - pub fn neighbors<'a>( - &'a self, - position: Position, - ) -> Neighbors> { - Neighbors::of_position(position) - .map(|pos| self.at(*pos)) - .mapmap(&|e| (e.id(), *e)) - } - - pub fn neighbor_entities<'a>( - &'a self, - position: Position, - ) -> Neighbors> { - self.neighbors(position).mapmap(&|(_eid, ent)| *ent) - } - - pub fn check_invariants(&self) { - for (id, ent) in &self.by_id { - assert_eq!(*id, ent.id()); - } - - for (pos, ents) in &self.by_position { - for eid in ents { - let ent = self.by_id.get(eid).unwrap(); - assert_eq!(*pos, ent.position()) - } - } - } -} - -impl<'a, A: Positioned + Identified> IntoIterator - for &'a EntityMap -{ - type Item = (&'a EntityID, &'a A); - type IntoIter = std::collections::hash_map::Iter<'a, EntityID, A>; - fn into_iter(self) -> Self::IntoIter { - (&self.by_id).iter() - } -} - -impl> IntoIterator for EntityMap { - type Item = (EntityID, A); - type IntoIter = std::collections::hash_map::IntoIter; - fn into_iter(self) -> Self::IntoIter { - self.by_id.into_iter() - } -} - -impl> FromIterator for EntityMap { - fn from_iter>(iter: I) -> Self { - let mut em = EntityMap::new(); - for ent in iter { - em.insert(ent); - } - em - } -} - -impl + Eq + Clone> AbstractMagma - for EntityMap -{ - fn operate(&self, right: &Self) -> Self { - let mut by_position = self.by_position.clone(); - by_position.append(&mut right.by_position.clone()); - - let mut by_id = self.by_id.clone(); - for (k, v) in right.by_id.clone() { - by_id.insert(k, v); - } - - EntityMap { - by_position, - by_id, - last_id: self.last_id.max(right.last_id), - } - } -} - -impl + Eq + Clone> - AbstractSemigroup for EntityMap -{ -} - -impl + Eq> Identity - for EntityMap -{ - fn identity() -> Self { - EntityMap::new() - } -} - -impl + Eq + Clone> AbstractMonoid - for EntityMap -{ -} - -impl EntityMap { - pub fn update_position( - &mut self, - entity_id: EntityID, - new_position: Position, - ) { - let mut old_pos = None; - if let Some(entity) = self.by_id.get_mut(&entity_id) { - if entity.position() == new_position { - return; - } - old_pos = Some(entity.position()); - entity.set_position(new_position); - } - - if let Some(p) = old_pos { - if let Some(es) = self.by_position.get_mut(&p) { - es.retain(|e| *e != entity_id); - } - - self.by_position - .entry(new_position) - .or_insert_with(Vec::new) - .push(entity_id); - } - } -} - -pub struct Drain<'a, A> { - map: &'a mut EntityMap, - ids_iter: Box + 'a>, -} - -impl> Iterator for Drain<'_, A> { - type Item = (EntityID, A); - - fn next(&mut self) -> Option { - self.ids_iter - .next() - .map(|eid| (eid, self.map.remove(eid).expect(BY_POS_INVARIANT))) - } -} - -#[cfg(test)] -mod tests { - use super::*; - use crate::types::PositionedMut; - use proptest::prelude::*; - use proptest_derive::Arbitrary; - - #[derive(Debug, Arbitrary, PartialEq, Eq, Clone)] - struct TestEntity { - _id: Option, - position: Position, - name: String, - } - - impl Positioned for TestEntity { - fn position(&self) -> Position { - self.position - } - } - - impl PositionedMut for TestEntity { - fn set_position(&mut self, pos: Position) { - self.position = pos - } - } - - impl Identified for TestEntity { - fn opt_id(&self) -> Option { - self._id - } - - fn set_id(&mut self, id: EntityID) { - self._id = Some(id); - } - } - - fn gen_entity_map() -> BoxedStrategy> { - any::>() - .prop_map(|ents| { - ents.iter().cloned().collect::>() - }) - .boxed() - } - - proptest! { - #![proptest_config(ProptestConfig::with_cases(10))] - - #[test] - fn test_entity_map_len(items: Vec) { - let mut map = EntityMap::new(); - assert_eq!(map.len(), 0); - for ent in &items { - map.insert(ent.clone()); - } - assert_eq!(map.len(), items.len()); - } - - #[test] - fn test_entity_map_getset( - mut em in gen_entity_map(), - ent: TestEntity - ) { - em.insert(ent.clone()); - assert!(em.at(ent.position).iter().any(|e| e.name == ent.name)) - } - - #[test] - fn test_entity_map_set_iter_contains( - mut em in gen_entity_map(), - ent: TestEntity - ) { - em.insert(ent.clone()); - assert!(em.entities().any(|e| e.name == ent.name)) - } - - #[test] - fn test_update_position( - mut em in gen_entity_map(), - ent: TestEntity, - new_position: Position, - ) { - let original_position = ent.position(); - let entity_id = em.insert(ent.clone()); - em.update_position(entity_id, new_position); - - if new_position != original_position { - assert!(em.at(original_position).iter().all(|e| e.name != ent.name)); - } - assert_eq!( - em.get(entity_id).map(|e| e.position()), - Some(new_position) - ); - assert!( - em.at(new_position).iter().map( - |e| e.name.clone()).any(|en| en == ent.name), - ) - } - - #[test] - fn test_remove_all_at( - mut em in gen_entity_map(), - pos: Position, - ) { - em.remove_all_at(pos); - assert_eq!(em.at(pos).len(), 0); - } - - #[test] - fn test_entity_map_semigroup_laws( - em1 in gen_entity_map(), - em2 in gen_entity_map(), - em3 in gen_entity_map(), - ) { - assert!(AbstractSemigroup::prop_is_associative((em1, em2, em3))); - } - - fn test_entity_map_monoid_laws( - em in gen_entity_map(), - ) { - assert!( - AbstractMonoid::prop_operating_identity_element_is_noop((em,)) - ); - } - - #[test] - fn test_entity_map_append( - mut target in gen_entity_map(), - mut source in gen_entity_map(), - ) { - let orig_target = target.clone(); - let orig_source = source.clone(); - - target.append(&mut source); - target.check_invariants(); - - assert_eq!(source, EntityMap::new()); - - for ent in orig_source.entities() { - assert!( - target.at(ent.position()).iter().any(|e| e.name == ent.name) - ); - } - - for ent in orig_target.entities() { - assert!( - target.at(ent.position()).iter().any(|e| e.name == ent.name) - ); - } - } - } -} diff --git a/src/types/menu.rs b/src/types/menu.rs deleted file mode 100644 index 63abc83778..0000000000 --- a/src/types/menu.rs +++ /dev/null @@ -1,31 +0,0 @@ -use crate::types::Dimensions; - -#[derive(Debug, Clone, PartialEq, Eq)] -pub struct MenuInfo { - pub prompt: String, - pub options: Vec, -} - -impl MenuInfo { - pub fn new(prompt: String, options: Vec) -> Self { - MenuInfo { prompt, options } - } - - /// Returns the inner dimensions of a box necessary to draw this menu. Will - /// not trim either dimension to the size of the terminal - pub fn dimensions(&self) -> Dimensions { - Dimensions { - w: self - .options - .iter() - .map(|s| s.len()) - .max() - .unwrap_or(0) - .max(self.prompt.len()) as u16 - + 4, - h: self.options.len() as u16 - + if self.prompt.is_empty() { 0 } else { 2 } - + 4, - } - } -} diff --git a/src/types/mod.rs b/src/types/mod.rs deleted file mode 100644 index d417e873d8..0000000000 --- a/src/types/mod.rs +++ /dev/null @@ -1,504 +0,0 @@ -#![allow(clippy::unit_arg)] -#![allow(clippy::identity_conversion)] - -use std::cmp::max; -use std::cmp::Ordering; -use std::ops; -use std::rc::Rc; - -pub mod collision; -pub mod command; -pub mod direction; -pub mod entity_map; -pub mod menu; - -pub use collision::Collision; -pub use direction::Direction; -pub use direction::Direction::*; -use proptest_derive::Arbitrary; -use termion::cursor; - -#[derive(Clone, Copy, Debug, PartialEq, Eq, Arbitrary)] -pub struct Dimensions { - #[proptest(strategy = "std::ops::Range::::from(0..100)")] - pub w: u16, - - #[proptest(strategy = "std::ops::Range::::from(0..100)")] - pub h: u16, -} - -pub const ZERO_DIMENSIONS: Dimensions = Dimensions { w: 0, h: 0 }; -pub const UNIT_DIMENSIONS: Dimensions = Dimensions { w: 1, h: 1 }; - -impl Default for Dimensions { - fn default() -> Self { - Dimensions { w: 80, h: 20 } - } -} - -impl ops::Sub for Dimensions { - type Output = Dimensions; - fn sub(self, dims: Dimensions) -> Dimensions { - Dimensions { - w: self.w - dims.w, - h: self.h - dims.h, - } - } -} - -#[derive(Clone, Copy, Debug, PartialEq, Eq, Arbitrary)] -pub struct BoundingBox { - pub dimensions: Dimensions, - pub position: Position, -} - -impl BoundingBox { - pub fn at_origin(dimensions: Dimensions) -> BoundingBox { - BoundingBox { - dimensions, - position: ORIGIN, - } - } - - pub fn from_corners( - top_left: Position, - lower_right: Position, - ) -> BoundingBox { - BoundingBox { - position: top_left, - dimensions: Dimensions { - w: (lower_right.x - top_left.x) as u16, - h: (lower_right.y - top_left.y) as u16, - }, - } - } - - pub fn lr_corner(self) -> Position { - self.position - + (Position { - x: self.dimensions.w as i16, - y: self.dimensions.h as i16, - }) - } - - pub fn ll_corner(self) -> Position { - self.position - + (Position { - x: 0, - y: self.dimensions.h as i16, - }) - } - - /// Returns a bounding box representing the *inside* of this box if it was - /// drawn on the screen. - pub fn inner(self) -> BoundingBox { - self + UNIT_POSITION - UNIT_DIMENSIONS - UNIT_DIMENSIONS - } - - /// Moves the top right corner of the bounding box by the offset specified - /// by the given position, keeping the lower right corner in place - pub fn move_tr_corner(self, offset: Position) -> BoundingBox { - self + offset - - Dimensions { - w: offset.x as u16, - h: offset.y as u16, - } - } -} - -impl ops::Add for BoundingBox { - type Output = BoundingBox; - fn add(self, pos: Position) -> BoundingBox { - BoundingBox { - position: self.position + pos, - ..self - } - } -} - -impl ops::Sub for BoundingBox { - type Output = BoundingBox; - fn sub(self, dims: Dimensions) -> BoundingBox { - BoundingBox { - dimensions: self.dimensions - dims, - ..self - } - } -} - -#[derive(Clone, Copy, Debug, PartialEq, Eq, Arbitrary, Hash, Ord)] -pub struct Position { - /// x (horizontal) position - #[proptest(strategy = "std::ops::Range::::from(0..100)")] - pub x: i16, - - #[proptest(strategy = "std::ops::Range::::from(0..100)")] - /// y (vertical) position - pub y: i16, -} - -pub fn pos(x: i16, y: i16) -> Position { - Position { x, y } -} - -pub const ORIGIN: Position = Position { x: 0, y: 0 }; -pub const UNIT_POSITION: Position = Position { x: 1, y: 1 }; - -impl Position { - /// Returns true if this position exists within the bounds of the given box, - /// inclusive - pub fn within(self, b: BoundingBox) -> bool { - (self > b.position - UNIT_POSITION) && self < (b.lr_corner()) - } - - /// Returns a sequence of ASCII escape characters for moving the cursor to - /// this Position - pub fn cursor_goto(self) -> cursor::Goto { - // + 1 because Goto is 1-based, but position is 0-based - cursor::Goto(self.x as u16 + 1, self.y as u16 + 1) - } - - /// Converts this position to the number of `Tiles` away from the origin it - /// represents. Usually done after subtracting two positions. Gives distance - /// as the crow flies - pub fn as_tiles(self) -> Tiles { - Tiles(max(self.x.abs(), self.y.abs()).into()) - } -} - -impl PartialOrd for Position { - fn partial_cmp(&self, other: &Position) -> Option { - if self.x == other.x && self.y == other.y { - Some(Ordering::Equal) - } else if self.x > other.x && self.y > other.y { - Some(Ordering::Greater) - } else if self.x < other.x && self.y < other.y { - Some(Ordering::Less) - } else { - None - } - } -} - -/// Implements (bounded) addition of a Dimension to a position. -/// -/// # Examples -/// -/// ``` -/// let pos = Position { x: 1, y: 10 } -/// -/// let left_pos = pos + Direction::Left -/// assert_eq!(left, Position { x: 0, y: 10 }) -/// -/// let right_pos = pos + Direction::Right -/// assert_eq!(right_pos, Position { x: 0, y: 10 }) -/// ``` -#[allow(clippy::suspicious_arithmetic_impl)] -impl ops::Add for Position { - type Output = Position; - fn add(self, dir: Direction) -> Position { - match dir { - Left => { - if self.x > std::i16::MIN { - Position { - x: self.x - 1, - ..self - } - } else { - self - } - } - Right => { - if self.x < std::i16::MAX { - Position { - x: self.x + 1, - ..self - } - } else { - self - } - } - Up => { - if self.y > std::i16::MIN { - Position { - y: self.y - 1, - ..self - } - } else { - self - } - } - Down => { - if self.y < std::i16::MAX { - Position { - y: self.y + 1, - ..self - } - } else { - self - } - } - UpLeft => self + Up + Left, - UpRight => self + Up + Right, - DownLeft => self + Down + Left, - DownRight => self + Down + Right, - } - } -} - -impl ops::Add for Position { - type Output = Position; - fn add(self, pos: Position) -> Position { - Position { - x: self.x + pos.x, - y: self.y + pos.y, - } - } -} - -impl ops::Sub for Position { - type Output = Position; - fn sub(self, pos: Position) -> Position { - Position { - x: self.x - pos.x, - y: self.y - pos.y, - } - } -} - -impl Positioned for Position { - fn position(&self) -> Position { - *self - } -} - -pub trait Positioned { - fn x(&self) -> i16 { - self.position().x - } - - fn y(&self) -> i16 { - self.position().y - } - - fn position(&self) -> Position { - Position { - x: self.x(), - y: self.y(), - } - } -} - -pub trait PositionedMut: Positioned { - fn set_position(&mut self, pos: Position); -} - -// impl Positioned for A where A : Deref, I: Positioned { -// fn position(&self) -> Position { -// self.position() -// } -// } - -impl Positioned for Box { - fn position(&self) -> Position { - (**self).position() - } -} - -impl<'a, T: Positioned> Positioned for &'a T { - fn position(&self) -> Position { - (**self).position() - } -} - -impl<'a, T: Positioned> Positioned for &'a mut T { - fn position(&self) -> Position { - (**self).position() - } -} - -impl<'a, T: Positioned> Positioned for Rc { - fn position(&self) -> Position { - (**self).position() - } -} - -impl<'a, T: PositionedMut> PositionedMut for &'a mut T { - fn set_position(&mut self, pos: Position) { - (**self).set_position(pos) - } -} - -#[macro_export] -macro_rules! positioned { - ($name:ident) => { - positioned!($name, position); - }; - ($name:ident, $attr:ident) => { - impl $crate::types::Positioned for $name { - fn position(&self) -> $crate::types::Position { - self.$attr - } - } - }; -} - -#[macro_export] -macro_rules! positioned_mut { - ($name:ident) => { - positioned_mut!($name, position); - }; - ($name:ident, $attr:ident) => { - impl crate::types::PositionedMut for $name { - fn set_position(&mut self, pos: $crate::types::Position) { - self.$attr = pos; - } - } - }; -} - -/// A number of ticks -#[derive(Clone, Copy, Debug, PartialEq, Eq, Arbitrary)] -pub struct Ticks(pub u16); - -/// A number of tiles -/// -/// Expressed in terms of a float to allow moving partial tiles in a number of -/// ticks -#[derive(Clone, Copy, Debug, PartialEq, Arbitrary)] -pub struct Tiles(pub f32); - -/// The speed of an entity, expressed in ticks per tile -#[derive(Clone, Copy, Debug, PartialEq, Eq, Arbitrary, Deserialize)] -#[serde(transparent)] -pub struct Speed(pub u32); - -impl Speed { - /// Returns the number of tiles that would be moved in the given number of - /// ticks at this speed - pub fn ticks_to_tiles(self, ticks: Ticks) -> Tiles { - Tiles(f32::from(ticks.0) / self.0 as f32) - } - - /// Returns the number of ticks required to move the given number of tiles - /// at this speed - pub fn tiles_to_ticks(self, tiles: Tiles) -> Ticks { - Ticks(tiles.0 as u16 * self.0 as u16) - } -} - -#[derive(Clone, Copy, Debug, PartialEq, Eq, Arbitrary)] -pub struct Neighbors { - pub top_left: A, - pub top: A, - pub top_right: A, - pub left: A, - pub right: A, - pub bottom_left: A, - pub bottom: A, - pub bottom_right: A, -} - -impl Neighbors { - fn of_position(pos: Position) -> Self { - Neighbors { - top_left: pos + Direction::UpLeft, - top: pos + Direction::Up, - top_right: pos + Direction::UpRight, - left: pos + Direction::Left, - right: pos + Direction::Right, - bottom_left: pos + Direction::DownLeft, - bottom: pos + Direction::Down, - bottom_right: pos + Direction::DownRight, - } - } -} - -impl Neighbors { - /// it's a functor, yo - pub fn map B>(&self, f: F) -> Neighbors { - Neighbors { - top_left: f(&self.top_left), - top: f(&self.top), - top_right: f(&self.top_right), - left: f(&self.left), - right: f(&self.right), - bottom_left: f(&self.bottom_left), - bottom: f(&self.bottom), - bottom_right: f(&self.bottom_right), - } - } -} - -impl Neighbors> { - pub fn mapmap B>(&self, f: &F) -> Neighbors> { - self.map(|xs| xs.iter().map(f).collect()) - } -} - -#[cfg(test)] -mod tests { - #![allow(clippy::unnecessary_operation)] - use super::*; - use proptest::prelude::*; - - proptest! { - #[test] - fn position_partialord_lt_transitive( - a: Position, - b: Position, - c: Position - ) { - if a < b && b < c { - assert!(a < c) - } - } - - #[test] - fn position_partialord_eq_transitive( - a: Position, - b: Position, - c: Position - ) { - if a == b && b == c { - assert!(a == c) - } - } - - #[test] - fn position_partialord_gt_transitive( - a: Position, - b: Position, - c: Position, - ) { - if a > b && b > c { - assert!(a > c) - } - } - - #[test] - fn position_partialord_antisymmetric(a: Position, b: Position) { - if a < b { - assert!(!(a > b)) - } else if a > b { - assert!(!(a < b)) - } - } - - #[test] - fn test_position_plus_dimension_as_tiles_monoid_action( - pos: Position, - dir: Direction, - ) { - prop_assume!(pos.y > 0 && pos.x > 0); - assert_eq!(((pos + dir) - pos).as_tiles(), Tiles(1.0)); - } - } - - #[test] - fn test_position_as_tiles() { - assert_eq!(pos(0, 0).as_tiles(), Tiles(0.0)); - assert_eq!(pos(1, 1).as_tiles(), Tiles(1.0)); - assert_eq!(pos(1, 2).as_tiles(), Tiles(2.0)); - } -} diff --git a/src/util/mod.rs b/src/util/mod.rs deleted file mode 100644 index dd5087a555..0000000000 --- a/src/util/mod.rs +++ /dev/null @@ -1,7 +0,0 @@ -#[macro_use] -pub mod static_cfg; -#[macro_use] -pub mod template; -pub mod promise; -#[macro_use] -pub mod trait_impls; diff --git a/src/util/promise.rs b/src/util/promise.rs deleted file mode 100644 index 22f1e8b47f..0000000000 --- a/src/util/promise.rs +++ /dev/null @@ -1,160 +0,0 @@ -use std::future::Future; -use std::pin::Pin; -use std::sync::{Arc, RwLock}; -use std::task::{Context, Poll, Waker}; - -type Waiter = Box; - -pub struct Promise { - inner: Arc>>, - waiters: Arc>>>, -} - -pub struct Complete { - inner: Arc>>, -} - -#[derive(Debug, Clone, Copy, PartialEq, Eq)] -pub struct Cancelled; - -struct Inner { - value: Option>, - waker: Option, -} - -pub fn promise() -> (Complete, Promise) { - let inner = Arc::new(RwLock::new(Inner { - value: None, - waker: None, - })); - let promise = Promise { - inner: inner.clone(), - waiters: Arc::new(RwLock::new(Vec::new())), - }; - let complete = Complete { inner }; - (complete, promise) -} - -impl Complete { - pub fn fulfill(&self, val: T) { - let mut inner = self.inner.write().unwrap(); - inner.value = Some(Arc::new(val)); - if let Some(waker) = inner.waker.take() { - waker.wake() - } - } -} - -impl Complete> { - pub fn cancel(&mut self) { - self.fulfill(Err(Cancelled)) - } -} - -impl Complete> { - pub fn ok(&mut self, val: T) { - self.fulfill(Ok(val)) - } - - pub fn err(&mut self, e: E) { - self.fulfill(Err(e)) - } -} - -impl Promise { - pub fn on_fulfill(&mut self, f: F) { - let mut waiters = self.waiters.write().unwrap(); - waiters.push(Box::new(f)); - } -} - -impl Promise> { - pub fn on_cancel(&mut self, f: F) { - self.on_err(move |env, _| f(env)) - } -} - -impl Promise> { - pub fn on_ok(&mut self, f: F) { - self.on_fulfill(move |env, r| { - if let Ok(val) = r { - f(env, val) - } - }) - } - - pub fn on_err(&mut self, f: F) { - self.on_fulfill(move |env, r| { - if let Err(e) = r { - f(env, e) - } - }) - } -} - -pub trait Give { - fn give(&self, env: &mut Env) -> bool; -} - -impl Give for Promise { - fn give(&self, env: &mut Env) -> bool { - let inner = self.inner.read().unwrap(); - if let Some(value) = &inner.value { - let mut waiters = self.waiters.write().unwrap(); - for waiter in waiters.iter() { - waiter(env, value); - } - waiters.clear(); - true - } else { - false - } - } -} - -impl Clone for Promise { - fn clone(&self) -> Self { - Promise { - inner: self.inner.clone(), - waiters: self.waiters.clone(), - } - } -} - -impl> Give for &P { - fn give(&self, env: &mut Env) -> bool { - (*self).give(env) - } -} - -impl Future for Promise { - type Output = Arc; - fn poll(self: Pin<&mut Self>, cx: &mut Context<'_>) -> Poll { - let mut inner = self.inner.write().unwrap(); - match inner.value { - Some(ref v) => Poll::Ready(v.clone()), - None => { - inner.waker = Some(cx.waker().clone()); - Poll::Pending - } - } - } -} - -pub struct Promises<'a, Env> { - ps: Vec + 'a>>, -} - -impl<'a, Env> Promises<'a, Env> { - pub fn new() -> Self { - Promises { ps: Vec::new() } - } - - pub fn push(&mut self, p: Box + 'a>) { - self.ps.push(p); - } - - pub fn give_all(&mut self, env: &mut Env) { - self.ps.retain(|p| !p.give(env)); - } -} diff --git a/src/util/static_cfg.rs b/src/util/static_cfg.rs deleted file mode 100644 index b20456fb3b..0000000000 --- a/src/util/static_cfg.rs +++ /dev/null @@ -1,147 +0,0 @@ -use include_dir::Dir; -use serde::de; - -macro_rules! __static_cfg_include { - (toml_file, $filename:expr) => { - include_str!($filename) - }; - (toml_dir, $filename:expr) => { - include_dir!($filename) - }; - (json_file, $filename:expr) => { - include_str!($filename) - }; - (json_dir, $filename:expr) => { - include_dir!($filename) - }; - (cfg_dir, $filename:expr) => { - include_dir!($filename) - }; -} - -macro_rules! __static_cfg_type { - (toml_file) => (&'static str); - (json_file) => (&'static str); - (toml_dir) => (include_dir::Dir<'static>); - (json_dir) => (include_dir::Dir<'static>); - (cfg_dir) => (include_dir::Dir<'static>); -} - -macro_rules! __static_cfg_parse { - (toml_file, $e:expr) => { - toml::from_str($e).unwrap() - }; - - (json_file, $e:expr) => { - serde_json::from_str($e).unwrap() - }; - - (toml_dir, $e:expr) => { - crate::util::static_cfg::parse_toml_dir($e) - }; - - (json_dir, $e:expr) => { - crate::util::static_cfg::parse_json_dir($e) - }; - - (cfg_dir, $e:expr) => { - crate::util::static_cfg::parse_cfg_dir($e); - }; -} - -macro_rules! __static_cfg_inner { - ($(#[$attr:meta])* ($($vis:tt)*) static ref $N:ident : $T:ty = $kind:ident($filename:expr); $($t:tt)*) => { - // static RAW: &'static str = __static_cfg_include!($kind, $filename); - static RAW: __static_cfg_type!($kind) = __static_cfg_include!($kind, $filename); - lazy_static! { - $(#[$attr])* static ref $N: $T = __static_cfg_parse!($kind, RAW); - } - - static_cfg!($($t)*); - } -} - -#[macro_export] -macro_rules! static_cfg { - ($(#[$attr:meta])* static ref $N:ident : $T:ty = $kind:ident($filename:expr); $($t:tt)*) => { - __static_cfg_inner!($(#[$attr])* () static ref $N : $T = $kind($filename); $($t)*); - }; - - ($(#[$attr:meta])* pub static ref $N:ident : $T:ty = $kind:ident($filename:expr); $($t:tt)*) => { - __static_cfg_inner!($(#[$attr])* (pub) static ref $N : $T = $kind($filename); $($t)*); - }; - - ($(#[$attr:meta])* pub ($($vis:tt)+) static ref $N:ident : $T:ty = $kind:ident($filename:expr); $($t:tt)*) => { - __static_cfg_inner!($(#[$attr])* (pub ($($vis)+)) static ref $N : $T = $kind($filename); $($t)*); - }; - - () => () -} - -pub fn parse_cfg_dir<'a, T>(d: Dir<'a>) -> Vec -where - T: de::Deserialize<'a>, -{ - d.files() - .iter() - .filter_map(|f| { - let path = f.path(); - let contents = f.contents_utf8().unwrap(); - match path.extension().and_then(|e| e.to_str()) { - Some("toml") => { - Some(toml::from_str(contents).unwrap_or_else(|e| { - panic!( - "Error parsing TOML file {}: {}", - path.display(), - e - ) - })) - } - Some("json") => { - Some(serde_json::from_str(contents).unwrap_or_else(|e| { - panic!( - "Error parsing JSON file {}: {}", - path.display(), - e - ) - })) - } - // > YAML currently does not support zero-copy deserialization - // Some("yaml") => { - // Some(serde_yaml::from_str(contents).unwrap_or_else(|e| { - // panic!( - // "Error parsing YAML file {}: {}", - // path.display(), - // e - // ) - // })) - // } - _ => None, - } - }) - .collect() -} - -pub fn parse_toml_dir<'a, T>(d: Dir<'a>) -> Vec -where - T: de::Deserialize<'a>, -{ - d.files() - .iter() - .map(|f| { - toml::from_str(f.contents_utf8().unwrap()).unwrap_or_else(|e| { - panic!("Error parsing TOML file {}: {}", f.path, e) - }) - }) - .collect() -} - -pub fn parse_json_dir<'a, T>(d: Dir<'a>) -> Vec -where - T: de::Deserialize<'a>, -{ - d.files() - .iter() - .map(|f| serde_json::from_str(f.contents_utf8().unwrap()).unwrap()) - .collect() -} diff --git a/src/util/template.rs b/src/util/template.rs deleted file mode 100644 index bb77f9b4d6..0000000000 --- a/src/util/template.rs +++ /dev/null @@ -1,362 +0,0 @@ -use nom::combinator::rest; -use nom::error::ErrorKind; -use nom::{Err, IResult}; -use std::collections::HashMap; -use std::fmt::{self, Display}; -use std::marker::PhantomData; - -#[derive(Debug, PartialEq, Eq, Clone)] -pub struct Path<'a> { - head: &'a str, - tail: Vec<&'a str>, -} - -impl<'a> Path<'a> { - fn new(head: &'a str, tail: Vec<&'a str>) -> Self { - Path { head, tail } - } -} - -impl<'a> Display for Path<'a> { - fn fmt(&self, f: &mut fmt::Formatter<'_>) -> fmt::Result { - write!(f, "{}", self.head)?; - for part in &self.tail { - write!(f, ".{}", part)?; - } - Ok(()) - } -} - -// named!(path_ident, map_res!(is_not!(".}"), std::str::from_utf8)); -fn path_ident<'a>(input: &'a str) -> IResult<&'a str, &'a str> { - take_till!(input, |c| c == '.' || c == '}') -} - -fn path<'a>(input: &'a str) -> IResult<&'a str, Path<'a>> { - map!( - input, - tuple!( - path_ident, - many0!(complete!(preceded!(char!('.'), path_ident))) - ), - |(h, t)| Path::new(h, t) - ) -} - -#[derive(Debug, PartialEq, Eq, Clone)] -pub enum TemplateToken<'a> { - Literal(&'a str), - Substitution(Path<'a>), -} - -fn token_substitution<'a>( - input: &'a str, -) -> IResult<&'a str, TemplateToken<'a>> { - map!( - input, - delimited!(tag!("{{"), path, tag!("}}")), - TemplateToken::Substitution - ) -} - -fn template_token<'a>(input: &'a str) -> IResult<&'a str, TemplateToken<'a>> { - alt!( - input, - token_substitution - | map!( - alt!(complete!(take_until!("{{")) | complete!(rest)), - TemplateToken::Literal - ) - ) -} - -#[derive(Debug, PartialEq, Eq, Clone)] -pub struct Template<'a> { - tokens: Vec>, -} - -impl<'a> Template<'a> { - pub fn new(tokens: Vec>) -> Self { - Template { tokens } - } -} - -pub struct TemplateVisitor<'a> { - marker: PhantomData Template<'a>>, -} - -impl<'a> TemplateVisitor<'a> { - pub fn new() -> Self { - TemplateVisitor { - marker: PhantomData, - } - } -} - -impl<'a> serde::de::Visitor<'a> for TemplateVisitor<'a> { - type Value = Template<'a>; - - fn expecting(&self, formatter: &mut fmt::Formatter<'_>) -> fmt::Result { - formatter.write_str("a valid template string") - } - - fn visit_borrowed_str( - self, - v: &'a str, - ) -> Result { - Template::parse(v).map_err(|_| { - serde::de::Error::invalid_value( - serde::de::Unexpected::Str(v), - &"a valid template string", - ) - }) - } -} - -impl<'a> serde::Deserialize<'a> for Template<'a> { - fn deserialize>( - deserializer: D, - ) -> Result { - deserializer.deserialize_str(TemplateVisitor::new()) - } -} - -impl<'a> Template<'a> { - pub fn parse( - input: &'a str, - ) -> Result, Err<(&'a str, ErrorKind)>> { - let (remaining, res) = template(input)?; - if !remaining.is_empty() { - unreachable!(); - } - Ok(res) - } - - pub fn format( - &self, - params: &TemplateParams<'a>, - ) -> Result> { - use TemplateToken::*; - let mut res = String::new(); - for token in &self.tokens { - match token { - Literal(s) => res.push_str(s), - Substitution(p) => match params.get(p.clone()) { - Some(s) => res.push_str(s), - None => return Err(TemplateError::MissingParam(p.clone())), - }, - } - } - Ok(res) - } -} - -#[derive(Debug, PartialEq, Eq)] -pub enum TemplateError<'a> { - MissingParam(Path<'a>), -} - -impl<'a> Display for TemplateError<'a> { - fn fmt(&self, f: &mut fmt::Formatter<'_>) -> fmt::Result { - use TemplateError::*; - match self { - MissingParam(path) => { - write!(f, "Missing template parameter: {}", path) - } - } - } -} - -#[derive(Debug, PartialEq, Eq)] -pub enum TemplateParams<'a> { - Direct(&'a str), - Nested(HashMap<&'a str, TemplateParams<'a>>), -} - -impl<'a> TemplateParams<'a> { - fn get(&self, path: Path<'a>) -> Option<&'a str> { - use TemplateParams::*; - match self { - Direct(_) => None, - Nested(m) => m.get(path.head).and_then(|next| { - if path.tail.is_empty() { - match next { - Direct(s) => Some(*s), - _ => None, - } - } else { - next.get(Path { - head: path.tail[0], - tail: path.tail[1..].to_vec(), - }) - } - }), - } - } -} - -#[macro_export] -macro_rules! template_params { - (@count $head: expr => $hv: tt, $($rest:tt)+) => { 1 + template_params!(@count $($rest)+) }; - (@count $one:expr => $($ov: tt)*) => { 1 }; - (@inner $ret: ident, ($key: expr => {$($v:tt)*}, $($r:tt)*)) => { - $ret.insert($key, template_params!({ $($v)* })); - template_params!(@inner $ret, ($($r)*)); - }; - (@inner $ret: ident, ($key: expr => $value: expr, $($r:tt)*)) => { - $ret.insert($key, template_params!($value)); - template_params!(@inner $ret, ($($r)*)); - }; - (@inner $ret: ident, ()) => {}; - - ({ $($body: tt)* }) => {{ - let _cap = template_params!(@count $($body)*); - let mut _m = ::std::collections::HashMap::with_capacity(_cap); - template_params!(@inner _m, ($($body)*)); - TemplateParams::Nested(_m) - }}; - - ($direct:expr) => { TemplateParams::Direct($direct) }; - - () => { TemplateParams::Nested(::std::collections::HashMap::new()) }; -} - -fn template<'a>(input: &'a str) -> IResult<&'a str, Template<'a>> { - complete!( - input, - map!(many1!(complete!(template_token)), Template::new) - ) -} - -#[cfg(test)] -mod tests { - use super::*; - - #[test] - fn test_parse_path_ident() { - assert_eq!(path_ident("foo}}"), Ok(("}}", "foo"))); - assert_eq!(path_ident("foo.bar}}"), Ok((".bar}}", "foo"))); - } - - #[test] - fn test_parse_path() { - assert_eq!(path("foo}}"), Ok(("}}", Path::new("foo", vec![])))); - assert_eq!( - path("foo.bar}}"), - Ok(("}}", Path::new("foo", vec!["bar"]))) - ); - assert_eq!( - path("foo.bar.baz}}"), - Ok(("}}", Path::new("foo", vec!["bar", "baz"]))) - ); - } - - #[test] - fn test_parse_template_token() { - assert_eq!( - template_token("foo bar"), - Ok(("", TemplateToken::Literal("foo bar"))) - ); - - assert_eq!( - template_token("foo bar {{baz}}"), - Ok(("{{baz}}", TemplateToken::Literal("foo bar "))) - ); - - assert_eq!( - template_token("{{baz}}"), - Ok(( - "", - TemplateToken::Substitution(Path::new("baz", Vec::new())) - )) - ); - - assert_eq!( - template_token("{{baz}} foo bar"), - Ok(( - " foo bar", - TemplateToken::Substitution(Path::new("baz", Vec::new())) - )) - ); - } - - #[test] - fn test_parse_template() { - assert_eq!( - template("foo bar"), - Ok(( - "", - Template { - tokens: vec![TemplateToken::Literal("foo bar")] - } - )) - ); - - assert_eq!( - template("foo bar {{baz}} qux"), - Ok(( - "", - Template { - tokens: vec![ - TemplateToken::Literal("foo bar "), - TemplateToken::Substitution(Path::new( - "baz", - Vec::new() - )), - TemplateToken::Literal(" qux"), - ] - } - )) - ); - } - - #[test] - fn test_template_params_literal() { - // trace_macros!(true); - let expected = template_params!({ - "direct" => "hi", - "other" => "here", - "nested" => { - "one" => "1", - "two" => "2", - "double" => { - "three" => "3", - }, - }, - }); - // trace_macros!(false); - assert_eq!( - TemplateParams::Nested(hashmap! { - "direct" => TemplateParams::Direct("hi"), - "other" => TemplateParams::Direct("here"), - "nested" => TemplateParams::Nested(hashmap!{ - "one" => TemplateParams::Direct("1"), - "two" => TemplateParams::Direct("2"), - "double" => TemplateParams::Nested(hashmap!{ - "three" => TemplateParams::Direct("3"), - }) - }) - }), - expected, - ) - } - - #[test] - fn test_format_template() { - assert_eq!( - "foo bar baz qux", - Template::parse("foo {{x}} {{y.z}} {{y.w.z}}") - .unwrap() - .format(&template_params!({ - "x" => "bar", - "y" => { - "z" => "baz", - "w" => { - "z" => "qux", - }, - }, - })) - .unwrap() - ) - } -} diff --git a/src/util/trait_impls.rs b/src/util/trait_impls.rs deleted file mode 100644 index ba15f7119d..0000000000 --- a/src/util/trait_impls.rs +++ /dev/null @@ -1,17 +0,0 @@ -macro_rules! ref_impl { - (impl $traiti:ident for &T { - $($body:tt)* - }) => { - impl<'a, T: $traitb $(+ $bound)*> $traiti for &'a T { - $($body)* - } - - impl<'a, T: $traitb $(+ $bound)*> $traiti for &'a mut T { - $($body)* - } - - impl $traiti for ::std::boxed::Box { - $($body)* - } - }; -} -- cgit 1.4.1 From d3f3890dc5408581eb6181125c871d1cf2c0e18f Mon Sep 17 00:00:00 2001 From: Griffin Smith Date: Sun, 25 Aug 2019 13:28:10 -0400 Subject: An @-sign in a box, in haskell Initial commit of a Haskell version of Xanthous, written using Brick and built with Nix. This is so much nicer and so much easier --- .gitignore | 32 ++- LICENSE | 674 ++++++++++++++++++++++++++++++++++++++++++++++ README.org | 1 + Setup.hs | 2 + default.nix | 8 + hie.sh | 10 + package.yaml | 79 ++++++ shell.nix | 28 ++ src/Main.hs | 17 ++ src/Xanthous/App.hs | 21 ++ src/Xanthous/Game.hs | 12 + src/Xanthous/Game/Draw.hs | 28 ++ src/Xanthous/Prelude.hs | 10 + src/Xanthous/Resource.hs | 11 + test/Spec.hs | 3 + xanthous.cabal | 113 ++++++++ xanthous.nix | 29 ++ 17 files changed, 1075 insertions(+), 3 deletions(-) create mode 100644 LICENSE create mode 100644 README.org create mode 100644 Setup.hs create mode 100644 default.nix create mode 100755 hie.sh create mode 100644 package.yaml create mode 100644 shell.nix create mode 100644 src/Main.hs create mode 100644 src/Xanthous/App.hs create mode 100644 src/Xanthous/Game.hs create mode 100644 src/Xanthous/Game/Draw.hs create mode 100644 src/Xanthous/Prelude.hs create mode 100644 src/Xanthous/Resource.hs create mode 100644 test/Spec.hs create mode 100644 xanthous.cabal create mode 100644 xanthous.nix diff --git a/.gitignore b/.gitignore index 47c274db4e..a2f7e636e5 100644 --- a/.gitignore +++ b/.gitignore @@ -1,3 +1,29 @@ -/target -**/*.rs.bk -debug.log +dist +dist-* +cabal-dev +*.o +*.hi +*.hie +*.chi +*.chs.h +*.dyn_o +*.dyn_hi +.hpc +.hsenv +.cabal-sandbox/ +cabal.sandbox.config +*.prof +*.aux +*.hp +*.eventlog +.stack-work/ +cabal.project.local +cabal.project.local~ +.HTF/ +.ghc.environment.* + +# from nix-build +result + +# grr +*_flymake.hs diff --git a/LICENSE b/LICENSE new file mode 100644 index 0000000000..45644ff764 --- /dev/null +++ b/LICENSE @@ -0,0 +1,674 @@ + GNU GENERAL PUBLIC LICENSE + Version 3, 29 June 2007 + + Copyright (C) 2007 Free Software Foundation, Inc. + Everyone is permitted to copy and distribute verbatim copies + of this license document, but changing it is not allowed. + + Preamble + + The GNU General Public License is a free, copyleft license for +software and other kinds of works. + + The licenses for most software and other practical works are designed +to take away your freedom to share and change the works. By contrast, +the GNU General Public License is intended to guarantee your freedom to +share and change all versions of a program--to make sure it remains free +software for all its users. We, the Free Software Foundation, use the +GNU General Public License for most of our software; it applies also to +any other work released this way by its authors. You can apply it to +your programs, too. + + When we speak of free software, we are referring to freedom, not +price. Our General Public Licenses are designed to make sure that you +have the freedom to distribute copies of free software (and charge for +them if you wish), that you receive source code or can get it if you +want it, that you can change the software or use pieces of it in new +free programs, and that you know you can do these things. + + To protect your rights, we need to prevent others from denying you +these rights or asking you to surrender the rights. Therefore, you have +certain responsibilities if you distribute copies of the software, or if +you modify it: responsibilities to respect the freedom of others. + + For example, if you distribute copies of such a program, whether +gratis or for a fee, you must pass on to the recipients the same +freedoms that you received. You must make sure that they, too, receive +or can get the source code. And you must show them these terms so they +know their rights. + + Developers that use the GNU GPL protect your rights with two steps: +(1) assert copyright on the software, and (2) offer you this License +giving you legal permission to copy, distribute and/or modify it. + + For the developers' and authors' protection, the GPL clearly explains +that there is no warranty for this free software. For both users' and +authors' sake, the GPL requires that modified versions be marked as +changed, so that their problems will not be attributed erroneously to +authors of previous versions. + + Some devices are designed to deny users access to install or run +modified versions of the software inside them, although the manufacturer +can do so. This is fundamentally incompatible with the aim of +protecting users' freedom to change the software. The systematic +pattern of such abuse occurs in the area of products for individuals to +use, which is precisely where it is most unacceptable. Therefore, we +have designed this version of the GPL to prohibit the practice for those +products. If such problems arise substantially in other domains, we +stand ready to extend this provision to those domains in future versions +of the GPL, as needed to protect the freedom of users. + + Finally, every program is threatened constantly by software patents. +States should not allow patents to restrict development and use of +software on general-purpose computers, but in those that do, we wish to +avoid the special danger that patents applied to a free program could +make it effectively proprietary. To prevent this, the GPL assures that +patents cannot be used to render the program non-free. + + The precise terms and conditions for copying, distribution and +modification follow. + + TERMS AND CONDITIONS + + 0. Definitions. + + "This License" refers to version 3 of the GNU General Public License. + + "Copyright" also means copyright-like laws that apply to other kinds of +works, such as semiconductor masks. + + "The Program" refers to any copyrightable work licensed under this +License. Each licensee is addressed as "you". "Licensees" and +"recipients" may be individuals or organizations. + + To "modify" a work means to copy from or adapt all or part of the work +in a fashion requiring copyright permission, other than the making of an +exact copy. The resulting work is called a "modified version" of the +earlier work or a work "based on" the earlier work. + + A "covered work" means either the unmodified Program or a work based +on the Program. + + To "propagate" a work means to do anything with it that, without +permission, would make you directly or secondarily liable for +infringement under applicable copyright law, except executing it on a +computer or modifying a private copy. Propagation includes copying, +distribution (with or without modification), making available to the +public, and in some countries other activities as well. + + To "convey" a work means any kind of propagation that enables other +parties to make or receive copies. Mere interaction with a user through +a computer network, with no transfer of a copy, is not conveying. + + An interactive user interface displays "Appropriate Legal Notices" +to the extent that it includes a convenient and prominently visible +feature that (1) displays an appropriate copyright notice, and (2) +tells the user that there is no warranty for the work (except to the +extent that warranties are provided), that licensees may convey the +work under this License, and how to view a copy of this License. If +the interface presents a list of user commands or options, such as a +menu, a prominent item in the list meets this criterion. + + 1. Source Code. + + The "source code" for a work means the preferred form of the work +for making modifications to it. "Object code" means any non-source +form of a work. + + A "Standard Interface" means an interface that either is an official +standard defined by a recognized standards body, or, in the case of +interfaces specified for a particular programming language, one that +is widely used among developers working in that language. + + The "System Libraries" of an executable work include anything, other +than the work as a whole, that (a) is included in the normal form of +packaging a Major Component, but which is not part of that Major +Component, and (b) serves only to enable use of the work with that +Major Component, or to implement a Standard Interface for which an +implementation is available to the public in source code form. A +"Major Component", in this context, means a major essential component +(kernel, window system, and so on) of the specific operating system +(if any) on which the executable work runs, or a compiler used to +produce the work, or an object code interpreter used to run it. + + The "Corresponding Source" for a work in object code form means all +the source code needed to generate, install, and (for an executable +work) run the object code and to modify the work, including scripts to +control those activities. However, it does not include the work's +System Libraries, or general-purpose tools or generally available free +programs which are used unmodified in performing those activities but +which are not part of the work. For example, Corresponding Source +includes interface definition files associated with source files for +the work, and the source code for shared libraries and dynamically +linked subprograms that the work is specifically designed to require, +such as by intimate data communication or control flow between those +subprograms and other parts of the work. + + The Corresponding Source need not include anything that users +can regenerate automatically from other parts of the Corresponding +Source. + + The Corresponding Source for a work in source code form is that +same work. + + 2. Basic Permissions. + + All rights granted under this License are granted for the term of +copyright on the Program, and are irrevocable provided the stated +conditions are met. This License explicitly affirms your unlimited +permission to run the unmodified Program. The output from running a +covered work is covered by this License only if the output, given its +content, constitutes a covered work. This License acknowledges your +rights of fair use or other equivalent, as provided by copyright law. + + You may make, run and propagate covered works that you do not +convey, without conditions so long as your license otherwise remains +in force. You may convey covered works to others for the sole purpose +of having them make modifications exclusively for you, or provide you +with facilities for running those works, provided that you comply with +the terms of this License in conveying all material for which you do +not control copyright. Those thus making or running the covered works +for you must do so exclusively on your behalf, under your direction +and control, on terms that prohibit them from making any copies of +your copyrighted material outside their relationship with you. + + Conveying under any other circumstances is permitted solely under +the conditions stated below. Sublicensing is not allowed; section 10 +makes it unnecessary. + + 3. Protecting Users' Legal Rights From Anti-Circumvention Law. + + No covered work shall be deemed part of an effective technological +measure under any applicable law fulfilling obligations under article +11 of the WIPO copyright treaty adopted on 20 December 1996, or +similar laws prohibiting or restricting circumvention of such +measures. + + When you convey a covered work, you waive any legal power to forbid +circumvention of technological measures to the extent such circumvention +is effected by exercising rights under this License with respect to +the covered work, and you disclaim any intention to limit operation or +modification of the work as a means of enforcing, against the work's +users, your or third parties' legal rights to forbid circumvention of +technological measures. + + 4. Conveying Verbatim Copies. + + You may convey verbatim copies of the Program's source code as you +receive it, in any medium, provided that you conspicuously and +appropriately publish on each copy an appropriate copyright notice; +keep intact all notices stating that this License and any +non-permissive terms added in accord with section 7 apply to the code; +keep intact all notices of the absence of any warranty; and give all +recipients a copy of this License along with the Program. + + You may charge any price or no price for each copy that you convey, +and you may offer support or warranty protection for a fee. + + 5. Conveying Modified Source Versions. + + You may convey a work based on the Program, or the modifications to +produce it from the Program, in the form of source code under the +terms of section 4, provided that you also meet all of these conditions: + + a) The work must carry prominent notices stating that you modified + it, and giving a relevant date. + + b) The work must carry prominent notices stating that it is + released under this License and any conditions added under section + 7. This requirement modifies the requirement in section 4 to + "keep intact all notices". + + c) You must license the entire work, as a whole, under this + License to anyone who comes into possession of a copy. This + License will therefore apply, along with any applicable section 7 + additional terms, to the whole of the work, and all its parts, + regardless of how they are packaged. This License gives no + permission to license the work in any other way, but it does not + invalidate such permission if you have separately received it. + + d) If the work has interactive user interfaces, each must display + Appropriate Legal Notices; however, if the Program has interactive + interfaces that do not display Appropriate Legal Notices, your + work need not make them do so. + + A compilation of a covered work with other separate and independent +works, which are not by their nature extensions of the covered work, +and which are not combined with it such as to form a larger program, +in or on a volume of a storage or distribution medium, is called an +"aggregate" if the compilation and its resulting copyright are not +used to limit the access or legal rights of the compilation's users +beyond what the individual works permit. Inclusion of a covered work +in an aggregate does not cause this License to apply to the other +parts of the aggregate. + + 6. Conveying Non-Source Forms. + + You may convey a covered work in object code form under the terms +of sections 4 and 5, provided that you also convey the +machine-readable Corresponding Source under the terms of this License, +in one of these ways: + + a) Convey the object code in, or embodied in, a physical product + (including a physical distribution medium), accompanied by the + Corresponding Source fixed on a durable physical medium + customarily used for software interchange. + + b) Convey the object code in, or embodied in, a physical product + (including a physical distribution medium), accompanied by a + written offer, valid for at least three years and valid for as + long as you offer spare parts or customer support for that product + model, to give anyone who possesses the object code either (1) a + copy of the Corresponding Source for all the software in the + product that is covered by this License, on a durable physical + medium customarily used for software interchange, for a price no + more than your reasonable cost of physically performing this + conveying of source, or (2) access to copy the + Corresponding Source from a network server at no charge. + + c) Convey individual copies of the object code with a copy of the + written offer to provide the Corresponding Source. This + alternative is allowed only occasionally and noncommercially, and + only if you received the object code with such an offer, in accord + with subsection 6b. + + d) Convey the object code by offering access from a designated + place (gratis or for a charge), and offer equivalent access to the + Corresponding Source in the same way through the same place at no + further charge. You need not require recipients to copy the + Corresponding Source along with the object code. If the place to + copy the object code is a network server, the Corresponding Source + may be on a different server (operated by you or a third party) + that supports equivalent copying facilities, provided you maintain + clear directions next to the object code saying where to find the + Corresponding Source. Regardless of what server hosts the + Corresponding Source, you remain obligated to ensure that it is + available for as long as needed to satisfy these requirements. + + e) Convey the object code using peer-to-peer transmission, provided + you inform other peers where the object code and Corresponding + Source of the work are being offered to the general public at no + charge under subsection 6d. + + A separable portion of the object code, whose source code is excluded +from the Corresponding Source as a System Library, need not be +included in conveying the object code work. + + A "User Product" is either (1) a "consumer product", which means any +tangible personal property which is normally used for personal, family, +or household purposes, or (2) anything designed or sold for incorporation +into a dwelling. In determining whether a product is a consumer product, +doubtful cases shall be resolved in favor of coverage. For a particular +product received by a particular user, "normally used" refers to a +typical or common use of that class of product, regardless of the status +of the particular user or of the way in which the particular user +actually uses, or expects or is expected to use, the product. A product +is a consumer product regardless of whether the product has substantial +commercial, industrial or non-consumer uses, unless such uses represent +the only significant mode of use of the product. + + "Installation Information" for a User Product means any methods, +procedures, authorization keys, or other information required to install +and execute modified versions of a covered work in that User Product from +a modified version of its Corresponding Source. The information must +suffice to ensure that the continued functioning of the modified object +code is in no case prevented or interfered with solely because +modification has been made. + + If you convey an object code work under this section in, or with, or +specifically for use in, a User Product, and the conveying occurs as +part of a transaction in which the right of possession and use of the +User Product is transferred to the recipient in perpetuity or for a +fixed term (regardless of how the transaction is characterized), the +Corresponding Source conveyed under this section must be accompanied +by the Installation Information. But this requirement does not apply +if neither you nor any third party retains the ability to install +modified object code on the User Product (for example, the work has +been installed in ROM). + + The requirement to provide Installation Information does not include a +requirement to continue to provide support service, warranty, or updates +for a work that has been modified or installed by the recipient, or for +the User Product in which it has been modified or installed. Access to a +network may be denied when the modification itself materially and +adversely affects the operation of the network or violates the rules and +protocols for communication across the network. + + Corresponding Source conveyed, and Installation Information provided, +in accord with this section must be in a format that is publicly +documented (and with an implementation available to the public in +source code form), and must require no special password or key for +unpacking, reading or copying. + + 7. Additional Terms. + + "Additional permissions" are terms that supplement the terms of this +License by making exceptions from one or more of its conditions. +Additional permissions that are applicable to the entire Program shall +be treated as though they were included in this License, to the extent +that they are valid under applicable law. If additional permissions +apply only to part of the Program, that part may be used separately +under those permissions, but the entire Program remains governed by +this License without regard to the additional permissions. + + When you convey a copy of a covered work, you may at your option +remove any additional permissions from that copy, or from any part of +it. (Additional permissions may be written to require their own +removal in certain cases when you modify the work.) You may place +additional permissions on material, added by you to a covered work, +for which you have or can give appropriate copyright permission. + + Notwithstanding any other provision of this License, for material you +add to a covered work, you may (if authorized by the copyright holders of +that material) supplement the terms of this License with terms: + + a) Disclaiming warranty or limiting liability differently from the + terms of sections 15 and 16 of this License; or + + b) Requiring preservation of specified reasonable legal notices or + author attributions in that material or in the Appropriate Legal + Notices displayed by works containing it; or + + c) Prohibiting misrepresentation of the origin of that material, or + requiring that modified versions of such material be marked in + reasonable ways as different from the original version; or + + d) Limiting the use for publicity purposes of names of licensors or + authors of the material; or + + e) Declining to grant rights under trademark law for use of some + trade names, trademarks, or service marks; or + + f) Requiring indemnification of licensors and authors of that + material by anyone who conveys the material (or modified versions of + it) with contractual assumptions of liability to the recipient, for + any liability that these contractual assumptions directly impose on + those licensors and authors. + + All other non-permissive additional terms are considered "further +restrictions" within the meaning of section 10. If the Program as you +received it, or any part of it, contains a notice stating that it is +governed by this License along with a term that is a further +restriction, you may remove that term. If a license document contains +a further restriction but permits relicensing or conveying under this +License, you may add to a covered work material governed by the terms +of that license document, provided that the further restriction does +not survive such relicensing or conveying. + + If you add terms to a covered work in accord with this section, you +must place, in the relevant source files, a statement of the +additional terms that apply to those files, or a notice indicating +where to find the applicable terms. + + Additional terms, permissive or non-permissive, may be stated in the +form of a separately written license, or stated as exceptions; +the above requirements apply either way. + + 8. Termination. + + You may not propagate or modify a covered work except as expressly +provided under this License. Any attempt otherwise to propagate or +modify it is void, and will automatically terminate your rights under +this License (including any patent licenses granted under the third +paragraph of section 11). + + However, if you cease all violation of this License, then your +license from a particular copyright holder is reinstated (a) +provisionally, unless and until the copyright holder explicitly and +finally terminates your license, and (b) permanently, if the copyright +holder fails to notify you of the violation by some reasonable means +prior to 60 days after the cessation. + + Moreover, your license from a particular copyright holder is +reinstated permanently if the copyright holder notifies you of the +violation by some reasonable means, this is the first time you have +received notice of violation of this License (for any work) from that +copyright holder, and you cure the violation prior to 30 days after +your receipt of the notice. + + Termination of your rights under this section does not terminate the +licenses of parties who have received copies or rights from you under +this License. If your rights have been terminated and not permanently +reinstated, you do not qualify to receive new licenses for the same +material under section 10. + + 9. Acceptance Not Required for Having Copies. + + You are not required to accept this License in order to receive or +run a copy of the Program. Ancillary propagation of a covered work +occurring solely as a consequence of using peer-to-peer transmission +to receive a copy likewise does not require acceptance. However, +nothing other than this License grants you permission to propagate or +modify any covered work. These actions infringe copyright if you do +not accept this License. Therefore, by modifying or propagating a +covered work, you indicate your acceptance of this License to do so. + + 10. Automatic Licensing of Downstream Recipients. + + Each time you convey a covered work, the recipient automatically +receives a license from the original licensors, to run, modify and +propagate that work, subject to this License. You are not responsible +for enforcing compliance by third parties with this License. + + An "entity transaction" is a transaction transferring control of an +organization, or substantially all assets of one, or subdividing an +organization, or merging organizations. If propagation of a covered +work results from an entity transaction, each party to that +transaction who receives a copy of the work also receives whatever +licenses to the work the party's predecessor in interest had or could +give under the previous paragraph, plus a right to possession of the +Corresponding Source of the work from the predecessor in interest, if +the predecessor has it or can get it with reasonable efforts. + + You may not impose any further restrictions on the exercise of the +rights granted or affirmed under this License. For example, you may +not impose a license fee, royalty, or other charge for exercise of +rights granted under this License, and you may not initiate litigation +(including a cross-claim or counterclaim in a lawsuit) alleging that +any patent claim is infringed by making, using, selling, offering for +sale, or importing the Program or any portion of it. + + 11. Patents. + + A "contributor" is a copyright holder who authorizes use under this +License of the Program or a work on which the Program is based. The +work thus licensed is called the contributor's "contributor version". + + A contributor's "essential patent claims" are all patent claims +owned or controlled by the contributor, whether already acquired or +hereafter acquired, that would be infringed by some manner, permitted +by this License, of making, using, or selling its contributor version, +but do not include claims that would be infringed only as a +consequence of further modification of the contributor version. For +purposes of this definition, "control" includes the right to grant +patent sublicenses in a manner consistent with the requirements of +this License. + + Each contributor grants you a non-exclusive, worldwide, royalty-free +patent license under the contributor's essential patent claims, to +make, use, sell, offer for sale, import and otherwise run, modify and +propagate the contents of its contributor version. + + In the following three paragraphs, a "patent license" is any express +agreement or commitment, however denominated, not to enforce a patent +(such as an express permission to practice a patent or covenant not to +sue for patent infringement). To "grant" such a patent license to a +party means to make such an agreement or commitment not to enforce a +patent against the party. + + If you convey a covered work, knowingly relying on a patent license, +and the Corresponding Source of the work is not available for anyone +to copy, free of charge and under the terms of this License, through a +publicly available network server or other readily accessible means, +then you must either (1) cause the Corresponding Source to be so +available, or (2) arrange to deprive yourself of the benefit of the +patent license for this particular work, or (3) arrange, in a manner +consistent with the requirements of this License, to extend the patent +license to downstream recipients. "Knowingly relying" means you have +actual knowledge that, but for the patent license, your conveying the +covered work in a country, or your recipient's use of the covered work +in a country, would infringe one or more identifiable patents in that +country that you have reason to believe are valid. + + If, pursuant to or in connection with a single transaction or +arrangement, you convey, or propagate by procuring conveyance of, a +covered work, and grant a patent license to some of the parties +receiving the covered work authorizing them to use, propagate, modify +or convey a specific copy of the covered work, then the patent license +you grant is automatically extended to all recipients of the covered +work and works based on it. + + A patent license is "discriminatory" if it does not include within +the scope of its coverage, prohibits the exercise of, or is +conditioned on the non-exercise of one or more of the rights that are +specifically granted under this License. You may not convey a covered +work if you are a party to an arrangement with a third party that is +in the business of distributing software, under which you make payment +to the third party based on the extent of your activity of conveying +the work, and under which the third party grants, to any of the +parties who would receive the covered work from you, a discriminatory +patent license (a) in connection with copies of the covered work +conveyed by you (or copies made from those copies), or (b) primarily +for and in connection with specific products or compilations that +contain the covered work, unless you entered into that arrangement, +or that patent license was granted, prior to 28 March 2007. + + Nothing in this License shall be construed as excluding or limiting +any implied license or other defenses to infringement that may +otherwise be available to you under applicable patent law. + + 12. No Surrender of Others' Freedom. + + If conditions are imposed on you (whether by court order, agreement or +otherwise) that contradict the conditions of this License, they do not +excuse you from the conditions of this License. If you cannot convey a +covered work so as to satisfy simultaneously your obligations under this +License and any other pertinent obligations, then as a consequence you may +not convey it at all. For example, if you agree to terms that obligate you +to collect a royalty for further conveying from those to whom you convey +the Program, the only way you could satisfy both those terms and this +License would be to refrain entirely from conveying the Program. + + 13. Use with the GNU Affero General Public License. + + Notwithstanding any other provision of this License, you have +permission to link or combine any covered work with a work licensed +under version 3 of the GNU Affero General Public License into a single +combined work, and to convey the resulting work. The terms of this +License will continue to apply to the part which is the covered work, +but the special requirements of the GNU Affero General Public License, +section 13, concerning interaction through a network will apply to the +combination as such. + + 14. Revised Versions of this License. + + The Free Software Foundation may publish revised and/or new versions of +the GNU General Public License from time to time. Such new versions will +be similar in spirit to the present version, but may differ in detail to +address new problems or concerns. + + Each version is given a distinguishing version number. If the +Program specifies that a certain numbered version of the GNU General +Public License "or any later version" applies to it, you have the +option of following the terms and conditions either of that numbered +version or of any later version published by the Free Software +Foundation. If the Program does not specify a version number of the +GNU General Public License, you may choose any version ever published +by the Free Software Foundation. + + If the Program specifies that a proxy can decide which future +versions of the GNU General Public License can be used, that proxy's +public statement of acceptance of a version permanently authorizes you +to choose that version for the Program. + + Later license versions may give you additional or different +permissions. However, no additional obligations are imposed on any +author or copyright holder as a result of your choosing to follow a +later version. + + 15. Disclaimer of Warranty. + + THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY +APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT +HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY +OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, +THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR +PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM +IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF +ALL NECESSARY SERVICING, REPAIR OR CORRECTION. + + 16. Limitation of Liability. + + IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING +WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES AND/OR CONVEYS +THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY +GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE +USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF +DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD +PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), +EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF +SUCH DAMAGES. + + 17. Interpretation of Sections 15 and 16. + + If the disclaimer of warranty and limitation of liability provided +above cannot be given local legal effect according to their terms, +reviewing courts shall apply local law that most closely approximates +an absolute waiver of all civil liability in connection with the +Program, unless a warranty or assumption of liability accompanies a +copy of the Program in return for a fee. + + END OF TERMS AND CONDITIONS + + How to Apply These Terms to Your New Programs + + If you develop a new program, and you want it to be of the greatest +possible use to the public, the best way to achieve this is to make it +free software which everyone can redistribute and change under these terms. + + To do so, attach the following notices to the program. It is safest +to attach them to the start of each source file to most effectively +state the exclusion of warranty; and each file should have at least +the "copyright" line and a pointer to where the full notice is found. + + + Copyright (C) + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . + +Also add information on how to contact you by electronic and paper mail. + + If the program does terminal interaction, make it output a short +notice like this when it starts in an interactive mode: + + Copyright (C) + This program comes with ABSOLUTELY NO WARRANTY; for details type `show w'. + This is free software, and you are welcome to redistribute it + under certain conditions; type `show c' for details. + +The hypothetical commands `show w' and `show c' should show the appropriate +parts of the General Public License. Of course, your program's commands +might be different; for a GUI interface, you would use an "about box". + + You should also get your employer (if you work as a programmer) or school, +if any, to sign a "copyright disclaimer" for the program, if necessary. +For more information on this, and how to apply and follow the GNU GPL, see +. + + The GNU General Public License does not permit incorporating your program +into proprietary programs. If your program is a subroutine library, you +may consider it more useful to permit linking proprietary applications with +the library. If this is what you want to do, use the GNU Lesser General +Public License instead of this License. But first, please read +. diff --git a/README.org b/README.org new file mode 100644 index 0000000000..2f766ec1b6 --- /dev/null +++ b/README.org @@ -0,0 +1 @@ +#+TITLE: Xanthous diff --git a/Setup.hs b/Setup.hs new file mode 100644 index 0000000000..9a994af677 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/default.nix b/default.nix new file mode 100644 index 0000000000..f73c537abd --- /dev/null +++ b/default.nix @@ -0,0 +1,8 @@ +{ nixpkgs ? import {}, compiler ? "ghc865" }: +let + inherit (nixpkgs) pkgs; + all-hies = import (fetchTarball "https://github.com/infinisil/all-hies/tarball/master") {}; + hie = all-hies.selection { selector = p: { inherit (p) ghc865; }; }; + xanthous = pkgs.haskellPackages.callPackage ./xanthous.nix {}; +in +xanthous // { inherit hie; } diff --git a/hie.sh b/hie.sh new file mode 100755 index 0000000000..4ea97997c7 --- /dev/null +++ b/hie.sh @@ -0,0 +1,10 @@ +#!/usr/bin/env bash + +cd "$(dirname "${BASH_SOURCE[0]}")" || exit 1 + +argv=( "$@" ) +argv=( "${argv[@]/\'/\'\\\'\'}" ) +argv=( "${argv[@]/#/\'}" ) +argv=( "${argv[@]/%/\'}" ) + +exec nix-shell --pure --run "exec $(nix-build -o dist/nix/hie -A hie)/bin/hie ${argv[*]}" diff --git a/package.yaml b/package.yaml new file mode 100644 index 0000000000..4a450cfd5d --- /dev/null +++ b/package.yaml @@ -0,0 +1,79 @@ +name: xanthous +version: 0.1.0.0 +github: "glittershark/xanthous" +license: GPL-3 +author: "Griffin Smith" +maintainer: "root@gws.fyi" +copyright: "2019 Griffin Smith" + +extra-source-files: +- README.org + +synopsis: A WIP TUI RPG +category: Game + +description: Please see the README on GitHub at + +dependencies: +- base +- lens +- containers +- constraints +- QuickCheck +- classy-prelude +- mtl +- data-default +- deepseq +- ascii-art-to-unicode +- brick +- vty + +default-extensions: +- ConstraintKinds +- DataKinds +- DeriveAnyClass +- DeriveGeneric +- DerivingStrategies +- FlexibleContexts +- FlexibleInstances +- FunctionalDependencies +- GADTSyntax +- GeneralizedNewtypeDeriving +- KindSignatures +- LambdaCase +- NoImplicitPrelude +- NoStarIsType +- OverloadedStrings +- PolyKinds +- RankNTypes +- ScopedTypeVariables +- TypeApplications +- TypeFamilies +- TypeOperators + +ghc-options: +- -Wall +- -threaded + +library: + source-dirs: src + +executable: + source-dirs: src + main: Main.hs + dependencies: + - xanthous + +tests: + test: + main: Spec.hs + source-dirs: test + ghc-options: + - -threaded + - -rtsopts + - -with-rtsopts=-N + dependencies: + - xanthous + - tasty + - tasty-hunit + - tasty-quickcheck diff --git a/shell.nix b/shell.nix new file mode 100644 index 0000000000..aefc492d3d --- /dev/null +++ b/shell.nix @@ -0,0 +1,28 @@ +{ nixpkgs ? import {}, compiler ? "ghc865", withHoogle ? true }: +let + inherit (nixpkgs) pkgs; + + xan = import ./xanthous.nix; + + packageSet = ( + if compiler == "default" + then pkgs.haskellPackages + else pkgs.haskell.packages.${compiler} + ); + + haskellPackages = ( + if withHoogle + then packageSet.override { + overrides = (self: super: { + ghc = super.ghc // { withPackages = super.ghc.withHoogle; }; + ghcWithPackages = self.ghc.withPackages; + }); + } + else packageSet + ); + + drv = haskellPackages.callPackage xan {}; + + inherit (pkgs.haskell.lib) addBuildTools; +in +(addBuildTools drv (with haskellPackages; [ cabal-install ])).env diff --git a/src/Main.hs b/src/Main.hs new file mode 100644 index 0000000000..1cd4e94457 --- /dev/null +++ b/src/Main.hs @@ -0,0 +1,17 @@ +module Main where + +import Xanthous.Prelude +import Brick + +import Xanthous.Game (getInitialState) +import Xanthous.App (makeApp) + +ui :: Widget () +ui = str "Hello, world!" + +main :: IO () +main = do + app <- makeApp + initialState <- getInitialState + _ <- defaultMain app initialState + pure () diff --git a/src/Xanthous/App.hs b/src/Xanthous/App.hs new file mode 100644 index 0000000000..5c0383c38e --- /dev/null +++ b/src/Xanthous/App.hs @@ -0,0 +1,21 @@ +module Xanthous.App (makeApp) where + +import Xanthous.Prelude +import Brick hiding (App) +import qualified Brick +import Graphics.Vty.Attributes (defAttr) + +import Xanthous.Game +import Xanthous.Game.Draw (drawGame) +import Xanthous.Resource (Name) + +type App = Brick.App GameState () Name + +makeApp :: IO App +makeApp = pure $ Brick.App + { appDraw = drawGame + , appChooseCursor = const headMay + , appHandleEvent = resizeOrQuit + , appStartEvent = pure + , appAttrMap = const $ attrMap defAttr [] + } diff --git a/src/Xanthous/Game.hs b/src/Xanthous/Game.hs new file mode 100644 index 0000000000..c88509819c --- /dev/null +++ b/src/Xanthous/Game.hs @@ -0,0 +1,12 @@ +module Xanthous.Game + ( GameState(..) + , getInitialState + ) where + +import Xanthous.Prelude + +data GameState = GameState + { } + +getInitialState :: IO GameState +getInitialState = pure GameState diff --git a/src/Xanthous/Game/Draw.hs b/src/Xanthous/Game/Draw.hs new file mode 100644 index 0000000000..2d793ba27b --- /dev/null +++ b/src/Xanthous/Game/Draw.hs @@ -0,0 +1,28 @@ +module Xanthous.Game.Draw + ( drawGame + ) where + +import Xanthous.Prelude +import Brick +import Brick.Widgets.Border +import Brick.Widgets.Border.Style + +import Xanthous.Game (GameState(..)) +import Xanthous.Resource (Name(..)) + +drawMessages :: GameState -> Widget Name +drawMessages _ = str "Welcome to Xanthous! It's dangerous out there, why not stay inside?" + +drawMap :: GameState -> Widget Name +drawMap _game + = viewport MapViewport Both + $ vBox mapRows + where + -- TODO + firstRow = [str "@"] <> replicate 79 (str " ") + mapRows = firstRow <> (replicate 20 . hBox . replicate 80 $ str " ") + +drawGame :: GameState -> [Widget Name] +drawGame game = pure . withBorderStyle unicode + $ drawMessages game + <=> border (drawMap game) diff --git a/src/Xanthous/Prelude.hs b/src/Xanthous/Prelude.hs new file mode 100644 index 0000000000..e75c11d7bb --- /dev/null +++ b/src/Xanthous/Prelude.hs @@ -0,0 +1,10 @@ +module Xanthous.Prelude + ( module ClassyPrelude + , Type + , Constraint + , module GHC.TypeLits + ) where + +import ClassyPrelude hiding (return) +import Data.Kind +import GHC.TypeLits hiding (Text) diff --git a/src/Xanthous/Resource.hs b/src/Xanthous/Resource.hs new file mode 100644 index 0000000000..2310a68cc2 --- /dev/null +++ b/src/Xanthous/Resource.hs @@ -0,0 +1,11 @@ +module Xanthous.Resource + ( Name(..) + ) where + +import Xanthous.Prelude + +data Name = MapViewport + -- ^ The main viewport where we display the game content + | MessageBox + -- ^ The box where we display messages to the user + deriving stock (Show, Eq, Ord) diff --git a/test/Spec.hs b/test/Spec.hs new file mode 100644 index 0000000000..18f034f969 --- /dev/null +++ b/test/Spec.hs @@ -0,0 +1,3 @@ +-- | + +module Spec where diff --git a/xanthous.cabal b/xanthous.cabal new file mode 100644 index 0000000000..f4dd1bcafd --- /dev/null +++ b/xanthous.cabal @@ -0,0 +1,113 @@ +cabal-version: 1.12 + +-- This file has been generated from package.yaml by hpack version 0.31.2. +-- +-- see: https://github.com/sol/hpack +-- +-- hash: 82abd26f60a9ec818eed37784bf7d873658bb40772a67205c42977a98a108566 + +name: xanthous +version: 0.1.0.0 +synopsis: A WIP TUI RPG +description: Please see the README on GitHub at +category: Game +homepage: https://github.com/glittershark/xanthous#readme +bug-reports: https://github.com/glittershark/xanthous/issues +author: Griffin Smith +maintainer: root@gws.fyi +copyright: 2019 Griffin Smith +license: GPL-3 +license-file: LICENSE +build-type: Simple +extra-source-files: + README.org + +source-repository head + type: git + location: https://github.com/glittershark/xanthous + +library + exposed-modules: + Main + Xanthous.App + Xanthous.Game + Xanthous.Game.Draw + Xanthous.Prelude + Xanthous.Resource + other-modules: + Paths_xanthous + hs-source-dirs: + src + default-extensions: ConstraintKinds DataKinds DeriveAnyClass DeriveGeneric DerivingStrategies FlexibleContexts FlexibleInstances FunctionalDependencies GADTSyntax GeneralizedNewtypeDeriving KindSignatures LambdaCase NoImplicitPrelude NoStarIsType OverloadedStrings PolyKinds RankNTypes ScopedTypeVariables TypeApplications TypeFamilies TypeOperators + ghc-options: -Wall -threaded + build-depends: + QuickCheck + , ascii-art-to-unicode + , base + , brick + , classy-prelude + , constraints + , containers + , data-default + , deepseq + , lens + , mtl + , vty + default-language: Haskell2010 + +executable xanthous + main-is: Main.hs + other-modules: + Xanthous.App + Xanthous.Game + Xanthous.Game.Draw + Xanthous.Prelude + Xanthous.Resource + Paths_xanthous + hs-source-dirs: + src + default-extensions: ConstraintKinds DataKinds DeriveAnyClass DeriveGeneric DerivingStrategies FlexibleContexts FlexibleInstances FunctionalDependencies GADTSyntax GeneralizedNewtypeDeriving KindSignatures LambdaCase NoImplicitPrelude NoStarIsType OverloadedStrings PolyKinds RankNTypes ScopedTypeVariables TypeApplications TypeFamilies TypeOperators + ghc-options: -Wall -threaded + build-depends: + QuickCheck + , ascii-art-to-unicode + , base + , brick + , classy-prelude + , constraints + , containers + , data-default + , deepseq + , lens + , mtl + , vty + , xanthous + default-language: Haskell2010 + +test-suite test + type: exitcode-stdio-1.0 + main-is: Spec.hs + other-modules: + Paths_xanthous + hs-source-dirs: + test + default-extensions: ConstraintKinds DataKinds DeriveAnyClass DeriveGeneric DerivingStrategies FlexibleContexts FlexibleInstances FunctionalDependencies GADTSyntax GeneralizedNewtypeDeriving KindSignatures LambdaCase NoImplicitPrelude NoStarIsType OverloadedStrings PolyKinds RankNTypes ScopedTypeVariables TypeApplications TypeFamilies TypeOperators + ghc-options: -Wall -threaded -threaded -rtsopts -with-rtsopts=-N + build-depends: + QuickCheck + , ascii-art-to-unicode + , base + , brick + , classy-prelude + , constraints + , containers + , data-default + , deepseq + , lens + , mtl + , tasty + , tasty-hunit + , tasty-quickcheck + , vty + , xanthous + default-language: Haskell2010 diff --git a/xanthous.nix b/xanthous.nix new file mode 100644 index 0000000000..a10ed48305 --- /dev/null +++ b/xanthous.nix @@ -0,0 +1,29 @@ +{ mkDerivation, ascii-art-to-unicode, base, brick, classy-prelude +, constraints, containers, data-default, deepseq, hpack, lens, mtl +, QuickCheck, stdenv, tasty, tasty-hunit, tasty-quickcheck, vty +}: +let + pkgs = import {}; + all-hies = import (fetchTarball "https://github.com/infinisil/all-hies/tarball/master") {}; + hie = all-hies.selection { selector = p: { inherit (p) ghc865; }; }; +in +mkDerivation { + pname = "xanthous"; + version = "0.1.0.0"; + src = ./.; + libraryHaskellDepends = [ + ascii-art-to-unicode base brick classy-prelude constraints + containers data-default deepseq lens mtl QuickCheck vty + ]; + libraryToolDepends = [ hpack ]; + testHaskellDepends = [ + ascii-art-to-unicode base brick classy-prelude constraints + containers data-default deepseq lens mtl QuickCheck tasty + tasty-hunit tasty-quickcheck + ]; + executableSystemDepends = [ hie pkgs.cabal-install ]; + preConfigure = "hpack"; + homepage = "https://github.com/glittershark/xanthous#readme"; + description = "A WIP TUI RPG"; + license = stdenv.lib.licenses.gpl3; +} -- cgit 1.4.1 From 6eba471e2426e7e4e7d5c935e3ce973e13fd6b24 Mon Sep 17 00:00:00 2001 From: Griffin Smith Date: Sat, 31 Aug 2019 13:15:17 -0400 Subject: Use haskellSrc2nix over explicit cabal2nix Use the (undocumented!) helper function haskellSrc2nix over having to explicitly run cabal2nix all the time when rebuilding --- default.nix | 4 ++-- nixpkgs.nix | 9 +++++++++ pkg.nix | 7 +++++++ shell.nix | 6 +++--- xanthous.nix | 29 ----------------------------- 5 files changed, 21 insertions(+), 34 deletions(-) create mode 100644 nixpkgs.nix create mode 100644 pkg.nix delete mode 100644 xanthous.nix diff --git a/default.nix b/default.nix index f73c537abd..7cf9f4beb4 100644 --- a/default.nix +++ b/default.nix @@ -1,8 +1,8 @@ -{ nixpkgs ? import {}, compiler ? "ghc865" }: +{ nixpkgs ? import ./nixpkgs.nix {}, compiler ? "ghc865" }: let inherit (nixpkgs) pkgs; all-hies = import (fetchTarball "https://github.com/infinisil/all-hies/tarball/master") {}; hie = all-hies.selection { selector = p: { inherit (p) ghc865; }; }; - xanthous = pkgs.haskellPackages.callPackage ./xanthous.nix {}; + xanthous = pkgs.haskellPackages.callPackage (import ./pkg.nix { inherit nixpkgs; }) {}; in xanthous // { inherit hie; } diff --git a/nixpkgs.nix b/nixpkgs.nix new file mode 100644 index 0000000000..19bf2c59ce --- /dev/null +++ b/nixpkgs.nix @@ -0,0 +1,9 @@ +let + inherit (import {}) fetchFromGitHub; + nixpkgs = fetchFromGitHub { + owner = "NixOS"; + repo = "nixpkgs-channels"; + rev = "54f385241e6649128ba963c10314942d73245479"; + sha256 = "0bd4v8v4xcdbaiaa59yqprnc6dkb9jv12mb0h5xz7b51687ygh9l"; + }; +in import nixpkgs diff --git a/pkg.nix b/pkg.nix new file mode 100644 index 0000000000..d3b65a64f3 --- /dev/null +++ b/pkg.nix @@ -0,0 +1,7 @@ +{ nixpkgs ? import ./nixpkgs.nix {} }: +let inherit (nixpkgs) pkgs; in +import (pkgs.haskellPackages.haskellSrc2nix { + name = "xanthous"; + src = ./.; + extraCabal2nixOptions = "--hpack"; +}) diff --git a/shell.nix b/shell.nix index aefc492d3d..966ab0bb08 100644 --- a/shell.nix +++ b/shell.nix @@ -1,8 +1,8 @@ -{ nixpkgs ? import {}, compiler ? "ghc865", withHoogle ? true }: +{ nixpkgs ? import ./nixpkgs.nix {}, compiler ? "ghc865", withHoogle ? true }: let inherit (nixpkgs) pkgs; - xan = import ./xanthous.nix; + pkg = import ./pkg.nix { inherit nixpkgs; }; packageSet = ( if compiler == "default" @@ -21,7 +21,7 @@ let else packageSet ); - drv = haskellPackages.callPackage xan {}; + drv = haskellPackages.callPackage pkg {}; inherit (pkgs.haskell.lib) addBuildTools; in diff --git a/xanthous.nix b/xanthous.nix deleted file mode 100644 index a10ed48305..0000000000 --- a/xanthous.nix +++ /dev/null @@ -1,29 +0,0 @@ -{ mkDerivation, ascii-art-to-unicode, base, brick, classy-prelude -, constraints, containers, data-default, deepseq, hpack, lens, mtl -, QuickCheck, stdenv, tasty, tasty-hunit, tasty-quickcheck, vty -}: -let - pkgs = import {}; - all-hies = import (fetchTarball "https://github.com/infinisil/all-hies/tarball/master") {}; - hie = all-hies.selection { selector = p: { inherit (p) ghc865; }; }; -in -mkDerivation { - pname = "xanthous"; - version = "0.1.0.0"; - src = ./.; - libraryHaskellDepends = [ - ascii-art-to-unicode base brick classy-prelude constraints - containers data-default deepseq lens mtl QuickCheck vty - ]; - libraryToolDepends = [ hpack ]; - testHaskellDepends = [ - ascii-art-to-unicode base brick classy-prelude constraints - containers data-default deepseq lens mtl QuickCheck tasty - tasty-hunit tasty-quickcheck - ]; - executableSystemDepends = [ hie pkgs.cabal-install ]; - preConfigure = "hpack"; - homepage = "https://github.com/glittershark/xanthous#readme"; - description = "A WIP TUI RPG"; - license = stdenv.lib.licenses.gpl3; -} -- cgit 1.4.1 From 4ef19aa35a6d63a8d9f7b6a7a11ac82c2a525783 Mon Sep 17 00:00:00 2001 From: Griffin Smith Date: Sat, 31 Aug 2019 13:17:27 -0400 Subject: Add entities, and allow walking around Add support for entities via a port of the EntityMap type, and implement command support starting at basic hjkl. --- package.yaml | 19 +++-- src/Main.hs | 2 +- src/Xanthous/App.hs | 16 +++- src/Xanthous/Command.hs | 20 +++++ src/Xanthous/Data.hs | 118 ++++++++++++++++++++++++++++++ src/Xanthous/Data/EntityMap.hs | 141 ++++++++++++++++++++++++++++++++++++ src/Xanthous/Entities.hs | 64 ++++++++++++++++ src/Xanthous/Entities/Character.hs | 21 ++++++ src/Xanthous/Entities/SomeEntity.hs | 34 +++++++++ src/Xanthous/Game.hs | 67 ++++++++++++++++- src/Xanthous/Game/Draw.hs | 35 ++++++--- src/Xanthous/Orphans.hs | 23 ++++++ src/Xanthous/Prelude.hs | 5 +- src/Xanthous/Resource.hs | 2 + src/Xanthous/Util.hs | 14 ++++ test/Spec.hs | 15 +++- test/Test/Prelude.hs | 18 +++++ test/Xanthous/Data/EntityMapSpec.hs | 26 +++++++ test/Xanthous/DataSpec.hs | 35 +++++++++ test/Xanthous/GameSpec.hs | 30 ++++++++ xanthous.cabal | 44 +++++++++-- 21 files changed, 718 insertions(+), 31 deletions(-) create mode 100644 src/Xanthous/Command.hs create mode 100644 src/Xanthous/Data.hs create mode 100644 src/Xanthous/Data/EntityMap.hs create mode 100644 src/Xanthous/Entities.hs create mode 100644 src/Xanthous/Entities/Character.hs create mode 100644 src/Xanthous/Entities/SomeEntity.hs create mode 100644 src/Xanthous/Orphans.hs create mode 100644 src/Xanthous/Util.hs create mode 100644 test/Test/Prelude.hs create mode 100644 test/Xanthous/Data/EntityMapSpec.hs create mode 100644 test/Xanthous/DataSpec.hs create mode 100644 test/Xanthous/GameSpec.hs diff --git a/package.yaml b/package.yaml index 4a450cfd5d..cc5002d80f 100644 --- a/package.yaml +++ b/package.yaml @@ -15,17 +15,20 @@ category: Game description: Please see the README on GitHub at dependencies: -- base -- lens -- containers -- constraints - QuickCheck +- base +- brick +- checkers - classy-prelude -- mtl +- constraints +- containers - data-default - deepseq -- ascii-art-to-unicode -- brick +- generic-arbitrary +- generic-monoid +- groups +- lens +- mtl - vty default-extensions: @@ -34,6 +37,7 @@ default-extensions: - DeriveAnyClass - DeriveGeneric - DerivingStrategies +- DerivingVia - FlexibleContexts - FlexibleInstances - FunctionalDependencies @@ -77,3 +81,4 @@ tests: - tasty - tasty-hunit - tasty-quickcheck + - lens-properties diff --git a/src/Main.hs b/src/Main.hs index 1cd4e94457..de867067b9 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -12,6 +12,6 @@ ui = str "Hello, world!" main :: IO () main = do app <- makeApp - initialState <- getInitialState + let initialState = getInitialState _ <- defaultMain app initialState pure () diff --git a/src/Xanthous/App.hs b/src/Xanthous/App.hs index 5c0383c38e..bf5ec68abb 100644 --- a/src/Xanthous/App.hs +++ b/src/Xanthous/App.hs @@ -4,10 +4,13 @@ import Xanthous.Prelude import Brick hiding (App) import qualified Brick import Graphics.Vty.Attributes (defAttr) +import Graphics.Vty.Input.Events (Event(EvResize, EvKey)) import Xanthous.Game import Xanthous.Game.Draw (drawGame) import Xanthous.Resource (Name) +import Xanthous.Command +import Xanthous.Data (move) type App = Brick.App GameState () Name @@ -15,7 +18,18 @@ makeApp :: IO App makeApp = pure $ Brick.App { appDraw = drawGame , appChooseCursor = const headMay - , appHandleEvent = resizeOrQuit + , appHandleEvent = handleEvent , appStartEvent = pure , appAttrMap = const $ attrMap defAttr [] } + +handleEvent :: GameState -> BrickEvent Name () -> EventM Name (Next GameState) +handleEvent game (VtyEvent (EvKey k mods)) + | Just command <- commandFromKey k mods + = handleCommand command game +handleEvent game _ = continue game + +handleCommand :: Command -> GameState -> EventM Name (Next GameState) +handleCommand Quit = halt +handleCommand (Move dir) = continue . (characterPosition %~ move dir) +handleCommand _ = undefined diff --git a/src/Xanthous/Command.hs b/src/Xanthous/Command.hs new file mode 100644 index 0000000000..50fe4abb45 --- /dev/null +++ b/src/Xanthous/Command.hs @@ -0,0 +1,20 @@ +module Xanthous.Command where + +import Graphics.Vty.Input (Key(..), Modifier(..)) + +import Xanthous.Prelude hiding (Left, Right, Down) +import Xanthous.Data (Direction(..)) + +data Command + = Quit + | Move Direction + | PickUp + | PreviousMessage + +commandFromKey :: Key -> [Modifier] -> Maybe Command +commandFromKey (KChar 'q') [] = Just Quit +commandFromKey (KChar 'h') [] = Just $ Move Left +commandFromKey (KChar 'j') [] = Just $ Move Down +commandFromKey (KChar 'k') [] = Just $ Move Up +commandFromKey (KChar 'l') [] = Just $ Move Right +commandFromKey _ _ = Nothing diff --git a/src/Xanthous/Data.hs b/src/Xanthous/Data.hs new file mode 100644 index 0000000000..773f1adc91 --- /dev/null +++ b/src/Xanthous/Data.hs @@ -0,0 +1,118 @@ +{-# LANGUAGE DeriveTraversable #-} +{-# LANGUAGE DeriveFoldable #-} +{-# LANGUAGE DeriveFunctor #-} +{-# LANGUAGE TemplateHaskell #-} +-------------------------------------------------------------------------------- +-- | Common data types for Xanthous +-------------------------------------------------------------------------------- +module Xanthous.Data + ( Position(..) + , x + , y + + , Positioned(..) + , position + , positioned + , loc + + -- * + , Direction(..) + , opposite + , move + , asPosition + ) where +-------------------------------------------------------------------------------- +import Xanthous.Prelude hiding (Left, Down, Right) +import Test.QuickCheck (Arbitrary, CoArbitrary, Function) +import Test.QuickCheck.Arbitrary.Generic +import Data.Group +import Brick (Location(Location)) +-------------------------------------------------------------------------------- +import Xanthous.Util (EqEqProp(..), EqProp) +-------------------------------------------------------------------------------- + +data Position where + Position :: { _x :: Int + , _y :: Int + } -> Position + deriving stock (Show, Eq, Generic, Ord) + deriving anyclass (Hashable, CoArbitrary, Function) + deriving EqProp via EqEqProp Position +makeLenses ''Position + +instance Arbitrary Position where + arbitrary = genericArbitrary + shrink = genericShrink + +instance Semigroup Position where + (Position x₁ y₁) <> (Position x₂ y₂) = Position (x₁ + x₂) (y₁ + y₂) + +instance Monoid Position where + mempty = Position 0 0 + +instance Group Position where + invert (Position px py) = Position (-px) (-py) + +data Positioned a where + Positioned :: Position -> a -> Positioned a + deriving stock (Show, Eq, Ord, Functor, Foldable, Traversable, Generic) + deriving anyclass (CoArbitrary, Function) + +instance Arbitrary a => Arbitrary (Positioned a) where + arbitrary = Positioned <$> arbitrary <*> arbitrary + +position :: Lens' (Positioned a) Position +position = lens + (\(Positioned pos _) -> pos) + (\(Positioned _ a) pos -> Positioned pos a) + +positioned :: Lens (Positioned a) (Positioned b) a b +positioned = lens + (\(Positioned _ x') -> x') + (\(Positioned pos _) x' -> Positioned pos x') + +loc :: Iso' Position Location +loc = iso hither yon + where + hither (Position px py) = Location (px, py) + yon (Location (lx, ly)) = Position lx ly + +-------------------------------------------------------------------------------- + +data Direction where + Up :: Direction + Down :: Direction + Left :: Direction + Right :: Direction + UpLeft :: Direction + UpRight :: Direction + DownLeft :: Direction + DownRight :: Direction + deriving stock (Show, Eq, Generic) + +instance Arbitrary Direction where + arbitrary = genericArbitrary + shrink = genericShrink + +opposite :: Direction -> Direction +opposite Up = Down +opposite Down = Up +opposite Left = Right +opposite Right = Left +opposite UpLeft = DownRight +opposite UpRight = DownLeft +opposite DownLeft = UpRight +opposite DownRight = UpLeft + +move :: Direction -> Position -> Position +move Up = y -~ 1 +move Down = y +~ 1 +move Left = x -~ 1 +move Right = x +~ 1 +move UpLeft = move Up . move Left +move UpRight = move Up . move Right +move DownLeft = move Down . move Left +move DownRight = move Down . move Right + +asPosition :: Direction -> Position +asPosition dir = move dir mempty diff --git a/src/Xanthous/Data/EntityMap.hs b/src/Xanthous/Data/EntityMap.hs new file mode 100644 index 0000000000..e3ceb6f651 --- /dev/null +++ b/src/Xanthous/Data/EntityMap.hs @@ -0,0 +1,141 @@ +{-# LANGUAGE DeriveTraversable #-} +{-# LANGUAGE TupleSections #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE DeriveFunctor #-} + +module Xanthous.Data.EntityMap + ( EntityMap + , EntityID + , emptyEntityMap + , insertAt + , insertAtReturningID + , atPosition + , positions + , lookup + , lookupWithPosition + -- , positionedEntities + ) where + +import Data.Monoid (Endo(..)) +import Test.QuickCheck (Arbitrary(..)) +import Test.QuickCheck.Checkers (EqProp) + +import Xanthous.Prelude hiding (lookup) +import Xanthous.Data (Position, Positioned(..), positioned, position) +import Xanthous.Orphans () +import Xanthous.Util (EqEqProp(..)) + +type EntityID = Word32 +type NonNullVector a = NonNull (Vector a) + +data EntityMap a where + EntityMap :: + { _byPosition :: Map Position (NonNullVector EntityID) + , _byID :: HashMap EntityID (Positioned a) + , _lastID :: EntityID + } -> EntityMap a + deriving stock (Functor, Foldable, Traversable) +deriving via (EqEqProp (EntityMap a)) instance Eq a => EqProp (EntityMap a) +makeLenses ''EntityMap + +byIDInvariantError :: forall a. a +byIDInvariantError = error $ "Invariant violation: All EntityIDs in byPosition " + <> "must point to entityIDs in byID" + +instance Eq a => Eq (EntityMap a) where + em₁ == em₂ = em₁ ^. _EntityMap == em₂ ^. _EntityMap + +instance Show a => Show (EntityMap a) where + show em = "_EntityMap # " <> show (em ^. _EntityMap) + +instance Arbitrary a => Arbitrary (EntityMap a) where + arbitrary = review _EntityMap <$> arbitrary + +type instance Index (EntityMap a) = EntityID +type instance IxValue (EntityMap a) = (Positioned a) +instance Ixed (EntityMap a) where ix eid = at eid . traverse + +instance At (EntityMap a) where + at eid = lens (view $ byID . at eid) setter + where + setter :: EntityMap a -> Maybe (Positioned a) -> EntityMap a + setter m Nothing = fromMaybe m $ do + Positioned pos _ <- m ^. byID . at eid + pure $ m + & removeEIDAtPos pos + & byID . at eid .~ Nothing + setter m (Just (Positioned pos e)) = + case lookupWithPosition eid m of + Nothing -> insertAt pos e m + Just (Positioned origPos _) -> m + & removeEIDAtPos origPos + & byID . ix eid . position .~ pos + & byPosition . at pos %~ \case + Nothing -> Just $ ncons eid mempty + Just es -> Just $ eid <| es + removeEIDAtPos pos = + byPosition . at pos %~ (>>= fromNullable . nfilter (/= eid)) + +emptyEntityMap :: EntityMap a +emptyEntityMap = EntityMap mempty mempty 0 + +_EntityMap :: Iso' (EntityMap a) [(Position, a)] +_EntityMap = iso hither yon + where + hither :: EntityMap a -> [(Position, a)] + hither em = do + (pos, eids) <- em ^. byPosition . _Wrapped + eid <- toList eids + ent <- em ^.. byID . at eid . folded . positioned + pure (pos, ent) + yon :: [(Position, a)] -> EntityMap a + yon poses = alaf Endo foldMap (uncurry insertAt) poses emptyEntityMap + +instance Semigroup (EntityMap a) where + em₁ <> em₂ = alaf Endo foldMap (uncurry insertAt) (em₁ ^. _EntityMap) em₂ + +instance Monoid (EntityMap a) where + mempty = emptyEntityMap + + +insertAtReturningID :: forall a. Position -> a -> EntityMap a -> (EntityID, EntityMap a) +insertAtReturningID pos e em = + let (eid, em') = em & lastID <+~ 1 + in em' + & byID . at eid ?~ Positioned pos e + & byPosition . at pos %~ \case + Nothing -> Just $ ncons eid mempty + Just es -> Just $ eid <| es + & (eid, ) + +insertAt :: forall a. Position -> a -> EntityMap a -> EntityMap a +insertAt pos e = snd . insertAtReturningID pos e + +atPosition :: forall a. Position -> Lens' (EntityMap a) (Vector a) +atPosition pos = lens getter setter + where + getter em = + let + eids :: Vector EntityID + eids = maybe mempty toNullable $ em ^. byPosition . at pos + + getEIDAssume :: EntityID -> a + getEIDAssume eid = fromMaybe byIDInvariantError + $ em ^? byID . ix eid . positioned + in getEIDAssume <$> eids + setter em Empty = em & byPosition . at pos .~ Nothing + setter em entities = alaf Endo foldMap (insertAt pos) entities em + +positions :: EntityMap a -> [Position] +positions = toListOf $ byPosition . to keys . folded + +lookupWithPosition :: EntityID -> EntityMap a -> Maybe (Positioned a) +lookupWithPosition eid = view $ byID . at eid + +lookup :: EntityID -> EntityMap a -> Maybe a +lookup eid = fmap (view positioned) . lookupWithPosition eid + +-- unlawful :( +-- positionedEntities :: IndexedTraversal EntityID (EntityMap a) (EntityMap b) (Positioned a) (Positioned b) +-- positionedEntities = byID . itraversed diff --git a/src/Xanthous/Entities.hs b/src/Xanthous/Entities.hs new file mode 100644 index 0000000000..6851a7a5d5 --- /dev/null +++ b/src/Xanthous/Entities.hs @@ -0,0 +1,64 @@ +{-# LANGUAGE UndecidableInstances #-} + +module Xanthous.Entities + ( Draw(..) + , DrawCharacter(..) + , DrawStyledCharacter(..) + , Entity + + , Color(..) + , KnownColor(..) + ) where + +import Xanthous.Prelude +import Brick +import Data.Typeable +import qualified Graphics.Vty.Attributes as Vty +import qualified Graphics.Vty.Image as Vty + +class Draw a where + draw :: a -> Widget n + +newtype DrawCharacter (char :: Symbol) (a :: Type) where + DrawCharacter :: a -> DrawCharacter char a + +instance KnownSymbol char => Draw (DrawCharacter char a) where + draw _ = str $ symbolVal @char Proxy + +-------------------------------------------------------------------------------- + +data Color = Black | Red | Green | Yellow | Blue | Magenta | Cyan | White + +class KnownColor (color :: Color) where + colorVal :: forall proxy. proxy color -> Vty.Color + +instance KnownColor 'Black where colorVal _ = Vty.black +instance KnownColor 'Red where colorVal _ = Vty.red +instance KnownColor 'Green where colorVal _ = Vty.green +instance KnownColor 'Yellow where colorVal _ = Vty.yellow +instance KnownColor 'Blue where colorVal _ = Vty.blue +instance KnownColor 'Magenta where colorVal _ = Vty.magenta +instance KnownColor 'Cyan where colorVal _ = Vty.cyan +instance KnownColor 'White where colorVal _ = Vty.white + +newtype DrawStyledCharacter (fg :: Color) (bg :: Color) (char :: Symbol) (a :: Type) where + DrawStyledCharacter :: a -> DrawStyledCharacter fg bg char a + +instance + ( KnownColor fg + , KnownColor bg + , KnownSymbol char + ) + => Draw (DrawStyledCharacter fg bg char a) where + draw _ = raw $ Vty.string attr $ symbolVal @char Proxy + where attr = Vty.Attr + { Vty.attrStyle = Vty.Default + , Vty.attrForeColor = Vty.SetTo $ colorVal @fg Proxy + , Vty.attrBackColor = Vty.SetTo $ colorVal @bg Proxy + , Vty.attrURL = Vty.Default + } + +-------------------------------------------------------------------------------- + +class (Show a, Eq a, Draw a) => Entity a +instance (Show a, Eq a, Draw a) => Entity a diff --git a/src/Xanthous/Entities/Character.hs b/src/Xanthous/Entities/Character.hs new file mode 100644 index 0000000000..5cf397e822 --- /dev/null +++ b/src/Xanthous/Entities/Character.hs @@ -0,0 +1,21 @@ +module Xanthous.Entities.Character + ( Character(..) + , mkCharacter + ) where + +import Xanthous.Prelude +import Test.QuickCheck + +import Xanthous.Entities + +data Character where + Character :: Character + deriving stock (Show, Eq, Ord, Generic) + deriving anyclass (CoArbitrary, Function) + deriving Draw via (DrawCharacter "@" Character) + +instance Arbitrary Character where + arbitrary = pure Character + +mkCharacter :: Character +mkCharacter = Character diff --git a/src/Xanthous/Entities/SomeEntity.hs b/src/Xanthous/Entities/SomeEntity.hs new file mode 100644 index 0000000000..029247de9b --- /dev/null +++ b/src/Xanthous/Entities/SomeEntity.hs @@ -0,0 +1,34 @@ +{-# LANGUAGE GADTs #-} +module Xanthous.Entities.SomeEntity + ( SomeEntity(..) + , downcastEntity + ) where + +import Xanthous.Prelude +import Test.QuickCheck (Arbitrary(..)) +import qualified Test.QuickCheck.Gen as Gen + +import Xanthous.Entities (Draw(..), Entity) +import Data.Typeable +import Xanthous.Entities.Character + +data SomeEntity where + SomeEntity :: forall a. (Entity a, Typeable a) => a -> SomeEntity + +instance Show SomeEntity where + show (SomeEntity x) = "SomeEntity (" <> show x <> ")" + +instance Eq SomeEntity where + (SomeEntity (a :: ea)) == (SomeEntity (b :: eb)) = case eqT @ea @eb of + Just Refl -> a == b + _ -> False + +instance Arbitrary SomeEntity where + arbitrary = Gen.oneof + [pure $ SomeEntity Character] + +instance Draw SomeEntity where + draw (SomeEntity ent) = draw ent + +downcastEntity :: (Entity a, Typeable a) => SomeEntity -> Maybe a +downcastEntity (SomeEntity e) = cast e diff --git a/src/Xanthous/Game.hs b/src/Xanthous/Game.hs index c88509819c..3ca00afbbd 100644 --- a/src/Xanthous/Game.hs +++ b/src/Xanthous/Game.hs @@ -1,12 +1,73 @@ +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE RecordWildCards #-} module Xanthous.Game ( GameState(..) + , entities , getInitialState + + , positionedCharacter + , character + , characterPosition ) where import Xanthous.Prelude +import Test.QuickCheck.Arbitrary + +import Xanthous.Data.EntityMap (EntityMap, EntityID) +import qualified Xanthous.Data.EntityMap as EntityMap +import Xanthous.Data (Positioned, Position(..), positioned, position) +import Xanthous.Entities +import Xanthous.Entities.SomeEntity +import Xanthous.Entities.Character data GameState = GameState - { } + { _entities :: EntityMap SomeEntity + , _characterEntityID :: EntityID + } + deriving stock (Show, Eq) +makeLenses ''GameState + +instance Arbitrary GameState where + arbitrary = do + ents <- arbitrary + char <- arbitrary + pure $ getInitialState + & entities .~ ents + & positionedCharacter .~ char + +getInitialState :: GameState +getInitialState = + let char = mkCharacter + (_characterEntityID, _entities) + = EntityMap.insertAtReturningID + (Position 0 0) + (SomeEntity char) + mempty + in GameState {..} + +positionedCharacter :: Lens' GameState (Positioned Character) +positionedCharacter = lens getPositionedCharacter setPositionedCharacter + where + setPositionedCharacter :: GameState -> Positioned Character -> GameState + setPositionedCharacter game char + = game + & entities . at (game ^. characterEntityID) + ?~ fmap SomeEntity char + + getPositionedCharacter :: GameState -> Positioned Character + getPositionedCharacter game + = over positioned + ( fromMaybe (error "Invariant error: Character was not a character!") + . downcastEntity + ) + . fromMaybe (error "Invariant error: Character not found!") + $ EntityMap.lookupWithPosition + (game ^. characterEntityID) + (game ^. entities) + + +character :: Lens' GameState Character +character = positionedCharacter . positioned -getInitialState :: IO GameState -getInitialState = pure GameState +characterPosition :: Lens' GameState Position +characterPosition = positionedCharacter . position diff --git a/src/Xanthous/Game/Draw.hs b/src/Xanthous/Game/Draw.hs index 2d793ba27b..79089029ea 100644 --- a/src/Xanthous/Game/Draw.hs +++ b/src/Xanthous/Game/Draw.hs @@ -1,28 +1,45 @@ +{-# LANGUAGE ViewPatterns #-} + module Xanthous.Game.Draw ( drawGame ) where import Xanthous.Prelude -import Brick +import Brick hiding (loc) import Brick.Widgets.Border import Brick.Widgets.Border.Style -import Xanthous.Game (GameState(..)) +import Xanthous.Data (Position(Position), x, y, loc) +import Xanthous.Data.EntityMap +import Xanthous.Entities +import Xanthous.Game (GameState(..), entities, characterPosition) import Xanthous.Resource (Name(..)) drawMessages :: GameState -> Widget Name drawMessages _ = str "Welcome to Xanthous! It's dangerous out there, why not stay inside?" +drawEntities :: (Draw a, Show a) => EntityMap a -> Widget Name +drawEntities em@(fromNullable . positions -> Just entityPositions) + = vBox rows + where + maxPosition = maximum entityPositions + maxY = maxPosition ^. y + maxX = maxPosition ^. x + rows = mkRow <$> [0..maxY] + mkRow rowY = hBox $ renderEntityAt . flip Position rowY <$> [0..maxX] + renderEntityAt pos = maybe (str " ") draw $ em ^? atPosition pos . folded +drawEntities _ = emptyWidget + drawMap :: GameState -> Widget Name -drawMap _game +drawMap game = viewport MapViewport Both - $ vBox mapRows - where - -- TODO - firstRow = [str "@"] <> replicate 79 (str " ") - mapRows = firstRow <> (replicate 20 . hBox . replicate 80 $ str " ") + . showCursor Character (game ^. characterPosition . loc) + . drawEntities + $ game ^. entities drawGame :: GameState -> [Widget Name] -drawGame game = pure . withBorderStyle unicode +drawGame game + = pure + . withBorderStyle unicode $ drawMessages game <=> border (drawMap game) diff --git a/src/Xanthous/Orphans.hs b/src/Xanthous/Orphans.hs new file mode 100644 index 0000000000..232eabf4ef --- /dev/null +++ b/src/Xanthous/Orphans.hs @@ -0,0 +1,23 @@ +{-# LANGUAGE UndecidableInstances, PatternSynonyms #-} +{-# OPTIONS_GHC -Wno-orphans #-} +-- | + +module Xanthous.Orphans () where + +import Xanthous.Prelude + +instance forall s a. + ( Cons s s a a + , MonoFoldable s + ) => Cons (NonNull s) (NonNull s) a a where + _Cons = prism hither yon + where + hither :: (a, NonNull s) -> NonNull s + hither (a, ns) = + let s = toNullable ns + in impureNonNull $ a <| s + + yon :: NonNull s -> Either (NonNull s) (a, NonNull s) + yon ns = case ns ^? _Cons of + Nothing -> Left ns + Just (a, ns') -> Right (a, ns') diff --git a/src/Xanthous/Prelude.hs b/src/Xanthous/Prelude.hs index e75c11d7bb..b769c4fe90 100644 --- a/src/Xanthous/Prelude.hs +++ b/src/Xanthous/Prelude.hs @@ -3,8 +3,11 @@ module Xanthous.Prelude , Type , Constraint , module GHC.TypeLits + , module Control.Lens ) where -import ClassyPrelude hiding (return) +import ClassyPrelude hiding + (return, (<|), unsnoc, uncons, cons, snoc, index, (<.>), Index) import Data.Kind import GHC.TypeLits hiding (Text) +import Control.Lens diff --git a/src/Xanthous/Resource.hs b/src/Xanthous/Resource.hs index 2310a68cc2..aa9020903c 100644 --- a/src/Xanthous/Resource.hs +++ b/src/Xanthous/Resource.hs @@ -6,6 +6,8 @@ import Xanthous.Prelude data Name = MapViewport -- ^ The main viewport where we display the game content + | Character + -- ^ The character | MessageBox -- ^ The box where we display messages to the user deriving stock (Show, Eq, Ord) diff --git a/src/Xanthous/Util.hs b/src/Xanthous/Util.hs new file mode 100644 index 0000000000..377b66cf15 --- /dev/null +++ b/src/Xanthous/Util.hs @@ -0,0 +1,14 @@ +module Xanthous.Util + ( EqEqProp(..) + , EqProp(..) + ) where + +import Xanthous.Prelude + +import Test.QuickCheck.Checkers + +newtype EqEqProp a = EqEqProp a + deriving newtype Eq + +instance Eq a => EqProp (EqEqProp a) where + (=-=) = eq diff --git a/test/Spec.hs b/test/Spec.hs index 18f034f969..c9f3150a74 100644 --- a/test/Spec.hs +++ b/test/Spec.hs @@ -1,3 +1,14 @@ --- | +import Test.Prelude +import qualified Xanthous.DataSpec +import qualified Xanthous.Data.EntityMapSpec +import qualified Xanthous.GameSpec -module Spec where +main :: IO () +main = defaultMain test + +test :: TestTree +test = testGroup "Xanthous" + [ Xanthous.DataSpec.test + , Xanthous.Data.EntityMapSpec.test + , Xanthous.GameSpec.test + ] diff --git a/test/Test/Prelude.hs b/test/Test/Prelude.hs new file mode 100644 index 0000000000..b12e1e895d --- /dev/null +++ b/test/Test/Prelude.hs @@ -0,0 +1,18 @@ +module Test.Prelude + ( module Xanthous.Prelude + , module Test.Tasty + , module Test.Tasty.HUnit + , module Test.Tasty.QuickCheck + , module Test.QuickCheck.Classes + , testBatch + ) where + +import Xanthous.Prelude hiding (assert, elements) +import Test.Tasty +import Test.Tasty.QuickCheck +import Test.Tasty.HUnit +import Test.QuickCheck.Classes +import Test.QuickCheck.Checkers (TestBatch) + +testBatch :: TestBatch -> TestTree +testBatch (name, tests) = testGroup name $ uncurry testProperty <$> tests diff --git a/test/Xanthous/Data/EntityMapSpec.hs b/test/Xanthous/Data/EntityMapSpec.hs new file mode 100644 index 0000000000..c08b568d9e --- /dev/null +++ b/test/Xanthous/Data/EntityMapSpec.hs @@ -0,0 +1,26 @@ +{-# LANGUAGE ApplicativeDo #-} +-------------------------------------------------------------------------------- +module Xanthous.Data.EntityMapSpec where +-------------------------------------------------------------------------------- +import Test.Prelude +-------------------------------------------------------------------------------- +import Xanthous.Data.EntityMap +-------------------------------------------------------------------------------- + +main :: IO () +main = defaultMain test + +test :: TestTree +test = testGroup "Xanthous.Data.EntityMap" + [ testBatch $ monoid @(EntityMap Int) mempty + , testGroup "Eq laws" + [ testProperty "reflexivity" $ \(em :: EntityMap Int) -> + em == em + , testProperty "symmetric" $ \(em₁ :: EntityMap Int) em₂ -> + (em₁ == em₂) == (em₂ == em₁) + , testProperty "transitive" $ \(em₁ :: EntityMap Int) em₂ em₃ -> + if (em₁ == em₂ && em₂ == em₃) + then (em₁ == em₃) + else True + ] + ] diff --git a/test/Xanthous/DataSpec.hs b/test/Xanthous/DataSpec.hs new file mode 100644 index 0000000000..ba060b7ad2 --- /dev/null +++ b/test/Xanthous/DataSpec.hs @@ -0,0 +1,35 @@ +-- | + +module Xanthous.DataSpec where + +import Test.Prelude hiding (Right, Left, Down) +import Xanthous.Data +import Data.Group + +main :: IO () +main = defaultMain test + +test :: TestTree +test = testGroup "Xanthous.Data" + [ testGroup "Position" + [ testBatch $ monoid @Position mempty + , testProperty "group laws" $ \(pos :: Position) -> + pos <> invert pos == mempty && invert pos <> pos == mempty + ] + , testGroup "Direction" + [ testProperty "opposite is involutive" $ \(dir :: Direction) -> + opposite (opposite dir) == dir + , testProperty "opposite provides inverse" $ \dir -> + invert (asPosition dir) == asPosition (opposite dir) + , testGroup "Move" + [ testCase "Up" $ move Up mempty @?= Position 0 (-1) + , testCase "Down" $ move Down mempty @?= Position 0 1 + , testCase "Left" $ move Left mempty @?= Position (-1) 0 + , testCase "Right" $ move Right mempty @?= Position 1 0 + , testCase "UpLeft" $ move UpLeft mempty @?= Position (-1) (-1) + , testCase "UpRight" $ move UpRight mempty @?= Position 1 (-1) + , testCase "DownLeft" $ move DownLeft mempty @?= Position (-1) 1 + , testCase "DownRight" $ move DownRight mempty @?= Position 1 1 + ] + ] + ] diff --git a/test/Xanthous/GameSpec.hs b/test/Xanthous/GameSpec.hs new file mode 100644 index 0000000000..1f1cc2e4d5 --- /dev/null +++ b/test/Xanthous/GameSpec.hs @@ -0,0 +1,30 @@ +module Xanthous.GameSpec where + +import Test.Prelude hiding (Down) +import Xanthous.Game +import Control.Lens.Properties +import Xanthous.Data (move, Direction(Down)) +import Xanthous.Data.EntityMap (atPosition) +import Xanthous.Entities.SomeEntity + +main :: IO () +main = defaultMain test + +test :: TestTree +test = testGroup "Xanthous.Game" + [ testGroup "positionedCharacter" + [ testProperty "lens laws" $ isLens positionedCharacter + , testCase "updates the position of the character" $ do + let initialGame = getInitialState + initialPos = initialGame ^. characterPosition + updatedGame = initialGame & characterPosition %~ move Down + updatedPos = updatedGame ^. characterPosition + updatedPos @?= move Down initialPos + updatedGame ^. entities . atPosition initialPos @?= fromList [] + updatedGame ^. entities . atPosition updatedPos + @?= fromList [SomeEntity $ initialGame ^. character] + ] + , testGroup "characterPosition" + [ testProperty "lens laws" $ isLens characterPosition + ] + ] diff --git a/xanthous.cabal b/xanthous.cabal index f4dd1bcafd..162540b202 100644 --- a/xanthous.cabal +++ b/xanthous.cabal @@ -4,7 +4,7 @@ cabal-version: 1.12 -- -- see: https://github.com/sol/hpack -- --- hash: 82abd26f60a9ec818eed37784bf7d873658bb40772a67205c42977a98a108566 +-- hash: d069cdc1d0657c9b140465b8156b86722d399db49289c8352cccb2a70ab548e0 name: xanthous version: 0.1.0.0 @@ -30,26 +30,37 @@ library exposed-modules: Main Xanthous.App + Xanthous.Command + Xanthous.Data + Xanthous.Data.EntityMap + Xanthous.Entities + Xanthous.Entities.Character + Xanthous.Entities.SomeEntity Xanthous.Game Xanthous.Game.Draw + Xanthous.Orphans Xanthous.Prelude Xanthous.Resource + Xanthous.Util other-modules: Paths_xanthous hs-source-dirs: src - default-extensions: ConstraintKinds DataKinds DeriveAnyClass DeriveGeneric DerivingStrategies FlexibleContexts FlexibleInstances FunctionalDependencies GADTSyntax GeneralizedNewtypeDeriving KindSignatures LambdaCase NoImplicitPrelude NoStarIsType OverloadedStrings PolyKinds RankNTypes ScopedTypeVariables TypeApplications TypeFamilies TypeOperators + default-extensions: ConstraintKinds DataKinds DeriveAnyClass DeriveGeneric DerivingStrategies DerivingVia FlexibleContexts FlexibleInstances FunctionalDependencies GADTSyntax GeneralizedNewtypeDeriving KindSignatures LambdaCase NoImplicitPrelude NoStarIsType OverloadedStrings PolyKinds RankNTypes ScopedTypeVariables TypeApplications TypeFamilies TypeOperators ghc-options: -Wall -threaded build-depends: QuickCheck - , ascii-art-to-unicode , base , brick + , checkers , classy-prelude , constraints , containers , data-default , deepseq + , generic-arbitrary + , generic-monoid + , groups , lens , mtl , vty @@ -59,25 +70,36 @@ executable xanthous main-is: Main.hs other-modules: Xanthous.App + Xanthous.Command + Xanthous.Data + Xanthous.Data.EntityMap + Xanthous.Entities + Xanthous.Entities.Character + Xanthous.Entities.SomeEntity Xanthous.Game Xanthous.Game.Draw + Xanthous.Orphans Xanthous.Prelude Xanthous.Resource + Xanthous.Util Paths_xanthous hs-source-dirs: src - default-extensions: ConstraintKinds DataKinds DeriveAnyClass DeriveGeneric DerivingStrategies FlexibleContexts FlexibleInstances FunctionalDependencies GADTSyntax GeneralizedNewtypeDeriving KindSignatures LambdaCase NoImplicitPrelude NoStarIsType OverloadedStrings PolyKinds RankNTypes ScopedTypeVariables TypeApplications TypeFamilies TypeOperators + default-extensions: ConstraintKinds DataKinds DeriveAnyClass DeriveGeneric DerivingStrategies DerivingVia FlexibleContexts FlexibleInstances FunctionalDependencies GADTSyntax GeneralizedNewtypeDeriving KindSignatures LambdaCase NoImplicitPrelude NoStarIsType OverloadedStrings PolyKinds RankNTypes ScopedTypeVariables TypeApplications TypeFamilies TypeOperators ghc-options: -Wall -threaded build-depends: QuickCheck - , ascii-art-to-unicode , base , brick + , checkers , classy-prelude , constraints , containers , data-default , deepseq + , generic-arbitrary + , generic-monoid + , groups , lens , mtl , vty @@ -88,22 +110,30 @@ test-suite test type: exitcode-stdio-1.0 main-is: Spec.hs other-modules: + Test.Prelude + Xanthous.Data.EntityMapSpec + Xanthous.DataSpec + Xanthous.GameSpec Paths_xanthous hs-source-dirs: test - default-extensions: ConstraintKinds DataKinds DeriveAnyClass DeriveGeneric DerivingStrategies FlexibleContexts FlexibleInstances FunctionalDependencies GADTSyntax GeneralizedNewtypeDeriving KindSignatures LambdaCase NoImplicitPrelude NoStarIsType OverloadedStrings PolyKinds RankNTypes ScopedTypeVariables TypeApplications TypeFamilies TypeOperators + default-extensions: ConstraintKinds DataKinds DeriveAnyClass DeriveGeneric DerivingStrategies DerivingVia FlexibleContexts FlexibleInstances FunctionalDependencies GADTSyntax GeneralizedNewtypeDeriving KindSignatures LambdaCase NoImplicitPrelude NoStarIsType OverloadedStrings PolyKinds RankNTypes ScopedTypeVariables TypeApplications TypeFamilies TypeOperators ghc-options: -Wall -threaded -threaded -rtsopts -with-rtsopts=-N build-depends: QuickCheck - , ascii-art-to-unicode , base , brick + , checkers , classy-prelude , constraints , containers , data-default , deepseq + , generic-arbitrary + , generic-monoid + , groups , lens + , lens-properties , mtl , tasty , tasty-hunit -- cgit 1.4.1 From 2fd3e4c9ad28b77a0d167ceefe879ca80ee1ee04 Mon Sep 17 00:00:00 2001 From: Griffin Smith Date: Sun, 1 Sep 2019 13:54:27 -0400 Subject: Implement messages Implement messages almost the same as in the Rust version, only with YAML instead of TOML this time, and a regular old mustache template instead of something handrolled. Besides that, pretty much everything here is the same. --- package.yaml | 22 ++++- src/Data/Aeson/Generic/DerivingVia.hs | 160 ++++++++++++++++++++++++++++++++++ src/Xanthous/App.hs | 4 +- src/Xanthous/Game.hs | 1 - src/Xanthous/Messages.hs | 87 ++++++++++++++++++ src/Xanthous/Orphans.hs | 135 +++++++++++++++++++++++++++- src/Xanthous/Prelude.hs | 2 + src/Xanthous/Random.hs | 40 +++++++++ src/Xanthous/messages.yaml | 1 + test/Spec.hs | 4 + test/Xanthous/MessageSpec.hs | 53 +++++++++++ test/Xanthous/OrphansSpec.hs | 31 +++++++ xanthous.cabal | 64 +++++++++++--- 13 files changed, 587 insertions(+), 17 deletions(-) create mode 100644 src/Data/Aeson/Generic/DerivingVia.hs create mode 100644 src/Xanthous/Messages.hs create mode 100644 src/Xanthous/Random.hs create mode 100644 src/Xanthous/messages.yaml create mode 100644 test/Xanthous/MessageSpec.hs create mode 100644 test/Xanthous/OrphansSpec.hs diff --git a/package.yaml b/package.yaml index cc5002d80f..2aa6bd9b58 100644 --- a/package.yaml +++ b/package.yaml @@ -15,8 +15,12 @@ category: Game description: Please see the README on GitHub at dependencies: -- QuickCheck - base + +- aeson +- QuickCheck +- quickcheck-text +- quickcheck-instances - brick - checkers - classy-prelude @@ -24,14 +28,24 @@ dependencies: - containers - data-default - deepseq +- file-embed - generic-arbitrary - generic-monoid - groups - lens +- megaparsec +- MonadRandom - mtl +- random +- raw-strings-qq +- reflection +- stache +- tomland - vty +- yaml default-extensions: +- BlockArguments - ConstraintKinds - DataKinds - DeriveAnyClass @@ -51,13 +65,13 @@ default-extensions: - PolyKinds - RankNTypes - ScopedTypeVariables +- TupleSections - TypeApplications - TypeFamilies - TypeOperators ghc-options: - -Wall -- -threaded library: source-dirs: src @@ -67,6 +81,10 @@ executable: main: Main.hs dependencies: - xanthous + ghc-options: + - -threaded + - -rtsopts + - -with-rtsopts=-N tests: test: diff --git a/src/Data/Aeson/Generic/DerivingVia.hs b/src/Data/Aeson/Generic/DerivingVia.hs new file mode 100644 index 0000000000..f387f1decc --- /dev/null +++ b/src/Data/Aeson/Generic/DerivingVia.hs @@ -0,0 +1,160 @@ +{-# LANGUAGE ConstraintKinds, DataKinds, DeriveGeneric, DerivingVia #-} +{-# LANGUAGE ExplicitNamespaces, FlexibleContexts, FlexibleInstances #-} +{-# LANGUAGE GADTs, GeneralizedNewtypeDeriving, MultiParamTypeClasses #-} +{-# LANGUAGE PolyKinds, ScopedTypeVariables, StandaloneDeriving #-} +{-# LANGUAGE TypeApplications, TypeFamilies, TypeInType, TypeOperators #-} +{-# LANGUAGE UndecidableInstances #-} +{-# OPTIONS_GHC -Wall #-} +-- | https://gist.github.com/konn/27c00f784dd883ec2b90eab8bc84a81d +module Data.Aeson.Generic.DerivingVia + ( StrFun(..), Setting(..), SumEncoding'(..), DefaultOptions, WithOptions(..) + , -- Utility type synonyms to save ticks (') before promoted data constructors + type Drop, type CamelTo2, type UserDefined + , type TaggedObj, type UntaggedVal, type ObjWithSingleField, type TwoElemArr + , type FieldLabelModifier + , type ConstructorTagModifier + , type AllNullaryToStringTag + , type OmitNothingFields + , type SumEnc + , type UnwrapUnaryRecords + , type TagSingleConstructors + ) + where + +import Prelude +import Data.Aeson (FromJSON (..), GFromJSON, GToJSON, + ToJSON (..)) +import Data.Aeson (Options (..), Zero, camelTo2, + genericParseJSON) +import Data.Aeson (defaultOptions, genericToJSON) +import qualified Data.Aeson as Aeson +import Data.Kind (Constraint, Type) +import Data.Proxy (Proxy (..)) +import Data.Reflection (Reifies (..)) +import GHC.Generics (Generic, Rep) +import GHC.TypeLits (KnownNat, KnownSymbol, natVal, symbolVal) +import GHC.TypeLits (Nat, Symbol) + +newtype WithOptions options a = WithOptions { runWithOptions :: a } + +data StrFun = Drop Nat + | CamelTo2 Symbol + | forall p. UserDefined p + +type Drop = 'Drop +type CamelTo2 = 'CamelTo2 +type UserDefined = 'UserDefined + +type family Demoted a where + Demoted Symbol = String + Demoted StrFun = String -> String + Demoted [a] = [Demoted a] + Demoted Setting = Options -> Options + Demoted SumEncoding' = Aeson.SumEncoding + Demoted a = a + +data SumEncoding' = TaggedObj {tagFieldName' :: Symbol, contentsFieldName :: Symbol } + | UntaggedVal + | ObjWithSingleField + | TwoElemArr + +type TaggedObj = 'TaggedObj +type UntaggedVal = 'UntaggedVal +type ObjWithSingleField = 'ObjWithSingleField +type TwoElemArr = 'TwoElemArr + +data Setting = FieldLabelModifier [StrFun] + | ConstructorTagModifier [StrFun] + | AllNullaryToStringTag Bool + | OmitNothingFields Bool + | SumEnc SumEncoding' + | UnwrapUnaryRecords Bool + | TagSingleConstructors Bool + +type FieldLabelModifier = 'FieldLabelModifier +type ConstructorTagModifier = 'ConstructorTagModifier +type AllNullaryToStringTag = 'AllNullaryToStringTag +type OmitNothingFields = 'OmitNothingFields +type SumEnc = 'SumEnc +type UnwrapUnaryRecords = 'UnwrapUnaryRecords +type TagSingleConstructors = 'TagSingleConstructors + +class Demotable (a :: k) where + demote :: proxy a -> Demoted k + +type family All (p :: Type -> Constraint) (xs :: [k]) :: Constraint where + All p '[] = () + All p (x ': xs) = (p x, All p xs) + +instance Reifies f (String -> String) => Demotable ('UserDefined f) where + demote _ = reflect @f Proxy + +instance KnownSymbol sym => Demotable sym where + demote = symbolVal + +instance (KnownSymbol s, KnownSymbol t) => Demotable ('TaggedObj s t) where + demote _ = Aeson.TaggedObject (symbolVal @s Proxy) (symbolVal @t Proxy) + +instance Demotable 'UntaggedVal where + demote _ = Aeson.UntaggedValue + +instance Demotable 'ObjWithSingleField where + demote _ = Aeson.ObjectWithSingleField + +instance Demotable 'TwoElemArr where + demote _ = Aeson.TwoElemArray + +instance Demotable xs => Demotable ('FieldLabelModifier xs) where + demote _ o = o { fieldLabelModifier = foldr (.) id (demote (Proxy @xs)) } + +instance Demotable xs => Demotable ('ConstructorTagModifier xs) where + demote _ o = o { constructorTagModifier = foldr (.) id (demote (Proxy @xs)) } + +instance Demotable b => Demotable ('AllNullaryToStringTag b) where + demote _ o = o { allNullaryToStringTag = demote (Proxy @b) } + +instance Demotable b => Demotable ('OmitNothingFields b) where + demote _ o = o { omitNothingFields = demote (Proxy @b) } + +instance Demotable b => Demotable ('UnwrapUnaryRecords b) where + demote _ o = o { unwrapUnaryRecords = demote (Proxy @b) } + +instance Demotable b => Demotable ('TagSingleConstructors b) where + demote _ o = o { tagSingleConstructors = demote (Proxy @b) } + +instance Demotable b => Demotable ('SumEnc b) where + demote _ o = o { sumEncoding = demote (Proxy @b) } + +instance Demotable 'True where + demote _ = True + +instance Demotable 'False where + demote _ = False + +instance KnownNat n => Demotable ('Drop n) where + demote _ = drop (fromIntegral $ natVal (Proxy :: Proxy n)) + +instance KnownSymbol sym => Demotable ('CamelTo2 sym) where + demote _ = camelTo2 $ head $ symbolVal @sym Proxy + +instance {-# OVERLAPPING #-} Demotable ('[] :: [k]) where + demote _ = [] + +instance (Demotable (x :: k), Demotable (xs :: [k])) => Demotable (x ': xs) where + demote _ = demote (Proxy @x) : demote (Proxy @xs) + +type DefaultOptions = ('[] :: [Setting]) + +reflectOptions :: forall xs proxy. Demotable (xs :: [Setting]) => proxy xs -> Options +reflectOptions pxy = foldr (.) id (demote pxy) defaultOptions + +instance (Demotable (options :: [Setting])) => Reifies options Options where + reflect = reflectOptions + +instance (Generic a, GToJSON Zero (Rep a), Reifies (options :: k) Options) + => ToJSON (WithOptions options a) where + toJSON = genericToJSON (reflect (Proxy @options)) . runWithOptions + +instance (Generic a, GFromJSON Zero (Rep a), Reifies (options :: k) Options) + => FromJSON (WithOptions options a) where + parseJSON = fmap WithOptions . genericParseJSON (reflect (Proxy @options)) diff --git a/src/Xanthous/App.hs b/src/Xanthous/App.hs index bf5ec68abb..ae88a746ce 100644 --- a/src/Xanthous/App.hs +++ b/src/Xanthous/App.hs @@ -4,7 +4,7 @@ import Xanthous.Prelude import Brick hiding (App) import qualified Brick import Graphics.Vty.Attributes (defAttr) -import Graphics.Vty.Input.Events (Event(EvResize, EvKey)) +import Graphics.Vty.Input.Events (Event(EvKey)) import Xanthous.Game import Xanthous.Game.Draw (drawGame) @@ -32,4 +32,4 @@ handleEvent game _ = continue game handleCommand :: Command -> GameState -> EventM Name (Next GameState) handleCommand Quit = halt handleCommand (Move dir) = continue . (characterPosition %~ move dir) -handleCommand _ = undefined +handleCommand _ = error "unimplemented" diff --git a/src/Xanthous/Game.hs b/src/Xanthous/Game.hs index 3ca00afbbd..f30f753439 100644 --- a/src/Xanthous/Game.hs +++ b/src/Xanthous/Game.hs @@ -16,7 +16,6 @@ import Test.QuickCheck.Arbitrary import Xanthous.Data.EntityMap (EntityMap, EntityID) import qualified Xanthous.Data.EntityMap as EntityMap import Xanthous.Data (Positioned, Position(..), positioned, position) -import Xanthous.Entities import Xanthous.Entities.SomeEntity import Xanthous.Entities.Character diff --git a/src/Xanthous/Messages.hs b/src/Xanthous/Messages.hs new file mode 100644 index 0000000000..4ff46ba3f5 --- /dev/null +++ b/src/Xanthous/Messages.hs @@ -0,0 +1,87 @@ +{-# LANGUAGE TemplateHaskell #-} +module Xanthous.Messages + ( Message(..) + , resolve + , MessageMap(..) + , lookupMessage + + -- * Game messages + , messages + , message + ) where + +import Xanthous.Prelude +import Data.List.NonEmpty +import Test.QuickCheck hiding (choose) +import Test.QuickCheck.Arbitrary.Generic +import Test.QuickCheck.Instances.UnorderedContainers () +import Text.Mustache +import Data.Aeson (FromJSON, ToJSON) +import Data.Aeson.Generic.DerivingVia +import Data.FileEmbed +import qualified Data.Yaml as Yaml +import Data.Aeson (toJSON) +import Control.Monad.Random.Class (MonadRandom) + +import Xanthous.Random +import Xanthous.Orphans () + +data Message = Single Template | Choice (NonEmpty Template) + deriving stock (Show, Eq, Ord, Generic) + deriving anyclass (CoArbitrary, Function, NFData) + deriving (ToJSON, FromJSON) + via WithOptions '[ SumEnc UntaggedVal ] + Message + +instance Arbitrary Message where + arbitrary = genericArbitrary + shrink = genericShrink + +resolve :: MonadRandom m => Message -> m Template +resolve (Single t) = pure t +resolve (Choice ts) = choose ts + +data MessageMap = Direct Message | Nested (HashMap Text MessageMap) + deriving stock (Show, Eq, Ord, Generic) + deriving anyclass (CoArbitrary, Function, NFData) + deriving (ToJSON, FromJSON) + via WithOptions '[ SumEnc UntaggedVal ] + MessageMap + +instance Arbitrary MessageMap where + arbitrary = frequency [ (10, Direct <$> arbitrary) + , (1, Nested <$> arbitrary) + ] + +lookupMessage :: [Text] -> MessageMap -> Maybe Message +lookupMessage [] (Direct msg) = Just msg +lookupMessage (k:ks) (Nested m) = lookupMessage ks =<< m ^. at k +lookupMessage _ _ = Nothing + +type instance Index MessageMap = [Text] +type instance IxValue MessageMap = Message +instance Ixed MessageMap where + ix [] f (Direct msg) = Direct <$> f msg + ix (k:ks) f (Nested m) = case m ^. at k of + Just m' -> ix ks f m' <&> \m'' -> + Nested $ m & at k ?~ m'' + Nothing -> pure $ Nested m + ix _ _ m = pure m + +-------------------------------------------------------------------------------- + +rawMessages :: ByteString +rawMessages = $(embedFile "src/Xanthous/messages.yaml") + +messages :: MessageMap +messages + = either (error . Yaml.prettyPrintParseException) id + $ Yaml.decodeEither' rawMessages + +message :: (MonadRandom m, ToJSON params) => [Text] -> params -> m Text +message path params = maybe notFound renderMessage $ messages ^? ix path + where + renderMessage msg = do + tpl <- resolve msg + pure . toStrict . renderMustache tpl $ toJSON params + notFound = pure "Message not found" diff --git a/src/Xanthous/Orphans.hs b/src/Xanthous/Orphans.hs index 232eabf4ef..d2e378cd28 100644 --- a/src/Xanthous/Orphans.hs +++ b/src/Xanthous/Orphans.hs @@ -1,10 +1,23 @@ +{-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE ViewPatterns #-} {-# LANGUAGE UndecidableInstances, PatternSynonyms #-} {-# OPTIONS_GHC -Wno-orphans #-} -- | -module Xanthous.Orphans () where +module Xanthous.Orphans + ( ppTemplate + ) where -import Xanthous.Prelude +import Xanthous.Prelude hiding (elements) +import Text.Mustache +import Test.QuickCheck +import Data.Text.Arbitrary () +import Text.Megaparsec (errorBundlePretty) +import Text.Megaparsec.Pos +import Text.Mustache.Type ( showKey ) +import Data.List.NonEmpty (NonEmpty(..)) +import qualified Data.List.NonEmpty as NonEmpty +import Data.Aeson instance forall s a. ( Cons s s a a @@ -21,3 +34,121 @@ instance forall s a. yon ns = case ns ^? _Cons of Nothing -> Left ns Just (a, ns') -> Right (a, ns') + +instance Arbitrary PName where + arbitrary = PName . pack <$> listOf1 (elements ['a'..'z']) + +instance Arbitrary Key where + arbitrary = Key <$> listOf1 arbSafeText + where arbSafeText = pack <$> listOf1 (elements ['a'..'z']) + shrink (Key []) = error "unreachable" + shrink k@(Key [_]) = pure k + shrink (Key (p:ps)) = Key . (p :) <$> shrink ps + +instance Arbitrary Pos where + arbitrary = mkPos . succ . abs <$> arbitrary + shrink (unPos -> 1) = [] + shrink (unPos -> x) = mkPos <$> [x..1] + +instance Arbitrary Node where + arbitrary = sized node + where + node n | n > 0 = oneof $ leaves ++ branches (n `div` 2) + node _ = oneof leaves + branches n = + [ Section <$> arbitrary <*> subnodes n + , InvertedSection <$> arbitrary <*> subnodes n + ] + subnodes = fmap concatTextBlocks . listOf . node + leaves = + [ TextBlock . pack <$> listOf1 (elements ['a'..'z']) + , EscapedVar <$> arbitrary + , UnescapedVar <$> arbitrary + -- TODO fix pretty-printing of mustache partials + -- , Partial <$> arbitrary <*> arbitrary + ] + shrink = genericShrink + +concatTextBlocks :: [Node] -> [Node] +concatTextBlocks [] = [] +concatTextBlocks [x] = [x] +concatTextBlocks (TextBlock txt₁ : TextBlock txt₂ : xs) + = concatTextBlocks $ TextBlock (txt₁ <> txt₂) : concatTextBlocks xs +concatTextBlocks (x : xs) = x : concatTextBlocks xs + +instance Arbitrary Template where + arbitrary = do + template <- concatTextBlocks <$> arbitrary + templateName <- arbitrary + rest <- arbitrary + pure $ Template + { templateActual = templateName + , templateCache = rest & at templateName ?~ template + } + shrink (Template actual cache) = + let Just tpl = cache ^. at actual + in do + cache' <- shrink cache + tpl' <- shrink tpl + actual' <- shrink actual + pure $ Template + { templateActual = actual' + , templateCache = cache' & at actual' ?~ tpl' + } + +instance CoArbitrary Template where + coarbitrary = coarbitrary . ppTemplate + +instance Function Template where + function = functionMap ppTemplate parseTemplatePartial + where + parseTemplatePartial txt + = compileMustacheText "template" txt ^?! _Right + +instance Arbitrary a => Arbitrary (NonEmpty a) where + arbitrary = do + x <- arbitrary + xs <- arbitrary + pure $ x :| xs + +instance CoArbitrary a => CoArbitrary (NonEmpty a) where + coarbitrary = coarbitrary . toList + +instance Function a => Function (NonEmpty a) where + function = functionMap toList NonEmpty.fromList + +ppNode :: Map PName [Node] -> Node -> Text +ppNode _ (TextBlock txt) = txt +ppNode _ (EscapedVar k) = "{{" <> showKey k <> "}}" +ppNode ctx (Section k body) = + let sk = showKey k + in "{{#" <> sk <> "}}" <> foldMap (ppNode ctx) body <> "{{/" <> sk <> "}}" +ppNode _ (UnescapedVar k) = "{{{" <> showKey k <> "}}}" +ppNode ctx (InvertedSection k body) = + let sk = showKey k + in "{{^" <> sk <> "}}" <> foldMap (ppNode ctx) body <> "{{/" <> sk <> "}}" +ppNode _ (Partial n _) = "{{> " <> unPName n <> "}}" + +ppTemplate :: Template -> Text +ppTemplate (Template actual cache) = + case cache ^. at actual of + Nothing -> error "Template not found?" + Just nodes -> foldMap (ppNode cache) nodes + +instance ToJSON Template where + toJSON = String . ppTemplate + +instance FromJSON Template where + parseJSON + = withText "Template" + $ either (fail . errorBundlePretty) pure + . compileMustacheText "template" + +instance CoArbitrary Text where + coarbitrary = coarbitrary . unpack + +instance Function Text where + function = functionMap unpack pack + +deriving anyclass instance NFData Node +deriving anyclass instance NFData Template diff --git a/src/Xanthous/Prelude.hs b/src/Xanthous/Prelude.hs index b769c4fe90..2097080975 100644 --- a/src/Xanthous/Prelude.hs +++ b/src/Xanthous/Prelude.hs @@ -4,6 +4,7 @@ module Xanthous.Prelude , Constraint , module GHC.TypeLits , module Control.Lens + , module Data.Void ) where import ClassyPrelude hiding @@ -11,3 +12,4 @@ import ClassyPrelude hiding import Data.Kind import GHC.TypeLits hiding (Text) import Control.Lens +import Data.Void diff --git a/src/Xanthous/Random.hs b/src/Xanthous/Random.hs new file mode 100644 index 0000000000..a3a1124f27 --- /dev/null +++ b/src/Xanthous/Random.hs @@ -0,0 +1,40 @@ +{-# LANGUAGE TupleSections #-} +{-# LANGUAGE UndecidableInstances #-} + +module Xanthous.Random + ( Choose(..) + , ChooseElement(..) + ) where + +import Xanthous.Prelude +import Data.List.NonEmpty (NonEmpty) +import System.Random +import Control.Monad.Random.Class (MonadRandom(getRandomR)) + +class Choose a where + type RandomResult a + choose :: MonadRandom m => a -> m (RandomResult a) + +newtype ChooseElement a = ChooseElement a + +instance MonoFoldable a => Choose (ChooseElement a) where + type RandomResult (ChooseElement a) = Maybe (Element a) + choose (ChooseElement xs) = do + chosenIdx <- getRandomR (0, olength xs - 1) + let pick _ (Just x) = Just x + pick (x, i) Nothing + | i == chosenIdx = Just x + | otherwise = Nothing + pure $ ofoldr pick Nothing $ zip (toList xs) [0..] + +instance MonoFoldable a => Choose (NonNull a) where + type RandomResult (NonNull a) = Element a + choose + = fmap (fromMaybe (error "unreachable")) -- why not lol + . choose + . ChooseElement + . toNullable + +instance Choose (NonEmpty a) where + type RandomResult (NonEmpty a) = a + choose = choose . fromNonEmpty @[_] diff --git a/src/Xanthous/messages.yaml b/src/Xanthous/messages.yaml new file mode 100644 index 0000000000..d383cf6196 --- /dev/null +++ b/src/Xanthous/messages.yaml @@ -0,0 +1 @@ +welcome: Welcome to Xanthous! It's dangerous out there, why not stay inside? diff --git a/test/Spec.hs b/test/Spec.hs index c9f3150a74..6f955aa696 100644 --- a/test/Spec.hs +++ b/test/Spec.hs @@ -2,6 +2,8 @@ import Test.Prelude import qualified Xanthous.DataSpec import qualified Xanthous.Data.EntityMapSpec import qualified Xanthous.GameSpec +import qualified Xanthous.MessageSpec +import qualified Xanthous.OrphansSpec main :: IO () main = defaultMain test @@ -11,4 +13,6 @@ test = testGroup "Xanthous" [ Xanthous.DataSpec.test , Xanthous.Data.EntityMapSpec.test , Xanthous.GameSpec.test + , Xanthous.MessageSpec.test + , Xanthous.OrphansSpec.test ] diff --git a/test/Xanthous/MessageSpec.hs b/test/Xanthous/MessageSpec.hs new file mode 100644 index 0000000000..b681e537ef --- /dev/null +++ b/test/Xanthous/MessageSpec.hs @@ -0,0 +1,53 @@ +{-# LANGUAGE OverloadedLists #-} +module Xanthous.MessageSpec ( main, test ) where + +import Test.Prelude +import Xanthous.Messages +import Data.Aeson +import Text.Mustache +import Control.Lens.Properties + +main :: IO () +main = defaultMain test + +test :: TestTree +test = testGroup "Xanthous.Messages" + [ testGroup "Message" + [ testGroup "JSON decoding" + [ testCase "Single" + $ decode "\"Test Single Template\"" + @?= Just (Single + $ compileMustacheText "template" "Test Single Template" + ^?! _Right) + , testCase "Choice" + $ decode "[\"Choice 1\", \"Choice 2\"]" + @?= Just + (Choice + [ compileMustacheText "template" "Choice 1" ^?! _Right + , compileMustacheText "template" "Choice 2" ^?! _Right + ]) + ] + ] + , localOption (QuickCheckTests 50) + . localOption (QuickCheckMaxSize 10) + $ testGroup "MessageMap" + [ testGroup "instance Ixed" + [ testProperty "traversal laws" $ \k -> + isTraversal $ ix @MessageMap k + , testCase "preview when exists" $ + let + Right tpl = compileMustacheText "foo" "bar" + msg = Single tpl + mm = Nested $ [("foo", Direct msg)] + in mm ^? ix ["foo"] @?= Just msg + ] + , testGroup "lookupMessage" + [ testProperty "is equivalent to preview ix" $ \msgMap path -> + lookupMessage path msgMap === msgMap ^? ix path + ] + ] + + , testGroup "Messages" + [ testCase "are all valid" $ messages `deepseq` pure () + ] + ] diff --git a/test/Xanthous/OrphansSpec.hs b/test/Xanthous/OrphansSpec.hs new file mode 100644 index 0000000000..3fe79ee563 --- /dev/null +++ b/test/Xanthous/OrphansSpec.hs @@ -0,0 +1,31 @@ +{-# LANGUAGE BlockArguments #-} +module Xanthous.OrphansSpec where + +import Test.Prelude +import Xanthous.Orphans +import Text.Mustache +import Text.Megaparsec (errorBundlePretty) + +import Xanthous.Orphans () + +main :: IO () +main = defaultMain test + +test :: TestTree +test = testGroup "Xanthous.Orphans" + [ localOption (QuickCheckTests 50) + . localOption (QuickCheckMaxSize 10) + $ testGroup "Template" + [ testProperty "ppTemplate / compileMustacheText " \tpl -> + let src = ppTemplate tpl + res :: Either String Template + res = over _Left errorBundlePretty + $ compileMustacheText (templateActual tpl) src + expected = templateCache tpl ^?! at (templateActual tpl) + in + counterexample (unpack src) + $ Right expected === do + (Template actual cache) <- res + maybe (Left "Template not found") Right $ cache ^? at actual + ] + ] diff --git a/xanthous.cabal b/xanthous.cabal index 162540b202..4fe938b40b 100644 --- a/xanthous.cabal +++ b/xanthous.cabal @@ -4,7 +4,7 @@ cabal-version: 1.12 -- -- see: https://github.com/sol/hpack -- --- hash: d069cdc1d0657c9b140465b8156b86722d399db49289c8352cccb2a70ab548e0 +-- hash: d86e44c1f3fe890c699f9af19ae10b013973d1cb6e79cc403d6e1c35a74c99c1 name: xanthous version: 0.1.0.0 @@ -28,6 +28,7 @@ source-repository head library exposed-modules: + Data.Aeson.Generic.DerivingVia Main Xanthous.App Xanthous.Command @@ -38,18 +39,22 @@ library Xanthous.Entities.SomeEntity Xanthous.Game Xanthous.Game.Draw + Xanthous.Messages Xanthous.Orphans Xanthous.Prelude + Xanthous.Random Xanthous.Resource Xanthous.Util other-modules: Paths_xanthous hs-source-dirs: src - default-extensions: ConstraintKinds DataKinds DeriveAnyClass DeriveGeneric DerivingStrategies DerivingVia FlexibleContexts FlexibleInstances FunctionalDependencies GADTSyntax GeneralizedNewtypeDeriving KindSignatures LambdaCase NoImplicitPrelude NoStarIsType OverloadedStrings PolyKinds RankNTypes ScopedTypeVariables TypeApplications TypeFamilies TypeOperators - ghc-options: -Wall -threaded + default-extensions: BlockArguments ConstraintKinds DataKinds DeriveAnyClass DeriveGeneric DerivingStrategies DerivingVia FlexibleContexts FlexibleInstances FunctionalDependencies GADTSyntax GeneralizedNewtypeDeriving KindSignatures LambdaCase NoImplicitPrelude NoStarIsType OverloadedStrings PolyKinds RankNTypes ScopedTypeVariables TupleSections TypeApplications TypeFamilies TypeOperators + ghc-options: -Wall build-depends: - QuickCheck + MonadRandom + , QuickCheck + , aeson , base , brick , checkers @@ -58,17 +63,28 @@ library , containers , data-default , deepseq + , file-embed , generic-arbitrary , generic-monoid , groups , lens + , megaparsec , mtl + , quickcheck-instances + , quickcheck-text + , random + , raw-strings-qq + , reflection + , stache + , tomland , vty + , yaml default-language: Haskell2010 executable xanthous main-is: Main.hs other-modules: + Data.Aeson.Generic.DerivingVia Xanthous.App Xanthous.Command Xanthous.Data @@ -78,17 +94,21 @@ executable xanthous Xanthous.Entities.SomeEntity Xanthous.Game Xanthous.Game.Draw + Xanthous.Messages Xanthous.Orphans Xanthous.Prelude + Xanthous.Random Xanthous.Resource Xanthous.Util Paths_xanthous hs-source-dirs: src - default-extensions: ConstraintKinds DataKinds DeriveAnyClass DeriveGeneric DerivingStrategies DerivingVia FlexibleContexts FlexibleInstances FunctionalDependencies GADTSyntax GeneralizedNewtypeDeriving KindSignatures LambdaCase NoImplicitPrelude NoStarIsType OverloadedStrings PolyKinds RankNTypes ScopedTypeVariables TypeApplications TypeFamilies TypeOperators - ghc-options: -Wall -threaded + default-extensions: BlockArguments ConstraintKinds DataKinds DeriveAnyClass DeriveGeneric DerivingStrategies DerivingVia FlexibleContexts FlexibleInstances FunctionalDependencies GADTSyntax GeneralizedNewtypeDeriving KindSignatures LambdaCase NoImplicitPrelude NoStarIsType OverloadedStrings PolyKinds RankNTypes ScopedTypeVariables TupleSections TypeApplications TypeFamilies TypeOperators + ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N build-depends: - QuickCheck + MonadRandom + , QuickCheck + , aeson , base , brick , checkers @@ -97,13 +117,23 @@ executable xanthous , containers , data-default , deepseq + , file-embed , generic-arbitrary , generic-monoid , groups , lens + , megaparsec , mtl + , quickcheck-instances + , quickcheck-text + , random + , raw-strings-qq + , reflection + , stache + , tomland , vty , xanthous + , yaml default-language: Haskell2010 test-suite test @@ -114,13 +144,17 @@ test-suite test Xanthous.Data.EntityMapSpec Xanthous.DataSpec Xanthous.GameSpec + Xanthous.MessageSpec + Xanthous.OrphansSpec Paths_xanthous hs-source-dirs: test - default-extensions: ConstraintKinds DataKinds DeriveAnyClass DeriveGeneric DerivingStrategies DerivingVia FlexibleContexts FlexibleInstances FunctionalDependencies GADTSyntax GeneralizedNewtypeDeriving KindSignatures LambdaCase NoImplicitPrelude NoStarIsType OverloadedStrings PolyKinds RankNTypes ScopedTypeVariables TypeApplications TypeFamilies TypeOperators - ghc-options: -Wall -threaded -threaded -rtsopts -with-rtsopts=-N + default-extensions: BlockArguments ConstraintKinds DataKinds DeriveAnyClass DeriveGeneric DerivingStrategies DerivingVia FlexibleContexts FlexibleInstances FunctionalDependencies GADTSyntax GeneralizedNewtypeDeriving KindSignatures LambdaCase NoImplicitPrelude NoStarIsType OverloadedStrings PolyKinds RankNTypes ScopedTypeVariables TupleSections TypeApplications TypeFamilies TypeOperators + ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N build-depends: - QuickCheck + MonadRandom + , QuickCheck + , aeson , base , brick , checkers @@ -129,15 +163,25 @@ test-suite test , containers , data-default , deepseq + , file-embed , generic-arbitrary , generic-monoid , groups , lens , lens-properties + , megaparsec , mtl + , quickcheck-instances + , quickcheck-text + , random + , raw-strings-qq + , reflection + , stache , tasty , tasty-hunit , tasty-quickcheck + , tomland , vty , xanthous + , yaml default-language: Haskell2010 -- cgit 1.4.1 From adb3b74c0c3a3bffa0d47f52036fde3623f859f7 Mon Sep 17 00:00:00 2001 From: Griffin Smith Date: Sun, 1 Sep 2019 16:21:45 -0400 Subject: Link up messages to the overall game Add a "say" function for saying messages within an app monad to the user, and link everything up to display them and track their history --- src/Main.hs | 2 +- src/Xanthous/App.hs | 29 +++++++++++++------- src/Xanthous/Game.hs | 68 ++++++++++++++++++++++++++++++++++++----------- src/Xanthous/Game/Draw.hs | 18 ++++++++++--- src/Xanthous/Messages.hs | 12 ++++----- src/Xanthous/Monad.hs | 58 ++++++++++++++++++++++++++++++++++++++++ src/Xanthous/Prelude.hs | 2 +- src/Xanthous/Random.hs | 1 - xanthous.cabal | 4 ++- 9 files changed, 155 insertions(+), 39 deletions(-) create mode 100644 src/Xanthous/Monad.hs diff --git a/src/Main.hs b/src/Main.hs index de867067b9..1cd4e94457 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -12,6 +12,6 @@ ui = str "Hello, world!" main :: IO () main = do app <- makeApp - let initialState = getInitialState + initialState <- getInitialState _ <- defaultMain app initialState pure () diff --git a/src/Xanthous/App.hs b/src/Xanthous/App.hs index ae88a746ce..c543ad468f 100644 --- a/src/Xanthous/App.hs +++ b/src/Xanthous/App.hs @@ -1,35 +1,46 @@ module Xanthous.App (makeApp) where import Xanthous.Prelude -import Brick hiding (App) +import Brick hiding (App, halt, continue) import qualified Brick import Graphics.Vty.Attributes (defAttr) import Graphics.Vty.Input.Events (Event(EvKey)) +import Control.Monad.State (get) import Xanthous.Game import Xanthous.Game.Draw (drawGame) import Xanthous.Resource (Name) import Xanthous.Command import Xanthous.Data (move) +import Xanthous.Monad type App = Brick.App GameState () Name +type AppM a = AppT (EventM Name) a makeApp :: IO App makeApp = pure $ Brick.App { appDraw = drawGame , appChooseCursor = const headMay - , appHandleEvent = handleEvent - , appStartEvent = pure + , appHandleEvent = \state event -> runAppM (handleEvent event) state + , appStartEvent = runAppM $ startEvent >> get , appAttrMap = const $ attrMap defAttr [] } -handleEvent :: GameState -> BrickEvent Name () -> EventM Name (Next GameState) -handleEvent game (VtyEvent (EvKey k mods)) +runAppM :: AppM a -> GameState -> EventM Name a +runAppM appm = fmap fst . runAppT appm + +startEvent :: AppM () +startEvent = say ["welcome"] + +handleEvent :: BrickEvent Name () -> AppM (Next GameState) +handleEvent (VtyEvent (EvKey k mods)) | Just command <- commandFromKey k mods - = handleCommand command game -handleEvent game _ = continue game + = handleCommand command +handleEvent _ = continue -handleCommand :: Command -> GameState -> EventM Name (Next GameState) +handleCommand :: Command -> AppM (Next GameState) handleCommand Quit = halt -handleCommand (Move dir) = continue . (characterPosition %~ move dir) +handleCommand (Move dir) = do + characterPosition %= move dir + continue handleCommand _ = error "unimplemented" diff --git a/src/Xanthous/Game.hs b/src/Xanthous/Game.hs index f30f753439..39066c23b6 100644 --- a/src/Xanthous/Game.hs +++ b/src/Xanthous/Game.hs @@ -3,46 +3,82 @@ module Xanthous.Game ( GameState(..) , entities + , messageHistory + , randomGen + , getInitialState , positionedCharacter , character , characterPosition + + , MessageHistory(..) + , pushMessage ) where -import Xanthous.Prelude -import Test.QuickCheck.Arbitrary +import Data.List.NonEmpty ( NonEmpty((:|))) +import qualified Data.List.NonEmpty as NonEmpty +import System.Random +import Test.QuickCheck +import Test.QuickCheck.Arbitrary.Generic +import Xanthous.Prelude -import Xanthous.Data.EntityMap (EntityMap, EntityID) +import Xanthous.Data.EntityMap (EntityMap, EntityID) import qualified Xanthous.Data.EntityMap as EntityMap -import Xanthous.Data (Positioned, Position(..), positioned, position) -import Xanthous.Entities.SomeEntity -import Xanthous.Entities.Character +import Xanthous.Data (Positioned, Position(..), positioned, position) +import Xanthous.Entities.SomeEntity +import Xanthous.Entities.Character +import Xanthous.Orphans () + +data MessageHistory + = NoMessageHistory + | MessageHistory (NonEmpty Text) Bool + deriving stock (Show, Eq, Generic) + deriving anyclass (NFData, CoArbitrary, Function) + +instance Arbitrary MessageHistory where + arbitrary = genericArbitrary + +pushMessage :: Text -> MessageHistory -> MessageHistory +pushMessage msg NoMessageHistory = MessageHistory (msg :| []) True +pushMessage msg (MessageHistory msgs _) = MessageHistory (NonEmpty.cons msg msgs) True data GameState = GameState { _entities :: EntityMap SomeEntity , _characterEntityID :: EntityID + , _messageHistory :: MessageHistory + , _randomGen :: StdGen } - deriving stock (Show, Eq) + deriving stock (Show) makeLenses ''GameState +instance Eq GameState where + (GameState es₁ ceid₁ mh₁ _) == (GameState es₂ ceid₂ mh₂ _) + = es₁ == es₂ + && ceid₁ == ceid₂ + && mh₁ == mh₂ + instance Arbitrary GameState where arbitrary = do - ents <- arbitrary - char <- arbitrary - pure $ getInitialState - & entities .~ ents - & positionedCharacter .~ char - -getInitialState :: GameState -getInitialState = + char <- arbitrary @Character + charPos <- arbitrary + _messageHistory <- arbitrary + (_characterEntityID, _entities) <- arbitrary <&> + EntityMap.insertAtReturningID charPos (SomeEntity char) + _randomGen <- mkStdGen <$> arbitrary + pure $ GameState {..} + +getInitialState :: IO GameState +getInitialState = do + _randomGen <- getStdGen let char = mkCharacter (_characterEntityID, _entities) = EntityMap.insertAtReturningID (Position 0 0) (SomeEntity char) mempty - in GameState {..} + _messageHistory = NoMessageHistory + pure GameState {..} positionedCharacter :: Lens' GameState (Positioned Character) positionedCharacter = lens getPositionedCharacter setPositionedCharacter diff --git a/src/Xanthous/Game/Draw.hs b/src/Xanthous/Game/Draw.hs index 79089029ea..5a2f773c1b 100644 --- a/src/Xanthous/Game/Draw.hs +++ b/src/Xanthous/Game/Draw.hs @@ -8,15 +8,25 @@ import Xanthous.Prelude import Brick hiding (loc) import Brick.Widgets.Border import Brick.Widgets.Border.Style +import Data.List.NonEmpty(NonEmpty((:|))) import Xanthous.Data (Position(Position), x, y, loc) import Xanthous.Data.EntityMap import Xanthous.Entities -import Xanthous.Game (GameState(..), entities, characterPosition) +import Xanthous.Game + ( GameState(..) + , entities + , characterPosition + , MessageHistory(..) + , messageHistory + ) import Xanthous.Resource (Name(..)) +import Xanthous.Orphans () -drawMessages :: GameState -> Widget Name -drawMessages _ = str "Welcome to Xanthous! It's dangerous out there, why not stay inside?" +drawMessages :: MessageHistory -> Widget Name +drawMessages NoMessageHistory = emptyWidget +drawMessages (MessageHistory _ False) = emptyWidget +drawMessages (MessageHistory (lastMessage :| _) True) = str $ unpack lastMessage drawEntities :: (Draw a, Show a) => EntityMap a -> Widget Name drawEntities em@(fromNullable . positions -> Just entityPositions) @@ -41,5 +51,5 @@ drawGame :: GameState -> [Widget Name] drawGame game = pure . withBorderStyle unicode - $ drawMessages game + $ drawMessages (game ^. messageHistory) <=> border (drawMap game) diff --git a/src/Xanthous/Messages.hs b/src/Xanthous/Messages.hs index 4ff46ba3f5..b1aeeb635c 100644 --- a/src/Xanthous/Messages.hs +++ b/src/Xanthous/Messages.hs @@ -9,19 +9,19 @@ module Xanthous.Messages , messages , message ) where - +-------------------------------------------------------------------------------- import Xanthous.Prelude + +import Control.Monad.Random.Class (MonadRandom) +import Data.Aeson (FromJSON, ToJSON, toJSON) +import Data.Aeson.Generic.DerivingVia +import Data.FileEmbed import Data.List.NonEmpty import Test.QuickCheck hiding (choose) import Test.QuickCheck.Arbitrary.Generic import Test.QuickCheck.Instances.UnorderedContainers () import Text.Mustache -import Data.Aeson (FromJSON, ToJSON) -import Data.Aeson.Generic.DerivingVia -import Data.FileEmbed import qualified Data.Yaml as Yaml -import Data.Aeson (toJSON) -import Control.Monad.Random.Class (MonadRandom) import Xanthous.Random import Xanthous.Orphans () diff --git a/src/Xanthous/Monad.hs b/src/Xanthous/Monad.hs new file mode 100644 index 0000000000..fb790d5f9c --- /dev/null +++ b/src/Xanthous/Monad.hs @@ -0,0 +1,58 @@ +module Xanthous.Monad + ( AppT(..) + , runAppT + , continue + , halt + , say + ) where + +import Xanthous.Prelude +import Control.Monad.Random +import Control.Monad.State +import qualified Brick +import Brick (EventM, Next) +import Data.Aeson + +import Xanthous.Game +import Xanthous.Messages (message) + +newtype AppT m a + = AppT { unAppT :: StateT GameState m a } + deriving ( Functor + , Applicative + , Monad + , MonadState GameState + ) + via (StateT GameState m) + +instance MonadTrans AppT where + lift = AppT . lift + +instance (Monad m) => MonadRandom (AppT m) where + getRandomR rng = randomGen %%= randomR rng + getRandom = randomGen %%= random + getRandomRs rng = uses randomGen $ randomRs rng + getRandoms = uses randomGen randoms + +runAppT :: Monad m => AppT m a -> GameState -> m (a, GameState) +runAppT appt initialState = flip runStateT initialState . unAppT $ appt + +halt :: AppT (EventM n) (Next GameState) +halt = lift . Brick.halt =<< get + +continue :: AppT (EventM n) (Next GameState) +continue = lift . Brick.continue =<< get + +-- say :: [Text] -> AppT m () +-- say :: [Text] -> params -> AppT m () + +class SayR a where + say :: [Text] -> a + +instance Monad m => SayR (AppT m ()) where + say msgPath = say msgPath $ object [] + +instance (Monad m, ToJSON params) => SayR (params -> AppT m ()) where + say msgPath params = do + msg <- message msgPath params + messageHistory %= pushMessage msg diff --git a/src/Xanthous/Prelude.hs b/src/Xanthous/Prelude.hs index 2097080975..756642440b 100644 --- a/src/Xanthous/Prelude.hs +++ b/src/Xanthous/Prelude.hs @@ -8,7 +8,7 @@ module Xanthous.Prelude ) where import ClassyPrelude hiding - (return, (<|), unsnoc, uncons, cons, snoc, index, (<.>), Index) + (return, (<|), unsnoc, uncons, cons, snoc, index, (<.>), Index, say) import Data.Kind import GHC.TypeLits hiding (Text) import Control.Lens diff --git a/src/Xanthous/Random.hs b/src/Xanthous/Random.hs index a3a1124f27..33ada54cf1 100644 --- a/src/Xanthous/Random.hs +++ b/src/Xanthous/Random.hs @@ -8,7 +8,6 @@ module Xanthous.Random import Xanthous.Prelude import Data.List.NonEmpty (NonEmpty) -import System.Random import Control.Monad.Random.Class (MonadRandom(getRandomR)) class Choose a where diff --git a/xanthous.cabal b/xanthous.cabal index 4fe938b40b..8c6fe406ae 100644 --- a/xanthous.cabal +++ b/xanthous.cabal @@ -4,7 +4,7 @@ cabal-version: 1.12 -- -- see: https://github.com/sol/hpack -- --- hash: d86e44c1f3fe890c699f9af19ae10b013973d1cb6e79cc403d6e1c35a74c99c1 +-- hash: 5d750bf0bb5c6d278928f6c9606427754a444344fd769f50c02b776dedf0e771 name: xanthous version: 0.1.0.0 @@ -40,6 +40,7 @@ library Xanthous.Game Xanthous.Game.Draw Xanthous.Messages + Xanthous.Monad Xanthous.Orphans Xanthous.Prelude Xanthous.Random @@ -95,6 +96,7 @@ executable xanthous Xanthous.Game Xanthous.Game.Draw Xanthous.Messages + Xanthous.Monad Xanthous.Orphans Xanthous.Prelude Xanthous.Random -- cgit 1.4.1 From 18551cdf30c0a13bce40fae9be829e5318612e71 Mon Sep 17 00:00:00 2001 From: Griffin Smith Date: Mon, 2 Sep 2019 10:36:15 -0400 Subject: Add a previous message command Add a "previous message" command, triggered via ctrl+p. I attempted here to get the message area to still take up a row of space post-hiding the message, but failed - should revisit that at some point --- src/Xanthous/App.hs | 8 ++++++-- src/Xanthous/Command.hs | 5 ++++- src/Xanthous/Game.hs | 12 ++++++++++++ src/Xanthous/Game/Draw.hs | 8 +++++++- test/Xanthous/GameSpec.hs | 4 ++-- 5 files changed, 31 insertions(+), 6 deletions(-) diff --git a/src/Xanthous/App.hs b/src/Xanthous/App.hs index c543ad468f..3561d35a3b 100644 --- a/src/Xanthous/App.hs +++ b/src/Xanthous/App.hs @@ -35,7 +35,8 @@ startEvent = say ["welcome"] handleEvent :: BrickEvent Name () -> AppM (Next GameState) handleEvent (VtyEvent (EvKey k mods)) | Just command <- commandFromKey k mods - = handleCommand command + = do messageHistory %= hideMessage + handleCommand command handleEvent _ = continue handleCommand :: Command -> AppM (Next GameState) @@ -43,4 +44,7 @@ handleCommand Quit = halt handleCommand (Move dir) = do characterPosition %= move dir continue -handleCommand _ = error "unimplemented" + +handleCommand PreviousMessage = do + messageHistory %= popMessage + continue diff --git a/src/Xanthous/Command.hs b/src/Xanthous/Command.hs index 50fe4abb45..10fa552b34 100644 --- a/src/Xanthous/Command.hs +++ b/src/Xanthous/Command.hs @@ -8,8 +8,8 @@ import Xanthous.Data (Direction(..)) data Command = Quit | Move Direction - | PickUp | PreviousMessage + -- | PickUp commandFromKey :: Key -> [Modifier] -> Maybe Command commandFromKey (KChar 'q') [] = Just Quit @@ -17,4 +17,7 @@ commandFromKey (KChar 'h') [] = Just $ Move Left commandFromKey (KChar 'j') [] = Just $ Move Down commandFromKey (KChar 'k') [] = Just $ Move Up commandFromKey (KChar 'l') [] = Just $ Move Right + +commandFromKey (KChar 'p') [MCtrl] = Just PreviousMessage + commandFromKey _ _ = Nothing diff --git a/src/Xanthous/Game.hs b/src/Xanthous/Game.hs index 39066c23b6..dffd0a9c6a 100644 --- a/src/Xanthous/Game.hs +++ b/src/Xanthous/Game.hs @@ -14,6 +14,8 @@ module Xanthous.Game , MessageHistory(..) , pushMessage + , popMessage + , hideMessage ) where import Data.List.NonEmpty ( NonEmpty((:|))) @@ -43,6 +45,16 @@ pushMessage :: Text -> MessageHistory -> MessageHistory pushMessage msg NoMessageHistory = MessageHistory (msg :| []) True pushMessage msg (MessageHistory msgs _) = MessageHistory (NonEmpty.cons msg msgs) True +popMessage :: MessageHistory -> MessageHistory +popMessage NoMessageHistory = NoMessageHistory +popMessage (MessageHistory msgs False) = MessageHistory msgs True +popMessage (MessageHistory msgs@(_ :| []) _) = MessageHistory msgs True +popMessage (MessageHistory (_ :| (msg : msgs)) True) = MessageHistory (msg :| msgs) True + +hideMessage :: MessageHistory -> MessageHistory +hideMessage NoMessageHistory = NoMessageHistory +hideMessage (MessageHistory msgs _) = MessageHistory msgs False + data GameState = GameState { _entities :: EntityMap SomeEntity , _characterEntityID :: EntityID diff --git a/src/Xanthous/Game/Draw.hs b/src/Xanthous/Game/Draw.hs index 5a2f773c1b..6527af7439 100644 --- a/src/Xanthous/Game/Draw.hs +++ b/src/Xanthous/Game/Draw.hs @@ -26,7 +26,13 @@ import Xanthous.Orphans () drawMessages :: MessageHistory -> Widget Name drawMessages NoMessageHistory = emptyWidget drawMessages (MessageHistory _ False) = emptyWidget -drawMessages (MessageHistory (lastMessage :| _) True) = str $ unpack lastMessage +drawMessages (MessageHistory (lastMessage :| _) True) = txt lastMessage + +-- an attempt to still take up a row even when no messages +-- drawMessages msgs = vLimit 1 . Widget Greedy Fixed . render $ case msgs of +-- NoMessageHistory -> padTop (Pad 2) $ str " " +-- (MessageHistory _ False) -> padTop (Pad 2) $ str " " +-- (MessageHistory (lastMessage :| _) True) -> txt lastMessage drawEntities :: (Draw a, Show a) => EntityMap a -> Widget Name drawEntities em@(fromNullable . positions -> Just entityPositions) diff --git a/test/Xanthous/GameSpec.hs b/test/Xanthous/GameSpec.hs index 1f1cc2e4d5..9319399ac2 100644 --- a/test/Xanthous/GameSpec.hs +++ b/test/Xanthous/GameSpec.hs @@ -15,8 +15,8 @@ test = testGroup "Xanthous.Game" [ testGroup "positionedCharacter" [ testProperty "lens laws" $ isLens positionedCharacter , testCase "updates the position of the character" $ do - let initialGame = getInitialState - initialPos = initialGame ^. characterPosition + initialGame <- getInitialState + let initialPos = initialGame ^. characterPosition updatedGame = initialGame & characterPosition %~ move Down updatedPos = updatedGame ^. characterPosition updatedPos @?= move Down initialPos -- cgit 1.4.1 From 243104c410da7e2064972b98cda757558b4e3913 Mon Sep 17 00:00:00 2001 From: Griffin Smith Date: Mon, 2 Sep 2019 10:54:52 -0400 Subject: Add commands for diagonal movement That Was Easy (tm)! --- src/Xanthous/Command.hs | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/src/Xanthous/Command.hs b/src/Xanthous/Command.hs index 10fa552b34..ee9a7ad50d 100644 --- a/src/Xanthous/Command.hs +++ b/src/Xanthous/Command.hs @@ -17,6 +17,10 @@ commandFromKey (KChar 'h') [] = Just $ Move Left commandFromKey (KChar 'j') [] = Just $ Move Down commandFromKey (KChar 'k') [] = Just $ Move Up commandFromKey (KChar 'l') [] = Just $ Move Right +commandFromKey (KChar 'y') [] = Just $ Move UpLeft +commandFromKey (KChar 'u') [] = Just $ Move UpRight +commandFromKey (KChar 'b') [] = Just $ Move DownLeft +commandFromKey (KChar 'n') [] = Just $ Move DownRight commandFromKey (KChar 'p') [MCtrl] = Just PreviousMessage -- cgit 1.4.1 From 4d270712aecf1b61249086718852b96968de2bd8 Mon Sep 17 00:00:00 2001 From: Griffin Smith Date: Mon, 2 Sep 2019 13:56:25 -0400 Subject: Add raws, loaded statically from a folder Add raw types with support for both creatures and items, loaded statically from a "raws" folder just like in the Rust version. --- package.yaml | 1 + src/Xanthous/Data.hs | 48 +++++++++++++++++++++---- src/Xanthous/Entities/RawTypes.hs | 62 +++++++++++++++++++++++++++++++++ src/Xanthous/Entities/Raws.hs | 28 +++++++++++++++ src/Xanthous/Entities/Raws/gormlak.yaml | 12 +++++++ src/Xanthous/Orphans.hs | 29 +++++++++++++++ test/Spec.hs | 6 ++-- test/Xanthous/DataSpec.hs | 2 +- test/Xanthous/Entities/RawsSpec.hs | 16 +++++++++ xanthous.cabal | 10 +++++- 10 files changed, 204 insertions(+), 10 deletions(-) create mode 100644 src/Xanthous/Entities/RawTypes.hs create mode 100644 src/Xanthous/Entities/Raws.hs create mode 100644 src/Xanthous/Entities/Raws/gormlak.yaml create mode 100644 test/Xanthous/Entities/RawsSpec.hs diff --git a/package.yaml b/package.yaml index 2aa6bd9b58..9ea1ee5217 100644 --- a/package.yaml +++ b/package.yaml @@ -29,6 +29,7 @@ dependencies: - data-default - deepseq - file-embed +- filepath - generic-arbitrary - generic-monoid - groups diff --git a/src/Xanthous/Data.hs b/src/Xanthous/Data.hs index 773f1adc91..e891a8e9e0 100644 --- a/src/Xanthous/Data.hs +++ b/src/Xanthous/Data.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE DeriveTraversable #-} {-# LANGUAGE DeriveFoldable #-} {-# LANGUAGE DeriveFunctor #-} @@ -20,15 +21,23 @@ module Xanthous.Data , opposite , move , asPosition + + -- * + , EntityChar(..) ) where -------------------------------------------------------------------------------- -import Xanthous.Prelude hiding (Left, Down, Right) -import Test.QuickCheck (Arbitrary, CoArbitrary, Function) -import Test.QuickCheck.Arbitrary.Generic -import Data.Group -import Brick (Location(Location)) +import Xanthous.Prelude hiding (Left, Down, Right) +import Test.QuickCheck (Arbitrary, CoArbitrary, Function) +import Test.QuickCheck.Arbitrary.Generic +import Data.Group +import Brick (Location(Location), raw) +import Graphics.Vty.Attributes +import qualified Graphics.Vty.Image as Vty +import Data.Aeson -------------------------------------------------------------------------------- -import Xanthous.Util (EqEqProp(..), EqProp) +import Xanthous.Util (EqEqProp(..), EqProp) +import Xanthous.Orphans () +import Xanthous.Entities (Draw(..)) -------------------------------------------------------------------------------- data Position where @@ -116,3 +125,30 @@ move DownRight = move Down . move Right asPosition :: Direction -> Position asPosition dir = move dir mempty + +-------------------------------------------------------------------------------- + +data EntityChar = EntityChar + { _char :: Char + , _style :: Attr + } + deriving stock (Show, Eq, Generic) + deriving anyclass (NFData) + +instance FromJSON EntityChar where + parseJSON (String (chr :< Empty)) = pure $ EntityChar chr defAttr + parseJSON (Object o) = do + (EntityChar _char _) <- o .: "char" + _style <- o .:? "style" >>= \case + Just styleO -> do + let attrStyle = Default -- TODO + attrURL = Default + attrForeColor <- styleO .:? "foreground" .!= Default + attrBackColor <- styleO .:? "background" .!= Default + pure Attr {..} + Nothing -> pure defAttr + pure EntityChar {..} + parseJSON _ = fail "Invalid type, expected string or object" + +instance Draw EntityChar where + draw EntityChar{..} = raw $ Vty.string _style [_char] diff --git a/src/Xanthous/Entities/RawTypes.hs b/src/Xanthous/Entities/RawTypes.hs new file mode 100644 index 0000000000..e82cb0c890 --- /dev/null +++ b/src/Xanthous/Entities/RawTypes.hs @@ -0,0 +1,62 @@ +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE DuplicateRecordFields #-} + +module Xanthous.Entities.RawTypes + ( CreatureType(..) + , ItemType(..) + , EntityRaw(..) + + , HasName(..) + , HasDescription(..) + , HasLongDescription(..) + , HasChar(..) + , HasMaxHitpoints(..) + , HasFriendly(..) + , _Creature + ) where + +import Xanthous.Prelude +import Data.Aeson.Generic.DerivingVia +import Data.Aeson (FromJSON) +import Data.Word + +import Xanthous.Data + +data CreatureType = CreatureType + { _name :: Text + , _description :: Text + , _char :: EntityChar + , _maxHitpoints :: Word16 + , _friendly :: Bool + } + deriving stock (Show, Eq, Generic) + deriving anyclass (NFData) + deriving (FromJSON) + via WithOptions '[ FieldLabelModifier '[Drop 1] ] + CreatureType +makeFieldsNoPrefix ''CreatureType + +data ItemType = ItemType + { _name :: Text + , _description :: Text + , _longDescription :: Text + , _char :: EntityChar + } + deriving stock (Show, Eq, Generic) + deriving anyclass (NFData) + deriving (FromJSON) + via WithOptions '[ FieldLabelModifier '[Drop 1] ] + ItemType +makeFieldsNoPrefix ''ItemType + +data EntityRaw + = Creature CreatureType + | Item ItemType + deriving stock (Show, Eq, Generic) + deriving anyclass (NFData) + deriving (FromJSON) + via WithOptions '[ SumEnc ObjWithSingleField ] + EntityRaw +makePrisms ''EntityRaw + +{-# ANN module ("HLint: ignore Use newtype instead of data" :: String) #-} diff --git a/src/Xanthous/Entities/Raws.hs b/src/Xanthous/Entities/Raws.hs new file mode 100644 index 0000000000..4a4cba8c9a --- /dev/null +++ b/src/Xanthous/Entities/Raws.hs @@ -0,0 +1,28 @@ +{-# LANGUAGE TemplateHaskell #-} + +module Xanthous.Entities.Raws + ( raws + , raw + ) where + +import Data.FileEmbed +import qualified Data.Yaml as Yaml +import Xanthous.Prelude +import System.FilePath.Posix + +import Xanthous.Entities.RawTypes + +rawRaws :: [(FilePath, ByteString)] +rawRaws = $(embedDir "src/Xanthous/Entities/Raws") + +raws :: HashMap Text EntityRaw +raws + = mapFromList + . map (bimap + (pack . takeBaseName) + (either (error . Yaml.prettyPrintParseException) id + . Yaml.decodeEither')) + $ rawRaws + +raw :: Text -> Maybe EntityRaw +raw n = raws ^. at n diff --git a/src/Xanthous/Entities/Raws/gormlak.yaml b/src/Xanthous/Entities/Raws/gormlak.yaml new file mode 100644 index 0000000000..fc3215f2f4 --- /dev/null +++ b/src/Xanthous/Entities/Raws/gormlak.yaml @@ -0,0 +1,12 @@ +Creature: + name: gormlak + description: | + A chittering imp-like creature with bright yellow horns. It adores shiny objects + and gathers in swarms. + char: + char: g + style: + color: red + maxHitpoints: 5 + speed: 120 + friendly: false diff --git a/src/Xanthous/Orphans.hs b/src/Xanthous/Orphans.hs index d2e378cd28..3efe1f1264 100644 --- a/src/Xanthous/Orphans.hs +++ b/src/Xanthous/Orphans.hs @@ -18,6 +18,7 @@ import Text.Mustache.Type ( showKey ) import Data.List.NonEmpty (NonEmpty(..)) import qualified Data.List.NonEmpty as NonEmpty import Data.Aeson +import Graphics.Vty.Attributes instance forall s a. ( Cons s s a a @@ -152,3 +153,31 @@ instance Function Text where deriving anyclass instance NFData Node deriving anyclass instance NFData Template + +instance FromJSON Color where + parseJSON = withText "Color" $ \case + "black" -> pure black + "red" -> pure red + "green" -> pure green + "yellow" -> pure yellow + "blue" -> pure blue + "magenta" -> pure magenta + "cyan" -> pure cyan + "white" -> pure white + _ -> fail "Invalid color" + +instance ToJSON Color where + toJSON color + | color == black = "black" + | color == red = "red" + | color == green = "green" + | color == yellow = "yellow" + | color == blue = "blue" + | color == magenta = "magenta" + | color == cyan = "cyan" + | color == white = "white" + | otherwise = error "unimplemented" + +instance (Eq a, Show a, Read a, FromJSON a) => FromJSON (MaybeDefault a) where + parseJSON Null = pure Default + parseJSON x = SetTo <$> parseJSON x diff --git a/test/Spec.hs b/test/Spec.hs index 6f955aa696..7ae9b40d26 100644 --- a/test/Spec.hs +++ b/test/Spec.hs @@ -4,15 +4,17 @@ import qualified Xanthous.Data.EntityMapSpec import qualified Xanthous.GameSpec import qualified Xanthous.MessageSpec import qualified Xanthous.OrphansSpec +import qualified Xanthous.Entities.RawsSpec main :: IO () main = defaultMain test test :: TestTree test = testGroup "Xanthous" - [ Xanthous.DataSpec.test - , Xanthous.Data.EntityMapSpec.test + [ Xanthous.Data.EntityMapSpec.test + , Xanthous.Entities.RawsSpec.test , Xanthous.GameSpec.test , Xanthous.MessageSpec.test , Xanthous.OrphansSpec.test + , Xanthous.DataSpec.test ] diff --git a/test/Xanthous/DataSpec.hs b/test/Xanthous/DataSpec.hs index ba060b7ad2..2c9f9dd3f9 100644 --- a/test/Xanthous/DataSpec.hs +++ b/test/Xanthous/DataSpec.hs @@ -1,6 +1,6 @@ -- | -module Xanthous.DataSpec where +module Xanthous.DataSpec (main, test) where import Test.Prelude hiding (Right, Left, Down) import Xanthous.Data diff --git a/test/Xanthous/Entities/RawsSpec.hs b/test/Xanthous/Entities/RawsSpec.hs new file mode 100644 index 0000000000..2e6f35457f --- /dev/null +++ b/test/Xanthous/Entities/RawsSpec.hs @@ -0,0 +1,16 @@ +-- | + +module Xanthous.Entities.RawsSpec (main, test) where + +import Test.Prelude +import Xanthous.Entities.Raws + +main :: IO () +main = defaultMain test + +test :: TestTree +test = testGroup "Xanthous.Entities.Raws" + [ testGroup "raws" + [ testCase "are all valid" $ raws `deepseq` pure () + ] + ] diff --git a/xanthous.cabal b/xanthous.cabal index 8c6fe406ae..390d0dbfc3 100644 --- a/xanthous.cabal +++ b/xanthous.cabal @@ -4,7 +4,7 @@ cabal-version: 1.12 -- -- see: https://github.com/sol/hpack -- --- hash: 5d750bf0bb5c6d278928f6c9606427754a444344fd769f50c02b776dedf0e771 +-- hash: 897c9cda436c62269dd43a0fc47226b24a310e52522fa6ebfe18cedc2394f6ea name: xanthous version: 0.1.0.0 @@ -36,6 +36,8 @@ library Xanthous.Data.EntityMap Xanthous.Entities Xanthous.Entities.Character + Xanthous.Entities.Raws + Xanthous.Entities.RawTypes Xanthous.Entities.SomeEntity Xanthous.Game Xanthous.Game.Draw @@ -65,6 +67,7 @@ library , data-default , deepseq , file-embed + , filepath , generic-arbitrary , generic-monoid , groups @@ -92,6 +95,8 @@ executable xanthous Xanthous.Data.EntityMap Xanthous.Entities Xanthous.Entities.Character + Xanthous.Entities.Raws + Xanthous.Entities.RawTypes Xanthous.Entities.SomeEntity Xanthous.Game Xanthous.Game.Draw @@ -120,6 +125,7 @@ executable xanthous , data-default , deepseq , file-embed + , filepath , generic-arbitrary , generic-monoid , groups @@ -145,6 +151,7 @@ test-suite test Test.Prelude Xanthous.Data.EntityMapSpec Xanthous.DataSpec + Xanthous.Entities.RawsSpec Xanthous.GameSpec Xanthous.MessageSpec Xanthous.OrphansSpec @@ -166,6 +173,7 @@ test-suite test , data-default , deepseq , file-embed + , filepath , generic-arbitrary , generic-monoid , groups -- cgit 1.4.1 From 73a52e531d940858f0ac334d8b2ccda479ea7b5e Mon Sep 17 00:00:00 2001 From: Griffin Smith Date: Mon, 2 Sep 2019 14:45:36 -0400 Subject: Put a test gormlak on the screen Implement a concrete "Creature" entity, and place one on the screen at the game startup for testing. This revealed a bug with drawing when getting the maximum entity position, but that appears to be fixed now (yay) --- src/Xanthous/App.hs | 38 ++++++++++++++++++++++----------- src/Xanthous/Entities/Creature.hs | 32 +++++++++++++++++++++++++++ src/Xanthous/Entities/Raws/gormlak.yaml | 2 +- src/Xanthous/Game/Draw.hs | 9 ++++---- xanthous.cabal | 4 +++- 5 files changed, 66 insertions(+), 19 deletions(-) create mode 100644 src/Xanthous/Entities/Creature.hs diff --git a/src/Xanthous/App.hs b/src/Xanthous/App.hs index 3561d35a3b..6cf22135a7 100644 --- a/src/Xanthous/App.hs +++ b/src/Xanthous/App.hs @@ -1,18 +1,25 @@ module Xanthous.App (makeApp) where -import Xanthous.Prelude -import Brick hiding (App, halt, continue) +import Xanthous.Prelude +import Brick hiding (App, halt, continue, raw) import qualified Brick -import Graphics.Vty.Attributes (defAttr) -import Graphics.Vty.Input.Events (Event(EvKey)) -import Control.Monad.State (get) +import Graphics.Vty.Attributes (defAttr) +import Graphics.Vty.Input.Events (Event(EvKey)) +import Control.Monad.State (get) -import Xanthous.Game -import Xanthous.Game.Draw (drawGame) -import Xanthous.Resource (Name) -import Xanthous.Command -import Xanthous.Data (move) -import Xanthous.Monad +import Xanthous.Command +import Xanthous.Data (move, Position(..)) +import qualified Xanthous.Data.EntityMap as EntityMap +import Xanthous.Game +import Xanthous.Game.Draw (drawGame) +import Xanthous.Monad +import Xanthous.Resource (Name) + +import Xanthous.Entities.Creature (Creature) +import qualified Xanthous.Entities.Creature as Creature +import Xanthous.Entities.RawTypes (EntityRaw(..)) +import Xanthous.Entities.Raws (raw) +import Xanthous.Entities.SomeEntity type App = Brick.App GameState () Name type AppM a = AppT (EventM Name) a @@ -29,8 +36,15 @@ makeApp = pure $ Brick.App runAppM :: AppM a -> GameState -> EventM Name a runAppM appm = fmap fst . runAppT appm +testGormlak :: Creature +testGormlak = + let Just (Creature gormlak) = raw "gormlak" + in Creature.newWithType gormlak + startEvent :: AppM () -startEvent = say ["welcome"] +startEvent = do + () <- say ["welcome"] + entities %= EntityMap.insertAt (Position 10 10) (SomeEntity testGormlak) handleEvent :: BrickEvent Name () -> AppM (Next GameState) handleEvent (VtyEvent (EvKey k mods)) diff --git a/src/Xanthous/Entities/Creature.hs b/src/Xanthous/Entities/Creature.hs new file mode 100644 index 0000000000..983772090e --- /dev/null +++ b/src/Xanthous/Entities/Creature.hs @@ -0,0 +1,32 @@ +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE TemplateHaskell #-} +-- | + +module Xanthous.Entities.Creature where + +import Data.Word + +import Xanthous.Prelude +import Xanthous.Entities.RawTypes hiding (Creature) +import Xanthous.Entities (Draw(..)) + +data Creature = Creature + { _creatureType :: CreatureType + , _hitpoints :: Word16 + } + deriving stock (Eq, Show, Generic) +makeLenses ''Creature + +instance Draw Creature where + draw = draw .view (creatureType . char) + +newWithType :: CreatureType -> Creature +newWithType _creatureType = + let _hitpoints = _creatureType ^. maxHitpoints + in Creature {..} + +damage :: Word16 -> Creature -> Creature +damage amount = hitpoints %~ \hp -> + if hp <= amount + then 0 + else hp - amount diff --git a/src/Xanthous/Entities/Raws/gormlak.yaml b/src/Xanthous/Entities/Raws/gormlak.yaml index fc3215f2f4..2441e7e782 100644 --- a/src/Xanthous/Entities/Raws/gormlak.yaml +++ b/src/Xanthous/Entities/Raws/gormlak.yaml @@ -6,7 +6,7 @@ Creature: char: char: g style: - color: red + foreground: red maxHitpoints: 5 speed: 120 friendly: false diff --git a/src/Xanthous/Game/Draw.hs b/src/Xanthous/Game/Draw.hs index 6527af7439..36abe16119 100644 --- a/src/Xanthous/Game/Draw.hs +++ b/src/Xanthous/Game/Draw.hs @@ -35,16 +35,15 @@ drawMessages (MessageHistory (lastMessage :| _) True) = txt lastMessage -- (MessageHistory (lastMessage :| _) True) -> txt lastMessage drawEntities :: (Draw a, Show a) => EntityMap a -> Widget Name -drawEntities em@(fromNullable . positions -> Just entityPositions) +drawEntities em = vBox rows where - maxPosition = maximum entityPositions - maxY = maxPosition ^. y - maxX = maxPosition ^. x + entityPositions = positions em + maxY = fromMaybe 0 $ maximumOf (folded . y) entityPositions + maxX = fromMaybe 0 $ maximumOf (folded . x) entityPositions rows = mkRow <$> [0..maxY] mkRow rowY = hBox $ renderEntityAt . flip Position rowY <$> [0..maxX] renderEntityAt pos = maybe (str " ") draw $ em ^? atPosition pos . folded -drawEntities _ = emptyWidget drawMap :: GameState -> Widget Name drawMap game diff --git a/xanthous.cabal b/xanthous.cabal index 390d0dbfc3..7f7d12932c 100644 --- a/xanthous.cabal +++ b/xanthous.cabal @@ -4,7 +4,7 @@ cabal-version: 1.12 -- -- see: https://github.com/sol/hpack -- --- hash: 897c9cda436c62269dd43a0fc47226b24a310e52522fa6ebfe18cedc2394f6ea +-- hash: 1e2605418faf05255c5de59433688704543e21d7d3edf669e7e18a99977c0241 name: xanthous version: 0.1.0.0 @@ -36,6 +36,7 @@ library Xanthous.Data.EntityMap Xanthous.Entities Xanthous.Entities.Character + Xanthous.Entities.Creature Xanthous.Entities.Raws Xanthous.Entities.RawTypes Xanthous.Entities.SomeEntity @@ -95,6 +96,7 @@ executable xanthous Xanthous.Data.EntityMap Xanthous.Entities Xanthous.Entities.Character + Xanthous.Entities.Creature Xanthous.Entities.Raws Xanthous.Entities.RawTypes Xanthous.Entities.SomeEntity -- cgit 1.4.1 From f03ad6bbd60b6ccdd329fc6740bcea2b554980dd Mon Sep 17 00:00:00 2001 From: Griffin Smith Date: Sat, 7 Sep 2019 14:49:59 -0400 Subject: Add cellular-automata cave generator Add a cellular-automata-based cave level generator, plus an optparse-applicative-based CLI for invoking level generators in general. --- package.yaml | 2 + src/Main.hs | 62 ++++++++++++++++-- src/Xanthous/Data.hs | 21 ++++++ src/Xanthous/Generators.hs | 54 +++++++++++++++ src/Xanthous/Generators/CaveAutomata.hs | 112 ++++++++++++++++++++++++++++++++ src/Xanthous/Generators/Util.hs | 70 ++++++++++++++++++++ src/Xanthous/Util.hs | 34 +++++++++- test/Spec.hs | 6 +- test/Xanthous/Generators/UtilSpec.hs | 66 +++++++++++++++++++ xanthous.cabal | 15 ++++- 10 files changed, 434 insertions(+), 8 deletions(-) create mode 100644 src/Xanthous/Generators.hs create mode 100644 src/Xanthous/Generators/CaveAutomata.hs create mode 100644 src/Xanthous/Generators/Util.hs create mode 100644 test/Xanthous/Generators/UtilSpec.hs diff --git a/package.yaml b/package.yaml index 9ea1ee5217..7df7234c16 100644 --- a/package.yaml +++ b/package.yaml @@ -18,6 +18,7 @@ dependencies: - base - aeson +- array - QuickCheck - quickcheck-text - quickcheck-instances @@ -37,6 +38,7 @@ dependencies: - megaparsec - MonadRandom - mtl +- optparse-applicative - random - raw-strings-qq - reflection diff --git a/src/Main.hs b/src/Main.hs index 1cd4e94457..4d6ccfd4af 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -2,16 +2,70 @@ module Main where import Xanthous.Prelude import Brick +import qualified Options.Applicative as Opt +import System.Random import Xanthous.Game (getInitialState) import Xanthous.App (makeApp) +import Xanthous.Generators + ( GeneratorInput(..) + , parseGeneratorInput + , generateFromInput + , showCells + ) +import Xanthous.Data (Dimensions, Dimensions'(Dimensions)) -ui :: Widget () -ui = str "Hello, world!" +data Command + = Run + | Generate GeneratorInput Dimensions -main :: IO () -main = do +parseDimensions :: Opt.Parser Dimensions +parseDimensions = Dimensions + <$> Opt.option Opt.auto + ( Opt.short 'w' + <> Opt.long "width" + ) + <*> Opt.option Opt.auto + ( Opt.short 'h' + <> Opt.long "height" + ) + +parseCommand :: Opt.Parser Command +parseCommand = Opt.subparser + $ Opt.command "run" + (Opt.info + (pure Run) + (Opt.progDesc "Run the game")) + <> Opt.command "generate" + (Opt.info + (Generate + <$> parseGeneratorInput + <*> parseDimensions + <**> Opt.helper + ) + (Opt.progDesc "Generate a sample level")) + +optParser :: Opt.ParserInfo Command +optParser = Opt.info + (parseCommand <**> Opt.helper) + (Opt.header "Xanthous: a WIP TUI RPG") + +runGame :: IO () +runGame = do app <- makeApp initialState <- getInitialState _ <- defaultMain app initialState pure () + +runGenerate :: GeneratorInput -> Dimensions -> IO () +runGenerate input dims = do + randGen <- getStdGen + let res = generateFromInput input dims randGen + putStrLn $ showCells res + +runCommand :: Command -> IO () +runCommand Run = runGame +runCommand (Generate input dims) = runGenerate input dims + +main :: IO () +main = runCommand =<< Opt.execParser optParser diff --git a/src/Xanthous/Data.hs b/src/Xanthous/Data.hs index e891a8e9e0..6e779a4505 100644 --- a/src/Xanthous/Data.hs +++ b/src/Xanthous/Data.hs @@ -16,6 +16,12 @@ module Xanthous.Data , positioned , loc + -- * + , Dimensions'(..) + , Dimensions + , HasWidth(..) + , HasHeight(..) + -- * , Direction(..) , opposite @@ -88,6 +94,21 @@ loc = iso hither yon -------------------------------------------------------------------------------- +data Dimensions' a = Dimensions + { _width :: a + , _height :: a + } + deriving stock (Show, Eq, Functor, Generic) + deriving anyclass (CoArbitrary, Function) +makeFieldsNoPrefix ''Dimensions' + +instance Arbitrary a => Arbitrary (Dimensions' a) where + arbitrary = Dimensions <$> arbitrary <*> arbitrary + +type Dimensions = Dimensions' Word + +-------------------------------------------------------------------------------- + data Direction where Up :: Direction Down :: Direction diff --git a/src/Xanthous/Generators.hs b/src/Xanthous/Generators.hs new file mode 100644 index 0000000000..c266742b05 --- /dev/null +++ b/src/Xanthous/Generators.hs @@ -0,0 +1,54 @@ +{-# LANGUAGE GADTs #-} + +module Xanthous.Generators where + +import Xanthous.Prelude +import Data.Array.Unboxed +import System.Random (RandomGen) +import qualified Options.Applicative as Opt + +import qualified Xanthous.Generators.CaveAutomata as CaveAutomata +import Xanthous.Data (Dimensions) + +data Generator = CaveAutomata + deriving stock (Show, Eq) + +data SGenerator (gen :: Generator) where + SCaveAutomata :: SGenerator 'CaveAutomata + +data AGenerator where + AGenerator :: forall gen. SGenerator gen -> AGenerator + +type family Params (gen :: Generator) :: Type where + Params 'CaveAutomata = CaveAutomata.Params + +generate + :: RandomGen g + => SGenerator gen + -> Params gen + -> Dimensions + -> g + -> UArray (Word, Word) Bool +generate SCaveAutomata = CaveAutomata.generate + +data GeneratorInput where + GeneratorInput :: forall gen. SGenerator gen -> Params gen -> GeneratorInput + +generateFromInput :: RandomGen g => GeneratorInput -> Dimensions -> g -> UArray (Word, Word) Bool +generateFromInput (GeneratorInput sg ps) = generate sg ps + +parseGeneratorInput :: Opt.Parser GeneratorInput +parseGeneratorInput = Opt.subparser $ + Opt.command "cave" (Opt.info + (GeneratorInput <$> pure SCaveAutomata <*> CaveAutomata.parseParams) + (Opt.progDesc "cellular-automata based cave generator")) + +showCells :: UArray (Word, Word) Bool -> Text +showCells arr = + let ((minX, minY), (maxX, maxY)) = bounds arr + showCellVal True = "x" + showCellVal False = " " + showCell = showCellVal . (arr !) + row r = foldMap (showCell . (, r)) [minX..maxX] + rows = row <$> [minY..maxY] + in intercalate "\n" rows diff --git a/src/Xanthous/Generators/CaveAutomata.hs b/src/Xanthous/Generators/CaveAutomata.hs new file mode 100644 index 0000000000..bf37cb3f08 --- /dev/null +++ b/src/Xanthous/Generators/CaveAutomata.hs @@ -0,0 +1,112 @@ +{-# LANGUAGE MultiWayIf #-} +{-# LANGUAGE ViewPatterns #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE TemplateHaskell #-} + +module Xanthous.Generators.CaveAutomata + ( Params(..) + , defaultParams + , parseParams + , generate + ) where + +import Xanthous.Prelude +import Control.Monad.Random (RandomGen, runRandT) +import Data.Array.ST +import Data.Array.Unboxed +import qualified Options.Applicative as Opt + +import Xanthous.Util (between) +import Xanthous.Data (Dimensions, width, height) +import Xanthous.Generators.Util + +data Params = Params + { _aliveStartChance :: Double + , _birthLimit :: Word + , _deathLimit :: Word + , _steps :: Word + } + deriving stock (Show, Eq, Generic) +makeLenses ''Params + +defaultParams :: Params +defaultParams = Params + { _aliveStartChance = 0.6 + , _birthLimit = 3 + , _deathLimit = 4 + , _steps = 4 + } + +parseParams :: Opt.Parser Params +parseParams = Params + <$> Opt.option parseChance + ( Opt.long "alive-start-chance" + <> Opt.value (defaultParams ^. aliveStartChance) + <> Opt.showDefault + <> Opt.help ( "Chance for each cell to start alive at the beginning of " + <> "the cellular automata" + ) + <> Opt.metavar "CHANCE" + ) + <*> Opt.option parseNeighbors + ( Opt.long "birth-limit" + <> Opt.value (defaultParams ^. birthLimit) + <> Opt.showDefault + <> Opt.help "Minimum neighbor count required for birth of a cell" + <> Opt.metavar "NEIGHBORS" + ) + <*> Opt.option parseNeighbors + ( Opt.long "death-limit" + <> Opt.value (defaultParams ^. deathLimit) + <> Opt.showDefault + <> Opt.help "Maximum neighbor count required for death of a cell" + <> Opt.metavar "NEIGHBORS" + ) + <*> Opt.option Opt.auto + ( Opt.long "steps" + <> Opt.value (defaultParams ^. steps) + <> Opt.showDefault + <> Opt.help "Number of generations to run the automata for" + <> Opt.metavar "STEPS" + ) + where + readWithGuard predicate errmsg = do + res <- Opt.auto + unless (predicate res) + $ Opt.readerError + $ errmsg res + pure res + + parseChance = readWithGuard + (between 0 1) + $ \res -> "Chance must be in the range [0,1], got: " <> show res + + parseNeighbors = readWithGuard + (between 0 8) + $ \res -> "Neighbors must be in the range [0,8], got: " <> show res + +generate :: RandomGen g => Params -> Dimensions -> g -> UArray (Word, Word) Bool +generate params dims gen + = runSTUArray + $ fmap fst + $ flip runRandT gen + $ generate' params dims + +generate' :: RandomGen g => Params -> Dimensions -> CellM g s (Cells s) +generate' params dims = do + cells <- randInitialize dims $ params ^. aliveStartChance + let steps' = params ^. steps + when (steps' > 0) + $ for_ [0 .. pred steps'] . const $ stepAutomata cells dims params + pure cells + +stepAutomata :: forall s g. Cells s -> Dimensions -> Params -> CellM g s () +stepAutomata cells dims params = do + origCells <- lift $ cloneMArray @_ @(STUArray s) cells + for_ (range ((0, 0), (dims ^. width, dims ^. height))) $ \pos -> do + neighs <- lift $ numAliveNeighborsM origCells pos + origValue <- lift $ readArray origCells pos + lift . writeArray cells pos + $ if origValue + then neighs >= params ^. deathLimit + else neighs > params ^. birthLimit diff --git a/src/Xanthous/Generators/Util.hs b/src/Xanthous/Generators/Util.hs new file mode 100644 index 0000000000..3f0d691b7f --- /dev/null +++ b/src/Xanthous/Generators/Util.hs @@ -0,0 +1,70 @@ +-- | + +module Xanthous.Generators.Util + ( Cells + , CellM + , randInitialize + , numAliveNeighborsM + , cloneMArray + ) where + +import Xanthous.Prelude +import Data.Array.ST +import Data.Array.Unboxed +import Control.Monad.ST +import Control.Monad.Random +import Data.Monoid + +import Xanthous.Util (foldlMapM') +import Xanthous.Data (Dimensions, width, height) + +type Cells s = STUArray s (Word, Word) Bool +type CellM g s a = RandT g (ST s) a + +randInitialize :: RandomGen g => Dimensions -> Double -> CellM g s (Cells s) +randInitialize dims aliveChance = do + res <- lift $ newArray ((0, 0), (dims ^. width, dims ^. height)) False + for_ [0..dims ^. width] $ \i -> + for_ [0..dims ^. height] $ \j -> do + val <- (>= aliveChance) <$> getRandomR (0, 1) + lift $ writeArray res (i, j) val + pure res + +numAliveNeighborsM + :: forall a i j m + . (MArray a Bool m, Ix (i, j), Integral i, Integral j) + => a (i, j) Bool + -> (i, j) + -> m Word +numAliveNeighborsM cells (x, y) = do + cellBounds <- getBounds cells + getSum <$> foldlMapM' + (fmap (Sum . fromIntegral . fromEnum) . boundedGet cellBounds) + neighborPositions + + where + boundedGet :: ((i, j), (i, j)) -> (Int, Int) -> m Bool + boundedGet ((minX, minY), (maxX, maxY)) (i, j) + | x <= minX + || y <= minY + || x >= maxX + || y >= maxY + = pure True + | otherwise = + let nx = fromIntegral $ fromIntegral x + i + ny = fromIntegral $ fromIntegral y + j + in readArray cells (nx, ny) + + neighborPositions :: [(Int, Int)] + neighborPositions = [(i, j) | i <- [-1..1], j <- [-1..1], (i, j) /= (0, 0)] + +cloneMArray + :: forall a a' i e m. + ( Ix i + , MArray a e m + , MArray a' e m + , IArray UArray e + ) + => a i e + -> m (a' i e) +cloneMArray = thaw @_ @UArray <=< freeze diff --git a/src/Xanthous/Util.hs b/src/Xanthous/Util.hs index 377b66cf15..cf1f80b82e 100644 --- a/src/Xanthous/Util.hs +++ b/src/Xanthous/Util.hs @@ -1,14 +1,46 @@ +{-# LANGUAGE BangPatterns #-} + module Xanthous.Util ( EqEqProp(..) , EqProp(..) + , foldlMapM + , foldlMapM' + , between ) where -import Xanthous.Prelude +import Xanthous.Prelude hiding (foldr) import Test.QuickCheck.Checkers +import Data.Foldable (foldr) newtype EqEqProp a = EqEqProp a deriving newtype Eq instance Eq a => EqProp (EqEqProp a) where (=-=) = eq + +foldlMapM :: forall g b a m. (Foldable g, Monoid b, Applicative m) => (a -> m b) -> g a -> m b +foldlMapM f = foldr f' (pure mempty) + where + f' :: a -> m b -> m b + f' x = liftA2 mappend (f x) + +-- Strict in the monoidal accumulator. For monads strict +-- in the left argument of bind, this will run in constant +-- space. +foldlMapM' :: forall g b a m. (Foldable g, Monoid b, Monad m) => (a -> m b) -> g a -> m b +foldlMapM' f xs = foldr f' pure xs mempty + where + f' :: a -> (b -> m b) -> b -> m b + f' x k bl = do + br <- f x + let !b = mappend bl br + k b + +between + :: Ord a + => a -- ^ lower bound + -> a -- ^ upper bound + -> a -- ^ scrutinee + -> Bool +between lower upper x = x >= lower && x <= upper diff --git a/test/Spec.hs b/test/Spec.hs index 7ae9b40d26..dd4212c2eb 100644 --- a/test/Spec.hs +++ b/test/Spec.hs @@ -1,10 +1,11 @@ import Test.Prelude -import qualified Xanthous.DataSpec import qualified Xanthous.Data.EntityMapSpec +import qualified Xanthous.DataSpec +import qualified Xanthous.Entities.RawsSpec import qualified Xanthous.GameSpec +import qualified Xanthous.Generators.UtilSpec import qualified Xanthous.MessageSpec import qualified Xanthous.OrphansSpec -import qualified Xanthous.Entities.RawsSpec main :: IO () main = defaultMain test @@ -14,6 +15,7 @@ test = testGroup "Xanthous" [ Xanthous.Data.EntityMapSpec.test , Xanthous.Entities.RawsSpec.test , Xanthous.GameSpec.test + , Xanthous.Generators.UtilSpec.test , Xanthous.MessageSpec.test , Xanthous.OrphansSpec.test , Xanthous.DataSpec.test diff --git a/test/Xanthous/Generators/UtilSpec.hs b/test/Xanthous/Generators/UtilSpec.hs new file mode 100644 index 0000000000..a1c2f79d60 --- /dev/null +++ b/test/Xanthous/Generators/UtilSpec.hs @@ -0,0 +1,66 @@ +{-# LANGUAGE PackageImports #-} + +module Xanthous.Generators.UtilSpec (main, test) where + +import Test.Prelude +import System.Random (mkStdGen) +import Control.Monad.Random (runRandT) +import Data.Array.ST (STUArray, runSTUArray, thaw) +import Data.Array.IArray (bounds) +import Data.Array.MArray (newArray, readArray, writeArray) +import Data.Array (Array, range, listArray, Ix) +import Control.Monad.ST (ST, runST) +import "checkers" Test.QuickCheck.Instances.Array () + +import Xanthous.Util +import Xanthous.Data (width, height) +import Xanthous.Generators.Util + +main :: IO () +main = defaultMain test + +newtype GenArray a b = GenArray (Array a b) + deriving stock (Show, Eq) + +instance (Ix a, Arbitrary a, CoArbitrary a, Arbitrary b) => Arbitrary (GenArray a b) where + arbitrary = GenArray <$> do + (mkElem :: a -> b) <- arbitrary + minDims <- arbitrary + maxDims <- arbitrary + let bnds = (minDims, maxDims) + pure $ listArray bnds $ mkElem <$> range bnds + +test :: TestTree +test = testGroup "Xanthous.Generators.Util" + [ testGroup "randInitialize" + [ testProperty "returns an array of the correct dimensions" $ \dims seed aliveChance -> + let gen = mkStdGen seed + res = runSTUArray + $ fmap fst + $ flip runRandT gen + $ randInitialize dims aliveChance + in bounds res === ((0, 0), (dims ^. width, dims ^. height)) + ] + , testGroup "numAliveNeighbors" + [ testProperty "maxes out at 8" $ \(GenArray (arr :: Array (Word, Word) Bool)) loc -> + let + act :: forall s. ST s Word + act = do + mArr <- thaw @_ @_ @_ @(STUArray s) arr + numAliveNeighborsM mArr loc + res = runST act + in counterexample (show res) $ between 0 8 res + ] + , testGroup "cloneMArray" + [ testCase "clones the array" $ runST $ + let + go :: forall s. ST s Assertion + go = do + arr <- newArray @(STUArray s) (0 :: Int, 5) (1 :: Int) + arr' <- cloneMArray @_ @(STUArray s) arr + writeArray arr' 0 1234 + x <- readArray arr 0 + pure $ x @?= 1 + in go + ] + ] diff --git a/xanthous.cabal b/xanthous.cabal index 7f7d12932c..36a5608805 100644 --- a/xanthous.cabal +++ b/xanthous.cabal @@ -4,7 +4,7 @@ cabal-version: 1.12 -- -- see: https://github.com/sol/hpack -- --- hash: 1e2605418faf05255c5de59433688704543e21d7d3edf669e7e18a99977c0241 +-- hash: e01963f3bf85136fe2b6993775d225999898d4c478efef6f917056f726d72e33 name: xanthous version: 0.1.0.0 @@ -42,6 +42,9 @@ library Xanthous.Entities.SomeEntity Xanthous.Game Xanthous.Game.Draw + Xanthous.Generators + Xanthous.Generators.CaveAutomata + Xanthous.Generators.Util Xanthous.Messages Xanthous.Monad Xanthous.Orphans @@ -59,6 +62,7 @@ library MonadRandom , QuickCheck , aeson + , array , base , brick , checkers @@ -75,6 +79,7 @@ library , lens , megaparsec , mtl + , optparse-applicative , quickcheck-instances , quickcheck-text , random @@ -102,6 +107,9 @@ executable xanthous Xanthous.Entities.SomeEntity Xanthous.Game Xanthous.Game.Draw + Xanthous.Generators + Xanthous.Generators.CaveAutomata + Xanthous.Generators.Util Xanthous.Messages Xanthous.Monad Xanthous.Orphans @@ -118,6 +126,7 @@ executable xanthous MonadRandom , QuickCheck , aeson + , array , base , brick , checkers @@ -134,6 +143,7 @@ executable xanthous , lens , megaparsec , mtl + , optparse-applicative , quickcheck-instances , quickcheck-text , random @@ -155,6 +165,7 @@ test-suite test Xanthous.DataSpec Xanthous.Entities.RawsSpec Xanthous.GameSpec + Xanthous.Generators.UtilSpec Xanthous.MessageSpec Xanthous.OrphansSpec Paths_xanthous @@ -166,6 +177,7 @@ test-suite test MonadRandom , QuickCheck , aeson + , array , base , brick , checkers @@ -183,6 +195,7 @@ test-suite test , lens-properties , megaparsec , mtl + , optparse-applicative , quickcheck-instances , quickcheck-text , random -- cgit 1.4.1 From e01cf9b0565eaa9c09e19f66331a2010aea908cb Mon Sep 17 00:00:00 2001 From: Griffin Smith Date: Sat, 7 Sep 2019 14:51:04 -0400 Subject: gitignore debug.log --- .gitignore | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/.gitignore b/.gitignore index a2f7e636e5..bc711a2470 100644 --- a/.gitignore +++ b/.gitignore @@ -22,8 +22,12 @@ cabal.project.local~ .HTF/ .ghc.environment.* + # from nix-build result # grr *_flymake.hs + +# app-specific +debug.log -- cgit 1.4.1 From 9ebdc6fbb446fea5e505172a6b3dd459beaf3552 Mon Sep 17 00:00:00 2001 From: Griffin Smith Date: Mon, 9 Sep 2019 20:54:33 -0400 Subject: Convert generated levels to walls Add support for converting generated levels to walls, and merge one into the entity map at the beginning of the game. There's nothing here that guarantees the character ends up *inside* the level though (they almost always don't) so that'll have to be slotted into the level generation process. --- src/Main.hs | 2 +- src/Xanthous/App.hs | 29 +++++++++--- src/Xanthous/Data.hs | 87 +++++++++++++++++++++++++----------- src/Xanthous/Data/EntityMap.hs | 13 +++++- src/Xanthous/Entities.hs | 80 +++++++++++++++++++++++++++++---- src/Xanthous/Entities/Arbitrary.hs | 19 ++++++++ src/Xanthous/Entities/Character.hs | 8 ++-- src/Xanthous/Entities/Draw/Util.hs | 31 +++++++++++++ src/Xanthous/Entities/Environment.hs | 26 +++++++++++ src/Xanthous/Entities/RawTypes.hs | 2 +- src/Xanthous/Entities/SomeEntity.hs | 34 -------------- src/Xanthous/Game.hs | 12 +++-- src/Xanthous/Game/Draw.hs | 12 +++-- src/Xanthous/Generators.hs | 30 ++++++++++--- src/Xanthous/Generators/Util.hs | 29 ++++++++++++ src/Xanthous/Monad.hs | 4 ++ src/Xanthous/Orphans.hs | 28 ++++++------ test/Xanthous/GameSpec.hs | 2 +- test/Xanthous/Generators/UtilSpec.hs | 13 +++++- xanthous.cabal | 10 +++-- 20 files changed, 356 insertions(+), 115 deletions(-) create mode 100644 src/Xanthous/Entities/Arbitrary.hs create mode 100644 src/Xanthous/Entities/Draw/Util.hs create mode 100644 src/Xanthous/Entities/Environment.hs delete mode 100644 src/Xanthous/Entities/SomeEntity.hs diff --git a/src/Main.hs b/src/Main.hs index 4d6ccfd4af..d49e082b7c 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -31,7 +31,7 @@ parseDimensions = Dimensions ) parseCommand :: Opt.Parser Command -parseCommand = Opt.subparser +parseCommand = (<|> pure Run) $ Opt.subparser $ Opt.command "run" (Opt.info (pure Run) diff --git a/src/Xanthous/App.hs b/src/Xanthous/App.hs index 6cf22135a7..af6b5caf61 100644 --- a/src/Xanthous/App.hs +++ b/src/Xanthous/App.hs @@ -1,25 +1,30 @@ module Xanthous.App (makeApp) where - +-------------------------------------------------------------------------------- import Xanthous.Prelude import Brick hiding (App, halt, continue, raw) import qualified Brick import Graphics.Vty.Attributes (defAttr) import Graphics.Vty.Input.Events (Event(EvKey)) import Control.Monad.State (get) - +import Control.Monad.Random (getRandom) +-------------------------------------------------------------------------------- import Xanthous.Command -import Xanthous.Data (move, Position(..)) +import Xanthous.Data (move, Position(..), Dimensions'(Dimensions), Dimensions) import qualified Xanthous.Data.EntityMap as EntityMap +import Xanthous.Data.EntityMap (EntityMap) import Xanthous.Game import Xanthous.Game.Draw (drawGame) import Xanthous.Monad import Xanthous.Resource (Name) - +-------------------------------------------------------------------------------- import Xanthous.Entities.Creature (Creature) import qualified Xanthous.Entities.Creature as Creature import Xanthous.Entities.RawTypes (EntityRaw(..)) import Xanthous.Entities.Raws (raw) -import Xanthous.Entities.SomeEntity +import Xanthous.Entities +import Xanthous.Generators +import qualified Xanthous.Generators.CaveAutomata as CaveAutomata +-------------------------------------------------------------------------------- type App = Brick.App GameState () Name type AppM a = AppT (EventM Name) a @@ -43,7 +48,10 @@ testGormlak = startEvent :: AppM () startEvent = do - () <- say ["welcome"] + say_ ["welcome"] + level <- generateLevel SCaveAutomata CaveAutomata.defaultParams + $ Dimensions 120 80 + entities <>= level entities %= EntityMap.insertAt (Position 10 10) (SomeEntity testGormlak) handleEvent :: BrickEvent Name () -> AppM (Next GameState) @@ -62,3 +70,12 @@ handleCommand (Move dir) = do handleCommand PreviousMessage = do messageHistory %= popMessage continue + +-------------------------------------------------------------------------------- + +generateLevel :: SGenerator gen -> Params gen -> Dimensions -> AppM (EntityMap SomeEntity) +generateLevel g ps dims = do + gen <- use randomGen + let cells = generate g ps dims gen + _ <- getRandom @_ @Int -- perturb the generator, so we don't get the same level twice + pure $ SomeEntity <$> cellsToWalls cells diff --git a/src/Xanthous/Data.hs b/src/Xanthous/Data.hs index 6e779a4505..e435526384 100644 --- a/src/Xanthous/Data.hs +++ b/src/Xanthous/Data.hs @@ -29,21 +29,20 @@ module Xanthous.Data , asPosition -- * - , EntityChar(..) + , Neighbors(..) + , edges + , neighborDirections + , neighborPositions ) where -------------------------------------------------------------------------------- import Xanthous.Prelude hiding (Left, Down, Right) import Test.QuickCheck (Arbitrary, CoArbitrary, Function) import Test.QuickCheck.Arbitrary.Generic import Data.Group -import Brick (Location(Location), raw) -import Graphics.Vty.Attributes -import qualified Graphics.Vty.Image as Vty -import Data.Aeson +import Brick (Location(Location), Edges(..)) -------------------------------------------------------------------------------- import Xanthous.Util (EqEqProp(..), EqProp) import Xanthous.Orphans () -import Xanthous.Entities (Draw(..)) -------------------------------------------------------------------------------- data Position where @@ -149,27 +148,61 @@ asPosition dir = move dir mempty -------------------------------------------------------------------------------- -data EntityChar = EntityChar - { _char :: Char - , _style :: Attr +data Neighbors a = Neighbors + { _topLeft + , _top + , _topRight + , _left + , _right + , _bottomLeft + , _bottom + , _bottomRight :: a } - deriving stock (Show, Eq, Generic) + deriving stock (Show, Eq, Ord, Functor, Foldable, Traversable, Generic) deriving anyclass (NFData) +makeLenses ''Neighbors + +instance Applicative Neighbors where + pure α = Neighbors + { _topLeft = α + , _top = α + , _topRight = α + , _left = α + , _right = α + , _bottomLeft = α + , _bottom = α + , _bottomRight = α + } + nf <*> nx = Neighbors + { _topLeft = nf ^. topLeft $ nx ^. topLeft + , _top = nf ^. top $ nx ^. top + , _topRight = nf ^. topRight $ nx ^. topRight + , _left = nf ^. left $ nx ^. left + , _right = nf ^. right $ nx ^. right + , _bottomLeft = nf ^. bottomLeft $ nx ^. bottomLeft + , _bottom = nf ^. bottom $ nx ^. bottom + , _bottomRight = nf ^. bottomRight $ nx ^. bottomRight + } + +edges :: Neighbors a -> Edges a +edges neighs = Edges + { eTop = neighs ^. top + , eBottom = neighs ^. bottom + , eLeft = neighs ^. left + , eRight = neighs ^. right + } + +neighborDirections :: Neighbors Direction +neighborDirections = Neighbors + { _topLeft = UpLeft + , _top = Up + , _topRight = UpRight + , _left = Left + , _right = Right + , _bottomLeft = DownLeft + , _bottom = Down + , _bottomRight = DownRight + } -instance FromJSON EntityChar where - parseJSON (String (chr :< Empty)) = pure $ EntityChar chr defAttr - parseJSON (Object o) = do - (EntityChar _char _) <- o .: "char" - _style <- o .:? "style" >>= \case - Just styleO -> do - let attrStyle = Default -- TODO - attrURL = Default - attrForeColor <- styleO .:? "foreground" .!= Default - attrBackColor <- styleO .:? "background" .!= Default - pure Attr {..} - Nothing -> pure defAttr - pure EntityChar {..} - parseJSON _ = fail "Invalid type, expected string or object" - -instance Draw EntityChar where - draw EntityChar{..} = raw $ Vty.string _style [_char] +neighborPositions :: Position -> Neighbors Position +neighborPositions pos = (`move` pos) <$> neighborDirections diff --git a/src/Xanthous/Data/EntityMap.hs b/src/Xanthous/Data/EntityMap.hs index e3ceb6f651..401e395547 100644 --- a/src/Xanthous/Data/EntityMap.hs +++ b/src/Xanthous/Data/EntityMap.hs @@ -15,6 +15,7 @@ module Xanthous.Data.EntityMap , lookup , lookupWithPosition -- , positionedEntities + , neighbors ) where import Data.Monoid (Endo(..)) @@ -22,7 +23,14 @@ import Test.QuickCheck (Arbitrary(..)) import Test.QuickCheck.Checkers (EqProp) import Xanthous.Prelude hiding (lookup) -import Xanthous.Data (Position, Positioned(..), positioned, position) +import Xanthous.Data + ( Position + , Positioned(..) + , positioned + , position + , Neighbors(..) + , neighborPositions + ) import Xanthous.Orphans () import Xanthous.Util (EqEqProp(..)) @@ -139,3 +147,6 @@ lookup eid = fmap (view positioned) . lookupWithPosition eid -- unlawful :( -- positionedEntities :: IndexedTraversal EntityID (EntityMap a) (EntityMap b) (Positioned a) (Positioned b) -- positionedEntities = byID . itraversed + +neighbors :: Position -> EntityMap a -> Neighbors (Vector a) +neighbors pos em = (\p -> view (atPosition p) em) <$> neighborPositions pos diff --git a/src/Xanthous/Entities.hs b/src/Xanthous/Entities.hs index 6851a7a5d5..bd52ae62b2 100644 --- a/src/Xanthous/Entities.hs +++ b/src/Xanthous/Entities.hs @@ -1,23 +1,65 @@ +{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE UndecidableInstances #-} - +{-# LANGUAGE GADTs #-} +{-# LANGUAGE AllowAmbiguousTypes #-} +-------------------------------------------------------------------------------- module Xanthous.Entities ( Draw(..) , DrawCharacter(..) , DrawStyledCharacter(..) , Entity + , SomeEntity(..) + , downcastEntity + , entityIs , Color(..) , KnownColor(..) - ) where -import Xanthous.Prelude -import Brick -import Data.Typeable + , EntityChar(..) + ) where +-------------------------------------------------------------------------------- +import Xanthous.Prelude +-------------------------------------------------------------------------------- +import Brick +import Data.Typeable import qualified Graphics.Vty.Attributes as Vty import qualified Graphics.Vty.Image as Vty +import Data.Aeson +-------------------------------------------------------------------------------- +import Xanthous.Data +-------------------------------------------------------------------------------- + +class (Show a, Eq a, Draw a) => Entity a +instance (Show a, Eq a, Draw a) => Entity a + +-------------------------------------------------------------------------------- +data SomeEntity where + SomeEntity :: forall a. (Entity a, Typeable a) => a -> SomeEntity + +instance Show SomeEntity where + show (SomeEntity e) = "SomeEntity (" <> show e <> ")" + +instance Eq SomeEntity where + (SomeEntity (a :: ea)) == (SomeEntity (b :: eb)) = case eqT @ea @eb of + Just Refl -> a == b + _ -> False + +instance Draw SomeEntity where + drawWithNeighbors ns (SomeEntity ent) = drawWithNeighbors ns ent + +downcastEntity :: (Entity a, Typeable a) => SomeEntity -> Maybe a +downcastEntity (SomeEntity e) = cast e + +entityIs :: forall a. (Entity a, Typeable a) => SomeEntity -> Bool +entityIs = isJust . downcastEntity @a +-------------------------------------------------------------------------------- class Draw a where + drawWithNeighbors :: Neighbors (Vector SomeEntity) -> a -> Widget n + drawWithNeighbors = const draw + draw :: a -> Widget n + draw = drawWithNeighbors $ pure mempty newtype DrawCharacter (char :: Symbol) (a :: Type) where DrawCharacter :: a -> DrawCharacter char a @@ -57,8 +99,30 @@ instance , Vty.attrBackColor = Vty.SetTo $ colorVal @bg Proxy , Vty.attrURL = Vty.Default } - -------------------------------------------------------------------------------- +data EntityChar = EntityChar + { _char :: Char + , _style :: Vty.Attr + } + deriving stock (Show, Eq, Generic) + deriving anyclass (NFData) -class (Show a, Eq a, Draw a) => Entity a -instance (Show a, Eq a, Draw a) => Entity a +instance FromJSON EntityChar where + parseJSON (String (chr :< Empty)) = pure $ EntityChar chr Vty.defAttr + parseJSON (Object o) = do + (EntityChar _char _) <- o .: "char" + _style <- o .:? "style" >>= \case + Just styleO -> do + let attrStyle = Vty.Default -- TODO + attrURL = Vty.Default + attrForeColor <- styleO .:? "foreground" .!= Vty.Default + attrBackColor <- styleO .:? "background" .!= Vty.Default + pure Vty.Attr {..} + Nothing -> pure Vty.defAttr + pure EntityChar {..} + parseJSON _ = fail "Invalid type, expected string or object" + +instance Draw EntityChar where + draw EntityChar{..} = raw $ Vty.string _style [_char] + +-------------------------------------------------------------------------------- diff --git a/src/Xanthous/Entities/Arbitrary.hs b/src/Xanthous/Entities/Arbitrary.hs new file mode 100644 index 0000000000..9153722d9b --- /dev/null +++ b/src/Xanthous/Entities/Arbitrary.hs @@ -0,0 +1,19 @@ +{-# OPTIONS_GHC -fno-warn-orphans #-} +-------------------------------------------------------------------------------- +module Xanthous.Entities.Arbitrary () where +-------------------------------------------------------------------------------- +import Xanthous.Prelude +-------------------------------------------------------------------------------- +import Test.QuickCheck +import qualified Test.QuickCheck.Gen as Gen +-------------------------------------------------------------------------------- +import Xanthous.Entities (SomeEntity(..)) +import Xanthous.Entities.Character +import Xanthous.Entities.Environment +-------------------------------------------------------------------------------- + +instance Arbitrary SomeEntity where + arbitrary = Gen.oneof + [ pure $ SomeEntity Character + , pure $ SomeEntity Wall + ] diff --git a/src/Xanthous/Entities/Character.hs b/src/Xanthous/Entities/Character.hs index 5cf397e822..faa9964a38 100644 --- a/src/Xanthous/Entities/Character.hs +++ b/src/Xanthous/Entities/Character.hs @@ -2,14 +2,14 @@ module Xanthous.Entities.Character ( Character(..) , mkCharacter ) where - +-------------------------------------------------------------------------------- import Xanthous.Prelude import Test.QuickCheck - +-------------------------------------------------------------------------------- import Xanthous.Entities +-------------------------------------------------------------------------------- -data Character where - Character :: Character +data Character = Character deriving stock (Show, Eq, Ord, Generic) deriving anyclass (CoArbitrary, Function) deriving Draw via (DrawCharacter "@" Character) diff --git a/src/Xanthous/Entities/Draw/Util.hs b/src/Xanthous/Entities/Draw/Util.hs new file mode 100644 index 0000000000..aa6c5fa4fc --- /dev/null +++ b/src/Xanthous/Entities/Draw/Util.hs @@ -0,0 +1,31 @@ +module Xanthous.Entities.Draw.Util where +-------------------------------------------------------------------------------- +import Xanthous.Prelude +-------------------------------------------------------------------------------- +import Brick.Widgets.Border.Style +import Brick.Types (Edges(..)) +-------------------------------------------------------------------------------- + +borderFromEdges :: BorderStyle -> Edges Bool -> Char +borderFromEdges bstyle edges = ($ bstyle) $ case edges of + Edges False False False False -> const '☐' + + Edges True False False False -> bsVertical + Edges False True False False -> bsVertical + Edges False False True False -> bsHorizontal + Edges False False False True -> bsHorizontal + + Edges True True False False -> bsVertical + Edges True False True False -> bsCornerBR + Edges True False False True -> bsCornerBL + + Edges False True True False -> bsCornerTR + Edges False True False True -> bsCornerTL + Edges False False True True -> bsHorizontal + + Edges False True True True -> bsIntersectT + Edges True False True True -> bsIntersectB + Edges True True False True -> bsIntersectL + Edges True True True False -> bsIntersectR + + Edges True True True True -> bsIntersectFull diff --git a/src/Xanthous/Entities/Environment.hs b/src/Xanthous/Entities/Environment.hs new file mode 100644 index 0000000000..f5301f94ad --- /dev/null +++ b/src/Xanthous/Entities/Environment.hs @@ -0,0 +1,26 @@ +module Xanthous.Entities.Environment + ( Wall(..) + ) where +-------------------------------------------------------------------------------- +import Xanthous.Prelude +import Test.QuickCheck +import Brick (str) +import Brick.Widgets.Border.Style (unicode) +-------------------------------------------------------------------------------- +import Xanthous.Entities (Draw(..), entityIs) +import Xanthous.Entities.Draw.Util +import Xanthous.Data +-------------------------------------------------------------------------------- + +data Wall = Wall + deriving stock (Show, Eq, Ord, Generic, Enum) + deriving anyclass (CoArbitrary, Function) + +instance Arbitrary Wall where + arbitrary = pure Wall + +instance Draw Wall where + drawWithNeighbors neighs _wall = + str . pure . borderFromEdges unicode $ wallEdges + where + wallEdges = any (entityIs @Wall) <$> edges neighs diff --git a/src/Xanthous/Entities/RawTypes.hs b/src/Xanthous/Entities/RawTypes.hs index e82cb0c890..88087a5dab 100644 --- a/src/Xanthous/Entities/RawTypes.hs +++ b/src/Xanthous/Entities/RawTypes.hs @@ -20,7 +20,7 @@ import Data.Aeson.Generic.DerivingVia import Data.Aeson (FromJSON) import Data.Word -import Xanthous.Data +import Xanthous.Entities (EntityChar) data CreatureType = CreatureType { _name :: Text diff --git a/src/Xanthous/Entities/SomeEntity.hs b/src/Xanthous/Entities/SomeEntity.hs deleted file mode 100644 index 029247de9b..0000000000 --- a/src/Xanthous/Entities/SomeEntity.hs +++ /dev/null @@ -1,34 +0,0 @@ -{-# LANGUAGE GADTs #-} -module Xanthous.Entities.SomeEntity - ( SomeEntity(..) - , downcastEntity - ) where - -import Xanthous.Prelude -import Test.QuickCheck (Arbitrary(..)) -import qualified Test.QuickCheck.Gen as Gen - -import Xanthous.Entities (Draw(..), Entity) -import Data.Typeable -import Xanthous.Entities.Character - -data SomeEntity where - SomeEntity :: forall a. (Entity a, Typeable a) => a -> SomeEntity - -instance Show SomeEntity where - show (SomeEntity x) = "SomeEntity (" <> show x <> ")" - -instance Eq SomeEntity where - (SomeEntity (a :: ea)) == (SomeEntity (b :: eb)) = case eqT @ea @eb of - Just Refl -> a == b - _ -> False - -instance Arbitrary SomeEntity where - arbitrary = Gen.oneof - [pure $ SomeEntity Character] - -instance Draw SomeEntity where - draw (SomeEntity ent) = draw ent - -downcastEntity :: (Entity a, Typeable a) => SomeEntity -> Maybe a -downcastEntity (SomeEntity e) = cast e diff --git a/src/Xanthous/Game.hs b/src/Xanthous/Game.hs index dffd0a9c6a..e967098015 100644 --- a/src/Xanthous/Game.hs +++ b/src/Xanthous/Game.hs @@ -1,5 +1,6 @@ {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE RecordWildCards #-} +-------------------------------------------------------------------------------- module Xanthous.Game ( GameState(..) , entities @@ -17,20 +18,23 @@ module Xanthous.Game , popMessage , hideMessage ) where - +-------------------------------------------------------------------------------- +import Xanthous.Prelude +-------------------------------------------------------------------------------- import Data.List.NonEmpty ( NonEmpty((:|))) import qualified Data.List.NonEmpty as NonEmpty import System.Random import Test.QuickCheck import Test.QuickCheck.Arbitrary.Generic -import Xanthous.Prelude - +-------------------------------------------------------------------------------- import Xanthous.Data.EntityMap (EntityMap, EntityID) import qualified Xanthous.Data.EntityMap as EntityMap import Xanthous.Data (Positioned, Position(..), positioned, position) -import Xanthous.Entities.SomeEntity +import Xanthous.Entities (SomeEntity(..), downcastEntity) import Xanthous.Entities.Character +import Xanthous.Entities.Arbitrary () import Xanthous.Orphans () +-------------------------------------------------------------------------------- data MessageHistory = NoMessageHistory diff --git a/src/Xanthous/Game/Draw.hs b/src/Xanthous/Game/Draw.hs index 36abe16119..4d3cb15dca 100644 --- a/src/Xanthous/Game/Draw.hs +++ b/src/Xanthous/Game/Draw.hs @@ -11,7 +11,8 @@ import Brick.Widgets.Border.Style import Data.List.NonEmpty(NonEmpty((:|))) import Xanthous.Data (Position(Position), x, y, loc) -import Xanthous.Data.EntityMap +import Xanthous.Data.EntityMap (EntityMap, atPosition) +import qualified Xanthous.Data.EntityMap as EntityMap import Xanthous.Entities import Xanthous.Game ( GameState(..) @@ -34,16 +35,19 @@ drawMessages (MessageHistory (lastMessage :| _) True) = txt lastMessage -- (MessageHistory _ False) -> padTop (Pad 2) $ str " " -- (MessageHistory (lastMessage :| _) True) -> txt lastMessage -drawEntities :: (Draw a, Show a) => EntityMap a -> Widget Name +drawEntities :: EntityMap SomeEntity -> Widget Name drawEntities em = vBox rows where - entityPositions = positions em + entityPositions = EntityMap.positions em maxY = fromMaybe 0 $ maximumOf (folded . y) entityPositions maxX = fromMaybe 0 $ maximumOf (folded . x) entityPositions rows = mkRow <$> [0..maxY] mkRow rowY = hBox $ renderEntityAt . flip Position rowY <$> [0..maxX] - renderEntityAt pos = maybe (str " ") draw $ em ^? atPosition pos . folded + renderEntityAt pos = + let neighbors = EntityMap.neighbors pos em + in maybe (str " ") (drawWithNeighbors neighbors) + $ em ^? atPosition pos . folded drawMap :: GameState -> Widget Name drawMap game diff --git a/src/Xanthous/Generators.hs b/src/Xanthous/Generators.hs index c266742b05..740b39c5f0 100644 --- a/src/Xanthous/Generators.hs +++ b/src/Xanthous/Generators.hs @@ -1,14 +1,19 @@ {-# LANGUAGE GADTs #-} - +-------------------------------------------------------------------------------- module Xanthous.Generators where - -import Xanthous.Prelude -import Data.Array.Unboxed -import System.Random (RandomGen) +-------------------------------------------------------------------------------- +import Xanthous.Prelude +import Data.Array.Unboxed +import System.Random (RandomGen) import qualified Options.Applicative as Opt - +-------------------------------------------------------------------------------- import qualified Xanthous.Generators.CaveAutomata as CaveAutomata -import Xanthous.Data (Dimensions) +import Xanthous.Generators.Util +import Xanthous.Data (Dimensions, Position(Position)) +import Xanthous.Data.EntityMap (EntityMap) +import qualified Xanthous.Data.EntityMap as EntityMap +import Xanthous.Entities.Environment +-------------------------------------------------------------------------------- data Generator = CaveAutomata deriving stock (Show, Eq) @@ -52,3 +57,14 @@ showCells arr = row r = foldMap (showCell . (, r)) [minX..maxX] rows = row <$> [minY..maxY] in intercalate "\n" rows + +cellsToWalls :: UArray (Word, Word) Bool -> EntityMap Wall +cellsToWalls cells = foldl' maybeInsertWall mempty . assocs $ cells + where + maybeInsertWall em (pos@(x, y), True) + | not (surroundedOnAllSides pos) = + let x' = fromIntegral x + y' = fromIntegral y + in EntityMap.insertAt (Position x' y') Wall em + maybeInsertWall em _ = em + surroundedOnAllSides pos = numAliveNeighbors cells pos == 8 diff --git a/src/Xanthous/Generators/Util.hs b/src/Xanthous/Generators/Util.hs index 3f0d691b7f..260c41ac60 100644 --- a/src/Xanthous/Generators/Util.hs +++ b/src/Xanthous/Generators/Util.hs @@ -5,6 +5,7 @@ module Xanthous.Generators.Util , CellM , randInitialize , numAliveNeighborsM + , numAliveNeighbors , cloneMArray ) where @@ -58,6 +59,34 @@ numAliveNeighborsM cells (x, y) = do neighborPositions :: [(Int, Int)] neighborPositions = [(i, j) | i <- [-1..1], j <- [-1..1], (i, j) /= (0, 0)] +numAliveNeighbors + :: forall a i j + . (IArray a Bool, Ix (i, j), Integral i, Integral j) + => a (i, j) Bool + -> (i, j) + -> Word +numAliveNeighbors cells (x, y) = + let cellBounds = bounds cells + in getSum $ foldMap + (Sum . fromIntegral . fromEnum . boundedGet cellBounds) + neighborPositions + + where + boundedGet :: ((i, j), (i, j)) -> (Int, Int) -> Bool + boundedGet ((minX, minY), (maxX, maxY)) (i, j) + | x <= minX + || y <= minY + || x >= maxX + || y >= maxY + = True + | otherwise = + let nx = fromIntegral $ fromIntegral x + i + ny = fromIntegral $ fromIntegral y + j + in cells ! (nx, ny) + + neighborPositions :: [(Int, Int)] + neighborPositions = [(i, j) | i <- [-1..1], j <- [-1..1], (i, j) /= (0, 0)] + cloneMArray :: forall a a' i e m. ( Ix i diff --git a/src/Xanthous/Monad.hs b/src/Xanthous/Monad.hs index fb790d5f9c..acf7775ede 100644 --- a/src/Xanthous/Monad.hs +++ b/src/Xanthous/Monad.hs @@ -4,6 +4,7 @@ module Xanthous.Monad , continue , halt , say + , say_ ) where import Xanthous.Prelude @@ -56,3 +57,6 @@ instance (Monad m, ToJSON params) => SayR (params -> AppT m ()) where say msgPath params = do msg <- message msgPath params messageHistory %= pushMessage msg + +say_ :: Monad m => [Text] -> AppT m () +say_ = say diff --git a/src/Xanthous/Orphans.hs b/src/Xanthous/Orphans.hs index 3efe1f1264..c84756eb1e 100644 --- a/src/Xanthous/Orphans.hs +++ b/src/Xanthous/Orphans.hs @@ -2,23 +2,24 @@ {-# LANGUAGE ViewPatterns #-} {-# LANGUAGE UndecidableInstances, PatternSynonyms #-} {-# OPTIONS_GHC -Wno-orphans #-} --- | - +-------------------------------------------------------------------------------- module Xanthous.Orphans ( ppTemplate ) where - -import Xanthous.Prelude hiding (elements) -import Text.Mustache -import Test.QuickCheck -import Data.Text.Arbitrary () -import Text.Megaparsec (errorBundlePretty) -import Text.Megaparsec.Pos -import Text.Mustache.Type ( showKey ) -import Data.List.NonEmpty (NonEmpty(..)) +-------------------------------------------------------------------------------- +import Xanthous.Prelude hiding (elements) +-------------------------------------------------------------------------------- +import Data.Aeson +import Data.List.NonEmpty (NonEmpty(..)) import qualified Data.List.NonEmpty as NonEmpty -import Data.Aeson -import Graphics.Vty.Attributes +import Data.Text.Arbitrary () +import Graphics.Vty.Attributes +import Test.QuickCheck +import Text.Megaparsec (errorBundlePretty) +import Text.Megaparsec.Pos +import Text.Mustache +import Text.Mustache.Type ( showKey ) +-------------------------------------------------------------------------------- instance forall s a. ( Cons s s a a @@ -181,3 +182,4 @@ instance ToJSON Color where instance (Eq a, Show a, Read a, FromJSON a) => FromJSON (MaybeDefault a) where parseJSON Null = pure Default parseJSON x = SetTo <$> parseJSON x + diff --git a/test/Xanthous/GameSpec.hs b/test/Xanthous/GameSpec.hs index 9319399ac2..dbd1677f7e 100644 --- a/test/Xanthous/GameSpec.hs +++ b/test/Xanthous/GameSpec.hs @@ -5,7 +5,7 @@ import Xanthous.Game import Control.Lens.Properties import Xanthous.Data (move, Direction(Down)) import Xanthous.Data.EntityMap (atPosition) -import Xanthous.Entities.SomeEntity +import Xanthous.Entities (SomeEntity(SomeEntity)) main :: IO () main = defaultMain test diff --git a/test/Xanthous/Generators/UtilSpec.hs b/test/Xanthous/Generators/UtilSpec.hs index a1c2f79d60..c82c385987 100644 --- a/test/Xanthous/Generators/UtilSpec.hs +++ b/test/Xanthous/Generators/UtilSpec.hs @@ -41,7 +41,7 @@ test = testGroup "Xanthous.Generators.Util" $ randInitialize dims aliveChance in bounds res === ((0, 0), (dims ^. width, dims ^. height)) ] - , testGroup "numAliveNeighbors" + , testGroup "numAliveNeighborsM" [ testProperty "maxes out at 8" $ \(GenArray (arr :: Array (Word, Word) Bool)) loc -> let act :: forall s. ST s Word @@ -51,6 +51,17 @@ test = testGroup "Xanthous.Generators.Util" res = runST act in counterexample (show res) $ between 0 8 res ] + , testGroup "numAliveNeighbors" + [ testProperty "is equivalient to runST . numAliveNeighborsM . thaw" $ + \(GenArray (arr :: Array (Word, Word) Bool)) loc -> + let + act :: forall s. ST s Word + act = do + mArr <- thaw @_ @_ @_ @(STUArray s) arr + numAliveNeighborsM mArr loc + res = runST act + in numAliveNeighbors arr loc === res + ] , testGroup "cloneMArray" [ testCase "clones the array" $ runST $ let diff --git a/xanthous.cabal b/xanthous.cabal index 36a5608805..c3307864fa 100644 --- a/xanthous.cabal +++ b/xanthous.cabal @@ -4,7 +4,7 @@ cabal-version: 1.12 -- -- see: https://github.com/sol/hpack -- --- hash: e01963f3bf85136fe2b6993775d225999898d4c478efef6f917056f726d72e33 +-- hash: 3fbeb53b2706e3f0186fa3c80619a166f64eb52cf045006ac993074fa7f3e9d1 name: xanthous version: 0.1.0.0 @@ -35,11 +35,13 @@ library Xanthous.Data Xanthous.Data.EntityMap Xanthous.Entities + Xanthous.Entities.Arbitrary Xanthous.Entities.Character Xanthous.Entities.Creature + Xanthous.Entities.Draw.Util + Xanthous.Entities.Environment Xanthous.Entities.Raws Xanthous.Entities.RawTypes - Xanthous.Entities.SomeEntity Xanthous.Game Xanthous.Game.Draw Xanthous.Generators @@ -100,11 +102,13 @@ executable xanthous Xanthous.Data Xanthous.Data.EntityMap Xanthous.Entities + Xanthous.Entities.Arbitrary Xanthous.Entities.Character Xanthous.Entities.Creature + Xanthous.Entities.Draw.Util + Xanthous.Entities.Environment Xanthous.Entities.Raws Xanthous.Entities.RawTypes - Xanthous.Entities.SomeEntity Xanthous.Game Xanthous.Game.Draw Xanthous.Generators -- cgit 1.4.1 From c06edf3cc698f36e995719dc6e192c5663110f6d Mon Sep 17 00:00:00 2001 From: Griffin Smith Date: Fri, 13 Sep 2019 15:24:05 -0400 Subject: Place the chacracter in the level at startup time Randomly select a position in the largest contiguous region of the generated level in which to place the character at startup time. --- src/Main.hs | 32 +++++++---- src/Xanthous/App.hs | 28 +++++++-- src/Xanthous/Data.hs | 4 ++ src/Xanthous/Data/EntityMap.hs | 2 +- src/Xanthous/Generators.hs | 8 +-- src/Xanthous/Generators/CaveAutomata.hs | 4 +- src/Xanthous/Generators/LevelContents.hs | 26 +++++++++ src/Xanthous/Generators/Util.hs | 97 +++++++++++++++++++++++++++++--- xanthous.cabal | 4 +- 9 files changed, 171 insertions(+), 34 deletions(-) create mode 100644 src/Xanthous/Generators/LevelContents.hs diff --git a/src/Main.hs b/src/Main.hs index d49e082b7c..2da277b640 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -1,20 +1,23 @@ -module Main where - -import Xanthous.Prelude -import Brick +module Main ( main ) where +-------------------------------------------------------------------------------- +import Xanthous.Prelude +import Brick import qualified Options.Applicative as Opt -import System.Random - -import Xanthous.Game (getInitialState) -import Xanthous.App (makeApp) -import Xanthous.Generators +import System.Random +-------------------------------------------------------------------------------- +import Xanthous.Game (getInitialState) +import Xanthous.App (makeApp) +import Xanthous.Generators ( GeneratorInput(..) , parseGeneratorInput , generateFromInput , showCells ) -import Xanthous.Data (Dimensions, Dimensions'(Dimensions)) - +import Xanthous.Generators.Util (regions) +import Xanthous.Generators.LevelContents +import Xanthous.Data (Dimensions, Dimensions'(Dimensions)) +import Data.Array.IArray ( amap ) +-------------------------------------------------------------------------------- data Command = Run | Generate GeneratorInput Dimensions @@ -61,6 +64,13 @@ runGenerate :: GeneratorInput -> Dimensions -> IO () runGenerate input dims = do randGen <- getStdGen let res = generateFromInput input dims randGen + rs = regions $ amap not res + putStr "num regions: " + print $ length rs + putStr "region lengths: " + print $ length <$> rs + putStr "character position: " + print =<< chooseCharacterPosition res putStrLn $ showCells res runCommand :: Command -> IO () diff --git a/src/Xanthous/App.hs b/src/Xanthous/App.hs index af6b5caf61..0dc24b9d41 100644 --- a/src/Xanthous/App.hs +++ b/src/Xanthous/App.hs @@ -9,7 +9,13 @@ import Control.Monad.State (get) import Control.Monad.Random (getRandom) -------------------------------------------------------------------------------- import Xanthous.Command -import Xanthous.Data (move, Position(..), Dimensions'(Dimensions), Dimensions) +import Xanthous.Data + ( move + , Position(..) + , Dimensions'(Dimensions) + , Dimensions + , positionFromPair + ) import qualified Xanthous.Data.EntityMap as EntityMap import Xanthous.Data.EntityMap (EntityMap) import Xanthous.Game @@ -24,6 +30,7 @@ import Xanthous.Entities.Raws (raw) import Xanthous.Entities import Xanthous.Generators import qualified Xanthous.Generators.CaveAutomata as CaveAutomata +import Xanthous.Generators.LevelContents -------------------------------------------------------------------------------- type App = Brick.App GameState () Name @@ -49,10 +56,13 @@ testGormlak = startEvent :: AppM () startEvent = do say_ ["welcome"] - level <- generateLevel SCaveAutomata CaveAutomata.defaultParams - $ Dimensions 120 80 + (level, charPos) <- + generateLevel SCaveAutomata CaveAutomata.defaultParams + $ Dimensions 80 80 entities <>= level - entities %= EntityMap.insertAt (Position 10 10) (SomeEntity testGormlak) + characterPosition .= charPos + -- entities %= EntityMap.insertAt (Position 10 10) (SomeEntity testGormlak) + handleEvent :: BrickEvent Name () -> AppM (Next GameState) handleEvent (VtyEvent (EvKey k mods)) @@ -73,9 +83,15 @@ handleCommand PreviousMessage = do -------------------------------------------------------------------------------- -generateLevel :: SGenerator gen -> Params gen -> Dimensions -> AppM (EntityMap SomeEntity) +generateLevel + :: SGenerator gen + -> Params gen + -> Dimensions + -> AppM (EntityMap SomeEntity, Position) generateLevel g ps dims = do gen <- use randomGen let cells = generate g ps dims gen _ <- getRandom @_ @Int -- perturb the generator, so we don't get the same level twice - pure $ SomeEntity <$> cellsToWalls cells + charPos <- positionFromPair <$> chooseCharacterPosition cells + let level = SomeEntity <$> cellsToWalls cells + pure (level, charPos) diff --git a/src/Xanthous/Data.hs b/src/Xanthous/Data.hs index e435526384..468e59217c 100644 --- a/src/Xanthous/Data.hs +++ b/src/Xanthous/Data.hs @@ -15,6 +15,7 @@ module Xanthous.Data , position , positioned , loc + , positionFromPair -- * , Dimensions'(..) @@ -91,6 +92,9 @@ loc = iso hither yon hither (Position px py) = Location (px, py) yon (Location (lx, ly)) = Position lx ly +positionFromPair :: (Integral i, Integral j) => (i, j) -> Position +positionFromPair (i, j) = Position (fromIntegral i) (fromIntegral j) + -------------------------------------------------------------------------------- data Dimensions' a = Dimensions diff --git a/src/Xanthous/Data/EntityMap.hs b/src/Xanthous/Data/EntityMap.hs index 401e395547..e713aff32c 100644 --- a/src/Xanthous/Data/EntityMap.hs +++ b/src/Xanthous/Data/EntityMap.hs @@ -101,7 +101,7 @@ _EntityMap = iso hither yon yon poses = alaf Endo foldMap (uncurry insertAt) poses emptyEntityMap instance Semigroup (EntityMap a) where - em₁ <> em₂ = alaf Endo foldMap (uncurry insertAt) (em₁ ^. _EntityMap) em₂ + em₁ <> em₂ = alaf Endo foldMap (uncurry insertAt) (em₂ ^. _EntityMap) em₁ instance Monoid (EntityMap a) where mempty = emptyEntityMap diff --git a/src/Xanthous/Generators.hs b/src/Xanthous/Generators.hs index 740b39c5f0..6e2e89d14a 100644 --- a/src/Xanthous/Generators.hs +++ b/src/Xanthous/Generators.hs @@ -33,13 +33,13 @@ generate -> Params gen -> Dimensions -> g - -> UArray (Word, Word) Bool + -> Cells generate SCaveAutomata = CaveAutomata.generate data GeneratorInput where GeneratorInput :: forall gen. SGenerator gen -> Params gen -> GeneratorInput -generateFromInput :: RandomGen g => GeneratorInput -> Dimensions -> g -> UArray (Word, Word) Bool +generateFromInput :: RandomGen g => GeneratorInput -> Dimensions -> g -> Cells generateFromInput (GeneratorInput sg ps) = generate sg ps parseGeneratorInput :: Opt.Parser GeneratorInput @@ -48,7 +48,7 @@ parseGeneratorInput = Opt.subparser $ (GeneratorInput <$> pure SCaveAutomata <*> CaveAutomata.parseParams) (Opt.progDesc "cellular-automata based cave generator")) -showCells :: UArray (Word, Word) Bool -> Text +showCells :: Cells -> Text showCells arr = let ((minX, minY), (maxX, maxY)) = bounds arr showCellVal True = "x" @@ -58,7 +58,7 @@ showCells arr = rows = row <$> [minY..maxY] in intercalate "\n" rows -cellsToWalls :: UArray (Word, Word) Bool -> EntityMap Wall +cellsToWalls :: Cells -> EntityMap Wall cellsToWalls cells = foldl' maybeInsertWall mempty . assocs $ cells where maybeInsertWall em (pos@(x, y), True) diff --git a/src/Xanthous/Generators/CaveAutomata.hs b/src/Xanthous/Generators/CaveAutomata.hs index bf37cb3f08..a2f0a165e3 100644 --- a/src/Xanthous/Generators/CaveAutomata.hs +++ b/src/Xanthous/Generators/CaveAutomata.hs @@ -92,7 +92,7 @@ generate params dims gen $ flip runRandT gen $ generate' params dims -generate' :: RandomGen g => Params -> Dimensions -> CellM g s (Cells s) +generate' :: RandomGen g => Params -> Dimensions -> CellM g s (MCells s) generate' params dims = do cells <- randInitialize dims $ params ^. aliveStartChance let steps' = params ^. steps @@ -100,7 +100,7 @@ generate' params dims = do $ for_ [0 .. pred steps'] . const $ stepAutomata cells dims params pure cells -stepAutomata :: forall s g. Cells s -> Dimensions -> Params -> CellM g s () +stepAutomata :: forall s g. MCells s -> Dimensions -> Params -> CellM g s () stepAutomata cells dims params = do origCells <- lift $ cloneMArray @_ @(STUArray s) cells for_ (range ((0, 0), (dims ^. width, dims ^. height))) $ \pos -> do diff --git a/src/Xanthous/Generators/LevelContents.hs b/src/Xanthous/Generators/LevelContents.hs new file mode 100644 index 0000000000..f8d9b8a204 --- /dev/null +++ b/src/Xanthous/Generators/LevelContents.hs @@ -0,0 +1,26 @@ +-------------------------------------------------------------------------------- +module Xanthous.Generators.LevelContents + ( chooseCharacterPosition + ) where +-------------------------------------------------------------------------------- +import Xanthous.Prelude +-------------------------------------------------------------------------------- +import Control.Monad.Random +import Data.Array.IArray (amap) +-------------------------------------------------------------------------------- +import Xanthous.Generators.Util +import Xanthous.Random +-------------------------------------------------------------------------------- + +chooseCharacterPosition :: MonadRandom m => Cells -> m (Word, Word) +chooseCharacterPosition cells = choose $ impureNonNull candidates + where + -- cells ends up with true = wall, we want true = can put a character here + placeableCells = amap not cells + + -- find the largest contiguous region of cells in the cave. + candidates + = maximumBy (compare `on` length) + $ fromMaybe (error "No regions generated! this should never happen.") + $ fromNullable + $ regions placeableCells diff --git a/src/Xanthous/Generators/Util.hs b/src/Xanthous/Generators/Util.hs index 260c41ac60..47ee81b293 100644 --- a/src/Xanthous/Generators/Util.hs +++ b/src/Xanthous/Generators/Util.hs @@ -1,28 +1,34 @@ --- | - +{-# LANGUAGE ViewPatterns #-} +-------------------------------------------------------------------------------- module Xanthous.Generators.Util - ( Cells + ( MCells + , Cells , CellM , randInitialize , numAliveNeighborsM , numAliveNeighbors , cloneMArray + , floodFill + , regions ) where - -import Xanthous.Prelude +-------------------------------------------------------------------------------- +import Xanthous.Prelude hiding (Foldable, toList) import Data.Array.ST import Data.Array.Unboxed import Control.Monad.ST import Control.Monad.Random import Data.Monoid - -import Xanthous.Util (foldlMapM') +import Data.Foldable (Foldable, toList) +-------------------------------------------------------------------------------- +import Xanthous.Util (foldlMapM', between) import Xanthous.Data (Dimensions, width, height) +-------------------------------------------------------------------------------- -type Cells s = STUArray s (Word, Word) Bool +type MCells s = STUArray s (Word, Word) Bool +type Cells = UArray (Word, Word) Bool type CellM g s a = RandT g (ST s) a -randInitialize :: RandomGen g => Dimensions -> Double -> CellM g s (Cells s) +randInitialize :: RandomGen g => Dimensions -> Double -> CellM g s (MCells s) randInitialize dims aliveChance = do res <- lift $ newArray ((0, 0), (dims ^. width, dims ^. height)) False for_ [0..dims ^. width] $ \i -> @@ -87,6 +93,14 @@ numAliveNeighbors cells (x, y) = neighborPositions :: [(Int, Int)] neighborPositions = [(i, j) | i <- [-1..1], j <- [-1..1], (i, j) /= (0, 0)] +safeGet :: (IArray a e, Ix i) => a i e -> i -> Maybe e +safeGet arr idx = + let (minIdx, maxIdx) = bounds arr + in if idx < minIdx || idx > maxIdx + then Nothing + else Just $ arr ! idx + + cloneMArray :: forall a a' i e m. ( Ix i @@ -97,3 +111,68 @@ cloneMArray => a i e -> m (a' i e) cloneMArray = thaw @_ @UArray <=< freeze + +-------------------------------------------------------------------------------- + +-- | Flood fill a cell array starting at a point, returning a list of all the +-- (true) cell locations reachable from that point +floodFill :: forall a i j. + ( IArray a Bool + , Ix (i, j) + , Enum i , Enum j + , Bounded i , Bounded j + , Eq i , Eq j + , Show i, Show j + ) + => a (i, j) Bool -- ^ array + -> (i, j) -- ^ position + -> Set (i, j) +floodFill = go mempty + where + go :: Set (i, j) -> a (i, j) Bool -> (i, j) -> Set (i, j) + -- TODO pass result in rather than passing seen in, return result + go res arr@(bounds -> arrBounds) idx@(x, y) + | not (inRange arrBounds idx) = res + | not (arr ! idx) = res + | otherwise = + let neighbors + = filter (inRange arrBounds) + . filter (/= idx) + . filter (`notMember` res) + $ (,) + <$> [(if x == minBound then x else pred x) + .. + (if x == maxBound then x else succ x)] + <*> [(if y == minBound then y else pred y) + .. + (if y == maxBound then y else succ y)] + in foldl' (\r idx' -> + if arr ! idx' + then r <> go (r & contains idx' .~ True) arr idx' + else r) + (res & contains idx .~ True) neighbors + +-- | Gives a list of all the disconnected regions in a cell array, represented +-- each as lists of points +regions :: forall a i j. + ( IArray a Bool + , Ix (i, j) + , Enum i , Enum j + , Bounded i , Bounded j + , Eq i , Eq j + , Show i, Show j + ) + => a (i, j) Bool + -> [Set (i, j)] +regions arr + | Just firstPoint <- findFirstPoint arr = + let region = floodFill arr firstPoint + arr' = fillAll region arr + in region : regions arr' + | otherwise = [] + where + findFirstPoint :: a (i, j) Bool -> Maybe (i, j) + findFirstPoint = fmap fst . headMay . filter snd . assocs + + fillAll :: Foldable f => f (i, j) -> a (i, j) Bool -> a (i, j) Bool + fillAll ixes a = accum (const fst) a $ (, (False, ())) <$> toList ixes diff --git a/xanthous.cabal b/xanthous.cabal index c3307864fa..a8cd8d213d 100644 --- a/xanthous.cabal +++ b/xanthous.cabal @@ -4,7 +4,7 @@ cabal-version: 1.12 -- -- see: https://github.com/sol/hpack -- --- hash: 3fbeb53b2706e3f0186fa3c80619a166f64eb52cf045006ac993074fa7f3e9d1 +-- hash: a79caccff8895730c394c19244f068830759636d17f55f3b6d1d8a9ebe43ecdd name: xanthous version: 0.1.0.0 @@ -46,6 +46,7 @@ library Xanthous.Game.Draw Xanthous.Generators Xanthous.Generators.CaveAutomata + Xanthous.Generators.LevelContents Xanthous.Generators.Util Xanthous.Messages Xanthous.Monad @@ -113,6 +114,7 @@ executable xanthous Xanthous.Game.Draw Xanthous.Generators Xanthous.Generators.CaveAutomata + Xanthous.Generators.LevelContents Xanthous.Generators.Util Xanthous.Messages Xanthous.Monad -- cgit 1.4.1 From 33c831d23d09d1e80a1dcfacb373dcedec55f694 Mon Sep 17 00:00:00 2001 From: Griffin Smith Date: Sat, 14 Sep 2019 15:10:51 -0400 Subject: Implement collision Check if there's a wall or other entity where the character is going, and stop the character from going there --- src/Xanthous/App.hs | 7 +++++-- src/Xanthous/Game.hs | 25 ++++++++++++++++++++++++- 2 files changed, 29 insertions(+), 3 deletions(-) diff --git a/src/Xanthous/App.hs b/src/Xanthous/App.hs index 0dc24b9d41..82c32f05a3 100644 --- a/src/Xanthous/App.hs +++ b/src/Xanthous/App.hs @@ -16,7 +16,6 @@ import Xanthous.Data , Dimensions , positionFromPair ) -import qualified Xanthous.Data.EntityMap as EntityMap import Xanthous.Data.EntityMap (EntityMap) import Xanthous.Game import Xanthous.Game.Draw (drawGame) @@ -74,7 +73,11 @@ handleEvent _ = continue handleCommand :: Command -> AppM (Next GameState) handleCommand Quit = halt handleCommand (Move dir) = do - characterPosition %= move dir + newPos <- uses characterPosition $ move dir + collisionAt newPos >>= \case + Nothing -> characterPosition .= newPos + Just Combat -> undefined + Just Stop -> pure () continue handleCommand PreviousMessage = do diff --git a/src/Xanthous/Game.hs b/src/Xanthous/Game.hs index e967098015..6a46896106 100644 --- a/src/Xanthous/Game.hs +++ b/src/Xanthous/Game.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE MultiWayIf #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE RecordWildCards #-} -------------------------------------------------------------------------------- @@ -17,6 +18,10 @@ module Xanthous.Game , pushMessage , popMessage , hideMessage + + -- * collisions + , Collision(..) + , collisionAt ) where -------------------------------------------------------------------------------- import Xanthous.Prelude @@ -26,12 +31,14 @@ import qualified Data.List.NonEmpty as NonEmpty import System.Random import Test.QuickCheck import Test.QuickCheck.Arbitrary.Generic +import Control.Monad.State.Class -------------------------------------------------------------------------------- import Xanthous.Data.EntityMap (EntityMap, EntityID) import qualified Xanthous.Data.EntityMap as EntityMap import Xanthous.Data (Positioned, Position(..), positioned, position) -import Xanthous.Entities (SomeEntity(..), downcastEntity) +import Xanthous.Entities (SomeEntity(..), downcastEntity, entityIs) import Xanthous.Entities.Character +import Xanthous.Entities.Creature import Xanthous.Entities.Arbitrary () import Xanthous.Orphans () -------------------------------------------------------------------------------- @@ -122,3 +129,19 @@ character = positionedCharacter . positioned characterPosition :: Lens' GameState Position characterPosition = positionedCharacter . position + +-------------------------------------------------------------------------------- + +data Collision + = Stop + | Combat + deriving stock (Show, Eq, Ord, Generic) + deriving anyclass (NFData) + +collisionAt :: MonadState GameState m => Position -> m (Maybe Collision) +collisionAt pos = do + ents <- use $ entities . EntityMap.atPosition pos + pure $ + if | null ents -> Nothing + | any (entityIs @Creature) ents -> pure Combat + | otherwise -> pure Stop -- cgit 1.4.1 From 6678ac986c0ccdc2a809da4fc99de7bcc0eb21f4 Mon Sep 17 00:00:00 2001 From: Griffin Smith Date: Sat, 14 Sep 2019 15:16:27 -0400 Subject: Fill the outer edges of generated levels To avoid the character being able to go OOB. This is something we had in the Rust version but I hadn't ported over yet --- src/Xanthous/Generators/CaveAutomata.hs | 1 + src/Xanthous/Generators/Util.hs | 13 ++++++++++++- 2 files changed, 13 insertions(+), 1 deletion(-) diff --git a/src/Xanthous/Generators/CaveAutomata.hs b/src/Xanthous/Generators/CaveAutomata.hs index a2f0a165e3..fd4c68ddbe 100644 --- a/src/Xanthous/Generators/CaveAutomata.hs +++ b/src/Xanthous/Generators/CaveAutomata.hs @@ -98,6 +98,7 @@ generate' params dims = do let steps' = params ^. steps when (steps' > 0) $ for_ [0 .. pred steps'] . const $ stepAutomata cells dims params + lift $ fillOuterEdgesM cells pure cells stepAutomata :: forall s g. MCells s -> Dimensions -> Params -> CellM g s () diff --git a/src/Xanthous/Generators/Util.hs b/src/Xanthous/Generators/Util.hs index 47ee81b293..6a2d27839c 100644 --- a/src/Xanthous/Generators/Util.hs +++ b/src/Xanthous/Generators/Util.hs @@ -7,6 +7,7 @@ module Xanthous.Generators.Util , randInitialize , numAliveNeighborsM , numAliveNeighbors + , fillOuterEdgesM , cloneMArray , floodFill , regions @@ -20,7 +21,7 @@ import Control.Monad.Random import Data.Monoid import Data.Foldable (Foldable, toList) -------------------------------------------------------------------------------- -import Xanthous.Util (foldlMapM', between) +import Xanthous.Util (foldlMapM') import Xanthous.Data (Dimensions, width, height) -------------------------------------------------------------------------------- @@ -93,6 +94,16 @@ numAliveNeighbors cells (x, y) = neighborPositions :: [(Int, Int)] neighborPositions = [(i, j) | i <- [-1..1], j <- [-1..1], (i, j) /= (0, 0)] +fillOuterEdgesM :: (MArray a Bool m, Ix i, Ix j) => a (i, j) Bool -> m () +fillOuterEdgesM arr = do + ((minX, minY), (maxX, maxY)) <- getBounds arr + for_ (range (minX, maxX)) $ \x -> do + writeArray arr (x, minY) True + writeArray arr (x, maxY) True + for_ (range (minY, maxY)) $ \y -> do + writeArray arr (minX, y) True + writeArray arr (maxX, y) True + safeGet :: (IArray a e, Ix i) => a i e -> i -> Maybe e safeGet arr idx = let (minIdx, maxIdx) = bounds arr -- cgit 1.4.1 From 58fce2ec1976b957c7e24a282964c62f7ddf7b02 Mon Sep 17 00:00:00 2001 From: Griffin Smith Date: Sun, 15 Sep 2019 13:00:28 -0400 Subject: Progressively reveal the map to the player As the character walks around the map, progressively reveal the entities on the map to them, using an algorithm based on well known circle-rasterizing and line-rasterizing algorithms to calculate lines of sight that are potentially obscured by walls. --- src/Xanthous/App.hs | 6 +- src/Xanthous/Data.hs | 14 +++ src/Xanthous/Data/EntityMap.hs | 104 ++++++++++++++++------ src/Xanthous/Data/EntityMap/Graphics.hs | 28 ++++++ src/Xanthous/Entities.hs | 16 +++- src/Xanthous/Entities/Character.hs | 3 + src/Xanthous/Entities/Creature.hs | 5 +- src/Xanthous/Entities/Environment.hs | 5 +- src/Xanthous/Game.hs | 35 ++++++-- src/Xanthous/Game/Draw.hs | 15 ++-- src/Xanthous/Generators/Util.hs | 8 -- src/Xanthous/Util.hs | 149 ++++++++++++++++++++++++++++++++ src/Xanthous/Util/Graphics.hs | 64 ++++++++++++++ test/Spec.hs | 2 + test/Xanthous/Data/EntityMapSpec.hs | 6 +- test/Xanthous/Util/GraphicsSpec.hs | 39 +++++++++ xanthous.cabal | 7 +- 17 files changed, 454 insertions(+), 52 deletions(-) create mode 100644 src/Xanthous/Data/EntityMap/Graphics.hs create mode 100644 src/Xanthous/Util/Graphics.hs create mode 100644 test/Xanthous/Util/GraphicsSpec.hs diff --git a/src/Xanthous/App.hs b/src/Xanthous/App.hs index 82c32f05a3..d4cc8d2b4f 100644 --- a/src/Xanthous/App.hs +++ b/src/Xanthous/App.hs @@ -6,6 +6,7 @@ import qualified Brick import Graphics.Vty.Attributes (defAttr) import Graphics.Vty.Input.Events (Event(EvKey)) import Control.Monad.State (get) +import Control.Monad.State.Class (modify) import Control.Monad.Random (getRandom) -------------------------------------------------------------------------------- import Xanthous.Command @@ -60,6 +61,7 @@ startEvent = do $ Dimensions 80 80 entities <>= level characterPosition .= charPos + modify updateCharacterVision -- entities %= EntityMap.insertAt (Position 10 10) (SomeEntity testGormlak) @@ -75,7 +77,9 @@ handleCommand Quit = halt handleCommand (Move dir) = do newPos <- uses characterPosition $ move dir collisionAt newPos >>= \case - Nothing -> characterPosition .= newPos + Nothing -> do + characterPosition .= newPos + modify updateCharacterVision Just Combat -> undefined Just Stop -> pure () continue diff --git a/src/Xanthous/Data.hs b/src/Xanthous/Data.hs index 468e59217c..704b3c6e74 100644 --- a/src/Xanthous/Data.hs +++ b/src/Xanthous/Data.hs @@ -12,9 +12,11 @@ module Xanthous.Data , y , Positioned(..) + , _Positioned , position , positioned , loc + , _Position , positionFromPair -- * @@ -73,6 +75,12 @@ data Positioned a where deriving stock (Show, Eq, Ord, Functor, Foldable, Traversable, Generic) deriving anyclass (CoArbitrary, Function) +_Positioned :: Iso (Position, a) (Position, b) (Positioned a) (Positioned b) +_Positioned = iso hither yon + where + hither (pos, a) = Positioned pos a + yon (Positioned pos b) = (pos, b) + instance Arbitrary a => Arbitrary (Positioned a) where arbitrary = Positioned <$> arbitrary <*> arbitrary @@ -92,6 +100,12 @@ loc = iso hither yon hither (Position px py) = Location (px, py) yon (Location (lx, ly)) = Position lx ly +_Position :: Iso' Position (Int, Int) +_Position = iso hither yon + where + hither (Position px py) = (px, py) + yon (lx, ly) = Position lx ly + positionFromPair :: (Integral i, Integral j) => (i, j) -> Position positionFromPair (i, j) = Position (fromIntegral i) (fromIntegral j) diff --git a/src/Xanthous/Data/EntityMap.hs b/src/Xanthous/Data/EntityMap.hs index e713aff32c..926a02a48c 100644 --- a/src/Xanthous/Data/EntityMap.hs +++ b/src/Xanthous/Data/EntityMap.hs @@ -1,27 +1,31 @@ -{-# LANGUAGE DeriveTraversable #-} -{-# LANGUAGE TupleSections #-} -{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE DeriveTraversable #-} +{-# LANGUAGE TupleSections #-} +{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE StandaloneDeriving #-} -{-# LANGUAGE DeriveFunctor #-} - +{-# LANGUAGE DeriveFunctor #-} +-------------------------------------------------------------------------------- module Xanthous.Data.EntityMap ( EntityMap + , _EntityMap , EntityID , emptyEntityMap , insertAt , insertAtReturningID + , fromEIDsAndPositioned , atPosition + , atPositionWithIDs , positions , lookup , lookupWithPosition -- , positionedEntities , neighbors - ) where - -import Data.Monoid (Endo(..)) -import Test.QuickCheck (Arbitrary(..)) -import Test.QuickCheck.Checkers (EqProp) + , Deduplicate(..) + -- * Querying an entityMap + ) where +-------------------------------------------------------------------------------- import Xanthous.Prelude hiding (lookup) import Xanthous.Data ( Position @@ -33,7 +37,11 @@ import Xanthous.Data ) import Xanthous.Orphans () import Xanthous.Util (EqEqProp(..)) - +-------------------------------------------------------------------------------- +import Data.Monoid (Endo(..)) +import Test.QuickCheck (Arbitrary(..)) +import Test.QuickCheck.Checkers (EqProp) +-------------------------------------------------------------------------------- type EntityID = Word32 type NonNullVector a = NonNull (Vector a) @@ -43,7 +51,7 @@ data EntityMap a where , _byID :: HashMap EntityID (Positioned a) , _lastID :: EntityID } -> EntityMap a - deriving stock (Functor, Foldable, Traversable) + deriving stock (Functor, Foldable, Traversable, Generic) deriving via (EqEqProp (EntityMap a)) instance Eq a => EqProp (EntityMap a) makeLenses ''EntityMap @@ -85,9 +93,36 @@ instance At (EntityMap a) where removeEIDAtPos pos = byPosition . at pos %~ (>>= fromNullable . nfilter (/= eid)) +instance Semigroup (EntityMap a) where + em₁ <> em₂ = alaf Endo foldMap (uncurry insertAt) (em₂ ^. _EntityMap) em₁ + +instance Monoid (EntityMap a) where + mempty = emptyEntityMap + emptyEntityMap :: EntityMap a emptyEntityMap = EntityMap mempty mempty 0 +newtype Deduplicate a = Deduplicate (EntityMap a) + deriving stock (Show, Traversable, Generic) + deriving newtype (Eq, Functor, Foldable, EqProp, Arbitrary) + +instance Semigroup (Deduplicate a) where + (Deduplicate em₁) <> (Deduplicate em₂) = + let _byID = em₁ ^. byID <> em₂ ^. byID + _byPosition = mempty &~ do + ifor_ _byID $ \eid (Positioned pos _) -> + at pos %= \case + Just eids -> Just $ eid <| eids + Nothing -> Just $ ncons eid mempty + _lastID = fromMaybe 1 $ maximumOf (ifolded . asIndex) _byID + in Deduplicate EntityMap{..} + +instance Monoid (Deduplicate a) where + mempty = Deduplicate emptyEntityMap + + +-------------------------------------------------------------------------------- + _EntityMap :: Iso' (EntityMap a) [(Position, a)] _EntityMap = iso hither yon where @@ -100,12 +135,6 @@ _EntityMap = iso hither yon yon :: [(Position, a)] -> EntityMap a yon poses = alaf Endo foldMap (uncurry insertAt) poses emptyEntityMap -instance Semigroup (EntityMap a) where - em₁ <> em₂ = alaf Endo foldMap (uncurry insertAt) (em₂ ^. _EntityMap) em₁ - -instance Monoid (EntityMap a) where - mempty = emptyEntityMap - insertAtReturningID :: forall a. Position -> a -> EntityMap a -> (EntityID, EntityMap a) insertAtReturningID pos e em = @@ -124,17 +153,37 @@ atPosition :: forall a. Position -> Lens' (EntityMap a) (Vector a) atPosition pos = lens getter setter where getter em = - let - eids :: Vector EntityID - eids = maybe mempty toNullable $ em ^. byPosition . at pos - - getEIDAssume :: EntityID -> a - getEIDAssume eid = fromMaybe byIDInvariantError - $ em ^? byID . ix eid . positioned - in getEIDAssume <$> eids + let eids :: Vector EntityID + eids = maybe mempty toNullable $ em ^. byPosition . at pos + in getEIDAssume em <$> eids setter em Empty = em & byPosition . at pos .~ Nothing setter em entities = alaf Endo foldMap (insertAt pos) entities em +getEIDAssume :: EntityMap a -> EntityID -> a +getEIDAssume em eid = fromMaybe byIDInvariantError + $ em ^? byID . ix eid . positioned + +atPositionWithIDs :: Position -> EntityMap a -> Vector (EntityID, Positioned a) +atPositionWithIDs pos em = + let eids = maybe mempty toNullable $ em ^. byPosition . at pos + in (id &&& Positioned pos . getEIDAssume em) <$> eids + +fromEIDsAndPositioned + :: (MonoFoldable mono, Element mono ~ (EntityID, Positioned a)) + => mono + -> EntityMap a +fromEIDsAndPositioned eps = newLastID $ alaf Endo foldMap insert' eps mempty + where + insert' (eid, pe@(Positioned pos _)) + = (byID . at eid ?~ pe) + . (byPosition . at pos %~ \case + Just eids -> Just $ eid <| eids + Nothing -> Just $ ncons eid mempty + ) + newLastID em = em & lastID + .~ fromMaybe 1 + (maximumOf (ifolded . asIndex) (em ^. byID)) + positions :: EntityMap a -> [Position] positions = toListOf $ byPosition . to keys . folded @@ -150,3 +199,6 @@ lookup eid = fmap (view positioned) . lookupWithPosition eid neighbors :: Position -> EntityMap a -> Neighbors (Vector a) neighbors pos em = (\p -> view (atPosition p) em) <$> neighborPositions pos + +-------------------------------------------------------------------------------- +makeWrapped ''Deduplicate diff --git a/src/Xanthous/Data/EntityMap/Graphics.hs b/src/Xanthous/Data/EntityMap/Graphics.hs new file mode 100644 index 0000000000..21a380a72c --- /dev/null +++ b/src/Xanthous/Data/EntityMap/Graphics.hs @@ -0,0 +1,28 @@ +{-# LANGUAGE ViewPatterns #-} +-------------------------------------------------------------------------------- +module Xanthous.Data.EntityMap.Graphics where +-------------------------------------------------------------------------------- +import Xanthous.Prelude +-------------------------------------------------------------------------------- +import Xanthous.Util (takeWhileInclusive) +import Xanthous.Data +import Xanthous.Data.EntityMap +import Xanthous.Entities +import Xanthous.Util.Graphics (circle, line) +-------------------------------------------------------------------------------- + +-- | Given a point and a radius of vision, returns a list of all entities that +-- are *visible* (eg, not blocked by an entity that obscures vision) from that +-- point +visibleEntities :: Position -> Word -> EntityMap SomeEntity -> EntityMap SomeEntity +visibleEntities (view _Position -> pos) visionRadius em + = fromEIDsAndPositioned . fold . fold $ sightAdjustedLines + where + -- I love laziness! + radius = circle pos $ fromIntegral visionRadius + linesOfSight = radius <&> line pos + entitiesOnLines = linesOfSight <&> map getPositionedAt + sightAdjustedLines = entitiesOnLines <&> takeWhileInclusive (none $ blocksVision . snd) + getPositionedAt p = + let ppos = _Position # p + in atPositionWithIDs ppos em diff --git a/src/Xanthous/Entities.hs b/src/Xanthous/Entities.hs index bd52ae62b2..223c8d769b 100644 --- a/src/Xanthous/Entities.hs +++ b/src/Xanthous/Entities.hs @@ -7,7 +7,7 @@ module Xanthous.Entities ( Draw(..) , DrawCharacter(..) , DrawStyledCharacter(..) - , Entity + , Entity(..) , SomeEntity(..) , downcastEntity , entityIs @@ -29,8 +29,11 @@ import Data.Aeson import Xanthous.Data -------------------------------------------------------------------------------- -class (Show a, Eq a, Draw a) => Entity a -instance (Show a, Eq a, Draw a) => Entity a +class (Show a, Eq a, Draw a) => Entity a where + blocksVision :: a -> Bool + +instance Entity a => Entity (Positioned a) where + blocksVision (Positioned _ ent) = blocksVision ent -------------------------------------------------------------------------------- data SomeEntity where @@ -47,6 +50,9 @@ instance Eq SomeEntity where instance Draw SomeEntity where drawWithNeighbors ns (SomeEntity ent) = drawWithNeighbors ns ent +instance Entity SomeEntity where + blocksVision (SomeEntity ent) = blocksVision ent + downcastEntity :: (Entity a, Typeable a) => SomeEntity -> Maybe a downcastEntity (SomeEntity e) = cast e @@ -61,6 +67,10 @@ class Draw a where draw :: a -> Widget n draw = drawWithNeighbors $ pure mempty +instance Draw a => Draw (Positioned a) where + drawWithNeighbors ns (Positioned _ a) = drawWithNeighbors ns a + draw (Positioned _ a) = draw a + newtype DrawCharacter (char :: Symbol) (a :: Type) where DrawCharacter :: a -> DrawCharacter char a diff --git a/src/Xanthous/Entities/Character.hs b/src/Xanthous/Entities/Character.hs index faa9964a38..e2ca874ddd 100644 --- a/src/Xanthous/Entities/Character.hs +++ b/src/Xanthous/Entities/Character.hs @@ -14,6 +14,9 @@ data Character = Character deriving anyclass (CoArbitrary, Function) deriving Draw via (DrawCharacter "@" Character) +instance Entity Character where + blocksVision _ = False + instance Arbitrary Character where arbitrary = pure Character diff --git a/src/Xanthous/Entities/Creature.hs b/src/Xanthous/Entities/Creature.hs index 983772090e..5af24a8cd3 100644 --- a/src/Xanthous/Entities/Creature.hs +++ b/src/Xanthous/Entities/Creature.hs @@ -8,7 +8,7 @@ import Data.Word import Xanthous.Prelude import Xanthous.Entities.RawTypes hiding (Creature) -import Xanthous.Entities (Draw(..)) +import Xanthous.Entities (Draw(..), Entity(..)) data Creature = Creature { _creatureType :: CreatureType @@ -17,6 +17,9 @@ data Creature = Creature deriving stock (Eq, Show, Generic) makeLenses ''Creature +instance Entity Creature where + blocksVision _ = False + instance Draw Creature where draw = draw .view (creatureType . char) diff --git a/src/Xanthous/Entities/Environment.hs b/src/Xanthous/Entities/Environment.hs index f5301f94ad..90fa05315a 100644 --- a/src/Xanthous/Entities/Environment.hs +++ b/src/Xanthous/Entities/Environment.hs @@ -7,7 +7,7 @@ import Test.QuickCheck import Brick (str) import Brick.Widgets.Border.Style (unicode) -------------------------------------------------------------------------------- -import Xanthous.Entities (Draw(..), entityIs) +import Xanthous.Entities (Draw(..), entityIs, Entity(..)) import Xanthous.Entities.Draw.Util import Xanthous.Data -------------------------------------------------------------------------------- @@ -16,6 +16,9 @@ data Wall = Wall deriving stock (Show, Eq, Ord, Generic, Enum) deriving anyclass (CoArbitrary, Function) +instance Entity Wall where + blocksVision _ = True + instance Arbitrary Wall where arbitrary = pure Wall diff --git a/src/Xanthous/Game.hs b/src/Xanthous/Game.hs index 6a46896106..ed65217e62 100644 --- a/src/Xanthous/Game.hs +++ b/src/Xanthous/Game.hs @@ -1,10 +1,11 @@ -{-# LANGUAGE MultiWayIf #-} +{-# LANGUAGE MultiWayIf #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE RecordWildCards #-} -------------------------------------------------------------------------------- module Xanthous.Game ( GameState(..) , entities + , revealedEntities , messageHistory , randomGen @@ -13,6 +14,7 @@ module Xanthous.Game , positionedCharacter , character , characterPosition + , updateCharacterVision , MessageHistory(..) , pushMessage @@ -33,8 +35,10 @@ import Test.QuickCheck import Test.QuickCheck.Arbitrary.Generic import Control.Monad.State.Class -------------------------------------------------------------------------------- +import Xanthous.Util (appendVia) import Xanthous.Data.EntityMap (EntityMap, EntityID) import qualified Xanthous.Data.EntityMap as EntityMap +import Xanthous.Data.EntityMap.Graphics import Xanthous.Data (Positioned, Position(..), positioned, position) import Xanthous.Entities (SomeEntity(..), downcastEntity, entityIs) import Xanthous.Entities.Character @@ -68,6 +72,8 @@ hideMessage (MessageHistory msgs _) = MessageHistory msgs False data GameState = GameState { _entities :: EntityMap SomeEntity + -- | A subset of the overall set of entities + , _revealedEntities :: EntityMap SomeEntity , _characterEntityID :: EntityID , _messageHistory :: MessageHistory , _randomGen :: StdGen @@ -76,10 +82,12 @@ data GameState = GameState makeLenses ''GameState instance Eq GameState where - (GameState es₁ ceid₁ mh₁ _) == (GameState es₂ ceid₂ mh₂ _) - = es₁ == es₂ - && ceid₁ == ceid₂ - && mh₁ == mh₂ + (==) = (==) `on` \gs -> + ( gs ^. entities + , gs ^. revealedEntities + , gs ^. characterEntityID + , gs ^. messageHistory + ) instance Arbitrary GameState where arbitrary = do @@ -88,6 +96,11 @@ instance Arbitrary GameState where _messageHistory <- arbitrary (_characterEntityID, _entities) <- arbitrary <&> EntityMap.insertAtReturningID charPos (SomeEntity char) + revealedPositions <- sublistOf $ EntityMap.positions _entities + let _revealedEntities = mempty &~ do + for_ revealedPositions $ \pos -> do + let ents = _entities ^. EntityMap.atPosition pos + EntityMap.atPosition pos <>= ents _randomGen <- mkStdGen <$> arbitrary pure $ GameState {..} @@ -101,6 +114,7 @@ getInitialState = do (SomeEntity char) mempty _messageHistory = NoMessageHistory + _revealedEntities = _entities pure GameState {..} positionedCharacter :: Lens' GameState (Positioned Character) @@ -130,6 +144,17 @@ character = positionedCharacter . positioned characterPosition :: Lens' GameState Position characterPosition = positionedCharacter . position +visionRadius :: Word +visionRadius = 12 -- TODO make this dynamic + +-- | Update the revealed entities at the character's position based on their vision +updateCharacterVision :: GameState -> GameState +updateCharacterVision game = + let charPos = game ^. characterPosition + visible = visibleEntities charPos visionRadius $ game ^. entities + in game & revealedEntities %~ appendVia EntityMap.Deduplicate visible + + -------------------------------------------------------------------------------- data Collision diff --git a/src/Xanthous/Game/Draw.hs b/src/Xanthous/Game/Draw.hs index 4d3cb15dca..bb6508acdf 100644 --- a/src/Xanthous/Game/Draw.hs +++ b/src/Xanthous/Game/Draw.hs @@ -17,6 +17,7 @@ import Xanthous.Entities import Xanthous.Game ( GameState(..) , entities + , revealedEntities , characterPosition , MessageHistory(..) , messageHistory @@ -35,8 +36,11 @@ drawMessages (MessageHistory (lastMessage :| _) True) = txt lastMessage -- (MessageHistory _ False) -> padTop (Pad 2) $ str " " -- (MessageHistory (lastMessage :| _) True) -> txt lastMessage -drawEntities :: EntityMap SomeEntity -> Widget Name -drawEntities em +drawEntities + :: EntityMap SomeEntity -- ^ visible entities + -> EntityMap SomeEntity -- ^ all entities + -> Widget Name +drawEntities em allEnts = vBox rows where entityPositions = EntityMap.positions em @@ -45,7 +49,7 @@ drawEntities em rows = mkRow <$> [0..maxY] mkRow rowY = hBox $ renderEntityAt . flip Position rowY <$> [0..maxX] renderEntityAt pos = - let neighbors = EntityMap.neighbors pos em + let neighbors = EntityMap.neighbors pos allEnts in maybe (str " ") (drawWithNeighbors neighbors) $ em ^? atPosition pos . folded @@ -53,8 +57,9 @@ drawMap :: GameState -> Widget Name drawMap game = viewport MapViewport Both . showCursor Character (game ^. characterPosition . loc) - . drawEntities - $ game ^. entities + $ drawEntities + (game ^. revealedEntities) + (game ^. entities) drawGame :: GameState -> [Widget Name] drawGame game diff --git a/src/Xanthous/Generators/Util.hs b/src/Xanthous/Generators/Util.hs index 6a2d27839c..e399ca5d49 100644 --- a/src/Xanthous/Generators/Util.hs +++ b/src/Xanthous/Generators/Util.hs @@ -104,14 +104,6 @@ fillOuterEdgesM arr = do writeArray arr (minX, y) True writeArray arr (maxX, y) True -safeGet :: (IArray a e, Ix i) => a i e -> i -> Maybe e -safeGet arr idx = - let (minIdx, maxIdx) = bounds arr - in if idx < minIdx || idx > maxIdx - then Nothing - else Just $ arr ! idx - - cloneMArray :: forall a a' i e m. ( Ix i diff --git a/src/Xanthous/Util.hs b/src/Xanthous/Util.hs index cf1f80b82e..439f9e8ffa 100644 --- a/src/Xanthous/Util.hs +++ b/src/Xanthous/Util.hs @@ -1,4 +1,5 @@ {-# LANGUAGE BangPatterns #-} +{-# LANGUAGE AllowAmbiguousTypes #-} module Xanthous.Util ( EqEqProp(..) @@ -6,12 +7,29 @@ module Xanthous.Util , foldlMapM , foldlMapM' , between + + , appendVia + + -- * Foldable + -- ** Uniqueness + -- *** Predicates on uniqueness + , isUniqueOf + , isUnique + -- *** Removing all duplicate elements in n * log n time + , uniqueOf + , unique + -- *** Removing sequentially duplicate elements in linear time + , uniqOf + , uniq + -- ** Bag sequence algorithms + , takeWhileInclusive ) where import Xanthous.Prelude hiding (foldr) import Test.QuickCheck.Checkers import Data.Foldable (foldr) +import Data.Monoid newtype EqEqProp a = EqEqProp a deriving newtype Eq @@ -44,3 +62,134 @@ between -> a -- ^ scrutinee -> Bool between lower upper x = x >= lower && x <= upper + +-- | +-- >>> appendVia Sum 1 2 +-- 3 +appendVia :: (Rewrapping s t, Semigroup s) => (Unwrapped s -> s) -> Unwrapped s -> Unwrapped s -> Unwrapped s +appendVia wrap x y = op wrap $ wrap x <> wrap y + +-------------------------------------------------------------------------------- + +-- | Returns True if the targets of the given 'Fold' are unique per the 'Ord' instance for @a@ +-- +-- >>> isUniqueOf (folded . _1) ([(1, 2), (2, 2), (3, 2)] :: [(Int, Int)]) +-- True +-- +-- >>> isUniqueOf (folded . _2) ([(1, 2), (2, 2), (3, 2)] :: [(Int, Int)]) +-- False +-- +-- @ +-- 'isUniqueOf' :: Ord a => 'Getter' s a -> s -> 'Bool' +-- 'isUniqueOf' :: Ord a => 'Fold' s a -> s -> 'Bool' +-- 'isUniqueOf' :: Ord a => 'Lens'' s a -> s -> 'Bool' +-- 'isUniqueOf' :: Ord a => 'Iso'' s a -> s -> 'Bool' +-- 'isUniqueOf' :: Ord a => 'Traversal'' s a -> s -> 'Bool' +-- 'isUniqueOf' :: Ord a => 'Prism'' s a -> s -> 'Bool' +-- @ +isUniqueOf :: Ord a => Getting (Endo (Set a, Bool)) s a -> s -> Bool +isUniqueOf aFold = orOf _2 . foldrOf aFold rejectUnique (mempty, True) + where + rejectUnique x (seen, acc) + | seen ^. contains x = (seen, False) + | otherwise = (seen & contains x .~ True, acc) + +-- | Returns true if the given 'Foldable' container contains only unique +-- elements, as determined by the 'Ord' instance for @a@ +-- +-- >>> isUnique ([3, 1, 2] :: [Int]) +-- True +-- +-- >>> isUnique ([1, 1, 2, 2, 3, 1] :: [Int]) +-- False +isUnique :: (Foldable f, Ord a) => f a -> Bool +isUnique = isUniqueOf folded + + +-- | O(n * log n). Returns a monoidal, 'Cons'able container (a list, a Set, +-- etc.) consisting of the unique (per the 'Ord' instance for @a@) targets of +-- the given 'Fold' +-- +-- >>> uniqueOf (folded . _2) ([(1, 2), (2, 2), (3, 2), (4, 3)] :: [(Int, Int)]) :: [Int] +-- [2,3] +-- +-- @ +-- 'uniqueOf' :: Ord a => 'Getter' s a -> s -> [a] +-- 'uniqueOf' :: Ord a => 'Fold' s a -> s -> [a] +-- 'uniqueOf' :: Ord a => 'Lens'' s a -> s -> [a] +-- 'uniqueOf' :: Ord a => 'Iso'' s a -> s -> [a] +-- 'uniqueOf' :: Ord a => 'Traversal'' s a -> s -> [a] +-- 'uniqueOf' :: Ord a => 'Prism'' s a -> s -> [a] +-- @ +uniqueOf + :: (Monoid c, Ord w, Cons c c w w) => Getting (Endo (Set w, c)) a w -> a -> c +uniqueOf aFold = snd . foldrOf aFold rejectUnique (mempty, mempty) + where + rejectUnique x (seen, acc) + | seen ^. contains x = (seen, acc) + | otherwise = (seen & contains x .~ True, cons x acc) + +-- | Returns a monoidal, 'Cons'able container (a list, a Set, etc.) consisting +-- of the unique (per the 'Ord' instance for @a@) contents of the given +-- 'Foldable' container +-- +-- >>> unique [1, 1, 2, 2, 3, 1] :: [Int] +-- [2,3,1] + +-- >>> unique [1, 1, 2, 2, 3, 1] :: Set Int +-- fromList [3,2,1] +unique :: (Foldable f, Cons c c a a, Ord a, Monoid c) => f a -> c +unique = uniqueOf folded + +-------------------------------------------------------------------------------- + +-- | O(n). Returns a monoidal, 'Cons'able container (a list, a Vector, etc.) +-- consisting of the targets of the given 'Fold' with sequential duplicate +-- elements removed +-- +-- This function (sorry for the confusing name) differs from 'uniqueOf' in that +-- it only compares /sequentially/ duplicate elements (and thus operates in +-- linear time). +-- cf 'Data.Vector.uniq' and POSIX @uniq@ for the name +-- +-- >>> uniqOf (folded . _2) ([(1, 2), (2, 2), (3, 1), (4, 2)] :: [(Int, Int)]) :: [Int] +-- [2,1,2] +-- +-- @ +-- 'uniqOf' :: Eq a => 'Getter' s a -> s -> [a] +-- 'uniqOf' :: Eq a => 'Fold' s a -> s -> [a] +-- 'uniqOf' :: Eq a => 'Lens'' s a -> s -> [a] +-- 'uniqOf' :: Eq a => 'Iso'' s a -> s -> [a] +-- 'uniqOf' :: Eq a => 'Traversal'' s a -> s -> [a] +-- 'uniqOf' :: Eq a => 'Prism'' s a -> s -> [a] +-- @ +uniqOf :: (Monoid c, Cons c c w w, Eq w) => Getting (Endo (Maybe w, c)) a w -> a -> c +uniqOf aFold = snd . foldrOf aFold rejectSeen (Nothing, mempty) + where + rejectSeen x (Nothing, acc) = (Just x, x <| acc) + rejectSeen x tup@(Just a, acc) + | x == a = tup + | otherwise = (Just x, x <| acc) + +-- | O(n). Returns a monoidal, 'Cons'able container (a list, a Vector, etc.) +-- consisting of the targets of the given 'Foldable' container with sequential +-- duplicate elements removed +-- +-- This function (sorry for the confusing name) differs from 'unique' in that +-- it only compares /sequentially/ unique elements (and thus operates in linear +-- time). +-- cf 'Data.Vector.uniq' and POSIX @uniq@ for the name +-- +-- >>> uniq [1, 1, 1, 2, 2, 2, 3, 3, 1] :: [Int] +-- [1,2,3,1] +-- +-- >>> uniq [1, 1, 1, 2, 2, 2, 3, 3, 1] :: Vector Int +-- [1,2,3,1] +-- +uniq :: (Foldable f, Eq a, Cons c c a a, Monoid c) => f a -> c +uniq = uniqOf folded + +-- | Like 'takeWhile', but inclusive +takeWhileInclusive :: (a -> Bool) -> [a] -> [a] +takeWhileInclusive _ [] = [] +takeWhileInclusive p (x:xs) = x : if p x then takeWhileInclusive p xs else [] diff --git a/src/Xanthous/Util/Graphics.hs b/src/Xanthous/Util/Graphics.hs new file mode 100644 index 0000000000..5a174d4f41 --- /dev/null +++ b/src/Xanthous/Util/Graphics.hs @@ -0,0 +1,64 @@ +-- | Graphics algorithms and utils for rendering things in 2D space +-------------------------------------------------------------------------------- +module Xanthous.Util.Graphics where +-------------------------------------------------------------------------------- +import Xanthous.Prelude +import Data.List ( unfoldr ) +-------------------------------------------------------------------------------- + +-- | Generate a circle centered at the given point and with the given radius +-- using the . +-- +-- Code taken from +circle :: (Num i, Ord i) + => (i, i) -- ^ center + -> i -- ^ radius + -> [(i, i)] +circle (x₀, y₀) radius + -- Four initial points, plus the generated points + = (x₀, y₀ + radius) : (x₀, y₀ - radius) : (x₀ + radius, y₀) : (x₀ - radius, y₀) : points + where + -- Creates the (x, y) octet offsets, then maps them to absolute points in all octets. + points = concatMap generatePoints $ unfoldr step initialValues + + generatePoints (x, y) + = [ (x₀ `xop` x', y₀ `yop` y') + | (x', y') <- [(x, y), (y, x)] + , xop <- [(+), (-)] + , yop <- [(+), (-)] + ] + + initialValues = (1 - radius, 1, (-2) * radius, 0, radius) + + step (f, ddf_x, ddf_y, x, y) + | x >= y = Nothing + | otherwise = Just ((x', y'), (f', ddf_x', ddf_y', x', y')) + where + (f', ddf_y', y') | f >= 0 = (f + ddf_y' + ddf_x', ddf_y + 2, y - 1) + | otherwise = (f + ddf_x, ddf_y, y) + ddf_x' = ddf_x + 2 + x' = x + 1 + +-- | Draw a line between two points using Bresenham's line drawing algorithm +-- +-- Code taken from +line :: (Num i, Ord i) => (i, i) -> (i, i) -> [(i, i)] +line pa@(xa, ya) pb@(xb, yb) + = (if maySwitch pa < maySwitch pb then id else reverse) points + where + points = map maySwitch . unfoldr go $ (x₁, y₁, 0) + steep = abs (yb - ya) > abs (xb - xa) + maySwitch = if steep then swap else id + [(x₁, y₁), (x₂, y₂)] = sort [maySwitch pa, maySwitch pb] + δx = x₂ - x₁ + δy = abs (y₂ - y₁) + ystep = if y₁ < y₂ then 1 else -1 + go (xTemp, yTemp, err) + | xTemp > x₂ = Nothing + | otherwise = Just ((xTemp, yTemp), (xTemp + 1, newY, newError)) + where + tempError = err + δy + (newY, newError) = if (2 * tempError) >= δx + then (yTemp + ystep, tempError - δx) + else (yTemp, tempError) diff --git a/test/Spec.hs b/test/Spec.hs index dd4212c2eb..cac474053c 100644 --- a/test/Spec.hs +++ b/test/Spec.hs @@ -6,6 +6,7 @@ import qualified Xanthous.GameSpec import qualified Xanthous.Generators.UtilSpec import qualified Xanthous.MessageSpec import qualified Xanthous.OrphansSpec +import qualified Xanthous.Util.GraphicsSpec main :: IO () main = defaultMain test @@ -19,4 +20,5 @@ test = testGroup "Xanthous" , Xanthous.MessageSpec.test , Xanthous.OrphansSpec.test , Xanthous.DataSpec.test + , Xanthous.Util.GraphicsSpec.test ] diff --git a/test/Xanthous/Data/EntityMapSpec.hs b/test/Xanthous/Data/EntityMapSpec.hs index c08b568d9e..00bf150046 100644 --- a/test/Xanthous/Data/EntityMapSpec.hs +++ b/test/Xanthous/Data/EntityMapSpec.hs @@ -11,8 +11,12 @@ main :: IO () main = defaultMain test test :: TestTree -test = testGroup "Xanthous.Data.EntityMap" +test = localOption (QuickCheckTests 20) + $ testGroup "Xanthous.Data.EntityMap" [ testBatch $ monoid @(EntityMap Int) mempty + , testGroup "Deduplicate" + [ testBatch $ monoid @(Deduplicate Int) mempty + ] , testGroup "Eq laws" [ testProperty "reflexivity" $ \(em :: EntityMap Int) -> em == em diff --git a/test/Xanthous/Util/GraphicsSpec.hs b/test/Xanthous/Util/GraphicsSpec.hs new file mode 100644 index 0000000000..4b761dc51f --- /dev/null +++ b/test/Xanthous/Util/GraphicsSpec.hs @@ -0,0 +1,39 @@ +module Xanthous.Util.GraphicsSpec (main, test) where +-------------------------------------------------------------------------------- +import Test.Prelude hiding (head) +-------------------------------------------------------------------------------- +import Xanthous.Util.Graphics +import Xanthous.Util +import Data.List (head) +-------------------------------------------------------------------------------- + +main :: IO () +main = defaultMain test + +test :: TestTree +test = testGroup "Xanthous.Util.Graphics" + [ testGroup "circle" + [ testCase "radius 12, origin 0" + $ (sort . unique @[] @[_]) (circle @Int (0, 0) 12) + @?= (sort . unique) ( + let quadrant = + [ (0, 12) , (1, 12) , (2, 12) , (3, 12) + , (4, 12) , (5, 11) , (6, 11) , (7, 10) + , (8, 9) , (9, 9) , (9, 8) , (10, 7) + , (11, 6) , (11, 5) , (12, 4) , (12, 3) + , (12, 2) , (12, 1) , (12, 0) + ] + in quadrant + <> (quadrant <&> _1 %~ negate) + <> (quadrant <&> _2 %~ negate) + <> (quadrant <&> both %~ negate) + ) + ] + + , testGroup "line" + [ testProperty "starts and ends at the start and end points" $ \start end -> + let ℓ = line @Int start end + in counterexample ("line: " <> show ℓ) + $ length ℓ > 2 ==> (head ℓ === start) .&&. (head (reverse ℓ) === end) + ] + ] diff --git a/xanthous.cabal b/xanthous.cabal index a8cd8d213d..b625105b1b 100644 --- a/xanthous.cabal +++ b/xanthous.cabal @@ -4,7 +4,7 @@ cabal-version: 1.12 -- -- see: https://github.com/sol/hpack -- --- hash: a79caccff8895730c394c19244f068830759636d17f55f3b6d1d8a9ebe43ecdd +-- hash: 86b7d3047b95fc65f4c6489a21e8c89883981c8c5bd552b5ea83aaf70de8a7cf name: xanthous version: 0.1.0.0 @@ -34,6 +34,7 @@ library Xanthous.Command Xanthous.Data Xanthous.Data.EntityMap + Xanthous.Data.EntityMap.Graphics Xanthous.Entities Xanthous.Entities.Arbitrary Xanthous.Entities.Character @@ -55,6 +56,7 @@ library Xanthous.Random Xanthous.Resource Xanthous.Util + Xanthous.Util.Graphics other-modules: Paths_xanthous hs-source-dirs: @@ -102,6 +104,7 @@ executable xanthous Xanthous.Command Xanthous.Data Xanthous.Data.EntityMap + Xanthous.Data.EntityMap.Graphics Xanthous.Entities Xanthous.Entities.Arbitrary Xanthous.Entities.Character @@ -123,6 +126,7 @@ executable xanthous Xanthous.Random Xanthous.Resource Xanthous.Util + Xanthous.Util.Graphics Paths_xanthous hs-source-dirs: src @@ -174,6 +178,7 @@ test-suite test Xanthous.Generators.UtilSpec Xanthous.MessageSpec Xanthous.OrphansSpec + Xanthous.Util.GraphicsSpec Paths_xanthous hs-source-dirs: test -- cgit 1.4.1 From 2604341c2f3c7805f88422707e8ed08e45ecfa0b Mon Sep 17 00:00:00 2001 From: Griffin Smith Date: Sun, 15 Sep 2019 13:43:10 -0400 Subject: Scroll the viewport around the character Scroll the viewport so that the character is never less than 5 away from the edge of the screen. This was super easy, thanks Brick! --- src/Xanthous/Entities/Character.hs | 12 +++++++++++- 1 file changed, 11 insertions(+), 1 deletion(-) diff --git a/src/Xanthous/Entities/Character.hs b/src/Xanthous/Entities/Character.hs index e2ca874ddd..246e55071c 100644 --- a/src/Xanthous/Entities/Character.hs +++ b/src/Xanthous/Entities/Character.hs @@ -5,6 +5,7 @@ module Xanthous.Entities.Character -------------------------------------------------------------------------------- import Xanthous.Prelude import Test.QuickCheck +import Brick -------------------------------------------------------------------------------- import Xanthous.Entities -------------------------------------------------------------------------------- @@ -12,7 +13,16 @@ import Xanthous.Entities data Character = Character deriving stock (Show, Eq, Ord, Generic) deriving anyclass (CoArbitrary, Function) - deriving Draw via (DrawCharacter "@" Character) + +scrollOffset :: Int +scrollOffset = 5 + +-- deriving Draw via (DrawCharacter "@" Character) +instance Draw Character where + draw _ = visibleRegion rloc rreg $ str "@" + where + rloc = Location (negate scrollOffset, negate scrollOffset) + rreg = (2 * scrollOffset, 2 * scrollOffset) instance Entity Character where blocksVision _ = False -- cgit 1.4.1 From 15895c69fe8f1415f45fe33f7b3d564f4239496e Mon Sep 17 00:00:00 2001 From: Griffin Smith Date: Sun, 15 Sep 2019 17:00:27 -0400 Subject: Remove all but the largest region in caves When generating cave levels, remove all but the largest contiguous region from the resulting level. --- src/Xanthous/Generators/CaveAutomata.hs | 3 +++ src/Xanthous/Generators/Util.hs | 13 +++++++++---- 2 files changed, 12 insertions(+), 4 deletions(-) diff --git a/src/Xanthous/Generators/CaveAutomata.hs b/src/Xanthous/Generators/CaveAutomata.hs index fd4c68ddbe..f1123abbd8 100644 --- a/src/Xanthous/Generators/CaveAutomata.hs +++ b/src/Xanthous/Generators/CaveAutomata.hs @@ -99,6 +99,9 @@ generate' params dims = do when (steps' > 0) $ for_ [0 .. pred steps'] . const $ stepAutomata cells dims params lift $ fillOuterEdgesM cells + -- Remove all but the largest contiguous region of unfilled space + (_: smallerRegions) <- lift $ regions @UArray . amap not <$> freeze cells + lift $ fillAllM (fold smallerRegions) cells pure cells stepAutomata :: forall s g. MCells s -> Dimensions -> Params -> CellM g s () diff --git a/src/Xanthous/Generators/Util.hs b/src/Xanthous/Generators/Util.hs index e399ca5d49..8fd04c0b93 100644 --- a/src/Xanthous/Generators/Util.hs +++ b/src/Xanthous/Generators/Util.hs @@ -11,15 +11,17 @@ module Xanthous.Generators.Util , cloneMArray , floodFill , regions + , fillAll + , fillAllM ) where -------------------------------------------------------------------------------- -import Xanthous.Prelude hiding (Foldable, toList) +import Xanthous.Prelude hiding (Foldable, toList, for_) import Data.Array.ST import Data.Array.Unboxed import Control.Monad.ST import Control.Monad.Random import Data.Monoid -import Data.Foldable (Foldable, toList) +import Data.Foldable (Foldable, toList, for_) -------------------------------------------------------------------------------- import Xanthous.Util (foldlMapM') import Xanthous.Data (Dimensions, width, height) @@ -177,5 +179,8 @@ regions arr findFirstPoint :: a (i, j) Bool -> Maybe (i, j) findFirstPoint = fmap fst . headMay . filter snd . assocs - fillAll :: Foldable f => f (i, j) -> a (i, j) Bool -> a (i, j) Bool - fillAll ixes a = accum (const fst) a $ (, (False, ())) <$> toList ixes +fillAll :: (IArray a Bool, Ix i, Foldable f) => f i -> a i Bool -> a i Bool +fillAll ixes a = accum (const fst) a $ (, (False, ())) <$> toList ixes + +fillAllM :: (MArray a Bool m, Ix i, Foldable f) => f i -> a i Bool -> m () +fillAllM ixes a = for_ ixes $ \i -> writeArray a i False -- cgit 1.4.1 From 62a2e05ef222dd69263b819a400a83f8910816f9 Mon Sep 17 00:00:00 2001 From: Griffin Smith Date: Thu, 19 Sep 2019 13:56:14 -0400 Subject: Add items and inventory Add a new "Item" entity, which pulls from the previously-existent ItemType raw, and add a "PickUp" command which takes the (currently *only*) item off the ground and puts it into the inventory. --- package.yaml | 1 + src/Main.hs | 2 +- src/Xanthous/App.hs | 50 ++++++++++++++------------ src/Xanthous/Command.hs | 5 ++- src/Xanthous/Data/EntityMap/Graphics.hs | 9 ++++- src/Xanthous/Entities.hs | 48 ++++++++++++++++++++++--- src/Xanthous/Entities/Arbitrary.hs | 2 +- src/Xanthous/Entities/Character.hs | 19 ++++++++-- src/Xanthous/Entities/Creature.hs | 25 +++++++------ src/Xanthous/Entities/Item.hs | 35 +++++++++++++++++++ src/Xanthous/Entities/RawTypes.hs | 24 +++++++------ src/Xanthous/Entities/Raws.hs | 38 +++++++++++++++++--- src/Xanthous/Entities/Raws/noodles.yaml | 8 +++++ src/Xanthous/Game.hs | 30 +++++++--------- src/Xanthous/Game/Draw.hs | 24 ++++++++----- src/Xanthous/Generators.hs | 41 ++++++++++++++++++++-- src/Xanthous/Generators/LevelContents.hs | 40 ++++++++++++++++----- src/Xanthous/Orphans.hs | 60 ++++++++++++++++++++++++++------ src/Xanthous/messages.yaml | 3 ++ xanthous.cabal | 7 +++- 20 files changed, 365 insertions(+), 106 deletions(-) create mode 100644 src/Xanthous/Entities/Item.hs create mode 100644 src/Xanthous/Entities/Raws/noodles.yaml diff --git a/package.yaml b/package.yaml index 7df7234c16..953fb0947b 100644 --- a/package.yaml +++ b/package.yaml @@ -33,6 +33,7 @@ dependencies: - filepath - generic-arbitrary - generic-monoid +- generic-lens - groups - lens - megaparsec diff --git a/src/Main.hs b/src/Main.hs index 2da277b640..547dc92f40 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -8,7 +8,7 @@ import System.Random import Xanthous.Game (getInitialState) import Xanthous.App (makeApp) import Xanthous.Generators - ( GeneratorInput(..) + ( GeneratorInput , parseGeneratorInput , generateFromInput , showCells diff --git a/src/Xanthous/App.hs b/src/Xanthous/App.hs index d4cc8d2b4f..0f49b4d800 100644 --- a/src/Xanthous/App.hs +++ b/src/Xanthous/App.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE ViewPatterns #-} module Xanthous.App (makeApp) where -------------------------------------------------------------------------------- import Xanthous.Prelude @@ -7,17 +8,16 @@ import Graphics.Vty.Attributes (defAttr) import Graphics.Vty.Input.Events (Event(EvKey)) import Control.Monad.State (get) import Control.Monad.State.Class (modify) -import Control.Monad.Random (getRandom) +import Data.Aeson (object) +import qualified Data.Aeson as A -------------------------------------------------------------------------------- import Xanthous.Command import Xanthous.Data ( move - , Position(..) , Dimensions'(Dimensions) - , Dimensions - , positionFromPair + , positioned ) -import Xanthous.Data.EntityMap (EntityMap) +import qualified Xanthous.Data.EntityMap as EntityMap import Xanthous.Game import Xanthous.Game.Draw (drawGame) import Xanthous.Monad @@ -25,12 +25,13 @@ import Xanthous.Resource (Name) -------------------------------------------------------------------------------- import Xanthous.Entities.Creature (Creature) import qualified Xanthous.Entities.Creature as Creature +import qualified Xanthous.Entities.Character as Character import Xanthous.Entities.RawTypes (EntityRaw(..)) import Xanthous.Entities.Raws (raw) import Xanthous.Entities +import Xanthous.Entities.Item (Item) import Xanthous.Generators import qualified Xanthous.Generators.CaveAutomata as CaveAutomata -import Xanthous.Generators.LevelContents -------------------------------------------------------------------------------- type App = Brick.App GameState () Name @@ -56,11 +57,12 @@ testGormlak = startEvent :: AppM () startEvent = do say_ ["welcome"] - (level, charPos) <- + level <- generateLevel SCaveAutomata CaveAutomata.defaultParams $ Dimensions 80 80 - entities <>= level - characterPosition .= charPos + entities <>= (SomeEntity <$> level ^. levelWalls) + entities <>= (SomeEntity <$> level ^. levelItems) + characterPosition .= level ^. levelCharacterPosition modify updateCharacterVision -- entities %= EntityMap.insertAt (Position 10 10) (SomeEntity testGormlak) @@ -84,21 +86,23 @@ handleCommand (Move dir) = do Just Stop -> pure () continue +handleCommand PickUp = do + pos <- use characterPosition + ents <- uses entities $ EntityMap.atPositionWithIDs pos + let items = flip foldMap ents $ \(eid, view positioned -> se) -> + case downcastEntity @Item se of + Just item -> [(eid, item)] + Nothing -> [] + case items of + [] -> say_ ["items", "nothingToPickUp"] + [(itemID, item)] -> do + character %= Character.pickUpItem item + entities . at itemID .= Nothing + say ["items", "pickUp"] $ object [ "item" A..= item ] + _ -> undefined + continue + handleCommand PreviousMessage = do messageHistory %= popMessage continue --------------------------------------------------------------------------------- - -generateLevel - :: SGenerator gen - -> Params gen - -> Dimensions - -> AppM (EntityMap SomeEntity, Position) -generateLevel g ps dims = do - gen <- use randomGen - let cells = generate g ps dims gen - _ <- getRandom @_ @Int -- perturb the generator, so we don't get the same level twice - charPos <- positionFromPair <$> chooseCharacterPosition cells - let level = SomeEntity <$> cellsToWalls cells - pure (level, charPos) diff --git a/src/Xanthous/Command.hs b/src/Xanthous/Command.hs index ee9a7ad50d..94c8075b34 100644 --- a/src/Xanthous/Command.hs +++ b/src/Xanthous/Command.hs @@ -9,10 +9,11 @@ data Command = Quit | Move Direction | PreviousMessage - -- | PickUp + | PickUp commandFromKey :: Key -> [Modifier] -> Maybe Command commandFromKey (KChar 'q') [] = Just Quit + commandFromKey (KChar 'h') [] = Just $ Move Left commandFromKey (KChar 'j') [] = Just $ Move Down commandFromKey (KChar 'k') [] = Just $ Move Up @@ -24,4 +25,6 @@ commandFromKey (KChar 'n') [] = Just $ Move DownRight commandFromKey (KChar 'p') [MCtrl] = Just PreviousMessage +commandFromKey (KChar ',') [] = Just PickUp + commandFromKey _ _ = Nothing diff --git a/src/Xanthous/Data/EntityMap/Graphics.hs b/src/Xanthous/Data/EntityMap/Graphics.hs index 21a380a72c..9dcc02b8e8 100644 --- a/src/Xanthous/Data/EntityMap/Graphics.hs +++ b/src/Xanthous/Data/EntityMap/Graphics.hs @@ -1,6 +1,9 @@ {-# LANGUAGE ViewPatterns #-} -------------------------------------------------------------------------------- -module Xanthous.Data.EntityMap.Graphics where +module Xanthous.Data.EntityMap.Graphics + ( visiblePositions + , visibleEntities + ) where -------------------------------------------------------------------------------- import Xanthous.Prelude -------------------------------------------------------------------------------- @@ -11,6 +14,10 @@ import Xanthous.Entities import Xanthous.Util.Graphics (circle, line) -------------------------------------------------------------------------------- +visiblePositions :: Position -> Word -> EntityMap SomeEntity -> Set Position +visiblePositions pos radius = setFromList . positions . visibleEntities pos radius + + -- | Given a point and a radius of vision, returns a list of all entities that -- are *visible* (eg, not blocked by an entity that obscures vision) from that -- point diff --git a/src/Xanthous/Entities.hs b/src/Xanthous/Entities.hs index 223c8d769b..e47e820f27 100644 --- a/src/Xanthous/Entities.hs +++ b/src/Xanthous/Entities.hs @@ -7,26 +7,33 @@ module Xanthous.Entities ( Draw(..) , DrawCharacter(..) , DrawStyledCharacter(..) + , DrawRawChar(..) , Entity(..) , SomeEntity(..) , downcastEntity , entityIs + , _SomeEntity , Color(..) , KnownColor(..) , EntityChar(..) + , HasChar(..) ) where -------------------------------------------------------------------------------- -import Xanthous.Prelude +import Xanthous.Prelude hiding ((.=)) -------------------------------------------------------------------------------- import Brick import Data.Typeable import qualified Graphics.Vty.Attributes as Vty import qualified Graphics.Vty.Image as Vty import Data.Aeson +import Data.Generics.Product.Fields +import Test.QuickCheck +import Test.QuickCheck.Arbitrary.Generic -------------------------------------------------------------------------------- import Xanthous.Data +import Xanthous.Orphans () -------------------------------------------------------------------------------- class (Show a, Eq a, Draw a) => Entity a where @@ -58,6 +65,10 @@ downcastEntity (SomeEntity e) = cast e entityIs :: forall a. (Entity a, Typeable a) => SomeEntity -> Bool entityIs = isJust . downcastEntity @a + +_SomeEntity :: forall a. (Entity a, Typeable a) => Prism' SomeEntity a +_SomeEntity = prism' SomeEntity downcastEntity + -------------------------------------------------------------------------------- class Draw a where @@ -109,13 +120,33 @@ instance , Vty.attrBackColor = Vty.SetTo $ colorVal @bg Proxy , Vty.attrURL = Vty.Default } + +-------------------------------------------------------------------------------- + +class HasChar s a | s -> a where + char :: Lens' s a + {-# MINIMAL char #-} + +newtype DrawRawChar (rawField :: Symbol) (a :: Type) = DrawRawChar a + +instance + forall rawField a raw. + ( HasField rawField a a raw raw + , HasChar raw EntityChar + ) => Draw (DrawRawChar rawField a) where + draw (DrawRawChar e) = draw $ e ^. field @rawField . char + -------------------------------------------------------------------------------- + data EntityChar = EntityChar { _char :: Char , _style :: Vty.Attr } deriving stock (Show, Eq, Generic) - deriving anyclass (NFData) + deriving anyclass (NFData, CoArbitrary, Function) + +instance Arbitrary EntityChar where + arbitrary = genericArbitrary instance FromJSON EntityChar where parseJSON (String (chr :< Empty)) = pure $ EntityChar chr Vty.defAttr @@ -132,7 +163,16 @@ instance FromJSON EntityChar where pure EntityChar {..} parseJSON _ = fail "Invalid type, expected string or object" +instance ToJSON EntityChar where + toJSON (EntityChar chr styl) + | styl == Vty.defAttr = String $ chr <| Empty + | otherwise = object + [ "char" .= chr + , "style" .= object + [ "foreground" .= Vty.attrForeColor styl + , "background" .= Vty.attrBackColor styl + ] + ] + instance Draw EntityChar where draw EntityChar{..} = raw $ Vty.string _style [_char] - --------------------------------------------------------------------------------- diff --git a/src/Xanthous/Entities/Arbitrary.hs b/src/Xanthous/Entities/Arbitrary.hs index 9153722d9b..480282cff6 100644 --- a/src/Xanthous/Entities/Arbitrary.hs +++ b/src/Xanthous/Entities/Arbitrary.hs @@ -14,6 +14,6 @@ import Xanthous.Entities.Environment instance Arbitrary SomeEntity where arbitrary = Gen.oneof - [ pure $ SomeEntity Character + [ SomeEntity <$> arbitrary @Character , pure $ SomeEntity Wall ] diff --git a/src/Xanthous/Entities/Character.hs b/src/Xanthous/Entities/Character.hs index 246e55071c..3b2b320004 100644 --- a/src/Xanthous/Entities/Character.hs +++ b/src/Xanthous/Entities/Character.hs @@ -1,23 +1,30 @@ +{-# LANGUAGE TemplateHaskell #-} module Xanthous.Entities.Character ( Character(..) , mkCharacter + , pickUpItem ) where -------------------------------------------------------------------------------- import Xanthous.Prelude import Test.QuickCheck +import Test.QuickCheck.Instances.Vector () +import Test.QuickCheck.Arbitrary.Generic import Brick -------------------------------------------------------------------------------- import Xanthous.Entities +import Xanthous.Entities.Item -------------------------------------------------------------------------------- data Character = Character - deriving stock (Show, Eq, Ord, Generic) + { _inventory :: !(Vector Item) + } + deriving stock (Show, Eq, Generic) deriving anyclass (CoArbitrary, Function) +makeLenses ''Character scrollOffset :: Int scrollOffset = 5 --- deriving Draw via (DrawCharacter "@" Character) instance Draw Character where draw _ = visibleRegion rloc rreg $ str "@" where @@ -28,7 +35,13 @@ instance Entity Character where blocksVision _ = False instance Arbitrary Character where - arbitrary = pure Character + arbitrary = genericArbitrary mkCharacter :: Character mkCharacter = Character + { _inventory = mempty + } + +pickUpItem :: Item -> Character -> Character +pickUpItem item = inventory %~ (item <|) + diff --git a/src/Xanthous/Entities/Creature.hs b/src/Xanthous/Entities/Creature.hs index 5af24a8cd3..024859473f 100644 --- a/src/Xanthous/Entities/Creature.hs +++ b/src/Xanthous/Entities/Creature.hs @@ -1,28 +1,33 @@ {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE TemplateHaskell #-} --- | - -module Xanthous.Entities.Creature where - -import Data.Word - +-------------------------------------------------------------------------------- +module Xanthous.Entities.Creature + ( Creature(..) + , creatureType + , hitpoints + , newWithType + , damage + ) where +-------------------------------------------------------------------------------- import Xanthous.Prelude +-------------------------------------------------------------------------------- +import Data.Word +-------------------------------------------------------------------------------- import Xanthous.Entities.RawTypes hiding (Creature) -import Xanthous.Entities (Draw(..), Entity(..)) +import Xanthous.Entities (Draw(..), Entity(..), DrawRawChar(..)) +-------------------------------------------------------------------------------- data Creature = Creature { _creatureType :: CreatureType , _hitpoints :: Word16 } deriving stock (Eq, Show, Generic) + deriving Draw via DrawRawChar "_creatureType" Creature makeLenses ''Creature instance Entity Creature where blocksVision _ = False -instance Draw Creature where - draw = draw .view (creatureType . char) - newWithType :: CreatureType -> Creature newWithType _creatureType = let _hitpoints = _creatureType ^. maxHitpoints diff --git a/src/Xanthous/Entities/Item.hs b/src/Xanthous/Entities/Item.hs new file mode 100644 index 0000000000..baf4be2f54 --- /dev/null +++ b/src/Xanthous/Entities/Item.hs @@ -0,0 +1,35 @@ +{-# LANGUAGE TemplateHaskell #-} +module Xanthous.Entities.Item + ( Item(..) + , itemType + , newWithType + ) where +-------------------------------------------------------------------------------- +import Xanthous.Prelude +import Test.QuickCheck +import Data.Aeson (ToJSON, FromJSON) +import Data.Aeson.Generic.DerivingVia +-------------------------------------------------------------------------------- +import Xanthous.Entities.RawTypes hiding (Item) +import Xanthous.Entities (Draw(..), Entity(..), DrawRawChar(..)) +-------------------------------------------------------------------------------- + +data Item = Item + { _itemType :: ItemType + } + deriving stock (Eq, Show, Generic) + deriving anyclass (CoArbitrary, Function) + deriving Draw via DrawRawChar "_itemType" Item + deriving (ToJSON, FromJSON) + via WithOptions '[ FieldLabelModifier '[Drop 1] ] + Item +makeLenses ''Item + +instance Arbitrary Item where + arbitrary = Item <$> arbitrary + +instance Entity Item where + blocksVision _ = False + +newWithType :: ItemType -> Item +newWithType = Item diff --git a/src/Xanthous/Entities/RawTypes.hs b/src/Xanthous/Entities/RawTypes.hs index 88087a5dab..1546d85e45 100644 --- a/src/Xanthous/Entities/RawTypes.hs +++ b/src/Xanthous/Entities/RawTypes.hs @@ -1,6 +1,6 @@ {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE DuplicateRecordFields #-} - +-------------------------------------------------------------------------------- module Xanthous.Entities.RawTypes ( CreatureType(..) , ItemType(..) @@ -9,19 +9,20 @@ module Xanthous.Entities.RawTypes , HasName(..) , HasDescription(..) , HasLongDescription(..) - , HasChar(..) , HasMaxHitpoints(..) , HasFriendly(..) , _Creature ) where - +-------------------------------------------------------------------------------- import Xanthous.Prelude +import Test.QuickCheck +import Test.QuickCheck.Arbitrary.Generic import Data.Aeson.Generic.DerivingVia -import Data.Aeson (FromJSON) +import Data.Aeson (ToJSON, FromJSON) import Data.Word - -import Xanthous.Entities (EntityChar) - +-------------------------------------------------------------------------------- +import Xanthous.Entities (EntityChar, HasChar(..)) +-------------------------------------------------------------------------------- data CreatureType = CreatureType { _name :: Text , _description :: Text @@ -35,7 +36,7 @@ data CreatureType = CreatureType via WithOptions '[ FieldLabelModifier '[Drop 1] ] CreatureType makeFieldsNoPrefix ''CreatureType - +-------------------------------------------------------------------------------- data ItemType = ItemType { _name :: Text , _description :: Text @@ -43,12 +44,15 @@ data ItemType = ItemType , _char :: EntityChar } deriving stock (Show, Eq, Generic) - deriving anyclass (NFData) - deriving (FromJSON) + deriving anyclass (NFData, CoArbitrary, Function) + deriving (ToJSON, FromJSON) via WithOptions '[ FieldLabelModifier '[Drop 1] ] ItemType makeFieldsNoPrefix ''ItemType +instance Arbitrary ItemType where + arbitrary = genericArbitrary + data EntityRaw = Creature CreatureType | Item ItemType diff --git a/src/Xanthous/Entities/Raws.hs b/src/Xanthous/Entities/Raws.hs index 4a4cba8c9a..e1bb429a0f 100644 --- a/src/Xanthous/Entities/Raws.hs +++ b/src/Xanthous/Entities/Raws.hs @@ -1,17 +1,23 @@ {-# LANGUAGE TemplateHaskell #-} - +-------------------------------------------------------------------------------- module Xanthous.Entities.Raws ( raws , raw + , RawType(..) + , rawsWithType + , entityFromRaw ) where - +-------------------------------------------------------------------------------- import Data.FileEmbed import qualified Data.Yaml as Yaml import Xanthous.Prelude import System.FilePath.Posix - +-------------------------------------------------------------------------------- import Xanthous.Entities.RawTypes - +import Xanthous.Entities +import qualified Xanthous.Entities.Creature as Creature +import qualified Xanthous.Entities.Item as Item +-------------------------------------------------------------------------------- rawRaws :: [(FilePath, ByteString)] rawRaws = $(embedDir "src/Xanthous/Entities/Raws") @@ -26,3 +32,27 @@ raws raw :: Text -> Maybe EntityRaw raw n = raws ^. at n + +class RawType (a :: Type) where + _RawType :: Prism' EntityRaw a + +instance RawType CreatureType where + _RawType = prism' Creature $ \case + Creature c -> Just c + _ -> Nothing + +instance RawType ItemType where + _RawType = prism' Item $ \case + Item i -> Just i + _ -> Nothing + +rawsWithType :: forall a. RawType a => HashMap Text a +rawsWithType = mapFromList . itoListOf (ifolded . _RawType) $ raws + +-------------------------------------------------------------------------------- + +entityFromRaw :: EntityRaw -> SomeEntity +entityFromRaw (Creature creatureType) + = SomeEntity $ Creature.newWithType creatureType +entityFromRaw (Item itemType) + = SomeEntity $ Item.newWithType itemType diff --git a/src/Xanthous/Entities/Raws/noodles.yaml b/src/Xanthous/Entities/Raws/noodles.yaml new file mode 100644 index 0000000000..120087d483 --- /dev/null +++ b/src/Xanthous/Entities/Raws/noodles.yaml @@ -0,0 +1,8 @@ +Item: + name: noodles + description: a big bowl o' noodles + longDescription: You know exactly what kind of noodles + char: + char: 'n' + style: + foreground: yellow diff --git a/src/Xanthous/Game.hs b/src/Xanthous/Game.hs index ed65217e62..777e05ee41 100644 --- a/src/Xanthous/Game.hs +++ b/src/Xanthous/Game.hs @@ -5,7 +5,7 @@ module Xanthous.Game ( GameState(..) , entities - , revealedEntities + , revealedPositions , messageHistory , randomGen @@ -35,7 +35,6 @@ import Test.QuickCheck import Test.QuickCheck.Arbitrary.Generic import Control.Monad.State.Class -------------------------------------------------------------------------------- -import Xanthous.Util (appendVia) import Xanthous.Data.EntityMap (EntityMap, EntityID) import qualified Xanthous.Data.EntityMap as EntityMap import Xanthous.Data.EntityMap.Graphics @@ -43,6 +42,7 @@ import Xanthous.Data (Positioned, Position(..), positioned, position) import Xanthous.Entities (SomeEntity(..), downcastEntity, entityIs) import Xanthous.Entities.Character import Xanthous.Entities.Creature +import Xanthous.Entities.Item import Xanthous.Entities.Arbitrary () import Xanthous.Orphans () -------------------------------------------------------------------------------- @@ -71,12 +71,11 @@ hideMessage NoMessageHistory = NoMessageHistory hideMessage (MessageHistory msgs _) = MessageHistory msgs False data GameState = GameState - { _entities :: EntityMap SomeEntity - -- | A subset of the overall set of entities - , _revealedEntities :: EntityMap SomeEntity - , _characterEntityID :: EntityID - , _messageHistory :: MessageHistory - , _randomGen :: StdGen + { _entities :: !(EntityMap SomeEntity) + , _revealedPositions :: !(Set Position) + , _characterEntityID :: !EntityID + , _messageHistory :: !MessageHistory + , _randomGen :: !StdGen } deriving stock (Show) makeLenses ''GameState @@ -84,7 +83,7 @@ makeLenses ''GameState instance Eq GameState where (==) = (==) `on` \gs -> ( gs ^. entities - , gs ^. revealedEntities + , gs ^. revealedPositions , gs ^. characterEntityID , gs ^. messageHistory ) @@ -96,11 +95,7 @@ instance Arbitrary GameState where _messageHistory <- arbitrary (_characterEntityID, _entities) <- arbitrary <&> EntityMap.insertAtReturningID charPos (SomeEntity char) - revealedPositions <- sublistOf $ EntityMap.positions _entities - let _revealedEntities = mempty &~ do - for_ revealedPositions $ \pos -> do - let ents = _entities ^. EntityMap.atPosition pos - EntityMap.atPosition pos <>= ents + _revealedPositions <- fmap setFromList . sublistOf $ EntityMap.positions _entities _randomGen <- mkStdGen <$> arbitrary pure $ GameState {..} @@ -114,7 +109,7 @@ getInitialState = do (SomeEntity char) mempty _messageHistory = NoMessageHistory - _revealedEntities = _entities + _revealedPositions = mempty pure GameState {..} positionedCharacter :: Lens' GameState (Positioned Character) @@ -151,8 +146,8 @@ visionRadius = 12 -- TODO make this dynamic updateCharacterVision :: GameState -> GameState updateCharacterVision game = let charPos = game ^. characterPosition - visible = visibleEntities charPos visionRadius $ game ^. entities - in game & revealedEntities %~ appendVia EntityMap.Deduplicate visible + visible = visiblePositions charPos visionRadius $ game ^. entities + in game & revealedPositions <>~ visible -------------------------------------------------------------------------------- @@ -169,4 +164,5 @@ collisionAt pos = do pure $ if | null ents -> Nothing | any (entityIs @Creature) ents -> pure Combat + | all (entityIs @Item) ents -> Nothing | otherwise -> pure Stop diff --git a/src/Xanthous/Game/Draw.hs b/src/Xanthous/Game/Draw.hs index bb6508acdf..8deb20ff84 100644 --- a/src/Xanthous/Game/Draw.hs +++ b/src/Xanthous/Game/Draw.hs @@ -17,7 +17,7 @@ import Xanthous.Entities import Xanthous.Game ( GameState(..) , entities - , revealedEntities + , revealedPositions , characterPosition , MessageHistory(..) , messageHistory @@ -37,28 +37,34 @@ drawMessages (MessageHistory (lastMessage :| _) True) = txt lastMessage -- (MessageHistory (lastMessage :| _) True) -> txt lastMessage drawEntities - :: EntityMap SomeEntity -- ^ visible entities + :: Set Position + -- ^ Positions the character has seen + -- FIXME: this will break down as soon as creatures can walk around on their + -- own, since we don't want to render things walking around when the + -- character can't see them -> EntityMap SomeEntity -- ^ all entities -> Widget Name -drawEntities em allEnts +drawEntities visiblePositions allEnts = vBox rows where - entityPositions = EntityMap.positions em + entityPositions = EntityMap.positions allEnts maxY = fromMaybe 0 $ maximumOf (folded . y) entityPositions maxX = fromMaybe 0 $ maximumOf (folded . x) entityPositions rows = mkRow <$> [0..maxY] mkRow rowY = hBox $ renderEntityAt . flip Position rowY <$> [0..maxX] - renderEntityAt pos = - let neighbors = EntityMap.neighbors pos allEnts - in maybe (str " ") (drawWithNeighbors neighbors) - $ em ^? atPosition pos . folded + renderEntityAt pos + | pos `member` visiblePositions + = let neighbors = EntityMap.neighbors pos allEnts + in maybe (str " ") (drawWithNeighbors neighbors) + $ allEnts ^? atPosition pos . folded + | otherwise = str " " drawMap :: GameState -> Widget Name drawMap game = viewport MapViewport Both . showCursor Character (game ^. characterPosition . loc) $ drawEntities - (game ^. revealedEntities) + (game ^. revealedPositions) (game ^. entities) drawGame :: GameState -> [Widget Name] diff --git a/src/Xanthous/Generators.hs b/src/Xanthous/Generators.hs index 6e2e89d14a..832a3d8fdc 100644 --- a/src/Xanthous/Generators.hs +++ b/src/Xanthous/Generators.hs @@ -1,18 +1,35 @@ -{-# LANGUAGE GADTs #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE TemplateHaskell #-} -------------------------------------------------------------------------------- -module Xanthous.Generators where +module Xanthous.Generators + ( generate + , SGenerator(..) + , GeneratorInput + , generateFromInput + , parseGeneratorInput + , showCells + , Level(..) + , levelWalls + , levelItems + , levelCharacterPosition + , generateLevel + ) where -------------------------------------------------------------------------------- -import Xanthous.Prelude +import Xanthous.Prelude hiding (Level) import Data.Array.Unboxed import System.Random (RandomGen) import qualified Options.Applicative as Opt +import Control.Monad.Random -------------------------------------------------------------------------------- import qualified Xanthous.Generators.CaveAutomata as CaveAutomata import Xanthous.Generators.Util +import Xanthous.Generators.LevelContents import Xanthous.Data (Dimensions, Position(Position)) import Xanthous.Data.EntityMap (EntityMap) import qualified Xanthous.Data.EntityMap as EntityMap import Xanthous.Entities.Environment +import Xanthous.Entities.Item -------------------------------------------------------------------------------- data Generator = CaveAutomata @@ -68,3 +85,21 @@ cellsToWalls cells = foldl' maybeInsertWall mempty . assocs $ cells in EntityMap.insertAt (Position x' y') Wall em maybeInsertWall em _ = em surroundedOnAllSides pos = numAliveNeighbors cells pos == 8 + +-------------------------------------------------------------------------------- + +data Level = Level + { _levelWalls :: EntityMap Wall + , _levelItems :: EntityMap Item + , _levelCharacterPosition :: Position + } +makeLenses ''Level + +generateLevel :: MonadRandom m => SGenerator gen -> Params gen -> Dimensions -> m Level +generateLevel gen ps dims = do + rand <- mkStdGen <$> getRandom + let cells = generate gen ps dims rand + _levelWalls = cellsToWalls cells + _levelItems <- randomItems cells + _levelCharacterPosition <- chooseCharacterPosition cells + pure Level {..} diff --git a/src/Xanthous/Generators/LevelContents.hs b/src/Xanthous/Generators/LevelContents.hs index f8d9b8a204..9192674ba7 100644 --- a/src/Xanthous/Generators/LevelContents.hs +++ b/src/Xanthous/Generators/LevelContents.hs @@ -1,21 +1,45 @@ -------------------------------------------------------------------------------- module Xanthous.Generators.LevelContents ( chooseCharacterPosition + , randomItems ) where -------------------------------------------------------------------------------- -import Xanthous.Prelude +import Xanthous.Prelude -------------------------------------------------------------------------------- -import Control.Monad.Random -import Data.Array.IArray (amap) +import Control.Monad.Random +import Data.Array.IArray (amap, bounds, rangeSize) -------------------------------------------------------------------------------- -import Xanthous.Generators.Util -import Xanthous.Random +import Xanthous.Generators.Util +import Xanthous.Random +import Xanthous.Data (Position, positionFromPair) +import Xanthous.Data.EntityMap (EntityMap, _EntityMap) +import Xanthous.Entities.Item (Item(..)) +import Xanthous.Entities.Raws +import Xanthous.Entities.RawTypes +import qualified Xanthous.Entities.Item as Item -------------------------------------------------------------------------------- -chooseCharacterPosition :: MonadRandom m => Cells -> m (Word, Word) -chooseCharacterPosition cells = choose $ impureNonNull candidates +chooseCharacterPosition :: MonadRandom m => Cells -> m Position +chooseCharacterPosition = randomPosition + +randomItems :: MonadRandom m => Cells -> m (EntityMap Item) +randomItems cells = do + let len = rangeSize $ bounds cells + (numItems :: Int) <- floor . (* fromIntegral len) + <$> getRandomR @_ @Float (0.0004, 0.001) + items <- for [0..numItems] $ const do + pos <- randomPosition cells + itemType <- fmap (fromMaybe (error "no item raws!")) + . choose . ChooseElement + $ rawsWithType @ItemType + let item = Item.newWithType itemType + pure (pos, item) + pure $ _EntityMap # items + +randomPosition :: MonadRandom m => Cells -> m Position +randomPosition cells = fmap positionFromPair . choose $ impureNonNull candidates where - -- cells ends up with true = wall, we want true = can put a character here + -- cells ends up with true = wall, we want true = can put an item here placeableCells = amap not cells -- find the largest contiguous region of cells in the cave. diff --git a/src/Xanthous/Orphans.hs b/src/Xanthous/Orphans.hs index c84756eb1e..22325f6366 100644 --- a/src/Xanthous/Orphans.hs +++ b/src/Xanthous/Orphans.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE ViewPatterns #-} {-# LANGUAGE UndecidableInstances, PatternSynonyms #-} @@ -15,6 +16,7 @@ import qualified Data.List.NonEmpty as NonEmpty import Data.Text.Arbitrary () import Graphics.Vty.Attributes import Test.QuickCheck +import Test.QuickCheck.Arbitrary.Generic import Text.Megaparsec (errorBundlePretty) import Text.Megaparsec.Pos import Text.Mustache @@ -157,15 +159,15 @@ deriving anyclass instance NFData Template instance FromJSON Color where parseJSON = withText "Color" $ \case - "black" -> pure black - "red" -> pure red - "green" -> pure green - "yellow" -> pure yellow - "blue" -> pure blue + "black" -> pure black + "red" -> pure red + "green" -> pure green + "yellow" -> pure yellow + "blue" -> pure blue "magenta" -> pure magenta - "cyan" -> pure cyan - "white" -> pure white - _ -> fail "Invalid color" + "cyan" -> pure cyan + "white" -> pure white + _ -> fail "Invalid color" instance ToJSON Color where toJSON color @@ -180,6 +182,44 @@ instance ToJSON Color where | otherwise = error "unimplemented" instance (Eq a, Show a, Read a, FromJSON a) => FromJSON (MaybeDefault a) where - parseJSON Null = pure Default - parseJSON x = SetTo <$> parseJSON x + parseJSON Null = pure Default + parseJSON (String "keepCurrent") = pure KeepCurrent + parseJSON x = SetTo <$> parseJSON x +instance ToJSON a => ToJSON (MaybeDefault a) where + toJSON Default = Null + toJSON KeepCurrent = String "keepCurrent" + toJSON (SetTo x) = toJSON x + +-------------------------------------------------------------------------------- + +instance Arbitrary Color where + arbitrary = genericArbitrary + +deriving anyclass instance CoArbitrary Color +deriving anyclass instance Function Color + +instance (Eq a, Show a, Read a, Arbitrary a) => Arbitrary (MaybeDefault a) where + arbitrary = oneof [ pure Default + , pure KeepCurrent + , SetTo <$> arbitrary + ] + +instance CoArbitrary a => CoArbitrary (MaybeDefault a) where + coarbitrary Default = variant @Int 1 + coarbitrary KeepCurrent = variant @Int 2 + coarbitrary (SetTo x) = variant @Int 3 . coarbitrary x + +instance (Eq a, Show a, Read a, Function a) => Function (MaybeDefault a) where + function = functionShow + +instance Arbitrary Attr where + arbitrary = do + attrStyle <- arbitrary + attrForeColor <- arbitrary + attrBackColor <- arbitrary + attrURL <- arbitrary + pure Attr {..} + +deriving anyclass instance CoArbitrary Attr +deriving anyclass instance Function Attr diff --git a/src/Xanthous/messages.yaml b/src/Xanthous/messages.yaml index d383cf6196..5bb11ab059 100644 --- a/src/Xanthous/messages.yaml +++ b/src/Xanthous/messages.yaml @@ -1 +1,4 @@ welcome: Welcome to Xanthous! It's dangerous out there, why not stay inside? +items: + pickUp: You pick up the {{item.itemType.name}} + nothingToPickUp: There's nothing here to pick up diff --git a/xanthous.cabal b/xanthous.cabal index b625105b1b..ef3498af06 100644 --- a/xanthous.cabal +++ b/xanthous.cabal @@ -4,7 +4,7 @@ cabal-version: 1.12 -- -- see: https://github.com/sol/hpack -- --- hash: 86b7d3047b95fc65f4c6489a21e8c89883981c8c5bd552b5ea83aaf70de8a7cf +-- hash: 78a45f3d5eb8c2993c219fd4214f61e9842177fa4d97667aeaedbfe3d0842165 name: xanthous version: 0.1.0.0 @@ -41,6 +41,7 @@ library Xanthous.Entities.Creature Xanthous.Entities.Draw.Util Xanthous.Entities.Environment + Xanthous.Entities.Item Xanthous.Entities.Raws Xanthous.Entities.RawTypes Xanthous.Game @@ -79,6 +80,7 @@ library , file-embed , filepath , generic-arbitrary + , generic-lens , generic-monoid , groups , lens @@ -111,6 +113,7 @@ executable xanthous Xanthous.Entities.Creature Xanthous.Entities.Draw.Util Xanthous.Entities.Environment + Xanthous.Entities.Item Xanthous.Entities.Raws Xanthous.Entities.RawTypes Xanthous.Game @@ -148,6 +151,7 @@ executable xanthous , file-embed , filepath , generic-arbitrary + , generic-lens , generic-monoid , groups , lens @@ -200,6 +204,7 @@ test-suite test , file-embed , filepath , generic-arbitrary + , generic-lens , generic-monoid , groups , lens -- cgit 1.4.1 From 7770ed05484a8a7aae4d5d680a069a0886a145dd Mon Sep 17 00:00:00 2001 From: Griffin Smith Date: Fri, 20 Sep 2019 12:03:30 -0400 Subject: Add the beginnings of a prompt system Add the beginnings of a generic prompt system, with exclusive support atm for string prompts, and test it out by asking the character for their name at startup --- src/Xanthous/App.hs | 87 +++++++++++++++++++++------ src/Xanthous/Data/EntityMap.hs | 27 ++++----- src/Xanthous/Entities/Character.hs | 9 +++ src/Xanthous/Game.hs | 44 ++++++++++++++ src/Xanthous/Game/Draw.hs | 68 ++++++++++++--------- src/Xanthous/Game/Prompt.hs | 117 ++++++++++++++++++++++++++++++++++++ src/Xanthous/Monad.hs | 39 +++--------- src/Xanthous/Resource.hs | 1 + src/Xanthous/messages.yaml | 4 +- test/Xanthous/Data/EntityMapSpec.hs | 5 +- test/Xanthous/GameSpec.hs | 3 + xanthous.cabal | 4 +- 12 files changed, 312 insertions(+), 96 deletions(-) create mode 100644 src/Xanthous/Game/Prompt.hs diff --git a/src/Xanthous/App.hs b/src/Xanthous/App.hs index 0f49b4d800..0c7b85541a 100644 --- a/src/Xanthous/App.hs +++ b/src/Xanthous/App.hs @@ -4,11 +4,13 @@ module Xanthous.App (makeApp) where import Xanthous.Prelude import Brick hiding (App, halt, continue, raw) import qualified Brick +import Brick.Widgets.Edit (handleEditorEvent) import Graphics.Vty.Attributes (defAttr) -import Graphics.Vty.Input.Events (Event(EvKey)) -import Control.Monad.State (get) +import Graphics.Vty.Input.Events (Event(EvKey), Key(..)) +import Control.Monad.State (get, state, StateT(..)) +import Data.Coerce import Control.Monad.State.Class (modify) -import Data.Aeson (object) +import Data.Aeson (object, ToJSON) import qualified Data.Aeson as A -------------------------------------------------------------------------------- import Xanthous.Command @@ -20,14 +22,13 @@ import Xanthous.Data import qualified Xanthous.Data.EntityMap as EntityMap import Xanthous.Game import Xanthous.Game.Draw (drawGame) +import Xanthous.Game.Prompt import Xanthous.Monad import Xanthous.Resource (Name) +import Xanthous.Messages (message) -------------------------------------------------------------------------------- -import Xanthous.Entities.Creature (Creature) -import qualified Xanthous.Entities.Creature as Creature import qualified Xanthous.Entities.Character as Character -import Xanthous.Entities.RawTypes (EntityRaw(..)) -import Xanthous.Entities.Raws (raw) +import Xanthous.Entities.Character (characterName) import Xanthous.Entities import Xanthous.Entities.Item (Item) import Xanthous.Generators @@ -41,7 +42,7 @@ makeApp :: IO App makeApp = pure $ Brick.App { appDraw = drawGame , appChooseCursor = const headMay - , appHandleEvent = \state event -> runAppM (handleEvent event) state + , appHandleEvent = \game event -> runAppM (handleEvent event) game , appStartEvent = runAppM $ startEvent >> get , appAttrMap = const $ attrMap defAttr [] } @@ -49,14 +50,13 @@ makeApp = pure $ Brick.App runAppM :: AppM a -> GameState -> EventM Name a runAppM appm = fmap fst . runAppT appm -testGormlak :: Creature -testGormlak = - let Just (Creature gormlak) = raw "gormlak" - in Creature.newWithType gormlak +-- testGormlak :: Creature +-- testGormlak = +-- let Just (Creature gormlak) = raw "gormlak" +-- in Creature.newWithType gormlak startEvent :: AppM () startEvent = do - say_ ["welcome"] level <- generateLevel SCaveAutomata CaveAutomata.defaultParams $ Dimensions 80 80 @@ -64,15 +64,23 @@ startEvent = do entities <>= (SomeEntity <$> level ^. levelItems) characterPosition .= level ^. levelCharacterPosition modify updateCharacterVision - -- entities %= EntityMap.insertAt (Position 10 10) (SomeEntity testGormlak) - + prompt_ @'StringPrompt ["character", "namePrompt"] Uncancellable + $ \(StringResult s) -> do + character . characterName ?= s + say ["welcome"] =<< use character handleEvent :: BrickEvent Name () -> AppM (Next GameState) -handleEvent (VtyEvent (EvKey k mods)) +handleEvent ev = use promptState >>= \case + NoPrompt -> handleNoPromptEvent ev + WaitingPrompt msg pr -> handlePromptEvent msg pr ev + + +handleNoPromptEvent :: BrickEvent Name () -> AppM (Next GameState) +handleNoPromptEvent (VtyEvent (EvKey k mods)) | Just command <- commandFromKey k mods = do messageHistory %= hideMessage handleCommand command -handleEvent _ = continue +handleNoPromptEvent _ = continue handleCommand :: Command -> AppM (Next GameState) handleCommand Quit = halt @@ -106,3 +114,48 @@ handleCommand PreviousMessage = do messageHistory %= popMessage continue +handlePromptEvent + :: Text -- ^ Prompt message + -> Prompt (AppT Identity) + -> BrickEvent Name () + -> AppM (Next GameState) +handlePromptEvent _ (Prompt Cancellable _ _ _) (VtyEvent (EvKey KEsc [])) = do + promptState .= NoPrompt + continue +handlePromptEvent _ pr (VtyEvent (EvKey KEnter [])) = do + () <- state . coerce $ submitPrompt pr + promptState .= NoPrompt + continue +handlePromptEvent + msg + (Prompt c SStringPrompt (StringPromptState edit) cb) + (VtyEvent ev) + = do + edit' <- lift $ handleEditorEvent ev edit + let prompt' = Prompt c SStringPrompt (StringPromptState edit') cb + promptState .= WaitingPrompt msg prompt' + continue +handlePromptEvent _ _ _ = undefined + +prompt + :: forall (pt :: PromptType) (params :: Type). + (ToJSON params, SingPromptType pt) + => [Text] -- ^ Message key + -> params -- ^ Message params + -> PromptCancellable + -> (PromptResult pt -> AppT Identity ()) -- ^ Prompt promise handler + -> AppM () +prompt msgPath params cancellable cb = do + let pt = singPromptType @pt + msg <- message msgPath params + let p = mkPrompt cancellable pt cb + promptState .= WaitingPrompt msg p + +prompt_ + :: forall (pt :: PromptType) . + (SingPromptType pt) + => [Text] -- ^ Message key + -> PromptCancellable + -> (PromptResult pt -> AppT Identity ()) -- ^ Prompt promise handler + -> AppM () +prompt_ msg = prompt msg $ object [] diff --git a/src/Xanthous/Data/EntityMap.hs b/src/Xanthous/Data/EntityMap.hs index 926a02a48c..7885839d51 100644 --- a/src/Xanthous/Data/EntityMap.hs +++ b/src/Xanthous/Data/EntityMap.hs @@ -23,7 +23,10 @@ module Xanthous.Data.EntityMap , neighbors , Deduplicate(..) - -- * Querying an entityMap + -- * debug + , byID + , byPosition + ) where -------------------------------------------------------------------------------- import Xanthous.Prelude hiding (lookup) @@ -31,7 +34,6 @@ import Xanthous.Data ( Position , Positioned(..) , positioned - , position , Neighbors(..) , neighborPositions ) @@ -81,15 +83,15 @@ instance At (EntityMap a) where pure $ m & removeEIDAtPos pos & byID . at eid .~ Nothing - setter m (Just (Positioned pos e)) = - case lookupWithPosition eid m of - Nothing -> insertAt pos e m - Just (Positioned origPos _) -> m - & removeEIDAtPos origPos - & byID . ix eid . position .~ pos - & byPosition . at pos %~ \case - Nothing -> Just $ ncons eid mempty - Just es -> Just $ eid <| es + setter m (Just pe@(Positioned pos _)) = m + & (case lookupWithPosition eid m of + Nothing -> id + Just (Positioned origPos _) -> removeEIDAtPos origPos + ) + & byID . at eid ?~ pe + & byPosition . at pos %~ \case + Nothing -> Just $ ncons eid mempty + Just es -> Just $ eid <| es removeEIDAtPos pos = byPosition . at pos %~ (>>= fromNullable . nfilter (/= eid)) @@ -117,9 +119,6 @@ instance Semigroup (Deduplicate a) where _lastID = fromMaybe 1 $ maximumOf (ifolded . asIndex) _byID in Deduplicate EntityMap{..} -instance Monoid (Deduplicate a) where - mempty = Deduplicate emptyEntityMap - -------------------------------------------------------------------------------- diff --git a/src/Xanthous/Entities/Character.hs b/src/Xanthous/Entities/Character.hs index 3b2b320004..695d7bb0d0 100644 --- a/src/Xanthous/Entities/Character.hs +++ b/src/Xanthous/Entities/Character.hs @@ -1,6 +1,8 @@ {-# LANGUAGE TemplateHaskell #-} module Xanthous.Entities.Character ( Character(..) + , characterName + , inventory , mkCharacter , pickUpItem ) where @@ -10,6 +12,8 @@ import Test.QuickCheck import Test.QuickCheck.Instances.Vector () import Test.QuickCheck.Arbitrary.Generic import Brick +import Data.Aeson.Generic.DerivingVia +import Data.Aeson (ToJSON, FromJSON) -------------------------------------------------------------------------------- import Xanthous.Entities import Xanthous.Entities.Item @@ -17,9 +21,13 @@ import Xanthous.Entities.Item data Character = Character { _inventory :: !(Vector Item) + , _characterName :: !(Maybe Text) } deriving stock (Show, Eq, Generic) deriving anyclass (CoArbitrary, Function) + deriving (ToJSON, FromJSON) + via WithOptions '[ FieldLabelModifier '[Drop 1] ] + Character makeLenses ''Character scrollOffset :: Int @@ -40,6 +48,7 @@ instance Arbitrary Character where mkCharacter :: Character mkCharacter = Character { _inventory = mempty + , _characterName = Nothing } pickUpItem :: Item -> Character -> Character diff --git a/src/Xanthous/Game.hs b/src/Xanthous/Game.hs index 777e05ee41..59e436edc9 100644 --- a/src/Xanthous/Game.hs +++ b/src/Xanthous/Game.hs @@ -8,6 +8,8 @@ module Xanthous.Game , revealedPositions , messageHistory , randomGen + , promptState + , GamePromptState(..) , getInitialState @@ -24,6 +26,9 @@ module Xanthous.Game -- * collisions , Collision(..) , collisionAt + + -- * App monad + , AppT(..) ) where -------------------------------------------------------------------------------- import Xanthous.Prelude @@ -34,6 +39,8 @@ import System.Random import Test.QuickCheck import Test.QuickCheck.Arbitrary.Generic import Control.Monad.State.Class +import Control.Monad.State +import Control.Monad.Random.Class -------------------------------------------------------------------------------- import Xanthous.Data.EntityMap (EntityMap, EntityID) import qualified Xanthous.Data.EntityMap as EntityMap @@ -45,6 +52,7 @@ import Xanthous.Entities.Creature import Xanthous.Entities.Item import Xanthous.Entities.Arbitrary () import Xanthous.Orphans () +import Xanthous.Game.Prompt -------------------------------------------------------------------------------- data MessageHistory @@ -70,12 +78,33 @@ hideMessage :: MessageHistory -> MessageHistory hideMessage NoMessageHistory = NoMessageHistory hideMessage (MessageHistory msgs _) = MessageHistory msgs False +-------------------------------------------------------------------------------- + +data GamePromptState m where + NoPrompt :: GamePromptState m + WaitingPrompt :: Text -> Prompt m -> GamePromptState m + deriving stock (Show) + +-------------------------------------------------------------------------------- + +newtype AppT m a + = AppT { unAppT :: StateT GameState m a } + deriving ( Functor + , Applicative + , Monad + , MonadState GameState + ) + via (StateT GameState m) + +-------------------------------------------------------------------------------- + data GameState = GameState { _entities :: !(EntityMap SomeEntity) , _revealedPositions :: !(Set Position) , _characterEntityID :: !EntityID , _messageHistory :: !MessageHistory , _randomGen :: !StdGen + , _promptState :: !(GamePromptState (AppT Identity)) } deriving stock (Show) makeLenses ''GameState @@ -88,6 +117,7 @@ instance Eq GameState where , gs ^. messageHistory ) + instance Arbitrary GameState where arbitrary = do char <- arbitrary @Character @@ -97,8 +127,10 @@ instance Arbitrary GameState where EntityMap.insertAtReturningID charPos (SomeEntity char) _revealedPositions <- fmap setFromList . sublistOf $ EntityMap.positions _entities _randomGen <- mkStdGen <$> arbitrary + let _promptState = NoPrompt -- TODO pure $ GameState {..} + getInitialState :: IO GameState getInitialState = do _randomGen <- getStdGen @@ -110,6 +142,7 @@ getInitialState = do mempty _messageHistory = NoMessageHistory _revealedPositions = mempty + _promptState = NoPrompt pure GameState {..} positionedCharacter :: Lens' GameState (Positioned Character) @@ -166,3 +199,14 @@ collisionAt pos = do | any (entityIs @Creature) ents -> pure Combat | all (entityIs @Item) ents -> Nothing | otherwise -> pure Stop + +-------------------------------------------------------------------------------- + +instance MonadTrans AppT where + lift = AppT . lift + +instance (Monad m) => MonadRandom (AppT m) where + getRandomR rng = randomGen %%= randomR rng + getRandom = randomGen %%= random + getRandomRs rng = uses randomGen $ randomRs rng + getRandoms = uses randomGen randoms diff --git a/src/Xanthous/Game/Draw.hs b/src/Xanthous/Game/Draw.hs index 8deb20ff84..60ae7110a6 100644 --- a/src/Xanthous/Game/Draw.hs +++ b/src/Xanthous/Game/Draw.hs @@ -1,40 +1,47 @@ -{-# LANGUAGE ViewPatterns #-} - +-------------------------------------------------------------------------------- module Xanthous.Game.Draw ( drawGame ) where - -import Xanthous.Prelude -import Brick hiding (loc) -import Brick.Widgets.Border -import Brick.Widgets.Border.Style -import Data.List.NonEmpty(NonEmpty((:|))) - -import Xanthous.Data (Position(Position), x, y, loc) -import Xanthous.Data.EntityMap (EntityMap, atPosition) +-------------------------------------------------------------------------------- +import Xanthous.Prelude +import Brick hiding (loc) +import Brick.Widgets.Border +import Brick.Widgets.Border.Style +import Brick.Widgets.Edit +import Data.List.NonEmpty(NonEmpty((:|))) +-------------------------------------------------------------------------------- +import Xanthous.Data (Position(Position), x, y, loc) +import Xanthous.Data.EntityMap (EntityMap, atPosition) import qualified Xanthous.Data.EntityMap as EntityMap -import Xanthous.Entities -import Xanthous.Game - ( GameState(..) - , entities - , revealedPositions - , characterPosition - , MessageHistory(..) - , messageHistory - ) -import Xanthous.Resource (Name(..)) -import Xanthous.Orphans () +import Xanthous.Entities +import Xanthous.Game + ( GameState(..) + , entities + , revealedPositions + , characterPosition + , MessageHistory(..) + , messageHistory + , GamePromptState(..) + , promptState + ) +import Xanthous.Game.Prompt +import Xanthous.Resource (Name) +import qualified Xanthous.Resource as Resource +import Xanthous.Orphans () +-------------------------------------------------------------------------------- drawMessages :: MessageHistory -> Widget Name drawMessages NoMessageHistory = emptyWidget -drawMessages (MessageHistory _ False) = emptyWidget +drawMessages (MessageHistory _ False) = str " " drawMessages (MessageHistory (lastMessage :| _) True) = txt lastMessage --- an attempt to still take up a row even when no messages --- drawMessages msgs = vLimit 1 . Widget Greedy Fixed . render $ case msgs of --- NoMessageHistory -> padTop (Pad 2) $ str " " --- (MessageHistory _ False) -> padTop (Pad 2) $ str " " --- (MessageHistory (lastMessage :| _) True) -> txt lastMessage +drawPromptState :: GamePromptState m -> Widget Name +drawPromptState NoPrompt = emptyWidget +drawPromptState (WaitingPrompt msg (Prompt _ pt ps _)) = + case (pt, ps) of + (SStringPrompt, StringPromptState edit) -> + txt msg <+> renderEditor (txt . fold) True edit + _ -> undefined drawEntities :: Set Position @@ -61,8 +68,8 @@ drawEntities visiblePositions allEnts drawMap :: GameState -> Widget Name drawMap game - = viewport MapViewport Both - . showCursor Character (game ^. characterPosition . loc) + = viewport Resource.MapViewport Both + . showCursor Resource.Character (game ^. characterPosition . loc) $ drawEntities (game ^. revealedPositions) (game ^. entities) @@ -72,4 +79,5 @@ drawGame game = pure . withBorderStyle unicode $ drawMessages (game ^. messageHistory) + <=> drawPromptState (game ^. promptState) <=> border (drawMap game) diff --git a/src/Xanthous/Game/Prompt.hs b/src/Xanthous/Game/Prompt.hs new file mode 100644 index 0000000000..928340f064 --- /dev/null +++ b/src/Xanthous/Game/Prompt.hs @@ -0,0 +1,117 @@ +{-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE GADTs #-} +-------------------------------------------------------------------------------- +module Xanthous.Game.Prompt + ( PromptType(..) + , SPromptType(..) + , SingPromptType(..) + , PromptCancellable(..) + , PromptResult(..) + , PromptState(..) + , Prompt(..) + , mkPrompt + , isCancellable + , submitPrompt + ) where +-------------------------------------------------------------------------------- +import Xanthous.Prelude +-------------------------------------------------------------------------------- +import Brick.Widgets.Edit (Editor, editorText, getEditContents) +import Test.QuickCheck +import Test.QuickCheck.Arbitrary.Generic +-------------------------------------------------------------------------------- +import Xanthous.Data (Direction, Position) +import Xanthous.Resource (Name) +import qualified Xanthous.Resource as Resource +-------------------------------------------------------------------------------- + +data PromptType where + StringPrompt :: PromptType + Confirm :: PromptType + Menu :: Type -> PromptType + DirectionPrompt :: PromptType + PointOnMap :: PromptType + deriving stock (Generic) + +instance Show PromptType where + show StringPrompt = "StringPrompt" + show Confirm = "Confirm" + show (Menu _) = "Menu" + show DirectionPrompt = "DirectionPrompt" + show PointOnMap = "PointOnMap" + +data SPromptType :: PromptType -> Type where + SStringPrompt :: SPromptType 'StringPrompt + SConfirm :: SPromptType 'Confirm + SMenu :: forall a. SPromptType ('Menu a) + SDirectionPrompt :: SPromptType 'DirectionPrompt + SPointOnMap :: SPromptType 'PointOnMap + +class SingPromptType pt where singPromptType :: SPromptType pt +instance SingPromptType 'StringPrompt where singPromptType = SStringPrompt + +instance Show (SPromptType pt) where + show SStringPrompt = "SStringPrompt" + show SConfirm = "SConfirm" + show SMenu = "SMenu" + show SDirectionPrompt = "SDirectionPrompt" + show SPointOnMap = "SPointOnMap" + +data PromptCancellable + = Cancellable + | Uncancellable + deriving stock (Show, Eq, Ord, Enum, Generic) + deriving anyclass (NFData, CoArbitrary, Function) + +instance Arbitrary PromptCancellable where + arbitrary = genericArbitrary + +data PromptResult (pt :: PromptType) where + StringResult :: Text -> PromptResult 'StringPrompt + ConfirmResult :: Bool -> PromptResult 'Confirm + MenuResult :: forall a. a -> PromptResult ('Menu a) + DirectionResult :: Direction -> PromptResult 'DirectionPrompt + PointOnMapResult :: Position -> PromptResult 'PointOnMap + +data PromptState pt where + StringPromptState :: Editor Text Name -> PromptState 'StringPrompt + +deriving stock instance Show (PromptState pt) + +data Prompt (m :: Type -> Type) where + Prompt + :: forall (pt :: PromptType) + (m :: Type -> Type). + PromptCancellable + -> SPromptType pt + -> PromptState pt + -> (PromptResult pt -> m ()) + -> Prompt m + +instance Show (Prompt m) where + show (Prompt c pt ps _) + = "(Prompt " + <> show c <> " " + <> show pt <> " " + <> show ps + <> " )" + +mkPrompt :: PromptCancellable -> SPromptType pt -> (PromptResult pt -> m ()) -> Prompt m +mkPrompt c pt@SStringPrompt cb = + let ps = StringPromptState $ editorText Resource.Prompt (Just 1) "" + in Prompt c pt ps cb +mkPrompt _ _ _ = undefined + +isCancellable :: Prompt m -> Bool +isCancellable (Prompt Cancellable _ _ _) = True +isCancellable (Prompt Uncancellable _ _ _) = False + +submitPrompt :: Prompt m -> m () +submitPrompt (Prompt _ pt ps cb) = + case (pt, ps) of + (SStringPrompt, StringPromptState edit) -> + cb . StringResult . mconcat . getEditContents $ edit + _ -> undefined + +-- data PromptInput :: PromptType -> Type where +-- StringInput :: PromptInput 'StringPrompt diff --git a/src/Xanthous/Monad.hs b/src/Xanthous/Monad.hs index acf7775ede..4e3e58607c 100644 --- a/src/Xanthous/Monad.hs +++ b/src/Xanthous/Monad.hs @@ -17,24 +17,6 @@ import Data.Aeson import Xanthous.Game import Xanthous.Messages (message) -newtype AppT m a - = AppT { unAppT :: StateT GameState m a } - deriving ( Functor - , Applicative - , Monad - , MonadState GameState - ) - via (StateT GameState m) - -instance MonadTrans AppT where - lift = AppT . lift - -instance (Monad m) => MonadRandom (AppT m) where - getRandomR rng = randomGen %%= randomR rng - getRandom = randomGen %%= random - getRandomRs rng = uses randomGen $ randomRs rng - getRandoms = uses randomGen randoms - runAppT :: Monad m => AppT m a -> GameState -> m (a, GameState) runAppT appt initialState = flip runStateT initialState . unAppT $ appt @@ -44,19 +26,12 @@ halt = lift . Brick.halt =<< get continue :: AppT (EventM n) (Next GameState) continue = lift . Brick.continue =<< get --- say :: [Text] -> AppT m () --- say :: [Text] -> params -> AppT m () - -class SayR a where - say :: [Text] -> a - -instance Monad m => SayR (AppT m ()) where - say msgPath = say msgPath $ object [] -instance (Monad m, ToJSON params) => SayR (params -> AppT m ()) where - say msgPath params = do - msg <- message msgPath params - messageHistory %= pushMessage msg +say :: (MonadRandom m, ToJSON params, MonadState GameState m) + => [Text] -> params -> m () +say msgPath params = do + msg <- message msgPath params + messageHistory %= pushMessage msg -say_ :: Monad m => [Text] -> AppT m () -say_ = say +say_ :: (MonadRandom m, MonadState GameState m) => [Text] -> m () +say_ msgPath = say msgPath $ object [] diff --git a/src/Xanthous/Resource.hs b/src/Xanthous/Resource.hs index aa9020903c..782fd5040d 100644 --- a/src/Xanthous/Resource.hs +++ b/src/Xanthous/Resource.hs @@ -10,4 +10,5 @@ data Name = MapViewport -- ^ The character | MessageBox -- ^ The box where we display messages to the user + | Prompt deriving stock (Show, Eq, Ord) diff --git a/src/Xanthous/messages.yaml b/src/Xanthous/messages.yaml index 5bb11ab059..0f0a0149f6 100644 --- a/src/Xanthous/messages.yaml +++ b/src/Xanthous/messages.yaml @@ -1,4 +1,6 @@ -welcome: Welcome to Xanthous! It's dangerous out there, why not stay inside? +welcome: Welcome to Xanthous, {{characterName}}! It's dangerous out there, why not stay inside? items: pickUp: You pick up the {{item.itemType.name}} nothingToPickUp: There's nothing here to pick up +character: + namePrompt: "What's your name? " diff --git a/test/Xanthous/Data/EntityMapSpec.hs b/test/Xanthous/Data/EntityMapSpec.hs index 00bf150046..2e9714a44e 100644 --- a/test/Xanthous/Data/EntityMapSpec.hs +++ b/test/Xanthous/Data/EntityMapSpec.hs @@ -15,7 +15,10 @@ test = localOption (QuickCheckTests 20) $ testGroup "Xanthous.Data.EntityMap" [ testBatch $ monoid @(EntityMap Int) mempty , testGroup "Deduplicate" - [ testBatch $ monoid @(Deduplicate Int) mempty + [ testGroup "Semigroup laws" + [ testProperty "associative" $ \(a :: Deduplicate (EntityMap Int)) b c -> + a <> (b <> c) === (a <> b) <> c + ] ] , testGroup "Eq laws" [ testProperty "reflexivity" $ \(em :: EntityMap Int) -> diff --git a/test/Xanthous/GameSpec.hs b/test/Xanthous/GameSpec.hs index dbd1677f7e..32faae03d7 100644 --- a/test/Xanthous/GameSpec.hs +++ b/test/Xanthous/GameSpec.hs @@ -27,4 +27,7 @@ test = testGroup "Xanthous.Game" , testGroup "characterPosition" [ testProperty "lens laws" $ isLens characterPosition ] + , testGroup "character" + [ testProperty "lens laws" $ isLens character + ] ] diff --git a/xanthous.cabal b/xanthous.cabal index ef3498af06..cb89323b2b 100644 --- a/xanthous.cabal +++ b/xanthous.cabal @@ -4,7 +4,7 @@ cabal-version: 1.12 -- -- see: https://github.com/sol/hpack -- --- hash: 78a45f3d5eb8c2993c219fd4214f61e9842177fa4d97667aeaedbfe3d0842165 +-- hash: 40187d0301465905043b8caafec5465e644f711620c9fc1cfc57af4105ebe08c name: xanthous version: 0.1.0.0 @@ -46,6 +46,7 @@ library Xanthous.Entities.RawTypes Xanthous.Game Xanthous.Game.Draw + Xanthous.Game.Prompt Xanthous.Generators Xanthous.Generators.CaveAutomata Xanthous.Generators.LevelContents @@ -118,6 +119,7 @@ executable xanthous Xanthous.Entities.RawTypes Xanthous.Game Xanthous.Game.Draw + Xanthous.Game.Prompt Xanthous.Generators Xanthous.Generators.CaveAutomata Xanthous.Generators.LevelContents -- cgit 1.4.1 From 4db3a68efec079bdb8723f377929bfa05860bdc2 Mon Sep 17 00:00:00 2001 From: Griffin Smith Date: Fri, 20 Sep 2019 13:14:55 -0400 Subject: Add doors and an open command Add a Door entity and an Open command, which necessitated supporting the direction prompt. Currently nothing actually puts doors on the map, which puts a slight damper on actually testing this out. --- src/Xanthous/App.hs | 49 ++++++++++++++++++++++++++++---- src/Xanthous/Command.hs | 39 +++++++++++++++---------- src/Xanthous/Data.hs | 3 ++ src/Xanthous/Entities/Arbitrary.hs | 7 ++++- src/Xanthous/Entities/Creature.hs | 4 +++ src/Xanthous/Entities/Environment.hs | 44 ++++++++++++++++++++++++++-- src/Xanthous/Entities/RawTypes.hs | 5 ++++ src/Xanthous/Game.hs | 6 +++- src/Xanthous/Game/Draw.hs | 2 ++ src/Xanthous/Game/Prompt.hs | 7 ++++- src/Xanthous/Generators/CaveAutomata.hs | 2 +- src/Xanthous/Generators/LevelContents.hs | 2 +- src/Xanthous/messages.yaml | 10 ++++++- 13 files changed, 151 insertions(+), 29 deletions(-) diff --git a/src/Xanthous/App.hs b/src/Xanthous/App.hs index 0c7b85541a..df0b30c41b 100644 --- a/src/Xanthous/App.hs +++ b/src/Xanthous/App.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE MultiWayIf #-} {-# LANGUAGE ViewPatterns #-} module Xanthous.App (makeApp) where -------------------------------------------------------------------------------- @@ -18,7 +19,9 @@ import Xanthous.Data ( move , Dimensions'(Dimensions) , positioned + , Position ) +import Xanthous.Data.EntityMap (EntityMap) import qualified Xanthous.Data.EntityMap as EntityMap import Xanthous.Game import Xanthous.Game.Draw (drawGame) @@ -31,6 +34,7 @@ import qualified Xanthous.Entities.Character as Character import Xanthous.Entities.Character (characterName) import Xanthous.Entities import Xanthous.Entities.Item (Item) +import Xanthous.Entities.Environment (Door, open, locked) import Xanthous.Generators import qualified Xanthous.Generators.CaveAutomata as CaveAutomata -------------------------------------------------------------------------------- @@ -96,11 +100,7 @@ handleCommand (Move dir) = do handleCommand PickUp = do pos <- use characterPosition - ents <- uses entities $ EntityMap.atPositionWithIDs pos - let items = flip foldMap ents $ \(eid, view positioned -> se) -> - case downcastEntity @Item se of - Just item -> [(eid, item)] - Nothing -> [] + items <- uses entities $ entitiesAtPositionWithType @Item pos case items of [] -> say_ ["items", "nothingToPickUp"] [(itemID, item)] -> do @@ -114,11 +114,26 @@ handleCommand PreviousMessage = do messageHistory %= popMessage continue +handleCommand Open = do + prompt_ @'DirectionPrompt ["open", "prompt"] Cancellable + $ \(DirectionResult dir) -> do + pos <- move dir <$> use characterPosition + doors <- uses entities $ entitiesAtPositionWithType @Door pos + if | null doors -> say_ ["open", "nothingToOpen"] + | any (view $ _2 . locked) doors -> say_ ["open", "locked"] + | otherwise -> do + for_ doors $ \(eid, _) -> + entities . ix eid . positioned . _SomeEntity . open .= True + say_ ["open", "success"] + pure () + continue + handlePromptEvent :: Text -- ^ Prompt message -> Prompt (AppT Identity) -> BrickEvent Name () -> AppM (Next GameState) + handlePromptEvent _ (Prompt Cancellable _ _ _) (VtyEvent (EvKey KEsc [])) = do promptState .= NoPrompt continue @@ -126,6 +141,7 @@ handlePromptEvent _ pr (VtyEvent (EvKey KEnter [])) = do () <- state . coerce $ submitPrompt pr promptState .= NoPrompt continue + handlePromptEvent msg (Prompt c SStringPrompt (StringPromptState edit) cb) @@ -135,6 +151,15 @@ handlePromptEvent let prompt' = Prompt c SStringPrompt (StringPromptState edit') cb promptState .= WaitingPrompt msg prompt' continue + +handlePromptEvent _ (Prompt _ SDirectionPrompt _ cb) + (VtyEvent (EvKey (KChar (directionFromChar -> Just dir)) [])) + = do + () <- state . coerce . cb $ DirectionResult dir + promptState .= NoPrompt + continue +handlePromptEvent _ (Prompt _ SDirectionPrompt _ _) _ = continue + handlePromptEvent _ _ _ = undefined prompt @@ -159,3 +184,17 @@ prompt_ -> (PromptResult pt -> AppT Identity ()) -- ^ Prompt promise handler -> AppM () prompt_ msg = prompt msg $ object [] + +-------------------------------------------------------------------------------- + +entitiesAtPositionWithType + :: forall a. (Entity a, Typeable a) + => Position + -> EntityMap SomeEntity + -> [(EntityMap.EntityID, a)] +entitiesAtPositionWithType pos em = + let someEnts = EntityMap.atPositionWithIDs pos em + in flip foldMap someEnts $ \(eid, view positioned -> se) -> + case downcastEntity @a se of + Just e -> [(eid, e)] + Nothing -> [] diff --git a/src/Xanthous/Command.hs b/src/Xanthous/Command.hs index 94c8075b34..19c5e17e0a 100644 --- a/src/Xanthous/Command.hs +++ b/src/Xanthous/Command.hs @@ -1,30 +1,39 @@ +{-# LANGUAGE ViewPatterns #-} +-------------------------------------------------------------------------------- module Xanthous.Command where - -import Graphics.Vty.Input (Key(..), Modifier(..)) - +-------------------------------------------------------------------------------- import Xanthous.Prelude hiding (Left, Right, Down) +-------------------------------------------------------------------------------- +import Graphics.Vty.Input (Key(..), Modifier(..)) +-------------------------------------------------------------------------------- import Xanthous.Data (Direction(..)) +-------------------------------------------------------------------------------- data Command = Quit | Move Direction | PreviousMessage | PickUp + | Open commandFromKey :: Key -> [Modifier] -> Maybe Command commandFromKey (KChar 'q') [] = Just Quit - -commandFromKey (KChar 'h') [] = Just $ Move Left -commandFromKey (KChar 'j') [] = Just $ Move Down -commandFromKey (KChar 'k') [] = Just $ Move Up -commandFromKey (KChar 'l') [] = Just $ Move Right -commandFromKey (KChar 'y') [] = Just $ Move UpLeft -commandFromKey (KChar 'u') [] = Just $ Move UpRight -commandFromKey (KChar 'b') [] = Just $ Move DownLeft -commandFromKey (KChar 'n') [] = Just $ Move DownRight - +commandFromKey (KChar (directionFromChar -> Just dir)) [] = Just $ Move dir commandFromKey (KChar 'p') [MCtrl] = Just PreviousMessage - commandFromKey (KChar ',') [] = Just PickUp - +commandFromKey (KChar 'o') [] = Just Open commandFromKey _ _ = Nothing + +-------------------------------------------------------------------------------- + +directionFromChar :: Char -> Maybe Direction +directionFromChar 'h' = Just Left +directionFromChar 'j' = Just Down +directionFromChar 'k' = Just Up +directionFromChar 'l' = Just Right +directionFromChar 'y' = Just UpLeft +directionFromChar 'u' = Just UpRight +directionFromChar 'b' = Just DownLeft +directionFromChar 'n' = Just DownRight +directionFromChar '.' = Just Here +directionFromChar _ = Nothing diff --git a/src/Xanthous/Data.hs b/src/Xanthous/Data.hs index 704b3c6e74..afba273005 100644 --- a/src/Xanthous/Data.hs +++ b/src/Xanthous/Data.hs @@ -135,6 +135,7 @@ data Direction where UpRight :: Direction DownLeft :: Direction DownRight :: Direction + Here :: Direction deriving stock (Show, Eq, Generic) instance Arbitrary Direction where @@ -150,6 +151,7 @@ opposite UpLeft = DownRight opposite UpRight = DownLeft opposite DownLeft = UpRight opposite DownRight = UpLeft +opposite Here = Here move :: Direction -> Position -> Position move Up = y -~ 1 @@ -160,6 +162,7 @@ move UpLeft = move Up . move Left move UpRight = move Up . move Right move DownLeft = move Down . move Left move DownRight = move Down . move Right +move Here = id asPosition :: Direction -> Position asPosition dir = move dir mempty diff --git a/src/Xanthous/Entities/Arbitrary.hs b/src/Xanthous/Entities/Arbitrary.hs index 480282cff6..2d1890f787 100644 --- a/src/Xanthous/Entities/Arbitrary.hs +++ b/src/Xanthous/Entities/Arbitrary.hs @@ -9,11 +9,16 @@ import qualified Test.QuickCheck.Gen as Gen -------------------------------------------------------------------------------- import Xanthous.Entities (SomeEntity(..)) import Xanthous.Entities.Character +import Xanthous.Entities.Item +import Xanthous.Entities.Creature import Xanthous.Entities.Environment -------------------------------------------------------------------------------- instance Arbitrary SomeEntity where arbitrary = Gen.oneof [ SomeEntity <$> arbitrary @Character - , pure $ SomeEntity Wall + , SomeEntity <$> arbitrary @Item + , SomeEntity <$> arbitrary @Creature + , SomeEntity <$> arbitrary @Wall + , SomeEntity <$> arbitrary @Door ] diff --git a/src/Xanthous/Entities/Creature.hs b/src/Xanthous/Entities/Creature.hs index 024859473f..b59cceab40 100644 --- a/src/Xanthous/Entities/Creature.hs +++ b/src/Xanthous/Entities/Creature.hs @@ -12,6 +12,7 @@ module Xanthous.Entities.Creature import Xanthous.Prelude -------------------------------------------------------------------------------- import Data.Word +import Test.QuickCheck.Arbitrary.Generic -------------------------------------------------------------------------------- import Xanthous.Entities.RawTypes hiding (Creature) import Xanthous.Entities (Draw(..), Entity(..), DrawRawChar(..)) @@ -25,6 +26,9 @@ data Creature = Creature deriving Draw via DrawRawChar "_creatureType" Creature makeLenses ''Creature +instance Arbitrary Creature where + arbitrary = genericArbitrary + instance Entity Creature where blocksVision _ = False diff --git a/src/Xanthous/Entities/Environment.hs b/src/Xanthous/Entities/Environment.hs index 90fa05315a..d9275266b0 100644 --- a/src/Xanthous/Entities/Environment.hs +++ b/src/Xanthous/Entities/Environment.hs @@ -1,13 +1,19 @@ +{-# LANGUAGE TemplateHaskell #-} module Xanthous.Entities.Environment ( Wall(..) + , Door(..) + , open + , locked ) where -------------------------------------------------------------------------------- import Xanthous.Prelude import Test.QuickCheck +import Test.QuickCheck.Arbitrary.Generic import Brick (str) import Brick.Widgets.Border.Style (unicode) +import Brick.Types (Edges(..)) -------------------------------------------------------------------------------- -import Xanthous.Entities (Draw(..), entityIs, Entity(..)) +import Xanthous.Entities (Draw(..), entityIs, Entity(..), SomeEntity) import Xanthous.Entities.Draw.Util import Xanthous.Data -------------------------------------------------------------------------------- @@ -22,8 +28,40 @@ instance Entity Wall where instance Arbitrary Wall where arbitrary = pure Wall +wallEdges :: (MonoFoldable mono, Element mono ~ SomeEntity) + => Neighbors mono -> Edges Bool +wallEdges neighs = any (entityIs @Wall) <$> edges neighs + instance Draw Wall where drawWithNeighbors neighs _wall = - str . pure . borderFromEdges unicode $ wallEdges + str . pure . borderFromEdges unicode $ wallEdges neighs + +data Door = Door + { _open :: Bool + , _locked :: Bool + } + deriving stock (Show, Eq, Ord, Generic) + deriving anyclass (NFData, CoArbitrary, Function) +makeLenses ''Door + +instance Arbitrary Door where + arbitrary = genericArbitrary + +instance Draw Door where + drawWithNeighbors neighs door + | door ^. open + = str . pure $ case wallEdges neighs of + Edges True False False False -> vertDoor + Edges False True False False -> vertDoor + Edges True True False False -> vertDoor + Edges False False True False -> horizDoor + Edges False False False True -> horizDoor + Edges False False True True -> horizDoor + _ -> '+' + | otherwise = str "\\" where - wallEdges = any (entityIs @Wall) <$> edges neighs + horizDoor = '␣' + vertDoor = '[' + +instance Entity Door where + blocksVision = not . view open diff --git a/src/Xanthous/Entities/RawTypes.hs b/src/Xanthous/Entities/RawTypes.hs index 1546d85e45..94f6505453 100644 --- a/src/Xanthous/Entities/RawTypes.hs +++ b/src/Xanthous/Entities/RawTypes.hs @@ -36,7 +36,12 @@ data CreatureType = CreatureType via WithOptions '[ FieldLabelModifier '[Drop 1] ] CreatureType makeFieldsNoPrefix ''CreatureType + +instance Arbitrary CreatureType where + arbitrary = genericArbitrary + -------------------------------------------------------------------------------- + data ItemType = ItemType { _name :: Text , _description :: Text diff --git a/src/Xanthous/Game.hs b/src/Xanthous/Game.hs index 59e436edc9..68bd9e0438 100644 --- a/src/Xanthous/Game.hs +++ b/src/Xanthous/Game.hs @@ -46,10 +46,12 @@ import Xanthous.Data.EntityMap (EntityMap, EntityID) import qualified Xanthous.Data.EntityMap as EntityMap import Xanthous.Data.EntityMap.Graphics import Xanthous.Data (Positioned, Position(..), positioned, position) -import Xanthous.Entities (SomeEntity(..), downcastEntity, entityIs) +import Xanthous.Entities + (SomeEntity(..), downcastEntity, entityIs, _SomeEntity) import Xanthous.Entities.Character import Xanthous.Entities.Creature import Xanthous.Entities.Item +import Xanthous.Entities.Environment import Xanthous.Entities.Arbitrary () import Xanthous.Orphans () import Xanthous.Game.Prompt @@ -198,6 +200,8 @@ collisionAt pos = do if | null ents -> Nothing | any (entityIs @Creature) ents -> pure Combat | all (entityIs @Item) ents -> Nothing + | doors@(_ : _) <- ents ^.. folded . _SomeEntity @Door + , all (view open) doors -> Nothing | otherwise -> pure Stop -------------------------------------------------------------------------------- diff --git a/src/Xanthous/Game/Draw.hs b/src/Xanthous/Game/Draw.hs index 60ae7110a6..ff9240a5e1 100644 --- a/src/Xanthous/Game/Draw.hs +++ b/src/Xanthous/Game/Draw.hs @@ -41,6 +41,8 @@ drawPromptState (WaitingPrompt msg (Prompt _ pt ps _)) = case (pt, ps) of (SStringPrompt, StringPromptState edit) -> txt msg <+> renderEditor (txt . fold) True edit + (SDirectionPrompt, DirectionPromptState) -> + txt msg _ -> undefined drawEntities diff --git a/src/Xanthous/Game/Prompt.hs b/src/Xanthous/Game/Prompt.hs index 928340f064..f0df1385f7 100644 --- a/src/Xanthous/Game/Prompt.hs +++ b/src/Xanthous/Game/Prompt.hs @@ -49,6 +49,7 @@ data SPromptType :: PromptType -> Type where class SingPromptType pt where singPromptType :: SPromptType pt instance SingPromptType 'StringPrompt where singPromptType = SStringPrompt +instance SingPromptType 'DirectionPrompt where singPromptType = SDirectionPrompt instance Show (SPromptType pt) where show SStringPrompt = "SStringPrompt" @@ -75,6 +76,7 @@ data PromptResult (pt :: PromptType) where data PromptState pt where StringPromptState :: Editor Text Name -> PromptState 'StringPrompt + DirectionPromptState :: PromptState 'DirectionPrompt deriving stock instance Show (PromptState pt) @@ -100,17 +102,20 @@ mkPrompt :: PromptCancellable -> SPromptType pt -> (PromptResult pt -> m ()) -> mkPrompt c pt@SStringPrompt cb = let ps = StringPromptState $ editorText Resource.Prompt (Just 1) "" in Prompt c pt ps cb +mkPrompt c pt@SDirectionPrompt cb = Prompt c pt DirectionPromptState cb mkPrompt _ _ _ = undefined isCancellable :: Prompt m -> Bool isCancellable (Prompt Cancellable _ _ _) = True isCancellable (Prompt Uncancellable _ _ _) = False -submitPrompt :: Prompt m -> m () +submitPrompt :: Applicative m => Prompt m -> m () submitPrompt (Prompt _ pt ps cb) = case (pt, ps) of (SStringPrompt, StringPromptState edit) -> cb . StringResult . mconcat . getEditContents $ edit + (SDirectionPrompt, DirectionPromptState) -> + pure () -- Don't use submit with a direction prompt _ -> undefined -- data PromptInput :: PromptType -> Type where diff --git a/src/Xanthous/Generators/CaveAutomata.hs b/src/Xanthous/Generators/CaveAutomata.hs index f1123abbd8..e885f4ed1a 100644 --- a/src/Xanthous/Generators/CaveAutomata.hs +++ b/src/Xanthous/Generators/CaveAutomata.hs @@ -98,10 +98,10 @@ generate' params dims = do let steps' = params ^. steps when (steps' > 0) $ for_ [0 .. pred steps'] . const $ stepAutomata cells dims params - lift $ fillOuterEdgesM cells -- Remove all but the largest contiguous region of unfilled space (_: smallerRegions) <- lift $ regions @UArray . amap not <$> freeze cells lift $ fillAllM (fold smallerRegions) cells + lift $ fillOuterEdgesM cells pure cells stepAutomata :: forall s g. MCells s -> Dimensions -> Params -> CellM g s () diff --git a/src/Xanthous/Generators/LevelContents.hs b/src/Xanthous/Generators/LevelContents.hs index 9192674ba7..87b2a28974 100644 --- a/src/Xanthous/Generators/LevelContents.hs +++ b/src/Xanthous/Generators/LevelContents.hs @@ -27,7 +27,7 @@ randomItems cells = do let len = rangeSize $ bounds cells (numItems :: Int) <- floor . (* fromIntegral len) <$> getRandomR @_ @Float (0.0004, 0.001) - items <- for [0..numItems] $ const do + items <- for [0..numItems] $ const $ do pos <- randomPosition cells itemType <- fmap (fromMaybe (error "no item raws!")) . choose . ChooseElement diff --git a/src/Xanthous/messages.yaml b/src/Xanthous/messages.yaml index 0f0a0149f6..ef4f09543d 100644 --- a/src/Xanthous/messages.yaml +++ b/src/Xanthous/messages.yaml @@ -1,6 +1,14 @@ welcome: Welcome to Xanthous, {{characterName}}! It's dangerous out there, why not stay inside? + items: pickUp: You pick up the {{item.itemType.name}} - nothingToPickUp: There's nothing here to pick up + nothingToPickUp: "There's nothing here to pick up" + +open: + prompt: Direction to open (hjklybnu.)? + success: "You open the door." + locked: "That door is locked" + nothingToOpen: "There's nothing to open there" + character: namePrompt: "What's your name? " -- cgit 1.4.1 From dd1616666593f65bab70f1363b5d040fe5edd054 Mon Sep 17 00:00:00 2001 From: Griffin Smith Date: Fri, 20 Sep 2019 19:38:16 -0400 Subject: Describe what you see when you walk over items Every step the character takes, describe the entities at that position excluding the character. --- src/Xanthous/App.hs | 18 +++++++++++++++++- src/Xanthous/Entities.hs | 3 +++ src/Xanthous/Entities/Character.hs | 1 + src/Xanthous/Entities/Creature.hs | 12 +++++++----- src/Xanthous/Entities/Environment.hs | 2 ++ src/Xanthous/Entities/Item.hs | 15 +++++++++------ src/Xanthous/Entities/Raws/noodles.yaml | 2 +- src/Xanthous/Util/Inflection.hs | 15 +++++++++++++++ src/Xanthous/messages.yaml | 3 +++ test/Spec.hs | 2 ++ test/Xanthous/Util/InflectionSpec.hs | 18 ++++++++++++++++++ xanthous.cabal | 5 ++++- 12 files changed, 82 insertions(+), 14 deletions(-) create mode 100644 src/Xanthous/Util/Inflection.hs create mode 100644 test/Xanthous/Util/InflectionSpec.hs diff --git a/src/Xanthous/App.hs b/src/Xanthous/App.hs index df0b30c41b..fce2beed13 100644 --- a/src/Xanthous/App.hs +++ b/src/Xanthous/App.hs @@ -8,7 +8,8 @@ import qualified Brick import Brick.Widgets.Edit (handleEditorEvent) import Graphics.Vty.Attributes (defAttr) import Graphics.Vty.Input.Events (Event(EvKey), Key(..)) -import Control.Monad.State (get, state, StateT(..)) +import Control.Monad.State (get, state, StateT(..), MonadState) +import Control.Monad.Random (MonadRandom) import Data.Coerce import Control.Monad.State.Class (modify) import Data.Aeson (object, ToJSON) @@ -29,12 +30,14 @@ import Xanthous.Game.Prompt import Xanthous.Monad import Xanthous.Resource (Name) import Xanthous.Messages (message) +import Xanthous.Util.Inflection (toSentence) -------------------------------------------------------------------------------- import qualified Xanthous.Entities.Character as Character import Xanthous.Entities.Character (characterName) import Xanthous.Entities import Xanthous.Entities.Item (Item) import Xanthous.Entities.Environment (Door, open, locked) +import Xanthous.Entities.Character import Xanthous.Generators import qualified Xanthous.Generators.CaveAutomata as CaveAutomata -------------------------------------------------------------------------------- @@ -93,6 +96,7 @@ handleCommand (Move dir) = do collisionAt newPos >>= \case Nothing -> do characterPosition .= newPos + describeEntitiesAt newPos modify updateCharacterVision Just Combat -> undefined Just Stop -> pure () @@ -198,3 +202,15 @@ entitiesAtPositionWithType pos em = case downcastEntity @a se of Just e -> [(eid, e)] Nothing -> [] + +describeEntitiesAt :: (MonadState GameState m, MonadRandom m) => Position -> m () +describeEntitiesAt pos = + use ( entities + . EntityMap.atPosition pos + . to (filter (not . entityIs @Character)) + ) >>= \case + Empty -> pure () + ents -> + let descriptions = description <$> ents + in say ["entities", "description"] $ object + ["entityDescriptions" A..= toSentence descriptions] diff --git a/src/Xanthous/Entities.hs b/src/Xanthous/Entities.hs index e47e820f27..66a583f6b3 100644 --- a/src/Xanthous/Entities.hs +++ b/src/Xanthous/Entities.hs @@ -38,9 +38,11 @@ import Xanthous.Orphans () class (Show a, Eq a, Draw a) => Entity a where blocksVision :: a -> Bool + description :: a -> Text instance Entity a => Entity (Positioned a) where blocksVision (Positioned _ ent) = blocksVision ent + description (Positioned _ ent) = description ent -------------------------------------------------------------------------------- data SomeEntity where @@ -59,6 +61,7 @@ instance Draw SomeEntity where instance Entity SomeEntity where blocksVision (SomeEntity ent) = blocksVision ent + description (SomeEntity ent) = description ent downcastEntity :: (Entity a, Typeable a) => SomeEntity -> Maybe a downcastEntity (SomeEntity e) = cast e diff --git a/src/Xanthous/Entities/Character.hs b/src/Xanthous/Entities/Character.hs index 695d7bb0d0..924c1857a8 100644 --- a/src/Xanthous/Entities/Character.hs +++ b/src/Xanthous/Entities/Character.hs @@ -41,6 +41,7 @@ instance Draw Character where instance Entity Character where blocksVision _ = False + description _ = "yourself" instance Arbitrary Character where arbitrary = genericArbitrary diff --git a/src/Xanthous/Entities/Creature.hs b/src/Xanthous/Entities/Creature.hs index b59cceab40..c660a6cdf5 100644 --- a/src/Xanthous/Entities/Creature.hs +++ b/src/Xanthous/Entities/Creature.hs @@ -9,13 +9,14 @@ module Xanthous.Entities.Creature , damage ) where -------------------------------------------------------------------------------- -import Xanthous.Prelude +import Xanthous.Prelude -------------------------------------------------------------------------------- -import Data.Word -import Test.QuickCheck.Arbitrary.Generic +import Data.Word +import Test.QuickCheck.Arbitrary.Generic -------------------------------------------------------------------------------- -import Xanthous.Entities.RawTypes hiding (Creature) -import Xanthous.Entities (Draw(..), Entity(..), DrawRawChar(..)) +import Xanthous.Entities.RawTypes hiding (Creature, description) +import qualified Xanthous.Entities.RawTypes as Raw +import Xanthous.Entities (Draw(..), Entity(..), DrawRawChar(..)) -------------------------------------------------------------------------------- data Creature = Creature @@ -31,6 +32,7 @@ instance Arbitrary Creature where instance Entity Creature where blocksVision _ = False + description = view $ creatureType . Raw.description newWithType :: CreatureType -> Creature newWithType _creatureType = diff --git a/src/Xanthous/Entities/Environment.hs b/src/Xanthous/Entities/Environment.hs index d9275266b0..4ef67a577d 100644 --- a/src/Xanthous/Entities/Environment.hs +++ b/src/Xanthous/Entities/Environment.hs @@ -24,6 +24,7 @@ data Wall = Wall instance Entity Wall where blocksVision _ = True + description _ = "a wall" instance Arbitrary Wall where arbitrary = pure Wall @@ -65,3 +66,4 @@ instance Draw Door where instance Entity Door where blocksVision = not . view open + description _ = "a door" diff --git a/src/Xanthous/Entities/Item.hs b/src/Xanthous/Entities/Item.hs index baf4be2f54..6b50f50ad8 100644 --- a/src/Xanthous/Entities/Item.hs +++ b/src/Xanthous/Entities/Item.hs @@ -1,17 +1,19 @@ {-# LANGUAGE TemplateHaskell #-} +-------------------------------------------------------------------------------- module Xanthous.Entities.Item ( Item(..) , itemType , newWithType ) where -------------------------------------------------------------------------------- -import Xanthous.Prelude -import Test.QuickCheck -import Data.Aeson (ToJSON, FromJSON) -import Data.Aeson.Generic.DerivingVia +import Xanthous.Prelude +import Test.QuickCheck +import Data.Aeson (ToJSON, FromJSON) +import Data.Aeson.Generic.DerivingVia -------------------------------------------------------------------------------- -import Xanthous.Entities.RawTypes hiding (Item) -import Xanthous.Entities (Draw(..), Entity(..), DrawRawChar(..)) +import Xanthous.Entities.RawTypes hiding (Item, description) +import qualified Xanthous.Entities.RawTypes as Raw +import Xanthous.Entities (Draw(..), Entity(..), DrawRawChar(..)) -------------------------------------------------------------------------------- data Item = Item @@ -30,6 +32,7 @@ instance Arbitrary Item where instance Entity Item where blocksVision _ = False + description = view $ itemType . Raw.description newWithType :: ItemType -> Item newWithType = Item diff --git a/src/Xanthous/Entities/Raws/noodles.yaml b/src/Xanthous/Entities/Raws/noodles.yaml index 120087d483..91a0a35388 100644 --- a/src/Xanthous/Entities/Raws/noodles.yaml +++ b/src/Xanthous/Entities/Raws/noodles.yaml @@ -1,6 +1,6 @@ Item: name: noodles - description: a big bowl o' noodles + description: "a big bowl o' noodles" longDescription: You know exactly what kind of noodles char: char: 'n' diff --git a/src/Xanthous/Util/Inflection.hs b/src/Xanthous/Util/Inflection.hs new file mode 100644 index 0000000000..fc66c08761 --- /dev/null +++ b/src/Xanthous/Util/Inflection.hs @@ -0,0 +1,15 @@ +{-# LANGUAGE ViewPatterns #-} + +module Xanthous.Util.Inflection + ( toSentence + ) where + +import Xanthous.Prelude + +toSentence :: (MonoFoldable mono, Element mono ~ Text) => mono -> Text +toSentence xs = case reverse . toList $ xs of + [] -> "" + [x] -> x + [b, a] -> a <> " and " <> b + (final : butlast) -> + intercalate ", " (reverse butlast) <> ", and " <> final diff --git a/src/Xanthous/messages.yaml b/src/Xanthous/messages.yaml index ef4f09543d..4d7b0003fa 100644 --- a/src/Xanthous/messages.yaml +++ b/src/Xanthous/messages.yaml @@ -1,5 +1,8 @@ welcome: Welcome to Xanthous, {{characterName}}! It's dangerous out there, why not stay inside? +entities: + description: You see here {{entityDescriptions}} + items: pickUp: You pick up the {{item.itemType.name}} nothingToPickUp: "There's nothing here to pick up" diff --git a/test/Spec.hs b/test/Spec.hs index cac474053c..7af988a3d7 100644 --- a/test/Spec.hs +++ b/test/Spec.hs @@ -7,6 +7,7 @@ import qualified Xanthous.Generators.UtilSpec import qualified Xanthous.MessageSpec import qualified Xanthous.OrphansSpec import qualified Xanthous.Util.GraphicsSpec +import qualified Xanthous.Util.InflectionSpec main :: IO () main = defaultMain test @@ -21,4 +22,5 @@ test = testGroup "Xanthous" , Xanthous.OrphansSpec.test , Xanthous.DataSpec.test , Xanthous.Util.GraphicsSpec.test + , Xanthous.Util.InflectionSpec.test ] diff --git a/test/Xanthous/Util/InflectionSpec.hs b/test/Xanthous/Util/InflectionSpec.hs new file mode 100644 index 0000000000..fad8410431 --- /dev/null +++ b/test/Xanthous/Util/InflectionSpec.hs @@ -0,0 +1,18 @@ +module Xanthous.Util.InflectionSpec (main, test) where + +import Test.Prelude +import Xanthous.Util.Inflection + +main :: IO () +main = defaultMain test + +test :: TestTree +test = testGroup "Xanthous.Util.Inflection" + [ testGroup "toSentence" + [ testCase "empty" $ toSentence [] @?= "" + , testCase "single" $ toSentence ["x"] @?= "x" + , testCase "two" $ toSentence ["x", "y"] @?= "x and y" + , testCase "three" $ toSentence ["x", "y", "z"] @?= "x, y, and z" + , testCase "four" $ toSentence ["x", "y", "z", "w"] @?= "x, y, z, and w" + ] + ] diff --git a/xanthous.cabal b/xanthous.cabal index cb89323b2b..c7b19155dd 100644 --- a/xanthous.cabal +++ b/xanthous.cabal @@ -4,7 +4,7 @@ cabal-version: 1.12 -- -- see: https://github.com/sol/hpack -- --- hash: 40187d0301465905043b8caafec5465e644f711620c9fc1cfc57af4105ebe08c +-- hash: cebd0598e7aa48a62741fd8a9acc462bb693bb9356947147e0604d8e4b395739 name: xanthous version: 0.1.0.0 @@ -59,6 +59,7 @@ library Xanthous.Resource Xanthous.Util Xanthous.Util.Graphics + Xanthous.Util.Inflection other-modules: Paths_xanthous hs-source-dirs: @@ -132,6 +133,7 @@ executable xanthous Xanthous.Resource Xanthous.Util Xanthous.Util.Graphics + Xanthous.Util.Inflection Paths_xanthous hs-source-dirs: src @@ -185,6 +187,7 @@ test-suite test Xanthous.MessageSpec Xanthous.OrphansSpec Xanthous.Util.GraphicsSpec + Xanthous.Util.InflectionSpec Paths_xanthous hs-source-dirs: test -- cgit 1.4.1 From d632a30d057f9a2775c4516570168b195c053879 Mon Sep 17 00:00:00 2001 From: Griffin Smith Date: Sat, 21 Sep 2019 12:43:54 -0400 Subject: Implement combat Put a bunch of gormlaks randomly on the level, and implement combat via damaging those gormlaks by one point. --- src/Xanthous/App.hs | 40 ++++++++++++++++++++++++----- src/Xanthous/Entities/Character.hs | 3 +++ src/Xanthous/Entities/Creature.hs | 14 ++++++++--- src/Xanthous/Entities/RawTypes.hs | 5 ++-- src/Xanthous/Generators.hs | 15 +++++------ src/Xanthous/Generators/LevelContents.hs | 43 +++++++++++++++++++++----------- src/Xanthous/messages.yaml | 9 +++++++ 7 files changed, 95 insertions(+), 34 deletions(-) diff --git a/src/Xanthous/App.hs b/src/Xanthous/App.hs index fce2beed13..8353df437b 100644 --- a/src/Xanthous/App.hs +++ b/src/Xanthous/App.hs @@ -36,6 +36,8 @@ import qualified Xanthous.Entities.Character as Character import Xanthous.Entities.Character (characterName) import Xanthous.Entities import Xanthous.Entities.Item (Item) +import Xanthous.Entities.Creature (Creature) +import qualified Xanthous.Entities.Creature as Creature import Xanthous.Entities.Environment (Door, open, locked) import Xanthous.Entities.Character import Xanthous.Generators @@ -64,17 +66,24 @@ runAppM appm = fmap fst . runAppT appm startEvent :: AppM () startEvent = do + initLevel + modify updateCharacterVision + prompt_ @'StringPrompt ["character", "namePrompt"] Uncancellable + $ \(StringResult s) -> do + character . characterName ?= s + say ["welcome"] =<< use character + +initLevel :: AppM () +initLevel = do level <- generateLevel SCaveAutomata CaveAutomata.defaultParams $ Dimensions 80 80 + entities <>= (SomeEntity <$> level ^. levelWalls) entities <>= (SomeEntity <$> level ^. levelItems) + entities <>= (SomeEntity <$> level ^. levelCreatures) + characterPosition .= level ^. levelCharacterPosition - modify updateCharacterVision - prompt_ @'StringPrompt ["character", "namePrompt"] Uncancellable - $ \(StringResult s) -> do - character . characterName ?= s - say ["welcome"] =<< use character handleEvent :: BrickEvent Name () -> AppM (Next GameState) handleEvent ev = use promptState >>= \case @@ -98,7 +107,7 @@ handleCommand (Move dir) = do characterPosition .= newPos describeEntitiesAt newPos modify updateCharacterVision - Just Combat -> undefined + Just Combat -> attackAt newPos Just Stop -> pure () continue @@ -214,3 +223,22 @@ describeEntitiesAt pos = let descriptions = description <$> ents in say ["entities", "description"] $ object ["entityDescriptions" A..= toSentence descriptions] + +attackAt :: Position -> AppM () +attackAt pos = + uses entities (entitiesAtPositionWithType @Creature pos) >>= \case + Empty -> say_ ["combat", "nothingToAttack"] + (creature :< Empty) -> attackCreature creature + creatures -> undefined + where + attackCreature (creatureID, creature) = do + charDamage <- use $ character . characterDamage + let creature' = Creature.damage charDamage creature + msgParams = object ["creature" A..= creature'] + if Creature.isDead creature' + then do + say ["combat", "killed"] msgParams + entities . at creatureID .= Nothing + else do + say ["combat", "hit"] msgParams + entities . ix creatureID . positioned .= SomeEntity creature' diff --git a/src/Xanthous/Entities/Character.hs b/src/Xanthous/Entities/Character.hs index 924c1857a8..9423f2dc96 100644 --- a/src/Xanthous/Entities/Character.hs +++ b/src/Xanthous/Entities/Character.hs @@ -3,6 +3,7 @@ module Xanthous.Entities.Character ( Character(..) , characterName , inventory + , characterDamage , mkCharacter , pickUpItem ) where @@ -22,6 +23,7 @@ import Xanthous.Entities.Item data Character = Character { _inventory :: !(Vector Item) , _characterName :: !(Maybe Text) + , _characterDamage :: !Word } deriving stock (Show, Eq, Generic) deriving anyclass (CoArbitrary, Function) @@ -50,6 +52,7 @@ mkCharacter :: Character mkCharacter = Character { _inventory = mempty , _characterName = Nothing + , _characterDamage = 1 } pickUpItem :: Item -> Character -> Character diff --git a/src/Xanthous/Entities/Creature.hs b/src/Xanthous/Entities/Creature.hs index c660a6cdf5..5151f78b30 100644 --- a/src/Xanthous/Entities/Creature.hs +++ b/src/Xanthous/Entities/Creature.hs @@ -7,12 +7,14 @@ module Xanthous.Entities.Creature , hitpoints , newWithType , damage + , isDead ) where -------------------------------------------------------------------------------- import Xanthous.Prelude -------------------------------------------------------------------------------- -import Data.Word import Test.QuickCheck.Arbitrary.Generic +import Data.Aeson.Generic.DerivingVia +import Data.Aeson (ToJSON, FromJSON) -------------------------------------------------------------------------------- import Xanthous.Entities.RawTypes hiding (Creature, description) import qualified Xanthous.Entities.RawTypes as Raw @@ -21,10 +23,13 @@ import Xanthous.Entities (Draw(..), Entity(..), DrawRawChar(..)) data Creature = Creature { _creatureType :: CreatureType - , _hitpoints :: Word16 + , _hitpoints :: Word } deriving stock (Eq, Show, Generic) deriving Draw via DrawRawChar "_creatureType" Creature + deriving (ToJSON, FromJSON) + via WithOptions '[ FieldLabelModifier '[Drop 1] ] + Creature makeLenses ''Creature instance Arbitrary Creature where @@ -39,8 +44,11 @@ newWithType _creatureType = let _hitpoints = _creatureType ^. maxHitpoints in Creature {..} -damage :: Word16 -> Creature -> Creature +damage :: Word -> Creature -> Creature damage amount = hitpoints %~ \hp -> if hp <= amount then 0 else hp - amount + +isDead :: Creature -> Bool +isDead = views hitpoints (== 0) diff --git a/src/Xanthous/Entities/RawTypes.hs b/src/Xanthous/Entities/RawTypes.hs index 94f6505453..3fb89c58ba 100644 --- a/src/Xanthous/Entities/RawTypes.hs +++ b/src/Xanthous/Entities/RawTypes.hs @@ -19,7 +19,6 @@ import Test.QuickCheck import Test.QuickCheck.Arbitrary.Generic import Data.Aeson.Generic.DerivingVia import Data.Aeson (ToJSON, FromJSON) -import Data.Word -------------------------------------------------------------------------------- import Xanthous.Entities (EntityChar, HasChar(..)) -------------------------------------------------------------------------------- @@ -27,12 +26,12 @@ data CreatureType = CreatureType { _name :: Text , _description :: Text , _char :: EntityChar - , _maxHitpoints :: Word16 + , _maxHitpoints :: Word , _friendly :: Bool } deriving stock (Show, Eq, Generic) deriving anyclass (NFData) - deriving (FromJSON) + deriving (ToJSON, FromJSON) via WithOptions '[ FieldLabelModifier '[Drop 1] ] CreatureType makeFieldsNoPrefix ''CreatureType diff --git a/src/Xanthous/Generators.hs b/src/Xanthous/Generators.hs index 832a3d8fdc..7bcf4da051 100644 --- a/src/Xanthous/Generators.hs +++ b/src/Xanthous/Generators.hs @@ -12,6 +12,7 @@ module Xanthous.Generators , Level(..) , levelWalls , levelItems + , levelCreatures , levelCharacterPosition , generateLevel ) where @@ -29,7 +30,8 @@ import Xanthous.Data (Dimensions, Position(Position)) import Xanthous.Data.EntityMap (EntityMap) import qualified Xanthous.Data.EntityMap as EntityMap import Xanthous.Entities.Environment -import Xanthous.Entities.Item +import Xanthous.Entities.Item (Item) +import Xanthous.Entities.Creature (Creature) -------------------------------------------------------------------------------- data Generator = CaveAutomata @@ -38,9 +40,6 @@ data Generator = CaveAutomata data SGenerator (gen :: Generator) where SCaveAutomata :: SGenerator 'CaveAutomata -data AGenerator where - AGenerator :: forall gen. SGenerator gen -> AGenerator - type family Params (gen :: Generator) :: Type where Params 'CaveAutomata = CaveAutomata.Params @@ -89,9 +88,10 @@ cellsToWalls cells = foldl' maybeInsertWall mempty . assocs $ cells -------------------------------------------------------------------------------- data Level = Level - { _levelWalls :: EntityMap Wall - , _levelItems :: EntityMap Item - , _levelCharacterPosition :: Position + { _levelWalls :: !(EntityMap Wall) + , _levelItems :: !(EntityMap Item) + , _levelCreatures :: !(EntityMap Creature) + , _levelCharacterPosition :: !Position } makeLenses ''Level @@ -101,5 +101,6 @@ generateLevel gen ps dims = do let cells = generate gen ps dims rand _levelWalls = cellsToWalls cells _levelItems <- randomItems cells + _levelCreatures <- randomCreatures cells _levelCharacterPosition <- chooseCharacterPosition cells pure Level {..} diff --git a/src/Xanthous/Generators/LevelContents.hs b/src/Xanthous/Generators/LevelContents.hs index 87b2a28974..583bdcbd67 100644 --- a/src/Xanthous/Generators/LevelContents.hs +++ b/src/Xanthous/Generators/LevelContents.hs @@ -2,6 +2,7 @@ module Xanthous.Generators.LevelContents ( chooseCharacterPosition , randomItems + , randomCreatures ) where -------------------------------------------------------------------------------- import Xanthous.Prelude @@ -13,28 +14,40 @@ import Xanthous.Generators.Util import Xanthous.Random import Xanthous.Data (Position, positionFromPair) import Xanthous.Data.EntityMap (EntityMap, _EntityMap) -import Xanthous.Entities.Item (Item(..)) -import Xanthous.Entities.Raws -import Xanthous.Entities.RawTypes +import Xanthous.Entities.Raws (rawsWithType, RawType) import qualified Xanthous.Entities.Item as Item +import Xanthous.Entities.Item (Item) +import qualified Xanthous.Entities.Creature as Creature +import Xanthous.Entities.Creature (Creature) -------------------------------------------------------------------------------- chooseCharacterPosition :: MonadRandom m => Cells -> m Position chooseCharacterPosition = randomPosition randomItems :: MonadRandom m => Cells -> m (EntityMap Item) -randomItems cells = do - let len = rangeSize $ bounds cells - (numItems :: Int) <- floor . (* fromIntegral len) - <$> getRandomR @_ @Float (0.0004, 0.001) - items <- for [0..numItems] $ const $ do - pos <- randomPosition cells - itemType <- fmap (fromMaybe (error "no item raws!")) - . choose . ChooseElement - $ rawsWithType @ItemType - let item = Item.newWithType itemType - pure (pos, item) - pure $ _EntityMap # items +randomItems = randomEntities Item.newWithType (0.0004, 0.001) + +randomCreatures :: MonadRandom m => Cells -> m (EntityMap Creature) +randomCreatures = randomEntities Creature.newWithType (0.0007, 0.003) + +randomEntities + :: forall entity raw m. (MonadRandom m, RawType raw) + => (raw -> entity) + -> (Float, Float) + -> Cells + -> m (EntityMap entity) +randomEntities newWithType sizeRange cells = + case fromNullable $ rawsWithType @raw of + Nothing -> pure mempty + Just raws -> do + let len = rangeSize $ bounds cells + (numEntities :: Int) <- floor . (* fromIntegral len) <$> getRandomR sizeRange + entities <- for [0..numEntities] $ const $ do + pos <- randomPosition cells + raw <- choose raws + let entity = newWithType raw + pure (pos, entity) + pure $ _EntityMap # entities randomPosition :: MonadRandom m => Cells -> m Position randomPosition cells = fmap positionFromPair . choose $ impureNonNull candidates diff --git a/src/Xanthous/messages.yaml b/src/Xanthous/messages.yaml index 4d7b0003fa..7590db2e20 100644 --- a/src/Xanthous/messages.yaml +++ b/src/Xanthous/messages.yaml @@ -15,3 +15,12 @@ open: character: namePrompt: "What's your name? " + +combat: + nothingToAttack: There's nothing to attack there + hit: + - You hit the {{creature.creatureType.name}} + - You attack the {{creature.creatureType.name}} + killed: + - You kill the {{creature.creatureType.name}}! + - You've killed the {{creature.creatureType.name}}! -- cgit 1.4.1 From 915264acae35e71f79c6193d022baa2455d880d3 Mon Sep 17 00:00:00 2001 From: Griffin Smith Date: Wed, 25 Sep 2019 14:27:44 -0400 Subject: Add Github Actions config --- .github/workflows/haskell.yml | 19 +++++++++++++++++++ 1 file changed, 19 insertions(+) create mode 100644 .github/workflows/haskell.yml diff --git a/.github/workflows/haskell.yml b/.github/workflows/haskell.yml new file mode 100644 index 0000000000..9b6cb1ab84 --- /dev/null +++ b/.github/workflows/haskell.yml @@ -0,0 +1,19 @@ +name: Haskell CI + +on: [push] + +jobs: + build: + + runs-on: ubuntu-latest + + steps: + - uses: actions/checkout@v1 + - name: Install dependencies + run: cabal install --only-dependencies --enable-tests + - name: Build + run: | + cabal configure --enable-tests + cabal build + - name: Run tests + run: cabal test -- cgit 1.4.1 From 1a0f618a829ec356e29176c77ea90a8a5a0157b4 Mon Sep 17 00:00:00 2001 From: Griffin Smith Date: Sat, 28 Sep 2019 13:20:57 -0400 Subject: Implement the start of creature AI Add a Brain class, which determines for an entity the set of moves it makes every step of the game, and begin to implement that for gormlaks. The idea here is that every step of the game, a gormlak will move towards the furthest-away wall it can see. --- package.yaml | 1 + src/Xanthous/AI/Gormlak.hs | 39 +++++++ src/Xanthous/App.hs | 50 ++++++-- src/Xanthous/Command.hs | 2 + src/Xanthous/Data.hs | 2 + src/Xanthous/Data/EntityMap.hs | 12 ++ src/Xanthous/Data/EntityMap/Graphics.hs | 44 ++++--- src/Xanthous/Entities.hs | 66 ++--------- src/Xanthous/Entities/Arbitrary.hs | 1 + src/Xanthous/Entities/Character.hs | 3 + src/Xanthous/Entities/Creature.hs | 11 +- src/Xanthous/Entities/Environment.hs | 16 ++- src/Xanthous/Entities/Item.hs | 13 ++- src/Xanthous/Entities/Raws.hs | 1 + src/Xanthous/Game.hs | 194 +------------------------------ src/Xanthous/Game/Arbitrary.hs | 27 +++++ src/Xanthous/Game/Lenses.hs | 72 ++++++++++++ src/Xanthous/Game/State.hs | 200 ++++++++++++++++++++++++++++++++ src/Xanthous/Monad.hs | 3 +- src/Xanthous/Util.hs | 1 + xanthous.cabal | 16 ++- 21 files changed, 493 insertions(+), 281 deletions(-) create mode 100644 src/Xanthous/AI/Gormlak.hs create mode 100644 src/Xanthous/Game/Arbitrary.hs create mode 100644 src/Xanthous/Game/Lenses.hs create mode 100644 src/Xanthous/Game/State.hs diff --git a/package.yaml b/package.yaml index 953fb0947b..fe4dde46c8 100644 --- a/package.yaml +++ b/package.yaml @@ -63,6 +63,7 @@ default-extensions: - GeneralizedNewtypeDeriving - KindSignatures - LambdaCase +- MultiWayIf - NoImplicitPrelude - NoStarIsType - OverloadedStrings diff --git a/src/Xanthous/AI/Gormlak.hs b/src/Xanthous/AI/Gormlak.hs new file mode 100644 index 0000000000..1cdb977619 --- /dev/null +++ b/src/Xanthous/AI/Gormlak.hs @@ -0,0 +1,39 @@ +{-# OPTIONS_GHC -fno-warn-orphans #-} +-------------------------------------------------------------------------------- +module Xanthous.AI.Gormlak () where +-------------------------------------------------------------------------------- +import Xanthous.Prelude hiding (lines) +-------------------------------------------------------------------------------- +import Data.Coerce +import Control.Monad.State +-------------------------------------------------------------------------------- +import Xanthous.Data (Positioned(..)) +import qualified Xanthous.Entities.Creature as Creature +import Xanthous.Entities.Creature (Creature) +import qualified Xanthous.Entities.RawTypes as Raw +import Xanthous.Entities (Entity(..), Brain(..), brainVia) +import Xanthous.Game.State (entities, GameState) +import Xanthous.Data.EntityMap.Graphics (linesOfSight) +-------------------------------------------------------------------------------- + +stepGormlak :: MonadState GameState m => Positioned Creature -> m (Positioned Creature) +stepGormlak (Positioned pos creature) = do + lines <- uses entities $ linesOfSight pos (Creature.visionRadius creature) + let newPos = fromMaybe pos + $ fmap fst + . headMay <=< tailMay <=< headMay + . sortOn (Down . length) + $ lines + pure $ Positioned newPos creature + +newtype GormlakBrain = GormlakBrain Creature + +instance Brain GormlakBrain where + step = fmap coerce . stepGormlak . coerce +-------------------------------------------------------------------------------- + +instance Brain Creature where step = brainVia GormlakBrain + +instance Entity Creature where + blocksVision _ = False + description = view $ Creature.creatureType . Raw.description diff --git a/src/Xanthous/App.hs b/src/Xanthous/App.hs index 8353df437b..8d9ea54f0f 100644 --- a/src/Xanthous/App.hs +++ b/src/Xanthous/App.hs @@ -1,5 +1,5 @@ -{-# LANGUAGE MultiWayIf #-} {-# LANGUAGE ViewPatterns #-} +-------------------------------------------------------------------------------- module Xanthous.App (makeApp) where -------------------------------------------------------------------------------- import Xanthous.Prelude @@ -8,9 +8,8 @@ import qualified Brick import Brick.Widgets.Edit (handleEditorEvent) import Graphics.Vty.Attributes (defAttr) import Graphics.Vty.Input.Events (Event(EvKey), Key(..)) -import Control.Monad.State (get, state, StateT(..), MonadState) +import Control.Monad.State (get, MonadState) import Control.Monad.Random (MonadRandom) -import Data.Coerce import Control.Monad.State.Class (modify) import Data.Aeson (object, ToJSON) import qualified Data.Aeson as A @@ -45,7 +44,6 @@ import qualified Xanthous.Generators.CaveAutomata as CaveAutomata -------------------------------------------------------------------------------- type App = Brick.App GameState () Name -type AppM a = AppT (EventM Name) a makeApp :: IO App makeApp = pure $ Brick.App @@ -85,6 +83,17 @@ initLevel = do characterPosition .= level ^. levelCharacterPosition +-------------------------------------------------------------------------------- + +stepGame :: AppM () +stepGame = do + ents <- uses entities EntityMap.toEIDsAndPositioned + for_ ents $ \(eid, pEntity) -> do + pEntity' <- step pEntity + entities . ix eid .= pEntity' + +-------------------------------------------------------------------------------- + handleEvent :: BrickEvent Name () -> AppM (Next GameState) handleEvent ev = use promptState >>= \case NoPrompt -> handleNoPromptEvent ev @@ -107,6 +116,7 @@ handleCommand (Move dir) = do characterPosition .= newPos describeEntitiesAt newPos modify updateCharacterVision + stepGame Just Combat -> attackAt newPos Just Stop -> pure () continue @@ -120,6 +130,7 @@ handleCommand PickUp = do character %= Character.pickUpItem item entities . at itemID .= Nothing say ["items", "pickUp"] $ object [ "item" A..= item ] + stepGame _ -> undefined continue @@ -139,11 +150,14 @@ handleCommand Open = do entities . ix eid . positioned . _SomeEntity . open .= True say_ ["open", "success"] pure () + stepGame continue +handleCommand Wait = stepGame >> continue + handlePromptEvent :: Text -- ^ Prompt message - -> Prompt (AppT Identity) + -> Prompt AppM -> BrickEvent Name () -> AppM (Next GameState) @@ -151,7 +165,7 @@ handlePromptEvent _ (Prompt Cancellable _ _ _) (VtyEvent (EvKey KEsc [])) = do promptState .= NoPrompt continue handlePromptEvent _ pr (VtyEvent (EvKey KEnter [])) = do - () <- state . coerce $ submitPrompt pr + submitPrompt pr promptState .= NoPrompt continue @@ -168,7 +182,7 @@ handlePromptEvent handlePromptEvent _ (Prompt _ SDirectionPrompt _ cb) (VtyEvent (EvKey (KChar (directionFromChar -> Just dir)) [])) = do - () <- state . coerce . cb $ DirectionResult dir + cb $ DirectionResult dir promptState .= NoPrompt continue handlePromptEvent _ (Prompt _ SDirectionPrompt _ _) _ = continue @@ -181,7 +195,7 @@ prompt => [Text] -- ^ Message key -> params -- ^ Message params -> PromptCancellable - -> (PromptResult pt -> AppT Identity ()) -- ^ Prompt promise handler + -> (PromptResult pt -> AppM ()) -- ^ Prompt promise handler -> AppM () prompt msgPath params cancellable cb = do let pt = singPromptType @pt @@ -194,7 +208,7 @@ prompt_ (SingPromptType pt) => [Text] -- ^ Message key -> PromptCancellable - -> (PromptResult pt -> AppT Identity ()) -- ^ Prompt promise handler + -> (PromptResult pt -> AppM ()) -- ^ Prompt promise handler -> AppM () prompt_ msg = prompt msg $ object [] @@ -242,3 +256,21 @@ attackAt pos = else do say ["combat", "hit"] msgParams entities . ix creatureID . positioned .= SomeEntity creature' + stepGame + +data Collision + = Stop + | Combat + deriving stock (Show, Eq, Ord, Generic) + deriving anyclass (NFData) + +collisionAt :: MonadState GameState m => Position -> m (Maybe Collision) +collisionAt pos = do + ents <- use $ entities . EntityMap.atPosition pos + pure $ + if | null ents -> Nothing + | any (entityIs @Creature) ents -> pure Combat + | all (entityIs @Item) ents -> Nothing + | doors@(_ : _) <- ents ^.. folded . _SomeEntity @Door + , all (view open) doors -> Nothing + | otherwise -> pure Stop diff --git a/src/Xanthous/Command.hs b/src/Xanthous/Command.hs index 19c5e17e0a..c2dbfe37ef 100644 --- a/src/Xanthous/Command.hs +++ b/src/Xanthous/Command.hs @@ -15,9 +15,11 @@ data Command | PreviousMessage | PickUp | Open + | Wait commandFromKey :: Key -> [Modifier] -> Maybe Command commandFromKey (KChar 'q') [] = Just Quit +commandFromKey (KChar '.') [] = Just Wait commandFromKey (KChar (directionFromChar -> Just dir)) [] = Just $ Move dir commandFromKey (KChar 'p') [MCtrl] = Just PreviousMessage commandFromKey (KChar ',') [] = Just PickUp diff --git a/src/Xanthous/Data.hs b/src/Xanthous/Data.hs index afba273005..ff9da6280b 100644 --- a/src/Xanthous/Data.hs +++ b/src/Xanthous/Data.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE RoleAnnotations #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE DeriveTraversable #-} {-# LANGUAGE DeriveFoldable #-} @@ -74,6 +75,7 @@ data Positioned a where Positioned :: Position -> a -> Positioned a deriving stock (Show, Eq, Ord, Functor, Foldable, Traversable, Generic) deriving anyclass (CoArbitrary, Function) +type role Positioned representational _Positioned :: Iso (Position, a) (Position, b) (Positioned a) (Positioned b) _Positioned = iso hither yon diff --git a/src/Xanthous/Data/EntityMap.hs b/src/Xanthous/Data/EntityMap.hs index 7885839d51..5b5e8a063f 100644 --- a/src/Xanthous/Data/EntityMap.hs +++ b/src/Xanthous/Data/EntityMap.hs @@ -14,6 +14,7 @@ module Xanthous.Data.EntityMap , insertAt , insertAtReturningID , fromEIDsAndPositioned + , toEIDsAndPositioned , atPosition , atPositionWithIDs , positions @@ -101,6 +102,14 @@ instance Semigroup (EntityMap a) where instance Monoid (EntityMap a) where mempty = emptyEntityMap +instance FunctorWithIndex EntityID EntityMap + +instance FoldableWithIndex EntityID EntityMap + +instance TraversableWithIndex EntityID EntityMap where + itraversed = byID . itraversed . rmap sequenceA . distrib + itraverse = itraverseOf itraversed + emptyEntityMap :: EntityMap a emptyEntityMap = EntityMap mempty mempty 0 @@ -183,6 +192,9 @@ fromEIDsAndPositioned eps = newLastID $ alaf Endo foldMap insert' eps mempty .~ fromMaybe 1 (maximumOf (ifolded . asIndex) (em ^. byID)) +toEIDsAndPositioned :: EntityMap a -> [(EntityID, Positioned a)] +toEIDsAndPositioned = itoListOf $ byID . ifolded + positions :: EntityMap a -> [Position] positions = toListOf $ byPosition . to keys . folded diff --git a/src/Xanthous/Data/EntityMap/Graphics.hs b/src/Xanthous/Data/EntityMap/Graphics.hs index 9dcc02b8e8..3124c6a334 100644 --- a/src/Xanthous/Data/EntityMap/Graphics.hs +++ b/src/Xanthous/Data/EntityMap/Graphics.hs @@ -3,9 +3,10 @@ module Xanthous.Data.EntityMap.Graphics ( visiblePositions , visibleEntities + , linesOfSight ) where -------------------------------------------------------------------------------- -import Xanthous.Prelude +import Xanthous.Prelude hiding (lines) -------------------------------------------------------------------------------- import Xanthous.Util (takeWhileInclusive) import Xanthous.Data @@ -14,22 +15,37 @@ import Xanthous.Entities import Xanthous.Util.Graphics (circle, line) -------------------------------------------------------------------------------- -visiblePositions :: Position -> Word -> EntityMap SomeEntity -> Set Position +visiblePositions :: Entity e => Position -> Word -> EntityMap e -> Set Position visiblePositions pos radius = setFromList . positions . visibleEntities pos radius - --- | Given a point and a radius of vision, returns a list of all entities that --- are *visible* (eg, not blocked by an entity that obscures vision) from that --- point -visibleEntities :: Position -> Word -> EntityMap SomeEntity -> EntityMap SomeEntity -visibleEntities (view _Position -> pos) visionRadius em - = fromEIDsAndPositioned . fold . fold $ sightAdjustedLines +-- | Returns a list of individual lines of sight, each of which is a list of +-- entities at positions on that line of sight +linesOfSight + :: forall e. Entity e + => Position + -> Word + -> EntityMap e + -> [[(Position, Vector (EntityID, e))]] +linesOfSight (view _Position -> pos) visionRadius em + = entitiesOnLines + <&> takeWhileInclusive (none (blocksVision . snd) . snd) where - -- I love laziness! radius = circle pos $ fromIntegral visionRadius - linesOfSight = radius <&> line pos - entitiesOnLines = linesOfSight <&> map getPositionedAt - sightAdjustedLines = entitiesOnLines <&> takeWhileInclusive (none $ blocksVision . snd) + lines = line pos <$> radius + entitiesOnLines :: [[(Position, Vector (EntityID, e))]] + entitiesOnLines = lines <&> map getPositionedAt + getPositionedAt :: (Int, Int) -> (Position, Vector (EntityID, e)) getPositionedAt p = let ppos = _Position # p - in atPositionWithIDs ppos em + in (ppos, over _2 (view positioned) <$> atPositionWithIDs ppos em) + +-- | Given a point and a radius of vision, returns a list of all entities that +-- are *visible* (eg, not blocked by an entity that obscures vision) from that +-- point +visibleEntities :: Entity e => Position -> Word -> EntityMap e -> EntityMap e +visibleEntities pos visionRadius + = fromEIDsAndPositioned + . fold + . map (\(p, es) -> over _2 (Positioned p) <$> es) + . fold + . linesOfSight pos visionRadius diff --git a/src/Xanthous/Entities.hs b/src/Xanthous/Entities.hs index 66a583f6b3..15080b3221 100644 --- a/src/Xanthous/Entities.hs +++ b/src/Xanthous/Entities.hs @@ -1,7 +1,8 @@ -{-# LANGUAGE RecordWildCards #-} -{-# LANGUAGE UndecidableInstances #-} -{-# LANGUAGE GADTs #-} -{-# LANGUAGE AllowAmbiguousTypes #-} +{-# LANGUAGE RoleAnnotations #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE AllowAmbiguousTypes #-} -------------------------------------------------------------------------------- module Xanthous.Entities ( Draw(..) @@ -19,72 +20,27 @@ module Xanthous.Entities , EntityChar(..) , HasChar(..) + + , Brain(..) + , Brainless(..) + , brainVia ) where -------------------------------------------------------------------------------- import Xanthous.Prelude hiding ((.=)) -------------------------------------------------------------------------------- import Brick -import Data.Typeable import qualified Graphics.Vty.Attributes as Vty import qualified Graphics.Vty.Image as Vty import Data.Aeson +import Data.Typeable (Proxy(..)) import Data.Generics.Product.Fields import Test.QuickCheck import Test.QuickCheck.Arbitrary.Generic -------------------------------------------------------------------------------- -import Xanthous.Data import Xanthous.Orphans () +import Xanthous.Game.State -------------------------------------------------------------------------------- -class (Show a, Eq a, Draw a) => Entity a where - blocksVision :: a -> Bool - description :: a -> Text - -instance Entity a => Entity (Positioned a) where - blocksVision (Positioned _ ent) = blocksVision ent - description (Positioned _ ent) = description ent - --------------------------------------------------------------------------------- -data SomeEntity where - SomeEntity :: forall a. (Entity a, Typeable a) => a -> SomeEntity - -instance Show SomeEntity where - show (SomeEntity e) = "SomeEntity (" <> show e <> ")" - -instance Eq SomeEntity where - (SomeEntity (a :: ea)) == (SomeEntity (b :: eb)) = case eqT @ea @eb of - Just Refl -> a == b - _ -> False - -instance Draw SomeEntity where - drawWithNeighbors ns (SomeEntity ent) = drawWithNeighbors ns ent - -instance Entity SomeEntity where - blocksVision (SomeEntity ent) = blocksVision ent - description (SomeEntity ent) = description ent - -downcastEntity :: (Entity a, Typeable a) => SomeEntity -> Maybe a -downcastEntity (SomeEntity e) = cast e - -entityIs :: forall a. (Entity a, Typeable a) => SomeEntity -> Bool -entityIs = isJust . downcastEntity @a - -_SomeEntity :: forall a. (Entity a, Typeable a) => Prism' SomeEntity a -_SomeEntity = prism' SomeEntity downcastEntity - --------------------------------------------------------------------------------- - -class Draw a where - drawWithNeighbors :: Neighbors (Vector SomeEntity) -> a -> Widget n - drawWithNeighbors = const draw - - draw :: a -> Widget n - draw = drawWithNeighbors $ pure mempty - -instance Draw a => Draw (Positioned a) where - drawWithNeighbors ns (Positioned _ a) = drawWithNeighbors ns a - draw (Positioned _ a) = draw a - newtype DrawCharacter (char :: Symbol) (a :: Type) where DrawCharacter :: a -> DrawCharacter char a diff --git a/src/Xanthous/Entities/Arbitrary.hs b/src/Xanthous/Entities/Arbitrary.hs index 2d1890f787..8ba6447933 100644 --- a/src/Xanthous/Entities/Arbitrary.hs +++ b/src/Xanthous/Entities/Arbitrary.hs @@ -12,6 +12,7 @@ import Xanthous.Entities.Character import Xanthous.Entities.Item import Xanthous.Entities.Creature import Xanthous.Entities.Environment +import Xanthous.AI.Gormlak () -------------------------------------------------------------------------------- instance Arbitrary SomeEntity where diff --git a/src/Xanthous/Entities/Character.hs b/src/Xanthous/Entities/Character.hs index 9423f2dc96..1c7d1bbe82 100644 --- a/src/Xanthous/Entities/Character.hs +++ b/src/Xanthous/Entities/Character.hs @@ -41,6 +41,9 @@ instance Draw Character where rloc = Location (negate scrollOffset, negate scrollOffset) rreg = (2 * scrollOffset, 2 * scrollOffset) +-- the character does not (yet) have a mind of its own +instance Brain Character where step = brainVia Brainless + instance Entity Character where blocksVision _ = False description _ = "yourself" diff --git a/src/Xanthous/Entities/Creature.hs b/src/Xanthous/Entities/Creature.hs index 5151f78b30..accf0c42e2 100644 --- a/src/Xanthous/Entities/Creature.hs +++ b/src/Xanthous/Entities/Creature.hs @@ -8,6 +8,7 @@ module Xanthous.Entities.Creature , newWithType , damage , isDead + , visionRadius ) where -------------------------------------------------------------------------------- import Xanthous.Prelude @@ -17,8 +18,7 @@ import Data.Aeson.Generic.DerivingVia import Data.Aeson (ToJSON, FromJSON) -------------------------------------------------------------------------------- import Xanthous.Entities.RawTypes hiding (Creature, description) -import qualified Xanthous.Entities.RawTypes as Raw -import Xanthous.Entities (Draw(..), Entity(..), DrawRawChar(..)) +import Xanthous.Entities (Draw(..), DrawRawChar(..)) -------------------------------------------------------------------------------- data Creature = Creature @@ -35,9 +35,7 @@ makeLenses ''Creature instance Arbitrary Creature where arbitrary = genericArbitrary -instance Entity Creature where - blocksVision _ = False - description = view $ creatureType . Raw.description +-------------------------------------------------------------------------------- newWithType :: CreatureType -> Creature newWithType _creatureType = @@ -52,3 +50,6 @@ damage amount = hitpoints %~ \hp -> isDead :: Creature -> Bool isDead = views hitpoints (== 0) + +visionRadius :: Creature -> Word +visionRadius = const 12 -- TODO diff --git a/src/Xanthous/Entities/Environment.hs b/src/Xanthous/Entities/Environment.hs index 4ef67a577d..e8190cd42a 100644 --- a/src/Xanthous/Entities/Environment.hs +++ b/src/Xanthous/Entities/Environment.hs @@ -13,7 +13,15 @@ import Brick (str) import Brick.Widgets.Border.Style (unicode) import Brick.Types (Edges(..)) -------------------------------------------------------------------------------- -import Xanthous.Entities (Draw(..), entityIs, Entity(..), SomeEntity) +import Xanthous.Entities + ( Draw(..) + , entityIs + , Entity(..) + , SomeEntity + , Brain(..) + , Brainless(..) + , brainVia + ) import Xanthous.Entities.Draw.Util import Xanthous.Data -------------------------------------------------------------------------------- @@ -22,6 +30,9 @@ data Wall = Wall deriving stock (Show, Eq, Ord, Generic, Enum) deriving anyclass (CoArbitrary, Function) +-- deriving via Brainless Wall instance Brain Wall +instance Brain Wall where step = brainVia Brainless + instance Entity Wall where blocksVision _ = True description _ = "a wall" @@ -64,6 +75,9 @@ instance Draw Door where horizDoor = '␣' vertDoor = '[' +-- deriving via Brainless Door instance Brain Door +instance Brain Door where step = brainVia Brainless + instance Entity Door where blocksVision = not . view open description _ = "a door" diff --git a/src/Xanthous/Entities/Item.hs b/src/Xanthous/Entities/Item.hs index 6b50f50ad8..832f0d4d62 100644 --- a/src/Xanthous/Entities/Item.hs +++ b/src/Xanthous/Entities/Item.hs @@ -1,4 +1,5 @@ {-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE StandaloneDeriving #-} -------------------------------------------------------------------------------- module Xanthous.Entities.Item ( Item(..) @@ -13,7 +14,14 @@ import Data.Aeson.Generic.DerivingVia -------------------------------------------------------------------------------- import Xanthous.Entities.RawTypes hiding (Item, description) import qualified Xanthous.Entities.RawTypes as Raw -import Xanthous.Entities (Draw(..), Entity(..), DrawRawChar(..)) +import Xanthous.Entities + ( Draw(..) + , Entity(..) + , DrawRawChar(..) + , Brain(..) + , Brainless(..) + , brainVia + ) -------------------------------------------------------------------------------- data Item = Item @@ -27,6 +35,9 @@ data Item = Item Item makeLenses ''Item +-- deriving via (Brainless Item) instance Brain Item +instance Brain Item where step = brainVia Brainless + instance Arbitrary Item where arbitrary = Item <$> arbitrary diff --git a/src/Xanthous/Entities/Raws.hs b/src/Xanthous/Entities/Raws.hs index e1bb429a0f..9b7d63c6c4 100644 --- a/src/Xanthous/Entities/Raws.hs +++ b/src/Xanthous/Entities/Raws.hs @@ -17,6 +17,7 @@ import Xanthous.Entities.RawTypes import Xanthous.Entities import qualified Xanthous.Entities.Creature as Creature import qualified Xanthous.Entities.Item as Item +import Xanthous.AI.Gormlak () -------------------------------------------------------------------------------- rawRaws :: [(FilePath, ByteString)] rawRaws = $(embedDir "src/Xanthous/Entities/Raws") diff --git a/src/Xanthous/Game.hs b/src/Xanthous/Game.hs index 68bd9e0438..278e3d8ff4 100644 --- a/src/Xanthous/Game.hs +++ b/src/Xanthous/Game.hs @@ -1,7 +1,3 @@ -{-# LANGUAGE MultiWayIf #-} -{-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE RecordWildCards #-} --------------------------------------------------------------------------------- module Xanthous.Game ( GameState(..) , entities @@ -23,194 +19,10 @@ module Xanthous.Game , popMessage , hideMessage - -- * collisions - , Collision(..) - , collisionAt - -- * App monad , AppT(..) ) where -------------------------------------------------------------------------------- -import Xanthous.Prelude --------------------------------------------------------------------------------- -import Data.List.NonEmpty ( NonEmpty((:|))) -import qualified Data.List.NonEmpty as NonEmpty -import System.Random -import Test.QuickCheck -import Test.QuickCheck.Arbitrary.Generic -import Control.Monad.State.Class -import Control.Monad.State -import Control.Monad.Random.Class --------------------------------------------------------------------------------- -import Xanthous.Data.EntityMap (EntityMap, EntityID) -import qualified Xanthous.Data.EntityMap as EntityMap -import Xanthous.Data.EntityMap.Graphics -import Xanthous.Data (Positioned, Position(..), positioned, position) -import Xanthous.Entities - (SomeEntity(..), downcastEntity, entityIs, _SomeEntity) -import Xanthous.Entities.Character -import Xanthous.Entities.Creature -import Xanthous.Entities.Item -import Xanthous.Entities.Environment -import Xanthous.Entities.Arbitrary () -import Xanthous.Orphans () -import Xanthous.Game.Prompt --------------------------------------------------------------------------------- - -data MessageHistory - = NoMessageHistory - | MessageHistory (NonEmpty Text) Bool - deriving stock (Show, Eq, Generic) - deriving anyclass (NFData, CoArbitrary, Function) - -instance Arbitrary MessageHistory where - arbitrary = genericArbitrary - -pushMessage :: Text -> MessageHistory -> MessageHistory -pushMessage msg NoMessageHistory = MessageHistory (msg :| []) True -pushMessage msg (MessageHistory msgs _) = MessageHistory (NonEmpty.cons msg msgs) True - -popMessage :: MessageHistory -> MessageHistory -popMessage NoMessageHistory = NoMessageHistory -popMessage (MessageHistory msgs False) = MessageHistory msgs True -popMessage (MessageHistory msgs@(_ :| []) _) = MessageHistory msgs True -popMessage (MessageHistory (_ :| (msg : msgs)) True) = MessageHistory (msg :| msgs) True - -hideMessage :: MessageHistory -> MessageHistory -hideMessage NoMessageHistory = NoMessageHistory -hideMessage (MessageHistory msgs _) = MessageHistory msgs False - --------------------------------------------------------------------------------- - -data GamePromptState m where - NoPrompt :: GamePromptState m - WaitingPrompt :: Text -> Prompt m -> GamePromptState m - deriving stock (Show) - --------------------------------------------------------------------------------- - -newtype AppT m a - = AppT { unAppT :: StateT GameState m a } - deriving ( Functor - , Applicative - , Monad - , MonadState GameState - ) - via (StateT GameState m) - --------------------------------------------------------------------------------- - -data GameState = GameState - { _entities :: !(EntityMap SomeEntity) - , _revealedPositions :: !(Set Position) - , _characterEntityID :: !EntityID - , _messageHistory :: !MessageHistory - , _randomGen :: !StdGen - , _promptState :: !(GamePromptState (AppT Identity)) - } - deriving stock (Show) -makeLenses ''GameState - -instance Eq GameState where - (==) = (==) `on` \gs -> - ( gs ^. entities - , gs ^. revealedPositions - , gs ^. characterEntityID - , gs ^. messageHistory - ) - - -instance Arbitrary GameState where - arbitrary = do - char <- arbitrary @Character - charPos <- arbitrary - _messageHistory <- arbitrary - (_characterEntityID, _entities) <- arbitrary <&> - EntityMap.insertAtReturningID charPos (SomeEntity char) - _revealedPositions <- fmap setFromList . sublistOf $ EntityMap.positions _entities - _randomGen <- mkStdGen <$> arbitrary - let _promptState = NoPrompt -- TODO - pure $ GameState {..} - - -getInitialState :: IO GameState -getInitialState = do - _randomGen <- getStdGen - let char = mkCharacter - (_characterEntityID, _entities) - = EntityMap.insertAtReturningID - (Position 0 0) - (SomeEntity char) - mempty - _messageHistory = NoMessageHistory - _revealedPositions = mempty - _promptState = NoPrompt - pure GameState {..} - -positionedCharacter :: Lens' GameState (Positioned Character) -positionedCharacter = lens getPositionedCharacter setPositionedCharacter - where - setPositionedCharacter :: GameState -> Positioned Character -> GameState - setPositionedCharacter game char - = game - & entities . at (game ^. characterEntityID) - ?~ fmap SomeEntity char - - getPositionedCharacter :: GameState -> Positioned Character - getPositionedCharacter game - = over positioned - ( fromMaybe (error "Invariant error: Character was not a character!") - . downcastEntity - ) - . fromMaybe (error "Invariant error: Character not found!") - $ EntityMap.lookupWithPosition - (game ^. characterEntityID) - (game ^. entities) - - -character :: Lens' GameState Character -character = positionedCharacter . positioned - -characterPosition :: Lens' GameState Position -characterPosition = positionedCharacter . position - -visionRadius :: Word -visionRadius = 12 -- TODO make this dynamic - --- | Update the revealed entities at the character's position based on their vision -updateCharacterVision :: GameState -> GameState -updateCharacterVision game = - let charPos = game ^. characterPosition - visible = visiblePositions charPos visionRadius $ game ^. entities - in game & revealedPositions <>~ visible - - --------------------------------------------------------------------------------- - -data Collision - = Stop - | Combat - deriving stock (Show, Eq, Ord, Generic) - deriving anyclass (NFData) - -collisionAt :: MonadState GameState m => Position -> m (Maybe Collision) -collisionAt pos = do - ents <- use $ entities . EntityMap.atPosition pos - pure $ - if | null ents -> Nothing - | any (entityIs @Creature) ents -> pure Combat - | all (entityIs @Item) ents -> Nothing - | doors@(_ : _) <- ents ^.. folded . _SomeEntity @Door - , all (view open) doors -> Nothing - | otherwise -> pure Stop - --------------------------------------------------------------------------------- - -instance MonadTrans AppT where - lift = AppT . lift - -instance (Monad m) => MonadRandom (AppT m) where - getRandomR rng = randomGen %%= randomR rng - getRandom = randomGen %%= random - getRandomRs rng = uses randomGen $ randomRs rng - getRandoms = uses randomGen randoms +import Xanthous.Game.State +import Xanthous.Game.Lenses +import Xanthous.Game.Arbitrary () diff --git a/src/Xanthous/Game/Arbitrary.hs b/src/Xanthous/Game/Arbitrary.hs new file mode 100644 index 0000000000..5ab2301e70 --- /dev/null +++ b/src/Xanthous/Game/Arbitrary.hs @@ -0,0 +1,27 @@ +{-# OPTIONS_GHC -fno-warn-orphans #-} +{-# LANGUAGE RecordWildCards #-} +-------------------------------------------------------------------------------- +module Xanthous.Game.Arbitrary where +-------------------------------------------------------------------------------- +import Xanthous.Prelude +-------------------------------------------------------------------------------- +import Test.QuickCheck +import System.Random +-------------------------------------------------------------------------------- +import Xanthous.Game.State +import Xanthous.Entities.Arbitrary () +import Xanthous.Entities.Character +import qualified Xanthous.Data.EntityMap as EntityMap +-------------------------------------------------------------------------------- + +instance Arbitrary GameState where + arbitrary = do + char <- arbitrary @Character + charPos <- arbitrary + _messageHistory <- arbitrary + (_characterEntityID, _entities) <- arbitrary <&> + EntityMap.insertAtReturningID charPos (SomeEntity char) + _revealedPositions <- fmap setFromList . sublistOf $ EntityMap.positions _entities + _randomGen <- mkStdGen <$> arbitrary + let _promptState = NoPrompt -- TODO + pure $ GameState {..} diff --git a/src/Xanthous/Game/Lenses.hs b/src/Xanthous/Game/Lenses.hs new file mode 100644 index 0000000000..91ff5c137d --- /dev/null +++ b/src/Xanthous/Game/Lenses.hs @@ -0,0 +1,72 @@ +{-# LANGUAGE RecordWildCards #-} +-------------------------------------------------------------------------------- +module Xanthous.Game.Lenses + ( positionedCharacter + , character + , characterPosition + , updateCharacterVision + , getInitialState + ) where +-------------------------------------------------------------------------------- +import Xanthous.Prelude +-------------------------------------------------------------------------------- +import System.Random +-------------------------------------------------------------------------------- +import Xanthous.Game.State +import Xanthous.Data +import qualified Xanthous.Data.EntityMap as EntityMap +import Xanthous.Data.EntityMap.Graphics (visiblePositions) +import Xanthous.Entities.Character (Character, mkCharacter) +-------------------------------------------------------------------------------- + +getInitialState :: IO GameState +getInitialState = do + _randomGen <- getStdGen + let char = mkCharacter + (_characterEntityID, _entities) + = EntityMap.insertAtReturningID + (Position 0 0) + (SomeEntity char) + mempty + _messageHistory = NoMessageHistory + _revealedPositions = mempty + _promptState = NoPrompt + pure GameState {..} + + +positionedCharacter :: Lens' GameState (Positioned Character) +positionedCharacter = lens getPositionedCharacter setPositionedCharacter + where + setPositionedCharacter :: GameState -> Positioned Character -> GameState + setPositionedCharacter game char + = game + & entities . at (game ^. characterEntityID) + ?~ fmap SomeEntity char + + getPositionedCharacter :: GameState -> Positioned Character + getPositionedCharacter game + = over positioned + ( fromMaybe (error "Invariant error: Character was not a character!") + . downcastEntity + ) + . fromMaybe (error "Invariant error: Character not found!") + $ EntityMap.lookupWithPosition + (game ^. characterEntityID) + (game ^. entities) + + +character :: Lens' GameState Character +character = positionedCharacter . positioned + +characterPosition :: Lens' GameState Position +characterPosition = positionedCharacter . position + +visionRadius :: Word +visionRadius = 12 -- TODO make this dynamic + +-- | Update the revealed entities at the character's position based on their vision +updateCharacterVision :: GameState -> GameState +updateCharacterVision game = + let charPos = game ^. characterPosition + visible = visiblePositions charPos visionRadius $ game ^. entities + in game & revealedPositions <>~ visible diff --git a/src/Xanthous/Game/State.hs b/src/Xanthous/Game/State.hs new file mode 100644 index 0000000000..9b81abe352 --- /dev/null +++ b/src/Xanthous/Game/State.hs @@ -0,0 +1,200 @@ +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE AllowAmbiguousTypes #-} +-------------------------------------------------------------------------------- +module Xanthous.Game.State + ( GameState(..) + , entities + , revealedPositions + , messageHistory + , randomGen + , promptState + , characterEntityID + , GamePromptState(..) + + -- * Messages + , MessageHistory(..) + , pushMessage + , popMessage + , hideMessage + + -- * App monad + , AppT(..) + , AppM + + -- * Entities + , Draw(..) + , Brain(..) + , Brainless(..) + , brainVia + , Entity(..) + , SomeEntity(..) + , downcastEntity + , _SomeEntity + , entityIs + ) where +-------------------------------------------------------------------------------- +import Xanthous.Prelude +-------------------------------------------------------------------------------- +import Data.List.NonEmpty ( NonEmpty((:|))) +import qualified Data.List.NonEmpty as NonEmpty +import Data.Typeable +import Data.Coerce +import System.Random +import Test.QuickCheck +import Test.QuickCheck.Arbitrary.Generic +import Control.Monad.State.Class +import Control.Monad.State +import Control.Monad.Random.Class +import Brick (EventM, Widget) +-------------------------------------------------------------------------------- +import Xanthous.Data.EntityMap (EntityMap, EntityID) +import Xanthous.Data (Positioned(..), Position(..), Neighbors) +import Xanthous.Orphans () +import Xanthous.Game.Prompt +import Xanthous.Resource +-------------------------------------------------------------------------------- + +data MessageHistory + = NoMessageHistory + | MessageHistory (NonEmpty Text) Bool + deriving stock (Show, Eq, Generic) + deriving anyclass (NFData, CoArbitrary, Function) + +instance Arbitrary MessageHistory where + arbitrary = genericArbitrary + +pushMessage :: Text -> MessageHistory -> MessageHistory +pushMessage msg NoMessageHistory = MessageHistory (msg :| []) True +pushMessage msg (MessageHistory msgs _) = MessageHistory (NonEmpty.cons msg msgs) True + +popMessage :: MessageHistory -> MessageHistory +popMessage NoMessageHistory = NoMessageHistory +popMessage (MessageHistory msgs False) = MessageHistory msgs True +popMessage (MessageHistory msgs@(_ :| []) _) = MessageHistory msgs True +popMessage (MessageHistory (_ :| (msg : msgs)) True) = MessageHistory (msg :| msgs) True + +hideMessage :: MessageHistory -> MessageHistory +hideMessage NoMessageHistory = NoMessageHistory +hideMessage (MessageHistory msgs _) = MessageHistory msgs False + +-------------------------------------------------------------------------------- + +data GamePromptState m where + NoPrompt :: GamePromptState m + WaitingPrompt :: Text -> Prompt m -> GamePromptState m + deriving stock (Show) + +-------------------------------------------------------------------------------- + +newtype AppT m a + = AppT { unAppT :: StateT GameState m a } + deriving ( Functor + , Applicative + , Monad + , MonadState GameState + ) + via (StateT GameState m) + +type AppM = AppT (EventM Name) + +-------------------------------------------------------------------------------- + +class Draw a where + drawWithNeighbors :: Neighbors (Vector SomeEntity) -> a -> Widget n + drawWithNeighbors = const draw + + draw :: a -> Widget n + draw = drawWithNeighbors $ pure mempty + +instance Draw a => Draw (Positioned a) where + drawWithNeighbors ns (Positioned _ a) = drawWithNeighbors ns a + draw (Positioned _ a) = draw a + +-------------------------------------------------------------------------------- + +class Brain a where + step :: Positioned a -> AppM (Positioned a) + +newtype Brainless a = Brainless a + +instance Brain (Brainless a) where + step = pure + +-- | Workaround for the inability to use DerivingVia on Brain due to the lack of +-- higher-order roles (specifically AppT not having its last type argument have +-- role representational bc of StateT) +brainVia + :: forall brain entity. (Coercible entity brain, Brain brain) + => (entity -> brain) -- ^ constructor, ignored + -> (Positioned entity -> AppM (Positioned entity)) +brainVia _ = fmap coerce . step . coerce @_ @(Positioned brain) + +-------------------------------------------------------------------------------- + +class (Show a, Eq a, Draw a, Brain a) => Entity a where + blocksVision :: a -> Bool + description :: a -> Text + +data SomeEntity where + SomeEntity :: forall a. (Entity a, Typeable a) => a -> SomeEntity + +instance Show SomeEntity where + show (SomeEntity e) = "SomeEntity (" <> show e <> ")" + +instance Eq SomeEntity where + (SomeEntity (a :: ea)) == (SomeEntity (b :: eb)) = case eqT @ea @eb of + Just Refl -> a == b + _ -> False + +instance Draw (SomeEntity) where + drawWithNeighbors ns (SomeEntity ent) = drawWithNeighbors ns ent + +instance Brain SomeEntity where + step (Positioned pos (SomeEntity ent)) = + fmap SomeEntity <$> step (Positioned pos ent) + +instance Entity SomeEntity where + blocksVision (SomeEntity ent) = blocksVision ent + description (SomeEntity ent) = description ent + +downcastEntity :: forall a. (Entity a, Typeable a) => SomeEntity -> Maybe a +downcastEntity (SomeEntity e) = cast e + +entityIs :: forall a. (Entity a, Typeable a) => SomeEntity -> Bool +entityIs = isJust . downcastEntity @a + +_SomeEntity :: forall a. (Entity a, Typeable a) => Prism' SomeEntity a +_SomeEntity = prism' SomeEntity downcastEntity + +-------------------------------------------------------------------------------- + +data GameState = GameState + { _entities :: !(EntityMap SomeEntity) + , _revealedPositions :: !(Set Position) + , _characterEntityID :: !EntityID + , _messageHistory :: !MessageHistory + , _randomGen :: !StdGen + , _promptState :: !(GamePromptState AppM) + } + deriving stock (Show) +makeLenses ''GameState + +instance Eq GameState where + (==) = (==) `on` \gs -> + ( gs ^. entities + , gs ^. revealedPositions + , gs ^. characterEntityID + , gs ^. messageHistory + ) + +-------------------------------------------------------------------------------- + +instance MonadTrans AppT where + lift = AppT . lift + +instance (Monad m) => MonadRandom (AppT m) where + getRandomR rng = randomGen %%= randomR rng + getRandom = randomGen %%= random + getRandomRs rng = uses randomGen $ randomRs rng + getRandoms = uses randomGen randoms diff --git a/src/Xanthous/Monad.hs b/src/Xanthous/Monad.hs index 4e3e58607c..3e567ee8fa 100644 --- a/src/Xanthous/Monad.hs +++ b/src/Xanthous/Monad.hs @@ -1,5 +1,6 @@ module Xanthous.Monad ( AppT(..) + , AppM , runAppT , continue , halt @@ -14,7 +15,7 @@ import qualified Brick import Brick (EventM, Next) import Data.Aeson -import Xanthous.Game +import Xanthous.Game.State import Xanthous.Messages (message) runAppT :: Monad m => AppT m a -> GameState -> m (a, GameState) diff --git a/src/Xanthous/Util.hs b/src/Xanthous/Util.hs index 439f9e8ffa..d90cf5b03d 100644 --- a/src/Xanthous/Util.hs +++ b/src/Xanthous/Util.hs @@ -1,5 +1,6 @@ {-# LANGUAGE BangPatterns #-} {-# LANGUAGE AllowAmbiguousTypes #-} +{-# LANGUAGE QuantifiedConstraints #-} module Xanthous.Util ( EqEqProp(..) diff --git a/xanthous.cabal b/xanthous.cabal index c7b19155dd..e0a2571677 100644 --- a/xanthous.cabal +++ b/xanthous.cabal @@ -4,7 +4,7 @@ cabal-version: 1.12 -- -- see: https://github.com/sol/hpack -- --- hash: cebd0598e7aa48a62741fd8a9acc462bb693bb9356947147e0604d8e4b395739 +-- hash: 121c6fd553f5e73ac5ff4c89f17eacc3a85997255aba87390943a418b439896c name: xanthous version: 0.1.0.0 @@ -30,6 +30,7 @@ library exposed-modules: Data.Aeson.Generic.DerivingVia Main + Xanthous.AI.Gormlak Xanthous.App Xanthous.Command Xanthous.Data @@ -45,8 +46,11 @@ library Xanthous.Entities.Raws Xanthous.Entities.RawTypes Xanthous.Game + Xanthous.Game.Arbitrary Xanthous.Game.Draw + Xanthous.Game.Lenses Xanthous.Game.Prompt + Xanthous.Game.State Xanthous.Generators Xanthous.Generators.CaveAutomata Xanthous.Generators.LevelContents @@ -64,7 +68,7 @@ library Paths_xanthous hs-source-dirs: src - default-extensions: BlockArguments ConstraintKinds DataKinds DeriveAnyClass DeriveGeneric DerivingStrategies DerivingVia FlexibleContexts FlexibleInstances FunctionalDependencies GADTSyntax GeneralizedNewtypeDeriving KindSignatures LambdaCase NoImplicitPrelude NoStarIsType OverloadedStrings PolyKinds RankNTypes ScopedTypeVariables TupleSections TypeApplications TypeFamilies TypeOperators + default-extensions: BlockArguments ConstraintKinds DataKinds DeriveAnyClass DeriveGeneric DerivingStrategies DerivingVia FlexibleContexts FlexibleInstances FunctionalDependencies GADTSyntax GeneralizedNewtypeDeriving KindSignatures LambdaCase MultiWayIf NoImplicitPrelude NoStarIsType OverloadedStrings PolyKinds RankNTypes ScopedTypeVariables TupleSections TypeApplications TypeFamilies TypeOperators ghc-options: -Wall build-depends: MonadRandom @@ -104,6 +108,7 @@ executable xanthous main-is: Main.hs other-modules: Data.Aeson.Generic.DerivingVia + Xanthous.AI.Gormlak Xanthous.App Xanthous.Command Xanthous.Data @@ -119,8 +124,11 @@ executable xanthous Xanthous.Entities.Raws Xanthous.Entities.RawTypes Xanthous.Game + Xanthous.Game.Arbitrary Xanthous.Game.Draw + Xanthous.Game.Lenses Xanthous.Game.Prompt + Xanthous.Game.State Xanthous.Generators Xanthous.Generators.CaveAutomata Xanthous.Generators.LevelContents @@ -137,7 +145,7 @@ executable xanthous Paths_xanthous hs-source-dirs: src - default-extensions: BlockArguments ConstraintKinds DataKinds DeriveAnyClass DeriveGeneric DerivingStrategies DerivingVia FlexibleContexts FlexibleInstances FunctionalDependencies GADTSyntax GeneralizedNewtypeDeriving KindSignatures LambdaCase NoImplicitPrelude NoStarIsType OverloadedStrings PolyKinds RankNTypes ScopedTypeVariables TupleSections TypeApplications TypeFamilies TypeOperators + default-extensions: BlockArguments ConstraintKinds DataKinds DeriveAnyClass DeriveGeneric DerivingStrategies DerivingVia FlexibleContexts FlexibleInstances FunctionalDependencies GADTSyntax GeneralizedNewtypeDeriving KindSignatures LambdaCase MultiWayIf NoImplicitPrelude NoStarIsType OverloadedStrings PolyKinds RankNTypes ScopedTypeVariables TupleSections TypeApplications TypeFamilies TypeOperators ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N build-depends: MonadRandom @@ -191,7 +199,7 @@ test-suite test Paths_xanthous hs-source-dirs: test - default-extensions: BlockArguments ConstraintKinds DataKinds DeriveAnyClass DeriveGeneric DerivingStrategies DerivingVia FlexibleContexts FlexibleInstances FunctionalDependencies GADTSyntax GeneralizedNewtypeDeriving KindSignatures LambdaCase NoImplicitPrelude NoStarIsType OverloadedStrings PolyKinds RankNTypes ScopedTypeVariables TupleSections TypeApplications TypeFamilies TypeOperators + default-extensions: BlockArguments ConstraintKinds DataKinds DeriveAnyClass DeriveGeneric DerivingStrategies DerivingVia FlexibleContexts FlexibleInstances FunctionalDependencies GADTSyntax GeneralizedNewtypeDeriving KindSignatures LambdaCase MultiWayIf NoImplicitPrelude NoStarIsType OverloadedStrings PolyKinds RankNTypes ScopedTypeVariables TupleSections TypeApplications TypeFamilies TypeOperators ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N build-depends: MonadRandom -- cgit 1.4.1 From abea2dcfac0e094bf4ce0d378763af7816b04501 Mon Sep 17 00:00:00 2001 From: Griffin Smith Date: Sat, 28 Sep 2019 15:01:21 -0400 Subject: Add debug command to reveal the game Add a (debug) command to reveal all tiles on the game regardless of the character's vision, which'll make it easier to debug creature's behavior while they're not visible. --- src/Xanthous/App.hs | 7 +++++++ src/Xanthous/Command.hs | 4 ++++ src/Xanthous/Game.hs | 5 +++++ src/Xanthous/Game/Arbitrary.hs | 1 + src/Xanthous/Game/Draw.hs | 19 +++++++++++-------- src/Xanthous/Game/State.hs | 23 +++++++++++++++++++++-- src/Xanthous/messages.yaml | 3 +++ 7 files changed, 52 insertions(+), 10 deletions(-) diff --git a/src/Xanthous/App.hs b/src/Xanthous/App.hs index 8d9ea54f0f..cff4a4d611 100644 --- a/src/Xanthous/App.hs +++ b/src/Xanthous/App.hs @@ -155,6 +155,13 @@ handleCommand Open = do handleCommand Wait = stepGame >> continue +handleCommand ToggleRevealAll = do + val <- debugState . allRevealed <%= not + say ["debug", "toggleRevealAll"] $ object [ "revealAll" A..= val ] + continue + +-------------------------------------------------------------------------------- + handlePromptEvent :: Text -- ^ Prompt message -> Prompt AppM diff --git a/src/Xanthous/Command.hs b/src/Xanthous/Command.hs index c2dbfe37ef..4bf0e28939 100644 --- a/src/Xanthous/Command.hs +++ b/src/Xanthous/Command.hs @@ -17,6 +17,9 @@ data Command | Open | Wait + -- | TODO replace with `:` commands + | ToggleRevealAll + commandFromKey :: Key -> [Modifier] -> Maybe Command commandFromKey (KChar 'q') [] = Just Quit commandFromKey (KChar '.') [] = Just Wait @@ -24,6 +27,7 @@ commandFromKey (KChar (directionFromChar -> Just dir)) [] = Just $ Move dir commandFromKey (KChar 'p') [MCtrl] = Just PreviousMessage commandFromKey (KChar ',') [] = Just PickUp commandFromKey (KChar 'o') [] = Just Open +commandFromKey (KChar 'r') [MMeta] = Just ToggleRevealAll commandFromKey _ _ = Nothing -------------------------------------------------------------------------------- diff --git a/src/Xanthous/Game.hs b/src/Xanthous/Game.hs index 278e3d8ff4..ffbeddb29d 100644 --- a/src/Xanthous/Game.hs +++ b/src/Xanthous/Game.hs @@ -21,6 +21,11 @@ module Xanthous.Game -- * App monad , AppT(..) + + -- * Debug State + , DebugState(..) + , debugState + , allRevealed ) where -------------------------------------------------------------------------------- import Xanthous.Game.State diff --git a/src/Xanthous/Game/Arbitrary.hs b/src/Xanthous/Game/Arbitrary.hs index 5ab2301e70..5bba77d5a1 100644 --- a/src/Xanthous/Game/Arbitrary.hs +++ b/src/Xanthous/Game/Arbitrary.hs @@ -24,4 +24,5 @@ instance Arbitrary GameState where _revealedPositions <- fmap setFromList . sublistOf $ EntityMap.positions _entities _randomGen <- mkStdGen <$> arbitrary let _promptState = NoPrompt -- TODO + _debugState <- arbitrary pure $ GameState {..} diff --git a/src/Xanthous/Game/Draw.hs b/src/Xanthous/Game/Draw.hs index ff9240a5e1..b3e27f86a6 100644 --- a/src/Xanthous/Game/Draw.hs +++ b/src/Xanthous/Game/Draw.hs @@ -23,6 +23,7 @@ import Xanthous.Game , messageHistory , GamePromptState(..) , promptState + , debugState, allRevealed ) import Xanthous.Game.Prompt import Xanthous.Resource (Name) @@ -46,14 +47,11 @@ drawPromptState (WaitingPrompt msg (Prompt _ pt ps _)) = _ -> undefined drawEntities - :: Set Position - -- ^ Positions the character has seen - -- FIXME: this will break down as soon as creatures can walk around on their - -- own, since we don't want to render things walking around when the - -- character can't see them + :: (Position -> Bool) + -- ^ Can we render a given position? -> EntityMap SomeEntity -- ^ all entities -> Widget Name -drawEntities visiblePositions allEnts +drawEntities canRenderPos allEnts = vBox rows where entityPositions = EntityMap.positions allEnts @@ -62,7 +60,7 @@ drawEntities visiblePositions allEnts rows = mkRow <$> [0..maxY] mkRow rowY = hBox $ renderEntityAt . flip Position rowY <$> [0..maxX] renderEntityAt pos - | pos `member` visiblePositions + | canRenderPos pos = let neighbors = EntityMap.neighbors pos allEnts in maybe (str " ") (drawWithNeighbors neighbors) $ allEnts ^? atPosition pos . folded @@ -73,7 +71,12 @@ drawMap game = viewport Resource.MapViewport Both . showCursor Resource.Character (game ^. characterPosition . loc) $ drawEntities - (game ^. revealedPositions) + (\pos -> + (game ^. debugState . allRevealed) + || (pos `member` (game ^. revealedPositions))) + -- FIXME: this will break down as soon as creatures can walk around on their + -- own, since we don't want to render things walking around when the + -- character can't see them (game ^. entities) drawGame :: GameState -> [Widget Name] diff --git a/src/Xanthous/Game/State.hs b/src/Xanthous/Game/State.hs index 9b81abe352..00785bf124 100644 --- a/src/Xanthous/Game/State.hs +++ b/src/Xanthous/Game/State.hs @@ -32,6 +32,11 @@ module Xanthous.Game.State , downcastEntity , _SomeEntity , entityIs + + -- * Debug State + , DebugState(..) + , debugState + , allRevealed ) where -------------------------------------------------------------------------------- import Xanthous.Prelude @@ -158,10 +163,10 @@ instance Entity SomeEntity where blocksVision (SomeEntity ent) = blocksVision ent description (SomeEntity ent) = description ent -downcastEntity :: forall a. (Entity a, Typeable a) => SomeEntity -> Maybe a +downcastEntity :: forall (a :: Type). (Typeable a) => SomeEntity -> Maybe a downcastEntity (SomeEntity e) = cast e -entityIs :: forall a. (Entity a, Typeable a) => SomeEntity -> Bool +entityIs :: forall (a :: Type). (Typeable a) => SomeEntity -> Bool entityIs = isJust . downcastEntity @a _SomeEntity :: forall a. (Entity a, Typeable a) => Prism' SomeEntity a @@ -169,6 +174,15 @@ _SomeEntity = prism' SomeEntity downcastEntity -------------------------------------------------------------------------------- +data DebugState = DebugState + { _allRevealed :: !Bool + } + deriving stock (Show, Eq, Generic) + deriving anyclass (NFData, CoArbitrary, Function) + +instance Arbitrary DebugState where + arbitrary = genericArbitrary + data GameState = GameState { _entities :: !(EntityMap SomeEntity) , _revealedPositions :: !(Set Position) @@ -176,6 +190,7 @@ data GameState = GameState , _messageHistory :: !MessageHistory , _randomGen :: !StdGen , _promptState :: !(GamePromptState AppM) + , _debugState :: DebugState } deriving stock (Show) makeLenses ''GameState @@ -198,3 +213,7 @@ instance (Monad m) => MonadRandom (AppT m) where getRandom = randomGen %%= random getRandomRs rng = uses randomGen $ randomRs rng getRandoms = uses randomGen randoms + +-------------------------------------------------------------------------------- + +makeLenses ''DebugState diff --git a/src/Xanthous/messages.yaml b/src/Xanthous/messages.yaml index 7590db2e20..ba6d49150a 100644 --- a/src/Xanthous/messages.yaml +++ b/src/Xanthous/messages.yaml @@ -24,3 +24,6 @@ combat: killed: - You kill the {{creature.creatureType.name}}! - You've killed the {{creature.creatureType.name}}! + +debug: + toggleRevealAll: revealAll now set to {{revealAll}} -- cgit 1.4.1 From ec39dc0a5bed58e0b0b48eeac98e0fd0ceaa65db Mon Sep 17 00:00:00 2001 From: Griffin Smith Date: Sat, 28 Sep 2019 15:02:30 -0400 Subject: Tweak gormlak movement slightly - Don't let gormlaks run into things like walls or each other - Add a small element of randomness to gormlaks' motion - Increase gormlaks' vision by a large amount --- package.yaml | 3 +++ src/Xanthous/AI/Gormlak.hs | 34 +++++++++++++++++++++------- src/Xanthous/App.hs | 22 ------------------ src/Xanthous/Entities/Creature.hs | 2 +- src/Xanthous/Game.hs | 4 ++++ src/Xanthous/Game/Lenses.hs | 28 +++++++++++++++++++++++ src/Xanthous/Random.hs | 47 +++++++++++++++++++++++++++++++++++---- xanthous.cabal | 11 ++++++++- 8 files changed, 115 insertions(+), 36 deletions(-) diff --git a/package.yaml b/package.yaml index fe4dde46c8..aa1b52ed03 100644 --- a/package.yaml +++ b/package.yaml @@ -41,6 +41,9 @@ dependencies: - mtl - optparse-applicative - random +- random-fu +- random-extras +- random-source - raw-strings-qq - reflection - stache diff --git a/src/Xanthous/AI/Gormlak.hs b/src/Xanthous/AI/Gormlak.hs index 1cdb977619..6ea9254ba2 100644 --- a/src/Xanthous/AI/Gormlak.hs +++ b/src/Xanthous/AI/Gormlak.hs @@ -6,25 +6,43 @@ import Xanthous.Prelude hiding (lines) -------------------------------------------------------------------------------- import Data.Coerce import Control.Monad.State +import Control.Monad.Random -------------------------------------------------------------------------------- -import Xanthous.Data (Positioned(..)) +import Xanthous.Data (Positioned(..), positioned) +import Xanthous.Data.EntityMap import qualified Xanthous.Entities.Creature as Creature import Xanthous.Entities.Creature (Creature) +import Xanthous.Entities.Character (Character) import qualified Xanthous.Entities.RawTypes as Raw import Xanthous.Entities (Entity(..), Brain(..), brainVia) -import Xanthous.Game.State (entities, GameState) +import Xanthous.Game.State (entities, GameState, entityIs) +import Xanthous.Game.Lenses (Collision(..), collisionAt) import Xanthous.Data.EntityMap.Graphics (linesOfSight) +import Xanthous.Random -------------------------------------------------------------------------------- -stepGormlak :: MonadState GameState m => Positioned Creature -> m (Positioned Creature) -stepGormlak (Positioned pos creature) = do +stepGormlak + :: (MonadState GameState m, MonadRandom m) + => Positioned Creature + -> m (Positioned Creature) +stepGormlak pe@(Positioned pos creature) = do lines <- uses entities $ linesOfSight pos (Creature.visionRadius creature) + line <- choose $ weightedBy length lines + -- traceShowM ("current position", pos) + -- traceShowM ("lines", (headMay <=< tailMay) <$> lines) let newPos = fromMaybe pos $ fmap fst - . headMay <=< tailMay <=< headMay - . sortOn (Down . length) - $ lines - pure $ Positioned newPos creature + . headMay + =<< tailMay + =<< line + collisionAt newPos >>= \case + Nothing -> pure $ Positioned newPos creature + Just Stop -> pure pe + Just Combat -> do + ents <- use $ entities . atPosition newPos + if | any (entityIs @Creature) ents -> pure pe + | any (entityIs @Character) ents -> undefined + | otherwise -> pure pe newtype GormlakBrain = GormlakBrain Creature diff --git a/src/Xanthous/App.hs b/src/Xanthous/App.hs index cff4a4d611..1632c39e58 100644 --- a/src/Xanthous/App.hs +++ b/src/Xanthous/App.hs @@ -57,11 +57,6 @@ makeApp = pure $ Brick.App runAppM :: AppM a -> GameState -> EventM Name a runAppM appm = fmap fst . runAppT appm --- testGormlak :: Creature --- testGormlak = --- let Just (Creature gormlak) = raw "gormlak" --- in Creature.newWithType gormlak - startEvent :: AppM () startEvent = do initLevel @@ -264,20 +259,3 @@ attackAt pos = say ["combat", "hit"] msgParams entities . ix creatureID . positioned .= SomeEntity creature' stepGame - -data Collision - = Stop - | Combat - deriving stock (Show, Eq, Ord, Generic) - deriving anyclass (NFData) - -collisionAt :: MonadState GameState m => Position -> m (Maybe Collision) -collisionAt pos = do - ents <- use $ entities . EntityMap.atPosition pos - pure $ - if | null ents -> Nothing - | any (entityIs @Creature) ents -> pure Combat - | all (entityIs @Item) ents -> Nothing - | doors@(_ : _) <- ents ^.. folded . _SomeEntity @Door - , all (view open) doors -> Nothing - | otherwise -> pure Stop diff --git a/src/Xanthous/Entities/Creature.hs b/src/Xanthous/Entities/Creature.hs index accf0c42e2..f2c789d6a6 100644 --- a/src/Xanthous/Entities/Creature.hs +++ b/src/Xanthous/Entities/Creature.hs @@ -52,4 +52,4 @@ isDead :: Creature -> Bool isDead = views hitpoints (== 0) visionRadius :: Creature -> Word -visionRadius = const 12 -- TODO +visionRadius = const 50 -- TODO diff --git a/src/Xanthous/Game.hs b/src/Xanthous/Game.hs index ffbeddb29d..2b346ace56 100644 --- a/src/Xanthous/Game.hs +++ b/src/Xanthous/Game.hs @@ -19,6 +19,10 @@ module Xanthous.Game , popMessage , hideMessage + -- * Collisions + , Collision(..) + , collisionAt + -- * App monad , AppT(..) diff --git a/src/Xanthous/Game/Lenses.hs b/src/Xanthous/Game/Lenses.hs index 91ff5c137d..e077e339cd 100644 --- a/src/Xanthous/Game/Lenses.hs +++ b/src/Xanthous/Game/Lenses.hs @@ -6,17 +6,25 @@ module Xanthous.Game.Lenses , characterPosition , updateCharacterVision , getInitialState + + -- * Collisions + , Collision(..) + , collisionAt ) where -------------------------------------------------------------------------------- import Xanthous.Prelude -------------------------------------------------------------------------------- import System.Random +import Control.Monad.State -------------------------------------------------------------------------------- import Xanthous.Game.State import Xanthous.Data import qualified Xanthous.Data.EntityMap as EntityMap import Xanthous.Data.EntityMap.Graphics (visiblePositions) import Xanthous.Entities.Character (Character, mkCharacter) +import Xanthous.Entities.Environment (Door, open) +import Xanthous.Entities.Item (Item) +import Xanthous.Entities.Creature (Creature) -------------------------------------------------------------------------------- getInitialState :: IO GameState @@ -31,6 +39,9 @@ getInitialState = do _messageHistory = NoMessageHistory _revealedPositions = mempty _promptState = NoPrompt + _debugState = DebugState + { _allRevealed = False + } pure GameState {..} @@ -70,3 +81,20 @@ updateCharacterVision game = let charPos = game ^. characterPosition visible = visiblePositions charPos visionRadius $ game ^. entities in game & revealedPositions <>~ visible + +data Collision + = Stop + | Combat + deriving stock (Show, Eq, Ord, Generic) + deriving anyclass (NFData) + +collisionAt :: MonadState GameState m => Position -> m (Maybe Collision) +collisionAt pos = do + ents <- use $ entities . EntityMap.atPosition pos + pure $ + if | null ents -> Nothing + | any (entityIs @Creature) ents -> pure Combat + | all (entityIs @Item) ents -> Nothing + | doors@(_ : _) <- ents ^.. folded . _SomeEntity @Door + , all (view open) doors -> Nothing + | otherwise -> pure Stop diff --git a/src/Xanthous/Random.hs b/src/Xanthous/Random.hs index 33ada54cf1..bbf176f71d 100644 --- a/src/Xanthous/Random.hs +++ b/src/Xanthous/Random.hs @@ -1,14 +1,34 @@ -{-# LANGUAGE TupleSections #-} +-------------------------------------------------------------------------------- {-# LANGUAGE UndecidableInstances #-} - +{-# OPTIONS_GHC -fno-warn-orphans #-} +-------------------------------------------------------------------------------- module Xanthous.Random ( Choose(..) , ChooseElement(..) + , Weighted(..) + , evenlyWeighted + , weightedBy ) where - +-------------------------------------------------------------------------------- import Xanthous.Prelude +-------------------------------------------------------------------------------- import Data.List.NonEmpty (NonEmpty) -import Control.Monad.Random.Class (MonadRandom(getRandomR)) +import Control.Monad.Random.Class (MonadRandom(getRandomR, getRandom)) +import Data.Random.Shuffle.Weighted +import Data.Random.Distribution +import Data.Random.Distribution.Uniform +import Data.Random.Distribution.Uniform.Exclusive +import Data.Random.Sample +import qualified Data.Random.Source as DRS +-------------------------------------------------------------------------------- + +instance {-# INCOHERENT #-} (Monad m, MonadRandom m) => DRS.MonadRandom m where + getRandomWord8 = getRandom + getRandomWord16 = getRandom + getRandomWord32 = getRandom + getRandomWord64 = getRandom + getRandomDouble = getRandom + getRandomNByteInteger n = getRandomR (0, 256 ^ n) class Choose a where type RandomResult a @@ -37,3 +57,22 @@ instance MonoFoldable a => Choose (NonNull a) where instance Choose (NonEmpty a) where type RandomResult (NonEmpty a) = a choose = choose . fromNonEmpty @[_] + +newtype Weighted w t a = Weighted (t (w, a)) + +evenlyWeighted :: [a] -> Weighted Int [] a +evenlyWeighted = Weighted . itoList + +weightedBy :: Functor t => (a -> w) -> t a -> Weighted w t a +weightedBy weighting xs = Weighted $ (weighting &&& id) <$> xs + +instance (Num w, Ord w, Distribution Uniform w, Excludable w) => Choose (Weighted w [] a) where + type RandomResult (Weighted w [] a) = Maybe a + choose (Weighted ws) = sample $ headMay <$> weightedSample 1 ws + +instance (Num w, Ord w, Distribution Uniform w, Excludable w) => Choose (Weighted w NonEmpty a) where + type RandomResult (Weighted w NonEmpty a) = a + choose (Weighted ws) = + sample + $ fromMaybe (error "unreachable") . headMay + <$> weightedSample 1 (toList ws) diff --git a/xanthous.cabal b/xanthous.cabal index e0a2571677..022b644209 100644 --- a/xanthous.cabal +++ b/xanthous.cabal @@ -4,7 +4,7 @@ cabal-version: 1.12 -- -- see: https://github.com/sol/hpack -- --- hash: 121c6fd553f5e73ac5ff4c89f17eacc3a85997255aba87390943a418b439896c +-- hash: ad4acf50f6be0dc7ae6c68d9920b61c2d32b5d759aae7311a124d159b4a9bc7f name: xanthous version: 0.1.0.0 @@ -96,6 +96,9 @@ library , quickcheck-instances , quickcheck-text , random + , random-extras + , random-fu + , random-source , raw-strings-qq , reflection , stache @@ -173,6 +176,9 @@ executable xanthous , quickcheck-instances , quickcheck-text , random + , random-extras + , random-fu + , random-source , raw-strings-qq , reflection , stache @@ -228,6 +234,9 @@ test-suite test , quickcheck-instances , quickcheck-text , random + , random-extras + , random-fu + , random-source , raw-strings-qq , reflection , stache -- cgit 1.4.1 From 05da490185e970b2cfdf6c61f69932fa373993f6 Mon Sep 17 00:00:00 2001 From: Griffin Smith Date: Sun, 29 Sep 2019 10:54:52 -0400 Subject: Gormlaks attack back When gormlaks see the character, they step towards them and attack dealing 1 damage when adjacent. Characters have hitpoints now, displayed at the bottom of the game screen, and when the game is over they die. --- src/Xanthous/AI/Gormlak.hs | 45 ++++++++++++++--------- src/Xanthous/App.hs | 11 ++++-- src/Xanthous/Data.hs | 63 ++++++++++++++++++++++++++++++++- src/Xanthous/Data/EntityMap.hs | 3 ++ src/Xanthous/Data/EntityMap/Graphics.hs | 5 +++ src/Xanthous/Entities/Character.hs | 10 ++++++ src/Xanthous/Game/Draw.hs | 18 ++++++++-- src/Xanthous/Game/Prompt.hs | 10 ++++++ src/Xanthous/Util/Graphics.hs | 2 +- src/Xanthous/messages.yaml | 4 +++ test/Xanthous/DataSpec.hs | 14 ++++++++ 11 files changed, 163 insertions(+), 22 deletions(-) diff --git a/src/Xanthous/AI/Gormlak.hs b/src/Xanthous/AI/Gormlak.hs index 6ea9254ba2..c9af688426 100644 --- a/src/Xanthous/AI/Gormlak.hs +++ b/src/Xanthous/AI/Gormlak.hs @@ -7,18 +7,22 @@ import Xanthous.Prelude hiding (lines) import Data.Coerce import Control.Monad.State import Control.Monad.Random +import Data.Aeson (object) +import qualified Data.Aeson as A -------------------------------------------------------------------------------- -import Xanthous.Data (Positioned(..), positioned) +import Xanthous.Data (Positioned(..), diffPositions, stepTowards, isUnit) import Xanthous.Data.EntityMap import qualified Xanthous.Entities.Creature as Creature import Xanthous.Entities.Creature (Creature) -import Xanthous.Entities.Character (Character) +import Xanthous.Entities.Character (Character, characterHitpoints) import qualified Xanthous.Entities.RawTypes as Raw import Xanthous.Entities (Entity(..), Brain(..), brainVia) import Xanthous.Game.State (entities, GameState, entityIs) -import Xanthous.Game.Lenses (Collision(..), collisionAt) -import Xanthous.Data.EntityMap.Graphics (linesOfSight) +import Xanthous.Game.Lenses + ( Collision(..), collisionAt, character, characterPosition ) +import Xanthous.Data.EntityMap.Graphics (linesOfSight, canSee) import Xanthous.Random +import Xanthous.Monad (say) -------------------------------------------------------------------------------- stepGormlak @@ -26,28 +30,37 @@ stepGormlak => Positioned Creature -> m (Positioned Creature) stepGormlak pe@(Positioned pos creature) = do - lines <- uses entities $ linesOfSight pos (Creature.visionRadius creature) - line <- choose $ weightedBy length lines - -- traceShowM ("current position", pos) - -- traceShowM ("lines", (headMay <=< tailMay) <$> lines) - let newPos = fromMaybe pos - $ fmap fst - . headMay - =<< tailMay - =<< line + newPos <- do + canSeeCharacter <- uses entities $ canSee (entityIs @Character) pos vision + if canSeeCharacter + then do + charPos <- use characterPosition + if isUnit (pos `diffPositions` charPos) + then attackCharacter $> charPos + else pure $ pos `stepTowards` charPos + else do + lines <- uses entities $ linesOfSight pos (Creature.visionRadius creature) + line <- choose $ weightedBy length lines + pure $ fromMaybe pos $ fmap fst . headMay =<< tailMay =<< line collisionAt newPos >>= \case Nothing -> pure $ Positioned newPos creature Just Stop -> pure pe Just Combat -> do ents <- use $ entities . atPosition newPos - if | any (entityIs @Creature) ents -> pure pe - | any (entityIs @Character) ents -> undefined - | otherwise -> pure pe + when (any (entityIs @Character) ents) attackCharacter + pure pe + + where + vision = Creature.visionRadius creature + attackCharacter = do + say ["combat", "creatureAttack"] $ object [ "creature" A..= creature ] + character . characterHitpoints -= 1 newtype GormlakBrain = GormlakBrain Creature instance Brain GormlakBrain where step = fmap coerce . stepGormlak . coerce + -------------------------------------------------------------------------------- instance Brain Creature where step = brainVia GormlakBrain diff --git a/src/Xanthous/App.hs b/src/Xanthous/App.hs index 1632c39e58..02f6f0987d 100644 --- a/src/Xanthous/App.hs +++ b/src/Xanthous/App.hs @@ -13,6 +13,7 @@ import Control.Monad.Random (MonadRandom) import Control.Monad.State.Class (modify) import Data.Aeson (object, ToJSON) import qualified Data.Aeson as A +import System.Exit -------------------------------------------------------------------------------- import Xanthous.Command import Xanthous.Data @@ -32,13 +33,12 @@ import Xanthous.Messages (message) import Xanthous.Util.Inflection (toSentence) -------------------------------------------------------------------------------- import qualified Xanthous.Entities.Character as Character -import Xanthous.Entities.Character (characterName) +import Xanthous.Entities.Character import Xanthous.Entities import Xanthous.Entities.Item (Item) import Xanthous.Entities.Creature (Creature) import qualified Xanthous.Entities.Creature as Creature import Xanthous.Entities.Environment (Door, open, locked) -import Xanthous.Entities.Character import Xanthous.Generators import qualified Xanthous.Generators.CaveAutomata as CaveAutomata -------------------------------------------------------------------------------- @@ -87,6 +87,11 @@ stepGame = do pEntity' <- step pEntity entities . ix eid .= pEntity' + whenM (uses (character . characterHitpoints) (== 0)) + . prompt_ @'Continue ["dead"] Uncancellable + . const . lift . liftIO + $ exitSuccess + -------------------------------------------------------------------------------- handleEvent :: BrickEvent Name () -> AppM (Next GameState) @@ -189,6 +194,8 @@ handlePromptEvent _ (Prompt _ SDirectionPrompt _ cb) continue handlePromptEvent _ (Prompt _ SDirectionPrompt _ _) _ = continue +handlePromptEvent _ (Prompt _ SContinue _ _) _ = continue + handlePromptEvent _ _ _ = undefined prompt diff --git a/src/Xanthous/Data.hs b/src/Xanthous/Data.hs index ff9da6280b..ff11a8da7f 100644 --- a/src/Xanthous/Data.hs +++ b/src/Xanthous/Data.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE ViewPatterns #-} {-# LANGUAGE RoleAnnotations #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE DeriveTraversable #-} @@ -8,7 +9,8 @@ -- | Common data types for Xanthous -------------------------------------------------------------------------------- module Xanthous.Data - ( Position(..) + ( -- * + Position(..) , x , y @@ -19,6 +21,10 @@ module Xanthous.Data , loc , _Position , positionFromPair + , addPositions + , diffPositions + , stepTowards + , isUnit -- * , Dimensions'(..) @@ -31,6 +37,7 @@ module Xanthous.Data , opposite , move , asPosition + , directionOf -- * , Neighbors(..) @@ -47,6 +54,7 @@ import Brick (Location(Location), Edges(..)) -------------------------------------------------------------------------------- import Xanthous.Util (EqEqProp(..), EqProp) import Xanthous.Orphans () +import Xanthous.Util.Graphics -------------------------------------------------------------------------------- data Position where @@ -111,6 +119,25 @@ _Position = iso hither yon positionFromPair :: (Integral i, Integral j) => (i, j) -> Position positionFromPair (i, j) = Position (fromIntegral i) (fromIntegral j) +-- | Add two positions +-- +-- Operation for the additive group on positions +addPositions :: Position -> Position -> Position +addPositions = (<>) + +-- | Subtract two positions. +-- +-- diffPositions pos₁ pos₂ = pos₁ `addPositions` (invert pos₂) +diffPositions :: Position -> Position -> Position +diffPositions (Position x₁ y₁) (Position x₂ y₂) = Position (x₁ - x₂) (y₁ - y₂) + +-- | Is this position a unit position? or: When taken as a difference, does this +-- position represent a step of one tile? +-- +-- ∀ dir :: Direction. isUnit ('asPosition' dir) +isUnit :: Position -> Bool +isUnit (Position px py) = abs px == 1 || abs py == 1 + -------------------------------------------------------------------------------- data Dimensions' a = Dimensions @@ -169,6 +196,38 @@ move Here = id asPosition :: Direction -> Position asPosition dir = move dir mempty +-- | Returns the direction that a given position is from a given source position +directionOf + :: Position -- ^ Source + -> Position -- ^ Target + -> Direction +directionOf (Position x₁ y₁) (Position x₂ y₂) = + case (x₁ `compare` x₂, y₁ `compare` y₂) of + (EQ, EQ) -> Here + (EQ, LT) -> Down + (EQ, GT) -> Up + (LT, EQ) -> Right + (GT, EQ) -> Left + + (LT, LT) -> DownRight + (GT, LT) -> DownLeft + + (LT, GT) -> UpRight + (GT, GT) -> UpLeft + +-- | Take one (potentially diagonal) step towards the given position +-- +-- ∀ src tgt. isUnit (src `diffPositions` (src `stepTowards tgt`)) +stepTowards + :: Position -- ^ Source + -> Position -- ^ Target + -> Position +stepTowards (view _Position -> p₁) (view _Position -> p₂) + | p₁ == p₂ = _Position # p₁ + | otherwise = + let (_:p:_) = line p₁ p₂ + in _Position # p + -------------------------------------------------------------------------------- data Neighbors a = Neighbors @@ -229,3 +288,5 @@ neighborDirections = Neighbors neighborPositions :: Position -> Neighbors Position neighborPositions pos = (`move` pos) <$> neighborDirections + +-------------------------------------------------------------------------------- diff --git a/src/Xanthous/Data/EntityMap.hs b/src/Xanthous/Data/EntityMap.hs index 5b5e8a063f..a068828a15 100644 --- a/src/Xanthous/Data/EntityMap.hs +++ b/src/Xanthous/Data/EntityMap.hs @@ -110,6 +110,9 @@ instance TraversableWithIndex EntityID EntityMap where itraversed = byID . itraversed . rmap sequenceA . distrib itraverse = itraverseOf itraversed +type instance Element (EntityMap a) = a +instance MonoFoldable (EntityMap a) + emptyEntityMap :: EntityMap a emptyEntityMap = EntityMap mempty mempty 0 diff --git a/src/Xanthous/Data/EntityMap/Graphics.hs b/src/Xanthous/Data/EntityMap/Graphics.hs index 3124c6a334..ace5ae49e8 100644 --- a/src/Xanthous/Data/EntityMap/Graphics.hs +++ b/src/Xanthous/Data/EntityMap/Graphics.hs @@ -4,6 +4,7 @@ module Xanthous.Data.EntityMap.Graphics ( visiblePositions , visibleEntities , linesOfSight + , canSee ) where -------------------------------------------------------------------------------- import Xanthous.Prelude hiding (lines) @@ -49,3 +50,7 @@ visibleEntities pos visionRadius . map (\(p, es) -> over _2 (Positioned p) <$> es) . fold . linesOfSight pos visionRadius + +canSee :: Entity e => (e -> Bool) -> Position -> Word -> EntityMap e -> Bool +canSee match pos radius = any match . visibleEntities pos radius +-- ^ this might be optimizable diff --git a/src/Xanthous/Entities/Character.hs b/src/Xanthous/Entities/Character.hs index 1c7d1bbe82..0bb5867ee5 100644 --- a/src/Xanthous/Entities/Character.hs +++ b/src/Xanthous/Entities/Character.hs @@ -4,8 +4,10 @@ module Xanthous.Entities.Character , characterName , inventory , characterDamage + , characterHitpoints , mkCharacter , pickUpItem + , isDead ) where -------------------------------------------------------------------------------- import Xanthous.Prelude @@ -24,6 +26,7 @@ data Character = Character { _inventory :: !(Vector Item) , _characterName :: !(Maybe Text) , _characterDamage :: !Word + , _characterHitpoints :: !Word } deriving stock (Show, Eq, Generic) deriving anyclass (CoArbitrary, Function) @@ -51,13 +54,20 @@ instance Entity Character where instance Arbitrary Character where arbitrary = genericArbitrary +initialHitpoints :: Word +initialHitpoints = 10 + mkCharacter :: Character mkCharacter = Character { _inventory = mempty , _characterName = Nothing , _characterDamage = 1 + , _characterHitpoints = initialHitpoints } +isDead :: Character -> Bool +isDead = (== 0) . view characterHitpoints + pickUpItem :: Item -> Character -> Character pickUpItem item = inventory %~ (item <|) diff --git a/src/Xanthous/Game/Draw.hs b/src/Xanthous/Game/Draw.hs index b3e27f86a6..e1242f2b7a 100644 --- a/src/Xanthous/Game/Draw.hs +++ b/src/Xanthous/Game/Draw.hs @@ -14,11 +14,13 @@ import Xanthous.Data (Position(Position), x, y, loc) import Xanthous.Data.EntityMap (EntityMap, atPosition) import qualified Xanthous.Data.EntityMap as EntityMap import Xanthous.Entities +import Xanthous.Entities.Character import Xanthous.Game ( GameState(..) , entities , revealedPositions , characterPosition + , character , MessageHistory(..) , messageHistory , GamePromptState(..) @@ -42,8 +44,8 @@ drawPromptState (WaitingPrompt msg (Prompt _ pt ps _)) = case (pt, ps) of (SStringPrompt, StringPromptState edit) -> txt msg <+> renderEditor (txt . fold) True edit - (SDirectionPrompt, DirectionPromptState) -> - txt msg + (SDirectionPrompt, DirectionPromptState) -> txt msg + (SContinue, _) -> txt msg _ -> undefined drawEntities @@ -79,6 +81,17 @@ drawMap game -- character can't see them (game ^. entities) +drawCharacterInfo :: Character -> Widget Name +drawCharacterInfo ch = txt " " <+> charName <+> charHitpoints + where + charName | Just n <- ch ^. characterName + = txt n <+> txt " " + | otherwise + = emptyWidget + charHitpoints + = txt "Hitpoints: " + <+> txt (tshow $ ch ^. characterHitpoints) + drawGame :: GameState -> [Widget Name] drawGame game = pure @@ -86,3 +99,4 @@ drawGame game $ drawMessages (game ^. messageHistory) <=> drawPromptState (game ^. promptState) <=> border (drawMap game) + <=> drawCharacterInfo (game ^. character) diff --git a/src/Xanthous/Game/Prompt.hs b/src/Xanthous/Game/Prompt.hs index f0df1385f7..cb34793c6d 100644 --- a/src/Xanthous/Game/Prompt.hs +++ b/src/Xanthous/Game/Prompt.hs @@ -31,6 +31,7 @@ data PromptType where Menu :: Type -> PromptType DirectionPrompt :: PromptType PointOnMap :: PromptType + Continue :: PromptType deriving stock (Generic) instance Show PromptType where @@ -39,6 +40,7 @@ instance Show PromptType where show (Menu _) = "Menu" show DirectionPrompt = "DirectionPrompt" show PointOnMap = "PointOnMap" + show Continue = "Continue" data SPromptType :: PromptType -> Type where SStringPrompt :: SPromptType 'StringPrompt @@ -46,10 +48,12 @@ data SPromptType :: PromptType -> Type where SMenu :: forall a. SPromptType ('Menu a) SDirectionPrompt :: SPromptType 'DirectionPrompt SPointOnMap :: SPromptType 'PointOnMap + SContinue :: SPromptType 'Continue class SingPromptType pt where singPromptType :: SPromptType pt instance SingPromptType 'StringPrompt where singPromptType = SStringPrompt instance SingPromptType 'DirectionPrompt where singPromptType = SDirectionPrompt +instance SingPromptType 'Continue where singPromptType = SContinue instance Show (SPromptType pt) where show SStringPrompt = "SStringPrompt" @@ -57,6 +61,7 @@ instance Show (SPromptType pt) where show SMenu = "SMenu" show SDirectionPrompt = "SDirectionPrompt" show SPointOnMap = "SPointOnMap" + show SContinue = "SContinue" data PromptCancellable = Cancellable @@ -73,10 +78,12 @@ data PromptResult (pt :: PromptType) where MenuResult :: forall a. a -> PromptResult ('Menu a) DirectionResult :: Direction -> PromptResult 'DirectionPrompt PointOnMapResult :: Position -> PromptResult 'PointOnMap + ContinueResult :: PromptResult 'Continue data PromptState pt where StringPromptState :: Editor Text Name -> PromptState 'StringPrompt DirectionPromptState :: PromptState 'DirectionPrompt + ContinuePromptState :: PromptState 'Continue deriving stock instance Show (PromptState pt) @@ -103,6 +110,7 @@ mkPrompt c pt@SStringPrompt cb = let ps = StringPromptState $ editorText Resource.Prompt (Just 1) "" in Prompt c pt ps cb mkPrompt c pt@SDirectionPrompt cb = Prompt c pt DirectionPromptState cb +mkPrompt c pt@SContinue cb = Prompt c pt ContinuePromptState cb mkPrompt _ _ _ = undefined isCancellable :: Prompt m -> Bool @@ -116,6 +124,8 @@ submitPrompt (Prompt _ pt ps cb) = cb . StringResult . mconcat . getEditContents $ edit (SDirectionPrompt, DirectionPromptState) -> pure () -- Don't use submit with a direction prompt + (SContinue, ContinuePromptState) -> + cb ContinueResult -- Don't use submit with a direction prompt _ -> undefined -- data PromptInput :: PromptType -> Type where diff --git a/src/Xanthous/Util/Graphics.hs b/src/Xanthous/Util/Graphics.hs index 5a174d4f41..3dc2f6f14c 100644 --- a/src/Xanthous/Util/Graphics.hs +++ b/src/Xanthous/Util/Graphics.hs @@ -3,7 +3,7 @@ module Xanthous.Util.Graphics where -------------------------------------------------------------------------------- import Xanthous.Prelude -import Data.List ( unfoldr ) +import Data.List (unfoldr) -------------------------------------------------------------------------------- -- | Generate a circle centered at the given point and with the given radius diff --git a/src/Xanthous/messages.yaml b/src/Xanthous/messages.yaml index ba6d49150a..8f761ba6e7 100644 --- a/src/Xanthous/messages.yaml +++ b/src/Xanthous/messages.yaml @@ -1,4 +1,5 @@ welcome: Welcome to Xanthous, {{characterName}}! It's dangerous out there, why not stay inside? +dead: You have died... Press Enter to continue. entities: description: You see here {{entityDescriptions}} @@ -21,6 +22,9 @@ combat: hit: - You hit the {{creature.creatureType.name}} - You attack the {{creature.creatureType.name}} + creatureAttack: + - The {{creature.creatureType.name}} hits you! + - The {{creature.creatureType.name}} attacks you! killed: - You kill the {{creature.creatureType.name}}! - You've killed the {{creature.creatureType.name}}! diff --git a/test/Xanthous/DataSpec.hs b/test/Xanthous/DataSpec.hs index 2c9f9dd3f9..6b94e6a058 100644 --- a/test/Xanthous/DataSpec.hs +++ b/test/Xanthous/DataSpec.hs @@ -15,12 +15,26 @@ test = testGroup "Xanthous.Data" [ testBatch $ monoid @Position mempty , testProperty "group laws" $ \(pos :: Position) -> pos <> invert pos == mempty && invert pos <> pos == mempty + , testGroup "stepTowards laws" + [ testProperty "takes only one step" $ \src tgt -> + src /= tgt ==> + isUnit (src `diffPositions` (src `stepTowards` tgt)) + -- , testProperty "moves in the right direction" $ \src tgt -> + -- stepTowards src tgt == move (directionOf src tgt) src + ] + , testProperty "directionOf laws" $ \pos dir -> + directionOf pos (move dir pos) == dir + , testProperty "diffPositions is add inverse" $ \pos₁ pos₂ -> + diffPositions pos₁ pos₂ == addPositions pos₁ (invert pos₂) + ] , testGroup "Direction" [ testProperty "opposite is involutive" $ \(dir :: Direction) -> opposite (opposite dir) == dir , testProperty "opposite provides inverse" $ \dir -> invert (asPosition dir) == asPosition (opposite dir) + , testProperty "asPosition isUnit" $ \dir -> + dir /= Here ==> isUnit (asPosition dir) , testGroup "Move" [ testCase "Up" $ move Up mempty @?= Position 0 (-1) , testCase "Down" $ move Down mempty @?= Position 0 1 -- cgit 1.4.1 From 272ff5b3e606cd95aedaa4889ff38906c0e0bf03 Mon Sep 17 00:00:00 2001 From: Griffin Smith Date: Sun, 29 Sep 2019 11:10:28 -0400 Subject: Use nix-build in github-actions --- .github/actions/nix-build/Dockerfile | 23 +++++++++++++++++++++++ .github/actions/nix-build/entrypoint.sh | 24 ++++++++++++++++++++++++ .github/workflows/haskell.yml | 14 +++++--------- 3 files changed, 52 insertions(+), 9 deletions(-) create mode 100644 .github/actions/nix-build/Dockerfile create mode 100755 .github/actions/nix-build/entrypoint.sh diff --git a/.github/actions/nix-build/Dockerfile b/.github/actions/nix-build/Dockerfile new file mode 100644 index 0000000000..cfe8e35df0 --- /dev/null +++ b/.github/actions/nix-build/Dockerfile @@ -0,0 +1,23 @@ +FROM lnl7/nix:2.1.2 + +LABEL name="Nix Build for GitHub Actions" +LABEL version="1.0" +LABEL repository="http://github.com/glittershark/xanthous" +LABEL homepage="http://github.com/glittershark/xanthous" +LABEL maintainer="Griffin Smith " + +LABEL "com.github.actions.name"="Nix Build" +LABEL "com.github.actions.description"="Runs 'nix-build'" +LABEL "com.github.actions.icon"="cpu" +LABEL "com.github.actions.color"="purple" + +RUN nix-env -iA \ + nixpkgs.gnutar nixpkgs.gzip \ + nixpkgs.gnugrep nixpkgs.git && \ + mkdir -p /etc/nix && \ + (echo "binary-caches = https://cache.nixos.org/" | tee -a /etc/nix/nix.conf) && \ + (echo "trusted-public-keys = cache.nixos.org-1:6NCHdD59X431o0gWypbMrAURkbJ16ZPMQFGspcDShjY=" | tee -a /etc/nix/nix.conf) + +COPY entrypoint.sh /entrypoint.sh +ENTRYPOINT [ "/entrypoint.sh" ] +CMD [ "--help" ] diff --git a/.github/actions/nix-build/entrypoint.sh b/.github/actions/nix-build/entrypoint.sh new file mode 100755 index 0000000000..4499660edd --- /dev/null +++ b/.github/actions/nix-build/entrypoint.sh @@ -0,0 +1,24 @@ +#!/usr/bin/env bash + +# Entrypoint that runs nix-build and, optionally, copies Docker image tarballs +# to real files. The reason this is necessary is because once a Nix container +# exits, you must copy out the artifacts to the working directory before exit. + +[ "$DEBUG" = "1" ] && set -x +[ "$QUIET" = "1" ] && QUIET_ARG="-Q" + +set -e + +# file to build (e.g. release.nix) +file="$1" + +[ "$file" = "" ] && echo "No .nix file to build specified!" && exit 1 +[ ! -e "$file" ] && echo "File $file not exist!" && exit 1 + +echo "Building all attrs in $file..." +nix-build --no-link ${QUIET_ARG} "$file" + +echo "Copying build closure to $(pwd)/store..." +mapfile -t storePaths < <(nix-build ${QUIET_ARG} --no-link "$file" | grep -v cache-deps) +printf '%s\n' "${storePaths[@]}" > store.roots +nix copy --to "file://$(pwd)/store" "${storePaths[@]}" diff --git a/.github/workflows/haskell.yml b/.github/workflows/haskell.yml index 9b6cb1ab84..e1a57d4400 100644 --- a/.github/workflows/haskell.yml +++ b/.github/workflows/haskell.yml @@ -4,16 +4,12 @@ on: [push] jobs: build: - + runs-on: ubuntu-latest steps: - uses: actions/checkout@v1 - - name: Install dependencies - run: cabal install --only-dependencies --enable-tests - - name: Build - run: | - cabal configure --enable-tests - cabal build - - name: Run tests - run: cabal test + - name: Nix Build + with: + args: default.nix + uses: ./.github/actions/nix-build -- cgit 1.4.1 From 5c6ba40019ea23660cfab80864593b398567f223 Mon Sep 17 00:00:00 2001 From: Griffin Smith Date: Sat, 5 Oct 2019 16:18:11 -0400 Subject: Display multiple messages per turn When tracking message history, save messages associated with the turn they were displayed on, which allows us to have the notion of the "current turn's" messages (provided via a MonoComonad instance). --- src/Xanthous/App.hs | 4 +-- src/Xanthous/Game.hs | 8 ++++-- src/Xanthous/Game/Draw.hs | 5 +--- src/Xanthous/Game/Lenses.hs | 2 +- src/Xanthous/Game/State.hs | 60 +++++++++++++++++++++++++++++++++------------ src/Xanthous/Orphans.hs | 21 +++++++++++++--- test/Xanthous/GameSpec.hs | 12 +++++++++ 7 files changed, 84 insertions(+), 28 deletions(-) diff --git a/src/Xanthous/App.hs b/src/Xanthous/App.hs index 02f6f0987d..72c9a3f553 100644 --- a/src/Xanthous/App.hs +++ b/src/Xanthous/App.hs @@ -103,7 +103,7 @@ handleEvent ev = use promptState >>= \case handleNoPromptEvent :: BrickEvent Name () -> AppM (Next GameState) handleNoPromptEvent (VtyEvent (EvKey k mods)) | Just command <- commandFromKey k mods - = do messageHistory %= hideMessage + = do messageHistory %= nextTurn handleCommand command handleNoPromptEvent _ = continue @@ -135,7 +135,7 @@ handleCommand PickUp = do continue handleCommand PreviousMessage = do - messageHistory %= popMessage + messageHistory %= previousMessage continue handleCommand Open = do diff --git a/src/Xanthous/Game.hs b/src/Xanthous/Game.hs index 2b346ace56..0ab5425a04 100644 --- a/src/Xanthous/Game.hs +++ b/src/Xanthous/Game.hs @@ -14,10 +14,14 @@ module Xanthous.Game , characterPosition , updateCharacterVision + -- * Messages , MessageHistory(..) + , HasMessages(..) + , HasTurn(..) + , HasDisplayedTurn(..) , pushMessage - , popMessage - , hideMessage + , previousMessage + , nextTurn -- * Collisions , Collision(..) diff --git a/src/Xanthous/Game/Draw.hs b/src/Xanthous/Game/Draw.hs index e1242f2b7a..addeaa14cd 100644 --- a/src/Xanthous/Game/Draw.hs +++ b/src/Xanthous/Game/Draw.hs @@ -8,7 +8,6 @@ import Brick hiding (loc) import Brick.Widgets.Border import Brick.Widgets.Border.Style import Brick.Widgets.Edit -import Data.List.NonEmpty(NonEmpty((:|))) -------------------------------------------------------------------------------- import Xanthous.Data (Position(Position), x, y, loc) import Xanthous.Data.EntityMap (EntityMap, atPosition) @@ -34,9 +33,7 @@ import Xanthous.Orphans () -------------------------------------------------------------------------------- drawMessages :: MessageHistory -> Widget Name -drawMessages NoMessageHistory = emptyWidget -drawMessages (MessageHistory _ False) = str " " -drawMessages (MessageHistory (lastMessage :| _) True) = txt lastMessage +drawMessages = txt . (<> " ") . unwords . oextract drawPromptState :: GamePromptState m -> Widget Name drawPromptState NoPrompt = emptyWidget diff --git a/src/Xanthous/Game/Lenses.hs b/src/Xanthous/Game/Lenses.hs index e077e339cd..101de3021c 100644 --- a/src/Xanthous/Game/Lenses.hs +++ b/src/Xanthous/Game/Lenses.hs @@ -36,7 +36,7 @@ getInitialState = do (Position 0 0) (SomeEntity char) mempty - _messageHistory = NoMessageHistory + _messageHistory = mempty _revealedPositions = mempty _promptState = NoPrompt _debugState = DebugState diff --git a/src/Xanthous/Game/State.hs b/src/Xanthous/Game/State.hs index 00785bf124..302d20e1ef 100644 --- a/src/Xanthous/Game/State.hs +++ b/src/Xanthous/Game/State.hs @@ -14,9 +14,12 @@ module Xanthous.Game.State -- * Messages , MessageHistory(..) + , HasMessages(..) + , HasTurn(..) + , HasDisplayedTurn(..) , pushMessage - , popMessage - , hideMessage + , previousMessage + , nextTurn -- * App monad , AppT(..) @@ -61,27 +64,54 @@ import Xanthous.Resource -------------------------------------------------------------------------------- data MessageHistory - = NoMessageHistory - | MessageHistory (NonEmpty Text) Bool + = MessageHistory + { _messages :: Map Word (NonEmpty Text) + , _turn :: Word + , _displayedTurn :: Maybe Word + } deriving stock (Show, Eq, Generic) deriving anyclass (NFData, CoArbitrary, Function) +makeFieldsNoPrefix ''MessageHistory + +instance Semigroup MessageHistory where + (MessageHistory msgs₁ turn₁ dt₁) <> (MessageHistory msgs₂ turn₂ dt₂) = + MessageHistory (msgs₁ <> msgs₂) (max turn₁ turn₂) $ case (dt₁, dt₂) of + (_, Nothing) -> Nothing + (Just t, _) -> Just t + (Nothing, Just t) -> Just t + +instance Monoid MessageHistory where + mempty = MessageHistory mempty 0 Nothing instance Arbitrary MessageHistory where arbitrary = genericArbitrary +type instance Element MessageHistory = [Text] +instance MonoFunctor MessageHistory where + omap f mh@(MessageHistory _ t _) = + mh & messages . at t %~ (NonEmpty.nonEmpty . f . toList =<<) + +instance MonoComonad MessageHistory where + oextract (MessageHistory ms t dt) = maybe [] toList $ ms ^. at (fromMaybe t dt) + oextend cok mh@(MessageHistory _ t dt) = + mh & messages . at (fromMaybe t dt) .~ NonEmpty.nonEmpty (cok mh) + pushMessage :: Text -> MessageHistory -> MessageHistory -pushMessage msg NoMessageHistory = MessageHistory (msg :| []) True -pushMessage msg (MessageHistory msgs _) = MessageHistory (NonEmpty.cons msg msgs) True +pushMessage msg mh@(MessageHistory _ turn' _) = + mh + & messages . at turn' %~ \case + Nothing -> Just $ msg :| mempty + Just msgs -> Just $ msg <| msgs + & displayedTurn .~ Nothing + +nextTurn :: MessageHistory -> MessageHistory +nextTurn = (turn +~ 1) . (displayedTurn .~ Nothing) -popMessage :: MessageHistory -> MessageHistory -popMessage NoMessageHistory = NoMessageHistory -popMessage (MessageHistory msgs False) = MessageHistory msgs True -popMessage (MessageHistory msgs@(_ :| []) _) = MessageHistory msgs True -popMessage (MessageHistory (_ :| (msg : msgs)) True) = MessageHistory (msg :| msgs) True +previousMessage :: MessageHistory -> MessageHistory +previousMessage mh = mh & displayedTurn .~ maximumOf + (messages . ifolded . asIndex . filtered (< mh ^. turn)) + mh -hideMessage :: MessageHistory -> MessageHistory -hideMessage NoMessageHistory = NoMessageHistory -hideMessage (MessageHistory msgs _) = MessageHistory msgs False -------------------------------------------------------------------------------- @@ -152,7 +182,7 @@ instance Eq SomeEntity where Just Refl -> a == b _ -> False -instance Draw (SomeEntity) where +instance Draw SomeEntity where drawWithNeighbors ns (SomeEntity ent) = drawWithNeighbors ns ent instance Brain SomeEntity where diff --git a/src/Xanthous/Orphans.hs b/src/Xanthous/Orphans.hs index 22325f6366..610067a375 100644 --- a/src/Xanthous/Orphans.hs +++ b/src/Xanthous/Orphans.hs @@ -25,7 +25,8 @@ import Text.Mustache.Type ( showKey ) instance forall s a. ( Cons s s a a - , MonoFoldable s + , IsSequence s + , Element s ~ a ) => Cons (NonNull s) (NonNull s) a a where _Cons = prism hither yon where @@ -35,9 +36,21 @@ instance forall s a. in impureNonNull $ a <| s yon :: NonNull s -> Either (NonNull s) (a, NonNull s) - yon ns = case ns ^? _Cons of - Nothing -> Left ns - Just (a, ns') -> Right (a, ns') + yon ns = case nuncons ns of + (_, Nothing) -> Left ns + (x, Just xs) -> Right (x, xs) + +instance forall a. Cons (NonEmpty a) (NonEmpty a) a a where + _Cons = prism hither yon + where + hither :: (a, NonEmpty a) -> NonEmpty a + hither (a, x :| xs) = a :| (x : xs) + + yon :: NonEmpty a -> Either (NonEmpty a) (a, NonEmpty a) + yon ns@(x :| xs) = case xs of + (y : ys) -> Right (x, y :| ys) + [] -> Left ns + instance Arbitrary PName where arbitrary = PName . pack <$> listOf1 (elements ['a'..'z']) diff --git a/test/Xanthous/GameSpec.hs b/test/Xanthous/GameSpec.hs index 32faae03d7..af98c7f6cc 100644 --- a/test/Xanthous/GameSpec.hs +++ b/test/Xanthous/GameSpec.hs @@ -30,4 +30,16 @@ test = testGroup "Xanthous.Game" , testGroup "character" [ testProperty "lens laws" $ isLens character ] + , localOption (QuickCheckTests 10) + $ testGroup "MessageHistory" + [ testGroup "MonoComonad laws" + [ testProperty "oextend oextract ≡ id" + $ \(mh :: MessageHistory) -> oextend oextract mh === mh + , testProperty "oextract ∘ oextend f ≡ f" + $ \(mh :: MessageHistory) f -> (oextract . oextend f) mh === f mh + , testProperty "oextend f ∘ oextend g ≡ oextend (f . oextend g)" + $ \(mh :: MessageHistory) f g -> + (oextend f . oextend g) mh === oextend (f . oextend g) mh + ] + ] ] -- cgit 1.4.1 From 262fc7fb41f14181ed34cecfcca9ef2d25102688 Mon Sep 17 00:00:00 2001 From: Griffin Smith Date: Sat, 5 Oct 2019 16:25:43 -0400 Subject: Don't move creatures when they're attacking This may have resulted in a double-attack per turn --- src/Xanthous/AI/Gormlak.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Xanthous/AI/Gormlak.hs b/src/Xanthous/AI/Gormlak.hs index c9af688426..68feb67ac2 100644 --- a/src/Xanthous/AI/Gormlak.hs +++ b/src/Xanthous/AI/Gormlak.hs @@ -36,7 +36,7 @@ stepGormlak pe@(Positioned pos creature) = do then do charPos <- use characterPosition if isUnit (pos `diffPositions` charPos) - then attackCharacter $> charPos + then attackCharacter $> pos else pure $ pos `stepTowards` charPos else do lines <- uses entities $ linesOfSight pos (Creature.visionRadius creature) -- cgit 1.4.1 From de8052cef8a9f749cdb2312a4f5ae5f5a44cf1b8 Mon Sep 17 00:00:00 2001 From: Griffin Smith Date: Sun, 6 Oct 2019 12:50:29 -0400 Subject: Allow eating edible items Add menu support to the prompt system, and an "Eat" command that prompts for an item to eat and eats the item the character specifies, restoring an amount of hitpoints configurable via the item raw type. --- package.yaml | 1 + src/Xanthous/App.hs | 84 ++++++++++++++++++++++++++------- src/Xanthous/Command.hs | 2 + src/Xanthous/Entities.hs | 12 +++-- src/Xanthous/Entities/Item.hs | 6 ++- src/Xanthous/Entities/RawTypes.hs | 33 +++++++++++-- src/Xanthous/Entities/Raws/noodles.yaml | 4 ++ src/Xanthous/Game/Draw.hs | 16 +++++-- src/Xanthous/Game/Prompt.hs | 79 +++++++++++++++++++++++-------- src/Xanthous/Messages.hs | 27 ++++++++--- src/Xanthous/Monad.hs | 37 +++++++++++---- src/Xanthous/Util.hs | 10 ++++ src/Xanthous/messages.yaml | 21 +++++++-- test/Spec.hs | 2 + test/Xanthous/UtilSpec.hs | 24 ++++++++++ xanthous.cabal | 6 ++- 16 files changed, 290 insertions(+), 74 deletions(-) create mode 100644 test/Xanthous/UtilSpec.hs diff --git a/package.yaml b/package.yaml index aa1b52ed03..35f6b56526 100644 --- a/package.yaml +++ b/package.yaml @@ -48,6 +48,7 @@ dependencies: - reflection - stache - tomland +- vector - vty - yaml diff --git a/src/Xanthous/App.hs b/src/Xanthous/App.hs index 72c9a3f553..eb2f0cf7ad 100644 --- a/src/Xanthous/App.hs +++ b/src/Xanthous/App.hs @@ -13,6 +13,7 @@ import Control.Monad.Random (MonadRandom) import Control.Monad.State.Class (modify) import Data.Aeson (object, ToJSON) import qualified Data.Aeson as A +import qualified Data.Vector as V import System.Exit -------------------------------------------------------------------------------- import Xanthous.Command @@ -29,16 +30,18 @@ import Xanthous.Game.Draw (drawGame) import Xanthous.Game.Prompt import Xanthous.Monad import Xanthous.Resource (Name) -import Xanthous.Messages (message) +import qualified Xanthous.Messages as Messages import Xanthous.Util.Inflection (toSentence) -------------------------------------------------------------------------------- import qualified Xanthous.Entities.Character as Character import Xanthous.Entities.Character import Xanthous.Entities import Xanthous.Entities.Item (Item) +import qualified Xanthous.Entities.Item as Item import Xanthous.Entities.Creature (Creature) import qualified Xanthous.Entities.Creature as Creature import Xanthous.Entities.Environment (Door, open, locked) +import Xanthous.Entities.RawTypes (edible, eatMessage, hitpointsHealed) import Xanthous.Generators import qualified Xanthous.Generators.CaveAutomata as CaveAutomata -------------------------------------------------------------------------------- @@ -155,6 +158,26 @@ handleCommand Open = do handleCommand Wait = stepGame >> continue +handleCommand Eat = do + uses (character . inventory) + (V.mapMaybe (\item -> (item,) <$> item ^. Item.itemType . edible)) + >>= \case + Empty -> say_ ["eat", "noFood"] + food -> + let foodMenuItem idx (item, edibleItem) + = ( item ^. Item.itemType . char . char + , MenuOption (description item) (idx, item, edibleItem)) + menuItems = mkMenuItems $ imap foodMenuItem food + in menu_ ["eat", "menuPrompt"] Cancellable menuItems + $ \(MenuResult (idx, item, edibleItem)) -> do + character . inventory %= \inv -> + let (before, after) = V.splitAt idx inv + in before <> fromMaybe Empty (tailMay after) + let msg = fromMaybe (Messages.lookup ["eat", "eat"]) + $ edibleItem ^. eatMessage + message msg $ object ["item" A..= item] + continue + handleCommand ToggleRevealAll = do val <- debugState . allRevealed <%= not say ["debug", "toggleRevealAll"] $ object [ "revealAll" A..= val ] @@ -168,39 +191,43 @@ handlePromptEvent -> BrickEvent Name () -> AppM (Next GameState) -handlePromptEvent _ (Prompt Cancellable _ _ _) (VtyEvent (EvKey KEsc [])) = do - promptState .= NoPrompt - continue -handlePromptEvent _ pr (VtyEvent (EvKey KEnter [])) = do - submitPrompt pr +handlePromptEvent _ (Prompt Cancellable _ _ _ _) (VtyEvent (EvKey KEsc [])) = do promptState .= NoPrompt continue +handlePromptEvent _ pr (VtyEvent (EvKey KEnter [])) = + submitPrompt pr >> clearPrompt handlePromptEvent msg - (Prompt c SStringPrompt (StringPromptState edit) cb) + (Prompt c SStringPrompt (StringPromptState edit) pi cb) (VtyEvent ev) = do edit' <- lift $ handleEditorEvent ev edit - let prompt' = Prompt c SStringPrompt (StringPromptState edit') cb + let prompt' = Prompt c SStringPrompt (StringPromptState edit') pi cb promptState .= WaitingPrompt msg prompt' continue -handlePromptEvent _ (Prompt _ SDirectionPrompt _ cb) +handlePromptEvent _ (Prompt _ SDirectionPrompt _ _ cb) (VtyEvent (EvKey (KChar (directionFromChar -> Just dir)) [])) - = do - cb $ DirectionResult dir - promptState .= NoPrompt - continue -handlePromptEvent _ (Prompt _ SDirectionPrompt _ _) _ = continue + = cb (DirectionResult dir) >> clearPrompt +handlePromptEvent _ (Prompt _ SDirectionPrompt _ _ _) _ = continue -handlePromptEvent _ (Prompt _ SContinue _ _) _ = continue +handlePromptEvent _ (Prompt _ SContinue _ _ _) _ = continue + +handlePromptEvent _ (Prompt _ SMenu _ items cb) (VtyEvent (EvKey (KChar chr) [])) + | Just (MenuOption _ res) <- items ^. at chr + = cb (MenuResult res) >> clearPrompt + | otherwise + = continue handlePromptEvent _ _ _ = undefined +clearPrompt :: AppM (Next GameState) +clearPrompt = promptState .= NoPrompt >> continue + prompt :: forall (pt :: PromptType) (params :: Type). - (ToJSON params, SingPromptType pt) + (ToJSON params, SingPromptType pt, PromptInput pt ~ ()) => [Text] -- ^ Message key -> params -- ^ Message params -> PromptCancellable @@ -208,19 +235,40 @@ prompt -> AppM () prompt msgPath params cancellable cb = do let pt = singPromptType @pt - msg <- message msgPath params + msg <- Messages.message msgPath params let p = mkPrompt cancellable pt cb promptState .= WaitingPrompt msg p prompt_ :: forall (pt :: PromptType) . - (SingPromptType pt) + (SingPromptType pt, PromptInput pt ~ ()) => [Text] -- ^ Message key -> PromptCancellable -> (PromptResult pt -> AppM ()) -- ^ Prompt promise handler -> AppM () prompt_ msg = prompt msg $ object [] +menu :: forall (a :: Type) (params :: Type). + (ToJSON params) + => [Text] -- ^ Message key + -> params -- ^ Message params + -> PromptCancellable + -> Map Char (MenuOption a) -- ^ Menu items + -> (PromptResult ('Menu a) -> AppM ()) -- ^ Menu promise handler + -> AppM () +menu msgPath params cancellable items cb = do + msg <- Messages.message msgPath params + let p = mkMenu cancellable items cb + promptState .= WaitingPrompt msg p + +menu_ :: forall (a :: Type). + [Text] -- ^ Message key + -> PromptCancellable + -> Map Char (MenuOption a) -- ^ Menu items + -> (PromptResult ('Menu a) -> AppM ()) -- ^ Menu promise handler + -> AppM () +menu_ msgPath = menu msgPath $ object [] + -------------------------------------------------------------------------------- entitiesAtPositionWithType diff --git a/src/Xanthous/Command.hs b/src/Xanthous/Command.hs index 4bf0e28939..f2f21160df 100644 --- a/src/Xanthous/Command.hs +++ b/src/Xanthous/Command.hs @@ -16,6 +16,7 @@ data Command | PickUp | Open | Wait + | Eat -- | TODO replace with `:` commands | ToggleRevealAll @@ -27,6 +28,7 @@ commandFromKey (KChar (directionFromChar -> Just dir)) [] = Just $ Move dir commandFromKey (KChar 'p') [MCtrl] = Just PreviousMessage commandFromKey (KChar ',') [] = Just PickUp commandFromKey (KChar 'o') [] = Just Open +commandFromKey (KChar 'e') [] = Just Eat commandFromKey (KChar 'r') [MMeta] = Just ToggleRevealAll commandFromKey _ _ = Nothing diff --git a/src/Xanthous/Entities.hs b/src/Xanthous/Entities.hs index 15080b3221..af226b395d 100644 --- a/src/Xanthous/Entities.hs +++ b/src/Xanthous/Entities.hs @@ -1,8 +1,9 @@ -{-# LANGUAGE RoleAnnotations #-} -{-# LANGUAGE RecordWildCards #-} -{-# LANGUAGE UndecidableInstances #-} -{-# LANGUAGE GADTs #-} -{-# LANGUAGE AllowAmbiguousTypes #-} +{-# LANGUAGE RoleAnnotations #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE AllowAmbiguousTypes #-} +{-# LANGUAGE TemplateHaskell #-} -------------------------------------------------------------------------------- module Xanthous.Entities ( Draw(..) @@ -103,6 +104,7 @@ data EntityChar = EntityChar } deriving stock (Show, Eq, Generic) deriving anyclass (NFData, CoArbitrary, Function) +makeFieldsNoPrefix ''EntityChar instance Arbitrary EntityChar where arbitrary = genericArbitrary diff --git a/src/Xanthous/Entities/Item.hs b/src/Xanthous/Entities/Item.hs index 832f0d4d62..ea6f16e05d 100644 --- a/src/Xanthous/Entities/Item.hs +++ b/src/Xanthous/Entities/Item.hs @@ -5,6 +5,7 @@ module Xanthous.Entities.Item ( Item(..) , itemType , newWithType + , isEdible ) where -------------------------------------------------------------------------------- import Xanthous.Prelude @@ -12,7 +13,7 @@ import Test.QuickCheck import Data.Aeson (ToJSON, FromJSON) import Data.Aeson.Generic.DerivingVia -------------------------------------------------------------------------------- -import Xanthous.Entities.RawTypes hiding (Item, description) +import Xanthous.Entities.RawTypes hiding (Item, description, isEdible) import qualified Xanthous.Entities.RawTypes as Raw import Xanthous.Entities ( Draw(..) @@ -47,3 +48,6 @@ instance Entity Item where newWithType :: ItemType -> Item newWithType = Item + +isEdible :: Item -> Bool +isEdible = Raw.isEdible . view itemType diff --git a/src/Xanthous/Entities/RawTypes.hs b/src/Xanthous/Entities/RawTypes.hs index 3fb89c58ba..f1f5e05f7a 100644 --- a/src/Xanthous/Entities/RawTypes.hs +++ b/src/Xanthous/Entities/RawTypes.hs @@ -3,14 +3,20 @@ -------------------------------------------------------------------------------- module Xanthous.Entities.RawTypes ( CreatureType(..) + , EdibleItem(..) , ItemType(..) + , isEdible , EntityRaw(..) + -- * Lens classes , HasName(..) , HasDescription(..) , HasLongDescription(..) , HasMaxHitpoints(..) , HasFriendly(..) + , HasEatMessage(..) + , HasHitpointsHealed(..) + , HasEdible(..) , _Creature ) where -------------------------------------------------------------------------------- @@ -21,6 +27,7 @@ import Data.Aeson.Generic.DerivingVia import Data.Aeson (ToJSON, FromJSON) -------------------------------------------------------------------------------- import Xanthous.Entities (EntityChar, HasChar(..)) +import Xanthous.Messages (Message(..)) -------------------------------------------------------------------------------- data CreatureType = CreatureType { _name :: Text @@ -41,11 +48,26 @@ instance Arbitrary CreatureType where -------------------------------------------------------------------------------- +data EdibleItem = EdibleItem + { _hitpointsHealed :: Int + , _eatMessage :: Maybe Message + } + deriving stock (Show, Eq, Generic) + deriving anyclass (NFData, CoArbitrary, Function) + deriving (ToJSON, FromJSON) + via WithOptions '[ FieldLabelModifier '[Drop 1] ] + EdibleItem +makeFieldsNoPrefix ''EdibleItem + +instance Arbitrary EdibleItem where + arbitrary = genericArbitrary + data ItemType = ItemType - { _name :: Text - , _description :: Text + { _name :: Text + , _description :: Text , _longDescription :: Text - , _char :: EntityChar + , _char :: EntityChar + , _edible :: Maybe EdibleItem } deriving stock (Show, Eq, Generic) deriving anyclass (NFData, CoArbitrary, Function) @@ -57,6 +79,11 @@ makeFieldsNoPrefix ''ItemType instance Arbitrary ItemType where arbitrary = genericArbitrary +isEdible :: ItemType -> Bool +isEdible = has $ edible . _Just + +-------------------------------------------------------------------------------- + data EntityRaw = Creature CreatureType | Item ItemType diff --git a/src/Xanthous/Entities/Raws/noodles.yaml b/src/Xanthous/Entities/Raws/noodles.yaml index 91a0a35388..c3f19dce91 100644 --- a/src/Xanthous/Entities/Raws/noodles.yaml +++ b/src/Xanthous/Entities/Raws/noodles.yaml @@ -6,3 +6,7 @@ Item: char: 'n' style: foreground: yellow + edible: + hitpointsHealed: 2 + eatMessage: + - You slurp up the noodles. Yumm! diff --git a/src/Xanthous/Game/Draw.hs b/src/Xanthous/Game/Draw.hs index addeaa14cd..9f247d3833 100644 --- a/src/Xanthous/Game/Draw.hs +++ b/src/Xanthous/Game/Draw.hs @@ -37,13 +37,19 @@ drawMessages = txt . (<> " ") . unwords . oextract drawPromptState :: GamePromptState m -> Widget Name drawPromptState NoPrompt = emptyWidget -drawPromptState (WaitingPrompt msg (Prompt _ pt ps _)) = - case (pt, ps) of - (SStringPrompt, StringPromptState edit) -> +drawPromptState (WaitingPrompt msg (Prompt _ pt ps pri _)) = + case (pt, ps, pri) of + (SStringPrompt, StringPromptState edit, _) -> txt msg <+> renderEditor (txt . fold) True edit - (SDirectionPrompt, DirectionPromptState) -> txt msg - (SContinue, _) -> txt msg + (SDirectionPrompt, DirectionPromptState, _) -> txt msg + (SContinue, _, _) -> txt msg + (SMenu, _, menuItems) -> + txt msg + <=> foldl' (<=>) emptyWidget (map drawMenuItem $ itoList menuItems) _ -> undefined + where + drawMenuItem (chr, MenuOption m _) = + str ("[" <> pure chr <> "] ") <+> txt m drawEntities :: (Position -> Bool) diff --git a/src/Xanthous/Game/Prompt.hs b/src/Xanthous/Game/Prompt.hs index cb34793c6d..26a7b96eb1 100644 --- a/src/Xanthous/Game/Prompt.hs +++ b/src/Xanthous/Game/Prompt.hs @@ -8,20 +8,25 @@ module Xanthous.Game.Prompt , PromptCancellable(..) , PromptResult(..) , PromptState(..) + , MenuOption(..) + , mkMenuItems + , PromptInput , Prompt(..) , mkPrompt + , mkMenu , isCancellable , submitPrompt ) where -------------------------------------------------------------------------------- import Xanthous.Prelude -------------------------------------------------------------------------------- -import Brick.Widgets.Edit (Editor, editorText, getEditContents) -import Test.QuickCheck -import Test.QuickCheck.Arbitrary.Generic +import Brick.Widgets.Edit (Editor, editorText, getEditContents) +import Test.QuickCheck +import Test.QuickCheck.Arbitrary.Generic -------------------------------------------------------------------------------- -import Xanthous.Data (Direction, Position) -import Xanthous.Resource (Name) +import Xanthous.Util (smallestNotIn) +import Xanthous.Data (Direction, Position) +import Xanthous.Resource (Name) import qualified Xanthous.Resource as Resource -------------------------------------------------------------------------------- @@ -81,12 +86,31 @@ data PromptResult (pt :: PromptType) where ContinueResult :: PromptResult 'Continue data PromptState pt where - StringPromptState :: Editor Text Name -> PromptState 'StringPrompt - DirectionPromptState :: PromptState 'DirectionPrompt - ContinuePromptState :: PromptState 'Continue + StringPromptState :: Editor Text Name -> PromptState 'StringPrompt + DirectionPromptState :: PromptState 'DirectionPrompt + ContinuePromptState :: PromptState 'Continue + MenuPromptState :: forall a. PromptState ('Menu a) deriving stock instance Show (PromptState pt) +data MenuOption a = MenuOption Text a + +mkMenuItems :: (MonoFoldable f, Element f ~ (Char, MenuOption a)) + => f + -> Map Char (MenuOption a) +mkMenuItems = flip foldl' mempty $ \items (chr, option) -> + let chr' = if has (ix chr) items + then smallestNotIn $ keys items + else chr + in items & at chr' ?~ option + +instance Show (MenuOption a) where + show (MenuOption m _) = show m + +type family PromptInput (pt :: PromptType) :: Type where + PromptInput ('Menu a) = Map Char (MenuOption a) + PromptInput _ = () + data Prompt (m :: Type -> Type) where Prompt :: forall (pt :: PromptType) @@ -94,38 +118,53 @@ data Prompt (m :: Type -> Type) where PromptCancellable -> SPromptType pt -> PromptState pt + -> PromptInput pt -> (PromptResult pt -> m ()) -> Prompt m instance Show (Prompt m) where - show (Prompt c pt ps _) + show (Prompt c pt ps pri _) = "(Prompt " <> show c <> " " <> show pt <> " " - <> show ps - <> " )" - -mkPrompt :: PromptCancellable -> SPromptType pt -> (PromptResult pt -> m ()) -> Prompt m + <> show ps <> " " + <> showPri + <> " )" + where showPri = case pt of + SMenu -> show pri + _ -> "()" + +mkPrompt :: (PromptInput pt ~ ()) => PromptCancellable -> SPromptType pt -> (PromptResult pt -> m ()) -> Prompt m mkPrompt c pt@SStringPrompt cb = let ps = StringPromptState $ editorText Resource.Prompt (Just 1) "" - in Prompt c pt ps cb -mkPrompt c pt@SDirectionPrompt cb = Prompt c pt DirectionPromptState cb -mkPrompt c pt@SContinue cb = Prompt c pt ContinuePromptState cb + in Prompt c pt ps () cb +mkPrompt c pt@SDirectionPrompt cb = Prompt c pt DirectionPromptState () cb +mkPrompt c pt@SContinue cb = Prompt c pt ContinuePromptState () cb mkPrompt _ _ _ = undefined +mkMenu + :: forall a m. + PromptCancellable + -> Map Char (MenuOption a) -- ^ Menu items + -> (PromptResult ('Menu a) -> m ()) + -> Prompt m +mkMenu c = Prompt c SMenu MenuPromptState + isCancellable :: Prompt m -> Bool -isCancellable (Prompt Cancellable _ _ _) = True -isCancellable (Prompt Uncancellable _ _ _) = False +isCancellable (Prompt Cancellable _ _ _ _) = True +isCancellable (Prompt Uncancellable _ _ _ _) = False submitPrompt :: Applicative m => Prompt m -> m () -submitPrompt (Prompt _ pt ps cb) = +submitPrompt (Prompt _ pt ps _ cb) = case (pt, ps) of (SStringPrompt, StringPromptState edit) -> cb . StringResult . mconcat . getEditContents $ edit (SDirectionPrompt, DirectionPromptState) -> pure () -- Don't use submit with a direction prompt (SContinue, ContinuePromptState) -> - cb ContinueResult -- Don't use submit with a direction prompt + cb ContinueResult + (SMenu, MenuPromptState) -> + pure () -- Don't use submit with a menu prompt _ -> undefined -- data PromptInput :: PromptType -> Type where diff --git a/src/Xanthous/Messages.hs b/src/Xanthous/Messages.hs index b1aeeb635c..b0dc0e4ae9 100644 --- a/src/Xanthous/Messages.hs +++ b/src/Xanthous/Messages.hs @@ -1,4 +1,5 @@ {-# LANGUAGE TemplateHaskell #-} +-------------------------------------------------------------------------------- module Xanthous.Messages ( Message(..) , resolve @@ -7,11 +8,13 @@ module Xanthous.Messages -- * Game messages , messages + , render + , lookup , message ) where -------------------------------------------------------------------------------- -import Xanthous.Prelude - +import Xanthous.Prelude hiding (lookup) +-------------------------------------------------------------------------------- import Control.Monad.Random.Class (MonadRandom) import Data.Aeson (FromJSON, ToJSON, toJSON) import Data.Aeson.Generic.DerivingVia @@ -22,9 +25,10 @@ import Test.QuickCheck.Arbitrary.Generic import Test.QuickCheck.Instances.UnorderedContainers () import Text.Mustache import qualified Data.Yaml as Yaml - +-------------------------------------------------------------------------------- import Xanthous.Random import Xanthous.Orphans () +-------------------------------------------------------------------------------- data Message = Single Template | Choice (NonEmpty Template) deriving stock (Show, Eq, Ord, Generic) @@ -78,10 +82,19 @@ messages = either (error . Yaml.prettyPrintParseException) id $ Yaml.decodeEither' rawMessages +render :: (MonadRandom m, ToJSON params) => Message -> params -> m Text +render msg params = do + tpl <- resolve msg + pure . toStrict . renderMustache tpl $ toJSON params + +lookup :: [Text] -> Message +lookup path = fromMaybe notFound $ messages ^? ix path + where notFound + = Single + $ compileMustacheText "template" "Message not found" + ^?! _Right + message :: (MonadRandom m, ToJSON params) => [Text] -> params -> m Text -message path params = maybe notFound renderMessage $ messages ^? ix path +message path params = maybe notFound (`render` params) $ messages ^? ix path where - renderMessage msg = do - tpl <- resolve msg - pure . toStrict . renderMustache tpl $ toJSON params notFound = pure "Message not found" diff --git a/src/Xanthous/Monad.hs b/src/Xanthous/Monad.hs index 3e567ee8fa..c11cb0e2d4 100644 --- a/src/Xanthous/Monad.hs +++ b/src/Xanthous/Monad.hs @@ -1,22 +1,28 @@ +-------------------------------------------------------------------------------- module Xanthous.Monad ( AppT(..) , AppM , runAppT , continue , halt + -- * Messages , say , say_ + , message + , message_ ) where - -import Xanthous.Prelude -import Control.Monad.Random -import Control.Monad.State +-------------------------------------------------------------------------------- +import Xanthous.Prelude +import Control.Monad.Random +import Control.Monad.State import qualified Brick -import Brick (EventM, Next) -import Data.Aeson - -import Xanthous.Game.State -import Xanthous.Messages (message) +import Brick (EventM, Next) +import Data.Aeson +-------------------------------------------------------------------------------- +import Xanthous.Game.State +import Xanthous.Messages (Message) +import qualified Xanthous.Messages as Messages +-------------------------------------------------------------------------------- runAppT :: Monad m => AppT m a -> GameState -> m (a, GameState) runAppT appt initialState = flip runStateT initialState . unAppT $ appt @@ -27,12 +33,23 @@ halt = lift . Brick.halt =<< get continue :: AppT (EventM n) (Next GameState) continue = lift . Brick.continue =<< get +-------------------------------------------------------------------------------- say :: (MonadRandom m, ToJSON params, MonadState GameState m) => [Text] -> params -> m () say msgPath params = do - msg <- message msgPath params + msg <- Messages.message msgPath params messageHistory %= pushMessage msg say_ :: (MonadRandom m, MonadState GameState m) => [Text] -> m () say_ msgPath = say msgPath $ object [] + +message :: (MonadRandom m, ToJSON params, MonadState GameState m) + => Message -> params -> m () +message msg params = do + m <- Messages.render msg params + messageHistory %= pushMessage m + +message_ :: (MonadRandom m, MonadState GameState m) + => Message -> m () +message_ msg = message msg $ object [] diff --git a/src/Xanthous/Util.hs b/src/Xanthous/Util.hs index d90cf5b03d..3a7c10ace1 100644 --- a/src/Xanthous/Util.hs +++ b/src/Xanthous/Util.hs @@ -24,6 +24,7 @@ module Xanthous.Util , uniq -- ** Bag sequence algorithms , takeWhileInclusive + , smallestNotIn ) where import Xanthous.Prelude hiding (foldr) @@ -194,3 +195,12 @@ uniq = uniqOf folded takeWhileInclusive :: (a -> Bool) -> [a] -> [a] takeWhileInclusive _ [] = [] takeWhileInclusive p (x:xs) = x : if p x then takeWhileInclusive p xs else [] + +-- | Returns the smallest value not in a list +smallestNotIn :: (Ord a, Bounded a, Enum a) => [a] -> a +smallestNotIn xs = case uniq $ sort xs of + [] -> minBound + xs'@(x : _) + | x > minBound -> minBound + | otherwise + -> snd . headEx . filter (uncurry (/=)) $ zip (xs' ++ [minBound]) [minBound..] diff --git a/src/Xanthous/messages.yaml b/src/Xanthous/messages.yaml index 8f761ba6e7..1d8e066ed7 100644 --- a/src/Xanthous/messages.yaml +++ b/src/Xanthous/messages.yaml @@ -1,5 +1,9 @@ welcome: Welcome to Xanthous, {{characterName}}! It's dangerous out there, why not stay inside? -dead: You have died... Press Enter to continue. +dead: + - You have died... + - You die... + - You perish... + - You have perished... entities: description: You see here {{entityDescriptions}} @@ -18,10 +22,10 @@ character: namePrompt: "What's your name? " combat: - nothingToAttack: There's nothing to attack there + nothingToAttack: There's nothing to attack there. hit: - - You hit the {{creature.creatureType.name}} - - You attack the {{creature.creatureType.name}} + - You hit the {{creature.creatureType.name}}. + - You attack the {{creature.creatureType.name}}. creatureAttack: - The {{creature.creatureType.name}} hits you! - The {{creature.creatureType.name}} attacks you! @@ -31,3 +35,12 @@ combat: debug: toggleRevealAll: revealAll now set to {{revealAll}} + +eat: + noFood: + - You have nothing edible. + - You don't have any food. + - You don't have anything to eat. + - You search your pockets for something edible, and come up short. + menuPrompt: What would you like to eat? + eat: You eat the {{item.itemType.name}}. diff --git a/test/Spec.hs b/test/Spec.hs index 7af988a3d7..27e26862e2 100644 --- a/test/Spec.hs +++ b/test/Spec.hs @@ -6,6 +6,7 @@ import qualified Xanthous.GameSpec import qualified Xanthous.Generators.UtilSpec import qualified Xanthous.MessageSpec import qualified Xanthous.OrphansSpec +import qualified Xanthous.UtilSpec import qualified Xanthous.Util.GraphicsSpec import qualified Xanthous.Util.InflectionSpec @@ -21,6 +22,7 @@ test = testGroup "Xanthous" , Xanthous.MessageSpec.test , Xanthous.OrphansSpec.test , Xanthous.DataSpec.test + , Xanthous.UtilSpec.test , Xanthous.Util.GraphicsSpec.test , Xanthous.Util.InflectionSpec.test ] diff --git a/test/Xanthous/UtilSpec.hs b/test/Xanthous/UtilSpec.hs new file mode 100644 index 0000000000..1cfca1ffca --- /dev/null +++ b/test/Xanthous/UtilSpec.hs @@ -0,0 +1,24 @@ +module Xanthous.UtilSpec (main, test) where + +import Test.Prelude +import Xanthous.Util + +main :: IO () +main = defaultMain test + +test :: TestTree +test = testGroup "Xanthous.Util" + [ testGroup "smallestNotIn" + [ testCase "examples" $ do + smallestNotIn [7 :: Word, 3, 7] @?= 0 + smallestNotIn [7 :: Word, 0, 1, 3, 7] @?= 2 + , testProperty "returns an element not in the list" $ \(xs :: [Word]) -> + smallestNotIn xs `notElem` xs + , testProperty "pred return is in the list" $ \(xs :: [Word]) -> + let res = smallestNotIn xs + in res /= 0 ==> pred res `elem` xs + , testProperty "ignores order" $ \(xs :: [Word]) -> + forAll (shuffle xs) $ \shuffledXs -> + smallestNotIn xs === smallestNotIn shuffledXs + ] + ] diff --git a/xanthous.cabal b/xanthous.cabal index 022b644209..f25521c5bb 100644 --- a/xanthous.cabal +++ b/xanthous.cabal @@ -4,7 +4,7 @@ cabal-version: 1.12 -- -- see: https://github.com/sol/hpack -- --- hash: ad4acf50f6be0dc7ae6c68d9920b61c2d32b5d759aae7311a124d159b4a9bc7f +-- hash: ac15bf59fd57f7a0bc23f010aec83824f819592494145cbce3e1db36e23f1107 name: xanthous version: 0.1.0.0 @@ -103,6 +103,7 @@ library , reflection , stache , tomland + , vector , vty , yaml default-language: Haskell2010 @@ -183,6 +184,7 @@ executable xanthous , reflection , stache , tomland + , vector , vty , xanthous , yaml @@ -202,6 +204,7 @@ test-suite test Xanthous.OrphansSpec Xanthous.Util.GraphicsSpec Xanthous.Util.InflectionSpec + Xanthous.UtilSpec Paths_xanthous hs-source-dirs: test @@ -244,6 +247,7 @@ test-suite test , tasty-hunit , tasty-quickcheck , tomland + , vector , vty , xanthous , yaml -- cgit 1.4.1 From bf92a370a5ad215fff3e2f692da981c95175b2f3 Mon Sep 17 00:00:00 2001 From: Griffin Smith Date: Sun, 6 Oct 2019 12:53:15 -0400 Subject: Remove circleci config github-actions seems to be working quite well, so no more circle for now --- .circleci/config.yml | 37 ------------------------------------- 1 file changed, 37 deletions(-) delete mode 100644 .circleci/config.yml diff --git a/.circleci/config.yml b/.circleci/config.yml deleted file mode 100644 index ffde5e9854..0000000000 --- a/.circleci/config.yml +++ /dev/null @@ -1,37 +0,0 @@ -version: 2.1 -orbs: - rust: glotrade/rust@0.1.3 -jobs: - build: - executor: rust/default - steps: - - checkout - - rust/update_toolchain - - rust/build - test: - executor: rust/default - steps: - - checkout - - rust/update_toolchain - - rust/test - format: - executor: rust/default - steps: - - checkout - - rust/update_toolchain - - rust/format - # lint: - # executor: rust/default - # steps: - # - checkout - # - rust/update_toolchain - # - rust/clippy -workflows: - default: - jobs: - # - lint - - format - - build - - test: - requires: - - build -- cgit 1.4.1 From a57e36dca81274dea015c9fbdac680b44ef5576e Mon Sep 17 00:00:00 2001 From: Griffin Smith Date: Sun, 6 Oct 2019 12:59:53 -0400 Subject: Fix underflow when damaging character Fix underflow that could happen when multiple gormlaks attack the character in a single turn --- src/Xanthous/AI/Gormlak.hs | 5 +++-- src/Xanthous/Entities/Character.hs | 5 +++++ 2 files changed, 8 insertions(+), 2 deletions(-) diff --git a/src/Xanthous/AI/Gormlak.hs b/src/Xanthous/AI/Gormlak.hs index 68feb67ac2..db504c1e7d 100644 --- a/src/Xanthous/AI/Gormlak.hs +++ b/src/Xanthous/AI/Gormlak.hs @@ -14,7 +14,8 @@ import Xanthous.Data (Positioned(..), diffPositions, stepTowards, isUn import Xanthous.Data.EntityMap import qualified Xanthous.Entities.Creature as Creature import Xanthous.Entities.Creature (Creature) -import Xanthous.Entities.Character (Character, characterHitpoints) +import Xanthous.Entities.Character (Character) +import qualified Xanthous.Entities.Character as Character import qualified Xanthous.Entities.RawTypes as Raw import Xanthous.Entities (Entity(..), Brain(..), brainVia) import Xanthous.Game.State (entities, GameState, entityIs) @@ -54,7 +55,7 @@ stepGormlak pe@(Positioned pos creature) = do vision = Creature.visionRadius creature attackCharacter = do say ["combat", "creatureAttack"] $ object [ "creature" A..= creature ] - character . characterHitpoints -= 1 + character %= Character.damage 1 newtype GormlakBrain = GormlakBrain Creature diff --git a/src/Xanthous/Entities/Character.hs b/src/Xanthous/Entities/Character.hs index 0bb5867ee5..84e653e6a0 100644 --- a/src/Xanthous/Entities/Character.hs +++ b/src/Xanthous/Entities/Character.hs @@ -8,6 +8,7 @@ module Xanthous.Entities.Character , mkCharacter , pickUpItem , isDead + , damage ) where -------------------------------------------------------------------------------- import Xanthous.Prelude @@ -71,3 +72,7 @@ isDead = (== 0) . view characterHitpoints pickUpItem :: Item -> Character -> Character pickUpItem item = inventory %~ (item <|) +damage :: Word -> Character -> Character +damage amount = characterHitpoints %~ \case + n | n <= amount -> 0 + | otherwise -> n - amount -- cgit 1.4.1 From 6ab7cdfdc92dc337ec483f3a70ab38560b5aeb63 Mon Sep 17 00:00:00 2001 From: Griffin Smith Date: Sun, 6 Oct 2019 13:13:00 -0400 Subject: Only allow adjacent gormlaks to attack Previously the isUnit function was falsely returning `True` for positions that were one tile off in *either* direction from the character, when it should've been *both*. Oops. --- src/Xanthous/Data.hs | 3 ++- test/Xanthous/DataSpec.hs | 9 ++++++++- 2 files changed, 10 insertions(+), 2 deletions(-) diff --git a/src/Xanthous/Data.hs b/src/Xanthous/Data.hs index ff11a8da7f..b7df191e58 100644 --- a/src/Xanthous/Data.hs +++ b/src/Xanthous/Data.hs @@ -136,7 +136,8 @@ diffPositions (Position x₁ y₁) (Position x₂ y₂) = Position (x₁ - x₂) -- -- ∀ dir :: Direction. isUnit ('asPosition' dir) isUnit :: Position -> Bool -isUnit (Position px py) = abs px == 1 || abs py == 1 +isUnit (Position px py) = + abs px `elem` [0,1] && abs py `elem` [0, 1] && (px, py) /= (0, 0) -------------------------------------------------------------------------------- diff --git a/test/Xanthous/DataSpec.hs b/test/Xanthous/DataSpec.hs index 6b94e6a058..26a862baa6 100644 --- a/test/Xanthous/DataSpec.hs +++ b/test/Xanthous/DataSpec.hs @@ -26,7 +26,14 @@ test = testGroup "Xanthous.Data" directionOf pos (move dir pos) == dir , testProperty "diffPositions is add inverse" $ \pos₁ pos₂ -> diffPositions pos₁ pos₂ == addPositions pos₁ (invert pos₂) - + , testGroup "isUnit" + [ testProperty "double direction is never unit" $ \dir -> + not . isUnit $ move dir (asPosition dir) + , testCase "examples" $ do + isUnit (Position 1 1) @? "not . isUnit $ Position 1 1" + isUnit (Position 0 (-1)) @? "not . isUnit $ Position 0 (-1)" + (not . isUnit) (Position 1 13) @? "isUnit $ Position 1 13" + ] ] , testGroup "Direction" [ testProperty "opposite is involutive" $ \(dir :: Direction) -> -- cgit 1.4.1 From 2d72c0e41390016bdd22c90c3489d91ae2ac8a81 Mon Sep 17 00:00:00 2001 From: Griffin Smith Date: Sun, 6 Oct 2019 13:13:54 -0400 Subject: Export unexported lens --- src/Xanthous/Entities.hs | 1 + 1 file changed, 1 insertion(+) diff --git a/src/Xanthous/Entities.hs b/src/Xanthous/Entities.hs index af226b395d..93c4813cc4 100644 --- a/src/Xanthous/Entities.hs +++ b/src/Xanthous/Entities.hs @@ -21,6 +21,7 @@ module Xanthous.Entities , EntityChar(..) , HasChar(..) + , HasStyle(..) , Brain(..) , Brainless(..) -- cgit 1.4.1 From d2b81df6b882e702e321b55eba85a8bfab1f77c4 Mon Sep 17 00:00:00 2001 From: Griffin Smith Date: Sat, 12 Oct 2019 12:23:41 -0400 Subject: Actually heal the character when they eat food --- src/Xanthous/App.hs | 2 ++ 1 file changed, 2 insertions(+) diff --git a/src/Xanthous/App.hs b/src/Xanthous/App.hs index eb2f0cf7ad..ac0a213f08 100644 --- a/src/Xanthous/App.hs +++ b/src/Xanthous/App.hs @@ -175,6 +175,8 @@ handleCommand Eat = do in before <> fromMaybe Empty (tailMay after) let msg = fromMaybe (Messages.lookup ["eat", "eat"]) $ edibleItem ^. eatMessage + character . characterHitpoints += + edibleItem ^. hitpointsHealed . to fromIntegral message msg $ object ["item" A..= item] continue -- cgit 1.4.1 From f1197be1867385a98d545f37c21235dfe7985f18 Mon Sep 17 00:00:00 2001 From: Griffin Smith Date: Sat, 12 Oct 2019 12:59:42 -0400 Subject: Allow specifying seed on startup Allow specifying the seed for the game's global RNG on startup, and print the seed when the game exits. This'll allow us to more reliably reproduce bugs - yay! --- src/Main.hs | 64 ++++++++++++++++++++++++++++++++++----------- src/Xanthous/App.hs | 15 ++++++----- src/Xanthous/Game.hs | 1 + src/Xanthous/Game/Lenses.hs | 13 ++++++--- 4 files changed, 68 insertions(+), 25 deletions(-) diff --git a/src/Main.hs b/src/Main.hs index 547dc92f40..61640c3646 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -1,25 +1,50 @@ module Main ( main ) where -------------------------------------------------------------------------------- -import Xanthous.Prelude +import Xanthous.Prelude hiding (finally) import Brick import qualified Options.Applicative as Opt import System.Random +import Control.Monad.Random (getRandom) +import Control.Exception (finally) -------------------------------------------------------------------------------- -import Xanthous.Game (getInitialState) +import qualified Xanthous.Game as Game import Xanthous.App (makeApp) import Xanthous.Generators - ( GeneratorInput - , parseGeneratorInput - , generateFromInput - , showCells - ) + ( GeneratorInput + , parseGeneratorInput + , generateFromInput + , showCells + ) +import qualified Xanthous.Entities.Character as Character import Xanthous.Generators.Util (regions) import Xanthous.Generators.LevelContents import Xanthous.Data (Dimensions, Dimensions'(Dimensions)) import Data.Array.IArray ( amap ) -------------------------------------------------------------------------------- + +data RunParams = RunParams + { seed :: Maybe Int + , characterName :: Maybe Text + } + deriving stock (Show, Eq) + +parseRunParams :: Opt.Parser RunParams +parseRunParams = RunParams + <$> optional (Opt.option Opt.auto + ( Opt.long "seed" + <> Opt.help "Random seed for the game." + )) + <*> optional (Opt.strOption + ( Opt.short 'n' + <> Opt.long "name" + <> Opt.help + ( "Name for the character. If not set on the command line, " + <> "will be prompted for at runtime" + ) + )) + data Command - = Run + = Run RunParams | Generate GeneratorInput Dimensions parseDimensions :: Opt.Parser Dimensions @@ -34,10 +59,10 @@ parseDimensions = Dimensions ) parseCommand :: Opt.Parser Command -parseCommand = (<|> pure Run) $ Opt.subparser +parseCommand = (<|> Run <$> parseRunParams) $ Opt.subparser $ Opt.command "run" (Opt.info - (pure Run) + (Run <$> parseRunParams) (Opt.progDesc "Run the game")) <> Opt.command "generate" (Opt.info @@ -53,11 +78,20 @@ optParser = Opt.info (parseCommand <**> Opt.helper) (Opt.header "Xanthous: a WIP TUI RPG") -runGame :: IO () -runGame = do +runGame :: RunParams -> IO () +runGame rparams = do app <- makeApp - initialState <- getInitialState - _ <- defaultMain app initialState + gameSeed <- maybe getRandom pure $ seed rparams + let initialState = Game.initialStateFromSeed gameSeed &~ do + for_ (characterName rparams) $ \cn -> + Game.character . Character.characterName ?= cn + _game' <- defaultMain app initialState `finally` do + putStr "\n\n" + putStrLn "Thanks for playing Xanthous!" + when (isNothing $ seed rparams) + . putStrLn + $ "Seed: " <> tshow gameSeed + putStr "\n\n" pure () runGenerate :: GeneratorInput -> Dimensions -> IO () @@ -74,7 +108,7 @@ runGenerate input dims = do putStrLn $ showCells res runCommand :: Command -> IO () -runCommand Run = runGame +runCommand (Run runParams) = runGame runParams runCommand (Generate input dims) = runGenerate input dims main :: IO () diff --git a/src/Xanthous/App.hs b/src/Xanthous/App.hs index ac0a213f08..7ba4bc673a 100644 --- a/src/Xanthous/App.hs +++ b/src/Xanthous/App.hs @@ -64,10 +64,12 @@ startEvent :: AppM () startEvent = do initLevel modify updateCharacterVision - prompt_ @'StringPrompt ["character", "namePrompt"] Uncancellable - $ \(StringResult s) -> do - character . characterName ?= s - say ["welcome"] =<< use character + use (character . characterName) >>= \case + Nothing -> prompt_ @'StringPrompt ["character", "namePrompt"] Uncancellable + $ \(StringResult s) -> do + character . characterName ?= s + say ["welcome"] =<< use character + Just n -> say ["welcome"] $ object [ "characterName" A..= n ] initLevel :: AppM () initLevel = do @@ -178,6 +180,7 @@ handleCommand Eat = do character . characterHitpoints += edibleItem ^. hitpointsHealed . to fromIntegral message msg $ object ["item" A..= item] + stepGame continue handleCommand ToggleRevealAll = do @@ -201,11 +204,11 @@ handlePromptEvent _ pr (VtyEvent (EvKey KEnter [])) = handlePromptEvent msg - (Prompt c SStringPrompt (StringPromptState edit) pi cb) + (Prompt c SStringPrompt (StringPromptState edit) pri cb) (VtyEvent ev) = do edit' <- lift $ handleEditorEvent ev edit - let prompt' = Prompt c SStringPrompt (StringPromptState edit') pi cb + let prompt' = Prompt c SStringPrompt (StringPromptState edit') pri cb promptState .= WaitingPrompt msg prompt' continue diff --git a/src/Xanthous/Game.hs b/src/Xanthous/Game.hs index 0ab5425a04..bbcf19ede4 100644 --- a/src/Xanthous/Game.hs +++ b/src/Xanthous/Game.hs @@ -8,6 +8,7 @@ module Xanthous.Game , GamePromptState(..) , getInitialState + , initialStateFromSeed , positionedCharacter , character diff --git a/src/Xanthous/Game/Lenses.hs b/src/Xanthous/Game/Lenses.hs index 101de3021c..f49477a2db 100644 --- a/src/Xanthous/Game/Lenses.hs +++ b/src/Xanthous/Game/Lenses.hs @@ -6,6 +6,7 @@ module Xanthous.Game.Lenses , characterPosition , updateCharacterVision , getInitialState + , initialStateFromSeed -- * Collisions , Collision(..) @@ -16,6 +17,7 @@ import Xanthous.Prelude -------------------------------------------------------------------------------- import System.Random import Control.Monad.State +import Control.Monad.Random (getRandom) -------------------------------------------------------------------------------- import Xanthous.Game.State import Xanthous.Data @@ -28,9 +30,12 @@ import Xanthous.Entities.Creature (Creature) -------------------------------------------------------------------------------- getInitialState :: IO GameState -getInitialState = do - _randomGen <- getStdGen - let char = mkCharacter +getInitialState = initialStateFromSeed <$> getRandom + +initialStateFromSeed :: Int -> GameState +initialStateFromSeed seed = + let _randomGen = mkStdGen seed + char = mkCharacter (_characterEntityID, _entities) = EntityMap.insertAtReturningID (Position 0 0) @@ -42,7 +47,7 @@ getInitialState = do _debugState = DebugState { _allRevealed = False } - pure GameState {..} + in GameState {..} positionedCharacter :: Lens' GameState (Positioned Character) -- cgit 1.4.1 From 0837df2a727df17b24cb2e761df5d7dc43e673fc Mon Sep 17 00:00:00 2001 From: Griffin Smith Date: Sat, 12 Oct 2019 13:28:10 -0400 Subject: Step the game *before* updating vision Stepping the game after updating the vision could allow creatures like gormlaks to move *out* of the character's pre-calculated lines of sight, causing gormlaks right next to the character to be invisible. --- src/Xanthous/App.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Xanthous/App.hs b/src/Xanthous/App.hs index 7ba4bc673a..7c103ccfbc 100644 --- a/src/Xanthous/App.hs +++ b/src/Xanthous/App.hs @@ -119,9 +119,9 @@ handleCommand (Move dir) = do collisionAt newPos >>= \case Nothing -> do characterPosition .= newPos + stepGame describeEntitiesAt newPos modify updateCharacterVision - stepGame Just Combat -> attackAt newPos Just Stop -> pure () continue -- cgit 1.4.1 From 8d36fb4af2f938d96c8d6c22ccc575d0a98d0d38 Mon Sep 17 00:00:00 2001 From: Griffin Smith Date: Sat, 12 Oct 2019 15:17:22 -0400 Subject: Make the positionedCharacter test run more quickly Dial down the quickcheck size and num tests on this --- test/Xanthous/GameSpec.hs | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) diff --git a/test/Xanthous/GameSpec.hs b/test/Xanthous/GameSpec.hs index af98c7f6cc..9f30faca0c 100644 --- a/test/Xanthous/GameSpec.hs +++ b/test/Xanthous/GameSpec.hs @@ -11,7 +11,10 @@ main :: IO () main = defaultMain test test :: TestTree -test = testGroup "Xanthous.Game" +test + = localOption (QuickCheckTests 10) + . localOption (QuickCheckMaxSize 10) + $ testGroup "Xanthous.Game" [ testGroup "positionedCharacter" [ testProperty "lens laws" $ isLens positionedCharacter , testCase "updates the position of the character" $ do @@ -30,8 +33,7 @@ test = testGroup "Xanthous.Game" , testGroup "character" [ testProperty "lens laws" $ isLens character ] - , localOption (QuickCheckTests 10) - $ testGroup "MessageHistory" + , testGroup "MessageHistory" [ testGroup "MonoComonad laws" [ testProperty "oextend oextract ≡ id" $ \(mh :: MessageHistory) -> oextend oextract mh === mh -- cgit 1.4.1 From 8a4220df830adb6f1616ca02dd06902474fd25df Mon Sep 17 00:00:00 2001 From: Griffin Smith Date: Sun, 13 Oct 2019 12:37:08 -0400 Subject: Implement speed and ticks Gormlaks now move 1/8th the speed of the character, which means we can run away from them - yay! Unfortunately this also introduces a bug where they'll eventually get stuck and not do anything, so I'll be tackling that next. --- src/Xanthous/AI/Gormlak.hs | 72 +++++++++++------ src/Xanthous/App.hs | 25 ++++-- src/Xanthous/Data.hs | 137 ++++++++++++++++++++++++++------ src/Xanthous/Entities/Character.hs | 10 +++ src/Xanthous/Entities/Creature.hs | 69 ++++++++++++++-- src/Xanthous/Entities/RawTypes.hs | 19 +++-- src/Xanthous/Entities/Raws/gormlak.yaml | 2 +- src/Xanthous/Game/Draw.hs | 2 +- src/Xanthous/Game/State.hs | 15 ++-- src/Xanthous/Generators.hs | 2 +- test/Xanthous/DataSpec.hs | 8 +- 11 files changed, 277 insertions(+), 84 deletions(-) diff --git a/src/Xanthous/AI/Gormlak.hs b/src/Xanthous/AI/Gormlak.hs index db504c1e7d..e13eb8ffe7 100644 --- a/src/Xanthous/AI/Gormlak.hs +++ b/src/Xanthous/AI/Gormlak.hs @@ -10,10 +10,17 @@ import Control.Monad.Random import Data.Aeson (object) import qualified Data.Aeson as A -------------------------------------------------------------------------------- -import Xanthous.Data (Positioned(..), diffPositions, stepTowards, isUnit) +import Xanthous.Data + ( Positioned(..), positioned, position + , diffPositions, stepTowards, isUnit + , Ticks, (|*|), invertedRate + ) import Xanthous.Data.EntityMap import qualified Xanthous.Entities.Creature as Creature -import Xanthous.Entities.Creature (Creature) +import Xanthous.Entities.Creature + ( Creature, hippocampus, creatureType + , destination, destinationProgress, destinationPosition + ) import Xanthous.Entities.Character (Character) import qualified Xanthous.Entities.Character as Character import qualified Xanthous.Entities.RawTypes as Raw @@ -28,30 +35,47 @@ import Xanthous.Monad (say) stepGormlak :: (MonadState GameState m, MonadRandom m) - => Positioned Creature + => Ticks + -> Positioned Creature -> m (Positioned Creature) -stepGormlak pe@(Positioned pos creature) = do - newPos <- do - canSeeCharacter <- uses entities $ canSee (entityIs @Character) pos vision - if canSeeCharacter - then do - charPos <- use characterPosition - if isUnit (pos `diffPositions` charPos) - then attackCharacter $> pos - else pure $ pos `stepTowards` charPos +stepGormlak ticks pe@(Positioned pos creature) = do + dest <- maybe (selectDestination pos creature) pure + $ creature ^. hippocampus . destination + let progress' = + dest ^. destinationProgress + + creature ^. creatureType . Raw.speed . invertedRate |*| ticks + if progress' < 1 + then pure + $ pe + & positioned . hippocampus . destination + ?~ (dest & destinationProgress .~ progress') else do - lines <- uses entities $ linesOfSight pos (Creature.visionRadius creature) - line <- choose $ weightedBy length lines - pure $ fromMaybe pos $ fmap fst . headMay =<< tailMay =<< line - collisionAt newPos >>= \case - Nothing -> pure $ Positioned newPos creature - Just Stop -> pure pe - Just Combat -> do - ents <- use $ entities . atPosition newPos - when (any (entityIs @Character) ents) attackCharacter - pure pe - + let newPos = dest ^. destinationPosition + remainingSpeed = progress' - 1 + newDest <- selectDestination newPos creature + <&> destinationProgress +~ remainingSpeed + let pe' = pe & positioned . hippocampus . destination ?~ newDest + collisionAt newPos >>= \case + Nothing -> pure $ pe' & position .~ newPos + Just Stop -> pure pe' + Just Combat -> do + ents <- use $ entities . atPosition newPos + when (any (entityIs @Character) ents) attackCharacter + pure pe' where + selectDestination pos' creature' = Creature.destinationFromPos <$> do + canSeeCharacter <- uses entities $ canSee (entityIs @Character) pos' vision + if canSeeCharacter + then do + charPos <- use characterPosition + if isUnit (pos' `diffPositions` charPos) + then attackCharacter $> pos' + else pure $ pos' `stepTowards` charPos + else do + lines <- uses entities $ linesOfSight pos' (Creature.visionRadius creature') + line <- choose $ weightedBy length lines + pure $ fromMaybe pos' $ fmap fst . headMay =<< tailMay =<< line + vision = Creature.visionRadius creature attackCharacter = do say ["combat", "creatureAttack"] $ object [ "creature" A..= creature ] @@ -60,7 +84,7 @@ stepGormlak pe@(Positioned pos creature) = do newtype GormlakBrain = GormlakBrain Creature instance Brain GormlakBrain where - step = fmap coerce . stepGormlak . coerce + step ticks = fmap coerce . stepGormlak ticks . coerce -------------------------------------------------------------------------------- diff --git a/src/Xanthous/App.hs b/src/Xanthous/App.hs index 7c103ccfbc..d3f266a1e3 100644 --- a/src/Xanthous/App.hs +++ b/src/Xanthous/App.hs @@ -22,6 +22,9 @@ import Xanthous.Data , Dimensions'(Dimensions) , positioned , Position + , Ticks + , Position'(Position) + , (|*|) ) import Xanthous.Data.EntityMap (EntityMap) import qualified Xanthous.Data.EntityMap as EntityMap @@ -85,11 +88,11 @@ initLevel = do -------------------------------------------------------------------------------- -stepGame :: AppM () -stepGame = do +stepGameBy :: Ticks -> AppM () +stepGameBy ticks = do ents <- uses entities EntityMap.toEIDsAndPositioned for_ ents $ \(eid, pEntity) -> do - pEntity' <- step pEntity + pEntity' <- step ticks pEntity entities . ix eid .= pEntity' whenM (uses (character . characterHitpoints) (== 0)) @@ -97,6 +100,12 @@ stepGame = do . const . lift . liftIO $ exitSuccess +ticksPerTurn :: Ticks +ticksPerTurn = 100 + +stepGame :: AppM () +stepGame = stepGameBy ticksPerTurn + -------------------------------------------------------------------------------- handleEvent :: BrickEvent Name () -> AppM (Next GameState) @@ -119,7 +128,7 @@ handleCommand (Move dir) = do collisionAt newPos >>= \case Nothing -> do characterPosition .= newPos - stepGame + stepGameBy =<< uses (character . speed) (|*| 1) describeEntitiesAt newPos modify updateCharacterVision Just Combat -> attackAt newPos @@ -135,7 +144,7 @@ handleCommand PickUp = do character %= Character.pickUpItem item entities . at itemID .= Nothing say ["items", "pickUp"] $ object [ "item" A..= item ] - stepGame + stepGameBy 100 -- TODO _ -> undefined continue @@ -155,7 +164,7 @@ handleCommand Open = do entities . ix eid . positioned . _SomeEntity . open .= True say_ ["open", "success"] pure () - stepGame + stepGame -- TODO continue handleCommand Wait = stepGame >> continue @@ -180,7 +189,7 @@ handleCommand Eat = do character . characterHitpoints += edibleItem ^. hitpointsHealed . to fromIntegral message msg $ object ["item" A..= item] - stepGame + stepGame -- TODO continue handleCommand ToggleRevealAll = do @@ -318,4 +327,4 @@ attackAt pos = else do say ["combat", "hit"] msgParams entities . ix creatureID . positioned .= SomeEntity creature' - stepGame + stepGame -- TODO diff --git a/src/Xanthous/Data.hs b/src/Xanthous/Data.hs index b7df191e58..5699228436 100644 --- a/src/Xanthous/Data.hs +++ b/src/Xanthous/Data.hs @@ -1,16 +1,20 @@ -{-# LANGUAGE ViewPatterns #-} -{-# LANGUAGE RoleAnnotations #-} -{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE PartialTypeSignatures #-} +{-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE ViewPatterns #-} +{-# LANGUAGE RoleAnnotations #-} +{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE DeriveTraversable #-} -{-# LANGUAGE DeriveFoldable #-} -{-# LANGUAGE DeriveFunctor #-} -{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE DeriveFoldable #-} +{-# LANGUAGE DeriveFunctor #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE NoTypeSynonymInstances #-} -------------------------------------------------------------------------------- -- | Common data types for Xanthous -------------------------------------------------------------------------------- module Xanthous.Data ( -- * - Position(..) + Position'(..) + , Position , x , y @@ -26,6 +30,17 @@ module Xanthous.Data , stepTowards , isUnit + -- * + , Per(..) + , invertRate + , invertedRate + , (|*|) + , Ticks(..) + , Tiles(..) + , TicksPerTile + , TilesPerTick + , timesTiles + -- * , Dimensions'(..) , Dimensions @@ -51,33 +66,67 @@ import Test.QuickCheck (Arbitrary, CoArbitrary, Function) import Test.QuickCheck.Arbitrary.Generic import Data.Group import Brick (Location(Location), Edges(..)) +import Data.Monoid (Product(..), Sum(..)) +import Data.Aeson.Generic.DerivingVia +import Data.Aeson (ToJSON, FromJSON) -------------------------------------------------------------------------------- import Xanthous.Util (EqEqProp(..), EqProp) import Xanthous.Orphans () import Xanthous.Util.Graphics -------------------------------------------------------------------------------- -data Position where - Position :: { _x :: Int - , _y :: Int - } -> Position - deriving stock (Show, Eq, Generic, Ord) - deriving anyclass (Hashable, CoArbitrary, Function) - deriving EqProp via EqEqProp Position -makeLenses ''Position +-- fromScalar ∘ scalar ≡ id +class Scalar a where + scalar :: a -> Double + fromScalar :: Double -> a + +instance Scalar Double where + scalar = id + fromScalar = id + +newtype ScalarIntegral a = ScalarIntegral a + deriving newtype (Eq, Ord, Num, Enum, Real, Integral) +instance Integral a => Scalar (ScalarIntegral a) where + scalar = fromIntegral + fromScalar = floor + +deriving via (ScalarIntegral Integer) instance Scalar Integer +deriving via (ScalarIntegral Word) instance Scalar Word -instance Arbitrary Position where +-------------------------------------------------------------------------------- + +data Position' a where + Position :: { _x :: a + , _y :: a + } -> (Position' a) + deriving stock (Show, Eq, Generic, Ord, Functor, Foldable, Traversable) + deriving anyclass (NFData, Hashable, CoArbitrary, Function) + deriving EqProp via EqEqProp (Position' a) + deriving (ToJSON, FromJSON) + via WithOptions '[ FieldLabelModifier '[Drop 1] ] + (Position' a) +makeLenses ''Position' + +type Position = Position' Int + +instance Arbitrary a => Arbitrary (Position' a) where arbitrary = genericArbitrary shrink = genericShrink -instance Semigroup Position where +instance Num a => Semigroup (Position' a) where (Position x₁ y₁) <> (Position x₂ y₂) = Position (x₁ + x₂) (y₁ + y₂) -instance Monoid Position where +instance Num a => Monoid (Position' a) where mempty = Position 0 0 -instance Group Position where - invert (Position px py) = Position (-px) (-py) +instance Num a => Group (Position' a) where + invert (Position px py) = Position (negate px) (negate py) + +-- | Positions convert to scalars by discarding their orientation and just +-- measuring the length from the origin +instance (Ord a, Num a, Scalar a) => Scalar (Position' a) where + scalar = fromIntegral . length . line (0, 0) . view _Position + fromScalar n = Position (fromScalar n) (fromScalar n) data Positioned a where Positioned :: Position -> a -> Positioned a @@ -110,32 +159,32 @@ loc = iso hither yon hither (Position px py) = Location (px, py) yon (Location (lx, ly)) = Position lx ly -_Position :: Iso' Position (Int, Int) +_Position :: Iso' (Position' a) (a, a) _Position = iso hither yon where hither (Position px py) = (px, py) yon (lx, ly) = Position lx ly -positionFromPair :: (Integral i, Integral j) => (i, j) -> Position +positionFromPair :: (Num a, Integral i, Integral j) => (i, j) -> Position' a positionFromPair (i, j) = Position (fromIntegral i) (fromIntegral j) -- | Add two positions -- -- Operation for the additive group on positions -addPositions :: Position -> Position -> Position +addPositions :: Num a => Position' a -> Position' a -> Position' a addPositions = (<>) -- | Subtract two positions. -- -- diffPositions pos₁ pos₂ = pos₁ `addPositions` (invert pos₂) -diffPositions :: Position -> Position -> Position +diffPositions :: Num a => Position' a -> Position' a -> Position' a diffPositions (Position x₁ y₁) (Position x₂ y₂) = Position (x₁ - x₂) (y₁ - y₂) -- | Is this position a unit position? or: When taken as a difference, does this -- position represent a step of one tile? -- -- ∀ dir :: Direction. isUnit ('asPosition' dir) -isUnit :: Position -> Bool +isUnit :: (Eq a, Num a) => Position' a -> Bool isUnit (Position px py) = abs px `elem` [0,1] && abs py `elem` [0, 1] && (px, py) /= (0, 0) @@ -291,3 +340,41 @@ neighborPositions :: Position -> Neighbors Position neighborPositions pos = (`move` pos) <$> neighborDirections -------------------------------------------------------------------------------- + +newtype Per a b = Rate Double + deriving stock (Show, Eq, Generic) + deriving anyclass (NFData, CoArbitrary, Function) + deriving (Num, Ord, Enum, Real, ToJSON, FromJSON) via Double + deriving (Semigroup, Monoid) via Product Double +instance Arbitrary (Per a b) where arbitrary = genericArbitrary + +invertRate :: a `Per` b -> b `Per` a +invertRate (Rate p) = Rate $ 1 / p + +invertedRate :: Iso (a `Per` b) (b' `Per` a') (b `Per` a) (a' `Per` b') +invertedRate = iso invertRate invertRate + +infixl 7 |*| +(|*|) :: (Scalar a, Scalar b) => a `Per` b -> b -> a +(|*|) (Rate rate) b = fromScalar $ rate * scalar b + +newtype Ticks = Ticks Word + deriving stock (Show, Eq, Generic) + deriving anyclass (NFData, CoArbitrary, Function) + deriving (Num, Ord, Bounded, Enum, Integral, Real, ToJSON, FromJSON) via Word + deriving (Semigroup, Monoid) via (Sum Word) + deriving Scalar via ScalarIntegral Ticks +instance Arbitrary Ticks where arbitrary = genericArbitrary + +newtype Tiles = Tiles Double + deriving stock (Show, Eq, Generic) + deriving anyclass (NFData, CoArbitrary, Function) + deriving (Num, Ord, Enum, Real, ToJSON, FromJSON, Scalar) via Double + deriving (Semigroup, Monoid) via (Sum Double) +instance Arbitrary Tiles where arbitrary = genericArbitrary + +type TicksPerTile = Ticks `Per` Tiles +type TilesPerTick = Tiles `Per` Ticks + +timesTiles :: TicksPerTile -> Tiles -> Ticks +timesTiles = (|*|) diff --git a/src/Xanthous/Entities/Character.hs b/src/Xanthous/Entities/Character.hs index 84e653e6a0..7d2d22c998 100644 --- a/src/Xanthous/Entities/Character.hs +++ b/src/Xanthous/Entities/Character.hs @@ -5,6 +5,9 @@ module Xanthous.Entities.Character , inventory , characterDamage , characterHitpoints + , speed + + -- * , mkCharacter , pickUpItem , isDead @@ -12,6 +15,7 @@ module Xanthous.Entities.Character ) where -------------------------------------------------------------------------------- import Xanthous.Prelude +-------------------------------------------------------------------------------- import Test.QuickCheck import Test.QuickCheck.Instances.Vector () import Test.QuickCheck.Arbitrary.Generic @@ -21,6 +25,7 @@ import Data.Aeson (ToJSON, FromJSON) -------------------------------------------------------------------------------- import Xanthous.Entities import Xanthous.Entities.Item +import Xanthous.Data (TicksPerTile) -------------------------------------------------------------------------------- data Character = Character @@ -28,6 +33,7 @@ data Character = Character , _characterName :: !(Maybe Text) , _characterDamage :: !Word , _characterHitpoints :: !Word + , _speed :: TicksPerTile } deriving stock (Show, Eq, Generic) deriving anyclass (CoArbitrary, Function) @@ -58,12 +64,16 @@ instance Arbitrary Character where initialHitpoints :: Word initialHitpoints = 10 +defaultSpeed :: TicksPerTile +defaultSpeed = 100 + mkCharacter :: Character mkCharacter = Character { _inventory = mempty , _characterName = Nothing , _characterDamage = 1 , _characterHitpoints = initialHitpoints + , _speed = defaultSpeed } isDead :: Character -> Bool diff --git a/src/Xanthous/Entities/Creature.hs b/src/Xanthous/Entities/Creature.hs index f2c789d6a6..6ea6f93e42 100644 --- a/src/Xanthous/Entities/Creature.hs +++ b/src/Xanthous/Entities/Creature.hs @@ -2,44 +2,101 @@ {-# LANGUAGE TemplateHaskell #-} -------------------------------------------------------------------------------- module Xanthous.Entities.Creature - ( Creature(..) + ( -- * Creature + Creature(..) + -- ** Lenses , creatureType , hitpoints + , hippocampus + + -- ** Creature functions , newWithType , damage , isDead , visionRadius + + -- * Hippocampus + , Hippocampus(..) + -- ** Lenses + , destination + -- ** Destination + , Destination(..) + , destinationFromPos + -- *** Lenses + , destinationPosition + , destinationProgress ) where -------------------------------------------------------------------------------- import Xanthous.Prelude -------------------------------------------------------------------------------- +import Test.QuickCheck import Test.QuickCheck.Arbitrary.Generic import Data.Aeson.Generic.DerivingVia import Data.Aeson (ToJSON, FromJSON) -------------------------------------------------------------------------------- import Xanthous.Entities.RawTypes hiding (Creature, description) import Xanthous.Entities (Draw(..), DrawRawChar(..)) +import Xanthous.Data +-------------------------------------------------------------------------------- + +data Destination = Destination + { _destinationPosition :: !Position + -- | The progress towards the destination, tracked as an offset from the + -- creature's original position. + -- + -- When this value reaches >= 1, the creature has reached their destination + , _destinationProgress :: !Tiles + } + deriving stock (Eq, Show, Generic) + deriving anyclass (NFData, CoArbitrary, Function) + deriving (ToJSON, FromJSON) + via WithOptions '[ FieldLabelModifier '[Drop 1] ] + Destination +instance Arbitrary Destination where arbitrary = genericArbitrary +makeLenses ''Destination + +destinationFromPos :: Position -> Destination +destinationFromPos _destinationPosition = + let _destinationProgress = 0 + in Destination{..} + +data Hippocampus = Hippocampus + { _destination :: !(Maybe Destination) + } + deriving stock (Eq, Show, Generic) + deriving anyclass (NFData, CoArbitrary, Function) + deriving (ToJSON, FromJSON) + via WithOptions '[ FieldLabelModifier '[Drop 1] ] + Hippocampus +instance Arbitrary Hippocampus where arbitrary = genericArbitrary +makeLenses ''Hippocampus + +initialHippocampus :: Hippocampus +initialHippocampus = Hippocampus Nothing + -------------------------------------------------------------------------------- data Creature = Creature - { _creatureType :: CreatureType - , _hitpoints :: Word + { _creatureType :: !CreatureType + , _hitpoints :: !Word + , _hippocampus :: !Hippocampus } deriving stock (Eq, Show, Generic) + deriving anyclass (NFData, CoArbitrary, Function) deriving Draw via DrawRawChar "_creatureType" Creature deriving (ToJSON, FromJSON) via WithOptions '[ FieldLabelModifier '[Drop 1] ] Creature +instance Arbitrary Creature where arbitrary = genericArbitrary makeLenses ''Creature -instance Arbitrary Creature where - arbitrary = genericArbitrary -------------------------------------------------------------------------------- newWithType :: CreatureType -> Creature newWithType _creatureType = let _hitpoints = _creatureType ^. maxHitpoints + _hippocampus = initialHippocampus in Creature {..} damage :: Word -> Creature -> Creature @@ -53,3 +110,5 @@ isDead = views hitpoints (== 0) visionRadius :: Creature -> Word visionRadius = const 50 -- TODO + +{-# ANN module ("Hlint: ignore Use newtype instead of data" :: String) #-} diff --git a/src/Xanthous/Entities/RawTypes.hs b/src/Xanthous/Entities/RawTypes.hs index f1f5e05f7a..fd66140376 100644 --- a/src/Xanthous/Entities/RawTypes.hs +++ b/src/Xanthous/Entities/RawTypes.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE DuplicateRecordFields #-} -------------------------------------------------------------------------------- module Xanthous.Entities.RawTypes @@ -8,6 +8,7 @@ module Xanthous.Entities.RawTypes , isEdible , EntityRaw(..) + , _Creature -- * Lens classes , HasName(..) , HasDescription(..) @@ -17,7 +18,7 @@ module Xanthous.Entities.RawTypes , HasEatMessage(..) , HasHitpointsHealed(..) , HasEdible(..) - , _Creature + , HasSpeed(..) ) where -------------------------------------------------------------------------------- import Xanthous.Prelude @@ -28,16 +29,18 @@ import Data.Aeson (ToJSON, FromJSON) -------------------------------------------------------------------------------- import Xanthous.Entities (EntityChar, HasChar(..)) import Xanthous.Messages (Message(..)) +import Xanthous.Data (TicksPerTile) -------------------------------------------------------------------------------- data CreatureType = CreatureType - { _name :: Text - , _description :: Text - , _char :: EntityChar - , _maxHitpoints :: Word - , _friendly :: Bool + { _name :: !Text + , _description :: !Text + , _char :: !EntityChar + , _maxHitpoints :: !Word + , _friendly :: !Bool + , _speed :: !TicksPerTile } deriving stock (Show, Eq, Generic) - deriving anyclass (NFData) + deriving anyclass (NFData, CoArbitrary, Function) deriving (ToJSON, FromJSON) via WithOptions '[ FieldLabelModifier '[Drop 1] ] CreatureType diff --git a/src/Xanthous/Entities/Raws/gormlak.yaml b/src/Xanthous/Entities/Raws/gormlak.yaml index 2441e7e782..9a9281c9a9 100644 --- a/src/Xanthous/Entities/Raws/gormlak.yaml +++ b/src/Xanthous/Entities/Raws/gormlak.yaml @@ -8,5 +8,5 @@ Creature: style: foreground: red maxHitpoints: 5 - speed: 120 + speed: 125 friendly: false diff --git a/src/Xanthous/Game/Draw.hs b/src/Xanthous/Game/Draw.hs index 9f247d3833..24c177513e 100644 --- a/src/Xanthous/Game/Draw.hs +++ b/src/Xanthous/Game/Draw.hs @@ -9,7 +9,7 @@ import Brick.Widgets.Border import Brick.Widgets.Border.Style import Brick.Widgets.Edit -------------------------------------------------------------------------------- -import Xanthous.Data (Position(Position), x, y, loc) +import Xanthous.Data (Position'(..), type Position, x, y, loc) import Xanthous.Data.EntityMap (EntityMap, atPosition) import qualified Xanthous.Data.EntityMap as EntityMap import Xanthous.Entities diff --git a/src/Xanthous/Game/State.hs b/src/Xanthous/Game/State.hs index 302d20e1ef..c437f640c0 100644 --- a/src/Xanthous/Game/State.hs +++ b/src/Xanthous/Game/State.hs @@ -57,7 +57,8 @@ import Control.Monad.Random.Class import Brick (EventM, Widget) -------------------------------------------------------------------------------- import Xanthous.Data.EntityMap (EntityMap, EntityID) -import Xanthous.Data (Positioned(..), Position(..), Neighbors) +import Xanthous.Data + (Positioned(..), type Position, Neighbors, Ticks(..)) import Xanthous.Orphans () import Xanthous.Game.Prompt import Xanthous.Resource @@ -149,12 +150,12 @@ instance Draw a => Draw (Positioned a) where -------------------------------------------------------------------------------- class Brain a where - step :: Positioned a -> AppM (Positioned a) + step :: Ticks -> Positioned a -> AppM (Positioned a) newtype Brainless a = Brainless a instance Brain (Brainless a) where - step = pure + step = const pure -- | Workaround for the inability to use DerivingVia on Brain due to the lack of -- higher-order roles (specifically AppT not having its last type argument have @@ -162,8 +163,8 @@ instance Brain (Brainless a) where brainVia :: forall brain entity. (Coercible entity brain, Brain brain) => (entity -> brain) -- ^ constructor, ignored - -> (Positioned entity -> AppM (Positioned entity)) -brainVia _ = fmap coerce . step . coerce @_ @(Positioned brain) + -> (Ticks -> Positioned entity -> AppM (Positioned entity)) +brainVia _ ticks = fmap coerce . step ticks . coerce @_ @(Positioned brain) -------------------------------------------------------------------------------- @@ -186,8 +187,8 @@ instance Draw SomeEntity where drawWithNeighbors ns (SomeEntity ent) = drawWithNeighbors ns ent instance Brain SomeEntity where - step (Positioned pos (SomeEntity ent)) = - fmap SomeEntity <$> step (Positioned pos ent) + step ticks (Positioned pos (SomeEntity ent)) = + fmap SomeEntity <$> step ticks (Positioned pos ent) instance Entity SomeEntity where blocksVision (SomeEntity ent) = blocksVision ent diff --git a/src/Xanthous/Generators.hs b/src/Xanthous/Generators.hs index 7bcf4da051..6b1a57299e 100644 --- a/src/Xanthous/Generators.hs +++ b/src/Xanthous/Generators.hs @@ -26,7 +26,7 @@ import Control.Monad.Random import qualified Xanthous.Generators.CaveAutomata as CaveAutomata import Xanthous.Generators.Util import Xanthous.Generators.LevelContents -import Xanthous.Data (Dimensions, Position(Position)) +import Xanthous.Data (Dimensions, Position'(Position), Position) import Xanthous.Data.EntityMap (EntityMap) import qualified Xanthous.Data.EntityMap as EntityMap import Xanthous.Entities.Environment diff --git a/test/Xanthous/DataSpec.hs b/test/Xanthous/DataSpec.hs index 26a862baa6..6fad88681a 100644 --- a/test/Xanthous/DataSpec.hs +++ b/test/Xanthous/DataSpec.hs @@ -24,15 +24,15 @@ test = testGroup "Xanthous.Data" ] , testProperty "directionOf laws" $ \pos dir -> directionOf pos (move dir pos) == dir - , testProperty "diffPositions is add inverse" $ \pos₁ pos₂ -> + , testProperty "diffPositions is add inverse" $ \(pos₁ :: Position) pos₂ -> diffPositions pos₁ pos₂ == addPositions pos₁ (invert pos₂) , testGroup "isUnit" [ testProperty "double direction is never unit" $ \dir -> not . isUnit $ move dir (asPosition dir) , testCase "examples" $ do - isUnit (Position 1 1) @? "not . isUnit $ Position 1 1" - isUnit (Position 0 (-1)) @? "not . isUnit $ Position 0 (-1)" - (not . isUnit) (Position 1 13) @? "isUnit $ Position 1 13" + isUnit (Position @Int 1 1) @? "not . isUnit $ Position 1 1" + isUnit (Position @Int 0 (-1)) @? "not . isUnit $ Position 0 (-1)" + (not . isUnit) (Position @Int 1 13) @? "isUnit $ Position 1 13" ] ] , testGroup "Direction" -- cgit 1.4.1 From 4882350f5d7e54a6ae5c8760f2510273dae19c60 Mon Sep 17 00:00:00 2001 From: Griffin Smith Date: Tue, 15 Oct 2019 22:54:31 -0400 Subject: Don't walk gormlaks into walls Because of the way lines are drawn, a specific configuration of positioning for gormlaks would have them decide they desperately wanted to walk *inside* a wall, which they would then both fail to do but also always collide with whenever they tried to go anywhere else. --- src/Xanthous/AI/Gormlak.hs | 12 +++++++++--- src/Xanthous/Game/Lenses.hs | 27 ++++++++++++++++++--------- test/Xanthous/UtilSpec.hs | 4 ++++ 3 files changed, 31 insertions(+), 12 deletions(-) diff --git a/src/Xanthous/AI/Gormlak.hs b/src/Xanthous/AI/Gormlak.hs index e13eb8ffe7..268e33ad6c 100644 --- a/src/Xanthous/AI/Gormlak.hs +++ b/src/Xanthous/AI/Gormlak.hs @@ -27,7 +27,9 @@ import qualified Xanthous.Entities.RawTypes as Raw import Xanthous.Entities (Entity(..), Brain(..), brainVia) import Xanthous.Game.State (entities, GameState, entityIs) import Xanthous.Game.Lenses - ( Collision(..), collisionAt, character, characterPosition ) + ( Collision(..), entityCollision, collisionAt + , character, characterPosition + ) import Xanthous.Data.EntityMap.Graphics (linesOfSight, canSee) import Xanthous.Random import Xanthous.Monad (say) @@ -72,9 +74,13 @@ stepGormlak ticks pe@(Positioned pos creature) = do then attackCharacter $> pos' else pure $ pos' `stepTowards` charPos else do - lines <- uses entities $ linesOfSight pos' (Creature.visionRadius creature') + lines <- map (takeWhile (isNothing . entityCollision . map snd . snd) + -- the first item on these lines is always the creature itself + . fromMaybe mempty . tailMay) + . linesOfSight pos' (Creature.visionRadius creature') + <$> use entities line <- choose $ weightedBy length lines - pure $ fromMaybe pos' $ fmap fst . headMay =<< tailMay =<< line + pure $ fromMaybe pos' $ fmap fst . headMay =<< line vision = Creature.visionRadius creature attackCharacter = do diff --git a/src/Xanthous/Game/Lenses.hs b/src/Xanthous/Game/Lenses.hs index f49477a2db..77314a9aea 100644 --- a/src/Xanthous/Game/Lenses.hs +++ b/src/Xanthous/Game/Lenses.hs @@ -10,6 +10,7 @@ module Xanthous.Game.Lenses -- * Collisions , Collision(..) + , entityCollision , collisionAt ) where -------------------------------------------------------------------------------- @@ -93,13 +94,21 @@ data Collision deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData) +entityCollision + :: ( MonoFoldable (f SomeEntity) + , Foldable f + , Element (f SomeEntity) ~ SomeEntity + , AsEmpty (f SomeEntity) + ) + => f SomeEntity + -> Maybe Collision +entityCollision Empty = Nothing +entityCollision ents + | any (entityIs @Creature) ents = pure Combat + | all (entityIs @Item) ents = Nothing + | doors@(_ : _) <- ents ^.. folded . _SomeEntity @Door + , all (view open) doors = Nothing + | otherwise = pure Stop + collisionAt :: MonadState GameState m => Position -> m (Maybe Collision) -collisionAt pos = do - ents <- use $ entities . EntityMap.atPosition pos - pure $ - if | null ents -> Nothing - | any (entityIs @Creature) ents -> pure Combat - | all (entityIs @Item) ents -> Nothing - | doors@(_ : _) <- ents ^.. folded . _SomeEntity @Door - , all (view open) doors -> Nothing - | otherwise -> pure Stop +collisionAt pos = uses (entities . EntityMap.atPosition pos) entityCollision diff --git a/test/Xanthous/UtilSpec.hs b/test/Xanthous/UtilSpec.hs index 1cfca1ffca..8538ea5098 100644 --- a/test/Xanthous/UtilSpec.hs +++ b/test/Xanthous/UtilSpec.hs @@ -21,4 +21,8 @@ test = testGroup "Xanthous.Util" forAll (shuffle xs) $ \shuffledXs -> smallestNotIn xs === smallestNotIn shuffledXs ] + , testGroup "takeWhileInclusive" + [ testProperty "takeWhileInclusive (const True) ≡ id" + $ \(xs :: [Int]) -> takeWhileInclusive (const True) xs === xs + ] ] -- cgit 1.4.1 From 87fedcb6c9bc251a5a23a632ccf985b674b84bc7 Mon Sep 17 00:00:00 2001 From: Griffin Smith Date: Wed, 16 Oct 2019 12:10:59 -0400 Subject: Add draw priority Rather than blindly taking one entity from the list when we have multiple entities on the same tile, add a `drawPriority` method to the Draw typeclass which allows individual entities to request to be drawn on top - this avoids the "noodles floating over your head" bug we saw before. --- src/Xanthous/Entities.hs | 16 ++++++++++++++++ src/Xanthous/Entities/Character.hs | 1 + src/Xanthous/Entities/Creature.hs | 4 ++-- src/Xanthous/Game/Draw.hs | 9 ++++++--- src/Xanthous/Game/State.hs | 6 +++++- 5 files changed, 30 insertions(+), 6 deletions(-) diff --git a/src/Xanthous/Entities.hs b/src/Xanthous/Entities.hs index 93c4813cc4..ccd3ae42bf 100644 --- a/src/Xanthous/Entities.hs +++ b/src/Xanthous/Entities.hs @@ -10,6 +10,7 @@ module Xanthous.Entities , DrawCharacter(..) , DrawStyledCharacter(..) , DrawRawChar(..) + , DrawRawCharPriority(..) , Entity(..) , SomeEntity(..) , downcastEntity @@ -97,6 +98,21 @@ instance ) => Draw (DrawRawChar rawField a) where draw (DrawRawChar e) = draw $ e ^. field @rawField . char +newtype DrawRawCharPriority + (rawField :: Symbol) + (priority :: Nat) + (a :: Type) + = DrawRawCharPriority a + +instance + forall rawField priority a raw. + ( HasField rawField a a raw raw + , KnownNat priority + , HasChar raw EntityChar + ) => Draw (DrawRawCharPriority rawField priority a) where + draw (DrawRawCharPriority e) = draw $ e ^. field @rawField . char + drawPriority = const . fromIntegral $ natVal @priority Proxy + -------------------------------------------------------------------------------- data EntityChar = EntityChar diff --git a/src/Xanthous/Entities/Character.hs b/src/Xanthous/Entities/Character.hs index 7d2d22c998..e3cbb2c038 100644 --- a/src/Xanthous/Entities/Character.hs +++ b/src/Xanthous/Entities/Character.hs @@ -50,6 +50,7 @@ instance Draw Character where where rloc = Location (negate scrollOffset, negate scrollOffset) rreg = (2 * scrollOffset, 2 * scrollOffset) + drawPriority = const maxBound -- Character should always be on top, for now -- the character does not (yet) have a mind of its own instance Brain Character where step = brainVia Brainless diff --git a/src/Xanthous/Entities/Creature.hs b/src/Xanthous/Entities/Creature.hs index 6ea6f93e42..4ad751a582 100644 --- a/src/Xanthous/Entities/Creature.hs +++ b/src/Xanthous/Entities/Creature.hs @@ -35,7 +35,7 @@ import Data.Aeson.Generic.DerivingVia import Data.Aeson (ToJSON, FromJSON) -------------------------------------------------------------------------------- import Xanthous.Entities.RawTypes hiding (Creature, description) -import Xanthous.Entities (Draw(..), DrawRawChar(..)) +import Xanthous.Entities (Draw(..), DrawRawCharPriority(..)) import Xanthous.Data -------------------------------------------------------------------------------- @@ -83,7 +83,7 @@ data Creature = Creature } deriving stock (Eq, Show, Generic) deriving anyclass (NFData, CoArbitrary, Function) - deriving Draw via DrawRawChar "_creatureType" Creature + deriving Draw via DrawRawCharPriority "_creatureType" 1000 Creature deriving (ToJSON, FromJSON) via WithOptions '[ FieldLabelModifier '[Drop 1] ] Creature diff --git a/src/Xanthous/Game/Draw.hs b/src/Xanthous/Game/Draw.hs index 24c177513e..b7d7a76956 100644 --- a/src/Xanthous/Game/Draw.hs +++ b/src/Xanthous/Game/Draw.hs @@ -4,12 +4,12 @@ module Xanthous.Game.Draw ) where -------------------------------------------------------------------------------- import Xanthous.Prelude -import Brick hiding (loc) +import Brick hiding (loc, on) import Brick.Widgets.Border import Brick.Widgets.Border.Style import Brick.Widgets.Edit -------------------------------------------------------------------------------- -import Xanthous.Data (Position'(..), type Position, x, y, loc) +import Xanthous.Data import Xanthous.Data.EntityMap (EntityMap, atPosition) import qualified Xanthous.Data.EntityMap as EntityMap import Xanthous.Entities @@ -68,7 +68,10 @@ drawEntities canRenderPos allEnts | canRenderPos pos = let neighbors = EntityMap.neighbors pos allEnts in maybe (str " ") (drawWithNeighbors neighbors) - $ allEnts ^? atPosition pos . folded + $ maximumByOf + (atPosition pos . folded) + (compare `on` drawPriority) + allEnts | otherwise = str " " drawMap :: GameState -> Widget Name diff --git a/src/Xanthous/Game/State.hs b/src/Xanthous/Game/State.hs index c437f640c0..e3df5c60de 100644 --- a/src/Xanthous/Game/State.hs +++ b/src/Xanthous/Game/State.hs @@ -58,7 +58,6 @@ import Brick (EventM, Widget) -------------------------------------------------------------------------------- import Xanthous.Data.EntityMap (EntityMap, EntityID) import Xanthous.Data - (Positioned(..), type Position, Neighbors, Ticks(..)) import Xanthous.Orphans () import Xanthous.Game.Prompt import Xanthous.Resource @@ -143,6 +142,10 @@ class Draw a where draw :: a -> Widget n draw = drawWithNeighbors $ pure mempty + -- | higher priority gets drawn on top + drawPriority :: a -> Word + drawPriority = const minBound + instance Draw a => Draw (Positioned a) where drawWithNeighbors ns (Positioned _ a) = drawWithNeighbors ns a draw (Positioned _ a) = draw a @@ -185,6 +188,7 @@ instance Eq SomeEntity where instance Draw SomeEntity where drawWithNeighbors ns (SomeEntity ent) = drawWithNeighbors ns ent + drawPriority (SomeEntity ent) = drawPriority ent instance Brain SomeEntity where step ticks (Positioned pos (SomeEntity ent)) = -- cgit 1.4.1 From 7b90b02049f891f752fff7e0e228511077bbcb84 Mon Sep 17 00:00:00 2001 From: Griffin Smith Date: Fri, 15 Nov 2019 21:20:01 -0500 Subject: Recover character hitpoints over time Wrap hitpoints in a newtype, and recover character hitpoints over time --- src/Xanthous/App.hs | 4 ++-- src/Xanthous/Data.hs | 15 ++++++++++++++- src/Xanthous/Entities/Character.hs | 33 +++++++++++++++++++++++---------- src/Xanthous/Entities/Creature.hs | 4 ++-- src/Xanthous/Entities/RawTypes.hs | 4 ++-- src/Xanthous/Game/Draw.hs | 2 +- 6 files changed, 44 insertions(+), 18 deletions(-) diff --git a/src/Xanthous/App.hs b/src/Xanthous/App.hs index d3f266a1e3..2f27948cde 100644 --- a/src/Xanthous/App.hs +++ b/src/Xanthous/App.hs @@ -95,7 +95,7 @@ stepGameBy ticks = do pEntity' <- step ticks pEntity entities . ix eid .= pEntity' - whenM (uses (character . characterHitpoints) (== 0)) + whenM (uses character isDead) . prompt_ @'Continue ["dead"] Uncancellable . const . lift . liftIO $ exitSuccess @@ -186,7 +186,7 @@ handleCommand Eat = do in before <> fromMaybe Empty (tailMay after) let msg = fromMaybe (Messages.lookup ["eat", "eat"]) $ edibleItem ^. eatMessage - character . characterHitpoints += + character . characterHitpoints' += edibleItem ^. hitpointsHealed . to fromIntegral message msg $ object ["item" A..= item] stepGame -- TODO diff --git a/src/Xanthous/Data.hs b/src/Xanthous/Data.hs index 5699228436..b0d865fa5d 100644 --- a/src/Xanthous/Data.hs +++ b/src/Xanthous/Data.hs @@ -59,6 +59,9 @@ module Xanthous.Data , edges , neighborDirections , neighborPositions + + -- * + , Hitpoints(..) ) where -------------------------------------------------------------------------------- import Xanthous.Prelude hiding (Left, Down, Right) @@ -344,7 +347,7 @@ neighborPositions pos = (`move` pos) <$> neighborDirections newtype Per a b = Rate Double deriving stock (Show, Eq, Generic) deriving anyclass (NFData, CoArbitrary, Function) - deriving (Num, Ord, Enum, Real, ToJSON, FromJSON) via Double + deriving (Num, Ord, Enum, Real, Fractional, ToJSON, FromJSON) via Double deriving (Semigroup, Monoid) via Product Double instance Arbitrary (Per a b) where arbitrary = genericArbitrary @@ -378,3 +381,13 @@ type TilesPerTick = Tiles `Per` Ticks timesTiles :: TicksPerTile -> Tiles -> Ticks timesTiles = (|*|) + +-------------------------------------------------------------------------------- + +newtype Hitpoints = Hitpoints Word + deriving stock (Show, Eq, Generic) + deriving anyclass (NFData, CoArbitrary, Function) + deriving (Arbitrary, Num, Ord, Bounded, Enum, Integral, Real, ToJSON, FromJSON) + via Word + deriving (Semigroup, Monoid) via Sum Word + diff --git a/src/Xanthous/Entities/Character.hs b/src/Xanthous/Entities/Character.hs index e3cbb2c038..271492d6ce 100644 --- a/src/Xanthous/Entities/Character.hs +++ b/src/Xanthous/Entities/Character.hs @@ -1,10 +1,13 @@ +{-# LANGUAGE ViewPatterns #-} {-# LANGUAGE TemplateHaskell #-} module Xanthous.Entities.Character ( Character(..) , characterName , inventory , characterDamage + , characterHitpoints' , characterHitpoints + , hitpointRecoveryRate , speed -- * @@ -22,17 +25,18 @@ import Test.QuickCheck.Arbitrary.Generic import Brick import Data.Aeson.Generic.DerivingVia import Data.Aeson (ToJSON, FromJSON) +import Data.Coerce (coerce) -------------------------------------------------------------------------------- import Xanthous.Entities import Xanthous.Entities.Item -import Xanthous.Data (TicksPerTile) +import Xanthous.Data (TicksPerTile, Hitpoints, Per, Ticks, (|*|), positioned) -------------------------------------------------------------------------------- data Character = Character { _inventory :: !(Vector Item) , _characterName :: !(Maybe Text) - , _characterDamage :: !Word - , _characterHitpoints :: !Word + , _characterDamage :: !Hitpoints + , _characterHitpoints' :: !Double , _speed :: TicksPerTile } deriving stock (Show, Eq, Generic) @@ -42,6 +46,9 @@ data Character = Character Character makeLenses ''Character +characterHitpoints :: Character -> Hitpoints +characterHitpoints = views characterHitpoints' floor + scrollOffset :: Int scrollOffset = 5 @@ -52,8 +59,11 @@ instance Draw Character where rreg = (2 * scrollOffset, 2 * scrollOffset) drawPriority = const maxBound -- Character should always be on top, for now --- the character does not (yet) have a mind of its own -instance Brain Character where step = brainVia Brainless +instance Brain Character where + step ticks = (pure .) $ positioned . characterHitpoints' %~ \hp -> + if hp > fromIntegral initialHitpoints + then hp + else hp + hitpointRecoveryRate |*| ticks instance Entity Character where blocksVision _ = False @@ -62,9 +72,12 @@ instance Entity Character where instance Arbitrary Character where arbitrary = genericArbitrary -initialHitpoints :: Word +initialHitpoints :: Hitpoints initialHitpoints = 10 +hitpointRecoveryRate :: Double `Per` Ticks +hitpointRecoveryRate = 1.0 / (15 * coerce defaultSpeed) + defaultSpeed :: TicksPerTile defaultSpeed = 100 @@ -73,17 +86,17 @@ mkCharacter = Character { _inventory = mempty , _characterName = Nothing , _characterDamage = 1 - , _characterHitpoints = initialHitpoints + , _characterHitpoints' = fromIntegral initialHitpoints , _speed = defaultSpeed } isDead :: Character -> Bool -isDead = (== 0) . view characterHitpoints +isDead = (== 0) . characterHitpoints pickUpItem :: Item -> Character -> Character pickUpItem item = inventory %~ (item <|) -damage :: Word -> Character -> Character -damage amount = characterHitpoints %~ \case +damage :: Hitpoints -> Character -> Character +damage (fromIntegral -> amount) = characterHitpoints' %~ \case n | n <= amount -> 0 | otherwise -> n - amount diff --git a/src/Xanthous/Entities/Creature.hs b/src/Xanthous/Entities/Creature.hs index 4ad751a582..11cad1ce6b 100644 --- a/src/Xanthous/Entities/Creature.hs +++ b/src/Xanthous/Entities/Creature.hs @@ -78,7 +78,7 @@ initialHippocampus = Hippocampus Nothing data Creature = Creature { _creatureType :: !CreatureType - , _hitpoints :: !Word + , _hitpoints :: !Hitpoints , _hippocampus :: !Hippocampus } deriving stock (Eq, Show, Generic) @@ -99,7 +99,7 @@ newWithType _creatureType = _hippocampus = initialHippocampus in Creature {..} -damage :: Word -> Creature -> Creature +damage :: Hitpoints -> Creature -> Creature damage amount = hitpoints %~ \hp -> if hp <= amount then 0 diff --git a/src/Xanthous/Entities/RawTypes.hs b/src/Xanthous/Entities/RawTypes.hs index fd66140376..09b250fb31 100644 --- a/src/Xanthous/Entities/RawTypes.hs +++ b/src/Xanthous/Entities/RawTypes.hs @@ -29,13 +29,13 @@ import Data.Aeson (ToJSON, FromJSON) -------------------------------------------------------------------------------- import Xanthous.Entities (EntityChar, HasChar(..)) import Xanthous.Messages (Message(..)) -import Xanthous.Data (TicksPerTile) +import Xanthous.Data (TicksPerTile, Hitpoints) -------------------------------------------------------------------------------- data CreatureType = CreatureType { _name :: !Text , _description :: !Text , _char :: !EntityChar - , _maxHitpoints :: !Word + , _maxHitpoints :: !Hitpoints , _friendly :: !Bool , _speed :: !TicksPerTile } diff --git a/src/Xanthous/Game/Draw.hs b/src/Xanthous/Game/Draw.hs index b7d7a76956..ffbf30cca8 100644 --- a/src/Xanthous/Game/Draw.hs +++ b/src/Xanthous/Game/Draw.hs @@ -96,7 +96,7 @@ drawCharacterInfo ch = txt " " <+> charName <+> charHitpoints = emptyWidget charHitpoints = txt "Hitpoints: " - <+> txt (tshow $ ch ^. characterHitpoints) + <+> txt (tshow $ let Hitpoints hp = characterHitpoints ch in hp) drawGame :: GameState -> [Widget Name] drawGame game -- cgit 1.4.1 From 2f2e5a0b684f886a7585161d30e8cda962c7eefb Mon Sep 17 00:00:00 2001 From: Griffin Smith Date: Wed, 27 Nov 2019 13:20:46 -0500 Subject: Gitignore source before passing to nix Call hercules-ci's gitignoreSource on the src path before passing to nix, which both prevents spurious rebuilds and also makes compilation via `nix build` (which under the hood uses cabal v1-build) work while also doing development using `cabal new-build` --- pkg.nix | 18 +++++++++++++++--- 1 file changed, 15 insertions(+), 3 deletions(-) diff --git a/pkg.nix b/pkg.nix index d3b65a64f3..dcf508fa54 100644 --- a/pkg.nix +++ b/pkg.nix @@ -1,7 +1,19 @@ -{ nixpkgs ? import ./nixpkgs.nix {} }: -let inherit (nixpkgs) pkgs; in +{ nixpkgs ? import ./nixpkgs.nix {} +, +}: +let + inherit (builtins) filterSource elem not; + inherit (nixpkgs) pkgs; + gitignoreSource = (import (pkgs.fetchFromGitHub { + owner = "hercules-ci"; + repo = "gitignore"; + rev = "f9e996052b5af4032fe6150bba4a6fe4f7b9d698"; + sha256 = "0jrh5ghisaqdd0vldbywags20m2cxpkbbk5jjjmwaw0gr8nhsafv"; + # date = 2019-09-18T15:15:15+02:00; + }) { inherit (pkgs) lib; }).gitignoreSource; +in import (pkgs.haskellPackages.haskellSrc2nix { name = "xanthous"; - src = ./.; + src = gitignoreSource ./.; extraCabal2nixOptions = "--hpack"; }) -- cgit 1.4.1 From f37d0f75c0b4a77c8e35192c24c6fdb6f2bc4619 Mon Sep 17 00:00:00 2001 From: Griffin Smith Date: Fri, 29 Nov 2019 14:33:52 -0500 Subject: Implement saving+loading the game Implement ToJSON and FromJSON for all of the various pieces of the game state, and add a pair of functions saveGame/loadGame implementing a prism to save the game as zlib-compressed JSON. To test this, there's now Arbitrary, CoArbitrary, and Function instances for all the parts of the game state - to get around circular imports with the concrete entities this unfortunately is happening via orphan instances, plus an hs-boot file to break a circular import that was just a little too hard to remove by moving things around. Ugh. --- package.yaml | 2 + src/Main.hs | 19 +++++ src/Xanthous/AI/Gormlak.hs-boot | 7 ++ src/Xanthous/App.hs | 16 +++- src/Xanthous/Command.hs | 2 + src/Xanthous/Data.hs | 18 +++- src/Xanthous/Data/EntityMap.hs | 15 +++- src/Xanthous/Entities.hs | 14 +-- src/Xanthous/Entities/Arbitrary.hs | 25 ------ src/Xanthous/Entities/Character.hs | 2 +- src/Xanthous/Entities/Entities.hs | 54 ++++++++++++ src/Xanthous/Entities/Environment.hs | 13 ++- src/Xanthous/Entities/Item.hs | 4 +- src/Xanthous/Game.hs | 33 +++++++- src/Xanthous/Game/Arbitrary.hs | 9 +- src/Xanthous/Game/Lenses.hs | 1 + src/Xanthous/Game/Prompt.hs | 98 ++++++++++++++++++++- src/Xanthous/Game/State.hs | 79 +++++++++++++++-- src/Xanthous/Orphans.hs | 160 ++++++++++++++++++++++++++++++----- src/Xanthous/Resource.hs | 13 ++- src/Xanthous/Util/JSON.hs | 19 +++++ src/Xanthous/Util/QuickCheck.hs | 28 ++++++ src/Xanthous/messages.yaml | 4 + test/Spec.hs | 2 + test/Test/Prelude.hs | 1 + test/Xanthous/Data/EntityMapSpec.hs | 11 ++- test/Xanthous/EntitiesSpec.hs | 20 +++++ test/Xanthous/GameSpec.hs | 6 ++ test/Xanthous/OrphansSpec.hs | 25 ++++-- xanthous.cabal | 17 +++- 30 files changed, 620 insertions(+), 97 deletions(-) create mode 100644 src/Xanthous/AI/Gormlak.hs-boot delete mode 100644 src/Xanthous/Entities/Arbitrary.hs create mode 100644 src/Xanthous/Entities/Entities.hs create mode 100644 src/Xanthous/Util/JSON.hs create mode 100644 src/Xanthous/Util/QuickCheck.hs create mode 100644 test/Xanthous/EntitiesSpec.hs diff --git a/package.yaml b/package.yaml index 35f6b56526..a54d3075b7 100644 --- a/package.yaml +++ b/package.yaml @@ -48,9 +48,11 @@ dependencies: - reflection - stache - tomland +- text-zipper - vector - vty - yaml +- zlib default-extensions: - BlockArguments diff --git a/src/Main.hs b/src/Main.hs index 61640c3646..2e9d8c41ee 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -6,6 +6,7 @@ import qualified Options.Applicative as Opt import System.Random import Control.Monad.Random (getRandom) import Control.Exception (finally) +import System.Exit (die) -------------------------------------------------------------------------------- import qualified Xanthous.Game as Game import Xanthous.App (makeApp) @@ -45,6 +46,7 @@ parseRunParams = RunParams data Command = Run RunParams + | Load FilePath | Generate GeneratorInput Dimensions parseDimensions :: Opt.Parser Dimensions @@ -64,6 +66,10 @@ parseCommand = (<|> Run <$> parseRunParams) $ Opt.subparser (Opt.info (Run <$> parseRunParams) (Opt.progDesc "Run the game")) + <> Opt.command "load" + (Opt.info + (Load <$> Opt.argument Opt.str (Opt.metavar "FILE")) + (Opt.progDesc "Load a saved game")) <> Opt.command "generate" (Opt.info (Generate @@ -78,6 +84,9 @@ optParser = Opt.info (parseCommand <**> Opt.helper) (Opt.header "Xanthous: a WIP TUI RPG") +thanks :: IO () +thanks = putStr "\n\n" >> putStrLn "Thanks for playing Xanthous!" + runGame :: RunParams -> IO () runGame rparams = do app <- makeApp @@ -94,6 +103,15 @@ runGame rparams = do putStr "\n\n" pure () +loadGame :: FilePath -> IO () +loadGame saveFile = do + app <- makeApp + gameState <- maybe (die "Invalid save file!") pure + =<< Game.loadGame . fromStrict <$> readFile @IO saveFile + _game' <- gameState `deepseq` defaultMain app gameState `finally` thanks + pure () + + runGenerate :: GeneratorInput -> Dimensions -> IO () runGenerate input dims = do randGen <- getStdGen @@ -109,6 +127,7 @@ runGenerate input dims = do runCommand :: Command -> IO () runCommand (Run runParams) = runGame runParams +runCommand (Load saveFile) = loadGame saveFile runCommand (Generate input dims) = runGenerate input dims main :: IO () diff --git a/src/Xanthous/AI/Gormlak.hs-boot b/src/Xanthous/AI/Gormlak.hs-boot new file mode 100644 index 0000000000..391a8a807f --- /dev/null +++ b/src/Xanthous/AI/Gormlak.hs-boot @@ -0,0 +1,7 @@ +{-# OPTIONS_GHC -fno-warn-orphans #-} +module Xanthous.AI.Gormlak where + +import Xanthous.Entities +import Xanthous.Entities.Creature + +instance Entity Creature diff --git a/src/Xanthous/App.hs b/src/Xanthous/App.hs index 2f27948cde..71bf40c427 100644 --- a/src/Xanthous/App.hs +++ b/src/Xanthous/App.hs @@ -8,12 +8,13 @@ import qualified Brick import Brick.Widgets.Edit (handleEditorEvent) import Graphics.Vty.Attributes (defAttr) import Graphics.Vty.Input.Events (Event(EvKey), Key(..)) -import Control.Monad.State (get, MonadState) +import Control.Monad.State (get, gets, MonadState) import Control.Monad.Random (MonadRandom) import Control.Monad.State.Class (modify) import Data.Aeson (object, ToJSON) import qualified Data.Aeson as A import qualified Data.Vector as V +import qualified Data.Yaml as Yaml import System.Exit -------------------------------------------------------------------------------- import Xanthous.Command @@ -23,7 +24,6 @@ import Xanthous.Data , positioned , Position , Ticks - , Position'(Position) , (|*|) ) import Xanthous.Data.EntityMap (EntityMap) @@ -192,6 +192,18 @@ handleCommand Eat = do stepGame -- TODO continue +handleCommand Save = do + -- TODO default save locations / config file? + prompt_ @'StringPrompt ["save", "location"] Cancellable + $ \(StringResult filename) -> do + src <- gets saveGame + lift . liftIO $ do + writeFile (unpack filename) $ toStrict src + exitSuccess + + continue + + handleCommand ToggleRevealAll = do val <- debugState . allRevealed <%= not say ["debug", "toggleRevealAll"] $ object [ "revealAll" A..= val ] diff --git a/src/Xanthous/Command.hs b/src/Xanthous/Command.hs index f2f21160df..74808443d3 100644 --- a/src/Xanthous/Command.hs +++ b/src/Xanthous/Command.hs @@ -17,6 +17,7 @@ data Command | Open | Wait | Eat + | Save -- | TODO replace with `:` commands | ToggleRevealAll @@ -30,6 +31,7 @@ commandFromKey (KChar ',') [] = Just PickUp commandFromKey (KChar 'o') [] = Just Open commandFromKey (KChar 'e') [] = Just Eat commandFromKey (KChar 'r') [MMeta] = Just ToggleRevealAll +commandFromKey (KChar 'S') [] = Just Save commandFromKey _ _ = Nothing -------------------------------------------------------------------------------- diff --git a/src/Xanthous/Data.hs b/src/Xanthous/Data.hs index b0d865fa5d..fdeb71beb5 100644 --- a/src/Xanthous/Data.hs +++ b/src/Xanthous/Data.hs @@ -64,14 +64,15 @@ module Xanthous.Data , Hitpoints(..) ) where -------------------------------------------------------------------------------- -import Xanthous.Prelude hiding (Left, Down, Right) +import Xanthous.Prelude hiding (Left, Down, Right, (.=)) import Test.QuickCheck (Arbitrary, CoArbitrary, Function) import Test.QuickCheck.Arbitrary.Generic import Data.Group import Brick (Location(Location), Edges(..)) import Data.Monoid (Product(..), Sum(..)) import Data.Aeson.Generic.DerivingVia -import Data.Aeson (ToJSON, FromJSON) +import Data.Aeson + ( ToJSON(..), FromJSON(..), object, (.=), (.:), withObject) -------------------------------------------------------------------------------- import Xanthous.Util (EqEqProp(..), EqProp) import Xanthous.Orphans () @@ -116,6 +117,7 @@ instance Arbitrary a => Arbitrary (Position' a) where arbitrary = genericArbitrary shrink = genericShrink + instance Num a => Semigroup (Position' a) where (Position x₁ y₁) <> (Position x₂ y₂) = Position (x₁ + x₂) (y₁ + y₂) @@ -134,7 +136,7 @@ instance (Ord a, Num a, Scalar a) => Scalar (Position' a) where data Positioned a where Positioned :: Position -> a -> Positioned a deriving stock (Show, Eq, Ord, Functor, Foldable, Traversable, Generic) - deriving anyclass (CoArbitrary, Function) + deriving anyclass (NFData, CoArbitrary, Function) type role Positioned representational _Positioned :: Iso (Position, a) (Position, b) (Positioned a) (Positioned b) @@ -146,6 +148,16 @@ _Positioned = iso hither yon instance Arbitrary a => Arbitrary (Positioned a) where arbitrary = Positioned <$> arbitrary <*> arbitrary +instance ToJSON a => ToJSON (Positioned a) where + toJSON (Positioned pos val) = object + [ "position" .= pos + , "data" .= val + ] + +instance FromJSON a => FromJSON (Positioned a) where + parseJSON = withObject "Positioned" $ \obj -> + Positioned <$> obj .: "position" <*> obj .: "data" + position :: Lens' (Positioned a) Position position = lens (\(Positioned pos _) -> pos) diff --git a/src/Xanthous/Data/EntityMap.hs b/src/Xanthous/Data/EntityMap.hs index a068828a15..9ca9155535 100644 --- a/src/Xanthous/Data/EntityMap.hs +++ b/src/Xanthous/Data/EntityMap.hs @@ -42,9 +42,13 @@ import Xanthous.Orphans () import Xanthous.Util (EqEqProp(..)) -------------------------------------------------------------------------------- import Data.Monoid (Endo(..)) -import Test.QuickCheck (Arbitrary(..)) +import Test.QuickCheck (Arbitrary(..), CoArbitrary, Function) import Test.QuickCheck.Checkers (EqProp) +import Test.QuickCheck.Instances.UnorderedContainers () +import Test.QuickCheck.Instances.Vector () +import Data.Aeson -------------------------------------------------------------------------------- + type EntityID = Word32 type NonNullVector a = NonNull (Vector a) @@ -55,9 +59,16 @@ data EntityMap a where , _lastID :: EntityID } -> EntityMap a deriving stock (Functor, Foldable, Traversable, Generic) + deriving anyclass (NFData, CoArbitrary, Function) deriving via (EqEqProp (EntityMap a)) instance Eq a => EqProp (EntityMap a) makeLenses ''EntityMap +instance ToJSON a => ToJSON (EntityMap a) where + toJSON = toJSON . toEIDsAndPositioned + +instance FromJSON a => FromJSON (EntityMap a) where + parseJSON = fmap (fromEIDsAndPositioned @[_]) . parseJSON + byIDInvariantError :: forall a. a byIDInvariantError = error $ "Invariant violation: All EntityIDs in byPosition " <> "must point to entityIDs in byID" @@ -180,7 +191,7 @@ atPositionWithIDs pos em = in (id &&& Positioned pos . getEIDAssume em) <$> eids fromEIDsAndPositioned - :: (MonoFoldable mono, Element mono ~ (EntityID, Positioned a)) + :: forall mono a. (MonoFoldable mono, Element mono ~ (EntityID, Positioned a)) => mono -> EntityMap a fromEIDsAndPositioned eps = newLastID $ alaf Endo foldMap insert' eps mempty diff --git a/src/Xanthous/Entities.hs b/src/Xanthous/Entities.hs index ccd3ae42bf..7f4efb71d1 100644 --- a/src/Xanthous/Entities.hs +++ b/src/Xanthous/Entities.hs @@ -130,14 +130,7 @@ instance FromJSON EntityChar where parseJSON (String (chr :< Empty)) = pure $ EntityChar chr Vty.defAttr parseJSON (Object o) = do (EntityChar _char _) <- o .: "char" - _style <- o .:? "style" >>= \case - Just styleO -> do - let attrStyle = Vty.Default -- TODO - attrURL = Vty.Default - attrForeColor <- styleO .:? "foreground" .!= Vty.Default - attrBackColor <- styleO .:? "background" .!= Vty.Default - pure Vty.Attr {..} - Nothing -> pure Vty.defAttr + _style <- o .:? "style" .!= Vty.defAttr pure EntityChar {..} parseJSON _ = fail "Invalid type, expected string or object" @@ -146,10 +139,7 @@ instance ToJSON EntityChar where | styl == Vty.defAttr = String $ chr <| Empty | otherwise = object [ "char" .= chr - , "style" .= object - [ "foreground" .= Vty.attrForeColor styl - , "background" .= Vty.attrBackColor styl - ] + , "style" .= styl ] instance Draw EntityChar where diff --git a/src/Xanthous/Entities/Arbitrary.hs b/src/Xanthous/Entities/Arbitrary.hs deleted file mode 100644 index 8ba6447933..0000000000 --- a/src/Xanthous/Entities/Arbitrary.hs +++ /dev/null @@ -1,25 +0,0 @@ -{-# OPTIONS_GHC -fno-warn-orphans #-} --------------------------------------------------------------------------------- -module Xanthous.Entities.Arbitrary () where --------------------------------------------------------------------------------- -import Xanthous.Prelude --------------------------------------------------------------------------------- -import Test.QuickCheck -import qualified Test.QuickCheck.Gen as Gen --------------------------------------------------------------------------------- -import Xanthous.Entities (SomeEntity(..)) -import Xanthous.Entities.Character -import Xanthous.Entities.Item -import Xanthous.Entities.Creature -import Xanthous.Entities.Environment -import Xanthous.AI.Gormlak () --------------------------------------------------------------------------------- - -instance Arbitrary SomeEntity where - arbitrary = Gen.oneof - [ SomeEntity <$> arbitrary @Character - , SomeEntity <$> arbitrary @Item - , SomeEntity <$> arbitrary @Creature - , SomeEntity <$> arbitrary @Wall - , SomeEntity <$> arbitrary @Door - ] diff --git a/src/Xanthous/Entities/Character.hs b/src/Xanthous/Entities/Character.hs index 271492d6ce..cc04340f6e 100644 --- a/src/Xanthous/Entities/Character.hs +++ b/src/Xanthous/Entities/Character.hs @@ -40,7 +40,7 @@ data Character = Character , _speed :: TicksPerTile } deriving stock (Show, Eq, Generic) - deriving anyclass (CoArbitrary, Function) + deriving anyclass (NFData, CoArbitrary, Function) deriving (ToJSON, FromJSON) via WithOptions '[ FieldLabelModifier '[Drop 1] ] Character diff --git a/src/Xanthous/Entities/Entities.hs b/src/Xanthous/Entities/Entities.hs new file mode 100644 index 0000000000..410a6514ae --- /dev/null +++ b/src/Xanthous/Entities/Entities.hs @@ -0,0 +1,54 @@ +{-# LANGUAGE StandaloneDeriving #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} +-------------------------------------------------------------------------------- +module Xanthous.Entities.Entities () where +-------------------------------------------------------------------------------- +import Xanthous.Prelude +-------------------------------------------------------------------------------- +import Test.QuickCheck +import qualified Test.QuickCheck.Gen as Gen +import Data.Aeson +-------------------------------------------------------------------------------- +import Xanthous.Entities (Entity(..), SomeEntity(..)) +import Xanthous.Entities.Character +import Xanthous.Entities.Item +import Xanthous.Entities.Creature +import Xanthous.Entities.Environment +import Xanthous.Game.State +import {-# SOURCE #-} Xanthous.AI.Gormlak () +import Xanthous.Util.QuickCheck +import Data.Aeson.Generic.DerivingVia +-------------------------------------------------------------------------------- + +instance Arbitrary SomeEntity where + arbitrary = Gen.oneof + [ SomeEntity <$> arbitrary @Character + , SomeEntity <$> arbitrary @Item + , SomeEntity <$> arbitrary @Creature + , SomeEntity <$> arbitrary @Wall + , SomeEntity <$> arbitrary @Door + ] + +instance FromJSON SomeEntity where + parseJSON = withObject "Entity" $ \obj -> do + (entityType :: Text) <- obj .: "type" + case entityType of + "Character" -> SomeEntity @Character <$> obj .: "data" + "Item" -> SomeEntity @Item <$> obj .: "data" + "Creature" -> SomeEntity @Creature <$> obj .: "data" + "Wall" -> SomeEntity @Wall <$> obj .: "data" + "Door" -> SomeEntity @Door <$> obj .: "data" + _ -> fail . unpack $ "Invalid entity type \"" <> entityType <> "\"" + +deriving via WithOptions '[ FieldLabelModifier '[Drop 1] ] GameState + instance FromJSON GameState + +instance Entity SomeEntity where + blocksVision (SomeEntity ent) = blocksVision ent + description (SomeEntity ent) = description ent + +instance Function SomeEntity where + function = functionJSON + +instance CoArbitrary SomeEntity where + coarbitrary = coarbitrary . encode diff --git a/src/Xanthous/Entities/Environment.hs b/src/Xanthous/Entities/Environment.hs index e8190cd42a..8119199631 100644 --- a/src/Xanthous/Entities/Environment.hs +++ b/src/Xanthous/Entities/Environment.hs @@ -12,6 +12,7 @@ import Test.QuickCheck.Arbitrary.Generic import Brick (str) import Brick.Widgets.Border.Style (unicode) import Brick.Types (Edges(..)) +import Data.Aeson -------------------------------------------------------------------------------- import Xanthous.Entities ( Draw(..) @@ -28,7 +29,15 @@ import Xanthous.Data data Wall = Wall deriving stock (Show, Eq, Ord, Generic, Enum) - deriving anyclass (CoArbitrary, Function) + deriving anyclass (NFData, CoArbitrary, Function) + +instance ToJSON Wall where + toJSON = const $ String "Wall" + +instance FromJSON Wall where + parseJSON = withText "Wall" $ \case + "Wall" -> pure Wall + _ -> fail "Invalid Wall: expected Wall" -- deriving via Brainless Wall instance Brain Wall instance Brain Wall where step = brainVia Brainless @@ -53,7 +62,7 @@ data Door = Door , _locked :: Bool } deriving stock (Show, Eq, Ord, Generic) - deriving anyclass (NFData, CoArbitrary, Function) + deriving anyclass (NFData, CoArbitrary, Function, ToJSON, FromJSON) makeLenses ''Door instance Arbitrary Door where diff --git a/src/Xanthous/Entities/Item.hs b/src/Xanthous/Entities/Item.hs index ea6f16e05d..ddd387af8c 100644 --- a/src/Xanthous/Entities/Item.hs +++ b/src/Xanthous/Entities/Item.hs @@ -29,13 +29,15 @@ data Item = Item { _itemType :: ItemType } deriving stock (Eq, Show, Generic) - deriving anyclass (CoArbitrary, Function) + deriving anyclass (NFData, CoArbitrary, Function) deriving Draw via DrawRawChar "_itemType" Item deriving (ToJSON, FromJSON) via WithOptions '[ FieldLabelModifier '[Drop 1] ] Item makeLenses ''Item +{-# ANN Item ("HLint: ignore Use newtype instead of data" :: String )#-} + -- deriving via (Brainless Item) instance Brain Item instance Brain Item where step = brainVia Brainless diff --git a/src/Xanthous/Game.hs b/src/Xanthous/Game.hs index bbcf19ede4..14b8230218 100644 --- a/src/Xanthous/Game.hs +++ b/src/Xanthous/Game.hs @@ -31,12 +31,39 @@ module Xanthous.Game -- * App monad , AppT(..) + -- * Saving the game + , saveGame + , loadGame + , saved + -- * Debug State , DebugState(..) , debugState , allRevealed ) where -------------------------------------------------------------------------------- -import Xanthous.Game.State -import Xanthous.Game.Lenses -import Xanthous.Game.Arbitrary () +import qualified Codec.Compression.Zlib as Zlib +import Codec.Compression.Zlib.Internal (DecompressError) +import qualified Data.Aeson as JSON +import System.IO.Unsafe +-------------------------------------------------------------------------------- +import Xanthous.Prelude +import Xanthous.Game.State +import Xanthous.Game.Lenses +import Xanthous.Game.Arbitrary () +import Xanthous.Entities.Entities () +-------------------------------------------------------------------------------- + +saveGame :: GameState -> LByteString +saveGame = Zlib.compress . JSON.encode + +loadGame :: LByteString -> Maybe GameState +loadGame = JSON.decode <=< decompressZlibMay + where + decompressZlibMay bs + = unsafeDupablePerformIO + $ (let r = Zlib.decompress bs in r `seq` pure (Just r)) + `catch` \(_ :: DecompressError) -> pure Nothing + +saved :: Prism' LByteString GameState +saved = prism' saveGame loadGame diff --git a/src/Xanthous/Game/Arbitrary.hs b/src/Xanthous/Game/Arbitrary.hs index 5bba77d5a1..e8f9ae22c4 100644 --- a/src/Xanthous/Game/Arbitrary.hs +++ b/src/Xanthous/Game/Arbitrary.hs @@ -1,4 +1,6 @@ +{-# LANGUAGE UndecidableInstances #-} {-# OPTIONS_GHC -fno-warn-orphans #-} +{-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE RecordWildCards #-} -------------------------------------------------------------------------------- module Xanthous.Game.Arbitrary where @@ -9,7 +11,7 @@ import Test.QuickCheck import System.Random -------------------------------------------------------------------------------- import Xanthous.Game.State -import Xanthous.Entities.Arbitrary () +import Xanthous.Entities.Entities () import Xanthous.Entities.Character import qualified Xanthous.Data.EntityMap as EntityMap -------------------------------------------------------------------------------- @@ -26,3 +28,8 @@ instance Arbitrary GameState where let _promptState = NoPrompt -- TODO _debugState <- arbitrary pure $ GameState {..} + + +instance CoArbitrary GameState +instance Function GameState +deriving newtype instance CoArbitrary (m (a, GameState)) => CoArbitrary (AppT m a) diff --git a/src/Xanthous/Game/Lenses.hs b/src/Xanthous/Game/Lenses.hs index 77314a9aea..cd7148442a 100644 --- a/src/Xanthous/Game/Lenses.hs +++ b/src/Xanthous/Game/Lenses.hs @@ -28,6 +28,7 @@ import Xanthous.Entities.Character (Character, mkCharacter) import Xanthous.Entities.Environment (Door, open) import Xanthous.Entities.Item (Item) import Xanthous.Entities.Creature (Creature) +import Xanthous.Entities.Entities () -------------------------------------------------------------------------------- getInitialState :: IO GameState diff --git a/src/Xanthous/Game/Prompt.hs b/src/Xanthous/Game/Prompt.hs index 26a7b96eb1..1154d6db5a 100644 --- a/src/Xanthous/Game/Prompt.hs +++ b/src/Xanthous/Game/Prompt.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE GADTs #-} -------------------------------------------------------------------------------- @@ -50,11 +51,19 @@ instance Show PromptType where data SPromptType :: PromptType -> Type where SStringPrompt :: SPromptType 'StringPrompt SConfirm :: SPromptType 'Confirm - SMenu :: forall a. SPromptType ('Menu a) + SMenu :: SPromptType ('Menu a) SDirectionPrompt :: SPromptType 'DirectionPrompt SPointOnMap :: SPromptType 'PointOnMap SContinue :: SPromptType 'Continue +instance NFData (SPromptType pt) where + rnf SStringPrompt = () + rnf SConfirm = () + rnf SMenu = () + rnf SDirectionPrompt = () + rnf SPointOnMap = () + rnf SContinue = () + class SingPromptType pt where singPromptType :: SPromptType pt instance SingPromptType 'StringPrompt where singPromptType = SStringPrompt instance SingPromptType 'DirectionPrompt where singPromptType = SDirectionPrompt @@ -85,15 +94,67 @@ data PromptResult (pt :: PromptType) where PointOnMapResult :: Position -> PromptResult 'PointOnMap ContinueResult :: PromptResult 'Continue +instance Arbitrary (PromptResult 'StringPrompt) where + arbitrary = StringResult <$> arbitrary + +instance Arbitrary (PromptResult 'Confirm) where + arbitrary = ConfirmResult <$> arbitrary + +instance Arbitrary a => Arbitrary (PromptResult ('Menu a)) where + arbitrary = MenuResult <$> arbitrary + +instance Arbitrary (PromptResult 'DirectionPrompt) where + arbitrary = DirectionResult <$> arbitrary + +instance Arbitrary (PromptResult 'PointOnMap) where + arbitrary = PointOnMapResult <$> arbitrary + +instance Arbitrary (PromptResult 'Continue) where + arbitrary = pure ContinueResult + +-------------------------------------------------------------------------------- + data PromptState pt where StringPromptState :: Editor Text Name -> PromptState 'StringPrompt DirectionPromptState :: PromptState 'DirectionPrompt ContinuePromptState :: PromptState 'Continue MenuPromptState :: forall a. PromptState ('Menu a) +instance NFData (PromptState pt) where + rnf sps@(StringPromptState ed) = sps `deepseq` ed `deepseq` () + rnf DirectionPromptState = () + rnf ContinuePromptState = () + rnf MenuPromptState = () + +instance Arbitrary (PromptState 'StringPrompt) where + arbitrary = StringPromptState <$> arbitrary + +instance Arbitrary (PromptState 'DirectionPrompt) where + arbitrary = pure DirectionPromptState + +instance Arbitrary (PromptState 'Continue) where + arbitrary = pure ContinuePromptState + +instance Arbitrary (PromptState ('Menu a)) where + arbitrary = pure MenuPromptState + +instance CoArbitrary (PromptState 'StringPrompt) where + coarbitrary (StringPromptState ed) = coarbitrary ed + +instance CoArbitrary (PromptState 'DirectionPrompt) where + coarbitrary DirectionPromptState = coarbitrary () + +instance CoArbitrary (PromptState 'Continue) where + coarbitrary ContinuePromptState = coarbitrary () + +instance CoArbitrary (PromptState ('Menu a)) where + coarbitrary MenuPromptState = coarbitrary () + deriving stock instance Show (PromptState pt) data MenuOption a = MenuOption Text a + deriving stock (Eq, Generic) + deriving anyclass (NFData, CoArbitrary, Function) mkMenuItems :: (MonoFoldable f, Element f ~ (Char, MenuOption a)) => f @@ -134,6 +195,41 @@ instance Show (Prompt m) where SMenu -> show pri _ -> "()" +instance NFData (Prompt m) where + rnf (Prompt c SMenu ps pri cb) + = c + `deepseq` ps + `deepseq` pri + `seq` cb + `seq` () + rnf (Prompt c spt ps pri cb) + = c + `deepseq` spt + `deepseq` ps + `deepseq` pri + `seq` cb + `seq` () + +instance CoArbitrary (m ()) => CoArbitrary (Prompt m) where + coarbitrary (Prompt c SStringPrompt ps pri cb) = + variant @Int 1 . coarbitrary (c, ps, pri, cb) + coarbitrary (Prompt c SConfirm _ pri cb) = -- TODO fill in prompt state + variant @Int 2 . coarbitrary (c, pri, cb) + coarbitrary (Prompt c SMenu _ps _pri _cb) = + variant @Int 3 . coarbitrary c {-, ps, pri, cb -} + coarbitrary (Prompt c SDirectionPrompt ps pri cb) = + variant @Int 4 . coarbitrary (c, ps, pri, cb) + coarbitrary (Prompt c SPointOnMap _ pri cb) = -- TODO fill in prompt state + variant @Int 5 . coarbitrary (c, pri, cb) + coarbitrary (Prompt c SContinue ps pri cb) = + variant @Int 6 . coarbitrary (c, ps, pri, cb) + +-- instance Function (Prompt m) where +-- function = functionMap toTuple _fromTuple +-- where +-- toTuple (Prompt c pt ps pri cb) = (c, pt, ps, pri, cb) + + mkPrompt :: (PromptInput pt ~ ()) => PromptCancellable -> SPromptType pt -> (PromptResult pt -> m ()) -> Prompt m mkPrompt c pt@SStringPrompt cb = let ps = StringPromptState $ editorText Resource.Prompt (Just 1) "" diff --git a/src/Xanthous/Game/State.hs b/src/Xanthous/Game/State.hs index e3df5c60de..92c68a3f65 100644 --- a/src/Xanthous/Game/State.hs +++ b/src/Xanthous/Game/State.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE AllowAmbiguousTypes #-} @@ -55,6 +56,9 @@ import Control.Monad.State.Class import Control.Monad.State import Control.Monad.Random.Class import Brick (EventM, Widget) +import Data.Aeson (ToJSON(..), FromJSON(..), Value(Null)) +import qualified Data.Aeson as JSON +import Data.Aeson.Generic.DerivingVia -------------------------------------------------------------------------------- import Xanthous.Data.EntityMap (EntityMap, EntityID) import Xanthous.Data @@ -71,6 +75,9 @@ data MessageHistory } deriving stock (Show, Eq, Generic) deriving anyclass (NFData, CoArbitrary, Function) + deriving (ToJSON, FromJSON) + via WithOptions '[ FieldLabelModifier '[Drop 1] ] + MessageHistory makeFieldsNoPrefix ''MessageHistory instance Semigroup MessageHistory where @@ -118,7 +125,31 @@ previousMessage mh = mh & displayedTurn .~ maximumOf data GamePromptState m where NoPrompt :: GamePromptState m WaitingPrompt :: Text -> Prompt m -> GamePromptState m - deriving stock (Show) + deriving stock (Show, Generic) + deriving anyclass (NFData) + +-- | Non-injective! We never try to serialize waiting prompts, since: +-- +-- * they contain callback functions +-- * we can't save the game when in a prompt anyway +instance ToJSON (GamePromptState m) where + toJSON _ = Null + +-- | Always expects Null +instance FromJSON (GamePromptState m) where + parseJSON Null = pure NoPrompt + parseJSON _ = fail "Invalid GamePromptState; expected null" + +instance CoArbitrary (GamePromptState m) where + coarbitrary NoPrompt = variant @Int 1 + coarbitrary (WaitingPrompt txt _) = variant @Int 2 . coarbitrary txt + +instance Function (GamePromptState m) where + function = functionMap onlyNoPrompt (const NoPrompt) + where + onlyNoPrompt NoPrompt = () + onlyNoPrompt (WaitingPrompt _ _) = + error "Can't handle prompts in Function!" -------------------------------------------------------------------------------- @@ -171,7 +202,10 @@ brainVia _ ticks = fmap coerce . step ticks . coerce @_ @(Positioned brain) -------------------------------------------------------------------------------- -class (Show a, Eq a, Draw a, Brain a) => Entity a where +class ( Show a, Eq a, NFData a + , ToJSON a, FromJSON a + , Draw a, Brain a + ) => Entity a where blocksVision :: a -> Bool description :: a -> Text @@ -186,6 +220,19 @@ instance Eq SomeEntity where Just Refl -> a == b _ -> False +instance NFData SomeEntity where + rnf (SomeEntity ent) = ent `deepseq` () + +instance ToJSON SomeEntity where + toJSON (SomeEntity ent) = entityToJSON ent + where + entityToJSON :: forall entity. (Entity entity, Typeable entity) + => entity -> JSON.Value + entityToJSON entity = JSON.object + [ "type" JSON..= tshow (typeRep @_ @entity Proxy) + , "data" JSON..= toJSON entity + ] + instance Draw SomeEntity where drawWithNeighbors ns (SomeEntity ent) = drawWithNeighbors ns ent drawPriority (SomeEntity ent) = drawPriority ent @@ -194,10 +241,6 @@ instance Brain SomeEntity where step ticks (Positioned pos (SomeEntity ent)) = fmap SomeEntity <$> step ticks (Positioned pos ent) -instance Entity SomeEntity where - blocksVision (SomeEntity ent) = blocksVision ent - description (SomeEntity ent) = description ent - downcastEntity :: forall (a :: Type). (Typeable a) => SomeEntity -> Maybe a downcastEntity (SomeEntity e) = cast e @@ -214,6 +257,10 @@ data DebugState = DebugState } deriving stock (Show, Eq, Generic) deriving anyclass (NFData, CoArbitrary, Function) + deriving (ToJSON, FromJSON) + via WithOptions '[ FieldLabelModifier '[Drop 1] ] + DebugState +{-# ANN DebugState ("HLint: ignore Use newtype instead of data" :: String) #-} instance Arbitrary DebugState where arbitrary = genericArbitrary @@ -227,7 +274,11 @@ data GameState = GameState , _promptState :: !(GamePromptState AppM) , _debugState :: DebugState } - deriving stock (Show) + deriving stock (Show, Generic) + deriving anyclass (NFData) + deriving (ToJSON) + via WithOptions '[ FieldLabelModifier '[Drop 1] ] + GameState makeLenses ''GameState instance Eq GameState where @@ -249,6 +300,20 @@ instance (Monad m) => MonadRandom (AppT m) where getRandomRs rng = uses randomGen $ randomRs rng getRandoms = uses randomGen randoms +instance (MonadIO m) => MonadIO (AppT m) where + liftIO = lift . liftIO + -------------------------------------------------------------------------------- makeLenses ''DebugState + +-------------------------------------------------------------------------------- + +-- saveGame :: GameState -> LByteString +-- saveGame = Zlib.compress . JSON.encode + +-- loadGame :: LByteString -> Maybe GameState +-- loadGame = JSON.decode . Zlib.decompress + +-- saved :: Prism' LByteString GameState +-- saved = prism' saveGame loadGame diff --git a/src/Xanthous/Orphans.hs b/src/Xanthous/Orphans.hs index 610067a375..6714a3bc56 100644 --- a/src/Xanthous/Orphans.hs +++ b/src/Xanthous/Orphans.hs @@ -8,20 +8,27 @@ module Xanthous.Orphans ( ppTemplate ) where -------------------------------------------------------------------------------- -import Xanthous.Prelude hiding (elements) +import Xanthous.Prelude hiding (elements, (.=)) -------------------------------------------------------------------------------- import Data.Aeson +import Data.Aeson.Types (typeMismatch) import Data.List.NonEmpty (NonEmpty(..)) import qualified Data.List.NonEmpty as NonEmpty import Data.Text.Arbitrary () import Graphics.Vty.Attributes +import Brick.Widgets.Edit +import Data.Text.Zipper.Generic (GenericTextZipper) +import Brick.Widgets.Core (getName) +import System.Random (StdGen) import Test.QuickCheck import Test.QuickCheck.Arbitrary.Generic import Text.Megaparsec (errorBundlePretty) import Text.Megaparsec.Pos import Text.Mustache import Text.Mustache.Type ( showKey ) +import Control.Monad.State -------------------------------------------------------------------------------- +import Xanthous.Util.JSON instance forall s a. ( Cons s s a a @@ -96,8 +103,10 @@ concatTextBlocks (x : xs) = x : concatTextBlocks xs instance Arbitrary Template where arbitrary = do template <- concatTextBlocks <$> arbitrary - templateName <- arbitrary - rest <- arbitrary + -- templateName <- arbitrary + -- rest <- arbitrary + let templateName = "template" + rest = mempty pure $ Template { templateActual = templateName , templateCache = rest & at templateName ?~ template @@ -171,28 +180,45 @@ deriving anyclass instance NFData Node deriving anyclass instance NFData Template instance FromJSON Color where - parseJSON = withText "Color" $ \case - "black" -> pure black - "red" -> pure red - "green" -> pure green - "yellow" -> pure yellow - "blue" -> pure blue - "magenta" -> pure magenta - "cyan" -> pure cyan - "white" -> pure white - _ -> fail "Invalid color" + parseJSON (String "black") = pure black + parseJSON (String "red") = pure red + parseJSON (String "green") = pure green + parseJSON (String "yellow") = pure yellow + parseJSON (String "blue") = pure blue + parseJSON (String "magenta") = pure magenta + parseJSON (String "cyan") = pure cyan + parseJSON (String "white") = pure white + parseJSON (String "brightBlack") = pure brightBlack + parseJSON (String "brightRed") = pure brightRed + parseJSON (String "brightGreen") = pure brightGreen + parseJSON (String "brightYellow") = pure brightYellow + parseJSON (String "brightBlue") = pure brightBlue + parseJSON (String "brightMagenta") = pure brightMagenta + parseJSON (String "brightCyan") = pure brightCyan + parseJSON (String "brightWhite") = pure brightWhite + parseJSON n@(Number _) = Color240 <$> parseJSON n + parseJSON x = typeMismatch "Color" x instance ToJSON Color where toJSON color - | color == black = "black" - | color == red = "red" - | color == green = "green" - | color == yellow = "yellow" - | color == blue = "blue" - | color == magenta = "magenta" - | color == cyan = "cyan" - | color == white = "white" - | otherwise = error "unimplemented" + | color == black = "black" + | color == red = "red" + | color == green = "green" + | color == yellow = "yellow" + | color == blue = "blue" + | color == magenta = "magenta" + | color == cyan = "cyan" + | color == white = "white" + | color == brightBlack = "brightBlack" + | color == brightRed = "brightRed" + | color == brightGreen = "brightGreen" + | color == brightYellow = "brightYellow" + | color == brightBlue = "brightBlue" + | color == brightMagenta = "brightMagenta" + | color == brightCyan = "brightCyan" + | color == brightWhite = "brightWhite" + | Color240 num <- color = toJSON num + | otherwise = error $ "unimplemented: " <> show color instance (Eq a, Show a, Read a, FromJSON a) => FromJSON (MaybeDefault a) where parseJSON Null = pure Default @@ -207,7 +233,9 @@ instance ToJSON a => ToJSON (MaybeDefault a) where -------------------------------------------------------------------------------- instance Arbitrary Color where - arbitrary = genericArbitrary + arbitrary = oneof [ Color240 <$> choose (0, 239) + , ISOColor <$> choose (0, 15) + ] deriving anyclass instance CoArbitrary Color deriving anyclass instance Function Color @@ -236,3 +264,89 @@ instance Arbitrary Attr where deriving anyclass instance CoArbitrary Attr deriving anyclass instance Function Attr + +instance ToJSON Attr where + toJSON Attr{..} = object + [ "style" .= maybeDefaultToJSONWith styleToJSON attrStyle + , "foreground" .= attrForeColor + , "background" .= attrBackColor + , "url" .= attrURL + ] + where + maybeDefaultToJSONWith _ Default = Null + maybeDefaultToJSONWith _ KeepCurrent = String "keepCurrent" + maybeDefaultToJSONWith tj (SetTo x) = tj x + styleToJSON style + | style == standout = "standout" + | style == underline = "underline" + | style == reverseVideo = "reverseVideo" + | style == blink = "blink" + | style == dim = "dim" + | style == bold = "bold" + | style == italic = "italic" + | otherwise = toJSON style + +instance FromJSON Attr where + parseJSON = withObject "Attr" $ \obj -> do + attrStyle <- parseStyle =<< obj .:? "style" .!= Default + attrForeColor <- obj .:? "foreground" .!= Default + attrBackColor <- obj .:? "background" .!= Default + attrURL <- obj .:? "url" .!= Default + pure Attr{..} + + where + parseStyle (SetTo (String "standout")) = pure (SetTo standout) + parseStyle (SetTo (String "underline")) = pure (SetTo underline) + parseStyle (SetTo (String "reverseVideo")) = pure (SetTo reverseVideo) + parseStyle (SetTo (String "blink")) = pure (SetTo blink) + parseStyle (SetTo (String "dim")) = pure (SetTo dim) + parseStyle (SetTo (String "bold")) = pure (SetTo bold) + parseStyle (SetTo (String "italic")) = pure (SetTo italic) + parseStyle (SetTo n@(Number _)) = SetTo <$> parseJSON n + parseStyle (SetTo v) = typeMismatch "Style" v + parseStyle Default = pure Default + parseStyle KeepCurrent = pure KeepCurrent + +-------------------------------------------------------------------------------- + +instance NFData a => NFData (NonNull a) where + rnf xs = xs `seq` toNullable xs `deepseq` () + +instance forall t name. (NFData t, Monoid t, NFData name) + => NFData (Editor t name) where + rnf ed = getName @_ @name ed `deepseq` getEditContents ed `deepseq` () + +instance NFData StdGen where + -- StdGen's fields are bang-patterned so this is actually correct! + rnf sg = sg `seq` () + +deriving via (ReadShowJSON StdGen) instance ToJSON StdGen +deriving via (ReadShowJSON StdGen) instance FromJSON StdGen + +instance Function StdGen where + function = functionShow + +-------------------------------------------------------------------------------- + +instance CoArbitrary a => CoArbitrary (NonNull a) where + coarbitrary = coarbitrary . toNullable + +instance (MonoFoldable a, Function a) => Function (NonNull a) where + function = functionMap toNullable $ fromMaybe (error "null") . fromNullable + +instance (Arbitrary t, Arbitrary n, GenericTextZipper t) + => Arbitrary (Editor t n) where + arbitrary = editor <$> arbitrary <*> arbitrary <*> arbitrary + +instance forall t n. (CoArbitrary t, CoArbitrary n, Monoid t) + => CoArbitrary (Editor t n) where + coarbitrary ed = coarbitrary (getName @_ @n ed, getEditContents ed) + +instance CoArbitrary StdGen where + coarbitrary = coarbitrary . show + +-------------------------------------------------------------------------------- + +deriving newtype instance (Arbitrary s, CoArbitrary (m (a, s))) + => CoArbitrary (StateT s m a) + diff --git a/src/Xanthous/Resource.hs b/src/Xanthous/Resource.hs index 782fd5040d..13f7e53967 100644 --- a/src/Xanthous/Resource.hs +++ b/src/Xanthous/Resource.hs @@ -1,8 +1,13 @@ +-------------------------------------------------------------------------------- module Xanthous.Resource ( Name(..) ) where - +-------------------------------------------------------------------------------- import Xanthous.Prelude +-------------------------------------------------------------------------------- +import Test.QuickCheck +import Test.QuickCheck.Arbitrary.Generic +-------------------------------------------------------------------------------- data Name = MapViewport -- ^ The main viewport where we display the game content @@ -11,4 +16,8 @@ data Name = MapViewport | MessageBox -- ^ The box where we display messages to the user | Prompt - deriving stock (Show, Eq, Ord) + deriving stock (Show, Eq, Ord, Generic) + deriving anyclass (NFData, CoArbitrary, Function) + +instance Arbitrary Name where + arbitrary = genericArbitrary diff --git a/src/Xanthous/Util/JSON.hs b/src/Xanthous/Util/JSON.hs new file mode 100644 index 0000000000..91d1328e4a --- /dev/null +++ b/src/Xanthous/Util/JSON.hs @@ -0,0 +1,19 @@ +-------------------------------------------------------------------------------- +module Xanthous.Util.JSON + ( ReadShowJSON(..) + ) where +-------------------------------------------------------------------------------- +import Xanthous.Prelude +-------------------------------------------------------------------------------- +import Data.Aeson +-------------------------------------------------------------------------------- + +newtype ReadShowJSON a = ReadShowJSON a + deriving newtype (Read, Show) + +instance Show a => ToJSON (ReadShowJSON a) where + toJSON = toJSON . show + +instance Read a => FromJSON (ReadShowJSON a) where + parseJSON = withText "readable" + $ maybe (fail "Could not read") pure . readMay diff --git a/src/Xanthous/Util/QuickCheck.hs b/src/Xanthous/Util/QuickCheck.hs new file mode 100644 index 0000000000..ac76a4c930 --- /dev/null +++ b/src/Xanthous/Util/QuickCheck.hs @@ -0,0 +1,28 @@ +module Xanthous.Util.QuickCheck + ( FunctionShow(..) + , functionJSON + , FunctionJSON(..) + ) where +-------------------------------------------------------------------------------- +import Xanthous.Prelude +import Test.QuickCheck +import Test.QuickCheck.Function +import Test.QuickCheck.Instances.ByteString () +import Data.Aeson +import Data.Coerce +-------------------------------------------------------------------------------- + +newtype FunctionShow a = FunctionShow a + deriving newtype (Show, Read) + +instance (Show a, Read a) => Function (FunctionShow a) where + function = functionShow + +functionJSON :: (ToJSON a, FromJSON a) => (a -> c) -> a :-> c +functionJSON = functionMap encode (headEx . decode) + +newtype FunctionJSON a = FunctionJSON a + deriving newtype (ToJSON, FromJSON) + +instance (ToJSON a, FromJSON a) => Function (FunctionJSON a) where + function = functionJSON diff --git a/src/Xanthous/messages.yaml b/src/Xanthous/messages.yaml index 1d8e066ed7..69664f8a79 100644 --- a/src/Xanthous/messages.yaml +++ b/src/Xanthous/messages.yaml @@ -5,6 +5,10 @@ dead: - You perish... - You have perished... +save: + location: + "Enter filename to save to: " + entities: description: You see here {{entityDescriptions}} diff --git a/test/Spec.hs b/test/Spec.hs index 27e26862e2..bd31867294 100644 --- a/test/Spec.hs +++ b/test/Spec.hs @@ -1,6 +1,7 @@ import Test.Prelude import qualified Xanthous.Data.EntityMapSpec import qualified Xanthous.DataSpec +import qualified Xanthous.EntitiesSpec import qualified Xanthous.Entities.RawsSpec import qualified Xanthous.GameSpec import qualified Xanthous.Generators.UtilSpec @@ -16,6 +17,7 @@ main = defaultMain test test :: TestTree test = testGroup "Xanthous" [ Xanthous.Data.EntityMapSpec.test + , Xanthous.EntitiesSpec.test , Xanthous.Entities.RawsSpec.test , Xanthous.GameSpec.test , Xanthous.Generators.UtilSpec.test diff --git a/test/Test/Prelude.hs b/test/Test/Prelude.hs index b12e1e895d..c423796184 100644 --- a/test/Test/Prelude.hs +++ b/test/Test/Prelude.hs @@ -13,6 +13,7 @@ import Test.Tasty.QuickCheck import Test.Tasty.HUnit import Test.QuickCheck.Classes import Test.QuickCheck.Checkers (TestBatch) +import Test.QuickCheck.Instances.ByteString () testBatch :: TestBatch -> TestTree testBatch (name, tests) = testGroup name $ uncurry testProperty <$> tests diff --git a/test/Xanthous/Data/EntityMapSpec.hs b/test/Xanthous/Data/EntityMapSpec.hs index 2e9714a44e..53f03020f3 100644 --- a/test/Xanthous/Data/EntityMapSpec.hs +++ b/test/Xanthous/Data/EntityMapSpec.hs @@ -2,9 +2,11 @@ -------------------------------------------------------------------------------- module Xanthous.Data.EntityMapSpec where -------------------------------------------------------------------------------- -import Test.Prelude +import Test.Prelude -------------------------------------------------------------------------------- -import Xanthous.Data.EntityMap +import qualified Data.Aeson as JSON +-------------------------------------------------------------------------------- +import Xanthous.Data.EntityMap -------------------------------------------------------------------------------- main :: IO () @@ -30,4 +32,9 @@ test = localOption (QuickCheckTests 20) then (em₁ == em₃) else True ] + , testGroup "JSON encoding/decoding" + [ testProperty "Preserves IDs" $ \(em :: EntityMap Int) -> + let Just em' = JSON.decode $ JSON.encode em + in toEIDsAndPositioned em' === toEIDsAndPositioned em + ] ] diff --git a/test/Xanthous/EntitiesSpec.hs b/test/Xanthous/EntitiesSpec.hs new file mode 100644 index 0000000000..14b03f7293 --- /dev/null +++ b/test/Xanthous/EntitiesSpec.hs @@ -0,0 +1,20 @@ +-------------------------------------------------------------------------------- +module Xanthous.EntitiesSpec where +-------------------------------------------------------------------------------- +import Test.Prelude +-------------------------------------------------------------------------------- +import qualified Data.Aeson as JSON +-------------------------------------------------------------------------------- +import Xanthous.Entities +-------------------------------------------------------------------------------- + +main :: IO () +main = defaultMain test + +test :: TestTree +test = testGroup "Xanthous.Entities" + [ testGroup "EntityChar" + [ testProperty "JSON round-trip" $ \(ec :: EntityChar) -> + JSON.decode (JSON.encode ec) === Just ec + ] + ] diff --git a/test/Xanthous/GameSpec.hs b/test/Xanthous/GameSpec.hs index 9f30faca0c..f9a9c543b9 100644 --- a/test/Xanthous/GameSpec.hs +++ b/test/Xanthous/GameSpec.hs @@ -44,4 +44,10 @@ test (oextend f . oextend g) mh === oextend (f . oextend g) mh ] ] + , testGroup "Saving the game" + [ testProperty "forms a prism" $ isPrism saved + , testProperty "preserves the character ID" $ \gs -> + let Just gs' = loadGame $ saveGame gs + in gs' ^. character === gs ^. character + ] ] diff --git a/test/Xanthous/OrphansSpec.hs b/test/Xanthous/OrphansSpec.hs index 3fe79ee563..3740945877 100644 --- a/test/Xanthous/OrphansSpec.hs +++ b/test/Xanthous/OrphansSpec.hs @@ -1,12 +1,16 @@ {-# LANGUAGE BlockArguments #-} +-------------------------------------------------------------------------------- module Xanthous.OrphansSpec where - -import Test.Prelude -import Xanthous.Orphans -import Text.Mustache -import Text.Megaparsec (errorBundlePretty) - -import Xanthous.Orphans () +-------------------------------------------------------------------------------- +import Test.Prelude +-------------------------------------------------------------------------------- +import Text.Mustache +import Text.Megaparsec (errorBundlePretty) +import Graphics.Vty.Attributes +import qualified Data.Aeson as JSON +-------------------------------------------------------------------------------- +import Xanthous.Orphans +-------------------------------------------------------------------------------- main :: IO () main = defaultMain test @@ -27,5 +31,12 @@ test = testGroup "Xanthous.Orphans" $ Right expected === do (Template actual cache) <- res maybe (Left "Template not found") Right $ cache ^? at actual + , testProperty "JSON round trip" $ \(tpl :: Template) -> + counterexample (unpack $ ppTemplate tpl) + $ JSON.decode (JSON.encode tpl) === Just tpl + ] + , testGroup "Attr" + [ testProperty "JSON round trip" $ \(attr :: Attr) -> + JSON.decode (JSON.encode attr) === Just attr ] ] diff --git a/xanthous.cabal b/xanthous.cabal index f25521c5bb..7204dc0f0f 100644 --- a/xanthous.cabal +++ b/xanthous.cabal @@ -4,7 +4,7 @@ cabal-version: 1.12 -- -- see: https://github.com/sol/hpack -- --- hash: ac15bf59fd57f7a0bc23f010aec83824f819592494145cbce3e1db36e23f1107 +-- hash: 0ec32d45d89e30640d8d59137c5eaa80e5eed7eb31cb553d9b251db94ed1ba36 name: xanthous version: 0.1.0.0 @@ -37,10 +37,10 @@ library Xanthous.Data.EntityMap Xanthous.Data.EntityMap.Graphics Xanthous.Entities - Xanthous.Entities.Arbitrary Xanthous.Entities.Character Xanthous.Entities.Creature Xanthous.Entities.Draw.Util + Xanthous.Entities.Entities Xanthous.Entities.Environment Xanthous.Entities.Item Xanthous.Entities.Raws @@ -64,6 +64,8 @@ library Xanthous.Util Xanthous.Util.Graphics Xanthous.Util.Inflection + Xanthous.Util.JSON + Xanthous.Util.QuickCheck other-modules: Paths_xanthous hs-source-dirs: @@ -102,10 +104,12 @@ library , raw-strings-qq , reflection , stache + , text-zipper , tomland , vector , vty , yaml + , zlib default-language: Haskell2010 executable xanthous @@ -119,10 +123,10 @@ executable xanthous Xanthous.Data.EntityMap Xanthous.Data.EntityMap.Graphics Xanthous.Entities - Xanthous.Entities.Arbitrary Xanthous.Entities.Character Xanthous.Entities.Creature Xanthous.Entities.Draw.Util + Xanthous.Entities.Entities Xanthous.Entities.Environment Xanthous.Entities.Item Xanthous.Entities.Raws @@ -146,6 +150,8 @@ executable xanthous Xanthous.Util Xanthous.Util.Graphics Xanthous.Util.Inflection + Xanthous.Util.JSON + Xanthous.Util.QuickCheck Paths_xanthous hs-source-dirs: src @@ -183,11 +189,13 @@ executable xanthous , raw-strings-qq , reflection , stache + , text-zipper , tomland , vector , vty , xanthous , yaml + , zlib default-language: Haskell2010 test-suite test @@ -198,6 +206,7 @@ test-suite test Xanthous.Data.EntityMapSpec Xanthous.DataSpec Xanthous.Entities.RawsSpec + Xanthous.EntitiesSpec Xanthous.GameSpec Xanthous.Generators.UtilSpec Xanthous.MessageSpec @@ -246,9 +255,11 @@ test-suite test , tasty , tasty-hunit , tasty-quickcheck + , text-zipper , tomland , vector , vty , xanthous , yaml + , zlib default-language: Haskell2010 -- cgit 1.4.1 From 0abcd8c9581f0017cb2bd59a09e93800ea8f3b1f Mon Sep 17 00:00:00 2001 From: Griffin Smith Date: Fri, 29 Nov 2019 15:43:46 -0500 Subject: Implement a "look" command Implement the PointOnMap prompt type, which allows the player to move the cursor around and select a position on the map, and use this prompt type to implement a "look" command, describing all entities at the selected position. --- src/Xanthous/App.hs | 78 ++++++++++++++++++++++++++------- src/Xanthous/Command.hs | 6 ++- src/Xanthous/Entities/Raws/gormlak.yaml | 3 +- src/Xanthous/Game/Draw.hs | 16 +++++-- src/Xanthous/Game/Prompt.hs | 32 ++++++++++---- src/Xanthous/Resource.hs | 1 + src/Xanthous/messages.yaml | 4 ++ 7 files changed, 111 insertions(+), 29 deletions(-) diff --git a/src/Xanthous/App.hs b/src/Xanthous/App.hs index 71bf40c427..13c4af1246 100644 --- a/src/Xanthous/App.hs +++ b/src/Xanthous/App.hs @@ -1,4 +1,5 @@ {-# LANGUAGE ViewPatterns #-} +{-# LANGUAGE UndecidableInstances #-} -------------------------------------------------------------------------------- module Xanthous.App (makeApp) where -------------------------------------------------------------------------------- @@ -14,8 +15,8 @@ import Control.Monad.State.Class (modify) import Data.Aeson (object, ToJSON) import qualified Data.Aeson as A import qualified Data.Vector as V -import qualified Data.Yaml as Yaml import System.Exit +import GHC.TypeLits (TypeError, ErrorMessage(..)) -------------------------------------------------------------------------------- import Xanthous.Command import Xanthous.Data @@ -167,6 +168,15 @@ handleCommand Open = do stepGame -- TODO continue +handleCommand Look = do + prompt_ @'PointOnMap ["look", "prompt"] Cancellable + $ \(PointOnMapResult pos) -> + use (entities . EntityMap.atPosition pos) + >>= \case + Empty -> say_ ["look", "nothing"] + ents -> describeEntities ents + continue + handleCommand Wait = stepGame >> continue handleCommand Eat = do @@ -217,11 +227,10 @@ handlePromptEvent -> BrickEvent Name () -> AppM (Next GameState) -handlePromptEvent _ (Prompt Cancellable _ _ _ _) (VtyEvent (EvKey KEsc [])) = do - promptState .= NoPrompt - continue -handlePromptEvent _ pr (VtyEvent (EvKey KEnter [])) = - submitPrompt pr >> clearPrompt +handlePromptEvent _ (Prompt Cancellable _ _ _ _) (VtyEvent (EvKey KEsc [])) + = clearPrompt +handlePromptEvent _ pr (VtyEvent (EvKey KEnter [])) + = submitPrompt pr >> clearPrompt handlePromptEvent msg @@ -246,14 +255,32 @@ handlePromptEvent _ (Prompt _ SMenu _ items cb) (VtyEvent (EvKey (KChar chr) []) | otherwise = continue -handlePromptEvent _ _ _ = undefined +handlePromptEvent + msg + (Prompt c SPointOnMap (PointOnMapPromptState pos) pri cb) + (VtyEvent (EvKey (KChar (directionFromChar -> Just dir)) [])) + = let pos' = move dir pos + prompt' = Prompt c SPointOnMap (PointOnMapPromptState pos') pri cb + in promptState .= WaitingPrompt msg prompt' + >> continue +handlePromptEvent _ (Prompt _ SPointOnMap _ _ _) _ = continue clearPrompt :: AppM (Next GameState) clearPrompt = promptState .= NoPrompt >> continue +class NotMenu (pt :: PromptType) +instance NotMenu 'StringPrompt +instance NotMenu 'Confirm +instance NotMenu 'DirectionPrompt +instance NotMenu 'PointOnMap +instance NotMenu 'Continue +instance TypeError ('Text "Cannot use `prompt` or `prompt_` for menu prompts" + ':$$: 'Text "Use `menu` or `menu_` instead") + => NotMenu ('Menu a) + prompt :: forall (pt :: PromptType) (params :: Type). - (ToJSON params, SingPromptType pt, PromptInput pt ~ ()) + (ToJSON params, SingPromptType pt, NotMenu pt) => [Text] -- ^ Message key -> params -- ^ Message params -> PromptCancellable @@ -262,12 +289,20 @@ prompt prompt msgPath params cancellable cb = do let pt = singPromptType @pt msg <- Messages.message msgPath params - let p = mkPrompt cancellable pt cb + p <- case pt of + SPointOnMap -> do + charPos <- use characterPosition + pure $ mkPointOnMapPrompt cancellable charPos cb + SStringPrompt -> pure $ mkPrompt cancellable pt cb + SConfirm -> pure $ mkPrompt cancellable pt cb + SDirectionPrompt -> pure $ mkPrompt cancellable pt cb + SContinue -> pure $ mkPrompt cancellable pt cb + SMenu -> error "unreachable" promptState .= WaitingPrompt msg p prompt_ - :: forall (pt :: PromptType) . - (SingPromptType pt, PromptInput pt ~ ()) + :: forall (pt :: PromptType). + (SingPromptType pt, NotMenu pt) => [Text] -- ^ Message key -> PromptCancellable -> (PromptResult pt -> AppM ()) -- ^ Prompt promise handler @@ -295,6 +330,7 @@ menu_ :: forall (a :: Type). -> AppM () menu_ msgPath = menu msgPath $ object [] + -------------------------------------------------------------------------------- entitiesAtPositionWithType @@ -316,10 +352,22 @@ describeEntitiesAt pos = . to (filter (not . entityIs @Character)) ) >>= \case Empty -> pure () - ents -> - let descriptions = description <$> ents - in say ["entities", "description"] $ object - ["entityDescriptions" A..= toSentence descriptions] + ents -> describeEntities ents + +describeEntities + :: ( Entity entity + , MonadRandom m + , MonadState GameState m + , MonoFoldable (f Text) + , Functor f + , Element (f Text) ~ Text + ) + => f entity + -> m () +describeEntities ents = + let descriptions = description <$> ents + in say ["entities", "description"] + $ object ["entityDescriptions" A..= toSentence descriptions] attackAt :: Position -> AppM () attackAt pos = diff --git a/src/Xanthous/Command.hs b/src/Xanthous/Command.hs index 74808443d3..35a8ce3672 100644 --- a/src/Xanthous/Command.hs +++ b/src/Xanthous/Command.hs @@ -17,6 +17,7 @@ data Command | Open | Wait | Eat + | Look | Save -- | TODO replace with `:` commands @@ -29,9 +30,12 @@ commandFromKey (KChar (directionFromChar -> Just dir)) [] = Just $ Move dir commandFromKey (KChar 'p') [MCtrl] = Just PreviousMessage commandFromKey (KChar ',') [] = Just PickUp commandFromKey (KChar 'o') [] = Just Open +commandFromKey (KChar ';') [] = Just Look commandFromKey (KChar 'e') [] = Just Eat -commandFromKey (KChar 'r') [MMeta] = Just ToggleRevealAll commandFromKey (KChar 'S') [] = Just Save + +commandFromKey (KChar 'r') [MMeta] = Just ToggleRevealAll + commandFromKey _ _ = Nothing -------------------------------------------------------------------------------- diff --git a/src/Xanthous/Entities/Raws/gormlak.yaml b/src/Xanthous/Entities/Raws/gormlak.yaml index 9a9281c9a9..2eac895190 100644 --- a/src/Xanthous/Entities/Raws/gormlak.yaml +++ b/src/Xanthous/Entities/Raws/gormlak.yaml @@ -1,6 +1,7 @@ Creature: name: gormlak - description: | + description: a gormlak + longDescription: | A chittering imp-like creature with bright yellow horns. It adores shiny objects and gathers in swarms. char: diff --git a/src/Xanthous/Game/Draw.hs b/src/Xanthous/Game/Draw.hs index ffbf30cca8..2f7ccf29f7 100644 --- a/src/Xanthous/Game/Draw.hs +++ b/src/Xanthous/Game/Draw.hs @@ -32,6 +32,14 @@ import qualified Xanthous.Resource as Resource import Xanthous.Orphans () -------------------------------------------------------------------------------- +cursorPosition :: GameState -> Widget Name -> Widget Name +cursorPosition game + | WaitingPrompt _ (Prompt _ SPointOnMap (PointOnMapPromptState pos) _ _) + <- game ^. promptState + = showCursor Resource.Prompt (pos ^. loc) + | otherwise + = showCursor Resource.Character (game ^. characterPosition . loc) + drawMessages :: MessageHistory -> Widget Name drawMessages = txt . (<> " ") . unwords . oextract @@ -46,7 +54,7 @@ drawPromptState (WaitingPrompt msg (Prompt _ pt ps pri _)) = (SMenu, _, menuItems) -> txt msg <=> foldl' (<=>) emptyWidget (map drawMenuItem $ itoList menuItems) - _ -> undefined + _ -> txt msg where drawMenuItem (chr, MenuOption m _) = str ("[" <> pure chr <> "] ") <+> txt m @@ -77,7 +85,7 @@ drawEntities canRenderPos allEnts drawMap :: GameState -> Widget Name drawMap game = viewport Resource.MapViewport Both - . showCursor Resource.Character (game ^. characterPosition . loc) + . cursorPosition game $ drawEntities (\pos -> (game ^. debugState . allRevealed) @@ -102,7 +110,9 @@ drawGame :: GameState -> [Widget Name] drawGame game = pure . withBorderStyle unicode - $ drawMessages (game ^. messageHistory) + $ case game ^. promptState of + NoPrompt -> drawMessages (game ^. messageHistory) + _ -> emptyWidget <=> drawPromptState (game ^. promptState) <=> border (drawMap game) <=> drawCharacterInfo (game ^. character) diff --git a/src/Xanthous/Game/Prompt.hs b/src/Xanthous/Game/Prompt.hs index 1154d6db5a..6c3629f310 100644 --- a/src/Xanthous/Game/Prompt.hs +++ b/src/Xanthous/Game/Prompt.hs @@ -15,6 +15,7 @@ module Xanthous.Game.Prompt , Prompt(..) , mkPrompt , mkMenu + , mkPointOnMapPrompt , isCancellable , submitPrompt ) where @@ -67,6 +68,7 @@ instance NFData (SPromptType pt) where class SingPromptType pt where singPromptType :: SPromptType pt instance SingPromptType 'StringPrompt where singPromptType = SStringPrompt instance SingPromptType 'DirectionPrompt where singPromptType = SDirectionPrompt +instance SingPromptType 'PointOnMap where singPromptType = SPointOnMap instance SingPromptType 'Continue where singPromptType = SContinue instance Show (SPromptType pt) where @@ -115,16 +117,20 @@ instance Arbitrary (PromptResult 'Continue) where -------------------------------------------------------------------------------- data PromptState pt where - StringPromptState :: Editor Text Name -> PromptState 'StringPrompt - DirectionPromptState :: PromptState 'DirectionPrompt - ContinuePromptState :: PromptState 'Continue - MenuPromptState :: forall a. PromptState ('Menu a) + StringPromptState :: Editor Text Name -> PromptState 'StringPrompt + DirectionPromptState :: PromptState 'DirectionPrompt + ContinuePromptState :: PromptState 'Continue + ConfirmPromptState :: PromptState 'Confirm + MenuPromptState :: forall a. PromptState ('Menu a) + PointOnMapPromptState :: Position -> PromptState 'PointOnMap instance NFData (PromptState pt) where rnf sps@(StringPromptState ed) = sps `deepseq` ed `deepseq` () rnf DirectionPromptState = () rnf ContinuePromptState = () + rnf ConfirmPromptState = () rnf MenuPromptState = () + rnf pomps@(PointOnMapPromptState pos) = pomps `deepseq` pos `deepseq` () instance Arbitrary (PromptState 'StringPrompt) where arbitrary = StringPromptState <$> arbitrary @@ -170,6 +176,7 @@ instance Show (MenuOption a) where type family PromptInput (pt :: PromptType) :: Type where PromptInput ('Menu a) = Map Char (MenuOption a) + PromptInput 'PointOnMap = Position -- Character pos PromptInput _ = () data Prompt (m :: Type -> Type) where @@ -236,7 +243,7 @@ mkPrompt c pt@SStringPrompt cb = in Prompt c pt ps () cb mkPrompt c pt@SDirectionPrompt cb = Prompt c pt DirectionPromptState () cb mkPrompt c pt@SContinue cb = Prompt c pt ContinuePromptState () cb -mkPrompt _ _ _ = undefined +mkPrompt c pt@SConfirm cb = Prompt c pt ConfirmPromptState () cb mkMenu :: forall a m. @@ -246,6 +253,13 @@ mkMenu -> Prompt m mkMenu c = Prompt c SMenu MenuPromptState +mkPointOnMapPrompt + :: PromptCancellable + -> Position + -> (PromptResult 'PointOnMap -> m ()) + -> Prompt m +mkPointOnMapPrompt c pos = Prompt c SPointOnMap (PointOnMapPromptState pos) pos + isCancellable :: Prompt m -> Bool isCancellable (Prompt Cancellable _ _ _ _) = True isCancellable (Prompt Uncancellable _ _ _ _) = False @@ -261,7 +275,7 @@ submitPrompt (Prompt _ pt ps _ cb) = cb ContinueResult (SMenu, MenuPromptState) -> pure () -- Don't use submit with a menu prompt - _ -> undefined - --- data PromptInput :: PromptType -> Type where --- StringInput :: PromptInput 'StringPrompt + (SPointOnMap, PointOnMapPromptState pos) -> + cb $ PointOnMapResult pos + (SConfirm, ConfirmPromptState) -> + cb $ ConfirmResult True diff --git a/src/Xanthous/Resource.hs b/src/Xanthous/Resource.hs index 13f7e53967..5350e7646e 100644 --- a/src/Xanthous/Resource.hs +++ b/src/Xanthous/Resource.hs @@ -16,6 +16,7 @@ data Name = MapViewport | MessageBox -- ^ The box where we display messages to the user | Prompt + -- ^ The game's prompt deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, CoArbitrary, Function) diff --git a/src/Xanthous/messages.yaml b/src/Xanthous/messages.yaml index 69664f8a79..71f08f2631 100644 --- a/src/Xanthous/messages.yaml +++ b/src/Xanthous/messages.yaml @@ -22,6 +22,10 @@ open: locked: "That door is locked" nothingToOpen: "There's nothing to open there" +look: + prompt: Select a position on the map to describe (use Enter to confirm) + nothing: There's nothing there + character: namePrompt: "What's your name? " -- cgit 1.4.1 From 7d8ce026a2acc5a4d208110750be188f0ce5591c Mon Sep 17 00:00:00 2001 From: Griffin Smith Date: Fri, 29 Nov 2019 22:57:58 -0500 Subject: Add DerivingVia newtype for generic arbitrary Add a newtype, GenericArbitrary, which can be used with -XDerivingVia to derive Arbitrary instances for types with Generic, via patching generic-arbitrary to expose the underlying typeclass it uses for surfacing the type information. --- default.nix | 7 +++++-- generic-arbitrary-export-garbitrary.patch | 12 ++++++++++++ haskell-overlay.nix | 7 +++++++ shell.nix | 8 +++++++- src/Xanthous/Util/QuickCheck.hs | 17 ++++++++++++++++- 5 files changed, 47 insertions(+), 4 deletions(-) create mode 100644 generic-arbitrary-export-garbitrary.patch create mode 100644 haskell-overlay.nix diff --git a/default.nix b/default.nix index 7cf9f4beb4..ca163c8e56 100644 --- a/default.nix +++ b/default.nix @@ -1,8 +1,11 @@ -{ nixpkgs ? import ./nixpkgs.nix {}, compiler ? "ghc865" }: +{ nixpkgs ? import ./nixpkgs.nix {} +, compiler ? "ghc865" }: let inherit (nixpkgs) pkgs; all-hies = import (fetchTarball "https://github.com/infinisil/all-hies/tarball/master") {}; hie = all-hies.selection { selector = p: { inherit (p) ghc865; }; }; - xanthous = pkgs.haskellPackages.callPackage (import ./pkg.nix { inherit nixpkgs; }) {}; + xanthous = (pkgs.haskellPackages + .extend (import ./haskell-overlay.nix { inherit nixpkgs; })) + .callPackage (import ./pkg.nix { inherit nixpkgs; }) {}; in xanthous // { inherit hie; } diff --git a/generic-arbitrary-export-garbitrary.patch b/generic-arbitrary-export-garbitrary.patch new file mode 100644 index 0000000000..f0c936bfca --- /dev/null +++ b/generic-arbitrary-export-garbitrary.patch @@ -0,0 +1,12 @@ +diff --git a/src/Test/QuickCheck/Arbitrary/Generic.hs b/src/Test/QuickCheck/Arbitrary/Generic.hs +index fed6ab3..91f59f1 100644 +--- a/src/Test/QuickCheck/Arbitrary/Generic.hs ++++ b/src/Test/QuickCheck/Arbitrary/Generic.hs +@@ -23,6 +23,7 @@ The generated 'arbitrary' method is equivalent to + + module Test.QuickCheck.Arbitrary.Generic + ( Arbitrary(..) ++ , GArbitrary + , genericArbitrary + , genericShrink + ) where diff --git a/haskell-overlay.nix b/haskell-overlay.nix new file mode 100644 index 0000000000..90ba35c6af --- /dev/null +++ b/haskell-overlay.nix @@ -0,0 +1,7 @@ +{ nixpkgs ? import ./nixpkgs.nix {} }: +let inherit (nixpkgs) pkgs; +in self: super: rec { + generic-arbitrary = pkgs.haskell.lib.appendPatch + super.generic-arbitrary + [ ./generic-arbitrary-export-garbitrary.patch ]; +} diff --git a/shell.nix b/shell.nix index 966ab0bb08..d1c2b7ad91 100644 --- a/shell.nix +++ b/shell.nix @@ -8,7 +8,9 @@ let if compiler == "default" then pkgs.haskellPackages else pkgs.haskell.packages.${compiler} - ); + ).override { + overrides = import ./haskell-overlay.nix { inherit nixpkgs; }; + }; haskellPackages = ( if withHoogle @@ -16,6 +18,10 @@ let overrides = (self: super: { ghc = super.ghc // { withPackages = super.ghc.withHoogle; }; ghcWithPackages = self.ghc.withPackages; + # eww https://github.com/NixOS/nixpkgs/issues/16394 + generic-arbitrary = pkgs.haskell.lib.appendPatch + super.generic-arbitrary + [ ./generic-arbitrary-export-garbitrary.patch ]; }); } else packageSet diff --git a/src/Xanthous/Util/QuickCheck.hs b/src/Xanthous/Util/QuickCheck.hs index ac76a4c930..ba04f9ffb2 100644 --- a/src/Xanthous/Util/QuickCheck.hs +++ b/src/Xanthous/Util/QuickCheck.hs @@ -1,15 +1,21 @@ +{-# LANGUAGE UndecidableInstances #-} module Xanthous.Util.QuickCheck - ( FunctionShow(..) + ( functionShow + , FunctionShow(..) , functionJSON , FunctionJSON(..) + , genericArbitrary + , GenericArbitrary(..) ) where -------------------------------------------------------------------------------- import Xanthous.Prelude import Test.QuickCheck import Test.QuickCheck.Function import Test.QuickCheck.Instances.ByteString () +import Test.QuickCheck.Arbitrary.Generic import Data.Aeson import Data.Coerce +import GHC.Generics (Rep) -------------------------------------------------------------------------------- newtype FunctionShow a = FunctionShow a @@ -26,3 +32,12 @@ newtype FunctionJSON a = FunctionJSON a instance (ToJSON a, FromJSON a) => Function (FunctionJSON a) where function = functionJSON + +-------------------------------------------------------------------------------- + +newtype GenericArbitrary a = GenericArbitrary a + deriving newtype Generic + +instance (Generic a, GArbitrary rep, Rep a ~ rep) + => Arbitrary (GenericArbitrary a) where + arbitrary = genericArbitrary -- cgit 1.4.1 From 8a1235c3dcf7fe69b2e2ea3eea326858d26d38b9 Mon Sep 17 00:00:00 2001 From: Griffin Smith Date: Fri, 29 Nov 2019 22:59:15 -0500 Subject: Use menus for combat and picking up items Refactor a bunch of stuff around to allow for polymorphically surfacing an EntityChar for all entities, and use this to write a generic `entityMenu` function, which generates a menu from the chars of a list of entities - and use that to fully implement (removing `undefined`) menus for both attacking and picking things up when there are multiple entities on the relevant tile. --- package.yaml | 1 + src/Xanthous/AI/Gormlak.hs | 4 +- src/Xanthous/AI/Gormlak.hs-boot | 2 +- src/Xanthous/App.hs | 47 +++++++--- src/Xanthous/Data/EntityChar.hs | 56 ++++++++++++ src/Xanthous/Data/EntityMap/Graphics.hs | 2 +- src/Xanthous/Entities.hs | 146 -------------------------------- src/Xanthous/Entities/Character.hs | 3 +- src/Xanthous/Entities/Creature.hs | 2 +- src/Xanthous/Entities/Entities.hs | 2 +- src/Xanthous/Entities/Environment.hs | 12 +-- src/Xanthous/Entities/Item.hs | 10 +-- src/Xanthous/Entities/RawTypes.hs | 3 +- src/Xanthous/Entities/Raws.hs | 2 +- src/Xanthous/Game/Arbitrary.hs | 4 +- src/Xanthous/Game/Draw.hs | 2 +- src/Xanthous/Game/Lenses.hs | 8 +- src/Xanthous/Game/Prompt.hs | 9 +- src/Xanthous/Game/State.hs | 85 ++++++++++++++++++- src/Xanthous/Orphans.hs | 1 - src/Xanthous/Prelude.hs | 6 +- src/Xanthous/messages.yaml | 4 +- test/Spec.hs | 8 +- test/Xanthous/Data/EntityCharSpec.hs | 18 ++++ test/Xanthous/EntitiesSpec.hs | 20 ----- test/Xanthous/GameSpec.hs | 2 +- xanthous.cabal | 11 ++- 27 files changed, 245 insertions(+), 225 deletions(-) create mode 100644 src/Xanthous/Data/EntityChar.hs delete mode 100644 src/Xanthous/Entities.hs create mode 100644 test/Xanthous/Data/EntityCharSpec.hs delete mode 100644 test/Xanthous/EntitiesSpec.hs diff --git a/package.yaml b/package.yaml index a54d3075b7..cadfd04d8d 100644 --- a/package.yaml +++ b/package.yaml @@ -25,6 +25,7 @@ dependencies: - brick - checkers - classy-prelude +- comonad - constraints - containers - data-default diff --git a/src/Xanthous/AI/Gormlak.hs b/src/Xanthous/AI/Gormlak.hs index 268e33ad6c..8b30bc2c9d 100644 --- a/src/Xanthous/AI/Gormlak.hs +++ b/src/Xanthous/AI/Gormlak.hs @@ -24,8 +24,7 @@ import Xanthous.Entities.Creature import Xanthous.Entities.Character (Character) import qualified Xanthous.Entities.Character as Character import qualified Xanthous.Entities.RawTypes as Raw -import Xanthous.Entities (Entity(..), Brain(..), brainVia) -import Xanthous.Game.State (entities, GameState, entityIs) +import Xanthous.Game.State import Xanthous.Game.Lenses ( Collision(..), entityCollision, collisionAt , character, characterPosition @@ -99,3 +98,4 @@ instance Brain Creature where step = brainVia GormlakBrain instance Entity Creature where blocksVision _ = False description = view $ Creature.creatureType . Raw.description + entityChar = view $ Creature.creatureType . char diff --git a/src/Xanthous/AI/Gormlak.hs-boot b/src/Xanthous/AI/Gormlak.hs-boot index 391a8a807f..47e62f6249 100644 --- a/src/Xanthous/AI/Gormlak.hs-boot +++ b/src/Xanthous/AI/Gormlak.hs-boot @@ -1,7 +1,7 @@ {-# OPTIONS_GHC -fno-warn-orphans #-} module Xanthous.AI.Gormlak where -import Xanthous.Entities +import Xanthous.Game.State import Xanthous.Entities.Creature instance Entity Creature diff --git a/src/Xanthous/App.hs b/src/Xanthous/App.hs index 13c4af1246..76e03e8609 100644 --- a/src/Xanthous/App.hs +++ b/src/Xanthous/App.hs @@ -30,6 +30,7 @@ import Xanthous.Data import Xanthous.Data.EntityMap (EntityMap) import qualified Xanthous.Data.EntityMap as EntityMap import Xanthous.Game +import Xanthous.Game.State import Xanthous.Game.Draw (drawGame) import Xanthous.Game.Prompt import Xanthous.Monad @@ -38,8 +39,7 @@ import qualified Xanthous.Messages as Messages import Xanthous.Util.Inflection (toSentence) -------------------------------------------------------------------------------- import qualified Xanthous.Entities.Character as Character -import Xanthous.Entities.Character -import Xanthous.Entities +import Xanthous.Entities.Character hiding (pickUpItem) import Xanthous.Entities.Item (Item) import qualified Xanthous.Entities.Item as Item import Xanthous.Entities.Creature (Creature) @@ -138,16 +138,19 @@ handleCommand (Move dir) = do handleCommand PickUp = do pos <- use characterPosition - items <- uses entities $ entitiesAtPositionWithType @Item pos - case items of - [] -> say_ ["items", "nothingToPickUp"] - [(itemID, item)] -> do + uses entities (entitiesAtPositionWithType @Item pos) >>= \case + [] -> say_ ["pickUp", "nothingToPickUp"] + [item] -> pickUpItem item + items -> + menu_ ["pickUp", "menu"] Cancellable (entityMenu_ items) + $ \(MenuResult item) -> pickUpItem item + continue + where + pickUpItem (itemID, item) = do character %= Character.pickUpItem item entities . at itemID .= Nothing - say ["items", "pickUp"] $ object [ "item" A..= item ] + say ["pickUp", "pickUp"] $ object [ "item" A..= item ] stepGameBy 100 -- TODO - _ -> undefined - continue handleCommand PreviousMessage = do messageHistory %= previousMessage @@ -188,6 +191,7 @@ handleCommand Eat = do let foodMenuItem idx (item, edibleItem) = ( item ^. Item.itemType . char . char , MenuOption (description item) (idx, item, edibleItem)) + -- TODO refactor to use entityMenu_ menuItems = mkMenuItems $ imap foodMenuItem food in menu_ ["eat", "menuPrompt"] Cancellable menuItems $ \(MenuResult (idx, item, edibleItem)) -> do @@ -265,6 +269,8 @@ handlePromptEvent >> continue handlePromptEvent _ (Prompt _ SPointOnMap _ _ _) _ = continue +handlePromptEvent _ _ _ = continue + clearPrompt :: AppM (Next GameState) clearPrompt = promptState .= NoPrompt >> continue @@ -330,7 +336,6 @@ menu_ :: forall (a :: Type). -> AppM () menu_ msgPath = menu msgPath $ object [] - -------------------------------------------------------------------------------- entitiesAtPositionWithType @@ -374,7 +379,9 @@ attackAt pos = uses entities (entitiesAtPositionWithType @Creature pos) >>= \case Empty -> say_ ["combat", "nothingToAttack"] (creature :< Empty) -> attackCreature creature - creatures -> undefined + creatures -> + menu_ ["combat", "menu"] Cancellable (entityMenu_ creatures) + $ \(MenuResult creature) -> attackCreature creature where attackCreature (creatureID, creature) = do charDamage <- use $ character . characterDamage @@ -388,3 +395,21 @@ attackAt pos = say ["combat", "hit"] msgParams entities . ix creatureID . positioned .= SomeEntity creature' stepGame -- TODO + +entityMenu_ + :: (Comonad w, Entity entity) + => [w entity] + -> Map Char (MenuOption (w entity)) +entityMenu_ = mkMenuItems @[_] . map entityMenuItem + where + entityMenuItem wentity + = let entity = extract wentity + in (entityMenuChar entity, MenuOption (description entity) wentity) + entityMenuChar entity + = let ec = entityChar entity ^. char + in if ec `elem` (['a'..'z'] ++ ['A'..'Z']) + then ec + else 'a' + +entityMenu :: Entity entity => [entity] -> Map Char (MenuOption entity) +entityMenu = map (map runIdentity) . entityMenu_ . fmap Identity diff --git a/src/Xanthous/Data/EntityChar.hs b/src/Xanthous/Data/EntityChar.hs new file mode 100644 index 0000000000..7aeb5fdf86 --- /dev/null +++ b/src/Xanthous/Data/EntityChar.hs @@ -0,0 +1,56 @@ +{-# LANGUAGE RoleAnnotations #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE AllowAmbiguousTypes #-} +{-# LANGUAGE TemplateHaskell #-} +-------------------------------------------------------------------------------- +module Xanthous.Data.EntityChar + ( EntityChar(..) + , HasChar(..) + , HasStyle(..) + ) where +-------------------------------------------------------------------------------- +import Xanthous.Prelude hiding ((.=)) +-------------------------------------------------------------------------------- +import qualified Graphics.Vty.Attributes as Vty +import Test.QuickCheck +import Data.Aeson +-------------------------------------------------------------------------------- +import Xanthous.Orphans () +import Xanthous.Util.QuickCheck (GenericArbitrary(..)) +-------------------------------------------------------------------------------- + + +class HasChar s a | s -> a where + char :: Lens' s a + {-# MINIMAL char #-} + +data EntityChar = EntityChar + { _char :: Char + , _style :: Vty.Attr + } + deriving stock (Show, Eq, Generic) + deriving anyclass (NFData, CoArbitrary, Function) + deriving Arbitrary via GenericArbitrary EntityChar +makeFieldsNoPrefix ''EntityChar + +instance FromJSON EntityChar where + parseJSON (String (chr :< Empty)) = pure $ EntityChar chr Vty.defAttr + parseJSON (Object o) = do + (EntityChar _char _) <- o .: "char" + _style <- o .:? "style" .!= Vty.defAttr + pure EntityChar {..} + parseJSON _ = fail "Invalid type, expected string or object" + +instance ToJSON EntityChar where + toJSON (EntityChar chr styl) + | styl == Vty.defAttr = String $ chr <| Empty + | otherwise = object + [ "char" .= chr + , "style" .= styl + ] + +instance IsString EntityChar where + fromString [ch] = EntityChar ch Vty.defAttr + fromString _ = error "Entity char must only be a single character" diff --git a/src/Xanthous/Data/EntityMap/Graphics.hs b/src/Xanthous/Data/EntityMap/Graphics.hs index ace5ae49e8..30c6d09673 100644 --- a/src/Xanthous/Data/EntityMap/Graphics.hs +++ b/src/Xanthous/Data/EntityMap/Graphics.hs @@ -12,7 +12,7 @@ import Xanthous.Prelude hiding (lines) import Xanthous.Util (takeWhileInclusive) import Xanthous.Data import Xanthous.Data.EntityMap -import Xanthous.Entities +import Xanthous.Game.State import Xanthous.Util.Graphics (circle, line) -------------------------------------------------------------------------------- diff --git a/src/Xanthous/Entities.hs b/src/Xanthous/Entities.hs deleted file mode 100644 index 7f4efb71d1..0000000000 --- a/src/Xanthous/Entities.hs +++ /dev/null @@ -1,146 +0,0 @@ -{-# LANGUAGE RoleAnnotations #-} -{-# LANGUAGE RecordWildCards #-} -{-# LANGUAGE UndecidableInstances #-} -{-# LANGUAGE GADTs #-} -{-# LANGUAGE AllowAmbiguousTypes #-} -{-# LANGUAGE TemplateHaskell #-} --------------------------------------------------------------------------------- -module Xanthous.Entities - ( Draw(..) - , DrawCharacter(..) - , DrawStyledCharacter(..) - , DrawRawChar(..) - , DrawRawCharPriority(..) - , Entity(..) - , SomeEntity(..) - , downcastEntity - , entityIs - , _SomeEntity - - , Color(..) - , KnownColor(..) - - , EntityChar(..) - , HasChar(..) - , HasStyle(..) - - , Brain(..) - , Brainless(..) - , brainVia - ) where --------------------------------------------------------------------------------- -import Xanthous.Prelude hiding ((.=)) --------------------------------------------------------------------------------- -import Brick -import qualified Graphics.Vty.Attributes as Vty -import qualified Graphics.Vty.Image as Vty -import Data.Aeson -import Data.Typeable (Proxy(..)) -import Data.Generics.Product.Fields -import Test.QuickCheck -import Test.QuickCheck.Arbitrary.Generic --------------------------------------------------------------------------------- -import Xanthous.Orphans () -import Xanthous.Game.State --------------------------------------------------------------------------------- - -newtype DrawCharacter (char :: Symbol) (a :: Type) where - DrawCharacter :: a -> DrawCharacter char a - -instance KnownSymbol char => Draw (DrawCharacter char a) where - draw _ = str $ symbolVal @char Proxy - --------------------------------------------------------------------------------- - -data Color = Black | Red | Green | Yellow | Blue | Magenta | Cyan | White - -class KnownColor (color :: Color) where - colorVal :: forall proxy. proxy color -> Vty.Color - -instance KnownColor 'Black where colorVal _ = Vty.black -instance KnownColor 'Red where colorVal _ = Vty.red -instance KnownColor 'Green where colorVal _ = Vty.green -instance KnownColor 'Yellow where colorVal _ = Vty.yellow -instance KnownColor 'Blue where colorVal _ = Vty.blue -instance KnownColor 'Magenta where colorVal _ = Vty.magenta -instance KnownColor 'Cyan where colorVal _ = Vty.cyan -instance KnownColor 'White where colorVal _ = Vty.white - -newtype DrawStyledCharacter (fg :: Color) (bg :: Color) (char :: Symbol) (a :: Type) where - DrawStyledCharacter :: a -> DrawStyledCharacter fg bg char a - -instance - ( KnownColor fg - , KnownColor bg - , KnownSymbol char - ) - => Draw (DrawStyledCharacter fg bg char a) where - draw _ = raw $ Vty.string attr $ symbolVal @char Proxy - where attr = Vty.Attr - { Vty.attrStyle = Vty.Default - , Vty.attrForeColor = Vty.SetTo $ colorVal @fg Proxy - , Vty.attrBackColor = Vty.SetTo $ colorVal @bg Proxy - , Vty.attrURL = Vty.Default - } - --------------------------------------------------------------------------------- - -class HasChar s a | s -> a where - char :: Lens' s a - {-# MINIMAL char #-} - -newtype DrawRawChar (rawField :: Symbol) (a :: Type) = DrawRawChar a - -instance - forall rawField a raw. - ( HasField rawField a a raw raw - , HasChar raw EntityChar - ) => Draw (DrawRawChar rawField a) where - draw (DrawRawChar e) = draw $ e ^. field @rawField . char - -newtype DrawRawCharPriority - (rawField :: Symbol) - (priority :: Nat) - (a :: Type) - = DrawRawCharPriority a - -instance - forall rawField priority a raw. - ( HasField rawField a a raw raw - , KnownNat priority - , HasChar raw EntityChar - ) => Draw (DrawRawCharPriority rawField priority a) where - draw (DrawRawCharPriority e) = draw $ e ^. field @rawField . char - drawPriority = const . fromIntegral $ natVal @priority Proxy - --------------------------------------------------------------------------------- - -data EntityChar = EntityChar - { _char :: Char - , _style :: Vty.Attr - } - deriving stock (Show, Eq, Generic) - deriving anyclass (NFData, CoArbitrary, Function) -makeFieldsNoPrefix ''EntityChar - -instance Arbitrary EntityChar where - arbitrary = genericArbitrary - -instance FromJSON EntityChar where - parseJSON (String (chr :< Empty)) = pure $ EntityChar chr Vty.defAttr - parseJSON (Object o) = do - (EntityChar _char _) <- o .: "char" - _style <- o .:? "style" .!= Vty.defAttr - pure EntityChar {..} - parseJSON _ = fail "Invalid type, expected string or object" - -instance ToJSON EntityChar where - toJSON (EntityChar chr styl) - | styl == Vty.defAttr = String $ chr <| Empty - | otherwise = object - [ "char" .= chr - , "style" .= styl - ] - -instance Draw EntityChar where - draw EntityChar{..} = raw $ Vty.string _style [_char] diff --git a/src/Xanthous/Entities/Character.hs b/src/Xanthous/Entities/Character.hs index cc04340f6e..22589252ac 100644 --- a/src/Xanthous/Entities/Character.hs +++ b/src/Xanthous/Entities/Character.hs @@ -27,7 +27,7 @@ import Data.Aeson.Generic.DerivingVia import Data.Aeson (ToJSON, FromJSON) import Data.Coerce (coerce) -------------------------------------------------------------------------------- -import Xanthous.Entities +import Xanthous.Game.State import Xanthous.Entities.Item import Xanthous.Data (TicksPerTile, Hitpoints, Per, Ticks, (|*|), positioned) -------------------------------------------------------------------------------- @@ -68,6 +68,7 @@ instance Brain Character where instance Entity Character where blocksVision _ = False description _ = "yourself" + entityChar _ = "@" instance Arbitrary Character where arbitrary = genericArbitrary diff --git a/src/Xanthous/Entities/Creature.hs b/src/Xanthous/Entities/Creature.hs index 11cad1ce6b..de9122746b 100644 --- a/src/Xanthous/Entities/Creature.hs +++ b/src/Xanthous/Entities/Creature.hs @@ -35,7 +35,7 @@ import Data.Aeson.Generic.DerivingVia import Data.Aeson (ToJSON, FromJSON) -------------------------------------------------------------------------------- import Xanthous.Entities.RawTypes hiding (Creature, description) -import Xanthous.Entities (Draw(..), DrawRawCharPriority(..)) +import Xanthous.Game.State import Xanthous.Data -------------------------------------------------------------------------------- diff --git a/src/Xanthous/Entities/Entities.hs b/src/Xanthous/Entities/Entities.hs index 410a6514ae..7e41fc8b7b 100644 --- a/src/Xanthous/Entities/Entities.hs +++ b/src/Xanthous/Entities/Entities.hs @@ -9,7 +9,6 @@ import Test.QuickCheck import qualified Test.QuickCheck.Gen as Gen import Data.Aeson -------------------------------------------------------------------------------- -import Xanthous.Entities (Entity(..), SomeEntity(..)) import Xanthous.Entities.Character import Xanthous.Entities.Item import Xanthous.Entities.Creature @@ -46,6 +45,7 @@ deriving via WithOptions '[ FieldLabelModifier '[Drop 1] ] GameState instance Entity SomeEntity where blocksVision (SomeEntity ent) = blocksVision ent description (SomeEntity ent) = description ent + entityChar (SomeEntity ent) = entityChar ent instance Function SomeEntity where function = functionJSON diff --git a/src/Xanthous/Entities/Environment.hs b/src/Xanthous/Entities/Environment.hs index 8119199631..8baa07650f 100644 --- a/src/Xanthous/Entities/Environment.hs +++ b/src/Xanthous/Entities/Environment.hs @@ -14,17 +14,9 @@ import Brick.Widgets.Border.Style (unicode) import Brick.Types (Edges(..)) import Data.Aeson -------------------------------------------------------------------------------- -import Xanthous.Entities - ( Draw(..) - , entityIs - , Entity(..) - , SomeEntity - , Brain(..) - , Brainless(..) - , brainVia - ) import Xanthous.Entities.Draw.Util import Xanthous.Data +import Xanthous.Game.State -------------------------------------------------------------------------------- data Wall = Wall @@ -45,6 +37,7 @@ instance Brain Wall where step = brainVia Brainless instance Entity Wall where blocksVision _ = True description _ = "a wall" + entityChar _ = "┼" instance Arbitrary Wall where arbitrary = pure Wall @@ -90,3 +83,4 @@ instance Brain Door where step = brainVia Brainless instance Entity Door where blocksVision = not . view open description _ = "a door" + entityChar _ = "d" diff --git a/src/Xanthous/Entities/Item.hs b/src/Xanthous/Entities/Item.hs index ddd387af8c..465110069c 100644 --- a/src/Xanthous/Entities/Item.hs +++ b/src/Xanthous/Entities/Item.hs @@ -15,14 +15,7 @@ import Data.Aeson.Generic.DerivingVia -------------------------------------------------------------------------------- import Xanthous.Entities.RawTypes hiding (Item, description, isEdible) import qualified Xanthous.Entities.RawTypes as Raw -import Xanthous.Entities - ( Draw(..) - , Entity(..) - , DrawRawChar(..) - , Brain(..) - , Brainless(..) - , brainVia - ) +import Xanthous.Game.State -------------------------------------------------------------------------------- data Item = Item @@ -47,6 +40,7 @@ instance Arbitrary Item where instance Entity Item where blocksVision _ = False description = view $ itemType . Raw.description + entityChar = view $ itemType . Raw.char newWithType :: ItemType -> Item newWithType = Item diff --git a/src/Xanthous/Entities/RawTypes.hs b/src/Xanthous/Entities/RawTypes.hs index 09b250fb31..f715f8743a 100644 --- a/src/Xanthous/Entities/RawTypes.hs +++ b/src/Xanthous/Entities/RawTypes.hs @@ -10,6 +10,7 @@ module Xanthous.Entities.RawTypes , _Creature -- * Lens classes + , HasChar(..) , HasName(..) , HasDescription(..) , HasLongDescription(..) @@ -27,9 +28,9 @@ import Test.QuickCheck.Arbitrary.Generic import Data.Aeson.Generic.DerivingVia import Data.Aeson (ToJSON, FromJSON) -------------------------------------------------------------------------------- -import Xanthous.Entities (EntityChar, HasChar(..)) import Xanthous.Messages (Message(..)) import Xanthous.Data (TicksPerTile, Hitpoints) +import Xanthous.Data.EntityChar -------------------------------------------------------------------------------- data CreatureType = CreatureType { _name :: !Text diff --git a/src/Xanthous/Entities/Raws.hs b/src/Xanthous/Entities/Raws.hs index 9b7d63c6c4..d4cae7ccc2 100644 --- a/src/Xanthous/Entities/Raws.hs +++ b/src/Xanthous/Entities/Raws.hs @@ -14,7 +14,7 @@ import Xanthous.Prelude import System.FilePath.Posix -------------------------------------------------------------------------------- import Xanthous.Entities.RawTypes -import Xanthous.Entities +import Xanthous.Game.State import qualified Xanthous.Entities.Creature as Creature import qualified Xanthous.Entities.Item as Item import Xanthous.AI.Gormlak () diff --git a/src/Xanthous/Game/Arbitrary.hs b/src/Xanthous/Game/Arbitrary.hs index e8f9ae22c4..090eba634d 100644 --- a/src/Xanthous/Game/Arbitrary.hs +++ b/src/Xanthous/Game/Arbitrary.hs @@ -18,11 +18,11 @@ import qualified Xanthous.Data.EntityMap as EntityMap instance Arbitrary GameState where arbitrary = do - char <- arbitrary @Character + chr <- arbitrary @Character charPos <- arbitrary _messageHistory <- arbitrary (_characterEntityID, _entities) <- arbitrary <&> - EntityMap.insertAtReturningID charPos (SomeEntity char) + EntityMap.insertAtReturningID charPos (SomeEntity chr) _revealedPositions <- fmap setFromList . sublistOf $ EntityMap.positions _entities _randomGen <- mkStdGen <$> arbitrary let _promptState = NoPrompt -- TODO diff --git a/src/Xanthous/Game/Draw.hs b/src/Xanthous/Game/Draw.hs index 2f7ccf29f7..ab0e31f8a0 100644 --- a/src/Xanthous/Game/Draw.hs +++ b/src/Xanthous/Game/Draw.hs @@ -12,7 +12,7 @@ import Brick.Widgets.Edit import Xanthous.Data import Xanthous.Data.EntityMap (EntityMap, atPosition) import qualified Xanthous.Data.EntityMap as EntityMap -import Xanthous.Entities +import Xanthous.Game.State import Xanthous.Entities.Character import Xanthous.Game ( GameState(..) diff --git a/src/Xanthous/Game/Lenses.hs b/src/Xanthous/Game/Lenses.hs index cd7148442a..7dbd602901 100644 --- a/src/Xanthous/Game/Lenses.hs +++ b/src/Xanthous/Game/Lenses.hs @@ -37,11 +37,11 @@ getInitialState = initialStateFromSeed <$> getRandom initialStateFromSeed :: Int -> GameState initialStateFromSeed seed = let _randomGen = mkStdGen seed - char = mkCharacter + chr = mkCharacter (_characterEntityID, _entities) = EntityMap.insertAtReturningID (Position 0 0) - (SomeEntity char) + (SomeEntity chr) mempty _messageHistory = mempty _revealedPositions = mempty @@ -56,10 +56,10 @@ positionedCharacter :: Lens' GameState (Positioned Character) positionedCharacter = lens getPositionedCharacter setPositionedCharacter where setPositionedCharacter :: GameState -> Positioned Character -> GameState - setPositionedCharacter game char + setPositionedCharacter game chr = game & entities . at (game ^. characterEntityID) - ?~ fmap SomeEntity char + ?~ fmap SomeEntity chr getPositionedCharacter :: GameState -> Positioned Character getPositionedCharacter game diff --git a/src/Xanthous/Game/Prompt.hs b/src/Xanthous/Game/Prompt.hs index 6c3629f310..8e9ec04ccb 100644 --- a/src/Xanthous/Game/Prompt.hs +++ b/src/Xanthous/Game/Prompt.hs @@ -1,6 +1,8 @@ +{-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE GADTs #-} +{-# LANGUAGE DeriveFunctor #-} -------------------------------------------------------------------------------- module Xanthous.Game.Prompt ( PromptType(..) @@ -25,6 +27,7 @@ import Xanthous.Prelude import Brick.Widgets.Edit (Editor, editorText, getEditContents) import Test.QuickCheck import Test.QuickCheck.Arbitrary.Generic +import Control.Comonad -------------------------------------------------------------------------------- import Xanthous.Util (smallestNotIn) import Xanthous.Data (Direction, Position) @@ -159,9 +162,13 @@ instance CoArbitrary (PromptState ('Menu a)) where deriving stock instance Show (PromptState pt) data MenuOption a = MenuOption Text a - deriving stock (Eq, Generic) + deriving stock (Eq, Generic, Functor) deriving anyclass (NFData, CoArbitrary, Function) +instance Comonad MenuOption where + extract (MenuOption _ x) = x + extend cok mo@(MenuOption text _) = MenuOption text (cok mo) + mkMenuItems :: (MonoFoldable f, Element f ~ (Char, MenuOption a)) => f -> Map Char (MenuOption a) diff --git a/src/Xanthous/Game/State.hs b/src/Xanthous/Game/State.hs index 92c68a3f65..16d93c61ba 100644 --- a/src/Xanthous/Game/State.hs +++ b/src/Xanthous/Game/State.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE GADTs #-} @@ -36,6 +37,13 @@ module Xanthous.Game.State , downcastEntity , _SomeEntity , entityIs + , DrawRawChar(..) + , DrawRawCharPriority(..) + , DrawCharacter(..) + , DrawStyledCharacter(..) + -- ** Field classes + , HasChar(..) + , HasStyle(..) -- * Debug State , DebugState(..) @@ -55,13 +63,18 @@ import Test.QuickCheck.Arbitrary.Generic import Control.Monad.State.Class import Control.Monad.State import Control.Monad.Random.Class -import Brick (EventM, Widget) +import Brick (EventM, Widget, raw, str) import Data.Aeson (ToJSON(..), FromJSON(..), Value(Null)) import qualified Data.Aeson as JSON import Data.Aeson.Generic.DerivingVia +import Data.Generics.Product.Fields +import qualified Graphics.Vty.Attributes as Vty +import qualified Graphics.Vty.Image as Vty +import Control.Comonad -------------------------------------------------------------------------------- -import Xanthous.Data.EntityMap (EntityMap, EntityID) import Xanthous.Data +import Xanthous.Data.EntityMap (EntityMap, EntityID) +import Xanthous.Data.EntityChar import Xanthous.Orphans () import Xanthous.Game.Prompt import Xanthous.Resource @@ -181,6 +194,73 @@ instance Draw a => Draw (Positioned a) where drawWithNeighbors ns (Positioned _ a) = drawWithNeighbors ns a draw (Positioned _ a) = draw a +newtype DrawCharacter (char :: Symbol) (a :: Type) where + DrawCharacter :: a -> DrawCharacter char a + +instance KnownSymbol char => Draw (DrawCharacter char a) where + draw _ = str $ symbolVal @char Proxy + +data Color = Black | Red | Green | Yellow | Blue | Magenta | Cyan | White + +class KnownColor (color :: Color) where + colorVal :: forall proxy. proxy color -> Vty.Color + +instance KnownColor 'Black where colorVal _ = Vty.black +instance KnownColor 'Red where colorVal _ = Vty.red +instance KnownColor 'Green where colorVal _ = Vty.green +instance KnownColor 'Yellow where colorVal _ = Vty.yellow +instance KnownColor 'Blue where colorVal _ = Vty.blue +instance KnownColor 'Magenta where colorVal _ = Vty.magenta +instance KnownColor 'Cyan where colorVal _ = Vty.cyan +instance KnownColor 'White where colorVal _ = Vty.white + +newtype DrawStyledCharacter (fg :: Color) (bg :: Color) (char :: Symbol) (a :: Type) where + DrawStyledCharacter :: a -> DrawStyledCharacter fg bg char a + +instance + ( KnownColor fg + , KnownColor bg + , KnownSymbol char + ) + => Draw (DrawStyledCharacter fg bg char a) where + draw _ = raw $ Vty.string attr $ symbolVal @char Proxy + where attr = Vty.Attr + { Vty.attrStyle = Vty.Default + , Vty.attrForeColor = Vty.SetTo $ colorVal @fg Proxy + , Vty.attrBackColor = Vty.SetTo $ colorVal @bg Proxy + , Vty.attrURL = Vty.Default + } + +instance Draw EntityChar where + draw EntityChar{..} = raw $ Vty.string _style [_char] + +-------------------------------------------------------------------------------- + +newtype DrawRawChar (rawField :: Symbol) (a :: Type) = DrawRawChar a + +instance + forall rawField a raw. + ( HasField rawField a a raw raw + , HasChar raw EntityChar + ) => Draw (DrawRawChar rawField a) where + draw (DrawRawChar e) = draw $ e ^. field @rawField . char + +newtype DrawRawCharPriority + (rawField :: Symbol) + (priority :: Nat) + (a :: Type) + = DrawRawCharPriority a + +instance + forall rawField priority a raw. + ( HasField rawField a a raw raw + , KnownNat priority + , HasChar raw EntityChar + ) => Draw (DrawRawCharPriority rawField priority a) where + draw (DrawRawCharPriority e) = draw $ e ^. field @rawField . char + drawPriority = const . fromIntegral $ natVal @priority Proxy + + -------------------------------------------------------------------------------- class Brain a where @@ -208,6 +288,7 @@ class ( Show a, Eq a, NFData a ) => Entity a where blocksVision :: a -> Bool description :: a -> Text + entityChar :: a -> EntityChar data SomeEntity where SomeEntity :: forall a. (Entity a, Typeable a) => a -> SomeEntity diff --git a/src/Xanthous/Orphans.hs b/src/Xanthous/Orphans.hs index 6714a3bc56..bb6b0d024e 100644 --- a/src/Xanthous/Orphans.hs +++ b/src/Xanthous/Orphans.hs @@ -21,7 +21,6 @@ import Data.Text.Zipper.Generic (GenericTextZipper) import Brick.Widgets.Core (getName) import System.Random (StdGen) import Test.QuickCheck -import Test.QuickCheck.Arbitrary.Generic import Text.Megaparsec (errorBundlePretty) import Text.Megaparsec.Pos import Text.Mustache diff --git a/src/Xanthous/Prelude.hs b/src/Xanthous/Prelude.hs index 756642440b..b17fd2897b 100644 --- a/src/Xanthous/Prelude.hs +++ b/src/Xanthous/Prelude.hs @@ -1,3 +1,4 @@ +-------------------------------------------------------------------------------- module Xanthous.Prelude ( module ClassyPrelude , Type @@ -5,11 +6,14 @@ module Xanthous.Prelude , module GHC.TypeLits , module Control.Lens , module Data.Void + , module Control.Comonad ) where - +-------------------------------------------------------------------------------- import ClassyPrelude hiding (return, (<|), unsnoc, uncons, cons, snoc, index, (<.>), Index, say) import Data.Kind import GHC.TypeLits hiding (Text) import Control.Lens import Data.Void +import Control.Comonad +-------------------------------------------------------------------------------- diff --git a/src/Xanthous/messages.yaml b/src/Xanthous/messages.yaml index 71f08f2631..ae9ca060bf 100644 --- a/src/Xanthous/messages.yaml +++ b/src/Xanthous/messages.yaml @@ -12,7 +12,8 @@ save: entities: description: You see here {{entityDescriptions}} -items: +pickUp: + menu: What would you like to pick up? pickUp: You pick up the {{item.itemType.name}} nothingToPickUp: "There's nothing here to pick up" @@ -31,6 +32,7 @@ character: combat: nothingToAttack: There's nothing to attack there. + menu: Which creature would you like to attack? hit: - You hit the {{creature.creatureType.name}}. - You attack the {{creature.creatureType.name}}. diff --git a/test/Spec.hs b/test/Spec.hs index bd31867294..cd2827e58b 100644 --- a/test/Spec.hs +++ b/test/Spec.hs @@ -1,23 +1,23 @@ import Test.Prelude +import qualified Xanthous.Data.EntityCharSpec import qualified Xanthous.Data.EntityMapSpec import qualified Xanthous.DataSpec -import qualified Xanthous.EntitiesSpec import qualified Xanthous.Entities.RawsSpec import qualified Xanthous.GameSpec import qualified Xanthous.Generators.UtilSpec import qualified Xanthous.MessageSpec import qualified Xanthous.OrphansSpec -import qualified Xanthous.UtilSpec import qualified Xanthous.Util.GraphicsSpec import qualified Xanthous.Util.InflectionSpec +import qualified Xanthous.UtilSpec main :: IO () main = defaultMain test test :: TestTree test = testGroup "Xanthous" - [ Xanthous.Data.EntityMapSpec.test - , Xanthous.EntitiesSpec.test + [ Xanthous.Data.EntityCharSpec.test + , Xanthous.Data.EntityMapSpec.test , Xanthous.Entities.RawsSpec.test , Xanthous.GameSpec.test , Xanthous.Generators.UtilSpec.test diff --git a/test/Xanthous/Data/EntityCharSpec.hs b/test/Xanthous/Data/EntityCharSpec.hs new file mode 100644 index 0000000000..9e8024c9d2 --- /dev/null +++ b/test/Xanthous/Data/EntityCharSpec.hs @@ -0,0 +1,18 @@ +-------------------------------------------------------------------------------- +module Xanthous.Data.EntityCharSpec where +-------------------------------------------------------------------------------- +import Test.Prelude +-------------------------------------------------------------------------------- +import qualified Data.Aeson as JSON +-------------------------------------------------------------------------------- +import Xanthous.Data.EntityChar +-------------------------------------------------------------------------------- + +main :: IO () +main = defaultMain test + +test :: TestTree +test = testGroup "Xanthous.Data.EntityChar" + [ testProperty "JSON round-trip" $ \(ec :: EntityChar) -> + JSON.decode (JSON.encode ec) === Just ec + ] diff --git a/test/Xanthous/EntitiesSpec.hs b/test/Xanthous/EntitiesSpec.hs deleted file mode 100644 index 14b03f7293..0000000000 --- a/test/Xanthous/EntitiesSpec.hs +++ /dev/null @@ -1,20 +0,0 @@ --------------------------------------------------------------------------------- -module Xanthous.EntitiesSpec where --------------------------------------------------------------------------------- -import Test.Prelude --------------------------------------------------------------------------------- -import qualified Data.Aeson as JSON --------------------------------------------------------------------------------- -import Xanthous.Entities --------------------------------------------------------------------------------- - -main :: IO () -main = defaultMain test - -test :: TestTree -test = testGroup "Xanthous.Entities" - [ testGroup "EntityChar" - [ testProperty "JSON round-trip" $ \(ec :: EntityChar) -> - JSON.decode (JSON.encode ec) === Just ec - ] - ] diff --git a/test/Xanthous/GameSpec.hs b/test/Xanthous/GameSpec.hs index f9a9c543b9..75e9f6215a 100644 --- a/test/Xanthous/GameSpec.hs +++ b/test/Xanthous/GameSpec.hs @@ -2,10 +2,10 @@ module Xanthous.GameSpec where import Test.Prelude hiding (Down) import Xanthous.Game +import Xanthous.Game.State import Control.Lens.Properties import Xanthous.Data (move, Direction(Down)) import Xanthous.Data.EntityMap (atPosition) -import Xanthous.Entities (SomeEntity(SomeEntity)) main :: IO () main = defaultMain test diff --git a/xanthous.cabal b/xanthous.cabal index 7204dc0f0f..a5fbe9b4dc 100644 --- a/xanthous.cabal +++ b/xanthous.cabal @@ -4,7 +4,7 @@ cabal-version: 1.12 -- -- see: https://github.com/sol/hpack -- --- hash: 0ec32d45d89e30640d8d59137c5eaa80e5eed7eb31cb553d9b251db94ed1ba36 +-- hash: 2f93900ad18d56709eb363a7f8dd251a9474dd7092b1aef956389f32c036a121 name: xanthous version: 0.1.0.0 @@ -34,9 +34,9 @@ library Xanthous.App Xanthous.Command Xanthous.Data + Xanthous.Data.EntityChar Xanthous.Data.EntityMap Xanthous.Data.EntityMap.Graphics - Xanthous.Entities Xanthous.Entities.Character Xanthous.Entities.Creature Xanthous.Entities.Draw.Util @@ -81,6 +81,7 @@ library , brick , checkers , classy-prelude + , comonad , constraints , containers , data-default @@ -120,9 +121,9 @@ executable xanthous Xanthous.App Xanthous.Command Xanthous.Data + Xanthous.Data.EntityChar Xanthous.Data.EntityMap Xanthous.Data.EntityMap.Graphics - Xanthous.Entities Xanthous.Entities.Character Xanthous.Entities.Creature Xanthous.Entities.Draw.Util @@ -166,6 +167,7 @@ executable xanthous , brick , checkers , classy-prelude + , comonad , constraints , containers , data-default @@ -203,10 +205,10 @@ test-suite test main-is: Spec.hs other-modules: Test.Prelude + Xanthous.Data.EntityCharSpec Xanthous.Data.EntityMapSpec Xanthous.DataSpec Xanthous.Entities.RawsSpec - Xanthous.EntitiesSpec Xanthous.GameSpec Xanthous.Generators.UtilSpec Xanthous.MessageSpec @@ -228,6 +230,7 @@ test-suite test , brick , checkers , classy-prelude + , comonad , constraints , containers , data-default -- cgit 1.4.1 From 92976cc9aad41c1f7b2c83dbbd22e0cf7e26b626 Mon Sep 17 00:00:00 2001 From: Griffin Smith Date: Fri, 29 Nov 2019 23:01:36 -0500 Subject: Move patch file to a less obtrusive location --- build/generic-arbitrary-export-garbitrary.patch | 12 ++++++++++++ generic-arbitrary-export-garbitrary.patch | 12 ------------ haskell-overlay.nix | 2 +- shell.nix | 2 +- 4 files changed, 14 insertions(+), 14 deletions(-) create mode 100644 build/generic-arbitrary-export-garbitrary.patch delete mode 100644 generic-arbitrary-export-garbitrary.patch diff --git a/build/generic-arbitrary-export-garbitrary.patch b/build/generic-arbitrary-export-garbitrary.patch new file mode 100644 index 0000000000..f0c936bfca --- /dev/null +++ b/build/generic-arbitrary-export-garbitrary.patch @@ -0,0 +1,12 @@ +diff --git a/src/Test/QuickCheck/Arbitrary/Generic.hs b/src/Test/QuickCheck/Arbitrary/Generic.hs +index fed6ab3..91f59f1 100644 +--- a/src/Test/QuickCheck/Arbitrary/Generic.hs ++++ b/src/Test/QuickCheck/Arbitrary/Generic.hs +@@ -23,6 +23,7 @@ The generated 'arbitrary' method is equivalent to + + module Test.QuickCheck.Arbitrary.Generic + ( Arbitrary(..) ++ , GArbitrary + , genericArbitrary + , genericShrink + ) where diff --git a/generic-arbitrary-export-garbitrary.patch b/generic-arbitrary-export-garbitrary.patch deleted file mode 100644 index f0c936bfca..0000000000 --- a/generic-arbitrary-export-garbitrary.patch +++ /dev/null @@ -1,12 +0,0 @@ -diff --git a/src/Test/QuickCheck/Arbitrary/Generic.hs b/src/Test/QuickCheck/Arbitrary/Generic.hs -index fed6ab3..91f59f1 100644 ---- a/src/Test/QuickCheck/Arbitrary/Generic.hs -+++ b/src/Test/QuickCheck/Arbitrary/Generic.hs -@@ -23,6 +23,7 @@ The generated 'arbitrary' method is equivalent to - - module Test.QuickCheck.Arbitrary.Generic - ( Arbitrary(..) -+ , GArbitrary - , genericArbitrary - , genericShrink - ) where diff --git a/haskell-overlay.nix b/haskell-overlay.nix index 90ba35c6af..959f63c5a0 100644 --- a/haskell-overlay.nix +++ b/haskell-overlay.nix @@ -3,5 +3,5 @@ let inherit (nixpkgs) pkgs; in self: super: rec { generic-arbitrary = pkgs.haskell.lib.appendPatch super.generic-arbitrary - [ ./generic-arbitrary-export-garbitrary.patch ]; + [ ./build/generic-arbitrary-export-garbitrary.patch ]; } diff --git a/shell.nix b/shell.nix index d1c2b7ad91..915e3e748a 100644 --- a/shell.nix +++ b/shell.nix @@ -21,7 +21,7 @@ let # eww https://github.com/NixOS/nixpkgs/issues/16394 generic-arbitrary = pkgs.haskell.lib.appendPatch super.generic-arbitrary - [ ./generic-arbitrary-export-garbitrary.patch ]; + [ ./build/generic-arbitrary-export-garbitrary.patch ]; }); } else packageSet -- cgit 1.4.1 From 310ea90985adcb6d9efe2ab05c67a235c2fb0ea2 Mon Sep 17 00:00:00 2001 From: Griffin Smith Date: Sat, 30 Nov 2019 14:13:07 -0500 Subject: Add build and run instructions to the README just for the heck of it. --- README.org | 32 ++++++++++++++++++++++++++++++++ 1 file changed, 32 insertions(+) diff --git a/README.org b/README.org index 2f766ec1b6..5d3b2af048 100644 --- a/README.org +++ b/README.org @@ -1 +1,33 @@ #+TITLE: Xanthous + +* Building + +#+BEGIN_SRC shell +$ nix build +#+END_SRC + +* Running + +#+BEGIN_SRC shell +$ ./result +#+END_SRC + +** Keyboard commands + +Keyboard commands are currently undocumented, but can be found in [[[https://github.com/glittershark/xanthous/blob/master/src/Xanthous/Command.hs#L26][this file]]. +Movement uses the nethack-esque hjklybnu. + +* Development + +#+BEGIN_SRC shell +$ nix-shell + +# Build (for dev) +[nix-shell:xanthous]$ cabal new-build + +# Run tests +[nix-shell:xanthous]$ cabal new-run test + +# Run a repl +[nix-shell:xanthous]$ cabal new-repl +#+END_SRC -- cgit 1.4.1 From 97a5c61f28ba98728bab390e0ea745edfbea7103 Mon Sep 17 00:00:00 2001 From: Griffin Smith Date: Sat, 30 Nov 2019 15:00:39 -0500 Subject: Fix an injectivity issue with saving the game Fix an injectivity issue with JSON-encoding the entity map that was causing the game saving to not properly round-trip. As part of this, there's a refactor to the internals of the entity map to use sets instead of vectors, which should also get us a nice perf boost. --- package.yaml | 3 +++ src/Xanthous/Data.hs | 2 +- src/Xanthous/Data/EntityChar.hs | 2 +- src/Xanthous/Data/EntityMap.hs | 49 ++++++++++++++++++++++++------------- src/Xanthous/Entities/Character.hs | 2 +- src/Xanthous/Entities/Creature.hs | 6 ++--- src/Xanthous/Entities/Item.hs | 2 +- src/Xanthous/Entities/RawTypes.hs | 6 ++--- src/Xanthous/Game/Prompt.hs | 1 - src/Xanthous/Game/State.hs | 9 +++++-- src/Xanthous/Orphans.hs | 4 +++ src/Xanthous/Prelude.hs | 17 +++++++++++++ test/Xanthous/Data/EntityMapSpec.hs | 10 +++++++- test/Xanthous/GameSpec.hs | 2 ++ xanthous.cabal | 9 ++++--- 15 files changed, 90 insertions(+), 34 deletions(-) diff --git a/package.yaml b/package.yaml index cadfd04d8d..f982a23397 100644 --- a/package.yaml +++ b/package.yaml @@ -41,6 +41,7 @@ dependencies: - MonadRandom - mtl - optparse-applicative +- parallel - random - random-fu - random-extras @@ -97,6 +98,7 @@ executable: - -threaded - -rtsopts - -with-rtsopts=-N + - -O2 tests: test: @@ -106,6 +108,7 @@ tests: - -threaded - -rtsopts - -with-rtsopts=-N + - -O0 dependencies: - xanthous - tasty diff --git a/src/Xanthous/Data.hs b/src/Xanthous/Data.hs index fdeb71beb5..dfad2cffd3 100644 --- a/src/Xanthous/Data.hs +++ b/src/Xanthous/Data.hs @@ -115,7 +115,7 @@ type Position = Position' Int instance Arbitrary a => Arbitrary (Position' a) where arbitrary = genericArbitrary - shrink = genericShrink + shrink (Position px py) = Position <$> shrink px <*> shrink py instance Num a => Semigroup (Position' a) where diff --git a/src/Xanthous/Data/EntityChar.hs b/src/Xanthous/Data/EntityChar.hs index 7aeb5fdf86..855a3462da 100644 --- a/src/Xanthous/Data/EntityChar.hs +++ b/src/Xanthous/Data/EntityChar.hs @@ -30,7 +30,7 @@ data EntityChar = EntityChar { _char :: Char , _style :: Vty.Attr } - deriving stock (Show, Eq, Generic) + deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, CoArbitrary, Function) deriving Arbitrary via GenericArbitrary EntityChar makeFieldsNoPrefix ''EntityChar diff --git a/src/Xanthous/Data/EntityMap.hs b/src/Xanthous/Data/EntityMap.hs index 9ca9155535..9ea952c054 100644 --- a/src/Xanthous/Data/EntityMap.hs +++ b/src/Xanthous/Data/EntityMap.hs @@ -27,6 +27,7 @@ module Xanthous.Data.EntityMap -- * debug , byID , byPosition + , lastID ) where -------------------------------------------------------------------------------- @@ -46,26 +47,28 @@ import Test.QuickCheck (Arbitrary(..), CoArbitrary, Function) import Test.QuickCheck.Checkers (EqProp) import Test.QuickCheck.Instances.UnorderedContainers () import Test.QuickCheck.Instances.Vector () +import Text.Show (showString, showParen) import Data.Aeson -------------------------------------------------------------------------------- type EntityID = Word32 -type NonNullVector a = NonNull (Vector a) +type NonNullSet a = NonNull (Set a) data EntityMap a where EntityMap :: - { _byPosition :: Map Position (NonNullVector EntityID) + { _byPosition :: Map Position (NonNullSet EntityID) , _byID :: HashMap EntityID (Positioned a) , _lastID :: EntityID } -> EntityMap a deriving stock (Functor, Foldable, Traversable, Generic) deriving anyclass (NFData, CoArbitrary, Function) -deriving via (EqEqProp (EntityMap a)) instance Eq a => EqProp (EntityMap a) +deriving via (EqEqProp (EntityMap a)) instance (Eq a, Ord a) => EqProp (EntityMap a) makeLenses ''EntityMap instance ToJSON a => ToJSON (EntityMap a) where toJSON = toJSON . toEIDsAndPositioned + instance FromJSON a => FromJSON (EntityMap a) where parseJSON = fmap (fromEIDsAndPositioned @[_]) . parseJSON @@ -73,14 +76,24 @@ byIDInvariantError :: forall a. a byIDInvariantError = error $ "Invariant violation: All EntityIDs in byPosition " <> "must point to entityIDs in byID" -instance Eq a => Eq (EntityMap a) where - em₁ == em₂ = em₁ ^. _EntityMap == em₂ ^. _EntityMap +instance (Ord a, Eq a) => Eq (EntityMap a) where + -- em₁ == em₂ = em₁ ^. _EntityMap == em₂ ^. _EntityMap + (==) = (==) `on` view (_EntityMap . to sort) + +deriving stock instance (Ord a) => Ord (EntityMap a) instance Show a => Show (EntityMap a) where - show em = "_EntityMap # " <> show (em ^. _EntityMap) + showsPrec pr em + = showParen (pr > 10) + $ showString + . ("fromEIDsAndPositioned " <>) + . show + . toEIDsAndPositioned + $ em instance Arbitrary a => Arbitrary (EntityMap a) where arbitrary = review _EntityMap <$> arbitrary + shrink em = review _EntityMap <$> shrink (em ^. _EntityMap) type instance Index (EntityMap a) = EntityID type instance IxValue (EntityMap a) = (Positioned a) @@ -102,10 +115,10 @@ instance At (EntityMap a) where ) & byID . at eid ?~ pe & byPosition . at pos %~ \case - Nothing -> Just $ ncons eid mempty - Just es -> Just $ eid <| es + Nothing -> Just $ opoint eid + Just es -> Just $ ninsertSet eid es removeEIDAtPos pos = - byPosition . at pos %~ (>>= fromNullable . nfilter (/= eid)) + byPosition . at pos %~ (>>= fromNullable . ndeleteSet eid) instance Semigroup (EntityMap a) where em₁ <> em₂ = alaf Endo foldMap (uncurry insertAt) (em₂ ^. _EntityMap) em₁ @@ -137,8 +150,8 @@ instance Semigroup (Deduplicate a) where _byPosition = mempty &~ do ifor_ _byID $ \eid (Positioned pos _) -> at pos %= \case - Just eids -> Just $ eid <| eids - Nothing -> Just $ ncons eid mempty + Just eids -> Just $ ninsertSet eid eids + Nothing -> Just $ opoint eid _lastID = fromMaybe 1 $ maximumOf (ifolded . asIndex) _byID in Deduplicate EntityMap{..} @@ -164,8 +177,8 @@ insertAtReturningID pos e em = in em' & byID . at eid ?~ Positioned pos e & byPosition . at pos %~ \case - Nothing -> Just $ ncons eid mempty - Just es -> Just $ eid <| es + Nothing -> Just $ opoint eid + Just es -> Just $ ninsertSet eid es & (eid, ) insertAt :: forall a. Position -> a -> EntityMap a -> EntityMap a @@ -176,7 +189,8 @@ atPosition pos = lens getter setter where getter em = let eids :: Vector EntityID - eids = maybe mempty toNullable $ em ^. byPosition . at pos + eids = maybe mempty (toVector . toNullable) + $ em ^. byPosition . at pos in getEIDAssume em <$> eids setter em Empty = em & byPosition . at pos .~ Nothing setter em entities = alaf Endo foldMap (insertAt pos) entities em @@ -187,7 +201,8 @@ getEIDAssume em eid = fromMaybe byIDInvariantError atPositionWithIDs :: Position -> EntityMap a -> Vector (EntityID, Positioned a) atPositionWithIDs pos em = - let eids = maybe mempty toNullable $ em ^. byPosition . at pos + let eids = maybe mempty (toVector . toNullable) + $ em ^. byPosition . at pos in (id &&& Positioned pos . getEIDAssume em) <$> eids fromEIDsAndPositioned @@ -199,8 +214,8 @@ fromEIDsAndPositioned eps = newLastID $ alaf Endo foldMap insert' eps mempty insert' (eid, pe@(Positioned pos _)) = (byID . at eid ?~ pe) . (byPosition . at pos %~ \case - Just eids -> Just $ eid <| eids - Nothing -> Just $ ncons eid mempty + Just eids -> Just $ ninsertSet eid eids + Nothing -> Just $ opoint eid ) newLastID em = em & lastID .~ fromMaybe 1 diff --git a/src/Xanthous/Entities/Character.hs b/src/Xanthous/Entities/Character.hs index 22589252ac..dd14390df9 100644 --- a/src/Xanthous/Entities/Character.hs +++ b/src/Xanthous/Entities/Character.hs @@ -39,7 +39,7 @@ data Character = Character , _characterHitpoints' :: !Double , _speed :: TicksPerTile } - deriving stock (Show, Eq, Generic) + deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, CoArbitrary, Function) deriving (ToJSON, FromJSON) via WithOptions '[ FieldLabelModifier '[Drop 1] ] diff --git a/src/Xanthous/Entities/Creature.hs b/src/Xanthous/Entities/Creature.hs index de9122746b..6f97c128d2 100644 --- a/src/Xanthous/Entities/Creature.hs +++ b/src/Xanthous/Entities/Creature.hs @@ -47,7 +47,7 @@ data Destination = Destination -- When this value reaches >= 1, the creature has reached their destination , _destinationProgress :: !Tiles } - deriving stock (Eq, Show, Generic) + deriving stock (Eq, Show, Ord, Generic) deriving anyclass (NFData, CoArbitrary, Function) deriving (ToJSON, FromJSON) via WithOptions '[ FieldLabelModifier '[Drop 1] ] @@ -63,7 +63,7 @@ destinationFromPos _destinationPosition = data Hippocampus = Hippocampus { _destination :: !(Maybe Destination) } - deriving stock (Eq, Show, Generic) + deriving stock (Eq, Show, Ord, Generic) deriving anyclass (NFData, CoArbitrary, Function) deriving (ToJSON, FromJSON) via WithOptions '[ FieldLabelModifier '[Drop 1] ] @@ -81,7 +81,7 @@ data Creature = Creature , _hitpoints :: !Hitpoints , _hippocampus :: !Hippocampus } - deriving stock (Eq, Show, Generic) + deriving stock (Eq, Show, Ord, Generic) deriving anyclass (NFData, CoArbitrary, Function) deriving Draw via DrawRawCharPriority "_creatureType" 1000 Creature deriving (ToJSON, FromJSON) diff --git a/src/Xanthous/Entities/Item.hs b/src/Xanthous/Entities/Item.hs index 465110069c..0156cd54c8 100644 --- a/src/Xanthous/Entities/Item.hs +++ b/src/Xanthous/Entities/Item.hs @@ -21,7 +21,7 @@ import Xanthous.Game.State data Item = Item { _itemType :: ItemType } - deriving stock (Eq, Show, Generic) + deriving stock (Eq, Show, Ord, Generic) deriving anyclass (NFData, CoArbitrary, Function) deriving Draw via DrawRawChar "_itemType" Item deriving (ToJSON, FromJSON) diff --git a/src/Xanthous/Entities/RawTypes.hs b/src/Xanthous/Entities/RawTypes.hs index f715f8743a..822b93f2df 100644 --- a/src/Xanthous/Entities/RawTypes.hs +++ b/src/Xanthous/Entities/RawTypes.hs @@ -40,7 +40,7 @@ data CreatureType = CreatureType , _friendly :: !Bool , _speed :: !TicksPerTile } - deriving stock (Show, Eq, Generic) + deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, CoArbitrary, Function) deriving (ToJSON, FromJSON) via WithOptions '[ FieldLabelModifier '[Drop 1] ] @@ -56,7 +56,7 @@ data EdibleItem = EdibleItem { _hitpointsHealed :: Int , _eatMessage :: Maybe Message } - deriving stock (Show, Eq, Generic) + deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, CoArbitrary, Function) deriving (ToJSON, FromJSON) via WithOptions '[ FieldLabelModifier '[Drop 1] ] @@ -73,7 +73,7 @@ data ItemType = ItemType , _char :: EntityChar , _edible :: Maybe EdibleItem } - deriving stock (Show, Eq, Generic) + deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, CoArbitrary, Function) deriving (ToJSON, FromJSON) via WithOptions '[ FieldLabelModifier '[Drop 1] ] diff --git a/src/Xanthous/Game/Prompt.hs b/src/Xanthous/Game/Prompt.hs index 8e9ec04ccb..b83c3d246f 100644 --- a/src/Xanthous/Game/Prompt.hs +++ b/src/Xanthous/Game/Prompt.hs @@ -27,7 +27,6 @@ import Xanthous.Prelude import Brick.Widgets.Edit (Editor, editorText, getEditContents) import Test.QuickCheck import Test.QuickCheck.Arbitrary.Generic -import Control.Comonad -------------------------------------------------------------------------------- import Xanthous.Util (smallestNotIn) import Xanthous.Data (Direction, Position) diff --git a/src/Xanthous/Game/State.hs b/src/Xanthous/Game/State.hs index 16d93c61ba..028688542a 100644 --- a/src/Xanthous/Game/State.hs +++ b/src/Xanthous/Game/State.hs @@ -70,7 +70,6 @@ import Data.Aeson.Generic.DerivingVia import Data.Generics.Product.Fields import qualified Graphics.Vty.Attributes as Vty import qualified Graphics.Vty.Image as Vty -import Control.Comonad -------------------------------------------------------------------------------- import Xanthous.Data import Xanthous.Data.EntityMap (EntityMap, EntityID) @@ -282,7 +281,7 @@ brainVia _ ticks = fmap coerce . step ticks . coerce @_ @(Positioned brain) -------------------------------------------------------------------------------- -class ( Show a, Eq a, NFData a +class ( Show a, Eq a, Ord a, NFData a , ToJSON a, FromJSON a , Draw a, Brain a ) => Entity a where @@ -301,6 +300,12 @@ instance Eq SomeEntity where Just Refl -> a == b _ -> False +instance Ord SomeEntity where + compare (SomeEntity (a :: ea)) (SomeEntity (b :: eb)) = case eqT @ea @eb of + Just Refl -> compare a b + _ -> compare (typeRep $ Proxy @ea) (typeRep $ Proxy @eb) + + instance NFData SomeEntity where rnf (SomeEntity ent) = ent `deepseq` () diff --git a/src/Xanthous/Orphans.hs b/src/Xanthous/Orphans.hs index bb6b0d024e..6a860e1c49 100644 --- a/src/Xanthous/Orphans.hs +++ b/src/Xanthous/Orphans.hs @@ -306,6 +306,10 @@ instance FromJSON Attr where parseStyle Default = pure Default parseStyle KeepCurrent = pure KeepCurrent +deriving stock instance Ord Color +deriving stock instance Ord a => Ord (MaybeDefault a) +deriving stock instance Ord Attr + -------------------------------------------------------------------------------- instance NFData a => NFData (NonNull a) where diff --git a/src/Xanthous/Prelude.hs b/src/Xanthous/Prelude.hs index b17fd2897b..2f50635e78 100644 --- a/src/Xanthous/Prelude.hs +++ b/src/Xanthous/Prelude.hs @@ -7,6 +7,12 @@ module Xanthous.Prelude , module Control.Lens , module Data.Void , module Control.Comonad + + + -- * Classy-Prelude addons + , ninsertSet + , ndeleteSet + , toVector ) where -------------------------------------------------------------------------------- import ClassyPrelude hiding @@ -17,3 +23,14 @@ import Control.Lens import Data.Void import Control.Comonad -------------------------------------------------------------------------------- + +ninsertSet + :: (IsSet set, MonoPointed set) + => Element set -> NonNull set -> NonNull set +ninsertSet x xs = impureNonNull $ opoint x `union` toNullable xs + +ndeleteSet :: IsSet b => Element b -> NonNull b -> b +ndeleteSet x = deleteSet x . toNullable + +toVector :: (MonoFoldable (f a), Element (f a) ~ a) => f a -> Vector a +toVector = fromList . toList diff --git a/test/Xanthous/Data/EntityMapSpec.hs b/test/Xanthous/Data/EntityMapSpec.hs index 53f03020f3..88e0d0d771 100644 --- a/test/Xanthous/Data/EntityMapSpec.hs +++ b/test/Xanthous/Data/EntityMapSpec.hs @@ -33,7 +33,15 @@ test = localOption (QuickCheckTests 20) else True ] , testGroup "JSON encoding/decoding" - [ testProperty "Preserves IDs" $ \(em :: EntityMap Int) -> + [ testProperty "round-trips" $ \(em :: EntityMap Int) -> + let em' = JSON.decode (JSON.encode em) + in counterexample (show (em' ^? _Just . lastID, em ^. lastID + , em' ^? _Just . byID == em ^. byID . re _Just + , em' ^? _Just . byPosition == em ^. byPosition . re _Just + , em' ^? _Just . _EntityMap == em ^. _EntityMap . re _Just + )) + $ em' === Just em + , testProperty "Preserves IDs" $ \(em :: EntityMap Int) -> let Just em' = JSON.decode $ JSON.encode em in toEIDsAndPositioned em' === toEIDsAndPositioned em ] diff --git a/test/Xanthous/GameSpec.hs b/test/Xanthous/GameSpec.hs index 75e9f6215a..2fa8527d0e 100644 --- a/test/Xanthous/GameSpec.hs +++ b/test/Xanthous/GameSpec.hs @@ -46,6 +46,8 @@ test ] , testGroup "Saving the game" [ testProperty "forms a prism" $ isPrism saved + , testProperty "round-trips" $ \gs -> + loadGame (saveGame gs) === Just gs , testProperty "preserves the character ID" $ \gs -> let Just gs' = loadGame $ saveGame gs in gs' ^. character === gs ^. character diff --git a/xanthous.cabal b/xanthous.cabal index a5fbe9b4dc..7198e9ab9d 100644 --- a/xanthous.cabal +++ b/xanthous.cabal @@ -4,7 +4,7 @@ cabal-version: 1.12 -- -- see: https://github.com/sol/hpack -- --- hash: 2f93900ad18d56709eb363a7f8dd251a9474dd7092b1aef956389f32c036a121 +-- hash: 0476b4307dfceb20b9358ca2e6f78c753e3e0a4ae60c6faed54528f6a9c0dc5c name: xanthous version: 0.1.0.0 @@ -96,6 +96,7 @@ library , megaparsec , mtl , optparse-applicative + , parallel , quickcheck-instances , quickcheck-text , random @@ -157,7 +158,7 @@ executable xanthous hs-source-dirs: src default-extensions: BlockArguments ConstraintKinds DataKinds DeriveAnyClass DeriveGeneric DerivingStrategies DerivingVia FlexibleContexts FlexibleInstances FunctionalDependencies GADTSyntax GeneralizedNewtypeDeriving KindSignatures LambdaCase MultiWayIf NoImplicitPrelude NoStarIsType OverloadedStrings PolyKinds RankNTypes ScopedTypeVariables TupleSections TypeApplications TypeFamilies TypeOperators - ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N + ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N -O2 build-depends: MonadRandom , QuickCheck @@ -182,6 +183,7 @@ executable xanthous , megaparsec , mtl , optparse-applicative + , parallel , quickcheck-instances , quickcheck-text , random @@ -220,7 +222,7 @@ test-suite test hs-source-dirs: test default-extensions: BlockArguments ConstraintKinds DataKinds DeriveAnyClass DeriveGeneric DerivingStrategies DerivingVia FlexibleContexts FlexibleInstances FunctionalDependencies GADTSyntax GeneralizedNewtypeDeriving KindSignatures LambdaCase MultiWayIf NoImplicitPrelude NoStarIsType OverloadedStrings PolyKinds RankNTypes ScopedTypeVariables TupleSections TypeApplications TypeFamilies TypeOperators - ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N + ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N -O0 build-depends: MonadRandom , QuickCheck @@ -246,6 +248,7 @@ test-suite test , megaparsec , mtl , optparse-applicative + , parallel , quickcheck-instances , quickcheck-text , random -- cgit 1.4.1 From 0b22bb099c9f2254d16784e5897b18e9e410c2fa Mon Sep 17 00:00:00 2001 From: Griffin Smith Date: Sat, 30 Nov 2019 18:16:48 -0500 Subject: Fail on all warnings in CI All the undefineds are gone, so it's time to enable -Werror in CI. --- .github/actions/nix-build/entrypoint.sh | 2 +- .github/workflows/haskell.yml | 2 +- default.nix | 16 ++++++++++------ src/Xanthous/App.hs | 4 ++-- src/Xanthous/Util/QuickCheck.hs | 1 - 5 files changed, 14 insertions(+), 11 deletions(-) diff --git a/.github/actions/nix-build/entrypoint.sh b/.github/actions/nix-build/entrypoint.sh index 4499660edd..cb7aca541a 100755 --- a/.github/actions/nix-build/entrypoint.sh +++ b/.github/actions/nix-build/entrypoint.sh @@ -16,7 +16,7 @@ file="$1" [ ! -e "$file" ] && echo "File $file not exist!" && exit 1 echo "Building all attrs in $file..." -nix-build --no-link ${QUIET_ARG} "$file" +nix-build --no-link ${QUIET_ARG} "$file" "${@:2}" echo "Copying build closure to $(pwd)/store..." mapfile -t storePaths < <(nix-build ${QUIET_ARG} --no-link "$file" | grep -v cache-deps) diff --git a/.github/workflows/haskell.yml b/.github/workflows/haskell.yml index e1a57d4400..df82de3e8c 100644 --- a/.github/workflows/haskell.yml +++ b/.github/workflows/haskell.yml @@ -11,5 +11,5 @@ jobs: - uses: actions/checkout@v1 - name: Nix Build with: - args: default.nix + args: default.nix --arg failOnWarnings true uses: ./.github/actions/nix-build diff --git a/default.nix b/default.nix index ca163c8e56..a341398509 100644 --- a/default.nix +++ b/default.nix @@ -1,11 +1,15 @@ { nixpkgs ? import ./nixpkgs.nix {} -, compiler ? "ghc865" }: +, compiler ? "ghc865" +, failOnWarnings ? false +}: let - inherit (nixpkgs) pkgs; + inherit (nixpkgs) pkgs lib; + inherit (lib) id; all-hies = import (fetchTarball "https://github.com/infinisil/all-hies/tarball/master") {}; hie = all-hies.selection { selector = p: { inherit (p) ghc865; }; }; - xanthous = (pkgs.haskellPackages - .extend (import ./haskell-overlay.nix { inherit nixpkgs; })) - .callPackage (import ./pkg.nix { inherit nixpkgs; }) {}; -in + xanthous = + (if failOnWarnings then pkgs.haskell.lib.failOnAllWarnings else id) + ((pkgs.haskellPackages + .extend (import ./haskell-overlay.nix { inherit nixpkgs; }) + ).callPackage (import ./pkg.nix { inherit nixpkgs; }) {}); in xanthous // { inherit hie; } diff --git a/src/Xanthous/App.hs b/src/Xanthous/App.hs index 76e03e8609..b8cda3b777 100644 --- a/src/Xanthous/App.hs +++ b/src/Xanthous/App.hs @@ -411,5 +411,5 @@ entityMenu_ = mkMenuItems @[_] . map entityMenuItem then ec else 'a' -entityMenu :: Entity entity => [entity] -> Map Char (MenuOption entity) -entityMenu = map (map runIdentity) . entityMenu_ . fmap Identity +-- entityMenu :: Entity entity => [entity] -> Map Char (MenuOption entity) +-- entityMenu = map (map runIdentity) . entityMenu_ . fmap Identity diff --git a/src/Xanthous/Util/QuickCheck.hs b/src/Xanthous/Util/QuickCheck.hs index ba04f9ffb2..be12bc2945 100644 --- a/src/Xanthous/Util/QuickCheck.hs +++ b/src/Xanthous/Util/QuickCheck.hs @@ -14,7 +14,6 @@ import Test.QuickCheck.Function import Test.QuickCheck.Instances.ByteString () import Test.QuickCheck.Arbitrary.Generic import Data.Aeson -import Data.Coerce import GHC.Generics (Rep) -------------------------------------------------------------------------------- -- cgit 1.4.1 From 4431d453f61e88383aba40c8db3c4afb3c828b2e Mon Sep 17 00:00:00 2001 From: Griffin Smith Date: Sat, 30 Nov 2019 18:25:32 -0500 Subject: Use correct bin path in README nix build for a haskell package makes a directory, not just a bare binary. --- README.org | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/README.org b/README.org index 5d3b2af048..18542fee6f 100644 --- a/README.org +++ b/README.org @@ -9,7 +9,7 @@ $ nix build * Running #+BEGIN_SRC shell -$ ./result +$ ./result/bin/xanthous [--help] #+END_SRC ** Keyboard commands -- cgit 1.4.1 From 71b628c604556bc2d829f12980db99c9a526ec84 Mon Sep 17 00:00:00 2001 From: Griffin Smith Date: Sat, 30 Nov 2019 19:55:43 -0500 Subject: Add messages on the ground Add support for a "GroundMessage" entity type, support for a Read command to read them, and randomly place an initial, tone-setting tutorial message on the ground near the character at the beginning of the game. --- src/Data/Aeson/Generic/DerivingVia.hs | 7 ++++ src/Xanthous/App.hs | 29 +++++++++++++- src/Xanthous/Command.hs | 2 + src/Xanthous/Entities/Entities.hs | 2 + src/Xanthous/Entities/Environment.hs | 37 ++++++++++++++---- src/Xanthous/Game/Lenses.hs | 8 +++- src/Xanthous/Game/State.hs | 65 +++++++++++++++++++++++++++----- src/Xanthous/Generators.hs | 3 ++ src/Xanthous/Generators/LevelContents.hs | 29 ++++++++++++-- src/Xanthous/Messages.hs | 29 ++++++++------ src/Xanthous/Util.hs | 29 +++++++++++--- src/Xanthous/messages.yaml | 10 ++++- 12 files changed, 210 insertions(+), 40 deletions(-) diff --git a/src/Data/Aeson/Generic/DerivingVia.hs b/src/Data/Aeson/Generic/DerivingVia.hs index f387f1decc..34f2a94038 100644 --- a/src/Data/Aeson/Generic/DerivingVia.hs +++ b/src/Data/Aeson/Generic/DerivingVia.hs @@ -73,10 +73,17 @@ data Setting = FieldLabelModifier [StrFun] type FieldLabelModifier = 'FieldLabelModifier type ConstructorTagModifier = 'ConstructorTagModifier +-- | If 'True' the constructors of a datatype, with all nullary constructors, +-- will be encoded to just a string with the constructor tag. If 'False' the +-- encoding will always follow the 'SumEncoding'. type AllNullaryToStringTag = 'AllNullaryToStringTag type OmitNothingFields = 'OmitNothingFields type SumEnc = 'SumEnc +-- | Hide the field name when a record constructor has only one field, like a +-- newtype. type UnwrapUnaryRecords = 'UnwrapUnaryRecords +-- | Encode types with a single constructor as sums, so that +-- 'AllNullaryToStringTag' and 'SumEncoding' apply. type TagSingleConstructors = 'TagSingleConstructors class Demotable (a :: k) where diff --git a/src/Xanthous/App.hs b/src/Xanthous/App.hs index b8cda3b777..df76eadc3b 100644 --- a/src/Xanthous/App.hs +++ b/src/Xanthous/App.hs @@ -44,7 +44,8 @@ import Xanthous.Entities.Item (Item) import qualified Xanthous.Entities.Item as Item import Xanthous.Entities.Creature (Creature) import qualified Xanthous.Entities.Creature as Creature -import Xanthous.Entities.Environment (Door, open, locked) +import Xanthous.Entities.Environment + (Door, open, locked, GroundMessage(..)) import Xanthous.Entities.RawTypes (edible, eatMessage, hitpointsHealed) import Xanthous.Generators import qualified Xanthous.Generators.CaveAutomata as CaveAutomata @@ -84,6 +85,7 @@ initLevel = do entities <>= (SomeEntity <$> level ^. levelWalls) entities <>= (SomeEntity <$> level ^. levelItems) entities <>= (SomeEntity <$> level ^. levelCreatures) + entities <>= (SomeEntity <$> level ^. levelTutorialMessage) characterPosition .= level ^. levelCharacterPosition @@ -206,6 +208,29 @@ handleCommand Eat = do stepGame -- TODO continue +handleCommand Read = do + -- TODO allow reading things in the inventory (combo direction+menu prompt?) + prompt_ @'DirectionPrompt ["read", "prompt"] Cancellable + $ \(DirectionResult dir) -> do + pos <- uses characterPosition $ move dir + uses entities + (fmap snd . entitiesAtPositionWithType @GroundMessage pos) >>= \case + Empty -> say_ ["read", "nothing"] + GroundMessage msg :< Empty -> + say ["read", "result"] $ object ["message" A..= msg] + msgs -> + let readAndContinue Empty = pure () + readAndContinue (msg :< msgs') = + prompt @'Continue + ["read", "result"] + (object ["message" A..= msg]) + Cancellable + . const + $ readAndContinue msgs' + readAndContinue _ = error "this is total" + in readAndContinue msgs + continue + handleCommand Save = do -- TODO default save locations / config file? prompt_ @'StringPrompt ["save", "location"] Cancellable @@ -413,3 +438,5 @@ entityMenu_ = mkMenuItems @[_] . map entityMenuItem -- entityMenu :: Entity entity => [entity] -> Map Char (MenuOption entity) -- entityMenu = map (map runIdentity) . entityMenu_ . fmap Identity + +-------------------------------------------------------------------------------- diff --git a/src/Xanthous/Command.hs b/src/Xanthous/Command.hs index 35a8ce3672..61fb11b22e 100644 --- a/src/Xanthous/Command.hs +++ b/src/Xanthous/Command.hs @@ -19,6 +19,7 @@ data Command | Eat | Look | Save + | Read -- | TODO replace with `:` commands | ToggleRevealAll @@ -33,6 +34,7 @@ commandFromKey (KChar 'o') [] = Just Open commandFromKey (KChar ';') [] = Just Look commandFromKey (KChar 'e') [] = Just Eat commandFromKey (KChar 'S') [] = Just Save +commandFromKey (KChar 'r') [] = Just Read commandFromKey (KChar 'r') [MMeta] = Just ToggleRevealAll diff --git a/src/Xanthous/Entities/Entities.hs b/src/Xanthous/Entities/Entities.hs index 7e41fc8b7b..802aecddeb 100644 --- a/src/Xanthous/Entities/Entities.hs +++ b/src/Xanthous/Entities/Entities.hs @@ -26,6 +26,7 @@ instance Arbitrary SomeEntity where , SomeEntity <$> arbitrary @Creature , SomeEntity <$> arbitrary @Wall , SomeEntity <$> arbitrary @Door + , SomeEntity <$> arbitrary @GroundMessage ] instance FromJSON SomeEntity where @@ -37,6 +38,7 @@ instance FromJSON SomeEntity where "Creature" -> SomeEntity @Creature <$> obj .: "data" "Wall" -> SomeEntity @Wall <$> obj .: "data" "Door" -> SomeEntity @Door <$> obj .: "data" + "GroundMessage" -> SomeEntity @GroundMessage <$> obj .: "data" _ -> fail . unpack $ "Invalid entity type \"" <> entityType <> "\"" deriving via WithOptions '[ FieldLabelModifier '[Drop 1] ] GameState diff --git a/src/Xanthous/Entities/Environment.hs b/src/Xanthous/Entities/Environment.hs index 8baa07650f..0690e47e54 100644 --- a/src/Xanthous/Entities/Environment.hs +++ b/src/Xanthous/Entities/Environment.hs @@ -1,22 +1,29 @@ {-# LANGUAGE TemplateHaskell #-} module Xanthous.Entities.Environment - ( Wall(..) + ( + -- * Walls + Wall(..) + -- * Doors , Door(..) , open , locked + -- * Messages + , GroundMessage(..) ) where -------------------------------------------------------------------------------- import Xanthous.Prelude +-------------------------------------------------------------------------------- import Test.QuickCheck -import Test.QuickCheck.Arbitrary.Generic import Brick (str) import Brick.Widgets.Border.Style (unicode) import Brick.Types (Edges(..)) import Data.Aeson +import Data.Aeson.Generic.DerivingVia -------------------------------------------------------------------------------- import Xanthous.Entities.Draw.Util import Xanthous.Data import Xanthous.Game.State +import Xanthous.Util.QuickCheck -------------------------------------------------------------------------------- data Wall = Wall @@ -31,7 +38,6 @@ instance FromJSON Wall where "Wall" -> pure Wall _ -> fail "Invalid Wall: expected Wall" --- deriving via Brainless Wall instance Brain Wall instance Brain Wall where step = brainVia Brainless instance Entity Wall where @@ -56,11 +62,9 @@ data Door = Door } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, CoArbitrary, Function, ToJSON, FromJSON) + deriving Arbitrary via GenericArbitrary Door makeLenses ''Door -instance Arbitrary Door where - arbitrary = genericArbitrary - instance Draw Door where drawWithNeighbors neighs door | door ^. open @@ -77,10 +81,29 @@ instance Draw Door where horizDoor = '␣' vertDoor = '[' --- deriving via Brainless Door instance Brain Door instance Brain Door where step = brainVia Brainless instance Entity Door where blocksVision = not . view open description _ = "a door" entityChar _ = "d" + +-------------------------------------------------------------------------------- + +newtype GroundMessage = GroundMessage Text + deriving stock (Show, Eq, Ord, Generic) + deriving anyclass (NFData, CoArbitrary, Function) + deriving Arbitrary via GenericArbitrary GroundMessage + deriving (ToJSON, FromJSON) + via WithOptions '[ 'TagSingleConstructors 'True + , 'SumEnc 'ObjWithSingleField + ] + GroundMessage + deriving Draw + via DrawStyledCharacter ('Just 'Yellow) 'Nothing "≈" + GroundMessage + deriving Entity + via DeriveEntity 'False "a message on the ground. Press r. to read it." + "≈" + GroundMessage +instance Brain GroundMessage where step = brainVia Brainless diff --git a/src/Xanthous/Game/Lenses.hs b/src/Xanthous/Game/Lenses.hs index 7dbd602901..13f4b89314 100644 --- a/src/Xanthous/Game/Lenses.hs +++ b/src/Xanthous/Game/Lenses.hs @@ -25,7 +25,7 @@ import Xanthous.Data import qualified Xanthous.Data.EntityMap as EntityMap import Xanthous.Data.EntityMap.Graphics (visiblePositions) import Xanthous.Entities.Character (Character, mkCharacter) -import Xanthous.Entities.Environment (Door, open) +import Xanthous.Entities.Environment (Door, open, GroundMessage) import Xanthous.Entities.Item (Item) import Xanthous.Entities.Creature (Creature) import Xanthous.Entities.Entities () @@ -105,8 +105,12 @@ entityCollision -> Maybe Collision entityCollision Empty = Nothing entityCollision ents + -- TODO track entity collision in the Entity class | any (entityIs @Creature) ents = pure Combat - | all (entityIs @Item) ents = Nothing + | all (\e -> + entityIs @Item e + || entityIs @GroundMessage e + ) ents = Nothing | doors@(_ : _) <- ents ^.. folded . _SomeEntity @Door , all (view open) doors = Nothing | otherwise = pure Stop diff --git a/src/Xanthous/Game/State.hs b/src/Xanthous/Game/State.hs index 028688542a..5ddb7de7e9 100644 --- a/src/Xanthous/Game/State.hs +++ b/src/Xanthous/Game/State.hs @@ -1,8 +1,8 @@ -{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE UndecidableInstances #-} -{-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE GADTs #-} -{-# LANGUAGE AllowAmbiguousTypes #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE AllowAmbiguousTypes #-} -------------------------------------------------------------------------------- module Xanthous.Game.State ( GameState(..) @@ -37,10 +37,14 @@ module Xanthous.Game.State , downcastEntity , _SomeEntity , entityIs + -- ** Vias + , Color(..) + , DrawNothing(..) , DrawRawChar(..) , DrawRawCharPriority(..) , DrawCharacter(..) , DrawStyledCharacter(..) + , DeriveEntity(..) -- ** Field classes , HasChar(..) , HasStyle(..) @@ -63,7 +67,7 @@ import Test.QuickCheck.Arbitrary.Generic import Control.Monad.State.Class import Control.Monad.State import Control.Monad.Random.Class -import Brick (EventM, Widget, raw, str) +import Brick (EventM, Widget, raw, str, emptyWidget) import Data.Aeson (ToJSON(..), FromJSON(..), Value(Null)) import qualified Data.Aeson as JSON import Data.Aeson.Generic.DerivingVia @@ -71,6 +75,7 @@ import Data.Generics.Product.Fields import qualified Graphics.Vty.Attributes as Vty import qualified Graphics.Vty.Image as Vty -------------------------------------------------------------------------------- +import Xanthous.Util (KnownBool(..)) import Xanthous.Data import Xanthous.Data.EntityMap (EntityMap, EntityID) import Xanthous.Data.EntityChar @@ -213,20 +218,29 @@ instance KnownColor 'Magenta where colorVal _ = Vty.magenta instance KnownColor 'Cyan where colorVal _ = Vty.cyan instance KnownColor 'White where colorVal _ = Vty.white -newtype DrawStyledCharacter (fg :: Color) (bg :: Color) (char :: Symbol) (a :: Type) where +class KnownMaybeColor (maybeColor :: Maybe Color) where + maybeColorVal :: forall proxy. proxy maybeColor -> Maybe Vty.Color + +instance KnownMaybeColor 'Nothing where maybeColorVal _ = Nothing +instance KnownColor color => KnownMaybeColor ('Just color) where + maybeColorVal _ = Just $ colorVal @color Proxy + +newtype DrawStyledCharacter (fg :: Maybe Color) (bg :: Maybe Color) (char :: Symbol) (a :: Type) where DrawStyledCharacter :: a -> DrawStyledCharacter fg bg char a instance - ( KnownColor fg - , KnownColor bg + ( KnownMaybeColor fg + , KnownMaybeColor bg , KnownSymbol char ) => Draw (DrawStyledCharacter fg bg char a) where draw _ = raw $ Vty.string attr $ symbolVal @char Proxy where attr = Vty.Attr { Vty.attrStyle = Vty.Default - , Vty.attrForeColor = Vty.SetTo $ colorVal @fg Proxy - , Vty.attrBackColor = Vty.SetTo $ colorVal @bg Proxy + , Vty.attrForeColor = maybe Vty.Default Vty.SetTo + $ maybeColorVal @fg Proxy + , Vty.attrBackColor = maybe Vty.Default Vty.SetTo + $ maybeColorVal @bg Proxy , Vty.attrURL = Vty.Default } @@ -235,6 +249,12 @@ instance Draw EntityChar where -------------------------------------------------------------------------------- +newtype DrawNothing (a :: Type) = DrawNothing a + +instance Draw (DrawNothing a) where + draw = const emptyWidget + drawPriority = const 0 + newtype DrawRawChar (rawField :: Symbol) (a :: Type) = DrawRawChar a instance @@ -336,6 +356,31 @@ entityIs = isJust . downcastEntity @a _SomeEntity :: forall a. (Entity a, Typeable a) => Prism' SomeEntity a _SomeEntity = prism' SomeEntity downcastEntity +newtype DeriveEntity + (blocksVision :: Bool) + (description :: Symbol) + (entityChar :: Symbol) + (entity :: Type) + = DeriveEntity entity + deriving newtype (Show, Eq, Ord, NFData, ToJSON, FromJSON, Draw) + +instance Brain entity => Brain (DeriveEntity b d c entity) where + step = brainVia $ \(DeriveEntity e) -> e + +instance + ( KnownBool blocksVision + , KnownSymbol description + , KnownSymbol entityChar + , Show entity, Eq entity, Ord entity, NFData entity + , ToJSON entity, FromJSON entity + , Draw entity, Brain entity + ) + => Entity (DeriveEntity blocksVision description entityChar entity) where + + blocksVision _ = boolVal @blocksVision + description _ = pack . symbolVal $ Proxy @description + entityChar _ = fromString . symbolVal $ Proxy @entityChar + -------------------------------------------------------------------------------- data DebugState = DebugState diff --git a/src/Xanthous/Generators.hs b/src/Xanthous/Generators.hs index 6b1a57299e..490e50ea60 100644 --- a/src/Xanthous/Generators.hs +++ b/src/Xanthous/Generators.hs @@ -14,6 +14,7 @@ module Xanthous.Generators , levelItems , levelCreatures , levelCharacterPosition + , levelTutorialMessage , generateLevel ) where -------------------------------------------------------------------------------- @@ -91,6 +92,7 @@ data Level = Level { _levelWalls :: !(EntityMap Wall) , _levelItems :: !(EntityMap Item) , _levelCreatures :: !(EntityMap Creature) + , _levelTutorialMessage :: !(EntityMap GroundMessage) , _levelCharacterPosition :: !Position } makeLenses ''Level @@ -103,4 +105,5 @@ generateLevel gen ps dims = do _levelItems <- randomItems cells _levelCreatures <- randomCreatures cells _levelCharacterPosition <- chooseCharacterPosition cells + _levelTutorialMessage <- tutorialMessage cells _levelCharacterPosition pure Level {..} diff --git a/src/Xanthous/Generators/LevelContents.hs b/src/Xanthous/Generators/LevelContents.hs index 583bdcbd67..91a7d38019 100644 --- a/src/Xanthous/Generators/LevelContents.hs +++ b/src/Xanthous/Generators/LevelContents.hs @@ -3,22 +3,26 @@ module Xanthous.Generators.LevelContents ( chooseCharacterPosition , randomItems , randomCreatures + , tutorialMessage ) where -------------------------------------------------------------------------------- import Xanthous.Prelude -------------------------------------------------------------------------------- import Control.Monad.Random -import Data.Array.IArray (amap, bounds, rangeSize) +import Data.Array.IArray (amap, bounds, rangeSize, (!)) -------------------------------------------------------------------------------- import Xanthous.Generators.Util import Xanthous.Random -import Xanthous.Data (Position, positionFromPair) +import Xanthous.Data (Position, _Position, positionFromPair) import Xanthous.Data.EntityMap (EntityMap, _EntityMap) import Xanthous.Entities.Raws (rawsWithType, RawType) import qualified Xanthous.Entities.Item as Item import Xanthous.Entities.Item (Item) import qualified Xanthous.Entities.Creature as Creature import Xanthous.Entities.Creature (Creature) +import Xanthous.Entities.Environment (GroundMessage(..)) +import Xanthous.Messages (message_) +import Xanthous.Util.Graphics (circle) -------------------------------------------------------------------------------- chooseCharacterPosition :: MonadRandom m => Cells -> m Position @@ -30,6 +34,24 @@ randomItems = randomEntities Item.newWithType (0.0004, 0.001) randomCreatures :: MonadRandom m => Cells -> m (EntityMap Creature) randomCreatures = randomEntities Creature.newWithType (0.0007, 0.003) +tutorialMessage :: MonadRandom m + => Cells + -> Position -- ^ CharacterPosition + -> m (EntityMap GroundMessage) +tutorialMessage cells characterPosition = do + let distance = 2 + pos <- fmap (fromMaybe (error "No valid positions for tutorial message?")) + . choose . ChooseElement + $ accessiblePositionsWithin distance cells characterPosition + msg <- message_ ["tutorial", "message1"] + pure $ _EntityMap # [(pos, GroundMessage msg)] + where + accessiblePositionsWithin :: Int -> Cells -> Position -> [Position] + accessiblePositionsWithin dist valid pos = + review _Position + <$> filter (\(px, py) -> not $ valid ! (fromIntegral px, fromIntegral py)) + (circle (pos ^. _Position) dist) + randomEntities :: forall entity raw m. (MonadRandom m, RawType raw) => (raw -> entity) @@ -41,7 +63,8 @@ randomEntities newWithType sizeRange cells = Nothing -> pure mempty Just raws -> do let len = rangeSize $ bounds cells - (numEntities :: Int) <- floor . (* fromIntegral len) <$> getRandomR sizeRange + (numEntities :: Int) <- + floor . (* fromIntegral len) <$> getRandomR sizeRange entities <- for [0..numEntities] $ const $ do pos <- randomPosition cells raw <- choose raws diff --git a/src/Xanthous/Messages.hs b/src/Xanthous/Messages.hs index b0dc0e4ae9..2b1b3da1e8 100644 --- a/src/Xanthous/Messages.hs +++ b/src/Xanthous/Messages.hs @@ -11,23 +11,25 @@ module Xanthous.Messages , render , lookup , message + , message_ ) where -------------------------------------------------------------------------------- import Xanthous.Prelude hiding (lookup) -------------------------------------------------------------------------------- -import Control.Monad.Random.Class (MonadRandom) -import Data.Aeson (FromJSON, ToJSON, toJSON) -import Data.Aeson.Generic.DerivingVia -import Data.FileEmbed -import Data.List.NonEmpty -import Test.QuickCheck hiding (choose) -import Test.QuickCheck.Arbitrary.Generic -import Test.QuickCheck.Instances.UnorderedContainers () -import Text.Mustache +import Control.Monad.Random.Class (MonadRandom) +import Data.Aeson (FromJSON, ToJSON, toJSON) +import qualified Data.Aeson as JSON +import Data.Aeson.Generic.DerivingVia +import Data.FileEmbed +import Data.List.NonEmpty +import Test.QuickCheck hiding (choose) +import Test.QuickCheck.Arbitrary.Generic +import Test.QuickCheck.Instances.UnorderedContainers () +import Text.Mustache import qualified Data.Yaml as Yaml -------------------------------------------------------------------------------- -import Xanthous.Random -import Xanthous.Orphans () +import Xanthous.Random +import Xanthous.Orphans () -------------------------------------------------------------------------------- data Message = Single Template | Choice (NonEmpty Template) @@ -98,3 +100,8 @@ message :: (MonadRandom m, ToJSON params) => [Text] -> params -> m Text message path params = maybe notFound (`render` params) $ messages ^? ix path where notFound = pure "Message not found" + +message_ :: (MonadRandom m) => [Text] -> m Text +message_ path = maybe notFound (`render` JSON.object []) $ messages ^? ix path + where + notFound = pure "Message not found" diff --git a/src/Xanthous/Util.hs b/src/Xanthous/Util.hs index 3a7c10ace1..814f937115 100644 --- a/src/Xanthous/Util.hs +++ b/src/Xanthous/Util.hs @@ -1,7 +1,7 @@ -{-# LANGUAGE BangPatterns #-} -{-# LANGUAGE AllowAmbiguousTypes #-} +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE QuantifiedConstraints #-} - +-------------------------------------------------------------------------------- module Xanthous.Util ( EqEqProp(..) , EqProp(..) @@ -25,13 +25,18 @@ module Xanthous.Util -- ** Bag sequence algorithms , takeWhileInclusive , smallestNotIn - ) where + -- * Type-level programming utils + , KnownBool(..) + ) where +-------------------------------------------------------------------------------- import Xanthous.Prelude hiding (foldr) - +-------------------------------------------------------------------------------- import Test.QuickCheck.Checkers import Data.Foldable (foldr) import Data.Monoid +import Data.Proxy +-------------------------------------------------------------------------------- newtype EqEqProp a = EqEqProp a deriving newtype Eq @@ -204,3 +209,17 @@ smallestNotIn xs = case uniq $ sort xs of | x > minBound -> minBound | otherwise -> snd . headEx . filter (uncurry (/=)) $ zip (xs' ++ [minBound]) [minBound..] + +-------------------------------------------------------------------------------- + +-- | This class gives a boolean associated with a type-level bool, a'la +-- 'KnownSymbol', 'KnownNat' etc. +class KnownBool (bool :: Bool) where + boolVal' :: forall proxy. proxy bool -> Bool + boolVal' _ = boolVal @bool + + boolVal :: Bool + boolVal = boolVal' $ Proxy @bool + +instance KnownBool 'True where boolVal = True +instance KnownBool 'False where boolVal = False diff --git a/src/Xanthous/messages.yaml b/src/Xanthous/messages.yaml index ae9ca060bf..1c5692ddfe 100644 --- a/src/Xanthous/messages.yaml +++ b/src/Xanthous/messages.yaml @@ -1,4 +1,4 @@ -welcome: Welcome to Xanthous, {{characterName}}! It's dangerous out there, why not stay inside? +welcome: Welcome to Xanthous, {{characterName}}! It's dangerous out there, why not stay inside? Use hjklybnu to move. dead: - You have died... - You die... @@ -54,3 +54,11 @@ eat: - You search your pockets for something edible, and come up short. menuPrompt: What would you like to eat? eat: You eat the {{item.itemType.name}}. + +read: + prompt: Direction to read (hjklybnu.)? + nothing: "There's nothing there to read" + result: "\"{{message}}\"" + +tutorial: + message1: The caves are dark and full of nightmarish creatures - and you are likely to perish without food. Seek out sustenance, and pick it up with , -- cgit 1.4.1 From 65b1352ef2e463393d0504c32b73bdcf7c99491a Mon Sep 17 00:00:00 2001 From: Griffin Smith Date: Sat, 30 Nov 2019 22:43:17 -0500 Subject: Add a very basic inventory panel Add a very basic inventory panel to the game opened by pressing `i`, which displays the contents of the player's inventory in a basic list. --- src/Xanthous/App.hs | 11 +++++++++-- src/Xanthous/Command.hs | 2 ++ src/Xanthous/Game/Arbitrary.hs | 1 + src/Xanthous/Game/Draw.hs | 44 ++++++++++++++++++++++++++++++++---------- src/Xanthous/Game/Lenses.hs | 1 + src/Xanthous/Game/State.hs | 19 +++++++----------- src/Xanthous/Resource.hs | 35 +++++++++++++++++++-------------- src/Xanthous/messages.yaml | 5 ++++- 8 files changed, 79 insertions(+), 39 deletions(-) diff --git a/src/Xanthous/App.hs b/src/Xanthous/App.hs index df76eadc3b..9d606bbef3 100644 --- a/src/Xanthous/App.hs +++ b/src/Xanthous/App.hs @@ -34,7 +34,7 @@ import Xanthous.Game.State import Xanthous.Game.Draw (drawGame) import Xanthous.Game.Prompt import Xanthous.Monad -import Xanthous.Resource (Name) +import Xanthous.Resource (Name, Panel(..)) import qualified Xanthous.Messages as Messages import Xanthous.Util.Inflection (toSentence) -------------------------------------------------------------------------------- @@ -231,6 +231,8 @@ handleCommand Read = do in readAndContinue msgs continue +handleCommand Inventory = showPanel InventoryPanel >> continue + handleCommand Save = do -- TODO default save locations / config file? prompt_ @'StringPrompt ["save", "location"] Cancellable @@ -439,4 +441,9 @@ entityMenu_ = mkMenuItems @[_] . map entityMenuItem -- entityMenu :: Entity entity => [entity] -> Map Char (MenuOption entity) -- entityMenu = map (map runIdentity) . entityMenu_ . fmap Identity --------------------------------------------------------------------------------- +showPanel :: Panel -> AppM () +showPanel panel = do + activePanel ?= panel + prompt_ @'Continue ["generic", "continue"] Uncancellable + . const + $ activePanel .= Nothing diff --git a/src/Xanthous/Command.hs b/src/Xanthous/Command.hs index 61fb11b22e..a14a4d0713 100644 --- a/src/Xanthous/Command.hs +++ b/src/Xanthous/Command.hs @@ -20,6 +20,7 @@ data Command | Look | Save | Read + | Inventory -- | TODO replace with `:` commands | ToggleRevealAll @@ -35,6 +36,7 @@ commandFromKey (KChar ';') [] = Just Look commandFromKey (KChar 'e') [] = Just Eat commandFromKey (KChar 'S') [] = Just Save commandFromKey (KChar 'r') [] = Just Read +commandFromKey (KChar 'i') [] = Just Inventory commandFromKey (KChar 'r') [MMeta] = Just ToggleRevealAll diff --git a/src/Xanthous/Game/Arbitrary.hs b/src/Xanthous/Game/Arbitrary.hs index 090eba634d..f4c83e0051 100644 --- a/src/Xanthous/Game/Arbitrary.hs +++ b/src/Xanthous/Game/Arbitrary.hs @@ -26,6 +26,7 @@ instance Arbitrary GameState where _revealedPositions <- fmap setFromList . sublistOf $ EntityMap.positions _entities _randomGen <- mkStdGen <$> arbitrary let _promptState = NoPrompt -- TODO + _activePanel <- arbitrary _debugState <- arbitrary pure $ GameState {..} diff --git a/src/Xanthous/Game/Draw.hs b/src/Xanthous/Game/Draw.hs index ab0e31f8a0..7947c6efe9 100644 --- a/src/Xanthous/Game/Draw.hs +++ b/src/Xanthous/Game/Draw.hs @@ -27,7 +27,7 @@ import Xanthous.Game , debugState, allRevealed ) import Xanthous.Game.Prompt -import Xanthous.Resource (Name) +import Xanthous.Resource (Name, Panel(..)) import qualified Xanthous.Resource as Resource import Xanthous.Orphans () -------------------------------------------------------------------------------- @@ -41,23 +41,23 @@ cursorPosition game = showCursor Resource.Character (game ^. characterPosition . loc) drawMessages :: MessageHistory -> Widget Name -drawMessages = txt . (<> " ") . unwords . oextract +drawMessages = txtWrap . (<> " ") . unwords . oextract drawPromptState :: GamePromptState m -> Widget Name drawPromptState NoPrompt = emptyWidget drawPromptState (WaitingPrompt msg (Prompt _ pt ps pri _)) = case (pt, ps, pri) of (SStringPrompt, StringPromptState edit, _) -> - txt msg <+> renderEditor (txt . fold) True edit - (SDirectionPrompt, DirectionPromptState, _) -> txt msg - (SContinue, _, _) -> txt msg + txtWrap msg <+> renderEditor (txtWrap . fold) True edit + (SDirectionPrompt, DirectionPromptState, _) -> txtWrap msg + (SContinue, _, _) -> txtWrap msg (SMenu, _, menuItems) -> - txt msg + txtWrap msg <=> foldl' (<=>) emptyWidget (map drawMenuItem $ itoList menuItems) - _ -> txt msg + _ -> txtWrap msg where drawMenuItem (chr, MenuOption m _) = - str ("[" <> pure chr <> "] ") <+> txt m + str ("[" <> pure chr <> "] ") <+> txtWrap m drawEntities :: (Position -> Bool) @@ -95,11 +95,32 @@ drawMap game -- character can't see them (game ^. entities) +bullet :: Char +bullet = '•' + +drawPanel :: GameState -> Panel -> Widget Name +drawPanel game panel + = border + . hLimit 35 + . viewport (Resource.Panel panel) Vertical + $ case panel of + InventoryPanel -> + let items = game ^. character . inventory + in if null items + then txtWrap "Your inventory is empty right now." + else + txtWrap "You are currently carrying the following items:" + <=> txt " " + <=> foldl' (<=>) emptyWidget + (map + (txtWrap . ((bullet <| " ") <>) . description) + items) + drawCharacterInfo :: Character -> Widget Name drawCharacterInfo ch = txt " " <+> charName <+> charHitpoints where charName | Just n <- ch ^. characterName - = txt n <+> txt " " + = txt $ n <> " " | otherwise = emptyWidget charHitpoints @@ -114,5 +135,8 @@ drawGame game NoPrompt -> drawMessages (game ^. messageHistory) _ -> emptyWidget <=> drawPromptState (game ^. promptState) - <=> border (drawMap game) + <=> + (maybe emptyWidget (drawPanel game) (game ^. activePanel) + <+> border (drawMap game) + ) <=> drawCharacterInfo (game ^. character) diff --git a/src/Xanthous/Game/Lenses.hs b/src/Xanthous/Game/Lenses.hs index 13f4b89314..1f72e08b7b 100644 --- a/src/Xanthous/Game/Lenses.hs +++ b/src/Xanthous/Game/Lenses.hs @@ -46,6 +46,7 @@ initialStateFromSeed seed = _messageHistory = mempty _revealedPositions = mempty _promptState = NoPrompt + _activePanel = Nothing _debugState = DebugState { _allRevealed = False } diff --git a/src/Xanthous/Game/State.hs b/src/Xanthous/Game/State.hs index 5ddb7de7e9..3b401d366d 100644 --- a/src/Xanthous/Game/State.hs +++ b/src/Xanthous/Game/State.hs @@ -10,6 +10,7 @@ module Xanthous.Game.State , revealedPositions , messageHistory , randomGen + , activePanel , promptState , characterEntityID , GamePromptState(..) @@ -383,6 +384,7 @@ instance -------------------------------------------------------------------------------- + data DebugState = DebugState { _allRevealed :: !Bool } @@ -402,8 +404,12 @@ data GameState = GameState , _characterEntityID :: !EntityID , _messageHistory :: !MessageHistory , _randomGen :: !StdGen + + -- | The active panel displayed in the UI, if any + , _activePanel :: !(Maybe Panel) + , _promptState :: !(GamePromptState AppM) - , _debugState :: DebugState + , _debugState :: !DebugState } deriving stock (Show, Generic) deriving anyclass (NFData) @@ -437,14 +443,3 @@ instance (MonadIO m) => MonadIO (AppT m) where -------------------------------------------------------------------------------- makeLenses ''DebugState - --------------------------------------------------------------------------------- - --- saveGame :: GameState -> LByteString --- saveGame = Zlib.compress . JSON.encode - --- loadGame :: LByteString -> Maybe GameState --- loadGame = JSON.decode . Zlib.decompress - --- saved :: Prism' LByteString GameState --- saved = prism' saveGame loadGame diff --git a/src/Xanthous/Resource.hs b/src/Xanthous/Resource.hs index 5350e7646e..cc2fc97a14 100644 --- a/src/Xanthous/Resource.hs +++ b/src/Xanthous/Resource.hs @@ -1,24 +1,31 @@ -------------------------------------------------------------------------------- module Xanthous.Resource - ( Name(..) + ( Panel(..) + , Name(..) ) where -------------------------------------------------------------------------------- import Xanthous.Prelude -------------------------------------------------------------------------------- import Test.QuickCheck -import Test.QuickCheck.Arbitrary.Generic +import Data.Aeson (ToJSON, FromJSON) +-------------------------------------------------------------------------------- +import Xanthous.Util.QuickCheck -------------------------------------------------------------------------------- -data Name = MapViewport - -- ^ The main viewport where we display the game content - | Character - -- ^ The character - | MessageBox - -- ^ The box where we display messages to the user - | Prompt - -- ^ The game's prompt - deriving stock (Show, Eq, Ord, Generic) - deriving anyclass (NFData, CoArbitrary, Function) +-- | Enum for "panels" displayed in the game's UI. +data Panel + = InventoryPanel -- ^ A panel displaying the character's inventory + deriving stock (Show, Eq, Ord, Generic, Enum, Bounded) + deriving anyclass (NFData, CoArbitrary, Function, ToJSON, FromJSON) + deriving Arbitrary via GenericArbitrary Panel -instance Arbitrary Name where - arbitrary = genericArbitrary + +data Name + = MapViewport -- ^ The main viewport where we display the game content + | Character -- ^ The character + | MessageBox -- ^ The box where we display messages to the user + | Prompt -- ^ The game's prompt + | Panel Panel -- ^ A panel in the game + deriving stock (Show, Eq, Ord, Generic) + deriving anyclass (NFData, CoArbitrary, Function, ToJSON, FromJSON) + deriving Arbitrary via GenericArbitrary Name diff --git a/src/Xanthous/messages.yaml b/src/Xanthous/messages.yaml index 1c5692ddfe..40a37cf59b 100644 --- a/src/Xanthous/messages.yaml +++ b/src/Xanthous/messages.yaml @@ -5,6 +5,9 @@ dead: - You perish... - You have perished... +generic: + continue: Press enter to continue... + save: location: "Enter filename to save to: " @@ -61,4 +64,4 @@ read: result: "\"{{message}}\"" tutorial: - message1: The caves are dark and full of nightmarish creatures - and you are likely to perish without food. Seek out sustenance, and pick it up with , + message1: The caves are dark and full of nightmarish creatures - and you are likely to perish without food. Seek out sustenance! You can pick items up with ,. -- cgit 1.4.1 From e619dcd126242c2dc290cc77b2fda0873ced947a Mon Sep 17 00:00:00 2001 From: Griffin Smith Date: Sat, 30 Nov 2019 22:48:29 -0500 Subject: Eating doesn't take time unless you actually eat Make it so that opening the eat menu but not actually eating anything (either because you cancel, or because there's nothing to eat) doesn't step the game --- src/Xanthous/App.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Xanthous/App.hs b/src/Xanthous/App.hs index 9d606bbef3..f663186a30 100644 --- a/src/Xanthous/App.hs +++ b/src/Xanthous/App.hs @@ -205,7 +205,7 @@ handleCommand Eat = do character . characterHitpoints' += edibleItem ^. hitpointsHealed . to fromIntegral message msg $ object ["item" A..= item] - stepGame -- TODO + stepGame -- TODO continue handleCommand Read = do -- cgit 1.4.1 From 0f754eb2a07062e8490ae3af04e7c7ff4d94cc55 Mon Sep 17 00:00:00 2001 From: Griffin Smith Date: Sun, 22 Dec 2019 22:42:05 -0500 Subject: Fix rendering string prompts Rendering an editor with txtWrap makes brick blow up because editors have an internal viewport, but txtWrap advertises an infinite width. --- src/Xanthous/Game/Draw.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Xanthous/Game/Draw.hs b/src/Xanthous/Game/Draw.hs index 7947c6efe9..e2390c47bf 100644 --- a/src/Xanthous/Game/Draw.hs +++ b/src/Xanthous/Game/Draw.hs @@ -48,7 +48,7 @@ drawPromptState NoPrompt = emptyWidget drawPromptState (WaitingPrompt msg (Prompt _ pt ps pri _)) = case (pt, ps, pri) of (SStringPrompt, StringPromptState edit, _) -> - txtWrap msg <+> renderEditor (txtWrap . fold) True edit + txtWrap msg <+> txt " " <+> renderEditor (txt . fold) True edit (SDirectionPrompt, DirectionPromptState, _) -> txtWrap msg (SContinue, _, _) -> txtWrap msg (SMenu, _, menuItems) -> -- cgit 1.4.1 From 5b1c7799a76480335f838356ad78bed50715d4c0 Mon Sep 17 00:00:00 2001 From: Griffin Smith Date: Sun, 22 Dec 2019 22:46:43 -0500 Subject: Add wielded, wieldable items Split the character's inventory up into wielded items (in one or both hands) and the backpack, and display wielded items when drawing the inventory panel. Currently there's no way to actually *wield* items though, so this is all unused/untested. Also, add the ability for items to be "wieldable", which gives specific descriptions for when attacking with them and also modified damage. --- src/Xanthous/App.hs | 21 ++--- src/Xanthous/Command.hs | 4 +- src/Xanthous/Entities/Character.hs | 157 +++++++++++++++++++++++++++++++++- src/Xanthous/Entities/Creature.hs | 3 +- src/Xanthous/Entities/RawTypes.hs | 67 +++++++++++---- src/Xanthous/Entities/Raws/stick.yaml | 14 +++ src/Xanthous/Game/Draw.hs | 41 ++++++--- src/Xanthous/messages.yaml | 8 +- 8 files changed, 268 insertions(+), 47 deletions(-) create mode 100644 src/Xanthous/Entities/Raws/stick.yaml diff --git a/src/Xanthous/App.hs b/src/Xanthous/App.hs index f663186a30..c7d9e3935e 100644 --- a/src/Xanthous/App.hs +++ b/src/Xanthous/App.hs @@ -143,8 +143,8 @@ handleCommand PickUp = do uses entities (entitiesAtPositionWithType @Item pos) >>= \case [] -> say_ ["pickUp", "nothingToPickUp"] [item] -> pickUpItem item - items -> - menu_ ["pickUp", "menu"] Cancellable (entityMenu_ items) + items' -> + menu_ ["pickUp", "menu"] Cancellable (entityMenu_ items') $ \(MenuResult item) -> pickUpItem item continue where @@ -185,7 +185,7 @@ handleCommand Look = do handleCommand Wait = stepGame >> continue handleCommand Eat = do - uses (character . inventory) + uses (character . inventory . backpack) (V.mapMaybe (\item -> (item,) <$> item ^. Item.itemType . edible)) >>= \case Empty -> say_ ["eat", "noFood"] @@ -197,7 +197,7 @@ handleCommand Eat = do menuItems = mkMenuItems $ imap foodMenuItem food in menu_ ["eat", "menuPrompt"] Cancellable menuItems $ \(MenuResult (idx, item, edibleItem)) -> do - character . inventory %= \inv -> + character . inventory . backpack %= \inv -> let (before, after) = V.splitAt idx inv in before <> fromMaybe Empty (tailMay after) let msg = fromMaybe (Messages.lookup ["eat", "eat"]) @@ -231,7 +231,7 @@ handleCommand Read = do in readAndContinue msgs continue -handleCommand Inventory = showPanel InventoryPanel >> continue +handleCommand ShowInventory = showPanel InventoryPanel >> continue handleCommand Save = do -- TODO default save locations / config file? @@ -280,8 +280,8 @@ handlePromptEvent _ (Prompt _ SDirectionPrompt _ _ _) _ = continue handlePromptEvent _ (Prompt _ SContinue _ _ _) _ = continue -handlePromptEvent _ (Prompt _ SMenu _ items cb) (VtyEvent (EvKey (KChar chr) [])) - | Just (MenuOption _ res) <- items ^. at chr +handlePromptEvent _ (Prompt _ SMenu _ items' cb) (VtyEvent (EvKey (KChar chr) [])) + | Just (MenuOption _ res) <- items' ^. at chr = cb (MenuResult res) >> clearPrompt | otherwise = continue @@ -350,9 +350,9 @@ menu :: forall (a :: Type) (params :: Type). -> Map Char (MenuOption a) -- ^ Menu items -> (PromptResult ('Menu a) -> AppM ()) -- ^ Menu promise handler -> AppM () -menu msgPath params cancellable items cb = do +menu msgPath params cancellable items' cb = do msg <- Messages.message msgPath params - let p = mkMenu cancellable items cb + let p = mkMenu cancellable items' cb promptState .= WaitingPrompt msg p menu_ :: forall (a :: Type). @@ -419,7 +419,8 @@ attackAt pos = say ["combat", "killed"] msgParams entities . at creatureID .= Nothing else do - say ["combat", "hit"] msgParams + -- TODO attack messages + say ["combat", "hit", "generic"] msgParams entities . ix creatureID . positioned .= SomeEntity creature' stepGame -- TODO diff --git a/src/Xanthous/Command.hs b/src/Xanthous/Command.hs index a14a4d0713..7b689c6466 100644 --- a/src/Xanthous/Command.hs +++ b/src/Xanthous/Command.hs @@ -20,7 +20,7 @@ data Command | Look | Save | Read - | Inventory + | ShowInventory -- | TODO replace with `:` commands | ToggleRevealAll @@ -36,7 +36,7 @@ commandFromKey (KChar ';') [] = Just Look commandFromKey (KChar 'e') [] = Just Eat commandFromKey (KChar 'S') [] = Just Save commandFromKey (KChar 'r') [] = Just Read -commandFromKey (KChar 'i') [] = Just Inventory +commandFromKey (KChar 'i') [] = Just ShowInventory commandFromKey (KChar 'r') [MMeta] = Just ToggleRevealAll diff --git a/src/Xanthous/Entities/Character.hs b/src/Xanthous/Entities/Character.hs index dd14390df9..5ddf33c294 100644 --- a/src/Xanthous/Entities/Character.hs +++ b/src/Xanthous/Entities/Character.hs @@ -10,6 +10,22 @@ module Xanthous.Entities.Character , hitpointRecoveryRate , speed + -- * Inventory + , Inventory(..) + , backpack + , wielded + , items + -- ** Wielded items + , Wielded(..) + , hands + , leftHand + , rightHand + , doubleHanded + , wieldedItems + , WieldedItem(..) + , wieldedItem + , wieldableItem + -- * , mkCharacter , pickUpItem @@ -27,13 +43,148 @@ import Data.Aeson.Generic.DerivingVia import Data.Aeson (ToJSON, FromJSON) import Data.Coerce (coerce) -------------------------------------------------------------------------------- +import Xanthous.Util.QuickCheck import Xanthous.Game.State import Xanthous.Entities.Item -import Xanthous.Data (TicksPerTile, Hitpoints, Per, Ticks, (|*|), positioned) +import Xanthous.Data + (TicksPerTile, Hitpoints, Per, Ticks, (|*|), positioned, Positioned(..)) +import Xanthous.Entities.RawTypes (WieldableItem, wieldable) +-------------------------------------------------------------------------------- + +data WieldedItem = WieldedItem + { _wieldedItem :: Item + , _wieldableItem :: WieldableItem + -- ^ Invariant: item ^. itemType . wieldable ≡ Just wieldableItem + } + deriving stock (Eq, Show, Ord, Generic) + deriving anyclass (NFData, CoArbitrary, Function) + deriving (ToJSON, FromJSON) + via WithOptions '[ FieldLabelModifier '[Drop 1] ] + WieldedItem +makeFieldsNoPrefix ''WieldedItem + +instance Brain WieldedItem where + step ticks (Positioned p wi) = + over positioned (\i -> WieldedItem i $ wi ^. wieldableItem) + <$> step ticks (Positioned p $ wi ^. wieldedItem) + +instance Draw WieldedItem where + draw = draw . view wieldedItem + +instance Entity WieldedItem where + blocksVision = blocksVision . view wieldedItem + description = description . view wieldedItem + entityChar = entityChar . view wieldedItem + +instance Arbitrary WieldedItem where + arbitrary = genericArbitrary <&> \wi -> + wi & wieldedItem . itemType . wieldable ?~ wi ^. wieldableItem + +data Wielded + = DoubleHanded WieldedItem + | Hands { _leftHand :: !(Maybe WieldedItem) + , _rightHand :: !(Maybe WieldedItem) + } + deriving stock (Eq, Show, Ord, Generic) + deriving anyclass (NFData, CoArbitrary, Function) + deriving Arbitrary via GenericArbitrary Wielded + deriving (ToJSON, FromJSON) + via WithOptions '[ 'SumEnc 'ObjWithSingleField ] + Wielded + +hands :: Prism' Wielded (Maybe WieldedItem, Maybe WieldedItem) +hands = prism' (uncurry Hands) $ \case + Hands l r -> Just (l, r) + _ -> Nothing + +leftHand :: Traversal' Wielded WieldedItem +leftHand = hands . _1 . _Just + +rightHand :: Traversal' Wielded WieldedItem +rightHand = hands . _2 . _Just + +doubleHanded :: Prism' Wielded WieldedItem +doubleHanded = prism' DoubleHanded $ \case + DoubleHanded i -> Just i + _ -> Nothing + +wieldedItems :: Traversal' Wielded Item +wieldedItems k (DoubleHanded wielded) = DoubleHanded <$> wieldedItem k wielded +wieldedItems k (Hands l r) = Hands + <$> (_Just . wieldedItem) k l + <*> (_Just . wieldedItem) k r + +data Inventory = Inventory + { _backpack :: Vector Item + , _wielded :: Wielded + } + deriving stock (Eq, Show, Ord, Generic) + deriving anyclass (NFData, CoArbitrary, Function) + deriving Arbitrary via GenericArbitrary Inventory + deriving (ToJSON, FromJSON) + via WithOptions '[ FieldLabelModifier '[Drop 1] ] + Inventory +makeFieldsNoPrefix ''Inventory + +items :: Traversal' Inventory Item +items k (Inventory bp w) = Inventory + <$> traversed k bp + <*> wieldedItems k w + +type instance Element Inventory = Item + +instance MonoFunctor Inventory where + omap = over items + +instance MonoFoldable Inventory where + ofoldMap = foldMapOf items + ofoldr = foldrOf items + ofoldl' = foldlOf' items + otoList = toListOf items + oall = allOf items + oany = anyOf items + onull = nullOf items + ofoldr1Ex = foldr1Of items + ofoldl1Ex' = foldl1Of' items + headEx = headEx . toListOf items + lastEx = lastEx . toListOf items + +instance MonoTraversable Inventory where + otraverse = traverseOf items + +instance Semigroup Inventory where + inv₁ <> inv₂ = + let backpack' = inv₁ ^. backpack <> inv₂ ^. backpack + (wielded', backpack'') = case (inv₁ ^. wielded, inv₂ ^. wielded) of + (wielded₁, wielded₂@(DoubleHanded _)) -> + (wielded₂, backpack' <> fromList (wielded₁ ^.. wieldedItems)) + (wielded₁, wielded₂@(Hands (Just _) (Just _))) -> + (wielded₂, backpack' <> fromList (wielded₁ ^.. wieldedItems)) + (wielded₁, Hands Nothing Nothing) -> (wielded₁, backpack') + (Hands Nothing Nothing, wielded₂) -> (wielded₂, backpack') + (Hands (Just l₁) Nothing, Hands Nothing (Just r₂)) -> + (Hands (Just l₁) (Just r₂), backpack') + (wielded₁@(DoubleHanded _), wielded₂) -> + (wielded₁, backpack' <> fromList (wielded₂ ^.. wieldedItems)) + (Hands Nothing (Just r₁), Hands Nothing (Just r₂)) -> + (Hands Nothing (Just r₂), r₁ ^. wieldedItem <| backpack') + (Hands Nothing r₁, Hands (Just l₂) Nothing) -> + (Hands (Just l₂) r₁, backpack') + (Hands (Just l₁) Nothing, Hands (Just l₂) Nothing) -> + (Hands (Just l₂) Nothing, l₁ ^. wieldedItem <| backpack') + (Hands (Just l₁) (Just r₁), Hands Nothing (Just r₂)) -> + (Hands (Just l₁) (Just r₂), r₁ ^. wieldedItem <| backpack') + (Hands (Just l₁) (Just r₁), Hands (Just l₂) Nothing) -> + (Hands (Just l₂) (Just r₁), l₁ ^. wieldedItem <| backpack') + in Inventory backpack'' wielded' + +instance Monoid Inventory where + mempty = Inventory mempty $ Hands Nothing Nothing + -------------------------------------------------------------------------------- data Character = Character - { _inventory :: !(Vector Item) + { _inventory :: !Inventory , _characterName :: !(Maybe Text) , _characterDamage :: !Hitpoints , _characterHitpoints' :: !Double @@ -95,7 +246,7 @@ isDead :: Character -> Bool isDead = (== 0) . characterHitpoints pickUpItem :: Item -> Character -> Character -pickUpItem item = inventory %~ (item <|) +pickUpItem it = inventory . backpack %~ (it <|) damage :: Hitpoints -> Character -> Character damage (fromIntegral -> amount) = characterHitpoints' %~ \case diff --git a/src/Xanthous/Entities/Creature.hs b/src/Xanthous/Entities/Creature.hs index 6f97c128d2..19c7834228 100644 --- a/src/Xanthous/Entities/Creature.hs +++ b/src/Xanthous/Entities/Creature.hs @@ -34,7 +34,8 @@ import Test.QuickCheck.Arbitrary.Generic import Data.Aeson.Generic.DerivingVia import Data.Aeson (ToJSON, FromJSON) -------------------------------------------------------------------------------- -import Xanthous.Entities.RawTypes hiding (Creature, description) +import Xanthous.Entities.RawTypes + hiding (Creature, description, damage) import Xanthous.Game.State import Xanthous.Data -------------------------------------------------------------------------------- diff --git a/src/Xanthous/Entities/RawTypes.hs b/src/Xanthous/Entities/RawTypes.hs index 822b93f2df..4b31524ad7 100644 --- a/src/Xanthous/Entities/RawTypes.hs +++ b/src/Xanthous/Entities/RawTypes.hs @@ -2,36 +2,51 @@ {-# LANGUAGE DuplicateRecordFields #-} -------------------------------------------------------------------------------- module Xanthous.Entities.RawTypes - ( CreatureType(..) - , EdibleItem(..) + ( + EntityRaw(..) + , _Creature + , _Item + + -- * Creatures + , CreatureType(..) + + -- * Items , ItemType(..) + -- ** Item sub-types + -- *** Edible + , EdibleItem(..) , isEdible - , EntityRaw(..) + -- *** Wieldable + , WieldableItem(..) + , isWieldable - , _Creature -- * Lens classes + , HasAttackMessage(..) , HasChar(..) - , HasName(..) + , HasDamage(..) , HasDescription(..) - , HasLongDescription(..) - , HasMaxHitpoints(..) - , HasFriendly(..) , HasEatMessage(..) - , HasHitpointsHealed(..) , HasEdible(..) + , HasFriendly(..) + , HasHitpointsHealed(..) + , HasLongDescription(..) + , HasMaxHitpoints(..) + , HasName(..) , HasSpeed(..) + , HasWieldable(..) ) where -------------------------------------------------------------------------------- import Xanthous.Prelude import Test.QuickCheck -import Test.QuickCheck.Arbitrary.Generic import Data.Aeson.Generic.DerivingVia import Data.Aeson (ToJSON, FromJSON) -------------------------------------------------------------------------------- import Xanthous.Messages (Message(..)) import Xanthous.Data (TicksPerTile, Hitpoints) import Xanthous.Data.EntityChar +import Xanthous.Util.QuickCheck -------------------------------------------------------------------------------- + data CreatureType = CreatureType { _name :: !Text , _description :: !Text @@ -42,14 +57,12 @@ data CreatureType = CreatureType } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, CoArbitrary, Function) + deriving Arbitrary via GenericArbitrary CreatureType deriving (ToJSON, FromJSON) via WithOptions '[ FieldLabelModifier '[Drop 1] ] CreatureType makeFieldsNoPrefix ''CreatureType -instance Arbitrary CreatureType where - arbitrary = genericArbitrary - -------------------------------------------------------------------------------- data EdibleItem = EdibleItem @@ -58,13 +71,25 @@ data EdibleItem = EdibleItem } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, CoArbitrary, Function) + deriving Arbitrary via GenericArbitrary EdibleItem deriving (ToJSON, FromJSON) via WithOptions '[ FieldLabelModifier '[Drop 1] ] EdibleItem makeFieldsNoPrefix ''EdibleItem -instance Arbitrary EdibleItem where - arbitrary = genericArbitrary +data WieldableItem = WieldableItem + { _damage :: !Hitpoints + , _attackMessage :: !(Maybe Message) + } + deriving stock (Show, Eq, Ord, Generic) + deriving anyclass (NFData, CoArbitrary, Function) + deriving Arbitrary via GenericArbitrary WieldableItem + deriving (ToJSON, FromJSON) + via WithOptions '[ FieldLabelModifier '[Drop 1] ] + WieldableItem +makeFieldsNoPrefix ''WieldableItem + +-------------------------------------------------------------------------------- data ItemType = ItemType { _name :: Text @@ -72,20 +97,24 @@ data ItemType = ItemType , _longDescription :: Text , _char :: EntityChar , _edible :: Maybe EdibleItem + , _wieldable :: Maybe WieldableItem } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, CoArbitrary, Function) + deriving Arbitrary via GenericArbitrary ItemType deriving (ToJSON, FromJSON) via WithOptions '[ FieldLabelModifier '[Drop 1] ] ItemType makeFieldsNoPrefix ''ItemType -instance Arbitrary ItemType where - arbitrary = genericArbitrary - +-- | Can this item be eaten? isEdible :: ItemType -> Bool isEdible = has $ edible . _Just +-- | Can this item be used as a weapon? +isWieldable :: ItemType -> Bool +isWieldable = has $ wieldable . _Just + -------------------------------------------------------------------------------- data EntityRaw @@ -93,9 +122,9 @@ data EntityRaw | Item ItemType deriving stock (Show, Eq, Generic) deriving anyclass (NFData) + deriving Arbitrary via GenericArbitrary EntityRaw deriving (FromJSON) via WithOptions '[ SumEnc ObjWithSingleField ] EntityRaw makePrisms ''EntityRaw -{-# ANN module ("HLint: ignore Use newtype instead of data" :: String) #-} diff --git a/src/Xanthous/Entities/Raws/stick.yaml b/src/Xanthous/Entities/Raws/stick.yaml new file mode 100644 index 0000000000..bc7fde4d8b --- /dev/null +++ b/src/Xanthous/Entities/Raws/stick.yaml @@ -0,0 +1,14 @@ +Item: + name: stick + description: a wooden stick + longDescription: A sturdy branch broken off from some sort of tree + char: + char: ∤ + style: + foreground: yellow + wieldable: + damage: 2 + attackMessage: + - You bonk the {{creature.creatureType.name}} over the head with your stick. + - You bash the {{creature.creatureType.name}} on the noggin with your stick. + - You whack the {{creature.creatureType.name}} with your stick. diff --git a/src/Xanthous/Game/Draw.hs b/src/Xanthous/Game/Draw.hs index e2390c47bf..09015d0688 100644 --- a/src/Xanthous/Game/Draw.hs +++ b/src/Xanthous/Game/Draw.hs @@ -14,6 +14,7 @@ import Xanthous.Data.EntityMap (EntityMap, atPosition) import qualified Xanthous.Data.EntityMap as EntityMap import Xanthous.Game.State import Xanthous.Entities.Character +import Xanthous.Entities.Item (Item) import Xanthous.Game ( GameState(..) , entities @@ -105,16 +106,36 @@ drawPanel game panel . viewport (Resource.Panel panel) Vertical $ case panel of InventoryPanel -> - let items = game ^. character . inventory - in if null items - then txtWrap "Your inventory is empty right now." - else - txtWrap "You are currently carrying the following items:" - <=> txt " " - <=> foldl' (<=>) emptyWidget - (map - (txtWrap . ((bullet <| " ") <>) . description) - items) + drawWielded (game ^. character . inventory . wielded) + <=> drawBackpack (game ^. character . inventory . backpack) + where + drawWielded :: Wielded -> Widget Name + drawWielded (Hands Nothing Nothing) = emptyWidget + drawWielded (DoubleHanded i) = + txt $ "You are holding " <> description i <> " in both hands" + drawWielded (Hands l r) = + maybe + emptyWidget + (\i -> + txt $ "You are holding " <> description i <> " in your left hand") + l + <=> + maybe + emptyWidget + (\i -> + txt $ "You are holding " <> description i <> " in your right hand") + r + + drawBackpack :: Vector Item -> Widget Name + drawBackpack Empty = txtWrap "Your backpack is empty right now." + drawBackpack backpackItems + = txtWrap ( "You are currently carrying the following items in your " + <> "backpack:") + <=> txt " " + <=> foldl' (<=>) emptyWidget + (map + (txtWrap . ((bullet <| " ") <>) . description) + backpackItems) drawCharacterInfo :: Character -> Widget Name drawCharacterInfo ch = txt " " <+> charName <+> charHitpoints diff --git a/src/Xanthous/messages.yaml b/src/Xanthous/messages.yaml index 40a37cf59b..0d8ada8c57 100644 --- a/src/Xanthous/messages.yaml +++ b/src/Xanthous/messages.yaml @@ -37,8 +37,12 @@ combat: nothingToAttack: There's nothing to attack there. menu: Which creature would you like to attack? hit: - - You hit the {{creature.creatureType.name}}. - - You attack the {{creature.creatureType.name}}. + fists: + - You punch the {{creature.creatureType.name}} with your bare fists! It hurts. A lot. + - You strike the {{creature.creatureType.name}} with your bare fists! It leaves a bit of a bruise on your knuckles. + generic: + - You hit the {{creature.creatureType.name}}. + - You attack the {{creature.creatureType.name}}. creatureAttack: - The {{creature.creatureType.name}} hits you! - The {{creature.creatureType.name}} attacks you! -- cgit 1.4.1 From 6622dd301860765ed16f29f74c9d1348d3aa0d41 Mon Sep 17 00:00:00 2001 From: Griffin Smith Date: Sun, 22 Dec 2019 23:22:25 -0500 Subject: Add a wield command Add a Wield command, which prompts for a wieldable item, if any, to take out of the character's inventory and put in their right hand. Eventually we should support other hands, but for now hardcoding the right hand should be fine. --- src/Xanthous/App.hs | 42 ++++++++++++++++++++++++++++++-------- src/Xanthous/Command.hs | 3 +++ src/Xanthous/Entities/Character.hs | 8 ++++++++ src/Xanthous/Game/Draw.hs | 21 ++++++++----------- src/Xanthous/Util.hs | 18 +++++++++++----- src/Xanthous/messages.yaml | 12 +++++++++++ 6 files changed, 77 insertions(+), 27 deletions(-) diff --git a/src/Xanthous/App.hs b/src/Xanthous/App.hs index c7d9e3935e..77fbf36850 100644 --- a/src/Xanthous/App.hs +++ b/src/Xanthous/App.hs @@ -36,6 +36,7 @@ import Xanthous.Game.Prompt import Xanthous.Monad import Xanthous.Resource (Name, Panel(..)) import qualified Xanthous.Messages as Messages +import Xanthous.Util (removeVectorIndex) import Xanthous.Util.Inflection (toSentence) -------------------------------------------------------------------------------- import qualified Xanthous.Entities.Character as Character @@ -46,7 +47,10 @@ import Xanthous.Entities.Creature (Creature) import qualified Xanthous.Entities.Creature as Creature import Xanthous.Entities.Environment (Door, open, locked, GroundMessage(..)) -import Xanthous.Entities.RawTypes (edible, eatMessage, hitpointsHealed) +import Xanthous.Entities.RawTypes + ( edible, eatMessage, hitpointsHealed + , wieldable + ) import Xanthous.Generators import qualified Xanthous.Generators.CaveAutomata as CaveAutomata -------------------------------------------------------------------------------- @@ -197,9 +201,7 @@ handleCommand Eat = do menuItems = mkMenuItems $ imap foodMenuItem food in menu_ ["eat", "menuPrompt"] Cancellable menuItems $ \(MenuResult (idx, item, edibleItem)) -> do - character . inventory . backpack %= \inv -> - let (before, after) = V.splitAt idx inv - in before <> fromMaybe Empty (tailMay after) + character . inventory . backpack %= removeVectorIndex idx let msg = fromMaybe (Messages.lookup ["eat", "eat"]) $ edibleItem ^. eatMessage character . characterHitpoints' += @@ -233,6 +235,24 @@ handleCommand Read = do handleCommand ShowInventory = showPanel InventoryPanel >> continue +handleCommand Wield = do + uses (character . inventory . backpack) + (V.mapMaybe (\item -> + (WieldedItem item) <$> item ^. Item.itemType . wieldable)) + >>= \case + Empty -> say_ ["wield", "nothing"] + wieldables -> + menu_ ["wield", "menu"] Cancellable (wieldableMenu wieldables) + $ \(MenuResult (idx, item)) -> do + character . inventory . backpack %= removeVectorIndex idx + character . inventory . wielded .= inRightHand item + say ["wield", "wielded"] item + continue + where + wieldableMenu = mkMenuItems . imap wieldableMenuItem + wieldableMenuItem idx wi@(WieldedItem item _) = + (entityMenuChar item, MenuOption (description item) (idx, wi)) + handleCommand Save = do -- TODO default save locations / config file? prompt_ @'StringPrompt ["save", "location"] Cancellable @@ -433,11 +453,15 @@ entityMenu_ = mkMenuItems @[_] . map entityMenuItem entityMenuItem wentity = let entity = extract wentity in (entityMenuChar entity, MenuOption (description entity) wentity) - entityMenuChar entity - = let ec = entityChar entity ^. char - in if ec `elem` (['a'..'z'] ++ ['A'..'Z']) - then ec - else 'a' + + +entityMenuChar :: Entity a => a -> Char +entityMenuChar entity + = let ec = entityChar entity ^. char + in if ec `elem` (['a'..'z'] ++ ['A'..'Z']) + then ec + else 'a' + -- entityMenu :: Entity entity => [entity] -> Map Char (MenuOption entity) -- entityMenu = map (map runIdentity) . entityMenu_ . fmap Identity diff --git a/src/Xanthous/Command.hs b/src/Xanthous/Command.hs index 7b689c6466..3547bdf09a 100644 --- a/src/Xanthous/Command.hs +++ b/src/Xanthous/Command.hs @@ -21,6 +21,7 @@ data Command | Save | Read | ShowInventory + | Wield -- | TODO replace with `:` commands | ToggleRevealAll @@ -37,7 +38,9 @@ commandFromKey (KChar 'e') [] = Just Eat commandFromKey (KChar 'S') [] = Just Save commandFromKey (KChar 'r') [] = Just Read commandFromKey (KChar 'i') [] = Just ShowInventory +commandFromKey (KChar 'w') [] = Just Wield +-- DEBUG COMMANDS -- commandFromKey (KChar 'r') [MMeta] = Just ToggleRevealAll commandFromKey _ _ = Nothing diff --git a/src/Xanthous/Entities/Character.hs b/src/Xanthous/Entities/Character.hs index 5ddf33c294..8a3e7c4520 100644 --- a/src/Xanthous/Entities/Character.hs +++ b/src/Xanthous/Entities/Character.hs @@ -20,6 +20,8 @@ module Xanthous.Entities.Character , hands , leftHand , rightHand + , inLeftHand + , inRightHand , doubleHanded , wieldedItems , WieldedItem(..) @@ -100,9 +102,15 @@ hands = prism' (uncurry Hands) $ \case leftHand :: Traversal' Wielded WieldedItem leftHand = hands . _1 . _Just +inLeftHand :: WieldedItem -> Wielded +inLeftHand wi = Hands (Just wi) Nothing + rightHand :: Traversal' Wielded WieldedItem rightHand = hands . _2 . _Just +inRightHand :: WieldedItem -> Wielded +inRightHand wi = Hands Nothing (Just wi) + doubleHanded :: Prism' Wielded WieldedItem doubleHanded = prism' DoubleHanded $ \case DoubleHanded i -> Just i diff --git a/src/Xanthous/Game/Draw.hs b/src/Xanthous/Game/Draw.hs index 09015d0688..d98b48c027 100644 --- a/src/Xanthous/Game/Draw.hs +++ b/src/Xanthous/Game/Draw.hs @@ -112,19 +112,14 @@ drawPanel game panel drawWielded :: Wielded -> Widget Name drawWielded (Hands Nothing Nothing) = emptyWidget drawWielded (DoubleHanded i) = - txt $ "You are holding " <> description i <> " in both hands" - drawWielded (Hands l r) = - maybe - emptyWidget - (\i -> - txt $ "You are holding " <> description i <> " in your left hand") - l - <=> - maybe - emptyWidget - (\i -> - txt $ "You are holding " <> description i <> " in your right hand") - r + txtWrap $ "You are holding " <> description i <> " in both hands" + drawWielded (Hands l r) = drawHand "left" l <=> drawHand "right" r + drawHand side = maybe emptyWidget $ \i -> + txtWrap ( "You are holding " + <> description i + <> " in your " <> side <> " hand" + ) + <=> txt " " drawBackpack :: Vector Item -> Widget Name drawBackpack Empty = txtWrap "Your backpack is empty right now." diff --git a/src/Xanthous/Util.hs b/src/Xanthous/Util.hs index 814f937115..b8b789e1b1 100644 --- a/src/Xanthous/Util.hs +++ b/src/Xanthous/Util.hs @@ -25,17 +25,19 @@ module Xanthous.Util -- ** Bag sequence algorithms , takeWhileInclusive , smallestNotIn + , removeVectorIndex -- * Type-level programming utils , KnownBool(..) ) where -------------------------------------------------------------------------------- -import Xanthous.Prelude hiding (foldr) +import Xanthous.Prelude hiding (foldr) -------------------------------------------------------------------------------- -import Test.QuickCheck.Checkers -import Data.Foldable (foldr) -import Data.Monoid -import Data.Proxy +import Test.QuickCheck.Checkers +import Data.Foldable (foldr) +import Data.Monoid +import Data.Proxy +import qualified Data.Vector as V -------------------------------------------------------------------------------- newtype EqEqProp a = EqEqProp a @@ -210,6 +212,12 @@ smallestNotIn xs = case uniq $ sort xs of | otherwise -> snd . headEx . filter (uncurry (/=)) $ zip (xs' ++ [minBound]) [minBound..] +-- | Remove the element at the given index, if any, from the given vector +removeVectorIndex :: Int -> Vector a -> Vector a +removeVectorIndex idx vect = + let (before, after) = V.splitAt idx vect + in before <> fromMaybe Empty (tailMay after) + -------------------------------------------------------------------------------- -- | This class gives a boolean associated with a type-level bool, a'la diff --git a/src/Xanthous/messages.yaml b/src/Xanthous/messages.yaml index 0d8ada8c57..3967a0cba0 100644 --- a/src/Xanthous/messages.yaml +++ b/src/Xanthous/messages.yaml @@ -67,5 +67,17 @@ read: nothing: "There's nothing there to read" result: "\"{{message}}\"" +wield: + nothing: + - You aren't carrying anything you can wield + - You can't wield anything in your backpack + - You can't wield anything currently in your backpack + menu: What would you like to wield? + # TODO: use actual hands + wielded : You wield the {{wieldedItem.itemType.name}} in your right hand. + + +### + tutorial: message1: The caves are dark and full of nightmarish creatures - and you are likely to perish without food. Seek out sustenance! You can pick items up with ,. -- cgit 1.4.1 From 8ecefddbd4cc9c79478003781877d37b3c80fcc4 Mon Sep 17 00:00:00 2001 From: Griffin Smith Date: Mon, 23 Dec 2019 10:47:09 -0500 Subject: Use wielded items to calculate damage Use whatever items the character has wielded, if any, to calculate the damage they deal when attacking. Currently this shortcuts handedness to just use the *first* item they have equipped, which is fine since it's currently only possible to equip something in the right hand. --- src/Xanthous/App.hs | 4 +-- src/Xanthous/Entities/Character.hs | 57 ++++++++++++++++++++++---------------- 2 files changed, 35 insertions(+), 26 deletions(-) diff --git a/src/Xanthous/App.hs b/src/Xanthous/App.hs index 77fbf36850..b278eec237 100644 --- a/src/Xanthous/App.hs +++ b/src/Xanthous/App.hs @@ -238,7 +238,7 @@ handleCommand ShowInventory = showPanel InventoryPanel >> continue handleCommand Wield = do uses (character . inventory . backpack) (V.mapMaybe (\item -> - (WieldedItem item) <$> item ^. Item.itemType . wieldable)) + WieldedItem item <$> item ^. Item.itemType . wieldable)) >>= \case Empty -> say_ ["wield", "nothing"] wieldables -> @@ -431,7 +431,7 @@ attackAt pos = $ \(MenuResult creature) -> attackCreature creature where attackCreature (creatureID, creature) = do - charDamage <- use $ character . characterDamage + charDamage <- uses character characterDamage let creature' = Creature.damage charDamage creature msgParams = object ["creature" A..= creature'] if Creature.isDead creature' diff --git a/src/Xanthous/Entities/Character.hs b/src/Xanthous/Entities/Character.hs index 8a3e7c4520..955c94fc77 100644 --- a/src/Xanthous/Entities/Character.hs +++ b/src/Xanthous/Entities/Character.hs @@ -37,20 +37,23 @@ module Xanthous.Entities.Character -------------------------------------------------------------------------------- import Xanthous.Prelude -------------------------------------------------------------------------------- -import Test.QuickCheck -import Test.QuickCheck.Instances.Vector () -import Test.QuickCheck.Arbitrary.Generic -import Brick -import Data.Aeson.Generic.DerivingVia -import Data.Aeson (ToJSON, FromJSON) -import Data.Coerce (coerce) +import Brick +import Data.Aeson.Generic.DerivingVia +import Data.Aeson (ToJSON, FromJSON) +import Data.Coerce (coerce) +import Test.QuickCheck +import Test.QuickCheck.Instances.Vector () +import Test.QuickCheck.Arbitrary.Generic -------------------------------------------------------------------------------- -import Xanthous.Util.QuickCheck -import Xanthous.Game.State -import Xanthous.Entities.Item -import Xanthous.Data - (TicksPerTile, Hitpoints, Per, Ticks, (|*|), positioned, Positioned(..)) -import Xanthous.Entities.RawTypes (WieldableItem, wieldable) +import Xanthous.Util.QuickCheck +import Xanthous.Game.State +import Xanthous.Entities.Item +import Xanthous.Data + ( TicksPerTile, Hitpoints, Per, Ticks, (|*|), positioned + , Positioned(..) + ) +import Xanthous.Entities.RawTypes (WieldableItem, wieldable) +import qualified Xanthous.Entities.RawTypes as Raw -------------------------------------------------------------------------------- data WieldedItem = WieldedItem @@ -116,11 +119,9 @@ doubleHanded = prism' DoubleHanded $ \case DoubleHanded i -> Just i _ -> Nothing -wieldedItems :: Traversal' Wielded Item -wieldedItems k (DoubleHanded wielded) = DoubleHanded <$> wieldedItem k wielded -wieldedItems k (Hands l r) = Hands - <$> (_Just . wieldedItem) k l - <*> (_Just . wieldedItem) k r +wieldedItems :: Traversal' Wielded WieldedItem +wieldedItems k (DoubleHanded wielded) = DoubleHanded <$> k wielded +wieldedItems k (Hands l r) = Hands <$> _Just k l <*> _Just k r data Inventory = Inventory { _backpack :: Vector Item @@ -137,7 +138,7 @@ makeFieldsNoPrefix ''Inventory items :: Traversal' Inventory Item items k (Inventory bp w) = Inventory <$> traversed k bp - <*> wieldedItems k w + <*> (wieldedItems . wieldedItem) k w type instance Element Inventory = Item @@ -165,15 +166,15 @@ instance Semigroup Inventory where let backpack' = inv₁ ^. backpack <> inv₂ ^. backpack (wielded', backpack'') = case (inv₁ ^. wielded, inv₂ ^. wielded) of (wielded₁, wielded₂@(DoubleHanded _)) -> - (wielded₂, backpack' <> fromList (wielded₁ ^.. wieldedItems)) + (wielded₂, backpack' <> fromList (wielded₁ ^.. wieldedItems . wieldedItem)) (wielded₁, wielded₂@(Hands (Just _) (Just _))) -> - (wielded₂, backpack' <> fromList (wielded₁ ^.. wieldedItems)) + (wielded₂, backpack' <> fromList (wielded₁ ^.. wieldedItems . wieldedItem)) (wielded₁, Hands Nothing Nothing) -> (wielded₁, backpack') (Hands Nothing Nothing, wielded₂) -> (wielded₂, backpack') (Hands (Just l₁) Nothing, Hands Nothing (Just r₂)) -> (Hands (Just l₁) (Just r₂), backpack') (wielded₁@(DoubleHanded _), wielded₂) -> - (wielded₁, backpack' <> fromList (wielded₂ ^.. wieldedItems)) + (wielded₁, backpack' <> fromList (wielded₂ ^.. wieldedItems . wieldedItem)) (Hands Nothing (Just r₁), Hands Nothing (Just r₂)) -> (Hands Nothing (Just r₂), r₁ ^. wieldedItem <| backpack') (Hands Nothing r₁, Hands (Just l₂) Nothing) -> @@ -194,7 +195,6 @@ instance Monoid Inventory where data Character = Character { _inventory :: !Inventory , _characterName :: !(Maybe Text) - , _characterDamage :: !Hitpoints , _characterHitpoints' :: !Double , _speed :: TicksPerTile } @@ -245,11 +245,20 @@ mkCharacter :: Character mkCharacter = Character { _inventory = mempty , _characterName = Nothing - , _characterDamage = 1 , _characterHitpoints' = fromIntegral initialHitpoints , _speed = defaultSpeed } +defaultCharacterDamage :: Hitpoints +defaultCharacterDamage = 1 + +-- | Returns the damage that the character currently does with an attack +-- TODO use double-handed/left-hand/right-hand here +characterDamage :: Character -> Hitpoints +characterDamage + = fromMaybe defaultCharacterDamage + . preview (inventory . wielded . wieldedItems . wieldableItem . Raw.damage) + isDead :: Character -> Bool isDead = (== 0) . characterHitpoints -- cgit 1.4.1 From bf7d139c1a17fe55921fb807aa249e93288d3e4d Mon Sep 17 00:00:00 2001 From: Griffin Smith Date: Mon, 23 Dec 2019 10:59:45 -0500 Subject: Use attack messages when attacking When attacking, use either: - the message defined on the entity raw of the wielded item, if any - the generic attack message, if an item without an attack message is wielded - the fists attack message, if no item is wielded --- src/Xanthous/App.hs | 14 ++++++++++---- src/Xanthous/Monad.hs | 12 ++++++------ 2 files changed, 16 insertions(+), 10 deletions(-) diff --git a/src/Xanthous/App.hs b/src/Xanthous/App.hs index b278eec237..6b1c2413c6 100644 --- a/src/Xanthous/App.hs +++ b/src/Xanthous/App.hs @@ -49,7 +49,7 @@ import Xanthous.Entities.Environment (Door, open, locked, GroundMessage(..)) import Xanthous.Entities.RawTypes ( edible, eatMessage, hitpointsHealed - , wieldable + , wieldable, attackMessage ) import Xanthous.Generators import qualified Xanthous.Generators.CaveAutomata as CaveAutomata @@ -439,10 +439,17 @@ attackAt pos = say ["combat", "killed"] msgParams entities . at creatureID .= Nothing else do - -- TODO attack messages - say ["combat", "hit", "generic"] msgParams + msg <- uses character getAttackMessage + message msg msgParams entities . ix creatureID . positioned .= SomeEntity creature' stepGame -- TODO + getAttackMessage chr = + case chr ^? inventory . wielded . wieldedItems . wieldableItem of + Just wi -> + fromMaybe (Messages.lookup ["combat", "hit", "generic"]) + $ wi ^. attackMessage + Nothing -> + Messages.lookup ["combat", "hit", "fists"] entityMenu_ :: (Comonad w, Entity entity) @@ -462,7 +469,6 @@ entityMenuChar entity then ec else 'a' - -- entityMenu :: Entity entity => [entity] -> Map Char (MenuOption entity) -- entityMenu = map (map runIdentity) . entityMenu_ . fmap Identity diff --git a/src/Xanthous/Monad.hs b/src/Xanthous/Monad.hs index c11cb0e2d4..1138a7a5a0 100644 --- a/src/Xanthous/Monad.hs +++ b/src/Xanthous/Monad.hs @@ -10,6 +10,7 @@ module Xanthous.Monad , say_ , message , message_ + , writeMessage ) where -------------------------------------------------------------------------------- import Xanthous.Prelude @@ -37,19 +38,18 @@ continue = lift . Brick.continue =<< get say :: (MonadRandom m, ToJSON params, MonadState GameState m) => [Text] -> params -> m () -say msgPath params = do - msg <- Messages.message msgPath params - messageHistory %= pushMessage msg +say msgPath = writeMessage <=< Messages.message msgPath say_ :: (MonadRandom m, MonadState GameState m) => [Text] -> m () say_ msgPath = say msgPath $ object [] message :: (MonadRandom m, ToJSON params, MonadState GameState m) => Message -> params -> m () -message msg params = do - m <- Messages.render msg params - messageHistory %= pushMessage m +message msg = writeMessage <=< Messages.render msg message_ :: (MonadRandom m, MonadState GameState m) => Message -> m () message_ msg = message msg $ object [] + +writeMessage :: MonadState GameState m => Text -> m () +writeMessage m = messageHistory %= pushMessage m -- cgit 1.4.1 From 052bc8455a99e7f1a90b6c9354e54cff10de02cc Mon Sep 17 00:00:00 2001 From: Griffin Smith Date: Mon, 23 Dec 2019 12:19:51 -0500 Subject: Add a drop command Add a drop command, bound to 'd', which prompts the character for an item in their inventory, removes it from the inventory, and places it on the ground. Along the way I had to fix a bug in the `EntityMap.atPosition` lens, which was always appending to the existing entities at the position on set, without removing the entities that were already there - the rabbit hole of quickchecking the lens laws here also lead to replacing the target of this lens with a newtype called `VectorBag`, which ignores order (since the entitymap makes no guarantees about order of entities at a given position). --- package.yaml | 1 - src/Xanthous/App.hs | 74 ++++++++++++++++++++++------- src/Xanthous/Command.hs | 2 + src/Xanthous/Data/EntityMap.hs | 20 ++++++-- src/Xanthous/Data/VectorBag.hs | 94 +++++++++++++++++++++++++++++++++++++ src/Xanthous/Entities/Character.hs | 7 +++ src/Xanthous/Game/State.hs | 3 +- src/Xanthous/messages.yaml | 11 +++++ test/Xanthous/Data/EntityMapSpec.hs | 5 ++ xanthous.cabal | 7 ++- 10 files changed, 197 insertions(+), 27 deletions(-) create mode 100644 src/Xanthous/Data/VectorBag.hs diff --git a/package.yaml b/package.yaml index f982a23397..b4c5330807 100644 --- a/package.yaml +++ b/package.yaml @@ -41,7 +41,6 @@ dependencies: - MonadRandom - mtl - optparse-applicative -- parallel - random - random-fu - random-extras diff --git a/src/Xanthous/App.hs b/src/Xanthous/App.hs index 6b1c2413c6..353ab28e16 100644 --- a/src/Xanthous/App.hs +++ b/src/Xanthous/App.hs @@ -49,7 +49,7 @@ import Xanthous.Entities.Environment (Door, open, locked, GroundMessage(..)) import Xanthous.Entities.RawTypes ( edible, eatMessage, hitpointsHealed - , wieldable, attackMessage + , attackMessage ) import Xanthous.Generators import qualified Xanthous.Generators.CaveAutomata as CaveAutomata @@ -158,6 +158,15 @@ handleCommand PickUp = do say ["pickUp", "pickUp"] $ object [ "item" A..= item ] stepGameBy 100 -- TODO +handleCommand Drop = do + selectItemFromInventory_ ["drop", "menu"] Cancellable id + (say_ ["drop", "nothing"]) + $ \(MenuResult item) -> do + charPos <- use characterPosition + entities . EntityMap.atPosition charPos %= (SomeEntity item <|) + say ["drop", "dropped"] $ object [ "item" A..= item ] + continue + handleCommand PreviousMessage = do messageHistory %= previousMessage continue @@ -236,22 +245,12 @@ handleCommand Read = do handleCommand ShowInventory = showPanel InventoryPanel >> continue handleCommand Wield = do - uses (character . inventory . backpack) - (V.mapMaybe (\item -> - WieldedItem item <$> item ^. Item.itemType . wieldable)) - >>= \case - Empty -> say_ ["wield", "nothing"] - wieldables -> - menu_ ["wield", "menu"] Cancellable (wieldableMenu wieldables) - $ \(MenuResult (idx, item)) -> do - character . inventory . backpack %= removeVectorIndex idx - character . inventory . wielded .= inRightHand item - say ["wield", "wielded"] item + selectItemFromInventory_ ["wield", "menu"] Cancellable asWieldedItem + (say_ ["wield", "nothing"]) + $ \(MenuResult item) -> do + character . inventory . wielded .= inRightHand item + say ["wield", "wielded"] item continue - where - wieldableMenu = mkMenuItems . imap wieldableMenuItem - wieldableMenuItem idx wi@(WieldedItem item _) = - (entityMenuChar item, MenuOption (description item) (idx, wi)) handleCommand Save = do -- TODO default save locations / config file? @@ -469,6 +468,49 @@ entityMenuChar entity then ec else 'a' +-- | Prompt with an item to select out of the inventory, remove it from the +-- inventory, and call callback with it +selectItemFromInventory + :: forall item params. + (ToJSON params) + => [Text] -- ^ Menu message + -> params -- ^ Menu message params + -> PromptCancellable -- ^ Is the menu cancellable? + -> Prism' Item item -- ^ Attach some extra information to the item, in a + -- recoverable fashion. Prism vs iso so we can discard + -- items. + -> AppM () -- ^ Action to take if there are no items matching + -> (PromptResult ('Menu item) -> AppM ()) + -> AppM () +selectItemFromInventory msgPath msgParams cancellable extraInfo onEmpty cb = + uses (character . inventory . backpack) + (V.mapMaybe $ preview extraInfo) + >>= \case + Empty -> onEmpty + items' -> + menu msgPath msgParams cancellable (itemMenu items') + $ \(MenuResult (idx, item)) -> do + character . inventory . backpack %= removeVectorIndex idx + cb $ MenuResult item + where + itemMenu = mkMenuItems . imap itemMenuItem + itemMenuItem idx extraInfoItem = + let item = extraInfo # extraInfoItem + in ( entityMenuChar item + , MenuOption (description item) (idx, extraInfoItem)) + +selectItemFromInventory_ + :: forall item. + [Text] -- ^ Menu message + -> PromptCancellable -- ^ Is the menu cancellable? + -> Prism' Item item -- ^ Attach some extra information to the item, in a + -- recoverable fashion. Prism vs iso so we can discard + -- items. + -> AppM () -- ^ Action to take if there are no items matching + -> (PromptResult ('Menu item) -> AppM ()) + -> AppM () +selectItemFromInventory_ msgPath = selectItemFromInventory msgPath () + -- entityMenu :: Entity entity => [entity] -> Map Char (MenuOption entity) -- entityMenu = map (map runIdentity) . entityMenu_ . fmap Identity diff --git a/src/Xanthous/Command.hs b/src/Xanthous/Command.hs index 3547bdf09a..d5bb5cd9ee 100644 --- a/src/Xanthous/Command.hs +++ b/src/Xanthous/Command.hs @@ -14,6 +14,7 @@ data Command | Move Direction | PreviousMessage | PickUp + | Drop | Open | Wait | Eat @@ -32,6 +33,7 @@ commandFromKey (KChar '.') [] = Just Wait commandFromKey (KChar (directionFromChar -> Just dir)) [] = Just $ Move dir commandFromKey (KChar 'p') [MCtrl] = Just PreviousMessage commandFromKey (KChar ',') [] = Just PickUp +commandFromKey (KChar 'd') [] = Just Drop commandFromKey (KChar 'o') [] = Just Open commandFromKey (KChar ';') [] = Just Look commandFromKey (KChar 'e') [] = Just Eat diff --git a/src/Xanthous/Data/EntityMap.hs b/src/Xanthous/Data/EntityMap.hs index 9ea952c054..619b4b05c4 100644 --- a/src/Xanthous/Data/EntityMap.hs +++ b/src/Xanthous/Data/EntityMap.hs @@ -39,6 +39,7 @@ import Xanthous.Data , Neighbors(..) , neighborPositions ) +import Xanthous.Data.VectorBag import Xanthous.Orphans () import Xanthous.Util (EqEqProp(..)) -------------------------------------------------------------------------------- @@ -184,16 +185,25 @@ insertAtReturningID pos e em = insertAt :: forall a. Position -> a -> EntityMap a -> EntityMap a insertAt pos e = snd . insertAtReturningID pos e -atPosition :: forall a. Position -> Lens' (EntityMap a) (Vector a) +atPosition :: forall a. Position -> Lens' (EntityMap a) (VectorBag a) atPosition pos = lens getter setter where getter em = - let eids :: Vector EntityID - eids = maybe mempty (toVector . toNullable) + let eids :: VectorBag EntityID + eids = maybe mempty (VectorBag . toVector . toNullable) $ em ^. byPosition . at pos in getEIDAssume em <$> eids setter em Empty = em & byPosition . at pos .~ Nothing - setter em entities = alaf Endo foldMap (insertAt pos) entities em + setter em entities = + alaf Endo foldMap (insertAt pos) entities + . removeAllAt pos + $ em + where + removeAllAt p e = + let eids = e ^.. byPosition . at p >>= toList >>= toList + in alaf Endo foldMap (\eid -> byID . at eid .~ Nothing) eids + . (byPosition . at pos .~ Nothing) + $ e getEIDAssume :: EntityMap a -> EntityID -> a getEIDAssume em eid = fromMaybe byIDInvariantError @@ -237,7 +247,7 @@ lookup eid = fmap (view positioned) . lookupWithPosition eid -- positionedEntities :: IndexedTraversal EntityID (EntityMap a) (EntityMap b) (Positioned a) (Positioned b) -- positionedEntities = byID . itraversed -neighbors :: Position -> EntityMap a -> Neighbors (Vector a) +neighbors :: Position -> EntityMap a -> Neighbors (VectorBag a) neighbors pos em = (\p -> view (atPosition p) em) <$> neighborPositions pos -------------------------------------------------------------------------------- diff --git a/src/Xanthous/Data/VectorBag.hs b/src/Xanthous/Data/VectorBag.hs new file mode 100644 index 0000000000..bd9af369e0 --- /dev/null +++ b/src/Xanthous/Data/VectorBag.hs @@ -0,0 +1,94 @@ +{-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE DeriveTraversable #-} +{-# LANGUAGE TemplateHaskell #-} +-------------------------------------------------------------------------------- +module Xanthous.Data.VectorBag + (VectorBag(..) + ) where +-------------------------------------------------------------------------------- +import Xanthous.Prelude +import Data.Aeson +import qualified Data.Vector as V +import Test.QuickCheck +import Test.QuickCheck.Instances.Vector () +-------------------------------------------------------------------------------- + +-- | Acts exactly like a Vector, except ignores order when testing for equality +newtype VectorBag a = VectorBag (Vector a) + deriving stock + ( Traversable + , Generic + ) + deriving newtype + ( Show + , Read + , Foldable + , FromJSON + , FromJSON1 + , ToJSON + , Reversing + , Applicative + , Functor + , Monad + , Monoid + , Semigroup + , Arbitrary + , CoArbitrary + ) +makeWrapped ''VectorBag + +instance Function a => Function (VectorBag a) where + function = functionMap (\(VectorBag v) -> v) VectorBag + +type instance Element (VectorBag a) = a +deriving via (Vector a) instance MonoFoldable (VectorBag a) +deriving via (Vector a) instance GrowingAppend (VectorBag a) +deriving via (Vector a) instance SemiSequence (VectorBag a) +deriving via (Vector a) instance MonoPointed (VectorBag a) +deriving via (Vector a) instance MonoFunctor (VectorBag a) + +instance Cons (VectorBag a) (VectorBag b) a b where + _Cons = prism (\(x, VectorBag xs) -> VectorBag $ x <| xs) $ \(VectorBag v) -> + if V.null v + then Left (VectorBag mempty) + else Right (V.unsafeHead v, VectorBag $ V.unsafeTail v) + +instance AsEmpty (VectorBag a) where + _Empty = prism' (const $ VectorBag Empty) $ \case + (VectorBag Empty) -> Just () + _ -> Nothing + +{- + TODO: + , Ixed + , FoldableWithIndex + , FunctorWithIndex + , TraversableWithIndex + , Snoc + , Each +-} + +instance Ord a => Eq (VectorBag a) where + (==) = (==) `on` (view _Wrapped . sort) + +instance Ord a => Ord (VectorBag a) where + compare = compare `on` (view _Wrapped . sort) + +instance MonoTraversable (VectorBag a) where + otraverse f (VectorBag v) = VectorBag <$> otraverse f v + +instance IsSequence (VectorBag a) where + fromList = VectorBag . fromList + break prd (VectorBag v) = bimap VectorBag VectorBag $ break prd v + span prd (VectorBag v) = bimap VectorBag VectorBag $ span prd v + dropWhile prd (VectorBag v) = VectorBag $ dropWhile prd v + takeWhile prd (VectorBag v) = VectorBag $ takeWhile prd v + splitAt idx (VectorBag v) = bimap VectorBag VectorBag $ splitAt idx v + unsafeSplitAt idx (VectorBag v) = + bimap VectorBag VectorBag $ unsafeSplitAt idx v + take n (VectorBag v) = VectorBag $ take n v + unsafeTake n (VectorBag v) = VectorBag $ unsafeTake n v + drop n (VectorBag v) = VectorBag $ drop n v + unsafeDrop n (VectorBag v) = VectorBag $ unsafeDrop n v + partition p (VectorBag v) = bimap VectorBag VectorBag $ partition p v diff --git a/src/Xanthous/Entities/Character.hs b/src/Xanthous/Entities/Character.hs index 955c94fc77..43d4f8a529 100644 --- a/src/Xanthous/Entities/Character.hs +++ b/src/Xanthous/Entities/Character.hs @@ -27,6 +27,7 @@ module Xanthous.Entities.Character , WieldedItem(..) , wieldedItem , wieldableItem + , asWieldedItem -- * , mkCharacter @@ -68,6 +69,12 @@ data WieldedItem = WieldedItem WieldedItem makeFieldsNoPrefix ''WieldedItem +asWieldedItem :: Prism' Item WieldedItem +asWieldedItem = prism' hither yon + where + yon item = WieldedItem item <$> item ^. itemType . wieldable + hither (WieldedItem item _) = item + instance Brain WieldedItem where step ticks (Positioned p wi) = over positioned (\i -> WieldedItem i $ wi ^. wieldableItem) diff --git a/src/Xanthous/Game/State.hs b/src/Xanthous/Game/State.hs index 3b401d366d..d8a0f0b320 100644 --- a/src/Xanthous/Game/State.hs +++ b/src/Xanthous/Game/State.hs @@ -80,6 +80,7 @@ import Xanthous.Util (KnownBool(..)) import Xanthous.Data import Xanthous.Data.EntityMap (EntityMap, EntityID) import Xanthous.Data.EntityChar +import Xanthous.Data.VectorBag import Xanthous.Orphans () import Xanthous.Game.Prompt import Xanthous.Resource @@ -185,7 +186,7 @@ type AppM = AppT (EventM Name) -------------------------------------------------------------------------------- class Draw a where - drawWithNeighbors :: Neighbors (Vector SomeEntity) -> a -> Widget n + drawWithNeighbors :: Neighbors (VectorBag SomeEntity) -> a -> Widget n drawWithNeighbors = const draw draw :: a -> Widget n diff --git a/src/Xanthous/messages.yaml b/src/Xanthous/messages.yaml index 3967a0cba0..9e59f4fb0f 100644 --- a/src/Xanthous/messages.yaml +++ b/src/Xanthous/messages.yaml @@ -76,6 +76,17 @@ wield: # TODO: use actual hands wielded : You wield the {{wieldedItem.itemType.name}} in your right hand. +drop: + nothing: You aren't carrying anything + menu: What would you like to drop? + # TODO: use actual hands + dropped: + - You drop the {{item.itemType.name}}. + - You drop the {{item.itemType.name}} on the ground. + - You put the {{item.itemType.name}} on the ground. + - You take the {{item.itemType.name}} out of your backpack and put it on the ground. + - You take the {{item.itemType.name}} out of your backpack and drop it on the ground. + ### diff --git a/test/Xanthous/Data/EntityMapSpec.hs b/test/Xanthous/Data/EntityMapSpec.hs index 88e0d0d771..8317f5f51f 100644 --- a/test/Xanthous/Data/EntityMapSpec.hs +++ b/test/Xanthous/Data/EntityMapSpec.hs @@ -3,6 +3,7 @@ module Xanthous.Data.EntityMapSpec where -------------------------------------------------------------------------------- import Test.Prelude +import Control.Lens.Properties -------------------------------------------------------------------------------- import qualified Data.Aeson as JSON -------------------------------------------------------------------------------- @@ -45,4 +46,8 @@ test = localOption (QuickCheckTests 20) let Just em' = JSON.decode $ JSON.encode em in toEIDsAndPositioned em' === toEIDsAndPositioned em ] + + , testGroup "atPosition" + [ testProperty "lens laws" $ \pos -> isLens $ atPosition @Int pos + ] ] diff --git a/xanthous.cabal b/xanthous.cabal index 7198e9ab9d..e70a7391f3 100644 --- a/xanthous.cabal +++ b/xanthous.cabal @@ -4,7 +4,7 @@ cabal-version: 1.12 -- -- see: https://github.com/sol/hpack -- --- hash: 0476b4307dfceb20b9358ca2e6f78c753e3e0a4ae60c6faed54528f6a9c0dc5c +-- hash: ae5b84ec168dd61b715e874bcb49579697873b164c43027a776dda725dfdffbf name: xanthous version: 0.1.0.0 @@ -37,6 +37,7 @@ library Xanthous.Data.EntityChar Xanthous.Data.EntityMap Xanthous.Data.EntityMap.Graphics + Xanthous.Data.VectorBag Xanthous.Entities.Character Xanthous.Entities.Creature Xanthous.Entities.Draw.Util @@ -96,7 +97,6 @@ library , megaparsec , mtl , optparse-applicative - , parallel , quickcheck-instances , quickcheck-text , random @@ -125,6 +125,7 @@ executable xanthous Xanthous.Data.EntityChar Xanthous.Data.EntityMap Xanthous.Data.EntityMap.Graphics + Xanthous.Data.VectorBag Xanthous.Entities.Character Xanthous.Entities.Creature Xanthous.Entities.Draw.Util @@ -183,7 +184,6 @@ executable xanthous , megaparsec , mtl , optparse-applicative - , parallel , quickcheck-instances , quickcheck-text , random @@ -248,7 +248,6 @@ test-suite test , megaparsec , mtl , optparse-applicative - , parallel , quickcheck-instances , quickcheck-text , random -- cgit 1.4.1 From f701a0be40598585cc1aec1ecf34e3fdd5690e81 Mon Sep 17 00:00:00 2001 From: Griffin Smith Date: Mon, 23 Dec 2019 14:12:32 -0500 Subject: Preserve entityIDs in atPosition's setter Make the setter for the atPosition lens preserve entityIDs for already-existing entities at the position, so that when we plop something in the same tile as the character the character's entity ID doesn't disappear. --- src/Xanthous/Data/EntityMap.hs | 43 ++++++++++++++++++++++++++----------- test/Xanthous/Data/EntityMapSpec.hs | 22 ++++++++++++++++--- 2 files changed, 50 insertions(+), 15 deletions(-) diff --git a/src/Xanthous/Data/EntityMap.hs b/src/Xanthous/Data/EntityMap.hs index 619b4b05c4..4e7796b1f4 100644 --- a/src/Xanthous/Data/EntityMap.hs +++ b/src/Xanthous/Data/EntityMap.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE ViewPatterns #-} {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE DeriveTraversable #-} @@ -185,7 +186,7 @@ insertAtReturningID pos e em = insertAt :: forall a. Position -> a -> EntityMap a -> EntityMap a insertAt pos e = snd . insertAtReturningID pos e -atPosition :: forall a. Position -> Lens' (EntityMap a) (VectorBag a) +atPosition :: forall a. (Ord a, Show a) => Position -> Lens' (EntityMap a) (VectorBag a) atPosition pos = lens getter setter where getter em = @@ -194,16 +195,34 @@ atPosition pos = lens getter setter $ em ^. byPosition . at pos in getEIDAssume em <$> eids setter em Empty = em & byPosition . at pos .~ Nothing - setter em entities = - alaf Endo foldMap (insertAt pos) entities - . removeAllAt pos - $ em - where - removeAllAt p e = - let eids = e ^.. byPosition . at p >>= toList >>= toList - in alaf Endo foldMap (\eid -> byID . at eid .~ Nothing) eids - . (byPosition . at pos .~ Nothing) - $ e + setter em (sort -> entities) = + let origEIDs = maybe Empty toNullable $ em ^. byPosition . at pos + origEntitiesWithIDs = + sortOn snd $ toList origEIDs <&> \eid -> (eid, getEIDAssume em eid) + go alles₁@((eid, e₁) :< es₁) -- orig + (e₂ :< es₂) -- new + | e₁ == e₂ + -- same, do nothing + = let (eids, lastEID, byID') = go es₁ es₂ + in (insertSet eid eids, lastEID, byID') + | otherwise + -- e₂ is new, generate a new ID for it + = let (eids, lastEID, byID') = go alles₁ es₂ + eid' = succ lastEID + in (insertSet eid' eids, eid', byID' & at eid' ?~ Positioned pos e₂) + go Empty Empty = (mempty, em ^. lastID, em ^. byID) + go orig Empty = + let byID' = foldr deleteMap (em ^. byID) $ map fst orig + in (mempty, em ^. lastID, byID') + go Empty (new :< news) = + let (eids, lastEID, byID') = go Empty news + eid' = succ lastEID + in (insertSet eid' eids, eid', byID' & at eid' ?~ Positioned pos new) + go _ _ = error "unreachable" + (eidsAtPosition, newLastID, newByID) = go origEntitiesWithIDs entities + in em & byPosition . at pos .~ fromNullable eidsAtPosition + & byID .~ newByID + & lastID .~ newLastID getEIDAssume :: EntityMap a -> EntityID -> a getEIDAssume em eid = fromMaybe byIDInvariantError @@ -247,7 +266,7 @@ lookup eid = fmap (view positioned) . lookupWithPosition eid -- positionedEntities :: IndexedTraversal EntityID (EntityMap a) (EntityMap b) (Positioned a) (Positioned b) -- positionedEntities = byID . itraversed -neighbors :: Position -> EntityMap a -> Neighbors (VectorBag a) +neighbors :: (Ord a, Show a) => Position -> EntityMap a -> Neighbors (VectorBag a) neighbors pos em = (\p -> view (atPosition p) em) <$> neighborPositions pos -------------------------------------------------------------------------------- diff --git a/test/Xanthous/Data/EntityMapSpec.hs b/test/Xanthous/Data/EntityMapSpec.hs index 8317f5f51f..7c5cad0196 100644 --- a/test/Xanthous/Data/EntityMapSpec.hs +++ b/test/Xanthous/Data/EntityMapSpec.hs @@ -3,11 +3,11 @@ module Xanthous.Data.EntityMapSpec where -------------------------------------------------------------------------------- import Test.Prelude -import Control.Lens.Properties -------------------------------------------------------------------------------- import qualified Data.Aeson as JSON -------------------------------------------------------------------------------- import Xanthous.Data.EntityMap +import Xanthous.Data (Positioned(..)) -------------------------------------------------------------------------------- main :: IO () @@ -47,7 +47,23 @@ test = localOption (QuickCheckTests 20) in toEIDsAndPositioned em' === toEIDsAndPositioned em ] - , testGroup "atPosition" - [ testProperty "lens laws" $ \pos -> isLens $ atPosition @Int pos + , localOption (QuickCheckTests 50) + $ testGroup "atPosition" + [ testProperty "setget" $ \pos (em :: EntityMap Int) es -> + view (atPosition pos) (set (atPosition pos) es em) === es + , testProperty "getset" $ \pos (em :: EntityMap Int) -> + set (atPosition pos) (view (atPosition pos) em) em === em + , testProperty "setset" $ \pos (em :: EntityMap Int) es -> + (set (atPosition pos) es . set (atPosition pos) es) em + === + set (atPosition pos) es em + -- testProperty "lens laws" $ \pos -> isLens $ atPosition @Int pos + , testProperty "preserves IDs" $ \(em :: EntityMap Int) e1 e2 p -> + let (eid, em') = insertAtReturningID p e1 em + em'' = em' & atPosition p %~ (e2 <|) + in + counterexample ("em': " <> show em') + . counterexample ("em'': " <> show em'') + $ em'' ^. at eid === Just (Positioned p e1) ] ] -- cgit 1.4.1 From a58966d43f86d6fae92c1fc11e43650177fcecd1 Mon Sep 17 00:00:00 2001 From: Griffin Smith Date: Mon, 23 Dec 2019 17:20:18 -0500 Subject: Confirm before quitting Prompt to confirm before quitting the game with the Quit command --- src/Xanthous/App.hs | 27 ++++++++++++++++++++++++--- src/Xanthous/Game/Prompt.hs | 1 + src/Xanthous/messages.yaml | 3 +++ 3 files changed, 28 insertions(+), 3 deletions(-) diff --git a/src/Xanthous/App.hs b/src/Xanthous/App.hs index 353ab28e16..2ffc11e8e6 100644 --- a/src/Xanthous/App.hs +++ b/src/Xanthous/App.hs @@ -129,7 +129,7 @@ handleNoPromptEvent (VtyEvent (EvKey k mods)) handleNoPromptEvent _ = continue handleCommand :: Command -> AppM (Next GameState) -handleCommand Quit = halt +handleCommand Quit = confirm_ ["quit", "confirm"] (liftIO exitSuccess) >> continue handleCommand (Move dir) = do newPos <- uses characterPosition $ move dir collisionAt newPos >>= \case @@ -282,6 +282,12 @@ handlePromptEvent _ (Prompt Cancellable _ _ _ _) (VtyEvent (EvKey KEsc [])) handlePromptEvent _ pr (VtyEvent (EvKey KEnter [])) = submitPrompt pr >> clearPrompt +handlePromptEvent _ pr@(Prompt _ SConfirm _ _ _) (VtyEvent (EvKey (KChar 'y') [])) + = submitPrompt pr >> clearPrompt + +handlePromptEvent _ (Prompt _ SConfirm _ _ _) (VtyEvent (EvKey (KChar 'n') [])) + = clearPrompt + handlePromptEvent msg (Prompt c SStringPrompt (StringPromptState edit) pri cb) @@ -297,8 +303,6 @@ handlePromptEvent _ (Prompt _ SDirectionPrompt _ _ cb) = cb (DirectionResult dir) >> clearPrompt handlePromptEvent _ (Prompt _ SDirectionPrompt _ _ _) _ = continue -handlePromptEvent _ (Prompt _ SContinue _ _ _) _ = continue - handlePromptEvent _ (Prompt _ SMenu _ items' cb) (VtyEvent (EvKey (KChar chr) [])) | Just (MenuOption _ res) <- items' ^. at chr = cb (MenuResult res) >> clearPrompt @@ -315,6 +319,11 @@ handlePromptEvent >> continue handlePromptEvent _ (Prompt _ SPointOnMap _ _ _) _ = continue +handlePromptEvent + _ + (Prompt Cancellable _ _ _ _) + (VtyEvent (EvKey (KChar 'q') [])) + = clearPrompt handlePromptEvent _ _ _ = continue clearPrompt :: AppM (Next GameState) @@ -361,6 +370,18 @@ prompt_ -> AppM () prompt_ msg = prompt msg $ object [] +confirm + :: ToJSON params + => [Text] -- ^ Message key + -> params + -> AppM () + -> AppM () +confirm msgPath params + = prompt @'Confirm msgPath params Cancellable . const + +confirm_ :: [Text] -> AppM () -> AppM () +confirm_ msgPath = confirm msgPath $ object [] + menu :: forall (a :: Type) (params :: Type). (ToJSON params) => [Text] -- ^ Message key diff --git a/src/Xanthous/Game/Prompt.hs b/src/Xanthous/Game/Prompt.hs index b83c3d246f..e89cf5bee3 100644 --- a/src/Xanthous/Game/Prompt.hs +++ b/src/Xanthous/Game/Prompt.hs @@ -69,6 +69,7 @@ instance NFData (SPromptType pt) where class SingPromptType pt where singPromptType :: SPromptType pt instance SingPromptType 'StringPrompt where singPromptType = SStringPrompt +instance SingPromptType 'Confirm where singPromptType = SConfirm instance SingPromptType 'DirectionPrompt where singPromptType = SDirectionPrompt instance SingPromptType 'PointOnMap where singPromptType = SPointOnMap instance SingPromptType 'Continue where singPromptType = SContinue diff --git a/src/Xanthous/messages.yaml b/src/Xanthous/messages.yaml index 9e59f4fb0f..408cb6a1a5 100644 --- a/src/Xanthous/messages.yaml +++ b/src/Xanthous/messages.yaml @@ -12,6 +12,9 @@ save: location: "Enter filename to save to: " +quit: + confirm: Really quit without saving? + entities: description: You see here {{entityDescriptions}} -- cgit 1.4.1 From 32421916e09dc56d91707af10474644276712fc5 Mon Sep 17 00:00:00 2001 From: Griffin Smith Date: Mon, 23 Dec 2019 17:55:28 -0500 Subject: Update the vision every time we step the game Recalculate the character's lines of sight every time we step the game, rather than just every time the character *moves*. I had originally thought this was a non-contiguous lines-of-sight bug - which there's a test disproving - but it actually turned out to be that actions like eating or attacking would step the game forward (thus moving gormlaks) without re-calculating the positions visible to the character. --- src/Xanthous/App.hs | 3 +- test/Spec.hs | 2 ++ test/Xanthous/Data/EntityMap/GraphicsSpec.hs | 47 ++++++++++++++++++++++++++++ xanthous.cabal | 3 +- 4 files changed, 53 insertions(+), 2 deletions(-) create mode 100644 test/Xanthous/Data/EntityMap/GraphicsSpec.hs diff --git a/src/Xanthous/App.hs b/src/Xanthous/App.hs index 2ffc11e8e6..2029be6f10 100644 --- a/src/Xanthous/App.hs +++ b/src/Xanthous/App.hs @@ -102,6 +102,8 @@ stepGameBy ticks = do pEntity' <- step ticks pEntity entities . ix eid .= pEntity' + modify updateCharacterVision + whenM (uses character isDead) . prompt_ @'Continue ["dead"] Uncancellable . const . lift . liftIO @@ -137,7 +139,6 @@ handleCommand (Move dir) = do characterPosition .= newPos stepGameBy =<< uses (character . speed) (|*| 1) describeEntitiesAt newPos - modify updateCharacterVision Just Combat -> attackAt newPos Just Stop -> pure () continue diff --git a/test/Spec.hs b/test/Spec.hs index cd2827e58b..73b965bdb6 100644 --- a/test/Spec.hs +++ b/test/Spec.hs @@ -1,6 +1,7 @@ import Test.Prelude import qualified Xanthous.Data.EntityCharSpec import qualified Xanthous.Data.EntityMapSpec +import qualified Xanthous.Data.EntityMap.GraphicsSpec import qualified Xanthous.DataSpec import qualified Xanthous.Entities.RawsSpec import qualified Xanthous.GameSpec @@ -18,6 +19,7 @@ test :: TestTree test = testGroup "Xanthous" [ Xanthous.Data.EntityCharSpec.test , Xanthous.Data.EntityMapSpec.test + , Xanthous.Data.EntityMap.GraphicsSpec.test , Xanthous.Entities.RawsSpec.test , Xanthous.GameSpec.test , Xanthous.Generators.UtilSpec.test diff --git a/test/Xanthous/Data/EntityMap/GraphicsSpec.hs b/test/Xanthous/Data/EntityMap/GraphicsSpec.hs new file mode 100644 index 0000000000..6b736be4ee --- /dev/null +++ b/test/Xanthous/Data/EntityMap/GraphicsSpec.hs @@ -0,0 +1,47 @@ +-------------------------------------------------------------------------------- +module Xanthous.Data.EntityMap.GraphicsSpec (main, test) where +-------------------------------------------------------------------------------- +import Test.Prelude +import Data.Aeson +-------------------------------------------------------------------------------- +import Xanthous.Game.State +import Xanthous.Data +import Xanthous.Data.EntityMap +import Xanthous.Data.EntityMap.Graphics +-------------------------------------------------------------------------------- + +main :: IO () +main = defaultMain test + +test :: TestTree +test = testGroup "Xanthous.Data.EntityMap.Graphics" + [ testGroup "visiblePositions" + [ testCase "non-contiguous bug 1" $ + let charPos = Position 20 20 + gormlakPos = Position 17 19 + em = insertAt gormlakPos TestEntity + . insertAt charPos TestEntity + $ mempty + visPositions = visiblePositions charPos 12 em + in (gormlakPos `member` visPositions) @? + ( "not (" + <> show gormlakPos <> " `member` " + <> show visPositions + <> ")" + ) + ] + ] + +-------------------------------------------------------------------------------- + +data TestEntity = TestEntity + deriving stock (Show, Eq, Ord, Generic) + deriving anyclass (ToJSON, FromJSON, NFData) + +instance Brain TestEntity where + step _ = pure +instance Draw TestEntity +instance Entity TestEntity where + blocksVision _ = False + description _ = "" + entityChar _ = "e" diff --git a/xanthous.cabal b/xanthous.cabal index e70a7391f3..5f1abdbc8f 100644 --- a/xanthous.cabal +++ b/xanthous.cabal @@ -4,7 +4,7 @@ cabal-version: 1.12 -- -- see: https://github.com/sol/hpack -- --- hash: ae5b84ec168dd61b715e874bcb49579697873b164c43027a776dda725dfdffbf +-- hash: 2d93180ab419496ded42f750d00a5b3f6c6994a9af86a8694bb585a1f52919d4 name: xanthous version: 0.1.0.0 @@ -208,6 +208,7 @@ test-suite test other-modules: Test.Prelude Xanthous.Data.EntityCharSpec + Xanthous.Data.EntityMap.GraphicsSpec Xanthous.Data.EntityMapSpec Xanthous.DataSpec Xanthous.Entities.RawsSpec -- cgit 1.4.1 From 13516911366a484ee5484166520133e056010515 Mon Sep 17 00:00:00 2001 From: Griffin Smith Date: Mon, 23 Dec 2019 18:10:22 -0500 Subject: Don't send the welcome message when loading Don't re-send the welcome message when loading the game if it's already been sent. This is done by just tracking whether or not we've sent it as a boolean in the game state, which may be a bit of a hack but should be fine --- src/Xanthous/App.hs | 8 ++++++-- src/Xanthous/Game/Arbitrary.hs | 1 + src/Xanthous/Game/Lenses.hs | 1 + src/Xanthous/Game/State.hs | 4 ++++ 4 files changed, 12 insertions(+), 2 deletions(-) diff --git a/src/Xanthous/App.hs b/src/Xanthous/App.hs index 2029be6f10..2bdf6142f9 100644 --- a/src/Xanthous/App.hs +++ b/src/Xanthous/App.hs @@ -77,8 +77,12 @@ startEvent = do Nothing -> prompt_ @'StringPrompt ["character", "namePrompt"] Uncancellable $ \(StringResult s) -> do character . characterName ?= s - say ["welcome"] =<< use character - Just n -> say ["welcome"] $ object [ "characterName" A..= n ] + whenM (uses sentWelcome not) $ say ["welcome"] =<< use character + sentWelcome .= True + Just n -> + whenM (uses sentWelcome not) $ do + say ["welcome"] $ object [ "characterName" A..= n ] + sentWelcome .= True initLevel :: AppM () initLevel = do diff --git a/src/Xanthous/Game/Arbitrary.hs b/src/Xanthous/Game/Arbitrary.hs index f4c83e0051..a4e0255ca8 100644 --- a/src/Xanthous/Game/Arbitrary.hs +++ b/src/Xanthous/Game/Arbitrary.hs @@ -28,6 +28,7 @@ instance Arbitrary GameState where let _promptState = NoPrompt -- TODO _activePanel <- arbitrary _debugState <- arbitrary + _sentWelcome <- arbitrary pure $ GameState {..} diff --git a/src/Xanthous/Game/Lenses.hs b/src/Xanthous/Game/Lenses.hs index 1f72e08b7b..853f758385 100644 --- a/src/Xanthous/Game/Lenses.hs +++ b/src/Xanthous/Game/Lenses.hs @@ -50,6 +50,7 @@ initialStateFromSeed seed = _debugState = DebugState { _allRevealed = False } + _sentWelcome = False in GameState {..} diff --git a/src/Xanthous/Game/State.hs b/src/Xanthous/Game/State.hs index d8a0f0b320..0ba7b2744a 100644 --- a/src/Xanthous/Game/State.hs +++ b/src/Xanthous/Game/State.hs @@ -11,6 +11,7 @@ module Xanthous.Game.State , messageHistory , randomGen , activePanel + , sentWelcome , promptState , characterEntityID , GamePromptState(..) @@ -405,6 +406,7 @@ data GameState = GameState , _characterEntityID :: !EntityID , _messageHistory :: !MessageHistory , _randomGen :: !StdGen + , _sentWelcome :: Bool -- | The active panel displayed in the UI, if any , _activePanel :: !(Maybe Panel) @@ -425,6 +427,8 @@ instance Eq GameState where , gs ^. revealedPositions , gs ^. characterEntityID , gs ^. messageHistory + , gs ^. sentWelcome + , gs ^. activePanel ) -------------------------------------------------------------------------------- -- cgit 1.4.1 From 6f427fe4d6ba9a03f122d15839298040a7cfb925 Mon Sep 17 00:00:00 2001 From: Griffin Smith Date: Tue, 24 Dec 2019 19:40:52 -0500 Subject: Fix circle rendering, add filled circle Make raster circle rendering use the Rasterific package instead of attempting desperately to hand-roll it, and add a method for generating filled circles. --- package.yaml | 3 ++ src/Xanthous/Generators/Util.hs | 49 ++++++++++++++++++----- src/Xanthous/Util.hs | 10 +++++ src/Xanthous/Util/Graphics.hs | 81 ++++++++++++++++++++++++-------------- test/Xanthous/Util/GraphicsSpec.hs | 33 ++++++++++------ 5 files changed, 124 insertions(+), 52 deletions(-) diff --git a/package.yaml b/package.yaml index b4c5330807..72eb0d32a6 100644 --- a/package.yaml +++ b/package.yaml @@ -36,6 +36,7 @@ dependencies: - generic-monoid - generic-lens - groups +- JuicyPixels - lens - megaparsec - MonadRandom @@ -47,7 +48,9 @@ dependencies: - random-source - raw-strings-qq - reflection +- Rasterific - stache +- semigroupoids - tomland - text-zipper - vector diff --git a/src/Xanthous/Generators/Util.hs b/src/Xanthous/Generators/Util.hs index 8fd04c0b93..2c041149d9 100644 --- a/src/Xanthous/Generators/Util.hs +++ b/src/Xanthous/Generators/Util.hs @@ -1,4 +1,6 @@ {-# LANGUAGE ViewPatterns #-} +{-# LANGUAGE QuantifiedConstraints #-} +{-# LANGUAGE AllowAmbiguousTypes #-} -------------------------------------------------------------------------------- module Xanthous.Generators.Util ( MCells @@ -13,18 +15,22 @@ module Xanthous.Generators.Util , regions , fillAll , fillAllM + , fromPoints + , fromPointsM ) where -------------------------------------------------------------------------------- -import Xanthous.Prelude hiding (Foldable, toList, for_) -import Data.Array.ST -import Data.Array.Unboxed -import Control.Monad.ST -import Control.Monad.Random -import Data.Monoid -import Data.Foldable (Foldable, toList, for_) +import Xanthous.Prelude hiding (Foldable, toList, for_) +import Data.Array.ST +import Data.Array.Unboxed +import Control.Monad.ST +import Control.Monad.Random +import Data.Monoid +import Data.Foldable (Foldable, toList, for_) +import qualified Data.Set as Set +import Data.Semigroup.Foldable -------------------------------------------------------------------------------- -import Xanthous.Util (foldlMapM') -import Xanthous.Data (Dimensions, width, height) +import Xanthous.Util (foldlMapM', maximum1, minimum1) +import Xanthous.Data (Dimensions, width, height) -------------------------------------------------------------------------------- type MCells s = STUArray s (Word, Word) Bool @@ -184,3 +190,28 @@ fillAll ixes a = accum (const fst) a $ (, (False, ())) <$> toList ixes fillAllM :: (MArray a Bool m, Ix i, Foldable f) => f i -> a i Bool -> m () fillAllM ixes a = for_ ixes $ \i -> writeArray a i False + +fromPoints + :: forall a f i. + ( IArray a Bool + , Ix i + , Functor f + , Foldable1 f + ) + => f (i, i) + -> a (i, i) Bool +fromPoints points = + let pts = Set.fromList $ toList points + dims = ( (minimum1 $ fst <$> points, minimum1 $ snd <$> points) + , (maximum1 $ fst <$> points, maximum1 $ snd <$> points) + ) + in array dims $ range dims <&> \i -> (i, i `member` pts) + +fromPointsM + :: (MArray a Bool m, Ix i, Element f ~ i, MonoFoldable f) + => NonNull f + -> m (a i Bool) +fromPointsM points = do + arr <- newArray (minimum points, maximum points) False + fillAllM (otoList points) arr + pure arr diff --git a/src/Xanthous/Util.hs b/src/Xanthous/Util.hs index b8b789e1b1..93155af3fd 100644 --- a/src/Xanthous/Util.hs +++ b/src/Xanthous/Util.hs @@ -26,6 +26,8 @@ module Xanthous.Util , takeWhileInclusive , smallestNotIn , removeVectorIndex + , maximum1 + , minimum1 -- * Type-level programming utils , KnownBool(..) @@ -38,6 +40,8 @@ import Data.Foldable (foldr) import Data.Monoid import Data.Proxy import qualified Data.Vector as V +import Data.Semigroup (Max(..), Min(..)) +import Data.Semigroup.Foldable -------------------------------------------------------------------------------- newtype EqEqProp a = EqEqProp a @@ -218,6 +222,12 @@ removeVectorIndex idx vect = let (before, after) = V.splitAt idx vect in before <> fromMaybe Empty (tailMay after) +maximum1 :: (Ord a, Foldable1 f) => f a -> a +maximum1 = getMax . foldMap1 Max + +minimum1 :: (Ord a, Foldable1 f) => f a -> a +minimum1 = getMin . foldMap1 Min + -------------------------------------------------------------------------------- -- | This class gives a boolean associated with a type-level bool, a'la diff --git a/src/Xanthous/Util/Graphics.hs b/src/Xanthous/Util/Graphics.hs index 3dc2f6f14c..e8269e72d6 100644 --- a/src/Xanthous/Util/Graphics.hs +++ b/src/Xanthous/Util/Graphics.hs @@ -1,44 +1,65 @@ -- | Graphics algorithms and utils for rendering things in 2D space -------------------------------------------------------------------------------- -module Xanthous.Util.Graphics where +module Xanthous.Util.Graphics + ( circle + , filledCircle + , line + ) where -------------------------------------------------------------------------------- -import Xanthous.Prelude -import Data.List (unfoldr) +import Xanthous.Prelude +import Data.List (unfoldr) +import Data.Ix (range, Ix) +import Data.Word (Word8) +import qualified Graphics.Rasterific as Raster +import Graphics.Rasterific hiding (circle, line) +import Graphics.Rasterific.Texture (uniformTexture) +import Codec.Picture (imagePixels) -------------------------------------------------------------------------------- --- | Generate a circle centered at the given point and with the given radius --- using the . --- --- Code taken from -circle :: (Num i, Ord i) + +circle :: (Num i, Integral i, Ix i) => (i, i) -- ^ center -> i -- ^ radius -> [(i, i)] -circle (x₀, y₀) radius - -- Four initial points, plus the generated points - = (x₀, y₀ + radius) : (x₀, y₀ - radius) : (x₀ + radius, y₀) : (x₀ - radius, y₀) : points - where - -- Creates the (x, y) octet offsets, then maps them to absolute points in all octets. - points = concatMap generatePoints $ unfoldr step initialValues +circle (ox, oy) radius + = pointsFromRaster (ox + radius) (oy + radius) + $ stroke 1 JoinRound (CapRound, CapRound) + $ Raster.circle (V2 (fromIntegral ox) (fromIntegral oy)) + $ fromIntegral radius - generatePoints (x, y) - = [ (x₀ `xop` x', y₀ `yop` y') - | (x', y') <- [(x, y), (y, x)] - , xop <- [(+), (-)] - , yop <- [(+), (-)] - ] +filledCircle :: (Num i, Integral i, Ix i) + => (i, i) -- ^ center + -> i -- ^ radius + -> [(i, i)] +filledCircle (ox, oy) radius + = pointsFromRaster (ox + radius) (oy + radius) + $ fill + $ Raster.circle (V2 (fromIntegral ox) (fromIntegral oy)) + $ fromIntegral radius + +-- showCells . fromPoints . NE.fromList $ filledCircle (15, 15) 7 +-- pointsFromRaster :: (Num i, Integral i, Ix i) +-- => i -- ^ width +-- -> i -- ^ height +-- -> _ +-- -> [(i, i)] +pointsFromRaster + :: (Integral a, Integral b, Ix a, Ix b) + => a + -> b + -> Drawing Word8 () + -> [(a, b)] +pointsFromRaster w h raster + = map snd + $ filter ((== 1) . fst) + $ zip pixels + $ range ((1, 1), (w, h)) + where + pixels = toListOf imagePixels + $ renderDrawing @Word8 (fromIntegral w) (fromIntegral h) 0 + $ withTexture (uniformTexture 1) raster - initialValues = (1 - radius, 1, (-2) * radius, 0, radius) - step (f, ddf_x, ddf_y, x, y) - | x >= y = Nothing - | otherwise = Just ((x', y'), (f', ddf_x', ddf_y', x', y')) - where - (f', ddf_y', y') | f >= 0 = (f + ddf_y' + ddf_x', ddf_y + 2, y - 1) - | otherwise = (f + ddf_x, ddf_y, y) - ddf_x' = ddf_x + 2 - x' = x + 1 -- | Draw a line between two points using Bresenham's line drawing algorithm -- diff --git a/test/Xanthous/Util/GraphicsSpec.hs b/test/Xanthous/Util/GraphicsSpec.hs index 4b761dc51f..ecd6dbe191 100644 --- a/test/Xanthous/Util/GraphicsSpec.hs +++ b/test/Xanthous/Util/GraphicsSpec.hs @@ -15,19 +15,26 @@ test = testGroup "Xanthous.Util.Graphics" [ testGroup "circle" [ testCase "radius 12, origin 0" $ (sort . unique @[] @[_]) (circle @Int (0, 0) 12) - @?= (sort . unique) ( - let quadrant = - [ (0, 12) , (1, 12) , (2, 12) , (3, 12) - , (4, 12) , (5, 11) , (6, 11) , (7, 10) - , (8, 9) , (9, 9) , (9, 8) , (10, 7) - , (11, 6) , (11, 5) , (12, 4) , (12, 3) - , (12, 2) , (12, 1) , (12, 0) - ] - in quadrant - <> (quadrant <&> _1 %~ negate) - <> (quadrant <&> _2 %~ negate) - <> (quadrant <&> both %~ negate) - ) + @?= [ (1,12) + , (2,12) + , (3,12) + , (4,12) + , (5,12) + , (6,11) + , (7,10) + , (7,11) + , (8,10) + , (9,9) + , (10,7) + , (10,8) + , (11,6) + , (11,7) + , (12,1) + , (12,2) + , (12,3) + , (12,4) + , (12,5) + ] ] , testGroup "line" -- cgit 1.4.1 From e76567b9e776070812838828d8de8220c2a461e7 Mon Sep 17 00:00:00 2001 From: Griffin Smith Date: Mon, 30 Dec 2019 11:31:56 -0500 Subject: Add dungeon level generation Add a dungeon level generator, which: 1. generates an infinite sequence of rectangular rooms within the dimensions of the level 2. removes any duplicates from that sequence 3. Generates a graph from the delaunay triangulation of the centerpoints of those rooms 4. Generates the minimum-spanning-tree of that delaunay triangulation, with weights given by line length in points 5. Adds back a subset (default 10-15%) of edges from the delaunay triangulation to the graph 6. Uses the resulting graph to draw corridors between the rooms, using a random point on the near edge of each room to pick the points of the corridors --- build/hgeometry-fix-haddock.patch | 13 +++ haskell-overlay.nix | 29 ++++- package.yaml | 6 + shell.nix | 6 +- src/Main.hs | 25 ++++- src/Xanthous/Data.hs | 173 +++++++++++++++++++++++----- src/Xanthous/Generators.hs | 29 ++++- src/Xanthous/Generators/CaveAutomata.hs | 31 +++--- src/Xanthous/Generators/Dungeon.hs | 192 ++++++++++++++++++++++++++++++++ src/Xanthous/Generators/Util.hs | 7 +- src/Xanthous/Orphans.hs | 33 ++---- src/Xanthous/Random.hs | 23 ++-- src/Xanthous/Util.hs | 9 ++ src/Xanthous/Util/Graph.hs | 33 ++++++ src/Xanthous/Util/Graphics.hs | 36 +++++- src/Xanthous/Util/Optparse.hs | 21 ++++ test/Spec.hs | 2 + test/Xanthous/DataSpec.hs | 34 +++++- test/Xanthous/Util/GraphSpec.hs | 39 +++++++ xanthous.cabal | 42 ++++++- 20 files changed, 680 insertions(+), 103 deletions(-) create mode 100644 build/hgeometry-fix-haddock.patch create mode 100644 src/Xanthous/Generators/Dungeon.hs create mode 100644 src/Xanthous/Util/Graph.hs create mode 100644 src/Xanthous/Util/Optparse.hs create mode 100644 test/Xanthous/Util/GraphSpec.hs diff --git a/build/hgeometry-fix-haddock.patch b/build/hgeometry-fix-haddock.patch new file mode 100644 index 0000000000..748c65b3e0 --- /dev/null +++ b/build/hgeometry-fix-haddock.patch @@ -0,0 +1,13 @@ +diff --git a/src/Data/Geometry/PlanarSubdivision/Merge.hs b/src/Data/Geometry/PlanarSubdivision/Merge.hs +index 1136114..3f4e7bb 100644 +--- a/src/Data/Geometry/PlanarSubdivision/Merge.hs ++++ b/src/Data/Geometry/PlanarSubdivision/Merge.hs +@@ -153,7 +153,7 @@ mergeWith' mergeFaces p1 p2 = PlanarSubdivision cs vd rd rf + -- we have to shift the number of the *Arcs*. Since every dart + -- consists of two arcs, we have to shift by numDarts / 2 + -- Furthermore, we take numFaces - 1 since we want the first +- -- *internal* face of p2 (the one with FaceId 1) to correspond with the first free ++ -- /internal/ face of p2 (the one with FaceId 1) to correspond with the first free + -- position (at index numFaces) + + cs = p1^.components <> p2'^.components diff --git a/haskell-overlay.nix b/haskell-overlay.nix index 959f63c5a0..d3775316ad 100644 --- a/haskell-overlay.nix +++ b/haskell-overlay.nix @@ -1,7 +1,32 @@ { nixpkgs ? import ./nixpkgs.nix {} }: let inherit (nixpkgs) pkgs; -in self: super: rec { - generic-arbitrary = pkgs.haskell.lib.appendPatch +in self: super: with pkgs.haskell.lib; rec { + generic-arbitrary = appendPatch super.generic-arbitrary [ ./build/generic-arbitrary-export-garbitrary.patch ]; + + hgeometry = + appendPatch + (self.callHackageDirect { + pkg = "hgeometry"; + ver = "0.9.0.0"; + sha256 = "02hyvbqm57lr47w90vdgl71cfbd6lvwpqdid9fcnmxkdjbq4kv6b"; + } {}) [ ./build/hgeometry-fix-haddock.patch ]; + + hgeometry-combinatorial = + self.callHackageDirect { + pkg = "hgeometry-combinatorial"; + ver = "0.9.0.0"; + sha256 = "12k41wd9fd1y3jd5djwcpwg2s1cva87wh14i0m1yn49zax9wl740"; + } {}; + + vinyl = pkgs.haskell.lib.overrideSrc + (pkgs.haskell.lib.markUnbroken super.vinyl) + rec { + src = nixpkgs.fetchzip { + url = "mirror://hackage/vinyl-${version}/vinyl-${version}.tar.gz"; + sha256 = "190ffrmm76fh8fi9afkcda2vldf89y7dxj10434h28mbpq55kgsx"; + }; + version = "0.12.0"; + }; } diff --git a/package.yaml b/package.yaml index 72eb0d32a6..32a402f3fd 100644 --- a/package.yaml +++ b/package.yaml @@ -30,14 +30,19 @@ dependencies: - containers - data-default - deepseq +- fgl +- fgl-arbitrary - file-embed - filepath - generic-arbitrary - generic-monoid - generic-lens - groups +- hgeometry +- hgeometry-combinatorial - JuicyPixels - lens +- linear - megaparsec - MonadRandom - mtl @@ -49,6 +54,7 @@ dependencies: - raw-strings-qq - reflection - Rasterific +- streams - stache - semigroupoids - tomland diff --git a/shell.nix b/shell.nix index 915e3e748a..edd2fe4c08 100644 --- a/shell.nix +++ b/shell.nix @@ -18,11 +18,7 @@ let overrides = (self: super: { ghc = super.ghc // { withPackages = super.ghc.withHoogle; }; ghcWithPackages = self.ghc.withPackages; - # eww https://github.com/NixOS/nixpkgs/issues/16394 - generic-arbitrary = pkgs.haskell.lib.appendPatch - super.generic-arbitrary - [ ./build/generic-arbitrary-export-garbitrary.patch ]; - }); + } // (import ./haskell-overlay.nix { inherit nixpkgs; }) self super); } else packageSet ); diff --git a/src/Main.hs b/src/Main.hs index 2e9d8c41ee..b11f1b9f49 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -47,19 +47,22 @@ parseRunParams = RunParams data Command = Run RunParams | Load FilePath - | Generate GeneratorInput Dimensions + | Generate GeneratorInput Dimensions (Maybe Int) parseDimensions :: Opt.Parser Dimensions parseDimensions = Dimensions <$> Opt.option Opt.auto ( Opt.short 'w' <> Opt.long "width" + <> Opt.metavar "TILES" ) <*> Opt.option Opt.auto ( Opt.short 'h' <> Opt.long "height" + <> Opt.metavar "TILES" ) + parseCommand :: Opt.Parser Command parseCommand = (<|> Run <$> parseRunParams) $ Opt.subparser $ Opt.command "run" @@ -75,6 +78,8 @@ parseCommand = (<|> Run <$> parseRunParams) $ Opt.subparser (Generate <$> parseGeneratorInput <*> parseDimensions + <*> optional + (Opt.option Opt.auto (Opt.long "seed")) <**> Opt.helper ) (Opt.progDesc "Generate a sample level")) @@ -91,6 +96,9 @@ runGame :: RunParams -> IO () runGame rparams = do app <- makeApp gameSeed <- maybe getRandom pure $ seed rparams + when (isNothing $ seed rparams) + . putStrLn + $ "Seed: " <> tshow gameSeed let initialState = Game.initialStateFromSeed gameSeed &~ do for_ (characterName rparams) $ \cn -> Game.character . Character.characterName ?= cn @@ -112,11 +120,16 @@ loadGame saveFile = do pure () -runGenerate :: GeneratorInput -> Dimensions -> IO () -runGenerate input dims = do - randGen <- getStdGen - let res = generateFromInput input dims randGen +runGenerate :: GeneratorInput -> Dimensions -> Maybe Int -> IO () +runGenerate input dims mSeed = do + putStrLn "Generating..." + genSeed <- maybe getRandom pure mSeed + let randGen = mkStdGen genSeed + res = generateFromInput input dims randGen rs = regions $ amap not res + when (isNothing mSeed) + . putStrLn + $ "Seed: " <> tshow genSeed putStr "num regions: " print $ length rs putStr "region lengths: " @@ -128,7 +141,7 @@ runGenerate input dims = do runCommand :: Command -> IO () runCommand (Run runParams) = runGame runParams runCommand (Load saveFile) = loadGame saveFile -runCommand (Generate input dims) = runGenerate input dims +runCommand (Generate input dims mSeed) = runGenerate input dims mSeed main :: IO () main = runCommand =<< Opt.execParser optParser diff --git a/src/Xanthous/Data.hs b/src/Xanthous/Data.hs index dfad2cffd3..8a8a62d0ee 100644 --- a/src/Xanthous/Data.hs +++ b/src/Xanthous/Data.hs @@ -1,23 +1,27 @@ -{-# LANGUAGE PartialTypeSignatures #-} -{-# LANGUAGE StandaloneDeriving #-} -{-# LANGUAGE ViewPatterns #-} -{-# LANGUAGE RoleAnnotations #-} -{-# LANGUAGE RecordWildCards #-} -{-# LANGUAGE DeriveTraversable #-} -{-# LANGUAGE DeriveFoldable #-} -{-# LANGUAGE DeriveFunctor #-} -{-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE NoTypeSynonymInstances #-} +{-# LANGUAGE PartialTypeSignatures #-} +{-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE ViewPatterns #-} +{-# LANGUAGE RoleAnnotations #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE DeriveTraversable #-} +{-# LANGUAGE DeriveFoldable #-} +{-# LANGUAGE DeriveFunctor #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE NoTypeSynonymInstances #-} +{-# LANGUAGE DuplicateRecordFields #-} -------------------------------------------------------------------------------- -- | Common data types for Xanthous -------------------------------------------------------------------------------- module Xanthous.Data - ( -- * - Position'(..) + ( Opposite(..) + + -- * + , Position'(..) , Position , x , y + -- ** , Positioned(..) , _Positioned , position @@ -30,6 +34,18 @@ module Xanthous.Data , stepTowards , isUnit + -- * Boxes + , Box(..) + , topLeftCorner + , bottomRightCorner + , setBottomRightCorner + , dimensions + , inBox + , boxIntersects + , boxCenter + , boxEdge + , module Linear.V2 + -- * , Per(..) , invertRate @@ -49,11 +65,15 @@ module Xanthous.Data -- * , Direction(..) - , opposite , move , asPosition , directionOf + -- * + , Corner(..) + , Edge(..) + , cornerEdges + -- * , Neighbors(..) , edges @@ -65,6 +85,9 @@ module Xanthous.Data ) where -------------------------------------------------------------------------------- import Xanthous.Prelude hiding (Left, Down, Right, (.=)) +-------------------------------------------------------------------------------- +import Linear.V2 hiding (_x, _y) +import qualified Linear.V2 as L import Test.QuickCheck (Arbitrary, CoArbitrary, Function) import Test.QuickCheck.Arbitrary.Generic import Data.Group @@ -74,11 +97,18 @@ import Data.Aeson.Generic.DerivingVia import Data.Aeson ( ToJSON(..), FromJSON(..), object, (.=), (.:), withObject) -------------------------------------------------------------------------------- -import Xanthous.Util (EqEqProp(..), EqProp) +import Xanthous.Util (EqEqProp(..), EqProp, between) +import Xanthous.Util.QuickCheck (GenericArbitrary(..)) import Xanthous.Orphans () import Xanthous.Util.Graphics -------------------------------------------------------------------------------- +-- | opposite ∘ opposite ≡ id +class Opposite x where + opposite :: x -> x + +-------------------------------------------------------------------------------- + -- fromScalar ∘ scalar ≡ id class Scalar a where scalar :: a -> Double @@ -109,7 +139,10 @@ data Position' a where deriving (ToJSON, FromJSON) via WithOptions '[ FieldLabelModifier '[Drop 1] ] (Position' a) -makeLenses ''Position' + +x, y :: Lens' (Position' a) a +x = lens (\(Position xx _) -> xx) (\(Position _ yy) xx -> Position xx yy) +y = lens (\(Position _ yy) -> yy) (\(Position xx _) yy -> Position xx yy) type Position = Position' Int @@ -236,16 +269,16 @@ instance Arbitrary Direction where arbitrary = genericArbitrary shrink = genericShrink -opposite :: Direction -> Direction -opposite Up = Down -opposite Down = Up -opposite Left = Right -opposite Right = Left -opposite UpLeft = DownRight -opposite UpRight = DownLeft -opposite DownLeft = UpRight -opposite DownRight = UpLeft -opposite Here = Here +instance Opposite Direction where + opposite Up = Down + opposite Down = Up + opposite Left = Right + opposite Right = Left + opposite UpLeft = DownRight + opposite UpRight = DownLeft + opposite DownLeft = UpRight + opposite DownRight = UpLeft + opposite Here = Here move :: Direction -> Position -> Position move Up = y -~ 1 @@ -295,6 +328,40 @@ stepTowards (view _Position -> p₁) (view _Position -> p₂) -------------------------------------------------------------------------------- +data Corner + = TopLeft + | TopRight + | BottomLeft + | BottomRight + deriving stock (Show, Eq, Ord, Enum, Bounded, Generic) + +instance Opposite Corner where + opposite TopLeft = BottomRight + opposite TopRight = BottomLeft + opposite BottomLeft = TopRight + opposite BottomRight = TopLeft + +data Edge + = TopEdge + | LeftEdge + | RightEdge + | BottomEdge + deriving stock (Show, Eq, Ord, Enum, Bounded, Generic) + +instance Opposite Edge where + opposite TopEdge = BottomEdge + opposite BottomEdge = TopEdge + opposite LeftEdge = RightEdge + opposite RightEdge = LeftEdge + +cornerEdges :: Corner -> (Edge, Edge) +cornerEdges TopLeft = (TopEdge, LeftEdge) +cornerEdges TopRight = (TopEdge, RightEdge) +cornerEdges BottomLeft = (BottomEdge, LeftEdge) +cornerEdges BottomRight = (BottomEdge, RightEdge) + +-------------------------------------------------------------------------------- + data Neighbors a = Neighbors { _topLeft , _top @@ -307,7 +374,7 @@ data Neighbors a = Neighbors } deriving stock (Show, Eq, Ord, Functor, Foldable, Traversable, Generic) deriving anyclass (NFData) -makeLenses ''Neighbors +makeFieldsNoPrefix ''Neighbors instance Applicative Neighbors where pure α = Neighbors @@ -403,3 +470,57 @@ newtype Hitpoints = Hitpoints Word via Word deriving (Semigroup, Monoid) via Sum Word +-------------------------------------------------------------------------------- + +data Box a = Box + { _topLeftCorner :: V2 a + , _dimensions :: V2 a + } + deriving stock (Show, Eq, Ord, Functor, Generic) + deriving Arbitrary via GenericArbitrary (Box a) +makeFieldsNoPrefix ''Box + +bottomRightCorner :: Num a => Box a -> V2 a +bottomRightCorner box = + V2 (box ^. topLeftCorner . L._x + box ^. dimensions . L._x) + (box ^. topLeftCorner . L._y + box ^. dimensions . L._y) + +setBottomRightCorner :: (Num a, Ord a) => Box a -> V2 a -> Box a +setBottomRightCorner box br@(V2 brx bry) + | brx < box ^. topLeftCorner . L._x || bry < box ^. topLeftCorner . L._y + = box & topLeftCorner .~ br + & dimensions . L._x .~ ((box ^. topLeftCorner . L._x) - brx) + & dimensions . L._y .~ ((box ^. topLeftCorner . L._y) - bry) + | otherwise + = box & dimensions . L._x .~ (brx - (box ^. topLeftCorner . L._x)) + & dimensions . L._y .~ (bry - (box ^. topLeftCorner . L._y)) + +inBox :: (Ord a, Num a) => Box a -> V2 a -> Bool +inBox box pt = flip all [L._x, L._y] $ \component -> + between (box ^. topLeftCorner . component) + (box ^. to bottomRightCorner . component) + (pt ^. component) + +boxIntersects :: (Ord a, Num a) => Box a -> Box a -> Bool +boxIntersects box₁ box₂ + = any (inBox box₁) [box₂ ^. topLeftCorner, bottomRightCorner box₂] + +boxCenter :: (Fractional a) => Box a -> V2 a +boxCenter box = V2 cx cy + where + cx = box ^. topLeftCorner . L._x + (box ^. dimensions . L._x / 2) + cy = box ^. topLeftCorner . L._y + (box ^. dimensions . L._y / 2) + +boxEdge :: (Enum a, Num a) => Box a -> Edge -> [V2 a] +boxEdge box LeftEdge = + V2 (box ^. topLeftCorner . L._x) + <$> [box ^. topLeftCorner . L._y .. box ^. to bottomRightCorner . L._y] +boxEdge box RightEdge = + V2 (box ^. to bottomRightCorner . L._x) + <$> [box ^. to bottomRightCorner . L._y .. box ^. to bottomRightCorner . L._y] +boxEdge box TopEdge = + flip V2 (box ^. topLeftCorner . L._y) + <$> [box ^. topLeftCorner . L._x .. box ^. to bottomRightCorner . L._x] +boxEdge box BottomEdge = + flip V2 (box ^. to bottomRightCorner . L._y) + <$> [box ^. topLeftCorner . L._x .. box ^. to bottomRightCorner . L._x] diff --git a/src/Xanthous/Generators.hs b/src/Xanthous/Generators.hs index 490e50ea60..592bf73c00 100644 --- a/src/Xanthous/Generators.hs +++ b/src/Xanthous/Generators.hs @@ -25,6 +25,7 @@ import qualified Options.Applicative as Opt import Control.Monad.Random -------------------------------------------------------------------------------- import qualified Xanthous.Generators.CaveAutomata as CaveAutomata +import qualified Xanthous.Generators.Dungeon as Dungeon import Xanthous.Generators.Util import Xanthous.Generators.LevelContents import Xanthous.Data (Dimensions, Position'(Position), Position) @@ -35,14 +36,18 @@ import Xanthous.Entities.Item (Item) import Xanthous.Entities.Creature (Creature) -------------------------------------------------------------------------------- -data Generator = CaveAutomata +data Generator + = CaveAutomata + | Dungeon deriving stock (Show, Eq) data SGenerator (gen :: Generator) where SCaveAutomata :: SGenerator 'CaveAutomata + SDungeon :: SGenerator 'Dungeon type family Params (gen :: Generator) :: Type where Params 'CaveAutomata = CaveAutomata.Params + Params 'Dungeon = Dungeon.Params generate :: RandomGen g @@ -52,6 +57,7 @@ generate -> g -> Cells generate SCaveAutomata = CaveAutomata.generate +generate SDungeon = Dungeon.generate data GeneratorInput where GeneratorInput :: forall gen. SGenerator gen -> Params gen -> GeneratorInput @@ -60,10 +66,23 @@ generateFromInput :: RandomGen g => GeneratorInput -> Dimensions -> g -> Cells generateFromInput (GeneratorInput sg ps) = generate sg ps parseGeneratorInput :: Opt.Parser GeneratorInput -parseGeneratorInput = Opt.subparser $ - Opt.command "cave" (Opt.info - (GeneratorInput <$> pure SCaveAutomata <*> CaveAutomata.parseParams) - (Opt.progDesc "cellular-automata based cave generator")) +parseGeneratorInput = Opt.subparser + $ generatorCommand SCaveAutomata + "cave" + "Cellular-automata based cave generator" + CaveAutomata.parseParams + <> generatorCommand SDungeon + "dungeon" + "Classic dungeon map generator" + Dungeon.parseParams + where + generatorCommand sgen name desc parseParams = + Opt.command name + (Opt.info + (GeneratorInput <$> pure sgen <*> parseParams) + (Opt.progDesc desc) + ) + showCells :: Cells -> Text showCells arr = diff --git a/src/Xanthous/Generators/CaveAutomata.hs b/src/Xanthous/Generators/CaveAutomata.hs index e885f4ed1a..5a7c081d03 100644 --- a/src/Xanthous/Generators/CaveAutomata.hs +++ b/src/Xanthous/Generators/CaveAutomata.hs @@ -2,23 +2,25 @@ {-# LANGUAGE ViewPatterns #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE TemplateHaskell #-} - +-------------------------------------------------------------------------------- module Xanthous.Generators.CaveAutomata ( Params(..) , defaultParams , parseParams , generate ) where - -import Xanthous.Prelude -import Control.Monad.Random (RandomGen, runRandT) -import Data.Array.ST -import Data.Array.Unboxed +-------------------------------------------------------------------------------- +import Xanthous.Prelude +import Control.Monad.Random (RandomGen, runRandT) +import Data.Array.ST +import Data.Array.Unboxed import qualified Options.Applicative as Opt - -import Xanthous.Util (between) -import Xanthous.Data (Dimensions, width, height) -import Xanthous.Generators.Util +-------------------------------------------------------------------------------- +import Xanthous.Util (between) +import Xanthous.Util.Optparse +import Xanthous.Data (Dimensions, width, height) +import Xanthous.Generators.Util +-------------------------------------------------------------------------------- data Params = Params { _aliveStartChance :: Double @@ -70,13 +72,6 @@ parseParams = Params <> Opt.metavar "STEPS" ) where - readWithGuard predicate errmsg = do - res <- Opt.auto - unless (predicate res) - $ Opt.readerError - $ errmsg res - pure res - parseChance = readWithGuard (between 0 1) $ \res -> "Chance must be in the range [0,1], got: " <> show res @@ -85,7 +80,7 @@ parseParams = Params (between 0 8) $ \res -> "Neighbors must be in the range [0,8], got: " <> show res -generate :: RandomGen g => Params -> Dimensions -> g -> UArray (Word, Word) Bool +generate :: RandomGen g => Params -> Dimensions -> g -> Cells generate params dims gen = runSTUArray $ fmap fst diff --git a/src/Xanthous/Generators/Dungeon.hs b/src/Xanthous/Generators/Dungeon.hs new file mode 100644 index 0000000000..fdc510bb79 --- /dev/null +++ b/src/Xanthous/Generators/Dungeon.hs @@ -0,0 +1,192 @@ +{-# LANGUAGE ViewPatterns #-} +{-# LANGUAGE TemplateHaskell #-} +-------------------------------------------------------------------------------- +module Xanthous.Generators.Dungeon + ( Params(..) + , defaultParams + , parseParams + , generate + ) where +-------------------------------------------------------------------------------- +import Xanthous.Prelude hiding ((:>)) +-------------------------------------------------------------------------------- +import Control.Monad.Random +import Data.Array.ST +import Data.Array.IArray (amap) +import Data.Stream.Infinite (Stream(..)) +import qualified Data.Stream.Infinite as Stream +import qualified Data.Graph.Inductive.Graph as Graph +import Data.Graph.Inductive.PatriciaTree +import qualified Data.List.NonEmpty as NE +import Data.Maybe (fromJust) +import Linear.V2 +import Linear.Metric +import qualified Options.Applicative as Opt +-------------------------------------------------------------------------------- +import Xanthous.Random +import Xanthous.Data hiding (x, y, _x, _y, edges) +import Xanthous.Generators.Util +import Xanthous.Util.Graphics (delaunay, straightLine) +import Xanthous.Util.Graph (mstSubGraph) +-------------------------------------------------------------------------------- + +data Params = Params + { _numRoomsRange :: (Word, Word) + , _roomDimensionRange :: (Word, Word) + , _connectednessRatioRange :: (Double, Double) + } + deriving stock (Show, Eq, Ord, Generic) +makeLenses ''Params + +defaultParams :: Params +defaultParams = Params + { _numRoomsRange = (6, 8) + , _roomDimensionRange = (3, 12) + , _connectednessRatioRange = (0.1, 0.15) + } + +parseParams :: Opt.Parser Params +parseParams = Params + <$> parseRange + "num-rooms" + "number of rooms to generate in the dungeon" + "ROOMS" + (defaultParams ^. numRoomsRange) + <*> parseRange + "room-size" + "size in tiles of one of the sides of a room" + "TILES" + (defaultParams ^. roomDimensionRange) + <*> parseRange + "connectedness-ratio" + ( "ratio of edges from the delaunay triangulation to re-add to the " + <> "minimum-spanning-tree") + "RATIO" + (defaultParams ^. connectednessRatioRange) + <**> Opt.helper + where + parseRange name desc metavar (defMin, defMax) = + (,) + <$> Opt.option Opt.auto + ( Opt.long ("min-" <> name) + <> Opt.value defMin + <> Opt.showDefault + <> Opt.help ("Minimum " <> desc) + <> Opt.metavar metavar + ) + <*> Opt.option Opt.auto + ( Opt.long ("max-" <> name) + <> Opt.value defMax + <> Opt.showDefault + <> Opt.help ("Maximum " <> desc) + <> Opt.metavar metavar + ) + +generate :: RandomGen g => Params -> Dimensions -> g -> Cells +generate params dims gen + = amap not + $ runSTUArray + $ fmap fst + $ flip runRandT gen + $ generate' params dims + +-------------------------------------------------------------------------------- + +generate' :: RandomGen g => Params -> Dimensions -> CellM g s (MCells s) +generate' params dims = do + cells <- initializeEmpty dims + rooms <- genRooms params dims + for_ rooms $ fillRoom cells + + let fullRoomGraph = delaunayRoomGraph rooms + mst = mstSubGraph fullRoomGraph + mstEdges = Graph.edges mst + nonMSTEdges = filter (\(n₁, n₂, _) -> (n₁, n₂) `notElem` mstEdges) + $ Graph.labEdges fullRoomGraph + + reintroEdgeCount <- floor . (* fromIntegral (length nonMSTEdges)) + <$> getRandomR (params ^. connectednessRatioRange) + let reintroEdges = take reintroEdgeCount nonMSTEdges + corridorGraph = Graph.insEdges reintroEdges mst + + corridors <- traverse + ( uncurry corridorBetween + . over both (fromJust . Graph.lab corridorGraph) + ) $ Graph.edges corridorGraph + + for_ (join corridors) $ \pt -> lift $ writeArray cells pt True + + pure cells + +type Room = Box Word + +genRooms :: MonadRandom m => Params -> Dimensions -> m [Room] +genRooms params dims = do + numRooms <- fromIntegral <$> getRandomR (params ^. numRoomsRange) + subRand . fmap (Stream.take numRooms . removeIntersecting []) . infinitely $ do + roomWidth <- getRandomR $ params ^. roomDimensionRange + roomHeight <- getRandomR $ params ^. roomDimensionRange + xPos <- getRandomR (0, dims ^. width - roomWidth) + yPos <- getRandomR (0, dims ^. height - roomHeight) + pure Box + { _topLeftCorner = V2 xPos yPos + , _dimensions = V2 roomWidth roomHeight + } + where + removeIntersecting seen (room :> rooms) + | any (boxIntersects room) seen + = removeIntersecting seen rooms + | otherwise + = room :> removeIntersecting (room : seen) rooms + streamRepeat x = x :> streamRepeat x + infinitely = sequence . streamRepeat + +delaunayRoomGraph :: [Room] -> Gr Room Double +delaunayRoomGraph rooms = + Graph.insEdges edges . Graph.insNodes nodes $ Graph.empty + where + edges = map (\((n₁, room₁), (n₂, room₂)) -> (n₁, n₂, roomDist room₁ room₂)) + . over (mapped . both) snd + . delaunay @Double + . NE.fromList + . map (\p@(_, room) -> (boxCenter $ fromIntegral <$> room, p)) + $ nodes + nodes = zip [0..] rooms + roomDist = distance `on` (boxCenter . fmap fromIntegral) + +fillRoom :: MCells s -> Room -> CellM g s () +fillRoom cells room = + let V2 posx posy = room ^. topLeftCorner + V2 dimx dimy = room ^. dimensions + in for_ [posx .. posx + dimx] $ \x -> + for_ [posy .. posy + dimy] $ \y -> + lift $ writeArray cells (x, y) True + +corridorBetween :: MonadRandom m => Room -> Room -> m [(Word, Word)] +corridorBetween originRoom destinationRoom + = straightLine <$> origin <*> destination + where + origin = choose . NE.fromList . map toTuple =<< originEdge + destination = choose . NE.fromList . map toTuple =<< destinationEdge + originEdge = pickEdge originRoom originCorner + destinationEdge = pickEdge destinationRoom destinationCorner + pickEdge room corner = choose . over both (boxEdge room) $ cornerEdges corner + originCorner = + case ( compare (originRoom ^. topLeftCorner . _x) + (destinationRoom ^. topLeftCorner . _x) + , compare (originRoom ^. topLeftCorner . _y) + (destinationRoom ^. topLeftCorner . _y) + ) of + (LT, LT) -> BottomRight + (LT, GT) -> TopRight + (GT, LT) -> BottomLeft + (GT, GT) -> TopLeft + + (EQ, LT) -> BottomLeft + (EQ, GT) -> TopRight + (GT, EQ) -> TopLeft + (LT, EQ) -> BottomRight + (EQ, EQ) -> TopLeft -- should never happen + + destinationCorner = opposite originCorner + toTuple (V2 x y) = (x, y) diff --git a/src/Xanthous/Generators/Util.hs b/src/Xanthous/Generators/Util.hs index 2c041149d9..13f248a045 100644 --- a/src/Xanthous/Generators/Util.hs +++ b/src/Xanthous/Generators/Util.hs @@ -7,6 +7,7 @@ module Xanthous.Generators.Util , Cells , CellM , randInitialize + , initializeEmpty , numAliveNeighborsM , numAliveNeighbors , fillOuterEdgesM @@ -39,13 +40,17 @@ type CellM g s a = RandT g (ST s) a randInitialize :: RandomGen g => Dimensions -> Double -> CellM g s (MCells s) randInitialize dims aliveChance = do - res <- lift $ newArray ((0, 0), (dims ^. width, dims ^. height)) False + res <- initializeEmpty dims for_ [0..dims ^. width] $ \i -> for_ [0..dims ^. height] $ \j -> do val <- (>= aliveChance) <$> getRandomR (0, 1) lift $ writeArray res (i, j) val pure res +initializeEmpty :: RandomGen g => Dimensions -> CellM g s (MCells s) +initializeEmpty dims = + lift $ newArray ((0, 0), (dims ^. width, dims ^. height)) False + numAliveNeighborsM :: forall a i j m . (MArray a Bool m, Ix (i, j), Integral i, Integral j) diff --git a/src/Xanthous/Orphans.hs b/src/Xanthous/Orphans.hs index 6a860e1c49..b7a4a32126 100644 --- a/src/Xanthous/Orphans.hs +++ b/src/Xanthous/Orphans.hs @@ -1,7 +1,9 @@ {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE ViewPatterns #-} -{-# LANGUAGE UndecidableInstances, PatternSynonyms #-} +{-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE PatternSynonyms #-} +{-# LANGUAGE PackageImports #-} {-# OPTIONS_GHC -Wno-orphans #-} -------------------------------------------------------------------------------- module Xanthous.Orphans @@ -13,21 +15,23 @@ import Xanthous.Prelude hiding (elements, (.=)) import Data.Aeson import Data.Aeson.Types (typeMismatch) import Data.List.NonEmpty (NonEmpty(..)) -import qualified Data.List.NonEmpty as NonEmpty -import Data.Text.Arbitrary () import Graphics.Vty.Attributes import Brick.Widgets.Edit import Data.Text.Zipper.Generic (GenericTextZipper) import Brick.Widgets.Core (getName) import System.Random (StdGen) import Test.QuickCheck +import "quickcheck-instances" Test.QuickCheck.Instances () import Text.Megaparsec (errorBundlePretty) import Text.Megaparsec.Pos import Text.Mustache import Text.Mustache.Type ( showKey ) import Control.Monad.State +import Linear -------------------------------------------------------------------------------- import Xanthous.Util.JSON +import Xanthous.Util.QuickCheck +-------------------------------------------------------------------------------- instance forall s a. ( Cons s s a a @@ -130,18 +134,6 @@ instance Function Template where parseTemplatePartial txt = compileMustacheText "template" txt ^?! _Right -instance Arbitrary a => Arbitrary (NonEmpty a) where - arbitrary = do - x <- arbitrary - xs <- arbitrary - pure $ x :| xs - -instance CoArbitrary a => CoArbitrary (NonEmpty a) where - coarbitrary = coarbitrary . toList - -instance Function a => Function (NonEmpty a) where - function = functionMap toList NonEmpty.fromList - ppNode :: Map PName [Node] -> Node -> Text ppNode _ (TextBlock txt) = txt ppNode _ (EscapedVar k) = "{{" <> showKey k <> "}}" @@ -169,12 +161,6 @@ instance FromJSON Template where $ either (fail . errorBundlePretty) pure . compileMustacheText "template" -instance CoArbitrary Text where - coarbitrary = coarbitrary . unpack - -instance Function Text where - function = functionMap unpack pack - deriving anyclass instance NFData Node deriving anyclass instance NFData Template @@ -353,3 +339,8 @@ instance CoArbitrary StdGen where deriving newtype instance (Arbitrary s, CoArbitrary (m (a, s))) => CoArbitrary (StateT s m a) +-------------------------------------------------------------------------------- + +deriving via (GenericArbitrary (V2 a)) instance Arbitrary a => Arbitrary (V2 a) +instance CoArbitrary a => CoArbitrary (V2 a) +instance Function a => Function (V2 a) diff --git a/src/Xanthous/Random.hs b/src/Xanthous/Random.hs index bbf176f71d..3cb0b068d3 100644 --- a/src/Xanthous/Random.hs +++ b/src/Xanthous/Random.hs @@ -8,17 +8,19 @@ module Xanthous.Random , Weighted(..) , evenlyWeighted , weightedBy + , subRand ) where -------------------------------------------------------------------------------- import Xanthous.Prelude -------------------------------------------------------------------------------- -import Data.List.NonEmpty (NonEmpty) -import Control.Monad.Random.Class (MonadRandom(getRandomR, getRandom)) -import Data.Random.Shuffle.Weighted -import Data.Random.Distribution -import Data.Random.Distribution.Uniform -import Data.Random.Distribution.Uniform.Exclusive -import Data.Random.Sample +import Data.List.NonEmpty (NonEmpty(..)) +import Control.Monad.Random.Class (MonadRandom(getRandomR, getRandom)) +import Control.Monad.Random (Rand, evalRand, mkStdGen, StdGen) +import Data.Random.Shuffle.Weighted +import Data.Random.Distribution +import Data.Random.Distribution.Uniform +import Data.Random.Distribution.Uniform.Exclusive +import Data.Random.Sample import qualified Data.Random.Source as DRS -------------------------------------------------------------------------------- @@ -58,6 +60,10 @@ instance Choose (NonEmpty a) where type RandomResult (NonEmpty a) = a choose = choose . fromNonEmpty @[_] +instance Choose (a, a) where + type RandomResult (a, a) = a + choose (x, y) = choose (x :| [y]) + newtype Weighted w t a = Weighted (t (w, a)) evenlyWeighted :: [a] -> Weighted Int [] a @@ -76,3 +82,6 @@ instance (Num w, Ord w, Distribution Uniform w, Excludable w) => Choose (Weighte sample $ fromMaybe (error "unreachable") . headMay <$> weightedSample 1 (toList ws) + +subRand :: MonadRandom m => Rand StdGen a -> m a +subRand sub = evalRand sub . mkStdGen <$> getRandom diff --git a/src/Xanthous/Util.hs b/src/Xanthous/Util.hs index 93155af3fd..524ad4819d 100644 --- a/src/Xanthous/Util.hs +++ b/src/Xanthous/Util.hs @@ -29,6 +29,9 @@ module Xanthous.Util , maximum1 , minimum1 + -- * Combinators + , times, times_ + -- * Type-level programming utils , KnownBool(..) ) where @@ -228,6 +231,12 @@ maximum1 = getMax . foldMap1 Max minimum1 :: (Ord a, Foldable1 f) => f a -> a minimum1 = getMin . foldMap1 Min +times :: (Applicative f, Num n, Enum n) => n -> (n -> f b) -> f [b] +times n f = traverse f [1..n] + +times_ :: (Applicative f, Num n, Enum n) => n -> f a -> f [a] +times_ n fa = times n (const fa) + -------------------------------------------------------------------------------- -- | This class gives a boolean associated with a type-level bool, a'la diff --git a/src/Xanthous/Util/Graph.hs b/src/Xanthous/Util/Graph.hs new file mode 100644 index 0000000000..8e5c04f4bf --- /dev/null +++ b/src/Xanthous/Util/Graph.hs @@ -0,0 +1,33 @@ +-------------------------------------------------------------------------------- +module Xanthous.Util.Graph where +-------------------------------------------------------------------------------- +import Xanthous.Prelude +-------------------------------------------------------------------------------- +import Data.Graph.Inductive.Query.MST (msTree) +import qualified Data.Graph.Inductive.Graph as Graph +import Data.Graph.Inductive.Graph +import Data.Graph.Inductive.Basic (undir) +import Data.Set (isSubsetOf) +-------------------------------------------------------------------------------- + +mstSubGraph + :: forall gr node edge. (DynGraph gr, Real edge, Show edge) + => gr node edge -> gr node edge +mstSubGraph graph = insEdges mstEdges . insNodes (labNodes graph) $ Graph.empty + where + mstEdges = ordNub $ do + LP path <- msTree $ undir graph + case path of + [] -> [] + [_] -> [] + ((n₂, edgeWeight) : (n₁, _) : _) -> + pure (n₁, n₂, edgeWeight) + +isSubGraphOf + :: (Graph gr1, Graph gr2, Ord node, Ord edge) + => gr1 node edge + -> gr2 node edge + -> Bool +isSubGraphOf graph₁ graph₂ + = setFromList (labNodes graph₁) `isSubsetOf` setFromList (labNodes graph₂) + && setFromList (labEdges graph₁) `isSubsetOf` setFromList (labEdges graph₂) diff --git a/src/Xanthous/Util/Graphics.hs b/src/Xanthous/Util/Graphics.hs index e8269e72d6..bd6a0906a6 100644 --- a/src/Xanthous/Util/Graphics.hs +++ b/src/Xanthous/Util/Graphics.hs @@ -4,16 +4,26 @@ module Xanthous.Util.Graphics ( circle , filledCircle , line + , straightLine + , delaunay ) where -------------------------------------------------------------------------------- import Xanthous.Prelude +-------------------------------------------------------------------------------- +import qualified Algorithms.Geometry.DelaunayTriangulation.DivideAndConquer + as Geometry +import qualified Algorithms.Geometry.DelaunayTriangulation.Types as Geometry +import Codec.Picture (imagePixels) +import qualified Data.Geometry.Point as Geometry +import Data.Ext ((:+)(..)) import Data.List (unfoldr) +import Data.List.NonEmpty (NonEmpty) import Data.Ix (range, Ix) import Data.Word (Word8) import qualified Graphics.Rasterific as Raster -import Graphics.Rasterific hiding (circle, line) +import Graphics.Rasterific hiding (circle, line, V2(..)) import Graphics.Rasterific.Texture (uniformTexture) -import Codec.Picture (imagePixels) +import Linear.V2 -------------------------------------------------------------------------------- @@ -24,7 +34,7 @@ circle :: (Num i, Integral i, Ix i) circle (ox, oy) radius = pointsFromRaster (ox + radius) (oy + radius) $ stroke 1 JoinRound (CapRound, CapRound) - $ Raster.circle (V2 (fromIntegral ox) (fromIntegral oy)) + $ Raster.circle (Raster.V2 (fromIntegral ox) (fromIntegral oy)) $ fromIntegral radius filledCircle :: (Num i, Integral i, Ix i) @@ -34,7 +44,7 @@ filledCircle :: (Num i, Integral i, Ix i) filledCircle (ox, oy) radius = pointsFromRaster (ox + radius) (oy + radius) $ fill - $ Raster.circle (V2 (fromIntegral ox) (fromIntegral oy)) + $ Raster.circle (Raster.V2 (fromIntegral ox) (fromIntegral oy)) $ fromIntegral radius -- showCells . fromPoints . NE.fromList $ filledCircle (15, 15) 7 @@ -83,3 +93,21 @@ line pa@(xa, ya) pb@(xb, yb) (newY, newError) = if (2 * tempError) >= δx then (yTemp + ystep, tempError - δx) else (yTemp, tempError) + +straightLine :: (Num i, Ord i) => (i, i) -> (i, i) -> [(i, i)] +straightLine pa@(xa, _) pb@(_, yb) = line pa midpoint ++ line midpoint pb + where midpoint = (xa, yb) + + +delaunay + :: (Ord n, Fractional n) + => NonEmpty (V2 n, p) + -> [((V2 n, p), (V2 n, p))] +delaunay + = map (over both fromPoint) + . Geometry.triangulationEdges + . Geometry.delaunayTriangulation + . map toPoint + where + toPoint (V2 px py, pid) = Geometry.Point2 px py :+ pid + fromPoint (Geometry.Point2 px py :+ pid) = (V2 px py, pid) diff --git a/src/Xanthous/Util/Optparse.hs b/src/Xanthous/Util/Optparse.hs new file mode 100644 index 0000000000..dfa6537235 --- /dev/null +++ b/src/Xanthous/Util/Optparse.hs @@ -0,0 +1,21 @@ +-------------------------------------------------------------------------------- +module Xanthous.Util.Optparse + ( readWithGuard + ) where +-------------------------------------------------------------------------------- +import Xanthous.Prelude +-------------------------------------------------------------------------------- +import qualified Options.Applicative as Opt +-------------------------------------------------------------------------------- + +readWithGuard + :: Read b + => (b -> Bool) + -> (b -> String) + -> Opt.ReadM b +readWithGuard predicate errmsg = do + res <- Opt.auto + unless (predicate res) + $ Opt.readerError + $ errmsg res + pure res diff --git a/test/Spec.hs b/test/Spec.hs index 73b965bdb6..8141b83e97 100644 --- a/test/Spec.hs +++ b/test/Spec.hs @@ -9,6 +9,7 @@ import qualified Xanthous.Generators.UtilSpec import qualified Xanthous.MessageSpec import qualified Xanthous.OrphansSpec import qualified Xanthous.Util.GraphicsSpec +import qualified Xanthous.Util.GraphSpec import qualified Xanthous.Util.InflectionSpec import qualified Xanthous.UtilSpec @@ -28,5 +29,6 @@ test = testGroup "Xanthous" , Xanthous.DataSpec.test , Xanthous.UtilSpec.test , Xanthous.Util.GraphicsSpec.test + , Xanthous.Util.GraphSpec.test , Xanthous.Util.InflectionSpec.test ] diff --git a/test/Xanthous/DataSpec.hs b/test/Xanthous/DataSpec.hs index 6fad88681a..bd02c0f36f 100644 --- a/test/Xanthous/DataSpec.hs +++ b/test/Xanthous/DataSpec.hs @@ -1,10 +1,10 @@ --- | - +-------------------------------------------------------------------------------- module Xanthous.DataSpec (main, test) where - +-------------------------------------------------------------------------------- import Test.Prelude hiding (Right, Left, Down) import Xanthous.Data import Data.Group +-------------------------------------------------------------------------------- main :: IO () main = defaultMain test @@ -35,11 +35,12 @@ test = testGroup "Xanthous.Data" (not . isUnit) (Position @Int 1 13) @? "isUnit $ Position 1 13" ] ] + , testGroup "Direction" [ testProperty "opposite is involutive" $ \(dir :: Direction) -> opposite (opposite dir) == dir , testProperty "opposite provides inverse" $ \dir -> - invert (asPosition dir) == asPosition (opposite dir) + invert (asPosition dir) === asPosition (opposite dir) , testProperty "asPosition isUnit" $ \dir -> dir /= Here ==> isUnit (asPosition dir) , testGroup "Move" @@ -53,4 +54,29 @@ test = testGroup "Xanthous.Data" , testCase "DownRight" $ move DownRight mempty @?= Position 1 1 ] ] + + , testGroup "Corner" + [ testGroup "instance Opposite" + [ testProperty "involutive" $ \corner -> + opposite (opposite corner) === corner + ] + ] + + , testGroup "Edge" + [ testGroup "instance Opposite" + [ testProperty "involutive" $ \edge -> + opposite (opposite edge) === edge + ] + ] + + , testGroup "Box" + [ testGroup "boxIntersects" + [ testProperty "True" $ \dims -> + boxIntersects (Box @Word (V2 1 1) (V2 2 2)) + (Box (V2 2 2) dims) + , testProperty "False" $ \dims -> + not $ boxIntersects (Box @Word (V2 1 1) (V2 2 2)) + (Box (V2 4 2) dims) + ] + ] ] diff --git a/test/Xanthous/Util/GraphSpec.hs b/test/Xanthous/Util/GraphSpec.hs new file mode 100644 index 0000000000..35ff090b28 --- /dev/null +++ b/test/Xanthous/Util/GraphSpec.hs @@ -0,0 +1,39 @@ +module Xanthous.Util.GraphSpec (main, test) where +-------------------------------------------------------------------------------- +import Test.Prelude +-------------------------------------------------------------------------------- +import Xanthous.Util.Graph +import Data.Graph.Inductive.Basic +import Data.Graph.Inductive.Graph (labNodes, size, order) +import Data.Graph.Inductive.PatriciaTree +import Data.Graph.Inductive.Arbitrary +-------------------------------------------------------------------------------- + +main :: IO () +main = defaultMain test + +test :: TestTree +test = testGroup "Xanthous.Util.Graph" + [ testGroup "mstSubGraph" + [ testProperty "always produces a subgraph" + $ \(CG _ (graph :: Gr Int Int)) -> + let msg = mstSubGraph $ undir graph + in counterexample (show msg) + $ msg `isSubGraphOf` undir graph + , testProperty "returns a graph with the same nodes" + $ \(CG _ (graph :: Gr Int Int)) -> + let msg = mstSubGraph graph + in counterexample (show msg) + $ labNodes msg === labNodes graph + , testProperty "has nodes - 1 edges" + $ \(CG _ (graph :: Gr Int Int)) -> + order graph > 1 ==> + let msg = mstSubGraph graph + in counterexample (show msg) + $ size msg === order graph - 1 + , testProperty "always produces a simple graph" + $ \(CG _ (graph :: Gr Int Int)) -> + let msg = mstSubGraph graph + in counterexample (show msg) $ isSimple msg + ] + ] diff --git a/xanthous.cabal b/xanthous.cabal index 5f1abdbc8f..23044d7fce 100644 --- a/xanthous.cabal +++ b/xanthous.cabal @@ -4,7 +4,7 @@ cabal-version: 1.12 -- -- see: https://github.com/sol/hpack -- --- hash: 2d93180ab419496ded42f750d00a5b3f6c6994a9af86a8694bb585a1f52919d4 +-- hash: 497414a98a626a63a6c5022688b33d0021c1580c7c262fbc1152599289df7935 name: xanthous version: 0.1.0.0 @@ -54,6 +54,7 @@ library Xanthous.Game.State Xanthous.Generators Xanthous.Generators.CaveAutomata + Xanthous.Generators.Dungeon Xanthous.Generators.LevelContents Xanthous.Generators.Util Xanthous.Messages @@ -63,9 +64,11 @@ library Xanthous.Random Xanthous.Resource Xanthous.Util + Xanthous.Util.Graph Xanthous.Util.Graphics Xanthous.Util.Inflection Xanthous.Util.JSON + Xanthous.Util.Optparse Xanthous.Util.QuickCheck other-modules: Paths_xanthous @@ -74,8 +77,10 @@ library default-extensions: BlockArguments ConstraintKinds DataKinds DeriveAnyClass DeriveGeneric DerivingStrategies DerivingVia FlexibleContexts FlexibleInstances FunctionalDependencies GADTSyntax GeneralizedNewtypeDeriving KindSignatures LambdaCase MultiWayIf NoImplicitPrelude NoStarIsType OverloadedStrings PolyKinds RankNTypes ScopedTypeVariables TupleSections TypeApplications TypeFamilies TypeOperators ghc-options: -Wall build-depends: - MonadRandom + JuicyPixels + , MonadRandom , QuickCheck + , Rasterific , aeson , array , base @@ -87,13 +92,18 @@ library , containers , data-default , deepseq + , fgl + , fgl-arbitrary , file-embed , filepath , generic-arbitrary , generic-lens , generic-monoid , groups + , hgeometry + , hgeometry-combinatorial , lens + , linear , megaparsec , mtl , optparse-applicative @@ -105,7 +115,9 @@ library , random-source , raw-strings-qq , reflection + , semigroupoids , stache + , streams , text-zipper , tomland , vector @@ -142,6 +154,7 @@ executable xanthous Xanthous.Game.State Xanthous.Generators Xanthous.Generators.CaveAutomata + Xanthous.Generators.Dungeon Xanthous.Generators.LevelContents Xanthous.Generators.Util Xanthous.Messages @@ -151,9 +164,11 @@ executable xanthous Xanthous.Random Xanthous.Resource Xanthous.Util + Xanthous.Util.Graph Xanthous.Util.Graphics Xanthous.Util.Inflection Xanthous.Util.JSON + Xanthous.Util.Optparse Xanthous.Util.QuickCheck Paths_xanthous hs-source-dirs: @@ -161,8 +176,10 @@ executable xanthous default-extensions: BlockArguments ConstraintKinds DataKinds DeriveAnyClass DeriveGeneric DerivingStrategies DerivingVia FlexibleContexts FlexibleInstances FunctionalDependencies GADTSyntax GeneralizedNewtypeDeriving KindSignatures LambdaCase MultiWayIf NoImplicitPrelude NoStarIsType OverloadedStrings PolyKinds RankNTypes ScopedTypeVariables TupleSections TypeApplications TypeFamilies TypeOperators ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N -O2 build-depends: - MonadRandom + JuicyPixels + , MonadRandom , QuickCheck + , Rasterific , aeson , array , base @@ -174,13 +191,18 @@ executable xanthous , containers , data-default , deepseq + , fgl + , fgl-arbitrary , file-embed , filepath , generic-arbitrary , generic-lens , generic-monoid , groups + , hgeometry + , hgeometry-combinatorial , lens + , linear , megaparsec , mtl , optparse-applicative @@ -192,7 +214,9 @@ executable xanthous , random-source , raw-strings-qq , reflection + , semigroupoids , stache + , streams , text-zipper , tomland , vector @@ -217,6 +241,7 @@ test-suite test Xanthous.MessageSpec Xanthous.OrphansSpec Xanthous.Util.GraphicsSpec + Xanthous.Util.GraphSpec Xanthous.Util.InflectionSpec Xanthous.UtilSpec Paths_xanthous @@ -225,8 +250,10 @@ test-suite test default-extensions: BlockArguments ConstraintKinds DataKinds DeriveAnyClass DeriveGeneric DerivingStrategies DerivingVia FlexibleContexts FlexibleInstances FunctionalDependencies GADTSyntax GeneralizedNewtypeDeriving KindSignatures LambdaCase MultiWayIf NoImplicitPrelude NoStarIsType OverloadedStrings PolyKinds RankNTypes ScopedTypeVariables TupleSections TypeApplications TypeFamilies TypeOperators ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N -O0 build-depends: - MonadRandom + JuicyPixels + , MonadRandom , QuickCheck + , Rasterific , aeson , array , base @@ -238,14 +265,19 @@ test-suite test , containers , data-default , deepseq + , fgl + , fgl-arbitrary , file-embed , filepath , generic-arbitrary , generic-lens , generic-monoid , groups + , hgeometry + , hgeometry-combinatorial , lens , lens-properties + , linear , megaparsec , mtl , optparse-applicative @@ -257,7 +289,9 @@ test-suite test , random-source , raw-strings-qq , reflection + , semigroupoids , stache + , streams , tasty , tasty-hunit , tasty-quickcheck -- cgit 1.4.1 From dcf44f29f5df75dedae62a9820b06d7c4cd36df1 Mon Sep 17 00:00:00 2001 From: Griffin Smith Date: Mon, 30 Dec 2019 12:30:12 -0500 Subject: Place doors on the level Pick a random subset of cells on the level that have a wall on two opposite sides and are clear on the other two sides, and place closed, unlocked doors on those cells. --- src/Xanthous/App.hs | 6 +---- src/Xanthous/Entities/Environment.hs | 8 ++++++ src/Xanthous/Generators.hs | 20 +++++++++++++- src/Xanthous/Generators/LevelContents.hs | 45 ++++++++++++++++++++++++-------- 4 files changed, 62 insertions(+), 17 deletions(-) diff --git a/src/Xanthous/App.hs b/src/Xanthous/App.hs index 2bdf6142f9..5fb70bd075 100644 --- a/src/Xanthous/App.hs +++ b/src/Xanthous/App.hs @@ -90,11 +90,7 @@ initLevel = do generateLevel SCaveAutomata CaveAutomata.defaultParams $ Dimensions 80 80 - entities <>= (SomeEntity <$> level ^. levelWalls) - entities <>= (SomeEntity <$> level ^. levelItems) - entities <>= (SomeEntity <$> level ^. levelCreatures) - entities <>= (SomeEntity <$> level ^. levelTutorialMessage) - + entities <>= levelToEntityMap level characterPosition .= level ^. levelCharacterPosition -------------------------------------------------------------------------------- diff --git a/src/Xanthous/Entities/Environment.hs b/src/Xanthous/Entities/Environment.hs index 0690e47e54..c34f2e0634 100644 --- a/src/Xanthous/Entities/Environment.hs +++ b/src/Xanthous/Entities/Environment.hs @@ -7,6 +7,7 @@ module Xanthous.Entities.Environment , Door(..) , open , locked + , unlockedDoor -- * Messages , GroundMessage(..) ) where @@ -88,6 +89,13 @@ instance Entity Door where description _ = "a door" entityChar _ = "d" +-- | A closed, unlocked door +unlockedDoor :: Door +unlockedDoor = Door + { _open = False + , _locked = False + } + -------------------------------------------------------------------------------- newtype GroundMessage = GroundMessage Text diff --git a/src/Xanthous/Generators.hs b/src/Xanthous/Generators.hs index 592bf73c00..8c0372ed53 100644 --- a/src/Xanthous/Generators.hs +++ b/src/Xanthous/Generators.hs @@ -13,9 +13,11 @@ module Xanthous.Generators , levelWalls , levelItems , levelCreatures + , levelDoors , levelCharacterPosition , levelTutorialMessage , generateLevel + , levelToEntityMap ) where -------------------------------------------------------------------------------- import Xanthous.Prelude hiding (Level) @@ -34,6 +36,7 @@ import qualified Xanthous.Data.EntityMap as EntityMap import Xanthous.Entities.Environment import Xanthous.Entities.Item (Item) import Xanthous.Entities.Creature (Creature) +import Xanthous.Game.State (SomeEntity(..)) -------------------------------------------------------------------------------- data Generator @@ -109,6 +112,7 @@ cellsToWalls cells = foldl' maybeInsertWall mempty . assocs $ cells data Level = Level { _levelWalls :: !(EntityMap Wall) + , _levelDoors :: !(EntityMap Door) , _levelItems :: !(EntityMap Item) , _levelCreatures :: !(EntityMap Creature) , _levelTutorialMessage :: !(EntityMap GroundMessage) @@ -116,13 +120,27 @@ data Level = Level } makeLenses ''Level -generateLevel :: MonadRandom m => SGenerator gen -> Params gen -> Dimensions -> m Level +generateLevel + :: MonadRandom m + => SGenerator gen + -> Params gen + -> Dimensions + -> m Level generateLevel gen ps dims = do rand <- mkStdGen <$> getRandom let cells = generate gen ps dims rand _levelWalls = cellsToWalls cells _levelItems <- randomItems cells _levelCreatures <- randomCreatures cells + _levelDoors <- randomDoors cells _levelCharacterPosition <- chooseCharacterPosition cells _levelTutorialMessage <- tutorialMessage cells _levelCharacterPosition pure Level {..} + +levelToEntityMap :: Level -> EntityMap SomeEntity +levelToEntityMap level + = (SomeEntity <$> level ^. levelWalls) + <> (SomeEntity <$> level ^. levelDoors) + <> (SomeEntity <$> level ^. levelItems) + <> (SomeEntity <$> level ^. levelCreatures) + <> (SomeEntity <$> level ^. levelTutorialMessage) diff --git a/src/Xanthous/Generators/LevelContents.hs b/src/Xanthous/Generators/LevelContents.hs index 91a7d38019..aaeb4a77fd 100644 --- a/src/Xanthous/Generators/LevelContents.hs +++ b/src/Xanthous/Generators/LevelContents.hs @@ -3,6 +3,7 @@ module Xanthous.Generators.LevelContents ( chooseCharacterPosition , randomItems , randomCreatures + , randomDoors , tutorialMessage ) where -------------------------------------------------------------------------------- @@ -10,6 +11,7 @@ import Xanthous.Prelude -------------------------------------------------------------------------------- import Control.Monad.Random import Data.Array.IArray (amap, bounds, rangeSize, (!)) +import qualified Data.Array.IArray as Arr -------------------------------------------------------------------------------- import Xanthous.Generators.Util import Xanthous.Random @@ -20,7 +22,8 @@ import qualified Xanthous.Entities.Item as Item import Xanthous.Entities.Item (Item) import qualified Xanthous.Entities.Creature as Creature import Xanthous.Entities.Creature (Creature) -import Xanthous.Entities.Environment (GroundMessage(..)) +import Xanthous.Entities.Environment + (GroundMessage(..), Door(..), unlockedDoor) import Xanthous.Messages (message_) import Xanthous.Util.Graphics (circle) -------------------------------------------------------------------------------- @@ -31,6 +34,25 @@ chooseCharacterPosition = randomPosition randomItems :: MonadRandom m => Cells -> m (EntityMap Item) randomItems = randomEntities Item.newWithType (0.0004, 0.001) +randomDoors :: MonadRandom m => Cells -> m (EntityMap Door) +randomDoors cells = do + doorRatio <- getRandomR subsetRange + let numDoors = floor $ doorRatio * fromIntegral (length candidateCells) + doorPositions = positionFromPair <$> take numDoors candidateCells + doors = zip doorPositions $ repeat unlockedDoor + pure $ _EntityMap # doors + where + candidateCells = filter doorable $ Arr.indices cells + subsetRange = (0.8 :: Double, 1.0) + doorable (x, y) = + ( fromMaybe True $ cells ^? ix (x - 1, y) -- left + , fromMaybe True $ cells ^? ix (x, y - 1) -- top + , fromMaybe True $ cells ^? ix (x + 1, y) -- right + , fromMaybe True $ cells ^? ix (x, y + 1) -- bottom + ) `elem` [ (True, False, True, False) + , (False, True, False, True) + ] + randomCreatures :: MonadRandom m => Cells -> m (EntityMap Creature) randomCreatures = randomEntities Creature.newWithType (0.0007, 0.003) @@ -73,14 +95,15 @@ randomEntities newWithType sizeRange cells = pure $ _EntityMap # entities randomPosition :: MonadRandom m => Cells -> m Position -randomPosition cells = fmap positionFromPair . choose $ impureNonNull candidates - where - -- cells ends up with true = wall, we want true = can put an item here - placeableCells = amap not cells +randomPosition = fmap positionFromPair . choose . impureNonNull . cellCandidates - -- find the largest contiguous region of cells in the cave. - candidates - = maximumBy (compare `on` length) - $ fromMaybe (error "No regions generated! this should never happen.") - $ fromNullable - $ regions placeableCells +-- cellCandidates :: Cells -> Cells +cellCandidates :: Cells -> Set (Word, Word) +cellCandidates + -- find the largest contiguous region of cells in the cave. + = maximumBy (compare `on` length) + . fromMaybe (error "No regions generated! this should never happen.") + . fromNullable + . regions + -- cells ends up with true = wall, we want true = can put an item here + . amap not -- cgit 1.4.1 From 7e6234e2e9e1307cc61884e53d0457c022543894 Mon Sep 17 00:00:00 2001 From: Griffin Smith Date: Mon, 30 Dec 2019 12:37:50 -0500 Subject: Use more evocative characters for closed doors --- src/Xanthous/Entities/Environment.hs | 14 ++++++++------ 1 file changed, 8 insertions(+), 6 deletions(-) diff --git a/src/Xanthous/Entities/Environment.hs b/src/Xanthous/Entities/Environment.hs index c34f2e0634..4f70d90253 100644 --- a/src/Xanthous/Entities/Environment.hs +++ b/src/Xanthous/Entities/Environment.hs @@ -68,19 +68,21 @@ makeLenses ''Door instance Draw Door where drawWithNeighbors neighs door - | door ^. open - = str . pure $ case wallEdges neighs of + = str . pure . ($ door ^. open) $ case wallEdges neighs of Edges True False False False -> vertDoor Edges False True False False -> vertDoor Edges True True False False -> vertDoor Edges False False True False -> horizDoor Edges False False False True -> horizDoor Edges False False True True -> horizDoor - _ -> '+' - | otherwise = str "\\" + _ -> allsidesDoor where - horizDoor = '␣' - vertDoor = '[' + horizDoor True = '␣' + horizDoor False = 'ᚔ' + vertDoor True = '[' + vertDoor False = 'ǂ' + allsidesDoor True = '+' + allsidesDoor False = '▥' instance Brain Door where step = brainVia Brainless -- cgit 1.4.1 From ffc8e793d5ca8a73f8a6ec0f0a4f2efb2c98cf93 Mon Sep 17 00:00:00 2001 From: Griffin Smith Date: Tue, 31 Dec 2019 11:09:18 -0500 Subject: Prompt before overwriting files when saving When saving the game to a file that already exists, prompt for whether or not to overwrite the file. Since this was the first instance of a prompt triggered by another prompt, this also had to do a minor fix to swap the order of completing the prompt and clearing it, so that we don't submit the prompt and then immediately clear it. --- package.yaml | 1 + src/Xanthous/App.hs | 29 ++++++++++++++++++----------- src/Xanthous/messages.yaml | 4 ++-- xanthous.cabal | 5 ++++- 4 files changed, 25 insertions(+), 14 deletions(-) diff --git a/package.yaml b/package.yaml index 32a402f3fd..8d761b58e0 100644 --- a/package.yaml +++ b/package.yaml @@ -30,6 +30,7 @@ dependencies: - containers - data-default - deepseq +- directory - fgl - fgl-arbitrary - file-embed diff --git a/src/Xanthous/App.hs b/src/Xanthous/App.hs index 5fb70bd075..808654e1ab 100644 --- a/src/Xanthous/App.hs +++ b/src/Xanthous/App.hs @@ -16,6 +16,7 @@ import Data.Aeson (object, ToJSON) import qualified Data.Aeson as A import qualified Data.Vector as V import System.Exit +import System.Directory (doesFileExist) import GHC.TypeLits (TypeError, ErrorMessage(..)) -------------------------------------------------------------------------------- import Xanthous.Command @@ -257,13 +258,19 @@ handleCommand Save = do -- TODO default save locations / config file? prompt_ @'StringPrompt ["save", "location"] Cancellable $ \(StringResult filename) -> do + exists <- liftIO . doesFileExist $ unpack filename + if exists + then confirm ["save", "overwrite"] (object ["filename" A..= filename]) + $ doSave filename + else doSave filename + continue + where + doSave filename = do src <- gets saveGame lift . liftIO $ do writeFile (unpack filename) $ toStrict src exitSuccess - continue - handleCommand ToggleRevealAll = do val <- debugState . allRevealed <%= not @@ -279,15 +286,15 @@ handlePromptEvent -> AppM (Next GameState) handlePromptEvent _ (Prompt Cancellable _ _ _ _) (VtyEvent (EvKey KEsc [])) - = clearPrompt + = clearPrompt >> continue handlePromptEvent _ pr (VtyEvent (EvKey KEnter [])) - = submitPrompt pr >> clearPrompt + = clearPrompt >> submitPrompt pr >> continue handlePromptEvent _ pr@(Prompt _ SConfirm _ _ _) (VtyEvent (EvKey (KChar 'y') [])) - = submitPrompt pr >> clearPrompt + = clearPrompt >> submitPrompt pr >> continue handlePromptEvent _ (Prompt _ SConfirm _ _ _) (VtyEvent (EvKey (KChar 'n') [])) - = clearPrompt + = clearPrompt >> continue handlePromptEvent msg @@ -301,12 +308,12 @@ handlePromptEvent handlePromptEvent _ (Prompt _ SDirectionPrompt _ _ cb) (VtyEvent (EvKey (KChar (directionFromChar -> Just dir)) [])) - = cb (DirectionResult dir) >> clearPrompt + = clearPrompt >> cb (DirectionResult dir) >> continue handlePromptEvent _ (Prompt _ SDirectionPrompt _ _ _) _ = continue handlePromptEvent _ (Prompt _ SMenu _ items' cb) (VtyEvent (EvKey (KChar chr) [])) | Just (MenuOption _ res) <- items' ^. at chr - = cb (MenuResult res) >> clearPrompt + = clearPrompt >> cb (MenuResult res) >> continue | otherwise = continue @@ -324,11 +331,11 @@ handlePromptEvent _ (Prompt Cancellable _ _ _ _) (VtyEvent (EvKey (KChar 'q') [])) - = clearPrompt + = clearPrompt >> continue handlePromptEvent _ _ _ = continue -clearPrompt :: AppM (Next GameState) -clearPrompt = promptState .= NoPrompt >> continue +clearPrompt :: AppM () +clearPrompt = promptState .= NoPrompt class NotMenu (pt :: PromptType) instance NotMenu 'StringPrompt diff --git a/src/Xanthous/messages.yaml b/src/Xanthous/messages.yaml index 408cb6a1a5..1a4159b0ac 100644 --- a/src/Xanthous/messages.yaml +++ b/src/Xanthous/messages.yaml @@ -9,8 +9,8 @@ generic: continue: Press enter to continue... save: - location: - "Enter filename to save to: " + location: "Enter filename to save to: " + overwrite: "A file named {{filename}} already exists. Would you like to overwrite it? " quit: confirm: Really quit without saving? diff --git a/xanthous.cabal b/xanthous.cabal index 23044d7fce..f173b1a114 100644 --- a/xanthous.cabal +++ b/xanthous.cabal @@ -4,7 +4,7 @@ cabal-version: 1.12 -- -- see: https://github.com/sol/hpack -- --- hash: 497414a98a626a63a6c5022688b33d0021c1580c7c262fbc1152599289df7935 +-- hash: a4f6c2c91e3c94c81de5d6b27201cb22e7f9f9c5d8a4f14beec63c1540d01ca1 name: xanthous version: 0.1.0.0 @@ -92,6 +92,7 @@ library , containers , data-default , deepseq + , directory , fgl , fgl-arbitrary , file-embed @@ -191,6 +192,7 @@ executable xanthous , containers , data-default , deepseq + , directory , fgl , fgl-arbitrary , file-embed @@ -265,6 +267,7 @@ test-suite test , containers , data-default , deepseq + , directory , fgl , fgl-arbitrary , file-embed -- cgit 1.4.1 From 0373e06c02d16a30e1cc39da9962618c066d14e7 Mon Sep 17 00:00:00 2001 From: Griffin Smith Date: Tue, 31 Dec 2019 11:23:54 -0500 Subject: Replace previously-wielded items when wielding When wielding a new item, put any previously-wielded items back in the character's backpack. --- src/Xanthous/App.hs | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/src/Xanthous/App.hs b/src/Xanthous/App.hs index 808654e1ab..1db75bb585 100644 --- a/src/Xanthous/App.hs +++ b/src/Xanthous/App.hs @@ -250,7 +250,9 @@ handleCommand Wield = do selectItemFromInventory_ ["wield", "menu"] Cancellable asWieldedItem (say_ ["wield", "nothing"]) $ \(MenuResult item) -> do - character . inventory . wielded .= inRightHand item + prevItems <- character . inventory . wielded <<.= inRightHand item + character . inventory . backpack + <>= fromList (prevItems ^.. wieldedItems . wieldedItem) say ["wield", "wielded"] item continue -- cgit 1.4.1 From 14997bc1a3501cb3b759dc6dff7a2604deb6648b Mon Sep 17 00:00:00 2001 From: Griffin Smith Date: Tue, 31 Dec 2019 11:28:51 -0500 Subject: Fix ambiguity error in Opposite tests For some reason cabal wasn't properly recompiling this file locally to pick up the introduction of an ambiguity error. --- src/Xanthous/Data.hs | 2 ++ test/Xanthous/DataSpec.hs | 4 ++-- 2 files changed, 4 insertions(+), 2 deletions(-) diff --git a/src/Xanthous/Data.hs b/src/Xanthous/Data.hs index 8a8a62d0ee..5e45169582 100644 --- a/src/Xanthous/Data.hs +++ b/src/Xanthous/Data.hs @@ -334,6 +334,7 @@ data Corner | BottomLeft | BottomRight deriving stock (Show, Eq, Ord, Enum, Bounded, Generic) + deriving Arbitrary via GenericArbitrary Corner instance Opposite Corner where opposite TopLeft = BottomRight @@ -347,6 +348,7 @@ data Edge | RightEdge | BottomEdge deriving stock (Show, Eq, Ord, Enum, Bounded, Generic) + deriving Arbitrary via GenericArbitrary Edge instance Opposite Edge where opposite TopEdge = BottomEdge diff --git a/test/Xanthous/DataSpec.hs b/test/Xanthous/DataSpec.hs index bd02c0f36f..a2fcdbba15 100644 --- a/test/Xanthous/DataSpec.hs +++ b/test/Xanthous/DataSpec.hs @@ -57,14 +57,14 @@ test = testGroup "Xanthous.Data" , testGroup "Corner" [ testGroup "instance Opposite" - [ testProperty "involutive" $ \corner -> + [ testProperty "involutive" $ \(corner :: Corner) -> opposite (opposite corner) === corner ] ] , testGroup "Edge" [ testGroup "instance Opposite" - [ testProperty "involutive" $ \edge -> + [ testProperty "involutive" $ \(edge :: Edge) -> opposite (opposite edge) === edge ] ] -- cgit 1.4.1 From 5c5aa14a3dcb5c172eaf8d2236b41020c8e92051 Mon Sep 17 00:00:00 2001 From: Griffin Smith Date: Fri, 3 Jan 2020 12:04:08 -0500 Subject: Don't render moving entities that aren't visible When the character walks away from or around the corner from entities that move such that they're no longer visible, stop rendering them. Still render static entities like walls, doors, and items though. This prevents entities walking into a "revealed position" after the character's left being visible despite not being in a line of sight any more. --- src/Xanthous/AI/Gormlak.hs | 5 ++++- src/Xanthous/Game.hs | 1 + src/Xanthous/Game/Draw.hs | 53 +++++++++++++++++++++++++++------------------ src/Xanthous/Game/Lenses.hs | 13 +++++++---- src/Xanthous/Game/State.hs | 3 +++ 5 files changed, 49 insertions(+), 26 deletions(-) diff --git a/src/Xanthous/AI/Gormlak.hs b/src/Xanthous/AI/Gormlak.hs index 8b30bc2c9d..3e950f67f3 100644 --- a/src/Xanthous/AI/Gormlak.hs +++ b/src/Xanthous/AI/Gormlak.hs @@ -90,10 +90,13 @@ newtype GormlakBrain = GormlakBrain Creature instance Brain GormlakBrain where step ticks = fmap coerce . stepGormlak ticks . coerce + entityCanMove = const True -------------------------------------------------------------------------------- -instance Brain Creature where step = brainVia GormlakBrain +instance Brain Creature where + step = brainVia GormlakBrain + entityCanMove = const True instance Entity Creature where blocksVision _ = False diff --git a/src/Xanthous/Game.hs b/src/Xanthous/Game.hs index 14b8230218..094858618d 100644 --- a/src/Xanthous/Game.hs +++ b/src/Xanthous/Game.hs @@ -14,6 +14,7 @@ module Xanthous.Game , character , characterPosition , updateCharacterVision + , characterVisiblePositions -- * Messages , MessageHistory(..) diff --git a/src/Xanthous/Game/Draw.hs b/src/Xanthous/Game/Draw.hs index d98b48c027..8a86101d99 100644 --- a/src/Xanthous/Game/Draw.hs +++ b/src/Xanthous/Game/Draw.hs @@ -20,6 +20,7 @@ import Xanthous.Game , entities , revealedPositions , characterPosition + , characterVisiblePositions , character , MessageHistory(..) , messageHistory @@ -62,10 +63,12 @@ drawPromptState (WaitingPrompt msg (Prompt _ pt ps pri _)) = drawEntities :: (Position -> Bool) - -- ^ Can we render a given position? + -- ^ Is a given position directly visible to the character? + -> (Position -> Bool) + -- ^ Has a given position *ever* been seen by the character? -> EntityMap SomeEntity -- ^ all entities -> Widget Name -drawEntities canRenderPos allEnts +drawEntities isVisible isRevealed allEnts = vBox rows where entityPositions = EntityMap.positions allEnts @@ -74,23 +77,27 @@ drawEntities canRenderPos allEnts rows = mkRow <$> [0..maxY] mkRow rowY = hBox $ renderEntityAt . flip Position rowY <$> [0..maxX] renderEntityAt pos - | canRenderPos pos + = let entitiesAtPosition = allEnts ^. atPosition pos + immobileEntitiesAtPosition = + filter (not . entityCanMove) entitiesAtPosition + in renderTopEntity pos + $ if | isVisible pos -> entitiesAtPosition + | isRevealed pos -> immobileEntitiesAtPosition + | otherwise -> mempty + renderTopEntity pos ents = let neighbors = EntityMap.neighbors pos allEnts in maybe (str " ") (drawWithNeighbors neighbors) - $ maximumByOf - (atPosition pos . folded) - (compare `on` drawPriority) - allEnts - | otherwise = str " " + $ maximumBy (compare `on` drawPriority) + <$> fromNullable ents drawMap :: GameState -> Widget Name drawMap game = viewport Resource.MapViewport Both . cursorPosition game $ drawEntities - (\pos -> - (game ^. debugState . allRevealed) - || (pos `member` (game ^. revealedPositions))) + (\pos -> (game ^. debugState . allRevealed) + || (pos `member` (game ^. revealedPositions))) + (`member` characterVisiblePositions game) -- FIXME: this will break down as soon as creatures can walk around on their -- own, since we don't want to render things walking around when the -- character can't see them @@ -99,17 +106,11 @@ drawMap game bullet :: Char bullet = '•' -drawPanel :: GameState -> Panel -> Widget Name -drawPanel game panel - = border - . hLimit 35 - . viewport (Resource.Panel panel) Vertical - $ case panel of - InventoryPanel -> - drawWielded (game ^. character . inventory . wielded) - <=> drawBackpack (game ^. character . inventory . backpack) +drawInventoryPanel :: GameState -> Widget Name +drawInventoryPanel game + = drawWielded (game ^. character . inventory . wielded) + <=> drawBackpack (game ^. character . inventory . backpack) where - drawWielded :: Wielded -> Widget Name drawWielded (Hands Nothing Nothing) = emptyWidget drawWielded (DoubleHanded i) = txtWrap $ "You are holding " <> description i <> " in both hands" @@ -132,6 +133,16 @@ drawPanel game panel (txtWrap . ((bullet <| " ") <>) . description) backpackItems) + +drawPanel :: GameState -> Panel -> Widget Name +drawPanel game panel + = border + . hLimit 35 + . viewport (Resource.Panel panel) Vertical + . case panel of + InventoryPanel -> drawInventoryPanel + $ game + drawCharacterInfo :: Character -> Widget Name drawCharacterInfo ch = txt " " <+> charName <+> charHitpoints where diff --git a/src/Xanthous/Game/Lenses.hs b/src/Xanthous/Game/Lenses.hs index 853f758385..4a080f85f0 100644 --- a/src/Xanthous/Game/Lenses.hs +++ b/src/Xanthous/Game/Lenses.hs @@ -5,6 +5,7 @@ module Xanthous.Game.Lenses , character , characterPosition , updateCharacterVision + , characterVisiblePositions , getInitialState , initialStateFromSeed @@ -84,12 +85,16 @@ characterPosition = positionedCharacter . position visionRadius :: Word visionRadius = 12 -- TODO make this dynamic --- | Update the revealed entities at the character's position based on their vision +-- | Update the revealed entities at the character's position based on their +-- vision updateCharacterVision :: GameState -> GameState -updateCharacterVision game = +updateCharacterVision game + = game & revealedPositions <>~ characterVisiblePositions game + +characterVisiblePositions :: GameState -> Set Position +characterVisiblePositions game = let charPos = game ^. characterPosition - visible = visiblePositions charPos visionRadius $ game ^. entities - in game & revealedPositions <>~ visible + in visiblePositions charPos visionRadius $ game ^. entities data Collision = Stop diff --git a/src/Xanthous/Game/State.hs b/src/Xanthous/Game/State.hs index 0ba7b2744a..853d0b6922 100644 --- a/src/Xanthous/Game/State.hs +++ b/src/Xanthous/Game/State.hs @@ -287,6 +287,8 @@ instance class Brain a where step :: Ticks -> Positioned a -> AppM (Positioned a) + entityCanMove :: a -> Bool + entityCanMove = const False newtype Brainless a = Brainless a @@ -429,6 +431,7 @@ instance Eq GameState where , gs ^. messageHistory , gs ^. sentWelcome , gs ^. activePanel + , gs ^. debugState ) -------------------------------------------------------------------------------- -- cgit 1.4.1 From c4351d46ef13da5fbe2048bb3506f9549b61f437 Mon Sep 17 00:00:00 2001 From: Griffin Smith Date: Fri, 3 Jan 2020 12:14:01 -0500 Subject: Describe doors as either closed or open Rather than just describing them as "a door". Descriptions should ideally be as injective as possible! --- src/Xanthous/Entities/Environment.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/Xanthous/Entities/Environment.hs b/src/Xanthous/Entities/Environment.hs index 4f70d90253..46416d1da5 100644 --- a/src/Xanthous/Entities/Environment.hs +++ b/src/Xanthous/Entities/Environment.hs @@ -88,7 +88,8 @@ instance Brain Door where step = brainVia Brainless instance Entity Door where blocksVision = not . view open - description _ = "a door" + description door | door ^. open = "an open door" + | otherwise = "a closed door" entityChar _ = "d" -- | A closed, unlocked door -- cgit 1.4.1 From 1b88921bc36e5da1ade5c52827d057dc2be65bc5 Mon Sep 17 00:00:00 2001 From: Griffin Smith Date: Fri, 3 Jan 2020 12:41:48 -0500 Subject: Decouple Gormlak AI from creatures Decouple the definition of the Gormlak AI from the creature type itself using generic lenses and a "HasVisionRadius" typeclass, to begin to untangle the hs-boot web of circular dependencies. This actually *increases* the number of hs-boot files from 1 to 2, but both of the source imports that use them are single-instance (unlike gormlak AI which I would expect to grow linearly with the growth of the game), plus at least one should be able to go away once we remove collision from the game lenses module and move it into something defined in the entity class itself. --- src/Xanthous/AI/Gormlak.hs | 74 +++++++++++++++++---------- src/Xanthous/AI/Gormlak.hs-boot | 7 --- src/Xanthous/Entities/Creature.hs | 58 ++++++--------------- src/Xanthous/Entities/Creature.hs-boot | 2 + src/Xanthous/Entities/Creature/Hippocampus.hs | 64 +++++++++++++++++++++++ src/Xanthous/Entities/Entities.hs | 1 - src/Xanthous/Entities/Entities.hs-boot | 14 +++++ src/Xanthous/Game/Lenses.hs | 6 +-- xanthous.cabal | 4 +- 9 files changed, 149 insertions(+), 81 deletions(-) delete mode 100644 src/Xanthous/AI/Gormlak.hs-boot create mode 100644 src/Xanthous/Entities/Creature.hs-boot create mode 100644 src/Xanthous/Entities/Creature/Hippocampus.hs create mode 100644 src/Xanthous/Entities/Entities.hs-boot diff --git a/src/Xanthous/AI/Gormlak.hs b/src/Xanthous/AI/Gormlak.hs index 3e950f67f3..031262533d 100644 --- a/src/Xanthous/AI/Gormlak.hs +++ b/src/Xanthous/AI/Gormlak.hs @@ -1,14 +1,18 @@ {-# OPTIONS_GHC -fno-warn-orphans #-} +{-# LANGUAGE UndecidableInstances #-} -------------------------------------------------------------------------------- -module Xanthous.AI.Gormlak () where +module Xanthous.AI.Gormlak + ( HasVisionRadius(..) + , GormlakBrain(..) + ) where -------------------------------------------------------------------------------- import Xanthous.Prelude hiding (lines) -------------------------------------------------------------------------------- -import Data.Coerce import Control.Monad.State import Control.Monad.Random import Data.Aeson (object) import qualified Data.Aeson as A +import Data.Generics.Product.Fields -------------------------------------------------------------------------------- import Xanthous.Data ( Positioned(..), positioned, position @@ -16,14 +20,11 @@ import Xanthous.Data , Ticks, (|*|), invertedRate ) import Xanthous.Data.EntityMap -import qualified Xanthous.Entities.Creature as Creature -import Xanthous.Entities.Creature - ( Creature, hippocampus, creatureType - , destination, destinationProgress, destinationPosition - ) +import Xanthous.Entities.Creature.Hippocampus import Xanthous.Entities.Character (Character) import qualified Xanthous.Entities.Character as Character import qualified Xanthous.Entities.RawTypes as Raw +import Xanthous.Entities.RawTypes (CreatureType) import Xanthous.Game.State import Xanthous.Game.Lenses ( Collision(..), entityCollision, collisionAt @@ -34,28 +35,44 @@ import Xanthous.Random import Xanthous.Monad (say) -------------------------------------------------------------------------------- +-- TODO move the following two classes to a more central location + +class HasVisionRadius a where visionRadius :: a -> Word + +type IsCreature entity = + ( HasVisionRadius entity + , HasField "_hippocampus" entity entity Hippocampus Hippocampus + , HasField "_creatureType" entity entity CreatureType CreatureType + , A.ToJSON entity + ) + +-------------------------------------------------------------------------------- + stepGormlak - :: (MonadState GameState m, MonadRandom m) + :: forall entity m. + ( MonadState GameState m, MonadRandom m + , IsCreature entity + ) => Ticks - -> Positioned Creature - -> m (Positioned Creature) + -> Positioned entity + -> m (Positioned entity) stepGormlak ticks pe@(Positioned pos creature) = do dest <- maybe (selectDestination pos creature) pure - $ creature ^. hippocampus . destination + $ creature ^. field @"_hippocampus" . destination let progress' = dest ^. destinationProgress - + creature ^. creatureType . Raw.speed . invertedRate |*| ticks + + creature ^. field @"_creatureType" . Raw.speed . invertedRate |*| ticks if progress' < 1 then pure $ pe - & positioned . hippocampus . destination + & positioned . field @"_hippocampus" . destination ?~ (dest & destinationProgress .~ progress') else do let newPos = dest ^. destinationPosition remainingSpeed = progress' - 1 newDest <- selectDestination newPos creature <&> destinationProgress +~ remainingSpeed - let pe' = pe & positioned . hippocampus . destination ?~ newDest + let pe' = pe & positioned . field @"_hippocampus" . destination ?~ newDest collisionAt newPos >>= \case Nothing -> pure $ pe' & position .~ newPos Just Stop -> pure pe' @@ -64,7 +81,7 @@ stepGormlak ticks pe@(Positioned pos creature) = do when (any (entityIs @Character) ents) attackCharacter pure pe' where - selectDestination pos' creature' = Creature.destinationFromPos <$> do + selectDestination pos' creature' = destinationFromPos <$> do canSeeCharacter <- uses entities $ canSee (entityIs @Character) pos' vision if canSeeCharacter then do @@ -76,29 +93,32 @@ stepGormlak ticks pe@(Positioned pos creature) = do lines <- map (takeWhile (isNothing . entityCollision . map snd . snd) -- the first item on these lines is always the creature itself . fromMaybe mempty . tailMay) - . linesOfSight pos' (Creature.visionRadius creature') + . linesOfSight pos' (visionRadius creature') <$> use entities line <- choose $ weightedBy length lines pure $ fromMaybe pos' $ fmap fst . headMay =<< line - vision = Creature.visionRadius creature + vision = visionRadius creature attackCharacter = do say ["combat", "creatureAttack"] $ object [ "creature" A..= creature ] character %= Character.damage 1 -newtype GormlakBrain = GormlakBrain Creature +newtype GormlakBrain entity = GormlakBrain { _unGormlakBrain :: entity } -instance Brain GormlakBrain where - step ticks = fmap coerce . stepGormlak ticks . coerce +instance (IsCreature entity) => Brain (GormlakBrain entity) where + step ticks + = fmap (fmap GormlakBrain) + . stepGormlak ticks + . fmap _unGormlakBrain entityCanMove = const True -------------------------------------------------------------------------------- -instance Brain Creature where - step = brainVia GormlakBrain - entityCanMove = const True +-- instance Brain Creature where +-- step = brainVia GormlakBrain +-- entityCanMove = const True -instance Entity Creature where - blocksVision _ = False - description = view $ Creature.creatureType . Raw.description - entityChar = view $ Creature.creatureType . char +-- instance Entity Creature where +-- blocksVision _ = False +-- description = view $ Creature.creatureType . Raw.description +-- entityChar = view $ Creature.creatureType . char diff --git a/src/Xanthous/AI/Gormlak.hs-boot b/src/Xanthous/AI/Gormlak.hs-boot deleted file mode 100644 index 47e62f6249..0000000000 --- a/src/Xanthous/AI/Gormlak.hs-boot +++ /dev/null @@ -1,7 +0,0 @@ -{-# OPTIONS_GHC -fno-warn-orphans #-} -module Xanthous.AI.Gormlak where - -import Xanthous.Game.State -import Xanthous.Entities.Creature - -instance Entity Creature diff --git a/src/Xanthous/Entities/Creature.hs b/src/Xanthous/Entities/Creature.hs index 19c7834228..6e955324a0 100644 --- a/src/Xanthous/Entities/Creature.hs +++ b/src/Xanthous/Entities/Creature.hs @@ -34,47 +34,13 @@ import Test.QuickCheck.Arbitrary.Generic import Data.Aeson.Generic.DerivingVia import Data.Aeson (ToJSON, FromJSON) -------------------------------------------------------------------------------- -import Xanthous.Entities.RawTypes - hiding (Creature, description, damage) +import Xanthous.AI.Gormlak +import Xanthous.Entities.RawTypes hiding + (Creature, description, damage) +import qualified Xanthous.Entities.RawTypes as Raw import Xanthous.Game.State import Xanthous.Data --------------------------------------------------------------------------------- - -data Destination = Destination - { _destinationPosition :: !Position - -- | The progress towards the destination, tracked as an offset from the - -- creature's original position. - -- - -- When this value reaches >= 1, the creature has reached their destination - , _destinationProgress :: !Tiles - } - deriving stock (Eq, Show, Ord, Generic) - deriving anyclass (NFData, CoArbitrary, Function) - deriving (ToJSON, FromJSON) - via WithOptions '[ FieldLabelModifier '[Drop 1] ] - Destination -instance Arbitrary Destination where arbitrary = genericArbitrary -makeLenses ''Destination - -destinationFromPos :: Position -> Destination -destinationFromPos _destinationPosition = - let _destinationProgress = 0 - in Destination{..} - -data Hippocampus = Hippocampus - { _destination :: !(Maybe Destination) - } - deriving stock (Eq, Show, Ord, Generic) - deriving anyclass (NFData, CoArbitrary, Function) - deriving (ToJSON, FromJSON) - via WithOptions '[ FieldLabelModifier '[Drop 1] ] - Hippocampus -instance Arbitrary Hippocampus where arbitrary = genericArbitrary -makeLenses ''Hippocampus - -initialHippocampus :: Hippocampus -initialHippocampus = Hippocampus Nothing - +import Xanthous.Entities.Creature.Hippocampus -------------------------------------------------------------------------------- data Creature = Creature @@ -91,6 +57,17 @@ data Creature = Creature instance Arbitrary Creature where arbitrary = genericArbitrary makeLenses ''Creature +instance HasVisionRadius Creature where + visionRadius = const 50 -- TODO + +instance Brain Creature where + step = brainVia GormlakBrain + entityCanMove = const True + +instance Entity Creature where + blocksVision _ = False + description = view $ creatureType . Raw.description + entityChar = view $ creatureType . char -------------------------------------------------------------------------------- @@ -109,7 +86,4 @@ damage amount = hitpoints %~ \hp -> isDead :: Creature -> Bool isDead = views hitpoints (== 0) -visionRadius :: Creature -> Word -visionRadius = const 50 -- TODO - {-# ANN module ("Hlint: ignore Use newtype instead of data" :: String) #-} diff --git a/src/Xanthous/Entities/Creature.hs-boot b/src/Xanthous/Entities/Creature.hs-boot new file mode 100644 index 0000000000..4c930d2642 --- /dev/null +++ b/src/Xanthous/Entities/Creature.hs-boot @@ -0,0 +1,2 @@ +module Xanthous.Entities.Creature where +data Creature diff --git a/src/Xanthous/Entities/Creature/Hippocampus.hs b/src/Xanthous/Entities/Creature/Hippocampus.hs new file mode 100644 index 0000000000..501a5b5972 --- /dev/null +++ b/src/Xanthous/Entities/Creature/Hippocampus.hs @@ -0,0 +1,64 @@ +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE TemplateHaskell #-} +-------------------------------------------------------------------------------- +module Xanthous.Entities.Creature.Hippocampus + (-- * Hippocampus + Hippocampus(..) + , initialHippocampus + -- ** Lenses + , destination + -- ** Destination + , Destination(..) + , destinationFromPos + -- *** Lenses + , destinationPosition + , destinationProgress + ) +where +-------------------------------------------------------------------------------- +import Xanthous.Prelude +-------------------------------------------------------------------------------- +import Data.Aeson.Generic.DerivingVia +import Data.Aeson (ToJSON, FromJSON) +import Test.QuickCheck +import Test.QuickCheck.Arbitrary.Generic +-------------------------------------------------------------------------------- +import Xanthous.Data +import Xanthous.Util.QuickCheck +-------------------------------------------------------------------------------- + + +data Destination = Destination + { _destinationPosition :: !Position + -- | The progress towards the destination, tracked as an offset from the + -- creature's original position. + -- + -- When this value reaches >= 1, the creature has reached their destination + , _destinationProgress :: !Tiles + } + deriving stock (Eq, Show, Ord, Generic) + deriving anyclass (NFData, CoArbitrary, Function) + deriving (ToJSON, FromJSON) + via WithOptions '[ FieldLabelModifier '[Drop 1] ] + Destination +instance Arbitrary Destination where arbitrary = genericArbitrary +makeLenses ''Destination + +destinationFromPos :: Position -> Destination +destinationFromPos _destinationPosition = + let _destinationProgress = 0 + in Destination{..} + +data Hippocampus = Hippocampus + { _destination :: !(Maybe Destination) + } + deriving stock (Eq, Show, Ord, Generic) + deriving anyclass (NFData, CoArbitrary, Function) + deriving Arbitrary via GenericArbitrary Hippocampus + deriving (ToJSON, FromJSON) + via WithOptions '[ FieldLabelModifier '[Drop 1] ] + Hippocampus +makeLenses ''Hippocampus + +initialHippocampus :: Hippocampus +initialHippocampus = Hippocampus Nothing diff --git a/src/Xanthous/Entities/Entities.hs b/src/Xanthous/Entities/Entities.hs index 802aecddeb..8793565a2a 100644 --- a/src/Xanthous/Entities/Entities.hs +++ b/src/Xanthous/Entities/Entities.hs @@ -14,7 +14,6 @@ import Xanthous.Entities.Item import Xanthous.Entities.Creature import Xanthous.Entities.Environment import Xanthous.Game.State -import {-# SOURCE #-} Xanthous.AI.Gormlak () import Xanthous.Util.QuickCheck import Data.Aeson.Generic.DerivingVia -------------------------------------------------------------------------------- diff --git a/src/Xanthous/Entities/Entities.hs-boot b/src/Xanthous/Entities/Entities.hs-boot new file mode 100644 index 0000000000..519a862c6a --- /dev/null +++ b/src/Xanthous/Entities/Entities.hs-boot @@ -0,0 +1,14 @@ +{-# OPTIONS_GHC -fno-warn-orphans #-} +module Xanthous.Entities.Entities where + +import Test.QuickCheck +import Data.Aeson +import Xanthous.Game.State (SomeEntity, GameState, Entity) + +instance Arbitrary SomeEntity +instance Function SomeEntity +instance CoArbitrary SomeEntity +instance FromJSON SomeEntity +instance Entity SomeEntity + +instance FromJSON GameState diff --git a/src/Xanthous/Game/Lenses.hs b/src/Xanthous/Game/Lenses.hs index 4a080f85f0..580435a068 100644 --- a/src/Xanthous/Game/Lenses.hs +++ b/src/Xanthous/Game/Lenses.hs @@ -27,9 +27,9 @@ import qualified Xanthous.Data.EntityMap as EntityMap import Xanthous.Data.EntityMap.Graphics (visiblePositions) import Xanthous.Entities.Character (Character, mkCharacter) import Xanthous.Entities.Environment (Door, open, GroundMessage) -import Xanthous.Entities.Item (Item) -import Xanthous.Entities.Creature (Creature) -import Xanthous.Entities.Entities () +import Xanthous.Entities.Item (Item) +import {-# SOURCE #-} Xanthous.Entities.Creature (Creature) +import {-# SOURCE #-} Xanthous.Entities.Entities () -------------------------------------------------------------------------------- getInitialState :: IO GameState diff --git a/xanthous.cabal b/xanthous.cabal index f173b1a114..090739c289 100644 --- a/xanthous.cabal +++ b/xanthous.cabal @@ -4,7 +4,7 @@ cabal-version: 1.12 -- -- see: https://github.com/sol/hpack -- --- hash: a4f6c2c91e3c94c81de5d6b27201cb22e7f9f9c5d8a4f14beec63c1540d01ca1 +-- hash: 36af39a9e3b4e97923c1b363d7d84e2c99f126efd908778d0d048d0c472f2723 name: xanthous version: 0.1.0.0 @@ -40,6 +40,7 @@ library Xanthous.Data.VectorBag Xanthous.Entities.Character Xanthous.Entities.Creature + Xanthous.Entities.Creature.Hippocampus Xanthous.Entities.Draw.Util Xanthous.Entities.Entities Xanthous.Entities.Environment @@ -141,6 +142,7 @@ executable xanthous Xanthous.Data.VectorBag Xanthous.Entities.Character Xanthous.Entities.Creature + Xanthous.Entities.Creature.Hippocampus Xanthous.Entities.Draw.Util Xanthous.Entities.Entities Xanthous.Entities.Environment -- cgit 1.4.1 From 84f32efad4ff6d358fdeb985b3b4ac408e753b78 Mon Sep 17 00:00:00 2001 From: Griffin Smith Date: Fri, 3 Jan 2020 18:28:43 -0500 Subject: Track entity collision in the Entity class Rather than having a single function in the Game.Lenses module for determining what collision type if any an entity has, track it in the Entity typeclass itself. This is both more extensible and a better separation of concerns and gets rid of one of the two needs for a circular import. Yay! As part of this, I realized nothing was being done to prevent doors from being placed on tiles that already had walls (since now that was properly causing a collision!) so I've fixed that as well. --- src/Xanthous/AI/Gormlak.hs | 4 ++-- src/Xanthous/Entities/Creature.hs | 1 + src/Xanthous/Entities/Creature.hs-boot | 2 -- src/Xanthous/Entities/Entities.hs | 1 + src/Xanthous/Entities/Environment.hs | 12 ++++++---- src/Xanthous/Entities/Item.hs | 1 + src/Xanthous/Game/Lenses.hs | 39 ++++++++++---------------------- src/Xanthous/Game/State.hs | 10 ++++++++ src/Xanthous/Generators/LevelContents.hs | 2 ++ 9 files changed, 37 insertions(+), 35 deletions(-) delete mode 100644 src/Xanthous/Entities/Creature.hs-boot diff --git a/src/Xanthous/AI/Gormlak.hs b/src/Xanthous/AI/Gormlak.hs index 031262533d..8040fea35b 100644 --- a/src/Xanthous/AI/Gormlak.hs +++ b/src/Xanthous/AI/Gormlak.hs @@ -27,7 +27,7 @@ import qualified Xanthous.Entities.RawTypes as Raw import Xanthous.Entities.RawTypes (CreatureType) import Xanthous.Game.State import Xanthous.Game.Lenses - ( Collision(..), entityCollision, collisionAt + ( Collision(..), entitiesCollision, collisionAt , character, characterPosition ) import Xanthous.Data.EntityMap.Graphics (linesOfSight, canSee) @@ -90,7 +90,7 @@ stepGormlak ticks pe@(Positioned pos creature) = do then attackCharacter $> pos' else pure $ pos' `stepTowards` charPos else do - lines <- map (takeWhile (isNothing . entityCollision . map snd . snd) + lines <- map (takeWhile (isNothing . entitiesCollision . map snd . snd) -- the first item on these lines is always the creature itself . fromMaybe mempty . tailMay) . linesOfSight pos' (visionRadius creature') diff --git a/src/Xanthous/Entities/Creature.hs b/src/Xanthous/Entities/Creature.hs index 6e955324a0..a44b3b2281 100644 --- a/src/Xanthous/Entities/Creature.hs +++ b/src/Xanthous/Entities/Creature.hs @@ -68,6 +68,7 @@ instance Entity Creature where blocksVision _ = False description = view $ creatureType . Raw.description entityChar = view $ creatureType . char + entityCollision = const $ Just Combat -------------------------------------------------------------------------------- diff --git a/src/Xanthous/Entities/Creature.hs-boot b/src/Xanthous/Entities/Creature.hs-boot deleted file mode 100644 index 4c930d2642..0000000000 --- a/src/Xanthous/Entities/Creature.hs-boot +++ /dev/null @@ -1,2 +0,0 @@ -module Xanthous.Entities.Creature where -data Creature diff --git a/src/Xanthous/Entities/Entities.hs b/src/Xanthous/Entities/Entities.hs index 8793565a2a..1e533a2973 100644 --- a/src/Xanthous/Entities/Entities.hs +++ b/src/Xanthous/Entities/Entities.hs @@ -47,6 +47,7 @@ instance Entity SomeEntity where blocksVision (SomeEntity ent) = blocksVision ent description (SomeEntity ent) = description ent entityChar (SomeEntity ent) = entityChar ent + entityCollision (SomeEntity ent) = entityCollision ent instance Function SomeEntity where function = functionJSON diff --git a/src/Xanthous/Entities/Environment.hs b/src/Xanthous/Entities/Environment.hs index 46416d1da5..dee8d83c32 100644 --- a/src/Xanthous/Entities/Environment.hs +++ b/src/Xanthous/Entities/Environment.hs @@ -91,6 +91,8 @@ instance Entity Door where description door | door ^. open = "an open door" | otherwise = "a closed door" entityChar _ = "d" + entityCollision door | door ^. open = Nothing + | otherwise = Just Stop -- | A closed, unlocked door unlockedDoor :: Door @@ -113,8 +115,10 @@ newtype GroundMessage = GroundMessage Text deriving Draw via DrawStyledCharacter ('Just 'Yellow) 'Nothing "≈" GroundMessage - deriving Entity - via DeriveEntity 'False "a message on the ground. Press r. to read it." - "≈" - GroundMessage instance Brain GroundMessage where step = brainVia Brainless + +instance Entity GroundMessage where + blocksVision = const False + description = const "a message on the ground. Press r. to read it." + entityChar = const "≈" + entityCollision = const Nothing diff --git a/src/Xanthous/Entities/Item.hs b/src/Xanthous/Entities/Item.hs index 0156cd54c8..cedd75507a 100644 --- a/src/Xanthous/Entities/Item.hs +++ b/src/Xanthous/Entities/Item.hs @@ -41,6 +41,7 @@ instance Entity Item where blocksVision _ = False description = view $ itemType . Raw.description entityChar = view $ itemType . Raw.char + entityCollision = const Nothing newWithType :: ItemType -> Item newWithType = Item diff --git a/src/Xanthous/Game/Lenses.hs b/src/Xanthous/Game/Lenses.hs index 580435a068..f7f4648dd5 100644 --- a/src/Xanthous/Game/Lenses.hs +++ b/src/Xanthous/Game/Lenses.hs @@ -1,4 +1,6 @@ {-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE QuantifiedConstraints #-} +{-# LANGUAGE AllowAmbiguousTypes #-} -------------------------------------------------------------------------------- module Xanthous.Game.Lenses ( positionedCharacter @@ -11,7 +13,7 @@ module Xanthous.Game.Lenses -- * Collisions , Collision(..) - , entityCollision + , entitiesCollision , collisionAt ) where -------------------------------------------------------------------------------- @@ -26,9 +28,6 @@ import Xanthous.Data import qualified Xanthous.Data.EntityMap as EntityMap import Xanthous.Data.EntityMap.Graphics (visiblePositions) import Xanthous.Entities.Character (Character, mkCharacter) -import Xanthous.Entities.Environment (Door, open, GroundMessage) -import Xanthous.Entities.Item (Item) -import {-# SOURCE #-} Xanthous.Entities.Creature (Creature) import {-# SOURCE #-} Xanthous.Entities.Entities () -------------------------------------------------------------------------------- @@ -96,31 +95,17 @@ characterVisiblePositions game = let charPos = game ^. characterPosition in visiblePositions charPos visionRadius $ game ^. entities -data Collision - = Stop - | Combat - deriving stock (Show, Eq, Ord, Generic) - deriving anyclass (NFData) - -entityCollision - :: ( MonoFoldable (f SomeEntity) - , Foldable f - , Element (f SomeEntity) ~ SomeEntity - , AsEmpty (f SomeEntity) +entitiesCollision + :: ( Functor f + , forall xx. MonoFoldable (f xx) + , forall xx. Element (f xx) ~ xx + , Element (f (Maybe Collision)) ~ Maybe Collision + , Show (f (Maybe Collision)) + , Show (f SomeEntity) ) => f SomeEntity -> Maybe Collision -entityCollision Empty = Nothing -entityCollision ents - -- TODO track entity collision in the Entity class - | any (entityIs @Creature) ents = pure Combat - | all (\e -> - entityIs @Item e - || entityIs @GroundMessage e - ) ents = Nothing - | doors@(_ : _) <- ents ^.. folded . _SomeEntity @Door - , all (view open) doors = Nothing - | otherwise = pure Stop +entitiesCollision = join . maximumMay . fmap entityCollision collisionAt :: MonadState GameState m => Position -> m (Maybe Collision) -collisionAt pos = uses (entities . EntityMap.atPosition pos) entityCollision +collisionAt pos = uses (entities . EntityMap.atPosition pos) entitiesCollision diff --git a/src/Xanthous/Game/State.hs b/src/Xanthous/Game/State.hs index 853d0b6922..171f381e6b 100644 --- a/src/Xanthous/Game/State.hs +++ b/src/Xanthous/Game/State.hs @@ -34,6 +34,7 @@ module Xanthous.Game.State , Brain(..) , Brainless(..) , brainVia + , Collision(..) , Entity(..) , SomeEntity(..) , downcastEntity @@ -306,6 +307,13 @@ brainVia _ ticks = fmap coerce . step ticks . coerce @_ @(Positioned brain) -------------------------------------------------------------------------------- + +data Collision + = Stop -- ^ Can't move through this + | Combat -- ^ Moving into this equates to hitting it with a stick + deriving stock (Show, Eq, Ord, Generic) + deriving anyclass (NFData) + class ( Show a, Eq a, Ord a, NFData a , ToJSON a, FromJSON a , Draw a, Brain a @@ -313,6 +321,8 @@ class ( Show a, Eq a, Ord a, NFData a blocksVision :: a -> Bool description :: a -> Text entityChar :: a -> EntityChar + entityCollision :: a -> Maybe Collision + entityCollision = const $ Just Stop data SomeEntity where SomeEntity :: forall a. (Entity a, Typeable a) => a -> SomeEntity diff --git a/src/Xanthous/Generators/LevelContents.hs b/src/Xanthous/Generators/LevelContents.hs index aaeb4a77fd..96d64a6937 100644 --- a/src/Xanthous/Generators/LevelContents.hs +++ b/src/Xanthous/Generators/LevelContents.hs @@ -45,6 +45,8 @@ randomDoors cells = do candidateCells = filter doorable $ Arr.indices cells subsetRange = (0.8 :: Double, 1.0) doorable (x, y) = + not (fromMaybe True $ cells ^? ix (x, y)) + && ( fromMaybe True $ cells ^? ix (x - 1, y) -- left , fromMaybe True $ cells ^? ix (x, y - 1) -- top , fromMaybe True $ cells ^? ix (x + 1, y) -- right -- cgit 1.4.1 From e669b54f0c9be84dd1e4704ccae4b8169f7458a5 Mon Sep 17 00:00:00 2001 From: Griffin Smith Date: Fri, 3 Jan 2020 18:30:33 -0500 Subject: Pin to a specific version of all-hies Fewer cache busts, plus makes updating versions easier --- default.nix | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/default.nix b/default.nix index a341398509..263e04beac 100644 --- a/default.nix +++ b/default.nix @@ -5,7 +5,7 @@ let inherit (nixpkgs) pkgs lib; inherit (lib) id; - all-hies = import (fetchTarball "https://github.com/infinisil/all-hies/tarball/master") {}; + all-hies = import (fetchTarball "https://github.com/infinisil/all-hies/tarball/c6e93d2d641ef48703eabed8ec5cde3d774cb0e5") {}; hie = all-hies.selection { selector = p: { inherit (p) ghc865; }; }; xanthous = (if failOnWarnings then pkgs.haskell.lib.failOnAllWarnings else id) -- cgit 1.4.1 From 6b0bab0e85266ce66836c4584f8cc83b307a3af5 Mon Sep 17 00:00:00 2001 From: Griffin Smith Date: Sat, 4 Jan 2020 23:48:51 -0500 Subject: Add support for multiple levels Add a data structure, based on the zipper comonad, which provides support for multiple levels, each of which is its own entity map. The current level is provided by coreturn, which the `entities` lens has been updated to use. Nothing currently supports going up or down levels yet - that's coming next. --- build/update-comonad-extras.patch | 92 +++++++++++++++++++++ haskell-overlay.nix | 3 + package.yaml | 3 + src/Xanthous/Data/Levels.hs | 170 ++++++++++++++++++++++++++++++++++++++ src/Xanthous/Game/Arbitrary.hs | 18 ++-- src/Xanthous/Game/Lenses.hs | 6 +- src/Xanthous/Game/State.hs | 12 ++- src/Xanthous/Util/Comonad.hs | 24 ++++++ test/Spec.hs | 7 +- test/Xanthous/Data/LevelsSpec.hs | 60 ++++++++++++++ xanthous.cabal | 16 +++- 11 files changed, 397 insertions(+), 14 deletions(-) create mode 100644 build/update-comonad-extras.patch create mode 100644 src/Xanthous/Data/Levels.hs create mode 100644 src/Xanthous/Util/Comonad.hs create mode 100644 test/Xanthous/Data/LevelsSpec.hs diff --git a/build/update-comonad-extras.patch b/build/update-comonad-extras.patch new file mode 100644 index 0000000000..cd1dbe24d3 --- /dev/null +++ b/build/update-comonad-extras.patch @@ -0,0 +1,92 @@ +diff --git a/comonad-extras.cabal b/comonad-extras.cabal +index fc3745a..77a2f0d 100644 +--- a/comonad-extras.cabal ++++ b/comonad-extras.cabal +@@ -1,7 +1,7 @@ + name: comonad-extras + category: Control, Comonads +-version: 4.0 ++version: 5.0 + x-revision: 1 + license: BSD3 + cabal-version: >= 1.6 + license-file: LICENSE +@@ -34,8 +34,8 @@ library + build-depends: + array >= 0.3 && < 0.6, +- base >= 4 && < 4.7, +- containers >= 0.4 && < 0.6, +- comonad >= 4 && < 5, ++ base >= 4 && < 5, ++ containers >= 0.6 && < 0.7, ++ comonad >= 5 && < 6, + distributive >= 0.3.2 && < 1, +- semigroupoids >= 4 && < 5, +- transformers >= 0.2 && < 0.4 ++ semigroupoids >= 5 && < 6, ++ transformers >= 0.5 && < 0.6 + + exposed-modules: + Control.Comonad.Store.Zipper +diff --git a/src/Control/Comonad/Store/Pointer.hs b/src/Control/Comonad/Store/Pointer.hs +index 5044a1e..8d4c62d 100644 +--- a/src/Control/Comonad/Store/Pointer.hs ++++ b/src/Control/Comonad/Store/Pointer.hs +@@ -41,7 +41,6 @@ module Control.Comonad.Store.Pointer + , module Control.Comonad.Store.Class + ) where + +-import Control.Applicative + import Control.Comonad + import Control.Comonad.Hoist.Class + import Control.Comonad.Trans.Class +@@ -51,27 +50,8 @@ import Control.Comonad.Env.Class + import Data.Functor.Identity + import Data.Functor.Extend + import Data.Array +- + #ifdef __GLASGOW_HASKELL__ + import Data.Typeable +-instance (Typeable i, Typeable1 w) => Typeable1 (PointerT i w) where +- typeOf1 diwa = mkTyConApp storeTTyCon [typeOf (i diwa), typeOf1 (w diwa)] +- where +- i :: PointerT i w a -> i +- i = undefined +- w :: PointerT i w a -> w a +- w = undefined +- +-instance (Typeable i, Typeable1 w, Typeable a) => Typeable (PointerT i w a) where +- typeOf = typeOfDefault +- +-storeTTyCon :: TyCon +-#if __GLASGOW_HASKELL__ < 704 +-storeTTyCon = mkTyCon "Control.Comonad.Trans.Store.Pointer.PointerT" +-#else +-storeTTyCon = mkTyCon3 "comonad-extras" "Control.Comonad.Trans.Store.Pointer" "PointerT" +-#endif +-{-# NOINLINE storeTTyCon #-} + #endif + + type Pointer i = PointerT i Identity +@@ -83,6 +63,9 @@ runPointer :: Pointer i a -> (Array i a, i) + runPointer (PointerT (Identity f) i) = (f, i) + + data PointerT i w a = PointerT (w (Array i a)) i ++#ifdef __GLASGOW_HASKELL__ ++ deriving Typeable ++#endif + + runPointerT :: PointerT i w a -> (w (Array i a), i) + runPointerT (PointerT g i) = (g, i) +diff --git a/src/Control/Comonad/Store/Zipper.hs b/src/Control/Comonad/Store/Zipper.hs +index 3b70c86..decc378 100644 +--- a/src/Control/Comonad/Store/Zipper.hs ++++ b/src/Control/Comonad/Store/Zipper.hs +@@ -15,7 +15,6 @@ + module Control.Comonad.Store.Zipper + ( Zipper, zipper, zipper1, unzipper, size) where + +-import Control.Applicative + import Control.Comonad (Comonad(..)) + import Data.Functor.Extend + import Data.Foldable diff --git a/haskell-overlay.nix b/haskell-overlay.nix index d3775316ad..fff1c21741 100644 --- a/haskell-overlay.nix +++ b/haskell-overlay.nix @@ -29,4 +29,7 @@ in self: super: with pkgs.haskell.lib; rec { }; version = "0.12.0"; }; + + comonad-extras = appendPatch (markUnbroken super.comonad-extras) + [ ./build/update-comonad-extras.patch ]; } diff --git a/package.yaml b/package.yaml index 8d761b58e0..d639e555c7 100644 --- a/package.yaml +++ b/package.yaml @@ -26,6 +26,7 @@ dependencies: - checkers - classy-prelude - comonad +- comonad-extras - constraints - containers - data-default @@ -48,6 +49,7 @@ dependencies: - MonadRandom - mtl - optparse-applicative +- pointed - random - random-fu - random-extras @@ -59,6 +61,7 @@ dependencies: - stache - semigroupoids - tomland +- text - text-zipper - vector - vty diff --git a/src/Xanthous/Data/Levels.hs b/src/Xanthous/Data/Levels.hs new file mode 100644 index 0000000000..bc5eff9bad --- /dev/null +++ b/src/Xanthous/Data/Levels.hs @@ -0,0 +1,170 @@ +{-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE TemplateHaskell #-} +-------------------------------------------------------------------------------- +module Xanthous.Data.Levels + ( Levels + , allLevels + , nextLevel + , prevLevel + , mkLevels1 + , mkLevels + , oneLevel + , current + , ComonadStore(..) + ) where +-------------------------------------------------------------------------------- +import Xanthous.Prelude hiding ((<.>), Empty, foldMap, levels) +import Xanthous.Util (between, EqProp, EqEqProp(..)) +import Xanthous.Util.Comonad (current) +import Xanthous.Orphans () +-------------------------------------------------------------------------------- +import Control.Comonad.Store +import Control.Comonad.Store.Zipper +import Data.Aeson (ToJSON(..), FromJSON(..)) +import Data.Aeson.Generic.DerivingVia +import Data.Functor.Apply +import Data.Foldable (foldMap) +import Data.List.NonEmpty (NonEmpty) +import qualified Data.List.NonEmpty as NE +import Data.Maybe (fromJust) +import Data.Sequence (Seq((:<|), Empty)) +import Data.Semigroup.Foldable.Class +import Data.Text (replace) +import Test.QuickCheck +-------------------------------------------------------------------------------- + +-- | Collection of levels plus a pointer to the current level +-- +-- Navigation is via the 'Comonad' instance. We can get the current level with +-- 'extract': +-- +-- extract @Levels :: Levels level -> level +-- +-- For access to and modification of the level, use +-- 'Xanthous.Util.Comonad.current' +newtype Levels a = Levels { levelZipper :: Zipper Seq a } + deriving stock (Generic) + deriving (Functor, Comonad, Foldable) via (Zipper Seq) + deriving (ComonadStore Int) via (Zipper Seq) + +type instance Element (Levels a) = a +instance MonoFoldable (Levels a) +instance MonoFunctor (Levels a) +instance MonoTraversable (Levels a) + +instance Traversable Levels where + traverse f (Levels z) = Levels <$> traverse f z + +instance Foldable1 Levels + +instance Traversable1 Levels where + traverse1 f (Levels z) = seek (pos z) . partialMkLevels <$> go (unzipper z) + where + go Empty = error "empty seq, unreachable" + go (x :<| xs) = (<|) <$> f x <.> go xs + +-- | Always takes the position of the latter element +instance Semigroup (Levels a) where + levs₁ <> levs₂ + = seek (pos levs₂) + . partialMkLevels + $ allLevels levs₁ <> allLevels levs₂ + +-- | Make Levels from a Seq. Throws an error if the seq is not empty +partialMkLevels :: Seq a -> Levels a +partialMkLevels = Levels . fromJust . zipper + +-- | Make Levels from a possibly-empty structure +mkLevels :: Foldable1 f => f level -> Maybe (Levels level) +mkLevels = fmap Levels . zipper . foldMap pure + +-- | Make Levels from a non-empty structure +mkLevels1 :: Foldable1 f => f level -> Levels level +mkLevels1 = fromJust . mkLevels + +oneLevel :: a -> Levels a +oneLevel = mkLevels1 . Identity + +-- | Get a sequence of all the levels +allLevels :: Levels a -> Seq a +allLevels = unzipper . levelZipper + +-- | Step to the next level, generating a new level if necessary using the given +-- applicative action +nextLevel + :: Applicative m + => m level -- ^ Generate a new level, if necessary + -> Levels level + -> m (Levels level) +nextLevel genLevel levs + | pos levs + 1 < size (levelZipper levs) + = pure $ seeks succ levs + | otherwise + = genLevel <&> \level -> + seek (pos levs + 1) . partialMkLevels $ level <| allLevels levs + +-- | Go to the previous level. Returns Nothing if 'pos' is 0 +prevLevel :: Levels level -> Maybe (Levels level) +prevLevel levs | pos levs == 0 = Nothing + | otherwise = Just $ seeks pred levs + +-------------------------------------------------------------------------------- + +-- | alternate, slower representation of Levels we can Iso into to perform +-- various operations +data AltLevels a = AltLevels + { _levels :: NonEmpty a + , _currentLevel :: Int -- ^ invariant: is within the bounds of _levels + } + deriving stock (Show, Eq, Generic) + deriving anyclass (NFData, CoArbitrary, Function) + deriving (ToJSON, FromJSON) + via WithOptions '[ FieldLabelModifier '[Drop 1] ] + (AltLevels a) +makeLenses ''AltLevels + +alt :: Iso (Levels a) (Levels b) (AltLevels a) (AltLevels b) +alt = iso hither yon + where + hither levs = AltLevels (NE.fromList . toList $ allLevels levs) (pos levs) + yon (AltLevels levs curr) = seek curr $ mkLevels1 levs + +instance Eq a => Eq (Levels a) where + (==) = (==) `on` view alt + +deriving via EqEqProp (Levels a) instance Eq a => EqProp (Levels a) + +instance Show a => Show (Levels a) where + show = unpack . replace "AltLevels" "Levels" . pack . show . view alt + +instance NFData a => NFData (Levels a) where + rnf = rnf . view alt + +instance ToJSON a => ToJSON (Levels a) where + toJSON = toJSON . view alt + +instance FromJSON a => FromJSON (Levels a) where + parseJSON = fmap (review alt) . parseJSON + +instance Arbitrary a => Arbitrary (AltLevels a) where + arbitrary = do + _levels <- arbitrary + _currentLevel <- choose (0, length _levels - 1) + pure AltLevels {..} + shrink als = do + _levels <- shrink $ als ^. levels + _currentLevel <- filter (between 0 $ length _levels - 1) + $ shrink $ als ^. currentLevel + pure AltLevels {..} + + +instance Arbitrary a => Arbitrary (Levels a) where + arbitrary = review alt <$> arbitrary + shrink = fmap (review alt) . shrink . view alt + +instance CoArbitrary a => CoArbitrary (Levels a) where + coarbitrary = coarbitrary . view alt + +instance Function a => Function (Levels a) where + function = functionMap (view alt) (review alt) diff --git a/src/Xanthous/Game/Arbitrary.hs b/src/Xanthous/Game/Arbitrary.hs index a4e0255ca8..3be711099c 100644 --- a/src/Xanthous/Game/Arbitrary.hs +++ b/src/Xanthous/Game/Arbitrary.hs @@ -5,15 +5,17 @@ -------------------------------------------------------------------------------- module Xanthous.Game.Arbitrary where -------------------------------------------------------------------------------- -import Xanthous.Prelude +import Xanthous.Prelude hiding (levels, foldMap) -------------------------------------------------------------------------------- import Test.QuickCheck import System.Random +import Data.Foldable (foldMap) -------------------------------------------------------------------------------- -import Xanthous.Game.State +import Xanthous.Data.Levels +import qualified Xanthous.Data.EntityMap as EntityMap import Xanthous.Entities.Entities () import Xanthous.Entities.Character -import qualified Xanthous.Data.EntityMap as EntityMap +import Xanthous.Game.State -------------------------------------------------------------------------------- instance Arbitrary GameState where @@ -21,9 +23,13 @@ instance Arbitrary GameState where chr <- arbitrary @Character charPos <- arbitrary _messageHistory <- arbitrary - (_characterEntityID, _entities) <- arbitrary <&> - EntityMap.insertAtReturningID charPos (SomeEntity chr) - _revealedPositions <- fmap setFromList . sublistOf $ EntityMap.positions _entities + levels <- arbitrary + let (_characterEntityID, currentLevel) = + EntityMap.insertAtReturningID charPos (SomeEntity chr) + $ extract levels + _levels = levels & current .~ currentLevel + _revealedPositions <- fmap setFromList . sublistOf + $ foldMap EntityMap.positions levels _randomGen <- mkStdGen <$> arbitrary let _promptState = NoPrompt -- TODO _activePanel <- arbitrary diff --git a/src/Xanthous/Game/Lenses.hs b/src/Xanthous/Game/Lenses.hs index f7f4648dd5..010fcb7022 100644 --- a/src/Xanthous/Game/Lenses.hs +++ b/src/Xanthous/Game/Lenses.hs @@ -25,6 +25,7 @@ import Control.Monad.Random (getRandom) -------------------------------------------------------------------------------- import Xanthous.Game.State import Xanthous.Data +import Xanthous.Data.Levels import qualified Xanthous.Data.EntityMap as EntityMap import Xanthous.Data.EntityMap.Graphics (visiblePositions) import Xanthous.Entities.Character (Character, mkCharacter) @@ -38,11 +39,12 @@ initialStateFromSeed :: Int -> GameState initialStateFromSeed seed = let _randomGen = mkStdGen seed chr = mkCharacter - (_characterEntityID, _entities) + (_characterEntityID, level) = EntityMap.insertAtReturningID (Position 0 0) (SomeEntity chr) mempty + _levels = oneLevel level _messageHistory = mempty _revealedPositions = mempty _promptState = NoPrompt @@ -108,4 +110,4 @@ entitiesCollision entitiesCollision = join . maximumMay . fmap entityCollision collisionAt :: MonadState GameState m => Position -> m (Maybe Collision) -collisionAt pos = uses (entities . EntityMap.atPosition pos) entitiesCollision +collisionAt p = uses (entities . EntityMap.atPosition p) entitiesCollision diff --git a/src/Xanthous/Game/State.hs b/src/Xanthous/Game/State.hs index 171f381e6b..7587618c96 100644 --- a/src/Xanthous/Game/State.hs +++ b/src/Xanthous/Game/State.hs @@ -58,7 +58,7 @@ module Xanthous.Game.State , allRevealed ) where -------------------------------------------------------------------------------- -import Xanthous.Prelude +import Xanthous.Prelude hiding (levels) -------------------------------------------------------------------------------- import Data.List.NonEmpty ( NonEmpty((:|))) import qualified Data.List.NonEmpty as NonEmpty @@ -80,6 +80,7 @@ import qualified Graphics.Vty.Image as Vty -------------------------------------------------------------------------------- import Xanthous.Util (KnownBool(..)) import Xanthous.Data +import Xanthous.Data.Levels import Xanthous.Data.EntityMap (EntityMap, EntityID) import Xanthous.Data.EntityChar import Xanthous.Data.VectorBag @@ -359,8 +360,8 @@ instance Draw SomeEntity where drawPriority (SomeEntity ent) = drawPriority ent instance Brain SomeEntity where - step ticks (Positioned pos (SomeEntity ent)) = - fmap SomeEntity <$> step ticks (Positioned pos ent) + step ticks (Positioned p (SomeEntity ent)) = + fmap SomeEntity <$> step ticks (Positioned p ent) downcastEntity :: forall (a :: Type). (Typeable a) => SomeEntity -> Maybe a downcastEntity (SomeEntity e) = cast e @@ -413,7 +414,7 @@ instance Arbitrary DebugState where arbitrary = genericArbitrary data GameState = GameState - { _entities :: !(EntityMap SomeEntity) + { _levels :: !(Levels (EntityMap SomeEntity)) , _revealedPositions :: !(Set Position) , _characterEntityID :: !EntityID , _messageHistory :: !MessageHistory @@ -433,6 +434,9 @@ data GameState = GameState GameState makeLenses ''GameState +entities :: Lens' GameState (EntityMap SomeEntity) +entities = levels . current + instance Eq GameState where (==) = (==) `on` \gs -> ( gs ^. entities diff --git a/src/Xanthous/Util/Comonad.hs b/src/Xanthous/Util/Comonad.hs new file mode 100644 index 0000000000..9e158cc8e2 --- /dev/null +++ b/src/Xanthous/Util/Comonad.hs @@ -0,0 +1,24 @@ +-------------------------------------------------------------------------------- +module Xanthous.Util.Comonad + ( -- * Store comonad utils + replace + , current + ) where +-------------------------------------------------------------------------------- +import Xanthous.Prelude +-------------------------------------------------------------------------------- +import Control.Comonad.Store.Class +-------------------------------------------------------------------------------- + +-- | Replace the current position of a store comonad with a new value by +-- comparing positions +replace :: (Eq i, ComonadStore i w) => w a -> a -> w a +replace w x = w =>> \w' -> if pos w' == pos w then x else extract w' +{-# INLINE replace #-} + +-- | Lens into the current position of a store comonad. +-- +-- current = lens extract replace +current :: (Eq i, ComonadStore i w) => Lens' (w a) a +current = lens extract replace +{-# INLINE current #-} diff --git a/test/Spec.hs b/test/Spec.hs index 8141b83e97..ba8f868a81 100644 --- a/test/Spec.hs +++ b/test/Spec.hs @@ -1,7 +1,10 @@ -import Test.Prelude +-------------------------------------------------------------------------------- +import Test.Prelude +-------------------------------------------------------------------------------- import qualified Xanthous.Data.EntityCharSpec import qualified Xanthous.Data.EntityMapSpec import qualified Xanthous.Data.EntityMap.GraphicsSpec +import qualified Xanthous.Data.LevelsSpec import qualified Xanthous.DataSpec import qualified Xanthous.Entities.RawsSpec import qualified Xanthous.GameSpec @@ -12,6 +15,7 @@ import qualified Xanthous.Util.GraphicsSpec import qualified Xanthous.Util.GraphSpec import qualified Xanthous.Util.InflectionSpec import qualified Xanthous.UtilSpec +-------------------------------------------------------------------------------- main :: IO () main = defaultMain test @@ -21,6 +25,7 @@ test = testGroup "Xanthous" [ Xanthous.Data.EntityCharSpec.test , Xanthous.Data.EntityMapSpec.test , Xanthous.Data.EntityMap.GraphicsSpec.test + , Xanthous.Data.LevelsSpec.test , Xanthous.Entities.RawsSpec.test , Xanthous.GameSpec.test , Xanthous.Generators.UtilSpec.test diff --git a/test/Xanthous/Data/LevelsSpec.hs b/test/Xanthous/Data/LevelsSpec.hs new file mode 100644 index 0000000000..eb74253903 --- /dev/null +++ b/test/Xanthous/Data/LevelsSpec.hs @@ -0,0 +1,60 @@ +-------------------------------------------------------------------------------- +module Xanthous.Data.LevelsSpec (main, test) where +-------------------------------------------------------------------------------- +import Test.Prelude hiding (levels) +-------------------------------------------------------------------------------- +import qualified Data.Aeson as JSON +-------------------------------------------------------------------------------- +import Xanthous.Util (between) +import Xanthous.Data.Levels +-------------------------------------------------------------------------------- + +main :: IO () +main = defaultMain test + +test :: TestTree +test = testGroup "Xanthous.Data.Levels" + [ testGroup "current" + [ testProperty "view is extract" $ \(levels :: Levels Int) -> + levels ^. current === extract levels + , testProperty "set replaces current" $ \(levels :: Levels Int) new -> + extract (set current new levels) === new + , testProperty "set extract is id" $ \(levels :: Levels Int) -> + set current (extract levels) levels === levels + , testProperty "set y ∘ set x ≡ set y" $ \(levels :: Levels Int) x y -> + set current y (set current x levels) === set current y levels + ] + , localOption (QuickCheckTests 20) + $ testBatch $ semigroup @(Levels Int) (error "unused", 1 :: Int) + , testGroup "next/prev" + [ testGroup "nextLevel" + [ testProperty "seeks forwards" $ \(levels :: Levels Int) genned -> + (pos . runIdentity . nextLevel (Identity genned) $ levels) + === pos levels + 1 + , testProperty "maintains the invariant" $ \(levels :: Levels Int) genned -> + let levels' = runIdentity . nextLevel (Identity genned) $ levels + in between 0 (length levels') $ pos levels' + , testProperty "extract is total" $ \(levels :: Levels Int) genned -> + let levels' = runIdentity . nextLevel (Identity genned) $ levels + in total $ extract levels' + ] + , testGroup "prevLevel" + [ testProperty "seeks backwards" $ \(levels :: Levels Int) -> + case prevLevel levels of + Nothing -> property Discard + Just levels' -> pos levels' === pos levels - 1 + , testProperty "maintains the invariant" $ \(levels :: Levels Int) -> + case prevLevel levels of + Nothing -> property Discard + Just levels' -> property $ between 0 (length levels') $ pos levels' + , testProperty "extract is total" $ \(levels :: Levels Int) -> + case prevLevel levels of + Nothing -> property Discard + Just levels' -> total $ extract levels' + ] + ] + , testGroup "JSON" + [ testProperty "toJSON/parseJSON round-trip" $ \(levels :: Levels Int) -> + JSON.decode (JSON.encode levels) === Just levels + ] + ] diff --git a/xanthous.cabal b/xanthous.cabal index 090739c289..702496b290 100644 --- a/xanthous.cabal +++ b/xanthous.cabal @@ -4,7 +4,7 @@ cabal-version: 1.12 -- -- see: https://github.com/sol/hpack -- --- hash: 36af39a9e3b4e97923c1b363d7d84e2c99f126efd908778d0d048d0c472f2723 +-- hash: eb0a7cd56cc2ea885be582c8ea7113a5f50f96a8d1b12ed27ca1a0271a45ad03 name: xanthous version: 0.1.0.0 @@ -37,6 +37,7 @@ library Xanthous.Data.EntityChar Xanthous.Data.EntityMap Xanthous.Data.EntityMap.Graphics + Xanthous.Data.Levels Xanthous.Data.VectorBag Xanthous.Entities.Character Xanthous.Entities.Creature @@ -65,6 +66,7 @@ library Xanthous.Random Xanthous.Resource Xanthous.Util + Xanthous.Util.Comonad Xanthous.Util.Graph Xanthous.Util.Graphics Xanthous.Util.Inflection @@ -89,6 +91,7 @@ library , checkers , classy-prelude , comonad + , comonad-extras , constraints , containers , data-default @@ -109,6 +112,7 @@ library , megaparsec , mtl , optparse-applicative + , pointed , quickcheck-instances , quickcheck-text , random @@ -120,6 +124,7 @@ library , semigroupoids , stache , streams + , text , text-zipper , tomland , vector @@ -139,6 +144,7 @@ executable xanthous Xanthous.Data.EntityChar Xanthous.Data.EntityMap Xanthous.Data.EntityMap.Graphics + Xanthous.Data.Levels Xanthous.Data.VectorBag Xanthous.Entities.Character Xanthous.Entities.Creature @@ -167,6 +173,7 @@ executable xanthous Xanthous.Random Xanthous.Resource Xanthous.Util + Xanthous.Util.Comonad Xanthous.Util.Graph Xanthous.Util.Graphics Xanthous.Util.Inflection @@ -190,6 +197,7 @@ executable xanthous , checkers , classy-prelude , comonad + , comonad-extras , constraints , containers , data-default @@ -210,6 +218,7 @@ executable xanthous , megaparsec , mtl , optparse-applicative + , pointed , quickcheck-instances , quickcheck-text , random @@ -221,6 +230,7 @@ executable xanthous , semigroupoids , stache , streams + , text , text-zipper , tomland , vector @@ -238,6 +248,7 @@ test-suite test Xanthous.Data.EntityCharSpec Xanthous.Data.EntityMap.GraphicsSpec Xanthous.Data.EntityMapSpec + Xanthous.Data.LevelsSpec Xanthous.DataSpec Xanthous.Entities.RawsSpec Xanthous.GameSpec @@ -265,6 +276,7 @@ test-suite test , checkers , classy-prelude , comonad + , comonad-extras , constraints , containers , data-default @@ -286,6 +298,7 @@ test-suite test , megaparsec , mtl , optparse-applicative + , pointed , quickcheck-instances , quickcheck-text , random @@ -300,6 +313,7 @@ test-suite test , tasty , tasty-hunit , tasty-quickcheck + , text , text-zipper , tomland , vector -- cgit 1.4.1 From 0f79a06733c30ddca4bc0746ddc99e1626775fff Mon Sep 17 00:00:00 2001 From: Griffin Smith Date: Sun, 5 Jan 2020 12:55:15 -0500 Subject: Add staircases, and moving between levels Currently we just pick randomly between the cave and dungeon level generators. There's a lot of bugs here, but it's *sorta* working, so I'm leaving it as is. --- src/Xanthous/App.hs | 60 +++++++++++++++++++++++++++++--- src/Xanthous/Command.hs | 4 +++ src/Xanthous/Data/Levels.hs | 2 +- src/Xanthous/Entities/Environment.hs | 30 ++++++++++++++++ src/Xanthous/Game.hs | 1 + src/Xanthous/Game/Arbitrary.hs | 10 +++--- src/Xanthous/Game/State.hs | 3 +- src/Xanthous/Generators.hs | 12 +++++-- src/Xanthous/Generators/LevelContents.hs | 8 ++++- src/Xanthous/Prelude.hs | 2 +- src/Xanthous/messages.yaml | 8 +++++ test/Xanthous/Data/LevelsSpec.hs | 2 +- 12 files changed, 125 insertions(+), 17 deletions(-) diff --git a/src/Xanthous/App.hs b/src/Xanthous/App.hs index 1db75bb585..2fd821af1c 100644 --- a/src/Xanthous/App.hs +++ b/src/Xanthous/App.hs @@ -14,6 +14,7 @@ import Control.Monad.Random (MonadRandom) import Control.Monad.State.Class (modify) import Data.Aeson (object, ToJSON) import qualified Data.Aeson as A +import Data.List.NonEmpty (NonEmpty(..)) import qualified Data.Vector as V import System.Exit import System.Directory (doesFileExist) @@ -30,6 +31,8 @@ import Xanthous.Data ) import Xanthous.Data.EntityMap (EntityMap) import qualified Xanthous.Data.EntityMap as EntityMap +import Xanthous.Data.Levels (prevLevel, nextLevel) +import qualified Xanthous.Data.Levels as Levels import Xanthous.Game import Xanthous.Game.State import Xanthous.Game.Draw (drawGame) @@ -37,6 +40,7 @@ import Xanthous.Game.Prompt import Xanthous.Monad import Xanthous.Resource (Name, Panel(..)) import qualified Xanthous.Messages as Messages +import Xanthous.Random import Xanthous.Util (removeVectorIndex) import Xanthous.Util.Inflection (toSentence) -------------------------------------------------------------------------------- @@ -47,13 +51,14 @@ import qualified Xanthous.Entities.Item as Item import Xanthous.Entities.Creature (Creature) import qualified Xanthous.Entities.Creature as Creature import Xanthous.Entities.Environment - (Door, open, locked, GroundMessage(..)) + (Door, open, locked, GroundMessage(..), Staircase(..)) import Xanthous.Entities.RawTypes ( edible, eatMessage, hitpointsHealed , attackMessage ) import Xanthous.Generators import qualified Xanthous.Generators.CaveAutomata as CaveAutomata +import qualified Xanthous.Generators.Dungeon as Dungeon -------------------------------------------------------------------------------- type App = Brick.App GameState () Name @@ -87,10 +92,7 @@ startEvent = do initLevel :: AppM () initLevel = do - level <- - generateLevel SCaveAutomata CaveAutomata.defaultParams - $ Dimensions 80 80 - + level <- genLevel 0 entities <>= levelToEntityMap level characterPosition .= level ^. levelCharacterPosition @@ -273,6 +275,40 @@ handleCommand Save = do writeFile (unpack filename) $ toStrict src exitSuccess +handleCommand GoUp = do + charPos <- use characterPosition + hasStairs <- uses (entities . EntityMap.atPosition charPos) + $ elem (SomeEntity UpStaircase) + if hasStairs + then uses levels prevLevel >>= \case + Just levs' -> levels .= levs' + Nothing -> + -- TODO in nethack, this leaves the game. Maybe something similar here? + say_ ["cant", "goUp"] + else say_ ["cant", "goUp"] + + continue + +handleCommand GoDown = do + charPos <- use characterPosition + hasStairs <- uses (entities . EntityMap.atPosition charPos) + $ elem (SomeEntity DownStaircase) + + if hasStairs + then do + levs <- use levels + let newLevelNum = Levels.pos levs + 1 + levs' <- nextLevel (levelToEntityMap <$> genLevel newLevelNum) levs + cEID <- use characterEntityID + pCharacter <- use $ entities . at cEID + entities . at cEID .= Nothing + levels .= levs' + entities . at cEID .= pCharacter + else say_ ["cant", "goDown"] + + continue + +-- handleCommand ToggleRevealAll = do val <- debugState . allRevealed <%= not @@ -551,3 +587,17 @@ showPanel panel = do prompt_ @'Continue ["generic", "continue"] Uncancellable . const $ activePanel .= Nothing + +-------------------------------------------------------------------------------- + +genLevel + :: Int -- ^ level number + -> AppM Level +genLevel _num = do + let dims = Dimensions 80 80 + generator <- choose $ CaveAutomata :| [Dungeon] + level <- case generator of + CaveAutomata -> generateLevel SCaveAutomata CaveAutomata.defaultParams dims + Dungeon -> generateLevel SDungeon Dungeon.defaultParams dims + characterPosition .= level ^. levelCharacterPosition + pure $!! level diff --git a/src/Xanthous/Command.hs b/src/Xanthous/Command.hs index d5bb5cd9ee..7db694575e 100644 --- a/src/Xanthous/Command.hs +++ b/src/Xanthous/Command.hs @@ -23,6 +23,8 @@ data Command | Read | ShowInventory | Wield + | GoUp + | GoDown -- | TODO replace with `:` commands | ToggleRevealAll @@ -41,6 +43,8 @@ commandFromKey (KChar 'S') [] = Just Save commandFromKey (KChar 'r') [] = Just Read commandFromKey (KChar 'i') [] = Just ShowInventory commandFromKey (KChar 'w') [] = Just Wield +commandFromKey (KChar '<') [] = Just GoUp +commandFromKey (KChar '>') [] = Just GoDown -- DEBUG COMMANDS -- commandFromKey (KChar 'r') [MMeta] = Just ToggleRevealAll diff --git a/src/Xanthous/Data/Levels.hs b/src/Xanthous/Data/Levels.hs index bc5eff9bad..5fc3f93341 100644 --- a/src/Xanthous/Data/Levels.hs +++ b/src/Xanthous/Data/Levels.hs @@ -14,7 +14,7 @@ module Xanthous.Data.Levels , ComonadStore(..) ) where -------------------------------------------------------------------------------- -import Xanthous.Prelude hiding ((<.>), Empty, foldMap, levels) +import Xanthous.Prelude hiding ((<.>), Empty, foldMap) import Xanthous.Util (between, EqProp, EqEqProp(..)) import Xanthous.Util.Comonad (current) import Xanthous.Orphans () diff --git a/src/Xanthous/Entities/Environment.hs b/src/Xanthous/Entities/Environment.hs index dee8d83c32..993714c844 100644 --- a/src/Xanthous/Entities/Environment.hs +++ b/src/Xanthous/Entities/Environment.hs @@ -3,13 +3,18 @@ module Xanthous.Entities.Environment ( -- * Walls Wall(..) + -- * Doors , Door(..) , open , locked , unlockedDoor + -- * Messages , GroundMessage(..) + + -- * Stairs + , Staircase(..) ) where -------------------------------------------------------------------------------- import Xanthous.Prelude @@ -122,3 +127,28 @@ instance Entity GroundMessage where description = const "a message on the ground. Press r. to read it." entityChar = const "≈" entityCollision = const Nothing + +-------------------------------------------------------------------------------- + +data Staircase = UpStaircase | DownStaircase + deriving stock (Show, Eq, Ord, Generic) + deriving anyclass (NFData, CoArbitrary, Function) + deriving Arbitrary via GenericArbitrary Staircase + deriving (ToJSON, FromJSON) + via WithOptions '[ 'TagSingleConstructors 'True + , 'SumEnc 'ObjWithSingleField + ] + Staircase +instance Brain Staircase where step = brainVia Brainless + +instance Draw Staircase where + draw UpStaircase = str "<" + draw DownStaircase = str ">" + +instance Entity Staircase where + blocksVision = const False + description UpStaircase = "a staircase leading upwards" + description DownStaircase = "a staircase leading downwards" + entityChar UpStaircase = "<" + entityChar DownStaircase = ">" + entityCollision = const Nothing diff --git a/src/Xanthous/Game.hs b/src/Xanthous/Game.hs index 094858618d..a8d096f02f 100644 --- a/src/Xanthous/Game.hs +++ b/src/Xanthous/Game.hs @@ -1,5 +1,6 @@ module Xanthous.Game ( GameState(..) + , levels , entities , revealedPositions , messageHistory diff --git a/src/Xanthous/Game/Arbitrary.hs b/src/Xanthous/Game/Arbitrary.hs index 3be711099c..d6f4784d55 100644 --- a/src/Xanthous/Game/Arbitrary.hs +++ b/src/Xanthous/Game/Arbitrary.hs @@ -5,7 +5,7 @@ -------------------------------------------------------------------------------- module Xanthous.Game.Arbitrary where -------------------------------------------------------------------------------- -import Xanthous.Prelude hiding (levels, foldMap) +import Xanthous.Prelude hiding (foldMap) -------------------------------------------------------------------------------- import Test.QuickCheck import System.Random @@ -23,13 +23,13 @@ instance Arbitrary GameState where chr <- arbitrary @Character charPos <- arbitrary _messageHistory <- arbitrary - levels <- arbitrary + levs <- arbitrary let (_characterEntityID, currentLevel) = EntityMap.insertAtReturningID charPos (SomeEntity chr) - $ extract levels - _levels = levels & current .~ currentLevel + $ extract levs + _levels = levs & current .~ currentLevel _revealedPositions <- fmap setFromList . sublistOf - $ foldMap EntityMap.positions levels + $ foldMap EntityMap.positions levs _randomGen <- mkStdGen <$> arbitrary let _promptState = NoPrompt -- TODO _activePanel <- arbitrary diff --git a/src/Xanthous/Game/State.hs b/src/Xanthous/Game/State.hs index 7587618c96..36a2c2c174 100644 --- a/src/Xanthous/Game/State.hs +++ b/src/Xanthous/Game/State.hs @@ -7,6 +7,7 @@ module Xanthous.Game.State ( GameState(..) , entities + , levels , revealedPositions , messageHistory , randomGen @@ -58,7 +59,7 @@ module Xanthous.Game.State , allRevealed ) where -------------------------------------------------------------------------------- -import Xanthous.Prelude hiding (levels) +import Xanthous.Prelude -------------------------------------------------------------------------------- import Data.List.NonEmpty ( NonEmpty((:|))) import qualified Data.List.NonEmpty as NonEmpty diff --git a/src/Xanthous/Generators.hs b/src/Xanthous/Generators.hs index 8c0372ed53..9b2b90e300 100644 --- a/src/Xanthous/Generators.hs +++ b/src/Xanthous/Generators.hs @@ -4,6 +4,7 @@ -------------------------------------------------------------------------------- module Xanthous.Generators ( generate + , Generator(..) , SGenerator(..) , GeneratorInput , generateFromInput @@ -20,7 +21,7 @@ module Xanthous.Generators , levelToEntityMap ) where -------------------------------------------------------------------------------- -import Xanthous.Prelude hiding (Level) +import Xanthous.Prelude import Data.Array.Unboxed import System.Random (RandomGen) import qualified Options.Applicative as Opt @@ -31,7 +32,7 @@ import qualified Xanthous.Generators.Dungeon as Dungeon import Xanthous.Generators.Util import Xanthous.Generators.LevelContents import Xanthous.Data (Dimensions, Position'(Position), Position) -import Xanthous.Data.EntityMap (EntityMap) +import Xanthous.Data.EntityMap (EntityMap, _EntityMap) import qualified Xanthous.Data.EntityMap as EntityMap import Xanthous.Entities.Environment import Xanthous.Entities.Item (Item) @@ -116,8 +117,11 @@ data Level = Level , _levelItems :: !(EntityMap Item) , _levelCreatures :: !(EntityMap Creature) , _levelTutorialMessage :: !(EntityMap GroundMessage) + , _levelStaircases :: !(EntityMap Staircase) , _levelCharacterPosition :: !Position } + deriving stock (Generic) + deriving anyclass (NFData) makeLenses ''Level generateLevel @@ -134,6 +138,9 @@ generateLevel gen ps dims = do _levelCreatures <- randomCreatures cells _levelDoors <- randomDoors cells _levelCharacterPosition <- chooseCharacterPosition cells + let upStaircase = _EntityMap # [(_levelCharacterPosition, UpStaircase)] + downStaircase <- placeDownStaircase cells + let _levelStaircases = upStaircase <> downStaircase _levelTutorialMessage <- tutorialMessage cells _levelCharacterPosition pure Level {..} @@ -144,3 +151,4 @@ levelToEntityMap level <> (SomeEntity <$> level ^. levelItems) <> (SomeEntity <$> level ^. levelCreatures) <> (SomeEntity <$> level ^. levelTutorialMessage) + <> (SomeEntity <$> level ^. levelStaircases) diff --git a/src/Xanthous/Generators/LevelContents.hs b/src/Xanthous/Generators/LevelContents.hs index 96d64a6937..748afa96da 100644 --- a/src/Xanthous/Generators/LevelContents.hs +++ b/src/Xanthous/Generators/LevelContents.hs @@ -4,6 +4,7 @@ module Xanthous.Generators.LevelContents , randomItems , randomCreatures , randomDoors + , placeDownStaircase , tutorialMessage ) where -------------------------------------------------------------------------------- @@ -23,7 +24,7 @@ import Xanthous.Entities.Item (Item) import qualified Xanthous.Entities.Creature as Creature import Xanthous.Entities.Creature (Creature) import Xanthous.Entities.Environment - (GroundMessage(..), Door(..), unlockedDoor) + (GroundMessage(..), Door(..), unlockedDoor, Staircase(..)) import Xanthous.Messages (message_) import Xanthous.Util.Graphics (circle) -------------------------------------------------------------------------------- @@ -34,6 +35,11 @@ chooseCharacterPosition = randomPosition randomItems :: MonadRandom m => Cells -> m (EntityMap Item) randomItems = randomEntities Item.newWithType (0.0004, 0.001) +placeDownStaircase :: MonadRandom m => Cells -> m (EntityMap Staircase) +placeDownStaircase cells = do + pos <- randomPosition cells + pure $ _EntityMap # [(pos, DownStaircase)] + randomDoors :: MonadRandom m => Cells -> m (EntityMap Door) randomDoors cells = do doorRatio <- getRandomR subsetRange diff --git a/src/Xanthous/Prelude.hs b/src/Xanthous/Prelude.hs index 2f50635e78..9a4ca0149f 100644 --- a/src/Xanthous/Prelude.hs +++ b/src/Xanthous/Prelude.hs @@ -19,7 +19,7 @@ import ClassyPrelude hiding (return, (<|), unsnoc, uncons, cons, snoc, index, (<.>), Index, say) import Data.Kind import GHC.TypeLits hiding (Text) -import Control.Lens +import Control.Lens hiding (levels, Level) import Data.Void import Control.Comonad -------------------------------------------------------------------------------- diff --git a/src/Xanthous/messages.yaml b/src/Xanthous/messages.yaml index 1a4159b0ac..23cc102f5e 100644 --- a/src/Xanthous/messages.yaml +++ b/src/Xanthous/messages.yaml @@ -23,6 +23,14 @@ pickUp: pickUp: You pick up the {{item.itemType.name}} nothingToPickUp: "There's nothing here to pick up" +cant: + goUp: + - You can't go up here + - There's nothing here that would let you go up + goDown: + - You can't go down here + - There's nothing here that would let you go down + open: prompt: Direction to open (hjklybnu.)? success: "You open the door." diff --git a/test/Xanthous/Data/LevelsSpec.hs b/test/Xanthous/Data/LevelsSpec.hs index eb74253903..49d3719b12 100644 --- a/test/Xanthous/Data/LevelsSpec.hs +++ b/test/Xanthous/Data/LevelsSpec.hs @@ -1,7 +1,7 @@ -------------------------------------------------------------------------------- module Xanthous.Data.LevelsSpec (main, test) where -------------------------------------------------------------------------------- -import Test.Prelude hiding (levels) +import Test.Prelude -------------------------------------------------------------------------------- import qualified Data.Aeson as JSON -------------------------------------------------------------------------------- -- cgit 1.4.1 From b6f170c02cb8231238ba0909fd311efc83b6bf69 Mon Sep 17 00:00:00 2001 From: Griffin Smith Date: Wed, 8 Jan 2020 23:01:22 -0500 Subject: Generate more reasonable doors Generate doors at more reasonable positions, by: - Only generating doors at the *ends* of hallways, where there's a tee-shaped opening - Never generating two doors adjacent to each other --- src/Xanthous/Data.hs | 41 +++++++++++++++++++++++++++++--- src/Xanthous/Generators/LevelContents.hs | 40 +++++++++++++++++++++---------- test/Xanthous/DataSpec.hs | 36 ++++++++++++++++++++-------- 3 files changed, 91 insertions(+), 26 deletions(-) diff --git a/src/Xanthous/Data.hs b/src/Xanthous/Data.hs index 5e45169582..1874b45e90 100644 --- a/src/Xanthous/Data.hs +++ b/src/Xanthous/Data.hs @@ -79,6 +79,8 @@ module Xanthous.Data , edges , neighborDirections , neighborPositions + , arrayNeighbors + , rotations -- * , Hitpoints(..) @@ -88,11 +90,13 @@ import Xanthous.Prelude hiding (Left, Down, Right, (.=)) -------------------------------------------------------------------------------- import Linear.V2 hiding (_x, _y) import qualified Linear.V2 as L +import Linear.V4 hiding (_x, _y) import Test.QuickCheck (Arbitrary, CoArbitrary, Function) import Test.QuickCheck.Arbitrary.Generic import Data.Group import Brick (Location(Location), Edges(..)) import Data.Monoid (Product(..), Sum(..)) +import Data.Array.IArray import Data.Aeson.Generic.DerivingVia import Data.Aeson ( ToJSON(..), FromJSON(..), object, (.=), (.:), withObject) @@ -280,7 +284,7 @@ instance Opposite Direction where opposite DownRight = UpLeft opposite Here = Here -move :: Direction -> Position -> Position +move :: Num a => Direction -> Position' a -> Position' a move Up = y -~ 1 move Down = y +~ 1 move Left = x -~ 1 @@ -375,7 +379,8 @@ data Neighbors a = Neighbors , _bottomRight :: a } deriving stock (Show, Eq, Ord, Functor, Foldable, Traversable, Generic) - deriving anyclass (NFData) + deriving anyclass (NFData, CoArbitrary, Function) + deriving Arbitrary via GenericArbitrary (Neighbors a) makeFieldsNoPrefix ''Neighbors instance Applicative Neighbors where @@ -420,9 +425,39 @@ neighborDirections = Neighbors , _bottomRight = DownRight } -neighborPositions :: Position -> Neighbors Position +neighborPositions :: Num a => Position' a -> Neighbors (Position' a) neighborPositions pos = (`move` pos) <$> neighborDirections +arrayNeighbors + :: (IArray a e, Ix i, Num i) + => a (i, i) e + -> (i, i) + -> Neighbors (Maybe e) +arrayNeighbors arr center = arrLookup <$> neighborPositions (_Position # center) + where + arrLookup (view _Position -> pos) + | inRange (bounds arr) pos = Just $ arr ! pos + | otherwise = Nothing + +-- | Returns a list of all 4 90-degree rotations of the given neighbors +rotations :: Neighbors a -> V4 (Neighbors a) +rotations orig@(Neighbors tl t tr l r bl b br) = V4 + orig -- tl t tr + -- l r + -- bl b br + + (Neighbors bl l tl b t br r tr) -- bl l tl + -- b t + -- br r tr + + (Neighbors br b bl r l tr t tl) -- br b bl + -- r l + -- tr t tl + + (Neighbors tr r br t b tl l bl) -- tr r br + -- t b + -- tl l bl + -------------------------------------------------------------------------------- newtype Per a b = Rate Double diff --git a/src/Xanthous/Generators/LevelContents.hs b/src/Xanthous/Generators/LevelContents.hs index 748afa96da..117860405a 100644 --- a/src/Xanthous/Generators/LevelContents.hs +++ b/src/Xanthous/Generators/LevelContents.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE ViewPatterns #-} -------------------------------------------------------------------------------- module Xanthous.Generators.LevelContents ( chooseCharacterPosition @@ -8,15 +9,19 @@ module Xanthous.Generators.LevelContents , tutorialMessage ) where -------------------------------------------------------------------------------- -import Xanthous.Prelude +import Xanthous.Prelude hiding (any, toList) -------------------------------------------------------------------------------- import Control.Monad.Random import Data.Array.IArray (amap, bounds, rangeSize, (!)) import qualified Data.Array.IArray as Arr +import Data.Foldable (any, toList) -------------------------------------------------------------------------------- import Xanthous.Generators.Util import Xanthous.Random -import Xanthous.Data (Position, _Position, positionFromPair) +import Xanthous.Data ( Position, _Position, positionFromPair + , rotations, arrayNeighbors, Neighbors(..) + , neighborPositions + ) import Xanthous.Data.EntityMap (EntityMap, _EntityMap) import Xanthous.Entities.Raws (rawsWithType, RawType) import qualified Xanthous.Entities.Item as Item @@ -44,22 +49,31 @@ randomDoors :: MonadRandom m => Cells -> m (EntityMap Door) randomDoors cells = do doorRatio <- getRandomR subsetRange let numDoors = floor $ doorRatio * fromIntegral (length candidateCells) - doorPositions = positionFromPair <$> take numDoors candidateCells + doorPositions = + removeAdjacent . fmap positionFromPair . take numDoors $ candidateCells doors = zip doorPositions $ repeat unlockedDoor pure $ _EntityMap # doors where + removeAdjacent = + foldr (\pos acc -> + if pos `elem` (acc >>= toList . neighborPositions) + then acc + else pos : acc + ) [] candidateCells = filter doorable $ Arr.indices cells subsetRange = (0.8 :: Double, 1.0) - doorable (x, y) = - not (fromMaybe True $ cells ^? ix (x, y)) - && - ( fromMaybe True $ cells ^? ix (x - 1, y) -- left - , fromMaybe True $ cells ^? ix (x, y - 1) -- top - , fromMaybe True $ cells ^? ix (x + 1, y) -- right - , fromMaybe True $ cells ^? ix (x, y + 1) -- bottom - ) `elem` [ (True, False, True, False) - , (False, True, False, True) - ] + doorable pos = + not (fromMaybe True $ cells ^? ix pos) + && any (teeish . fmap (fromMaybe True)) + (rotations $ arrayNeighbors cells pos) + -- only generate doors at the *ends* of hallways, eg (where O is walkable, + -- X is a wall, and D is a door): + -- + -- O O O + -- X D X + -- O + teeish (fmap not -> (Neighbors tl t tr l r _ b _ )) = + and [tl, t, tr, b] && (and . fmap not) [l, r] randomCreatures :: MonadRandom m => Cells -> m (EntityMap Creature) randomCreatures = randomEntities Creature.newWithType (0.0007, 0.003) diff --git a/test/Xanthous/DataSpec.hs b/test/Xanthous/DataSpec.hs index a2fcdbba15..91dc6cea1b 100644 --- a/test/Xanthous/DataSpec.hs +++ b/test/Xanthous/DataSpec.hs @@ -1,9 +1,11 @@ -------------------------------------------------------------------------------- module Xanthous.DataSpec (main, test) where -------------------------------------------------------------------------------- -import Test.Prelude hiding (Right, Left, Down) -import Xanthous.Data +import Test.Prelude hiding (Right, Left, Down, toList, all) import Data.Group +import Data.Foldable (toList, all) +-------------------------------------------------------------------------------- +import Xanthous.Data -------------------------------------------------------------------------------- main :: IO () @@ -44,14 +46,14 @@ test = testGroup "Xanthous.Data" , testProperty "asPosition isUnit" $ \dir -> dir /= Here ==> isUnit (asPosition dir) , testGroup "Move" - [ testCase "Up" $ move Up mempty @?= Position 0 (-1) - , testCase "Down" $ move Down mempty @?= Position 0 1 - , testCase "Left" $ move Left mempty @?= Position (-1) 0 - , testCase "Right" $ move Right mempty @?= Position 1 0 - , testCase "UpLeft" $ move UpLeft mempty @?= Position (-1) (-1) - , testCase "UpRight" $ move UpRight mempty @?= Position 1 (-1) - , testCase "DownLeft" $ move DownLeft mempty @?= Position (-1) 1 - , testCase "DownRight" $ move DownRight mempty @?= Position 1 1 + [ testCase "Up" $ move Up mempty @?= Position @Int 0 (-1) + , testCase "Down" $ move Down mempty @?= Position @Int 0 1 + , testCase "Left" $ move Left mempty @?= Position @Int (-1) 0 + , testCase "Right" $ move Right mempty @?= Position @Int 1 0 + , testCase "UpLeft" $ move UpLeft mempty @?= Position @Int (-1) (-1) + , testCase "UpRight" $ move UpRight mempty @?= Position @Int 1 (-1) + , testCase "DownLeft" $ move DownLeft mempty @?= Position @Int (-1) 1 + , testCase "DownRight" $ move DownRight mempty @?= Position @Int 1 1 ] ] @@ -79,4 +81,18 @@ test = testGroup "Xanthous.Data" (Box (V2 4 2) dims) ] ] + + , testGroup "Neighbors" + [ testGroup "rotations" + [ testProperty "always has the same members" + $ \(neighs :: Neighbors Int) -> + all (\ns -> sort (toList ns) == sort (toList neighs)) + $ rotations neighs + , testProperty "all rotations have the same rotations" + $ \(neighs :: Neighbors Int) -> + let rots = rotations neighs + in all (\ns -> sort (toList $ rotations ns) == sort (toList rots)) + rots + ] + ] ] -- cgit 1.4.1 From d62aba218d1996b2c0541553c182313cfcc9843d Mon Sep 17 00:00:00 2001 From: Griffin Smith Date: Sun, 19 Jan 2020 13:19:00 -0500 Subject: Switch to DelaunayTriangulation.Naive Per https://github.com/noinia/hgeometry/issues/28, occasionally DelaunayTriangulation.DivideAndConquer loops infinitely - in this case, I was able to consistently use the seed 127624940715530481, to generate a dungeon which had the following room centroids: [ Point2 [38.5,3.5] :+ 0 , Point2 [67.0,33.0] :+ 1 , Point2 [46.0,45.5] :+ 2 , Point2 [55.5,42.0] :+ 3 , Point2 [36.0,25.0] :+ 4 , Point2 [76.5,12.0] :+ 5 , Point2 [29.0,26.5] :+ 6 , Point2 [55.0,10.5] :+ 7 ] and cause delaunay triangulation to loop indefinitely (or at least longer than I cared to wait for). Given the size of our graphs switching to naive generation should be fine performance-wise, and avoids the infinite loop. --- src/Xanthous/Util/Graphics.hs | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/src/Xanthous/Util/Graphics.hs b/src/Xanthous/Util/Graphics.hs index bd6a0906a6..fc704abf64 100644 --- a/src/Xanthous/Util/Graphics.hs +++ b/src/Xanthous/Util/Graphics.hs @@ -10,7 +10,10 @@ module Xanthous.Util.Graphics -------------------------------------------------------------------------------- import Xanthous.Prelude -------------------------------------------------------------------------------- -import qualified Algorithms.Geometry.DelaunayTriangulation.DivideAndConquer +-- https://github.com/noinia/hgeometry/issues/28 +-- import qualified Algorithms.Geometry.DelaunayTriangulation.DivideAndConquer +-- as Geometry +import qualified Algorithms.Geometry.DelaunayTriangulation.Naive as Geometry import qualified Algorithms.Geometry.DelaunayTriangulation.Types as Geometry import Codec.Picture (imagePixels) -- cgit 1.4.1 From 72edcff32307ffebda07d350634792cc86b268bb Mon Sep 17 00:00:00 2001 From: Griffin Smith Date: Mon, 20 Jan 2020 10:31:02 -0500 Subject: Put new levels at the right position in the list New levels need to go at the *end* of the list of levels, not the beginning - otherwise we jump to the proper position on the new level but the current level stays the same (oops). --- src/Xanthous/App.hs | 3 +-- src/Xanthous/Data/Levels.hs | 2 +- test/Xanthous/Data/LevelsSpec.hs | 6 ++++++ 3 files changed, 8 insertions(+), 3 deletions(-) diff --git a/src/Xanthous/App.hs b/src/Xanthous/App.hs index 2fd821af1c..5774663281 100644 --- a/src/Xanthous/App.hs +++ b/src/Xanthous/App.hs @@ -300,8 +300,7 @@ handleCommand GoDown = do let newLevelNum = Levels.pos levs + 1 levs' <- nextLevel (levelToEntityMap <$> genLevel newLevelNum) levs cEID <- use characterEntityID - pCharacter <- use $ entities . at cEID - entities . at cEID .= Nothing + pCharacter <- entities . at cEID <<.= Nothing levels .= levs' entities . at cEID .= pCharacter else say_ ["cant", "goDown"] diff --git a/src/Xanthous/Data/Levels.hs b/src/Xanthous/Data/Levels.hs index 5fc3f93341..efc0f53ace 100644 --- a/src/Xanthous/Data/Levels.hs +++ b/src/Xanthous/Data/Levels.hs @@ -102,7 +102,7 @@ nextLevel genLevel levs = pure $ seeks succ levs | otherwise = genLevel <&> \level -> - seek (pos levs + 1) . partialMkLevels $ level <| allLevels levs + seek (pos levs + 1) . partialMkLevels $ allLevels levs |> level -- | Go to the previous level. Returns Nothing if 'pos' is 0 prevLevel :: Levels level -> Maybe (Levels level) diff --git a/test/Xanthous/Data/LevelsSpec.hs b/test/Xanthous/Data/LevelsSpec.hs index 49d3719b12..4e46946a93 100644 --- a/test/Xanthous/Data/LevelsSpec.hs +++ b/test/Xanthous/Data/LevelsSpec.hs @@ -37,6 +37,12 @@ test = testGroup "Xanthous.Data.Levels" , testProperty "extract is total" $ \(levels :: Levels Int) genned -> let levels' = runIdentity . nextLevel (Identity genned) $ levels in total $ extract levels' + , testProperty "uses the generated level as the next level" + $ \(levels :: Levels Int) genned -> + let levels' = seek (length levels - 1) levels + levels'' = runIdentity . nextLevel (Identity genned) $ levels' + in counterexample (show levels'') + $ extract levels'' === genned ] , testGroup "prevLevel" [ testProperty "seeks backwards" $ \(levels :: Levels Int) -> -- cgit 1.4.1 From 7082a4088ba06c825eb45f89888fed2f4577ed10 Mon Sep 17 00:00:00 2001 From: Griffin Smith Date: Mon, 20 Jan 2020 11:37:37 -0500 Subject: Store revealed positions on the level itself This was a bit of an oversight initially - we should be storing the positions that the character has seen *on the level*, rather than on the entire game state, for obvious reasons. This introduces a GameLevel record, which has this field, the entities, and also the up staircase position, which we can *also* use to position the character after going down to a level we've already visited. --- src/Xanthous/App.hs | 12 ++++++++++-- src/Xanthous/Entities/Entities.hs | 2 ++ src/Xanthous/Game/Arbitrary.hs | 24 ++++++++++++++++-------- src/Xanthous/Game/Lenses.hs | 8 +++++--- src/Xanthous/Game/State.hs | 34 ++++++++++++++++++++++++++++------ 5 files changed, 61 insertions(+), 19 deletions(-) diff --git a/src/Xanthous/App.hs b/src/Xanthous/App.hs index 5774663281..1f7714da1d 100644 --- a/src/Xanthous/App.hs +++ b/src/Xanthous/App.hs @@ -1,5 +1,6 @@ -{-# LANGUAGE ViewPatterns #-} +{-# LANGUAGE ViewPatterns #-} {-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE RecordWildCards #-} -------------------------------------------------------------------------------- module Xanthous.App (makeApp) where -------------------------------------------------------------------------------- @@ -298,7 +299,7 @@ handleCommand GoDown = do then do levs <- use levels let newLevelNum = Levels.pos levs + 1 - levs' <- nextLevel (levelToEntityMap <$> genLevel newLevelNum) levs + levs' <- nextLevel (levelToGameLevel <$> genLevel newLevelNum) levs cEID <- use characterEntityID pCharacter <- entities . at cEID <<.= Nothing levels .= levs' @@ -600,3 +601,10 @@ genLevel _num = do Dungeon -> generateLevel SDungeon Dungeon.defaultParams dims characterPosition .= level ^. levelCharacterPosition pure $!! level + +levelToGameLevel :: Level -> GameLevel +levelToGameLevel level = + let _levelEntities = levelToEntityMap level + _upStaircasePosition = level ^. levelCharacterPosition + _levelRevealedPositions = mempty + in GameLevel {..} diff --git a/src/Xanthous/Entities/Entities.hs b/src/Xanthous/Entities/Entities.hs index 1e533a2973..1b9f138fe2 100644 --- a/src/Xanthous/Entities/Entities.hs +++ b/src/Xanthous/Entities/Entities.hs @@ -40,6 +40,8 @@ instance FromJSON SomeEntity where "GroundMessage" -> SomeEntity @GroundMessage <$> obj .: "data" _ -> fail . unpack $ "Invalid entity type \"" <> entityType <> "\"" +deriving via WithOptions '[ FieldLabelModifier '[Drop 1] ] GameLevel + instance FromJSON GameLevel deriving via WithOptions '[ FieldLabelModifier '[Drop 1] ] GameState instance FromJSON GameState diff --git a/src/Xanthous/Game/Arbitrary.hs b/src/Xanthous/Game/Arbitrary.hs index d6f4784d55..4a64a12be0 100644 --- a/src/Xanthous/Game/Arbitrary.hs +++ b/src/Xanthous/Game/Arbitrary.hs @@ -16,20 +16,26 @@ import qualified Xanthous.Data.EntityMap as EntityMap import Xanthous.Entities.Entities () import Xanthous.Entities.Character import Xanthous.Game.State +import Xanthous.Util.QuickCheck (GenericArbitrary(..)) -------------------------------------------------------------------------------- +deriving via GenericArbitrary GameLevel instance Arbitrary GameLevel + instance Arbitrary GameState where arbitrary = do chr <- arbitrary @Character - charPos <- arbitrary + _upStaircasePosition <- arbitrary _messageHistory <- arbitrary - levs <- arbitrary - let (_characterEntityID, currentLevel) = - EntityMap.insertAtReturningID charPos (SomeEntity chr) - $ extract levs - _levels = levs & current .~ currentLevel - _revealedPositions <- fmap setFromList . sublistOf - $ foldMap EntityMap.positions levs + levs <- arbitrary @(Levels GameLevel) + _levelRevealedPositions <- + fmap setFromList + . sublistOf + . foldMap (EntityMap.positions . _levelEntities) + $ levs + let (_characterEntityID, _levelEntities) = + EntityMap.insertAtReturningID _upStaircasePosition (SomeEntity chr) + $ levs ^. current . levelEntities + _levels = levs & current .~ GameLevel {..} _randomGen <- mkStdGen <$> arbitrary let _promptState = NoPrompt -- TODO _activePanel <- arbitrary @@ -38,6 +44,8 @@ instance Arbitrary GameState where pure $ GameState {..} +instance CoArbitrary GameLevel +instance Function GameLevel instance CoArbitrary GameState instance Function GameState deriving newtype instance CoArbitrary (m (a, GameState)) => CoArbitrary (AppT m a) diff --git a/src/Xanthous/Game/Lenses.hs b/src/Xanthous/Game/Lenses.hs index 010fcb7022..8f6053a5ec 100644 --- a/src/Xanthous/Game/Lenses.hs +++ b/src/Xanthous/Game/Lenses.hs @@ -39,14 +39,16 @@ initialStateFromSeed :: Int -> GameState initialStateFromSeed seed = let _randomGen = mkStdGen seed chr = mkCharacter - (_characterEntityID, level) + _upStaircasePosition = Position 0 0 + (_characterEntityID, _levelEntities) = EntityMap.insertAtReturningID - (Position 0 0) + _upStaircasePosition (SomeEntity chr) mempty + _levelRevealedPositions = mempty + level = GameLevel {..} _levels = oneLevel level _messageHistory = mempty - _revealedPositions = mempty _promptState = NoPrompt _activePanel = Nothing _debugState = DebugState diff --git a/src/Xanthous/Game/State.hs b/src/Xanthous/Game/State.hs index 36a2c2c174..e5ee66deac 100644 --- a/src/Xanthous/Game/State.hs +++ b/src/Xanthous/Game/State.hs @@ -17,6 +17,12 @@ module Xanthous.Game.State , characterEntityID , GamePromptState(..) + -- * Game Level + , GameLevel(..) + , levelEntities + , upStaircasePosition + , levelRevealedPositions + -- * Messages , MessageHistory(..) , HasMessages(..) @@ -80,6 +86,7 @@ import qualified Graphics.Vty.Attributes as Vty import qualified Graphics.Vty.Image as Vty -------------------------------------------------------------------------------- import Xanthous.Util (KnownBool(..)) +import Xanthous.Util.QuickCheck (GenericArbitrary(..)) import Xanthous.Data import Xanthous.Data.Levels import Xanthous.Data.EntityMap (EntityMap, EntityID) @@ -98,6 +105,7 @@ data MessageHistory } deriving stock (Show, Eq, Generic) deriving anyclass (NFData, CoArbitrary, Function) + deriving Arbitrary via GenericArbitrary MessageHistory deriving (ToJSON, FromJSON) via WithOptions '[ FieldLabelModifier '[Drop 1] ] MessageHistory @@ -113,9 +121,6 @@ instance Semigroup MessageHistory where instance Monoid MessageHistory where mempty = MessageHistory mempty 0 Nothing -instance Arbitrary MessageHistory where - arbitrary = genericArbitrary - type instance Element MessageHistory = [Text] instance MonoFunctor MessageHistory where omap f mh@(MessageHistory _ t _) = @@ -400,6 +405,19 @@ instance -------------------------------------------------------------------------------- +data GameLevel = GameLevel + { _levelEntities :: !(EntityMap SomeEntity) + , _upStaircasePosition :: !Position + , _levelRevealedPositions :: !(Set Position) + } + deriving stock (Show, Eq, Generic) + deriving anyclass (NFData) + deriving (ToJSON) + via WithOptions '[ FieldLabelModifier '[Drop 1] ] + GameLevel + +-------------------------------------------------------------------------------- + data DebugState = DebugState { _allRevealed :: !Bool @@ -415,8 +433,7 @@ instance Arbitrary DebugState where arbitrary = genericArbitrary data GameState = GameState - { _levels :: !(Levels (EntityMap SomeEntity)) - , _revealedPositions :: !(Set Position) + { _levels :: !(Levels GameLevel) , _characterEntityID :: !EntityID , _messageHistory :: !MessageHistory , _randomGen :: !StdGen @@ -433,10 +450,15 @@ data GameState = GameState deriving (ToJSON) via WithOptions '[ FieldLabelModifier '[Drop 1] ] GameState + +makeLenses ''GameLevel makeLenses ''GameState entities :: Lens' GameState (EntityMap SomeEntity) -entities = levels . current +entities = levels . current . levelEntities + +revealedPositions :: Lens' GameState (Set Position) +revealedPositions = levels . current . levelRevealedPositions instance Eq GameState where (==) = (==) `on` \gs -> -- cgit 1.4.1 From 5337d7c0eb4e4c6ab835f959c59dff6ee8d879fc Mon Sep 17 00:00:00 2001 From: Griffin Smith Date: Sat, 25 Jan 2020 10:57:38 -0500 Subject: Lower the maximum gormlak coefficient Little too easy to generate tons of gormlaks and then immediately die. --- src/Xanthous/Generators/LevelContents.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Xanthous/Generators/LevelContents.hs b/src/Xanthous/Generators/LevelContents.hs index 117860405a..5f83a83a3b 100644 --- a/src/Xanthous/Generators/LevelContents.hs +++ b/src/Xanthous/Generators/LevelContents.hs @@ -76,7 +76,7 @@ randomDoors cells = do and [tl, t, tr, b] && (and . fmap not) [l, r] randomCreatures :: MonadRandom m => Cells -> m (EntityMap Creature) -randomCreatures = randomEntities Creature.newWithType (0.0007, 0.003) +randomCreatures = randomEntities Creature.newWithType (0.0007, 0.002) tutorialMessage :: MonadRandom m => Cells -- cgit 1.4.1 From 2fc4fcfee95ad34a9272414c4fd214b10007539f Mon Sep 17 00:00:00 2001 From: Griffin Smith Date: Sat, 25 Jan 2020 11:06:01 -0500 Subject: Put the character at the staircase when going down Always put the character at the up staircase when going down a level, even when going down to a level we've already generated. --- src/Xanthous/App.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Xanthous/App.hs b/src/Xanthous/App.hs index 1f7714da1d..202f38e868 100644 --- a/src/Xanthous/App.hs +++ b/src/Xanthous/App.hs @@ -304,6 +304,7 @@ handleCommand GoDown = do pCharacter <- entities . at cEID <<.= Nothing levels .= levs' entities . at cEID .= pCharacter + characterPosition .= extract levs' ^. upStaircasePosition else say_ ["cant", "goDown"] continue @@ -599,7 +600,6 @@ genLevel _num = do level <- case generator of CaveAutomata -> generateLevel SCaveAutomata CaveAutomata.defaultParams dims Dungeon -> generateLevel SDungeon Dungeon.defaultParams dims - characterPosition .= level ^. levelCharacterPosition pure $!! level levelToGameLevel :: Level -> GameLevel -- cgit 1.4.1 From 9256c976edec462af26f33317df6171045e68aa5 Mon Sep 17 00:00:00 2001 From: Griffin Smith Date: Sat, 25 Jan 2020 11:18:32 -0500 Subject: Factor out an "entitiesAtCharacter" lens Factor an "entitiesAtCharacter" lens from the one-two step of getting the character position, then getting the entities at that position. --- src/Xanthous/App.hs | 11 +++-------- src/Xanthous/Game.hs | 1 + src/Xanthous/Game/Lenses.hs | 9 +++++++++ 3 files changed, 13 insertions(+), 8 deletions(-) diff --git a/src/Xanthous/App.hs b/src/Xanthous/App.hs index 202f38e868..1c2fbf86f3 100644 --- a/src/Xanthous/App.hs +++ b/src/Xanthous/App.hs @@ -167,8 +167,7 @@ handleCommand Drop = do selectItemFromInventory_ ["drop", "menu"] Cancellable id (say_ ["drop", "nothing"]) $ \(MenuResult item) -> do - charPos <- use characterPosition - entities . EntityMap.atPosition charPos %= (SomeEntity item <|) + entitiesAtCharacter %= (SomeEntity item <|) say ["drop", "dropped"] $ object [ "item" A..= item ] continue @@ -277,9 +276,7 @@ handleCommand Save = do exitSuccess handleCommand GoUp = do - charPos <- use characterPosition - hasStairs <- uses (entities . EntityMap.atPosition charPos) - $ elem (SomeEntity UpStaircase) + hasStairs <- uses entitiesAtCharacter $ elem (SomeEntity UpStaircase) if hasStairs then uses levels prevLevel >>= \case Just levs' -> levels .= levs' @@ -291,9 +288,7 @@ handleCommand GoUp = do continue handleCommand GoDown = do - charPos <- use characterPosition - hasStairs <- uses (entities . EntityMap.atPosition charPos) - $ elem (SomeEntity DownStaircase) + hasStairs <- uses entitiesAtCharacter $ elem (SomeEntity DownStaircase) if hasStairs then do diff --git a/src/Xanthous/Game.hs b/src/Xanthous/Game.hs index a8d096f02f..4ca6688919 100644 --- a/src/Xanthous/Game.hs +++ b/src/Xanthous/Game.hs @@ -16,6 +16,7 @@ module Xanthous.Game , characterPosition , updateCharacterVision , characterVisiblePositions + , entitiesAtCharacter -- * Messages , MessageHistory(..) diff --git a/src/Xanthous/Game/Lenses.hs b/src/Xanthous/Game/Lenses.hs index 8f6053a5ec..dc886f65c6 100644 --- a/src/Xanthous/Game/Lenses.hs +++ b/src/Xanthous/Game/Lenses.hs @@ -10,6 +10,7 @@ module Xanthous.Game.Lenses , characterVisiblePositions , getInitialState , initialStateFromSeed + , entitiesAtCharacter -- * Collisions , Collision(..) @@ -28,6 +29,7 @@ import Xanthous.Data import Xanthous.Data.Levels import qualified Xanthous.Data.EntityMap as EntityMap import Xanthous.Data.EntityMap.Graphics (visiblePositions) +import Xanthous.Data.VectorBag import Xanthous.Entities.Character (Character, mkCharacter) import {-# SOURCE #-} Xanthous.Entities.Entities () -------------------------------------------------------------------------------- @@ -113,3 +115,10 @@ entitiesCollision = join . maximumMay . fmap entityCollision collisionAt :: MonadState GameState m => Position -> m (Maybe Collision) collisionAt p = uses (entities . EntityMap.atPosition p) entitiesCollision + +entitiesAtCharacter :: Lens' GameState (VectorBag SomeEntity) +entitiesAtCharacter = lens getter setter + where + getter gs = gs ^. entities . EntityMap.atPosition (gs ^. characterPosition) + setter gs ents = gs + & entities . EntityMap.atPosition (gs ^. characterPosition) .~ ents -- cgit 1.4.1 From 308c7eb4f6cd1e7bb333e438bb4e6c904d9c20ee Mon Sep 17 00:00:00 2001 From: Griffin Smith Date: Sat, 25 Jan 2020 11:38:37 -0500 Subject: Add a close command Add a close command, to close doors, that works basically the same as the open command. --- src/Xanthous/App.hs | 18 +++++++++++++++++- src/Xanthous/Command.hs | 2 ++ src/Xanthous/Entities/Environment.hs | 4 ++++ src/Xanthous/messages.yaml | 11 ++++++++++- 4 files changed, 33 insertions(+), 2 deletions(-) diff --git a/src/Xanthous/App.hs b/src/Xanthous/App.hs index 1c2fbf86f3..0d4f973d71 100644 --- a/src/Xanthous/App.hs +++ b/src/Xanthous/App.hs @@ -52,7 +52,7 @@ import qualified Xanthous.Entities.Item as Item import Xanthous.Entities.Creature (Creature) import qualified Xanthous.Entities.Creature as Creature import Xanthous.Entities.Environment - (Door, open, locked, GroundMessage(..), Staircase(..)) + (Door, open, closed, locked, GroundMessage(..), Staircase(..)) import Xanthous.Entities.RawTypes ( edible, eatMessage, hitpointsHealed , attackMessage @@ -182,6 +182,7 @@ handleCommand Open = do doors <- uses entities $ entitiesAtPositionWithType @Door pos if | null doors -> say_ ["open", "nothingToOpen"] | any (view $ _2 . locked) doors -> say_ ["open", "locked"] + | all (view $ _2 . open) doors -> say_ ["open", "alreadyOpen"] | otherwise -> do for_ doors $ \(eid, _) -> entities . ix eid . positioned . _SomeEntity . open .= True @@ -190,6 +191,21 @@ handleCommand Open = do stepGame -- TODO continue +handleCommand Close = do + prompt_ @'DirectionPrompt ["close", "prompt"] Cancellable + $ \(DirectionResult dir) -> do + pos <- move dir <$> use characterPosition + doors <- uses entities $ entitiesAtPositionWithType @Door pos + if | null doors -> say_ ["close", "nothingToClose"] + | all (view $ _2 . closed) doors -> say_ ["close", "alreadyClosed"] + | otherwise -> do + for_ doors $ \(eid, _) -> + entities . ix eid . positioned . _SomeEntity . closed .= True + say_ ["close", "success"] + pure () + stepGame -- TODO + continue + handleCommand Look = do prompt_ @'PointOnMap ["look", "prompt"] Cancellable $ \(PointOnMapResult pos) -> diff --git a/src/Xanthous/Command.hs b/src/Xanthous/Command.hs index 7db694575e..e12feaebd0 100644 --- a/src/Xanthous/Command.hs +++ b/src/Xanthous/Command.hs @@ -16,6 +16,7 @@ data Command | PickUp | Drop | Open + | Close | Wait | Eat | Look @@ -37,6 +38,7 @@ commandFromKey (KChar 'p') [MCtrl] = Just PreviousMessage commandFromKey (KChar ',') [] = Just PickUp commandFromKey (KChar 'd') [] = Just Drop commandFromKey (KChar 'o') [] = Just Open +commandFromKey (KChar 'c') [] = Just Close commandFromKey (KChar ';') [] = Just Look commandFromKey (KChar 'e') [] = Just Eat commandFromKey (KChar 'S') [] = Just Save diff --git a/src/Xanthous/Entities/Environment.hs b/src/Xanthous/Entities/Environment.hs index 993714c844..430ce1b7a9 100644 --- a/src/Xanthous/Entities/Environment.hs +++ b/src/Xanthous/Entities/Environment.hs @@ -7,6 +7,7 @@ module Xanthous.Entities.Environment -- * Doors , Door(..) , open + , closed , locked , unlockedDoor @@ -99,6 +100,9 @@ instance Entity Door where entityCollision door | door ^. open = Nothing | otherwise = Just Stop +closed :: Lens' Door Bool +closed = open . involuted not + -- | A closed, unlocked door unlockedDoor :: Door unlockedDoor = Door diff --git a/src/Xanthous/messages.yaml b/src/Xanthous/messages.yaml index 23cc102f5e..4efcc8dbc3 100644 --- a/src/Xanthous/messages.yaml +++ b/src/Xanthous/messages.yaml @@ -35,7 +35,16 @@ open: prompt: Direction to open (hjklybnu.)? success: "You open the door." locked: "That door is locked" - nothingToOpen: "There's nothing to open there" + nothingToOpen: "There's nothing to open there." + alreadyOpen: "That door is already open." + +close: + prompt: Direction to close (hjklybnu.)? + success: + - You close the door. + - You shut the door. + nothingToClose: "There's nothing to close there." + alreadyClosed: "That door is already closed." look: prompt: Select a position on the map to describe (use Enter to confirm) -- cgit 1.4.1 From 782d3880c8da35b48276a874d396d24ca6dc7004 Mon Sep 17 00:00:00 2001 From: Griffin Smith Date: Sat, 8 Feb 2020 13:42:51 -0500 Subject: Block doors being closed on gormlaks Prevent closing doors when there's a gormlak or other entity with the blocksObject attribute set to true on the same tile. There's a message sent here which is grammatically incorrect - it says "The a gormlak blocks the door" - should fix that later. --- src/Xanthous/App.hs | 23 ++++++++++++++++++++++- src/Xanthous/Entities/Creature.hs | 1 + src/Xanthous/Entities/Entities.hs | 1 + src/Xanthous/Game/State.hs | 8 ++++++++ src/Xanthous/messages.yaml | 1 + 5 files changed, 33 insertions(+), 1 deletion(-) diff --git a/src/Xanthous/App.hs b/src/Xanthous/App.hs index 0d4f973d71..d786eb29da 100644 --- a/src/Xanthous/App.hs +++ b/src/Xanthous/App.hs @@ -26,6 +26,7 @@ import Xanthous.Data ( move , Dimensions'(Dimensions) , positioned + , position , Position , Ticks , (|*|) @@ -195,12 +196,32 @@ handleCommand Close = do prompt_ @'DirectionPrompt ["close", "prompt"] Cancellable $ \(DirectionResult dir) -> do pos <- move dir <$> use characterPosition - doors <- uses entities $ entitiesAtPositionWithType @Door pos + (nonDoors, doors) <- uses entities + $ partitionEithers + . toList + . map ( (matching . aside $ _SomeEntity @Door) + . over _2 (view positioned) + ) + . EntityMap.atPositionWithIDs pos if | null doors -> say_ ["close", "nothingToClose"] | all (view $ _2 . closed) doors -> say_ ["close", "alreadyClosed"] + | any (blocksObject . snd) nonDoors -> + say ["close", "blocked"] + $ object [ "entityDescriptions" + A..= ( toSentence . map description . filter blocksObject + . map snd + ) nonDoors + , "blockOrBlocks" + A..= ( if length nonDoors == 1 + then "blocks" + else "block" + :: Text) + ] | otherwise -> do for_ doors $ \(eid, _) -> entities . ix eid . positioned . _SomeEntity . closed .= True + for_ nonDoors $ \(eid, _) -> + entities . ix eid . position %= move dir say_ ["close", "success"] pure () stepGame -- TODO diff --git a/src/Xanthous/Entities/Creature.hs b/src/Xanthous/Entities/Creature.hs index a44b3b2281..cc07b3560c 100644 --- a/src/Xanthous/Entities/Creature.hs +++ b/src/Xanthous/Entities/Creature.hs @@ -66,6 +66,7 @@ instance Brain Creature where instance Entity Creature where blocksVision _ = False + blocksObject _ = True description = view $ creatureType . Raw.description entityChar = view $ creatureType . char entityCollision = const $ Just Combat diff --git a/src/Xanthous/Entities/Entities.hs b/src/Xanthous/Entities/Entities.hs index 1b9f138fe2..710e577be8 100644 --- a/src/Xanthous/Entities/Entities.hs +++ b/src/Xanthous/Entities/Entities.hs @@ -47,6 +47,7 @@ deriving via WithOptions '[ FieldLabelModifier '[Drop 1] ] GameState instance Entity SomeEntity where blocksVision (SomeEntity ent) = blocksVision ent + blocksObject (SomeEntity ent) = blocksObject ent description (SomeEntity ent) = description ent entityChar (SomeEntity ent) = entityChar ent entityCollision (SomeEntity ent) = entityCollision ent diff --git a/src/Xanthous/Game/State.hs b/src/Xanthous/Game/State.hs index e5ee66deac..5c9130de38 100644 --- a/src/Xanthous/Game/State.hs +++ b/src/Xanthous/Game/State.hs @@ -295,6 +295,7 @@ instance class Brain a where step :: Ticks -> Positioned a -> AppM (Positioned a) + -- | Does this entity ever move on its own? entityCanMove :: a -> Bool entityCanMove = const False @@ -326,6 +327,12 @@ class ( Show a, Eq a, Ord a, NFData a , Draw a, Brain a ) => Entity a where blocksVision :: a -> Bool + + -- | Does this entity block a large object from being put in the same tile as + -- it - eg a a door being closed on it + blocksObject :: a -> Bool + blocksObject = const False + description :: a -> Text entityChar :: a -> EntityChar entityCollision :: a -> Maybe Collision @@ -368,6 +375,7 @@ instance Draw SomeEntity where instance Brain SomeEntity where step ticks (Positioned p (SomeEntity ent)) = fmap SomeEntity <$> step ticks (Positioned p ent) + entityCanMove (SomeEntity ent) = entityCanMove ent downcastEntity :: forall (a :: Type). (Typeable a) => SomeEntity -> Maybe a downcastEntity (SomeEntity e) = cast e diff --git a/src/Xanthous/messages.yaml b/src/Xanthous/messages.yaml index 4efcc8dbc3..ed592e2650 100644 --- a/src/Xanthous/messages.yaml +++ b/src/Xanthous/messages.yaml @@ -45,6 +45,7 @@ close: - You shut the door. nothingToClose: "There's nothing to close there." alreadyClosed: "That door is already closed." + blocked: "The {{entityDescriptions}} {{blockOrBlocks}} the door!" look: prompt: Select a position on the map to describe (use Enter to confirm) -- cgit 1.4.1 From 25a1c5ade32ee0dca41b8057f053972e4ab816d7 Mon Sep 17 00:00:00 2001 From: Griffin Smith Date: Sat, 8 Feb 2020 17:24:27 -0500 Subject: Factor out an EntityAttributes type Factor out a new EntityAttributes type from some of the methods of the Entity class, to avoid the proliferation of 1-argument boolean methods on the entity class that always have to be forwarded through the Entity instance for SomeEntity if they have defaults (forgetting to do which has wasted tons of my time up to this point). Currently blocksVision, blocksObject, and collision are all in there. --- src/Xanthous/App.hs | 19 ++++---- src/Xanthous/Data/Entities.hs | 68 ++++++++++++++++++++++++++++ src/Xanthous/Data/EntityMap/Graphics.hs | 4 +- src/Xanthous/Entities/Character.hs | 3 +- src/Xanthous/Entities/Creature.hs | 5 +- src/Xanthous/Entities/Entities.hs | 3 +- src/Xanthous/Entities/Environment.hs | 10 ++-- src/Xanthous/Entities/Item.hs | 1 - src/Xanthous/Game/State.hs | 21 ++------- test/Spec.hs | 2 + test/Xanthous/Data/EntitiesSpec.hs | 28 ++++++++++++ test/Xanthous/Data/EntityMap/GraphicsSpec.hs | 1 - xanthous.cabal | 5 +- 13 files changed, 132 insertions(+), 38 deletions(-) create mode 100644 src/Xanthous/Data/Entities.hs create mode 100644 test/Xanthous/Data/EntitiesSpec.hs diff --git a/src/Xanthous/App.hs b/src/Xanthous/App.hs index d786eb29da..ab7c8f8e50 100644 --- a/src/Xanthous/App.hs +++ b/src/Xanthous/App.hs @@ -35,6 +35,7 @@ import Xanthous.Data.EntityMap (EntityMap) import qualified Xanthous.Data.EntityMap as EntityMap import Xanthous.Data.Levels (prevLevel, nextLevel) import qualified Xanthous.Data.Levels as Levels +import Xanthous.Data.Entities (blocksObject) import Xanthous.Game import Xanthous.Game.State import Xanthous.Game.Draw (drawGame) @@ -205,17 +206,19 @@ handleCommand Close = do . EntityMap.atPositionWithIDs pos if | null doors -> say_ ["close", "nothingToClose"] | all (view $ _2 . closed) doors -> say_ ["close", "alreadyClosed"] - | any (blocksObject . snd) nonDoors -> + | any (view blocksObject . entityAttributes . snd) nonDoors -> say ["close", "blocked"] $ object [ "entityDescriptions" - A..= ( toSentence . map description . filter blocksObject - . map snd - ) nonDoors + A..= ( toSentence + . map description + . filter (view blocksObject . entityAttributes) + . map snd + ) nonDoors , "blockOrBlocks" - A..= ( if length nonDoors == 1 - then "blocks" - else "block" - :: Text) + A..= ( if length nonDoors == 1 + then "blocks" + else "block" + :: Text) ] | otherwise -> do for_ doors $ \(eid, _) -> diff --git a/src/Xanthous/Data/Entities.hs b/src/Xanthous/Data/Entities.hs new file mode 100644 index 0000000000..39953410f2 --- /dev/null +++ b/src/Xanthous/Data/Entities.hs @@ -0,0 +1,68 @@ +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE RecordWildCards #-} +-------------------------------------------------------------------------------- +module Xanthous.Data.Entities + ( -- * Collisions + Collision(..) + , _Stop + , _Combat + -- * Entity Attributes + , EntityAttributes(..) + , blocksVision + , blocksObject + , collision + , defaultEntityAttributes + ) where +-------------------------------------------------------------------------------- +import Xanthous.Prelude +-------------------------------------------------------------------------------- +import Data.Aeson (ToJSON(..), FromJSON(..), (.:?), (.!=), withObject) +import Data.Aeson.Generic.DerivingVia +import Xanthous.Util.QuickCheck (GenericArbitrary(..)) +import Test.QuickCheck +-------------------------------------------------------------------------------- + +data Collision + = Stop -- ^ Can't move through this + | Combat -- ^ Moving into this equates to hitting it with a stick + deriving stock (Show, Eq, Ord, Generic) + deriving anyclass (NFData, CoArbitrary, Function) + deriving Arbitrary via GenericArbitrary Collision + deriving (ToJSON, FromJSON) + via WithOptions '[ AllNullaryToStringTag 'True ] + Collision +makePrisms ''Collision + +-- | Attributes of an entity +data EntityAttributes = EntityAttributes + { _blocksVision :: Bool + -- | Does this entity block a large object from being put in the same tile as + -- it - eg a a door being closed on it + , _blocksObject :: Bool + -- | What type of collision happens when moving into this entity? + , _collision :: Collision + } + deriving stock (Show, Eq, Ord, Generic) + deriving anyclass (NFData, CoArbitrary, Function) + deriving Arbitrary via GenericArbitrary EntityAttributes + deriving (ToJSON) + via WithOptions '[ FieldLabelModifier '[Drop 1] ] + EntityAttributes +makeLenses ''EntityAttributes + +instance FromJSON EntityAttributes where + parseJSON = withObject "EntityAttributes" $ \o -> do + _blocksVision <- o .:? "blocksVision" + .!= _blocksVision defaultEntityAttributes + _blocksObject <- o .:? "blocksObject" + .!= _blocksObject defaultEntityAttributes + _collision <- o .:? "collision" + .!= _collision defaultEntityAttributes + pure EntityAttributes {..} + +defaultEntityAttributes :: EntityAttributes +defaultEntityAttributes = EntityAttributes + { _blocksVision = False + , _blocksObject = False + , _collision = Stop + } diff --git a/src/Xanthous/Data/EntityMap/Graphics.hs b/src/Xanthous/Data/EntityMap/Graphics.hs index 30c6d09673..9064855bdb 100644 --- a/src/Xanthous/Data/EntityMap/Graphics.hs +++ b/src/Xanthous/Data/EntityMap/Graphics.hs @@ -11,6 +11,7 @@ import Xanthous.Prelude hiding (lines) -------------------------------------------------------------------------------- import Xanthous.Util (takeWhileInclusive) import Xanthous.Data +import Xanthous.Data.Entities import Xanthous.Data.EntityMap import Xanthous.Game.State import Xanthous.Util.Graphics (circle, line) @@ -29,7 +30,8 @@ linesOfSight -> [[(Position, Vector (EntityID, e))]] linesOfSight (view _Position -> pos) visionRadius em = entitiesOnLines - <&> takeWhileInclusive (none (blocksVision . snd) . snd) + <&> takeWhileInclusive + (none (view blocksVision . entityAttributes . snd) . snd) where radius = circle pos $ fromIntegral visionRadius lines = line pos <$> radius diff --git a/src/Xanthous/Entities/Character.hs b/src/Xanthous/Entities/Character.hs index 43d4f8a529..424488828c 100644 --- a/src/Xanthous/Entities/Character.hs +++ b/src/Xanthous/Entities/Character.hs @@ -84,7 +84,7 @@ instance Draw WieldedItem where draw = draw . view wieldedItem instance Entity WieldedItem where - blocksVision = blocksVision . view wieldedItem + entityAttributes = entityAttributes . view wieldedItem description = description . view wieldedItem entityChar = entityChar . view wieldedItem @@ -232,7 +232,6 @@ instance Brain Character where else hp + hitpointRecoveryRate |*| ticks instance Entity Character where - blocksVision _ = False description _ = "yourself" entityChar _ = "@" diff --git a/src/Xanthous/Entities/Creature.hs b/src/Xanthous/Entities/Creature.hs index cc07b3560c..e95e9f0b98 100644 --- a/src/Xanthous/Entities/Creature.hs +++ b/src/Xanthous/Entities/Creature.hs @@ -40,6 +40,7 @@ import Xanthous.Entities.RawTypes hiding import qualified Xanthous.Entities.RawTypes as Raw import Xanthous.Game.State import Xanthous.Data +import Xanthous.Data.Entities import Xanthous.Entities.Creature.Hippocampus -------------------------------------------------------------------------------- @@ -65,8 +66,8 @@ instance Brain Creature where entityCanMove = const True instance Entity Creature where - blocksVision _ = False - blocksObject _ = True + entityAttributes _ = defaultEntityAttributes + & blocksObject .~ True description = view $ creatureType . Raw.description entityChar = view $ creatureType . char entityCollision = const $ Just Combat diff --git a/src/Xanthous/Entities/Entities.hs b/src/Xanthous/Entities/Entities.hs index 710e577be8..55991fc284 100644 --- a/src/Xanthous/Entities/Entities.hs +++ b/src/Xanthous/Entities/Entities.hs @@ -46,8 +46,7 @@ deriving via WithOptions '[ FieldLabelModifier '[Drop 1] ] GameState instance FromJSON GameState instance Entity SomeEntity where - blocksVision (SomeEntity ent) = blocksVision ent - blocksObject (SomeEntity ent) = blocksObject ent + entityAttributes (SomeEntity ent) = entityAttributes ent description (SomeEntity ent) = description ent entityChar (SomeEntity ent) = entityChar ent entityCollision (SomeEntity ent) = entityCollision ent diff --git a/src/Xanthous/Entities/Environment.hs b/src/Xanthous/Entities/Environment.hs index 430ce1b7a9..b45a91eabe 100644 --- a/src/Xanthous/Entities/Environment.hs +++ b/src/Xanthous/Entities/Environment.hs @@ -29,6 +29,7 @@ import Data.Aeson.Generic.DerivingVia -------------------------------------------------------------------------------- import Xanthous.Entities.Draw.Util import Xanthous.Data +import Xanthous.Data.Entities import Xanthous.Game.State import Xanthous.Util.QuickCheck -------------------------------------------------------------------------------- @@ -48,7 +49,9 @@ instance FromJSON Wall where instance Brain Wall where step = brainVia Brainless instance Entity Wall where - blocksVision _ = True + entityAttributes _ = defaultEntityAttributes + & blocksVision .~ True + & blocksObject .~ True description _ = "a wall" entityChar _ = "┼" @@ -93,7 +96,8 @@ instance Draw Door where instance Brain Door where step = brainVia Brainless instance Entity Door where - blocksVision = not . view open + entityAttributes door = defaultEntityAttributes + & blocksVision .~ not (door ^. open) description door | door ^. open = "an open door" | otherwise = "a closed door" entityChar _ = "d" @@ -127,7 +131,6 @@ newtype GroundMessage = GroundMessage Text instance Brain GroundMessage where step = brainVia Brainless instance Entity GroundMessage where - blocksVision = const False description = const "a message on the ground. Press r. to read it." entityChar = const "≈" entityCollision = const Nothing @@ -150,7 +153,6 @@ instance Draw Staircase where draw DownStaircase = str ">" instance Entity Staircase where - blocksVision = const False description UpStaircase = "a staircase leading upwards" description DownStaircase = "a staircase leading downwards" entityChar UpStaircase = "<" diff --git a/src/Xanthous/Entities/Item.hs b/src/Xanthous/Entities/Item.hs index cedd75507a..b50a5eab80 100644 --- a/src/Xanthous/Entities/Item.hs +++ b/src/Xanthous/Entities/Item.hs @@ -38,7 +38,6 @@ instance Arbitrary Item where arbitrary = Item <$> arbitrary instance Entity Item where - blocksVision _ = False description = view $ itemType . Raw.description entityChar = view $ itemType . Raw.char entityCollision = const Nothing diff --git a/src/Xanthous/Game/State.hs b/src/Xanthous/Game/State.hs index 5c9130de38..100204c755 100644 --- a/src/Xanthous/Game/State.hs +++ b/src/Xanthous/Game/State.hs @@ -92,6 +92,7 @@ import Xanthous.Data.Levels import Xanthous.Data.EntityMap (EntityMap, EntityID) import Xanthous.Data.EntityChar import Xanthous.Data.VectorBag +import Xanthous.Data.Entities import Xanthous.Orphans () import Xanthous.Game.Prompt import Xanthous.Resource @@ -315,24 +316,12 @@ brainVia _ ticks = fmap coerce . step ticks . coerce @_ @(Positioned brain) -------------------------------------------------------------------------------- - -data Collision - = Stop -- ^ Can't move through this - | Combat -- ^ Moving into this equates to hitting it with a stick - deriving stock (Show, Eq, Ord, Generic) - deriving anyclass (NFData) - class ( Show a, Eq a, Ord a, NFData a , ToJSON a, FromJSON a , Draw a, Brain a ) => Entity a where - blocksVision :: a -> Bool - - -- | Does this entity block a large object from being put in the same tile as - -- it - eg a a door being closed on it - blocksObject :: a -> Bool - blocksObject = const False - + entityAttributes :: a -> EntityAttributes + entityAttributes = const defaultEntityAttributes description :: a -> Text entityChar :: a -> EntityChar entityCollision :: a -> Maybe Collision @@ -406,8 +395,8 @@ instance , Draw entity, Brain entity ) => Entity (DeriveEntity blocksVision description entityChar entity) where - - blocksVision _ = boolVal @blocksVision + entityAttributes _ = defaultEntityAttributes + & blocksVision .~ boolVal @blocksVision description _ = pack . symbolVal $ Proxy @description entityChar _ = fromString . symbolVal $ Proxy @entityChar diff --git a/test/Spec.hs b/test/Spec.hs index ba8f868a81..3790f3ce65 100644 --- a/test/Spec.hs +++ b/test/Spec.hs @@ -5,6 +5,7 @@ import qualified Xanthous.Data.EntityCharSpec import qualified Xanthous.Data.EntityMapSpec import qualified Xanthous.Data.EntityMap.GraphicsSpec import qualified Xanthous.Data.LevelsSpec +import qualified Xanthous.Data.EntitiesSpec import qualified Xanthous.DataSpec import qualified Xanthous.Entities.RawsSpec import qualified Xanthous.GameSpec @@ -26,6 +27,7 @@ test = testGroup "Xanthous" , Xanthous.Data.EntityMapSpec.test , Xanthous.Data.EntityMap.GraphicsSpec.test , Xanthous.Data.LevelsSpec.test + , Xanthous.Data.EntitiesSpec.test , Xanthous.Entities.RawsSpec.test , Xanthous.GameSpec.test , Xanthous.Generators.UtilSpec.test diff --git a/test/Xanthous/Data/EntitiesSpec.hs b/test/Xanthous/Data/EntitiesSpec.hs new file mode 100644 index 0000000000..e403503743 --- /dev/null +++ b/test/Xanthous/Data/EntitiesSpec.hs @@ -0,0 +1,28 @@ +-------------------------------------------------------------------------------- +module Xanthous.Data.EntitiesSpec (main, test) where +-------------------------------------------------------------------------------- +import Test.Prelude +-------------------------------------------------------------------------------- +import qualified Data.Aeson as JSON +-------------------------------------------------------------------------------- +import Xanthous.Data.Entities +-------------------------------------------------------------------------------- + +main :: IO () +main = defaultMain test + +test :: TestTree +test = testGroup "Xanthous.Data.Entities" + [ testGroup "Collision" + [ testProperty "JSON round-trip" $ \(c :: Collision) -> + JSON.decode (JSON.encode c) === Just c + , testGroup "JSON encoding examples" + [ testCase "Stop" $ JSON.encode Stop @?= "\"Stop\"" + , testCase "Combat" $ JSON.encode Combat @?= "\"Combat\"" + ] + ] + , testGroup "EntityAttributes" + [ testProperty "JSON round-trip" $ \(ea :: EntityAttributes) -> + JSON.decode (JSON.encode ea) === Just ea + ] + ] diff --git a/test/Xanthous/Data/EntityMap/GraphicsSpec.hs b/test/Xanthous/Data/EntityMap/GraphicsSpec.hs index 6b736be4ee..9347a1c1b5 100644 --- a/test/Xanthous/Data/EntityMap/GraphicsSpec.hs +++ b/test/Xanthous/Data/EntityMap/GraphicsSpec.hs @@ -42,6 +42,5 @@ instance Brain TestEntity where step _ = pure instance Draw TestEntity instance Entity TestEntity where - blocksVision _ = False description _ = "" entityChar _ = "e" diff --git a/xanthous.cabal b/xanthous.cabal index 702496b290..3dc2de467f 100644 --- a/xanthous.cabal +++ b/xanthous.cabal @@ -4,7 +4,7 @@ cabal-version: 1.12 -- -- see: https://github.com/sol/hpack -- --- hash: eb0a7cd56cc2ea885be582c8ea7113a5f50f96a8d1b12ed27ca1a0271a45ad03 +-- hash: 09d294830fde12021527c15ba1e1698afdec092a16c4171ee67dce3256fe0d96 name: xanthous version: 0.1.0.0 @@ -34,6 +34,7 @@ library Xanthous.App Xanthous.Command Xanthous.Data + Xanthous.Data.Entities Xanthous.Data.EntityChar Xanthous.Data.EntityMap Xanthous.Data.EntityMap.Graphics @@ -141,6 +142,7 @@ executable xanthous Xanthous.App Xanthous.Command Xanthous.Data + Xanthous.Data.Entities Xanthous.Data.EntityChar Xanthous.Data.EntityMap Xanthous.Data.EntityMap.Graphics @@ -245,6 +247,7 @@ test-suite test main-is: Spec.hs other-modules: Test.Prelude + Xanthous.Data.EntitiesSpec Xanthous.Data.EntityCharSpec Xanthous.Data.EntityMap.GraphicsSpec Xanthous.Data.EntityMapSpec -- cgit 1.4.1 From f6eeccbb0fd833b5d6d710e87e9c41d432341b9a Mon Sep 17 00:00:00 2001 From: Griffin Smith Date: Mon, 17 Feb 2020 13:14:12 -0500 Subject: Add Staircase to the list of all entities Forgot to do this when I added staircases - this is necessary for loading saved games. --- src/Xanthous/Entities/Entities.hs | 2 ++ 1 file changed, 2 insertions(+) diff --git a/src/Xanthous/Entities/Entities.hs b/src/Xanthous/Entities/Entities.hs index 55991fc284..62e6e15c98 100644 --- a/src/Xanthous/Entities/Entities.hs +++ b/src/Xanthous/Entities/Entities.hs @@ -26,6 +26,7 @@ instance Arbitrary SomeEntity where , SomeEntity <$> arbitrary @Wall , SomeEntity <$> arbitrary @Door , SomeEntity <$> arbitrary @GroundMessage + , SomeEntity <$> arbitrary @Staircase ] instance FromJSON SomeEntity where @@ -38,6 +39,7 @@ instance FromJSON SomeEntity where "Wall" -> SomeEntity @Wall <$> obj .: "data" "Door" -> SomeEntity @Door <$> obj .: "data" "GroundMessage" -> SomeEntity @GroundMessage <$> obj .: "data" + "Staircase" -> SomeEntity @Staircase <$> obj .: "data" _ -> fail . unpack $ "Invalid entity type \"" <> entityType <> "\"" deriving via WithOptions '[ FieldLabelModifier '[Drop 1] ] GameLevel -- cgit 1.4.1 From 69ccf3a77de7b11ea1c8c11d96ae14595b204589 Mon Sep 17 00:00:00 2001 From: Griffin Smith Date: Mon, 17 Feb 2020 13:14:36 -0500 Subject: Fix argument order to drawEntities I had swapped the order of isVisible and isRevealed, which was causing not-currently-visible gormlaks to still be rendered. --- src/Xanthous/Game/Draw.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Xanthous/Game/Draw.hs b/src/Xanthous/Game/Draw.hs index 8a86101d99..a9b55945ff 100644 --- a/src/Xanthous/Game/Draw.hs +++ b/src/Xanthous/Game/Draw.hs @@ -95,9 +95,9 @@ drawMap game = viewport Resource.MapViewport Both . cursorPosition game $ drawEntities + (`member` characterVisiblePositions game) (\pos -> (game ^. debugState . allRevealed) || (pos `member` (game ^. revealedPositions))) - (`member` characterVisiblePositions game) -- FIXME: this will break down as soon as creatures can walk around on their -- own, since we don't want to render things walking around when the -- character can't see them -- cgit 1.4.1 From 1265155ae43f59c6bbd4b25f2747515cdf416622 Mon Sep 17 00:00:00 2001 From: Griffin Smith Date: Mon, 17 Feb 2020 13:24:31 -0500 Subject: Don't run initEvent when loading the game Rather than having a single sentWelcome boolean, avoid running the initEvent entirely when loading an already-initialized game. Among other things, this stops us from re-generating a level and then merging it with the existing one when the game is loaded (oops). --- src/Main.hs | 6 +++--- src/Xanthous/App.hs | 24 ++++++++++++++---------- src/Xanthous/Game/Arbitrary.hs | 1 - src/Xanthous/Game/Lenses.hs | 1 - src/Xanthous/Game/State.hs | 3 --- 5 files changed, 17 insertions(+), 18 deletions(-) diff --git a/src/Main.hs b/src/Main.hs index b11f1b9f49..95cfc9edba 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -9,7 +9,7 @@ import Control.Exception (finally) import System.Exit (die) -------------------------------------------------------------------------------- import qualified Xanthous.Game as Game -import Xanthous.App (makeApp) +import Xanthous.App import Xanthous.Generators ( GeneratorInput , parseGeneratorInput @@ -94,7 +94,7 @@ thanks = putStr "\n\n" >> putStrLn "Thanks for playing Xanthous!" runGame :: RunParams -> IO () runGame rparams = do - app <- makeApp + app <- makeApp NewGame gameSeed <- maybe getRandom pure $ seed rparams when (isNothing $ seed rparams) . putStrLn @@ -113,7 +113,7 @@ runGame rparams = do loadGame :: FilePath -> IO () loadGame saveFile = do - app <- makeApp + app <- makeApp LoadGame gameState <- maybe (die "Invalid save file!") pure =<< Game.loadGame . fromStrict <$> readFile @IO saveFile _game' <- gameState `deepseq` defaultMain app gameState `finally` thanks diff --git a/src/Xanthous/App.hs b/src/Xanthous/App.hs index ab7c8f8e50..24073c5109 100644 --- a/src/Xanthous/App.hs +++ b/src/Xanthous/App.hs @@ -2,7 +2,10 @@ {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE RecordWildCards #-} -------------------------------------------------------------------------------- -module Xanthous.App (makeApp) where +module Xanthous.App + ( makeApp + , RunType(..) + ) where -------------------------------------------------------------------------------- import Xanthous.Prelude import Brick hiding (App, halt, continue, raw) @@ -66,12 +69,17 @@ import qualified Xanthous.Generators.Dungeon as Dungeon type App = Brick.App GameState () Name -makeApp :: IO App -makeApp = pure $ Brick.App +data RunType = NewGame | LoadGame + deriving stock (Eq) + +makeApp :: RunType -> IO App +makeApp rt = pure $ Brick.App { appDraw = drawGame , appChooseCursor = const headMay , appHandleEvent = \game event -> runAppM (handleEvent event) game - , appStartEvent = runAppM $ startEvent >> get + , appStartEvent = case rt of + NewGame -> runAppM $ startEvent >> get + LoadGame -> pure , appAttrMap = const $ attrMap defAttr [] } @@ -86,12 +94,8 @@ startEvent = do Nothing -> prompt_ @'StringPrompt ["character", "namePrompt"] Uncancellable $ \(StringResult s) -> do character . characterName ?= s - whenM (uses sentWelcome not) $ say ["welcome"] =<< use character - sentWelcome .= True - Just n -> - whenM (uses sentWelcome not) $ do - say ["welcome"] $ object [ "characterName" A..= n ] - sentWelcome .= True + say ["welcome"] =<< use character + Just n -> say ["welcome"] $ object [ "characterName" A..= n ] initLevel :: AppM () initLevel = do diff --git a/src/Xanthous/Game/Arbitrary.hs b/src/Xanthous/Game/Arbitrary.hs index 4a64a12be0..886a8c03d7 100644 --- a/src/Xanthous/Game/Arbitrary.hs +++ b/src/Xanthous/Game/Arbitrary.hs @@ -40,7 +40,6 @@ instance Arbitrary GameState where let _promptState = NoPrompt -- TODO _activePanel <- arbitrary _debugState <- arbitrary - _sentWelcome <- arbitrary pure $ GameState {..} diff --git a/src/Xanthous/Game/Lenses.hs b/src/Xanthous/Game/Lenses.hs index dc886f65c6..017d53652c 100644 --- a/src/Xanthous/Game/Lenses.hs +++ b/src/Xanthous/Game/Lenses.hs @@ -56,7 +56,6 @@ initialStateFromSeed seed = _debugState = DebugState { _allRevealed = False } - _sentWelcome = False in GameState {..} diff --git a/src/Xanthous/Game/State.hs b/src/Xanthous/Game/State.hs index 100204c755..80137df7a7 100644 --- a/src/Xanthous/Game/State.hs +++ b/src/Xanthous/Game/State.hs @@ -12,7 +12,6 @@ module Xanthous.Game.State , messageHistory , randomGen , activePanel - , sentWelcome , promptState , characterEntityID , GamePromptState(..) @@ -434,7 +433,6 @@ data GameState = GameState , _characterEntityID :: !EntityID , _messageHistory :: !MessageHistory , _randomGen :: !StdGen - , _sentWelcome :: Bool -- | The active panel displayed in the UI, if any , _activePanel :: !(Maybe Panel) @@ -463,7 +461,6 @@ instance Eq GameState where , gs ^. revealedPositions , gs ^. characterEntityID , gs ^. messageHistory - , gs ^. sentWelcome , gs ^. activePanel , gs ^. debugState ) -- cgit 1.4.1 From 22b7a9be84b26d3c40d065fc0d699ad1ebcadb3c Mon Sep 17 00:00:00 2001 From: Griffin Smith Date: Mon, 17 Feb 2020 18:01:57 -0500 Subject: Drop Rasterific for non-filled circles Rasterific appears to generate some pretty surprising, if not completely wrong, circles at especially low sizes - this was resulting in unexpected behavior with vision calculation, including the character never being able to see directly to the left of them, among other things. This moves back to the old midpoint circle algorithm I pulled off of rosetta code, but only for the non-filled circle. The filled circle is still using the wonky algorithm for now, but at some point I'd love to refactor it such that empty circles are eg always a subset of non-filled circles. --- src/Xanthous/Data.hs | 23 ++++++++---- src/Xanthous/Data/EntityMap/Graphics.hs | 12 +++++-- src/Xanthous/Util/Graphics.hs | 43 +++++++++++++++++----- test/Xanthous/Data/EntityMap/GraphicsSpec.hs | 36 ++++++++++++------- test/Xanthous/Util/GraphicsSpec.hs | 54 +++++++++++++++++----------- 5 files changed, 117 insertions(+), 51 deletions(-) diff --git a/src/Xanthous/Data.hs b/src/Xanthous/Data.hs index 1874b45e90..2cfb8204d5 100644 --- a/src/Xanthous/Data.hs +++ b/src/Xanthous/Data.hs @@ -68,6 +68,7 @@ module Xanthous.Data , move , asPosition , directionOf + , Cardinal(..) -- * , Corner(..) @@ -86,12 +87,12 @@ module Xanthous.Data , Hitpoints(..) ) where -------------------------------------------------------------------------------- -import Xanthous.Prelude hiding (Left, Down, Right, (.=)) +import Xanthous.Prelude hiding (Left, Down, Right, (.=), elements) -------------------------------------------------------------------------------- import Linear.V2 hiding (_x, _y) import qualified Linear.V2 as L import Linear.V4 hiding (_x, _y) -import Test.QuickCheck (Arbitrary, CoArbitrary, Function) +import Test.QuickCheck (Arbitrary, CoArbitrary, Function, elements) import Test.QuickCheck.Arbitrary.Generic import Data.Group import Brick (Location(Location), Edges(..)) @@ -267,11 +268,9 @@ data Direction where DownLeft :: Direction DownRight :: Direction Here :: Direction - deriving stock (Show, Eq, Generic) - -instance Arbitrary Direction where - arbitrary = genericArbitrary - shrink = genericShrink + deriving stock (Show, Eq, Ord, Generic) + deriving anyclass (CoArbitrary, Function, NFData) + deriving Arbitrary via GenericArbitrary Direction instance Opposite Direction where opposite Up = Down @@ -330,6 +329,16 @@ stepTowards (view _Position -> p₁) (view _Position -> p₂) let (_:p:_) = line p₁ p₂ in _Position # p +-- | Newtype controlling arbitrary generation to only include cardinal +-- directions ('Up', 'Down', 'Left', 'Right') +newtype Cardinal = Cardinal { getCardinal :: Direction } + deriving stock (Eq, Show, Ord, Generic) + deriving anyclass (NFData, Function, CoArbitrary) + deriving newtype (Opposite) + +instance Arbitrary Cardinal where + arbitrary = Cardinal <$> elements [Up, Down, Left, Right] + -------------------------------------------------------------------------------- data Corner diff --git a/src/Xanthous/Data/EntityMap/Graphics.hs b/src/Xanthous/Data/EntityMap/Graphics.hs index 9064855bdb..d523c0555e 100644 --- a/src/Xanthous/Data/EntityMap/Graphics.hs +++ b/src/Xanthous/Data/EntityMap/Graphics.hs @@ -17,8 +17,16 @@ import Xanthous.Game.State import Xanthous.Util.Graphics (circle, line) -------------------------------------------------------------------------------- -visiblePositions :: Entity e => Position -> Word -> EntityMap e -> Set Position -visiblePositions pos radius = setFromList . positions . visibleEntities pos radius +-- | Returns a set of positions that are visible, when taking into account +-- 'blocksVision', from the given position, within the given radius. +visiblePositions + :: Entity e + => Position + -> Word -- ^ Vision radius + -> EntityMap e + -> Set Position +visiblePositions pos radius + = setFromList . positions . visibleEntities pos radius -- | Returns a list of individual lines of sight, each of which is a list of -- entities at positions on that line of sight diff --git a/src/Xanthous/Util/Graphics.hs b/src/Xanthous/Util/Graphics.hs index fc704abf64..ea1dbffe83 100644 --- a/src/Xanthous/Util/Graphics.hs +++ b/src/Xanthous/Util/Graphics.hs @@ -30,16 +30,45 @@ import Linear.V2 -------------------------------------------------------------------------------- -circle :: (Num i, Integral i, Ix i) +-- | Generate a circle centered at the given point and with the given radius +-- using the . +-- +-- Code taken from +circle :: (Num i, Ord i) => (i, i) -- ^ center -> i -- ^ radius -> [(i, i)] -circle (ox, oy) radius - = pointsFromRaster (ox + radius) (oy + radius) - $ stroke 1 JoinRound (CapRound, CapRound) - $ Raster.circle (Raster.V2 (fromIntegral ox) (fromIntegral oy)) - $ fromIntegral radius +circle (x₀, y₀) radius + -- Four initial points, plus the generated points + = (x₀, y₀ + radius) : (x₀, y₀ - radius) : (x₀ + radius, y₀) : (x₀ - radius, y₀) : points + where + -- Creates the (x, y) octet offsets, then maps them to absolute points in all octets. + points = concatMap generatePoints $ unfoldr step initialValues + + generatePoints (x, y) + = [ (x₀ `xop` x', y₀ `yop` y') + | (x', y') <- [(x, y), (y, x)] + , xop <- [(+), (-)] + , yop <- [(+), (-)] + ] + initialValues = (1 - radius, 1, (-2) * radius, 0, radius) + + step (f, ddf_x, ddf_y, x, y) + | x >= y = Nothing + | otherwise = Just ((x', y'), (f', ddf_x', ddf_y', x', y')) + where + (f', ddf_y', y') | f >= 0 = (f + ddf_y' + ddf_x', ddf_y + 2, y - 1) + | otherwise = (f + ddf_x, ddf_y, y) + ddf_x' = ddf_x + 2 + x' = x + 1 + + +-- | Generate a *filled* circle centered at the given point and with the given +-- radius using the Rasterific package. Note that since this uses a different +-- implementation, this is not a strict superset of the 'circle' function +-- (unfortunately - would like to make that not the case!) filledCircle :: (Num i, Integral i, Ix i) => (i, i) -- ^ center -> i -- ^ radius @@ -72,8 +101,6 @@ pointsFromRaster w h raster $ renderDrawing @Word8 (fromIntegral w) (fromIntegral h) 0 $ withTexture (uniformTexture 1) raster - - -- | Draw a line between two points using Bresenham's line drawing algorithm -- -- Code taken from diff --git a/test/Xanthous/Data/EntityMap/GraphicsSpec.hs b/test/Xanthous/Data/EntityMap/GraphicsSpec.hs index 9347a1c1b5..55ae0d79db 100644 --- a/test/Xanthous/Data/EntityMap/GraphicsSpec.hs +++ b/test/Xanthous/Data/EntityMap/GraphicsSpec.hs @@ -8,6 +8,7 @@ import Xanthous.Game.State import Xanthous.Data import Xanthous.Data.EntityMap import Xanthous.Data.EntityMap.Graphics +import Xanthous.Entities.Environment (Wall(..)) -------------------------------------------------------------------------------- main :: IO () @@ -16,19 +17,28 @@ main = defaultMain test test :: TestTree test = testGroup "Xanthous.Data.EntityMap.Graphics" [ testGroup "visiblePositions" - [ testCase "non-contiguous bug 1" $ - let charPos = Position 20 20 - gormlakPos = Position 17 19 - em = insertAt gormlakPos TestEntity - . insertAt charPos TestEntity - $ mempty - visPositions = visiblePositions charPos 12 em - in (gormlakPos `member` visPositions) @? - ( "not (" - <> show gormlakPos <> " `member` " - <> show visPositions - <> ")" - ) + [ testProperty "one step in each cardinal direction is always visible" + $ \pos (Cardinal dir) (Positive r) (wallPositions :: Set Position)-> + let em = review _EntityMap . map (, Wall) . toList $ wallPositions + em' = em & atPosition (move dir pos) %~ (Wall <|) + poss = visiblePositions pos r em' + in counterexample ("visiblePositions: " <> show poss) + $ move dir pos `member` poss + , testGroup "bugs" + [ testCase "non-contiguous bug 1" + $ let charPos = Position 20 20 + gormlakPos = Position 17 19 + em = insertAt gormlakPos TestEntity + . insertAt charPos TestEntity + $ mempty + visPositions = visiblePositions charPos 12 em + in (gormlakPos `member` visPositions) @? + ( "not (" + <> show gormlakPos <> " `member` " + <> show visPositions + <> ")" + ) + ] ] ] diff --git a/test/Xanthous/Util/GraphicsSpec.hs b/test/Xanthous/Util/GraphicsSpec.hs index ecd6dbe191..a1eaf73e28 100644 --- a/test/Xanthous/Util/GraphicsSpec.hs +++ b/test/Xanthous/Util/GraphicsSpec.hs @@ -13,30 +13,40 @@ main = defaultMain test test :: TestTree test = testGroup "Xanthous.Util.Graphics" [ testGroup "circle" - [ testCase "radius 12, origin 0" + [ testCase "radius 1, origin 2,2" + {- + | | 0 | 1 | 2 | 3 | + |---+---+---+---+---| + | 0 | | | | | + | 1 | | | x | | + | 2 | | x | | x | + | 3 | | | x | | + -} + $ (sort . unique @[] @[_]) (circle @Int (2, 2) 1) + @?= [ (1, 2) + , (2, 1), (2, 3) + , (3, 2) + ] + , testCase "radius 12, origin 0" $ (sort . unique @[] @[_]) (circle @Int (0, 0) 12) - @?= [ (1,12) - , (2,12) - , (3,12) - , (4,12) - , (5,12) - , (6,11) - , (7,10) - , (7,11) - , (8,10) - , (9,9) - , (10,7) - , (10,8) - , (11,6) - , (11,7) - , (12,1) - , (12,2) - , (12,3) - , (12,4) - , (12,5) + @?= [ (-12,-4),(-12,-3),(-12,-2),(-12,-1),(-12,0),(-12,1),(-12,2) + , (-12,3),(-12,4),(-11,-6),(-11,-5),(-11,5),(-11,6),(-10,-7),(-10,7) + , (-9,-9),(-9,-8),(-9,8),(-9,9),(-8,-9),(-8,9),(-7,-10),(-7,10) + , (-6,-11),(-6,11),(-5,-11),(-5 ,11),(-4,-12),(-4,12),(-3,-12),(-3,12) + , (-2,-12),(-2,12),(-1,-12),(-1,12),(0,-12),(0,12),(1,-12),(1,12) + , (2,-12),(2,12),(3,-12),(3,12),(4,-12),(4,12),(5,-11),(5 ,11),(6,-11) + , (6,11),(7,-10),(7,10),(8,-9),(8,9),(9,-9),(9,-8),(9,8),(9,9),(10,-7) + , (10,7),(11,-6),(11,-5),(11,5),(11,6),(12,-4),(12,-3),(12,-2),(12,-1) + , (12,0), (12,1),(12,2),(12,3),(12,4) ] - ] + -- , testProperty "is a subset of filledCircle" $ \center radius -> + -- let circ = circle @Int center radius + -- filledCirc = filledCircle center radius + -- in counterexample ( "circle: " <> show circ + -- <> "\nfilledCircle: " <> show filledCirc) + -- $ setFromList circ `isSubsetOf` setFromList filledCirc + ] , testGroup "line" [ testProperty "starts and ends at the start and end points" $ \start end -> let ℓ = line @Int start end @@ -44,3 +54,5 @@ test = testGroup "Xanthous.Util.Graphics" $ length ℓ > 2 ==> (head ℓ === start) .&&. (head (reverse ℓ) === end) ] ] + +-------------------------------------------------------------------------------- -- cgit 1.4.1 From 555257be5057c1f5b548c5165ae024e63abdf2a6 Mon Sep 17 00:00:00 2001 From: Griffin Smith Date: Sun, 10 May 2020 15:19:53 -0400 Subject: Add envrc for lorri --- .envrc | 1 + 1 file changed, 1 insertion(+) create mode 100644 .envrc diff --git a/.envrc b/.envrc new file mode 100644 index 0000000000..be81feddb1 --- /dev/null +++ b/.envrc @@ -0,0 +1 @@ +eval "$(lorri direnv)" \ No newline at end of file -- cgit 1.4.1 From 78a323ec7a2be18325604829122b7bf95e232b9b Mon Sep 17 00:00:00 2001 From: Griffin Smith Date: Sun, 10 May 2020 18:04:04 -0400 Subject: Bump all-hies version Bump all-hies to the latest commit --- default.nix | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/default.nix b/default.nix index 263e04beac..0d08d7f26b 100644 --- a/default.nix +++ b/default.nix @@ -5,7 +5,11 @@ let inherit (nixpkgs) pkgs lib; inherit (lib) id; - all-hies = import (fetchTarball "https://github.com/infinisil/all-hies/tarball/c6e93d2d641ef48703eabed8ec5cde3d774cb0e5") {}; + inherit (pkgs) fetchurl; + all-hies = import (fetchTarball { + url = "https://github.com/infinisil/all-hies/archive/4b6aab017cdf96a90641dc287437685675d598da.tar.gz"; + sha256 = "0ap12mbzk97zmxk42fk8vqacyvpxk29r2wrnjqpx4m2w9g7gfdya"; + }) {}; hie = all-hies.selection { selector = p: { inherit (p) ghc865; }; }; xanthous = (if failOnWarnings then pkgs.haskell.lib.failOnAllWarnings else id) -- cgit 1.4.1 From 2320cfa8cd2540cd0caf91f2e7cdc81045c9504c Mon Sep 17 00:00:00 2001 From: Griffin Smith Date: Sun, 10 May 2020 19:44:30 -0400 Subject: Use open circles to generate filled circles Rather than leaning on rasterific to generate filled circles for us, instead start with an open circle, then fill it by scanning line-by-line and filling in points that are "inside" of the circle, based on keeping track with a boolean. Also adds a couple of helper functions for displaying these kinda "boolean graphics" things we're passing around, as sets of points. --- src/Xanthous/Util/Graphics.hs | 105 ++++++++++++++++++++++++------------- test/Xanthous/Util/GraphicsSpec.hs | 19 ++++--- 2 files changed, 81 insertions(+), 43 deletions(-) diff --git a/src/Xanthous/Util/Graphics.hs b/src/Xanthous/Util/Graphics.hs index ea1dbffe83..5f7432f4c7 100644 --- a/src/Xanthous/Util/Graphics.hs +++ b/src/Xanthous/Util/Graphics.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE TemplateHaskell #-} -- | Graphics algorithms and utils for rendering things in 2D space -------------------------------------------------------------------------------- module Xanthous.Util.Graphics @@ -6,6 +7,10 @@ module Xanthous.Util.Graphics , line , straightLine , delaunay + + -- * Debugging and testing tools + , renderBooleanGraphics + , showBooleanGraphics ) where -------------------------------------------------------------------------------- import Xanthous.Prelude @@ -16,16 +21,13 @@ import Xanthous.Prelude import qualified Algorithms.Geometry.DelaunayTriangulation.Naive as Geometry import qualified Algorithms.Geometry.DelaunayTriangulation.Types as Geometry -import Codec.Picture (imagePixels) +import Control.Monad.State (execState, State) import qualified Data.Geometry.Point as Geometry import Data.Ext ((:+)(..)) import Data.List (unfoldr) -import Data.List.NonEmpty (NonEmpty) -import Data.Ix (range, Ix) -import Data.Word (Word8) -import qualified Graphics.Rasterific as Raster -import Graphics.Rasterific hiding (circle, line, V2(..)) -import Graphics.Rasterific.Texture (uniformTexture) +import Data.List.NonEmpty (NonEmpty((:|))) +import qualified Data.List.NonEmpty as NE +import Data.Ix (Ix) import Linear.V2 -------------------------------------------------------------------------------- @@ -65,41 +67,44 @@ circle (x₀, y₀) radius x' = x + 1 +data FillState i + = FillState + { _inCircle :: Bool + , _result :: NonEmpty (i, i) + } +makeLenses ''FillState + +runFillState :: NonEmpty (i, i) -> State (FillState i) a -> [(i, i)] +runFillState circumference s + = toList + . view result + . execState s + $ FillState False circumference + -- | Generate a *filled* circle centered at the given point and with the given --- radius using the Rasterific package. Note that since this uses a different --- implementation, this is not a strict superset of the 'circle' function --- (unfortunately - would like to make that not the case!) +-- radius by filling a circle generated with 'circle' filledCircle :: (Num i, Integral i, Ix i) => (i, i) -- ^ center -> i -- ^ radius -> [(i, i)] -filledCircle (ox, oy) radius - = pointsFromRaster (ox + radius) (oy + radius) - $ fill - $ Raster.circle (Raster.V2 (fromIntegral ox) (fromIntegral oy)) - $ fromIntegral radius - --- showCells . fromPoints . NE.fromList $ filledCircle (15, 15) 7 --- pointsFromRaster :: (Num i, Integral i, Ix i) --- => i -- ^ width --- -> i -- ^ height --- -> _ --- -> [(i, i)] -pointsFromRaster - :: (Integral a, Integral b, Ix a, Ix b) - => a - -> b - -> Drawing Word8 () - -> [(a, b)] -pointsFromRaster w h raster - = map snd - $ filter ((== 1) . fst) - $ zip pixels - $ range ((1, 1), (w, h)) - where - pixels = toListOf imagePixels - $ renderDrawing @Word8 (fromIntegral w) (fromIntegral h) 0 - $ withTexture (uniformTexture 1) raster +filledCircle origin radius = + case NE.nonEmpty (circle origin radius) of + Nothing -> [] + Just circumference -> runFillState circumference $ + -- the first and last lines of all circles are solid, so the whole "in the + -- circle, out of the circle" thing doesn't work... but that's fine since + -- we don't need to fill them. So just skip them + for_ [succ minX..pred maxX] $ \x -> + for_ [minY..maxY] $ \y -> do + let pt = (x, y) + next = (x, succ y) + whenM (use inCircle) $ result %= NE.cons pt + + when (pt `elem` circumference && next `notElem` circumference) + $ inCircle %= not + + where + ((minX, minY), (maxX, maxY)) = minmaxes circumference -- | Draw a line between two points using Bresenham's line drawing algorithm -- @@ -141,3 +146,29 @@ delaunay where toPoint (V2 px py, pid) = Geometry.Point2 px py :+ pid fromPoint (Geometry.Point2 px py :+ pid) = (V2 px py, pid) + +-------------------------------------------------------------------------------- + +renderBooleanGraphics :: forall i. (Num i, Ord i, Enum i) => [(i, i)] -> String +renderBooleanGraphics [] = "" +renderBooleanGraphics (pt : pts') = intercalate "\n" rows + where + rows = row <$> [minX..maxX] + row x = [minY..maxY] <&> \y -> if (x, y) `member` ptSet then 'X' else ' ' + ((minX, minY), (maxX, maxY)) = minmaxes pts + pts = pt :| pts' + ptSet :: Set (i, i) + ptSet = setFromList $ toList pts + +showBooleanGraphics :: forall i. (Num i, Ord i, Enum i) => [(i, i)] -> IO () +showBooleanGraphics = putStrLn . pack . renderBooleanGraphics + +minmaxes :: forall i. (Ord i) => NonEmpty (i, i) -> ((i, i), (i, i)) +minmaxes xs = + ( ( minimum1Of (traverse1 . _1) xs + , minimum1Of (traverse1 . _2) xs + ) + , ( maximum1Of (traverse1 . _1) xs + , maximum1Of (traverse1 . _2) xs + ) + ) diff --git a/test/Xanthous/Util/GraphicsSpec.hs b/test/Xanthous/Util/GraphicsSpec.hs index a1eaf73e28..ff99d10738 100644 --- a/test/Xanthous/Util/GraphicsSpec.hs +++ b/test/Xanthous/Util/GraphicsSpec.hs @@ -5,6 +5,7 @@ import Test.Prelude hiding (head) import Xanthous.Util.Graphics import Xanthous.Util import Data.List (head) +import Data.Set (isSubsetOf) -------------------------------------------------------------------------------- main :: IO () @@ -40,12 +41,18 @@ test = testGroup "Xanthous.Util.Graphics" , (12,0), (12,1),(12,2),(12,3),(12,4) ] - -- , testProperty "is a subset of filledCircle" $ \center radius -> - -- let circ = circle @Int center radius - -- filledCirc = filledCircle center radius - -- in counterexample ( "circle: " <> show circ - -- <> "\nfilledCircle: " <> show filledCirc) - -- $ setFromList circ `isSubsetOf` setFromList filledCirc + ] + , testGroup "filledCircle" + [ testProperty "is a superset of circle" $ \center radius -> + let circ = circle @Int center radius + filledCirc = filledCircle center radius + in counterexample ( "circle: " <> show circ + <> "\nfilledCircle: " <> show filledCirc) + $ setFromList circ `isSubsetOf` setFromList filledCirc + -- TODO later + -- , testProperty "is always contiguous" $ \center radius -> + -- let filledCirc = filledCircle center radius + -- in counterexample (renderBooleanGraphics filledCirc) $ ] , testGroup "line" [ testProperty "starts and ends at the start and end points" $ \start end -> -- cgit 1.4.1 From 9ec51e51234b0c9ace93091d9071d932cf819f1f Mon Sep 17 00:00:00 2001 From: Griffin Smith Date: Sun, 10 May 2020 19:50:03 -0400 Subject: Entities inside a wall can't see anything The test for "one step in each cardinal direction is always visible" was giving a false-negative for an entity at the same position as a wall - not only is this something that would ostensibly never happen, it's also completely reasonable to assume that someone stuck in a wall (due to a bad teleport perhaps?) wouldn't be able to see anything, on account of their head being INSIDE A WALL. --- src/Xanthous/Data/EntityMap/Graphics.hs | 3 +-- test/Xanthous/Data/EntityMap/GraphicsSpec.hs | 1 + 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/src/Xanthous/Data/EntityMap/Graphics.hs b/src/Xanthous/Data/EntityMap/Graphics.hs index d523c0555e..0f2f2bfe16 100644 --- a/src/Xanthous/Data/EntityMap/Graphics.hs +++ b/src/Xanthous/Data/EntityMap/Graphics.hs @@ -56,8 +56,7 @@ linesOfSight (view _Position -> pos) visionRadius em visibleEntities :: Entity e => Position -> Word -> EntityMap e -> EntityMap e visibleEntities pos visionRadius = fromEIDsAndPositioned - . fold - . map (\(p, es) -> over _2 (Positioned p) <$> es) + . foldMap (\(p, es) -> over _2 (Positioned p) <$> es) . fold . linesOfSight pos visionRadius diff --git a/test/Xanthous/Data/EntityMap/GraphicsSpec.hs b/test/Xanthous/Data/EntityMap/GraphicsSpec.hs index 55ae0d79db..fd37548ce8 100644 --- a/test/Xanthous/Data/EntityMap/GraphicsSpec.hs +++ b/test/Xanthous/Data/EntityMap/GraphicsSpec.hs @@ -19,6 +19,7 @@ test = testGroup "Xanthous.Data.EntityMap.Graphics" [ testGroup "visiblePositions" [ testProperty "one step in each cardinal direction is always visible" $ \pos (Cardinal dir) (Positive r) (wallPositions :: Set Position)-> + pos `notMember` wallPositions ==> let em = review _EntityMap . map (, Wall) . toList $ wallPositions em' = em & atPosition (move dir pos) %~ (Wall <|) poss = visiblePositions pos r em' -- cgit 1.4.1 From b64dd08c6ec5f68539c6b4159b10d960e8e96bc3 Mon Sep 17 00:00:00 2001 From: Griffin Smith Date: Sun, 10 May 2020 19:52:43 -0400 Subject: Update README for lorri This is going to be the happy-path for development --- README.org | 13 ++++++++----- 1 file changed, 8 insertions(+), 5 deletions(-) diff --git a/README.org b/README.org index 18542fee6f..7e1fedb069 100644 --- a/README.org +++ b/README.org @@ -19,15 +19,18 @@ Movement uses the nethack-esque hjklybnu. * Development -#+BEGIN_SRC shell -$ nix-shell +Use [[https://github.com/target/lorri][lorri]], or run everything in a ~nix-shell~ +#+BEGIN_SRC shell # Build (for dev) -[nix-shell:xanthous]$ cabal new-build +$ cabal new-build + +# Run the game +$ cabal new-run xanthous # Run tests -[nix-shell:xanthous]$ cabal new-run test +$ cabal new-run test # Run a repl -[nix-shell:xanthous]$ cabal new-repl +$ cabal new-repl #+END_SRC -- cgit 1.4.1 From ce3730ba3a5831e590dd9cc037649eb49e2f0804 Mon Sep 17 00:00:00 2001 From: Griffin Smith Date: Sun, 10 May 2020 20:26:44 -0400 Subject: Small chance of hurting self when punching When attacking monsters with bare fists, there is a small chance (8%, right now) of causing 1 point of self-damage --- src/Xanthous/App.hs | 9 ++++++++- src/Xanthous/Random.hs | 15 +++++++++++++++ src/Xanthous/messages.yaml | 3 +++ 3 files changed, 26 insertions(+), 1 deletion(-) diff --git a/src/Xanthous/App.hs b/src/Xanthous/App.hs index 24073c5109..ea1405e463 100644 --- a/src/Xanthous/App.hs +++ b/src/Xanthous/App.hs @@ -548,9 +548,16 @@ attackAt pos = msg <- uses character getAttackMessage message msg msgParams entities . ix creatureID . positioned .= SomeEntity creature' + + whenM (uses character $ isNothing . weapon) + $ whenM (chance (0.08 :: Float)) $ do + say_ ["combat", "fistSelfDamage"] + character %= Character.damage 1 + stepGame -- TODO + weapon chr = chr ^? inventory . wielded . wieldedItems . wieldableItem getAttackMessage chr = - case chr ^? inventory . wielded . wieldedItems . wieldableItem of + case weapon chr of Just wi -> fromMaybe (Messages.lookup ["combat", "hit", "generic"]) $ wi ^. attackMessage diff --git a/src/Xanthous/Random.hs b/src/Xanthous/Random.hs index 3cb0b068d3..41c80ab73c 100644 --- a/src/Xanthous/Random.hs +++ b/src/Xanthous/Random.hs @@ -9,6 +9,7 @@ module Xanthous.Random , evenlyWeighted , weightedBy , subRand + , chance ) where -------------------------------------------------------------------------------- import Xanthous.Prelude @@ -85,3 +86,17 @@ instance (Num w, Ord w, Distribution Uniform w, Excludable w) => Choose (Weighte subRand :: MonadRandom m => Rand StdGen a -> m a subRand sub = evalRand sub . mkStdGen <$> getRandom + +-- | Has a @n@ chance of returning 'True' +-- +-- eg, chance 0.5 will return 'True' half the time +chance + :: (Num w, Ord w, Distribution Uniform w, Excludable w, MonadRandom m) + => w + -> m Bool +chance n = choose $ weightedBy (bool 1 (n * 2)) bools + +-------------------------------------------------------------------------------- + +bools :: NonEmpty Bool +bools = True :| [False] diff --git a/src/Xanthous/messages.yaml b/src/Xanthous/messages.yaml index ed592e2650..4042642378 100644 --- a/src/Xanthous/messages.yaml +++ b/src/Xanthous/messages.yaml @@ -57,6 +57,9 @@ character: combat: nothingToAttack: There's nothing to attack there. menu: Which creature would you like to attack? + fistSelfDamage: + - You hit so hard with your fists you hurt yourself! + - The punch leaves your knuckles bloody! hit: fists: - You punch the {{creature.creatureType.name}} with your bare fists! It hurts. A lot. -- cgit 1.4.1 From 296f73a4d63479735cb5af90a4f502ef2477aed4 Mon Sep 17 00:00:00 2001 From: Griffin Smith Date: Sun, 10 May 2020 20:38:56 -0400 Subject: Display messages in the order they were sent Rather than displaying messages most-recent-first in the message box, display them most-recent-last (which feels more natural) --- src/Xanthous/Game/Draw.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Xanthous/Game/Draw.hs b/src/Xanthous/Game/Draw.hs index a9b55945ff..659081e573 100644 --- a/src/Xanthous/Game/Draw.hs +++ b/src/Xanthous/Game/Draw.hs @@ -43,7 +43,7 @@ cursorPosition game = showCursor Resource.Character (game ^. characterPosition . loc) drawMessages :: MessageHistory -> Widget Name -drawMessages = txtWrap . (<> " ") . unwords . oextract +drawMessages = txtWrap . (<> " ") . unwords . reverse . oextract drawPromptState :: GamePromptState m -> Widget Name drawPromptState NoPrompt = emptyWidget -- cgit 1.4.1 From ecd33e0c901b34d77ea77ad0f3b65125d85a4515 Mon Sep 17 00:00:00 2001 From: Griffin Smith Date: Mon, 11 May 2020 22:47:50 -0400 Subject: Add ViewPatterns to default-extensions Seems relatively harmless --- package.yaml | 1 + src/Xanthous/App.hs | 1 - src/Xanthous/Command.hs | 1 - src/Xanthous/Data.hs | 1 - src/Xanthous/Data/EntityMap.hs | 1 - src/Xanthous/Data/EntityMap/Graphics.hs | 1 - src/Xanthous/Entities/Character.hs | 1 - src/Xanthous/Generators/CaveAutomata.hs | 1 - src/Xanthous/Generators/Dungeon.hs | 1 - src/Xanthous/Generators/LevelContents.hs | 1 - src/Xanthous/Generators/Util.hs | 1 - src/Xanthous/Orphans.hs | 1 - src/Xanthous/Util/Inflection.hs | 1 - 13 files changed, 1 insertion(+), 12 deletions(-) diff --git a/package.yaml b/package.yaml index d639e555c7..936fc4fd05 100644 --- a/package.yaml +++ b/package.yaml @@ -94,6 +94,7 @@ default-extensions: - TypeApplications - TypeFamilies - TypeOperators +- ViewPatterns ghc-options: - -Wall diff --git a/src/Xanthous/App.hs b/src/Xanthous/App.hs index ea1405e463..f7013076d5 100644 --- a/src/Xanthous/App.hs +++ b/src/Xanthous/App.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE ViewPatterns #-} {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE RecordWildCards #-} -------------------------------------------------------------------------------- diff --git a/src/Xanthous/Command.hs b/src/Xanthous/Command.hs index e12feaebd0..2e7e6f1ff5 100644 --- a/src/Xanthous/Command.hs +++ b/src/Xanthous/Command.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE ViewPatterns #-} -------------------------------------------------------------------------------- module Xanthous.Command where -------------------------------------------------------------------------------- diff --git a/src/Xanthous/Data.hs b/src/Xanthous/Data.hs index 2cfb8204d5..ec40b87211 100644 --- a/src/Xanthous/Data.hs +++ b/src/Xanthous/Data.hs @@ -1,6 +1,5 @@ {-# LANGUAGE PartialTypeSignatures #-} {-# LANGUAGE StandaloneDeriving #-} -{-# LANGUAGE ViewPatterns #-} {-# LANGUAGE RoleAnnotations #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE DeriveTraversable #-} diff --git a/src/Xanthous/Data/EntityMap.hs b/src/Xanthous/Data/EntityMap.hs index 4e7796b1f4..d24defa841 100644 --- a/src/Xanthous/Data/EntityMap.hs +++ b/src/Xanthous/Data/EntityMap.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE ViewPatterns #-} {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE DeriveTraversable #-} diff --git a/src/Xanthous/Data/EntityMap/Graphics.hs b/src/Xanthous/Data/EntityMap/Graphics.hs index 0f2f2bfe16..5a73bd3938 100644 --- a/src/Xanthous/Data/EntityMap/Graphics.hs +++ b/src/Xanthous/Data/EntityMap/Graphics.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE ViewPatterns #-} -------------------------------------------------------------------------------- module Xanthous.Data.EntityMap.Graphics ( visiblePositions diff --git a/src/Xanthous/Entities/Character.hs b/src/Xanthous/Entities/Character.hs index 424488828c..c18d726a4b 100644 --- a/src/Xanthous/Entities/Character.hs +++ b/src/Xanthous/Entities/Character.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE ViewPatterns #-} {-# LANGUAGE TemplateHaskell #-} module Xanthous.Entities.Character ( Character(..) diff --git a/src/Xanthous/Generators/CaveAutomata.hs b/src/Xanthous/Generators/CaveAutomata.hs index 5a7c081d03..83740fe4b7 100644 --- a/src/Xanthous/Generators/CaveAutomata.hs +++ b/src/Xanthous/Generators/CaveAutomata.hs @@ -1,5 +1,4 @@ {-# LANGUAGE MultiWayIf #-} -{-# LANGUAGE ViewPatterns #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE TemplateHaskell #-} -------------------------------------------------------------------------------- diff --git a/src/Xanthous/Generators/Dungeon.hs b/src/Xanthous/Generators/Dungeon.hs index fdc510bb79..7fde0075e6 100644 --- a/src/Xanthous/Generators/Dungeon.hs +++ b/src/Xanthous/Generators/Dungeon.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE ViewPatterns #-} {-# LANGUAGE TemplateHaskell #-} -------------------------------------------------------------------------------- module Xanthous.Generators.Dungeon diff --git a/src/Xanthous/Generators/LevelContents.hs b/src/Xanthous/Generators/LevelContents.hs index 5f83a83a3b..ed4cc87e79 100644 --- a/src/Xanthous/Generators/LevelContents.hs +++ b/src/Xanthous/Generators/LevelContents.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE ViewPatterns #-} -------------------------------------------------------------------------------- module Xanthous.Generators.LevelContents ( chooseCharacterPosition diff --git a/src/Xanthous/Generators/Util.hs b/src/Xanthous/Generators/Util.hs index 13f248a045..cdac568e40 100644 --- a/src/Xanthous/Generators/Util.hs +++ b/src/Xanthous/Generators/Util.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE ViewPatterns #-} {-# LANGUAGE QuantifiedConstraints #-} {-# LANGUAGE AllowAmbiguousTypes #-} -------------------------------------------------------------------------------- diff --git a/src/Xanthous/Orphans.hs b/src/Xanthous/Orphans.hs index b7a4a32126..8e82c372b2 100644 --- a/src/Xanthous/Orphans.hs +++ b/src/Xanthous/Orphans.hs @@ -1,6 +1,5 @@ {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE StandaloneDeriving #-} -{-# LANGUAGE ViewPatterns #-} {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE PackageImports #-} diff --git a/src/Xanthous/Util/Inflection.hs b/src/Xanthous/Util/Inflection.hs index fc66c08761..724f2339dd 100644 --- a/src/Xanthous/Util/Inflection.hs +++ b/src/Xanthous/Util/Inflection.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE ViewPatterns #-} module Xanthous.Util.Inflection ( toSentence -- cgit 1.4.1 From 34cabba896507f2b6523d6aec344ec1c88e453be Mon Sep 17 00:00:00 2001 From: Griffin Smith Date: Mon, 11 May 2020 23:03:21 -0400 Subject: Add a very basic, naive auto-move command Add a very basic, naive auto-move command, which just steps the player in a direction until they collide with something, regardless of any surrounding beasties who might want to eat them. There's a lot of other stuff going on here - in order to get this working the way I wanted with a slight (I settled on 50ms) delay between every step in these autocommands while still redrawing in between I had to do all the extra machinery for custom Brick events with a channel, and then at the same time adding the bits for actually executing autocommands in a general fashion (because there will definitely be more!) hit my threshold for size for App.hs which sent me on a big journey to break it up into smaller files -- which seems actually like it was quite successful. Hopefully this will help with compile times too, though App.hs is still pretty slow (maybe more to do here). --- package.yaml | 4 + src/Main.hs | 34 ++++-- src/Xanthous/App.hs | 235 ++++----------------------------------- src/Xanthous/App/Autocommands.hs | 44 ++++++++ src/Xanthous/App/Common.hs | 67 +++++++++++ src/Xanthous/App/Prompt.hs | 161 +++++++++++++++++++++++++++ src/Xanthous/App/Time.hs | 40 +++++++ src/Xanthous/Command.hs | 6 + src/Xanthous/Data.hs | 2 +- src/Xanthous/Data/App.hs | 39 +++++++ src/Xanthous/Game/Arbitrary.hs | 2 +- src/Xanthous/Game/Draw.hs | 24 ++-- src/Xanthous/Game/Env.hs | 19 ++++ src/Xanthous/Game/Lenses.hs | 1 + src/Xanthous/Game/Prompt.hs | 17 +-- src/Xanthous/Game/State.hs | 94 ++++++++++++++-- src/Xanthous/Monad.hs | 29 ++++- src/Xanthous/Resource.hs | 31 ------ xanthous.cabal | 34 +++++- 19 files changed, 588 insertions(+), 295 deletions(-) create mode 100644 src/Xanthous/App/Autocommands.hs create mode 100644 src/Xanthous/App/Common.hs create mode 100644 src/Xanthous/App/Prompt.hs create mode 100644 src/Xanthous/App/Time.hs create mode 100644 src/Xanthous/Data/App.hs create mode 100644 src/Xanthous/Game/Env.hs delete mode 100644 src/Xanthous/Resource.hs diff --git a/package.yaml b/package.yaml index 936fc4fd05..b74a4df9e5 100644 --- a/package.yaml +++ b/package.yaml @@ -19,6 +19,7 @@ dependencies: - aeson - array +- async - QuickCheck - quickcheck-text - quickcheck-instances @@ -44,8 +45,11 @@ dependencies: - hgeometry-combinatorial - JuicyPixels - lens +- lifted-async - linear - megaparsec +- mmorph +- monad-control - MonadRandom - mtl - optparse-applicative diff --git a/src/Main.hs b/src/Main.hs index 95cfc9edba..dcd31afff9 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -2,6 +2,8 @@ module Main ( main ) where -------------------------------------------------------------------------------- import Xanthous.Prelude hiding (finally) import Brick +import qualified Brick.BChan +import qualified Graphics.Vty as Vty import qualified Options.Applicative as Opt import System.Random import Control.Monad.Random (getRandom) @@ -9,6 +11,7 @@ import Control.Exception (finally) import System.Exit (die) -------------------------------------------------------------------------------- import qualified Xanthous.Game as Game +import Xanthous.Game.Env (GameEnv(..)) import Xanthous.App import Xanthous.Generators ( GeneratorInput @@ -92,9 +95,8 @@ optParser = Opt.info thanks :: IO () thanks = putStr "\n\n" >> putStrLn "Thanks for playing Xanthous!" -runGame :: RunParams -> IO () -runGame rparams = do - app <- makeApp NewGame +newGame :: RunParams -> IO () +newGame rparams = do gameSeed <- maybe getRandom pure $ seed rparams when (isNothing $ seed rparams) . putStrLn @@ -102,23 +104,33 @@ runGame rparams = do let initialState = Game.initialStateFromSeed gameSeed &~ do for_ (characterName rparams) $ \cn -> Game.character . Character.characterName ?= cn - _game' <- defaultMain app initialState `finally` do - putStr "\n\n" - putStrLn "Thanks for playing Xanthous!" + runGame NewGame initialState `finally` do + thanks when (isNothing $ seed rparams) . putStrLn $ "Seed: " <> tshow gameSeed putStr "\n\n" - pure () loadGame :: FilePath -> IO () loadGame saveFile = do - app <- makeApp LoadGame gameState <- maybe (die "Invalid save file!") pure =<< Game.loadGame . fromStrict <$> readFile @IO saveFile - _game' <- gameState `deepseq` defaultMain app gameState `finally` thanks - pure () + gameState `deepseq` runGame LoadGame gameState +runGame :: RunType -> Game.GameState -> IO () +runGame rt gameState = do + eventChan <- Brick.BChan.newBChan 10 + let gameEnv = GameEnv eventChan + app <- makeApp gameEnv rt + let buildVty = Vty.mkVty Vty.defaultConfig + initialVty <- buildVty + _game' <- customMain + initialVty + buildVty + (Just eventChan) + app + gameState + pure () runGenerate :: GeneratorInput -> Dimensions -> Maybe Int -> IO () runGenerate input dims mSeed = do @@ -139,7 +151,7 @@ runGenerate input dims mSeed = do putStrLn $ showCells res runCommand :: Command -> IO () -runCommand (Run runParams) = runGame runParams +runCommand (Run runParams) = newGame runParams runCommand (Load saveFile) = loadGame saveFile runCommand (Generate input dims mSeed) = runGenerate input dims mSeed diff --git a/src/Xanthous/App.hs b/src/Xanthous/App.hs index f7013076d5..672aa93f6b 100644 --- a/src/Xanthous/App.hs +++ b/src/Xanthous/App.hs @@ -9,11 +9,9 @@ module Xanthous.App import Xanthous.Prelude import Brick hiding (App, halt, continue, raw) import qualified Brick -import Brick.Widgets.Edit (handleEditorEvent) import Graphics.Vty.Attributes (defAttr) -import Graphics.Vty.Input.Events (Event(EvKey), Key(..)) -import Control.Monad.State (get, gets, MonadState) -import Control.Monad.Random (MonadRandom) +import Graphics.Vty.Input.Events (Event(EvKey)) +import Control.Monad.State (get, gets) import Control.Monad.State.Class (modify) import Data.Aeson (object, ToJSON) import qualified Data.Aeson as A @@ -21,8 +19,11 @@ import Data.List.NonEmpty (NonEmpty(..)) import qualified Data.Vector as V import System.Exit import System.Directory (doesFileExist) -import GHC.TypeLits (TypeError, ErrorMessage(..)) -------------------------------------------------------------------------------- +import Xanthous.App.Common +import Xanthous.App.Time +import Xanthous.App.Prompt +import Xanthous.App.Autocommands import Xanthous.Command import Xanthous.Data ( move @@ -30,20 +31,18 @@ import Xanthous.Data , positioned , position , Position - , Ticks , (|*|) ) -import Xanthous.Data.EntityMap (EntityMap) +import Xanthous.Data.App (ResourceName, Panel(..), AppEvent(..)) import qualified Xanthous.Data.EntityMap as EntityMap import Xanthous.Data.Levels (prevLevel, nextLevel) import qualified Xanthous.Data.Levels as Levels import Xanthous.Data.Entities (blocksObject) import Xanthous.Game import Xanthous.Game.State +import Xanthous.Game.Env import Xanthous.Game.Draw (drawGame) import Xanthous.Game.Prompt -import Xanthous.Monad -import Xanthous.Resource (Name, Panel(..)) import qualified Xanthous.Messages as Messages import Xanthous.Random import Xanthous.Util (removeVectorIndex) @@ -66,24 +65,24 @@ import qualified Xanthous.Generators.CaveAutomata as CaveAutomata import qualified Xanthous.Generators.Dungeon as Dungeon -------------------------------------------------------------------------------- -type App = Brick.App GameState () Name +type App = Brick.App GameState AppEvent ResourceName data RunType = NewGame | LoadGame deriving stock (Eq) -makeApp :: RunType -> IO App -makeApp rt = pure $ Brick.App +makeApp :: GameEnv -> RunType -> IO App +makeApp env rt = pure $ Brick.App { appDraw = drawGame , appChooseCursor = const headMay - , appHandleEvent = \game event -> runAppM (handleEvent event) game + , appHandleEvent = \game event -> runAppM (handleEvent event) env game , appStartEvent = case rt of - NewGame -> runAppM $ startEvent >> get + NewGame -> runAppM (startEvent >> get) env LoadGame -> pure , appAttrMap = const $ attrMap defAttr [] } -runAppM :: AppM a -> GameState -> EventM Name a -runAppM appm = fmap fst . runAppT appm +runAppM :: AppM a -> GameEnv -> GameState -> EventM ResourceName a +runAppM appm ge = fmap fst . runAppT appm ge startEvent :: AppM () startEvent = do @@ -104,39 +103,20 @@ initLevel = do -------------------------------------------------------------------------------- -stepGameBy :: Ticks -> AppM () -stepGameBy ticks = do - ents <- uses entities EntityMap.toEIDsAndPositioned - for_ ents $ \(eid, pEntity) -> do - pEntity' <- step ticks pEntity - entities . ix eid .= pEntity' - - modify updateCharacterVision - - whenM (uses character isDead) - . prompt_ @'Continue ["dead"] Uncancellable - . const . lift . liftIO - $ exitSuccess - -ticksPerTurn :: Ticks -ticksPerTurn = 100 - -stepGame :: AppM () -stepGame = stepGameBy ticksPerTurn - --------------------------------------------------------------------------------- - -handleEvent :: BrickEvent Name () -> AppM (Next GameState) +handleEvent :: BrickEvent ResourceName AppEvent -> AppM (Next GameState) handleEvent ev = use promptState >>= \case NoPrompt -> handleNoPromptEvent ev WaitingPrompt msg pr -> handlePromptEvent msg pr ev -handleNoPromptEvent :: BrickEvent Name () -> AppM (Next GameState) +handleNoPromptEvent :: BrickEvent ResourceName AppEvent -> AppM (Next GameState) handleNoPromptEvent (VtyEvent (EvKey k mods)) | Just command <- commandFromKey k mods = do messageHistory %= nextTurn handleCommand command +handleNoPromptEvent (AppEvent AutoContinue) = do + preuse (autocommand . _ActiveAutocommand . _1) >>= traverse_ autoStep + continue handleNoPromptEvent _ = continue handleCommand :: Command -> AppM (Next GameState) @@ -347,6 +327,10 @@ handleCommand GoDown = do continue +handleCommand (StartAutoMove dir) = do + runAutocommand $ AutoMove dir + continue + -- handleCommand ToggleRevealAll = do @@ -355,177 +339,6 @@ handleCommand ToggleRevealAll = do continue -------------------------------------------------------------------------------- - -handlePromptEvent - :: Text -- ^ Prompt message - -> Prompt AppM - -> BrickEvent Name () - -> AppM (Next GameState) - -handlePromptEvent _ (Prompt Cancellable _ _ _ _) (VtyEvent (EvKey KEsc [])) - = clearPrompt >> continue -handlePromptEvent _ pr (VtyEvent (EvKey KEnter [])) - = clearPrompt >> submitPrompt pr >> continue - -handlePromptEvent _ pr@(Prompt _ SConfirm _ _ _) (VtyEvent (EvKey (KChar 'y') [])) - = clearPrompt >> submitPrompt pr >> continue - -handlePromptEvent _ (Prompt _ SConfirm _ _ _) (VtyEvent (EvKey (KChar 'n') [])) - = clearPrompt >> continue - -handlePromptEvent - msg - (Prompt c SStringPrompt (StringPromptState edit) pri cb) - (VtyEvent ev) - = do - edit' <- lift $ handleEditorEvent ev edit - let prompt' = Prompt c SStringPrompt (StringPromptState edit') pri cb - promptState .= WaitingPrompt msg prompt' - continue - -handlePromptEvent _ (Prompt _ SDirectionPrompt _ _ cb) - (VtyEvent (EvKey (KChar (directionFromChar -> Just dir)) [])) - = clearPrompt >> cb (DirectionResult dir) >> continue -handlePromptEvent _ (Prompt _ SDirectionPrompt _ _ _) _ = continue - -handlePromptEvent _ (Prompt _ SMenu _ items' cb) (VtyEvent (EvKey (KChar chr) [])) - | Just (MenuOption _ res) <- items' ^. at chr - = clearPrompt >> cb (MenuResult res) >> continue - | otherwise - = continue - -handlePromptEvent - msg - (Prompt c SPointOnMap (PointOnMapPromptState pos) pri cb) - (VtyEvent (EvKey (KChar (directionFromChar -> Just dir)) [])) - = let pos' = move dir pos - prompt' = Prompt c SPointOnMap (PointOnMapPromptState pos') pri cb - in promptState .= WaitingPrompt msg prompt' - >> continue -handlePromptEvent _ (Prompt _ SPointOnMap _ _ _) _ = continue - -handlePromptEvent - _ - (Prompt Cancellable _ _ _ _) - (VtyEvent (EvKey (KChar 'q') [])) - = clearPrompt >> continue -handlePromptEvent _ _ _ = continue - -clearPrompt :: AppM () -clearPrompt = promptState .= NoPrompt - -class NotMenu (pt :: PromptType) -instance NotMenu 'StringPrompt -instance NotMenu 'Confirm -instance NotMenu 'DirectionPrompt -instance NotMenu 'PointOnMap -instance NotMenu 'Continue -instance TypeError ('Text "Cannot use `prompt` or `prompt_` for menu prompts" - ':$$: 'Text "Use `menu` or `menu_` instead") - => NotMenu ('Menu a) - -prompt - :: forall (pt :: PromptType) (params :: Type). - (ToJSON params, SingPromptType pt, NotMenu pt) - => [Text] -- ^ Message key - -> params -- ^ Message params - -> PromptCancellable - -> (PromptResult pt -> AppM ()) -- ^ Prompt promise handler - -> AppM () -prompt msgPath params cancellable cb = do - let pt = singPromptType @pt - msg <- Messages.message msgPath params - p <- case pt of - SPointOnMap -> do - charPos <- use characterPosition - pure $ mkPointOnMapPrompt cancellable charPos cb - SStringPrompt -> pure $ mkPrompt cancellable pt cb - SConfirm -> pure $ mkPrompt cancellable pt cb - SDirectionPrompt -> pure $ mkPrompt cancellable pt cb - SContinue -> pure $ mkPrompt cancellable pt cb - SMenu -> error "unreachable" - promptState .= WaitingPrompt msg p - -prompt_ - :: forall (pt :: PromptType). - (SingPromptType pt, NotMenu pt) - => [Text] -- ^ Message key - -> PromptCancellable - -> (PromptResult pt -> AppM ()) -- ^ Prompt promise handler - -> AppM () -prompt_ msg = prompt msg $ object [] - -confirm - :: ToJSON params - => [Text] -- ^ Message key - -> params - -> AppM () - -> AppM () -confirm msgPath params - = prompt @'Confirm msgPath params Cancellable . const - -confirm_ :: [Text] -> AppM () -> AppM () -confirm_ msgPath = confirm msgPath $ object [] - -menu :: forall (a :: Type) (params :: Type). - (ToJSON params) - => [Text] -- ^ Message key - -> params -- ^ Message params - -> PromptCancellable - -> Map Char (MenuOption a) -- ^ Menu items - -> (PromptResult ('Menu a) -> AppM ()) -- ^ Menu promise handler - -> AppM () -menu msgPath params cancellable items' cb = do - msg <- Messages.message msgPath params - let p = mkMenu cancellable items' cb - promptState .= WaitingPrompt msg p - -menu_ :: forall (a :: Type). - [Text] -- ^ Message key - -> PromptCancellable - -> Map Char (MenuOption a) -- ^ Menu items - -> (PromptResult ('Menu a) -> AppM ()) -- ^ Menu promise handler - -> AppM () -menu_ msgPath = menu msgPath $ object [] - --------------------------------------------------------------------------------- - -entitiesAtPositionWithType - :: forall a. (Entity a, Typeable a) - => Position - -> EntityMap SomeEntity - -> [(EntityMap.EntityID, a)] -entitiesAtPositionWithType pos em = - let someEnts = EntityMap.atPositionWithIDs pos em - in flip foldMap someEnts $ \(eid, view positioned -> se) -> - case downcastEntity @a se of - Just e -> [(eid, e)] - Nothing -> [] - -describeEntitiesAt :: (MonadState GameState m, MonadRandom m) => Position -> m () -describeEntitiesAt pos = - use ( entities - . EntityMap.atPosition pos - . to (filter (not . entityIs @Character)) - ) >>= \case - Empty -> pure () - ents -> describeEntities ents - -describeEntities - :: ( Entity entity - , MonadRandom m - , MonadState GameState m - , MonoFoldable (f Text) - , Functor f - , Element (f Text) ~ Text - ) - => f entity - -> m () -describeEntities ents = - let descriptions = description <$> ents - in say ["entities", "description"] - $ object ["entityDescriptions" A..= toSentence descriptions] - attackAt :: Position -> AppM () attackAt pos = uses entities (entitiesAtPositionWithType @Creature pos) >>= \case diff --git a/src/Xanthous/App/Autocommands.hs b/src/Xanthous/App/Autocommands.hs new file mode 100644 index 0000000000..e8d94ce741 --- /dev/null +++ b/src/Xanthous/App/Autocommands.hs @@ -0,0 +1,44 @@ +-------------------------------------------------------------------------------- +module Xanthous.App.Autocommands + ( runAutocommand + , autoStep + ) where +-------------------------------------------------------------------------------- +import Xanthous.Prelude +-------------------------------------------------------------------------------- +import Control.Concurrent (threadDelay) +-------------------------------------------------------------------------------- +import Xanthous.App.Common +import Xanthous.App.Time +import Xanthous.Data +import Xanthous.Data.App +import Xanthous.Entities.Character (speed) +import Xanthous.Game.State +-------------------------------------------------------------------------------- + +autoStep :: Autocommand -> AppM () +autoStep (AutoMove dir) = do + newPos <- uses characterPosition $ move dir + collisionAt newPos >>= \case + Nothing -> do + characterPosition .= newPos + stepGameBy =<< uses (character . speed) (|*| 1) + describeEntitiesAt newPos + Just _ -> cancelAutocommand + +-------------------------------------------------------------------------------- + +autocommandIntervalμs :: Int +autocommandIntervalμs = 1000 * 50 -- 50 ms + +runAutocommand :: Autocommand -> AppM () +runAutocommand ac = do + env <- ask + tid <- liftIO . async $ runReaderT go env + autocommand .= ActiveAutocommand ac tid + where + go = everyμs autocommandIntervalμs $ sendEvent AutoContinue + +-- | Perform 'act' every μs microseconds forever +everyμs :: MonadIO m => Int -> m () -> m () +everyμs μs act = act >> liftIO (threadDelay μs) >> everyμs μs act diff --git a/src/Xanthous/App/Common.hs b/src/Xanthous/App/Common.hs new file mode 100644 index 0000000000..69ba6f0e05 --- /dev/null +++ b/src/Xanthous/App/Common.hs @@ -0,0 +1,67 @@ +-------------------------------------------------------------------------------- +module Xanthous.App.Common + ( describeEntities + , describeEntitiesAt + , entitiesAtPositionWithType + + -- * Re-exports + , MonadState + , MonadRandom + , EntityMap + , module Xanthous.Game.Lenses + , module Xanthous.Monad + ) where +-------------------------------------------------------------------------------- +import Xanthous.Prelude +-------------------------------------------------------------------------------- +import Data.Aeson (object) +import qualified Data.Aeson as A +import Control.Monad.State (MonadState) +import Control.Monad.Random (MonadRandom) +-------------------------------------------------------------------------------- +import Xanthous.Data (Position, positioned) +import Xanthous.Data.EntityMap (EntityMap) +import qualified Xanthous.Data.EntityMap as EntityMap +import Xanthous.Game +import Xanthous.Game.Lenses +import Xanthous.Game.State +import Xanthous.Monad +import Xanthous.Entities.Character (Character) +import Xanthous.Util.Inflection (toSentence) +-------------------------------------------------------------------------------- + +entitiesAtPositionWithType + :: forall a. (Entity a, Typeable a) + => Position + -> EntityMap SomeEntity + -> [(EntityMap.EntityID, a)] +entitiesAtPositionWithType pos em = + let someEnts = EntityMap.atPositionWithIDs pos em + in flip foldMap someEnts $ \(eid, view positioned -> se) -> + case downcastEntity @a se of + Just e -> [(eid, e)] + Nothing -> [] + +describeEntitiesAt :: (MonadState GameState m, MonadRandom m) => Position -> m () +describeEntitiesAt pos = + use ( entities + . EntityMap.atPosition pos + . to (filter (not . entityIs @Character)) + ) >>= \case + Empty -> pure () + ents -> describeEntities ents + +describeEntities + :: ( Entity entity + , MonadRandom m + , MonadState GameState m + , MonoFoldable (f Text) + , Functor f + , Element (f Text) ~ Text + ) + => f entity + -> m () +describeEntities ents = + let descriptions = description <$> ents + in say ["entities", "description"] + $ object ["entityDescriptions" A..= toSentence descriptions] diff --git a/src/Xanthous/App/Prompt.hs b/src/Xanthous/App/Prompt.hs new file mode 100644 index 0000000000..6704a601da --- /dev/null +++ b/src/Xanthous/App/Prompt.hs @@ -0,0 +1,161 @@ +{-# LANGUAGE UndecidableInstances #-} +-------------------------------------------------------------------------------- +module Xanthous.App.Prompt + ( handlePromptEvent + , clearPrompt + , prompt + , prompt_ + , confirm_ + , confirm + , menu + , menu_ + ) where +-------------------------------------------------------------------------------- +import Xanthous.Prelude +-------------------------------------------------------------------------------- +import Brick (BrickEvent(..), Next) +import Brick.Widgets.Edit (handleEditorEvent) +import Data.Aeson (ToJSON, object) +import Graphics.Vty.Input.Events (Event(EvKey), Key(..)) +import GHC.TypeLits (TypeError, ErrorMessage(..)) +-------------------------------------------------------------------------------- +import Xanthous.App.Common +import Xanthous.Data (move) +import Xanthous.Command (directionFromChar) +import Xanthous.Data.App (ResourceName, AppEvent) +import Xanthous.Game.Prompt +import Xanthous.Game.State +import qualified Xanthous.Messages as Messages +-------------------------------------------------------------------------------- + +handlePromptEvent + :: Text -- ^ Prompt message + -> Prompt AppM + -> BrickEvent ResourceName AppEvent + -> AppM (Next GameState) + +handlePromptEvent _ (Prompt Cancellable _ _ _ _) (VtyEvent (EvKey KEsc [])) + = clearPrompt >> continue +handlePromptEvent _ pr (VtyEvent (EvKey KEnter [])) + = clearPrompt >> submitPrompt pr >> continue + +handlePromptEvent _ pr@(Prompt _ SConfirm _ _ _) (VtyEvent (EvKey (KChar 'y') [])) + = clearPrompt >> submitPrompt pr >> continue + +handlePromptEvent _ (Prompt _ SConfirm _ _ _) (VtyEvent (EvKey (KChar 'n') [])) + = clearPrompt >> continue + +handlePromptEvent + msg + (Prompt c SStringPrompt (StringPromptState edit) pri cb) + (VtyEvent ev) + = do + edit' <- lift $ handleEditorEvent ev edit + let prompt' = Prompt c SStringPrompt (StringPromptState edit') pri cb + promptState .= WaitingPrompt msg prompt' + continue + +handlePromptEvent _ (Prompt _ SDirectionPrompt _ _ cb) + (VtyEvent (EvKey (KChar (directionFromChar -> Just dir)) [])) + = clearPrompt >> cb (DirectionResult dir) >> continue +handlePromptEvent _ (Prompt _ SDirectionPrompt _ _ _) _ = continue + +handlePromptEvent _ (Prompt _ SMenu _ items' cb) (VtyEvent (EvKey (KChar chr) [])) + | Just (MenuOption _ res) <- items' ^. at chr + = clearPrompt >> cb (MenuResult res) >> continue + | otherwise + = continue + +handlePromptEvent + msg + (Prompt c SPointOnMap (PointOnMapPromptState pos) pri cb) + (VtyEvent (EvKey (KChar (directionFromChar -> Just dir)) [])) + = let pos' = move dir pos + prompt' = Prompt c SPointOnMap (PointOnMapPromptState pos') pri cb + in promptState .= WaitingPrompt msg prompt' + >> continue +handlePromptEvent _ (Prompt _ SPointOnMap _ _ _) _ = continue + +handlePromptEvent + _ + (Prompt Cancellable _ _ _ _) + (VtyEvent (EvKey (KChar 'q') [])) + = clearPrompt >> continue +handlePromptEvent _ _ _ = continue + +clearPrompt :: AppM () +clearPrompt = promptState .= NoPrompt + +class NotMenu (pt :: PromptType) +instance NotMenu 'StringPrompt +instance NotMenu 'Confirm +instance NotMenu 'DirectionPrompt +instance NotMenu 'PointOnMap +instance NotMenu 'Continue +instance TypeError ('Text "Cannot use `prompt` or `prompt_` for menu prompts" + ':$$: 'Text "Use `menu` or `menu_` instead") + => NotMenu ('Menu a) + +prompt + :: forall (pt :: PromptType) (params :: Type). + (ToJSON params, SingPromptType pt, NotMenu pt) + => [Text] -- ^ Message key + -> params -- ^ Message params + -> PromptCancellable + -> (PromptResult pt -> AppM ()) -- ^ Prompt promise handler + -> AppM () +prompt msgPath params cancellable cb = do + let pt = singPromptType @pt + msg <- Messages.message msgPath params + p <- case pt of + SPointOnMap -> do + charPos <- use characterPosition + pure $ mkPointOnMapPrompt cancellable charPos cb + SStringPrompt -> pure $ mkPrompt cancellable pt cb + SConfirm -> pure $ mkPrompt cancellable pt cb + SDirectionPrompt -> pure $ mkPrompt cancellable pt cb + SContinue -> pure $ mkPrompt cancellable pt cb + SMenu -> error "unreachable" + promptState .= WaitingPrompt msg p + +prompt_ + :: forall (pt :: PromptType). + (SingPromptType pt, NotMenu pt) + => [Text] -- ^ Message key + -> PromptCancellable + -> (PromptResult pt -> AppM ()) -- ^ Prompt promise handler + -> AppM () +prompt_ msg = prompt msg $ object [] + +confirm + :: ToJSON params + => [Text] -- ^ Message key + -> params + -> AppM () + -> AppM () +confirm msgPath params + = prompt @'Confirm msgPath params Cancellable . const + +confirm_ :: [Text] -> AppM () -> AppM () +confirm_ msgPath = confirm msgPath $ object [] + +menu :: forall (a :: Type) (params :: Type). + (ToJSON params) + => [Text] -- ^ Message key + -> params -- ^ Message params + -> PromptCancellable + -> Map Char (MenuOption a) -- ^ Menu items + -> (PromptResult ('Menu a) -> AppM ()) -- ^ Menu promise handler + -> AppM () +menu msgPath params cancellable items' cb = do + msg <- Messages.message msgPath params + let p = mkMenu cancellable items' cb + promptState .= WaitingPrompt msg p + +menu_ :: forall (a :: Type). + [Text] -- ^ Message key + -> PromptCancellable + -> Map Char (MenuOption a) -- ^ Menu items + -> (PromptResult ('Menu a) -> AppM ()) -- ^ Menu promise handler + -> AppM () +menu_ msgPath = menu msgPath $ object [] diff --git a/src/Xanthous/App/Time.hs b/src/Xanthous/App/Time.hs new file mode 100644 index 0000000000..b17348f385 --- /dev/null +++ b/src/Xanthous/App/Time.hs @@ -0,0 +1,40 @@ +-------------------------------------------------------------------------------- +module Xanthous.App.Time + ( stepGame + , stepGameBy + ) where +-------------------------------------------------------------------------------- +import Xanthous.Prelude +-------------------------------------------------------------------------------- +import System.Exit +-------------------------------------------------------------------------------- +import Xanthous.Data (Ticks) +import Xanthous.App.Prompt +import qualified Xanthous.Data.EntityMap as EntityMap +import Xanthous.Entities.Character (isDead) +import Xanthous.Game.State +import Xanthous.Game.Prompt +import Xanthous.Game.Lenses +import Control.Monad.State (modify) +-------------------------------------------------------------------------------- + + +stepGameBy :: Ticks -> AppM () +stepGameBy ticks = do + ents <- uses entities EntityMap.toEIDsAndPositioned + for_ ents $ \(eid, pEntity) -> do + pEntity' <- step ticks pEntity + entities . ix eid .= pEntity' + + modify updateCharacterVision + + whenM (uses character isDead) + . prompt_ @'Continue ["dead"] Uncancellable + . const . lift . liftIO + $ exitSuccess + +ticksPerTurn :: Ticks +ticksPerTurn = 100 + +stepGame :: AppM () +stepGame = stepGameBy ticksPerTurn diff --git a/src/Xanthous/Command.hs b/src/Xanthous/Command.hs index 2e7e6f1ff5..37025dd37a 100644 --- a/src/Xanthous/Command.hs +++ b/src/Xanthous/Command.hs @@ -4,6 +4,7 @@ module Xanthous.Command where import Xanthous.Prelude hiding (Left, Right, Down) -------------------------------------------------------------------------------- import Graphics.Vty.Input (Key(..), Modifier(..)) +import qualified Data.Char as Char -------------------------------------------------------------------------------- import Xanthous.Data (Direction(..)) -------------------------------------------------------------------------------- @@ -11,6 +12,7 @@ import Xanthous.Data (Direction(..)) data Command = Quit | Move Direction + | StartAutoMove Direction | PreviousMessage | PickUp | Drop @@ -33,6 +35,10 @@ commandFromKey :: Key -> [Modifier] -> Maybe Command commandFromKey (KChar 'q') [] = Just Quit commandFromKey (KChar '.') [] = Just Wait commandFromKey (KChar (directionFromChar -> Just dir)) [] = Just $ Move dir +commandFromKey (KChar c) [] + | Char.isUpper c + , Just dir <- directionFromChar $ Char.toLower c + = Just $ StartAutoMove dir commandFromKey (KChar 'p') [MCtrl] = Just PreviousMessage commandFromKey (KChar ',') [] = Just PickUp commandFromKey (KChar 'd') [] = Just Drop diff --git a/src/Xanthous/Data.hs b/src/Xanthous/Data.hs index ec40b87211..3cb74bdca9 100644 --- a/src/Xanthous/Data.hs +++ b/src/Xanthous/Data.hs @@ -268,7 +268,7 @@ data Direction where DownRight :: Direction Here :: Direction deriving stock (Show, Eq, Ord, Generic) - deriving anyclass (CoArbitrary, Function, NFData) + deriving anyclass (CoArbitrary, Function, NFData, ToJSON, FromJSON, Hashable) deriving Arbitrary via GenericArbitrary Direction instance Opposite Direction where diff --git a/src/Xanthous/Data/App.hs b/src/Xanthous/Data/App.hs new file mode 100644 index 0000000000..0361d2a59e --- /dev/null +++ b/src/Xanthous/Data/App.hs @@ -0,0 +1,39 @@ +-------------------------------------------------------------------------------- +module Xanthous.Data.App + ( Panel(..) + , ResourceName(..) + , AppEvent(..) + ) where +-------------------------------------------------------------------------------- +import Xanthous.Prelude +-------------------------------------------------------------------------------- +import Test.QuickCheck +import Data.Aeson (ToJSON, FromJSON) +-------------------------------------------------------------------------------- +import Xanthous.Util.QuickCheck +-------------------------------------------------------------------------------- + +-- | Enum for "panels" displayed in the game's UI. +data Panel + = InventoryPanel -- ^ A panel displaying the character's inventory + deriving stock (Show, Eq, Ord, Generic, Enum, Bounded) + deriving anyclass (NFData, CoArbitrary, Function, ToJSON, FromJSON) + deriving Arbitrary via GenericArbitrary Panel + + +data ResourceName + = MapViewport -- ^ The main viewport where we display the game content + | Character -- ^ The character + | MessageBox -- ^ The box where we display messages to the user + | Prompt -- ^ The game's prompt + | Panel Panel -- ^ A panel in the game + deriving stock (Show, Eq, Ord, Generic) + deriving anyclass (NFData, CoArbitrary, Function, ToJSON, FromJSON) + deriving Arbitrary via GenericArbitrary ResourceName + +data AppEvent + = AutoContinue -- ^ Continue whatever autocommand has been requested by the + -- user + deriving stock (Show, Eq, Ord, Generic) + deriving anyclass (NFData, CoArbitrary, Function, ToJSON, FromJSON) + deriving Arbitrary via GenericArbitrary AppEvent diff --git a/src/Xanthous/Game/Arbitrary.hs b/src/Xanthous/Game/Arbitrary.hs index 886a8c03d7..a1eb789a33 100644 --- a/src/Xanthous/Game/Arbitrary.hs +++ b/src/Xanthous/Game/Arbitrary.hs @@ -40,6 +40,7 @@ instance Arbitrary GameState where let _promptState = NoPrompt -- TODO _activePanel <- arbitrary _debugState <- arbitrary + let _autocommand = NoAutocommand pure $ GameState {..} @@ -47,4 +48,3 @@ instance CoArbitrary GameLevel instance Function GameLevel instance CoArbitrary GameState instance Function GameState -deriving newtype instance CoArbitrary (m (a, GameState)) => CoArbitrary (AppT m a) diff --git a/src/Xanthous/Game/Draw.hs b/src/Xanthous/Game/Draw.hs index 659081e573..b855ce88e4 100644 --- a/src/Xanthous/Game/Draw.hs +++ b/src/Xanthous/Game/Draw.hs @@ -10,6 +10,8 @@ import Brick.Widgets.Border.Style import Brick.Widgets.Edit -------------------------------------------------------------------------------- import Xanthous.Data +import Xanthous.Data.App (ResourceName, Panel(..)) +import qualified Xanthous.Data.App as Resource import Xanthous.Data.EntityMap (EntityMap, atPosition) import qualified Xanthous.Data.EntityMap as EntityMap import Xanthous.Game.State @@ -29,12 +31,10 @@ import Xanthous.Game , debugState, allRevealed ) import Xanthous.Game.Prompt -import Xanthous.Resource (Name, Panel(..)) -import qualified Xanthous.Resource as Resource import Xanthous.Orphans () -------------------------------------------------------------------------------- -cursorPosition :: GameState -> Widget Name -> Widget Name +cursorPosition :: GameState -> Widget ResourceName -> Widget ResourceName cursorPosition game | WaitingPrompt _ (Prompt _ SPointOnMap (PointOnMapPromptState pos) _ _) <- game ^. promptState @@ -42,10 +42,10 @@ cursorPosition game | otherwise = showCursor Resource.Character (game ^. characterPosition . loc) -drawMessages :: MessageHistory -> Widget Name +drawMessages :: MessageHistory -> Widget ResourceName drawMessages = txtWrap . (<> " ") . unwords . reverse . oextract -drawPromptState :: GamePromptState m -> Widget Name +drawPromptState :: GamePromptState m -> Widget ResourceName drawPromptState NoPrompt = emptyWidget drawPromptState (WaitingPrompt msg (Prompt _ pt ps pri _)) = case (pt, ps, pri) of @@ -67,7 +67,7 @@ drawEntities -> (Position -> Bool) -- ^ Has a given position *ever* been seen by the character? -> EntityMap SomeEntity -- ^ all entities - -> Widget Name + -> Widget ResourceName drawEntities isVisible isRevealed allEnts = vBox rows where @@ -90,7 +90,7 @@ drawEntities isVisible isRevealed allEnts $ maximumBy (compare `on` drawPriority) <$> fromNullable ents -drawMap :: GameState -> Widget Name +drawMap :: GameState -> Widget ResourceName drawMap game = viewport Resource.MapViewport Both . cursorPosition game @@ -106,7 +106,7 @@ drawMap game bullet :: Char bullet = '•' -drawInventoryPanel :: GameState -> Widget Name +drawInventoryPanel :: GameState -> Widget ResourceName drawInventoryPanel game = drawWielded (game ^. character . inventory . wielded) <=> drawBackpack (game ^. character . inventory . backpack) @@ -122,7 +122,7 @@ drawInventoryPanel game ) <=> txt " " - drawBackpack :: Vector Item -> Widget Name + drawBackpack :: Vector Item -> Widget ResourceName drawBackpack Empty = txtWrap "Your backpack is empty right now." drawBackpack backpackItems = txtWrap ( "You are currently carrying the following items in your " @@ -134,7 +134,7 @@ drawInventoryPanel game backpackItems) -drawPanel :: GameState -> Panel -> Widget Name +drawPanel :: GameState -> Panel -> Widget ResourceName drawPanel game panel = border . hLimit 35 @@ -143,7 +143,7 @@ drawPanel game panel InventoryPanel -> drawInventoryPanel $ game -drawCharacterInfo :: Character -> Widget Name +drawCharacterInfo :: Character -> Widget ResourceName drawCharacterInfo ch = txt " " <+> charName <+> charHitpoints where charName | Just n <- ch ^. characterName @@ -154,7 +154,7 @@ drawCharacterInfo ch = txt " " <+> charName <+> charHitpoints = txt "Hitpoints: " <+> txt (tshow $ let Hitpoints hp = characterHitpoints ch in hp) -drawGame :: GameState -> [Widget Name] +drawGame :: GameState -> [Widget ResourceName] drawGame game = pure . withBorderStyle unicode diff --git a/src/Xanthous/Game/Env.hs b/src/Xanthous/Game/Env.hs new file mode 100644 index 0000000000..6e10d0f735 --- /dev/null +++ b/src/Xanthous/Game/Env.hs @@ -0,0 +1,19 @@ +{-# LANGUAGE TemplateHaskell #-} +-------------------------------------------------------------------------------- +module Xanthous.Game.Env + ( GameEnv(..) + , eventChan + ) where +-------------------------------------------------------------------------------- +import Xanthous.Prelude +-------------------------------------------------------------------------------- +import Brick.BChan (BChan) +import Xanthous.Data.App (AppEvent) +-------------------------------------------------------------------------------- + +data GameEnv = GameEnv + { _eventChan :: BChan AppEvent + } + deriving stock (Generic) +makeLenses ''GameEnv +{-# ANN GameEnv ("HLint: ignore Use newtype instead of data" :: String) #-} diff --git a/src/Xanthous/Game/Lenses.hs b/src/Xanthous/Game/Lenses.hs index 017d53652c..48b7235d22 100644 --- a/src/Xanthous/Game/Lenses.hs +++ b/src/Xanthous/Game/Lenses.hs @@ -56,6 +56,7 @@ initialStateFromSeed seed = _debugState = DebugState { _allRevealed = False } + _autocommand = NoAutocommand in GameState {..} diff --git a/src/Xanthous/Game/Prompt.hs b/src/Xanthous/Game/Prompt.hs index e89cf5bee3..30b5fe7545 100644 --- a/src/Xanthous/Game/Prompt.hs +++ b/src/Xanthous/Game/Prompt.hs @@ -30,8 +30,8 @@ import Test.QuickCheck.Arbitrary.Generic -------------------------------------------------------------------------------- import Xanthous.Util (smallestNotIn) import Xanthous.Data (Direction, Position) -import Xanthous.Resource (Name) -import qualified Xanthous.Resource as Resource +import Xanthous.Data.App (ResourceName) +import qualified Xanthous.Data.App as Resource -------------------------------------------------------------------------------- data PromptType where @@ -120,12 +120,13 @@ instance Arbitrary (PromptResult 'Continue) where -------------------------------------------------------------------------------- data PromptState pt where - StringPromptState :: Editor Text Name -> PromptState 'StringPrompt - DirectionPromptState :: PromptState 'DirectionPrompt - ContinuePromptState :: PromptState 'Continue - ConfirmPromptState :: PromptState 'Confirm - MenuPromptState :: forall a. PromptState ('Menu a) - PointOnMapPromptState :: Position -> PromptState 'PointOnMap + StringPromptState + :: Editor Text ResourceName -> PromptState 'StringPrompt + DirectionPromptState :: PromptState 'DirectionPrompt + ContinuePromptState :: PromptState 'Continue + ConfirmPromptState :: PromptState 'Confirm + MenuPromptState :: forall a. PromptState ('Menu a) + PointOnMapPromptState :: Position -> PromptState 'PointOnMap instance NFData (PromptState pt) where rnf sps@(StringPromptState ed) = sps `deepseq` ed `deepseq` () diff --git a/src/Xanthous/Game/State.hs b/src/Xanthous/Game/State.hs index 80137df7a7..f614cad473 100644 --- a/src/Xanthous/Game/State.hs +++ b/src/Xanthous/Game/State.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE TemplateHaskell #-} @@ -14,6 +15,7 @@ module Xanthous.Game.State , activePanel , promptState , characterEntityID + , autocommand , GamePromptState(..) -- * Game Level @@ -31,9 +33,16 @@ module Xanthous.Game.State , previousMessage , nextTurn + -- * Autocommands + , Autocommand(..) + , AutocommandState(..) + , _NoAutocommand + , _ActiveAutocommand + -- * App monad , AppT(..) , AppM + , runAppT -- * Entities , Draw(..) @@ -73,9 +82,11 @@ import Data.Coerce import System.Random import Test.QuickCheck import Test.QuickCheck.Arbitrary.Generic -import Control.Monad.State.Class -import Control.Monad.State import Control.Monad.Random.Class +import Control.Monad.State +import Control.Monad.Trans.Control (MonadTransControl(..)) +import Control.Monad.Trans.Compose +import Control.Monad.Morph (MFunctor(..)) import Brick (EventM, Widget, raw, str, emptyWidget) import Data.Aeson (ToJSON(..), FromJSON(..), Value(Null)) import qualified Data.Aeson as JSON @@ -87,6 +98,7 @@ import qualified Graphics.Vty.Image as Vty import Xanthous.Util (KnownBool(..)) import Xanthous.Util.QuickCheck (GenericArbitrary(..)) import Xanthous.Data +import Xanthous.Data.App import Xanthous.Data.Levels import Xanthous.Data.EntityMap (EntityMap, EntityID) import Xanthous.Data.EntityChar @@ -94,7 +106,7 @@ import Xanthous.Data.VectorBag import Xanthous.Data.Entities import Xanthous.Orphans () import Xanthous.Game.Prompt -import Xanthous.Resource +import Xanthous.Game.Env -------------------------------------------------------------------------------- data MessageHistory @@ -182,15 +194,21 @@ instance Function (GamePromptState m) where -------------------------------------------------------------------------------- newtype AppT m a - = AppT { unAppT :: StateT GameState m a } + = AppT { unAppT :: ReaderT GameEnv (StateT GameState m) a } deriving ( Functor , Applicative , Monad , MonadState GameState + , MonadReader GameEnv + , MonadIO + ) + via (ReaderT GameEnv (StateT GameState m)) + deriving ( MonadTrans + , MFunctor ) - via (StateT GameState m) + via (ReaderT GameEnv `ComposeT` StateT GameState) -type AppM = AppT (EventM Name) +type AppM = AppT (EventM ResourceName) -------------------------------------------------------------------------------- @@ -414,6 +432,50 @@ data GameLevel = GameLevel -------------------------------------------------------------------------------- +data Autocommand + = AutoMove Direction + deriving stock (Show, Eq, Ord, Generic) + deriving anyclass (NFData, Hashable, ToJSON, FromJSON, CoArbitrary, Function) + deriving Arbitrary via GenericArbitrary Autocommand +{-# ANN module ("HLint: ignore Use newtype instead of data" :: String) #-} + +data AutocommandState + = NoAutocommand + | ActiveAutocommand Autocommand (Async ()) + deriving stock (Eq, Ord, Generic) + deriving anyclass (Hashable) + +instance Show AutocommandState where + show NoAutocommand = "NoAutocommand" + show (ActiveAutocommand ac _) = + "(ActiveAutocommand " <> show ac <> " )" + +instance ToJSON AutocommandState where + toJSON = const Null + +instance FromJSON AutocommandState where + parseJSON Null = pure NoAutocommand + parseJSON _ = fail "Invalid AutocommandState; expected null" + +instance NFData AutocommandState where + rnf NoAutocommand = () + rnf (ActiveAutocommand ac t) = ac `deepseq` t `seq` () + +instance CoArbitrary AutocommandState where + coarbitrary NoAutocommand = variant @Int 1 + coarbitrary (ActiveAutocommand ac t) + = variant @Int 2 + . coarbitrary ac + . coarbitrary (hash t) + +instance Function AutocommandState where + function = functionMap onlyNoAC (const NoAutocommand) + where + onlyNoAC NoAutocommand = () + onlyNoAC _ = error "Can't handle autocommands in Function" + +-------------------------------------------------------------------------------- + data DebugState = DebugState { _allRevealed :: !Bool @@ -439,6 +501,7 @@ data GameState = GameState , _promptState :: !(GamePromptState AppM) , _debugState :: !DebugState + , _autocommand :: !AutocommandState } deriving stock (Show, Generic) deriving anyclass (NFData) @@ -467,8 +530,12 @@ instance Eq GameState where -------------------------------------------------------------------------------- -instance MonadTrans AppT where - lift = AppT . lift +runAppT :: Monad m => AppT m a -> GameEnv -> GameState -> m (a, GameState) +runAppT appt env initialState + = flip runStateT initialState + . flip runReaderT env + . unAppT + $ appt instance (Monad m) => MonadRandom (AppT m) where getRandomR rng = randomGen %%= randomR rng @@ -476,9 +543,16 @@ instance (Monad m) => MonadRandom (AppT m) where getRandomRs rng = uses randomGen $ randomRs rng getRandoms = uses randomGen randoms -instance (MonadIO m) => MonadIO (AppT m) where - liftIO = lift . liftIO +instance MonadTransControl AppT where + type StT AppT a = (a, GameState) + liftWith f + = AppT + . ReaderT $ \e + -> StateT $ \s + -> (,s) <$> f (\action -> runAppT action e s) + restoreT = AppT . ReaderT . const . StateT . const -------------------------------------------------------------------------------- makeLenses ''DebugState +makePrisms ''AutocommandState diff --git a/src/Xanthous/Monad.hs b/src/Xanthous/Monad.hs index 1138a7a5a0..db602de56f 100644 --- a/src/Xanthous/Monad.hs +++ b/src/Xanthous/Monad.hs @@ -5,12 +5,19 @@ module Xanthous.Monad , runAppT , continue , halt + -- * Messages , say , say_ , message , message_ , writeMessage + + -- * Autocommands + , cancelAutocommand + + -- * Events + , sendEvent ) where -------------------------------------------------------------------------------- import Xanthous.Prelude @@ -18,16 +25,16 @@ import Control.Monad.Random import Control.Monad.State import qualified Brick import Brick (EventM, Next) -import Data.Aeson +import Brick.BChan (writeBChan) +import Data.Aeson (ToJSON, object) -------------------------------------------------------------------------------- +import Xanthous.Data.App (AppEvent) import Xanthous.Game.State +import Xanthous.Game.Env import Xanthous.Messages (Message) import qualified Xanthous.Messages as Messages -------------------------------------------------------------------------------- -runAppT :: Monad m => AppT m a -> GameState -> m (a, GameState) -runAppT appt initialState = flip runStateT initialState . unAppT $ appt - halt :: AppT (EventM n) (Next GameState) halt = lift . Brick.halt =<< get @@ -53,3 +60,17 @@ message_ msg = message msg $ object [] writeMessage :: MonadState GameState m => Text -> m () writeMessage m = messageHistory %= pushMessage m + +-- | Cancel the currently active autocommand, if any +cancelAutocommand :: (MonadState GameState m, MonadIO m) => m () +cancelAutocommand = do + traverse_ (liftIO . cancel . snd) =<< preuse (autocommand . _ActiveAutocommand) + autocommand .= NoAutocommand + +-------------------------------------------------------------------------------- + +-- | Send an event to the app in an environment where the game env is available +sendEvent :: (MonadReader GameEnv m, MonadIO m) => AppEvent -> m () +sendEvent evt = do + ec <- view eventChan + liftIO $ writeBChan ec evt diff --git a/src/Xanthous/Resource.hs b/src/Xanthous/Resource.hs deleted file mode 100644 index cc2fc97a14..0000000000 --- a/src/Xanthous/Resource.hs +++ /dev/null @@ -1,31 +0,0 @@ --------------------------------------------------------------------------------- -module Xanthous.Resource - ( Panel(..) - , Name(..) - ) where --------------------------------------------------------------------------------- -import Xanthous.Prelude --------------------------------------------------------------------------------- -import Test.QuickCheck -import Data.Aeson (ToJSON, FromJSON) --------------------------------------------------------------------------------- -import Xanthous.Util.QuickCheck --------------------------------------------------------------------------------- - --- | Enum for "panels" displayed in the game's UI. -data Panel - = InventoryPanel -- ^ A panel displaying the character's inventory - deriving stock (Show, Eq, Ord, Generic, Enum, Bounded) - deriving anyclass (NFData, CoArbitrary, Function, ToJSON, FromJSON) - deriving Arbitrary via GenericArbitrary Panel - - -data Name - = MapViewport -- ^ The main viewport where we display the game content - | Character -- ^ The character - | MessageBox -- ^ The box where we display messages to the user - | Prompt -- ^ The game's prompt - | Panel Panel -- ^ A panel in the game - deriving stock (Show, Eq, Ord, Generic) - deriving anyclass (NFData, CoArbitrary, Function, ToJSON, FromJSON) - deriving Arbitrary via GenericArbitrary Name diff --git a/xanthous.cabal b/xanthous.cabal index 3dc2de467f..85b70c97f7 100644 --- a/xanthous.cabal +++ b/xanthous.cabal @@ -4,7 +4,7 @@ cabal-version: 1.12 -- -- see: https://github.com/sol/hpack -- --- hash: 09d294830fde12021527c15ba1e1698afdec092a16c4171ee67dce3256fe0d96 +-- hash: 61744d8e26bf309ee73e128a90af8badee98aedace39a756b6033f51711d3e2e name: xanthous version: 0.1.0.0 @@ -32,8 +32,13 @@ library Main Xanthous.AI.Gormlak Xanthous.App + Xanthous.App.Autocommands + Xanthous.App.Common + Xanthous.App.Prompt + Xanthous.App.Time Xanthous.Command Xanthous.Data + Xanthous.Data.App Xanthous.Data.Entities Xanthous.Data.EntityChar Xanthous.Data.EntityMap @@ -52,6 +57,7 @@ library Xanthous.Game Xanthous.Game.Arbitrary Xanthous.Game.Draw + Xanthous.Game.Env Xanthous.Game.Lenses Xanthous.Game.Prompt Xanthous.Game.State @@ -65,7 +71,6 @@ library Xanthous.Orphans Xanthous.Prelude Xanthous.Random - Xanthous.Resource Xanthous.Util Xanthous.Util.Comonad Xanthous.Util.Graph @@ -78,7 +83,7 @@ library Paths_xanthous hs-source-dirs: src - default-extensions: BlockArguments ConstraintKinds DataKinds DeriveAnyClass DeriveGeneric DerivingStrategies DerivingVia FlexibleContexts FlexibleInstances FunctionalDependencies GADTSyntax GeneralizedNewtypeDeriving KindSignatures LambdaCase MultiWayIf NoImplicitPrelude NoStarIsType OverloadedStrings PolyKinds RankNTypes ScopedTypeVariables TupleSections TypeApplications TypeFamilies TypeOperators + default-extensions: BlockArguments ConstraintKinds DataKinds DeriveAnyClass DeriveGeneric DerivingStrategies DerivingVia FlexibleContexts FlexibleInstances FunctionalDependencies GADTSyntax GeneralizedNewtypeDeriving KindSignatures LambdaCase MultiWayIf NoImplicitPrelude NoStarIsType OverloadedStrings PolyKinds RankNTypes ScopedTypeVariables TupleSections TypeApplications TypeFamilies TypeOperators ViewPatterns ghc-options: -Wall build-depends: JuicyPixels @@ -87,6 +92,7 @@ library , Rasterific , aeson , array + , async , base , brick , checkers @@ -109,8 +115,11 @@ library , hgeometry , hgeometry-combinatorial , lens + , lifted-async , linear , megaparsec + , mmorph + , monad-control , mtl , optparse-applicative , pointed @@ -140,8 +149,13 @@ executable xanthous Data.Aeson.Generic.DerivingVia Xanthous.AI.Gormlak Xanthous.App + Xanthous.App.Autocommands + Xanthous.App.Common + Xanthous.App.Prompt + Xanthous.App.Time Xanthous.Command Xanthous.Data + Xanthous.Data.App Xanthous.Data.Entities Xanthous.Data.EntityChar Xanthous.Data.EntityMap @@ -160,6 +174,7 @@ executable xanthous Xanthous.Game Xanthous.Game.Arbitrary Xanthous.Game.Draw + Xanthous.Game.Env Xanthous.Game.Lenses Xanthous.Game.Prompt Xanthous.Game.State @@ -173,7 +188,6 @@ executable xanthous Xanthous.Orphans Xanthous.Prelude Xanthous.Random - Xanthous.Resource Xanthous.Util Xanthous.Util.Comonad Xanthous.Util.Graph @@ -185,7 +199,7 @@ executable xanthous Paths_xanthous hs-source-dirs: src - default-extensions: BlockArguments ConstraintKinds DataKinds DeriveAnyClass DeriveGeneric DerivingStrategies DerivingVia FlexibleContexts FlexibleInstances FunctionalDependencies GADTSyntax GeneralizedNewtypeDeriving KindSignatures LambdaCase MultiWayIf NoImplicitPrelude NoStarIsType OverloadedStrings PolyKinds RankNTypes ScopedTypeVariables TupleSections TypeApplications TypeFamilies TypeOperators + default-extensions: BlockArguments ConstraintKinds DataKinds DeriveAnyClass DeriveGeneric DerivingStrategies DerivingVia FlexibleContexts FlexibleInstances FunctionalDependencies GADTSyntax GeneralizedNewtypeDeriving KindSignatures LambdaCase MultiWayIf NoImplicitPrelude NoStarIsType OverloadedStrings PolyKinds RankNTypes ScopedTypeVariables TupleSections TypeApplications TypeFamilies TypeOperators ViewPatterns ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N -O2 build-depends: JuicyPixels @@ -194,6 +208,7 @@ executable xanthous , Rasterific , aeson , array + , async , base , brick , checkers @@ -216,8 +231,11 @@ executable xanthous , hgeometry , hgeometry-combinatorial , lens + , lifted-async , linear , megaparsec + , mmorph + , monad-control , mtl , optparse-applicative , pointed @@ -265,7 +283,7 @@ test-suite test Paths_xanthous hs-source-dirs: test - default-extensions: BlockArguments ConstraintKinds DataKinds DeriveAnyClass DeriveGeneric DerivingStrategies DerivingVia FlexibleContexts FlexibleInstances FunctionalDependencies GADTSyntax GeneralizedNewtypeDeriving KindSignatures LambdaCase MultiWayIf NoImplicitPrelude NoStarIsType OverloadedStrings PolyKinds RankNTypes ScopedTypeVariables TupleSections TypeApplications TypeFamilies TypeOperators + default-extensions: BlockArguments ConstraintKinds DataKinds DeriveAnyClass DeriveGeneric DerivingStrategies DerivingVia FlexibleContexts FlexibleInstances FunctionalDependencies GADTSyntax GeneralizedNewtypeDeriving KindSignatures LambdaCase MultiWayIf NoImplicitPrelude NoStarIsType OverloadedStrings PolyKinds RankNTypes ScopedTypeVariables TupleSections TypeApplications TypeFamilies TypeOperators ViewPatterns ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N -O0 build-depends: JuicyPixels @@ -274,6 +292,7 @@ test-suite test , Rasterific , aeson , array + , async , base , brick , checkers @@ -297,8 +316,11 @@ test-suite test , hgeometry-combinatorial , lens , lens-properties + , lifted-async , linear , megaparsec + , mmorph + , monad-control , mtl , optparse-applicative , pointed -- cgit 1.4.1 From 15b4f0e6a73987f9afbc46f46862b5120029e715 Mon Sep 17 00:00:00 2001 From: Griffin Smith Date: Sat, 16 May 2020 18:57:07 -0400 Subject: Stop auto-moving if there's an enemy nearby If at any point during an auto-move there's an enemy in the character's line of sight, cancel the autocommand and send a message --- src/Xanthous/App/Autocommands.hs | 37 +++++++++++++++++++++++++++++-------- src/Xanthous/Entities/RawTypes.hs | 5 ++++- src/Xanthous/Game/Lenses.hs | 9 ++++++++- src/Xanthous/messages.yaml | 4 +++- 4 files changed, 44 insertions(+), 11 deletions(-) diff --git a/src/Xanthous/App/Autocommands.hs b/src/Xanthous/App/Autocommands.hs index e8d94ce741..35b92bba72 100644 --- a/src/Xanthous/App/Autocommands.hs +++ b/src/Xanthous/App/Autocommands.hs @@ -4,16 +4,24 @@ module Xanthous.App.Autocommands , autoStep ) where -------------------------------------------------------------------------------- -import Xanthous.Prelude +import Xanthous.Prelude -------------------------------------------------------------------------------- -import Control.Concurrent (threadDelay) +import Control.Concurrent (threadDelay) +import qualified Data.Aeson as A +import Data.Aeson (object) +import Data.List.NonEmpty (nonEmpty) +import qualified Data.List.NonEmpty as NE +import Control.Monad.State (gets) -------------------------------------------------------------------------------- -import Xanthous.App.Common -import Xanthous.App.Time -import Xanthous.Data -import Xanthous.Data.App -import Xanthous.Entities.Character (speed) -import Xanthous.Game.State +import Xanthous.App.Common +import Xanthous.App.Time +import Xanthous.Data +import Xanthous.Data.App +import Xanthous.Entities.Character (speed) +import Xanthous.Entities.Creature (Creature, creatureType) +import Xanthous.Entities.RawTypes (hostile) +import Xanthous.Game.State +import Xanthous.Game.Lenses (characterVisibleEntities) -------------------------------------------------------------------------------- autoStep :: Autocommand -> AppM () @@ -24,7 +32,20 @@ autoStep (AutoMove dir) = do characterPosition .= newPos stepGameBy =<< uses (character . speed) (|*| 1) describeEntitiesAt newPos + maybeVisibleEnemies <- nonEmpty <$> enemiesInSight + for_ maybeVisibleEnemies $ \visibleEnemies -> do + say ["autoMove", "enemyInSight"] + $ object [ "firstEntity" A..= NE.head visibleEnemies ] + cancelAutocommand Just _ -> cancelAutocommand + where + enemiesInSight :: AppM [Creature] + enemiesInSight = do + ents <- gets characterVisibleEntities + pure $ ents + ^.. folded + . _SomeEntity @Creature + . filtered (view $ creatureType . hostile) -------------------------------------------------------------------------------- diff --git a/src/Xanthous/Entities/RawTypes.hs b/src/Xanthous/Entities/RawTypes.hs index 4b31524ad7..30039662f0 100644 --- a/src/Xanthous/Entities/RawTypes.hs +++ b/src/Xanthous/Entities/RawTypes.hs @@ -9,6 +9,7 @@ module Xanthous.Entities.RawTypes -- * Creatures , CreatureType(..) + , hostile -- * Items , ItemType(..) @@ -63,6 +64,9 @@ data CreatureType = CreatureType CreatureType makeFieldsNoPrefix ''CreatureType +hostile :: Lens' CreatureType Bool +hostile = friendly . involuted not + -------------------------------------------------------------------------------- data EdibleItem = EdibleItem @@ -127,4 +131,3 @@ data EntityRaw via WithOptions '[ SumEnc ObjWithSingleField ] EntityRaw makePrisms ''EntityRaw - diff --git a/src/Xanthous/Game/Lenses.hs b/src/Xanthous/Game/Lenses.hs index 48b7235d22..5d5e673c5b 100644 --- a/src/Xanthous/Game/Lenses.hs +++ b/src/Xanthous/Game/Lenses.hs @@ -8,6 +8,7 @@ module Xanthous.Game.Lenses , characterPosition , updateCharacterVision , characterVisiblePositions + , characterVisibleEntities , getInitialState , initialStateFromSeed , entitiesAtCharacter @@ -28,7 +29,8 @@ import Xanthous.Game.State import Xanthous.Data import Xanthous.Data.Levels import qualified Xanthous.Data.EntityMap as EntityMap -import Xanthous.Data.EntityMap.Graphics (visiblePositions) +import Xanthous.Data.EntityMap.Graphics + (visiblePositions, visibleEntities) import Xanthous.Data.VectorBag import Xanthous.Entities.Character (Character, mkCharacter) import {-# SOURCE #-} Xanthous.Entities.Entities () @@ -101,6 +103,11 @@ characterVisiblePositions game = let charPos = game ^. characterPosition in visiblePositions charPos visionRadius $ game ^. entities +characterVisibleEntities :: GameState -> EntityMap.EntityMap SomeEntity +characterVisibleEntities game = + let charPos = game ^. characterPosition + in visibleEntities charPos visionRadius $ game ^. entities + entitiesCollision :: ( Functor f , forall xx. MonoFoldable (f xx) diff --git a/src/Xanthous/messages.yaml b/src/Xanthous/messages.yaml index 4042642378..c1835ef232 100644 --- a/src/Xanthous/messages.yaml +++ b/src/Xanthous/messages.yaml @@ -111,7 +111,9 @@ drop: - You take the {{item.itemType.name}} out of your backpack and put it on the ground. - You take the {{item.itemType.name}} out of your backpack and drop it on the ground. - +autoMove: + enemyInSight: + - There's a {{firstEntity.creatureType.name}} nearby! ### tutorial: -- cgit 1.4.1 From 2c86856ca7784483a7cdd438763b2693a297908a Mon Sep 17 00:00:00 2001 From: Griffin Smith Date: Sun, 24 May 2020 11:14:02 -0400 Subject: Add a new template system Add a parser, pretty-printer, and renderer for a new template system, which should eventually be a drop-in replacement for the current mustache-based template system, but also supports text filters (which will be used for things like pluralization and noun casing). Nothing currently uses it yet, though. --- package.yaml | 1 + src/Xanthous/Messages/Template.hs | 275 +++++++++++++++++++++++++++++++++ test/Spec.hs | 2 + test/Xanthous/Messages/TemplateSpec.hs | 80 ++++++++++ xanthous.cabal | 8 +- 5 files changed, 365 insertions(+), 1 deletion(-) create mode 100644 src/Xanthous/Messages/Template.hs create mode 100644 test/Xanthous/Messages/TemplateSpec.hs diff --git a/package.yaml b/package.yaml index b74a4df9e5..40e42a5b8a 100644 --- a/package.yaml +++ b/package.yaml @@ -53,6 +53,7 @@ dependencies: - MonadRandom - mtl - optparse-applicative +- parser-combinators - pointed - random - random-fu diff --git a/src/Xanthous/Messages/Template.hs b/src/Xanthous/Messages/Template.hs new file mode 100644 index 0000000000..0f47729d68 --- /dev/null +++ b/src/Xanthous/Messages/Template.hs @@ -0,0 +1,275 @@ +{-# LANGUAGE DeriveDataTypeable #-} +-------------------------------------------------------------------------------- +module Xanthous.Messages.Template + ( -- * Template AST + Template(..) + , Substitution(..) + , Filter(..) + + -- ** Template AST transformations + , reduceTemplate + + -- * Template parser + , template + , runParser + , errorBundlePretty + + -- * Template pretty-printer + , ppTemplate + + -- * Rendering templates + , TemplateVar(..) + , nested + , TemplateVars(..) + , vars + , RenderError + , render + ) +where +-------------------------------------------------------------------------------- +import Xanthous.Prelude hiding + (many, concat, try, elements, some, parts) +-------------------------------------------------------------------------------- +import Test.QuickCheck hiding (label) +import Test.QuickCheck.Instances.Text () +import Test.QuickCheck.Instances.Semigroup () +import Test.QuickCheck.Checkers (EqProp) +import Control.Monad.Combinators.NonEmpty +import Data.List.NonEmpty (NonEmpty(..)) +import Data.Data +import Text.Megaparsec hiding (sepBy1, some) +import Text.Megaparsec.Char +import qualified Text.Megaparsec.Char.Lexer as L +import Data.Function (fix) +-------------------------------------------------------------------------------- +import Xanthous.Util (EqEqProp(..)) +-------------------------------------------------------------------------------- + +genIdentifier :: Gen Text +genIdentifier = pack <$> listOf1 (elements identifierChars) + +identifierChars :: String +identifierChars = ['a'..'z'] <> ['A'..'Z'] <> ['-', '_'] + +newtype Filter = FilterName Text + deriving stock (Show, Eq, Ord, Generic, Data) + deriving anyclass (NFData) + deriving (IsString) via Text + +instance Arbitrary Filter where + arbitrary = FilterName <$> genIdentifier + shrink (FilterName fn) = fmap FilterName . filter (not . null) $ shrink fn + +data Substitution + = SubstPath (NonEmpty Text) + | SubstFilter Substitution Filter + deriving stock (Show, Eq, Ord, Generic, Data) + deriving anyclass (NFData) + +instance Arbitrary Substitution where + arbitrary = sized . fix $ \gen n -> + let leaves = + [ SubstPath <$> ((:|) <$> genIdentifier <*> listOf genIdentifier)] + subtree = gen $ n `div` 2 + in if n == 0 + then oneof leaves + else oneof $ leaves <> [ SubstFilter <$> subtree <*> arbitrary ] + shrink (SubstPath pth) = + fmap SubstPath + . filter (not . any ((||) <$> null <*> any (`notElem` identifierChars))) + $ shrink pth + shrink (SubstFilter s f) + = shrink s + <> (uncurry SubstFilter <$> shrink (s, f)) + +data Template + = Literal Text + | Subst Substitution + | Concat Template Template + deriving stock (Show, Generic, Data) + deriving anyclass (NFData) + deriving EqProp via EqEqProp Template + +instance Plated Template where + plate _ tpl@(Literal _) = pure tpl + plate _ tpl@(Subst _) = pure tpl + plate f (Concat tpl₁ tpl₂) = Concat <$> f tpl₁ <*> f tpl₂ + +reduceTemplate :: Template -> Template +reduceTemplate = transform $ \case + (Concat (Literal t₁) (Literal t₂)) -> Literal (t₁ <> t₂) + (Concat (Literal "") t) -> t + (Concat t (Literal "")) -> t + (Concat t₁ (Concat t₂ t₃)) -> Concat (Concat t₁ t₂) t₃ + (Concat (Concat t₁ (Literal t₂)) (Literal t₃)) -> (Concat t₁ (Literal $ t₂ <> t₃)) + t -> t + +instance Eq Template where + tpl₁ == tpl₂ = case (reduceTemplate tpl₁, reduceTemplate tpl₂) of + (Literal t₁, Literal t₂) -> t₁ == t₂ + (Subst s₁, Subst s₂) -> s₁ == s₂ + (Concat ta₁ ta₂, Concat tb₁ tb₂) -> ta₁ == tb₁ && ta₂ == tb₂ + _ -> False + +instance Arbitrary Template where + arbitrary = sized . fix $ \gen n -> + let leaves = [ Literal . filter (`notElem` ['\\', '{']) <$> arbitrary + , Subst <$> arbitrary + ] + subtree = gen $ n `div` 2 + genConcat = Concat <$> subtree <*> subtree + in if n == 0 + then oneof leaves + else oneof $ genConcat : leaves + shrink (Literal t) = Literal <$> shrink t + shrink (Subst s) = Subst <$> shrink s + shrink (Concat t₁ t₂) + = shrink t₁ + <> shrink t₂ + <> (Concat <$> shrink t₁ <*> shrink t₂) + +instance Semigroup Template where + (<>) = Concat + +instance Monoid Template where + mempty = Literal "" + +-------------------------------------------------------------------------------- + +type Parser = Parsec Void Text + +sc :: Parser () +sc = L.space space1 empty empty + +lexeme :: Parser a -> Parser a +lexeme = L.lexeme sc + +symbol :: Text -> Parser Text +symbol = L.symbol sc + +identifier :: Parser Text +identifier = lexeme . label "identifier" $ do + firstChar <- letterChar <|> oneOf ['-', '_'] + restChars <- many $ alphaNumChar <|> oneOf ['-', '_'] + pure $ firstChar <| pack restChars + +filterName :: Parser Filter +filterName = FilterName <$> identifier + +substitutionPath :: Parser Substitution +substitutionPath = SubstPath <$> sepBy1 identifier (char '.') + +substitutionFilter :: Parser Substitution +substitutionFilter = do + path <- substitutionPath + fs <- some $ symbol "|" *> filterName + pure $ foldl' SubstFilter path fs + -- pure $ SubstFilter path f + +substitutionContents :: Parser Substitution +substitutionContents + = try substitutionFilter + <|> substitutionPath + +substitution :: Parser Substitution +substitution = between (string "{{") (string "}}") substitutionContents + +literal :: Parser Template +literal = Literal <$> + ( (string "\\{" $> "{") + <|> takeWhile1P Nothing (`notElem` ['\\', '{']) + ) + +subst :: Parser Template +subst = Subst <$> substitution + +template' :: Parser Template +template' = do + parts <- many $ literal <|> subst + pure $ foldr Concat (Literal "") parts + + +template :: Parser Template +template = reduceTemplate <$> template' <* eof + +-------------------------------------------------------------------------------- + +ppSubstitution :: Substitution -> Text +ppSubstitution (SubstPath substParts) = intercalate "." substParts +ppSubstitution (SubstFilter s (FilterName f)) = ppSubstitution s <> " | " <> f + +ppTemplate :: Template -> Text +ppTemplate (Literal txt) = txt +ppTemplate (Subst s) = "{{" <> ppSubstitution s <> "}}" +ppTemplate (Concat tpl₁ tpl₂) = ppTemplate tpl₁ <> ppTemplate tpl₂ + +-------------------------------------------------------------------------------- + +data TemplateVar + = Val Text + | Nested (Map Text TemplateVar) + deriving stock (Show, Eq, Generic) + deriving anyclass (NFData) + +nested :: [(Text, TemplateVar)] -> TemplateVar +nested = Nested . mapFromList + +instance Arbitrary TemplateVar where + arbitrary = sized . fix $ \gen n -> + let nst = fmap mapFromList . listOf $ (,) <$> arbitrary <*> gen (n `div` 2) + in if n == 0 + then Val <$> arbitrary + else oneof [ Val <$> arbitrary + , Nested <$> nst] + +newtype TemplateVars = Vars { getTemplateVars :: Map Text TemplateVar } + deriving stock (Show, Eq, Generic) + deriving anyclass (NFData) + deriving (Arbitrary) via (Map Text TemplateVar) + +type instance Index TemplateVars = Text +type instance IxValue TemplateVars = TemplateVar +instance Ixed TemplateVars where + ix k f (Vars vs) = Vars <$> ix k f vs +instance At TemplateVars where + at k f (Vars vs) = Vars <$> at k f vs + +vars :: [(Text, TemplateVar)] -> TemplateVars +vars = Vars . mapFromList + +lookupVar :: TemplateVars -> NonEmpty Text -> Maybe TemplateVar +lookupVar vs (p :| []) = vs ^. at p +lookupVar vs (p :| (p₁ : ps)) = vs ^. at p >>= \case + (Val _) -> Nothing + (Nested vs') -> lookupVar (Vars vs') $ p₁ :| ps + +data RenderError + = NoSuchVariable (NonEmpty Text) + | NestedFurther (NonEmpty Text) + | NoSuchFilter Filter + deriving stock (Show, Eq, Generic) + deriving anyclass (NFData) + +renderSubst + :: Map Filter (Text -> Text) -- ^ Filters + -> TemplateVars + -> Substitution + -> Either RenderError Text +renderSubst _ vs (SubstPath pth) = + case lookupVar vs pth of + Just (Val v) -> Right v + Just (Nested _) -> Left $ NestedFurther pth + Nothing -> Left $ NoSuchVariable pth +renderSubst fs vs (SubstFilter s fn) = + case fs ^. at fn of + Just filterFn -> filterFn <$> renderSubst fs vs s + Nothing -> Left $ NoSuchFilter fn + +render + :: Map Filter (Text -> Text) -- ^ Filters + -> TemplateVars -- ^ Template variables + -> Template -- ^ Template + -> Either RenderError Text +render _ _ (Literal s) = pure s +render fs vs (Concat t₁ t₂) = (<>) <$> render fs vs t₁ <*> render fs vs t₂ +render fs vs (Subst s) = renderSubst fs vs s diff --git a/test/Spec.hs b/test/Spec.hs index 3790f3ce65..afe81d028c 100644 --- a/test/Spec.hs +++ b/test/Spec.hs @@ -11,6 +11,7 @@ import qualified Xanthous.Entities.RawsSpec import qualified Xanthous.GameSpec import qualified Xanthous.Generators.UtilSpec import qualified Xanthous.MessageSpec +import qualified Xanthous.Messages.TemplateSpec import qualified Xanthous.OrphansSpec import qualified Xanthous.Util.GraphicsSpec import qualified Xanthous.Util.GraphSpec @@ -32,6 +33,7 @@ test = testGroup "Xanthous" , Xanthous.GameSpec.test , Xanthous.Generators.UtilSpec.test , Xanthous.MessageSpec.test + , Xanthous.Messages.TemplateSpec.test , Xanthous.OrphansSpec.test , Xanthous.DataSpec.test , Xanthous.UtilSpec.test diff --git a/test/Xanthous/Messages/TemplateSpec.hs b/test/Xanthous/Messages/TemplateSpec.hs new file mode 100644 index 0000000000..8ea5186c50 --- /dev/null +++ b/test/Xanthous/Messages/TemplateSpec.hs @@ -0,0 +1,80 @@ +-------------------------------------------------------------------------------- +module Xanthous.Messages.TemplateSpec (main, test) where +-------------------------------------------------------------------------------- +import Test.Prelude +import Test.QuickCheck.Instances.Text () +import Data.List.NonEmpty (NonEmpty(..)) +import Data.Function (fix) +-------------------------------------------------------------------------------- +import Xanthous.Messages.Template +-------------------------------------------------------------------------------- + +main :: IO () +main = defaultMain test + +test :: TestTree +test = testGroup "Xanthous.Messages.Template" + [ testGroup "parsing" + [ testProperty "literals" $ forAll genLiteral $ \s -> + testParse template s === Right (Literal s) + , parseCase "escaped curlies" + "foo\\{" + $ Literal "foo{" + , parseCase "simple substitution" + "foo {{bar}}" + $ Literal "foo " `Concat` Subst (SubstPath $ "bar" :| []) + , parseCase "substitution with filters" + "foo {{bar | baz}}" + $ Literal "foo " + `Concat` Subst (SubstFilter (SubstPath $ "bar" :| []) + (FilterName "baz")) + , parseCase "substitution with multiple filters" + "foo {{bar | baz | qux}}" + $ Literal "foo " + `Concat` Subst (SubstFilter (SubstFilter (SubstPath $ "bar" :| []) + (FilterName "baz")) + (FilterName "qux")) + , parseCase "two substitutions and a literal" + "{{a}}{{b}}c" + $ Subst (SubstPath $ "a" :| []) + `Concat` Subst (SubstPath $ "b" :| []) + `Concat` Literal "c" + , localOption (QuickCheckTests 10) + $ testProperty "round-trips with ppTemplate" $ \tpl -> + testParse template (ppTemplate tpl) === Right tpl + ] + , testBatch $ monoid @Template mempty + , testGroup "rendering" + [ testProperty "rendering literals renders literally" + $ forAll genLiteral $ \s fs vs -> + render fs vs (Literal s) === Right s + , testProperty "rendering substitutions renders substitutions" + $ forAll genPath $ \ident val fs -> + let tpl = Subst (SubstPath ident) + tvs = varsWith ident val + in render fs tvs tpl === Right val + , testProperty "filters filter" $ forAll genPath + $ \ident filterName filterFn val -> + let tpl = Subst (SubstFilter (SubstPath ident) filterName) + fs = mapFromList [(filterName, filterFn)] + vs = varsWith ident val + in render fs vs tpl === Right (filterFn val) + ] + ] + where + genLiteral = filter (`notElem` ['\\', '{']) <$> arbitrary + parseCase name input expected = + testCase name $ testParse template input @?= Right expected + testParse p = over _Left errorBundlePretty . runParser p "" + genIdentifier = pack @Text <$> listOf1 (elements identifierChars) + identifierChars = ['a'..'z'] <> ['A'..'Z'] <> ['-', '_'] + + varsWith (p :| []) val = vars [(p, Val val)] + varsWith (phead :| ps) val = vars . pure . (phead ,) . flip fix ps $ + \next pth -> case pth of + [] -> Val val + p : ps' -> nested [(p, next ps')] + + genPath = (:|) <$> genIdentifier <*> listOf genIdentifier + +-- diff --git a/xanthous.cabal b/xanthous.cabal index 85b70c97f7..3c635a8630 100644 --- a/xanthous.cabal +++ b/xanthous.cabal @@ -4,7 +4,7 @@ cabal-version: 1.12 -- -- see: https://github.com/sol/hpack -- --- hash: 61744d8e26bf309ee73e128a90af8badee98aedace39a756b6033f51711d3e2e +-- hash: 4c80448c82dc61f97ea9809ad646f7ad66b0f57ca297e4d44ee596c7a1ef42fe name: xanthous version: 0.1.0.0 @@ -67,6 +67,7 @@ library Xanthous.Generators.LevelContents Xanthous.Generators.Util Xanthous.Messages + Xanthous.Messages.Template Xanthous.Monad Xanthous.Orphans Xanthous.Prelude @@ -122,6 +123,7 @@ library , monad-control , mtl , optparse-applicative + , parser-combinators , pointed , quickcheck-instances , quickcheck-text @@ -184,6 +186,7 @@ executable xanthous Xanthous.Generators.LevelContents Xanthous.Generators.Util Xanthous.Messages + Xanthous.Messages.Template Xanthous.Monad Xanthous.Orphans Xanthous.Prelude @@ -238,6 +241,7 @@ executable xanthous , monad-control , mtl , optparse-applicative + , parser-combinators , pointed , quickcheck-instances , quickcheck-text @@ -274,6 +278,7 @@ test-suite test Xanthous.Entities.RawsSpec Xanthous.GameSpec Xanthous.Generators.UtilSpec + Xanthous.Messages.TemplateSpec Xanthous.MessageSpec Xanthous.OrphansSpec Xanthous.Util.GraphicsSpec @@ -323,6 +328,7 @@ test-suite test , monad-control , mtl , optparse-applicative + , parser-combinators , pointed , quickcheck-instances , quickcheck-text -- cgit 1.4.1 From db6ea025818b2212725442a733ad02d4b5188d2a Mon Sep 17 00:00:00 2001 From: Griffin Smith Date: Mon, 25 May 2020 11:21:19 -0400 Subject: Begin a broken-out NestedMap type Begin breaking out a NestedMap data structure, which existed in both the variables for the new template system and the structure that stored messages. --- package.yaml | 1 + src/Xanthous/Data/NestedMap.hs | 227 ++++++++++++++++++++++++++++++++++++ test/Spec.hs | 4 +- test/Xanthous/Data/NestedMapSpec.hs | 20 ++++ xanthous.cabal | 8 +- 5 files changed, 258 insertions(+), 2 deletions(-) create mode 100644 src/Xanthous/Data/NestedMap.hs create mode 100644 test/Xanthous/Data/NestedMapSpec.hs diff --git a/package.yaml b/package.yaml index 40e42a5b8a..5f43171e38 100644 --- a/package.yaml +++ b/package.yaml @@ -24,6 +24,7 @@ dependencies: - quickcheck-text - quickcheck-instances - brick +- bifunctors - checkers - classy-prelude - comonad diff --git a/src/Xanthous/Data/NestedMap.hs b/src/Xanthous/Data/NestedMap.hs new file mode 100644 index 0000000000..1b875d4483 --- /dev/null +++ b/src/Xanthous/Data/NestedMap.hs @@ -0,0 +1,227 @@ +{-# LANGUAGE PartialTypeSignatures #-} +{-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE QuantifiedConstraints #-} +{-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE PolyKinds #-} +-------------------------------------------------------------------------------- +module Xanthous.Data.NestedMap + ( NestedMapVal(..) + , NestedMap(..) + , lookup + , lookupVal + , insert + + -- * + , (:->) + , BifunctorFunctor'(..) + , BifunctorMonad'(..) + ) where +-------------------------------------------------------------------------------- +import Xanthous.Prelude hiding (lookup, foldMap) +import qualified Xanthous.Prelude as P +-------------------------------------------------------------------------------- +import Test.QuickCheck +import Data.Aeson +import Data.Function (fix) +import Data.Foldable (Foldable(..)) +import Data.List.NonEmpty (NonEmpty(..)) +import qualified Data.List.NonEmpty as NE +-------------------------------------------------------------------------------- + +-- | Natural transformations on bifunctors +type (:->) p q = forall a b. p a b -> q a b +infixr 0 :-> + +class (forall b. Bifunctor b => Bifunctor (t b)) => BifunctorFunctor' t where + bifmap' :: (Bifunctor p, Bifunctor q) => (p :-> q) -> t p :-> t q + +class BifunctorFunctor' t => BifunctorMonad' t where + bireturn' :: (Bifunctor p) => p :-> t p + + bibind' :: (Bifunctor p, Bifunctor q) => (p :-> t q) -> t p :-> t q + bibind' f = bijoin' . bifmap' f + + bijoin' :: (Bifunctor p) => t (t p) :-> t p + bijoin' = bibind' id + + {-# MINIMAL bireturn', (bibind' | bijoin') #-} + +-------------------------------------------------------------------------------- + +data NestedMapVal m k v = Val v | Nested (NestedMap m k v) + +deriving stock instance + ( forall k' v'. (Show k', Show v') => Show (m k' v') + , Show k + , Show v + ) => Show (NestedMapVal m k v) + +deriving stock instance + ( forall k' v'. (Eq k', Eq v') => Eq (m k' v') + , Eq k + , Eq v + ) => Eq (NestedMapVal m k v) + +instance + forall m k v. + ( Arbitrary (m k v) + , Arbitrary (m k (NestedMapVal m k v)) + , Arbitrary k + , Arbitrary v + , IsMap (m k (NestedMapVal m k v)) + , MapValue (m k (NestedMapVal m k v)) ~ (NestedMapVal m k v) + , ContainerKey (m k (NestedMapVal m k v)) ~ k + ) => Arbitrary (NestedMapVal m k v) where + arbitrary = sized . fix $ \gen n -> + let nst = fmap (NestedMap . mapFromList) + . listOf + $ (,) <$> arbitrary @k <*> gen (n `div` 2) + in if n == 0 + then Val <$> arbitrary + else oneof [ Val <$> arbitrary + , Nested <$> nst] + shrink (Val v) = Val <$> shrink v + shrink (Nested mkv) = Nested <$> shrink mkv + +instance Functor (m k) => Functor (NestedMapVal m k) where + fmap f (Val v) = Val $ f v + fmap f (Nested m) = Nested $ fmap f m + +instance Bifunctor m => Bifunctor (NestedMapVal m) where + bimap _ g (Val v) = Val $ g v + bimap f g (Nested m) = Nested $ bimap f g m + +instance BifunctorFunctor' NestedMapVal where + bifmap' _ (Val v) = Val v + bifmap' f (Nested m) = Nested $ bifmap' f m + +instance (ToJSONKey k, ToJSON v, ToJSON (m k (NestedMapVal m k v))) + => ToJSON (NestedMapVal m k v) where + toJSON (Val v) = toJSON v + toJSON (Nested m) = toJSON m + +instance Foldable (m k) => Foldable (NestedMapVal m k) where + foldMap f (Val v) = f v + foldMap f (Nested m) = foldMap f m + +-- _NestedMapVal +-- :: forall m k v m' k' v'. +-- ( IsMap (m k v), IsMap (m' k' v') +-- , IsMap (m [k] v), IsMap (m' [k'] v') +-- , ContainerKey (m k v) ~ k, ContainerKey (m' k' v') ~ k' +-- , ContainerKey (m [k] v) ~ [k], ContainerKey (m' [k'] v') ~ [k'] +-- , MapValue (m k v) ~ v, MapValue (m' k' v') ~ v' +-- , MapValue (m [k] v) ~ v, MapValue (m' [k'] v') ~ v' +-- ) +-- => Iso (NestedMapVal m k v) +-- (NestedMapVal m' k' v') +-- (m [k] v) +-- (m' [k'] v') +-- _NestedMapVal = iso hither yon +-- where +-- hither :: NestedMapVal m k v -> m [k] v +-- hither (Val v) = singletonMap [] v +-- hither (Nested m) = bimap _ _ $ m ^. _NestedMap +-- yon = _ + +-------------------------------------------------------------------------------- + +newtype NestedMap m k v = NestedMap (m k (NestedMapVal m k v)) + +deriving stock instance + ( forall k' v'. (Eq k', Eq v') => Eq (m k' v') + , Eq k + , Eq v + ) => Eq (NestedMap m k v) + +deriving stock instance + ( forall k' v'. (Show k', Show v') => Show (m k' v') + , Show k + , Show v + ) => Show (NestedMap m k v) + +instance Arbitrary (m k (NestedMapVal m k v)) + => Arbitrary (NestedMap m k v) where + arbitrary = NestedMap <$> arbitrary + shrink (NestedMap m) = NestedMap <$> shrink m + +instance Functor (m k) => Functor (NestedMap m k) where + fmap f (NestedMap m) = NestedMap $ fmap (fmap f) m + +instance Bifunctor m => Bifunctor (NestedMap m) where + bimap f g (NestedMap m) = NestedMap $ bimap f (bimap f g) m + +instance BifunctorFunctor' NestedMap where + bifmap' f (NestedMap m) = NestedMap . f $ bimap id (bifmap' f) m + +instance (ToJSONKey k, ToJSON v, ToJSON (m k (NestedMapVal m k v))) + => ToJSON (NestedMap m k v) where + toJSON (NestedMap m) = toJSON m + +instance Foldable (m k) => Foldable (NestedMap m k) where + foldMap f (NestedMap m) = foldMap (foldMap f) m + +-------------------------------------------------------------------------------- + +lookup + :: ( IsMap (m k (NestedMapVal m k v)) + , MapValue (m k (NestedMapVal m k v)) ~ (NestedMapVal m k v) + , ContainerKey (m k (NestedMapVal m k v)) ~ k + ) + => NonEmpty k + -> NestedMap m k v + -> Maybe (NestedMapVal m k v) +lookup (p :| []) (NestedMap vs) = P.lookup p vs +lookup (p :| (p₁ : ps)) (NestedMap vs) = P.lookup p vs >>= \case + (Val _) -> Nothing + (Nested vs') -> lookup (p₁ :| ps) vs' + +lookupVal + :: ( IsMap (m k (NestedMapVal m k v)) + , MapValue (m k (NestedMapVal m k v)) ~ (NestedMapVal m k v) + , ContainerKey (m k (NestedMapVal m k v)) ~ k + ) + => NonEmpty k + -> NestedMap m k v + -> Maybe v +lookupVal ks m + | Just (Val v) <- lookup ks m = Just v + | otherwise = Nothing + +insert + :: ( IsMap (m k (NestedMapVal m k v)) + , MapValue (m k (NestedMapVal m k v)) ~ (NestedMapVal m k v) + , ContainerKey (m k (NestedMapVal m k v)) ~ k + ) + => NonEmpty k + -> v + -> NestedMap m k v + -> NestedMap m k v +insert (k :| []) v (NestedMap m) = NestedMap $ P.insertMap k (Val v) m +insert (k₁ :| (k₂ : ks)) v (NestedMap m) = NestedMap $ alterMap upd k₁ m + where + upd (Just (Nested nm)) = Just . Nested $ insert (k₂ :| ks) v nm + upd _ = Just $ + let (kΩ :| ks') = NE.reverse (k₂ :| ks) + in P.foldl' + (\m' k -> Nested . NestedMap . singletonMap k $ m') + (Nested . NestedMap . singletonMap kΩ $ Val v) + ks' + +-- _NestedMap +-- :: ( IsMap (m k v), IsMap (m' k' v') +-- , IsMap (m (NonEmpty k) v), IsMap (m' (NonEmpty k') v') +-- , ContainerKey (m k v) ~ k, ContainerKey (m' k' v') ~ k' +-- , ContainerKey (m (NonEmpty k) v) ~ (NonEmpty k) +-- , ContainerKey (m' (NonEmpty k') v') ~ (NonEmpty k') +-- , MapValue (m k v) ~ v, MapValue (m' k' v') ~ v' +-- , MapValue (m (NonEmpty k) v) ~ v, MapValue (m' (NonEmpty k') v') ~ v' +-- ) +-- => Iso (NestedMap m k v) +-- (NestedMap m' k' v') +-- (m (NonEmpty k) v) +-- (m' (NonEmpty k') v') +-- _NestedMap = iso undefined yon +-- where +-- hither (NestedMap m) = undefined . mapToList $ m +-- yon mkv = undefined diff --git a/test/Spec.hs b/test/Spec.hs index afe81d028c..b7004b4f89 100644 --- a/test/Spec.hs +++ b/test/Spec.hs @@ -6,6 +6,7 @@ import qualified Xanthous.Data.EntityMapSpec import qualified Xanthous.Data.EntityMap.GraphicsSpec import qualified Xanthous.Data.LevelsSpec import qualified Xanthous.Data.EntitiesSpec +import qualified Xanthous.Data.NestedMapSpec import qualified Xanthous.DataSpec import qualified Xanthous.Entities.RawsSpec import qualified Xanthous.GameSpec @@ -27,8 +28,9 @@ test = testGroup "Xanthous" [ Xanthous.Data.EntityCharSpec.test , Xanthous.Data.EntityMapSpec.test , Xanthous.Data.EntityMap.GraphicsSpec.test - , Xanthous.Data.LevelsSpec.test , Xanthous.Data.EntitiesSpec.test + , Xanthous.Data.LevelsSpec.test + , Xanthous.Data.NestedMapSpec.test , Xanthous.Entities.RawsSpec.test , Xanthous.GameSpec.test , Xanthous.Generators.UtilSpec.test diff --git a/test/Xanthous/Data/NestedMapSpec.hs b/test/Xanthous/Data/NestedMapSpec.hs new file mode 100644 index 0000000000..acf7a67268 --- /dev/null +++ b/test/Xanthous/Data/NestedMapSpec.hs @@ -0,0 +1,20 @@ +-------------------------------------------------------------------------------- +module Xanthous.Data.NestedMapSpec (main, test) where +-------------------------------------------------------------------------------- +import Test.Prelude +-------------------------------------------------------------------------------- +import Test.QuickCheck.Instances.Semigroup () +-------------------------------------------------------------------------------- +import qualified Xanthous.Data.NestedMap as NM +-------------------------------------------------------------------------------- + +main :: IO () +main = defaultMain test + +test :: TestTree +test = testGroup "Xanthous.Data.NestedMap" + [ testProperty "insert/lookup" $ \nm ks v -> + let nm' = NM.insert ks v nm + in counterexample ("inserted: " <> show nm') + $ NM.lookup @Map @Int @Int ks nm' === Just (NM.Val v) + ] diff --git a/xanthous.cabal b/xanthous.cabal index 3c635a8630..6d0b7b1093 100644 --- a/xanthous.cabal +++ b/xanthous.cabal @@ -4,7 +4,7 @@ cabal-version: 1.12 -- -- see: https://github.com/sol/hpack -- --- hash: 4c80448c82dc61f97ea9809ad646f7ad66b0f57ca297e4d44ee596c7a1ef42fe +-- hash: 0486cac7957fae1f9badffdd082f0c5eb5910eb8c066569123b0f57bc6fa0d8b name: xanthous version: 0.1.0.0 @@ -44,6 +44,7 @@ library Xanthous.Data.EntityMap Xanthous.Data.EntityMap.Graphics Xanthous.Data.Levels + Xanthous.Data.NestedMap Xanthous.Data.VectorBag Xanthous.Entities.Character Xanthous.Entities.Creature @@ -95,6 +96,7 @@ library , array , async , base + , bifunctors , brick , checkers , classy-prelude @@ -163,6 +165,7 @@ executable xanthous Xanthous.Data.EntityMap Xanthous.Data.EntityMap.Graphics Xanthous.Data.Levels + Xanthous.Data.NestedMap Xanthous.Data.VectorBag Xanthous.Entities.Character Xanthous.Entities.Creature @@ -213,6 +216,7 @@ executable xanthous , array , async , base + , bifunctors , brick , checkers , classy-prelude @@ -274,6 +278,7 @@ test-suite test Xanthous.Data.EntityMap.GraphicsSpec Xanthous.Data.EntityMapSpec Xanthous.Data.LevelsSpec + Xanthous.Data.NestedMapSpec Xanthous.DataSpec Xanthous.Entities.RawsSpec Xanthous.GameSpec @@ -299,6 +304,7 @@ test-suite test , array , async , base + , bifunctors , brick , checkers , classy-prelude -- cgit 1.4.1 From 53b56744f4335c038724a1bcffc27a7eb8cf6a6d Mon Sep 17 00:00:00 2001 From: Griffin Smith Date: Mon, 25 May 2020 11:34:29 -0400 Subject: Remove obsolete fixme comment This has been fixed --- src/Xanthous/Game/Draw.hs | 3 --- 1 file changed, 3 deletions(-) diff --git a/src/Xanthous/Game/Draw.hs b/src/Xanthous/Game/Draw.hs index b855ce88e4..b9bd8fdc03 100644 --- a/src/Xanthous/Game/Draw.hs +++ b/src/Xanthous/Game/Draw.hs @@ -98,9 +98,6 @@ drawMap game (`member` characterVisiblePositions game) (\pos -> (game ^. debugState . allRevealed) || (pos `member` (game ^. revealedPositions))) - -- FIXME: this will break down as soon as creatures can walk around on their - -- own, since we don't want to render things walking around when the - -- character can't see them (game ^. entities) bullet :: Char -- cgit 1.4.1