##########################################################################
#
#
# Little girl in the big world. An Interactive Fiction story file.
# Designed to be compiled and run with StoryFactory.
#
# Written and declared public domain by Peter Wendrich 2003.
#
#
##########################################################################
#
# Main file
#
##########################################################################

title Little girl in the big world



##########################################################################
#
#
# General game information
#
#
##########################################################################

#
# Master object
#
object objectWorld {
}

#
# location where non active objects are placed
object objectVoid {
  location: objectWorld
}

#
# What is in the name of the game?
#
sub printGameName {
  ` little girl in the big world '
}

#
# Startup message
#
sub _startup_message {
  ^
  printGameName ^
  an interactive fiction story by Peter Wendrich . ^
  game , compiler and runtime engine written for the IF-Competition-2003 . ^
  email to pwsoft@syntiac.com or on the web http://www.syntiac.com ^
  ^
  type ` about ' if you want information from the online manual .
  type ` hint ' if you want support from the hint system ( recommended for new players ) .
  ^
}

define START_OF_NAME 3

define ALICE_sleepOnBed         0
define ALICE_sitOnBed           1
define ALICE_standingInRoom     2
define ALICE_standingByDoor     3
define ALICE_openDrawerBed      4
define ALICE_standingOnBed      5
define ALICE_standingOnGreenBox 6
define ALICE_standingOnCage     7


define ALICE_playDollhouse     20


##########################################################################
#
#
# Story progress
#
#
##########################################################################

vars {
# score
  $naughtyScore
  $entertainmentScore
  $educationScore


# hint system
  $hintIntro
  $hintHelp

# game basics
  $hint_look
  $hint_done_examine_me
  $hint_done_examine_alice

# wakeup
  $hintWakeupAlice
  $hintPushSomething
  $hintExamineTable
  $hintTurnOnAlarm

# goal hints
  $flagExaminedDollhouse
  $hintFindDolls

# goals
  $goalAliceFindsDolls
  $goalAlicePlayWithDollhouse
  $goalAlicePlayWithPlayer
  $goalPutOnUnderwear
  $goalPutOnDress
  $goalJumpOnBed

# other activities
  $goalPlayWithTeddy
  $goalPlayWithDoor

# auto help
  $auto_too_heavy

# story logic
  $aliceMode
  $wakeupTry
}

sub _hintName {
  the magic-helping-claw (tm) hint system
}

sub _hint {
  /get $hintIntro /nif
    dear player , ^ ^
    this is _hintName , which can be activated by typing ` hint ' . it can be used when you are stuck in the game or need a new idea to try . ^ ^
    this hint system adapts itself and will try to only give the hints relevant for the current situation in the game .
    the hints will be given in small amounts , so typing ` hint ' repeatedly will reveal more and more details .  ^ ^
    the game will also automatically give some playing tips along the way , which can be recognised by being printed between square brackets [ like this ] . ^
    /1 /to $hintIntro
    /ret
  /then
  /get $hint_look /nif
    /1 /to $hint_look
    try typing ` look ' or ` look around ' to know where you are in the game . ^
    /ret
  /then
  /get $hint_look /1 /eqif
    /2 /to $hint_look
    after looking around in the room the ` look at ' or ` examine ' commands can be used to closer inspect a certain object , for example ` I look at little girl ' .
    because looking and examining is done often , `l' can be used instead of look and `x' is a shortcut for examine . ^
    /ret
  /then
  /get $aliceMode &ALICE_sleepOnBed /eqif
    /get $hintWakeupAlice /nif
      /1 /to $hintWakeupAlice
      try to wake up the little girl called Alice .
      /ret
    /then
    /get $hintPushSomething /nif
      /1 /to $hintPushSomething
      maybe you can push something to make noise .
      /ret
    /then
    /get $hintExamineTable /nif
      /1 /to $hintExamineTable
      did you look on the table next to the bed ?
      /ret
    /then
    /get $hintTurnOnAlarm /nif
      /1 /to $hintTurnOnAlarm
      use the *alarm* clock on the table !
      /ret
    /then
    push , pull or move the alarm clock on the table .
    /ret
  /then
  /get $goalAliceFindsDolls /nif
    /get $flagExaminedDollhouse /if
      /get $hintFindDolls /nif
        /1 /to $hintFindDolls
        maybe you can help finding the dolls for the dollhouse .
        /ret
      /then
    /else
      &objectPlayer _findRoom &objectAliceBedroom /eqif
        did you look at the dollhouse in the corner ?
        /ret
      /then
    /then
  /then
  /get $hintHelp /nif
    /1 /to $hintHelp
    typing help or about will access the online manual . 
    /ret
  /then
  apparently _hintName has run out of ideas for the current situation . ^
}

