dialer/dialer.jrt

0 var, quiet
0 var, quick

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#

: quiet? quiet @ quick @ or ; : quick? quick @ ;
: noisy quiet? if rdrop then ;
: slow quick? if rdrop then ;
: delay quick? if drop else sleep-csec 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 noisy 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 )
var status
var status-timer
var status-bg

: disconnect-status 
  s" DISCONNECTED" status ! 0 status-timer ! magenta status-bg ! ;
: connect-status 
  s" CONNECTED" status ! ticks status-timer ! green status-bg ! ;
disconnect-status

: connected? status-bg @ green = ;
: 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
  ticks status-timer @ - 18 / 60 /mod swap 60 /mod swap 
  .2digit .: .2digit .: .2digit ;

: draw-status
  status-bg @ bg! white fg! 0 0 textxy!
  1 space-to status @ draw-text
  connected? if 70 space-to draw-status-timer 
             else 65 space-to s" | ESC for menu" draw-text then
  80 space-to ;

: init-statusbar
  :| begin textstate draw-status textstate! suspend again |;
  spawn-task drop ;

( terminal words )
: sleep-key begin key-waiting? not while suspend repeat wait-key ;
: pause sleep-key drop ;

: 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 delay next ;
: xmit-line xmit nl ;

{ :timm x" t" t, xmit ;
  :timm l" t" t, xmit-line ; }

79 const MAXLINE
array linebuf MAXLINE 1+ allot

: printable? ( k -- f ) key>ch dup 0x20 >= swap 0x7e <= and ;
: bs? ( k -- f ) key>scan dup %bs = swap %left = or ;
: bs textx 1- dup textx! sp draw-char textx! fixcursor ;
: enter? ( k -- f ) key>scan %enter = ;
: readline linebuf begin sleep-key
  dup enter? not while
    dup printable? if over linebuf MAXLINE + < 
      if key>ch 2dup swap b! emit 1+ else drop then else
    dup bs? if drop dup linebuf > if bs 1- then else
    drop then then
  repeat drop 0 swap b! linebuf ;


: call ( st -- ) white fg! x" ATDT" dup xmit-line 
  quiet? if drop else offhook dialtone dialst then ;
: successful-call ( st -- ) call noisy 200 sleep-csec handshake ;
: hangup ( -- ) nl offhook disconnect-status white fg! l" NO CARRIER" ;

: connect ( cp st -- ) 
  successful-call connect-status l" CONNECT 57600" execute hangup ;

( bbses )

import embed.jrt
: xmit-screen ( rle -- ) rle-decode each i 8 >> textpen ! i emit next ;
{ : lines-of pagew 2* * take ; }

import rick.jrt

( menu )
: snapshot 1 0 pagecopy ; : restore 0 1 pagecopy ;
: nth ( i -- v ) 0 each 2dup = if drop i break then 1+ next swap drop ;
: count 0 each 1+ next ;

var menu-onclose
: close-menu ( cp -- ) menu-onclose ! restore suspend ;
: menu-options ((
  0 s" Phone Book:" yield2
  :| :| ' rick s" 5551212" connect |; close-menu |; 
    s" Rick's Clubhouse BBS" yield2
  0 0 yield2
  quiet @ if :| 0 quiet !save |; s" Enable modem sounds" yield2 else
             :| 1 quiet !save |; s" Disable modem sounds" yield2 then
  :| connected? if hangup then textmode exit |; s" Exit to DOS" yield2 )) ;

var selection
: option-walk ( cpstop -- )
  >r selection @ 0 menu-options each
    i if dup selection ! then r@ execute if break then 1+ 
  next 2drop rdrop ;

: prev-option :| 2dup 1+ <= |; option-walk ;
: next-option :| i if 2dup < else 0 then |; option-walk ;
: choose menu-options selection @ nth execute ;
: first-option 0 selection ! next-option prev-option ;

25 const menux 7 const menuy 
pagew menux 2* - const menuw

: draw-options
  menux 2 + menuy 1+ textxy!
  0 menu-options each
    dup selection @ = if green else magenta then bg!
    textx j if j draw-text then menux menuw + 2 - space-to nextline textx!
  1+ next drop ;
: draw-menubox
  magenta bg! white fg! 1 boxstyle!
  menux menuy textxy!
  menuw menu-options count 2 + filled draw-box ;

: menu-interact sleep-key key>scan
    dup %enter = if choose then
    dup %up    = if prev-option then
    dup %down  = if next-option then
        %esc   = if ' noop close-menu then ;

: menu-loop begin draw-options menu-interact menu-onclose @ until ;
: popup-menu snapshot textstate 0 menu-onclose ! first-option
  draw-menubox menu-loop textstate! menu-onclose @ execute 0 menu-onclose ! ;

( logo )
{ : 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 draw-logo slow
  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-line
  15 textx! s" days of your limited trial!" xmit-line nl nl nl 200 delay 
  lgray fg! ;

: go init-statusbar splash
  popup-menu begin sleep-key key>scan %esc = if popup-menu then again ;

' go ' main redefine

dbg" saving"

{ s" dialer.com" writecom }