# Adventure 350. A-code conversion copyleft Mike Arnautov, 2020
#
# Procedures.
#
proc is.it.dark?
  local was.dark
  ifflag status, light.here
    unflag status, light.here
  else
    set was.dark, 1
  fin
  ifnear lamp, switched.on
    or
  ifflag here, lit
    flag status, light.here
  else
    ifflag status, moved  # A move to a dark location
      and
    ifeq was.dark, 1      # From a dark location
      and
    chance 35             # Play may fall into a pit!
      say crunch
      call coroner
    fin
  fin
#
#====================================================================
#
proc describe.here
  local locno, obj.ptr
  local loccnt, objcnt, the.it
#
  ifflag status, light.here
#
# Emulate the original's handling of long/short description display.
#
    ifne abnum, 0
      set locno, here
      sub locno, locbase
      add locno, abbase
      eval loccnt, locno
      add loccnt, 1
      ifeq loccnt, abnum
        unflag here, been.here  # Force long description
        set loccnt, 0
      fin
      deposit locno, loccnt
    fin
#
# Show the appropriate description
#
    ifflag here, been.here
      say here
    else
      describe here
      flag here, been.here
    fin
    ifat east.pit.end, west.pit.end
      say plant.2
    fin
#
  ifhave bear
    say bear.tags.along
  fin
#
# Firstly, list any features (non-portable objects), while marking
# any non-NPCs as seen.
#
    itobj obj.ptr, here
      ifinrange obj.ptr, dwarf0, pirate
      else
        flag obj.ptr, seen
      fin
      ifflag obj.ptr, portable
      else
        say obj.ptr
      fin
    fin
#
# Secondly, describe non-valued portable objects
#
    itobj obj.ptr, here, portable
      ifflag obj.ptr, valued
        or
      ifflag obj.ptr, faked     # Happens in the repository!
      else
        flag obj.ptr, seen
        say obj.ptr
        set the.it, obj.ptr
        add objcnt, 1
      fin
    fin
# 
# Finally, describe treasures
#
    itobj obj.ptr, here, valued
      say obj.ptr
        set the.it, obj.ptr
        add objcnt, 1
    fin
  else
    say it.is.now.dark
  fin
  ifeq objcnt, 1
    set it, the.it
  fin
#
#====================================================================
#
proc coroner
  local obj.ptr
  add death.count, 1
  ifeq stage, adventuring
    ifeq context, none
      say you.are.dead, death.count
      call cgiquery, blank, q.resurrect, 0
    fin
    set context, 0
    ifeq qreply, 1
      itobj obj.ptr, inhand
        drop obj.ptr
      fin
      goto house
      ifhave lamp
        apport lamp, road
        set lamp, switched.off
      fin
      unflag house, been.here
      quip resurrection
    fin
  otherwise
  iflt stage, victory!
#
# Player died during closing time -- kick him out.
#
    say dead.&.closed
  fin
#
# Triumph!
#
  set score.text, 1
  call finis
#
#====================================================================
#
proc get.score
  local obj.ptr
  set scorex, 0
#
# Initial exlporation bonus.
#
  ifflag axe, seen
    add scorex, 25    # Met the first dwarf
  fin
#
# Now score for finding and collecting treasures.
#
  itobj obj.ptr, valued
    ifflag obj.ptr, seen
      add scorex, 2   # Found the treasure
    fin
    ifloc obj.ptr, house  # Tot up treasures collected ni the house
      add scorex, 10      # Base reward
      ifinrange obj.ptr chest, chain
        ifis obj.ptr, chest
          add scorex, 2   # Chest gets 2 points more
        else
          add scorex, 4   # Everything after the chest gets extra 4 points
        fin
      fin
    fin
  fin
#
# Extra points game ending, rather than player quitting.
#
  ifany score, quit
  else
    add scorex, 4     # Points for game ending.
  fin
