fPainter = setRefClass("firePainter",
##These fields will be set by the calling Layer
fields = list(
ctx = "jsvalRef",
canvas = "jsvalRef"),
methods = list(
drawLine = function(x, y, stroke = NULL) {
call_JS_Method(ScriptCon, .self$ctx, "beginPath", list(), addRoot = FALSE)
res = mapply(function(x,y)
{
call_JS_Method(ScriptCon, .self$ctx, "lineTo", list(x,y), addRoot = FALSE)
call_JS_Method(ScriptCon, .self$ctx, "moveTo", list(x,y), addRoot = FALSE)
},
x,
y)
call_JS_Method(ScriptCon, .self$ctx, "moveTo", list(0, 0), addRoot = FALSE)
call_JS_Method(ScriptCon, .self$ctx, "stroke", list(), addRoot = FALSE)
print(res)
TRUE
},
drawSegment = function(x0, y0, x1, y1, stroke = NULL) {
call_JS_Method(ScriptCon, .self$ctx, "beginPath", list(), addRoot = FALSE)
mapply(function(x0, y0, x1, y1) {
call_JS_Method(ScriptCon, .self$ctx, "moveTo", list(x0, y0), addRoot = FALSE)
call_JS_Method(ScriptCon, .self$ctx, "lineTo", list(x1, y1), addRoot = FALSE)
}, x0, y0, x1, y1)
call_JS_Method(ScriptCon, .self$ctx, "stroke", list(), addRoot = FALSE)
TRUE
},
##Not sure what to do about the point method. Very small filled circle or rectangle?
##currently they are non-filled circles of radius 5 pixels
drawPoint = cmpfun(
function(x,y, stroke = NULL) {
print("in drawPoint function")
if(!is.null(stroke))
stroke = col2rgb(stroke)
if (!length(stroke))
{
change = rep(FALSE, times= length(x))
call_JS_Method(ScriptCon, .self$ctx, "beginPath", list(), addRoot = FALSE)
} else {
if (length(stroke) == 1)
change = c(TRUE,rep(FALSE, times = length(x) - 1))
else
{
stroke2 = stroke[-1]
change = c(TRUE, stroke == stroke2)
}
}
mapply(function(x, y, strokeChange, stroke) {
if (strokeChange)
{
##This will likely cause strange results if drawPoint is called when there is a path already started.
call_JS_Method(ScriptCon, .self$ctx, "fill", list(), addRoot = FALSE)
set_JS_Property(ScriptCon, .self$ctx, "strokeStyle", list(stroke))
call_JS_Method(ScriptCon, .self$ctx, "beginPath", list(), addRoot = FALSE)
}
call_JS_Method(ScriptCon, .self$ctx, "rect", list(x, y, 1, 1), addRoot = FALSE)
}, x, y, change, stroke)
call_JS_Method(ScriptCon, .self$ctx, "fill", list(), addRoot = FALSE)
TRUE
}),
drawRect = function(xleft, ybottom, xright, ytop, stroke = NULL, fill = NULL)
{
call_JS_Method(ScriptCon, .self$ctx, "beginPath", list(), addRoot = FALSE)
##the documentation isn't clear whether this is a global function or a method on the context
glob = JS_GetGlobalObject(Scriptcon, returnInputs = FALSE)
##rect gives us the ability to be vectorized and only draw once, but I don't think we can get stroke/fill capabilities per rectangle
if (is.null(fill) & length(stroke) < 2)
{
mapply(function(x0, y0, x1, y1) {
call_JS_Method(SciptCon, glob, "rect",
list(x0, y0, x1 - x0, y1 - y0),
addRoot = FALSE)
}, xleft, ybottom, xright, ytop)
JS_Call_Method(ScriptCon, .self$ctx, "stroke", list(), addRoot = FALSE)
}
TRUE
}),
contains = "Painter")
#experiment for speed. This is much faster than naively looping in R
fPainter2 = setRefClass("firePainter2",
fields = list(canvas = "character", ctx = "character"),
methods = list(
drawLine = function(x, y, stroke = NULL) {
c1 = paste(.self$ctx, ".beginPath();", sep="")
#call_JS_Method(ScriptCon, .self$ctx, "beginPath", list(), addRoot = FALSE)
cmiddle = mapply(function(x,y) paste(.self$ctx, ".lineTo(", x, " , ", y, ");", sep = ""),
#call_JS_Method(ScriptCon, .self$ctx, "lineTo", list(x,y), addRoot = FALSE),
x,
y)
cend = paste(.self$ctx, ".stroke();", sep="")
#call_JS_Method(ScriptCon, .self$ctx, "stroke", list(), addRoot = FALSE)
script = paste(c(c1, cmiddle, cend), collapse = " ")
print(script)
ret = jsVal()
JS_EvaluateScript(ScriptCon,
JS_GetGlobalObject(ScriptCon),
script,
nchar(script),
"drawPoints",
1L, ret)
TRUE
},
drawPoint = function(x,y, stroke)
{
script = paste(
paste(.self$ctx, ".beginPath();", sep=""),
paste(#.self$ctx, ".moveTo(" , x , " , " , y , ");\n",
.self$ctx, ".rect(", x , " , " , y , " , ", 1 , " , ", 1 , ");", sep=""),
paste(.self$ctx, ".fill();", sep = ""),
collapse="\n")
ret = jsVal()
JS_EvaluateScript(ScriptCon,
JS_GetGlobalObject(ScriptCon),
script,
nchar(script),
"drawPoints",
1L, ret)
TRUE
},
drawCircle = function(x,y, r, stroke)
{
script = paste(
paste(.self$ctx, ".beginPath();", sep=""),
paste(.self$ctx, ".moveTo(" , x , " , " , y , ");\n",
.self$ctx, ".arc(", x , " , " , y , " , ", r , " , " , 0, " , " , 2*pi, " , ", 1 , ");", sep=""),
paste(.self$ctx, ".fill();", sep = ""),
collapse="\n")
ret = jsVal()
JS_EvaluateScript(ScriptCon,
JS_GetGlobalObject(ScriptCon),
script,
nchar(script),
"drawPoints",
1L, ret)
TRUE
}
),
contains = "Painter")
fPainter3 = setRefClass("firePainter3",
fields = list(canvas = "jsvalRef", ctx = "jsvalRef"),
methods = list(
drawPoint = function(x,y, stroke)
{
if(!is.null(stroke))
stroke = col2rgb(stroke)
if (!length(stroke))
{
change = rep(FALSE, times= length(x))
call_JS_Method(ScriptCon, .self$ctx, "beginPath", list(), addRoot = FALSE)
} else {
if (length(stroke) == 1)
change = c(TRUE,rep(FALSE, times = length(x) - 1))
else
{
stroke2 = stroke[-1]
change = c(TRUE, stroke == stroke2)
}
}
if(is.null(stroke))
hexstroke = NULL
else
hexstroke = paste("#", paste(format(as.hexmode(stroke), width = 2), collapse = ""), sep = "")
.Call("R_DrawPoints", as.numeric(x), as.numeric(y), hexstroke, ScriptCon, change, .self$ctx)
TRUE
},
drawCircle = function(x,y,r, stroke)
{
if(!is.null(stroke))
{
stroke = col2rgb(stroke)
if (length(stroke) == 1)
change = c(TRUE,rep(FALSE, times = length(x) - 1))
else
{
stroke2 = stroke[-1]
change = c(TRUE, stroke == stroke2)
}
hexstroke = paste("#", paste(format(as.hexmode(stroke), width = 2), collapse = ""), sep = "")
} else {
change = rep(FALSE, times= length(x))
call_JS_Method(ScriptCon, .self$ctx, "beginPath", list(), addRoot = FALSE)
hexstroke = NULL
}
if (length(r) != length(x))
r = rep(r, length.out = length(x))
.Call("R_DrawCircles", as.numeric(x), as.numeric(y),as.numeric(r), hexstroke, ScriptCon, change, .self$ctx)
TRUE
}),
contains = "Painter")
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.