From 643902eff71c50076bb61e7999c36fb8c97b50c3 Mon Sep 17 00:00:00 2001
From: Lars Brinkhoff <lars@nocrew.org>
Date: Fri, 28 Sep 2018 10:49:26 +0200
Subject: [PATCH] APLCLK - Apple II clock.

Reconstructed from GUEST2; VTCLK 6 and disassembly of SYS3; TS APLCLK
dated 1981-09-06.
---
 Makefile                       |  2 +-
 build/misc.tcl                 |  4 ++
 doc/programs.md                |  1 +
 src/{guest2 => music1}/vtclk.6 | 78 +++++++++++++++++++++++++++++++++-
 4 files changed, 82 insertions(+), 3 deletions(-)
 rename src/{guest2 => music1}/vtclk.6 (73%)

diff --git a/Makefile b/Makefile
index 71d211ed..0551611c 100644
--- a/Makefile
+++ b/Makefile
@@ -25,7 +25,7 @@ SRC = syseng sysen1 sysen2 sysen3 sysnet kshack dragon channa	\
       tensor transl wgd zz graphs lmlib pratt quux scheme gsb ejs mudsys \
       draw wl taa tj6 budd sharem ucode rvb kldcp math as imsrc gls demo \
       macsym lmcons dmcg hack hibou agb gt40 rug maeda ms kle aap common \
-      fonts zork 11logo kmp info aplogo bkph bbn pdp11 chsncp sca guest2
+      fonts zork 11logo kmp info aplogo bkph bbn pdp11 chsncp sca music1
 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 \
diff --git a/build/misc.tcl b/build/misc.tcl
index 05ceb4f8..804edcc1 100644
--- a/build/misc.tcl
+++ b/build/misc.tcl
@@ -876,6 +876,10 @@ respond "   " ":kill\r"
 respond "*" ":midas sys1;ts vttime_rvb;vttime\r"
 expect ":KILL"
 
+# APLCLK
+respond "*" ":midas sys3;ts aplclk_music1; vtclk\r"
+expect ":KILL"
+
 # DEVICE; CHAOS TIME
 respond "*" ":midas device;chaos time_syseng;ctimsr\r"
 expect ":KILL"
diff --git a/doc/programs.md b/doc/programs.md
index 3fac17cc..9894fa1e 100644
--- a/doc/programs.md
+++ b/doc/programs.md
@@ -13,6 +13,7 @@
 - ADV350, 350-point Adventure.
 - ADV448, 448-point Adventure.
 - ANIMAL, an animal guessing game.
+- APLCLK, clock for Apple II.
 - APLOGO, Apple II Logo.
 - AR, PDP-11 debugger.
 - ARCCPY, copies an old-format archive, converting to new format.
