add user choice of dialogue selection

This commit is contained in:
Jeremy Penner 2019-05-16 22:25:13 -04:00
parent 3da93a2eb0
commit a9dfc15130
6 changed files with 49 additions and 6 deletions

View file

@ -58,3 +58,5 @@ array frames
14 defsingle {chair} 14 defsingle {chair}
15 defsingle {pete-bed} 15 defsingle {pete-bed}
16 defsingle {horse} 16 defsingle {horse}
17 defsingle {mary}
18 defsingle {phone}

View file

@ -25,13 +25,16 @@ var text-color
WHITE text-color ! WHITE text-color !
: textxy ( s x y ) <rot text-color @ text ; : textxy ( s x y ) <rot text-color @ text ;
: portraity 1 swap textxy ; : portraity 1 swap textxy ;
: statusy 7 swap textxy ; : statusy 6 swap textxy ;
var textx var textx
var texty var texty
2 const textspeed 2 const textspeed
var textleft
: textleftsay 6 textleft ! ;
: textleftchoice 8 textleft ! ;
: nltext 6 textx ! 10 texty +! ; : nltext textleft @ textx ! 10 texty +! ;
: inctextx : inctextx
textx @ 1 + dup 38 <= if textx ! textx @ 1 + dup 38 <= if textx !
else drop nltext inctextx then ; else drop nltext inctextx then ;
@ -57,7 +60,7 @@ var texttimer
WHITE text-color ! WHITE text-color !
s" " dup dup 10 statusy 20 statusy 30 statusy s" " dup dup 10 statusy 20 statusy 30 statusy
text-color ! text-color !
6 textx ! textleft @ textx !
10 texty ! ; 10 texty ! ;
: show-footer 48 10 footer-y move-to ; : show-footer 48 10 footer-y move-to ;
@ -65,9 +68,41 @@ var texttimer
: footer-wait show-footer ^ENTER wait-key ; : footer-wait show-footer ^ENTER wait-key ;
: say ( s -- ) clear show-footer slowtext footer-wait ; : say ( s -- ) textleftsay clear show-footer slowtext footer-wait ;
: say" [ ' s" , ] ' say expile ; immediate : 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 , , : character ( iportrait color ) create , ,
does> dup @ text-color ! cell + @ draw-portrait ; does> dup @ text-color ! cell + @ draw-portrait ;
@ -75,6 +110,7 @@ var texttimer
1 MAGENTA character mary 1 MAGENTA character mary
2 BROWN character chuck 2 BROWN character chuck
3 YELLOW character jeanne 3 YELLOW character jeanne
4 LGRAY character phone
: noone WHITE text-color ! s" " dup dup dup : noone WHITE text-color ! s" " dup dup dup
8 portraity 16 portraity 24 portraity 32 portraity ; 8 portraity 16 portraity 24 portraity 32 portraity ;

BIN
game.prj

Binary file not shown.

View file

@ -3,15 +3,20 @@
16 5 N ' {pete-table} defentity table 16 5 N ' {pete-table} defentity table
15 5 N ' {chair} defentity chair 15 5 N ' {chair} defentity chair
7 6 N ' {pete-bed} defentity bed 7 6 N ' {pete-bed} defentity bed
10 9 N ' {phone} defentity e_phone
table :touch pete say" Yesterday's breakfast is still\on the table." table :touch pete say" Yesterday's breakfast is still\on the table."
say" Maybe the day before's too." ;entity say" Maybe the day before's too." ;entity
chair :touch pete say" I've had my morning coffee\already." ;entity chair :touch pete say" I've had my morning coffee\already." ;entity
bed :touch pete say" I'm not tired yet." ;entity bed :touch pete say" I'm not tired yet." ;entity
e_phone :touch phone
:| s" [don't pick up]" :| pete say" Hmm... no answer." |; yield
s" Hey Pete, what's up?" :| pete say" Not much, old friend!" |; yield
done |; choose ;entity
:noname :noname
reset-level reset-level
:| table yield chair yield bed yield done |; ' entities redefine :| table yield chair yield bed yield e_phone yield done |; ' entities redefine
:| :|
touch-begin 16 10 2= dup if touch-begin 16 10 2= dup if
player move-entity 12 8 pete.jor queue-level player move-entity 12 8 pete.jor queue-level

Binary file not shown.

Binary file not shown.