Pirate Animation R Code

Here you will find the source code for the pirate animation, 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() {
  size(300, 300) 
}

setup <- function() {
  ships <<- list() # list for ships
  for (i in 1:10) {
    ship <- pirate_ship()
    # initialise
    ship <- initialise(ship)
    # Add the object to the list
    ships[[length(ships) + 1]] <- ship 
  }
  # waves
  wave_max_height <<- 20
  wave_min_height <<- 5
  wave_height <<- wave_max_height   
  up <<- 1
  down <<- -1
  wave_direction <<- up

}

draw <- function() {
  # light blue background
  background(102, 205, 170)
  # waves
  noFill()
  # wave y coordinate
  wave_y <- wave_max_height/2
  # while the y coordinate is less than the height of the window
  while (wave_y <= height) {
    # wave x coordinate
    wave_x <- 0
    # while the x coordinate is less than the width of the window
    while (wave_x <= width) {
            # draw a semi-circle arc
            arc(wave_x, wave_y, wave_max_height, wave_height, 0, PI)
            # increase the x coordinate by 20
            wave_x <- wave_x + wave_max_height
    }
    # increase the y coordinate by 20
    wave_y <- wave_y + wave_max_height
  }
  # determine of the waves should be going up or down
  if (wave_height <= wave_min_height) {
    wave_direction = up
  }
  if (wave_height >= wave_max_height) {
    wave_direction = down
  }
  # change the wave height for next time
  wave_height <<- wave_height + wave_direction


  # ships
  for (i in 1:length(ships)) {
    ship <- ships[[i]]
    display(ship)
    ship <- move(ship)
    if (ship$x + ship$length < 0) {
      ship <- initialise(ship)
    }
    ships[[i]] <- ship
  }
}

# pirate ship class
pirate_ship <- function() {
   structure(
     list(
       x = 0,
       y = 0,
       length = 60,
       sails = 0,
       sail_colour = 0,
       porthole_count = 0,
       sail_spacing = 0,
       speed = 0
     ),
    class = "pirate_ship"
  )
}

initialise <- function(obj) { # generic method
  UseMethod("initialise") 
}

initialise.pirate_ship <- function(obj) {
       obj$x <- width
       obj$y <- random(50,350)
       obj$length <- random(40,100)
       obj$sails <- min(obj$length/30,3)
       obj$sail_colour <- color(random(255),random(255),random(255))
       obj$porthole_count <- obj$length/12
       obj$sail_spacing <- obj$length/3
       obj$speed <- obj$length/20
       return(obj)
}

display <- function(obj) { # generic method
  UseMethod("display") 
}

display.pirate_ship <- function(obj) {
  # calculate ship coordinates
  front_of_ship_x_position <- obj$x - (obj$length / 2)
  back_of_ship_x_position <- obj$x + obj$length + (obj$length / 3)

  # ship hull
  # brown lines and fill
  stroke(139, 71, 38)
  fill(139, 71, 38)
  # middle rectangle
  rect(obj$x, obj$y, obj$length, 20)
  # front and back
  triangle(front_of_ship_x_position, obj$y, obj$x, obj$y, obj$x, obj$y + 20)
  triangle(obj$x + obj$length, obj$y, back_of_ship_x_position, obj$y, obj$x + obj$length, obj$y + 20)
  
  # draw the sails
  initial_sail_x_position = obj$x
  for (i in 1:obj$sails) {
    # black lines
    stroke(0)
    # sail
    fill(obj$sail_colour)
    quad(initial_sail_x_position + (obj$sail_spacing * i), obj$y - 40, initial_sail_x_position + (obj$sail_spacing * i) + 10, obj$y - 40, initial_sail_x_position + (obj$sail_spacing * i) + 20, obj$y - 10, initial_sail_x_position + (obj$sail_spacing * i), obj$y - 10)
    # mast
    fill(0)
    line(initial_sail_x_position + (obj$sail_spacing * i), obj$y - 10, initial_sail_x_position + (obj$sail_spacing * i), obj$y)
    line(initial_sail_x_position + (obj$sail_spacing * i), obj$y - 40, initial_sail_x_position + (obj$sail_spacing * i), obj$y - 50)
    
    # flag
    fill(0)
    rect(initial_sail_x_position + (obj$sail_spacing * i), obj$y - 50, 10, 5)
    # jolly roger
    stroke(255)
    line(initial_sail_x_position + (obj$sail_spacing * i) + 2, obj$y - 49, initial_sail_x_position + (obj$sail_spacing * i) + 8, obj$y - 46)
    line(initial_sail_x_position + (obj$sail_spacing * i) + 8, obj$y - 49, initial_sail_x_position + (obj$sail_spacing * i) + 2, obj$y - 46)
  }

  # draw the portholes
  stroke(0)
  for (i in 1:obj$porthole_count) {
    # portholes
    fill(0)
    ellipse(obj$x+(15*(i-1)),obj$y+10,5,5)
  }
}

move <- function(obj) { # generic method
  UseMethod("move") 
}

move.pirate_ship <- function(obj) {
  obj$x <- obj$x - obj$speed
  return(obj)
}