diff --git a/beep.jrt b/beep.jrt index 3da4e26..4212ded 100755 --- a/beep.jrt +++ b/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 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 ] div lit 300 freq>div lit ] 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 } diff --git a/iter.jrt b/iter.jrt index ab0d32c..5c77311 100755 --- a/iter.jrt +++ b/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 else drop 0 then 1 |; >next ; +: pchars ( st -- ) 1- >i :| 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 then ; +: chars pchars (( each i b@ map next )) ; diff --git a/swine.com b/swine.com index bf50f07..bdc7a7f 100755 Binary files a/swine.com and b/swine.com differ diff --git a/swine.jrt b/swine.jrt index 20c0971..e61acdc 100755 --- a/swine.jrt +++ b/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" diff --git a/timer.jrt b/timer.jrt index 3189659..33a8fb8 100755 --- a/timer.jrt +++ b/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 ; diff --git a/zipoff.com b/zipoff.com index a01d020..3ed5dad 100755 Binary files a/zipoff.com and b/zipoff.com differ diff --git a/zipstub.seg b/zipstub.seg index 2d8a9c4..b2c09dc 100755 Binary files a/zipstub.seg and b/zipstub.seg differ