View source for RCRPG/uBasic-4tH

== The game ==
The user starts on the bottom floor in a room with a sledge. That seems like a reasonable precaution, because all rooms are completely sealed. You have to equip a sledge every time you want to knock down a wall. If you want to make a hole in the ceiling, you not only got to have a ladder - you have to equip it too. As well as the sledge.

There is one ladder per floor. If you want to go up, there ''has'' to be a ladder in the room. If there is no ladder in the room you can't go up. If you happen to be carrying one, you have to drop it first. And you can't take it with you when you go up, ''because you're standing on it''.

Vice versa - if you want to go down, there'd better be a ladder. For the same reason you can't make holes in the floor. It's far too dangerous to jump. The outer walls are impenetrable as well.

All commands are supported - except for the ones used to name the rooms. There is even a neat "help" command and lots of short aliases. Commands can be concatenated, so a sequence like: 

<code>take ladder equip ladder equip sledge attack up up</code>

Will make you take the ladder, equip it, equip the sledge as well, tear down the ceiling and get you up to the next floor. In theory, you could solve the entire game with one (very) long command.

There are pieces of gold and sledges dispersed in the building, but there is only one Prize Room. It contains gold. Lots of it. And every game it is a different room.

== Implementation ==
[[uBasic/4tH]] has a single array of 256 elements. It can barely accommodate a building of six floors of 36 rooms. For that reason you can't "name" any rooms. There are just not enough variables to store them.

The entire room record is bitmapped and designed to fit a signed 32 bit integer:
<pre>
8 bits = #gold
8 bits = #sledge
1 bit  = ladder
1 bit  = target
6 bits = directions (udsnew)
</pre>
The "player" structure was crammed in an integer as well - but that wasn't really required. It's just neat since it makes the code much harder to understand.

This implementation really uses [[uBasic/4tH]] strengths. The <code>NAME()</code> function converts an ordinary string to a label, while <code>LINE()</code> returns true when the label has been defined. The <code>PROC</code> keyword can call a procedure directly by using an expression. 

So - in essence the user directly enters procedure names. [[uBasic/4tH]] has an intimate relation with [[Forth]], so it's no surprise that the parser closely resembles the classic [[Forth]] parser.

The entire program is about 450 lines. It could have been factored a bit better, agreed, but it feels more readable now.

== The code ==
<lang>
Dim @r(216)                            ' these are our rooms

i = Rnd(36)                            ' now place the person in a room, floor 0

For x = 0 To 215 : @r(x) = 63 : Next   ' all directions are closed
For x = 0 To 215 : @r(x) = @r(x) + (65536 * (Rnd(10) = 1)) : Next
For x = 0 To 215 : @r(x) = @r(x) + (256 * (Rnd(25) = 1)) : Next
                                       ' distribute gold and sledges
For x = 0 To 4 : r = Rnd(36) : @r((x*36) + r) = @r((x*36) + r) + 128 : Next
                                       ' place a single ladder on every floor,
@r(i) = Or(@r(i), 256)                 ' except the top floor
                                       ' give the guy a sledge
x = Rnd(216) : @r(x) = @r(x) + 64 + (65536 * (Rnd(25) + 15))
x = FUNC(_Describe (And(i, 255)))      ' set prize room and describe position

Do                                     ' go into the main command loop
  While FUNC(_Interpret(Ask("<Command> ")))
Loop

End

_Interpret                             ' interpret a command
  Param (1)
  Local (1)

  c = a@ : Print

  Do While Len(c)                      ' if it is a valid label
    If Line(Name(Set (b@, FUNC(_Token)))) Then
      Proc Name(b@)                    ' then call it
    Else                               ' otherwise not a valid command
      Print "I don't understand this \q"; Show(b@);"\q.\n"
    EndIf
  Loop
                                       ' describe the room
  If FUNC(_Describe (And(i, 255))) Then Return (1)
Return (0)

