From 47daada35c72fa2590b78b63786d5c1974c02ac6 Mon Sep 17 00:00:00 2001
From: Lars Brinkhoff <lars@nocrew.org>
Date: Sun, 17 Jan 2021 20:11:24 +0100
Subject: [PATCH] Lisp library for sending TT2500 turtle commands.

---
 src/lars/tt2500.57 | 148 +++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 148 insertions(+)
 create mode 100644 src/lars/tt2500.57

diff --git a/src/lars/tt2500.57 b/src/lars/tt2500.57
new file mode 100644
index 00000000..936ae689
--- /dev/null
+++ b/src/lars/tt2500.57
@@ -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))