sub _tooHeavy {
  you are not strong enough .
  /get $auto_too_heavy /nif
    ^ [ you might ask Alice to do it for you . ]
    /1 /to $auto_too_heavy
  /then
}

#define ALICE_standingInRoom     2
#define ALICE_standingByDoor     3

# new mode
sub changeMode {
  /dup /get $aliceMode /neqif
    Alice

# process old state
    /get $aliceMode &ALICE_openDrawerBed /eqif
      stands up and
    /then
    /get $aliceMode &ALICE_sitOnBed /eqif
      &objectAlice /dup _findRoom /swap [+1] /store
      stands up from the bed and
    /then

# change to new state
    /dup &ALICE_sitOnBed /eqif
      /get $aliceMode &ALICE_sleepOnBed /eqif
        wakes up , blinks a few times with her eyes and sits up in bed .
      /else
        /get $aliceMode &ALICE_openDrawerBed /eqif
          sits down on the bed .
        /else
          walks to the bed and sits down .
        /then
      /then
    /then
    /dup &ALICE_standingInRoom /eqif
        walks across the room . ^
    /then
    /dup &ALICE_standingByDoor /eqif
        walks to the door . ^
    /then
    /dup &ALICE_openDrawerBed /eqif
      /get $aliceMode &ALICE_sitOnBed /neqif
        walks to the bed and
      /then
      sits on the floor next to the bed . ^
    /then
    /dup &ALICE_standingOnBed /eqif
      climbs on the bed . ^
    /then
    /dup &ALICE_standingOnGreenBox /eqif
      while climbing on the box , she says , `` I hope it holds . ''
    /then
    /dup &ALICE_standingOnCage /eqif
      climbs on the cage .
    /then

# store new mode
    /to $aliceMode
  /else
     /drop
  /then
}

sub pointPoints {
  /1 /eqif
    point
  /else
    points
  /then
}

sub printScores {
  total /get $naughtyScore /dup /dot naughty pointPoints , /get $entertainmentScore /dup /dot entertainment pointPoints and /get $educationScore /dup /dot education pointPoints .
}

sub naughtyScore {
  /get $naughtyScore [+1] /to $naughtyScore
  ^ ^ you earnt one naughty-point .
}

sub entertainmentScore {
  /get $entertainmentScore [+1] /to $entertainmentScore
  ^ ^ you earnt one entertainment point .
}

sub educationScore {
  /get $educationScore [+1] /to $educationScore
  ^ ^ you earnt one education point .
}


##########################################################################
#
#
# Master tables and support routines
#
#
##########################################################################

#
# parse results
#
vars {
  $actor
  $verb
  $action
  $noun
  $second
  $assume

  $parsepos
}

sub isActorAlice {
  /get $actor &objectAlice /eqif
    /tret
  /then
  /fret
}

sub isActorPlayer {
  /get $actor &objectPlayer /eqif
    /tret
  /then
  /fret
}

#
# ( object -- roomobject ; Find room where object is located )
sub _findRoom {
  # process 'worn' objects (Alice clothing)
  /dup [+2] /fetch /if [+2] /fetch /then

  # room is just below world-object. So keep going up until next up
  # equals objectWorld. Now we have the room object
  /do /dup [+1] /fetch &objectWorld /neqwhile [+1] /fetch /loop
}

#
# table
#   item , routine
#
# inputs
#   item to search
#   table addr
# outputs
#   flag
#
sub _switchTable {
  /do
    /dup /fetch /lit /ret /neqwhile
    /over /over /fetch /eqif
      /swap /drop [+1] /fetch /execute
      /tret
    /then
    [+2]
  /loop
  /drop /drop /0
}

vars {
  $showExits
}
sub _exits {
  /get $showExits /if
    ^ ^
    obvious exits : ^
    /0 /to $showExits
  /then
}

