dialer splash screen, modem noises

This commit is contained in:
Jeremy Penner 2023-10-07 09:28:46 -04:00
parent 2980900aa0
commit f45d523bdd
9 changed files with 147 additions and 7 deletions

View file

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

BIN
dialer.com Executable file

Binary file not shown.

View file

@ -1,3 +1,5 @@
1 var, quiet
array dtmf-col 1209 freq>div , 1336 freq>div , 1477 freq>div , 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 , 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* -2 const D*
-1 const D# -1 const D#
: noisy quiet @ if rdrop then ;
: dtmf ( digit -- f1 f2 ) 1- : dtmf ( digit -- f1 f2 ) 1-
dup 0 < if abs 3 % 3 swap else 3 /mod then dup 0 < if abs 3 % 3 swap else 3 /mod then
cells dtmf-col + @ swap cells dtmf-row + @ ; cells dtmf-col + @ swap cells dtmf-row + @ ;
: dial ( digit -- ) dtmf 20 arp 7 sleep-csec ; : 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 }

View file

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

BIN
swine.com

Binary file not shown.

View file

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

View file

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

Binary file not shown.

Binary file not shown.