1
0
mirror of https://github.com/PDP-10/its.git synced 2026-03-10 12:48:25 +00:00

Lisp library for sending TT2500 turtle commands.

This commit is contained in:
Lars Brinkhoff
2021-01-17 20:11:24 +01:00
parent 96fccc355a
commit 47daada35c

148
src/lars/tt2500.57 Normal file
View 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))