55 lines
1.7 KiB
Plaintext
55 lines
1.7 KiB
Plaintext
|
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" ;
|