@program tporter.muf
1 1000 d
i
$include $lib/alynna
lvar param

: telmatch ( s -- d )
var dname 
var dest
dname !
me @ "/_tport/" dname @ strcat getprop dest !
dest @ not if
 #0 "/_tport/" dname @ strcat getprop dest !
 dest @ not if
  #-1 dest !
  then 
 then 
dest @
; PUBLIC telmatch

: tlearn
here "/_telname" getprop if
  here "/_telname" getprop
  me @ "/_tport/" rot strcat here setprop
  str "Location " here " learned as name: " here "_telname" getprop cat "tport" pretty tellme
 else
  here "J" flag? if 
   param @ not if str "Please enter a name for this location:" cat "tport" pretty tellme read param ! then
   me @ "/_tport/" param @ strcat here setprop
   str "Location " here " learned as name: " param @ cat "tport" pretty tellme
  else
   str "Location " here " not learnable." cat "tport" pretty tellme  
  then
 then  
;

: tdel
var value
me @ "/_tport/" param @ strcat getprop value @
value @ if
  me @ "/_tport" param @ strcat 0 setprop 
  str "Location " param @ " cleared." cat "tport" pretty tellme  
 else
  str "Location " param @ " not found." cat "tport" pretty tellme  
 then
;

: tpublic
var item
var value
var linestore
var count
"Known public locations" header tellme
-1 count !
"" linestore !
#0 "/_tport/" array_get_propvals foreach item ! value ! count @ 1 + count !
linestore @
str
 "^Green^"
 value @ tostr 7 rj
 " ^Yellow^"
 item @ name 30 rj strip 30 lj
 " ^NORMAL^"
cat strcat linestore !
count @ 2 % 1 = if linestore @ tellme "" linestore ! then
repeat 
count @ 2 % 1 < if linestore @ tellme "" linestore ! then
"tport" footer tellme
;

: tpublearn
here "J" flag? not if here "J" set then
param @ not if str "Please enter a name for this location:" cat "tport" pretty tellme read param ! then
#0 "/_tport/" param @ strcat here setprop
str "Location " here " set as global: " param @ cat "tport" pretty tellme
;

: tlist
var item
var value
var linestore
var count
"Learned locations" header tellme
-1 count !
"" linestore !
me @ "/_tport/" array_get_propvals foreach item ! value ! count @ 1 + count !
linestore @
str
 "^Green^"
 value @ tostr 7 rj
 " ^Yellow^"
 item @ name 30 rj strip 30 lj
 " ^NORMAL^"
cat strcat linestore !
count @ 2 % 1 = if linestore @ tellme "" linestore ! then
repeat 
count @ 2 % 1 < if linestore @ tellme "" linestore ! then
"tport" footer tellme
;

: tmake
me @ here controls if
 here "J" flag? not if here "J" set then
 param @ not if str "Please enter a name for this location:" cat "tport" pretty tellme read param ! then
 here "/_telname" param @ setprop
 str "Location " here " set as learnable location: " param @ cat "tport" pretty tellme
else
 str "Can't touch this." cat "tport" pretty tellme
then
;

: thelp
{
"tport 1.0 by Alynna"
" "
"Commands:"
" tel <dest>        Teleport to a stored or public location (also t or tport)"
" tmake <name>      Make the current location JUMP_OK and set a name for it"
" tlearn            Learn the current location (if its JUMP_OK)"
" tdel <name>       Delete the location specified that you learned"
" tlist             List all the locations you have learned"
" tpub              List public, wiz-set places (also tpublic)"
" tset <name>       Make this a new public location (wiz only)"
" thelp             Look at this, also t #help"
} array_make atellme
;

: tport
param @ not if str "Format: " command @ " <destination name>" cat "tport" pretty tellme exit then
param @ "#help" smatch if thelp exit then
param @ telmatch #-1 dbcmp if
  "Destination not found." "tport" pretty tellme
 else
  me @ param @ telmatch moveto
 then
;

: main
param !
command @ tolower case
 "{tport|tel|t}" smatch when tport exit end
 "{tmake}" smatch when tmake exit end
 "{tlearn}" smatch when tlearn exit end
 "{tdel}" smatch when tdel exit end
 "{tlist}" smatch when tlist exit end
 "{tpublic|tpub}" smatch when tpublic exit end
 "{tset}" smatch when tpublearn exit end
 default thelp end
endcase
;
.
c
q