( tport Version: 2.0.0 Restricted Teleport. Properties: [ total list on #0 ] @tport/locations/: @tport/plocations/: - public locations [ on player ] @tport/locations/: - known locations _tport/lock: [ On room ] @tport/location: _tport/lock: _tport/name: [ On room or environment ] _prefs/tport_ok?:yes|no Commands: tport * - Teleport to symname tport * - Teleport to a player. [ Public Teleports: ] tport #public * - location everone can jump to tport #!public - remove a location tport #public * - list public jump locations [ Personal Managment: ] tport #list * - list your known destinations. tport #listall * - list all destinations tport #forget * - forget a location tport #learn * - Learn here if its a location tport #plock * - Set your personal lock. [ Room Managment: ] tport #show * - show info for curent room. tport #create [=] * - Create a teleport patern here that shows as listname. tport #lock * - Set a room lock. tport #destroy * - Remove teleport pattern here. ) $define FROMMSG "You think of the distant teleport pattern %word, and the world around you changes!" $enddef $define FROMMSG_PLR "You think of %dest, and the world around you changes!" $enddef $define FROMOMSG "concentrates on a distant place, and fades from sight." $enddef $define TOOMSG "fades into existance on the teleport pattern." $enddef $define TOOMSG_PLR "fades into existance next to %dest." $enddef ( ----------------------------------------------------------------- $include ) $include $lib/command ( ----------------------------------------------------------------- VARS ) var cmd-option var cmd-arg1 var cmd-arg2 var tport-isglobal var tport-dest ( ----------------------------------------------------------------- UTIL ) : tell-me me @ swap notify ; ( ----------------------------------------------------------------- PARSE ) ( Varous general functions.. ) : cmd-parse ( s -- s1 s2 s3 ) strip ( *s1* if it starts with a # strip off the option.. ) dup 1 strcut pop "#" stringcmp 0 = over 1 strcut swap pop 1 strcut pop number? not and if dup " " instr dup if strcut strip swap strip else pop "" swap then 1 strcut swap pop (strip #/-) else "" then swap ( stack: s1 s ) ( *s3* Is there a =? ) dup "=" instr dup if 1 - strcut 1 strcut swap pop ( strip = ) strip swap else pop "" swap then ( stack: s1 s3 s ) ( *s2* Finish it.. ) strip swap ; ( ----------------------------------------------------------------- Funcs ) : controls? ( d d -- i ) ( wizard controlls all ) dup "w" flag? if pop pop 1 exit then ( What you own ) swap owner dbcmp ; : loc-name-ok? ( s -- i ) ( Null string not valid. ) dup not if pop 0 exit then ( check first character ) dup 1 strcut pop "_.@~" swap instr if pop 0 exit then ( Nothing silly like propdirs .. ) dup " " instr over "/" instr or swap ":" instr or if 0 exit then 1 ; var list-prefix var list-object : show-list ( object prefix -- ) list-prefix ! list-object ! list-prefix @ BEGIN list-object @ swap nextprop dup list-prefix @ strlen strcut pop list-prefix @ stringcmp 0 = WHILE ( dest address ) dup list-prefix @ strlen strcut swap pop " - " strcat ( actual destination ) over list-object @ swap getpropstr atoi dbref dup ok? if dup "_tport/name" getpropstr dup if me @ "w" flag? 3 pick owner me @ dbcmp or if over unparseobj " [" swap strcat "]" strcat strcat then swap pop else pop unparseobj then else pop "** INVALID **" then strcat tell-me REPEAT pop "> Done" tell-me ; : parse-msg ( s -- 's ) me @ name "%name" subst cmd-arg1 @ "%word" subst tport-dest @ name "%dest" subst ; : parse-omsg ( s -- 's ) parse-msg me @ name " " strcat swap strcat ; ( ----------------------------------------------------------------- COMMANDS ) : do-teleport ( Teleport, find location ) cmd-arg1 @ .pmatch dup player? if tport-dest ! 0 tport-isglobal ! else pop me @ "@tport/locations/" cmd-arg1 @ strcat getpropstr dup not if pop #0 "@tport/plocations/" cmd-arg1 @ strcat getpropstr 1 else 0 then tport-isglobal ! dup not if "> \"" cmd-arg1 @ strcat "\" is an unknown pattern." strcat tell-me pop exit then atoi dbref tport-dest ! then ( Teleport, verify location. ) tport-dest @ room? not tport-dest @ player? not and if "> \"" cmd-arg1 @ strcat "\" has an invalid destination." strcat tell-me exit then tport-isglobal @ not tport-dest @ player? not and if tport-dest @ "@tport/location" getpropstr cmd-arg1 @ stringcmp 0 = not if "> The teleport pattern there has changed." tell-me exit then then ( Check locking conditions in destination. ) tport-dest @ "_tport/lock" getprop dup lock? if me @ swap testlock not if tport-dest @ player? if "> You may not teleport to " tport-dest @ name strcat "." strcat else "> The teleport pattern is warded against you." then tell-me exit then else pop tport-dest @ player? if "> " tport-dest @ name strcat " is not setup for teleport." strcat tell-me exit then then ( Do teleport ) loc @ me @ FROMOMSG parse-omsg notify_except tport-dest @ player? if FROMMSG_PLR parse-msg tell-me tport-dest @ me @ TOOMSG_PLR parse-omsg notify_except tport-dest @ location tport-dest ! else FROMMSG parse-msg tell-me tport-dest @ me @ TOOMSG parse-omsg notify_except then me @ tport-dest @ moveto ; : do-list me @ "_tport/lock" getprop dup lock? if "> Personal Lock: " swap prettylock strcat tell-me else pop then "> Personal destinations." tell-me me @ "@tport/locations/" show-list "> Done." ; : do-learn loc @ "@tport/location" getpropstr dup not if "> There is no teleport pattern here." tell-me pop exit then dup loc-name-ok? not if "> The teleport pattern here is not working." tell-me pop exit then dup "@tport/locations/" swap strcat me @ swap loc @ int intostr 0 addprop "> Teleport destination \"" swap strcat "\" added." strcat tell-me ; : do-help prog cmd-arg1 @ lib-help ; : do-addpublic ( Name ok? ) cmd-arg1 @ loc-name-ok? not if "> \"" cmd-arg1 @ strcat "\" is not a valid name." strcat tell-me exit then #0 "@tport/plocations/" cmd-arg1 @ strcat loc @ int intostr 0 addprop "> Teleport destination \"" cmd-arg1 @ strcat "\" added." strcat tell-me ; : do-public cmd-arg1 @ if do-addpublic exit then "> Public destinations." tell-me #0 "@tport/plocations/" show-list "> Done." ; : do-listall me @ "w" flag? not if "> This command is restricted to wizards." tell-me exit then "> All non-public patterns." tell-me #0 "@tport/locations/" show-list "> Done." ; : do-show loc @ "@tport/location" getpropstr dup if dup loc-name-ok? else dup then if "> This room has a teleport pattern with the name \"" swap strcat "\"." strcat tell-me me @ "w" flag? me @ loc @ owner dbcmp or if loc @ "_tport/name" getpropstr dup if "> Shows on lists as: " swap strcat tell-me else pop then loc @ "_tport/lock" getprop dup lock? if "> Locked to: " swap prettylock strcat tell-me else pop then then else "> This room does not have a teleport pattern." tell-me pop exit then ; : do-create loc @ me @ controls? not if "> You do not own this room." tell-me exit then cmd-arg1 @ loc-name-ok? not if "> That is an invalid name for a teleport pattern." tell-me exit then #0 "@tport/locations/" cmd-arg1 @ strcat getpropstr if "> The pattern name \"" cmd-arg1 @ strcat "\" is already in use." strcat tell-me exit then loc @ "@tport/location" getpropstr if "> This room already has a teleport pattern." tell-me exit then loc @ "@tport/location" cmd-arg1 @ 0 addprop #0 "@tport/locations/" cmd-arg1 @ strcat loc @ int intostr 0 addprop cmd-arg2 @ if loc @ "_tport/name" cmd-arg2 @ 0 addprop then "> Teleport pattern \"" cmd-arg1 @ strcat "\" created." strcat tell-me ; : do-destroy loc @ me @ controls? not if "> You do not own this room." tell-me exit then loc @ "@tport/location" getpropstr not if "> This room does not have a teleport pattern." tell-me exit then #0 "@tport/locations/" loc @ "@tport/location" getpropstr strcat remove_prop loc @ "@tport/location" remove_prop loc @ "_tport/name" remove_prop loc @ "_tport/lock" remove_prop "> Teleport pattern destroyed." tell-me ; : do-lock ( "> Command disabled due to server bug, type the following to" tell-me "> set the lock manualy:" tell-me "> @propset here=lock:_tport/lock:" cmd-arg1 @ strcat tell-me exit ) loc @ me @ controls? not if "> You do not own this room." tell-me exit then cmd-arg1 @ not if loc @ "_tport/lock" remove_prop "> Lock removed." tell-me then cmd-arg1 @ parselock dup not if pop "> Invalid lock." tell-me exit then dup loc @ swap "_tport/lock" swap setprop "> Lock set to: " swap prettylock strcat tell-me ; : do-forget me @ "@tport/locations/" cmd-arg1 @ strcat getpropstr not if "> You didn't know any such location." tell-me exit then me @ "@tport/locations/" cmd-arg1 @ strcat remove_prop "> Forgotten." tell-me ; : do-plock ( "> Command disabled due to server bug, type the following to" tell-me "> set the lock manualy:" tell-me "> @propset me=lock:_tport/lock:" cmd-arg1 @ strcat tell-me exit ) cmd-arg1 @ not if me @ "_tport/lock" remove_prop "> Lock removed." tell-me exit then cmd-arg1 @ parselock dup not if pop "> Invalid lock." tell-me exit then dup me @ swap "_tport/lock" swap setprop "> Personal lock set to: " swap prettylock strcat tell-me ; ( ----------------------------------------------------------------- MAIN ) : main cmd-parse ( #s1 s2=s4 ) cmd-arg2 ! cmd-arg1 ! cmd-option ! cmd-option @ not cmd-arg1 @ not and if "> See tport #help for usage." tell-me exit then cmd-option @ not if do-teleport exit then cmd-option @ "learn" stringcmp 0 = if do-learn exit then cmd-option @ "list" stringcmp 0 = if do-list exit then cmd-option @ "help" stringcmp 0 = if do-help exit then cmd-option @ "public" stringcmp 0 = if do-public exit then cmd-option @ "show" stringcmp 0 = if do-show exit then cmd-option @ "create" stringcmp 0 = if do-create exit then cmd-option @ "destroy" stringcmp 0 = if do-destroy exit then cmd-option @ "listall" stringcmp 0 = if do-listall exit then cmd-option @ "lock" stringcmp 0 = if do-lock exit then cmd-option @ "forget" stringcmp 0 = if do-forget exit then cmd-option @ "plock" stringcmp 0 = if do-plock exit then "> \"#" cmd-option @ strcat "\" is an unknown command. Try \"tport #help\" for help." strcat tell-me ;