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:
take ladder equip ladder equip sledge attack up up
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:
8 bits = #gold 8 bits = #sledge 1 bit = ladder 1 bit = target 6 bits = directions (udsnew)
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 NAME() function converts an ordinary string to a label, while LINE() returns true when the label has been defined. The PROC 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 such 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
Push ((And(i/65536, 255) + And(@r(a@)/65526, 255)) * 65536) Push ((And(i/256, 255) + And(@r(a@)/256, 255)) * 256) i = ((i/16777216) * 16777216) + Pop() + Pop() + 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
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
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 such 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
Push ((@r(a@)/65536 + And(i/65536, 255)) * 65536) Push ((And(@r(a@)/256, 255) + And(i/256, 255)) * 256) @r(a@) = Pop() + Pop() + 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 "\tTake 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>