@prog wizprogs.muf 1 999 d 1 i : say me @ swap notify ; : true-wizard? "c" ("w") flag? ; : mpop begin dup 0 > while 1 - swap pop loop pop ; : abort 0 sleep daemon kill ; : lowat prog ".lowat" getpropstr atoi ; : hiwat prog ".hiwat" getpropstr atoi ; : holder prog ".holder" getpropstr atoi dbref ; : hexit prog ".exit" getpropstr atoi dbref ; : xopen ".." swap open ; : crecycle dup prog owner chown recycle ; : player-to-dbref dup .pmatch+ dup player? if swap pop exit then pop dup match dup player? if swap pop exit then pop dup "#" 1 strncmp not if 1 strcut atoi dbref dup player? if swap pop swap pop exit then pop pop then ": can't turn that into a player!" strcat say abort ; : is-one-of? (thing exit -- i) getlinks dup 2 + rotate swap ( l1 ... lN thing N ) begin dup 0 > while 1 - rot prog "d" flag? if read pop then ( ... thing N l ) dup exit? if ( thing N l ) dup getlinks dup 1 = if pop crecycle crecycle else ( thing N l l1 ... lM M ) dup 4 + pick swap begin dup 0 > while 1 - rot ( thing N l l1 ... lM thing M ln ) 3 pick dbcmp if 2 + mpop 1 + mpop 1 exit then loop pop pop pop then else pop then loop pop pop 0 ; : add-one-to (thing exit -- ) holder dup xopen over xopen ( thing exit h e1 e2 ) 4 rotate over addlink ( thing h e1 e2 ) dup 5 rotate addlink ( h e1 e2 ) over addlink ( h e1 ) swap addlink ; : clear-all-of (exit -- ) getlinks begin dup 0 > while 1 - swap dup exit? if dup getlinks begin dup 0 > while 1 - swap dup exit? if crecycle else pop then loop then pop loop pop ; : hexit-check (prog -- i) hexit is-one-of? ; : hexit-add hexit add-one-to ; : my-exit prog "." me @ int intostr strcat "." strcat getpropstr atoi dbref ; : mine-check my-exit is-one-of? ; : mine-add my-exit add-one-to ; : count-pool prog ".pool" getpropstr dup if " " explode dup begin dup 0 > while 1 - rot pop loop pop else pop 0 then ; : add-to-pool systime intostr 1 begin over "." strcat over intostr strcat me @ over rmatch while pop 1 + loop swap pop swap pop "Please type q to the editor." say "@prog " over strcat me @ swap force (me @ "q" force - this doesn't work...) nop pop (neither should be needed; seems to be sth strange somewhere) "@set " over strcat "=c" strcat me @ swap force me @ over rmatch dup ok? not if pop "Error rmatching " over strcat "!" strcat say abort then swap pop dup holder moveto dup hexit-add prog ".pool" getpropstr dup if " " strcat then swap int intostr strcat prog ".pool" rot 0 addprop ; : permitted? me @ wizard? if 1 exit then prog ".permit" getpropstr "<" me @ int intostr "/" strcat strcat instr ; : do-help "wiz " say " Chown the program to your wiz." say "unwiz " say " Chown the program to you." say "get" say " Get an empty wizbit program." say me @ wizard? if "padd <*player-or-#dbref> <*wiz-or-#dbref>" say " Allow the first player to use this facility, with wizzed progs owned" say " by the specified wizard." say "pdel <*player-or-#dbref>" say " Forbid the player to use this facility." say "pool" say " Refill the pool of empty programs." say then ; : do-wiz me @ swap rmatch dup #-3 dbcmp if "Can't wiz HOME!" say abort then dup #-2 dbcmp if "You'll have to be more specific." say abort then dup not if "You must be carrying the program." say abort then dup program? not if "That's not a program." say abort then dup mine-check not if "That program isn't yours." say abort then prog "d" set dup hexit-check not if "That program isn't under the control of this system." say abort then prog "!d" set dup owner me @ dbcmp not if "You must own the program." say abort then dup wizard? not if "That program's not wizbitted." say abort then prog ".permit" getpropstr dup "<" me @ int intostr strcat "/" strcat instr strcut swap pop dup "/" instr strcut swap pop atoi dbref dup true-wizard? not if "Your wizard somehow isn't a wizard!" say abort then over swap chown "Done." say ; : do-unwiz me @ swap rmatch dup #-3 dbcmp if "Can't wiz HOME!" say abort then dup #-2 dbcmp if "You'll have to be more specific." say abort then dup not if "You must be carrying the program." say abort then dup program? not if "That's not a program." say abort then dup mine-check not if "That program isn't yours." say abort then dup hexit-check not if "That program isn't under the control of this system." say abort then dup wizard? not if "That program's not wizbitted." say abort then prog ".permit" getpropstr dup "<" me @ int intostr strcat "/" strcat instr strcut swap pop dup "/" instr strcut swap pop atoi dbref dup true-wizard? not if "Your wizard somehow isn't a wizard!" say abort then over owner over dbcmp not if "Your wizard must own the program." say abort then pop me @ chown "Done." say ; : do-get do prog ".pool" getpropstr dup not if "No programs available - get a wizard to refill the pool." say abort then dup " " instr dup if 1 - strcut 1 strcut swap pop else pop "" then prog ".pool" rot 0 addprop atoi dbref dup program? if dup hexit-check else 0 then if dup wizard? else 0 then if dup mine-add dup me @ moveto dup me @ chown dup "Program #" over int intostr strcat setname "You got #" swap int intostr strcat "." strcat say count-pool lowat <= if "Getting low on spare programs; get a wizard to refill the pool." say then exit then loop ; : do-padd " " explode dup 2 = if pop player-to-dbref swap player-to-dbref ( player wiz ) dup true-wizard? not if "Second player must be wiz." say pop pop exit then "<" 3 pick int intostr strcat "/" strcat dup rot int intostr strcat ">" strcat prog ".permit" getpropstr ( p

permit ) dup 4 pick instr dup if "Replacing previous entry." say 1 - strcut 4 pick strlen strcut swap pop dup ">" instr strcut swap pop strcat else pop "." 5 pick int intostr strcat "." strcat holder xopen prog rot 3 pick int intostr 0 addprop holder addlink then ( p

permit ) strcat swap pop prog ".permit" rot 0 addprop pop else mpop "Invalid usage - use help for info." say then ; : do-pdel player-to-dbref "<" over int intostr strcat "/" strcat prog ".permit" getpropstr dup 3 pick instr dup if 1 - strcut 3 pick strlen strcut swap pop dup ">" instr strcut swap pop strcat prog ".permit" rot 0 addprop pop prog "." rot int intostr "." strcat strcat over over getpropstr atoi dbref dup clear-all-of crecycle remove_prop else 4 mpop "Entry not found." say then ; : do-plist prog ".permit" getpropstr dup not if pop "None." say exit then 1 strcut swap pop dup strlen 1 - strcut pop "><" explode begin dup 0 > while 1 - swap dup "/" instr 1 - strcut 1 strcut swap pop swap atoi dbref name ", wizard " strcat swap atoi dbref name strcat "." strcat say loop ; : do-pool count-pool hiwat over over < if prog owner rot rot prog me @ chown 1 - 1 for pop add-to-pool loop prog swap chown else pop pop "Pool is already full." say then ; : do-check "Apparent pool size: " count-pool intostr "." strcat strcat say #-1 hexit-check pop prog ".permit" getpropstr dup if 1 strcut dup strlen 1 - strcut pop swap pop "><" explode begin dup 0 > while 1 - swap dup "/" instr dup if 1 - strcut pop else pop then atoi intostr prog "." rot strcat "." strcat getpropstr atoi dbref #-1 swap is-one-of? pop loop else pop then "Checks done." say ; : main permitted? not if pop "Permission denied." say exit then dup " " instr dup if 1 - strcut 1 strcut swap pop swap else pop "" swap then dup "help" strcmp not if pop do-help exit then dup "wiz" strcmp not if pop do-wiz exit then dup "unwiz" strcmp not if pop do-unwiz exit then dup "get" strcmp not if pop do-get exit then me @ wizard? if dup "padd" strcmp not if pop do-padd exit then dup "pdel" strcmp not if pop do-pdel exit then dup "plist" strcmp not if pop do-plist exit then dup "pool" strcmp not if pop do-pool exit then dup "check" strcmp not if pop do-check exit then then dup if ": unrecognized." else "No command given." then strcat " Use `help' for help." strcat say ; . c q