RCRPG/Tcl: Difference between revisions
m
Fixed syntax highlighting.
(+ version with encapsulated setter/getter) |
m (Fixed syntax highlighting.) |
||
| (5 intermediate revisions by one other user not shown) | |||
Line 1:
{{collection|RCRPG}}[[
This [[Tcl]] version of [[RCRPG]] was typed and tested on a cellphone, so pardon my brevity.
<syntaxhighlight lang="tcl">#!/usr/bin/env tclsh▼
▲#!/usr/bin/env tclsh
proc help args {
return "RosettaCode 3D single user dungeon in Tcl. Type a command:
Line 11:
i(nventory) : get told what you have
For going up, you also need a ladder."}
proc main argv {
Room 0,0,0 StartRoom sledge
Line 30 ⟶ 31:
}
}
proc Room {xyz {name {}} {items {}}} { #-- "constructor"
if {$name eq ""} {set name R.[incr ::R()]}
if {![llength $items]} {set items [lpick {sledge {} ladder gold}]}
array set ::R [list $xyz.name $name $xyz.items $items $xyz.exits {}]
}
proc Inverse where {
switch -- $where {
Line 43 ⟶ 46:
}
}
proc Normalize where {
switch -- $where {
Line 50 ⟶ 54:
}
}
proc attack where {
if {"sledge" ni $::Self(items)} {return "need sledge to attack!"}
Line 66 ⟶ 71:
describe
}
proc describe {} {
set xyz $::Self(coords)
Line 76 ⟶ 82:
}
set exits $::R($xyz.exits)
if {![llength $exits]} {set exits nowhere}
puts "There are exits towards: [join $exits {, }]"
inventory
}
proc drop what {
set xyz $::Self(coords)
Line 90 ⟶ 97:
inventory
}
proc go {where {describe 1}} {
set where [Normalize $where]
Line 105 ⟶ 113:
}
set xyz $x,$y,$z
if {![info exists ::R($xyz.name)]} {Room $xyz}
set ::Self(coords) $xyz
if {$describe} describe
}
proc inventory {} {
return "You have [pretty $::Self(items)]."
}
proc name what {
set ::R($::Self(coords).name) $what
return "This room is now named $what."
}
proc take what {
set xyz $::Self(coords)
Line 126 ⟶ 137:
inventory
}
#--- general utilities
proc alias {new = args} {interp alias {} $new {} {*}$args}
Line 136 ⟶ 148:
}
proc pretty lst {
if {![llength $lst]} {return nothing}
foreach i $lst {lappend tmp "a $i"}
regsub {(.+),} [join $tmp ", "] {\1, and}
}
main $argv</
==Alternative Version==
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).
Line 152 ⟶ 165:
lappend [@ my items &] teacup ;#-- returns a reference
<
return "RosettaCode 3D single-user dungeon in Tcl. Type a command:
e(ast), s(outh), n(orth), w(est), u(p), d(own)
Line 183 ⟶ 196:
}
}
proc Room {xyz {name {}} {items {}}} { #-- "constructor"
if {$name eq ""} {set name R.[incr ::ID]}
Line 190 ⟶ 204:
@ $xyz exits {}
}
proc Inverse where {
switch -- $where {
Line 198 ⟶ 213:
}
}
proc Normalize where {
switch -- $where {
Line 204 ⟶ 220:
}
}
proc @ {coords what {value --}} { #-- universal setter/getter
if {$coords eq "my"} {
Line 215 ⟶ 232:
} else {set ::R($coords.$what) $value}
}
#------------------- commands in Afferbeck Lauder
proc attack where {
Line 235 ⟶ 253:
describe
}
proc describe {} {
set coords [@ my coords]
Line 243 ⟶ 262:
}
set exits [@ here exits]
if {![llength $exits]} {set exits nowhere}
puts "There are exits towards: [join $exits {, }]."
inventory
}
proc drop what {
if {$what eq "all"} {set what [@ my items]}
Line 256 ⟶ 276:
inventory
}
proc go {where {describe 1}} {
set where [Normalize $where]
Line 272 ⟶ 293:
return "No exit towards $where, consider an attack..."
}
if {[catch {@ $coords name}]} {Room $coords}
@ my coords $coords
if {$describe} describe
}
proc inventory {} {return "You have [pretty [@ my items]]."}
proc name what {
return "This room is now named [@ here name $what]."
}
proc take what {
if {$what eq "all"} {set what [@ here items]}
Line 289 ⟶ 312:
inventory
}
#----------------------- general utilities
proc alias {new = args} {interp alias {} $new {} {*}$args}
Line 299 ⟶ 323:
}
proc pretty lst {
if {![llength $lst]} {return nothing}
foreach i $lst {lappend tmp [expr {$i eq "gold"? $i : "a $i"}]}
regsub {(.+),} [join $tmp ", "] {\1, and}
}
main $argv</
| |||