TurtleGraphics with the Turtle in Excel

Let's add a turtle to the Graph.





So we put a bunch of parameters on the sheet for TurtleAngle, TurtleXY, TurtleScale, along with a set of points for the turtle:



and set up some matrices to rotate, scale, and translate the points:



And a little bit of code to update the turtle:



Oh and don't forget to add the range of computed points to the graph as another data series.




And the code is pretty short:

If you're using Libreoffice Calc, add

Option VBASupport 1

and comment out the line in colorpoint

Dim xpos, ypos, angle, pencolor As Single
Dim turtlescale As Single
Dim penstatus As Integer
Dim pi As Single
Dim rowpos As Integer

Sub colorpoint(rowpos)
     'comment out for LibreOffice Calc
     ActiveSheet.ChartObjects(1).Chart.SeriesCollection(1).Points(rowpos).Format.Line.ForeColor.RGB = pencolor
End Sub


Sub pc(acolor)
pencolor = acolor
End Sub

Sub initturtle()
rowpos = 1
pi = 3.14
xpos = 0
ypos = 0
angle = 0
pencolor = RGB(255, 0, 0)
penstatus = 1
Cells(1, 1).Resize(500, 2).Clear
turtlescale = 1
updateturtle
End Sub

Sub tsize(x)
  turtlescale = x / 100
  updateturtle
End Sub

Sub updateturtle()
  Cells(1, 6) = angle
  Cells(2, 6) = xpos
  Cells(2, 7) = ypos
  Cells(3, 6) = turtlescale
End Sub


Sub pu()
 penstatus = 0
End Sub

Sub pd()
 penstatus = 1
End Sub

Sub setangle(x)
  angle = x
  updateturtle
End Sub


Sub rt(x)
  angle = angle - x
  updateturtle
End Sub

Sub lt(x)
  rt -x
End Sub


Sub movepos(newxpos, newypos)
  
  oldxpos = xpos
  oldypos = ypos 
    
  If penstatus = 1 Then
    If (rowpos = 1) Then
      ActiveSheet.Cells(rowpos, 1) = oldxpos
      ActiveSheet.Cells(rowpos, 2) = oldypos
      colorpoint rowpos
      rowpos = rowpos + 1
      ActiveSheet.Cells(rowpos, 1) = newxpos
      ActiveSheet.Cells(rowpos, 2) = newypos
      colorpoint rowpos
    ElseIf (ActiveSheet.Cells(rowpos, 1) = oldxpos) And (ActiveSheet.Cells(rowpos, 2) = oldypos) Then
      rowpos = rowpos + 1
      colorpoint rowpos
      ActiveSheet.Cells(rowpos, 1) = newxpos
      ActiveSheet.Cells(rowpos, 2) = newypos
    Else
      rowpos = rowpos + 1
      colorpoint rowpos
      'assigning a cell to empty doesn't actually do anything in LibreOffice
      'LibreOffice likes clear though
      ActiveSheet.Cells(rowpos, 1) = Empty  
      ActiveSheet.Cells(rowpos, 2) = Empty
      ActiveSheet.Cells(rowpos, 1).clear  
      ActiveSheet.Cells(rowpos, 2).clear  
      rowpos = rowpos + 1
      colorpoint rowpos
      ActiveSheet.Cells(rowpos, 1) = oldxpos
      ActiveSheet.Cells(rowpos, 2) = oldypos
      rowpos = rowpos + 1
      colorpoint rowpos
      ActiveSheet.Cells(rowpos, 1) = newxpos
      ActiveSheet.Cells(rowpos, 2) = newypos
  End If
  End If
   xpos = newxpos
   ypos = newypos
   updateturtle
End Sub

Sub fd(dist)
  newxpos = xpos + Cos(angle / 360 * 2 * pi) * dist
  newypos = ypos + Sin(angle / 360 * 2 * pi) * dist
  movepos newxpos, newypos
End Sub
Sub bk(x)
  fd -x
End Sub


Sub refresh()
Application.ScreenUpdating = False
Application.ScreenUpdating = True
End Sub


Sub test1()
Call initturtle: For j = 1 To 6: For i = 1 To 20: call refresh: lt 360 / 20: fd 20: Next i: rt 60: Next j
End Sub

Sub test2()
Call initturtle: For i = 1 To 50: call refresh: Call pu: movepos Rnd() * 50, Rnd() * 50: Call pd: movepos Rnd() * 50, Rnd() * 50: pc RGB(Rnd() * 255, Rnd() * 255, Rnd() * 255): Next i
End Sub