#
# Deaths penalty.
#
  add scorex, 30
  set j, numdie
  multiply j, 10
  sub scorex, j
#
# Another bonus for cave closure.
#
  ifgt stage, 0
    add scorex, 25
#
# Extra points for the repository exit, depending on it nature.
#
    ifeq blew.it, 0   # Didn't blow it
      add scorex, 10
    otherwise
    ifeq blew.it, 3   # Lava flows
      add scorex, 25
    otherwise
    ifeq blew.it, 2   # Lava flows
      add scorex, 30
    otherwise
    ifeq blew.it, 1   # Triumph!
      add scorex, 45
    fin
  fin
#
# The Last Lousy Point!
#
  ifloc magazines, witts.end
    add scorex, 1
  fin
#
# Subtract any accumulated hint penalties.
#
  sub scorex, penalties
#
# And 2 freebie points, just to round it up!
#
  add scorex, 2
#
#====================================================================
#
proc finis
  call get.score
  iflt scorex 35
    set rank, 0
    set j, 35
  otherwise
  iflt scorex 100
    set rank, 1
    set j, 100
  otherwise
  iflt scorex 130
    set rank, 2
    set j, 130
  otherwise
  iflt scorex 200
    set rank, 3
    set j, 200
  otherwise
  iflt scorex 250
    set rank, 4
    set j, 250
  otherwise
  iflt scorex 300
    set rank, 5
    set j, 300
  otherwise
  iflt scorex 330
    set rank, 6
    set j, 330
  otherwise
  iflt scorex 350
    set rank, 7
    set j, 350
  else
    set rank, 8
  fin
  say score.text, scorex 
  ifgt score.text, 0
    and
  iflt scorex, 350
    say rank
    say blank
    sub j, scorex
    say "To achieve the next higher ranking, you need $ more point[//s].", j
  fin
  stop
#
#====================================================================
#
proc bailout
  flush
  ifinrange arg1, east, down
    quip no.can.go
  fin
  respond in, out, in.from.out
  respond forward, left, right, need.a.direction
  respond crawl, which.way?
  respond crawl, which.way?
  respond xyzzy, plugh, fee, fie, foe, foo, fum, nothing.happens
  respond north, ne, east, se, south, sw, west, nw, up, down, no.can.go
  respond find, find.it.yourself
  respond in, out, in.from.out
  respond left, right, need.a.direction
  respond blast, need.dynamite
  ifkey cave
    ifinrange here, road, slit
      quip try.following.stream
    fin
    quip need.more.detail
  fin
  ifeq status, 1
    ifflag arg1, object
      ifnear arg1
        flag status, pls.clarify
        quip need.verb, arg1
      fin
      quip i.dont.see, arg1
    else
      flag status, pls.clarify
      quip need.object, arg1
    fin
  else
    ifnear arg2
    else
      quip i.dont.see, arg2
    fin
  fin
  ifany road, hill, forest, valley cobbles, giant, view, pit
    or
  ifany hall, barren, debris, hole, broken, y2, slit, slab, depression
    or
  ifany entrance, secret, plover, oriental, cavern, shell reservoir, fork
    quip dont.know.the.way
  fin
  respond carry, you.have.it
  respond drop, you.arent.carrying
  respond lock, unlock, donno.hao.2
  respond light, extinguish, no.light.here
  respond wave, nothing.happens
  respond calm, i.am.game
  respond walk, where?
  respond eat, attack, hah!
  respond pour, throw, you.arent.carrying
  respond drink, slurp
  respond rub, you.rub.lamp
  respond find, inventory, find.it.yourself
  respond feed, no.food
  respond fill, cant.fill.that
  respond feed, dunno.how
  respond brief, on.what?
  respond break, no.can.fix
  respond wake, hah!