# inputs
#   addr_of_parent
# outputs
#   -
#
sub _look_child {
  &objectWorld /do
    /dup /0 /neqwhile
    # check if object is child of parent
    /over /over [+1] /fetch /eqif
      /dup [+3] /fetch /dup /if &look /swap /execute /then /drop
    /then
    /fetch
  /loop /drop /drop
}


include girlwrld_alice_bedroom.story

include girlwrld_garden.story

include girlwrld_hall_gnd.story
include girlwrld_living_room.story
include girlwrld_kitchen.story

include girlwrld_hall_1st.story
include girlwrld_master_bedroom.story

include girlwrld_attic.story

include girlwrld_doors.story
include girlwrld_about.story


#
# choose player as default actor
#
# input
#   --
# output
#   --
#
sub _assumePlayer {
  /get $actor /nif
    &objectPlayer /to $actor
    &objectPlayer /to $assume
#    [ I will /dup [-1] /execute ] ^
  /then
}

#
# ( -- ; choose Alice as default actor if possible )
sub _assumeAlice {
  /get $actor /nif
    /get $aliceMode /nif
# !!! test if Alice is in same room
      _assumePlayer
    /else
#      [ asking Alice to /dup [-1] /execute ] ^
      &objectAlice /to $actor
      &objectAlice /to $assume
    /then
  /then
}

sub displayNounName {
  /get $noun /if
    /get $noun [+3] /fetch /dup /if
      &name /swap /execute /drop
    /else
      /drop
    /then
  /then
}

sub displaySecondNounName {
  /get $second /if
    /get $second [+3] /fetch /dup /if
      &name /swap /execute /drop
    /else
      /drop
    /then
  /then
}

