200 lines
5.6 KiB
Plaintext
Executable file
200 lines
5.6 KiB
Plaintext
Executable file
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 ,
|
|
|
|
( 0 1 2
|
|
3 4 5
|
|
6 7 8
|
|
-3 -1 -2 )
|
|
|
|
-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 ;
|
|
: 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 ;
|
|
|
|
( statusbar words )
|
|
s" DISCONNECTED" const DISCONNECTED
|
|
DISCONNECTED var, status
|
|
var status-timer
|
|
: start-status-timer ticks status-timer ! ;
|
|
: stop-status-timer 0 status-timer ! ;
|
|
|
|
: space-to ( x -- ) textx - sp draw-hrepeat ;
|
|
: .digit ( v -- ) [ key 0 lit ] + draw-char ;
|
|
: .2digit ( v -- ) 10 /mod swap 10 % .digit .digit ;
|
|
: .: [ key : lit ] draw-char ;
|
|
: draw-status-timer
|
|
status-timer @ dup if ticks swap - 18 / 60 /mod swap 60 /mod swap
|
|
.2digit .: .2digit .: .2digit else drop then ;
|
|
|
|
: draw-status
|
|
magenta bg! white fg! 0 0 textxy!
|
|
1 space-to status @ draw-text
|
|
55 space-to draw-status-timer
|
|
65 space-to s" | ESC for menu" draw-text
|
|
80 space-to ;
|
|
|
|
: init-statusbar
|
|
:| begin textpos @ textpen @ draw-status textpen ! textpos ! suspend again |;
|
|
spawn-task drop ;
|
|
|
|
( terminal words )
|
|
: sleep-key begin key-waiting? not while suspend repeat wait-key ;
|
|
|
|
: fixcursor
|
|
texty 24 - dup 0 > if times each 1 24 scrollup next 24 texty! else drop then
|
|
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 ;
|
|
|
|
import embed.jrt
|
|
array rick-welcome-rle
|
|
{ : lines-of pagew 2* * take ;
|
|
s" rickclub.bin" open filebytes 18 lines-of encode-rle }
|
|
|
|
: xmit-screen ( rle -- ) rle-decode each i 8 >> textpen ! i emit next ;
|
|
|
|
: rick-welcome rick-welcome-rle xmit-screen ;
|
|
|
|
{ : 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! sp 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! ;
|
|
|
|
: login black bg! white fg!
|
|
begin sleep-key nl key>scan %esc != while s" LOGON PLEASE: " xmit repeat ;
|
|
|
|
: go init-statusbar splash 0 15 textxy!
|
|
s" 5551212" connect
|
|
s" CONNECTED AT 57600 BAUD" status ! start-status-timer
|
|
s" CONNECT 57600" xmit nl
|
|
rick-welcome login ;
|
|
|
|
' go ' main redefine
|
|
|
|
dbg" saving"
|
|
|
|
{ s" dialer.com" writecom }
|