#
#====================================================================
#
proc cross.chasm.to, target
  ifne chasm, 0
    ifkey jump
      say didnt.make.it
      call coroner
    fin
    quip no.bridge
  fin
  respond jump, try.the.bridge
  ifhere troll, 
    ifeq troll, wants.treasure
      quip troll.blocks.way
    otherwise
    ifeq troll, will.be.back
      set troll, wants.treasure
      quip troll.comes
    otherwise
    ifeq troll, bought.off
      set troll, will.be.back
    fin
  fin
  ifhave bear
    set chasm, 1
    say bear.wrecks.bridge
    apport troll, ylem
    apport bear, ylem
    apport spices, ylem
    call coroner
  fin
  move target
#
#====================================================================
#
proc foo.stuff, state
  ifeq stage, in.repository
    quip nothing.happens
  fin
  ifeq foobar, state
    add foobar, 1
    ifeq foobar, 4
      set foobar, 0
      ifnear eggs
        ifat giant.room
          say nothing.happens
        else
          say "The nest of golden eggs has vanished!"
        fin
      else
        say "Done!"
      fin
      apport eggs, giant.room
      ifeq troll, bought.off       # If stealing aggs from troll before
        set troll, wants.treasure  # crossing, bring him back.
      fin
      quit
    fin
    quip ok
  fin
  ifeq foobar, 0
    quip nothing.happens
  fin
  set foobar, 0
  quip cant.you.read?
#
#====================================================================
#
proc water.plant
  set bottle, full.of.air
  ifeq plant, stunted
    set plant, grown
    quip growth.from, stunted
  otherwise
  ifeq plant, grown
    set plant, gigantic
    quip growth.from, grown
  otherwise
  ifeq plant, gigantic
    set plant, stunted
    say growth.from, gigantic
    quip plant
  fin
#
#====================================================================
#
proc water.door
  set door, rusty
  set bottle, full.of.air
  quip hinges.rust
#
#====================================================================
#
proc oil.door
  set door, oiled
  set bottle, full.of.air
  quip door.now.oiled
#
#====================================================================
#
proc plover.check, target
  local obj.ptr
  itobj obj.ptr, inhand
    ifis obj.ptr, emerald
    else
      quip something.doesnt.fit
    fin
  fin
  move target
#
#==================================================================
#
proc wiz.reports
   proceed        # Stub routine for debug mode.
#
#====================================================================
#
proc cgiquery q, qid, qcomsav
  ifeq qcomsav, 1
    save command
  fin
  set context, qid
  quip q
#
#====================================================================
#
proc hintquery q, qid, qp
  ifflag hints, qid
    proceed
  fin
  set hint.text, q
  set hint.cost, qp
  set hint.id, qid
  set context, qid
  quip hint.text, 0
#
#=====================================================================
#
proc cave.closure
  local obj.ptr
  ifeq stage, adventuring
    set clock, 50
    set stage, exits.barred
    iterate obj.ptr, dwarf0, pirate
      apport obj.ptr, ylem
    fin
    say closing.soon
  otherwise
  ifeq stage, exits.barred
    set stage, in.repository
    itobj obj.ptr, inhand
      apport obj.ptr, ylem
    fin
    itobj obj.ptr, portable
      flag obj.ptr, faked  # So that we can fiddle them in repository!
    fin
    set bird, caged
    apport mirror ne.repository
    smove ne.repository, cave.now.closed
  fin
#
#=====================================================================
#
proc zap.bird, info
  apport bird, ylem
  ifloc snake, mtking
    apport jewelry, ylem
  fin
  quip info
  
#
#=====================================================================
#
proc fiddle.rod
  ifany drop, throw, wave
    ifhave dynamite
      and
      not
    ifhave rod
      fakearg rod, dynamite
    fin
  otherwise
  ifat sw.repository
    or
  ifhere dynamite
    and
    not
  ifhere rod
    fakearg rod, dynamite
  fin
