From e1753de8666db94316d46d953b36b54dea6eef42 Mon Sep 17 00:00:00 2001
From: Lars Brinkhoff <lars@nocrew.org>
Date: Sat, 12 May 2018 19:07:33 +0200
Subject: [PATCH] LLOGO - Logo written in Lisp.

By Ira Goldstein, Henry Lieberman, et al.

The added IOC LSP file is for emulating older Maclisp forms no longer
supported in the latest version.
---
 Makefile                |   4 ++--
 bin/llogo/tvrtle.kst    | Bin 0 -> 7131 bytes
 build/lisp.tcl          |  35 +++++++++++++++++++++++++++++++++++
 doc/llogo/-read-.-this- |   1 +
 doc/programs.md         |   1 +
 src/llogo/ioc.lsp       |  17 +++++++++++++++++
 src/llogo/loader.153    |   2 ++
 7 files changed, 58 insertions(+), 2 deletions(-)
 create mode 100644 bin/llogo/tvrtle.kst
 create mode 100644 doc/llogo/-read-.-this-
 create mode 100644 src/llogo/ioc.lsp

diff --git a/Makefile b/Makefile
index 59ca29d7..817e9611 100644
--- a/Makefile
+++ b/Makefile
@@ -31,10 +31,10 @@ DOC = info _info_ sysdoc sysnet syshst kshack _teco_ emacs emacs1 c kcc \
       chprog sail draw wl pc tj6 share _glpr_ _xgpr_ inquir mudman system \
       xfont maxout ucode moon acount alan channa fonts games graphs humor \
       kldcp libdoc lisp _mail_ midas quux scheme manual wp chess ms macdoc \
-      aplogo _klfe_ pdp11 chsncp cbf rug bawden
+      aplogo _klfe_ pdp11 chsncp cbf rug bawden llogo
 BIN = sys2 emacs _teco_ lisp liblsp alan inquir sail comlap c decsys \
       graphs draw datdrw fonts fonts1 fonts2 games macsym maint imlac \
-      _www_ hqm gt40
+      _www_ hqm gt40 llogo
 MINSRC = midas system $(DDT) $(SALV) $(KSFEDR) $(DUMP)
 
 # These are not included on the tape.
