October 2014

Sun Mon Tue Wed Thu Fri Sat
      1 2 3 4
5 6 7 8 9 10 11
12 13 14 15 16 17 18
19 20 21 22 23 24 25
26 27 28 29 30 31  










« AU 2008 class schedule published | Main | Choosing the programming language to use for an AutoCAD development project »

July 24, 2008

A simple 3D LOGO implementation inside AutoCAD using F#

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:

Code for LOGO Spring

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:

Executed LOGO Spring

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.

TrackBack

TrackBack URL for this entry:
http://www.typepad.com/services/trackback/6a00d83452464869e200e553b2e97c8833

Listed below are links to weblogs that reference A simple 3D LOGO implementation inside AutoCAD using F#:

blog comments powered by Disqus

Feed/Share

10 Random Posts