dialer/rick.jrt

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 <rot <r char>> ( state n st )
    <rot drop 1 <rot
  else drop over if <rot $0 char>> >rot then then ;
: nsep>> ( st state n -- st state n )
  over if <rot [ key , lit ] char>> >rot then ;
: n>st ( n -- st )
  numstr 0 <rot 
  10000 digit>> 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 ;