' ' Commons.dxl ' (for Underworld) ' ' by Cris (cris@dimensionex.net) ' http://www.dimensionex.net ' ' This software is Open Source released under the GPL License ' ' General Purpose Routines ' ' Version 21.9 ' EVENT Living person = getObject($OWNER) If person.type=0 'Special characters always live person.Health=10 Return true End_If ' The following is for all remaining characters ' Restore health a little bit person.Health = person.Health+0.2 If person.artdefense = "survival" If person.Health < 1 Dim item = getContainedType(person,"bottle.potion") If item <> null Print person,"Survival: I drink the potion!" Call drinkPotion(person,item) End_If End_If End_If If person.Health > 10 ' Limits health to 10 person.Health = 10 End_If If person.toxine > 1 person.Health = person.Health-0.2*person.toxine End_If person.Health = Round(person.Health,1) 'Decreases invulnerability If person.invul person.invul = person.invul-1 End_If Call checkInvis(person) Call levelParams(person) person.angry=0 ' Calm down werewolves person.lastattacker = null ' Clear last attacker If ExistScript("Living_local") Call Living_local(person) 'Calls local Living() sub, if defined End_If If Not(IsPlayer(person)) Call robotAI(person) Else person.ticker=person.ticker+1 End_If If person.container = hellfire Dim item For Each item In getItemsIn($TARGET) Move item,RndSet(setAll) Next End_If If Not(Exists(person)) ' If just died, quit Return End_If Call checkLevelAdvance(person) 'Returns result - if positive, character will live Dim survives = (person.Health > 0) Return survives End_EVENT Sub incKilledCount(loser,winner) If winner.remoteAddr <> null and winner.remoteAddr = loser.remoteAddr and loser.remoteAddr <> "127.0.0.1" Speak SYS,winner,"Struggling with yourself? Need a shrinker?" Return End_If If loser.type=3 ' Neutral type Print winner,"I don't get any points for killing neutral people." Return End_If If IsPlayer(loser) And IsBeginner(loser) And IsPlayer(winner) And winner.Level > 1 If loser.Level < 2 winner.Health = winner.Health/2 End_If If IsPlayer(loser) And loser.Level<=Round(winner.Level/2,0) ' Lower level Print winner,"I don't get any points for killing players whose Level is <= "+Round(winner.Level/2,0)+"." Return End_If End_If 'Update global counters If loser.type <= 10 hkilled = hkilled+1 Else mkilled = mkilled+1 End_If 'Update winner's guild's kills count (effective in area1 only) If IsCharacter(winner) Dim winnerguild = winner.guild If winnerguild <> null If winnerguild = loser.guild Print winner,"I don't get any points for killing my guild's members." Return End_If If loser.guild = null And IsPlayer(loser) Print winner,"No points for killing players that are not any guild's members" Return End_If guildkills(winnerguild) = 1 + guildkills(winnerguild) End_If ' Update own stats on winner Dim loserguild = loser.guild If loserguild = null ' Fix up guild If loser.type <= 10 loserguild = "_humans" Else loserguild = "_monsters" End_If End_If If winner.killstats = null ' Fix up kill stats winner.killstats = NewSet() End_If winner.killstats(loserguild) = 1 + winner.killstats(loserguild) 'Update kills count in profile If IsPlayer(winner) Call advanceCheck(winner,"kills",getKillTotal(winner)-winner.Kills) End_If End_If End_Sub EVENT onNew PlayBackground $AGENT,bakmusic, 0 If Not($AGENT.master) And blocked($AGENT.name) $AGENT.name = "a jailed user" Call doJail($AGENT,$AGENT.name,SYS) Return false End_If ' Suspend masters during tournament If master=1 If tournament>0 And Not($AGENT.mastersuper) And (tournament<>5) $AGENT.master = 0 End_If Else master="" End_If $AGENT.balanceignore=null If $AGENT.master $AGENT.balanceignore=1 End_If If $AGENT.whipper If SetLen(getObjectsType($AGENT,"whip")) < 1 Call restore("whip","*",$AGENT) End_If End_If If $AGENT.type > 0 ' Player is back with a restored game ' Fix panel if needed If $AGENT.type = 2 If $AGENT.master SetPanel $AGENT, "pmastercleric" Else SetPanel $AGENT, "pcleric" End_If End_If If $AGENT.type = 4 If $AGENT.master SetPanel $AGENT, "pmasterartisan" Else SetPanel $AGENT, "partisan" End_If End_If If $AGENT.type < 2 If $AGENT.master SetPanel $AGENT, "pmasterwarrior" Else SetPanel $AGENT, "pwarrior" End_If End_If If $AGENT.type>=10 ' Monster If $AGENT.type=10 Or $AGENT.type=16 Or $AGENT.type=12 Or $AGENT.type=14 If $AGENT.master SetPanel $AGENT, "pmastervamp" Else SetPanel $AGENT, "pvampire" End_If End_If If $AGENT.type=19 If $AGENT.master SetPanel $AGENT, "pmasterdarken" Else SetPanel $AGENT, "pdarken" End_If End_If If $AGENT.yell = "" $AGENT.yell = "roar1.wav" End_If End_If If getTime("dd/MM/yyyy")=smDay Speak SYS,$AGENT,"Today is Sottomondo Day!! Free Drinks at the castle's tavern and bonuses for all!!" 'Dim fbid = getSetting($AGENT.name & "_fbid") 'If fbid="" ' fbid=getSetting(CookName($AGENT.name)&"_fbid") 'End_If 'If fbid ' fbusers(fbid)=$AGENT.name 'End_If Else Dim msg = getTournamentMessage() If msg <> "" Speak SYS,$AGENT,msg End_If End_If Speak SYS,$AGENT,frontpagetext $AGENT.ticksaved = kingTicks-9 'Enable saving Call levelParams($AGENT) ' Fix guild info $AGENT.guild = guildSubscribed($AGENT) If $AGENT.guildrequest <> null If InStr(guildrequests($AGENT.guildrequest),$AGENT.name+";") Print $AGENT,"My request for guild " + guildnames($AGENT.guildrequest) + " is still pending." Else If InStr(guildsubscribers($AGENT.guildrequest),$AGENT.name+";") Speak SYS,$AGENT,"Your request for guild " + guildnames($AGENT.guildrequest) + " has been APPROVED!!" Else Speak SYS,$AGENT,"Your request for guild " + guildnames($AGENT.guildrequest) + " has been rejected. Too bad." End_If $AGENT.guildrequest = null End_If End_If ' Tournament operation If $AGENT.tickertype<>tournament ' If new tournament then reset ticker $AGENT.tickertype = tournament $AGENT.ticker = 0 End_If End_If ' Hooked $AGENT.__hooked = NewSet() 'Create missing arrays for protections & weapons Call FixArrays($AGENT) 'Fix invisibile avatar If LCase(Right($AGENT.image("N").url,9))="blank.gif" Or LCase(Right($AGENT.image("N").url,10))="spacer.gif" Call restoreAvatar($AGENT) If $AGENT.invisible Call doInvis($AGENT) End_If End_If Call checkInvis($AGENT) 'Credit Score added by husband/wife If $AGENT.score_added > 0 If incrScore($AGENT.name,$AGENT.score_added) ' Done - reset score_added on disk Dim nick = CookName($AGENT.name) Dim tmp = getSetting(nick + "_properties","") SaveSetting nick + "_properties",tmp+",score_added=0" $AGENT.score_added = NULL Else Debug "Warning: cannot increment by score_added for " + $AGENT End_If Else $AGENT.score_added = NULL End_If Dim footprint = $AGENT.getCookie("footprint") If $AGENT.mainpg = "" $AGENT.mainpg = footprint If $AGENT.mainpg = "" Call $AGENT.SaveCookie("footprint",$AGENT.name) $AGENT.mainpg = $AGENT.name End_If Else If footprint = "" Call $AGENT.SaveCookie("footprint",$AGENT.mainpg) Else If $AGENT.mainpg <> footprint $AGENT.lastused=footprint+"/"+getTime("dd/MM/yyyy HH:mm") Call SaveProperty($AGENT.name,"lastused",$AGENT.lastused,false) End_If End_If End_If 'Speak SYS,$AGENT,"Alias: " + $AGENT.mainpg If IsJailed($AGENT.mainpg) Call doJail($AGENT,$AGENT.name,SYS) End_If If dbdown Print "Game profiles database offline - Using backup profile" $AGENT.__backupprofile = true End_If PlaySound $WORLD,"connect.wav" Call onNew_local ' Calls local onNew subroutine End_EVENT EVENT onEnter If $OWNER.type=14 ' Vampires die in sunlight Call checkLight($OWNER) End_If End_EVENT EVENT onBite If $AGENT.type = 14 Or $AGENT.type = 16 Call doBite($AGENT,$OWNER) Else Print msgNOTNOW End_If End_EVENT EVENT onLook Dim what = getObject($OWNER) Call checkAffinity(what) If IsPlayer(what) PrintRight htmlUsedEquip(what) PrintRight htmlArts(what) PrintRight htmlAffinitiesCompact(what,"Base Affinity") PrintRight htmlAffinitiesCompact(calcAffiResult(what,what.weapon,"weapons"),"Attack Affinity") Dim s = what.guild If s<>null PrintRight "
" + getGuildBox(s,0) + GuildDelegateIcon(what.name,s) Else If what.guildrequest <> null PrintRight "
" +"Pending request for: " + guildnames(what.guildrequest) + "" End_If End_If If ProfileExists(what.name) PrintRight "
" + "Character page: " & UserCardLink(what.name) fbid = getSetting(what.name & "_fbid") If fbid="" fbid=getSetting(CookName(what.name)&"_fbid") End_If If fbid If s<>null And s=$AGENT.guild PrintRight "
"&NewImage("fb.gif",16,16).html("Facebook user!")+" Facebook user" Else PrintRight "
"&NewImage("fb.gif",16,16).html("Facebook user!")+" Facebook user" End_If If what.name<>CookName(what.name) 'Try fixing saveSetting CookName(what.name)&"_fbid",fbid End_If End_If End_If PrintRight MarriedBox(what) Call printKillStats(what) ' Amulet If what.invisible If ContainsType($AGENT,"amulet.invis",false) Call doInvis(what) End_If End_If Return End_If If IsCharacter(what) ' If looking at a character... If areEnemies(what,$AGENT) Dim empathic = false If $AGENT.type=12 Or $AGENT.type=14 'Vampire empathic = empathy($AGENT,what) End_If If empathic Print "Can be hypnotized!" End_If Else 'Ally If (what.type=1 And what.command=null) Call humanknight_speak() End_If End_If If what.progeny <> null Print "Progeny of: "+UserCardLink(what.progeny) End_If Print robotCommandForm(what,$AGENT) PrintRight htmlUsedEquip(what) PrintRight htmlArts(what) PrintRight htmlAffinitiesCompact(what,"Base Affinity") Call FixArrays(what) PrintRight htmlAffinitiesCompact(calcAffiResult(what,what.weapon,"weapons"),"Attack Affinity") Call printKillStats(what) Else If what.getProperty(cstPROT)>0 Or what.getProperty(cstPOWER)>0 Print "Item ID: "+what.type End_If Print htmlAffinitiesCompact(what,"Affinity") ' Print $WORLD,"- " + what + " and " + $AGENT + " no enemies" If what.designer <> null Print "Designer: " + UserCardLink(what.designer) + "
" End_If If $AGENT.Level < 3 And what.Protection > 0 Print "["&htmlIcon("panuse.gif","USA")&" USE] this object in order to add it to your permanent equipment!

