diff --git a/common.jrt b/common.jrt index 5a64081..216f409 100755 --- a/common.jrt +++ b/common.jrt @@ -1,3 +1,4 @@ +: 2drop drop drop ; : !+ ( v p -- ) dup @ 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 diff --git a/iter.jrt b/iter.jrt index 6892e6b..f66a1b4 100755 --- a/iter.jrt +++ b/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 >i :| idrop idrop ' noop _resume |; _suspend ; :yield map next >i :| :| idrop i cancel |; _resume idrop i |; _suspend 1+ ; : _pass-suspend rdrop :| ' cancel _resume |; _suspend ; diff --git a/rick.jrt b/rick.jrt new file mode 100755 index 0000000..e06d63b --- /dev/null +++ b/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" ; diff --git a/rickclub.bin b/rickclub.bin index e0e64f4..eb136ac 100755 --- a/rickclub.bin +++ b/rickclub.bin @@ -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 ß ßßß ß ßßß ßÜÜÜÜß \ No newline at end of file + ÛÛÛÛÛÛ»  ÛÛ»  ÛÛÛÛÛÛ» ÛÛ»  ÛÛ» ÜÛ» ÛÛÛÛÛÛÛ»          ÛÛÉÍÍÛÛ» ÛÛº ÛÛÉÍÍÍͼ ÛÛº ÛÛɼ ßͼ ÛÛÉÍÍÍͼ     ÿ ÛÛÛÛÛÛɼ ÛÛº ÛÛº      ÛÛÛÛÛɼ      ÛÛÛÛÛÛÛ»        ( 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 ß ßßß ß ßßß ßÜÜÜÜß \ No newline at end of file diff --git a/rickmenu.bin b/rickmenu.bin new file mode 100755 index 0000000..7d7237e --- /dev/null +++ b/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           ³         ³                                                                     ³         ÔÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ;                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                      \ No newline at end of file diff --git a/swine.com b/swine.com index e4bc0d3..fddd259 100755 Binary files a/swine.com and b/swine.com differ diff --git a/swine.jrt b/swine.jrt index d03f613..62b18a9 100755 --- a/swine.jrt +++ b/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 diff --git a/text.jrt b/text.jrt index 3159b53..e9ecb40 100755 --- a/text.jrt +++ b/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* + page swap id>page swap [ pagew pageh * lit ] SCREENSEG segwordmove ; + +: textstate textpen @ textpos @ boxstyle @ ; +: textstate! boxstyle ! textpos ! textpen ! ; diff --git a/zipoff.com b/zipoff.com index 336df18..1d2a05f 100755 Binary files a/zipoff.com and b/zipoff.com differ diff --git a/zipoff.jrt b/zipoff.jrt index 1e489df..1021ab9 100755 --- a/zipoff.jrt +++ b/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 # diff --git a/zipstub.seg b/zipstub.seg index 96e97ff..98f353a 100755 Binary files a/zipstub.seg and b/zipstub.seg differ