Here you will find the source code for the Kitty Hero game, as described in the upcoming book Graphic Guide to R
Copyright 2018 Antony Lees
Licensed under the Apache License, Version 2.0 (the "License"); you may not use this file except in compliance with the License. You may obtain a copy of the License at
http://www.apache.org/licenses/LICENSE-2.0
Unless required by applicable law or agreed to in writing, software distributed under the License is distributed on an "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. See the License for the specific language governing permissions and limitations under the License.
settings <- function() {
library(R6)
size(600, 1000)
}
setup <- function() {
# Cat class
Cat <- R6Class("Cat",
public = list(
x = 0,
y = 0,
cat_colour = color(255,200,0),
cat_size = 0,
tail_length = 0,
tail_thickness = 0,
tail = NULL,
initialize = function(x, y, cat_size) {
self$x <- x
self$y <- y
self$cat_size <- cat_size
self$tail_length <- cat_size/5
self$tail_thickness <- cat_size/6
# initialise tail
self$tail <- list()
for (i in 1:self$tail_length) {
self$tail[[i]] <- c(0,0)
}
},
draw_cat = function() {
noStroke()
fill(self$cat_colour)
ellipse(self$x, self$y, self$cat_size, self$cat_size) # body
ellipse(self$x, self$y-(self$cat_size * 0.5), self$cat_size * 0.5, self$cat_size * 0.5) #head
triangle(self$x-(self$cat_size/24), self$y-(self$cat_size * 0.7), self$x-(self$cat_size/6), self$y-(self$cat_size * 0.7),self$x-(self$cat_size/8), self$y-(self$cat_size * 0.7)-20) # left ear
triangle(self$x+(self$cat_size/24), self$y-(self$cat_size * 0.7), self$x+(self$cat_size/6), self$y-(self$cat_size * 0.7),self$x+(self$cat_size/8), self$y-(self$cat_size * 0.7)-20) # right ear
# tail
# update tail end
tail_end <- self$tail[[length(self$tail)]]
new_tail_end_x <- (sin(frameCount * 0.2) * 10)
self$tail[[length(self$tail)]] <- c(new_tail_end_x, tail_end[2])
# rest of tail
for (i in 1:(length(self$tail)-1)) {
tail_part <- self$tail[[i]]
new_tail_part <- self$tail[[i+1]]
self$tail[[i]] <- c(new_tail_part[1], tail_part[2])
pushMatrix()
translate(self$x, self$y + self$tail_thickness + (i * self$tail_thickness))
ellipse(new_tail_part[1], new_tail_part[2], self$tail_thickness, self$tail_thickness)
popMatrix()
}
},
set_x = function(x) {
self$x <- x
},
set_y = function(y) {
self$y <- y
}
)
)
# Tile class
Tile <- R6Class("Tile",
public = list(
x = 0,
y = 0,
type = NULL,
initialize = function(x, y, type) {
self$x <- x
self$y <- y
self$type <- type
},
draw_tile = function() {
stroke(0)
if (self$type == standard_tile) {
tile_colour <- color(255) # white
} else if (self$type == hole_tile) {
tile_colour <- color(0) # black
} else if (self$type == hole_hit_tile) {
tile_colour <- color(255, 0, 0) #red
} else if (self$type == target_tile) {
tile_colour <- color(255, 255, 0) #yellow
}
fill(tile_colour)
rect(self$x, self$y, tile_size, tile_size)
},
hit = function(cat_x, cat_y) {
hit <- cat_y >= self$y && cat_y <= self$y + tile_size && cat_x >= self$x && cat_x <= self$x + tile_size
return(hit)
},
target_hit = function(cat_x, cat_y) {
hit <- self$hit(cat_x, cat_y) && self$type == target_tile
if (hit) {
self$type <- standard_tile
}
return(hit)
},
hole_hit = function(cat_x, cat_y) {
hit <- self$hit(cat_x, cat_y) && self$type == hole_tile
if (hit) {
self$type = hole_hit_tile
}
return(hit)
}
)
)
# global variables
standard_tile <<- "standard"
hole_tile <<- "hole"
hole_hit_tile <<- "hole hit"
target_tile <<- "target"
number_of_columns <<- 5
tiles <<- list()
tile_size <<- width/number_of_columns/2
number_of_rows <<- height/tile_size
score <<- 0
lives <<- 3
lowest_speed <<- 5
highest_speed <<- 20
speed <<- lowest_speed
x_offset <- (width - tile_size * number_of_columns)/2
grace_period <- 1
# initialise tiles
for (i in 1:number_of_rows) {
# set y coordinates (-y so scrolls downwards)
y <- -(i-1) * tile_size
for (j in 1:number_of_columns) {
if (i > grace_period) { # grace period
# set x coordinates
x <- (j-1) * tile_size + x_offset
tile_type = random_tile_type()
tile <- Tile$new(x, y, tile_type)
tiles[[length(tiles)+1]] <- tile
}
}
}
cat <<- Cat$new(width/2, height/2, tile_size)
}
draw <- function() {
background(0)
# set speed but keep within limits
speed <<- constrain(score/2, lowest_speed, highest_speed)
#tiles
for (i in 1: length(tiles)) {
if (lives >= 1) {
tile <- tiles[[i]]
tile$y <- tile$y + speed
tile$draw_tile()
if(tile$target_hit(cat$x, cat$y)) {
score <- score + 1
}
if(tile$hole_hit(cat$x, cat$y)) {
lives <- lives -1
}
}
}
recycle_tiles()
# score
fill(255) # white text
textSize(tile_size/2.5)
text(sprintf("Score: %s", score), 10, tile_size/2)
# lives
text(sprintf("Lives: %s", lives), width-(tile_size*1.5), tile_size/2)
#cat
cat$draw_cat()
}
# generate a random tile type
random_tile_type <- function() {
tile_type = standard_tile
# randomised tile chances
if(random(0,5) > 4) {
tile_type = hole_tile
}
if(random(0,50) > 45) {
tile_type = target_tile
}
return(tile_type)
}
recycle_tiles <- function() {
# get y coord of last tile
y <- 0
for (i in 1:length(tiles)) {
tile <- tiles[[i]]
if (tile$y < y) {
y <- tile$y
}
}
# move tiles to the end (x coord can stay the same)
new_y <- y + (tile_size*2)
for (i in 1:length(tiles)) {
tile <- tiles[[i]]
if (tile$y > height) {
tile$y <- new_y
tile$type <- random_tile_type()
}
}
}
mouseMoved <- function() {
cat$set_x(mouseX)
cat$set_y(mouseY)
}