_Describe                              ' describe the room
  Param (1)                            ' clean location
  Local (3)                            ' amount of gold and sledges
                                       ' list the location
  Print "***************************"
  Print "You're on floor ";a@/36;", room ";(a@%36)/6;".";(a@%36)%6
  Print "***************************"
  Print
  Print "Directions you may proceed in:"
  Print "\t";                          ' list all valid directions

  If And(@r(a@), 63) = 63 Then Print "None";
  If And(@r(a@), 1) = 0   Then Print "West",
  If And(@r(a@), 2) = 0   Then Print "East",
  If And(@r(a@), 4) = 0   Then Print "North",
  If And(@r(a@), 8) = 0   Then Print "South",
  If And(@r(a@), 16) = 0  Then Print "Down",
  If And(@r(a@), 32) = 0  Then Print "Up",
  Print : Print

  Print "Things of interest here:"       ' list anything of interest

  b@ = And(@r(a@)/65536, 255)            ' calculate pieces of gold
  c@ = And(@r(a@)/256, 255)              ' calculate sledges

  If b@ Then Print "\t";b@;" piece(s) of gold"
  If c@ Then Print "\t";c@;" sledge(s)"
  If And(@r(a@), 128) Then Print "\tA ladder"
  If @r(a@)/128 = 0 Then Print "\tNothing"

  If And(@r(a@), 64) Then             ' see if we are in the prize room
    Print
    Print "You found the Prize Room!"
    Print "Congratulations! You have won!"
    Return (0)                         ' we can safely quit now
  EndIf
  Print
Return (1)                             ' no, this isn't the prize room

_Token                                 ' split token
  Local (1)                            ' token string

  Do
    While Len(c)                       ' any string left?
    While Peek(c, 0) = Ord(" ")        ' is it a space?
    c = Chop(c, 1)                   ' split off space
  Next

  a@ = Dup ("")                        ' start with an empty token

  Do                                   ' start after leading spaces
    While Len(c)
    While Peek(c, 0) # Ord(" ")        ' until we find another space
    a@ = Join(a@, Char(Peek (c, 0)))   ' add character to token
    c = Chop(c, 1)                     ' split off character
  Loop

Return (a@)                            ' return remainder and token

_exit                                  ' this is the exit command
  Print "You realize there's no way out of here."
  Print "You decide to commit suicide."
End

_list Goto _inventory                  ' alias for "inventory"
_inv Goto _inventory                   ' alias for "inventory"

_inventory
  Print "You're carrying:"             ' list all items
  If And(i/256, 131071) = 0 Then Print "\tNothing"
  If And(i, 16777216)   Then Print "\tA ladder"
  If And(i/256, 255)    Then Print "\t";And(i/256, 255);" sledge(s)"
  If And(i/65536, 255)  Then Print "\t";And(i/65536, 255);" piece(s) of gold"
  Print
Return

_take                                  ' take any item
  Local (1)

  a@ = FUNC(_Token)

  If Comp(a@, "sledge") = 0 Then
    Proc _TakeSledge                   ' get the sledge
  Else If Comp(a@, "gold") = 0 Then
    Proc _TakeGold                     ' take the gold
  Else If Comp(a@, "ladder") = 0 Then
    Proc _TakeLadder                   ' get the ladder
  Else If Comp(a@, "all") = 0 Then
    Proc _TakeAll                      ' be greedy
  Else Print "Hey, just what you see, pal!\n"
  EndIf EndIf EndIf EndIf              ' no sauch thing
Return

_TakeSledge
  Local (2)

  If Set(a@, And(@r(Set(b@, And(i, 255)))/256, 255)) Then
    @r(b@) = ((@r(b@)/65536) * 65536) + ((a@ - 1) * 256) + And(@r(b@), 255)
    i = ((i/65536) * 65536) + ((And(i/256, 255) + 1) * 256) + b@
  Else
    Print "There is no sledge here.\n"
  EndIf
Return

_TakeGold
  Local (2)

  If Set(a@, And(@r(Set(b@, And(i, 255)))/65536, 255))  Then
    @r(b@) = ((a@-1) * 65536) + And(@r(b@), 65535)
    i = ((i/16777216) * 16777216) + ((And(i/65536, 255) + 1) * 65536) + And(i, 65535)
  Else
    Print "There is no gold here.\n"
  EndIf
Return

_TakeLadder
  Local (1)

  If And(@r(Set (a@, And(i, 255))), 128) Then
    @r(a@) = And(@r(a@), Not(128))
    i = Or(i, 16777216)
  Else
    Print "There is no ladder here.\n"
  EndIf
Return

_TakeAll
  Local (1)

  If @r(Set (a@, And(i, 255)))/128 > 0 Then
    If And(@r(a@), 128) Then
      Proc _TakeLadder
    EndIf

    i = ((i/16777216) * 16777216) + ((And(i/65536, 255) + And(@r(a@)/65526, 255)) * 65536) + ((And(i/256, 255) + And(@r(a@)/256, 255)) * 256) + a@
    @r(a@) = And(@r(a@), 63)
  Else
    Print "Nothing of interest here.\n"
  EndIf
Return

_arm Goto _equip                       ' alias for "equip"

