RCRPG/Tcl: Difference between revisions

Content added Content deleted
(+ version with encapsulated setter/getter)
(Minor improvements for readability)
Line 1: Line 1:
{{collection|RCRPG}}[[Category:Tcl]]This version of [[RCRPG]] was typed and tested on a cellphone, so pardon my brevity.
{{collection|RCRPG}}[[Category:Tcl]]This version of [[RCRPG]] was typed and tested on a cellphone, so pardon my brevity.


<lang Tcl>
<lang Tcl>#!/usr/bin/env tclsh
#!/usr/bin/env tclsh
proc help args {
proc help args {
return "RosettaCode 3D single user dungeon in Tcl. Type a command:
return "RosettaCode 3D single user dungeon in Tcl. Type a command:
Line 11: Line 10:
i(nventory) : get told what you have
i(nventory) : get told what you have
For going up, you also need a ladder."}
For going up, you also need a ladder."}

proc main argv {
proc main argv {
Room 0,0,0 StartRoom sledge
Room 0,0,0 StartRoom sledge
Line 30: Line 30:
}
}
}
}

proc Room {xyz {name {}} {items {}}} { #-- "constructor"
proc Room {xyz {name {}} {items {}}} { #-- "constructor"
if {$name eq ""} {set name R.[incr ::R()]}
if {$name eq ""} {set name R.[incr ::R()]}
Line 35: Line 36:
array set ::R [list $xyz.name $name $xyz.items $items $xyz.exits {}]
array set ::R [list $xyz.name $name $xyz.items $items $xyz.exits {}]
}
}

proc Inverse where {
proc Inverse where {
switch -- $where {
switch -- $where {
Line 43: Line 45:
}
}
}
}

proc Normalize where {
proc Normalize where {
switch -- $where {
switch -- $where {
Line 50: Line 53:
}
}
}
}

proc attack where {
proc attack where {
if {"sledge" ni $::Self(items)} {return "need sledge to attack!"}
if {"sledge" ni $::Self(items)} {return "need sledge to attack!"}
Line 66: Line 70:
describe
describe
}
}

proc describe {} {
proc describe {} {
set xyz $::Self(coords)
set xyz $::Self(coords)
Line 80: Line 85:
inventory
inventory
}
}

proc drop what {
proc drop what {
set xyz $::Self(coords)
set xyz $::Self(coords)
Line 90: Line 96:
inventory
inventory
}
}

proc go {where {describe 1}} {
proc go {where {describe 1}} {
set where [Normalize $where]
set where [Normalize $where]
Line 109: Line 116:
if $describe describe
if $describe describe
}
}

proc inventory {} {
proc inventory {} {
return "You have [pretty $::Self(items)]."
return "You have [pretty $::Self(items)]."
}
}

proc name what {
proc name what {
set ::R($::Self(coords).name) $what
set ::R($::Self(coords).name) $what
return "This room is now named $what."
return "This room is now named $what."
}
}

proc take what {
proc take what {
set xyz $::Self(coords)
set xyz $::Self(coords)
Line 126: Line 136:
inventory
inventory
}
}

#--- general utilities
#--- general utilities
proc alias {new = args} {interp alias {} $new {} {*}$args}
proc alias {new = args} {interp alias {} $new {} {*}$args}
Line 143: Line 154:
main $argv</lang>
main $argv</lang>


==Alternative Version==
The following version is functionally identical, but uses a setter/getter function "@" to hide away the data representation
The following version is functionally identical, but uses a setter/getter function "@" to hide away the data representation
from most of the code (except in the definition of "@" itself).
from most of the code (except in the definition of "@" itself).
Line 183: Line 195:
}
}
}
}

proc Room {xyz {name {}} {items {}}} { #-- "constructor"
proc Room {xyz {name {}} {items {}}} { #-- "constructor"
if {$name eq ""} {set name R.[incr ::ID]}
if {$name eq ""} {set name R.[incr ::ID]}
Line 190: Line 203:
@ $xyz exits {}
@ $xyz exits {}
}
}

proc Inverse where {
proc Inverse where {
switch -- $where {
switch -- $where {
Line 198: Line 212:
}
}
}
}

proc Normalize where {
proc Normalize where {
switch -- $where {
switch -- $where {
Line 204: Line 219:
}
}
}
}

proc @ {coords what {value --}} { #-- universal setter/getter
proc @ {coords what {value --}} { #-- universal setter/getter
if {$coords eq "my"} {
if {$coords eq "my"} {
Line 215: Line 231:
} else {set ::R($coords.$what) $value}
} else {set ::R($coords.$what) $value}
}
}

#------------------- commands in Afferbeck Lauder
#------------------- commands in Afferbeck Lauder
proc attack where {
proc attack where {
Line 235: Line 252:
describe
describe
}
}

proc describe {} {
proc describe {} {
set coords [@ my coords]
set coords [@ my coords]
Line 247: Line 265:
inventory
inventory
}
}

proc drop what {
proc drop what {
if {$what eq "all"} {set what [@ my items]}
if {$what eq "all"} {set what [@ my items]}
Line 256: Line 275:
inventory
inventory
}
}

proc go {where {describe 1}} {
proc go {where {describe 1}} {
set where [Normalize $where]
set where [Normalize $where]
Line 276: Line 296:
if $describe describe
if $describe describe
}
}

proc inventory {} {return "You have [pretty [@ my items]]."}
proc inventory {} {return "You have [pretty [@ my items]]."}
proc name what {
proc name what {
return "This room is now named [@ here name $what]."
return "This room is now named [@ here name $what]."
}
}

proc take what {
proc take what {
if {$what eq "all"} {set what [@ here items]}
if {$what eq "all"} {set what [@ here items]}
Line 289: Line 311:
inventory
inventory
}
}

#----------------------- general utilities
#----------------------- general utilities
proc alias {new = args} {interp alias {} $new {} {*}$args}
proc alias {new = args} {interp alias {} $new {} {*}$args}
Retrieved from "https://rosettacode.org/wiki/RCRPG/Tcl"