@q
@edit jweather.muf
1 9999 d
i
( jweather.muf v1.1 Jessy @ FurryMUCK 7/01
An easy to set up, multi-climate MUCK weather system. Jweather
supports both periodic weather messages to rooms and
weather-related MPI.
INSTALLATION:
Ensure that the program is set at least M3. Create a global exit with
a name such as 'weather' and link it to the program. Internal routines
will complete the installation the first time the program is run.
CONFIGURATION:
By default, jweather uses values for the northern hemisphere and
measurements in fahrenheit and imperial units. To change this,
edit the definitions below for HEMISPHERE and SCALE, and recompile
the program.)
(* edit HEMISPHERE value to "northern" or "southern" *)
$define HEMISPHERE "northern" $enddef
(* edit SCALE value to "fahrenheit" or "centigrade" *)
$define SCALE "fahrenheit" $enddef
( Jweather installs one default climate, named 'Temperate'. You can
define additional climates -- with associated values for high and
low temperatures, changeability, etc. -- and/or change the default
values for the Temperate climate with the command's #config option.
To set the climate for a specific room, go to the room and use the
#climate option. To set the climate for an area, go to the area's
environment room and use the #climate option.
To cause periodic weather messages to be displayed in a specific
room, go to the room and use the #yes option. To cause periodic
messages to be displayed in all rooms in an area, go to the area's
environment room and use the #yes option.
MPI:
Jweather supports the following MPI functions:
{weather:climate} ..... <climate name for current location>
{weather:daynight} .... day|night
{weather:degrees} ..... <temperature in degrees fahrenheit>
{weather:moonphase} ... full|gibbous|half|quarter|new
{weather:phase} ....... morning|afternoon|evening|night
{weather:precip} ...... rain|mist|snow|hail|""
{weather:precipverb} .. raining|misting|snowing|hailing|""
{weather:temp} ........ extremely cold|very cold|cold|cool|
warm|hot|very hot|extremely hot
{weather:season} ...... spring|summer|fall|winter
{weather:skyadj} ...... overcast|mostly cloudy|partly cloudy|clear
{weather:skynoun} ..... clouds|some clouds|a few clouds|no clouds
{weather:waxwane} ..... waxing|waning
{weather:windadj} ..... calm|breezy|windy|very windy|extremely windy
{weather:winddir} ..... north|northeast|east|southeast|south|
southwest|west|northwest
{weather:winddiradj} .. northerly|northeasterly|easterly|southeasterly|
southwesterly|westerly|northwesterly
{weather:windnoun} .... light winds|moderate winds|high winds|
extremely high winds|gail force winds
{weather:windspeed} ... <speed> mph|kph
Jweather.muf may be freely ported. Please comment any changes.
CHANGES:
1.1: Fixed a major problem with the {weather} macro.
)
(2345678901234567890123456789012345678901234567890123456789012345678901)
$define Tell me @ swap notify $enddef
$define DoNukeStack begin depth while pop repeat $enddef
$include $lib/reflist
lvar ourArg
lvar ourDir
lvar ourOpt
lvar ourLoc
lvar ourCounter
lvar ourClimate
: CopyDir ( d1 s1 d2 s2 -- ) (* copy dir s1 on d1 to dir s2 on d2.
do not copy subdirs *)
4 pick 4 pick propdir? if
3 pick "*/" smatch not if
3 pick "/" strcat 3 put
then
else
pop pop pop pop exit
then
dup "*/" smatch not if
"/" strcat
then
3 pick 5 rotate 5 rotate 5 rotate 5 rotate
dup 5 rotate 5 rotate 5 rotate 5 rotate
4 pick 4 pick nextprop dup 4 put
5 rotate 5 rotate 5 rotate 5 rotate
begin
4 pick 4 pick getprop if
pop over
7 pick 7 pick swap subst
4 pick 4 pick 4 pick 4 pick
4 rotate 4 rotate getprop setprop
4 pick 4 pick nextprop dup not if
break
then
dup 4 put 5 put
else
4 pick 4 pick dup "*/" smatch if
dup strlen 1 - strcut pop
then
over over nextprop not if
pop pop break
then
nextprop dup 4 put 5 put
then
pop over 7 pick 7 pick swap subst
repeat
pop pop pop pop pop pop pop pop
;
: DoParseThis ( d s -- s ) (* returns d's prop s, parsed for MPI *)
dup 3 pick swap getpropstr 0 parseprop
;
: DoParseTimeString ( s -- i1 i2 | i )
(* convert string s to number of seconds i1. i2 is true if successful *)
(* format of s is '<num> <units>', eg '3 hours', '1 day', '2 weeks' *)
(* if unsuccessful, return only one val, 0 *)
(* tokenize string *)
" " explode dup 2 = if (* check syntax and bail out if needed *)
pop
else
begin
dup while
swap pop
1 -
repeat
pop
">> Entry not understood." Tell 0 exit
then
(* parse units and convert amount *)
swap strip
"seconds" over stringpfx if 1 else
"minutes" over stringpfx if 60 else
"hours" over stringpfx if 3600 else
"days" over stringpfx if 86400 else
"weeks" over stringpfx if 604800 else
"months" over stringpfx if 1036800 else
"years" over stringpfx if 12441600 else
pop pop 0 exit
then then then then then then then
swap pop swap atoi * 1
;
: DoCapRomans ( s -- s' ) (* return s, all caps if it's a low roman *)
dup "{ii|iii|iv|v|vi|vii|viii|ix}" smatch if
toupper
then
;
: DoCapitalize ( s -- s' ) (* return s, capitalized *)
1 strcut swap toupper swap strcat DoCapRomans
;
: DoCapAll ( s -- s' ) (* return s, all words upper case *)
" " explode
dup if
""
begin
rot DoCapitalize " " strcat strcat
swap 1 - swap
over while
repeat
swap pop dup strlen 1 - strcut pop
else
pop
then
;
: DoApplyTempVals ( -- )(* move working dir to dir for new climate *)
prog ourDir @
prog "climates/%name/" ourClimate @ "%name" subst
CopyDir
prog ourDir @ dup strlen 1 - strcut pop remove_prop
;
: DoReadLine ( -- s )
(* read keyboard input; emit poses|says and continue, else return *)
begin (* begin input-scanning loop *)
read (* does input begin with 'say ' or " ? Emit if so *)
dup "\"" stringpfx if
1 strcut swap pop
me @ name " says, \"" strcat
swap strcat "\"" strcat
loc @ swap 0 swap notify_exclude
continue
then
dup "say " stringpfx if
4 strcut swap pop
me @ name " says, \"" strcat
swap strcat "\"" strcat
loc @ swap 0 swap notify_exclude
continue
then
(* does input begin with 'pose ' or : ? Emit if so *)
dup ":" stringpfx if
1 strcut swap pop
me @ name " " strcat swap strcat
loc @ swap 0 swap notify_exclude
continue
then
dup "pose " stringpfx if
5 strcut swap pop
me @ name " " strcat swap strcat
loc @ swap 0 swap notify_exclude
continue
then
(* continue for strings of all spaces; i.e., treat as null *)
dup strip not if
pop continue
then
break (* it's not a pose or say; break and exit *)
repeat
;
: QCheck ( -- i )(* wrap smatch for .q in an if, to avoid null string
match error if user enters a string of all spaces,
which DoReadLine would strip to a null string *)
dup if
dup ".quit" swap stringpfx
over ".end" swap stringpfx or if
pop ">> Done." Tell pid kill
then
then
;
: DoReadYesNo ( -- i )
(* read from keyboard; accept only vars of yes|no; return 1 for yes *)
begin (* begin input-scanning loop *)
DoReadLine
QCheck
"yes" over stringpfx if
pop 1 break
then
"no" over stringpfx if
pop 0 break
then
pop
">> Please enter 'Yes' or 'No'." Tell
repeat (* end input-scanning loop *)
;
: DoGetFirst ( -- s ) (* can't find climate; use first def'd *)
prog "climates/" nextprop dup if
"" "climates/" subst
else (* shouldn't happen *)
">> ERROR: Weather system not properly initialized." Tell
pop pid kill
then
;
: DoGetDefaultClimate ( -- s ) (* return def'd default climate name *)
prog "config/default" getpropstr dup not if
pop DoGetFirst (* use first climate in propdir if no default *)
then
DoCapAll
;
: DoGetClimate ( -- s ) (* return climate name for ourLoc *)
(* prop search first.... *)
ourLoc @ "weather/climate" envpropstr swap pop
(* use default if not found by prop *)
dup not if pop DoGetDefaultClimate then
(* make sure found climate actually exists; use default if not *)
prog "climates/%clim/" 3 pick "%clim" subst nextprop not if
pop DoGetDefaultClimate
then
;
: DoGetMoonPhase ( -- s ) (* return current phase of moon *)
systime 991983670 - (* get time since a full moon in June 2001 *)
2360595 % (* divide by moon periods; get remainder *)
86400 / (* divide into days *)
1 over >= if "full" else (* calc phase as offset from full *)
6 over >= if "gibbous" else
8 over >= if "half" else
12 over >= if "quarter" else
14 over >= if "new" else
20 over >= if "quarter" else
22 over >= if "half" else
26 over >= if "gibbous" else
"full"
then then then then then then then then
swap pop
;
: DoGetWaxWane ( -- s ) (* return wax|wane *)
DoGetMoonPhase "{full|new}" smatch if "" exit then
systime 991810870 -
2360595 %
86400 /
14 over >= if pop "waning" else "waxing" then
;
: DoGetSeason ( -- ) (* return season of year *)
"%m" systime timefmt atoi
HEMISPHERE "northern" smatch if
dup 2 <= if
pop "winter" exit
then
dup 5 <= if
pop "spring" exit
then
dup 8 <= if
pop "summer" exit
then
dup 11 <= if
pop "fall" exit
then
pop "winter"
else
dup 2 <= if
pop "summer" exit
then
dup 5 <= if
pop "fall" exit
then
dup 8 <= if
pop "winter" exit
then
dup 11 <= if
pop "spring" exit
then
pop "summer"
then
;
: DoGetDayPhase ( -- s )(* return time of day: morning, night, etc. *)
"%k" systime timefmt atoi
dup 6 < if
pop "night" exit
then
dup 12 < if
pop "morning" exit
then
dup 18 < if
pop "afternoon" exit
then
dup 20 < if
pop "evening" exit
then
pop "night" exit
;
: DoGetDayNight ( -- s )(* return 'day' for 0600-1800, else 'night' *)
"%k" systime timefmt atoi
dup 6 < swap 18 > or if
"night"
else
"day"
then
;
: DoApplyNightCooling ( s -- s' ) (* cool it down some at night *)
DoGetDayPhase dup "night" smatch if
pop atoi
SCALE "fahrenheit" smatch if 10 else 5 then
- intostr
else
"evening" smatch if
atoi
SCALE "fahrenheit" smatch if 5 else 2 then
- intostr
then
then
;
: DoGetTemperature ( -- s ) (* return current temp in degrees *)
prog "conditions/%clim/temp" ourClimate @ "%clim" subst getpropstr
DoApplyNightCooling
;
: DoGetFreezing ( -- s )
(* return true if it's frezzing in ourClimate *)
SCALE "fahrenheit" smatch if 32 else 0 then
DoGetTemperature atoi >= if "yes" else "" then
;
: DoGetPrecipitation ( -- s )
(* return true if it is precipitating in ourClimate *)
prog "conditions/%clim/prec" ourClimate @ "%clim" subst getpropstr
;
: DoGetPrecipNoun ( -- s ) (* return current form of precipitation *)
DoGetPrecipitation if
prog "conditions/%clim/prcf" ourClimate @ "%clim" subst getpropstr
else
""
then
;
: DoGetPrecipVerb ( -- s ) (* return verb for current precip form *)
DoGetPrecipNoun dup if "ing" strcat then
;
: DoGetTempAdj ( -- s ) (* return adj describing current temp *)
DoGetTemperature atoi
SCALE "fahrenheit" smatch if
0 over >= if pop "extremely cold" else
32 over >= if pop "very cold" else
45 over >= if pop "cold" else
60 over >= if pop "cool" else
78 over >= if pop "warm" else
90 over >= if pop "hot" else
100 over >= if pop "very hot" else
pop "extremely hot"
then then then then then then then
else
-17 over >= if pop "extremely cold" else
0 over >= if pop "very cold" else
7 over >= if pop "cold" else
16 over >= if pop "cool" else
26 over >= if pop "warm" else
32 over >= if pop "hot" else
38 over >= if pop "very hot" else
pop "extremely hot"
then then then then then then then
then
;
: DoGetSkyAdj ( -- s ) (* return adj describing current cloud cond *)
prog "conditions/%clim/over" ourClimate @ "%clim" subst getpropstr
;
: DoGetSkyNoun ( -- s ) (* return noun for current cloud conditions *)
DoGetSkyAdj
"overcast" over smatch if "clouds" else
"mostly cloudy" over smatch if "some clouds" else
"partly cloudy" over smatch if "a few clouds" else
"no clouds"
then then then
swap pop
;
: DoGetWindSpeed ( -- s ) (* return current wind speed in mph|kph *)
prog "conditions/%clim/wnds" ourClimate @ "%clim" subst getpropstr
" " strcat
SCALE "fahrenheit" smatch if "mph" else "kph" then strcat
;
: DoGetWindDir
prog "conditions/%clim/wndd" ourClimate @ "%clim" subst getpropstr
"0" over smatch if "north" else
"1" over smatch if "northeast" else
"2" over smatch if "east" else
"3" over smatch if "southeast" else
"4" over smatch if "south" else
"5" over smatch if "southwest" else
"6" over smatch if "west" else
"7" over smatch if "northwest" else
"north"
then then then then then then then then
swap pop
;
: DoGetWindAdj ( -- s ) (* return an adj describing current windspd *)
prog "conditions/%clim/wnds" ourClimate @ "%clim" subst getpropstr
atoi SCALE "centigrade" smatch if 2 / then
dup 2 <= if "calm" else
dup 8 <= if "breezy" else
dup 17 <= if "windy" else
dup 25 <= if "very windy" else
"extremely windy"
then then then then
swap pop
;
: DoGetWindDirAdj ( -- s ) (* return an adv describing wind dir *)
DoGetWindDir "erly" strcat
;
: DoGetWindNoun ( -- s ) (* return wind speed as a noun *)
prog "conditions/%clim/wnds" ourClimate @ "%clim" subst getpropstr
atoi SCALE "centigrade" smatch if 2 / then
dup 2 <= if "calm winds" else
dup 8 <= if "light winds" else
dup 14 <= if "moderate winds" else
dup 25 <= if "high winds" else
dup 60 <= if "extremely high winds" else
"gail force winds"
then then then then then
swap pop
;
: DoGetNormalTemp ( -- i ) (* get norm temp for clim & season *)
DoGetSeason
"summer" over smatch if
prog "climates/%clim/nsht" ourClimate @ "%clim" subst
getpropstr
else
"fall" over smatch if
prog "climates/%clim/nsht" ourClimate @ "%clim" subst
getpropstr atoi 1000 + dup
prog "climates/%clim/nwlt" ourClimate @ "%clim" subst
getpropstr atoi 1000 + - 2 / -
1000 - intostr
else
"winter" over smatch if
prog "climates/%clim/nwlt" ourClimate @ "%clim" subst
getpropstr atoi
prog "climates/%clim/ndnd" ourClimate @ "%clim" subst
getpropstr atoi + intostr
else
prog "climates/%clim/nsht" ourClimate @ "%clim" subst
getpropstr atoi 1000 + dup
prog "climates/%clim/nwlt" ourClimate @ "%clim" subst
getpropstr atoi 1000 + - 2 / -
1000 - intostr
then then then
swap pop
;
: DoGetRandomTemp ( -- s ) (* get random temp for season & clim *)
DoGetNormalTemp atoi
random
SCALE "Fahrenheit" smatch if 10 else 5 then
% 1 +
random 2 % if + else - then
prog "climates/%clim/esht" ourClimate @ "%clim" subst getpropstr
atoi over < if
pop
prog "climates/%clim/esht" ourClimate @ "%clim" subst getpropstr
then
prog "climates/%clim/ewlt" ourClimate @ "%clim" subst getpropstr
atoi over > if
pop
prog "climates/%clim/ewlt" ourClimate @ "%clim" subst getpropstr
then
dup string? not if intostr then
;
: DoGetRandomPrecip ( -- s ) (* return precip T|F for ourClimate *)
prog "climates/%clim/chng"
ourClimate @ "%clim" subst getpropstr atoi
random 100 % 1 + >= if "yes" else "" then
;
: DoGetRandomPrecForm ( -- s ) (* return random precip form *)
DoGetFreezing if
random 100 % 1 + 15 >= if "snow" else "hail" then
else
random 100 % 1 + 15 >= if "rain" else "mist" then
then
;
: DoGetRandomWindDir ( -- s ) (* return random wind direction *)
random 8 % intostr
;
: DoGetRandomWindSpeed ( -- s ) (* return low random wind dir *)
random 16 % intostr (* 0-15 ought to do it *)
;
: DoGetRandomOverCast ( -- s ) (* return random overcast val *)
DoGetPrecipitation if (* if it's raining, make it overcast *)
3
else (* otherwise, roll random *)
random 4 %
then
dup 3 = if "overcast" else
dup 2 = if "mostly cloudy" else
dup 1 = if "partly cloudy" else
"clear"
then then then
swap pop
;
: DoChange? ( -- i ) (* make a roll; return true if weather changes *)
random 100 % 1 + ourCounter @ <= if 1 else 0 then
;
: DoUpdateWeather ( s -- ) (* check for changes in weather
for climate stored in dir s *)
"" "climates/" subst ourClimate !
(* store chance for changes *)
prog "climates/%clim/chng" ourClimate @ "%clim" subst
getprop atoi ourCounter !
(* rec current temp and precip, so we can see if changed *)
prog "conditions/%clim/otmp" ourClimate @ "%clim" subst
prog "conditions/%clim/temp" ourClimate @ "%clim" subst
getprop setprop
prog "conditions/%clim/oprc" ourClimate @ "%clim" subst
prog "conditions/%clim/prec" ourClimate @ "%clim" subst
getprop setprop
(* if temp changes, move it up or down by a bit, randomly *)
DoChange? if
prog "conditions/%clim/temp" ourClimate @ "%clim" subst
over over getprop atoi
random SCALE "fahrenheit" smatch if 10 else 5 then
% 1 +
random 2 % if + else - then
prog "climates/%clim/esht" ourClimate @ "%clim" subst
getpropstr atoi dup 3 pick > if pop else swap pop then
prog "climates/%clim/ewlt" ourClimate @ "%clim" subst
getpropstr atoi dup 3 pick < if pop else swap pop then
DoGetSeason "summer" smatch if
prog "climates/%clim/esht" ourClimate @ "%clim" subst
getpropstr atoi SCALE "Fahrenheit" smatch if 50 else 25 then
- over over > if pop else swap pop then
then
DoGetSeason "winter" smatch if
prog "climates/%clim/ewlt" ourClimate @ "%clim" subst
getpropstr atoi SCALE "Fahrenheit" smatch if 50 else 25 then
+ over over < if pop else swap pop then
then
intostr setprop
then
(* if precip changes, toggle it *)
DoChange? if
prog "conditions/%clim/prec" ourClimate @ "%clim" subst
over over getprop not setprop
then
(* see if we have unusual precip *)
DoChange? if
prog "conditions/%clim/prcf" ourClimate @ "%clim" subst
DoGetFreezing if
random 10 % 8 <= if "snow" else "hail" then
else
random 10 % 8 <= if "rain" else "mist" then
then
setprop
then
(* if windspeed changes, move it up or down by a bit *)
DoChange? if
prog "conditions/%clim/wnds" ourClimate @ "%clim" subst
over over getprop atoi
random 10 % 1 + random 2 % if + else - then
0 over > if pop 0 then
intostr setprop
then
(* if wind direction changes, move it clockwise or counter by a bit *)
DoChange? if
prog "conditions/%clim/wndd" ourClimate @ "%clim" subst
over over getprop atoi
1 random 2 % if + else - then
0 over > if pop 7 then
7 over < if pop 0 then
intostr setprop
then
;
: DoInitConditions ( -- ) (* set initial conditions for ourClimate *)
prog "conditions/%clim/init" ourClimate @ "%clim" subst
DoGetSeason setprop
prog "conditions/%clim/temp" ourClimate @ "%clim" subst
prog "conditions/%clim/otmp" ourClimate @ "%clim" subst
DoGetRandomTemp ourCounter !
ourCounter @ setprop
ourCounter @ setprop
prog "conditions/%clim/prec" ourClimate @ "%clim" subst
prog "conditions/%clim/oprc" ourClimate @ "%clim" subst
DoGetRandomPrecip ourCounter !
ourCounter @ setprop
ourCounter @ setprop
prog "conditions/%clim/prcf" ourClimate @ "%clim" subst
DoGetRandomPrecForm setprop
prog "conditions/%clim/wndd" ourClimate @ "%clim" subst
DoGetRandomWindDir setprop
prog "conditions/%clim/wnds" ourClimate @ "%clim" subst
DoGetRandomWindSpeed setprop
prog "conditions/%clim/over" ourClimate @ "%clim" subst
DoGetRandomOverCast setprop
;
: DoInstall ( -- ) (* set initial program props *)
#0 "_reg/jweather" prog setprop
prog "L" set
#0 "_msgmacs/weather" "{muf:$jweather,{subst:{:1},{:1},#mpi{:1}}}" setprop
prog "msgmacs/climate" "{muf:$jweather,#mpiclimate}" setprop
prog "msgmacs/daynight" "{muf:$jweather,#mpidaynight}" setprop
prog "msgmacs/degrees" "{muf:$jweather,#mpidegrees}" setprop
prog "msgmacs/moonphase" "{muf:$jweather,#mpimoonphase}" setprop
prog "msgmacs/phase" "{muf:$jweather,#mpiphase}" setprop
prog "msgmacs/precip" "{muf:$jweather,#mpiprecip}" setprop
prog "msgmacs/precipverb" "{muf:$jweather,#mpiprecipverb}" setprop
prog "msgmacs/temp" "{muf:$jweather,#mpitemp}" setprop
prog "msgmacs/season" "{muf:$jweather,#mpiseason}" setprop
prog "msgmacs/skyadj" "{muf:$jweather,#mpiskyadj}" setprop
prog "msgmacs/skynoun" "{muf:$jweather,#mpiskynoun}" setprop
prog "msgmacs/waxwane" "{muf:$jweather,#mpiwaxwane}" setprop
prog "msgmacs/windadj" "{muf:$jweather,#mpiwindadj}" setprop
prog "msgmacs/winddir" "{muf:$jweather,#mpiwinddir}" setprop
prog "msgmacs/winddiradj" "{muf:$jweather,#mpiwinddiradj}" setprop
prog "msgmacs/windnoun" "{muf:$jweather,#mpiwindnoun}" setprop
prog "msgmacs/windspeed" "{muf:$jweather,#mpiwindspeed}" setprop
prog "climates/Temperate/chng" "25" setprop
prog "climates/Temperate/esht" "102" setprop
prog "climates/Temperate/ewlt" "0" setprop
prog "climates/Temperate/ndnd" "16" setprop
prog "climates/Temperate/nsht" "95" setprop
prog "climates/Temperate/nwlt" "28" setprop
prog "climates/Temperate/rain" "25" setprop
prog "config/default" "Temperate" setprop
;
: DoChecks ( -- ) (* make sure program and vars are iniitialized *)
"me" match me ! (* to catch dbref spoofing *)
loc @ ourLoc ! (* make a loc var we can safely fool with *)
#0 "_msgmacs/weather" getpropstr not (* make sure props are set *)
prog "msgmacs/" nextprop not or
prog "climates/" nextprop not or if
DoInstall
then
DoGetClimate ourClimate !
prog "conditions/%clim/init"
ourClimate @ "%clim" subst getpropstr DoGetSeason stringcmp if
DoInitConditions
then
;
: DoMPIHelp ( -- ) (* display MPI help screen *)
"Jweather supports the following MPI functions:" Tell " " Tell
"{weather:windspeed} ... <speed> %units"
SCALE "fahrenheit" smatch if "mph" else "kph" then
"%units" subst
" extremely high winds|gail force winds"
"{weather:windnoun} .... light winds|moderate winds|high winds|"
" southwesterly|westerly|northwesterly"
"{weather:winddiradj} .. northerly|northeasterly|easterly|southeasterly|"
" southwest|west|northwest"
"{weather:winddir} ..... north|northeast|east|southeast|south|"
"{weather:windadj} ..... calm|breezy|windy|very windy|extremely windy"
"{weather:waxwane} ..... waxing|waning"
"{weather:skynoun} ..... clouds|some clouds|a few clouds|no clouds"
"{weather:skyadj} ...... overcast|mostly cloudy|partly cloudy|clear"
"{weather:season} ...... spring|summer|fall|winter"
" warm|hot|very hot|extremely hot"
"{weather:temp} ........ extremely cold|very cold|cold|cool|"
"{weather:precipverb} .. raining|misting|snowing|hailing|\"\""
"{weather:precip} ...... rain|mist|snow|hail|\"\""
"{weather:phase} ....... morning|afternoon|evening|night"
"{weather:moonphase} ... full|gibbous|half|quarter|new"
"{weather:degrees} ..... <temperature in degrees %scale>"
SCALE tolower "%scale" subst
"{weather:daynight} .... day|night"
"{weather:climate} ..... <climate name for current location>"
" FUNCTION RETURNS"
Tell Tell Tell Tell Tell Tell Tell Tell Tell Tell Tell
Tell Tell Tell Tell Tell Tell Tell Tell Tell Tell Tell
;
: DoHelp ( -- ) (* display help screen *)
ourArg @ if
"mpi" ourArg @ stringpfx
"#mpi" ourArg @ stringpfx or if
DoMPIHelp exit
then
then
"jweather.muf (#" prog intostr strcat ")" strcat Tell " " Tell
"Jweather is a MUCK weather system. It can be used to display "
"notifications of weather changes to rooms, or to support weather-"
"related MPI." strcat strcat Tell " " Tell
" %cmd ................... Display current temp and precipitation"
command @ "%cmd" subst Tell
" %cmd #full ............. Display full weather report"
command @ "%cmd" subst Tell
" %cmd #climate .......... Display name of current climate"
command @ "%cmd" subst Tell
" %cmd #climate <name> ... Set climate for current room (o)"
command @ "%cmd" subst Tell
" %cmd #yes .............. Current room will display weather notices (o)"
command @ "%cmd" subst Tell
" %cmd #no ............... Current room won't display weather notices (o)"
command @ "%cmd" subst Tell
" %cmd #start ............ Start weather system (w)"
command @ "%cmd" subst Tell
" %cmd #stop ............. Stop weather system (w)"
command @ "%cmd" subst Tell
" %cmd #config ........... Go to prompt; configure system (w)"
command @ "%cmd" subst Tell
" " Tell
"You must be a wizard or the owner of the current room to use options "
"marked (o). You must be a wizard to use options marked (w). To cause "
"weather notices to go to all rooms in an area, use the #yes option "
"in the area environment room. To set the climate for all rooms in "
"an area, use the #climate option in the area environment room. For "
"help on using MPI with jweather, type '%cmd #help mpi'."
strcat strcat strcat strcat strcat
command @ "%cmd" subst Tell
;
: DoListClimates ( -- ) (* list defined climates *)
">> DEFINED CLIMATES:" Tell
prog "climates/" nextprop dup if
begin
dup while
" " over "" "climates/" subst strcat Tell
prog swap nextprop
repeat
pop
else
" <none>" Tell
then
;
: DoClimate ( -- ) (* set the current location's climate *)
ourArg @ if
me @ loc @ controls if
ourArg @ DoCapAll ourArg !
prog "climates/%clim/" ourArg @ "%clim" subst nextprop if
loc @ "weather/climate" ourArg @ setprop
">> Climate set." Tell
else
" " Tell
DoListClimates
" " Tell
">> No climate called '%clim' has been defined."
ourArg @ "%clim" subst Tell
then
else
">> Permission denied." Tell
then
else
">> The climate at this location is %clim."
DoGetClimate "%clim" subst Tell
then
;
: DoRoomMessage ( d -- ) (* display weather message to room d *)
(* make sure messages haven't been quelled for d *)
dup "weather/quell" getpropstr if pop exit then
(* store room to notify *)
ourLoc !
(* store dir holding room's climate's conditions *)
DoGetClimate "conditions/" swap strcat "/" strcat ourDir !
(* start with a null string; won't notify if no changes *)
""
(* if temp changed, format that as a weather notice; concat *)
prog ourDir @ "temp" strcat getprop atoi
prog ourDir @ "otmp" strcat getprop atoi = not if
"The temperature %verbs."
prog ourDir @ "temp" strcat getprop atoi
prog ourDir @ "otmp" strcat getprop atoi
> if "rises" else "falls" then
"%verbs" subst
strcat
then
(* if precip changed, format that as a weather notice; concat *)
prog ourDir @ "prec" strcat getprop atoi
prog ourDir @ "oprc" strcat getprop atoi = not if
prog ourDir @ "prec" strcat getprop if
dup if
", and it begins to %verb." "." subst
else
"It begins to %verb."
then
else
dup if
", and it stops %verbing." "." subst
else
"It stops %verbing."
then
then
prog ourDir @ "prcf" strcat getprop
"%verb" subst
strcat
then
(* if we ended up with a message, display it to room *)
dup if
ourLoc @ #-1 rot notify_except
else
pop
then
;
: DoRoomLoop ( d -- ) (* display message to d; search for subrooms *)
dup DoRoomMessage (* notify room *)
contents
begin
dup while (* see if it holds child rooms *)
dup room? if
dup DoRoomLoop (* if so, call recursively *)
then
next (* check next contents item of room; is *it* a room? *)
repeat
pop
;
: DoStartWeather ( -- ) (* start loop controlling weather system *)
me @ "W" flag? not if (* check perm *)
">> Permission denied." Tell exit
then
background (* get out of the way *)
DoChecks (* make sure we have all needed props *)
prog "config/pid" getprop dup if (* get rid of any previous loop *)
kill pop
else
pop
then
prog "config/pid" pid setprop (* record pid *)
prog "config/stop" remove_prop
">> Weather system started." Tell (* notify wiz *)
begin (* start weather loop *)
prog "config/stop" getpropstr if (* check: told to stop? *)
prog "config/stop" remove_prop
prog "config/pid" getprop kill
prog "config/pid" remove_prop
pid kill
then
prog "climates/" nextprop (* update weather for each clim *)
begin
dup while
dup DoUpdateWeather
prog swap nextprop
repeat
pop
prog "_rooms/" nextprop dup if (* notify config'd rooms *)
"" "_rooms/" subst atoi dbref ourCounter !
begin
ourCounter @ ok? if (* record if prop holds bad room *)
ourCounter @ room? if
ourCounter @ DoRoomLoop
else
prog "config/badrooms" ourCounter @ REF-add
then
else
prog "config/badrooms" ourCounter @ REF-add
then
prog "_rooms/%room" ourCounter @ intostr "%room" subst
nextprop dup if
"" "_rooms/" subst atoi dbref ourCounter !
else
pop break
then
repeat
else
pop
then
(* remove any rec'd rooms from prop list *)
prog "config/badrooms" REF-allrefs
begin
dup while
prog "_rooms/%room" 4 rotate intostr "%room" subst remove_prop
1 -
repeat
pop
(* sleep for config'd interval, default 1 hour *)
prog "config/interval" getpropstr dup if
atoi
else
pop 3600
then
sleep
repeat
;
: DoStopWeather ( -- ) (* stop the weather loop *)
me @ "W" flag? not if
">> Permission denied." Tell exit
then
prog "config/pid"
over over getprop kill pop remove_prop
prog "config/stop" 1 setprop
">> Weather system stopped." Tell
;
: DoSetYes ( -- ) (* config room to display weather notices *)
me @ loc @ controls if
prog "_rooms/" loc @ intostr strcat 1 setprop
">> Set. This room will display weather notifications."
0 ourCounter !
loc @ contents
begin
dup while
dup room? if
1 ourCounter ! break
then
next
repeat
pop
ourCounter @ if
"room and its child rooms" "room" subst
then
Tell
else
">> Permission denied." Tell
then
;
: DoSetNo ( -- ) (* config room to not display weather notices *)
me @ loc @ controls if
prog "_rooms/" loc @ intostr strcat remove_prop
loc @ "weather/quell" "yes" setprop
">> Set. This room will not display weather notifications." Tell
else
">> Permission denied." Tell
then
;
: DoShowClimateVals ( s -- ) (* show vals for ourClimate *)
">> CURRENT VALUES FOR CLIMATE %name"
over toupper "%name" subst Tell
">> Normal Summer High ......... %val"
prog "climates/%name/nsht" 4 pick "%name" subst
getpropstr "%val" subst Tell
">> Extreme Summer High ........ %val"
prog "climates/%name/esht" 4 pick "%name" subst
getpropstr "%val" subst Tell
">> Normal Winter Low .......... %val"
prog "climates/%name/nwlt" 4 pick "%name" subst
getpropstr "%val" subst Tell
">> Extreme Winter Low ......... %val"
prog "climates/%name/ewlt" 4 pick "%name" subst
getpropstr "%val" subst Tell
">> Normal Day/Night Swing ..... %val"
prog "climates/%name/ndnd" 4 pick "%name" subst
getpropstr "%val" subst Tell
">> Rain Scale ................. %val"
prog "climates/%name/rain" 4 pick "%name" subst
getpropstr "%val" subst Tell
">> Changeability Scale ........ %val"
prog "climates/%name/chng" 4 pick "%name" subst
getpropstr "%val" subst Tell
pop
;
: DoSetNSHT ( -- ) (* set normal summer high temp for ourClimate *)
begin
">> [Enter a normal summer high temperature, or .q to quit]"
">> In this climate, how hot does it normally get in the summer time?"
Tell Tell DoReadLine strip QCheck
dup number? not if
">> Sorry, a temperature entry must be a number."
Tell pop continue
then
prog ourDir @ "nsht" strcat rot setprop break
repeat
;
: DoSetESHT ( -- )(* set extreme summer high temperature for ourClim *)
begin
">> [Enter an extreme summer high temperature, or .q to quit]"
">> What is the hottest it ever gets during summer?"
Tell Tell DoReadLine strip QCheck
dup number? not if
">> Sorry, a temperature entry must be a number."
Tell pop continue
then
prog ourDir @ "esht" strcat rot setprop break
repeat
;
: DoSetNWLT ( -- ) (* set normal low winter temp for ourClimate *)
begin
">> [Enter a normal winter low temperature, or .q to quit]"
">> How cold does it normally get in the winter?"
Tell Tell DoReadLine strip QCheck
dup number? not if
">> Sorry, a temperature entry must be a number."
Tell pop continue
then
prog ourDir @ "nwlt" strcat rot setprop break
repeat
;
: DoSetEWLT ( -- ) (* set extreme low winter temp for ourClimate *)
begin
">> [Enter an extreme winter low temperature, or .q to quit]"
">> What is the coldest it ever gets during winter?"
Tell Tell DoReadLine strip QCheck
dup number? not if
">> Sorry, a temperature entry must be a number."
Tell pop continue
then
prog ourDir @ "ewlt" strcat rot setprop break
repeat
;
: DoSetNDND ( -- ) (* set amount temp drops at night in ourClimate *)
begin
">> [Enter the normal difference between daytime high and nighttime low]"
">> How much does the temperature drop at night?"
Tell Tell DoReadLine strip QCheck
dup number? not if
">> Sorry, a temperature entry must be a number."
Tell pop continue
then
prog ourDir @ "ndnd" strcat rot setprop break
repeat
;
: DoSetRain ( -- ) (* set percent time it rains in ourClimate *)
begin
">> [Enter rain scale as a number between 1 and 100, or .q to quit]"
" is this climate?"
">> On a scale of 1 (never rains) to 100 (always rains), how rainy "
Tell Tell Tell DoReadLine strip QCheck
dup number? not if
">> Sorry, a scale entry must be a number between 1 and 100."
Tell pop continue
then
dup atoi 100 > if
">> Sorry, a scale entry must be a number between 1 and 100."
Tell pop continue
then
dup atoi 1 < if
">> Sorry, a scale entry must be a number between 1 and 100."
Tell pop continue
then
prog ourDir @ "rain" strcat rot setprop break
repeat
;
: DoSetChng ( -- ) (* set percent chance of weather chng *)
begin
">> [Enter changeability scale as a number between 1 and 100, or .q "
"to quit]" strcat
" constantly changing, how changeable is this climate?"
">> On a scale of 1 (weather always the same) to 100 (weather is "
Tell Tell Tell DoReadLine strip QCheck
dup number? not if
">> Sorry, a scale entry must be a number between 1 and 100."
Tell pop continue
then
dup atoi 100 > if
">> Sorry, a scale entry must be a number between 1 and 100."
Tell pop continue
then
dup atoi 1 < if
">> Sorry, a scale entry must be a number between 1 and 100."
Tell pop continue
then
prog ourDir @ "chng" strcat rot setprop break
repeat
;
: DoAddClimate ( -- ) (* define a new climate *)
(* store in temp dir so we won't have partial data if user bails *)
"_temp/%me/" me @ intostr "%me" subst ourDir !
prog ourDir @ dup strlen 1 - strcut pop remove_prop
begin (* get a name for climate *)
">> What is the name of this climate?" Tell
">> [Enter name of climate, or .q to quit]" Tell
DoReadLine strip QCheck
(* if climate exists, confirm overwrite *)
prog "climates/%name/" 3 pick "%name" subst nextprop if
">> A climated named '%name' has already been defined."
over "%name" subst Tell
">> Do you want to overwrite it? (y/n)" Tell
DoReadYesNo not if
">> Aborted." Tell pop continue
then
then
DoCapAll ourClimate ! break
repeat
DoSetNSHT (* set climate parameters *)
DoSetESHT
DoSetNWLT
DoSetEWLT
DoSetNDND
DoSetRain
DoSetChng
DoApplyTempVals (* got all we need; move it to permanent data dir *)
prog "config/default" getpropstr not if
prog "config/default" ourClimate @ setprop
then
DoInitConditions (* initialize conditions for new climate *)
">> Climate %name defined!" ourClimate @ "%name" subst Tell
;
: DoEditClimate ( -- ) (* edit params for an existing climate *)
(* store in temp dir so we won't have partial data if user bails *)
"_temp/%me/" me @ intostr "%me" subst ourDir !
prog ourDir @ dup strlen 1 - strcut pop remove_prop
begin
">> [Enter climate name, or .l to list choices, or .q to quit]"
">> What climate do you want to edit?"
Tell Tell DoReadLine strip QCheck
".list" over stringpfx if
DoListClimates pop continue
then
DoCapAll ourClimate !
"_temp/%me/" me @ intostr "%me" subst ourDir !
break
repeat
begin
">> EDIT OPTIONS FOR %name"
ourClimate @ "%name" subst toupper Tell " " Tell
" "
" D) Extreme Winter Low H) Climate Name"
" C) Normal Winter Low G) Changeability Scale"
" B) Extreme Summer High F) Rain Scale"
" A) Normal Summer High E) Normal Day/Night Swing"
Tell Tell Tell Tell Tell
">> Enter parameter, .s to show current values, .d when "
"done, or .q to quit." strcat
Tell DoReadLine strip QCheck
".done" over stringpfx if
prog "_temp/%me" me @ intostr "%me" subst remove_prop
pop exit
then
".show" over stringpfx if
ourClimate @ DoShowClimateVals pop continue
then
"A" over smatch if
DoSetNSHT DoApplyTempVals
">> Normal summer high temperature set." Tell
pop continue
then
"B" over smatch if
DoSetESHT DoApplyTempVals
">> Extreme summer high temperature set." Tell
pop continue
then
"C" over smatch if
DoSetNWLT DoApplyTempVals
">> Normal winter low temperature set." Tell
pop continue
then
"D" over smatch if
DoSetEWLT DoApplyTempVals
">> Extreme winter low temperature set." Tell
pop continue
then
"E" over smatch if
DoSetNDND DoApplyTempVals
">> Normal day/night swing set." Tell
pop continue
then
"F" over smatch if
DoSetRain DoApplyTempVals
">> Rain scale set." Tell
pop continue
then
"G" over smatch if
DoSetChng DoApplyTempVals
">> Changeability scale set." Tell
pop continue
then
"H" over smatch if
begin
">> [Enter new name, or .q to quit]"
">> What do you want to change the name to?"
Tell Tell DoReadLine strip QCheck
prog "climates/%name/" 3 pick "%name" subst nextprop if
">> There is already a climate named %name."
over "%name" subst Tell
">> Do you want to overwrite it? (y/n)" Tell
DoReadYesNo not if
">> Aborted." Tell pop continue
then
then
DoCapAll
prog "climates/%old" ourClimate @ "%old" subst
prog "climates/%new" 5 pick "%new" subst
CopyDir
prog "climates/%old" ourClimate @ "%old" subst
remove_prop ourClimate !
">> Climate renamed." Tell break
repeat
pop continue
then
">> Sorry, invalid option." Tell pop
repeat
;
: DoDelClimate ( -- ) (* delete an existing climate *)
begin
">> [Enter climate name, or .l to list choices, or .q to quit]"
">> What climate do you want to delete?"
Tell Tell DoReadLine strip QCheck
".list" over stringpfx if
DoListClimates pop continue
then
prog "climates/%name/" 3 pick "%name" subst nextprop not if
">> Climate '%name' not found."
swap "%name" subst Tell continue
then
prog "climates/" rot strcat remove_prop
">> Climate deleted." Tell
(* see if user maybe just deleted default climate; notify if so *)
prog "climates/%clim/"
prog "config/default" getpropstr
"%clim" subst nextprop not if
">> WARNING: Default climate is no longer valid." Tell
">> You should set a new default climate." Tell
then
break
repeat
;
: DoSetDefault ( -- ) (* set default climate *)
begin
">> Which climate should be the default?" Tell
">> [Enter default climate name, .l to list choices, "
"or .q to quit]" strcat Tell
DoReadLine strip QCheck
".list" over stringpfx if DoListClimates pop continue then
prog "climates/%name/" 3 pick "%name" subst nextprop not if
">> Sorry, climate '%name' not found."
swap "%name" subst Tell continue
then
prog "config/default" rot DoCapAll setprop
">> Default climate set." Tell break
repeat
;
: DoSetInterval ( -- ) (* set interval for weather updates *)
begin
">> How often should the weather be updated?" Tell
">> [Enter a time string, such as '1 hour' or '90 minutes', or .q "
"to quit." strcat Tell
DoReadLine strip QCheck
DoParseTimeString not if
">> Invalid entry." Tell continue
then
prog "config/interval" rot intostr setprop
">> Interval set." Tell break
repeat
;
: DoConfigure ( -- ) (* configure weather system *)
me @ "W" flag? if
begin
">> WEATHER CONFIGURATION:" Tell " " Tell
" A) List climates D) Delete a climate" Tell
" B) Add a climate E) Set default climate" Tell
" C) Edit a climate F) Set interval" Tell
" " Tell
">> Enter option A-F, or .q to quit." Tell
DoReadLine strip QCheck
"A" over smatch if DoListClimates else
"B" over smatch if DoAddClimate else
"C" over smatch if DoEditClimate else
"D" over smatch if DoDelClimate else
"E" over smatch if DoSetDefault else
"F" over smatch if DoSetInterval else
">> Sorry, invalid option."
then then then then then then
pop
repeat
else
"Permission denied." Tell
then
;
: DoFullReport ( -- ) (* display a verbose weather report *)
"------------------------------------------------------------------------------"
Tell
">> Current Weather Conditions:" Tell
" Temperature ............... %val degrees"
DoGetTemperature "%val" subst Tell
" Precipitation ............. %val"
DoGetPrecipNoun dup not if pop "none" then
"%val" subst Tell
" Cloud cover ............... %val"
DoGetSkyAdj "%val" subst Tell
" Wind ...................... %val1, at %val2"
DoGetWindDirAdj "%val1" subst
DoGetWindSpeed "%val2" subst Tell
" Moon ...................... %val1 %val2"
DoGetWaxWane "%val1" subst
DoGetMoonPhase "%val2" subst Tell
"------------------------------------------------------------------------------"
Tell
;
: DoReport ( -- ) (* display basic weather conditions for loc *)
">> The temperature is %temp."
DoGetTempAdj "%temp" subst
DoGetPrecipVerb dup if
", and it's " swap strcat "." strcat
"." subst
else
pop
then
Tell
;
: main
DoChecks
dup if
dup "#*" smatch if
dup " " instr if
dup " " instr strcut
strip ourArg !
strip ourOpt !
else
strip ourOpt !
then
then
then
ourOpt @ if
ourOpt @ "#mpi" stringpfx if
"#mpiclimate" ourOpt @ smatch if DoGetClimate else
"#mpidaynight" ourOpt @ smatch if DoGetDayNight else
"#mpidegrees" ourOpt @ smatch if DoGetTemperature else
"#mpimoonphase" ourOpt @ smatch if DoGetMoonPhase else
"#mpiphase" ourOpt @ smatch if DoGetDayPhase else
"#mpiprecip" ourOpt @ smatch if DoGetPrecipNoun else
"#mpiprecipverb" ourOpt @ smatch if DoGetPrecipVerb else
"#mpitemp" ourOpt @ smatch if DoGetTempAdj else
"#mpiseason" ourOpt @ smatch if DoGetSeason else
"#mpiskyadj" ourOpt @ smatch if DoGetSkyAdj else
"#mpiskynoun" ourOpt @ smatch if DoGetSkyNoun else
"#mpiwaxwane" ourOpt @ smatch if DoGetWaxWane else
"#mpiwindadj" ourOpt @ smatch if DoGetWindAdj else
"#mpiwinddir" ourOpt @ smatch if DoGetWindDir else
"#mpiwinddiradj" ourOpt @ smatch if DoGetWindDirAdj else
"#mpiwindnoun" ourOpt @ smatch if DoGetWindNoun else
"#mpiwindspeed" ourOpt @ smatch if DoGetWindSpeed else
""
then then then then then then then then then then then then
then then then then then
exit
else
"#help" ourOpt @ stringpfx if DoHelp else
"#full" ourOpt @ stringpfx if DoFullReport else
"#climate" ourOpt @ stringpfx if DoClimate else
"#start" ourOpt @ stringpfx if DoStartWeather else
"#stop" ourOpt @ stringpfx if DoStopWeather else
"#yes" ourOpt @ stringpfx if DoSetYes else
"#no" ourOpt @ stringpfx if DoSetNo else
"#configure" ourOpt @ stringpfx if DoConfigure else
">> #Option not found." Tell
then then then then then then then then
then
else
DoReport
then
;
.
c
q
.
c
q