_equip                                 ' equip any item
  Local (1)

  a@ = FUNC(_Token)

  If Comp(a@, "sledge") = 0 Then
    Proc _EquipSledge                   ' equip the sledge
  Else If Comp(a@, "ladder") = 0 Then
    Proc _EquipLadder                   ' equip the ladder
  Else Print "You can't equip that.\n"
  EndIf EndIf                           ' no such thing
Return

_EquipSledge
  If And(i/256, 255) Then
    i = Or(i, 33554432)
    Print "The sledge is equipped."
  Else
    Print "You're not carrying a sledge."
  EndIf

  Print
Return

_EquipLadder
  If And(i, 16777216) Then
    i = Or(i, 67108864)
    Print "The ladder is equipped."
  Else
    Print "You're not carrying a ladder."
  EndIf

  Print
Return

_drop                                  ' drop any item
  Local (1)

  a@ = FUNC(_Token)

  If Comp(a@, "sledge") = 0 Then
    Proc _DropSledge                   ' get the sledge
  Else If Comp(a@, "gold") = 0 Then
    Proc _DropGold                     ' take the gold
  Else If Comp(a@, "ladder") = 0 Then
    Proc _DropLadder                   ' get the ladder
  Else If Comp(a@, "all") = 0 Then
    Proc _DropAll                      ' be greedy
  Else Print "You can't drop what you don't have.\n"
  EndIf EndIf EndIf EndIf              ' no sauch thing
Return

_DropSledge
  Local (2)

  If Set(a@, And(i/256, 255)) Then
    b@ = And(i, 255)
    @r(b@) = ((@r(b@)/65536) * 65536) + ((And(@r(b@)/256, 255) + 1) * 256) + And(@r(b@), 255)
    i = And(((i/65536) * 65536) + ((a@ - 1) * 256) + b@, Not(33554432))
  Else
    Print "You're not carrying a sledge.\n"
  EndIf
Return

_DropGold
  Local (2)

  If Set(a@, And(i/65536, 255)) Then Then
    b@ = And(i, 255)
    @r(b@) = (((@r(b@)/65536) + 1) * 65536) + And(@r(b@), 65535)
    i = ((i/16777216) * 16777216) + ((a@ - 1) * 65536) + And(i, 65535)
  Else
    Print "There is no gold here.\n"
  EndIf
Return

_DropLadder
  Local (1)

  If And(i, 16777216) Then
    a@ = And(i, 255)
    @r(a@) = Or(@r(a@), 128)
    i = And(i, Not(16777216 + 67108864))
  Else                                 ' disable ladder
    Print "You're not carrying a ladder.\n"
  EndIf
Return

_DropAll
  Local (1)

  If And(i/256, 131071) Then
    a@ = And(i , 255)

    If And(i, 16777216) Then
      Proc _DropLadder
    EndIf

    @r(a@) = ((@r(a@)/65536 + And(i/65536, 255)) * 65536) + ((And(@r(a@)/256, 255) + And(i/256, 255)) * 256) + And(@r(a@), 255)
    i = And(i, 255)
  Else
    Print "Nothing of interest here.\n"
  EndIf
Return

' west  = -1
' east  = +1
' north = -6
' south = +6
' down  = -36
' up    = +36

_s Goto _south                         ' aliases for directions
_n Goto _north
_w Goto _west
_e Goto _east
_u Goto _up
_d Goto _down

_west
  If And(@r(And(i, 255)), 1) = 0 Then i = i - 1 : Return
  Print "You can't go west." : Print
Return

_east
  If And(@r(And(i, 255)), 2) = 0 Then i = i + 1 : Return
  Print "You can't go east." : Print
Return

_north
  If And(@r(And(i, 255)), 4) = 0 Then i = i - 6 : Return
  Print "You can't go north." : Print
Return

_south
  If And(@r(And(i, 255)), 8) = 0 Then i = i + 6 : Return
  Print "You can't go south." : Print
Return

_down
  If And(@r(And(i, 255) - 36), 128) = 0 Then Print "You'll need a ladder.\n" : Return
  If And(@r(And(i, 255)), 16) = 0 Then i = i - 36 : Return
  Print "You can't go down." : Print
Return

_up
  If And(@r(And(i, 255)), 128) = 0 Then Print "You'll need a ladder.\n" : Return
  If And(@r(And(i, 255)), 32) = 0 Then i = i + 36 : Return
  Print "You can't go up." : Print
Return

