SpindleyQ/dialer
1
1
Fork 0
Code Issues Pull requests Packages Projects Releases Wiki Activity

fill out rick's bbs, dialer ESC menu, silence modem

Browse source
This commit is contained in:
Jeremy Penner 2023-10-14 22:22:50 -04:00
parent f00bd76589
commit 85824a202d
13 changed files with 181 additions and 38 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

1
common.jrt
View file

@ -1,3 +1,4 @@
: 2drop drop drop ;
: !+ ( v p -- ) dup @ <rot + swap ! ;
: b!+ ( v p -- ) dup b@ <rot + swap b! ;
: b!| ( f p -- ) dup b@ <rot | swap b! ;

BIN
dialer.com
View file

Binary file not shown.

144
dialer.jrt
View file

@ -1,4 +1,5 @@
1 var, quiet
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 ,
@ -11,7 +12,10 @@ 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 ;
: 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
@ -26,7 +30,7 @@ array dtmf-row 697 freq>div , 770 freq>div , 852 freq>div , 941 freq>div ,
: 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 ;
: 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
@ -54,33 +58,39 @@ array dtmf-row 697 freq>div , 770 freq>div , 852 freq>div , 941 freq>div ,
300 fullduplex ;
( statusbar words )
s" DISCONNECTED" const DISCONNECTED
DISCONNECTED var, status
var status
var status-timer
: start-status-timer ticks status-timer ! ;
: stop-status-timer 0 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
status-timer @ dup if ticks swap - 18 / 60 /mod swap 60 /mod swap
.2digit .: .2digit .: .2digit else drop then ;
ticks status-timer @ - 18 / 60 /mod swap 60 /mod swap
.2digit .: .2digit .: .2digit ;
: draw-status
magenta bg! white fg! 0 0 textxy!
status-bg @ 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
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 textpos @ textpen @ draw-status textpen ! textpos ! suspend again |;
:| 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
@ -88,20 +98,96 @@ var status-timer
: 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 ;
: xmit ( st -- ) chars each i emit 1 delay next ;
: xmit-line xmit nl ;
: connect ( st -- ) call noisy 200 sleep-csec handshake ;
{ :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
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 ;
{ : lines-of pagew 2* * take ; }
: rick-welcome rick-welcome-rle xmit-screen ;
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
@ -173,24 +259,18 @@ var curr-logobit
next drop
next nextline textx! next ;
: animate-logo
: 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 nl
15 textx! s" days of your limited trial!" xmit nl nl 200 sleep-csec
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! ;
: 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 init-statusbar splash
popup-menu begin sleep-key key>scan %esc = if popup-menu then again ;
' go ' main redefine

1
iter.jrt
View file

@ -246,6 +246,7 @@ nexttop :push >next
:yield yield0 :| ' noop _resume |; _suspend ;
:yield yield >i :| ' idrop _resume idrop |; _suspend ;
:yield yield> >i :| ' idrop _resume <i |; _suspend ;
:yield yield2 >i >i :| idrop idrop ' noop _resume |; _suspend ;
:yield map <i >next >i :| :| idrop <next >i cancel |;
_resume idrop <next >i |; _suspend 1+ ;
: _pass-suspend rdrop :| ' cancel _resume |; _suspend ;

54
rick.jrt Executable file
View file

@ -0,0 +1,54 @@
array rick-welcome-rle
{ s" rickclub.bin" open filebytes 18 lines-of encode-rle }
array rick-menu-rle
{ s" rickmenu.bin" open filebytes 7 lines-of encode-rle }
: login
l" To login as a guest, leave your name blank."
begin
x" Enter your name: " readline nl
dup b@ while x" Sorry, I don't recognize " xmit l" !" nl
repeat nl
l" Welcome, guest! We hope you decide to apply for a full membership."
l" Guest accounts have limited access."
l" If you have any questions, feel free to page the sysop - I'll be happy"
l" to chat with you if I'm around!"
l" -- Rick" nl ;
: tolower ( ch -- ch )
dup [ key A lit ] >= over [ key Z lit ] <= and
if [ key a key A - lit ] + then ;
: readch ( -- ch )
begin sleep-key key>ch dup printable? not while drop repeat ;
deferred rick-menu noop
: page-rick
l" Paging Sysop........"
500 delay
l" Sorry, guess he's not home!"
' rick-menu ;
: rick-files l" WORK IN PROGRESS, HERE BE DRAGONS" ' rick-menu ;
:noname ( -- cp )
nl rick-menu-rle xmit-screen nl
0 begin
yellow fg! black bg!
nl x" Your selection: " readch tolower dup emit nl
dup [ key m lit ] = if
lred fg! l" Sorry, message boards are not available to guests." then
dup [ key g lit ] = if
lred fg! l" Sorry, games are not available to guests." then
dup [ key p lit ] = if swap drop ' page-rick swap then
dup [ key f lit ] = if swap drop ' rick-files swap then
[ key h lit ] = if
lcyan fg! l" Thank you for calling!" 300 delay return then
dup until ; ' rick-menu redefine
: rick
black bg! white fg!
nl nl nl rick-welcome-rle xmit-screen login
' rick-menu begin execute dup not until ;
: call-rick s" 5551212" ;

2
rickclub.bin
View file

@ -1 +1 @@
ÛÛÛÛÛÛ»  ÛÛ»  ÛÛÛÛÛÛ» ÛÛ»  ÛÛ» ÜÛ» ÛÛÛÛÛÛÛ»          ÛÛÉÍÍÛÛ» ÛÛº ÛÛÉÍÍÍͼ ÛÛº ÛÛɼ ßͼ ÛÛÉÍÍÍͼ     ÿ ÛÛÛÛÛÛɼ ÛÛº ÛÛº      ÛÛÛÛÛɼ      ÛÛÛÛÛÛÛ»        ( 2 7 3 ) 5 5 5 - 1 2 1 2 ÛÛÉÍÍÛÛ» ÛÛº ÛÛº      ÛÛÉÍÛÛ»      ÈÍÍÍÍÛÛº        ÛÛº  ÛÛº ÛÛº ÈÛÛÛÛÛÛ» ÛÛº  ÛÛ»     ÛÛÛÛÛÛÛº        Èͼ  Èͼ Èͼ  ÈÍÍÍÍͼ Èͼ  Èͼ     ÈÍÍÍÍÍͼ        ÜÜÜÜÜÜÜ ÜÜÜ ÜÜÜ ÜÜÜ ÜÜÜÜÜÜ ÜÜÜ ÜÜÜ ÜÜÜÜÜÜÜ ÜÜÜ ÜÜÜ ÜÜÜÜÜÜÜ ÜÜÜÜÜÜÜ     ÛÿÜÜÜÜÛ ÛÿÛ ÛÿÛ ÛÿÛ ÛÿÜÜÿÛÜ ÛÿÛÜÛÿÛ ÛÿÜÜÜÿÛ ÛÿÛ ÛÿÛ ÛÿÜÜÜÜÛ ÛÿÜÜÜÜÛ ÛÿÛÜÜÜÜ ÛÿÛÜÜÜÜ ÛÿÛÜÛÿÛ ÛÿÜÜÜÿÛ ÛÿÜÜÜÿÛ ÛÿÛÜÛÿÛ ÛÿÛÜÛÿÛ ÛÜÜÜÜÿÛ ÛÿÜÜÜÛÜ ÛÜÜÜÜÜÛ ÛÜÜÜÜÜÛ ÛÜÜÜÜÜÛ ÛÜÜÜÜÜÛ ÛÜÛ ÛÜÛ ÛÜÜÜÜÜÛ ÛÜÜÜÜÜÛ ÛÜÜÜÜÜÛ ÛÜÜÜÜÜÛ SYSOP:ÿRick Toews ßÛßßÜ ßÛßßÜ ÜßßßÜ ÚOÄOÄOÄOÄOÄOÄOÄOÄOÄOÄOÄOÄOÄOÄOÄOÄOÄOÄOÄOÄOÄOÄOÄOÄOÄOÄOÄOÄOÄOÄOÄOÄO¿O Û Û Û Û Û ³O O OYOoOuOrO OfOrOiOeOnOdOlOyO OlOoOcOaOlO OcOoOmOpOuOtOeOrO O O³O ßÛßßßÛ ßÛßßßÛ ßßÜÜ ³O O O O O O O O O O O OhOaOnOgOoOuOtO!O O O O O O O O O O O O O O³O Û Û Û Û Û ÀOÄOÄOÄOÄOÄOÄOÄOÄOÄOÄOÄOÄOÄOÄOÄOÄOÄOÄOÄOÄOÄOÄOÄOÄOÄOÄOÄOÄOÄOÄOÄOÄOÙO ß ßßß ß ßßß ßÜÜÜÜß
ÛÛÛÛÛÛ»  ÛÛ»  ÛÛÛÛÛÛ» ÛÛ»  ÛÛ» ÜÛ» ÛÛÛÛÛÛÛ»          ÛÛÉÍÍÛÛ» ÛÛº ÛÛÉÍÍÍͼ ÛÛº ÛÛɼ ßͼ ÛÛÉÍÍÍͼ     ÿ ÛÛÛÛÛÛɼ ÛÛº ÛÛº      ÛÛÛÛÛɼ      ÛÛÛÛÛÛÛ»        ( 2 7 3 ) 5 5 5 - 1 2 1 2 ÛÛÉÍÍÛÛ» ÛÛº ÛÛº      ÛÛÉÍÛÛ»      ÈÍÍÍÍÛÛº        ÛÛº  ÛÛº ÛÛº ÈÛÛÛÛÛÛ» ÛÛº  ÛÛ»     ÛÛÛÛÛÛÛº        Èͼ  Èͼ Èͼ  ÈÍÍÍÍͼ Èͼ  Èͼ     ÈÍÍÍÍÍͼ        ÜÜÜÜÜÜÜ ÜÜÜ ÜÜÜ ÜÜÜ ÜÜÜÜÜÜ ÜÜÜ ÜÜÜ ÜÜÜÜÜÜÜ ÜÜÜ ÜÜÜ ÜÜÜÜÜÜÜ ÜÜÜÜÜÜÜ     ÛÿÜÜÜÜÛ ÛÿÛ ÛÿÛ ÛÿÛ ÛÿÜÜÿÛÜ ÛÿÛÜÛÿÛ ÛÿÜÜÜÿÛ ÛÿÛ ÛÿÛ ÛÿÜÜÜÜÛ ÛÿÜÜÜÜÛ ÛÿÛÜÜÜÜ ÛÿÛÜÜÜÜ ÛÿÛÜÛÿÛ ÛÿÜÜÜÿÛ ÛÿÜÜÜÿÛ ÛÿÛÜÛÿÛ ÛÿÛÜÛÿÛ ÛÜÜÜÜÿÛ ÛÿÜÜÜÛÜ ÛÜÜÜÜÜÛ ÛÜÜÜÜÜÛ ÛÜÜÜÜÜÛ ÛÜÜÜÜÜÛ ÛÜÛ ÛÜÛ ÛÜÜÜÜÜÛ ÛÜÜÜÜÜÛ ÛÜÜÜÜÜÛ ÛÜÜÜÜÜÛ SYSOP:ÿRick Fehr  ßÛßßÜ ßÛßßÜ ÜßßßÜ ÚOÄOÄOÄOÄOÄOÄOÄOÄOÄOÄOÄOÄOÄOÄOÄOÄOÄOÄOÄOÄOÄOÄOÄOÄOÄOÄOÄOÄOÄOÄOÄOÄO¿O Û Û Û Û Û ³O O OYOoOuOrO OfOrOiOeOnOdOlOyO OlOoOcOaOlO OcOoOmOpOuOtOeOrO O O³O ßÛßßßÛ ßÛßßßÛ ßßÜÜ ³O O O O O O O O O O O OhOaOnOgOoOuOtO!O O O O O O O O O O O O O O³O Û Û Û Û Û ÀOÄOÄOÄOÄOÄOÄOÄOÄOÄOÄOÄOÄOÄOÄOÄOÄOÄOÄOÄOÄOÄOÄOÄOÄOÄOÄOÄOÄOÄOÄOÄOÄOÙO ß ßßß ß ßßß ßÜÜÜÜß

1
rickmenu.bin Executable file
View file

@ -0,0 +1 @@
                       ÕÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ͸                             ÕÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ;  ððð M A I N   M E N U ððð  ÔÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ͸         ³                                                                     ³         ³  M)essage Boards            Door G)ames          F)ile Area         ³         ³  P)age Sysop                                     H)ang Up           ³         ³                                                                     ³         ÔÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ;                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                     

