daily pastebin goal
66%
SHARE
TWEET

eLOGO.el

a guest Mar 6th, 2014 119 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
RAW Paste Data
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy. OK, I Understand
 
Top