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 ; dbg" swine.com" s" swine.com" s" Swine Meeper - A fun freeware puzzler. Find all the truffles!" defembed swine.com dbg" dirtrect.com" s" dirtrect.com" s" Dirty Rectangles - A simple textmode graphics demo" defembed dirtrect.com dbg" kpshrink4.kps" s" kpshrink4.kps" s" KP Shrinker 4.0 - Compressor and decompressor for KPS files\Requires an earlier version of PK Shrinker to extract." 59943 deffake kpshrink4.kps dbg" mazecr3d.kps" s" mazecr3d.kps" 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 : rick-filelist (( kpshrink4.kps yield dirtrect.com yield mazecr3d.kps yield swine.com yield )) ; : xmit-desc ( st -- ) chars (( each i [ key \ lit ] = if nl else pass then next )) xmit-iter ; array numstr 7 allot key 0 const $0 : char>> ( st ch -- st+1 ) over b! 1+ ; : digit>> ( st state n div -- st state n ) /mod swap dup if ( st state n digit ) $0 + >r > ( state n st ) > >rot then then ; : nsep>> ( st state n -- st state n ) over if > >rot then ; : n>st ( n -- st ) numstr 0 > 1000 digit>> nsep>> 100 digit>> 10 digit>> swap drop $0 + char>> 0 char>> drop numstr ; : 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 ; : inputch readch tolower dup emit nl ; : download-file ( file -- ) write-file ; ( todo: more elaborate ) : 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 rick-filelist nth lblue fg! x" Downloading " dup filename xmit l" ..." download-file l" Done!" ' rick-menu return then drop lred fg! l" Sorry, that is not a valid selection." ' select-file ; : rick-files nl rick-filelist list-files ' select-file ; :noname ( -- cp ) nl rick-menu-rle xmit-screen nl 0 begin yellow fg! black bg! nl x" Your selection: " inputch 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! sp [ pagew 3 * lit ] repeated xmit-iter rick-welcome-rle xmit-screen login ' rick-menu begin execute dup not until ;