diff --git a/src/guest2/vtclk.6 b/src/music1/vtclk.6
similarity index 73%
rename from src/guest2/vtclk.6
rename to src/music1/vtclk.6
index 30f3593c..e1dca0c0 100644
--- a/src/guest2/vtclk.6
+++ b/src/music1/vtclk.6
@@ -39,7 +39,10 @@ START:	SYSCAL OPEN,[%CLBIT,,%TJDIS+.UIO
 	 .LOSE %LSFIL
 
 	move p,[-lpdl,,pdl]
-	MOVEI A,[ASCIZ/Multi-Time Zone clock program.
+	MOVEI A,[ASCIZ/4-zone Clock and System Status for the Apple ][ with The Terminal.
+/]
+        PUSHJ P,ASCOUT
+	MOVEI A,[ASCIZ/by Kevin Burnett
 /]
 
         PUSHJ P,ASCOUT
@@ -89,6 +92,15 @@ RE:	.IOT TTYO,[^P]			; Save cursor pos
        	 MOVEI A,[ASCIZ/Time (Eastern) =/]
 	PUSHJ P,ASCOUT
 
+	.IOT TTYO,[^P]
+	.IOT TTYO,["V]
+	.IOT TTYO,[7+31.]
+	.IOT TTYO,[^P]
+	.IOT TTYO,["H]
+	.IOT TTYO,[7+28.]
+	MOVEI A,[ASCIZ/Active Users =     Free Net Ports =/]
+	PUSHJ P,ASCOUT
+
 	MOVSI A,-1			; Load A with  -1,,0
 	MOVEM A,ONE			; Load it into ONE
 CLOCK:	SETZ A,				; Clear A
@@ -112,7 +124,7 @@ CLOCK:	SETZ A,				; Clear A
 	CAIGE  A,0		; Midnight or after ?
 	 ADDI A,24.		;Negative,add 24 to restore;-1=23 O'clock
 	SETZ B,
-	CAILE A,12.		; time 0<=x<12 means AM
+	CAIL A,12.		; time 0<=x<12 means AM
 	 MOVEI B,1	
 	MOVEM B,AMPM	 
 
@@ -157,6 +169,38 @@ SLEEP:	.IOT TTYO,[^P]
 LOADP:	SETZ A,				; Clear A
 	MOVEM A,FLAG			; Zero FLAG
 
+BEG:	MOVE P,[-LPDL,,PDL]
+	MOVEI B,0
+	SETZM NFSTYS
+	SETZM NIDLE1
+	SETZM NIDLE5
+	SETZM NIDL10
+
+COUNT:	SYSCAL TTYGET,[%CLIMM+2,,400000
+		       %CLOUT,,A
+		       %CLOUT,,A
+		       %CLOUT,,D]
+	 JRST PRINT
+	SYSCAL TTYVAR,[%CLIMM+2,,400000
+		       [SIXBIT /TTYTYP/]
+		       %CLOUT,,A]
+	 .LOSE %LSFIL
+	TRNN A,200000
+	JRST COUNT1
+	JUMPGE D,COUNT1
+	AOS NFSTYS
+COUNT1:	JUMPL D,COUNT2
+	SYSCAL TTYVAR,[%CLIMM+2,,400000
+		       [SIXBIT /IDLTIM/]
+		       %CLOUT,,A]
+	 .LOSE %LSFIL
+	CAIGE A,30.*60.
+	 AOS NIDLE1
+	CAIGE A,30.*60.*5
+	 AOS NIDLE5
+	CAIGE A,30.*60.*10.
+	 AOS NIDL10
+COUNT2:	AOJA B,COUNT
 
 ascout:	hrli a,440700		;If C=1, "#" => "", else => "s"
 ascou1:	ildb b,a
@@ -172,10 +216,40 @@ ascou1:	ildb b,a
 decout:	move c,a		;leaves number in C.
 decou1:	idivi a,10.
 	hrlm b,(p)
+	skipe a
+	 pushj p,decou1
+	hlrz b,(p)
+	addi b,"0
+	.iot ttyo,b
 
 cpopj: popj p,
 blank: popj p,
 
+PRINT:	.IOT TTYO,[^P]
+	.IOT TTYO,["S]
+	.IOT TTYO,[^P]
+	.IOT TTYO,["V]
+	.IOT TTYO,[7+31.]
+	.IOT TTYO,[^P]
+	.IOT TTYO,["H]
+	.IOT TTYO,[7+43.]
+	MOVE A,NIDLE1
+	PUSHJ P,DECOUT
+	PUSHJ P,BLANK
+	.IOT TTYO,[^P]
+	.IOT TTYO,["V]
+	.IOT TTYO,[7+31.]
+	.IOT TTYO,[^P]
+	.IOT TTYO,["H]
+	.IOT TTYO,[7+64.]
+	MOVE A,NFSTYS
+	PUSHJ P,DECOUT
+	.IOT TTYO,[^P]
+	.IOT TTYO,["R]
+	MOVEI A,[40]
+	.SLEEP A,
+	JUMPA RE
+
 WARN:
 	POPJ P,