mirror of
https://github.com/PDP-10/its.git
synced 2026-03-09 20:38:23 +00:00
Lisp library for sending TT2500 turtle commands.
This commit is contained in:
148
src/lars/tt2500.57
Normal file
148
src/lars/tt2500.57
Normal file
@@ -0,0 +1,148 @@
|
||||
(comment) ;-*- lisp -*-
|
||||
|
||||
(herald tt2500)
|
||||
|
||||
(setq turtle-out (open "TTY:" '(tty image out)))
|
||||
|
||||
(defun send-word (word)
|
||||
(tyo 33 turtle-out)
|
||||
(tyo (+ 100 (load-byte word 12 5)) turtle-out)
|
||||
(tyo (+ 100 (load-byte word 5 5)) turtle-out)
|
||||
(tyo (+ 100 (load-byte word 0 5)) turtle-out))
|
||||
|
||||
(defun home ()
|
||||
(send-word 04000))
|
||||
|
||||
(defun pendown ()
|
||||
(send-word 4400))
|
||||
|
||||
(defun small-dot ()
|
||||
(send-word 4401))
|
||||
|
||||
(defun dot ()
|
||||
(send-word 4402))
|
||||
|
||||
(defun wide-dot ()
|
||||
(send-word 4403))
|
||||
|
||||
(defun dash ()
|
||||
(send-word 4404))
|
||||
|
||||
(defun dash-dot ()
|
||||
(send-word 4405))
|
||||
|
||||
(defun wide-dash ()
|
||||
(send-word 4406))
|
||||
|
||||
(defun penup ()
|
||||
(send-word 4407))
|
||||
|
||||
(defun hideturtle ()
|
||||
(send-word 5000))
|
||||
|
||||
(defun showturtle ()
|
||||
(send-word 5001))
|
||||
|
||||
(defun endsnap ()
|
||||
(send-word 5400))
|
||||
|
||||
(defun blink ()
|
||||
(send-word 6000))
|
||||
|
||||
(defun wrap ()
|
||||
(send-word 6400))
|
||||
|
||||
(defun bounce ()
|
||||
(send-word 6401))
|
||||
|
||||
(defun reset ()
|
||||
(send-word 7000))
|
||||
|
||||
(defun nop ()
|
||||
(send-word 7400))
|
||||
|
||||
(defun nop ()
|
||||
(send-word 17400))
|
||||
|
||||
(defun forward (x)
|
||||
(send-word (logior 10000 (logand x 3777))))
|
||||
|
||||
(defun right (x)
|
||||
(send-word (logior 14000 (logand x 3777))))
|
||||
|
||||
(defun setheading (x)
|
||||
(send-word (logior 20000 (logand x 3777))))
|
||||
|
||||
(defun move (x)
|
||||
(send-word (logior 24000 (logand x 3777))))
|
||||
|
||||
(defun spin (x)
|
||||
(send-word (logior 30000 (logand x 3777))))
|
||||
|
||||
(defun display (x)
|
||||
(send-word 34000)
|
||||
(send-word (logand x 77777)))
|
||||
|
||||
(defun timed-display (x y z)
|
||||
(send-word 34001)
|
||||
(send-word (logand x 77777))
|
||||
(send-word (logand y 77777))
|
||||
(send-word (logand z 77777)))
|
||||
|
||||
(defun x-display (x y z)
|
||||
(send-word 34002)
|
||||
(send-word (logand x 77777))
|
||||
(send-word (logand y 77777))
|
||||
(send-word (logand z 77777)))
|
||||
|
||||
(defun y-display (x y z)
|
||||
(send-word 34003)
|
||||
(send-word (logand x 77777))
|
||||
(send-word (logand y 77777))
|
||||
(send-word (logand z 77777)))
|
||||
|
||||
(defun h-display (x y z)
|
||||
(send-word 34004)
|
||||
(send-word (logand x 77777))
|
||||
(send-word (logand y 77777))
|
||||
(send-word (logand z 77777)))
|
||||
|
||||
(defun setxy (x y)
|
||||
(send-word (logior 40000 (logand x 3777)))
|
||||
(send-word (logand y 77777)))
|
||||
|
||||
(defun deltaxy (x y)
|
||||
(send-word (logior 44000 (logand x 3777)))
|
||||
(send-word (logand y 77777)))
|
||||
|
||||
(defun clearscreen ()
|
||||
(send-word 50000))
|
||||
|
||||
(defun remove (x)
|
||||
(send-word (logior 54000 (logand x 3777))))
|
||||
|
||||
(defun grow (x y z)
|
||||
(send-word (logior 60000 (logand x 3777)))
|
||||
(send-word (logand y 77777))
|
||||
(send-word (logand z 77777)))
|
||||
|
||||
(defun store-here (x)
|
||||
(send-word (logior 64000 (logand x 3777))))
|
||||
|
||||
(defun goto (x)
|
||||
(send-word (logior 70000 (logand x 3777))))
|
||||
|
||||
(defun back (x)
|
||||
(right 180.)
|
||||
(forward x)
|
||||
(right 180.))
|
||||
|
||||
(defun left (x)
|
||||
(right (- 360. x)))
|
||||
|
||||
(defun fd (x) (forward x))
|
||||
(defun bk (x) (back x))
|
||||
(defun rt (x) (right x))
|
||||
(defun lt (x) (left x))
|
||||
(defun pu () (penup))
|
||||
(defun pd () (pendown))
|
||||
Reference in New Issue
Block a user