dialer splash screen, modem noises

beep.jrt

@@ -30,6 +30,5 @@
 : boop ( div count -- ) swap >spk sleep-csec silence ;
 : noise ( count -- ) 
   begin rand >spk 1 sleep-csec 1- dup not until drop silence ;
-: arp ( d1 d2 count -- )
-  begin >rot dup 1 boop swap <rot 1- dup not until drop drop drop ;
+: arp ( d1 d2 count -- ) times each dup 1 boop swap next drop drop ;
 

dialer.jrt

@@ -1,3 +1,5 @@
+1 var, quiet
+
 array dtmf-col 1209 freq>div , 1336 freq>div , 1477 freq>div ,
 array dtmf-row 697 freq>div , 770 freq>div , 852 freq>div , 941 freq>div ,
 
@@ -9,9 +11,143 @@ array dtmf-row 697 freq>div , 770 freq>div , 852 freq>div , 941 freq>div ,
 -2 const D*
 -1 const D#
 
+: noisy quiet @ if rdrop then ;
+
 : dtmf ( digit -- f1 f2 ) 1- 
   dup 0 < if abs 3 % 3 swap else 3 /mod then 
   cells dtmf-col + @ swap cells dtmf-row + @ ;
 : dial ( digit -- ) dtmf 20 arp 7 sleep-csec ;
