home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / CLIPPER / MISC / LSP.ZIP / T.LSP < prev   
Encoding:
Text File  |  1985-08-22  |  3.4 KB  |  140 lines
  1. ; A simple turtle graphics program for VT100 compatible terminals
  2. ; By David Betz with some stuff borrowed from a similar program
  3. ; by Mark Mallett
  4.  
  5. ; :::::::::::::::::::::
  6. ; :: Misc. Functions ::
  7. ; :::::::::::::::::::::
  8.  
  9. ; Note:  The following functions assume that this program is running on
  10. ; a VT100 compatible terminal.
  11.  
  12. ; Clear the screen
  13. (defun clear ()
  14.     (princ "\e[H\e[J"))
  15.  
  16. ; Move the cursor
  17. (defun setpos (x y)
  18.     (princ "\e[" y ";" x "H"))
  19.  
  20. ; Kill the remainder of the screen
  21. (defun kill ()
  22.     (princ "\e[J"))
  23.  
  24. ; Set the scrolling region
  25. (defun setscroll (t b)
  26.     (princ "\e[" t ";" b "r"))
  27.  
  28. ; Move the cursor to the currently set bottom position and clear the line
  29. ;  under it
  30. (defun bottom ()
  31.     (setpos 0 by)
  32.     (kill))
  33.  
  34. ; Clear the screen and go to the bottom
  35. (defun cb ()
  36.     (clear)
  37.     (bottom))
  38.  
  39.  
  40. ; ::::::::::::
  41. ; :: Turtle ::
  42. ; ::::::::::::
  43.  
  44. ; Define "Turtle" class
  45. (setq Turtle (Class 'new))
  46.  
  47. ; Define instance variables
  48. (Turtle 'ivars '(xpos ypos xvel yvel heading trail char))
  49.  
  50. ; Answer "isnew" by initing a position and char and displaying.
  51. (Turtle 'answer 'isnew '(x y) '(
  52.     (setq xpos x)    ; set the turtle's x position
  53.     (setq ypos y)    ; set the turtle's y position
  54.     (setq xvel 0)    ; set the turtle's x velocity
  55.     (setq yvel -1)    ; set the turtle's y velocity
  56.     (setq char "^")    ; set the turtle's character representation
  57.     (setq trail ".")    ; set the turtle's trail character
  58.     (setq heading 0)    ; set the turtle's heading
  59.     (self 'display)))    ; display the new turtle
  60.  
  61. ; Message "display" prints its char at its current position
  62. (Turtle 'answer 'display '() '(
  63.     (setpos xpos ypos)
  64.     (princ char)
  65.     (bottom)
  66.     self))
  67.  
  68. ; Message "trail" sets the turtle's trail character to its arg
  69. ;  and redisplays the turtle
  70. (Turtle 'answer 'trail '(c) '(
  71.     (setq trail c)
  72.     (self 'display)))
  73.  
  74. ; Message "goto" goes to a new place after clearing old one
  75. (Turtle 'answer 'goto '(x y) '(
  76.     (setpos xpos ypos)
  77.     (princ trail)
  78.     (setq xpos (max 1 (min x 80)))
  79.     (setq ypos (max 1 (min y by)))
  80.     (self 'display)))
  81.  
  82. ; Message "left" turns the turtle left
  83. (Turtle 'answer 'left '() '(
  84.     (turn 3)
  85.     (self 'display)))
  86.  
  87. ; Message "right" turns the turtle right
  88. (Turtle 'answer 'right '() '(
  89.     (turn 1)
  90.     (self 'display)))
  91.  
  92. ; Function "turn" turns a turtle
  93. (defun turn (inc)
  94.     (setq heading (% (+ heading inc) 4))
  95.     (cond
  96.     ((== heading 0)        ; heading north
  97.         (setq xvel 0)
  98.         (setq yvel -1)
  99.         (setq char "^"))
  100.     ((== heading 1)        ; heading east
  101.         (setq xvel 1)
  102.         (setq yvel 0)
  103.         (setq char ">"))
  104.     ((== heading 2)        ; heading south
  105.         (setq xvel 0)
  106.         (setq yvel 1)
  107.         (setq char "v"))
  108.     ((== heading 3)        ; heading west
  109.         (setq xvel -1)
  110.         (setq yvel 0)
  111.         (setq char "<"))))
  112.  
  113. ; Message "forward" moves the turtle forward
  114. (Turtle 'answer 'forward '() '(
  115.     (self 'goto (+ xpos xvel) (+ ypos yvel))))
  116.  
  117. ; Message "backward" moves the turtle backward
  118. (Turtle 'answer 'backward '() '(
  119.     (self 'goto (- xpos xvel) (- ypos yvel))))
  120.  
  121.  
  122. ; :::::::::::::::
  123. ; :: Main Code ::
  124. ; :::::::::::::::
  125.  
  126. ; Initialize
  127. (setq by 20)
  128. (setscroll (+ by 1) 24)
  129.  
  130. ; Create some programmable turtles
  131. (cb)
  132. (setq t1 (Turtle 'new 40 10))
  133. (setq t2 (Turtle 'new 41 10))
  134. 
  135.     (turn 1)
  136.     (self 'display)))
  137.  
  138. ; Function "turn" turns a turtle
  139. (defun turn (inc)
  140.     (setq head