I've been threatening to implement this for a few posts, now, so I decided it was finally time for me to put my money where my mouth is. :-)
This post extends the series I've been writing on turtle graphics (here's the most recent part, from which you'll find links to its predecessors). This series has been about developing a turtle graphics engine using C#, eventually extending it for 3D. The series so far has focused very much on the engine, but from very early on it was my intention to use this engine to implement a subset of the LOGO programming language within AutoCAD.
[Note: you may have noticed I've switched to all capital letters when spelling "LOGO", in this post: over the last few weeks I've seen it in many places as "LOGO" and many others as "Logo". Even on Wikipedia it varies depending on the article, so in the absence of a definitive reference I've alternated to use the one I chose not to use last time. :-)]
For the language implementation I took advantage of code posted in this article, which shows how to create a simple LOGO implementation using F#. In this post we take the language-oriented portion of the F# code, extend it to implement some additional operations (especially related to 3D) and hook it up to the core C# engine.
Why did I choose to use F# for the language module? As mentioned earlier in the series, functional programming languages are very well suited to implementing other programming languages, and F# has the additional benefit of very simple interoperability with other .NET languages (such as C#, the language we used for the engine). I'd even made the decision to use F# before finding a pre-existing LOGO implementation I could just drop into my project. :-)
The development process was actually pretty painless, all told. The result is a modeless LOGO Interpreter window hosted inside AutoCAD which remembers the position and properties of the turtle, allowing you to interactively generate 3D geometry using interpreted code. Which is, in fact, very cool - even more so than I originally expected... :-)
A couple of notes: the LOGO implementation is relatively bare-bones: for instance, while you can define functions and iterate using "repeat", I miss having a conditional operator ("if... then... else..."). But not quite enough to go ahead and implement one. For now I've focused more on getting the integration with AutoCAD working.
Before we dive into the code, here's the source project, which contains a C# module and an F# module implemented using F# 1.9.4. This should save you lots of project set-up and copy & pasting, but you will still need to build both projects to try them out.
I made some changes to the TurtleEngine to support saving the current state of the turtle to the active document's UserData property, a technique covered in this previous post. I also extended the engine to allow automatic updating of the UCS to match the current turtle position & orientation: the idea being that rather than going to the trouble of displaying a turtle (which I would probably do using the Transient Graphics API in AutoCAD 2009, if I really had to), we can simply have the UCS icon (controlled via the UCSICON command) show where it is, by changing the UCS's origin and orientation to be that of the turtle. The engine creates all geometry relative to the World Coordinate System, in any case, so changing the UCS is only going to impact additional geometry created by the user.
Here's the updated C# code for the engine:
using Autodesk.AutoCAD.ApplicationServices;
using Autodesk.AutoCAD.DatabaseServices;
using Autodesk.AutoCAD.EditorInput;
using Autodesk.AutoCAD.Geometry;
using Autodesk.AutoCAD.Colors;
using System.Collections;
using System;
namespace TurtleGraphics
{
// This class encapsulates pen
// information and will be
// used by our TurtleEngine
class Pen
{
// Private members
private Color m_color;
private double m_width;
private bool m_down;
// Public properties
public Color Color
{
get { return m_color; }
set { m_color = value; }
}
public double Width
{
get { return m_width; }
set { m_width = value; }
}
public bool Down
{
get { return m_down; }
set { m_down = value; }
}
// Constructor
public Pen()
{
m_color =
Color.FromColorIndex(ColorMethod.ByAci, 0);
m_width = 0.0;
m_down = false;
}
}
// The main Turtle Graphics engine
public class TurtleEngine : IDisposable
{
// Constants
const string kPenKey = "TTIF_TG_Pen";
const string kEcsKey = "TTIF_TG_Ecs";
// Private members
private Transaction m_trans;
private Polyline3d m_poly;
private Circle m_profile;
private Pen m_pen;
private CoordinateSystem3d m_ecs;
private bool m_updateGraphics;
// Public properties
public Point3d Position
{
get { return m_ecs.Origin; }
set
{
m_ecs =
new CoordinateSystem3d(
value,
m_ecs.Xaxis,
m_ecs.Yaxis
);
}
}
public Vector3d Direction
{
get { return m_ecs.Xaxis; }
}
// Constructor
public TurtleEngine(Transaction tr)
{
m_pen = new Pen();
m_trans = tr;
m_poly = null;
m_profile = null;
m_ecs =
new CoordinateSystem3d(
Point3d.Origin,
Vector3d.XAxis,
Vector3d.YAxis
);
m_updateGraphics = false;
}
public void Dispose()
{
TerminateCurrentSection();
}
// Public methods
public bool LoadSettings(Document doc)
{
Hashtable ud = doc.UserData;
bool foundAll = true;
m_pen = ud[kPenKey] as Pen;
if (m_pen == null)
{
foundAll = false;
object obj = ud[kPenKey];
if (obj == null)
{
m_pen = new Pen();
}
else
{
// Found something different instead
doc.Editor.WriteMessage(
"Found an object of type \"" +
obj.GetType().ToString() +
"\" instead of a Pen.");
}
}
if (ud.ContainsKey(kEcsKey))
{
m_ecs =
(CoordinateSystem3d)ud[kEcsKey];
}
else
{
foundAll = false;
m_ecs =
new CoordinateSystem3d(
Point3d.Origin,
Vector3d.XAxis,
Vector3d.YAxis
);
}
return foundAll;
}
public void SaveSettings(Document doc)
{
ClearSettings(doc);
Hashtable ud = doc.UserData;
ud.Add(kPenKey, m_pen);
ud.Add(kEcsKey, m_ecs);
}
public void ClearSettings(Document doc)
{
Hashtable ud = doc.UserData;
if (ud.ContainsKey(kPenKey))
ud.Remove(kPenKey);
if (ud.ContainsKey(kEcsKey))
ud.Remove(kEcsKey);
}
public void TurtleToUcs(Document doc)
{
Editor ed = doc.Editor;
Matrix3d curUcs =
ed.CurrentUserCoordinateSystem;
ed.CurrentUserCoordinateSystem =
curUcs.PreMultiplyBy(
Matrix3d.AlignCoordinateSystem(
curUcs.CoordinateSystem3d.Origin,
curUcs.CoordinateSystem3d.Xaxis,
curUcs.CoordinateSystem3d.Yaxis,
curUcs.CoordinateSystem3d.Zaxis,
m_ecs.Origin,
m_ecs.Xaxis,
m_ecs.Yaxis,
m_ecs.Zaxis
)
);
}
public void Turn(double angle)
{
// Rotate our direction by the
// specified angle
Matrix3d mat =
Matrix3d.Rotation(
angle,
m_ecs.Zaxis,
Position
);
m_ecs =
new CoordinateSystem3d(
m_ecs.Origin,
m_ecs.Xaxis.TransformBy(mat),
m_ecs.Yaxis.TransformBy(mat)
);
}
public void Pitch(double angle)
{
// Pitch in our direction by the
// specified angle
Matrix3d mat =
Matrix3d.Rotation(
angle,
m_ecs.Yaxis,
m_ecs.Origin
);
m_ecs =
new CoordinateSystem3d(
m_ecs.Origin,
m_ecs.Xaxis.TransformBy(mat),
m_ecs.Yaxis
);
}
public void Roll(double angle)
{
// Roll along our direction by the
// specified angle
Matrix3d mat =
Matrix3d.Rotation(
angle,
m_ecs.Xaxis,
m_ecs.Origin
);
m_ecs =
new CoordinateSystem3d(
m_ecs.Origin,
m_ecs.Xaxis,
m_ecs.Yaxis.TransformBy(mat)
);
}
public void Move(double distance)
{
// Move the cursor by a specified
// distance in the direction in
// which we're pointing
Point3d oldPos = m_ecs.Origin;
Point3d newPos = oldPos + m_ecs.Xaxis * distance;
m_ecs =
new CoordinateSystem3d(
newPos,
m_ecs.Xaxis,
m_ecs.Yaxis
);
// If the pen is down, we draw something
if (m_pen.Down)
GenerateSegment(oldPos, newPos);
}
public void PenDown()
{
m_pen.Down = true;
}
public void PenUp()
{
m_pen.Down = false;
// We'll start a new entity with the next
// use of the pen
TerminateCurrentSection();
}
public void SetPenWidth(double width)
{
m_pen.Width = width;
TerminateCurrentSection();
}
public void SetPenColor(int idx)
{
// Right now we just use an ACI,
// to make the code simpler
Color col =
Color.FromColorIndex(
ColorMethod.ByAci,
(short)idx
);
// If we have to change the color,
// we'll start a new entity
// (if the entity type we're creating
// supports per-segment colors, we
// don't need to do this)
if (col != m_pen.Color)
{
TerminateCurrentSection();
m_pen.Color = col;
}
}
// Internal helper to generate geometry
private void GenerateSegment(
Point3d oldPos, Point3d newPos)
{
Document doc =
Autodesk.AutoCAD.ApplicationServices.
Application.DocumentManager.MdiActiveDocument;
Database db = doc.Database;
Editor ed = doc.Editor;
Autodesk.AutoCAD.ApplicationServices.
TransactionManager tm =
doc.TransactionManager;
// Create the current object, if there is none
if (m_poly == null)
{
BlockTable bt =
(BlockTable)m_trans.GetObject(
db.BlockTableId,
OpenMode.ForRead
);
BlockTableRecord ms =
(BlockTableRecord)m_trans.GetObject(
bt[BlockTableRecord.ModelSpace],
OpenMode.ForWrite
);
// Create the polyline
m_poly = new Polyline3d();
m_poly.Color = m_pen.Color;
// Add the polyline to the database
ms.AppendEntity(m_poly);
m_trans.AddNewlyCreatedDBObject(m_poly, true);
// Add the first vertex
PolylineVertex3d vert =
new PolylineVertex3d(oldPos);
m_poly.AppendVertex(vert);
m_trans.AddNewlyCreatedDBObject(vert, true);
m_profile =
new Circle(oldPos, Direction, m_pen.Width);
ms.AppendEntity(m_profile);
m_trans.AddNewlyCreatedDBObject(m_profile, true);
m_profile.DowngradeOpen();
}
// Add the new vertex
PolylineVertex3d vert2 =
new PolylineVertex3d(newPos);
m_poly.AppendVertex(vert2);
m_trans.AddNewlyCreatedDBObject(vert2, true);
// Display the graphics, to avoid long,
// black-box operations
if (m_updateGraphics)
{
tm.QueueForGraphicsFlush();
tm.FlushGraphics();
ed.UpdateScreen();
}
}
// Internal helper to generate 3D geometry
private void TerminateCurrentSection()
{
if (m_profile != null && m_poly != null)
{
Document doc =
Autodesk.AutoCAD.ApplicationServices.
Application.DocumentManager.MdiActiveDocument;
Database db = doc.Database;
Editor ed = doc.Editor;
try
{
// Generate a Region from our circular profile
DBObjectCollection col =
new DBObjectCollection();
col.Add(m_profile);
DBObjectCollection res =
Region.CreateFromCurves(col);
Region reg =
res[0] as Region;
if (reg != null)
{
BlockTable bt =
(BlockTable)m_trans.GetObject(
db.BlockTableId,
OpenMode.ForRead
);
BlockTableRecord ms =
(BlockTableRecord)m_trans.GetObject(
bt[BlockTableRecord.ModelSpace],
OpenMode.ForWrite
);
// Extrude our Region along the Polyline3d path
Solid3d sol = new Solid3d();
sol.ExtrudeAlongPath(reg, m_poly, 0.0);
sol.Color = m_pen.Color;
// Add the generated Solid3d to the database
ms.AppendEntity(sol);
m_trans.AddNewlyCreatedDBObject(sol, true);
// Get rid of the Region, profile and path
reg.Dispose();
m_profile.UpgradeOpen();
m_profile.Erase();
m_poly.Erase();
}
}
catch (System.Exception ex)
{
ed.WriteMessage(
"\nException: {0}",
ex.Message
);
}
}
m_profile = null;
m_poly = null;
}
}
}
Now for the language portion. You'll notice some additional commands related to pen properties and 3D, and I've also removed the "Canvas" command, as the concept is irrelevant for our purposes. I've left much of the code as it is - there was already a graphics state (gstate) object being passed in to the various functions, so rather than change the code throughout, I updated the calling function to pass in our TurtleEngine instead: F#'s code inference makes it really simple to replace one object type with another, and have that propagate throughout the project. Which is one reason F# code is much more composable (functions can be dropped into other systems with very little need for rework) than C#, for instance.
Something I noticed about the engine, when making use of Turn(), Pitch() and Roll()... the positive/negative angle values didn't always match the directions (at least not as I expected them to). So I did a little adjustment when implementing the PitchUp, PitchDown, Left & Right instructions, negating where needed. I could have also changed the engine, but I decided to leave it as a legacy implementation quirk. :-)
Here's the F# code for the language module... my apologies for the lack of comments: as I picked up someone else's code, I haven't gone through and documented what is happening (the original article helps understand this).
#light
module AutoLogo
#I @"..\bin"
#r "TurtleGraphics.dll"
#nowarn "57"
#nowarn "191"
open TurtleGraphics
open System.IO
open Printf
open String
open System.Collections.Generic
type num = float
type source =
{
reader : IEnumerator<token>
pos : pos
}
and ppos =
{
mutable x' : int
mutable y' : int
}
and pos =
{
x : int
y : int
}
and token =
| WORD of string * pos
| VAR of string * pos
| NUMBER of num * pos
| LBRACK of pos
| RBRACK of pos
| HOLE of pos
with
member self.IsRBrack =
match self with
| RBRACK _ -> true | _ -> false
end
type instr =
| Hole of pos
| Number of num * pos
| Var of string * pos
| List of instr list * pos
| Binop of (num -> num -> num) * instr * instr * pos
| Unop of (num -> num) * instr * pos
| Left of instr * pos
| Right of instr * pos
| RollLeft of instr * pos
| RollRight of instr * pos
| PitchUp of instr * pos
| PitchDown of instr * pos
| Forward of instr * pos
| PenWidth of instr * pos
| PenColor of instr * pos
| PenUp of pos
| PenDown of pos
| Repeat of instr * instr * pos
| To of string * string list * instr * pos
| FunCall of string * instr list * pos
with
member self.Pos =
match self with
| Var (_, pos) | List (_, pos)
| Hole pos | Number (_, pos)
| Binop (_, _, _, pos) | Unop (_, _, pos)
| Left (_, pos) | Right (_, pos)
| RollLeft (_, pos) | RollRight (_, pos)
| PitchUp (_, pos) | PitchDown (_, pos)
| Forward (_, pos)
| PenWidth (_, pos) | PenColor (_, pos)
| PenUp pos | PenDown pos
| Repeat (_, _, pos) | To (_, _, _, pos)
| FunCall (_, _, pos) ->
pos
end
type state =
{
funs : Map<string, string list * instr>
vars : Map<string, float>
} with
static member Default =
{
funs = Map.Empty()
vars = Map.Empty()
}
end
let isEof (stream: #StringReader) = stream.Peek() = -1
let rec neq_peek allowEof (stream: #StringReader) =
function
| [] ->
if allowEof then stream.Peek() <> -1 else true
| a :: b ->
stream.Peek() <> Char.code a &&
neq_peek allowEof stream b
let rec eq_peek (stream: #StringReader) =
function
| [] ->
stream.Peek() <> -1
| [ a ] ->
stream.Peek() = Char.code a &&
stream.Peek() <> -1
| a :: b :: rest ->
stream.Peek() = Char.code a ||
eq_peek stream (b :: rest)
let eatWS ((stream: #StringReader), pos) =
while (eq_peek stream [' '; '\n'; '\t']) do
let x, y =
if stream.Peek()=10 then
1, (!pos).y'+1
else
(!pos).x'+1, (!pos).y'
stream.Read() |> ignore
(!pos).x' <- x
(!pos).y' <- y
let readWord (((stream: #StringReader), pos) as source) =
let res, seps = ref "", [' '; ']'; '['; '?'; '\n'; '\t']
eatWS source
if not (neq_peek true stream []) then
failwith "readWord"
while (neq_peek true stream seps) do
res := !res ^ (String.of_char (Char.chr (stream.Peek())))
(!pos).x' <- (!pos).x' + 1
stream.Read() |> ignore
!res
exception Eof
let GenerateTokenStream s =
let pos_of_ppos ({ x'=x; y'=y }: ppos) = { x=x; y=y }
let reader =
Seq.generate
(fun () -> new StringReader(s), ref { x'=1; y'=1 })
(fun ((stream, pos) as source) ->
let rec fetch stream =
eatWS source
if eq_peek stream [':'] then
let w = readWord source
VAR (w, pos_of_ppos !pos)
elif eq_peek stream ['['] then
stream.Read() |> ignore
LBRACK (pos_of_ppos !pos)
elif eq_peek stream [']'] then
stream.Read() |> ignore
RBRACK (pos_of_ppos !pos)
elif eq_peek stream ['?'] then
stream.Read() |> ignore
HOLE (pos_of_ppos !pos)
elif isEof stream then
raise Eof
else
let w = readWord source
try NUMBER (float w, (pos_of_ppos !pos)) with
_ -> WORD (w, pos_of_ppos !pos)
try Some (fetch stream) with Eof -> None)
(fun (stream, _) -> stream.Dispose())
reader.GetEnumerator()
exception VarNotFound of string * pos
exception FunNotFound of string * pos
exception NoCanvas of pos
exception InvalidFunName of pos
exception InvalidParam of pos
exception UnexpectedRBrack of pos
exception UnexpectedEof
exception NumberExpected of pos
exception UnexpectedHole of pos
let find_var state pos v =
try state.vars.[v]
with _ -> raise (VarNotFound (v,pos))
let find_fun state pos f =
try state.funs.[f]
with _ -> raise (FunNotFound (f,pos))
let add_var state v va =
{ state with vars=state.vars.Add (v, va) }
let add_fun state f va =
{ state with funs=state.funs.Add (f, va) }
let ParseTokenStream state stScoping (en: IEnumerator<token>) =
en.Reset()
let rec parse_until state check en f =
let state', e = parse state check true en
let state', res = ref state', ref [ e ]
while (f state en) do
let state'', res' = parse !state' check false en
res := res' :: !res
state' := state''
!state', List.rev !res
and parse state check shouldMove (en: IEnumerator<token>) =
let get1 state check en = snd (parse state check true en)
let get2 state check en =
let _, e1 = parse state check true en
let _, e2 = parse state check true en
e1, e2
let funname_of =
function
| WORD (s, pos) -> s
| VAR (_, pos) | NUMBER (_, pos) | LBRACK pos
| RBRACK pos | HOLE pos ->
raise (InvalidFunName pos)
let rec params_of = function
| Var (s, _) -> [ s ]
| List (l, _) ->
List.fold_left (fun lst e -> lst @ params_of e) [] l
| instr ->
raise (InvalidParam instr.Pos)
let eq_string1 s s1 =
String.lowercase s =
String.lowercase s1
let eq_string2 s s1 s2 =
let s' = String.lowercase s
s' = String.lowercase s1 || s' = String.lowercase s2
if shouldMove && en.MoveNext() || not shouldMove then
match en.Current with
| WORD (s, pos) when eq_string2 s "lt" "left" ->
let _, e = parse state check true en
state, Left (e, pos)
| WORD (s, pos) when eq_string2 s "rt" "right" ->
let _, e = parse state check true en
state, Right (e, pos)
| WORD (s, pos) when eq_string2 s "rl" "rollleft" ->
let _, e = parse state check true en
state, RollLeft (e, pos)
| WORD (s, pos) when eq_string2 s "rr" "rollright" ->
let _, e = parse state check true en
state, RollRight (e, pos)
| WORD (s, pos) when eq_string2 s "pu" "pitchup" ->
let _, e = parse state check true en
state, PitchUp (e, pos)
| WORD (s, pos) when eq_string2 s "pd" "pitchdown" ->
let _, e = parse state check true en
state, PitchDown (e, pos)
| WORD (s, pos) when eq_string2 s "fd" "forward" ->
let _, e = parse state check true en
state, Forward (e, pos)
| WORD (s, pos) when eq_string1 s "penwidth" ->
let _, e = parse state check true en
state, PenWidth (e, pos)
| WORD (s, pos) when eq_string1 s "pencolor" ->
let _, e = parse state check true en
state, PenColor (e, pos)
| WORD (s, pos) when eq_string1 s "penup" ->
state, PenUp pos
| WORD (s, pos) when eq_string1 s "pendown" ->
state, PenDown pos
| WORD (s, pos) when eq_string1 s "repeat" ->
let _, e1 = parse state check true en
let state' = add_var state ":repcount" 1.0
let _, e2 = parse state' check true en
state, Repeat (e1, e2, pos)
| WORD (s, pos) when eq_string2 s "+" "sum" ->
let e1, e2 = get2 state check en
state, Binop ((+), e1, e2, pos)
| WORD (s, pos) when eq_string2 s "-" "minus" ->
let e1, e2 = get2 state check en
state, Binop ((-), e1, e2, pos)
| WORD (s, pos) when eq_string2 s "*" "times" ->
let e1, e2 = get2 state check en
state, Binop (( * ), e1, e2, pos)
| WORD (s, pos) when eq_string2 s "/" "divide" ->
let e1, e2 = get2 state check en
state, Binop ((/), e1, e2, pos)
| WORD (s, pos) when eq_string1 s "min" ->
let e1, e2 = get2 state check en
state, Binop (min, e1, e2, pos)
| WORD (s, pos) when eq_string1 s "max" ->
let e1, e2 = get2 state check en
state, Binop (max, e1, e2, pos)
| WORD (s, pos) when eq_string1 s "sin" ->
let e = get1 state check en
state, Unop (sin, e, pos)
| WORD (s, pos) when eq_string1 s "cos" ->
let e = get1 state check en
state, Unop (cos, e, pos)
| WORD (s, pos) when eq_string1 s "tan" ->
let e = get1 state check en
state, Unop (tan, e, pos)
| WORD (s, pos) when eq_string1 s "pi" ->
state, Number (System.Math.PI, pos)
| WORD (s, pos) when eq_string1 s "repcount" ->
state, Var (":repcount", pos)
| WORD (s, pos) when String.lowercase s = "to" ->
let f =
if en.MoveNext() then
funname_of en.Current
else
raise UnexpectedEof
// Don't check formal parameters
let _, pars = parse state false true en
let pars' = params_of pars
// Add formal parameters to the current state
let state' = List.fold_left (fun state p ->
add_var state p 0.0) state pars'
// Add dummy reference to self
// to allow recursive calls
let state' = add_fun state' f (pars', Hole pos)
let _, e = parse state' check true en
let state'' = add_fun state f (pars', e)
state'', To (f, pars', e, pos)
| WORD (s, pos) ->
let pars, _ = find_fun state pos s
let args =
List.fold_left
(fun args _ ->
let _, e = parse state check true en
e :: args)
[] pars
state, FunCall (s, List.rev args, pos)
| NUMBER (i, pos) ->
state, Number (i, pos)
| VAR (v, pos) ->
if check then find_var state pos v |> ignore
state, Var (v, pos)
| HOLE pos ->
state, Hole pos
| LBRACK pos ->
let _, exps =
parse_until state check en
(fun state (en: IEnumerator<token>) ->
en.MoveNext() && not en.Current.IsRBrack)
state, List (exps, pos)
| RBRACK pos ->
raise (UnexpectedRBrack pos)
else
raise UnexpectedEof
let _, exps =
parse_until state stScoping en
(fun state en -> en.MoveNext())
exps
let rec eval (state: state) (gstate : TurtleEngine) instr =
let rec eval2 state gstate e1 e2 =
let state', gstate', n1 = eval1 state gstate e1
let state'', gstate'', n2 = eval1 state' gstate' e2
state'', gstate'', n1, n2
and eval1 state gstate (e: instr) =
let state', gstate', e' = eval state gstate e
let n = num_of_value e.Pos e'
state', gstate', n
and num_of_value pos = function
| Some i -> i | _ -> raise (NumberExpected pos)
let forward state (gstate : TurtleEngine) pos d =
gstate.Move(d)
state, gstate, None
match instr with
| Binop (f, e1, e2, _) ->
let _, gstate', n1, n2 = eval2 state gstate e1 e2
state, gstate', Some (f n1 n2)
| Unop (f, e, _) ->
let _, gstate', n = eval1 state gstate e
state, gstate', Some (f n)
| Left (e, _) ->
let _, gstate', i = eval1 state gstate e
gstate'.Turn(i * System.Math.PI / 180.0)
state, gstate', None
| Right (e, _) ->
let _, gstate', i = eval1 state gstate e
gstate'.Turn(i * System.Math.PI / -180.0)
state, gstate', None
| RollLeft (e, _) ->
let _, gstate', i = eval1 state gstate e
gstate'.Roll(i * System.Math.PI / -180.0)
state, gstate', None
| RollRight (e, _) ->
let _, gstate', i = eval1 state gstate e
gstate'.Roll(i * System.Math.PI / 180.0)
state, gstate', None
| PitchUp (e, _) ->
let _, gstate', i = eval1 state gstate e
gstate'.Pitch(i * System.Math.PI / -180.0)
state, gstate', None
| PitchDown (e, _) ->
let _, gstate', i = eval1 state gstate e
gstate'.Pitch(i * System.Math.PI / 180.0)
state, gstate', None
| Forward (e, pos) ->
let _, gstate', i = eval1 state gstate e
forward state gstate' pos i
| PenWidth (e, pos) ->
let _, gstate', i = eval1 state gstate e
gstate'.SetPenWidth (i / 2.0)
state, gstate', None
| PenColor (e, pos) ->
let _, gstate', i = eval1 state gstate e
gstate'.SetPenColor (int.of_float i)
state, gstate', None
| PenUp _ ->
gstate.PenUp()
state, gstate, None
| PenDown _ ->
gstate.PenDown()
state, gstate, None
| Number (n, _) ->
state, gstate, Some n
| Var (s, pos) ->
let n = find_var state pos s
state, gstate, Some n
| FunCall (f, args, pos) ->
let pars, body = find_fun state pos f
let state', gstate' =
List.fold_left2
(fun (state, gstate) p arg ->
let _, gstate', i =
eval1 state gstate arg
add_var state p i, gstate')
(state, gstate) pars args
let _, gstate'', res = eval state' gstate' body
state, gstate'', res
| Hole pos ->
raise (UnexpectedHole pos)
| List (lst, _) ->
let _, gstate', res =
List.fold_left (fun (state, gstate, res) e ->
eval state gstate e) (state, gstate, None) lst
state, gstate', res
| Repeat (num, e, pos) ->
let _, gstate', i = eval1 state gstate num
Seq.fold (fun (state, gstate, _) j ->
let state' = add_var state ":repcount" j
eval state' gstate e) (state, gstate', None) { 1.0 .. i }
| To (f, par, e, pos) ->
let state' = add_fun state f (par, e)
state', gstate, None
let eval_list (state: state) gstate =
List.fold_left (fun (state, gstate, res) e ->
eval state gstate e) (state, gstate, None)
Now for the client module. I decided to implement our user-interface via a PaletteSet, with the Source editor living on one Palette (hosting a RichTextBox control), with the various execution options living on another. I had some fun with the embedded RichTextBox: it seems AutoCAD's PaletteSet eats linefeed characters, so they don't get passed through to the active, hosted control. I looked at various ways to get around this - the most promising of which was to add a message hook at the system level, which then switches the message to something that will pass through the PaletteSet's defenses successfully for later re-mapping - but ended up with the very simple (and still reasonably pragmatic) solution of checking for semi-colons entered at the keyboard and inserting linefeeds at that point. So for all intents and purposes the semi-colon key has been remapped to work like Enter when entering code in the Source tab. Which is just fine for those of us who are hardcore C/C#/C++ coders, but less intuitive for those of us working primarily with VB. :-)
While this approach is acceptable in this application, it may not be in your own: please let me know if this is a significant problem for you and I will pass the information on to our Engineering team.
Here's the F# code for the client module:
#light
#I @"C:\Program Files\Autodesk\AutoCAD 2009"
#r "acdbmgd.dll"
#r "acmgd.dll"
#I @"..\bin"
#r "TurtleGraphics.dll"
open TurtleGraphics
open AutoLogo
open Autodesk.AutoCAD.Runtime
open Autodesk.AutoCAD.ApplicationServices
open Autodesk.AutoCAD.EditorInput
open Autodesk.AutoCAD.DatabaseServices
open Autodesk.AutoCAD.Geometry
open Autodesk.AutoCAD.Windows
open System.Windows.Forms
open System.Drawing
open System
// Some error-handling helpers
let error {x=x; y=y} msg =
MessageBox.Show
(sprintf "Error at %d:%d\n%s" y x msg)
|> ignore
let error_no_pos msg =
MessageBox.Show
(sprintf "Error: %s" msg)
|> ignore
// Our code editor control
let memo =
new RichTextBox(Dock = DockStyle.Fill)
// A tooltip explaining what to do with the window
let tt =
new ToolTip()
tt.SetToolTip
(memo,
"Enter LOGO code, use semi-colons (;) instead of Enter" +
"\n\npendown - put the pen down" +
"\npenup - put the pen up" +
"\npencolor i - set the color of the pen to index i" +
"\npenwidth d - set the width of the pen to double d" +
"\nfd d - forward distance d" +
"\nrt a - turn right through angle a" +
"\nlt a - turn left through angle a" +
"\npu a - pitch up through angle a" +
"\npd a - pitch down through angle a" +
"\nrr a - roll right through angle a" +
"\nrl a - roll left through angle a")
// Translate the semi-colon character into a linefeed
memo.KeyPress.Add(fun (ea : KeyPressEventArgs) ->
if ea.KeyChar = ';' then
memo.SelectedText <- "\n"
ea.Handled <- true)
// Our various option checkboxes
let clrSrc =
new CheckBox
(Text = "Clear source after execution",
Width = 250,
Location = new Point(10,40),
Checked = false)
let keepInfo =
new CheckBox
(Text = "Keep turtle information",
Width = 250,
Location = new Point(10,80),
Checked = true)
let changeUcs =
new CheckBox
(Text = "Update UCS to reflect turtle position",
Width = 250,
Location = new Point(10,120),
Checked = false)
keepInfo.Click.Add (fun _ ->
changeUcs.Enabled <- keepInfo.Checked)
// Our Execute button
let run =
new Button
(Text = "Execute",
Width = 100,
Height = 30,
Location = new Point(50,180))
// The code behind the execute button
run.Click.Add (fun _ ->
try
let doc =
Application.DocumentManager.MdiActiveDocument
// Remember to lock the document, as it's
// a modeless dialog
use lock = doc.LockDocument()
use tr =
doc.TransactionManager.StartTransaction()
let te = new TurtleEngine(tr)
// If we don't load valid settings, make sure
// there's a pen width and the pen is down
// (this just simplifies the client code)
if keepInfo.Checked then
if te.LoadSettings(doc) <> true then
te.SetPenWidth(1.0)
te.PenDown()
else
te.SetPenWidth(1.0)
te.PenDown()
// Parse and evaluate our source
let source =
GenerateTokenStream memo.Text
let e =
ParseTokenStream state.Default true source
let _, _, res = eval_list state.Default te e
// Save turtle settings, if appropriate
if keepInfo.Checked then
if changeUcs.Checked then
te.TurtleToUcs(doc)
te.SaveSettings(doc)
else
te.ClearSettings(doc)
// Finish up
te.Dispose()
tr.Commit()
doc.Editor.UpdateScreen()
match res with
| None -> ()
| Some i ->
MessageBox.Show
(sprintf "Exit value=%f" i) |> ignore
// Clear the source window, if that option was selected
if clrSrc.Checked then
memo.Clear()
with
| VarNotFound (v, pos) ->
error pos (sprintf "Unbound variable '%s'" v)
| FunNotFound (f, pos) ->
error pos (sprintf "Unbound function '%s'" f)
| NoCanvas pos ->
error pos "No canvas available to draw on"
| InvalidFunName pos ->
error pos "Invalid function"
| InvalidParam pos ->
error pos "Invalid parameter"
| UnexpectedRBrack pos ->
error pos "Unexpected ]"
| UnexpectedEof ->
error_no_pos "Unexpected eof"
| NumberExpected pos ->
error pos "Number expected"
| UnexpectedHole pos ->
error pos "[internal] Uninstantiated hole")
// Create a group box for our execution tab
let grp =
new GroupBox(Text = "Execution Options")
grp.Controls.Add(clrSrc)
grp.Controls.Add(keepInfo)
grp.Controls.Add(changeUcs)
grp.Controls.Add(run)
// Create the palette set and set its properties
let ps =
new PaletteSet
("LOGO Interpreter",
new Guid("153C43BD-7AB9-489E-B674-175C8679812A"))
ps.Style <-
PaletteSetStyles.ShowPropertiesMenu |||
PaletteSetStyles.ShowAutoHideButton |||
PaletteSetStyles.ShowCloseButton
// Make it half-transparent (or is that half-opaque? :-)
// and set its size and dockability
ps.EnableTransparency(true) |> ignore
ps.Opacity <- 50
ps.MinimumSize <- new Size(240,240)
ps.Size <- new Size(250,550)
ps.DockEnabled <-
DockSides.Left |||
DockSides.Right
// Add our two palettes to the set
ps.Add("Source", memo) |> ignore
ps.Add("Execution", grp) |> ignore
// Finally we define a command that simply shows
// the palette (rather than multi-instancing it)
[<CommandMethod("LOGO")>]
let startLogo() =
ps.Activate(0) // Displays the source tab
ps.Visible <- true
To give this a try, NETLOAD the two DLLs created by the above code (TurtleGraphics.dll and Logo.dll - it shouldn't matter in which order, as long as you load them both) and run the LOGO command. Here's the palette that gets displayed, showing here some simple LOGO source code:
Here's the LOGO code itself, to make it simpler for you to copy & paste into the Source window (which also bypasses the linefeed problem, incidentally):
to spring :x [
pencolor :x
repeat 50 [
fd 1
rt 10
pu 10
rr 10
]
]
penwidth 3
pendown
repeat 10 [spring repcount]
When executed it should create a "spring" with sections of different colours:
You can see the UCS icon is pointing in the direction the turtle will move in next. Try typing some simple instructions into the Source window, and then executing them repeatedly.