#
#=====================================================================
#
proc offer.hint?
  ifeq context, 0
    ifneedcmd
      proceed
    fin
    ifat depression
      and
    ifeq grate, locked
      and
      not
    ifhave keys
      add grate.turns, 1
      ifeq grate.turns, 4
        set grate.turns, 0
        call hintquery, cant.get.in?, q.grate, 2
      fin
    otherwise
    ifflag here, in.maze
      and
      not
    ifhere dwarf
      add maze.turns, 1
      ifeq maze.turns, 75
        set maze.turns, 0
        call hintquery, hint.maze?, q.maze, 4
      fin
    otherwise
    ifat alcove, plover, dark
      and
      not
    ifflag pyramid, seen
      add plover.turns, 1
      ifeq plover.turns, 25
        set plover.turns, 0
        call hintquery, hint.plover?, q.plover, 5
      fin
    otherwise
    ifat mtking
      and
    ifhere snake
      add snake.turns, 1
      ifeq snake.turns, 8
        set plover.turns, 0
        call hintquery, get.past.snake?, q.snake, 2
      fin
    otherwise
    ifat witts.end
      add witts.turns, 1
      ifeq witts.turns, 20
        set witts.turns, 0
        call hintquery, hint.witts?, q.witts, 3
      fin
    otherwise
    ifat bird.chamber
      and
      not
    ifnear bird
      add bird.turns, 1
      ifeq bird.turns, 5
        set bird.turns, 0
        call hintquery, bird.hint?, q.hint, 2
      fin
    otherwise
    ifeq stage, in.repository
      and
    ifkey read
      and
    ifnear oyster
      call hintquery, oyster.hint, q.oyster, 10
    fin
  fin
#
#=====================================================================
#
proc do.hint
  ifeq qreply, 1
    say hint.text, 1
    add penalties, hint.cost
  else
    say ok
  fin
  flag hints, hint.id     # Don't repeat this hint offer in either case
#
#=====================================================================
#
proc fudge.default.save.name, act
  local tmp
  fakecom act, .default   # Replace arg1 (the actual command) with .defualt
  exec 10, act            # Make arg2 to contain the actual command
  set status, 2           # Pretend there a name was given
  exec 29, tmp            # Swap the command words
#
#=====================================================================
#
proc handle.query
  local qtype
  input               # Yes/no  (and maybe quit) answer expected
  unflag context, prompted
  set qtype, context
  ifeq status, 0
    set qreply, -1    # No answer, possibly default
  otherwise
  ifkey yes
    set qreply, 1     # Yes
  otherwise
  ifkey  quit
    set qreply 2
  otherwise
  ifany n, no, quit
    set qreply, 0     # No (note, N is generally NORTH, not NO)
  else
    quip "Please answer the question."
  fin
  restore command     # Restore the command that prompted the context query
#
# Now deal with individual queries. If possible, we just call the code
# that made the query -- it will know to deal with the answer.
#
  ifeq qtype, q.intro
    set context, none
    ifeq qreply, 1
      say intro
      add penalties, 5
      set lamplife, 1000    # Be kind to novices (ha!)
    fin
    describe here
  fin
#
# This one is issued by hintquery, saying it will cost you -- are you sure?
#
  ifeq qtype, q.hint
    call do.hint
  fin
#
# These are spontaneous hint prompts resulting in hintquery calls.
#
  ifinrange qtype, q.bird, q.witts
    ifeq qreply, 1
      say hint.will.cost.you, hint.cost
      set context, q.hint
      quip wanna.hint?
    fin
    proceed
  fin
#
# This one only happens in the repository, after oyster writing noted.
#
  ifeq qtype q.oyster
    ifeq qreply, 1
      proceed
    else
      set context, none
      quip ok
    fin
  fin
#
# Answers to the remaining queries are handled by the appropriate code.
#
  ifeq qtype, q.quit
    call quit
  fin
#
  ifeq qtype q.kill.dragon
    call arg1
  fin
#
  ifeq qtype, q.resurrect
     call coroner
  fin
#
######################################################################