BIN
swine.com
View file

Binary file not shown.

2
swine.jrt
View file

@ -59,8 +59,6 @@ array board maxw maxh * allot
: revealed? ( p -- f ) b@ FREVEALED & ;
: squarecount ( p -- c ) b@ NEIGHBOUR-MASK & ;
:yield yield2 >i >i :| idrop idrop ' noop _resume |; _suspend ;
: 8-neighbours ( x y -- ) >arg >arg ((
over 1- over 1- yield2
over 1- over yield2

9
text.jrt
View file

@ -6,7 +6,8 @@
0 var, textpageid
0 var, textpage
: page! dup textpageid ! 12 << textpage ! ;
: id>page 12 << ;
: page! dup textpageid ! id>page textpage ! ;
:asm showpage
POP AX
@ -203,3 +204,9 @@ var boxstyle
pagew 2* * textpage @ +
dup pagew 2* + <rot SCREENSEG segwordmove
textpos @ 0 <r textxy! pagew sp draw-hrepeat textpos ! ;
: pagecopy ( dstpage srcpage -- )
id>page swap id>page swap [ pagew pageh * lit ] SCREENSEG segwordmove ;
: textstate textpen @ textpos @ boxstyle @ ;
: textstate! boxstyle ! textpos ! textpen ! ;

BIN
zipoff.com
View file

Binary file not shown.

5
zipoff.jrt
View file

@ -98,7 +98,8 @@ s" coredefs.jrt" loadfile
:timm until t, BZ_ w>t ;
: t", begin key dup [ key " lit ] != while >t repeat drop 0 >t ;
:timm s" state if t, INLINEDATA_ patchpt t", patch!t else target t", then ;
: t" t, INLINEDATA_ patchpt t", patch!t ;
:timm s" state if t" else target t", then ;
: startcolon t& $DOCOLON w>t ] ;
: t:| t, INLINEDATA_ patchpt startcolon ;
@ -165,7 +166,7 @@ tdict-lookup cleanup drop ' cleanup redefine
dbg" boot"
} : start init main cleanup terminate ; {
} : exit cleanup terminate ; : start init main exit ; {
9 <: ( actual entry point )
MOV SI t& start #

BIN
zipstub.seg
View file

Binary file not shown.