Add minigame, correct XP freeze and alive logic (#36)

* Specify persistent in DESCRIPTION, update NEWS

* Consolidate blueprint-handling functions to one file

* Changes to game

* Add higher-lower game with chance influenced by hungry status

* Add dirty graphic

* Correct xp freeze and alive logic

DESCRIPTION

@@ -3,8 +3,8 @@ Title: Digital Pets in R
 Version: 0.0.0.9007
 Authors@R: c(person("Matt", "Dray", , "mwdray@gmail.com", role = c("aut", "cre")),
     person("Adriana", "De Palma", , , role = "ctb"))
-Description: Store a digital pet on your computer and interact with it in your R
-    console.
+Description: Store a persistent digital pet on your computer and interact with
+    it in your R console.
 License: MIT + file LICENSE
 URL: https://matt-dray.github.io/tamRgo/, https://github.com/matt-dray/tamRgo
 BugReports: https://github.com/matt-dray/tamRgo/issues

NEWS.md

@@ -1,9 +1,11 @@
 # tamRgo 0.0.0.9007
 
 * Used concept of 'XP freeze' at a certain age (21); chance of being unalive after this is dependent on that freeze value and the number of days since that age was reached (towards #23).
-* Adjusedt passive XP accumulation (#24).
-* Alerted user on level up.
+* Adjusted passive XP accumulation (#24).
+* Added alert for user when pet levels up.
 * Created internal dataset as `internal`, containing `$sprites` and `$constants` for a single source of truth on level up thresholds, age for XP freeze, etc.
+* Added a chance-based minigame to the `play()` function.
+* Corrected and update exported-function documentation.
 
 # tamRgo 0.0.0.9006
 

R/blueprints.R

@@ -1,47 +1,4 @@
 
-#' Create a Blueprint
-#'
-#' @description Generate a blueprint for a new pet. Includes date-dependent and
-#'    randomised elements.
-#'
-#' @param pet_name Character. A name for the new tamRgo pet. Maximum eight
-#'     characters.
-#'
-#' @details The full blueprint contains the following values.
-#'
-#' Section 'meta':
-#' \describe{
-#'   \item{pet_id}{Unique (probably) identification number.}
-#'   \item{alive}{Is the pet not unalive?}
-#'   \item{last_interaction}{Datetime that user last interacted with their pet.}
-#' }
-#'
-#' Section 'characteristics':
-#' \describe{
-#'   \item{name}{Pet's user-provided name.}
-#'   \item{species}{Randomly-selected pet species.}
-#'   \item{born}{Date that the pet was created.}
-#'   \item{age}{Days since born.}
-#' }
-#'
-#' Section 'experience':
-#' \describe{
-#'   \item{xp}{Experience points.}
-#'   \item{level}{Growth stage.}
-#' }
-#'
-#' Section 'status':
-#' \describe{
-#'   \item{happy}{Happiness on a scale of 0 to 5.}
-#'   \item{hungry}{Hunger on a scale of 0 to 5.}
-#'   \item{dirty}{Dirtiness on a scale of 0 to 5.}
-#' }
-#'
-#' @return A list.
-#'
-#' @examples \dontrun{.create_blueprint(name = "Kevin")}
-#'
-#' @noRd
 .create_blueprint <- function(pet_name) {
 
   if (!is.character(pet_name) | nchar(pet_name) > 8) {
@@ -80,15 +37,6 @@
 
 }
 
-#' Sample Characteristics for a New Pet
-#'
-#' @details A sub-function of \code{\link{.create_blueprint}}.
-#'
-#' @return A list.
-#'
-#' @examples \dontrun{.roll_characteristics()}
-#'
-#' @noRd
 .roll_characteristics <- function() {
 
   pet_id_chars <- c(letters, LETTERS, 0:9)
@@ -104,26 +52,6 @@
 
 }
 
-#' Write a Local Blueprint
-#'
-#' @description Save a newly-created pet blueprint to the package's directory
-#'     for user-specific data. The package will seek the blueprint from this
-#'     location, but its relatively hidden from the user.
-#'
-#' @param blueprint List. A pet's blueprint created via \code{\link{lay_egg}}.
-#' @param ask Logical. Should the user be asked about creating or updating the
-#'     existing blueprint file? Defaults to TRUE. Used internally with FALSE to
-#'     ignore interactivity.
-#'
-#' @return Nothing.
-#'
-#' @examples
-#' \dontrun{
-#' bp <- .create_blueprint("KEVIN")
-#' .write_blueprint(bp, ask = FALSE)
-#' }
-#'
-#' @noRd
 .write_blueprint <- function(blueprint, ask = TRUE) {
 
   .check_blueprint(blueprint)
@@ -148,7 +76,12 @@
 
   if (ask & !has_data_file) {
 
-    answer <- readline("Save pet blueprint? y/n: ")
+    answer <- readline(
+      paste(
+        "Your pet's data is stored as a small 'blueprint' file on your computer.",
+        "Save pet blueprint? y/n: "
+      )
+    )
 
     if (substr(tolower(answer), 1, 1) == "y") {
 
@@ -192,21 +125,14 @@
 
 }
 
-#' Read a Local Blueprint
-#'
-#' @return Nothing.
-#'
-#' @examples \dontrun{.read_blueprint()}
-#'
-#' @noRd
 .read_blueprint <- function() {
 
   data_dir <- tools::R_user_dir("tamRgo", which = "data")
   data_file <- file.path(data_dir, "blueprint.rds")
   has_data_file <- file.exists(data_file)
 
   if (!has_data_file) {
-    stop("There is no blueprint to read.", call. = FALSE)
+    stop("There is no pet blueprint to read.", call. = FALSE)
   }
 
   if (has_data_file) {

R/interact.R

@@ -131,6 +131,10 @@ see_pet <- function() {
 
   .draw_pet(pet_matrix)
 
+  if (bp$status$dirty > 0) {
+    .draw_pet(internal$graphics$dirt)
+  }
+
 }
 
 #' Play with Your Pet
@@ -154,27 +158,56 @@ play <- function() {
     )
   }
 
+  if (bp$status$dirty > 0) {
+    stop(
+      paste(
+        bp$characteristics$name, "is dirty! You should clean() before you play!"
+      ),
+      call. = FALSE
+    )
+  }
+
+  chance_bad_base <- 1 - (1 / (bp$status$hungry + 1))
+  chance_bad <- chance_bad_base / 4
+  chance_good <- (1 - chance_bad_base) / 6
+
   results <- vector(mode = "list", length = 5)
 
   for (i in 1:5) {
 
-    answer <- sample(c("h", "t"), size = 1)
-    guess <- tolower(readline("Heads or tails? Type 'h' or 't': "))
-    is_correct <- guess == answer
+    shown <- sample(
+      1:10,
+      size = 1,
+      prob = c(rep(chance_good, 3), rep(chance_bad, 4), rep(chance_good, 3))
+    )
+
+    actual <- sample(1:10, size = 1)
+    actual_direction <- sign(actual - shown)
+
+    guess <- tolower(
+      readline(
+        paste0("The number is ", shown, ". Higher or lower? Type 'H' or 'L': ")
+      )
+    )
+
+    if (guess == "h") guess_direction <- 1
+    if (guess == "l") guess_direction <- -1
+
+    is_correct <- actual_direction == guess_direction
 
     if (is_correct) {
 
       results[i] <- TRUE
       correct_n <- length(Filter(isTRUE, results))
-      message("Correct! ", correct_n, "/5.")
+      message("Correct! It was ", actual, ". Score: ", correct_n, "/5.")
 
     }
 
     if (!is_correct) {
 
       results[i] <- FALSE
       correct_n <- length(Filter(isTRUE, results))
-      message("Wrong! ", correct_n, "/5.")
+      message("Wrong! It was ", actual, ". Score: ", correct_n, "/5.")
 
     }
 
@@ -183,7 +216,10 @@ play <- function() {
   correct_n <- length(Filter(isTRUE, results))
   message("Result: you scored ", correct_n, "/5!")
 
-  bp$status$happy <- min(bp$status$happy + 1L, 5L)
+  if (correct_n > 0) {
+    bp$status$happy <- min(bp$status$happy + 1L, 5L)
+  }
+
   bp$experience$xp <- bp$experience$xp + correct_n
   suppressMessages(.write_blueprint(bp, ask = FALSE))
 

R/update.R

@@ -110,16 +110,16 @@
 # between the age at last interaction and today's age.
 .update_xp_freeze <- function(blueprint, age_last, age_updated) {
 
-  if (internal$constants$age_freeze %in% c(age_last:age_updated)) {  # if age freeze met since last interaction
+  if (internal$constants$age_freeze %in% age_last:age_updated) {  # if age freeze met since last interaction
 
-    if (!is.na(blueprint$experience$xp_freeze)) {   # if the xp value has not yet been stored already
+    if (is.na(blueprint$experience$xp_freeze)) {   # if the xp value has not yet been stored already
 
       # Calculate how many passive XP woul dhave been accumulated between last interaction and age freeze
       days_last_to_freeze <- internal$constants$age_freeze - age_last  # days between last interaction and the age freeze
       xp_per_hour <- 60 / internal$constants$xp_increment  # pass ive XP per hour
       xp_to_freeze <- xp_per_hour * (days_last_to_freeze * 24)  # XP per hour, times days between last interaction and age freeze
 
-      xp_freeze_value <- blueprint$experience$xp_freeze + xp_to_freeze  # XP at last interaction plus XP to age freeze from last interaction
+      xp_freeze_value <- blueprint$experience$xp + xp_to_freeze  # XP at last interaction plus XP to age freeze from last interaction
 
       blueprint$experience$xp_freeze <- xp_freeze_value
 
@@ -169,8 +169,8 @@
     # Calculate base chance of survival
     unalive_chance <- 100 / blueprint$experience$xp_freeze  # chance of sampling FALSE
 
-    days_since_freeze <-  # number of days to sample for
-      blueprint$characteristics$age_updated - internal$constants$age_freeze
+    # Number of days to sample for ()
+    days_since_freeze <- (age_updated - internal$constants$age_freeze) + 1  # +1 in case age is same day
 
     if (days_since_freeze > 0) {  # if the XP freeze has occurred
 

data-raw/internal-data.R

@@ -1,4 +1,11 @@
 
+
+# Load in existing data for editing ---------------------------------------
+
+
+load("R/sysdata.rda")
+
+
 # Create internal data list of species images -----------------------------
 
 
@@ -65,6 +72,14 @@ sprites <- list(
 )
 
 
+
+# Other graphics ----------------------------------------------------------
+
+
+dirt <- click_pixels(5, 7)
+graphics <- list(dirt = matrix_to_sprite(dirt))
+
+
 # Declare constants -------------------------------------------------------
 
 
@@ -95,11 +110,11 @@ constants <- list(
 # Combine the lists
 internal <- list(
   sprites = internal$sprites,
+  graphics = internal$graphics,
   constants = constants
 )
 
 # Write the object
 usethis::use_data(internal, internal = TRUE, overwrite = TRUE)
 
-# Load in existing saved file for editing
-load("R/sysdata.rda")
+