Nothing
R/move.R
In TurtleGraphics: Turtle Graphics
## TurtleGraphics package for R
## Copyright (C) 2014-2017 A.Cena, M.Gagolewski, B.Zogala-Siudem, and others
##
## 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 <http://www.gnu.org/licenses/>.
#' @title Move the Turtle Forward or Backward
#'
#' @description
#' \code{turtle_forward} moves the Turtle in forward direction and
#' \code{turtle_backward} moves the Turtle back.
#'
#'
#' @details
#' The Turtle must be initialized prior to using
#' these functions, see \code{\link{turtle_init}}.
#'
#' These functions make use of the Turtle's display options specified by
#' the \code{\link{turtle_param}} function
#' (or if not, use the default options set by \code{\link{turtle_init}}).
#'
#' Note that if \code{\link{turtle_up}} or \code{\link{turtle_down}}
#' was called, the Turtle's trace will be or not be drawn, respectively.
#'
#' If you are willing to call these functions in an R loop,
#' you may want to hide the Turtle temporarily (see \code{\link{turtle_hide}}
#' and \code{\link{turtle_do}})
#' before making actual moves. This will increase the drawing performance
#' significantly.
#'
#'
#' @param distance single numeric value; specifies the distance to make.
#' Negative distance results in moving in the opposite direction.
#' @param direction character string; moving direction.
#' One of \code{"forward"} or \code{"backward"}.
#'
#'
#'
#' @examples
#' turtle_init()
#' turtle_left(30)
#' turtle_forward(2)
#' turtle_up()
#' turtle_forward(1)
#' turtle_down()
#' turtle_right(60)
#' turtle_forward(9)
#'
#' @family TurtleGraphics
#' @rdname turtle_move
#' @export
turtle_move <- function(distance, direction = c("forward", "backward"))
{
.turtle_check()
direction <- match.arg(direction)
stopifnot(is.numeric(distance), length(distance) == 1, is.finite(distance))
if (distance < 0)
warning("Negative value of `distance` moves the Turtle in the opposite direction.")
if (direction == 'backward')
distance <- -distance
# current values for .turtle_history
curX <- get("x", envir=.turtle_data)
curY <- get("y", envir=.turtle_data)
curAng <- get("angle", envir=.turtle_data)
curGp <- get("gpar_path", envir=.turtle_data)
curDraw <- get("draw", envir=.turtle_data)
curMode <- get("mode", envir=.turtle_data)
curWidth <- get("width", envir=.turtle_data)
curHeight <- get("height", envir=.turtle_data)
curVisible <- get("visible", envir=.turtle_data)
if (curMode == 'error')
.turtle_draw_error(distance, curX, curY, curAng, curGp, curDraw,
curWidth, curHeight, curVisible)
else if (curMode == 'clip')
.turtle_draw_clip(distance, curX, curY, curAng, curGp, curDraw,
curWidth, curHeight, curVisible)
else
.turtle_draw_cycle(distance, curX, curY, curAng, curGp, curDraw,
curWidth, curHeight, curVisible)
invisible(NULL)
}
#' @rdname turtle_move
#' @export
turtle_forward <- function(distance)
{
turtle_move(distance, 'forward')
}
#' @rdname turtle_move
#' @export
turtle_backward <- function(distance)
{
turtle_move(distance, 'backward')
}
# This function shall not be exported:
.turtle_draw_fromto <- function(curX, curY, newX, newY, curGp, curDraw, curVisible)
{
if (curVisible) .turtle_undraw()
if (curDraw) {
grid.lines(c(curX, newX), c(curY, newY),
gp = curGp, default.units='native')
}
assign("x", newX, envir=.turtle_data)
assign("y", newY, envir=.turtle_data)
if (curVisible) .turtle_draw()
}
# This function shall not be exported:
.turtle_draw_error <- function(distance, curX, curY, curAng, curGp, curDraw,
curWidth, curHeight, curVisible)
{
newX <- curX + distance * sin(curAng * pi / 180)
newY <- curY + distance * cos(curAng * pi / 180)
if (newY > curHeight || newY < 0 || newX > curWidth || newX < 0)
stop("The Turtle escaped from the terrarium. :-(")
.turtle_draw_fromto(curX, curY, newX, newY, curGp, curDraw, curVisible)
}
# This function shall not be exported:
.turtle_draw_clip <- function(distance, curX, curY, curAng, curGp, curDraw,
curWidth, curHeight, curVisible)
{
# new position
newX <- curX + distance * sin(curAng * pi / 180)
newY <- curY + distance * cos(curAng * pi / 180)
.turtle_draw_fromto(curX, curY, newX, newY, curGp, curDraw, curVisible)
}
# This function shall not be exported:
.turtle_draw_cycle <- function(distance, curX, curY, curAng, curGp, curDraw,
curWidth, curHeight, curVisible)
{
tmpVisible <- curVisible
if (curVisible){
tmpVisible <- TRUE
curVisible <- FALSE
.turtle_undraw()
assign("visible", FALSE, envir=.turtle_data)
}
newX <- curX + distance * sin(curAng * pi / 180)
newY <- curY + distance * cos(curAng * pi / 180)
tmpAng <- curAng %% 360
# if turtle leaves terrarium:
if(newX > curWidth | newX < 0 | newY > curHeight | newY < 0){
if(tmpAng < 90){
distWallX <- curWidth - curX
distWallY <- curHeight - curY
if(distWallX / distWallY > tan(tmpAng * pi / 180)){
# up
.turtle_cycle_up(distance, curX, curY, curAng, curGp, curDraw,
curWidth, curHeight, curVisible,
newX, newY, tmpAng)
}else{
# right
.turtle_cycle_right(distance, curX, curY, curAng, curGp, curDraw,
curWidth, curHeight, curVisible,
newX, newY, tmpAng)
}
}else{
if(tmpAng < 180){
distWallX <- curWidth - curX
distWallY <- curY
if(distWallY / distWallX > tan((tmpAng - 90) * pi / 180)){
# right
.turtle_cycle_right(distance, curX, curY, curAng, curGp, curDraw,
curWidth, curHeight, curVisible,
newX, newY, tmpAng)
}else{
# down
.turtle_cycle_down(distance, curX, curY, curAng, curGp, curDraw,
curWidth, curHeight, curVisible,
newX, newY, tmpAng)
}
}else{
if(tmpAng < 270){
distWallX <- curX
distWallY <- curY
if(distWallX / distWallY > tan((tmpAng - 180) * pi / 180)){
# down
.turtle_cycle_down(distance, curX, curY, curAng, curGp, curDraw,
curWidth, curHeight, curVisible,
newX, newY, tmpAng)
}else{
# left
.turtle_cycle_left(distance, curX, curY, curAng, curGp, curDraw,
curWidth, curHeight, curVisible,
newX, newY, tmpAng)
}
}else{
distWallX <- curX
distWallY <- curHeight - curY
if(distWallY / distWallX > tan((tmpAng - 270) * pi / 180)){
# left
.turtle_cycle_left(distance, curX, curY, curAng, curGp, curDraw,
curWidth, curHeight, curVisible,
newX, newY, tmpAng)
}else{
# up
.turtle_cycle_up(distance, curX, curY, curAng, curGp, curDraw,
curWidth, curHeight, curVisible,
newX, newY, tmpAng)
}
}
}
}
}
else .turtle_draw_fromto(curX, curY, newX, newY, curGp, curDraw, curVisible)
if (tmpVisible){
.turtle_draw()
assign("visible", TRUE, envir=.turtle_data)
}
}
# This function shall not be exported:
.turtle_cycle_up <- function(distance, curX, curY, curAng, curGp, curDraw,
curWidth, curHeight, curVisible,
newX, newY, tmpAng)
{
distPassed <- (curHeight - curY) / cos(tmpAng * pi / 180)
nextX <- curX + distPassed * sin(tmpAng * pi / 180)
distLeft <- distance - distPassed
.turtle_draw_fromto(curX, curY, nextX, curHeight, curGp, curDraw, curVisible)
assign("y", 0, envir=.turtle_data)
.turtle_draw_cycle(distLeft, nextX, 0, curAng, curGp, curDraw,
curWidth, curHeight, curVisible)
}
# This function shall not be exported:
.turtle_cycle_down <- function(distance, curX, curY, curAng, curGp, curDraw,
curWidth, curHeight, curVisible,
newX, newY, tmpAng)
{
tmpAng <- tmpAng - 180
distPassed <- (curY) / cos(tmpAng * pi / 180)
nextX <- curX - distPassed * sin(tmpAng * pi / 180)
distLeft <- distance - distPassed
.turtle_draw_fromto(curX, curY, nextX, 0, curGp, curDraw, curVisible)
assign("y", curHeight, envir=.turtle_data)
.turtle_draw_cycle(distLeft, nextX, curHeight, curAng, curGp, curDraw,
curWidth, curHeight, curVisible)
}
# This function shall not be exported:
.turtle_cycle_left <- function(distance, curX, curY, curAng, curGp, curDraw,
curWidth, curHeight, curVisible,
newX, newY, tmpAng)
{
tmpAng <- tmpAng - 270
distPassed <- (curX) / cos(tmpAng * pi / 180)
nextY <- curY + distPassed * sin(tmpAng * pi / 180)
distLeft <- distance - distPassed
.turtle_draw_fromto(curX, curY, 0, nextY, curGp, curDraw, curVisible)
assign("x", curWidth, envir=.turtle_data)
.turtle_draw_cycle(distLeft, curWidth, nextY, curAng, curGp, curDraw,
curWidth, curHeight, curVisible)
}
# This function shall not be exported:
.turtle_cycle_right <- function(distance, curX, curY, curAng, curGp, curDraw,
curWidth, curHeight, curVisible,
newX, newY, tmpAng)
{
tmpAng <- tmpAng - 90
distPassed <- (curWidth - curX) / cos(tmpAng * pi / 180)
nextY <- curY - distPassed * sin(tmpAng * pi / 180)
distLeft <- distance - distPassed
.turtle_draw_fromto(curX, curY, curWidth, nextY, curGp, curDraw, curVisible)
assign("x", 0, envir=.turtle_data)
.turtle_draw_cycle(distLeft, 0, nextY, curAng, curGp, curDraw,
curWidth, curHeight, curVisible)
}
Try the TurtleGraphics package in your browser
Any scripts or data that you put into this service are public.
TurtleGraphics documentation built on May 2, 2019, 1:07 p.m.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
## TurtleGraphics package for R
## Copyright (C) 2014-2017 A.Cena, M.Gagolewski, B.Zogala-Siudem, and others
##
## 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 <http://www.gnu.org/licenses/>.
#' @title Move the Turtle Forward or Backward
#'
#' @description
#' \code{turtle_forward} moves the Turtle in forward direction and
#' \code{turtle_backward} moves the Turtle back.
#'
#'
#' @details
#' The Turtle must be initialized prior to using
#' these functions, see \code{\link{turtle_init}}.
#'
#' These functions make use of the Turtle's display options specified by
#' the \code{\link{turtle_param}} function
#' (or if not, use the default options set by \code{\link{turtle_init}}).
#'
#' Note that if \code{\link{turtle_up}} or \code{\link{turtle_down}}
#' was called, the Turtle's trace will be or not be drawn, respectively.
#'
#' If you are willing to call these functions in an R loop,
#' you may want to hide the Turtle temporarily (see \code{\link{turtle_hide}}
#' and \code{\link{turtle_do}})
#' before making actual moves. This will increase the drawing performance
#' significantly.
#'
#'
#' @param distance single numeric value; specifies the distance to make.
#' Negative distance results in moving in the opposite direction.
#' @param direction character string; moving direction.
#' One of \code{"forward"} or \code{"backward"}.
#'
#'
#'
#' @examples
#' turtle_init()
#' turtle_left(30)
#' turtle_forward(2)
#' turtle_up()
#' turtle_forward(1)
#' turtle_down()
#' turtle_right(60)
#' turtle_forward(9)
#'
#' @family TurtleGraphics
#' @rdname turtle_move
#' @export
turtle_move <- function(distance, direction = c("forward", "backward"))
{
.turtle_check()
direction <- match.arg(direction)
stopifnot(is.numeric(distance), length(distance) == 1, is.finite(distance))
if (distance < 0)
warning("Negative value of `distance` moves the Turtle in the opposite direction.")
if (direction == 'backward')
distance <- -distance
# current values for .turtle_history
curX <- get("x", envir=.turtle_data)
curY <- get("y", envir=.turtle_data)
curAng <- get("angle", envir=.turtle_data)
curGp <- get("gpar_path", envir=.turtle_data)
curDraw <- get("draw", envir=.turtle_data)
curMode <- get("mode", envir=.turtle_data)
curWidth <- get("width", envir=.turtle_data)
curHeight <- get("height", envir=.turtle_data)
curVisible <- get("visible", envir=.turtle_data)
if (curMode == 'error')
.turtle_draw_error(distance, curX, curY, curAng, curGp, curDraw,
curWidth, curHeight, curVisible)
else if (curMode == 'clip')
.turtle_draw_clip(distance, curX, curY, curAng, curGp, curDraw,
curWidth, curHeight, curVisible)
else
.turtle_draw_cycle(distance, curX, curY, curAng, curGp, curDraw,
curWidth, curHeight, curVisible)
invisible(NULL)
}
#' @rdname turtle_move
#' @export
turtle_forward <- function(distance)
{
turtle_move(distance, 'forward')
}
#' @rdname turtle_move
#' @export
turtle_backward <- function(distance)
{
turtle_move(distance, 'backward')
}
# This function shall not be exported:
.turtle_draw_fromto <- function(curX, curY, newX, newY, curGp, curDraw, curVisible)
{
if (curVisible) .turtle_undraw()
if (curDraw) {
grid.lines(c(curX, newX), c(curY, newY),
gp = curGp, default.units='native')
}
assign("x", newX, envir=.turtle_data)
assign("y", newY, envir=.turtle_data)
if (curVisible) .turtle_draw()
}
# This function shall not be exported:
.turtle_draw_error <- function(distance, curX, curY, curAng, curGp, curDraw,
curWidth, curHeight, curVisible)
{
newX <- curX + distance * sin(curAng * pi / 180)
newY <- curY + distance * cos(curAng * pi / 180)
if (newY > curHeight || newY < 0 || newX > curWidth || newX < 0)
stop("The Turtle escaped from the terrarium. :-(")
.turtle_draw_fromto(curX, curY, newX, newY, curGp, curDraw, curVisible)
}
# This function shall not be exported:
.turtle_draw_clip <- function(distance, curX, curY, curAng, curGp, curDraw,
curWidth, curHeight, curVisible)
{
# new position
newX <- curX + distance * sin(curAng * pi / 180)
newY <- curY + distance * cos(curAng * pi / 180)
.turtle_draw_fromto(curX, curY, newX, newY, curGp, curDraw, curVisible)
}
# This function shall not be exported:
.turtle_draw_cycle <- function(distance, curX, curY, curAng, curGp, curDraw,
curWidth, curHeight, curVisible)
{
tmpVisible <- curVisible
if (curVisible){
tmpVisible <- TRUE
curVisible <- FALSE
.turtle_undraw()
assign("visible", FALSE, envir=.turtle_data)
}
newX <- curX + distance * sin(curAng * pi / 180)
newY <- curY + distance * cos(curAng * pi / 180)
tmpAng <- curAng %% 360
# if turtle leaves terrarium:
if(newX > curWidth | newX < 0 | newY > curHeight | newY < 0){
if(tmpAng < 90){
distWallX <- curWidth - curX
distWallY <- curHeight - curY
if(distWallX / distWallY > tan(tmpAng * pi / 180)){
# up
.turtle_cycle_up(distance, curX, curY, curAng, curGp, curDraw,
curWidth, curHeight, curVisible,
newX, newY, tmpAng)
}else{
# right
.turtle_cycle_right(distance, curX, curY, curAng, curGp, curDraw,
curWidth, curHeight, curVisible,
newX, newY, tmpAng)
}
}else{
if(tmpAng < 180){
distWallX <- curWidth - curX
distWallY <- curY
if(distWallY / distWallX > tan((tmpAng - 90) * pi / 180)){
# right
.turtle_cycle_right(distance, curX, curY, curAng, curGp, curDraw,
curWidth, curHeight, curVisible,
newX, newY, tmpAng)
}else{
# down
.turtle_cycle_down(distance, curX, curY, curAng, curGp, curDraw,
curWidth, curHeight, curVisible,
newX, newY, tmpAng)
}
}else{
if(tmpAng < 270){
distWallX <- curX
distWallY <- curY
if(distWallX / distWallY > tan((tmpAng - 180) * pi / 180)){
# down
.turtle_cycle_down(distance, curX, curY, curAng, curGp, curDraw,
curWidth, curHeight, curVisible,
newX, newY, tmpAng)
}else{
# left
.turtle_cycle_left(distance, curX, curY, curAng, curGp, curDraw,
curWidth, curHeight, curVisible,
newX, newY, tmpAng)
}
}else{
distWallX <- curX
distWallY <- curHeight - curY
if(distWallY / distWallX > tan((tmpAng - 270) * pi / 180)){
# left
.turtle_cycle_left(distance, curX, curY, curAng, curGp, curDraw,
curWidth, curHeight, curVisible,
newX, newY, tmpAng)
}else{
# up
.turtle_cycle_up(distance, curX, curY, curAng, curGp, curDraw,
curWidth, curHeight, curVisible,
newX, newY, tmpAng)
}
}
}
}
}
else .turtle_draw_fromto(curX, curY, newX, newY, curGp, curDraw, curVisible)
if (tmpVisible){
.turtle_draw()
assign("visible", TRUE, envir=.turtle_data)
}
}
# This function shall not be exported:
.turtle_cycle_up <- function(distance, curX, curY, curAng, curGp, curDraw,
curWidth, curHeight, curVisible,
newX, newY, tmpAng)
{
distPassed <- (curHeight - curY) / cos(tmpAng * pi / 180)
nextX <- curX + distPassed * sin(tmpAng * pi / 180)
distLeft <- distance - distPassed
.turtle_draw_fromto(curX, curY, nextX, curHeight, curGp, curDraw, curVisible)
assign("y", 0, envir=.turtle_data)
.turtle_draw_cycle(distLeft, nextX, 0, curAng, curGp, curDraw,
curWidth, curHeight, curVisible)
}
# This function shall not be exported:
.turtle_cycle_down <- function(distance, curX, curY, curAng, curGp, curDraw,
curWidth, curHeight, curVisible,
newX, newY, tmpAng)
{
tmpAng <- tmpAng - 180
distPassed <- (curY) / cos(tmpAng * pi / 180)
nextX <- curX - distPassed * sin(tmpAng * pi / 180)
distLeft <- distance - distPassed
.turtle_draw_fromto(curX, curY, nextX, 0, curGp, curDraw, curVisible)
assign("y", curHeight, envir=.turtle_data)
.turtle_draw_cycle(distLeft, nextX, curHeight, curAng, curGp, curDraw,
curWidth, curHeight, curVisible)
}
# This function shall not be exported:
.turtle_cycle_left <- function(distance, curX, curY, curAng, curGp, curDraw,
curWidth, curHeight, curVisible,
newX, newY, tmpAng)
{
tmpAng <- tmpAng - 270
distPassed <- (curX) / cos(tmpAng * pi / 180)
nextY <- curY + distPassed * sin(tmpAng * pi / 180)
distLeft <- distance - distPassed
.turtle_draw_fromto(curX, curY, 0, nextY, curGp, curDraw, curVisible)
assign("x", curWidth, envir=.turtle_data)
.turtle_draw_cycle(distLeft, curWidth, nextY, curAng, curGp, curDraw,
curWidth, curHeight, curVisible)
}
# This function shall not be exported:
.turtle_cycle_right <- function(distance, curX, curY, curAng, curGp, curDraw,
curWidth, curHeight, curVisible,
newX, newY, tmpAng)
{
tmpAng <- tmpAng - 90
distPassed <- (curWidth - curX) / cos(tmpAng * pi / 180)
nextY <- curY - distPassed * sin(tmpAng * pi / 180)
distLeft <- distance - distPassed
.turtle_draw_fromto(curX, curY, curWidth, nextY, curGp, curDraw, curVisible)
assign("x", 0, envir=.turtle_data)
.turtle_draw_cycle(distLeft, 0, nextY, curAng, curGp, curDraw,
curWidth, curHeight, curVisible)
}
Try the TurtleGraphics package in your browser
Any scripts or data that you put into this service are public.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Embedding an R snippet on your website
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.