-: dialtone [ 350 freq>div lit 440 freq>div lit ] 200 arp ;
+: dialch ( b -- ) >r
+  r@ [ key * lit ] = if D* dial then
+  r@ [ key # lit ] = if D# dial then
+  r@ [ key 0 lit ] >= if r@ [ key 9 lit ] <= if 
+    r@ [ key 0 lit ] - dial 
+  then then rdrop ;
 
+: dialst ( st -- ) chars each i dialch next ;
+: dialtone [ 350 freq>div lit 440 freq>div lit ] 200 arp ;
+: offhook 30 sleep-csec 3 2 boop 15 sleep-csec 7 2 boop 10 sleep-csec ;
+
+2100 freq>div const carrier-div
+980 freq>div const hs-low
+1180 freq>div const hs-high
+1650 freq>div const hs2-low
+1850 freq>div const hs2-high
+
+: carrier-drop 0x6000 1 boop ;
+: carrier ( csec -- ) carrier-div swap boop carrier-drop ;
+: scramblebip ( div div -- ) rand 2 % if swap then drop 1 boop ;
+: hs-with-carrier ( csec -- )
+  over-csec each carrier-div 1 boop hs-low hs-high scramblebip next ;
+: dual-hs ( csec -- ) over-csec each 
+    hs-low hs-high scramblebip hs2-low hs2-high scramblebip 
+  next ;
+: probe-hi ( csec -- ) [ 2400 freq>div lit 1200 freq>div lit ] <rot arp ;
+: probe-lo ( csec -- ) [ 600 freq>div lit 300 freq>div lit ] <rot arp ;
+: fullduplex ( csec -- ) 
+  over-csec each rand 3700 % 20 + freq>div >spk next silence ;
+: handshake 
+  30 carrier 45 carrier 75 carrier 30 carrier
+  30 hs-with-carrier 75 hs-with-carrier 45 hs-with-carrier 
+  37 dual-hs 37 dual-hs 37 dual-hs 30 dual-hs 
+  45 probe-hi 50 probe-lo 15 probe-hi 60 probe-lo 60 probe-hi 
+  300 fullduplex ;
+
+( terminal words )
+: fixcursor texty 8 << textx | movecursor ;
+: nl nextline fixcursor ;
+: emit draw-char fixcursor ;
+: xmit ( st -- ) chars each i emit 1 sleep-csec next ;
+: call ( st -- ) s" ATDT" xmit dup xmit nl noisy offhook dialtone dialst ;
+
+: connect ( st -- ) call noisy 200 sleep-csec handshake ;
+
+{ : X ( v -- v ) 2* 1 | ;
+  : o ( v -- v ) 2* ; }
+7 const logoh
+6 const logocount
+
+array logo
+0 X X X X X o o o >t
+0 X X o o X X o o >t
+0 X X o o X X o o >t
+0 X X o o X X o o >t
+0 X X o o X X o o >t
+0 X X o o X X o o >t
+0 X X X X X o o o >t
+
+0 o o o o o o o o >t
+0 o o X X X o o o >t
+0 o o o o o o o o >t
+0 o o X X X o o o >t
+0 o o o X X o o o >t
+0 o o o X X o o o >t
+0 o X X X X X X o >t
+
+0 o o o o o o o o >t
+0 o o o o o o o o >t
+0 o o X X X X X o >t
+0 o X X o o X X o >t
+0 o X X o o X X o >t
+0 o X X o o X X o >t
+0 o o X X X X X X >t
+
+0 o o X X X o o o >t
+0 o o o X X o o o >t
+0 o o o X X o o o >t
+0 o o o X X o o o >t
+0 o o o X X o o o >t
+0 o o o X X o o o >t
+0 o o X X X X o o >t
+
+0 o o o o o o o o >t
+0 o o o o o o o o >t
+0 o o X X X X o o >t
+0 o X X o o X X o >t
+0 o X X X X X X o >t
+0 o X X o o o o o >t
+0 o o X X X X X o >t
+
+0 o o o o o o o o >t
+0 o o o o o o o o >t
+0 X X o X X X o o >t
+0 o X X X o X X o >t
+0 o X X o o o o o >t
+0 o X X o o o o o >t
+0 X X X X o o o o >t
+
+array logobits 
+0xb2 b, 0xdd b, 0xf0 b, 0xde b, 0x1f b, 0x7f b, 0xfe b, 0x0a b, 0xba b, 
+target logobits - const logobit-count
+
+var curr-logobit
+: logobit curr-logobit @ logobits + ub@ ;
+: nextlogo curr-logobit @ 1+ logobit-count % curr-logobit ! ;
+
+: draw-logo
+  80 logocount 8 * - 2/ 3 textxy!
+  logo logo logoh + for each textx 0 logocount for each
+    j i logoh * + ub@ 
+    8 times each dup 0x80 & 
+      if logobit else [ key   lit ] then draw-char 2* 
+    next drop
+  next nextline textx! next ;
+
+: animate-logo
+  logobit-count 3 * times each draw-logo 10 sleep-csec nextlogo next ;
+
+: splash
+  blue bg! lgray fg! 32 fill-page lcyan fg! animate-logo 
+  nl nl 15 textx! lblue bg! lred fg! s" Unregistered version" xmit 
+  blue bg! lcyan fg! s" - you have used 13246 / 30" xmit nl 
+  15 textx! s" days of your limited trial!" xmit nl nl 200 sleep-csec 
+  lgray fg! ;
+
+: go splash 0 15 textxy! 
+  s" 5551212" connect s" CONNECT 57600" xmit nl ;
+
+' go ' main redefine
+
+dbg" saving"
+
+{ s" dialer.com" writecom }

iter.jrt

@@ -121,7 +121,7 @@ nexttop :push >next
 : for ( start lim -- ) >next 1- >i :| 1 +for? 2 |; >next ;
 : for+ ( start lim inc -- )
   >next >next 1 nextpeek - >i :| 2 nextpeek +for? 3 |; >next ;
-: chars ( st -- ) 1- >i :| <i 1+ dup b@ if >i 1 else drop 0 then 1 |; >next ;
+: pchars ( st -- ) 1- >i :| <i 1+ dup b@ if >i 1 else drop 0 then 1 |; >next ;
 
 :asm tail ( TODO: support CREATE words )
   LODSW
@@ -165,3 +165,4 @@ nexttop :push >next
 :yield pass _pass-suspend ;
 :yield filter if _pass-suspend else <r 1+ >r then ;
 
+: chars pchars (( each i b@ map next )) ;

swine.jrt

@@ -189,7 +189,7 @@ dbg" general-purpose drawing"
 : spacer ( st -- ) sp drawdot? if dot else sp then sp ;
 
 : draw-spaced-text ( st -- )
-  chars each i b@ draw-char i spacer next ;
+  pchars each i b@ draw-char i spacer next ;
 
 ( menu subsystem )
 dbg" menu"

timer.jrt

@@ -57,8 +57,12 @@ var timer
   OUT 0x40 # AL
   NEXT
 
-: sleep-csec ( cs -- )
-  timer @ + begin suspend dup timer @ <= until drop ;
+( the timer is set to run at just under 150hz, so a "csec" is closer to 7.5ms
+  than 10ms. )
+: over-csec ( csec -- ) 
+  timer @ + >arg (( begin yield0 dup timer @ <= until drop )) ;
+: sleep-csec ( cs -- ) over-csec each suspend next ;
+
 ' init :chain [ 0xffff 3 >> lit ] set-timer-div timer-isr install-isr ;
 ' cleanup :chain 0xffff set-timer-div timer-isr uninstall-isr ;