( Attach a global acton to this program, usually called @field.  This )
( program must be set WIZARD to work properly.                        )
()
: fixfield
dup "@" 1 strncmp if swap 0 addprop exit then
dup "@name" stringcmp not if pop setname then
dup "@desc" stringcmp not if pop setdesc then
dup "@succ" stringcmp not if pop setsucc then
dup "@osucc" stringcmp not if pop setosucc then
dup "@fail" stringcmp not if pop setfail then
dup "@ofail" stringcmp not if pop setofail then
dup "@drop" stringcmp not if pop setdrop then
dup "@odrop" stringcmp not if pop setodrop then
;
: getfield
dup "@" 1 strncmp if getpropstr exit then
dup "@name" stringcmp not if pop name exit then
dup "@desc" stringcmp not if pop desc exit then
dup "@succ" stringcmp not if pop succ exit then
dup "@osucc" stringcmp not if pop osucc exit then
dup "@fail" stringcmp not if pop fail exit then
dup "@ofail" stringcmp not if pop ofail exit then
dup "@drop" stringcmp not if pop drop exit then
dup "@odrop" stringcmp not if pop odrop exit then
;
: main
.sstrip
dup "" stringcmp not if pop
"FIELD> Format is: @field object/field=oldstr^newstr" me @ swap notify
exit then
dup dup dup dup
"/" instr 4 rotate "^" instr 4 rotate
"=" instr and and not swap "" stringcmp not or if
me @ "FIELD> Incorrect format." notify pop exit then
dup dup dup
"/" instr rot "=" instr rot "^" instr <
swap 3 pick "=" instr < and not if
me @ "FIELD> Incorrect format." notify pop exit then
dup "/" instr 1 - strcut 1 strcut swap pop
dup "=" instr 1 - strcut 1 strcut swap pop
dup "^" instr 1 - strcut 1 strcut swap pop
4 rotate .sstrip 4 rotate .sstrip
4 rotate 4 rotate
4 pick "" stringcmp not
4 pick "" stringcmp not
4 pick "" stringcmp not or or if
me @ "FIELD> Missing operand." notify
pop pop pop pop exit then
4 rotate match dup
#-1 dbcmp if pop pop pop pop
me @ "FIELD> Object to modify is not present." notify exit then
dup #-2 dbcmp if pop pop pop pop
me @ "FIELD> Object to modify is ambiguous." notify exit then
dup dup dup dup thing? 4 rotate player? 4 rotate
exit? 4 rotate program? or or or over
location dup me @ dbcmp swap loc @ dbcmp
or not me @ "P" flag? not and and if pop pop pop pop
me @ "FIELD> Object to modify is not present." notify exit then
dup owner me @ dbcmp not me @ "P" flag? not
and if pop pop pop pop
me @ "FIELD> Invalid object." notify exit then
-4 rotate rot
dup "@" 1 strncmp 5 pick
3 pick getpropstr "" stringcmp not and if
me @ "FIELD> Non-existant property." notify
pop pop pop pop exit then
over "@" 1 strncmp not if pop pop pop pop
me @ "FIELD> Invalid field." notify exit then
-3 rotate 4 pick 4 pick getfield
dup 4 pick instr not if
pop pop pop pop pop
me @ "FIELD> String to replace not found." notify exit then
me @ "-----" notify
dup "FIELD> Old:  " swap strcat me @ swap notify
rot rot swap subst
3 pick over 4 pick
fixfield
3 pick dup intostr "(#" swap strcat ") " strcat
swap dup room? if "Room" over loc @ dbcmp if
" (Here)" strcat then else
dup player? over me @ dbcmp not and if "Player" over name
" (" swap strcat ")" strcat strcat
me @ name " just tweaked your \"" strcat
6 pick strcat "\" prop/field." strcat
3 pick swap notify else
dup player? if "Player" over name
" (" swap strcat ")" strcat strcat else
dup thing? if "Object" else
dup program? if "Program" then
dup exit? if "Exit" then
then
then
then
then
swap pop strcat
"FIELD> Obj:  " swap strcat me @ swap notify
rot owner dup name swap intostr
"(#" swap strcat ") " strcat swap strcat
"FIELD> Own:  " swap strcat me @ swap notify
"FIELD> Set:  " rot strcat me @ swap notify
"FIELD> New:  " swap strcat me @ swap notify
me @ "-----" notify
;
100 lines displayed.