pete286/footer.jor

( F O O T E R )
var footer-y
0 footer-y !

: draw-footer footer-y @ split-screen ;

0 const BLACK
1 const BLUE
2 const GREEN
3 const CYAN
4 const RED
5 const MAGENTA
6 const BROWN
7 const LGRAY
8 const DGRAY
9 const LBLUE
10 const LGREEN
11 const LCYAN
12 const PINK
13 const LMAGENTA
14 const YELLOW
15 const WHITE

var text-color
WHITE text-color !
: textxy ( s x y ) <rot text-color @ text ;
: portraity 1 swap textxy ;
: statusy 6 swap textxy ;

var textx
var texty
2 const textspeed
var textleft
: textleftsay 6 textleft ! ;
: textleftchoice 8 textleft ! ;

: nltext textleft @ textx ! 10 texty +! ;
: inctextx
  textx @ 1 + dup 38 <= if textx !
  else drop nltext inctextx then ;

key \ const '\'
: statusc
  dup dup '\' = swap '\n' = or if drop nltext
  else dup '\r' = if drop
  else inctextx textx @ texty @ <rot text-color @ textc then then ;

var texttimer
: textnextc ( s -- s )
  dup b@ dup if statusc 1 + else drop then ;

: slowtext ( s -- )
  texttimer now!
  begin dup b@ while
    texttimer advance! textspeed * 0 for textnextc next
  suspend repeat drop ;

: clear
  text-color @
  WHITE text-color !
  s"                                  " dup dup 10 statusy 20 statusy 30 statusy
  text-color !
  textleft @ textx !
  10 texty ! ;

: show-footer 48 10 footer-y move-to ;
: hide-footer 0 10 footer-y move-to ;

: footer-wait show-footer ^ENTER wait-key ;

: say ( s -- ) textleftsay clear show-footer slowtext footer-wait ;
: say" [ ' s" , ] ' say expile ; immediate

defer choosegen
var ichoose
var cchoose
: countchoosegen ( -- )
  0 choosegen each drop drop 1 + more cchoose ! ;

: getchoice ( -- s cp )
  0 choosegen
  each <rot dup ichoose @ < if 1 + >rot drop drop else drop break then more ;

: canchooseleft ichoose @ 0 > ;
: canchooseright ichoose @ cchoose @ 1 - < ;

: displaychoice
  clear
  canchooseleft if s" <" 6 20 textxy then
  canchooseright if s" >" 38 20 textxy then
  getchoice drop slowtext ;

: navchoice ( -- done )
  0 begin suspend
    ^LEFT key-pressed canchooseleft and if drop 1 -1 ichoose +! then
    ^RIGHT key-pressed canchooseright and if drop 1 1 ichoose +! then
    ^ENTER key-pressed if drop 2 then
  dup until 1 - ;

: choose ( gen -- )
  ' choosegen redefine countchoosegen 0 ichoose !
  textleftchoice clear show-footer
  begin displaychoice navchoice until
  getchoice swap drop execute ;

: character ( iportrait color ) create , ,
  does> dup @ text-color ! cell + @ draw-portrait ;

0 GREEN character pete
1 MAGENTA character mary
2 BROWN character chuck
3 YELLOW character jeanne
4 LGRAY character phone

: noone WHITE text-color ! s"     " dup dup dup
  8 portraity 16 portraity 24 portraity 32 portraity ;