Advertisement
Guest User

eLOGO.el

a guest
Mar 6th, 2014
329
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. ;;;; Name: eLOGO
  2. ;;;; Author: Ryan Burnside
  3. ;;;; Date: 2014-03-06
  4. ;;;; Released under GPL v4
  5.  
  6. ;;; This is the beginning of a LOGO like module to draw vector shapes
  7. ;;; Historically the cursor is called a "turtle"
  8. ;;; It has a small set of commands to draw primative line graphics
  9.  
  10. ;;; Global variables for turtle maintenance
  11.  
  12. (defvar *x-pos* 0)
  13. (defvar *y-pos* 0)
  14. (defvar *previous-x-pos* 0)
  15. (defvar *previous-y-pos* 0)
  16.  
  17. (defvar *direction* 0)
  18. (defvar *step* 0)
  19. (defvar *is-drawing* t)
  20. (defvar *color* '(0 0 0))
  21. (defvar *line-list* '()) ; Elements are (x y x2 y2 '(R G B))
  22.  
  23. ;;; Turtle manipulation commands
  24. (defun move ()
  25.   "Move at the current angle and step size, save line to list if *is-drawing*"
  26.   (if *is-drawing*
  27.    (setf *line-list*
  28.      (cons (list *previous-x-pos* *previous-y-pos* *x-pos* *y-pos* *color*)
  29.            *line-list*)))
  30.   (setf *previous-x-pos* *x-pos*)
  31.   (setf *previous-y-pos* *y-pos*))
  32.  
  33. (defun rt (dir)
  34.   "Turn the turtle right in degrees"
  35.   (incf *direction* dir))
  36.  
  37. (defun lt (dir)
  38.   "Turn the turtle left in degrees"
  39.   (decf *direction* dir))
  40.  
  41. (defun fd (length)
  42.   "Move forward in pixels at current heading"
  43.   (setf *step* length)
  44.   (setf *x-pos* (+ *x-pos* (* (cos (degrees-to-radians *direction*)) *step*)))
  45.   (setf *y-pos* (+ *y-pos* (* (sin (degrees-to-radians *direction*)) *step*)))
  46.   (move))
  47.  
  48. (defun set-pen-color (red green blue)
  49.   "Set the RGB triplet for the turtle's line color"
  50.   (setf *color* (list red green blue)))
  51.  
  52. (defun tail-up ()
  53.   "Don't draw following step commands"
  54.   (setf *is-drawing* nil))
  55.  
  56. (defun tail-down ()
  57.   "Start drawing following step commands"
  58.   (setf *is-drawing* t))
  59.  
  60. (defun clear-drawing ()
  61.   "Reset the global line list"
  62.   (setf *line-list* '()))
  63.  
  64.  
  65. ;;; We'll need to impliment a very small subset of XML file writing below
  66. ;;; We can easily do this with the *line-list* the turtle makes
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement