From 175b4bc49780518ea3f95592f2d034c8137abd81 Mon Sep 17 00:00:00 2001
From: Virgil Dupras <hsoft@hardcoded.net>
Date: Fri, 15 May 2020 12:14:27 -0400
Subject: [PATCH] sms: CollapseOS prompt!

---
 blk/056              |   4 +++-
 blk/081              |   4 ++--
 blk/083              |   4 ++--
 blk/393              |   1 +
 blk/394              |  17 +++++++----------
 blk/627              |  18 +++++-------------
 blk/628              |   9 +++++++++
 emul/forth.bin       | Bin 5879 -> 5938 bytes
 recipes/sms/xcomp.fs |   6 +++---
 9 files changed, 32 insertions(+), 31 deletions(-)
 create mode 100644 blk/628

diff --git a/blk/056 b/blk/056
index d3db076..5e28f9b 100644
--- a/blk/056
+++ b/blk/056
@@ -6,7 +6,9 @@ Logic
 ><   n l h -- f Push true if l < n < h
 =><= n l h -- f Push true if l <= n <= h
 CMP  n1 n2 -- n Compare n1 and n2 and set n to -1, 0, or 1.
-               n=0: a1=a2. n=1: a1>a2. n=-1: a1<a2.
+                n=0: a1=a2. n=1: a1>a2. n=-1: a1<a2.
+MIN  a b -- n   Returns the lowest of a and b
+MAX  a b -- n   Returns the highest of a and b
 NOT  f -- f     Push the logical opposite of f
 
 
diff --git a/blk/081 b/blk/081
index c894fc6..e216810 100644
--- a/blk/081
+++ b/blk/081
@@ -1,6 +1,6 @@
 RAMSTART  FUTURE USES          +3c       BLK(*
-+02       CURRENT              +3e       FUTURE USES
-+04       HERE                 
++02       CURRENT              +3e       XYPOS
++04       HERE                 +40       FUTURE USES
 +06       C<?                  +51       CURRENTPTR
 +08       C<* override         +53       (emit) override
 +0a       NLPTR                +55       (key) override
diff --git a/blk/083 b/blk/083
index a45d747..a3afc08 100644
--- a/blk/083
+++ b/blk/083
@@ -7,8 +7,8 @@ WORDBUF is the buffer used by WORD
 BOOT C< PTR is used when Forth boots from in-memory
 source. See "Initialization sequence" below.
 
-
-
+XYPOS Current position of the cursor on screen. The meaning of
+the pos in terms of row and cols is driver-dependent.
 
 
 
diff --git a/blk/393 b/blk/393
index e602432..d4092d0 100644
--- a/blk/393
+++ b/blk/393
@@ -3,6 +3,7 @@
 : HERE 0x04 RAM+ ;
 : CURRENT* 0x51 RAM+ ;
 : CURRENT CURRENT* @ ;
+: XYPOS 0x40 RAM+ ;
 
 ( w -- a f )
 : (find) CURRENT @ SWAP _find ;
diff --git a/blk/394 b/blk/394
index d6742b5..36de94d 100644
--- a/blk/394
+++ b/blk/394
@@ -2,14 +2,11 @@
 : ERR LIT< (print) (find) IF EXECUTE THEN ABORT ;
 : = CMP NOT ; : < CMP -1 = ; : > CMP 1 = ;
 : 0< 32767 > ; : >= < NOT ; : <= > NOT ; : 0>= 0< NOT ;
-( n l h -- f )
-: >< 2 PICK > ( n l f ) ROT ROT > AND ;
+: >< ( n l h -- f ) 2 PICK > ( n l f ) ROT ROT > AND ;
 : =><= 2 PICK >= ( n l f ) ROT ROT >= AND ;
-( a -- a+1 c )
-: C@+ DUP C@ SWAP 1+ SWAP ;
-( c a -- a+1 )
-: C!+ SWAP OVER C! 1+ ;
-( a -- a-1 c )
-: C@- DUP C@ SWAP 1- SWAP ;
-( c a -- a-1 )
-: C!- SWAP OVER C! 1- ;
+: MIN ( n n - n ) 2DUP > IF SWAP THEN DROP ;
+: MAX ( n n - n ) 2DUP < IF SWAP THEN DROP ;
+: C@+ ( a -- a+1 c ) DUP C@ SWAP 1+ SWAP ;
+: C!+ ( c a -- a+1 ) SWAP OVER C! 1+ ;
+: C@- ( a -- a-1 c ) DUP C@ SWAP 1- SWAP ;
+: C!- ( c a -- a-1 ) SWAP OVER C! 1- ;
diff --git a/blk/627 b/blk/627
index 4aa6757..b8ded29 100644
--- a/blk/627
+++ b/blk/627
@@ -1,14 +1,6 @@
-: _set ( row col tilenum -- )
-    ROT 5 LSHIFT ROT OR 0x7800 OR _ctl
-    _data 1 _zero
+: (emit)
+    XYPOS @ 2 * 0x7800 OR _ctl
+    0x20 - 0x5e MIN ( tilenum ) _data 1 _zero
+    XYPOS @ 1+ DUP [ VDP_COLS VDP_ROWS * LITN ]
+    = IF DROP 0 THEN XYPOS !
 ;
-: VDP$
-    9 0 DO _idat I 2 * + @ _ctl LOOP _blank
-    ( palettes )
-    0xc000 _ctl
-    ( BG ) 1 _zero 0x3f _data 14 _zero
-    ( sprite, inverted colors ) 0x3f _data 15 _zero
-    0x4000 _ctl 0x5e 0 DO ~FNT I 7 * + _sfont LOOP
-    0 0 1 _set
-;
-
diff --git a/blk/628 b/blk/628
new file mode 100644
index 0000000..abd4ef2
--- /dev/null
+++ b/blk/628
@@ -0,0 +1,9 @@
+: VDP$
+    9 0 DO _idat I 2 * + @ _ctl LOOP _blank
+    ( palettes )
+    0xc000 _ctl
+    ( BG ) 1 _zero 0x3f _data 14 _zero
+    ( sprite, inverted colors ) 0x3f _data 15 _zero
+    0x4000 _ctl 0x5e 0 DO ~FNT I 7 * + _sfont LOOP
+    0 XYPOS !
+;
diff --git a/emul/forth.bin b/emul/forth.bin
index 85666f4f91d07e2dba27df8978b0569661de9504..4bf769f524e2c66a46592e432750e7ec72d2dcc5 100644
GIT binary patch
delta 2889
zcma)8ZERa-6+XWAwPRn~*LGs3t@@E`*IVM&32j3wmaoP)an=yWj%>F}iK;C$brdZ)
zQ{1YmSa8N@D~R%=yYvTBD})3{3$z+l6)6G<X_3k_v8qV@!w)`!0{c)J5rG&%W#KvR
zO`t#dVc+|n_k5q{oO3^GzSrVe_BxiE97O;AndgRc_wd=FT){_9-JovDI8ACQO_awH
z0qY0OL)H7vh_dQ1DP`vJ#e>Ww9)KmC&ugUWF=~2kdZK(WLHC{GBxu#KhRe>~<j~Iv
zQcdb`%hzQQcA3<r$-|;N9O>|q0+U<SBwuy%slg>>Iz4z#%J=G#u1+@8CQn@*d}EM8
zeM-``;n;8_UB6Udu&bkU7m4kgQ}X7Nycz7z)<gUT*xA3R5&`>QYPePs8=fKdbRTA-
zQ0}Nv<&lVjuP1ug`o7ED!)$JfD2u`*gN{&K6^cO`HCX?09ZiLCTZ`LAVx(q4Y&hbO
zH)#PHA~ix`$v2b*NJbRa%lbDQJ9leaNQO08v)3PXwJPi4j%rXNg{|+_#P?i>UTxc+
zNo;WxrxIPaepA!f7)C<I$pt$mtqZpHflDY%V|(oB$FSaJHMo<G>sH47|44k@%@S|B
zn~pElaJEc3<hGwb+J25~(^2=!<&s@>H>zF$_nP&Y`xl)JC}uiWJn5I^5X5!IIk|Jb
z<}s<5dnuRi4UkJ;5D{g-Ba}}(q_!%X)?YolUf8P%Wz)lPv??=z5dS|C1D;l7pc(k&
zOnu^cjLiOJi|c8S4r&zA-P*2~cCz3?7EHS4DbV_sNh24^7pJeBJ3ux1q;nnxx}n+6
zxXMopzqnfVT=Uo`Hrpgc5=S7?uHCclYV(Irc!7z0I#o>j;rpL8gS@a{(wS7gKV@dp
zb>!CH^fEjvR>>RN*RI`1H#Bk!yyvwO`QOA@KlB#%KLN8!PoQ=%cLw4D30VS2KLCP%
zXN7%9*E-%DHCCUm-}|9gDDU_toiplN*4w^Akuogz<g$fgDqC!nmdl=1>$koGj&|#x
zzDw1ceuGFv5Q>=@hzFp210HuES2I8viHg^wEr_fB8Fg7y@GtqI&w;PvpI6W0x9YI(
zP3p^>E}Ytp?!O8$N3!CV?A;--KlKZRMYs`MfH{M;;;)}k^HPVcH~KuJ7sXXe(KC*l
zR!;u{{;T@Y>VS@1+e0LVTyy;l@&h-mKr>g_uH<9AK&z;vSvV+1fSVpeFw<ub5lx<Y
z^7hHUeaiGP>e>U%0h0<tJv>JYv=9qsGuwhy<YONF%y?rQa{vS2Z@N^Pyqt)l&M~T7
z96kT4aj86ZVY)Oqb(uDKMl$~QA*M}zI1r=DQ`2KcdFrB3ngXBXNXGWTQ%1KzF~qZz
z9LD6Qh$Pcrj5UyTH{i;aJ?{q=1VgDM7NT$Jp9bQzsdItl*ahvH{yAuCPNu!=1E380
z2rw3yEUeir=L9DnXG;k_pK1fu2Wm6IT^7gHXpsGQfp`wuMdFOE!H<(IP&co>5`<=k
zD)V_LX-xzht78CYkj|>Nf{%6n!NK7@GXLZ_t3C)mU?F{5s12rs@*p@IFn|z7vQXw3
zYG93m&Nu5~7Qu7Vx+RBQZm!BV=(-$fJZKGSfv#D4?oV4K)S~zF;Ls>4*&K*UK~~2g
ze1y5TM1Qls7&_KF7h<G0O_WQMiIAKub0ML;9-2{QGf$MiT1iAee?2s>&V@K<Jm2{A
z2f<v!frfy!5NfD?h4DB&Hd#KOU_3I%Ey>TbSR<ZvPoUYLs;sH)u3OG$?HLM?r*Jwr
zP`mc;hqykhZ$@2&%@gQn8|ijMc#=0wS7AAE368!Ss;xE1NxXdivDF-y3$dFf<$E*P
zjspN5Yq}$m>myqq`}Un$o4z2DE(4Y3ZnuTv#~{Qb;Fu)d3eAP$YQ_6*C{90tC7+}&
zTED8@RkioxaDXw9&Sg&WZryP<D%+CbTPQ|A4+4roS<4lS>DoH3emAYC$JLwuh+LH2
z6hXn3Kx224b-dOh%1^!QE?4<u6nU230~GtS#dLls|D|;C40$kid0Fx*umOADX|K1Z
zZkAkiv}0+EV^nbeO}&bSDOoq`PB<#ouj>vD1$CZ(Ei$M$t<-THI2VgzCo8w>9-^W)
z2fx|5S^;30(;jC!J%p<dDX3c~!~63*<szyxjOcTz-h2=V<u3&eO(?GfO95wimj2GY
z&DV$bql~slR1Qc^!#fae`r7D3Ik6YFx2?P3!76*Vo&IOM`(tg4UanlJ&^;|iJyVmD
zqpwvi<O&>T;3H`1&0WE$h|?04JsTR^%nb$TTcFHJ3NJJ+Q!!hIGI5KQJxpox(Hj_Q
z32N861Y@geQd<x`%nMD&LgTeHPW1q599wH=y_YezT=dlay-0z6&$a41D$S2eV{++X
zj}=d)vk^EUlnw36-l$yQ=}aLVl8zO?YjghZenU%t4&<BZ7yGj@x(bA1>b;oi&uTct
z(Qh1`9n0x#u|E@*WZSAu9tk3#+g4Y7{dhY<h(Y28HXDyqM4w`i8WabWqwmQL4)tf!
uwRBzo(EH>19rDOF{aihL8yC#kjt?m~U_y{VfRBjAb3uBO#jKy#cl-x~ZcZ`)

delta 2716
zcma)8Uu;`v6+idh&wuW<eXnn9Cz~>pYu8=ur44PpY+)p6eI2KD<Jgw%W~5Ol>AFPO
zf>V;E)sRxBFjheoA@)7>35~)eA~Hk}5k;t|i^RhuN*)$Xq7q{$j1^6VRA@X*BAoMG
zXMN?t*Y`VrzVq*Q&bjN||2eE~`lQXI1n|x;)E~G!$*Gz8g;apAyPgW)bVcMH$%c$w
zs?-jEOSjms_`h6X^`>hY80<**c);D(P~0{QXdvkmY=hC^NS_a6-GaSFJF)udq`N_}
zp|4-X_jd7qWT0OIMNf&tKp!zIkYPw}ckfEOQoH+ivJL$Mef@2~nw)0^=UKtYp6F^t
zbtdyaxJ#1Gqn<W=_IQrYDDG)!frz}tEYB+2l@dw}Z(3zB`A=>pPlFe(%B##qi5SW-
zc}>}s_IaP|Q3$(I1T~TuC+8Pld?7UsUNp0&SkMWIJ1sw8&3FDsPvY@QXiWnPjz9tf
zWU>X5c$$Js-0$t|R4}?}aHDk_9x(FZ`{)DF$cqi6u6dZ8;%B{wq)YtT|D|!lOB&nW
zWX}~3)xm~;HveDpI%lhSjzjWteJTZ1FE7@siqiM^G4;0%9Sf5y)s6>5ZW+cU&WHBT
z!>SFn((|RtpaE`ul||&B%H+3IP}1^k^*zkugFPFF9~C#~P;mVPC2p%^DJ?HyF6g<%
zf@&Ibav1rPySIhzM^Ep?<Oq^UEhdyGg{-Mq&6dZ|Ree8IZcLR8!~9L{v9?id*0q8K
zO(^uw@t082>M-BZS{2YP^ZVLL*Jqjy*-9=`%LT}J%>o}#K%<#TK4TYhAuQ-AAAzlx
zzv+uV0oqNM4V_+u@HL;4!Ot_tKk!wf>nN<iy3dA@(kQAk%*ZXETJB0e;wAqf_b>77
z_ildGpZC4tV{+X;>snHt=iC0Lo=&6XY^hkSWs0><VL7e-)W3oW8qW_+7<k#f$?@8$
zTyX+11UwyBY@7{P04#!nc40U{f*Tl0AEs;xu?Vc!cUN6yrvppMChNtgkc%Bex!%Bv
zlEmMR<nV16Dx9gFdJJ3mG?K~QTLB?{!bI^q0Vb0QHI5tGf?(VmXkAj;#2wDPu_sY`
zgPrF6dO<qNzo&l@pTE(MHi9~}%KS|Il~f!&qG%QbM5lm4NO8({L$AUPV#cl>5S{LY
z8>m<qaz=$FPT7ic3N%lJA;KdV4^gsO&eFKB5GSNqEHoAQOGZcv@+(G1<72F%0Q?i^
z>TNx0#NqPX`~|B%_lh+&w^+XbByk7}F6#tm3*zYJe$2ya75;$^7V@=t2fT)s;*eHX
zj8#V1>5iN5E&b<40&eS6Q85#d_PV}_w0kb3#o(MDA!Nbd5uXf44BhP&qk%GtXWk!t
zGLu58AE}2ij!o91d}NR(UxN0}J)u;6f}R}j#_Lv;gFze45jaUsg?9eqVCOR_gk%uL
zl*!-?oqp)yR~{FM1!+vV9=uLUdQ<5+G{xlW!6=u^$QUuB#sjvD;ZhTNaXQ@sYBox)
z1y|sbm|9+hf(6~Ey9|Hb>oRN@JTp?B#ELxBV?u8X10^tR;bgl7zvgr1vB9!Qh)vGa
zr)E>8m>p%4$r*D=A%r6R{6Z>%^o+Tplub$zO)xrrz(^`;?CAV&W=Ep~V@l3nn61Ac
za77Z6LY_v21~kjo@n#DeqKJ;SUNM0YC?fUbKO#t`=qXO8*efQLgYH{WHqhp08gU7+
z4isosC+8bzIkkw6E}HL~7Pvr1_NRLf^|DEB+E5uR6#Kq_NTZw96xu9)aPA}DN-Yk3
zm9@Jq>;dXpM=5cPItg3(m>^D?Wiz4l`WDRuTx_xM5)$3ua;WVj*<=tk2m-lM;W(|r
zeP?61M&83-E##}U2-3H4Tm(faKg6;7eoNG_-~@cA^eAWf*Fur;-4<F@5&0WFa*vAo
zF&1?h-a(}0i?v*(T*=i&LDd2Cv8K=@cZR`Dm$R?#cu8?bLJZ;v37}hXn0p!fp^I;Y
zo{@UFCw$<*c7VoKw}>GDZ-prBA|AG%g!6nP+@Vvlb-0WE+=cA`|7JMqr4bZS-VN~|
zh9f-(gI&hEp=J0tbz~_sSm}ylEgX@Um{t)4Up<Va`ugNdJ=Kof^Zb5zq(L^DIecU@
z^plo2oLhKx0WNEC$j;5qPF`Giu~a4Rji2EygQZuozY}l^dwv7=N1;?I8#o0Luq-IF
zWyEYKhA`LECTW!@Nk3fG<B$T-1{eXPVZ(Dl>^oXJI<6gBF4NG8h`X;n+QMlZHg34%
z{c5BNf2INq9Tn!Mg)y<3aNE#6h@cZp-p~wROl;L$p_(&=V^x%OBp>lNw8noCzIN_p
zz8Ht^Ak470PG<5&4G#%y8j8+|<xH`bFN6izvFeb=gBZ~HkPQ=VjDiXz!p2X!*AN-b
zP#o2qp@^e0L(sDz(M(6SlpQJO3%M4!roZ8PxpkjDo-GObL@Rt38I-v%;};ORgx?9O
SV`aQ^A_(6mHU4R9-~Rw$ZVe>>

diff --git a/recipes/sms/xcomp.fs b/recipes/sms/xcomp.fs
index 8fe4c50..9353fe6 100644
--- a/recipes/sms/xcomp.fs
+++ b/recipes/sms/xcomp.fs
@@ -21,12 +21,12 @@ CURRENT @ XCURRENT !
 282 LOAD  ( boot.z80 )
 393 LOAD  ( xcomp core low )
 CREATE ~FNT CPFNT7x7
-623 627 LOADR ( VDP )
-: (key) 0 ; : (emit) DROP ;
+623 628 LOADR ( VDP )
+: (key) 4 ;
 420 LOAD  ( xcomp core high )
 (entry) _
 ( Update LATEST )
 PC ORG @ 8 + !
-," VDP$ BYE "
+," VDP$ " EOT,
 ORG @ 0x100 - 256 /MOD 2 PC! 2 PC!
 H@ 256 /MOD 2 PC! 2 PC!