2023-10-16 01:05:54 +00:00
dbg" Rick's Clubhouse BBS"
2023-10-15 02:22:50 +00:00
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 }
2023-10-16 01:05:54 +00:00
dbg" login"
2023-10-15 02:22:50 +00:00
: 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
2023-10-16 01:05:54 +00:00
cyan fg!
2023-10-15 02:22:50 +00:00
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 ;
deferred rick-menu noop
: page-rick
2023-10-16 01:05:54 +00:00
x" Paging Sysop..."
5 times each 100 delay [ key . lit ] emit next nl
l" Sorry, guess they're not home!"
2023-10-15 02:22:50 +00:00
' rick-menu ;
2023-10-16 01:05:54 +00:00
dbg" files"
s" swine.com"
2023-10-15 20:54:40 +00:00
s" Swine Meeper - A fun freeware puzzler. Find all the truffles!"
defembed swine.com
2023-10-16 01:05:54 +00:00
s" dirtrect.com"
s" A simple textmode graphics demo advertising the game development collective\called Dirty Rectangles."
2023-10-15 20:54:40 +00:00
defembed dirtrect.com
2023-10-16 01:05:54 +00:00
s" assemble.com"
s" I think this is an 8086 assembler, but I don't have any documentation for\it and it doesn't use a standard syntax. Some kind of Forth system?"
defembed assemble.com
(
s" kpshrink4.kps"
2023-10-15 20:54:40 +00:00
s" KP Shrinker 4.0 - Compressor and decompressor for KPS files\Requires an earlier version of PK Shrinker to extract."
59943 deffake kpshrink4.kps
2023-10-16 01:05:54 +00:00
s" mazecr3d.kps"
2023-10-15 20:54:40 +00:00
s" Maze Crazy 3D - Explore a fascinating maze filled with twists and turns\in 3 incredible dimensions! Includes instructions for building a PC adapter\for the Virtua Glove."
48371 deffake mazecr3d.kps
2023-10-16 01:05:54 +00:00
)
2023-10-15 20:54:40 +00:00
: rick-filelist ((
swine.com yield
2023-10-16 01:05:54 +00:00
dirtrect.com yield
assemble.com yield
2023-10-15 20:54:40 +00:00
)) ;
: list-files 1 each
blue bg! yellow fg! x" [" dup .digit x" ]"
lcyan fg! black bg! sp emit i filename xmit
cyan fg! x" (" i filesize n>st xmit l" bytes)"
lgray fg! nl i filedesc xmit-desc nl
nl 1+ next drop ;
: select-file
x" Type the number of a file, or Q to return to the menu: " inputch
dup [ key q lit ] = if drop ' rick-menu return then
[ key 1 lit ] - dup 0 >= over rick-filelist count < and if
2023-10-16 01:05:54 +00:00
rick-filelist nth
2023-10-15 20:54:40 +00:00
lblue fg! x" Downloading " dup filename xmit l" ..."
2023-10-16 01:05:54 +00:00
download-file l" Done!" else
drop lred fg! l" Sorry, that is not a valid selection." then
' select-file ;
2023-10-15 20:54:40 +00:00
: rick-files nl rick-filelist list-files ' select-file ;
2023-10-15 02:22:50 +00:00
2023-10-16 01:05:54 +00:00
dbg" menu"
2023-10-15 02:22:50 +00:00
:noname ( -- cp )
nl rick-menu-rle xmit-screen nl
0 begin
yellow fg! black bg!
2023-10-15 20:54:40 +00:00
nl x" Your selection: " inputch
2023-10-15 02:22:50 +00:00
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!
2023-10-15 20:54:40 +00:00
sp [ pagew 3 * lit ] repeated xmit-iter
rick-welcome-rle xmit-screen login
2023-10-15 02:22:50 +00:00
' rick-menu begin execute dup not until ;