sub displayAssume {
  /get $assume &objectPlayer /eqif
    [ I will
    isActorAlice /if
      ask Alice to
    /then
  /else
    [ asking Alice to
  /then
  /get $verb &n       /eqif go north /get $noun /if using /then /then
  /get $verb &e       /eqif go east /get $noun /if using /then /then
  /get $verb &s       /eqif go south /get $noun /if using /then /then
  /get $verb &w       /eqif go west /get $noun /if using /then /then
  /get $verb &u       /eqif go up /get $noun /if using /then /then
  /get $verb &d       /eqif go down /get $noun /if using /then /then

  /get $verb &bite    /eqif bite /then
  /get $verb &climbon /eqif climb on /then
  /get $verb &close   /eqif close /then
  /get $verb &drop    /eqif drop /then
  /get $verb &enter   /eqif enter /then
  /get $verb &examine /eqif examine /then
  /get $verb &fill    /eqif fill /then
  /get $verb &get     /eqif get /then
  /get $verb &jump    /eqif jump /then
  /get $verb &jumpon  /eqif jump on /then
  /get $verb &kiss    /eqif kiss /then
  /get $verb &look    /eqif look around /then
  /get $verb &lookin  /eqif look in /then
  /get $verb &move    /eqif move /then
  /get $verb &nibble  /eqif nibble /then
  /get $verb &open    /eqif open /then
  /get $verb &play    /eqif play with /then
  /get $verb &plug    /eqif plug in /then
  /get $verb &pull    /eqif pull /then
  /get $verb &push    /eqif push /then
  /get $verb &put     /eqif put /then
  /get $verb &putxin  /eqif put /then
#  /get $verb &puton   /eqif put on /then
  /get $verb &putxon  /eqif put /then
#  /get $verb &standon /eqif stand on /then
  /get $verb &tell    /eqif tell about /then
  /get $verb &turnoff /eqif turn off /then
  /get $verb &turnon  /eqif turn on /then
  /get $verb &undress /eqif undress /then
  /get $verb &wake    /eqif wake up /then
  /get $verb &watch   /eqif watch /then

  displayNounName
  /get $verb &putxin  /eqif in /then
  /get $verb &putxon  /eqif on /then
  displaySecondNounName

  ] ^
}

#
# input
#   parsepos
#   object name array
# output
#   new parsepos
#   ptr to end of object name/alias array
#
sub _matchObject {
  /do
    /dup /fetch /lit /ret /neqwhile
    /over /fetch /over /fetch /eqif      
      /swap [+1] /swap
    /then
    [+1]
  /loop
}

vars {
  $actorRoom
  $matchScore
  $matchObject
  $matchCount
}

#
# find object(s) with specified names
#
# input
#   parsepos
# output
#   new parsepos
#
sub findObject {
  /0 /to $matchObject
  /0 /to $matchCount
  /dup /to $matchScore
  /get $actor _findRoom /to $actorRoom

  # match initial 'the'
  /dup /fetch &the /eqif [+1] /then

  &objectWorld /fetch /do
    /dup /0 /neqwhile
    /dup _findRoom /get $actorRoom /eqif
      /over /over [+3] _matchObject /drop
      /dup /get $matchScore [>] /if
        /to $matchScore
        /dup /to $matchObject
        /1 /to $matchCount
      /else        
        /dup /get $matchScore /eq /if
          /get $matchCount /if
            /to $matchScore
            /dup /to $matchObject
            /get $matchCount [+1] /to $matchCount
          /else
            /drop
          /then
        /else
          /drop
        /then
      /then
    /then
    /fetch
  /loop /drop /drop /get $matchScore
}


sub _nonoun {
  /get $noun /nif
    /get $actor /to $noun
  /then
}

#
# find noun with specified name
#
# input
#   parsepos
# output
#   new parsepos
#
sub findNoun {
  findObject
  /get $matchObject /to $noun
}

#
# find second-noun with specified name
#
# input
#   parsepos
# output
#   new parsepos
#
sub findSecond {
  findObject
  /get $matchObject /to $second
}

#
# display all object within the room of the player
#sub _allobjects {
#  _assumePlayer
#  _findObject
#}

include girlwrld_verbs.story


sub defaultCompassAction {
  isActorAlice /if
    `` I can't go that way. '', says Alice .
  /else
    you can't go that way .
  /then
}

#
# Make sure actor is only an animate object (Player, Alice, Mom).
#
sub fixActor {
  isActorAlice /if /ret /then
  isActorPlayer /if /ret /then
  /0 /to $actor
}

sub _performAction {
  /get $assume /if
    displayAssume
  /then

  fixActor  
  /get $action /if
    /get $action /execute
    /ret
  /then
  /get $actor /if
    /get $actor [+4] /fetch /dup /if
      /get $verb /swap /execute /if
        /ret
      /then
    /else
      /drop
    /then
    /get $noun /if
      /get $noun  [+3] /fetch /dup /if
        /get $verb /swap /execute /if
          /ret
        /then
      /else
        /drop
      /then
    /then
  /else
    it didn't respond .
    /ret
  /then
#  /get $noun   /if /get $noun  [+3] /fetch /dup /if /get $verb /swap /execute /if /ret /then /else /drop /then /then

  /get $verb &u /eqif isActorAlice /if `` sorry , I can't fly '', giggles Alice . /else although strange things have happend lately , flying is not one of the skills you have mastered . /then /ret /then
  /get $verb &d /eqif defaultCompassAction /ret /then
  /get $verb &n /eqif defaultCompassAction /ret /then
  /get $verb &e /eqif defaultCompassAction /ret /then
  /get $verb &s /eqif defaultCompassAction /ret /then
  /get $verb &w /eqif defaultCompassAction /ret /then
  /get $verb &examine /eqif nothing special to note about displayNounName . /ret /then
  that didn't work .
}

#
# ( parsepos -- parsepos+1 )
sub _parsePerson {
  /dup /fetch &I /eqif
    &objectPlayer /to $actor [+1]
    /dup /fetch &, /eqif [+1] /then
    /ret
  /then
  /dup /fetch &Alice /eqif
    &objectAlice /to $actor [+1]
    /dup /fetch &, /eqif [+1] /then
    /ret
  /then
}

sub prepareNextInput {
  /0 /to $actor
  /0 /to $verb
  /0 /to $noun
  /0 /to $action
  /0 /to $second
  /0 /to $assume
}

#include girlwrld_debug.story


##########################################################################
#
#
# main entry point into the game
#
#
##########################################################################
main {
#  testAll

  _startup_message
  /do /input
    prepareNextInput

# get start of parsing buffer
    /get 2
    _parsePerson
    /dup /fetch &quit /neqwhile
    parseVerb
    
    /dup /fetch /lit /ret /neqif
      ^ confused about the ` /execute ' part . ^
    /else
      /drop
      _performAction
    /then
  /loop
}