@program $lib/alynna 1 1000 d i ( Alynna's MUF function library v5.1 for FB6 ) ( Last updated November 19, 2001 ) ( FB6 compatible tofloat ) : tofloat ( ? -- f ) dup int? if 1.0 * exit then dup float? if exit then dup dbref? if int float exit then dup string? if dup "." instring not if ".0" strcat then dup "." instring 1 = if "0" swap strcat then strtof exit then ; PUBLIC tofloat : toint ( ? -- i ) ( Unconditional convert to int ) dup int? if exit then dup float? if int exit then dup dbref? if int exit then dup string? if atoi exit then ; PUBLIC toint : tostr ( ? -- s ) ( Unconditional convert to str ) dup int? if intostr exit then dup float? if ftostr exit then dup dbref? if intostr exit then dup string? if exit then ; PUBLIC tostr : todbref ( ? -- d ) ( Unconditional convert to dbref ) dup int? if dbref exit then dup float? if int dbref exit then dup dbref? if exit then dup string? if match exit then ; PUBLIC todbref : resolve var target var tmp target ! target @ tmp ! tmp @ pmatch target ! target @ #-1 dbcmp if tmp @ match target ! then target @ ; PUBLIC resolve : astrcat ( a -- s ) ( Take everything in an array and convert it to a string ) "" var! temp array_reverse foreach temp @ swap tostr strcat temp ! repeat temp @ ; PUBLIC astrcat : atellme ( a -- ) ( Tell me everything in the array, which must all be strings ) { me @ } array_make array_notify ; PUBLIC atellme : atellhere ( a -- ) ( Tell me everything in the array, which must all be strings ) me @ location contents_array array_notify ; PUBLIC atellhere : capitalize ( s -- s ) ( Capitalise this string, making the first character uppercase ) 1 strcut swap toupper swap strcat ; PUBLIC capitalize : tellhere ( s -- ) ( tell here the string ) me @ location swap #-1 swap notify_except ; PUBLIC tellhere : tellme ( s -- ) ( tell me the string ) me @ swap notify ; PUBLIC tellme : here ( -- d ) ( return my location ) me @ location ; PUBLIC here : parsempi ( d1 s1 s2 i1 -- s ) ( basically duplicate ProtoMUCK parsempi ) var! i1 var! s2 var! s1 var! d1 d1 @ "_mpi" s1 @ setprop d1 @ "_mpi" s2 @ i1 @ parseprop d1 @ "_mpi" 0 setprop ; : nstrcat ( si .. s1 n -- s ) ( strcat a stackrange ) var nstrcount 1 - nstrcount ! begin strcat nstrcount -- 1 < until ; PUBLIC nstrcat : strcatall ( si .. s1 -- s ) ( cats all strings till a non-string datatype is reached ) begin over string? if strcat else exit then depth 0 = until ; PUBLIC strcatall : str ( -- #-4 ) ( begins string compaction ) #-4 ; PUBLIC str : cat ( #-4 ?n .. ?1 -- s ) ( foolproof cat, ends string compaction section and converts all datatypes to strings, then strcats all strings ) ( Check first string ) dup dbref? if dup #-4 dbcmp if pop "" exit else name then else dup int? if intostr else dup float? if ftostr else dup string? if then then then then ( Start cycling ) begin over dbref? if over #-4 dbcmp if swap pop exit else swap name swap strcat then else over int? if swap intostr swap strcat else over float? if swap ftostr swap strcat else over string? if strcat then then then then depth 0 = until ; PUBLIC cat : mpime ( s -- ) ( Parse the MPI string based on me ) me @ swap "(MPI)" 0 parsempi ; PUBLIC mpime : mpi ( d s -- : Parse the MPI string based on the specified object ) "(MPI)" 0 parsempi ; PUBLIC mpi : statbar ( i2 i1 -- s ) ( outputs a statbar ===*--- i1 = length i2 = filled ) var! tmp1 var! tmp2 me @ str "{right:{if:" tmp2 @ ",*,}," tmp2 @ ",=}{left:,{subt:" tmp1 @ "," tmp2 @ "},-}" cat mpi ; PUBLIC statbar : fstatbar ( i2 i1 -- s ) ( outputs a statbar 4 |===*---| i1 = length i2 = filled ) var! tmp1 var! tmp2 me @ str tmp2 @ " |{right:{if:" tmp2 @ ",*,}," tmp2 @ ",=}{left:,{subt:" tmp1 @ "," tmp2 @ "},-}|" cat mpi ; PUBLIC fstatbar : fchop ( i/f i -- s ) ( rounds and chops a float to i decimal places ) swap tofloat over round ftostr swap over "." instr swap + strcut pop ; PUBLIC fchop : prop? ( d s -- i ) ( returns true if the prop exists, and false if not ) getprop dup int? if 0 = if 0 exit else 1 exit then else pop 1 exit then ; PUBLIC prop? : wassup? ( ? -- i ) ( returns false if the argument is 0, "", or #-1, and true otherwise ) dup string? if "" stringcmp 0 = if 0 exit then then dup int? if 0 = if 0 exit then then dup dbref? if #-1 dbcmp if 0 exit then then 1 ; PUBLIC wassup? : lj ( s i -- s ) ( format to x characters left justified ) swap " " strcat swap ansi_strcut pop ; PUBLIC lj : rj ( s i -- s ) ( format to x characters right justified ) swap " " swap strcat dup ansi_strlen 3 pick - ansi_strcut swap pop swap pop ; PUBLIC rj : ulj ( s i -- s ) ( format to x characters left justified ) swap "______________________________________________________________________________" strcat swap ansi_strcut pop ; PUBLIC ulj : urj ( s i -- s ) ( format to x characters right justified ) swap "______________________________________________________________________________" swap strcat dup ansi_strlen 3 pick - ansi_strcut swap pop swap pop ; PUBLIC urj : ematch ( s3 s2 s1 -- s ) ( Explode match ) ( s3 = "Source string S" s2 = "Explode argument E" s1 = "Match string X" -- "Match found" ) ( Very complex function that matches an stack for the characters in s ) ( Returns s with a match or null, leaves the stack without exploded arguments ) var emS var emE var emX var emI var emT emX ! emE ! emS ! ( Store it all ) emS @ emE @ explode emI ! ( explode on stack, save the count ) emI @ 0 = if "" exit then ( n = 0 ? nothing to explode. Leave. ) begin ( should have string on the stack ) dup emX @ stringpfx if ( Does this string have the first same chars as our search string? ) emS ! emI @ 1 - popn emS @ exit ( if so, return it ) else pop ( remove it from the stack ) then emI @ 1 - emI ! ( decrement emI ) emI @ 0 = until ( until 0 ) "" ( Didnt match, return null, and book it ) ; PUBLIC ematch : eselect ( s2 s1 i -- s ) ( Selects i in explode ) ( s1 = explode seperator s2 = explode string i = number in list to return ) var emS var emE var emX var emI var emT emX ! emE ! emS ! ( Store it all ) emS @ emE @ explode emI ! ( explode on stack, save the count ) 1 emT ! ( initialize emX ) emI @ 1 < if "" exit then ( n < 1 ? nothing to explode. Leave. ) begin ( should have string on the stack ) emT @ emX @ = if ( does emT = emX? ) emS ! emI @ emT @ - popn emS @ exit ( if so, return it ) else pop ( remove it from the stack ) then emT @ 1 + emT ! ( increment emI ) emT @ emI @ > until ( until > emT ) "" ( Didnt match, return null, and book it ) ; PUBLIC eselect : erand ( s2 s1 -- s ) ( Selects a random member of the explode ) ( s1 = explode seperator s2 = explode string ) var emS var emE var emX var emI var emT emE ! emS ! ( Store it all ) emS @ emE @ explode emI ! ( explode on stack, save the count ) random emI @ % 1 + emX ! ( Select a random member of the list ) 1 emT ! ( initialize emT ) emI @ 1 < if "" exit then ( n < 1 ? nothing to explode. Leave. ) begin ( should have string on the stack ) emT @ emX @ = if ( does emT = emX? ) emS ! emI @ emT @ - popn emS @ exit ( if so, return it ) else pop ( remove it from the stack ) then emT @ 1 + emT ! ( increment emI ) emT @ emI @ > until ( until > emT ) ; PUBLIC erand : ecount ( s2 s1 -- i ) ( Returns number of items in the explode ) var emS var emE var emX var emI var emT ( s1 = explode seperator s2 = explode string ) emE ! emS ! ( Store it all ) emS @ emE @ explode emI ! ( explode on stack, save the count ) emI @ popn emI @ exit ( clear the stack, return the count and leave ) ; PUBLIC ecount : invprop ( d s ? -- s ) ( search propdir s on d for value ?, returns prop s, or "" if not found ) var ipD var ipS var ipO ipO ! ipS ! ipD ! ipD @ ipS @ nextprop ipS ! begin ipS @ "" stringcmp if ipD @ ipS @ getprop dup dup string? if ipO @ stringcmp not if pop ipS @ exit then then dup int? if ipO @ = if pop ipS @ exit then then dup dbref? if ipO @ dbcmp if pop ipS @ exit then then pop then ipD @ ipS @ nextprop ipS ! ipS @ "" stringcmp not until "" ; PUBLIC invprop : header ( s -- s ) ( Place string into a header block ) "\[[1;37m-\[[0;34m[ \[[1;33m" swap strcat " \[[0;34m]\[[1;37m----------------------------------------------------------------------------\[[0m" strcat 78 ansi_strcut pop ; PUBLIC header : footer ( s -- s ) ( Place string into a footer block ) "\[[1;37m-----------------------------------------------------------------------------\[[0;34m[ \[[1;33m" swap strcat " \[[0;34m]\[[1;37m-\[[0m" strcat dup ansi_strlen 78 - ansi_strcut swap pop ; PUBLIC footer : pretty ( s s -- s ) ( Prefix string with official prefix ) str swap "<" "blue" textattr swap "bold,yellow" textattr "> " "blue" textattr cat swap strcat ; PUBLIC pretty : timex ( i -- s ) ( translate i seconds to long time string ) var temp fabs int temp ! str temp @ 31536000 >= if temp @ 31536000 / 999 % tostr " years, " then temp @ 86400 >= if temp @ 86400 / 365 % tostr " days, " then temp @ 3600 >= if temp @ 3600 / 24 % tostr " hours, " then temp @ 60 >= if temp @ 60 / 60 % tostr " minutes, " then temp @ 60 % tostr " seconds" cat ; PUBLIC timex : dhm ( i -- s ) ( translate i minutes into xxd mm:ss ) dup 60 % swap 60 / dup 24 % swap 24 / dup if intostr "d " strcat else pop "" then swap intostr dup strlen 1 = if "0" swap strcat then ":" strcat strcat swap intostr dup strlen 1 = if "0" swap strcat then strcat ; PUBLIC dhm : stimestr ( i -- s ) ( return short time string for x seconds ) me @ swap str swap "{stimestr:" swap "}" cat "(STimeStr.MUF)" 0 parsempi ; PUBLIC stimestr : idletime ( d -- i ) ( return object d's lowest idle time ) var temp1 var idle 99999999 idle ! descriptors temp1 ! begin descridle dup idle @ < if idle ! else pop then temp1 @ 1 - temp1 ! temp1 @ not until idle @ ; PUBLIC idletime : onlinetime ( d -- i ) ( return object d's highest connect time ) var temp1 var oltime -1 oltime ! descriptors temp1 ! begin descrtime dup oltime @ > if oltime ! else pop then temp1 @ 1 - temp1 ! temp1 @ not until oltime @ ; PUBLIC onlinetime : numplayers ( d -- i ) ( return the number of players at the current location ) 0 swap contents begin dup ok? while dup player? if dup awake? if swap 1 + swap then then next repeat pop ; PUBLIC numplayers : main ( -- ) ( installer ) prog "/_defs/++" "" setprop prog "/_defs/--" "" setprop prog "/_defs/str" "#173779 \"str\" call" setprop prog "/_defs/cat" "#173779 \"cat\" call" setprop prog "/_defs/ecount" "#173779 \"ecount\" call" setprop prog "/_defs/ematch" "#173779 \"ematch\" call" setprop prog "/_defs/erand" "#173779 \"erand\" call" setprop prog "/_defs/eselect" "#173779 \"eselect\" call" setprop prog "/_defs/fchop" "#173779 \"fchop\" call" setprop prog "/_defs/footer" "#173779 \"footer\" call" setprop prog "/_defs/fstatbar" "#173779 \"fstatbar\" call" setprop prog "/_defs/header" "#173779 \"header\" call" setprop prog "/_defs/here" "#173779 \"here\" call" setprop prog "/_defs/invprop" "#173779 \"invprop\" call" setprop prog "/_defs/lj" "#173779 \"lj\" call" setprop prog "/_defs/lju" "" setprop prog "/_defs/mpi" "#173779 \"mpi\" call" setprop prog "/_defs/mpime" "#173779 \"mpime\" call" setprop prog "/_defs/nstrcat" "#173779 \"nstrcat\" call" setprop prog "/_defs/parsempi" "#173779 \"parsempi\" call" setprop prog "/_defs/pretty" "#173779 \"pretty\" call" setprop prog "/_defs/prop?" "#173779 \"prop?\" call" setprop prog "/_defs/resolve" "#173779 \"resolve\" call" setprop prog "/_defs/rj" "#173779 \"rj\" call" setprop prog "/_defs/rju" "" setprop prog "/_defs/statbar" "#173779 \"statbar\" call" setprop prog "/_defs/tellhere" "#173779 \"tellhere\" call" setprop prog "/_defs/tellme" "#173779 \"tellme\" call" setprop prog "/_defs/timex" "#173779 \"timex\" call" setprop prog "/_defs/todbref" "#173779 \"todbref\" call" setprop prog "/_defs/tofloat" "#173779 \"tofloat\" call" setprop prog "/_defs/toint" "#173779 \"toint\" call" setprop prog "/_defs/tostr" "#173779 \"tostr\" call" setprop prog "/_defs/ulj" "#173779 \"ulj\" call" setprop prog "/_defs/urj" "#173779 \"urj\" call" setprop prog "/_defs/wassup?" "#173779 \"wassup?\" call" setprop prog "/_defs/dhm" "#173779 \"dhm\" call" setprop prog "/_defs/stimestr" "#173779 \"stimestr\" call" setprop prog "/_defs/idletime" "#173779 \"idletime\" call" setprop prog "/_defs/onlinetime" "#173779 \"onlinetime\" call" setprop prog "/_defs/numplayers" "#173779 \"numplayers\" call" setprop prog "/_defs/astrcat" "#173779 \"astrcat\" call" setprop prog "/_defs/atellme" "#173779 \"atellme\" call" setprop prog "/_defs/atellhere" "#173779 \"atellhere\" call" setprop prog "/_defs/capitalize" "#173779 \"capitalize\" call" setprop prog "L" set prog "V" set "libAlynna v5.3.20020625 for FB6" header tellhere "The library is installed properly" "TEST" pretty tellhere "LINK_OK VIEWABLE" "REQUIRES" pretty tellhere "str cat ecount ematch erand eselect fchop footer header dhm" "PROVIDES" pretty tellhere "invprop lj lju mpi mpime nstrcat pretty prop? rj rju tellhere" "PROVIDES" pretty tellhere "tellme timex todbref tofloat toint tostr ulj urj wassup? stimestr" "PROVIDES" pretty tellhere "dhm onlinetime idletime numplayers astrcat atellme atellhere capitalize" "PROVIDES" pretty tellhere "resolve snatch parsempi" "PROVIDES" pretty tellhere "Alynna's MUFInstaller" footer tellhere ; . c q +lib/alynna