_help                                  ' a quick help
  Print "north, south, east, west, up, down"
  Print "\tMove in the direction specified. You won’t be able"
  Print "\tto move if there isn’t an exit in that direction."
  Print
  Print "attack (direction)"
  Print "\tAttack in the direction specified. (Hint: equip stuff first.)"
  Print
  Print "drop (all|item name)"
  Print "\tDrop the item specified. Or drop everything you’re carrying."
  Print
  Print "take (all|item name)"
  Print "\t Take the item specified. Or take everything in the room."
  Print
  Print "inventory"
  Print "\tDisplay everything you’re carrying."
  Print
  Print "equip (item name)"
  Print "\tEquip the item in question."
  Print
Return

' if (room) / 36 = 0       then no down
' 1f (room) / 36 = 5       then no up
' if ((room) % 36) / 6 = 5 then no south
' if ((room) % 36) / 6 = 0 then no north
' if ((room) % 36) % 6 = 5 then no east
' if ((room) % 36) % 6 = 0 then no west

_smash Goto _attack                    ' aliases for "attack"
_go Goto _attack

_attack                                ' attack a direction
  Local (1)                            ' just make a hole in the wall

  a@ = FUNC(_Token)

  If Comp(a@, "north") = 0 Then
    Proc _SmashNorth (And (i, 255))
  Else If Comp(a@, "south") = 0 Then
    Proc _SmashSouth (And (i, 255))
  Else If Comp(a@, "west") = 0 Then
    Proc _SmashWest (And (i, 255))
  Else If Comp(a@, "east") = 0 Then
    Proc _SmashEast (And (i, 255))
  Else If Comp(a@, "up") = 0 Then
    Proc _SmashUp (And (i, 255))
  Else If Comp(a@, "down") = 0 Then
    Print "That's quite a drop, dude..\n"
  Else Print "You don't wanna go there..\n"
  EndIf EndIf EndIf EndIf EndIf EndIf
Return
                                       ' do we have a sledge - or a ladder?
_Sledge? Return(And(i/256, 255)  * And(i, 33554432))
_Ladder? Return(And(i, 16777216) * And(i, 67108864))

_SmashWest
  Param (1)

  If FUNC(_Sledge?) Then
    If (a@ % 36) % 6 = 0 Then
      Print "That looks like a tough west wall..\n"
    Else
      @r(a@) = And(@r(a@), Not(1))
      @r(a@-1) = And(@r(a@-1), Not(2))
      i = And(i, Not(33554432))
    EndIf
  Else
    Print "Equip the sledge first. If you got one..\n"
  EndIf
Return

_SmashEast
  Param (1)

  If FUNC(_Sledge?) Then
    If (a@ % 36) % 6 = 5 Then
      Print "That looks like one tough east wall..\n"
    Else
      @r(a@) = And(@r(a@), Not(2))
      @r(a@+1) = And(@r(a@+1), Not(1))
      i = And(i, Not(33554432))
    EndIf
  Else
    Print "Activate the sledge first. If you got one..\n"
  EndIf
Return

_SmashNorth
  Param (1)

  If FUNC(_Sledge?) Then
    If (a@ % 36) / 6 = 0 Then
      Print "That looks like one tough north wall..\n"
    Else
      @r(a@) = And(@r(a@), Not(4))
      @r(a@-6) = And(@r(a@-6), Not(8))
      i = And(i, Not(33554432))
    EndIf
  Else
    Print "Equip the sledge first. If you got one..\n"
  EndIf
Return

_SmashSouth
  Param (1)

  If FUNC(_Sledge?) Then
    If (a@ % 36) / 6 = 5 Then
      Print "That looks like one tough south wall..\n"
    Else
      @r(a@) = And(@r(a@), Not(8))
      @r(a@+6) = And(@r(a@+6), Not(4))
      i = And(i, Not(33554432))
    EndIf
  Else
    Print "Equip the sledge first. If you got one..\n"
  EndIf
Return

_SmashUp
  Param (1)

  If FUNC(_Sledge?) Then
    If a@ / 36 = 5 Then
      Print "That looks like one tough ceiling..\n"
    Else
      If FUNC(_Ladder?) Then           ' note we drop the ladder
        @r(a@) = And(@r(a@), Not(32)) + 128
        @r(a@+36) = And(@r(a@+36), Not(16))
        i = And(i, Not(16777216 + 33554432 + 67108864))
      Else                             ' nothing equipped and NO ladder
        Print "Equip the ladder first. If you got one..\n"
      EndIf
    EndIf
  Else
    Print "Equip the sledge first. If you got one..\n"
  EndIf
Return
</lang>