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

common.jrt

@@ -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! ;

dialer.jrt

@@ -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
+var status
-DISCONNECTED var, status
 var status-timer
-: start-status-timer ticks status-timer ! ;
+var status-bg
-: stop-status-timer 0 status-timer ! ;
 
+: 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 
+  ticks status-timer @ - 18 / 60 /mod swap 60 /mod swap 
-  .2digit .: .2digit .: .2digit else drop then ;
+  .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
+  connected? if 70 space-to draw-status-timer 
-  65 space-to s" | ESC for menu" draw-text 
+             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 ;
+: xmit ( st -- ) chars each i emit 1 delay next ;
-: call ( st -- ) s" ATDT" xmit dup xmit nl noisy offhook dialtone dialst ;
+: 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 
+  blue bg! lcyan fg! s" - you have used 13246 / 30" xmit-line
-  15 textx! s" days of your limited trial!" xmit nl nl 200 sleep-csec 
+  15 textx! s" days of your limited trial!" xmit-line nl nl nl 200 delay 
   lgray fg! ;
 
-: login black bg! white fg!
+: go init-statusbar splash
-  begin sleep-key nl key>scan %esc != while s" LOGON PLEASE: " xmit repeat ;
+  popup-menu begin sleep-key key>scan %esc = if popup-menu then again ;
-
-: 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
 

iter.jrt

@@ -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 ;

rick.jrt

@@ -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" ;

rickclub.bin

@@ -1 +1 @@
-   ÛÛÛÛÛÛ»  ÛÛ»  ÛÛÛÛÛÛ» ÛÛ»  ÛÛ» ÜÛ» ÛÛÛÛÛÛÛ»                                     ÛÛÉÍÍÛÛ» ÛÛº ÛÛÉÍÍÍͼ ÛÛº ÛÛɼ ßͼ ÛÛÉÍÍÍͼ       ÿ                             ÛÛÛÛÛÛɼ ÛÛº ÛÛº      ÛÛÛÛÛɼ      ÛÛÛÛÛÛÛ»        (273) 555-1212               ÛÛÉÍÍÛÛ» ÛÛº ÛÛº      ÛÛÉÍÛÛ»      ÈÍÍÍÍÛÛº                                     ÛÛº  ÛÛº ÛÛº ÈÛÛÛÛÛÛ» ÛÛº  ÛÛ»     ÛÛÛÛÛÛÛº                                     Èͼ  Èͼ Èͼ  ÈÍÍÍÍͼ Èͼ  Èͼ     ÈÍÍÍÍÍͼ                                     ÜÜÜÜÜÜÜ ÜÜÜ     ÜÜÜ ÜÜÜ ÜÜÜÜÜÜ  ÜÜÜ ÜÜÜ ÜÜÜÜÜÜÜ ÜÜÜ ÜÜÜ ÜÜÜÜÜÜÜ ÜÜÜÜÜÜÜ  	       ÛÿÜÜÜÜÛ ÛÿÛ     ÛÿÛ ÛÿÛ ÛÿÜÜÿÛÜ ÛÿÛÜÛÿÛ ÛÿÜÜÜÿÛ ÛÿÛ ÛÿÛ ÛÿÜÜÜÜÛ ÛÿÜÜÜÜÛ         ÛÿÛÜÜÜÜ ÛÿÛÜÜÜÜ ÛÿÛÜÛÿÛ ÛÿÜÜÜÿÛ ÛÿÜÜÜÿÛ ÛÿÛÜÛÿÛ ÛÿÛÜÛÿÛ ÛÜÜÜÜÿÛ ÛÿÜÜÜÛÜ         ÛÜÜÜÜÜÛ ÛÜÜÜÜÜÛ ÛÜÜÜÜÜÛ ÛÜÜÜÜÜÛ ÛÜÛ ÛÜÛ ÛÜÜÜÜÜÛ ÛÜÜÜÜÜÛ ÛÜÜÜÜÜÛ ÛÜÜÜÜÜÛ                                                                                             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              ß ßßß  ß ßßß  ßÜÜÜÜß                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                      
+   ÛÛÛÛÛÛ»  ÛÛ»  ÛÛÛÛÛÛ» ÛÛ»  ÛÛ» ÜÛ» ÛÛÛÛÛÛÛ»                                     ÛÛÉÍÍÛÛ» ÛÛº ÛÛÉÍÍÍͼ ÛÛº ÛÛɼ ßͼ ÛÛÉÍÍÍͼ       ÿ                             ÛÛÛÛÛÛɼ ÛÛº ÛÛº      ÛÛÛÛÛɼ      ÛÛÛÛÛÛÛ»        (273) 555-1212               ÛÛÉÍÍÛÛ» ÛÛº ÛÛº      ÛÛÉÍÛÛ»      ÈÍÍÍÍÛÛº                                     ÛÛº  ÛÛº ÛÛº ÈÛÛÛÛÛÛ» ÛÛº  ÛÛ»     ÛÛÛÛÛÛÛº                                     Èͼ  Èͼ Èͼ  ÈÍÍÍÍͼ Èͼ  Èͼ     ÈÍÍÍÍÍͼ                                     ÜÜÜÜÜÜÜ ÜÜÜ     ÜÜÜ ÜÜÜ ÜÜÜÜÜÜ  ÜÜÜ ÜÜÜ ÜÜÜÜÜÜÜ ÜÜÜ ÜÜÜ ÜÜÜÜÜÜÜ ÜÜÜÜÜÜÜ  	       ÛÿÜÜÜÜÛ ÛÿÛ     ÛÿÛ ÛÿÛ ÛÿÜÜÿÛÜ ÛÿÛÜÛÿÛ ÛÿÜÜÜÿÛ ÛÿÛ ÛÿÛ ÛÿÜÜÜÜÛ ÛÿÜÜÜÜÛ         ÛÿÛÜÜÜÜ ÛÿÛÜÜÜÜ ÛÿÛÜÛÿÛ ÛÿÜÜÜÿÛ ÛÿÜÜÜÿÛ ÛÿÛÜÛÿÛ ÛÿÛÜÛÿÛ ÛÜÜÜÜÿÛ ÛÿÜÜÜÛÜ         ÛÜÜÜÜÜÛ ÛÜÜÜÜÜÛ ÛÜÜÜÜÜÛ ÛÜÜÜÜÜÛ ÛÜÛ ÛÜÛ ÛÜÜÜÜÜÛ ÛÜÜÜÜÜÛ ÛÜÜÜÜÜÛ ÛÜÜÜÜÜÛ                                                                                             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              ß ßßß  ß ßßß  ßÜÜÜÜß                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                      

rickmenu.bin

@@ -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           ³         ³                                                                     ³         ÔÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ;                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                     

swine.jrt

@@ -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

text.jrt

@@ -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 ! ;

zipoff.jrt

@@ -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 #