" End_If End_If End_EVENT EVENT beforeOpen If $OWNER.locked And $OWNER.unlocker <> null Dim k = getContainedType($AGENT,$OWNER.unlocker) If k <> null ' Yes you've got the correct key If Not($OWNER.locked) Print "It is not locked." Return false End_If $OWNER.locked=Not($OWNER.locked) Display "Done! I used " + $OWNER.unlocker.name + " and it worked perfectly." If $OWNER.linked <> null $OWNER.linked.locked = $OWNER.locked End_If Else Display "Hmmm... It seems that nothing I have is working." End_If End_If End_EVENT Sub drinkPotion(person,potion) If potion.type = "bottle.poison" Speak "The spirit is poisonous!" person.Health = person.Health - 5 Return End_If If potion.uses <= 0 Return false End_If If potion.type = "bottle.water" Print person,"Ahhhhhhh! How refreshing." PlaySound person,"bubblegurggle.wav" person.Health = person.Health+1 Call levelParams(person) End_If If potion.type = "bottle.potion" ' Potion person.Health = 10 Display person,"WOW! I feel much better now!!" If person.gender = "F" PlaySound person,"woohoof.wav" Else PlaySound person,"woow.wav" End_If End_If If potion.type = "bottle.antidote" person.toxine = 0 Display person,"Toxine neutralized!!" If person.gender = "F" PlaySound person,"woohoof.wav" Else PlaySound person,"woow.wav" End_If End_If potion.uses = potion.uses-1 If potion.uses = 0 potion.icon = "bottlempty.gif" potion.image = "bottlempty.gif" potion.name = "empty bottle" potion.Value = 1 potion.type = "bottle.empty" potion.description = "The bottle is now empty." End_If EVENT onReceiveItem If $TARGET.vanishing 'Vanishing item If $TARGET.vanishing < 2 And Not(IsRoom($OWNER)) Return End_If 'Print $AGENT,$TARGET.name + " vanishes" Kill $TARGET Return false End_If End_EVENT EVENT onReceive Dim x = getContainedType($OWNER,"bomb.proximity") Call checkBomb(x) If IsPlayer($TARGET) = false Return End_If ' This loop looks a little bit strange ' I just wanted to avoid bugs when removing items Dim i Dim c Dim setHooked = $TARGET.__hooked Dim n = SetLen(setHooked) For i=0 To n-1 c = setHooked(SetKey(setHooked,n-i)) If Exists(c) Move c,$OWNER Else SetRemove setHooked,SetKey(setHooked,n-i) End_If Next If ExistScript("onReceive_Local") Call onReceive_Local() End_If End_EVENT EVENT whenPicked If $TARGET.type = 0 Return true ' Managed by onReceiveItem End_If If $OWNER.Level > $TARGET.Level Display "To use "+$OWNER.name+" I need at least Level "+$OWNER.Level Move $OWNER,$TARGET.container Return false End_If ' Management of money If $OWNER.Cash>0 ' Money!! Store value for later Dim value = $OWNER.Cash If $OWNER = coins And mode<2 ' If picking up hidden gold then actually hide it somewhere else $OWNER.hidden = 1 $OWNER.Cash = 2 + RndInt(5) Move $OWNER, RndSet(setCastle) Else ' If generic money - delete it Kill $OWNER End_If ' Create/update another money pack with stored value Call giveMoney($TARGET,value) ' Return false, otherwise the moved/deleted money will actually appear in inventory Return false End_If Call checkAffinity($OWNER) If MainType($OWNER)="weapon" And Not(IsMagician($TARGET)) If $TARGET.weapon = null Or getContainedType($TARGET,$TARGET.weapon) = null Dim weapon = getContainedType($TARGET,"weapon") Display $TARGET,"Current weapon: " + weapon.name + ", Power: " + weapon.Power $TARGET.weapon = weapon.type End_If Return End_If If Left($OWNER.type,12)="spell.attack" And IsMagician($TARGET) If $TARGET.weapon = null Or getContainedType($TARGET,$TARGET.weapon) = null Dim weapon = $OWNER Display $TARGET,"Current attack spell: " + weapon.name + ", Power: " + weapon.Power $TARGET.weapon = weapon.type End_If Return End_If If $OWNER.type = "amulet.invis" And $TARGET.invisible Call doInvis($TARGET) End_If If ExistScript("whenPicked_Local") Return whenPicked_Local() End_If End_EVENT EVENT onTick ticks = 1+ticks ' Increment world's ticker Call onTick_local ' Calls local onTick subroutine Call checkBomb(activebomb) ' Check exploding bombs Call doRndMusic() ' Music update Call manageInfections() 'Infections by vampire Call nightDayCycle() Call balanceGame(monstersPopupSet) 'Balance situation Call unexpectedEvents_Local 'Local sub - optional END_EVENT Function calcMonstersLeft Dim tmp = targkilled-mkilled If tmp < 0 tmp = 0 End_If Return tmp EVENT onBuy If $OWNER.Value = 0 Display "Hmm... I don't think I can buy this." Return false End_If If $OWNER.seller = "" Display "It is not for sale, I can simply pick it up." Return false End_If If InCatalog($OWNER.type) Return buy_item($OWNER.type) End_If If $OWNER.Level > $AGENT.Level Display "To buy this one, it is required at least Level "+$OWNER.Level Return false End_If Dim money=0 Dim moneypack Dim item For Each item In getItemsIn($AGENT) If item.Cash > 0 money=item.Cash moneypack=item End_If Next shopkeeper = $AGENT.container.shopkeeper If money >= $OWNER.Value 'You have got enough money item = cloneItem($OWNER) If item = null item = $OWNER End_If item.seller = "" Move item, $AGENT If item.container = $AGENT ' Transaction being successful moneypack.Cash = moneypack.Cash - $OWNER.Value moneypack.name = "" + moneypack.Cash + " coins" If moneypack.Cash = 0 Kill moneypack End_If Speak shopkeeper,$AGENT,"Thanks stranger, and come back whenever you need good stuff!" Else Display "Can't hold more objects. I should DROP something." $OWNER.seller = shopkeeper End_If Else Display "Don't have enough money. It costs " + $OWNER.Value + " coins." Return false End_If EVENT onSell Dim item = getObject($OWNER) If $OWNER.container <> $AGENT Display "I don't own it." Return false End_If If $AGENT.container.shop <> 1 Display "This is not a shop." Return false End_if If $OWNER.Value = 0 Display "I can't sell this item." Return false End_If Dim shopkeeper = $AGENT.container.shopkeeper If shopkeeper = null Return false End_If Dim value = Int($OWNER.Value * 0.8) If value = 0 value = 1 End_If If InCatalog($OWNER.type) Dim dummy If limitedavails And $AGENT.container.shopkeeper.avail(item.type) >= 10 ' Too many items in stock Speak shopkeeper,$AGENT,"I have got too much of that stuff, already, thanks!" Return false End_If Else If IsAcquirable($OWNER) If Not(SanityCheck($OWNER)) Speak shopkeeper,$AGENT,"This object cannot be used: " & SharedError Return false End_If End_If End_If Speak shopkeeper,$AGENT,"OK I pay " + value + " coins for this one, take!" Call giveMoney($AGENT,value) If InCatalog($OWNER.type) Kill $OWNER If limitedavails If SetContainsKey($AGENT.container.shopkeeper.avail,item.type) $AGENT.container.shopkeeper.avail(item.type) = 1 + $AGENT.container.shopkeeper.avail(item.type) End_If End_If 'Print "ON CATALOG" Return Else If IsAcquirable($OWNER) Call CatalogStoreItem(item) Call shops_prepare(arrShopkeepers) Kill item 'Print "ACQUIRED AND UPDATED" Return Else Dim dummy 'Print "NOT ACQUIRABLE" End_If End_If If SetContainsKey(cloneableTypes,MainType($OWNER)) If SetLen(getObjectsType(shopkeeper.container,$OWNER.type)) > 0 Kill item Return End_If End_If Move $OWNER, shopkeeper.container If Exists($OWNER) $OWNER.seller = shopkeeper End_If End_EVENT EVENT onYell If $AGENT.type <= 10 Print msgNOTNOW Return false End_If PlaySound $AGENT.container, $AGENT.yell Dim c For Each c In getCharactersIn($AGENT.container) If c.type > 0 And c.Level=1 And c <> $AGENT And c.type <> 3 If areEnemies(c,$AGENT) Print c,"HEY!! " + $AGENT.name + " is yelling at me!!" Call c.go($AGENT.facing) End_If End_If Next EVENT onDie ' If Exists($OWNER.killer) And $OWNER.killer <> $OWNER Speak SYS,$WORLD,UserCardLink($OWNER.name) + " has been vanquished by " + $OWNER.killer.name + "!!" If $OWNER.killer.name = $OWNER.married $OWNER.killer.married = null End_If Else Speak SYS,$WORLD,UserCardLink($OWNER.name) + " has been vanquished!!" End_If PlaySound $WORLD,"monster_death.wav" ' doRndMusic ' ' Updates background music (Juke-Box) ' with Random track - to be called at each tick ' ' global variables ' musicSet (input) ' musicTicks Sub doRndMusic() musicTicks=musicTicks-1 If musicTicks<=0 'Time to put on a new track! Dim track,length If SetLen(playlist) > 0 ' Alternate Playlist playlist = CutFirst(playlist) ' Cut first entry away playlistLen = CutFirst(playlistLen) ' Cut first entry away End_If If SetLen(playlist) > 0 ' Alternate Playlist track = playlist(1) length = playlistLen(1) SetRemove playlist,1 'Speak SYS,$WORLD,"Playlist is now: " + playlist Else If SetLen(musicSet) < 1 Return End_If Dim n = RndInt(SetLen(musicSet)) Dim tmp = musicSet(n) Dim tmparr = Split(tmp,"|") track = Replace(tmparr(1),"$dir$",gameInfo("site")+"downloads") length = tmparr(2) End_If 'Speak SYS,$WORLD,"playing now " + track + " " + length Call doMusic(track,length) End_If End_Sub ' doMusic ' ' Updates background music (Juke-Box) ' with specific track ' ' input ' track track to be played ' mins estimated duration ' global variables ' musicTicks ' bakmusic Sub doMusic(track,mins) bakmusic = track musicTicks = mins*2 PlayBackground $WORLD, bakmusic, false End_Sub EVENT onGather If $AGENT.container = lake Or $AGENT.container = cave4 Or $AGENT.container.id = "castlebridge" Dim myset = getObjectsType($AGENT,"bottle.empty") If SetLen(myset) < 1 myset = getObjectsType($AGENT,"bottle") End_If If SetLen(myset) >= 1 Dim mycont = myset(1) mycont.image = "bottlewater.gif" mycont.icon = "bottlewaterico.gif" mycont.uses = 3 mycont.Value = 2 mycont.type = "bottle.water" mycont.name = "bottled water" mycont.description = "Clear, transparent, makes me thirsty." PlaySound $AGENT,"bubblegurggle.wav" Display "Done!" Return End_If End_If If $AGENT.container = cave7 If $AGENT.type = 4 Call NewItem($AGENT,"stone","It's a table of rock mineral.",NewImage("spelltablet.gif",48,48),"pickable,showmode=2,icon=spelltablet.gif,type=stone,Value=2") $AGENT.Health = $AGENT.Health - 2 Print $AGENT,msgNOWREST Else Print $AGENT,"I can't get anything out from rocks, sorry, only a craftsman can do it." End_If Return End_If Display $AGENT,"I haven't got the right container." EVENT onCombine ' Magician operations If $OWNER.type = "bottle.water" And $TARGET.name = "cymbidium" Call refillPotion($OWNER) Call advanceCheck($AGENT,"spells",1) Return 1 End_If If $TARGET.type = "bottle.water" And $OWNER.name = "cymbidium" Call refillPotion($TARGET) Call advanceCheck($AGENT,"spells",1) Return 1 End_If If $AGENT.Level >=2 ' Expert If ($OWNER.type = "bottle.potion" And IsCharacter($TARGET)) Call drinkPotion($TARGET,$OWNER) If IsPlayer($TARGET) And $TARGET.Health <= 2 Call advanceCheck($AGENT,"spells",2) Else Call advanceCheck($AGENT,"spells",1) End_If Print "Done!" Return true Else Print "I don't know how..." End_If Else Print "To do that, I need at least Level 2" End_If EVENT onUse If $OWNER.seller <> "" Print "This item is for sale" Speak $OWNER.seller, $AGENT, "Hey, this will cost you " + $OWNER.Value + " coins!", "You need " + $OWNER.name + " huh? It is on sale, you know.", "Look: special price for you: "+ $OWNER.Value + " coins!" Return false End_If If $OWNER.Level > $AGENT.Level Print "For this I need at least Level "+$OWNER.Level Return false End_If Return doUse($AGENT,$OWNER) EVENT onUseWith Dim success = false If $OWNER.Level > $AGENT.Level Print msgATLEASTLVL+$OWNER.Level Return false End_If If $TARGET.Level > $AGENT.Level Print msgATLEASTLVL+$TARGET.Level Return false End_If ' If $AGENT.type=4 ' Craftsman operations ' BOMB If ($OWNER.type = "powder" And $TARGET.type = "bottle.empty") Or ($OWNER.type = "bottle.empty" And $TARGET.type = "powder") If $AGENT.Level < 2 Print msgATLEASTLVL+2 Return false End_If Dim powder = $OWNER Dim bomb = $TARGET If $OWNER.type = "bottle.empty" And $TARGET.type = "powder" bomb = $OWNER powder = $TARGET End_If If bomb.container <> $AGENT Return false End_If bomb.image = NewImage("bomb.gif",40,40) bomb.icon = "bomb.gif" bomb.name = "bomb" bomb.description = "A bomb." bomb.Value = 10 bomb.sound = "match.wav" bomb.type = "bomb" PlaySound $AGENT,"fanfare.wav" Kill powder Call advanceCheck($AGENT,"crafts",1) $AGENT.Health = $AGENT.Health-1 success = true End_If ' BOMB TRAP If ($OWNER.type = "bomb" And $TARGET.type = "trap") Or ($OWNER.type = "trap" And $TARGET.type = "bomb") Dim bomb = $OWNER Dim trap = $TARGET If $OWNER.type = "trap" And $TARGET.type = "bomb" bomb = $TARGET trap = $OWNER End_If If trap.container <> $AGENT Return false End_If bomb.image = NewImage("bombtrap.gif",40,40) bomb.icon = "bombtrap.gif" bomb.name = "bomb trap" bomb.description = "A bomb with a trap mechanism." bomb.Value = 22 bomb.sound = "click.wav" bomb.type = "bomb.trap" PlaySound $AGENT,bomb.sound Kill trap Call advanceCheck($AGENT,"crafts",1) $AGENT.Health = $AGENT.Health-1 success = true End_If ' End_If If Not(success) And ExistScript("onUseWith_Local") success = onUseWith_Local() End_If Return success Sub refillPotion(target) ' input: "target" should reference the bottle object target.uses = 5 target.name = "healing potion" target.description = "Label reads: 'Healing Potion'" target.image = "potion.gif" target.icon = "bottle3.gif" target.type = "bottle.potion" target.Value = 5 Display target.container,"The bottle fills up with magic potion!" PlaySound target.container,"bubblegurggle.wav" EVENT onSave 'If $TARGET = "" ' Print $OWNER,"Save and Exit" 'Else ' Print $OWNER,"Save and continue" 'End_If If $OWNER.container = bedroom Return "I can't do it in this room." End_If If dbdown Display $OWNER,"Can't do this because of technical problems on database. Please wait awhile." Return false End_If If $OWNER.__backupprofile Display $OWNER,"You are using the backup profile. This one can't be saved." Return false End_If If debugmode Or (kingTicks-$OWNER.ticksaved) > 8 $OWNER.ticksaved = kingTicks Return 1 Else Display $OWNER,"Can't save the game so often. Let's wait awhile." Return false End_If End_EVENT ' Die for vampires when in sunlight ' Input: target character Sub checkLight(target) If itsday If Not(SetContainsKey(setCovered,target.container.id)) And target.container.dark=false ' Not in dark places Nor In buildings Display target,"AAARGHHH!!! Sunlight is killing me!!" Kill target End_If End_If End_Sub EVENT onTransform Call doTransform($AGENT) Sub manageInfections() ' Is still an existing Player? (Might have disconnected in the meantime) Call infect_SpecialCase If Exists(infected) And Exists(infector) ' Normal case infected.prevtype = infected.type infected.type = infectype If IsPlayer(infector) Or infector.progeny = "" infected.progeny = infector.name Print infector,"New adept: "+infected.name+" in "+infected.container.name Else infected.progeny = infector.progeny Dim p = getPlayer(infector.progeny) If p <> null Speak infector,p,"New adept for your progeny! "+infected.name+" in "+infected.container.name If Not(IsPlayer(infected)) Call GiveMoney(p,2) Print p,infector.name + msgEXECUTED Kill infector End_If End_If End_If If infectype = 16 infected.Class = "Werewolf" infected.type = 10 If Not(IsPlayer(infected)) infected.angry=1 Call doTransform(infected) End_If Else infected.Class = "Vampire" If infected.gender = "F" infected.image("N") = NewImage("vampirebride.gif",93,100) Else infected.image("N") = NewImage("vampire.gif",95,100) End_If PlaySound infected.container,"death.wav" End_If Speak SYS,infected, "You have turned into a " + infected.Class + "!!!" infected.yell = "roar2.wav" infected.Strength = infected.Strength + 2 If cross.container = infected And infected.type=14 Move cross,infected.container End_If SetPanel infected, "pvampire" RefreshView infected.container If infected.type = 14 Call checkLight(infected) End_If 'Credit points to infector If Exists(infector) If SameIPorGuild(infector,infected) Print infector,"Infection of "+infected.name+" is not taken into account for advancement." Else Call advanceCheck(infector,"infections",1) End_If End_If End_If infected = null infector = null End_Sub Function doBite(attacker,victim) If ExistScript("doBite_Local") If doBite_Local(attacker,victim) 'Already Managed? Return false 'Exit End_If End_If If Not(victim.type>0) Or victim.invul Or victim.type=3 Display "I can't..." Return false End_If If victim.type >= 10 Display "I do not bite monsters." Return false End_If If attacker.type=10 Display "I can't do it right now." Return false End_If If attacker.type=14 And containsType(victim,"garlic",true) Print attacker,"I can't get close." Return false End_If If (attacker.type=16) And ContainsSubtype(victim,"silver",false) Print attacker,"I can't get close." Return false End_If If Exists(infected) Print attacker,"There's an infection progressing: "+infector.name+" bite "+infected.name+". Let's wait a while." Return false End_If If attacker.type=16 Print victim,"Aaaahhh!!! " + attacker.name + " bite me!!!" Else Print victim,"Aaaahhh!!! " + attacker.name + " bite me on my neck!!!" End_If If victim.gender = "F" PlaySound victim.container,"scream1.wav" Else PlaySound victim.container,"ahh.wav" End_If Dim msgidx = RndInt(3) Dim msg If msgidx = 1 msg ="Soon " + victim.name + " will receive the gift of immortality!! Ha ha ha!!" End_If If msgidx = 2 msg =victim.name+"! Don't you feel... er... different?" End_If If msgidx = 3 msg ="Dear "+victim.name+"... you are about to join the big family!!" End_If Speak attacker,victim.container,msg If IsPlayer(attacker) Print attacker,"- " + msg End_If victim.killer = attacker victim.Health = victim.Health-1 infected = victim infector = attacker infectype = attacker.type If infectype = 12 infectype = 14 End_If Return 1 End_Function Sub giveMoney(target,value) 'Input: target=(container for the money); ' value=(how much money) Dim item For Each item In getItemsIn(target) If item.Cash > 0 item.Cash=item.Cash+value PlaySound target,"fanfare.wav" item.name = "" + item.Cash + " coins" Print target,"Now I have got " + item.Cash + " gold coins!" Return End_If Next ' If we are here, no money packs found Dim newobj = NewItem(target,"" + value + " coins","Gold coins are money!",NewImage("money.gif",31,31),"type=money,volume=0,pickable,showmode=2,icon=money.gif,Cash="+value) PlaySound target,"fanfare.wav" Print target,"Now I have got " + newobj.Cash + " gold coins!" End_Sub ' calcAvgPower ' ' Calculates the average overall power of both armies ' 'side f/x: modifies countHumans,countMonsters,avgPowerHumans,avgPowerMonsters,levMin,levMax ' Sub calcAvgPower() Dim ch Dim totalH = 0 Dim totalM = 0 countHumans = 0 countMonsters = 0 avgPowerHumans = 0 avgPowerMonsters = 0 levMin = 100 'Min level found levMax = 1 'Max level found For Each ch In getCharactersIn($WORLD) If ch.type>0 And Not(ch.balanceignore) If ch.type <= 10 ' Human totalH = totalH + ch.Strength countHumans = countHumans+1 Else 'Monster totalM = totalM + ch.Strength countMonsters = countMonsters+1 End_If End_If If ch.Level < levMin levMin = ch.Level End_If If ch.Level > levMax levMax = ch.Level End_If Next If countHumans > 0 avgPowerHumans = totalH/countHumans End_If If countMonsters > 0 avgPowerMonsters = totalM/countMonsters End_If End_Sub ' popMonster ' ' Input: power= Desired Overall power of the monster ' setRooms=Popup place: set of rooms to choose from ' setCovered=Covered Places must be defined for vampires to pop up ' Returns: reference the popped up monster ' Side f/x: pops up the monster Function popMonster(power,setRooms) Dim mname,image,attrs Dim x If power <= 2 x = RndInt(3) If x = 1 mname = "a sludge" image = NewImage("asludge.gif",40,40) attrs = "type=11,nohands=1,Strength=1.5,suffersound=pig.wav,affi=2/0/0/0" End_If If x = 2 mname = "a conch" image = NewImage("conch.gif",48,49) attrs = "type=11,nohands=1,Strength=1.5,suffersound=pig.wav,affi=2/2/0/0" End_If If x=3 mname = "a snake" image = NewImage("snake2.gif",40,40) attrs = "type=11,nohands=1,Strength=2,suffersound=pig.wav,affi=0/2/0/0,artdefense=counterattack" End_If End_If If power > 2 And power <= 2.5 x = RndInt(2) If x = 1 mname = "a sludge" image = NewImage("asludge.gif",40,40) attrs = "type=11,nohands=1,Strength=2.2,suffersound=pig.wav,affi=4/0/0/0" End_If If x = 2 mname = "a blood sucker" image = NewImage("conch.gif",48,49) attrs = "type=11,nohands=1,Strength=2.5,suffersound=pig.wav,affi=4/0/0/0" End_If End_If If power > 2.5 And power <= 3.5 x = RndInt(3) If x = 1 mname = "a biruburu" image = NewImage("biruburu.gif",70,54) attrs = "type=11,nohands=1,Strength=2.6,suffersound=pig.wav,affi=0/4/0/0" End_If If x = 2 mname = "a chorking" image = NewImage("chorking.gif",80,73) attrs = "type=11,nohands=1,Strength=2.8,suffersound=pig.wav" End_If If x = 3 mname = "a blood sucker" image = NewImage("bloodskr.gif",50,29) attrs = "type=11,nohands=1,Strength=3,suffersound=pig.wav" End_If End_If If power > 3.5 And power <= 4 mname = "a young werewolf" image = NewImage("werewolf.gif",80,90) attrs = "type=16,Strength=4,suffersound=wolfhit.wav" End_If If power > 4 And power <= 4.5 mname = "a mutant worm" image = NewImage("horror091.gif",90,115) attrs = "type=11,Strength=4.2,affi=0/4/0/0" End_If If power > 4.5 And power <= 5 mname = "a werewolf" image = NewImage("werewolf.gif",90,100) attrs = "type=16,Strength=5,suffersound=wolfhit.wav" End_If If power > 5 And power <= 5.5 mname = "a giant worm" image = NewImage("horror091.gif",100,125) attrs = "type=11,Strength=5.2,vuln_mob,affi=0/4/0/0" End_If If power > 5.5 And power <= 6 If RndInt(2) = 1 mname = "a vampire" image = NewImage("vampire.gif",95,100) attrs = "type=14,Strength=5.7,yell=roar2.wav,artdefense=counterattack" Else mname = "a ghost" image = NewImage("2003ghost.gif",80,100) attrs = "type=11,Strength=5.7,yell=roar2.wav" End_If End_If If power > 6 And power <= 6.5 If RndInt(2) = 1 mname = "a snake monster" image = NewImage("horror104.gif",115,150) attrs = "type=11,Strength=6.2" Else mname = "a beholder" image = NewImage("beholder.gif",80,100) attrs = "type=11,Strength=6.5,nohands=1,vuln_mob" End_If End_If If power > 6.5 And power <= 7 x = RndInt(2) If x = 1 mname = "a mummy" image = NewImage("mummy.gif",92,100) attrs = "type=11,Strength=6.7,affi=0/4/0/0" End_If If x = 2 mname = "a troll" image = NewImage("troll.png",74,110) attrs = "type=11,Strength=7,vuln_mob" End_If End_If If power > 7 And power <= 8 x = RndInt(5) If x = 1 mname = "a deathpede" image = NewImage("dethpede.png",84,80) attrs = "type=11,nohands=1,Strength=7.2" End_If If x = 2 mname = "a golem" image = NewImage("sgolem.png",110,98) attrs = "type=11,Strength=8,affi=0/4/0/0" End_If If x = 3 mname = "an ogre" image = NewImage("horror076.gif",140,133) attrs = "type=11,Strength=8,yell=roarlong2.wav,affi=0/4/0/0" End_If If x = 4 mname = "a skeleton" image = NewImage("skeleton.gif",120,120) attrs = "type=11,Strength=7.5,yell=roar2.wav,vuln_mob" End_If If x = 5 mname = "a Cyclops" image = NewImage("cyclops.gif",120,120) attrs = "type=11,Strength=7.6,yell=roar2.wav,affi=0/4/0/0" End_If End_If If power > 8 And power <= 8.5 x = RndInt(2) If x = 1 mname = "a power vampire" image = NewImage("vampire.gif",95,100) attrs = "type=14,Strength=8.3,yell=roar2.wav,vuln_mob,artdefense=counterattack" End_If If x = 2 mname = "a dark entity" image = NewImage("horror047.gif",121,144) attrs = "type=11,Strength=8.5,artdefense=counterattack" End_If End_If If power > 8.5 And power <= 9.5 x = RndInt(3) If x = 1 mname = "a daemon" image = NewImage("daemon.png",121,117) attrs = "type=11,Strength=9,artdefense=counterattack" End_If If x = 2 mname = "a flying daemon" image = NewImage("tn_an22.gif",152,105) attrs = "type=11,Strength=8.7,vuln_mob,affi=0/0/4/0" End_If If x = 3 mname = "a flying goblin" image = NewImage("flyinggoblin.gif",95,113) attrs = "type=11,Strength=9.2,affi=0/0/4/0" End_If End_If If power > 9.5 And power <= 10.5 x = RndInt(3) If x = 1 mname = "a daemon guard" image = NewImage("daemonguard.gif",121,100) attrs = "type=11,Strength=10" End_If If x = 2 mname = "a lizard-man" image = NewImage("lizardman.gif",84,110) attrs = "type=11,Strength=9.7,affi=0/4/0/0" End_If If x = 3 mname = "a poisonous snake" image = NewImage("snake2.gif",84,110) attrs ="type=11,Strength=10.5,affi=0/4/0/0,artdefense=counterattack" End_If End_If If power > 10.5 And power <= 11.5 x = RndInt(4) If x = 1 mname = "an ectoplasmic monster" image = NewImage("monst52.gif",78,100) attrs = "type=11,Strength=12" End_If If x = 2 mname = "a skeleton fighter" image = NewImage("skeleton2.gif",78,100) attrs = "type=10.6,Strength=12" End_If If x = 3 mname = "a demoncyclops" image = NewImage("demoncyclops.gif",144,120) attrs = "type=11,Strength=11,artdefense=counterattack" End_If If x = 4 mname = "a Demon" image = NewImage("deamona.gif",88,105) attrs = "type=11,Strength=11.3,vuln_mob" End_If End_If If power > 11.5 And power <= 12 x = RndInt(3) If x = 1 mname = "a multiarm Demon" image = NewImage("multiarm.gif",76,120) attrs = "type=12,Strength=11,vuln_mob" End_If If x = 2 mname = "a giant Dragon" image = NewImage("gdragon.gif",125,117) attrs = "type=11.8,Strength=11" End_If If x = 3 mname = "a flying Dragon" image = NewImage("fdragon.gif",64,100) attrs = "type=11,Strength=11.5,affi=0/0/4/0" End_If End_If If power > 12 And power < 15 x = RndInt(2) If x = 1 mname = "a dark knight" image = NewImage("darkknight.gif",95,102) attrs = "type=11,Strength=12.5,affi=4/0/0/0" End_If If x = 2 mname = "a death evengelion" image = NewImage("deathevanfront.gif",110,82) attrs = "type=11,Strength=14,affi=0/0/4/0,artdefense=counterattack" End_If 'If x = 3 ' mname = "a drake" ' image = NewImage("drago.gif",95,102) ' attrs = "type=11,Strength=13" 'End_If End_If If power = 15 mname = "a devilman" image = NewImage("horror046.gif",140,175) attrs = "type=17,Strength=15,keeper=1,vuln_mob,affi=0/0/0/4" End_If If power > 15 x = RndInt(8) If x = 1 mname = "an exterminator devilman" image = NewImage("horror046.gif",145,180) attrs = "type=11,Strength=" + Round(power,0) + ",keeper=1,vuln_mob,terminator,affi=0/0/0/4,artdefense=counterattack" End_If If x = 2 mname = "a red devil" image = NewImage("reddevil.gif",150,150) attrs = "type=11,Strength=" + Round(power,0) + ",keeper=1,affi=0/0/0/4" End_If If x = 3 mname = "a gargoyle" image = NewImage("gargoyle.gif",167,115) attrs = "type=1,affi=0/0/4/01,Strength=" + Round(power,0) End_If If x = 4 mname = "a death reaper" image = NewImage("deathreaper.gif",144,120) attrs = "type=11,affi=0/0/4/0,Strength=" + Round(power,0) End_If If x = 5 mname = "a gigabat" image = NewImage("gigabat.gif",120,100) attrs = "type=11,Strength=" + Round(power,0) + ",terminator,affi=0/0/4/0" End_If If x = 6 mname = "an exterminator" image = NewImage("monst11.gif",130,100) attrs = "type=11,Strength=" + Round(power,0) + ",terminator" End_If If x = 7 mname = "a bat demon" image = NewImage("batdevil.gif",64,100) attrs = "type=11,Strength=" + Round(power,0) + ",terminator,affi=0/0/4/0" End_If If x = 8 mname = "an exterminator gargoyle" image = NewImage("monst28.gif",100,100) attrs = "type=11,Strength=" + Round(power,0) + ",terminator,affi=0/0/4/0,artdefense=counterattack" End_If End_If Dim new Dim setWhere = setRooms If InStr(attrs,"type=14") setWhere = setCovered End_If new = NewCharacter(RndSet(setWhere),mname,"",image,attrs+",dyncreated,accepts=*") 'Check - it happened we got a null character If new.type = null Debug "Problem in popMonster. New.type = null. Power was: " + power + " setRooms=" + setRooms + " x= " + x $WORLD.debuginfo = "" + $WORLD.debuginfo + ",problem in popMonster" return null End_If If new.type = 0 Debug "Problem in popMonster. New has type=0. Power was: " + power $WORLD.debuginfo = "" + $WORLD.debuginfo + ",problem in popMonster" Kill new return null End_If new.Level = levMax Display $WORLD,"" + mname + " has appeared, Strength: " + (new.Strength + new.Experience) ' Fix description now new.description = "" If new.suffersound="" new.suffersound="pig.wav" End_If new.__hooked = NewSet() new.arts = SetKeys(artNames) 'Knowledge of all arts If new.artdefense = null ' Survival Art by default new.artdefense = "survival" End_If 'Affinity Call SetRndAffinity(new) Call FixArrays(new) If ExistScript("popMonster_Local") Call popMonster_Local(new) End_If Return new End_Function ' popHuman ' ' Input: power= Desired Overall power ' setRooms=Popup place: set of rooms to choose from ' Returns: reference the popped up robot ' Side f/x: pops up the robot Function popHuman(power,setRooms) If power = 0 power = 1 Debug "popHuman: power=0" End_If Dim mname,image,attrs Dim str = Round(power,1) Dim x = RndInt(4) If x = 1 mname = RndSet(arrNames) image = NewImage("karmor.gif",100,140) attrs = "type=1,gender=M,Class=Warrior,Strength=" + str End_If If x = 2 mname = RndSet(arrNames) image = NewImage("blueknight.gif",85,106) attrs = "type=1,gender=M,Class=Warrior,Strength=" + str End_If If x = 3 mname = RndSet(NewArray("Ophelia,Marian,Diana")) image = NewImage("girlknight.gif",49,103) attrs = "type=1,gender=F,suffersound=bighit1.wav,Classe=Guerriero,Strength=" + str End_If If x = 4 mname = RndSet(arrNames) image = NewImage("cler.gif",74,106) attrs = "type=1,gender=M,Class=Warrior,Strength=" + str End_If Dim new new = NewCharacter(RndSet(setRooms),mname,"",image,attrs+",dyncreated,accepts=*") Display $WORLD,"" + mname + " is near here, Strength:" + (new.Strength) new.Level = levMax ' Fix description and type new.description = "" new.__hooked = NewSet() new.type = Int(new.type) 'Check - it happened we got a null character If new.type = 0 Debug "Problem #1 in popHuman: new.type=0" Debug "new=" + new + " power=" + power $WORLD.debuginfo = $WORLD.debuginfo + ",problem in popHuman" Kill new return null End_If 'Check - it happened we got a null character If new.Strength = 0 Debug "Problem #2 in popHuman: new.Strength=0" Debug "new=" + new + " power=" + power Speak SYS,$WORLD,"Problem #2 in popHuman: new.Strength=0" Speak SYS,$WORLD,"new=" + new + " power=" + power $WORLD.debuginfo = $WORLD.debuginfo + ",problem in popHuman" Kill new return null End_If AttachEvent new,"onHear","humanknight_speak" new.arts = SetKeys(artNames) 'Knowledge of all arts If new.artdefense = null ' Survival Art by default new.artdefense = "survival" End_If 'Affinity Call SetRndAffinity(new) Call FixArrays(new) Return new End_Function ' robotAI ' Artificial Intelligence routine for robots ' ' input: person=who will perform the action Sub robotAI(person) If person.Health <= 0 'Debug "robotAI: "+person.name+" dieing" If person.type <= 10 hkilled = hkilled+1 Else mkilled = mkilled+1 End_If If ExistScript("onAboutDie") Call onAboutDie(person) End_If ' Person will die, do nothing Return End_If ' If we are here, robot will live Dim cmd = person.command If cmd = "" Call robotAIstandard(person) Else Call robotAIcommand(person,cmd) End_If ' robotAIstandard ' standard AI procedure for robots who are NOT in command Sub robotAIstandard(person) ' Attack should be first action choice Dim nearPeople = getCharactersIn(person.container) If Not(person.pacific) And SetLen(nearPeople)>0 Dim aggressivity = 3 If person.terminator If IsCharacter(person.aimed) aggressivity = 4 'raise aggressivity End_If End_If 'Examine attackable people Dim tobeattacked = null Dim c For Each c In nearPeople If areEnemies(person,c) And Not(c.invisible Or c.invul) And c.Strength < (person.Strength*2) tobeattacked = c 'Display $WORLD,person.name + " sees " + c.name End_If Next If tobeattacked <> null And RndInt(3)0 And Not(person.nohands) possibilities = possibilities + "/pick" End_If If Not(person.steady) possibilities = possibilities + "/go" End_If If SetLen(ownedItems)>0 And Not(person.keeper) possibilities = possibilities + "/drop/use" End_If If (person.type=14 Or person.type=16) And SetLen(nearPeople)>0 possibilities = possibilities + "/bite" End_If If person.terminator If IsCharacter(person.aimed) ' Just attack possibilities = Replace(possibilities,"/go","") Else possibilities = possibilities + "/aim" 'possibilities = "aim" End_If End_If 'Print $WORLD,"possibilities for: " + person.name + ":" + possibilities possibilities = Split(possibilities,"/") ' Turn it into an ARRAY of strings If SetLen(possibilities) = 0 'Display $WORLD,person.name + " has NO CHOICES!!" Return End_If Dim choice = RndSet(possibilities) 'Display $WORLD,person.name + "'s choice is: " + choice 'Debug person.name + " is in " + person.container.name If choice = "aim" 'Speak SYS,$WORLD,person.name + " would like to aim somebody." Dim tobeattacked = null Dim c For Each c In nearPeople If Not(c.invisible) And areEnemies(person,c) And IsPlayer(c) person.aimed = c If SetLen(c.__hooked) < 0 c.__hooked = NewSet() End_If SetAdd c.__hooked,person.id,person Print c,person.name + " aims at me!" Return End_If Next choice = "go" End_If If choice = "pick" 'Display $WORLD,person.name + " would like to pick up something." For Each item In nearItems If item.pickable And Not(item.hidden) Move item,person 'Display $WORLD,person.name + " picks up: " + item.name Return End_If Next End_If If choice = "go" 'Display $WORLD,person.name + " would like to go away." Call stepAway(person) Return End_If If choice = "drop" Dim aset = getItemsIn(person) If SetLen(aset) Dim o = RndSet(aset) If o.type <> "money" And o.Value < 5 Move o,person.container Return End_If End_If choice = "use" ' Dropped nothing? Then use! If person.yell PlaySound person.container,person.yell End_If End_If If choice = "use" 'Display $WORLD,person.name + " uses something" Call doUse(person,RndSet(ownedItems)) End_If If choice = "bite" 'Bite If Not(person.type=14 Or person.type=16) Return End_If 'Display $WORLD,person.name + " would like to bite somebody." Dim tobeattacked = null Dim c For Each c In nearPeople If Not(c.invisible) And c.type > 0 And c.type <= 10 tobeattacked = c 'Debug person.name + " sees " + c.name End_If Next If tobeattacked <> null 'Display $WORLD,person.name + " would like to bite " + tobeattacked.name Call doBite(person,tobeattacked) Return End_If End_If End_Sub ' robotAIcommand ' standard AI procedure for robots who are in command Sub robotAIcommand(robot,cmd) Dim commander = getPlayer(robot.commander) If debugtype="cmds" Print $WORLD,"robot: "+robot.name+" mission:"+cmd+" "+robot.commandaux+" for "+commander End_If Dim item If cmd="findobj" Dim nearItems = getItemsIn(robot.container) For Each item In nearItems If item.pickable And Not(item.hidden) Move item,robot If item.container = robot 'Display $WORLD,robot.name + " picks up: " + item.name If Exists(commander) Move item,commander Speak robot,commander,"Found for you: "+item.name End_If End_If Return End_If Next End_If If cmd="hunt" Dim nearPeople = getCharactersIn(robot.container) Dim c For Each c In nearPeople If Not(c.invisible) And areEnemies(robot,c) Return doAttack(person,c,robot.weapon,true) End_If Next End_If If cmd="progeny" Dim nearPeople = getCharactersIn(robot.container) Dim c For Each c In nearPeople If Not(c.invisible) And c.type > 0 And c.type < 10 Return doBite(robot,c) End_If Next End_If If cmd="terminate" If Not(Exists(commander)) ' Disconnect robots robot.command = null robot.commander = null robot.commandaux = null Else If robot.aimed <> null If Exists(robot.aimed) If robot.container <> robot.aimed.container Move robot,robot.aimed.container SetAdd robot.aimed.__hooked,robot.id,robot End_If Call doAttack(robot,robot.aimed,robot.weapon,true) If Not(Exists(robot.aimed)) ' Mission: completed Speak robot,commander,"Mission completed! "+robot.commandaux+" has been killed." Call GiveMoney(commander,5) Print commander,robot.name + msgEXECUTED Kill robot End_If Else robot.aimed = null End_If End_If Dim nearPeople = getCharactersIn(robot.container) Dim c For Each c In nearPeople If Not(c.invisible) And (InStr(c.name,robot.commandaux)>0) Speak robot,c,"I found you!!" robot.aimed = c 'robot.terminator = 1 If SetLen(c.__hooked)<0 Debug "Strange case: NO __hooked set for " & c Else SetAdd c.__hooked,robot.id,robot End_If Print c,person.name + " is aiming at me!" Return true End_If Next End_If End_If Return stepAway(robot) End_Sub ' person=robot which should step away Sub stepAway(person) Dim myset = getRoomsFrom(person.container) 'Display "Accessible rooms for " + person.name + " are: " + myset Dim destination = RndSet(myset) If person.type=14 If Not(SetContainsKey(setCovered,destination.id)) ' If vampire and destination is in sunlight then cancel action destination = null End_If End_If If destination <> null 'Display $WORLD,person.name + " goes to " + destination.name Move person,destination End_If End_Sub ' balanceGame ' balances Game by determining the number of the two armies and adding extra robots to the defaulting army ' a difference up the 30% of the total is tolerated 'Input: ' setRooms=Popup place for monsters: set of rooms to choose from Sub balanceGame(setRooms) ' Calc stats Dim humanPlayers = countHumanPlayers() Dim monsterPlayers = countMonsterPlayers() ' If no or perfectly balanced players - try to reduce number of robots If humanPlayers-monsterPlayers=0 Dim victim = RndSet(getCharactersIn($WORLD)) If victim <> null If victim.dyncreated And key4.container <> victim Display $WORLD,victim.name + " goes away." Kill victim End_If End_If Return End_If ' If here, might need to balance ' calc statistics Call calcAvgPower() If monsterPlayers > 0 And countHumans < 4 'Debug "Fixing problem #1 - monster players and no humans to kill" Call popHuman(avgPowerMonsters,setRooms) Return End_If If humanPlayers > 0 And countMonsters < 4+humanPlayers 'Fixes problem #2 - human players and few monsters to kill - at least no.humans+4 Call popMonster(avgPowerHumans,setRooms) Return End_If If monsterPlayers-humanPlayers >= countHumans 'Debug "Fixing problem #3 - there are unmatched monster players" Call popHuman(avgPowerMonsters,setRooms) Return End_If If countMonsters-monsterPlayers + countHumans-humanPlayers > 30 'Debug "Fixing problem #4 - too many computer controlled characters" Call cleanup() End_If Return End_Sub Function countHumanPlayers() Dim count = 0 Dim ch For Each ch In getPlayersIn($WORLD) If ch.type <= 10 count=count+1 End_If Next Return count Function countMonsterPlayers() Dim count = 0 Dim ch For Each ch In getPlayersIn($WORLD) If ch.type > 10 count=count+1 End_If Next Return count Sub doTransform(person) If person.type = 12 ' Bat to Vampire person.image("N") = person.oldimage If person.oldstrength > 0 person.Strength = person.oldstrength End_If person.oldstrength = null person.type = 14 Display person,"I'm back to normal!" PlaySound person.container,"roarlong2.wav" RefreshView person.container Call checkLight(person) Call levelParams(person) Return End_If If person.type = 16 'Werewolf to human Dim swap = person.image("N") person.image("N") = person.oldimage person.oldimage = swap person.Strength = person.oldstrength person.type = 10 person.yell = "ahh.wav" Display person,"Now I look like a human!" PlaySound person.container,"music.wav" RefreshView person.container Return End_If If person.type = 14 'Vampire to Bat person.oldimage = person.image("N") person.image("N") = NewImage("bat.gif",16,100) person.type = 12 Display person,"I turned into a bat!" PlaySound person.container,"music.wav" RefreshView person.container Return End_If If person.type = 10 'Human to Werewolf If person.angry Dim swap = person.oldimage If swap = null swap = NewImage("werewolf.gif",90,100) End_If person.oldimage = person.image("N") person.oldstrength = person.Strength person.Strength = person.Strength * 2 person.image("N") = swap person.type = 16 person.yell = "roar2.wav" person.angry = 0 Display person,"I turned to a wolf-man!" PlaySound person.container,"roarlong2.wav" RefreshView person.container Call levelParams(person) Else Print person,"I am not angry enough." End_If Return End_If End_Sub ' p1 potential attacker ' p2 potential victim Function areEnemies(p1,p2) If ((p1.type>10) And (p2.type>0 And p2.type<=10)) ' Monster and Human Return 1 End_If If ((p2.type>10) And (p1.type>0 And p1.type<=10)) ' Human and Monster Return 1 End_If If ((p1.type=12 Or p1.type=14) And p2.type=16) ' Vampire and Werewolf Return 1 End_If If ((p2.type=12 Or p2.type=14) And p1.type=16) ' Werewolf and Vampire Return 1 End_If Return false End_Function ' containsType ' checks whether the specified container contains a specified object type ' returns true or false Function containsType(container,type,recursive) If SetLen(getObjectsType(container,type)) > 0 Return true End_If Dim res = False If recursive ' another chance: look inside objects Dim setobjects = getItemsIn(container) Dim o For Each o In setobjects res = res Or containsType(o,type,true) Next Return res End_If Return res End_Function ' containsSubtype ' checks whether the specified container contains a specified object type or subtype ' returns true or false Function containsSubtype(container,type,recursive) If SetLen(getObjectsSubtype(container,type)) > 0 Return true End_If Dim res = False If recursive ' another chance: look inside objects Dim setobjects = getItemsIn(container) Dim o For Each o In setobjects res = res Or containsSubtype(o,type,true) Next Return res End_If Return res End_Function ' getContainedType ' gets from the specified container ' the first item of the specified type, null if none Function getContainedType(container,type) Dim myset = getObjectsType(container,type) If SetLen(myset) < 1 Return null End_If Return myset(1) End_Function ' getPeopleName ' Returns a set of characters of specified name contained in specified container ' returns a set Function getPeopleName(container,aname) Dim setPeople = NewSet() 'Print "setPeople= " + setPeople + "." Dim c For Each c In getCharactersIn(container) 'Print $WORLD,"-" + c.name + ":" + c.type + "<>" + type If LCase(c.name) = LCase(aname) setPeople(c.id) = c End_If Next Return setPeople End_Function Sub checkBomb(activeBomb) If activeBomb <> null If Exists(activeBomb) ' Explode Dim activator = activeBomb.activator Dim cont = activeBomb.container Call bombExplode(activeBomb,cont,activator) Dim myset = getObjectsType(cont,"bomb") Dim x ' Now lets explode all near bombs For Each x In myset If x.seller = "" Call bombExplode(x,cont,activator) End_If Next End_If End_If If Not(Exists(activebomb)) activeBomb = null End_If End_Sub ' Bomb exlosion routine ' bomb = Bomb exploding ' cont = where bomb is exloding ' activator = ID of who activated the bomb Sub bombExplode(bomb,cont,activator) If Not(Exists(bomb)) Return End_If Display cont,"BOOOOOOOM!!!!
A bomb just blew up!" PlaySound $WORLD,"bomb.wav" 'SendPage cont,flash,4 If IsCharacter(cont) And cont.invul <= 0 Dim healthy = (cont.Health >= 0) cont.Health=cont.Health-20 If activator = cont DropItems cont 'If self blow up then drop all End_If If healthy And cont.Health < 0 cont.killer = activator Call incKilledCount(cont,activator) If Not(IsPlayer(cont)) Call onKillRobot(cont,activator) End_If End_If End_If If IsRoom(cont) Dim x For Each x In getCharactersIn(cont) If x.type>0 And x.invul <= 0 Dim arrProtections = NewArray() arrProtections(1) = getContainedType(x,x.helmet) arrProtections(2) = getContainedType(x,x.armour) arrProtections(3) = getContainedType(x,x.shield) Dim shieldpower = arrProtections(1).Protection+arrProtections(2).Protection+arrProtections(3).Protection Dim damage = 10-shieldpower/Sqr(1+x.Level) If damage > 0 Dim healthy = (x.Health >= 0) x.Health=x.Health-damage If healthy And x.Health < 0 x.killer = activator Call incKilledCount(x,activator) If Not(IsPlayer(x)) Call onKillRobot(x,activator) End_If End_If End_If End_If Next If ExistScript("bombExplode_local") Call bombExplode_local(cont) End_If End_If kill bomb End_Sub Function doUse(person,item) Dim type = MainType(item) If type = "bottle" Return drinkPotion(person,item) End_If If item.type = "pill.blue" person.invul = person.invul+10 person.toxine = person.toxine+1 Kill item If person.toxine > 1 Print person,"I am getting poisoned!" End_If Return true End_If If item.type = "spell.water" If IsMagician(person) Display "Perhaps I should try 'Cast SPELL' on ..." Else Display "I cannot use spells..." End_If End_If If item.type = "spell.tele" If IsMagician(person) Dim success = doTeleport(person,person) If success If person.Level < 2 Call advanceCheck($AGENT,"spells",1) End_If Return true End_If Else Display "I cannot use spells..." End_If End_If If item.type = "spell.invis" If IsMagician(person) $AGENT.Health = 1 Return doInvis(person) Else Display "I cannot use spells..." End_If End_If If type = "bomb" If GuildPacific($AGENT) Print "A member of a pacific guild does not do it." Return false End_If item.activator = $AGENT PlaySound item.container,item.sound If item.type = "bomb.trap" item.type = "bomb.proximity" item.icon = "bombtrapactive.gif" item.image = NewImage("bombtrapactive.gif",40,40) item.description = item.description + " It's ACTIVATED!" Print $AGENT,"Trap ACTIVATED!" End_If If item.type = "bomb" activeBomb = item Print item.container,"Smells like there's something burning..." End_If Return true End_If If type = "gem" If Mid(item.type,5,4) = "art." Dim art = Mid(item.type,9,Len(item.type)-8) Speak SYS,person,"You have learned the Art of "+artNames(art)+" ("+artTypes(art)+")." If SetLen(person.arts) < 1 person.arts = NewArray(art) Else person.arts(SetLen(person.arts)+1)=art End_If Kill item Return true End_If End_If If item.type = "book1" If item.uses > 0 Display "The book reads: 'Awakananda wakandu orcaddu g'htulu'" Display "I feel a shiver......." item.uses = item.uses-1 Call popMonster(avgPowerHumans,monstersPopupSet) Return true Else Display "The words are unreadable. It's been used too much." End_If End_If ' Is it an acquirable object? If IsAcquirable(item) If Not(SanityCheck(item)) Print "This object cannot be used: " & SharedError Return false End_If If acquireObject(person,item) Print "Now it's part of my permanent equipment. Click ["+htmlIcon("paninfo.gif","Info")+"Info] to verify and remember to SAVE game!" Kill item Return true End_If End_If If ExistScript("doUse_Local") Return doUse_Local(person,item) End_If Return false End_Function ' Cleans the castle from computer-controlled characters Sub cleanup Dim c For Each c In getCharactersIn($WORLD) If Not(IsPlayer(c)) And c.type <> 0 Kill c End_If Next End_Sub EVENT onFindObject Dim name = $TARGET If Exists(name) name = name.id End_If If name = "" Display $AGENT,"Type part of the name in the textbox BEFORE clicking the button." Return End_If Dim found=0 Dim c For Each c In getItemsIn($WORLD) If InStr(c.name,name) found=1 Display $AGENT,"
  • " + c.name + " is in: " + c.container.name End_If Next For Each c In getCharactersIn($WORLD) If InStr(c.name,name) found=1 Display $AGENT,"
  • " + c.name + " is in: " + c.container.name End_If Next If Not(found) Display "Not found: " + name End_If End_Event EVENT doMasterPanel ' Creates dynamic room for special op Dim battleroomid = $AGENT.id + "_myroom" If $AGENT.container.id = battleroomid.id Print "Click RETURN" Return End_If NewRoom battleroomid battleroomid.name = "Master Panel" battleroomid.image("N") = NewImage("uw2_clouds.jpg",400,230) $AGENT.comingfrom = $AGENT.container SetPanel battleroomid, "pmasterspecial" Move $AGENT,battleroomid AttachEvent $AGENT.container,"onLoose","masterroom_onLoose" End_Event EVENT doMasterReturn Move $AGENT,$AGENT.comingfrom $AGENT.comingfrom = null End_Event EVENT masterroom_onLoose Kill $OWNER End_EVENT Sub humanknight_speak Speak "Hey! Do you think this place is safe?", "I am here to fight monsters!", "For the honor of the King!" ' Common init code Sub common_onStart() arrVerbs=NewArray("defeated,killed,vanquished,slain,beaten") setDict = NewSet("score=Score,kills=Kills,spells=Spells,crafts=Crafts,infections=InfectedHumans,money=Credits,exp=Experience") arrNames=Split("Sir Richard/John/Jack/Lord Hastings/Sir Jones/Sir Duncan/Sir McCormack/Lord Jeremy/Sir Jeffrey/soldier","/") setSndBeastYell=Split("roar1.wav/roar2.wav/gnarl1.wav/roarlong2.wav","/") setSndHumanYell=NewArray("death.wav,yell.wav,ahh.wav") setRobotCmds=NewSet("findobj=Provide items,hunt=Hunt enemies,progeny=Make more adepts,terminate=Kill ...,escort=Escort") masterOps = NewSet("_0=(Command),exp=Grant Experience pts to ...,eqp=Grant weapon*person *,money=Grant money to ...,kill=Kill (person),jail=Jail (choose or name),unjail=Un-jail (choose or name),ban=Ban (person),move=Move (person) in (room),moveo=Move (item) in (room),rstavatar=Restore avatar to (person),vip=View IP of (player),vipb=View/change banned IP list*,restart=Restart game,restart1=Restart game from phase 1,purge=Purge*,fix=Fix Catalog*,resetpwd=Reset password to,info=Info on player...,catsave=Catalog-Save*,catload=Catalog-Reload,catadd=Catalog-Add item+,catview=Catalog-View Item,tournament=Set up tournament mode...*,makemaster=Make master...*") cloneableTypes = NewSet("bomb,weapon,spell,helmet,armour,shield,bottle,stone,pill,garlic,trap") uniqueTypes = NewSet("crown,key1,key2,key3,key4,key5,cross,book1,book2") itsday = "?" ' For day/night cycle tournament=Int(getSetting("ctx_tournament","0")) limitedavails = false ' Decide se gli articoli in vendita hanno disp limitata If dbdown gamelocked = true End_If main_imagedir = gameinfo("imagesfolder") levMax =1 'Maximum level for monsters cstMaxLocked = 6 ' Max locked items in shops cstHELMET = "helmet" cstSHIELD = "shield" cstARMOUR = "armour" cstATTACK = "attack" cstDEFENSE = "defense" cstLEVEL = "Level" cstEXP = "Experience" cstPROT = "Protection" cstPOWER = "Power" cstOBJECT = "object" msgNOCHIEF = "You don't lead any guild nor you are a delegate. (More..)" msgATLEASTLVL = "For this I need at least Level " msgEXECUTED = " executed orders and goes away." msgNOWREST = "Done. But I need some resting now." msgNOTNOW = "In cannot do that in this state, I have to transform first!" visitsperinc = 500 'Required visits to ch card per increment cstAffiNames = NewArray("Water,Earth,Wind,Fire") artNames=NewSet("counterattack=Counter-attack,doublehit=Double hit,survival=Survival,rogue=Rogue Power,heavyshot=Heavy shot,poisonattack=Poison Attack,gainlife=Gain Life,equilibrium=Equilibrium") artTypes=NewSet("counterattack=defense,doublehit=attack,survival=defense,rogue=defense,heavyshot=attack,poisonattack=attack,gainlife=attack,equilibrium=defense") urlTermsOfUse = "http://www.underworld-game.net/?page_id=63" urlForum = "http://z4.invisionfree.com/dimensionex/index.php?showforum=7&age=10000" urlFB = "http://www.facebook.com/underworld.online" urlGuilds = "http://www.dimensionex.com/wiki/DimensioneX/underworld/guilds" hellfire.description = "You have been jailed because of your behaviour not tolerated by our Terms of Use.

    " hellfire.description = hellfire.description+"It is a temporary measure but we recommend to read and follow the rules in order to avoid banning.

    " hellfire.description = hellfire.description+"You can ask for clarifications to a game master by posting on our public Forum (requires registration)." tourntypes = NewSet("t0=Normal game,t1=Humans vs. Monsters,t2=Assassin Guild,t3=Guild wars,t4=Guild Trophy,t5=NewComers Tournament,t6=All vs. All,t7=Permanent Competition") tournpages = NewSet("t1=?page_id!202,t2=?page_id!13,t3=?page_id!13,t4=Guild Trophy,t5=?page_id!163,t6=?page_id!289,t7=?page_id!512") arrShopkeepers = NewArray() ' To be overridden in local area fbusers = NewSet("0=dummy") smDay="" End_Sub ' Common load context code ' Calls local load context, if exists Sub LoadContext() musicSet = NewArray(getSetting("ctx_soundtrack","$dir$/sentry.mp3|2,$dir$/finalbattle_ziurerdna.mp3|3,$dir$/danosongs_com_dream_player.mp3|3.5,$dir$/danosongs_com_owl_named_orion.mp3|3.5,$dir$/danosongs_com_crazy_from_the_message.mp3|3.5,sndbackground08.mid|6,alchemist.mid|5.5,termthmz.mid|4.5,independenceday.mid|1.5,termthmz.mid|2,aliens.mid|2,laststarfighter.mid|3.2,days.mid|2.5")) uw4up = getSetting("ctx_uw4up","") guildnames = getSetting("ctx_guildnames","!set!Cris=Lyons' Guild") guildlogos = getSetting("ctx_guildlogos","!set!Cris=http://www.dimensionex.net/underworld/uwpics/odin.gif") guildsubscribers = getSetting("ctx_guildsubscribers","!set!") guilddelegates = getSetting("ctx_guilddelegates","!set!") guildtypes = getSetting("ctx_guildtypes","!set!") guildmoney = getSetting("ctx_guildmoney","!set!") guildtypes = getSetting("ctx_guildtypes","!set!") guildwars = getSetting("ctx_guildwars","!set!") guildwarsqueue = getSetting("ctx_guildwarsqueue","!set!") pastwars = getSetting("ctx_pastwars","!set!") 'Fix subscribers Dim k For Each k In SetKeys(guildsubscribers) If guildsubscribers(k) = "0" Debug "Dummy guild subscriber '0' to be removed in guild by: " + k guildsubscribers(k) = "" End_If Next 'Fix delegates Dim k For Each k In SetKeys(guilddelegates) If guilddelegates(k) = "0" Debug "Dummy guild delegate '0' to be removed in guild by: " + k guilddelegates(k) = "" End_If Next guildrequests = getSetting("ctx_guildrequests","!set!") guildwebs = getSetting("ctx_guildwebs","!set!Cris=http://www.gamesclan.it/dimensionex/wiki/index.php/DimensioneX/underworld/lyonsguild") guildkills = getSetting("ctx_guildkills","!set!") guildavglvl = getSetting("ctx_guildavglvl","!set!") guildmutualkills = NewSet() guildfounded = getSetting("ctx_guildfounded","!set!") guildstatsgenwhen = NewSet() arrIps = NewSet() 'ip numbers of beginners _bannedclients = getSetting("ctx_bannedclients",_bannedclients) If tournament=2 assassinguild = getSetting("ctx_assassin","") End_If Call buildWCatalog() Call shops_prepare(arrShopkeepers) If ExistScript("LoadContext_Local") Call LoadContext_Local() End_If Call nightDayCycle() End_Sub ' Checks if the specified person is subscribed to a guild ' if so, returns the guild's owner, null otherwise Function guildSubscribed(person) Dim i Dim n = person.name For i=1 To SetLen(guildsubscribers) Dim arrnames = Split(guildsubscribers(i),";") If SetIndexOf(arrnames,n) > 0 Return SetKey(guildsubscribers,i) End_If Next If Int(n) > 0 n = "_" + n ' fix for number nicks End_If If guildnames(n) <> null Return n End_If Return null End_If 'withmembers > 0 - show additional info (see below) 'withmembers AND 1 - show members 'withmembers AND 2 - show wanna-be members 'withmembers AND 4 - show enemies Function getGuildBox(owner,withmembers) Dim txt = "" Dim tmp Dim link1 = "" Dim link0 = "" If Int(owner) > 0 owner = "_" + owner End_If If guildwebs(owner) <> null link1 = "" link0 = "" End_If If guildlogos(owner) <> "" tmp = link1 + "logo" + link0 End_If txt = txt + "" + tmp + link1 + guildnames(owner) + link0 + " founded by " + UserCardLink(owner) + "" If guildfounded(owner) <> "" txt = txt + " on " + guildfounded(owner) End_If If guildtypes(owner) = "p" txt = txt + " +Chr(34)+" End_If If ExistScript("war_engaged") If war_engaged(owner) txt = txt + " +Chr(34)+" End_If End_If If withmembers > 0 Dim d txt = txt + "
    AVG Level: " + guildavglvl(owner) txt = txt + "
    Victories: " + guildkills(owner) txt = txt + "
    Richness: " + Int(guildmoney(owner)) Dim n = InStrCount(guilddelegates(owner),";") If n > 0 txt = txt +"
    Delegates: " For Each d In Split(guilddelegates(owner),";") txt = txt + UserCardLink(d) + ", " Next End_If If withmembers And 4 Dim n = 0 ' Dummy: Print guilds fighting with End_If If withmembers And 1 txt = txt + "
    "+Chr(13) If ($AGENT.guildrequest=owner) txt = txt + "YOUR REQUEST AWAITING APPROVAL
    " End_If If ($AGENT.guild=NULL And $AGENT.guildrequest<>owner) txt = txt + "
    " End_If If ($AGENT.guild=owner And $AGENT.name<>owner) txt = txt + "
    " End_If txt = txt + "
    Members: " For Each d In Split(guildsubscribers(owner),";") txt = txt + UserCardLink(d) + ", " Next Dim n = InStrCount(guildrequests(owner),";") If n > 0 If withmembers And 2 txt = txt + "
    Wanna-be members: " For Each d In Split(guildrequests(owner),";") txt = txt + UserCardLink(d) + ", " Next Else txt = txt + "
    " + n + " pending requests for joining! Advise " + UserCardLink(owner) End_If End_If End_If txt = txt + "
    • " End_If Return txt End_Function Sub levelParams(person) If person.Strength > (8 + person.Level*2) person.Strength = 8 + person.Level*2 End_If If person.Health > 10 person.Health = 10 End_If End_Sub EVENT doSpecialOp(cmd,input) Print masterOps(cmd) Dim person = input("charsel") Dim txt = input("txtBox") If cmd = "kill" If person <> "_0" If input("txtBox") = "YES" If IsCharacter(person) Kill person Speak SYS,$AGENT,"Done." SendCmd $AGENT,"custom:refresh!ctrls" Else Speak SYS,$AGENT,"Killed." Return End_If Else Speak SYS,$AGENT,"Type YES to confirm." Return End_If Else Speak SYS,$AGENT,"Choose the person." Return End_If End_If If cmd = "jail" Call prepareJail(person,txt) End_If If cmd = "unjail" Call unJail(person,txt) End_If If cmd = "ban" If input("charsel") <> "_0" If input("txtBox") = "YES" If IsPlayer(person) Speak SYS,$WORLD,"Instant banning of: " + name Debug $AGENT.name + " just banned " + person.name + " date/time: " + getTime("MM-dd-yyyy HH:mm") Ban person 'Kill input("charsel") Speak SYS,$AGENT,"Banned. Action logged." SendCmd $AGENT,"custom:refresh!ctrls" Else Speak SYS,$AGENT,"Cannot ban a robot." Return End_If Else Speak SYS,$AGENT,"Type YES to confirm." Return End_If Else Speak SYS,$AGENT,"Choose the person." Return End_If End_If If cmd = "rstavatar" If input("charsel") <> "_0" If restoreAvatar(input("charsel")) Speak SYS,$AGENT,"Done." End_If Else Speak SYS,$AGENT,"Choose the person." Return End_If End_If If cmd = "move" If input("charsel") <> "_0" If input("roomsel") <> "_0" Move input("charsel"),input("roomsel") Speak SYS,$AGENT,"Done." Else Speak SYS,$AGENT,"Choose the room." Return End_If Else Speak SYS,$AGENT,"Choose the person." Return End_If End_If If cmd = "moveo" If input("itemsel") <> "_0" If input("roomsel") <> "_0" Move input("itemsel"),input("roomsel") Speak SYS,$AGENT,"Done." Else Speak SYS,$AGENT,"Choose the room." Return End_If Else Speak SYS,$AGENT,"Choose the item." Return End_If End_If If cmd = "vip" If input("charsel") <> "_0" And IsPlayer(input("charsel")) Print $AGENT,"IP number of " + input("charsel").name + ": " + input("charsel").remoteAddr Else Speak SYS,$AGENT,"Choose a player." Return End_If End_If If cmd = "vipb" And $AGENT.mastersuper Print $AGENT,"Banned IPs: " + _bannedclients Print $AGENT,"List must be separated with pipe symbols | and terminate with |" Print $AGENT,"Enter | in the textbox to reset the list" If input("txtBox") <> "" _bannedclients = input("txtBox") saveSetting "ctx_bannedclients",_bannedclients Print $AGENT,"List just modified: " + _bannedclients End_If End_If If cmd = "restart1" If input("txtBox") = "RESET" If mode=2 Print "CLICK HERE TO COMPLETE RESTART" saveSetting "ctx_mode",null saveSetting "ctx_kingTicks",null Call BroadcastOtherWorlds("reset","") Reset Else Display "Possible in phase 2 only" End_If Else Print "Type RESET in the textbox and redo." End_If End_If If cmd = "restart" If input("txtBox") = "RESET" Print "CLICK HERE TO COMPLETE RESTART" Call BroadcastOtherWorlds("reset","") Reset Else Print "Type RESET in the textbox and redo." End_If End_If If cmd = "purge" And $AGENT.mastersuper Print "

    Purging Guild

    " Dim k For Each k In SetKeys(guildnames) If Not(ProfileExists(k)) Print "(!) Manually delete GUILD " + guildnames(k) + " di " + k Else Print "Cleaning " + guildnames(k) + "" Print "" End_If Next saveSetting "ctx_guildsubscribers",guildsubscribers Print "

    Purging bank accounts

    " For Each k In SetKeys(garumir.accounts) If Not(ProfileExists(k)) Print "Deleted account of " + k + "=" + garumir.accounts(k) SetRemove garumir.accounts,k End_If Next End_If If cmd = "resetpwd" If txt <> "" Dim nick = CookName(txt) If getSetting(nick + "_name","") <> "" saveSetting nick + "_pass","" Speak SYS,$AGENT,"Password of " + txt + " has been reset to (blank)." Else Speak SYS,$AGENT,"No such player: " + txt Return End_If Else Speak SYS,$AGENT,"Type player's nickname and retry." Return End_If End_If If cmd = "info" If txt <> "" Print getPeopleInfo(txt,true) Else Speak SYS,$AGENT,"Type player's nickname and retry." Return End_If End_If If cmd = "exp" If txt <> "" Dim data = Split(txt,"*") If SetLen(data) < 2 Print "Type: points*nickname and retry" Return Else Dim nick = data(2) Dim tmp = getSetting(CookName(nick) + "_properties","") If tmp = "" Print "Un-existent user: " + nick Return End_If Dim pts = Int(data(1)) If pts <= 0 Or pts > 10 Print "Before * you have to write a number. You wrote: " + data(1) Return End_If Call SaveProperty(nick,cstEXP,LookupProfileDB(nick,cstEXP)+pts,true) Print "Granted " + pts + " Exp points to "+nick Debug $AGENT.name + " has given " + pts + " Exp points to "+nick+" at date/time: " + getTime("yyyy-MM-dd HH:mm") End_If Else Print "Type: points*nickname and retry" Return End_If End_If If cmd = "eqp" And $AGENT.mastersuper If txt <> "" Dim data = Split(txt,"*") If SetLen(data) < 2 Print "Scrivi: arma*persona e riprova" Return Else Dim nick = data(2) Dim tmp = getSetting(CookName(nick) + "_properties","") If tmp = "" Print "Utente inesistente: " + nick Return End_If Dim weap = data(1) If Not(InCatalog(weap)) Print "Prima di * devi scrivere un codice articolo di arma esistente. Hai scritto: " + weap Return End_If Dim arr = LookupProfileDB(nick,"weapons") If SetIndexOf(arr,weap) > 0 Print "Già in equipaggiamento: " & weap Return End_If If SetLen(arr) > 0 arr(LeadingZero(SetLen(arr)+1,"000")) = weap Else Print "Problema nell'assegnazione (nessun array armi)" End_If Call SaveProperty(nick,"weapons",arr,true) Print "Equipaggiato con " + weap + " il giocatore "+nick&arr Debug $AGENT.name + " ha equipaggiato con " + weap + " il giocatore "+nick+" in data/ora: " + getTime("dd/MM/yyyy HH:mm") End_If Else Print "Scrivi: codicearma*nickname e riprova" Return End_If End_If If cmd = "fix" And $AGENT.mastersuper Call FixCatalog() End_If If cmd = "money" If txt <> "" Dim data = Split(txt,"*") If SetLen(data) < 2 Print "Type: money*nickname and retry" Return Else Dim nick = data(2) Dim tmp = getSetting(CookName(nick) + "_properties","") If tmp = "" Print "Un-existent user: " + nick Return End_If Dim pts = Int(data(1)) If pts <= 0 Print "Before * you have to write a number. You wrote: " + data(1) Return End_If If Exists(garumir) garumir.accounts(nick)=pts+garumir.accounts(nick) Print "Granted " + pts + " money a "+nick Debug $AGENT.name + " has given " + pts + " money credits to "+nick+" at date/time: " + getTime("yyyy-MM-dd HH:mm") End_If End_If Else Print "Type: money*nickname and retry" Return End_If End_If If cmd = "tournament" And $AGENT.mastersuper If txt = "" Print "Type:" Dim tt For Each tt In SetKeys(tourntypes) Print ""+Mid(tt,2,Len(tt)-1)+" for "+tourntypes(tt)+"" Next Else SaveSetting "ctx_tournament",txt Print "Set to tournament mode: "+txt+" ("+tourntypes("t"+txt)+")" End_If End_If If cmd = "makemaster" And $AGENT.mastersuper If txt = "" Print "Type the person to be made master" Else If Not(ProfileExists(txt)) Print "Un-existent user: " + txt Return End_If Dim nick = CookName(txt) Call SaveProperty(nick,"master",Not(LookupProfileDB(nick,"master")),true) Print "Current master status for "+txt+": "+LookupProfileDB(nick,"master")+"" End_If End_If If cmd = "catsave" And $AGENT.mastersuper Call saveWCatalog() End_If If cmd = "catload" Print "" + buildWCatalog() + " loaded items." End_If If cmd = "catadd" And $AGENT.itemmaster If txt <> "" Dim nitems = SetLen(wcatalog) Dim arrData = Split(txt,"*") wcatalog_names(arrData(1)) = arrData(2) wcatalog(arrData(1)) = arrData(3) If SetLen(arrData) > 3 wcatalog_desc(arrData(1)) = arrData(4) End_If Print "The new item is now in the catalog, type: "+arrData(1) Else Speak SYS,$AGENT,"Type the item string defining the new item, then retry." Return End_If End_If If cmd = "catview" If txt <> "" Print "Item type: "+txt+"
    " Dim x = Replace(Replace(wcatalog_desc(txt),"<","<"),">",">") Print txt+"*"+wcatalog_names(txt)+"*"+wcatalog(txt)+"*"+x Else Speak SYS,$AGENT,"Write down the item's type, then retry" Return End_If End_If End_EVENT Function getKillable(exclude) Dim fullset = getCharactersIn($WORLD) Dim myset = NewSet() SetAdd myset,"_0","(choose person)" Dim c For Each c In fullset If c.type <> 0 And c.type <> null And c <> exclude SetAdd myset,c.id,c End_If Next Return myset End_Function ' Checks whether the specified name is blocked Function blocked(aname) Dim addrset = NewArray("voice,garumir,morubar") Dim x For Each x In addrset If InStr(aname,x) Return true End_If Next Return false End_Function Function restoreAvatar(person) If Not(IsPlayer(person)) Speak SYS,$AGENT,"Cannot operate on robots" Return False End_If If person.invisible Call doInvis(person) End_If If person.type=1 And person.gender = "M" person.image = NewImage("uomo.gif",64,100) Return true End_If If person.type=1 And person.gender = "F" person.image = NewImage("guerriera.gif",100,100) Return true End_If If person.type=2 And person.gender = "M" person.image = NewImage("cleric.gif",64,100) Return true End_If If person.type=2 And person.gender = "F" person.image = NewImage("mystic.gif",64,100) Return true End_If If person.type=4 person.image = NewImage("paesant.gif",64,100) Return true End_If If person.type=10 person.image = NewImage("paesant.gif",64,100) person.oldimage = NewImage("werewolf.gif",90,100) Return true End_If If person.type=12 And person.gender = "M" ' bat person.image = NewImage("bat.gif",16,100) person.oldimage = NewImage("vampire.gif",95,100) Return true End_If If person.type=12 And person.gender = "F" ' bat person.image = NewImage("bat.gif",16,100) person.oldimage = NewImage("vampirebride.gif",94,100) Return true End_If If person.type=14 And person.gender = "F" person.image = NewImage("vampirebride.gif",94,100) Return true End_If If person.type=14 And person.gender = "M" person.image = NewImage("vampire.gif",95,100) Return true End_If If person.type=16 person.image = NewImage("werewolf.gif",90,100) person.oldimage = NewImage("paesant.gif",64,100) Return true End_If If person.type=19 person.image = NewImage("horror047.gif",121,144) Return true End_If Speak $AGENT,"Not implemented yet for this player type." Return False End_Function Function getKillTotal(person) Dim tot = 0 If person.killstats <> null Dim x For Each x In person.killstats tot = tot + x Next End_If Return tot End_Function Sub printKillStats(person) Dim tot = 0 If person.killstats <> null Dim owner, link1, link0, txt, tmp, name txt = "" For Each owner In SetKeys(person.killstats) skip = false link1 = "" tmp = "" If Int(owner) > 0 Or owner = "0" owner = "_" + owner End_If If guildwebs(owner) <> null link1 = "" link0 = "" End_If If guildlogos(owner) <> "" tmp = link1 + "" + link0 + " " End_If name = guildnames(owner) If name = "" If owner = "_monsters" name = "Monsters" Else If owner = "_humans" name = "Humans" Else ' No more existing guild 'Move killstats under uncategorized person.killstats("_humans") = Int(person.killstats(owner)/2) + person.killstats("_humans") person.killstats("_monsters") = Int(person.killstats(owner)/2) + person.killstats("_monsters") SetRemove person.killstats, owner skip = true End_If End_If End_If If Not(skip) txt = txt+"" End_If tot = tot + person.killstats(owner) Next txt = txt+"" txt = txt+"
    Guild/NatureWin count
    " + tmp + "" + link1 + name + link0 + "" + person.killstats(owner) + "
    Total" + tot + "
    " PrintRight txt End_If End_Sub Function myExtract(haystack,needle) If Left(haystack,Len(needle)) = needle x = 1 Else x = InStr(haystack,","+needle,2) If x=0 Return null Else x=x+1 End_If End_If Dim y = InStr(haystack,",",x+1) If y = 0 y = Len(haystack)+1 End_If Dim startcut=x+Len(needle)+1 Dim ret = Mid(haystack,startcut,y-startcut) 'Print $WORLD,"Extract: " + needle + "=" + ret Return ret End_Function ' Transforms a user name into the userid format ' used by DimensioneX.Player.saveGame Function CookName(aname) aname = Replace(LCase(aname)," ","_") return aname End_Function 'Looks up in the Users' profile DB 'Searches for specified user NAME and parameter 'Returns a string value Function LookupProfileDB(user_name,parameter) Dim props = getPlayerProperties(user_name) Return props(parameter) End_Function Sub MakeWhip(person) Dim new = NewItem(person,"diabolic whip","magic whip to ban annoying players. Type player name and look the whip.",NewImage("whip.gif",75,100),"type=whip,icon=whip.gif,vanishing=2,pickable,volume=0,hideable") AttachEvent new,"onLook","whip_onUse" AttachEvent new,"whenPicked","whip_whenPicked" End_Sub Sub whip_onUse() If Not($AGENT.whipper) And Not($AGENT.master) Print $TARGET,"I cannot use it" Return False End_If Dim name = input("txtBox") If name = "" Speak "Type in the text box the name of who you want to jail" Return End_If Dim person = getPlayer(name) If person <> null Print $AGENT,"Swisssshhhhh.... SNAP!!" Speak SYS,$WORLD,"Instant jailing of: " + name Debug $AGENT.name + " just jailed " + name + " date/time: " + getTime("MM-dd-yyyy HH:mm") Call doJail(person,person.name,$AGENT) Return End_If Speak "'" + name + "': not a player" End_Sub Sub whip_whenPicked If Not($TARGET.whipper) And Not($TARGET.master) Print $TARGET,"I leave the whip, I cannot use it and I could hurt somebody" Kill $OWNER Return False End_If End_Sub Function cloneItem(item) Dim new If item.type = null Return null End_If If SetContainsKey(cloneableTypes,MainType(item)) new = NewItem(null,item.name,item.description,item.image("N"),"type="+item.type) new.pickable = item.pickable new.showmode = item.showmode new.icon = item.icon new.sound = item.sound new.volume = item.volume new.Value = item.Value new.affi = item.affi new.designer = item.designer If item.Level new.Level = item.Level End_If If item.Power new.Power = item.Power End_If If item.Protection new.Protection = item.Protection End_If If MainType(item) = "bottle" new.uses = item.uses End_If Return new End_If Return null End_Function ' Sends a command message to another area Sub SendMessage(area,command,properties) Dim props = "type=msg,cmd="+command If properties <> "" props = props + "," + properties End_If Dim new = NewItem(null,"msg",null,null,props) MoveOutside new,area End_Sub ' Prints current time of day Function getTimeOfDay() Dim realsecs = 60*getTime("mm")+getTime("ss") Dim uwsecs = 24*realsecs Dim uwhrs = Int(uwsecs/3600) uwsecs = uwsecs - uwhrs*3600 Dim uwmins = Int(uwsecs/60) If uwhrs < 10 uwhrs = "" + "0" + uwhrs End_If If uwmins < 10 uwmins = "" + "0" + uwmins End_If 'uwsecs = uwsecs - uwmins*60 Return "" + uwhrs + ":" + uwmins End_Function Function htmlTimeOfDay Dim tod = getTimeOfDay() Dim todicon = "sun.gif" Dim hr = Int(Left(tod,2)) If hr < 6 Or hr > 20 todicon = "moon.gif" End_If Dim ico = "+Chr(34)+Chr(34)+" Return ico + " in the kingdom it's now " + tod + "" End_Function Sub nightDayCycle Dim hr = Int(Left(getTimeOfDay(),2)) Dim nowday = (hr >= 7 And hr <= 21) If hr = 6 Or hr = 20 $WORLD.bgcolor = "#FF2B6C" End_If If nowday <> itsday ' sunset/dawn If nowday Speak SYS,$WORLD,"It's a new day in the kingdom...","The sun rose in the sky!","Vampires must retire!" $WORLD.bgcolor = "#9DB9E9" Call onNewDay() Else Speak SYS,$WORLD,"Another day ends...the night begins!","The sun has set!","Pay attention to vampires!" $WORLD.bgcolor = "#000055" End_If PlaySound $WORLD,"churchbell.wav" itsday = nowday End_If End_Sub ' Calculates the specifed guilds' statistics ' Returns: a text description ' Side F/X: Sends a message to area1 with total OR saves into guildkills Function getGuildKillStats(guildowner,sendmsg) Dim res Dim totkills = 0 Dim totlvl = 0 Dim tmp = guildsubscribers(guildowner) Dim subs = Split(tmp,";") If Not(SetContainsKey(subs,guildowner)) subs(SetLen(subs)+1) = guildowner End_If Dim x Dim thisguildstats = NewSet() For Each x In subs If garumir <> null And SetLen(garumir.accounts)>0 res = res + Int(garumir.accounts(x)) End_If Dim props = getPlayerProperties(x) If props <> null Dim personkillstats = props("killstats") 'Print "-" + x + "=" + personkillstats If personkillstats <> null Dim owner For Each owner In SetKeys(personkillstats) If Int(owner) > 0 Or owner = "0" owner = "_" + owner End_If thisguildstats(owner) = Int(personkillstats(owner)) + thisguildstats(owner) Next End_If totlvl = totlvl + props(cstLEVEL) End_If Next Dim txt = "" txt = txt + "" For Each owner In SetKeys(thisguildstats) Dim tmp,link1="", link0, tmp, name, skip skip = false If Int(owner) > 0 Or owner = "0" owner = "_" + owner End_If If guildwebs(owner) <> null link1 = "" link0 = "" End_If If guildlogos(owner) <> "" tmp = link1 + "" + link0 End_If name = guildnames(owner) If name = "" If owner = "_monsters" name = "Monsters" Else If owner = "_humans" name = "Humans" Else ' No more existing guild skip = true End_If End_If End_If If Not(skip) x = thisguildstats(owner) txt = txt + "" guildmutualkills(guildowner+"*"+owner)=x totkills = totkills + x End_If Next txt = "

    " + txt + "

    Guild/RaceWins
    " + tmp + "" + link1 + name + link0 + "" + x + "
    " txt = "Defeated enemies, total: " + totkills + "
    " + txt guildkills(guildowner)=totkills guildavglvl(guildowner)=Round(totlvl/SetLen(subs),1) txt = "Average Level: " + guildavglvl(guildowner) + "
    "+txt If garumir <> null txt = "Total credits of the members: " + res + "
    " + txt End_If txt = "Situation of guild: " + guildnames(guildowner) + "
    Produced on: " + getTime("MM-dd-yyyy HH:mm") + "
    " + txt txt = txt + "

    Warning: This sheet will destroy itself if dropped on the ground." If sendmsg Call SendMessage("Underworld","upd_guildkills","guild="+guildowner+",guildkills="+totkills+",guildavglvl="+guildavglvl(guildowner)) End_If Return txt End_Function Function SettingStringToSet(setstring) If Left(setstring,5) <> "!set!" Return null End_If setstring = Right(setstring,Len(setstring)-5) setstring = Replace(setstring,"*",",") Return NewSet(setstring) End_Function 'Builds a sorting index for the specified SET ' sort_type can be "<" or ">" Function SetBuildIndex(set,sort_type) Dim ret = NewSet() Dim x Dim origsize = SetLen(set) Dim setcopy = Copy(set) Dim i For i = 1 To origsize If sort_type = "<" x = SetKeyOfMin(setcopy) Else x = SetKeyOfMax(setcopy) End_If 'Debug "pos " + i + " key " + x ret(i) = x SetRemove setcopy,x Next Return ret End_Function 'Given a set, returns the key of the MAX element Function SetKeyOfMax(set) If SetLen(set) < 1 Return null End_If Dim maxk = SetKey(set,1) Dim max = set(1) If SetLen(set) > 1 Dim i For i = 2 To SetLen(set) If set(i) > max maxk = SetKey(set,i) max = set(i) End_If Next End_If Return maxk End_Function 'Given a set, returns the key of the MIN element Function SetKeyOfMin(set) If SetLen(set) < 1 Return null End_If Dim mink = SetKey(set,1) Dim min = set(1) If SetLen(set) > 1 Dim i For i = 2 To SetLen(set) If set(i) < min mink = SetKey(set,i) min = set(i) End_If Next End_If Return mink End_Function ' onNewDay ' Things to do at each new game day Sub onNewDay() Dim p For Each p In getPlayersIn($WORLD) p.toxine = null Next If ExistScript("onNewDay_Local") Call onNewDay_Local() End_If End_Sub 'Attack with bare hands or weapons (all except magicians) EVENT onAttack If IsCharacter($OWNER) Dim w = $AGENT.weapon p = getInfoOwnedOrCatalog($AGENT,w,"power") If p < 1 And IsMagician($AGENT) Print $AGENT,"I need to get and select an attack spell (click ["+htmlIcon("paninfo.gif","Info")+"Info])." Return false End_If Call doAttack($AGENT,$OWNER,w,true) End_If End_EVENT 'Input: attacker, victim, weapon, arts_allowed 'Return: true - attacked, false= no attack Function doAttack(attacker,victim,weapon,arts_allowed) If Not(Exists(victim)) Or attacker.container <> victim.container Print attacker,"Not here anymore." Return false End_If ' Nobody can attack protected characters If Not(victim.type>0) Or victim.invul Print attacker,"Cannot be attacked." Return false End_If If IsPlayer(victim) If GuildPacific(attacker) Print attacker,"Cannot be attacked. I belong to a pacific guild." Return false End_If If IsPlayer(attacker) And GuildPacific(victim) Print attacker,"Cannot be attacked. Belongs to a pacific guild." Return false End_If End_If If ExistScript("onAboutAttack") If onAboutAttack(attacker,victim,weapon) 'Already Managed? Return false End_If End_If If weapon <> null If SetIndexOf(attacker.weapons,weapon)=0 If Not(containsType(attacker,weapon,false)) weapon = null End_If End_If End_If If weapon <> null Dim maintype=Left(weapon,5) If maintype="spell" And Not(IsMagician(attacker)) weapon=null Print attacker, "Default weapon cannot be used. Click [INFO] to select another." End_If End_If If weapon <> null attacker.attacksound = getInfoOwnedOrCatalog(attacker,weapon,"sound") Else attacker.attacksound = attacker.yell If attacker.attacksound = null If attacker.type<=10 attacker.attacksound = "robshortest.wav" Else attacker.attacksound = rndSet(setSndBeastYell) End_If End_If End_If If attacker.suffersound = "" If attacker.type<=10 attacker.suffersound = rndSet(setSndHumanYell) Else attacker.suffersound = "pig.wav" End_If End_If Call subFight(attacker,victim,weapon,arts_allowed) '************** 'ARTS OF ATTACK '************** If arts_allowed If attacker.artattack = "doublehit" If attacker.Health > 0 And Exists(victim) Print attacker,"Double Hit!" Call subFight(attacker,victim,weapon,false) End_If End_If End_If Return true End_Function ' ' The following is a shared procedure for fights ' ' Input: attacker, victim, weapon, arts_allowed Sub subFight(attacker,victim,weapon,arts_allowed) 'Allow transform to werewolves victim.angry=1 Dim sound=null '****************** ' WEAPON PREAPARATION '****************** Dim weapname = "with bare hands" Dim wpower=0 Dim weapaffi=null If weapon <> "" weapname = "with " + getInfoOwnedOrCatalog(attacker,weapon,"name") wpower = getInfoOwnedOrCatalog(attacker,weapon,"power") weapaffi = getInfoOwnedOrCatalog(attacker,weapon,"affi") 'If weapon.bestagainst = victim.type ' wpower = wpower * 1.3 ' weapname = weapname + ", powered +30%" 'End_If 'If weapon.badagainst = victim.type ' wpower = wpower * 0.7 ' weapname = weapname + ", weakened -30%" 'End_If If attacker.type = 4 If wpower > 2 wpower = 2 weapname = weapname + ", with Power limit to 2" End_If End_If End_If ' Battle algorhithm calculations Dim txtattack Dim txtdefense '****************** ' ATTACK '****************** Dim target=RndInt(3) Dim arrTargets=NewArray("head,body,arms") txtattack = "

    " txtdefense = "
    " txtattack = txtattack+"" + attacker.name +" attacks "+ victim.name +", " + arrTargets(target)+", "+weapname+"
    "+Chr(13) txtdefense = txtdefense+victim.name +": " 'txtattack = txtattack+"Strength: " + attacker.Strength + "+
    " 'txtattack = txtattack+"Weapon: " + wpower + " ("+weapname+")
    " '****************** ' PROTECTION CHOICE '****************** Dim prot = null Dim arrProtections = NewArray() arrProtections(1) = victim.helmet arrProtections(2) = victim.armour arrProtections(3) = victim.shield prot = arrProtections(target) If prot = "0" prot = null End_If '****************** ' AFFINITY '****************** Dim affidiff = calcAffiDiff(attacker,victim,weapaffi,getCatalogItemInfo(prot,"affi")) Dim maxhits = Round(Sqr(2*attacker.Strength+wpower),2) txtattack = txtattack+htmlAffinitiesCompact(affiattack,"Affinity attack") txtattack = txtattack+"Max damage: " + maxhits + "
    " '****************** ' DEFENSE '****************** txtdefense=txtdefense+htmlAffinitiesCompact(affidefense,"Affinity defense") txtdefense=txtdefense+"Unbalanced affinity: "+affidiff+" out of 8
    " Dim hits = Round(RndInt(maxhits)*(1+affidiff)/9,2) txtdefense=txtdefense+"Hits landed: "+hits+"
    " If hits > 0 '******************* 'SPECIAL PROTECTIONS '******************* If victim.vuln_mob 'Vulnerable to mob attacks If victim.lastattacker = attacker.name Or victim.lastattacker = null txtdefense=txtdefense+"Special protection: vulnerability to group attacks
    " hits = 0 victim.lastattacker=attacker.name Else txtdefense=txtdefense+"Attacked also by "+victim.lastattacker+", now vulnerable!
    " If hits >= 0 victim.lastattacker="*" 'Breach opened! End_If End_If End_If If victim.invul > 0 txtdefense=txtdefense+"Special protection: invulnerability" hits=0 End_If If attacker.invisible And ContainsType(victim,"amulet.invis",false) txtdefense=txtdefense+"Special protection: anti-invisibility" Call doInvis(attacker) End_If Dim protval = 0 If prot <> null protval=getCatalogItemInfo(prot,"protection")/(victim.Level*2) txtdefense=txtdefense+"Protecting "+arrTargets(target)+": " txtdefense=txtdefense+Wcatalog_names(prot)+", protection "+Int(100*protval)+"%
    " End_If Dim shielded = hits*protval 'Update with affi diff shielded = Round(shielded*(21-Int(Log(affidiff+1)*10))/21,1) If shielded > 0 txtdefense=txtdefense+"Shields "+shielded+" points
    " hits=hits-shielded End_If End_If ' Damage to be shielded '************** 'ARTS OF ATTACK '************** If arts_allowed If attacker.artattack = "heavyshot" If attacker.Health > 0 And Exists(victim) And hits > 0 Dim morehits = Round(hits*0.7,1) txtdefense = txtdefense+"Heavy Shot! +"+morehits+"
    " hits = hits+morehits End_If End_If If attacker.artattack = "poisonattack" If Exists(victim) And hits > 0 victim.toxine = 1+victim.toxine txtdefense = txtdefense+"Poison Attack! "+victim.toxine+" poison drops total
    " Print victim,"Poison Attack: "+victim.toxine+" poison drops total
    " End_If End_If If attacker.artattack = "gainlife" If Exists(victim) And hits > 0 Dim got = Round(hits*0.3,1) txtdefense = txtdefense+"Gain Life! got +"+got+" Health points
    " attacker.Health = Round(attacker.Health+got,1) End_If End_If End_If 'txtdefense=txtdefense+"Damage: "+hits+" health-points
    " txtdefense=txtdefense+"
    " txtattack = txtattack+"
    " If attacker.expert Print attacker,txtattack+Chr(13)+txtdefense End_If If victim.expert Print victim,txtattack+Chr(13)+txtdefense End_If ' Sounding - always according to the attacker ' loser's Health is updated here hits = Round(hits,2) If hits < 0.1 ' No damages If protval < 0.1 ' Dodge Display attacker,victim.name + " dodges my attack" Display victim,"I dodged, whew!" sound = "swordswing1.wav" Else Display attacker,victim.name + " shields the hit" Display victim,"Shielded!" sound = "swordswing2.wav" End_If PlaySound attacker.container,sound Else ' We have a winner and a loser Dim winner,loser If Left(weapon,12) = "spell.attack" Call advanceCheck(attacker,"spells",1) End_If sound = attacker.attacksound victim.Health = Round(victim.Health - hits,1) winner = attacker loser = victim 'Display attacker,"Opponent's Health is now " + victim.Health + "!!" 'Display victim,"I lose " + hits + " Health points." Print attacker,victim.name&": "&(-hits)&"" Display attacker,barDamage(victim.Health,hits) Print victim,""+attacker.name+" hits me: "&myDamage(hits) PlaySound attacker.container,sound 'SendPage loser,flash,2 Call battleResult(winner,loser,arts_allowed) End_If If victim <> $AGENT And victim.container <> "" RefreshView victim End_If '*************** 'ARTS OF DEFENSE '*************** If arts_allowed=false Return End_If If victim.artdefense = "counterattack" If victim.Health > 0 Print victim,"Counter-attack!" Call doAttack(victim,attacker,getContainedType(victim,victim.weapon),false) End_If End_If If victim.artdefense = "rogue" If victim.Health > 0 And hits > 0 Print victim,"Rogue Power!" Print attacker,victim.name+" uses Rogue power!" attacker.Health = Round(attacker.Health - hits/2,1) End_If End_If End_Sub Sub battleResult(winner,loser,arts_allowed) '*************** 'ARTS OF DEFENSE '*************** If loser.artdefense = "survival" If Not(IsPlayer(loser)) And loser.Health < 1 ' For robots only. Players are managed in Living() Dim item = getContainedType(loser,"bottle.potion") If item <> null Call drinkPotion(loser,item) End_If End_If End_If If loser.Health <= 0 ' Opponent is dieing... If loser.killer <> winner ' If winning not yet recorded... ' Calculate improvements for winner Dim improvement = calcImprovement(loser.Strength-winner.Strength) winner.Strength = Round(winner.Strength+improvement,1) Call levelParams(winner) Call incKilledCount(loser,winner) ' Record winning now loser.killer = winner End_If ' Manage the loser If IsPlayer(loser) Display loser, "Feeling so weak..." If (loser.artdefense <> "equilibrium" And RndInt(5)=1) Or (loser.artdefense = "equilibrium" And RndInt(100)=1) Move RndSet(getItemsIn(loser)),loser.container End_If Else 'Robot If winner.type = 1 And AreEnemies(winner,loser) Call GiveMoney(winner,loser.getProperty(cstLevel)) Speak SYS,winner,"Reward for the winning: "&loser.getProperty(cstLevel)&" coins!" End_If Call onKillRobot(loser,winner) Kill loser End_If Else ' Actions to be performed when loser is a robot If Not(IsPlayer(loser)) If loser.Health < 3 And loser.type > 10 And RndInt(6)=1 And Not(loser.steady) ' Health is low and loser is a monster - escape Move loser,RndSet(escapeSet) Display winner,loser.name + " escapes!!" Return End_If If loser.type = 10 And RndInt(2)=1 ' loser is a werewolf - transform Call doTransform(loser) Return End_If End_If End_If End_Sub ' calcImprovement ' input: difference (for any parameter) ' returns: improvement Function calcImprovement(difference) If difference <= 0 ' Loser was weaker or equal - little increase Return 0.1 Else ' Loser was stronger - increase Return difference/2 End_If ' ************** ' Shows player's profile ' *************** Sub doCheckup() Dim s,guild Dim txt txt = "
    Battle Equipment" If IsMagician($AGENT) txt = txt + PanelHtml("pchoose_spell") Else txt = txt + PanelHtml("pchoose_weapon") End_If 'txt = txt + "
    " txt = txt + PanelHtml("pchoose_armour") txt = txt + PanelHtml("pchoose_shield") txt = txt + PanelHtml("pchoose_helmet") Print txt+"
    " Dim link = gameInfo("site")+"?page_id=12#arts" txt = "
    Arts [?]" txt = txt + PanelHtml("pchoose_artattack") txt = txt + PanelHtml("pchoose_artdefense") Print txt+"
    " Dim txt = "
    Current status" txt = txt+htmlTimeOfDay()+"
    "+Chr(13) s = $AGENT.guild If s=null guild = "None." If $AGENT.guildrequest <> null guild = guild + " (pending request for: " + guildnames($AGENT.guildrequest) + ")" End_If Else guild = getGuildBox(s,0) + GuildDelegateIcon($AGENT.name,s) End_If txt = txt+"Guild: " + guild + "
    "+Chr(13) txt = txt+MarriedBox($AGENT) txt = txt+"
    "+$AGENT.image("N").html("my avatar: this is how I look like")+"
    "+Chr(13) txt = txt + "Strength: " + $AGENT.Strength + " pts of " + (8+$AGENT.Level*2) + "
    " If $AGENT.invul txt = txt + "Invulnerability: " + ($AGENT.invul/2) + " minutes left
    " End_If If $AGENT.toxine > 0 txt = txt + "Poison drops: " + $AGENT.toxine + "
    " End_If Dim app = "normal" If $AGENT.type > 9 If $AGENT.type = 10 app = "human" End_If If $AGENT.type = 16 app = "wolf" End_If If $AGENT.type = 14 app = "vampire" End_If If $AGENT.type = 12 app = "bat" End_If End_If Dim left = checkInvis($AGENT) If left > 0 app = app + ", invisible ("+Round(left/2,0)+" min. left)" Else app = app + ", visible" End_If Dim link = gameInfo("site")+"?page_id=12#avatar" txt = txt + "Appearence: " + app + " [custom?]
    " txt = txt+htmlAffinitiesCompact($AGENT,"Base Affinity") txt = txt+htmlAffinitiesCompact(calcAffiResult($AGENT,$AGENT.weapon,"weapons"),"Attack Affinity") txt = txt+htmlAffinitiesCompact(calcAffiResult($AGENT,$AGENT.helmet,"helmets"),"Defense Aff. Helmet") txt = txt+htmlAffinitiesCompact(calcAffiResult($AGENT,$AGENT.armour,"armours"),"Defense Aff. Armour") txt = txt+htmlAffinitiesCompact(calcAffiResult($AGENT,$AGENT.shield,"shields"),"Defense Aff. Shield") PrintRight $AGENT,txt Dim v="Simple" If $AGENT.expert v="Expert" End_If 'PrintRight $AGENT,"View mode: "&v&" (Switch)" PrintRight $AGENT,"View mode: "&v&" Change" PrintRight $AGENT,"
    Kills, detailed stats" Call printKillStats($AGENT) PrintRight "

    "+Chr(13) Dim link = gameInfo("site")+"?page_id=12#community" Print $AGENT,"
    Community [?]My character card:" Print $AGENT,"("+UserCardLink($AGENT.name)+") - (badge)" If getSetting(CookName($AGENT.name) + "_fbid","")<>"" Print $AGENT,""&NewImage("fb.gif",16,16).html("Facebook user!")+" Facebook user!"+"" End_If Print $AGENT,"
    " PrintRight advanceBox($AGENT)+Chr(13) Dim link = gameInfo("site")+"?page_id=12#security" Print $AGENT,"
    Security [?]Last use by other players:" Print $AGENT,$AGENT.lastused&"
    " End_Sub EVENT onCastSpell Dim success = false Dim skipcount = false ' Set to true to skip spell counting Dim item = $OWNER Dim attacker = $AGENT Dim target = $TARGET If MainType(item) <> "spell" Print item.name + " isn't a spell." Return End_If If item.seller <> "" Or target.seller <> "" Print "E' in vendita." Return false End_If If item.type = "spell.water" If MainType(target) = "bottle" Display "Casting the Water spell on the bottle..." Call refillPotion(target) success = true attacker.Health = attacker.Health-1 End_If End_If If Left(item.type,12) = "spell.attack" If IsCharacter(target) attacker.attacksound = item.sound success = doAttack(attacker,target,item,true) skipcount = true End_If End_If If item.type = "spell.tele" If attacker.Level >= 2 If doTeleport(attacker,target) Display "Done!" Display target, attacker.name + " has just cast a teleport spell on me!" success = true End_If Else Display "I need at least Level 2 to do that." End_If End_If If item.type = "spell.invis" If doInvis(target) Display "Done!" Display target, attacker.name + " cast an invisibility spell on me!" success = true End_If End_If If item.type = "spell.whirl" If attacker.Level >= 4 If CanAttackAB(attacker,target)=false Print "A member of a pacific guild does not do it." Return false End_If success = doWhirl(attacker,target) Else Display "I need at least Level 4 to do that." End_If End_If If item.type = "spell.gemini" success = doGemini() End_If If item.type = "spell.blood" If attacker.Level >= 10 If IsCharacter(target) And target.invul < 1 And CanAttackAB(attacker,target) If doBlood(attacker,target) success = true End_If Else Print "A member of a pacific guild does not do it." End_If Else Display "I need at least Level 10 to do that." 'Translate this End_If End_If If item.type = "spell.eye" If target.vuln_mob If attacker.Level < 4 target.lastattacker = "*" Else target.vuln_mob = 0 End_If PlaySound target.container,item.sound Display "Done!" Display target, attacker.name + " cast the eye spell on me!" success = true attacker.Health = attacker.Health-1 Else Display "Not effective on this target." End_If End_If If Not(success) And ExistScript("doCastSpell_Local") success = doCastSpell_Local(attacker,item) End_If If success If item.type <> "spell.water" And item.type <> "spell.tele" And Not(skipcount) Call advanceCheck(attacker,"spells",1) End_If Else Print "Nothing happens." End_If Return success End_EVENT Function doBlood(attacker,victim) Dim bloodrain = 0 Dim atthealthdiff = 10 - attacker.Health If victim.Health > 0 bloodrain = RndInt(victim.Health*100)/100 + 1 End_If If bloodrain > atthealthdiff bloodrain = atthealthdiff End_If If bloodrain > victim.Health bloodrain = victim.Health End_If If victim.Health < 0 bloodrain = 0 End_If victim.Health = victim.Health - bloodrain attacker.Health = attacker.Health + bloodrain Display victim, "You have lost " + bloodrain + " health due to Blood Spell cast by " + attacker.name + "!" 'Translate this Display attacker, "You have gained " + bloodrain + " health!" 'Translate this If victim.type = 0 Print attacker,"Can't be killed." Return 1 End_If call battleResult(attacker,victim,false) Return 1 End_Function Function doTeleport(attacker,victim) If IsCharacter(victim.container) ' Avoids teleport to be used to steal objects Display "Can't do this" Return 0 End_If If attacker <> victim If attacker.Health > 2 attacker.Health = Int(attacker.Health/2) Else attacker.Health = -1 End_If End_If If (Not(IsCharacter(victim)) And victim.pickable) Or (IsCharacter(victim) And victim.type <> 0 And victim <> guard And victim.noteleport=0) PlaySound victim.container,teleport.sound Move victim,rndSet(setAll) PlaySound victim.container,teleport.sound If victim.type=15 victim.description = "He's trying to close my way, but he can't." End_If Return 1 End_If Display attacker,"Doesn't work." Return 0 Function doWhirl(attacker,victim) If IsCharacter(victim) If attacker.Health > 2 attacker.Health = Int(attacker.Health/2) Else attacker.Health = -1 End_If If victim.type=17 Speak victim,victim.container,"That ridicolous spell has no effect on me! Har! Har! Har!" Return false End_If PlaySound victim.container,whirl.sound If victim.artdefense="equilibrium" And RndInt(100)>4 Print victim,attacker.name+" has attempted to steal my stuff with the Whirl Spell, but it didn't work!" Print attacker,victim.name+" is using the Art of Equilibrium, so the spell did not work." Return false End_If Dim items = getItemsIn(victim) Dim phrase = attacker.name+" has cast the Whirl Spell on me" If SetLen(items) > 0 Move RndSet(items),victim.container Else phrase = phrase + ", but it didn't work this time" End_If Print attacker,"Done!" Print victim, phrase+"!" If Not(IsPlayer(victim)) Call doAttack(victim,attacker,getContainedType(victim,victim.weapon),true) End_If Return 1 Else Print "Doesnt' work on items..." End_If Return false End_Function Function doInvis(victim) If Not(IsPlayer(victim)) Or (victim.invisible=0 And ContainsType(victim,"amulet.invis",false)) ' Avoids invisibility to be used on robots and objects Print "Anti-invisibility amulet is in force." Return false End_If PlaySound victim.container,invis.sound If victim.invisible > 0 victim.invisible = 0 victim.invisticks = null Display victim,"I'm visible again!" Else victim.invisible = 1 victim.invisticks = instanceid+"*"+Int(ticks) Display victim,"I became invisible!" End_If If victim.container <> null RefreshView victim.container End_If Return true Function doGemini() If $AGENT.Health < 5 Print $AGENT,"Health too low." Return false End_If If $TARGET.type = "spell.blood" Print $AGENT,"This one cannot be duplicated." Return false End_If If InstrCount($TARGET.type,"spell")>0 ' OK, trying to clone a spell Dim x = getContainedType($AGENT,"stone") If x<>null ' I got a stone Kill x Call NewItem($AGENT,$TARGET.name,$TARGET.description,$TARGET.image("N"),"pickable,showmode=2,Value=" + $TARGET.Value + ",Power=" + $TARGET.Power + ",type="+ $TARGET.type + ",icon=" + $TARGET.icon + ",sound=" + $TARGET.sound) PlaySound $AGENT,"music.wav" $AGENT.Health = $AGENT.Health - 5 Print $AGENT,msgNOWREST Return true Else Display "I've got no stone tablets." Return false End_If End_If Display "Nothing happens." Return false End_Function ' Increment a parameter for the specified person, then check ' for advancement: if it passes the threshold, the Experience ' is incremented Sub advanceCheck(person,param,incr) Dim setMax = NewSet("score=0,kills=0,spells=0,crafts=0,infections=0") Dim k For Each k In SetKeys(setMax) setMax(k) = getNextAdvance(person,k) Next k = null If param = "score" If incr+person.Score >= setMax("score") k = "Score" End_If person.Score=incr+person.Score End_If If param = "kills" If incr+person.Kills >= setMax("kills") k = "Kills" End_If person.Kills=incr+person.Kills End_If If param = "spells" If incr+person.Spells >= setMax("spells") k = "Spells" End_If person.Spells=incr+person.Spells End_If If param = "crafts" If incr+person.Crafts >= setMax("crafts") k = "Crafts" End_If person.Crafts=incr+person.Crafts End_If If param = "infections" If incr+person.InfectedHumans >= setMax("infections") k = "InfectedHumans" End_If person.InfectedHumans=incr+person.InfectedHumans End_If If k = null Return End_If person.Experience = person.Experience + 1 Speak SYS,$WORLD,""+UserCardLink(person.name)+"! Experience Advancement: +1 for reaching threshold "+k+"!!" End_Sub Sub purgeGuild(owner) Dim s,w For Each s In Split(guildsubscribers(owner),";") w = getSetting(CookName(s) + "_when","") If w = "" Print "Deleting " + s + getSetting(CookName(s) + "_properties","") Call GuildUnsubscribe2(owner,s) End_If Next End_Sub EVENT onDbDown Speak SYS,$WORLD,"Because of a temporary problem, game save is suspended." dbdown = true End_EVENT EVENT onDbUp Speak SYS,$WORLD,"Connection to the profile database restored - Exiting without saving, and then re-enter!" dbdown = false gamelocked = false End_EVENT ' Gets info on a person (from profile DB) ' Returns a message to be diplayed to the user Function getPeopleInfo(personname,extended) Dim res = "" Dim props = getPlayerProperties(personname) If SetLen(props) > 0 res = "Alias: " + props("mainpg") res = res + ", Class: " + props("Class") res = res + " (" + props("gender") + ")" res = res + ", Level: " + props(cstLEVEL) res = res + ", Experience: " + props(cstEXP) res = res + ", Strength: " + props("Strength") res = res + ", Credits: " + props("Credits") res = res + ", Hrs online: " + Round(props("ticker")/120,0)+" ("+tourntypes("t"+Int(props("tickertype")))+")" Dim personkillstats = props("killstats") Dim kills = 0 If personkillstats <> null Dim owner For Each owner In SetKeys(personkillstats) kills = kills + Int(personkillstats(owner)) Next End_If res = res + ", Kills: " + kills res = res + ", Latest login: " + getSetting(CookName(personname) + "_login","?") res = res + ", Latest savegame: " + getSetting(CookName(personname) + "_when","?") If extended res=res + ", Last used by: " + props("lastused") res=res+", IP Number:"+props("remoteAddr") End_If End_If Return "About " + personname + ": " + res End_Function Function MarriedBox(person) Dim tmp = "" If person.married<>null tmp = tmp + NewImage(main_imagedir + "goldring.gif",16,16).html("married") tmp = tmp + " married with " + UserCardLink(person.married) + "
    " End_If Return tmp End_Function ' Sorts the specified set by name Function SetSortedByName(aset) Dim setnames = NewArray() Dim i Dim k For i = 1 To SetLen(aset) setnames(i) = aset(i).name Next Dim index = SetBuildIndex(setnames,"<") Dim result = getItemsIn(null) For i = 1 To SetLen(index) k = Int(index(i)) SetAdd result,SetKey(aset,k),aset(k) Next Return result End_Function ' Sends a command/control message to other worlds of the same cluster ' cmd - command to be sent (string) ' more - either NULL or more attributes to be sent Function BroadcastOtherWorlds(cmd,more) Dim setWorlds = NewArray("Underworld,Underworld2,Underworld3") If uw4up setWorlds(4)="Underworld4" End_If ' Prepare message Dim attrlist = "type=msg,cmd="+cmd If more <> null attrlist = attrlist + "," + more End_If Dim w For Each w in setWorlds If w <> $WORLD.name Dim new = NewItem(null,"msg",null,null,attrlist) 'Debug "Sending to " + w MoveOutside new,w End_If If Exists(new) Kill new End_If Next End_Function ' Common handling of inter-area command messages ' Returns true if message have been handled Function HandleCommandMessage_Common(msg) ' Handle control/command message If msg.cmd = "guilds_update" guildnames = msg.guildnames guildlogos = msg.guildlogos guildsubscribers = msg.guildsubscribers guildmoney = msg.guildmoney Return true End_If If msg.cmd = "catalog_update" Call buildWcatalog() Call shops_prepare(arrShopkeepers) Return true End_If If msg.cmd = "kill_crown" Dim crown = getContainedType($WORLD,"crown") If crown <> null Kill crown End_If Return true End_If If msg.cmd = "incr_score" Return incrScore(msg.to,msg.incr) End_If If msg.cmd = "upd_prop" Return SaveProperty(msg.to,msg.key,msg.val,false) End_If If msg.cmd = "reset" Reset End_If If msg.cmd = "shout" Speak SYS,$WORLD,msg.txt Return true End_If Return false End_Function Function incrScore(name,incr) Dim person = getPlayer(name) If person <> null Call advanceCheck(person,"score",Int(incr)) person.score_added=0 ' Avoids double increment Speak SYS,person,"Score increment: " + incr Return true End_If Return false End_Function Function CutFirst(array) Dim newarr = NewArray() Dim i For i = 2 To SetLen(array) newarr(i-1) = array(i) Next Return newarr End_Function ' Updates a player's property ' supported properties: Level/Experience ' nick: player's nickname ' property: property to be updated ' value: value to be set ' wide: true: save & send to other worlds if not found / false: just search current world and don't save Sub SaveProperty(nick,property,value,wide) If wide If profileExists(nick) Dim nick2 = CookName(nick) Dim value2 = SetToString(value) tmp = getSetting(nick2 + "_properties","") SaveSetting nick2 + "_properties",tmp+"," + property + "="+value2 End_If End_If 'Search & update current world Dim person = getPlayer(nick) If person <> null If property = cstLEVEL person.Level = value End_If If property = cstEXP person.Experience = value End_If If property = "Score" person.Score = value End_If Else If wide 'Search & update other worlds Call BroadcastOtherWorlds("upd_prop","key="+property+",val="+value+",to="+nick) End_If End_If End_Sub EVENT onMap If $AGENT.getPanel() = "map" SetPanel $AGENT,$AGENT.__prevpanel $AGENT.__prevpanel = null Else $AGENT.__prevpanel = $AGENT.getPanel() ' Remember panel SetPanel $AGENT,"map" End_If END_EVENT EVENT onOpen If $OWNER.imageOpen <> null And $OWNER.open Dim im = NewImage($OWNER.imageOpen,1,1) $OWNER.image("N").url = im.url End_If Dim linked = $OWNER.linked If linked <> null linked.open=$OWNER.open If linked.imageOpen <> null And linked.open Dim im = NewImage(linked.imageOpen,1,1) linked.image("N").url = im.url End_If End_If END_EVENT EVENT onClose If $OWNER.imageClosed <> null And $OWNER.open=0 Dim im = NewImage($OWNER.imageClosed,1,1) $OWNER.image("N").url = im.url End_If Dim linked = $OWNER.linked If linked <> null linked.open=$OWNER.open If linked.imageClosed <> null And linked.open=0 Dim im = NewImage(linked.imageClosed,1,1) linked.image("N").url = im.url End_If End_If END_EVENT Sub getMoneyFrom(person,howmuch) Dim money=0 Dim moneypack Dim item For Each item In getItemsIn(person) If item.Cash >= howmuch money=item.Cash moneypack=item End_If Next shopkeeper = person.container.shopkeeper If money >= howmuch ' Transaction being successful moneypack.Cash = moneypack.Cash - howmuch moneypack.name = "" + moneypack.Cash + " coins" If moneypack.Cash = 0 Kill moneypack End_If Return true Else Return false End_If End_Sub ' Returns the advance box Function advanceBox(person) Dim link = gameInfo("site")+"?page_id=12#advance" Dim txt = "
    My Goals [?]" txt = txt+"Next Experience advance:
    "+Chr(13) Return txt End_Function 'Calculates and returns the next advance threshold 'for the specified person 'parameter: score/kills/spells/crafts/infections Function getNextAdvance(person,param) If param = "score" Dim s=Int(person.Level^1.3)*10 Return (Int(person.Score/s)+1)*s End_If If param = "kills" If person.type=1 Dim s=Int(person.Level^1.3)*1 Else Dim s=Int(person.Level^1.3)*2 End_If Return (Int(person.Kills/s)+1)*s End_If If param = "spells" Dim s=Int(person.Level^1.3)*4 Return (Int(person.Spells/s)+1)*s End_If If param = "crafts" Dim s=Int(person.Level^1.3)*4 Return (Int(person.Crafts/s)+1)*s End_If If param = "infections" Dim s=Int(person.Level^1.3)*4 Return (Int(person.InfectedHumans/s)+1)*s End_If End_Function 'Checks Experience for level advance Sub checkLevelAdvance(person) If person.Experience >= 10 person.Experience = person.Experience-10 If person.Level < 100 person.Level = person.Level+1 Speak SYS,$WORLD,"Level Advancement: "+UserCardLink(person.name)+" advanced to Level: "+person.Level+"!" PlaySound person,"fanfare.wav" Journal person.name&" advances to higher level",UserCard(person.name),person.name&" has advanced to Level: "&person.Level&"!","news*advancements*user:"&person.name End_If End_If End_Sub Function weaponsOf(person) Dim arr = NewSet("0=None") Dim arr2 = person.weapons Dim x, good For Each x In arr2 good = ((getCatalogItemInfo(x,"power") <> null) Or (getCatalogItemInfo(x,"protection") <> null)) If InCatalog(x) And good Dim n= wcatalog_names(x) Dim p= getCatalogItemInfo(x,"power") arr(x)=n&" ("&p&")" Else SetRemove arr2,x End_If Next Return arr End_Function Function spellsOf(person) Return weaponsOf(person) End_Function Function protectionsOf(person,ptype) Dim arr = NewSet("0=None") If ptype = cstHELMET Dim arr2 = person.helmets End_If If ptype = cstSHIELD Dim arr2 = person.shields End_If If ptype = cstARMOUR Dim arr2 = person.armours End_If Dim x, good For Each x In arr2 good = ((getCatalogItemInfo(x,"power") <> null) Or (getCatalogItemInfo(x,"protection") <> null)) If InCatalog(x) And good Dim n= wcatalog_names(x) Dim p= getCatalogItemInfo(x,"protection") arr(x)=n&" ("&p&")" Else SetRemove arr2,SetIndexOf(arr2,x) End_If Next Return arr End_Function Function artsOf(person,atype) Dim arr = NewSet("0=None") Dim arr2 = person.arts If SetLen(arr2) > 0 Dim x Dim i=1 For Each x In arr2 If artTypes(x)=atype arr(x)=artNames(x) i = i+1 End_If Next End_If Return arr End_Function ' doChoose ' multi-purpose event, catches command from ' context-sensitive menus and triggers an action EVENT doChoose() Dim cmd = input("selector_command") If (cmd <> null) Return set_robotcommand(cmd,input("object"),input("txtBox")) End_If Dim cmd = input("selector_weapon") If (cmd <> null) Return select_equipment(cmd,"weapon") End_If Dim cmd = input("selector_spell") If (cmd <> null) Return select_equipment(cmd,"weapon") End_If Dim cmd = input("selector_helmet") If (cmd <> null) Return select_equipment(cmd,"helmet") End_If Dim cmd = input("selector_armour") If (cmd <> null) Return select_equipment(cmd,"armour") End_If Dim cmd = input("selector_shield") If (cmd <> null) Return select_equipment(cmd,"shield") End_If 'Dim cmd = input("selector_item") 'If (cmd <> null) ' Return buy_item(cmd) 'End_If Dim cmd = input("selector_artattack") If (cmd <> null) Return select_art(cmd,cstATTACK) End_If Dim cmd = input("selector_artdefense") If (cmd <> null) Return select_art(cmd,cstDEFENSE) End_If If ExistScript("doChoose_Local") Return onChoose_Local() End_If Return False END_EVENT ' doCommand ' multi-purpose event, catches command from ' context-sensitive menus and triggers an action EVENT doCommand() Dim item = input("selector_item") If (item <> null) If input("shopop")<>"del" $AGENT.__interested=item Dim res = true If input("shopop")="buy" res = buy_item(item) End_If Return res Else If $AGENT.mastersuper Return catalog_del_item(item) End_If End_If End_If Dim cmd = input("masterOp") If (cmd <> null) Return doSpecialOp(cmd,input) End_If If ExistScript("doCommand_Local") Return doCommand_Local(input) End_If Return False END_EVENT Function select_equipment(cmd,ptype) If cmd<>0 If ptype = "helmet" $AGENT.helmet = cmd End_If If ptype = "shield" $AGENT.shield = cmd End_If If ptype = "armour" $AGENT.armour = cmd End_If If ptype = "weapon" $AGENT.weapon = cmd End_If Print $AGENT,"I'll be using: " & wcatalog_names(cmd) & "" End_If Call doCheckup() Return true End_Function Function select_art(art,atype) If art <> 0 Print $AGENT,"I will use the Art of " + artNames(art) + " for " + atype If atype = cstATTACK $AGENT.artattack = art Else $AGENT.artdefense = art End_If End_If Call doCheckup() Return true End_Function ' Checks if two players have the same IP or guild ' same result if one of the two guilds is NULL Function SameIPorGuild(winner,loser) If winner.remoteAddr <> null and winner.remoteAddr = loser.remoteAddr Return true End_If If IsPlayer(loser) And loser.guild = null ' Newbies don't count Return true End_If If IsPlayer(loser) And winner.guild = loser.guild ' Guild mates don't count Return true End_If Return false End_Function ' Prints out the affinities of the specified object ' Input: object (should have a .affinities property) ' or affinities array (4 numbers) Function htmlAffinities(object) Dim tmp = "" Dim affi = object.affinity If affi = null And SetLen(object) = 4 affi = object End_If If affi<>null tmp = "Affinity
    "+Chr(13) tmp=tmp+"" + NewImage("panhelp.gif",16,16).html("Explain",$AGENT) + "Explain" tmp=tmp+"" Dim i For i = 1 To 4 tmp = tmp + ""+Chr(13) Next tmp = tmp + "
    + cstAffiNames(i) +" + cstAffiNames(i) + "" + affi(i) + "
    " End_If Return tmp End_Function ' Prints out the affinities of the specified object ' Input: object (should have a .affinities property) ' or affinities array (4 numbers) Function htmlAffinitiesCompact(object,label) Dim tmp = "" Dim affi = object.affinity If affi = null And SetLen(object) = 4 affi = object End_If If affi<>null tmp = "" Dim i For i = 1 To 4 tmp = tmp + "" Next tmp = tmp + "
    "+label+"+ cstAffiNames(i) +
    " End_If Return tmp End_Function Function calcAffiDiff(attacker,victim,weapaffi,protaffi) 'Print $WORLD,"attacker: " + attacker 'Print $WORLD,"victim: " + victim 'Print $WORLD,"weapon: " + weapon 'Print $WORLD,"protection: " + prot Dim affidiff = NewArray("0,0,0,0") Dim i,x Dim difftot = 0 affiattack = NewArray("0,0,0,0") affidefense = NewArray("0,0,0,0") For i = 1 To 4 '*** Attacker x = 0 If attacker.affinity <> null x = x + attacker.affinity(i) End_If If weapaffi <> null Dim ar = Split(weapaffi,"/") x = x + ar(i) End_If If x > 4 x = 4 End_If affidiff(i) = x 'Print $WORLD,"affi attack" + "+ cstAffiNames(i) + " + cstAffiNames(i) + ": " + affidiff(i) + Chr(13) affiattack(i) = x '*** Victim x = 0 If victim.affinity <> null x = x + victim.affinity(i) End_If If protaffi <> null Dim ar = Split(protaffi,"/") x = x + ar(i) End_If If x > 4 x = 4 End_If 'Print $WORLD,"affi defense" + "+ cstAffiNames(i) + " + cstAffiNames(i) + ": " + x + Chr(13) affidefense(i) = x affidiff(i) = affidiff(i) - x If affidiff(i) < 0 affidiff(i) = 0 End_If 'Print $WORLD,"affi total" + "+ cstAffiNames(i) + " + cstAffiNames(i) + ": " + affidiff(i) + Chr(13) difftot = difftot+affidiff(i) Next Return difftot End_Function 'Checks object for affinity - if not present, select at random Sub SetRndAffinity(object) Dim affi = object.affi If affi = null affi = "" Dim i,x Dim spend = 4 ' Points to spend For i = 1 to 3 If spend < 1 x = 0 Else x = RndInt(spend+1)-1 End_If affi = affi + x spend = Int(spend-x) affi = affi + "/" Next affi = affi + spend End_If Call SetAffinity(object,affi) End_Sub Sub SetAffinity(object,affi) If affi<>null object.affinity = Split(affi,"/") Return End_If Call checkAffinity(object) End_Sub Sub checkAffinity(object) If object.affinity = null If object.affi<>null object.affinity = Split(object.affi,"/") Return End_If If object.__affi<>null object.affinity = Split(object.__affi,"/") Return End_If End_If End_Sub Function getCatalog(shop) Dim x = NewSet() If shop.shopkeeper = null ' Not a shop - quick exit Return x End_If Dim i,p Dim s = shop.shopkeeper For Each i In SetKeys(wcatalog) If s.avail(i) >= 0 Or Not(limitedavails) x(i) = wcatalog_names(i) p=Int(getCatalogItemInfo(i,"protection")) + getCatalogItemInfo(i,"power") If p>0 x(i)=x(i)&" ("&p&")" End_If End_If Next Return x End_Function ' Loads (rebuilds) Weapon's catalog Function buildWCatalog() wcatalog = NewSet() wcatalog_names = NewSet() wcatalog_desc = NewSet() wcatalog_props = NewSet() Dim nitems = getSetting("ctx_items",0) Dim i Dim itemstring For i = 1 To nitems itemstring = getSetting("ctx_item"+i) If itemstring <> null Dim arrData = Split(itemstring,"*") wcatalog_names(arrData(1)) = arrData(2) wcatalog(arrData(1)) = arrData(3) Call buildWcatalogProps(arrData(1)) If SetLen(arrData) > 3 wcatalog_desc(arrData(1)) = arrData(4) End_If Else Debug "ERROR - missing item "+i+" from catalog" End_If Next Return nitems End_Function ' Creates a property map for each catalog item ' key format item_property Function buildWcatalogProps(item) Dim bits = NewSet(wcatalog(item)) Dim p For Each p In SetKeys(bits) wcatalog_props(item&"_"&p)=bits(p) Next End_Function ' Gets the attributes of an Item in the items catalog ' And returns the specified property ' property cannot be name (use wcatalog_names(item)) Function getCatalogItemInfo(item,property) 'Dim bits = NewSet(wcatalog(item)) 'Return bits(property) Return wcatalog_props(item&"_"&property) End_Function ' Similar to getCatalogItemInfo but looks in inventory first Function getInfoOwnedOrCatalog(who,type,property) If containsType(who,type,false) wset = getObjectsType(who,type) Return wset(1).getProperty(property) End_If If property <> "name" Return getCatalogItemInfo(type,property) End_If Return wcatalog_names(type) End_Function Function view_item(item,shopkeeper,nocontrols) Dim txt = "" Dim Cr = "
    " & Chr(13) Dim icon = "+wcatalog_names(item)+" Dim imagefull = "+wcatalog_names(item)+" txt = txt & icon + imagefull + "

    "+wcatalog_names(item)+"

    "+wcatalog_desc(item) & Cr Dim lev = getCatalogItemInfo(item,"level") Dim lock = "" If lev > 0 If $AGENT.Level < lev lock = " (LOCKED)" End_If txt = txt & "Required Level: "+lev&lock & Cr End_If If Not(nocontrols) txt = txt & "Price: "+getCatalogItemInfo(item,"value") & Cr If limitedavails And Exists(shopkeeper) If SetContainsKey(shopkeeper.avail,item) Dim avail = shopkeeper.avail(item) txt = txt & "In stock: "+avail & Cr End_If End_If End_If Dim x = getCatalogItemInfo(item,"power") If x <> null txt = txt & "Power: "+x & Cr End_If Dim x = getCatalogItemInfo(item,"protection") If x <> null txt = txt & "Protection: "+x & Cr End_If Dim affi = getCatalogItemInfo(item,"affi") If affi <> null txt = txt & htmlAffinitiesCompact(Split(affi,"/"),"Affinity") & Cr End_If Dim designer = getCatalogItemInfo(item,"designer") If designer <> null txt = txt & "Forged by: "+ UserCardLink(designer) & Cr End_If txt = txt & "" If nocontrols Return txt End_If txt = txt & "" & " " ' Navi Dim keys = SetKeys(Wcatalog) Dim pos = SetIndexOf(keys,item) Dim k = findNextVisibleItem(keys,pos,-1) If k<>null txt = txt&"" End_If Dim k = findNextVisibleItem(keys,pos,1) If k<>null txt = txt&"" End_If txt=txt&"
    "&Cr Return txt End_Function Function buy_item(item) Dim shopkeeper If $AGENT.container <> null If $AGENT.container.shopkeeper <> null ' Not a shop - quick exit shopkeeper = $AGENT.container.shopkeeper End_If End_If If shopkeeper = null 'Not in a shop - quick exit Return false End_If $AGENT.__interested=item Dim value = getCatalogItemInfo(item,"value") If getCatalogItemInfo(item,"level") > $AGENT.Level Display "To buy this item you need at least Level "+getCatalogItemInfo(item,"level") Return false End_If If limitedavails Dim avail = shopkeeper.avail(item) If SetContainsKey(shopkeeper.avail,item) And avail < 1 Speak shopkeeper,$AGENT,"I don't have this item in stock, hope that somebody makes one soon and brings it to me, I would pay it well!" Return false End_If End_If If getMoneyFrom($AGENT,value) Speak shopkeeper,$AGENT,"So you want: " + wcatalog_names(item) Dim newobj = MakeItem(item,$AGENT) Move newobj,$AGENT If newobj.container <> $AGENT Speak shopkeeper,$AGENT,"Ma non hai abbastanza spazio! Ti rendo subito i soldi." Kill newobj Call giveMoney($AGENT,value) Return false End_If If limitedavails And SetContainsKey(shopkeeper.avail,item) shopkeeper.avail(item) = shopkeeper.avail(item)-1 End_If Else Print "Don't have enough money. It costs " + value + " coins." End_If Return true End_Function 'Makes item out from the item catalog 'for the specified player 'input: type = unique ID of object type Function MakeItem(type,player) Dim features = wcatalog(type) If features = null Speak SYS,player,"Impossibile to create object " + type + " - contact a game master" Debug "Problem on creating item: "+type+" features='" & features & "'" Return null End_If Dim personal = false If Right(type,9) = ".personal" Or MyExtract(features,"personal") personal = true End_If Dim name = wcatalog_names(type) Dim descr = wcatalog_desc(type) Dim power = MyExtract(features,"power") Dim protection = MyExtract(features,"protection") Dim icon = MyExtract(features,"icon") Dim sound = MyExtract(features,"sound") Dim imageurl = MyExtract(features,"imageurl") Dim imagew = MyExtract(features,"imagew") Dim imageh = MyExtract(features,"imageh") Dim zimageurl = MyExtract(features,"zimage") Dim affi = MyExtract(features,"affi") Dim level = MyExtract(features,"level") Dim badagainst = MyExtract(features,"badagainst") Dim bestagainst = MyExtract(features,"bestagainst") Dim showmode = MyExtract(features,"showmode") Dim attrlist = "type="+type+",icon="+icon+",pickable" Dim uses = MyExtract(features,"uses") Dim volume = MyExtract(features,"volume") Dim capacity = MyExtract(features,"capacity") Dim open = MyExtract(features,"open") Dim openable = MyExtract(features,"openable") If power <> null attrlist = attrlist+",Power="+power End_If If protection <> null attrlist = attrlist+",Protection="+protection End_If If showmode = null showmode = 1 'default: 1=ONSCREEN End_If attrlist = attrlist + ",showmode="+showmode If sound <> null attrlist=attrlist+",sound="+sound End_If If affi <> null attrlist=attrlist+",affi="+affi End_If If level <> null attrlist=attrlist+",Level="+level End_If If badagainst <> null attrlist = attrlist + ",badagainst="+badagainst End_If If bestagainst <> null attrlist = attrlist + ",bestagainst="+bestagainst End_If If uses <> null attrlist = attrlist + ",uses="+uses End_If If personal attrlist = attrlist + ",vanishing=2" Else attrlist = attrlist + ",Value=" + MyExtract(features,"value") End_If If volume <> null attrlist = attrlist + ",volume=" + volume End_If If capacity <> null attrlist = attrlist + ",capacity=" + capacity End_If If open <> null attrlist = attrlist + ",open=" + open End_If If "" <> openable attrlist = attrlist + ",openable=" + openable End_If Dim image If imageurl <> null image = NewImage(imageurl,imagew,imageh) End_If Dim x = NewItem(null,name,descr,image,attrlist) If zimageurl <> null x.zoomimage = NewImage(zimageurl,MyExtract(features,"zimagew"),MyExtract(features,"zimageh")) End_If Dim t = MainType(getObject(x)) If t="armour" Or t="helmet" Or t="shield" x.volume=0 End_If 'Speak SYS,$WORLD,attrlist If personal AttachEvent x,"saveInfo","personalWeapon_saveInfo" End_If Return x End_Function ' Saves Weapon's catalog to disk Function saveWCatalog() Dim nitems = SetLen(wcatalog) Dim keys = SetKeys(wcatalog) SaveSetting "ctx_items",nitems Dim i Dim k Dim itemstring For i = 1 To nitems k = keys(i) itemstring = k + "*" + wcatalog_names(k) + "*" + wcatalog(k) + "*" + wcatalog_desc(k) SaveSetting "ctx_item"+i,itemstring Next Call BroadcastOtherWorlds("catalog_update","") Print "(Saved catalogue: "&nitems&" items)" Return nitems End_Function Function UserCard(pg) Dim pg1 = CookName(pg) Return gameInfo("site")&"infobox.php?id="&pg1 End_Function Function UserCardLink(pg) Dim pg1 = CookName(pg) Dim site = gameInfo("site") Dim lang = "eng" Return ""+pg+"" End_Function EVENT doFindObj(obj) 'obj = input("obj") 'Print "input: " + input + "
    " 'Print "obj: " + obj + "
    " 'Print "Searching: " + obj + "
    " If Len(obj) < 3 Print "Search WHAT? Specify at least 3 characters." Return End_If If tournament=2 Print "Not available during tournament" Return End_If Dim found = false Dim c For Each c In getItemsIn($WORLD) If InStr(c.name,obj) found=true Print "
  • " + c.name + " is in: " + c.container.name End_If Next For Each c In getCharactersIn($WORLD) If InStr(c.name,obj) found=true Print "
  • " + c.name + " is in: " + c.container.name End_If Next If Not(found) Print "Not found: '" + obj + "'" End_If End_EVENT 'Tells whether a player is a beginner or not (duplicate character) Function IsBeginner(person) If person.mainpg <> "" And person.mainpg <> person.name Return False End_If Return True End_If Sub prepareJail(person,name) If doJail(person,name,$AGENT) Print "success." Else Print "NOT POSSIBLE!" End_If Dim mainpg = LookupProfileDB(name,"mainpg") If mainpg <> name If doJail(NULL,mainpg,$AGENT) Print "Jailed main character: "+mainpg+" and all related characters" Else Print "Jailing of main character: "+mainpg+" NOT POSSIBLE" End_If End_If Speak SYS,$AGENT,"Done. Action logged." End_Sub Function doJail(person,name,agent) Dim result = false Debug agent.name + " incarcera: " + person.name + "/" + name + " in data/ora: " + getTime("dd/MM/yyyy HH:mm") If Not(Exists(person)) ' Try looking by name person = getPlayer(name) End_If If Exists(person) name = person.name Move person,hellfire result = true End_If If ProfileExists(name) SaveSetting CookName(name) + "_location","hellfire" Print agent,"Jailing of "+name+" succeeded on saved profile" result = true Else If result = true 'No profile saved - Ban Print agent,"Jailing of "+name+" partial success - no saved profile - try banning" result = false End_If End_If Return result End_Function Function isJailed(name) If getSetting(CookName(name) + "_location") = "hellfire" Return true End_If Return false End_Function Sub unJail(person,name) Debug $AGENT.name + " has FREED " + person.name + "/" + name + " in date/time: " + getTime("MM-dd-yyyy HH:mm") If Not(Exists(person)) ' Try looking by name person = getPlayer(name) End_If If Exists(person) Print "Instantly freeing: "+person.name name = person.name Move person,start End_If If ProfileExists(name) SaveSetting CookName(name) + "_location","start" Print "Unlocked profile "+Chr(34)+name+Chr(34) End_If Dim mainpg = LookupProfileDB(name,"mainpg") If mainpg <> "" And mainpg <> name If ProfileExists(mainpg) SaveSetting CookName(mainpg) + "_location","start" Print "Unlocked main ch "+Chr(34)+mainpg+Chr(34)+" and linked characters" End_If Else Print "Main ch of "+name+": "+Chr(34)+mainpg+Chr(34) End_If Speak SYS,$AGENT,"Done. Action logged." End_Sub Function ProfileExists(name) If getSetting(CookName(name) + "_when","") <> "" Return true End_If Return false End_Function Function getGuildCount(owner) Return 1+SetLen(Split(guildsubscribers(owner),";")) End_If Function getTournamentMessage() If tournament > 0 Return "There's a competition ongoing: "+tourntypes("t"+tournament)+". Partecipate, it's free!" End_If Return "" End_Function Function doGetVisits(id) ' Gets the visits from uw site id = cookname(id) 'Print "" Dim code = getSetting(id+"_pass","") Dim url = gameInfo("site")+"infovisits.php?id="+id+"&code="+code Dim txt = HttpFetch(url) If InStr(txt,"ok") ' Fetching OK - now read visits number Dim x = InStr(txt,"")+8 Dim y = InStr(txt,"") ' Read between tags Dim visits = Int(Mid(txt,x,y-x)) If tournament > 0 Print "Visits: "+visits Print "Exp advance temporarily suspended until competition finishes" Return End_If Dim extinc = Int(visits/visitsperinc) If extinc > 0 If $AGENT <> null $AGENT.Experience = $AGENT.Experience+extinc Print "

    Exp points added: +"+extinc+" SAVE NOW!

    " ' "clear" parameter tells site to clear visits that have been just credited Dim url = gameInfo("site")+"infovisits.php?id="+id+"&code="+code+"&clear="+extinc*visitsperinc Dim txt = HttpFetch(url) 'Print url End_If Else Dim link = "" Print link+"Next advance: "+(visitsperinc-visits)+" visits" End_If Else Print "Problem getting visits of: "+id+Chr(13)+" Retry later!" 'Debug "Problem getting visits of: "+id+" url= "+url End_If 'Print "" End_Function ' Determines whether an object is unique from its type Function IsUnique(object) Return SetContainsKey(uniqueTypes,object.type) End_Function ' Determines whether an object contains a unique object from its type Function ContainsUnique(object) Dim t For Each t In SetKeys(uniqueTypes) If containsType(object,t,true) Return true End_If Next Return false End_Function Function htmlArts(person) Dim txt="" If person.artdefense <> null txt = txt & "Defense: "+artNames(person.artdefense)+"
    " End_If If person.artattack <> null txt = txt & "Attack: "+artNames(person.artattack)+"
    " End_If If txt<>"" Dim link = gameInfo("site")+"?page_id=12#arts" Return "
    Owned Arts"+txt+"
    " Else Return "" End_If End_Function Function htmlUsedEquip(person) Dim txt,x Dim Q = Chr(34) txt = "
    Equipment in use" txt = txt & "Weapon: " x = person.weapon If x <> null icon = "" txt = txt & "" & wcatalog_names(x) & icon & "
    " Else txt = txt & "none" End_If x = person.armour If x <> null icon = "" txt = txt & "Armour: " txt = txt & "" & wcatalog_names(x) & icon & "
    " End_If x = person.shield If x <> null icon = "" txt = txt & "Shield: " txt = txt & "" & wcatalog_names(x) & icon & "
    " End_If x = person.helmet If x <> null icon = "" txt = txt & "Helmet: " txt = txt & "" & wcatalog_names(x) & icon & "
    " End_If Return txt+"
    " End_Function ' Does person belongs to a pacific guild? Function GuildPacific(person) Dim g = person.guild If g=null Return false End_If If guildtypes(g) = "p" Return true end_If Return false End_If Function CanAttackAB(a,b) Return Not(GuildPacific(b)) And Not(GuildPacific(a) And IsPlayer(b)) End_Function Function Concordate(person) If person.gender = "F" Return "a" Else Return "o" End_If End_Function ' calcAffiResult ' Calculates the result affinity of ' a person (MUST NOT be null) ' an object's type and the set name Function calcAffiResult(person,type,setname) Dim myset = person.getProperty(setname) 'If SetLen(myset)<0 ' myset = NewArray() 'End_If If SetIndexOf(myset,type) = 0 Dim affi = null Else Dim affi = getCatalogItemInfo(type,"affi") End_If Dim affinity = Split(affi,"/") If SetLen(person.affinity) <> 4 person.affinity = NewArray() person.affinity(1)=0 person.affinity(2)=0 person.affinity(3)=0 person.affinity(4)=0 End_If Dim affiresult = Copy(person.affinity) If SetLen(affinity) = 4 'print person,"+ affinity: "+affinity Dim i,x For i = 1 To 4 x = affiresult(i)+affinity(i) If x > 4 x = 4 End_If affiresult(i) = x Next 'Else ' print person,"- affi: "&affi&"=affinity: "&affinity End_If Return affiresult End_Function ' calcAffiResult2 ' Calculates the result affinity of ' a person (MUST NOT be null) ' and an object of specified type (s)he could carry Function calcAffiResult2(person,type) If SetLen(person.affinity) <> 4 Return NewArray("0,0,0,0") End_If Dim affiresult = Copy(person.affinity) If type = null 'Print person,"NULL type or NULL person.affinity" Return affiresult End_If Dim object = getContainedType(person,type) If object = null 'Print person,"NO object of type: "+type Return affiresult End_If 'Print person,"NONNNULL: "+object If SetLen(object.affinity) = 4 'print person,"- affinity: "+object.affinity Dim i,x For i = 1 To 4 x = affiresult(i)+object.affinity(i) If x > 4 x = 4 End_If affiresult(i) = x Next 'Else 'print person,"- affinity: NULL" End_If Return affiresult End_Function 'Returns true if the two are in war Function areInWar(guild1,guild2) Return SetContainsKey(guildwars,guild1+"*"+guild2) Or SetContainsKey(guildwars,guild2+"*"+guild1) End_Function Function GuildHasDelegate(owner,name) Return InStr(guilddelegates(owner),name+";") End_Function Function GuildDelegateIcon(name,guild) If GuildHasDelegate(guild,name) Return " " Else Return "" End_If End_If ' Checks for person's invisibility ' Possibly clears invisibility ' Returns: invisibility left ticks Function CheckInvis(person) Dim left = 0 If person.invisible ' Check ticks Dim invi = Split(person.invisticks,"*") If SetLen(invi) < 2 left = 0 Else left = 4+invi(2)-Int(ticks) End_If If left <= 0 Or invi(1) <> $WORLD.instanceid Call doInvis(person) left = 0 End_If Else person.invisticks = "" End_If Return left End_Function Sub onKillRobot(loser,winner) If ExistScript("onKillRobot_local") Call onKillRobot_local(loser,winner) Else Dim tmp = winner.name + " has " + RndSet(arrVerbs) + " " + loser.name + "!! " If SetLen(getPlayersIn($WORLD)) < 4 Speak SYS,$WORLD,tmp End_If End_If PlaySound winner.container,loser.suffersound End_Sub Function IsMagician(person) Return (person.type=2 Or person.type=19) End_Function EVENT saveInfo() 'Print $WORLD,"Saving... $OWNER: "+$OWNER+" $AGENT: "+$AGENT+" $TARGET:"+$TARGET maintype = MainType($OWNER) type = $OWNER.type Dim txt DropItems $OWNER 'Drop inner objects If type = "money" txt = ""+$AGENT.name+" saves money" 'Print $WORLD,txt 'Debug txt Return $OWNER.Cash End_If If type = "bottle.potion" txt = ""+$AGENT.name+" saves potion w/ uses "+$OWNER.uses 'Print $WORLD,txt 'Debug txt Return $OWNER.uses End_If If IsUnique($OWNER) txt = ""+$AGENT.name+" tries to save a unique object: "+$OWNER.name 'Print $WORLD,txt 'Debug txt Return null End_If 'If not unique then it should be in the catalog If InCatalog(type) Return "*" ' Special value means: it's in the catalog, no more info needed to restore End_If 'Everything else - don't know how to restore ' Return null End_EVENT Sub restore(type,restoreinfo,player) If restoreinfo = "" Or restoreinfo="null" 'Do not event attempt Return false End_If If InCatalog(type) Dim item = MakeItem(type,player) If Exists(item) Print player,"Restoring: "+type Move item,player Return true End_If End_If If type = "whip" If SetLen(getObjectsType(player,"whip")) < 1 Dim exis = getObjectsType($WORLD,"whip") If SetLen(exis) < 1 Call MakeWhip(player) Return true Else Print player,"Una frusta diabolica si trova qui: " + exis(1).container.name Return false End_If End_If Return true End_If If type = "money" restoreinfo = Int(restoreinfo) If restoreinfo>0 Call giveMoney(player,restoreinfo) Return true Else Return false End_If End_If If type = "bottle.potion" Dim item = MakeItem(type,player) If item=null Print player,"Cannot remake "+type Return false End_If item.uses = Int(restoreinfo) 'Debug "Restored potion!" Return true End_If Print player,"Don't know how to restore: type="+type+" info:"+restoreinfo Return false ' Not restored by default End_Sub ' Initalizes all the shops ' input: array with all shopkeepers IDs Sub shops_prepare(shopkeepers) Dim s For Each s In shopkeepers Call initialize_catalog(s) Next End_Sub ' Initalizes a shop (availability of items) ' input: shopkeeper Sub initialize_catalog(s) s.avail = NewSet() Dim i For Each i In SetKeys(wcatalog) Dim avail = getCatalogItemInfo(i,"avail") If avail > 0 s.avail(i) = avail End_If Next End_Sub Function commandsFromTo(from,to) Dim setCmds = NewSet("_=(nothing)") Dim empathic = false If from.type=12 Or from.type=14 'Vampire empathic = empathy(from,to) End_If If Not(areEnemies(to,from)) Or debugtype="cmds" Or empathic If Not(to.nohands) setCmds("findobj") = setRobotCmds("findobj") End_If If from.Level > 5 Or from.type > 10 setCmds("hunt") = setRobotCmds("hunt") End_If If to.progeny = from.name setCmds("progeny") = setRobotCmds("progeny") End_If If from.type=1 Or debugtype="cmds" setCmds("terminate") = setRobotCmds("terminate") End_If If ContainsType(from,"crown",false) Or debugtype="cmds" setCmds("escort") = setRobotCmds("escort") End_If End_If Return setCmds End_Function Function set_robotcommand(cmd,object,text) 'Print "object:"+object+" $AGENT:"+$AGENT+" cmd:"+cmd If Exists(object) And cmd<>"_" If (object.command <> null) Dim commander = getPlayer(object.commander) If Exists(commander) And object.commander <> $AGENT.name Speak object,$AGENT,"I am executing orders by "+object.commander Return false End_If End_If If cmd = "terminate" And Len(text) < 3 Speak object,$AGENT,"Victim's name must be longer" Return false End_If If cmd = "escort" SetAdd $AGENT.__hooked,object.id,object End_If object.command = cmd object.commandaux = text $AGENT.__prevenemy = text object.commander = $AGENT.name Speak object,$AGENT,"I will do it!","Yes sure!","All right." End_If End_Function Function htmlIcon(icon,alt) Return "+Chr(34)+alt+Chr(34)+" End_Function Function robotCommandForm(robot,person) Dim txt = "
    " txt = txt & "Mission: " If SetContainsKey(setCmds,"terminate") Dim value = robot.commandaux If person.__prevenemy <> null value=" value="+Chr(34)+person.__prevenemy+Chr(34) End_if txt=txt+"" End_If txt = txt & "" txt = txt & "" If robot.command <> null txt = txt & "
    Commanded by: "+UserCardLink(robot.commander) End_If txt = txt & "
    " Return txt End_Function 'Absolutizes and image's url 'If the url is already absolute, leaves it like it is, ' otherwise adds the image dir at the beginning Function absolutizeUrl(url) If Left(url,7) = "http://" Return url Else Return main_imagedir+url End_If End_Function Function relativizeUrl(url) If Left(url,Len(main_imagedir)) = main_imagedir Return Right(url,Len(url)-Len(main_imagedir)) End_if Return url End_Function Function catalog_dropdown(shop,person) Dim cname = "Shop catalog" Dim txt Dim q = Chr(34) ' Quotes If cat=null Or limitedavails=True 'Speak SYS,$WORLD,"Loading catalog..." cat = getCatalog(shop) End_If txt = txt&"" txt = txt&" " txt = txt&"" Return txt End_Function ' Calculates if there is empathy between person and name2 ' Empathy is calculated on names' basis ' by using hash functions ' empathy increases with inverse logarithmic function ' Until reaches 50% chance. Function empathy(person,enemy) Dim i Dim h1=0 Dim name1=person.name For i = 1 To Len(name1) h1=h1+Asc(Mid(name1,i,1)) Next Dim h2=0 Dim name2=enemy.id For i = 1 To Len(name2) h2=h2+Asc(Mid(name2,i,1)) Next Dim max=Int((20-Log(person.Level+1)*6)/2) If max<2 max = 2 End_if Return ((h1 Mod max) = (h2 Mod max)) End_Function 'Acquires an acquirable object 'input: the object (MUST be acquirable!) 'output: true on success Function acquireObject(person,item) Dim res = false If $WORLD.name <> "Underworld" Print "This operation can only be executed in the central area (castle)." Return false End_If Dim maintype = MainType(item) If SetLen(person.helmets) < 0 Debug "ERROR - this person does not have arrays: "&person.name&" id: "&person.id Call FixArrays(person) End_If If maintype = cstHELMET If SetIndexOf(person.helmets,item.type)=0 person.helmets(SetLen(person.helmets)+1) = item.type res = true End_If End_If If maintype = cstSHIELD If SetIndexOf(person.shields,item.type)=0 person.shields(SetLen(person.shields)+1) = item.type res = true End_If End_If If maintype = cstARMOUR If SetIndexOf(person.armours,item.type)=0 person.armours(SetLen(person.armours)+1) = item.type res = true End_If End_If If maintype = "weapon" Or maintype = "spell" Dim canacquire = (maintype="spell" And (person.type=2 Or person.type=19)) Or (maintype="weapon" And Not(person.type=2 Or person.type=19)) If canacquire If SetIndexOf(person.weapons,item.type)=0 person.weapons(SetLen(person.weapons)+1) = item.type res = true End_If Else Print "Cannot do that." Return false End_If End_If If res = false Print "It is already in my permanent equipment. Click ["+htmlIcon("paninfo.gif","Info")+"Info]" End_If If Not(InCatalog(item.type)) ' Not in catalog! - add it Call CatalogStoreItem(item) Call shops_prepare(arrShopkeepers) End_If Return res End_Function Sub CatalogStoreItem(item) Dim nitems = SetLen(wcatalog) Dim attributes wcatalog_names(item.type) = item.name 'Build attributes list attributes = attributes & "level=" & item.Level & "," attributes = attributes & "value=" & item.Value & "," attributes = attributes & "icon=" & relativizeUrl(item.icon) & "," attributes = attributes & "imageurl=" & relativizeUrl(item.image("N").url) & "," attributes = attributes & "imagew=" & item.image("N").width & "," attributes = attributes & "imageh=" & item.image("N").height & "," attributes = attributes & "power=" & item.Power & "," attributes = attributes & "protection=" & item.Protection & "," attributes = attributes & "showmode=" & item.showmode & "," attributes = attributes & "sound=" & item.sound & "," attributes = attributes & "avail=1" & "," Dim affi = item.affi If SetLen(item.affinity) = 4 affi = AffiStringCat(item.affinity) End_If If affi <> null attributes = attributes & "affi="&affi End_If wcatalog(item.type) = attributes If item.description <> null wcatalog_desc(item.type) = item.description End_If Call saveWCatalog() Call buildWCatalog() End_Sub Function catalog_del_item(item) SetRemove wcatalog,item SetRemove wcatalog_names,item SetRemove wcatalog_desc,item Return saveWCatalog() Call buildWCatalog() End_Function 'Converts an affinity array into a string 'input: affi: array(1...4) Function AffiString(affinity) If SetLen(affinity) < 4 Return affinity End_If Dim i,x For i = 1 To 4 x = x&affinity(i) Next Return x End_If 'Converts an affinity array into a string for catalog use 'input: affi: array(1...4) Function AffiStringCat(affinity) If SetLen(affinity) < 4 Return affinity End_If Dim i,x For i = 1 To 4 x = x&affinity(i) If i < 4 x=x&"/" End_If Next Return x End_If Sub FixArrays(person) If SetLen(person.helmets)=-1 person.helmets = NewArray() End_If If SetLen(person.shields)=-1 person.shields = NewArray() End_If If SetLen(person.armours)=-1 person.armours = NewArray() End_If If SetLen(person.weapons)=-1 person.weapons = NewArray() End_If End_Sub ' Is this item acquirable? Function IsAcquirable(item) If item = null SharedError = "The object does no exist" Return false End_If If item.getProperty(cstPROT)=null And item.getProperty(cstPOWER)=null SharedError = null Return false End_If Return true End_Function ' Is Specified type in the catalog? Function InCatalog(type) Return SetContainsKey(wcatalog,type) End_Function EVENT doViewItem(item,nocontrols) Dim Q = Chr(34) Print "" Print "" Print "" Print "" If Not(InCatalog(item)) Print "

    Not Found

    " End_If Print "
    " Print view_item(item,null,nocontrols) Print "
    " 'Print Replace(view_item(item,null,nocontrols),Chr(13),"
    "&Chr(13)) Print "" End_EVENT EVENT doExpertSwitch() Dim Q = Chr(34) Print "" Print "" If $AGENT.expert $AGENT.expert="" Print "Simple" Else $AGENT.expert=1 Print "Expert" End_If Print "" End_EVENT Function SetToString(value) If SetLen(value)<0 Return value End_If Dim ret = "!set!" Dim v Dim keys = SetKeys(value) For Each k In keys ret = ret&k&"="&value(k) ret = ret&"*" Next ret = Left(ret,Len(ret)-1) ' Trim last * Return ret End_Function Function LeadingZero(number,format) Dim x = Len(number) If Len(format) > x Return Left(format,Len(format)-x) + number End_If Return number End_Function Function SanityCheck(item) SharedError = "" If Not(Exists(item)) SharedError = "The boject does not exist" Return false End_If Dim t = item.type If InCatalog(t) Return true End_If Dim x For Each x In wcatalog_names If item.name = x SharedError = "Name needs to be changed" Return false End_If Next For Each x In wcatalog_desc If item.description = x SharedError = "Description needs to be changed" Return false End_If Next Dim im = relativizeUrl(item.image("N").url) For Each x In wcatalog If im = MyExtract(x,"imageurl") SharedError = "Image needs to be changed" Return false End_If Next Return true End_Function Function FixCatalog() Dim t,x Dim valids = NewArray("weapon,armour,shield,helmet") For Each t In SetKeys(wcatalog) x = wcatalog(t) Dim arr = Split(t,".") If SetLen(arr) >= 4 Dim y = arr(1) If SetIndexOf(valids,y) > 0 And Len(arr(2)) = 2 And Len(arr(3)) = 2 And Len(arr(4)) = 4 If InStr(t,"affi=")=0 Print "Da sistemare: " & t & ":" & x Dim affi = arr(4) Dim newaffi = Left(affi,1)&"/"&Mid(affi,2,1)&"/"&Mid(affi,3,1)&"/"&Right(affi,1) If Right(x,1) <> "," x = x&"," End_If wcatalog(t) = x&"affi="&newaffi Print "Sistemata: "& wcatalog(t) Else Print "VA BENE!: " & t & ":" & x End_If Else Print "Scartato: " & t & ":" & x End_If Else Print "Decisamente Scartato: " & t & ":" & x End_If Next End_Function Function FormatTimestamp(ts) Return Left(ts,4) & "-" & Mid(ts,5,2) & "-" & Mid(ts,7,2) & " " & Mid(ts,9,2)&":"&Mid(ts,11,2) End_Function ' Displays a progress bar for showing damage Function barDamage(H,inc) Dim b b = "" 'Invariant: H-inc+gap=10, and (H-inc+gap)/x=10/100 so x=(H-inc+gap) Dim Horig=H If H<0 inc=inc+H 'Avoid inc too large H=0 End_If Dim p1=Round(H*10,0) Dim pi=Round(inc*10,0) Dim p2=Round(100-p1-pi,0) Dim bak="darkgrey" If H > 5 Dim x1=H Dim x2=" " Else If H > 0.5 Dim x1=" " Dim x2=H Else Dim bak="red" Dim x2=Horig End_If End_If If p1>0 b = b & "" End_If b = b & "" If p2 >= 1 b = b & "" End_If b = b & "
    "&x1&" "&x2&"
    " Return b End_Function Function myDamage(hits) Dim orighits=hits Dim b="" Dim h=NewImage("heart.png",20,20).html() hits=Round(1+hits,0) If hits < 1 Return ""&orighits&"" Else For i=1 To hits b=b&h Next End_If Return ""&orighits&" "&b&"" End_Function Function findNextVisibleItem(keys,pos,increment) pos = pos + increment If pos>=1 And Pos <= SetLen(keys) Dim item = keys(pos) If Not(getCatalogItemInfo(item,"hide")) Return item Else Return findNextVisibleItem(keys,pos,increment) End_If End_If Return null End_Function '******** UNUSED Function IsWeaponCoherent(wtype,player) Dim maintype=Left(wtype,5) If maintype="spell" And Not(IsMagician(player)) Return False End_If Return True End_Function