diff --git a/bin/llogo/tvrtle.kst b/bin/llogo/tvrtle.kst
new file mode 100644
index 0000000000000000000000000000000000000000..dc5c7c14d13ca2b02817eb3abe4ef67a1a7f3537
GIT binary patch
literal 7131
zcmcIpO>7%Q6#jPY*s+oj_a`(ZZSByM(4SD3^e;5UDNq3_&{Pyv{8VfdP*eemt5OwI
z5JE!o1x|25LgE4^xF8{M0m)U6d_n4kBT_CL5uO7_B$)Sh{dQ*Tq;|Zv;`Q#%`@T2x
z=FOY^Hh}&p3?rrViARTz^c8|?^}Q|pF$qzYmH!WZaTyxdTS(jAlFodHp+#J6;i-&w
zc1!y6xbpwNPcCS+;r3^}W!U8fJsj!JZ44Fhip#Uq!n4-GlNBD#hqKE66+gH<LBZ`$
zt=vKlA);QrkC6(lI7D|H?~NNS@7*98l%~ME^1sJ-4#yprqjK7{XmU_LZee5rmmQ0H
zTsA6UV5tvhl>Y_3bpWGPd-QduPs<Sjb>JpO^0?#>cn(3$AqYxw4<1wg2l(0|Xxy^n
z*5+C=;|6j8Ua;X62i|(ka2o%d^54Lh4t(%l*W&#;awS}_%vbE#IXO{S&`!nsY2`nM
z&n<Xh!<}?U37j}qkprHw;7*{;%fN7aO8Lj}nTf2MrcQOJH=*S89Sknwya}~tw_(?a
zS`(^~IH~+SsG88SnJ88fST%C&Eesa%go(?VIBU@_8OeP@`DuJ?;$Y(JMIPkia&ryY
z3d%9iTFCB&%;s_B{e{~G%3Qh)=YmmmSb;84^D)Yt2jje^O~uo!@_xt77_)37P2B*E
zE;LaDeG}O{=3-P(j@OAfhn}D`2#+f7XRHb;o+NWst_M-?$j>q|0Zs}co}PxW5Z9Ur
z4ZtzweS>R)Feau^i5Fw7XgFCyri5966l7xK1-D|PLP>d_Vp+^nVjeHBz{t4QkpW6#
z-g+Waaa4Kl%1#-t8|#dX>2MVTi<pVn;+0~Z3G*Y$drh_&*)k>m_6GSX28uWoG0VOv
zp|^Lz8Rb1CHCr~nIO_IR_cGEIOo!A_aAgTt``HoY9cdQBD6Eq8cLHPXt{}aDsn(!Y
z&7JA6@^&`sOtc}@!_+pnpO=u%V=|<QcAY4d%{}Ij!oT5qj*>S1k-2#hsQ~+kDN57$
zN2cVU!k^&^it;l45uQs(l`ug(E4(VhklA(rVTIqq<PFPx7%jWFUqlKR4@VXqn=yp`
zOe_4zsZ^&P^8=n$rk{tuh%pVMaD)kF)#8T~zT#P>5==>D7TgQ)i`cHgRA(uP%&K}o
z;S&xy6;n<cvvfWSuL3<^`q3x)O7x}_-qw+!oQS>>w5Oqq&Tu%)njW2C_A6Z0!_Wmz
zkJBz^=i%j%tLiGIhp6EO>OqBhjIQfhwhGge`T-l6H9fIwfnhzVFoj&LTp6?~%sE{F
zkSbg>%Se%**;D7tT2bZ)ckRAUABjbQAMX3)MbpY`oaLwgK06}%eJl_9?1+YShV?_A
z9TELr78reYL?fDG0n!&ol5l%ip!ClNIXcAxCTSlsgbCI+eW52GCs_UTg`P+sU~QBj
zJ;#L(vn-pEW+uMftf-P^ram8Iv6VD4@r|<%OPZPbe3T_xGR!=AM74|6TY{v-Jj1#!
zK~kc+pA}!vq&#vu9A+h$3?H$Ku|iCSkNS6zg<~&#JX9js$!fA^D&m`FiP<w15$s^)
z*)tXO>HxA@j`mDN1lw7oZjp*3PKW)hTYF(4>^9c2y|7SUCXvzdwtE&H48ig&c(+JE
zECrUpT@i@$Q5MDBV~Jod2DC=*9!rS(STc8yCBGA_pu5Ks;%^qz-DAn`Zltxm?i4E_
z9%ixK6^yXESbBE=6Gua=!#hO~Y>YK|rwFneVST<if;&Wq9Y|@R-hnZh<XEwHU`)*0
zSh{y$OeTY@;X5!U=1~^&8yfT2s5Q%~eseoA9$|IAxgE7;Smn2~W0!OoVy(ZS2{jC`
z;@{AOSaK};9TWCJ_tLEV+qIHOmc@U&R=StsHvsKg2|K_q0ot|FJ)hqL#I4*RI;22v
g0-OfA)c=ap?*g0#hVk0~Zip`RIlm3yd;iJje~D&Ii~s-t

literal 0
HcmV?d00001

diff --git a/build/lisp.tcl b/build/lisp.tcl
index 7dd32835..8d867ad8 100644
--- a/build/lisp.tcl
+++ b/build/lisp.tcl
@@ -865,3 +865,38 @@ respond_load "(load '((lmio1) ukbd))"
 respond "T" "(as 'ukbd)"
 respond "UKBD" "(quit)"
 expect ":KILL"
+
+# Lisp Logo
+respond "*" ":cwd llogo\r"
+respond "*" ":complr\r"
+respond "_" "ioc\r"
+respond "_" "\032"
+type ":kill\r"
+respond "*" ":complr\r"
+respond "_" "\007"
+respond "*" "(load 'ioc)"
+respond_load "(load 'define)"
+respond "T" "(maklap)"
+respond "_" "define\r"
+respond "_" "\032"
+type ":kill\r"
+respond "*" ":complr\r"
+respond "_" "\007"
+respond "*" "(load 'ioc)"
+respond_load "(load 'define)"
+respond_load "(maklap)"
+respond "_" "error\r"
+respond "_" "parser\r"
+respond "_" "primit\r"
+respond "_" "print\r"
+respond "_" "reader\r"
+respond "_" "setup\r"
+respond "_" "unedit\r"
+respond "_" "\032"
+type ":kill\r"
+respond "*" ":lisp loader\r"
+respond "?" "Y\r"
+respond "?" "LLOGO\r"
+respond "?" "1700\r"
+expect ":KILL"
+respond "*" ":link sys1; ts llogo, llogo; ts llogo\r"
diff --git a/doc/llogo/-read-.-this- b/doc/llogo/-read-.-this-
new file mode 100644
index 00000000..f7f9ffb2
--- /dev/null
+++ b/doc/llogo/-read-.-this-
@@ -0,0 +1 @@
+This directory belongs to Henry Lieberman (HENRY@MIT-AI).
diff --git a/doc/programs.md b/doc/programs.md
index 5cfe15c9..6633d45e 100644
--- a/doc/programs.md
+++ b/doc/programs.md
@@ -138,6 +138,7 @@
 - LIMSER, Chaosnet limerick service.
 - LISP, Lisp interpreter and runtime library (autoloads only).
 - LIVE, PALX Game of Life.
+- LLOGO, Logo implemented in Maclisp.
 - LOADP, displays system load.
 - LOCK, shut down system.
 - LOGO, BBN Logo.
diff --git a/src/llogo/ioc.lsp b/src/llogo/ioc.lsp
new file mode 100644
index 00000000..7d41c750
--- /dev/null
+++ b/src/llogo/ioc.lsp
@@ -0,0 +1,17 @@
+;;; -*- lisp -*-
+;;; Emulate old Maclisp special forms IOC and IOG.
+
+(defmacro ioc (sym)
+  (cond
+    ((eq sym 'G)   `(^G))
+    ((eq sym 'R)   `(setq ^R t))
+    ((eq sym 'T)   `(setq ^R nil))
+    ((eq sym 'V)   `(setq ^W nil))
+    ((eq sym 'W)   `(setq ^W t))
+    ((eq sym 'RW)  `(progn (ioc R) (ioc W)))
+    (t             (error "Unknown IOC character"))))
+
+(defmacro iog (sym &rest forms)
+  `(let ((^Q nil) (^R nil) (^W nil))
+     ,@(if sym `((ioc ,sym)))
+     ,@forms))
diff --git a/src/llogo/loader.153 b/src/llogo/loader.153
index 833b9d86..25a917e4 100644
--- a/src/llogo/loader.153
+++ b/src/llogo/loader.153
@@ -11,6 +11,8 @@
 
 (DECLARE (COUTPUT (READ))) 
 
+(LOAD '((DSK LLOGO) IOC LSP))
+
 (DEFUN HOW-BIG NIL 
        (REMPROP 'HOW-BIG 'EXPR)
        ((LAMBDA (FREE)