home *** CD-ROM | disk | FTP | other *** search
/ Phoenix CD 2.0 / Phoenix_CD.cdr / 01e / lisp211.zip / TURTLE.L < prev   
Lisp/Scheme  |  1986-04-14  |  3KB  |  93 lines
  1. ;; TURTLE.L for PC-LISP.EXE V2.10
  2. ;; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  3. ;;      A set of turtle graphics primitives to demonstrate PC-LISP's BIOS 
  4. ;; graphics routines. These routines are pretty self explanitory. The first
  5. ;; 5 defun's define the primitives, next are a set of routines to draw things
  6. ;; like squares, triangles etc. Try the function (GraphicsDemo). It will
  7. ;; draw Squirals, Trianglerals, etc. Note that the BIOS line drawing is really
  8. ;; slow. This is because the BIOS 'set dot/pixel' routine is used for every
  9. ;; point in a line. Using the BIOS has the advantage however of portability,
  10. ;; these routines work on virtually every MS-DOS machine. The global variable
  11. ;; !Mode controls the graphics resolution that will be used. It is set by 
  12. ;; default to 6 I set it to 8 or 9 for my 2000 but these routines will not
  13. ;; support the lower resolution modes. 
  14. ;;
  15. ;;                      Peter Ashwood-Smith
  16. ;;                      April 2nd, 1986 
  17. ;;
  18.  
  19. (setq !Mode 6)                                              ; default setting
  20.  
  21. (defun TurtleGraphicsUp()           
  22.        (#scrmde# !Mode)(#scrsap# 0)      
  23.        (cond ((= !Mode 6)                                   ; 640x200 B&W mode
  24.           (setq CenterX 100 CenterY 100 Scale 3.2 Lfactor 1) 
  25.           (TurtleCenter))  
  26.          ((= !Mode 7)
  27.           (patom '|mode 7 not allowed|))
  28.          ((or (= !Mode 8) (= !Mode 9))                   ; 640x400 modes
  29.           (setq CenterX 266 CenterY 200 Scale 1.2 Lfactor 2) 
  30.           (TurtleCenter))  
  31.          (t (patom '|unsupported mode|))
  32.        )
  33. )   
  34.  
  35. (defun TurtleGraphicsDown() (#scrmde# 2))
  36. (defun TurtleCenter()       (setq Lastx CenterX Lasty CenterY Heading 1.570796372))
  37. (defun TurtleRight(n)       (setq Heading (plus Heading (times n 0.01745329))))
  38. (defun TurtleLeft(n)        (setq Heading (diff Heading (times n 0.01745329))))
  39. (defun TurtleGoTo(x y)      (setq Lastx (quotient x Scale) Lasty (times y Lfactor) )) 
  40.  
  41. (defun TurtleForward(n) 
  42.       (setq n (times n Lfactor) Newx(plus Lastx(times(cos Heading)n))Newy(plus Lasty(times(sin Heading)n)))
  43.       (#scrline#(times Lastx Scale) Lasty (times Newx Scale) Newy 1)
  44.       (setq Lastx Newx Lasty Newy)
  45. )
  46.  
  47. ;
  48. ; end of Turtle Graphics primitives, start of Graphics demonstration code
  49. ; you can cut this out if you like and leave the Turtle primitives intact.
  50. ;
  51.  
  52. (defun Line_T(n)        
  53.     (TurtleForward n) (TurtleRight 180)
  54.     (TurtleForward (quotient n 4)) 
  55. )
  56.     
  57. (defun Square(n)
  58.     (TurtleForward n)  (TurtleRight 90)     
  59.     (TurtleForward n)  (TurtleRight 90)     
  60.     (TurtleForward n)  (TurtleRight 90)     
  61.     (TurtleForward n)                       
  62. )
  63.  
  64. (defun Triangle(n)
  65.     (TurtleForward n)  (TurtleRight 120)
  66.     (TurtleForward n)  (TurtleRight 120)
  67.     (TurtleForward n)
  68. )
  69.  
  70. (defun Make(ObjectFunc Size times skew) 
  71.       (prog()       
  72.        TOP:(cond ((zerop times) (return)))
  73.        (ObjectFunc Size) 
  74.        (TurtleRight skew)
  75.        (setq times (1- times))
  76.        (go TOP:)    
  77.        )
  78. )
  79.  
  80. (defun GraphicsDemo()
  81.        (TurtleGraphicsUp) 
  82.        (Make Square 40 18 5) (Make Square 60 18 5)
  83.        (gc)                                                 ; idle work
  84.        (TurtleGraphicsUp) 
  85.        (Make Triangle 40 18 5) (Make Triangle 60 18 5)
  86.        (gc)                                                 ; idle work
  87.        (TurtleGraphicsUp) 
  88.        (Make Line_T 80 50 10)
  89.        (gc)                                                 ; idle work
  90.        (TurtleGraphicsDown)
  91. )
  92.  
  93.