LambdaHack-0.9.5.0/0000755000000000000000000000000007346545000012023 5ustar0000000000000000LambdaHack-0.9.5.0/CHANGELOG.md0000644000000000000000000007145407346545000013647 0ustar0000000000000000## [v0.9.5.0](https://github.com/LambdaHack/LambdaHack/compare/v0.9.4.0...v0.9.5.0) - Fix NumLock disabled in the browser - In screen reader frontend, highlight active menu line with the cursor - Clone the main main menu commands as map mode commands - Add C-RMB and C-S-LMB as alternatives of MMB - Announce prominently MMB binding for describing map positions - Clean up the default config file, keeping compatibility - Make scenario names longer and slighlty more informative - Make Vi movement keys the default in addition to keypad and mouse - Fix a bug where death prompt when autoplaying was capturing a keypress - Let ESC from main menu return to insert coin mode, if applicable - Make various small UI tweaks, especially to main menu and its submenu - Let main menu lines have 35, not 30, characters - Make the main menu ASCII art less intrusive (and easier for screen readers) - Don't invalidate the score file due to game minor (only) version bump ## [v0.9.4.0](https://github.com/LambdaHack/LambdaHack/compare/v0.9.3.0...v0.9.4.0) - In vty frontend highlight actors more - Clean up actor highlighting - Add yell/yawn to minimal command set, remove swerving the aiming line - Invoke yell/yawn exclusively with '%', due tor Windows and terminal woes - Move C-c command to C, not to mask C-c on console frontends - Tweak and fix vty console frontends, for screen-readers - React specially at gameover under certain special circumstances - Simpliy assignSlot now that slots are auto-sorted - Get rid of explicit item sorting; let lore and menu slots agree - Make DetectExit non-modal - Mark in a game end confirmation message that more treasure can be found - Add a description to the escape embedded item - Reword gameover text for raid scenario - Be more verbose when confirming escape from the game - Don't claim to summon, when not possible on this level - Fix missing 'no longer poisoned' when applying antidote - Don't ask confirmation for neutral (e.g., not IDed) items - Fix 'you fall down; you stand on a sword' - Prevent selecting regions via mouse down in web frontend - Deselect item if player declines to apply or fling - Hand-hold the player, warning if flung item is beneficial - Hand-hold the player, warning if applied item is harmful - Rewrite the condition in UI applyItem check - Improve the lobable item skill failure message - Let mouse buttons describe tiles, etc. - Unblock S-MouseButton in SDL2 frontend - Always describe things under mouse button - Make the message when hitting dead foe more varied ## [v0.9.3.0, aka 'Velvet smoking jacket'](https://github.com/LambdaHack/LambdaHack/compare/v0.8.3.0...v0.9.3.0) - Introduce message classes with configurable behaviour - Create a new 16x16 font and use it everywhere; tweak smaller fonts - Lock some levels or otherwise make ascending tricky - Add cooldown to most melee weapons, display that in HUD, adjust AI - Add per-scenario and per-outcome end-game messages in content - Add duplicate and reroll item effects in preparation for crafting - Add actor and item analytics as a preparation for XP gain quests - Implement piercing projectiles that may share a tile with a big actor - Increase the spawn speed now that monsters sleep a lot - Introduce actors falling asleep and yelling - Allow any level size and position - Mention places when looking at tiles and add place lore menu - Expand all kinds of content and rebalance - Create and rework all item, cave and plot prose (Dan Keefe @Peritract) - Make explosives in cramped spaces twice weaker - Tweak player fling command - Tweak equipping when equipment overfull - Start cycling stores at equipment since that's the one mentioned in help - Overhaul CI scripts - Restructure and clean up codebase - Extend balance debugging tools, using item and actor analytics, places, etc. - Drop the gameplay option that first death means defeat - Avoid idle-GC between slow keystrokes - Put content data into a compact region to limit GC - Remove the border around web frontend game screen; seems unneeded now - Don't draw aiming line nor path in vty frontend - Highlight xhair by cursor in vty frontend - Highlight player by cursor in vty frontend - Switch the default FPS to 24 for tradition's sake - Highlight current high score - Remove most stopPlayBack, now spurious, because message classes used - Overhaul cabal file: define common options, split into internal libraries - Fix confusion of nub and uniq - Rename short wait to lurk and many lurks to heed - Show a red message when HP or Calm dip too low or when foe appears - Lose Calm and so alert AI even at weakest non-zero HP draining attacks - Enable screenshots while in menus - Rename config options related to fonts - Recolour aiming line not to clash with the red crosshair - Exchange the functions of yellow and red highlight - Tweak all colours, in particular to differentiate blues/cyans - Cap bright colours at 85 CIELAB Lightness at D65 - Normalize dark colours to be between 42 and 57 CIELAB Lightness at D65 - Get rid of colorIsBold option; KISS - Tint white in alternating lines with different hue for long text readability - Don't split lines at articles - Set xhair to currently meleed foe to see his HP - Display speed on HUD; tweak status lines in other ways - Don't show description of leader target in HUD; TMI - Help AI flee in a consistent direction over many turns - Expose the save backup command, for browser games - Don't display target info when item selected - Let AI actors spawn even quite far from the player - Auto-select all new team members, to help new players - Replace O by zero on the map display; make zero distinct from O in all fonts - Flesh out the initial ? prompt - Add 'I' alias for pack-related commands, unless laptop key-scheme used - Turn off movementLaptopKeys by default not to confuse new players - Make sure AI attacks bosses even if distant and fleeing or non-moving - Lower bonus HP at extreme difficulty - Add a separate frame for each projectiles start - Don't go modal at the frequent and weak hidden tile detection effect - Make AI pick closest stairs more often - Let apply-unskilled actors activate embedded items - Don't boost damage by speed unless actor is projectile - If everything else fails, let AI flee by opening doors - Help AI actor prevent being dominated - Make computing gameplay benefit to items more accurate - Rename, clone and fine-tune effect Temporary - Simplify code and content by getting rid of Recharging effect - Let applying periodic items only produce the first effect - Tweak item detection to help in skipping boring level portions and in stealth - Invoke and display embedded items in the order specified in tile definitions - Let lit trails illuminate colonnades - Prevent an exploit for avoiding self-invoked firecrackers - Don't let AI attempt summoning if not enough Calm - Improve item label bracket codes in menus - Pick randomly destination stairs if teleporting level - Display the number of items in store - Summarize value of player loot in shared stash menu's header - Start history menu at the close-up of the last message - Make fast-dying insects aggressive - Overhaul game score DSL and particular scoring definitions in content - Add and extend messages, e.g., tell if victim blocks and with what armor - Extend and rework menu manipulation keys - Remove specialized quaff, read and throw commands; KISS - Split walls of text into more paragraphs and/or make them narrower - Extend and update help and manual - Don't let AI waste time looting distant lone projectiles - Make Enum instances of Point and Vector contiguous, hackily - Make dominated actor drop all his items, for ID and in case he defects ASAP - Try to find a non-waiting action, if better AI leader can't be found - Prevent summoning OoD actors - Let animals eat food and add several foods - Make Domination effect harder to activate - Let only actors and items with SkOdor property leave smell and add perfumes - Let spawning rate level out after a few dozen spawns - Describe smell, if present in an inspected tile - Let pushed actor fly after crashing a door open - Show passing time and heard events even if no actors in the UI faction - When movement impossible, describe the tile with SHIFT-direction - Catch and steal projectiles when braced instead of when weaponless - Let actors that are pushed perform any action in addition to movement - Improve deduplication of messages - When describing actor on map, tell if it has loot - Represent being braced as having an organ; also add other pseudo-organs - Overhaul hearing to facilitate triangulation based on sound cues - Prefer to spawn aquatic actors on aquatic tiles - Add swimming and flying skills and shallow water tile features - Boost/drain skills via many new items - Rework and extend skills and their effects as a preparation for XP rewards - Enable specifying each side of outer cave fence separately - Make definition of caves of a scenario more precise - Specify more properties of levels in content - Extend content validation - Improve placement and fitting stairs and rooms on levels - Don't hardwire level size - Simplify game rules content - Change the format of game client content - Fix an arbitrary delay in killing dying actors - Fix arbitrary branch of a corridor chosen when running - Fix bush patches blocking off a level's corner - Fix config file ignored at game reinit - Fix running disturbed by flavours of walls - Fix splitting lines one character too early - Fix Calm drain from nearby foes occurring only every other turn - Fix some AI looping movement, in particular when fleeing - Fix running into own periodic explosions, e.g., from necklaces - Fix 'she painfullies collide' - Fix AI with vector targets unwilling to change them - Fix crash when attempting to fling at a target on remote level - Fix wrong timestamps in history - Fix, again, various kinds of frames intruding between fadeout and fadein - Fix wrong pluralization of some item names, compound and exceptions - Fix disabled items benefit recalculation after item kind learned - Fix in many ways too close initial faction and item positions - Fix performance in many ways and places, particularly for JS translation - Fix missing perception updates, causing missed AI actions concerning us - Fix uninitialized sarenas, which was probably causing resume to change state - Fix weak AI actors fleeing even if enemy can't melee - Fix and optimize sifting free tiles for spawn/summon location - Fix various cases of excessive summoning - Fix recording of item first seen level - Fix many problems with item descriptions and other messages - Fix reporting of reduction and elimination of actor conditions - Fix reading and interpreting old format config files - Fix synced initial item timeouts and actor times, leading to artificial feel - Fix actors erratically following their leader - Fix lifts continuing as stars and the other way around - Fix various 32bit overflows - Fix other errors, probably not present or not visible in previous version ## [v0.8.3.0](https://github.com/LambdaHack/LambdaHack/compare/v0.8.1.2...v0.8.3.0) - Add a hack to run SDL2 on the main thread, fixing the OS X crash - Warn visually when impressed and Calm running low, risking domination - Display actor as red when low Calm and impressed or when low HP - Fix, complete and fine tune UI, AI and server skill and weapon checks - Fix a bug where item aspects look different to clients than to the server - Change the requirements for the main menu ASCII art ## [v0.8.1.2](https://github.com/LambdaHack/LambdaHack/compare/v0.8.1.1...v0.8.1.2) - Fix typos detected by lintian - Fix the code that runs in case of old async (bug introduced in v0.8.1.1) ## [v0.8.1.1](https://github.com/LambdaHack/LambdaHack/compare/v0.8.1.0...v0.8.1.1) - no player-visible changes - make it possible to compile with old async package - rewrite copyright information according to Debian format - make github display the correct main license ## [v0.8.1.0](https://github.com/LambdaHack/LambdaHack/compare/v0.8.0.0...v0.8.1.0) - no player-visible changes - significantly reduce RAM usage when compiling library - update and extend CI ## [v0.8.0.0, aka 'Explosive dashboard'](https://github.com/LambdaHack/LambdaHack/compare/v0.7.1.0...v0.8.0.0) - rework greying out menu items and permitting item application and projection - rework history collection; merge message repetitions more aggressively - display HP in red when below (configurable) warning threshold - tweak AI: actors remember they are fleeing; better leader choice, etc. - add to content specialized explosive projectiles; tune the effects - calculate loot score component based on fraction of dungeon loot collected - don't hardwire item price, but let it be specified in content - let all valuables glitter in the dark to avoid complete level exploration - teach AI to cure ailments and shake off impressions - rework detection effects; add detection of items embedded in tiles - automatically identify stolen items that only have minor effects - let projectiles hit each other if fragile and substantial enough - rework item kind identification code; change the way it's defined in content - make more item kinds (including some traps) secret - protect paralyzed actors with a stasis condition to avoid infinite paralysis - implement dumping screenshots in SDL2 and create animated GIFs in Makefile - generate most common consumables less often, but in depth-scaled bunches - make pushed actors alter tiles and trigger effects of embedded items - validate and cross-validate more content; reduce content creation boilerplate - make summoning more varied and prevent chain-summoning - add many ways to conditionally sequence effects - create large, merged rooms more often - generalize the terrain altering player command (C-c, mouse) - let RET, SPACE and ESC clear pending messages, if any - add dashboard with links to all menus and info screens - scale some organ and trap power with level depth - simplify level-scaled dice roll semantics - change scaled dice notation 'dl' to 'dL' for readability in-game - rebalance items and decrease dice variety to unclutter backpack - colour-code beneficial and harmful conditions in menu and in HUD - display item lore (also for organs, embedded items, explosions, etc.) - display embedded item descriptions as if they were tile descriptions - tweak blast visuals, lower particle counts, beautify their spread - tweak projectile visuals, e.g., display an extra frame when projectile dies - add intro screen and work on other ways to convey story - simplify a lot of code, including a bit of game rules - fix some bugs, tweak content, speed up some AI bottlenecks ## [v0.7.1.0, aka 'Ancient troubles'](https://github.com/LambdaHack/LambdaHack/compare/v0.7.0.0...v0.7.1.0) - add amazing cave and item (actor, blast, organ) descriptions - package for Windows as an installer and also as zip archives - fix a crash from SDL frontend under some OpenGL drivers (no thread-safety) - add WWW address to the Main Menu, for other sites that may run our JS blob ## [v0.7.0.0, aka 'The dice are cast'](https://github.com/LambdaHack/LambdaHack/compare/v0.6.2.0...v0.7.0.0) - decouple tile searching from tile alteration - refrain from identifying items that are not randomized - switch away from incapacitated leader to let others revive him - make rescue easier by not going into negative HP the first time - fix crowd of friends on another level slowing even actors that melee - fix missing report about items underneath an actor when changing levels - API breakage: change the syntax of dice in content - API addition: introduce cave descriptions - keep all client states in the server and optimize communication with clients - improve item choice for identification and item polymorphing - reset embedded items when altering tile - replace atomic command filtering with exception catching - reimplement dice as symbolic expressions inducing multiple RNG calls - switch to optparse-applicative and rewrite cli handling - add stack and cabal new-build project files - improve haddocks across the codebase ## [v0.6.2.0, aka 'Zoom out'](https://github.com/LambdaHack/LambdaHack/compare/v0.6.1.0...v0.6.2.0) - make fireworks slower and so easier to spot - make rattlesnake deeper but more common - announce no effect of activation - describe original and current faction of an actor - highlight dominated actors - mark organs with comma instead of percent and gems with dollar - make the healing cave dangerous to prevent camping - slightly balance various content - by default move item the same as last time - often spawn between heroes and stairs going deeper - fix totalUsefulness computation for negative effects - fix abandoning distant enemy target despite no alternatives - fix slow pushing of actors - fix a crash when many actors run towards stairs - hotfix: Pass zoom keys through to the browser - help players find the info about changing the font size - depend on GHC >= 8.0 and new vector - specialize client code already in SampleMonadClient.hs - enable StrictData in all modules - replace 'failure' with 'error' that now shows call stack ## [v0.6.1.0, aka 'Breaking one rule at a time'](https://github.com/LambdaHack/LambdaHack/compare/v0.6.0.0...v0.6.1.0) - fix redrawing after window minimized and restored - hack around vanishing texture on Windows - hack around SDL backends not thread-safe on Windows - the only breaking API change: specify font directory in game rules content - let the game use its own fonts, not fonts from the sample game in library - tweak some item creation to occur in character's pack, not on the ground - slightly balance various content - make sure the 'resolution' effect is not a drawback - make artifact weapon rarities more regular - avoid creating lit, open dungeon at the bottom, where foes have ranged weapons - number scenarios in user descriptions - correct, add and modify some in-game messages - let player hear unseen summonings performed by other actors - don't let actors hear blasts hitting walls, as opposed to hitting actors - when moving item out of shared stash, reset its timeouts - when ascending, shift timeouts of inventory as well - when creating item not on the ground, discover it - when dominating, auto-discover only if the item can't be discovered by use - let henchmen take into account their targets, as described in PLAYING.md - let only walkable tiles be explorable, for clear walls inside solid blocks - move to API 2.0.0 of sdl2-ttf and depend on corrected sdl2 (builds on Windows) - simplify code thanks to the new sdl2-ttf API - tweak travis scripts and building docs in README ## [v0.6.0.0, aka 'Too much to tell'](https://github.com/LambdaHack/LambdaHack/compare/v0.5.0.0...v0.6.0.0) - add and modify a lot of content: items, tiles, embedded items, scenarios - improve AI: targeting, stealth, moving in groups, item use, fleeing, etc. - make monsters more aggressive than animals - tie scenarios into a loose, optional storyline - add more level generators and more variety to room placement - make stairs not walkable and use them by bumping - align stair position on the levels they pass through - introduce noctovision - increase human vision to 12 so that normal speed missiles can be sidestepped - tweak and document weapon damage calculation - derive projectile damage mostly from their speed - make heavy projectiles better vs armor but easier to sidestep - improve hearing of unseen actions, actors and missiles impacts - let some missiles lit up on impact - make torches reusable flares and add blankets for dousing dynamic light - add detection effects and use them in items and tiles - make it possible to catch missiles, if not using weapons - make it possible to wait 0.1 of a turn, at the cost of no bracing - improve pathfinding, prefer less unknown, alterable and dark tiles on paths - slow down actors when acting at the same time, for speed with large factions - don't halve Calm at serious damage any more - eliminate alternative FOV modes, for speed - stop actors blocking FOV, for speed - let actor move diagonally to and from doors, for speed - improve blast (explosion) shapes visually and gameplay-wise - add SDL2 frontend and deprecate GTK frontend - add specialized square bitmap fonts and hack a scalable font - use middle dot instead of period on the map (except in teletype frontend) - add a browser frontend based on DOM, using ghcjs - improve targeting UI, e.g., cycle among items on the map - show an animation when actor teleports - add character stats menu and stat description texts - add item lore and organ lore menus - add a command to sort item slots and perform the sort at startup - add a single item manipulation menu and let it mark an item for later - make history display a menu and improve display of individual messages - display highscore dates according to the local timezone - make the help screen a menu, execute actions directly from it - rework the Main Menu - rework special positions highlight in all frontends - mark leader's target on the map (grey highlight) - visually mark currently chosen menu item and grey out impossible items - define mouse commands based on UI mode and screen area - let the game be fully playable only with mouse, use mouse wheel - pick menu items with mouse and with arrow keys - add more sanity checks for content - reorganize content in files to make rebasing on changed content easier - rework keybinding definition machinery - let clients, not the server, start frontends - version savefiles and move them aside if versions don't match - lots of bug fixes internal improvements and minor visual and text tweaks ## [v0.5.0.0, aka 'Halfway through space'](https://github.com/LambdaHack/LambdaHack/compare/v0.4.101.0...v0.5.0.0) - let AI put excess items in shared stash and use them out of shared stash - let UI multiple items pickup routine put items that don't fit into equipment into shared stash, if possible, not into inventory pack - re-enable the ability to hear close, invisible foes - add a few more AI and autonomous henchmen tactics (CTRL-T) - keep difficulty setting over session restart - change some game start keybindings - replace the Duel game mode with the Raid game mode - various bugfixes, minor improvements and balancing ## [v0.4.101.0, aka 'Officially fun'](https://github.com/LambdaHack/LambdaHack/compare/v0.4.100.0...v0.4.101.0) - the game is now officially fun to play - introduce unique boss monsters and unique artifact items - add animals that heal the player - let AI gang up, attempt stealth and react to player aggressiveness - spawn actors fast and close to the enemy - spawn actors less and less often on a given level, but with growing depth - prefer weapons with effects, if recharged - make the bracing melee bonus additive, not multiplicative - let explosions buffet actors around - make braced actors immune to translocation effects - use mouse for movement, actor selection, aiming - don't run straight with selected actors, but go-to cross-hair with them - speed up default frame rate, slow down projectiles visually - rework item manipulation UI - you can pick up many items at once and it costs only one turn - allow actors to apply and project from the shared stash - reverse messages shown in player diary - display actor organs and stats - split highscore tables wrt game modes - move score calculation formula to content - don't keep the default/example config file commented out; was misleading - I was naughty again and changed v0.5.0.0 of LambdaHack content API slightly one last time ## [v0.4.100.0, aka 'The last thaw'](https://github.com/LambdaHack/LambdaHack/compare/v0.4.99.0...v0.4.100.0) - unexpectedly thaw and freeze again v0.5.0.0 of LambdaHack content API - unexpectedly implement timeouts and temporary effects easily without FRP - make a couple of skill levels meaningful and tweak skills of some actors - make AI prefer exploration of easier levels - permit overfull HP and Calm - let non-projectile actors block view - make colorful characters bold (if it resizes your fonts, turn off via colorIsBold = False in config file or --noColorIsBold on commandline) - start the game with a screensaver safari mode - add i386 Linux and Windows compilation targets to Makefile ## [v0.4.99.0, aka 'Player escapes'](https://github.com/LambdaHack/LambdaHack/compare/v0.2.14...v0.4.99.0) - balance the example game content a bit (campaign still unbalanced) - various code and documentation tweaks and fixes - add cabal flag expose_internal that reveals internal library operations - merge FactionKind into ModeKind and rework completely the semantics - compatibility tweaks for Nixpkgs - define AI tactics, expose them to UI and add one more: follow-the-leader - share leader target between the UI and AI client of each faction - specify monster spawn rate per-cave - extend content validation and make it more user friendly - freeze v0.5.0.0 of LambdaHack content API ## [v0.2.14, aka 'Out of balance'](https://github.com/LambdaHack/LambdaHack/compare/v0.2.12...v0.2.14) - tons of new (unbalanced) content, content fields, effects and descriptions - add a simple cabal test in addition to make-test and travis-test - generate items and actors according to their rarities at various depths - redo weapon choice, combat bonuses and introduce armor - introduce skill levels for abilities (boolean for now, WIP) - remove regeneration, re-add through periodically activating items - ensure passable areas of randomly filled caves are well connected - make secondary factions leaderless - auto-tweak digital line epsilon to let projectiles evade obstacles - add shrapnel (explosions) and organs (body parts) - express actor kinds as item kinds (their trunk) - add dynamic lights through items, actors, projectiles - fix and improve item kind and item stats identification - make aspects additive from all equipment and organ items - split item effects into aspects, effects and item features - rework AI and structure it according to the Ability type - define Num instance for Dice to make writing it in content easier - remove the shared screen multiplayer mode and all support code, for now - rename all modules and nearly all other code entities - check and consume HP when calling friends and Calm when summoning - determine sight radius from items and cap it at current Calm/5 - introduce Calm; use to hear nearby enemies and limit item abuse before death - let AI actors manage items and share them with party members - completely revamp item manipulation UI - add a command to cede control to AI - separate actor inventory, 10-item actor equipment and shared party stash - vi movement keys (hjklyubn) are now disabled by default - new movement keyset: laptop movement keys (uk8o79jl) ## [v0.2.12](https://github.com/LambdaHack/LambdaHack/compare/v0.2.10...v0.2.12) - improve and simplify dungeon generation - simplify running and permit multi-actor runs - let items explode and generate shrapnel projectiles - add game difficulty setting (initial HP scaling right now) - allow recording, playing back and looping commands - implement pathfinding via per-actor BFS over the whole level - extend setting targets for actors in UI tremendously - implement autoexplore, go-to-target, etc., as macros - let AI use pathfinding, switch leaders, pick levels to swarm to - force level/leader changes on spawners (even when played by humans) - extend and redesign UI bottom status lines - get rid of CPS style monads, aborts and WriterT - benchmark and optimize the code, in particular using Data.Vector - split off and use the external library assert-failure - simplify config files and limit the number of external dependencies ## [v0.2.10](https://github.com/LambdaHack/LambdaHack/compare/v0.2.8...v0.2.10) - screensaver game modes (AI vs AI) - improved AI (can now climbs stairs, etc.) - multiple, multi-floor staircases - multiple savefiles - configurable framerate and combat animations ## [v0.2.8](https://github.com/LambdaHack/LambdaHack/compare/v0.2.6.5...v0.2.8) - cooperative and competitive multiplayer (shared-screen only in this version) - overhauled searching - rewritten engine code to have a single server that sends restricted game state updates to many fat clients, while a thin frontend layer multiplexes visuals from a subset of the clients ## [v0.2.6.5](https://github.com/LambdaHack/LambdaHack/compare/v0.2.6...v0.2.6.5) - this is a minor release, primarily intended to fix the broken haddock documentation on Hackage - changes since 0.2.6 are mostly unrelated to gameplay: - strictly typed config files split into UI and rules - a switch from Text to String throughout the codebase - use of the external library miniutter for English sentence generation ## [v0.2.6](https://github.com/LambdaHack/LambdaHack/compare/v0.2.1...v0.2.6) - the Main Menu - improved and configurable mode of squad combat ## [v0.2.1](https://github.com/LambdaHack/LambdaHack/compare/v0.2.0...v0.2.1) - missiles flying for three turns (by an old kosmikus' idea) - visual feedback for targeting - animations of combat and individual monster moves ## [v0.2.0](https://github.com/LambdaHack/LambdaHack/compare/release-0.1.20110918...v0.2.6) - the LambdaHack engine becomes a Haskell library - the LambdaHack game depends on the engine library LambdaHack-0.9.5.0/COPYLEFT0000644000000000000000000001621307346545000013176 0ustar0000000000000000Format: https://www.debian.org/doc/packaging-manuals/copyright-format/1.0/ Upstream-Name: LambdaHack Upstream-Contact: Mikolaj Konarski Source: https://hackage.haskell.org/package/LambdaHack Files: * Copyright: 2008-2011 Andres Loeh 2010-2019 Mikolaj Konarski and others (see git history) License: BSD-3-Clause Files: GameDefinition/fonts/{*.fnt,*.bdf,16x16xw.woff} Copyright: 1997-2016 Leon Marrick 1997-2016 Sheldon Simms III 1997-2016 Nick McConnell 2016-2019 Mikolaj Konarski License: GPL-2.0-or-later Files: GameDefinition/fonts/Fix15Mono-Bold.woff Copyright: 2012-2015 The Mozilla Foundation and Telefonica S.A 2016-2019 Mikolaj Konarski License: OFL-1.1 Files: debian/* Copyright: held by the contributors mentioned in debian/changelog License: BSD-3-Clause License: BSD-3-Clause Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. 3. Neither the name of the copyright holder nor the names of its contributors may be used to endorse or promote products derived from this software without specific prior written permission. . THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. License: GPL-2.0-or-later This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License, version 2, as published by the Free Software Foundation . This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. . You should have received a copy of the GNU General Public License along with this package; if not, write to the Free Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA . On Debian systems, the full text of the GNU General Public License version 2 can be found in the file `/usr/share/common-licenses/GPL-2'. License: OFL-1.1 SIL OPEN FONT LICENSE Version 1.1 - 26 February 2007 . PREAMBLE The goals of the Open Font License (OFL) are to stimulate worldwide development of collaborative font projects, to support the font creation efforts of academic and linguistic communities, and to provide a free and open framework in which fonts may be shared and improved in partnership with others. . The OFL allows the licensed fonts to be used, studied, modified and redistributed freely as long as they are not sold by themselves. The fonts, including any derivative works, can be bundled, embedded, redistributed and/or sold with any software provided that any reserved names are not used by derivative works. The fonts and derivatives, however, cannot be released under any other type of license. The requirement for fonts to remain under this license does not apply to any document created using the fonts or their derivatives. . DEFINITIONS Font Software refers to the set of files released by the Copyright Holder(s) under this license and clearly marked as such. This may include source files, build scripts and documentation. . Reserved Font Name refers to any names specified as such after the copyright statement(s). . Original Version refers to the collection of Font Software components as distributed by the Copyright Holder(s). . Modified Version refers to any derivative made by adding to, deleting, or substituting in part or in whole any of the components of the Original Version, by changing formats or by porting the Font Software to a new environment. . Author refers to any designer, engineer, programmer, technical writer or other person who contributed to the Font Software. . PERMISSION & CONDITIONS Permission is hereby granted, free of charge, to any person obtaining a copy of the Font Software, to use, study, copy, merge, embed, modify, redistribute, and sell modified and unmodified copies of the Font Software, subject to the following conditions: . 1) Neither the Font Software nor any of its individual components, in Original or Modified Versions, may be sold by itself. . 2) Original or Modified Versions of the Font Software may be bundled, redistributed and/or sold with any software, provided that each copy contains the above copyright notice and this license. These can be included either as stand-alone text files, human-readable headers or in the appropriate machine-readable metadata fields within text or binary files as long as those fields can be easily viewed by the user. . 3) No Modified Version of the Font Software may use the Reserved Font Name(s) unless explicit written permission is granted by the corresponding Copyright Holder. This restriction only applies to the primary font name as presented to the users. . 4) The name(s) of the Copyright Holder(s) or the Author(s) of the Font Software shall not be used to promote, endorse or advertise any Modified Version, except to acknowledge the contribution(s) of the Copyright Holder(s) and the Author(s) or with their explicit written permission. . 5) The Font Software, modified or unmodified, in part or in whole, must be distributed entirely under this license, and must not be distributed under any other license. The requirement for fonts to remain under this license does not apply to any document created using the Font Software. . TERMINATION This license becomes null and void if any of the above conditions are not met. . DISCLAIMER THE FONT SOFTWARE IS PROVIDED AS IS, WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO ANY WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT OF COPYRIGHT, PATENT, TRADEMARK, OR OTHER RIGHT. IN NO EVENT SHALL THE COPYRIGHT HOLDER BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, INCLUDING ANY GENERAL, SPECIAL, INDIRECT, INCIDENTAL, OR CONSEQUENTIAL DAMAGES, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF THE USE OR INABILITY TO USE THE FONT SOFTWARE OR FROM OTHER DEALINGS IN THE FONT SOFTWARE. LambdaHack-0.9.5.0/CREDITS0000644000000000000000000000466507346545000013056 0ustar0000000000000000All kinds of contributions to the LambdaHack engine are gratefully welcome! Some of the contributors are listed below, in chronological order. Andres Loeh Mikolaj Konarski Tuukka Turto Veronika Romashkina Daniel Keefe Pablo Reszczynski Fonts 16x16xw.woff, 16x16xw.bdf, 16x16x.fnt, 8x8x.fnt and 8x8xb.fnt are are derived from fonts taken from https://github.com/angband/angband, copyrighted by Leon Marrick, Sheldon Simms III and Nick McConnell and released by them under GNU GPL, version 2 or any later version (confirmed at http://www.thangorodrim.net/development/opensource.html). Any further modifications by authors of LambdaHack are also released under GNU GPL version 2. The licence file is at GameDefinition/fonts/LICENSE.16x16x in the source code tree. Font 16x16xw.bdf is derived from 16x16x.fon by changing all but a few glyphs, converting to BDF format, extending character set and hacking the font file with bdftopcf and pcf2bdf to include full bitmaps, not only non-zero portions, for otherwise SDL2-ttf was not able to display the glyphs. Font 16x16xw.woff was derived from 16x16xw.bdf by changing format to TTF with bitsnpicas, faking descendent offsets to be 1 point lower to prevent freetype from adding an extra pixel to the descendent, tweaking with fontforge glyps 3 5 6 8 A a S s b d h to prevent antialiasing of their vital parts when zoomed out, auto-hinting, manually simplifying hints in some glyphs and converting to WOFF format. Font Fix15Mono-Bold.woff is a modified version of https://github.com/mozilla/Fira/blob/master/ttf/FiraMono-Bold.ttf that is copyright 2012-2015, The Mozilla Foundation and Telefonica S.A. The modified font is released under the SIL Open Font License, as seen in GameDefinition/fonts/LICENSE.Fix15Mono-Bold in the source code tree. Modifications were performed with font editor FontForge and are as follows: * straighten and enlarge #, enlarge %, &, ', +, \,, -, :, ;, O, _, ` * centre a few other glyphs * create a small 0x22c5 * shrink 0xb7 a bit * extend all fonts by 150% and 150% (the extension resulted in an artifact in letter 'n', which was gleefully kept, and many other artifacts and distortions that should be fixed at some point) * set width of space, nbsp and # glyphs to 1170 (this is a hack to make DOM create square table cells) * copy O to 0 (zero) and add the middle dot from the original zero * randomly fix various errors and simplify with fontforge * auto-generate hints with fontforge LambdaHack-0.9.5.0/GameDefinition/Content/0000755000000000000000000000000007346545000016317 5ustar0000000000000000LambdaHack-0.9.5.0/GameDefinition/Content/CaveKind.hs0000644000000000000000000005142307346545000020344 0ustar0000000000000000-- | Cave properties. module Content.CaveKind ( content ) where import Prelude () import Game.LambdaHack.Core.Prelude import Data.Ratio import Game.LambdaHack.Content.CaveKind import Game.LambdaHack.Core.Dice content :: [CaveKind] content = [rogue, arena, smoking, laboratory, noise, mine, empty, shallowRogue, outermost, raid, brawl, shootout, hunt, escape, zoo, ambush, battle, safari1, safari2, safari3] rogue, arena, smoking, laboratory, noise, mine, empty, shallowRogue, outermost, raid, brawl, shootout, hunt, escape, zoo, ambush, battle, safari1, safari2, safari3 :: CaveKind -- * Underground caves; most of mediocre height and size rogue = CaveKind { csymbol = 'R' , cname = "A maze of twisty passages" , cfreq = [("default random", 100), ("caveRogue", 1)] , cXminSize = 80 , cYminSize = 21 , ccellSize = DiceXY (2 `d` 4 + 10) 6 , cminPlaceSize = DiceXY (2 `d` 2 + 4) 5 , cmaxPlaceSize = DiceXY 16 40 , cdarkOdds = 1 `d` 54 + 1 `dL` 20 -- most rooms lit, to compensate for dark corridors , cnightOdds = 51 -- always night , cauxConnects = 1%2 , cmaxVoid = 1%6 , cminStairDist = 20 , cextraStairs = 1 + 1 `d` 2 , cdoorChance = 3%4 , copenChance = 1%5 , chidden = 7 , cactorCoeff = 65 -- the maze requires time to explore , cactorFreq = [("monster", 60), ("animal", 40)] , citemNum = 6 `d` 5 + 10 - 10 `dL` 1 -- deep down quality over quantity , citemFreq = [("common item", 40), ("treasure", 60)] , cplaceFreq = [("rogue", 1)] , cpassable = False , labyrinth = False , cdefTile = "fillerWall" , cdarkCorTile = "floorCorridorDark" , clitCorTile = "floorCorridorLit" , cwallTile = "fillerWall" , ccornerTile = "fillerWall" , cfenceTileN = "basic outer fence" , cfenceTileE = "basic outer fence" , cfenceTileS = "basic outer fence" , cfenceTileW = "basic outer fence" , cfenceApart = False , clegendDarkTile = "legendDark" , clegendLitTile = "legendLit" , cescapeFreq = [] , cstairFreq = [ ("walled staircase", 50), ("open staircase", 50) , ("tiny staircase", 1) ] , cstairAllowed = [] , cdesc = "Winding tunnels stretch into the dark." } -- no lit corridors cave alternative, since both lit # and . look bad here arena = rogue { csymbol = 'A' , cname = "Dusty underground library" , cfreq = [("default random", 60), ("caveArena", 1)] , cXminSize = 50 , cYminSize = 21 , ccellSize = DiceXY (3 `d` 3 + 17) (1 `d` 3 + 4) , cminPlaceSize = DiceXY (2 `d` 2 + 4) 6 , cmaxPlaceSize = DiceXY 16 12 , cdarkOdds = 49 + 1 `d` 10 -- almost all rooms dark (1 in 10 lit) -- Light is not too deadly, because not many obstructions and so -- foes visible from far away and few foes have ranged combat -- at shallow depth. , cnightOdds = 0 -- always day , cauxConnects = 1 , cmaxVoid = 1%8 , cminStairDist = 15 , cextraStairs = 1 `d` 2 , chidden = 0 , cactorCoeff = 75 -- small open level, don't rush the player , cactorFreq = [("monster", 30), ("animal", 70)] , citemNum = 4 `d` 5 -- few rooms , citemFreq = [("common item", 20), ("treasure", 40), ("any scroll", 40)] , cplaceFreq = [("arena", 1)] , cpassable = True , cdefTile = "arenaSetLit" , cdarkCorTile = "trailLit" -- let trails give off light , clitCorTile = "trailLit" -- may be rolled different than the above , cstairFreq = [ ("walled staircase", 20), ("closed staircase", 80) , ("tiny staircase", 1) ] , cdesc = "The shelves groan with dusty books and tattered scrolls." } smoking = arena { cname = "Smoking rooms" , cfreq = [("caveSmoking", 1)] , cdarkOdds = 41 + 1 `d` 10 -- almost all rooms lit (1 in 10 dark) -- Trails provide enough light for fun stealth. , cnightOdds = 51 -- always night , citemNum = 6 `d` 5 -- rare, so make it exciting , citemFreq = [("common item", 20), ("treasure", 40), ("any vial", 40)] , cdefTile = "arenaSetDark" , cdesc = "Velvet couches exude the strong smell of tobacco." } laboratory = rogue { csymbol = 'L' , cname = "Burnt laboratory" , cfreq = [("caveLaboratory", 1)] , cXminSize = 60 , cYminSize = 21 , ccellSize = DiceXY (1 `d` 2 + 5) 6 , cminPlaceSize = DiceXY 7 5 , cmaxPlaceSize = DiceXY 10 40 , cnightOdds = 0 -- always day so that the corridor smoke is lit , cauxConnects = 1%5 , cmaxVoid = 1%10 , cextraStairs = 2 , cdoorChance = 1 , copenChance = 1%2 , cactorFreq = [("monster", 30), ("animal", 70)] , citemNum = 6 `d` 5 -- reward difficulty , citemFreq = [("common item", 20), ("treasure", 40), ("explosive", 40)] , cplaceFreq = [("laboratory", 1)] , cdarkCorTile = "labTrailLit" -- let lab smoke give off light always , clitCorTile = "labTrailLit" , cstairFreq = [ ("walled staircase", 50), ("open staircase", 50) , ("tiny staircase", 1) ] , cdesc = "Shattered glassware and the sharp scent of spilt chemicals show that something terrible happened here." } noise = rogue { csymbol = 'N' , cname = "Leaky burrowed sediment" , cfreq = [("default random", 30), ("caveNoise", 1)] , cXminSize = 50 , cYminSize = 21 , ccellSize = DiceXY (3 `d` 5 + 12) 6 , cminPlaceSize = DiceXY 8 5 , cmaxPlaceSize = DiceXY 20 20 , cdarkOdds = 51 -- Light is deadly, because nowhere to hide and pillars enable spawning -- very close to heroes. , cnightOdds = 0 -- harder variant, but looks cheerful , cauxConnects = 1%10 , cmaxVoid = 1%100 , cminStairDist = 15 , cdoorChance = 1 -- to avoid lit quasi-door tiles , chidden = 0 , cactorCoeff = 80 -- the maze requires time to explore; also, small , cactorFreq = [("monster", 80), ("animal", 20)] , citemNum = 6 `d` 5 -- an incentive to explore the labyrinth , cpassable = True , labyrinth = True , cplaceFreq = [("noise", 1)] , cdefTile = "noiseSetLit" , cfenceApart = True -- ensures no cut-off parts from collapsed , cdarkCorTile = "damp floor Dark" , clitCorTile = "damp floor Lit" , cstairFreq = [ ("closed staircase", 50), ("open staircase", 50) , ("tiny staircase", 1) ] , cdesc = "Soon, these passages will be swallowed up by the mud." } mine = noise { cname = "Frozen derelict mine" , cfreq = [("caveMine", 1)] , cnightOdds = 51 -- easier variant, but looks sinister , citemNum = 10 `d` 4 -- an incentive to explore the final labyrinth , citemFreq = [("common item", 20), ("gem", 20)] -- can't be "valuable" or template items generated , cplaceFreq = [("noise", 1), ("mine", 99)] , cdefTile = "powerSetDark" , cstairFreq = [ ("gated closed staircase", 50) , ("gated open staircase", 50) , ("gated tiny staircase", 1) ] , cdesc = "Pillars of shining ice create a frozen labyrinth." } empty = rogue { csymbol = 'E' , cname = "Tall cavern" , cfreq = [("caveEmpty", 1)] , ccellSize = DiceXY (2 `d` 2 + 11) (1 `d` 2 + 8) , cminPlaceSize = DiceXY 13 11 , cmaxPlaceSize = DiceXY 37 31 -- favour large rooms , cdarkOdds = 1 `d` 100 + 1 `dL` 100 , cnightOdds = 0 -- always day , cauxConnects = 3%2 , cmaxVoid = 0 -- too few rooms to have void and fog common anyway , cminStairDist = 30 , cextraStairs = 1 , cdoorChance = 0 , copenChance = 0 , chidden = 0 , cactorCoeff = 7 , cactorFreq = [("animal", 10), ("immobile animal", 90)] -- The healing geysers on lvl 3 act like HP resets. Needed to avoid -- cascading failure, if the particular starting conditions were -- very hard. Items are not reset, even if they are bad, which provides -- enough of a continuity. Gyesers on lvl 3 are not OP and can't be -- abused, because they spawn less and less often and also HP doesn't -- effectively accumulate over max. , citemNum = 4 `d` 5 -- few rooms and geysers are the boon , cplaceFreq = [("empty", 1)] , cpassable = True , cdefTile = "emptySetLit" , cdarkCorTile = "floorArenaDark" , clitCorTile = "floorArenaLit" , cstairFreq = [ ("walled staircase", 20), ("closed staircase", 80) , ("tiny staircase", 1) ] , cdesc = "Swirls of warm fog fill the air, the hiss of geysers sounding all around." } shallowRogue = rogue { cfreq = [("caveShallowRogue", 100)] , cXminSize = 60 , cYminSize = 21 , cextraStairs = 1 -- ensure heroes meet initial monsters and their loot , cdesc = "The snorts and grunts of savage beasts can be clearly heard." } outermost = shallowRogue { csymbol = 'B' , cname = "Cave entrance" , cfreq = [("caveOutermost", 100)] , cXminSize = 40 , cYminSize = 21 , cdarkOdds = 0 -- all rooms lit, for a gentle start , cminStairDist = 10 , cextraStairs = 1 , cactorCoeff = 80 -- already animals start there; also, pity on the noob , cactorFreq = filter ((/= "monster") . fst) $ cactorFreq rogue , citemNum = 6 `d` 5 -- lure them in with loot , citemFreq = filter ((/= "treasure") . fst) $ citemFreq rogue , cescapeFreq = [("escape up", 1)] , cdesc = "This close to the surface, the sunlight still illuminates the dungeon." } -- * Overground "caves"; no story-wise limits wrt height and size raid = rogue { csymbol = 'T' , cname = "Typing den" , cfreq = [("caveRaid", 1)] , cXminSize = 50 , cYminSize = 21 , ccellSize = DiceXY (2 `d` 4 + 6) 6 , cminPlaceSize = DiceXY (2 `d` 2 + 4) 5 , cmaxPlaceSize = DiceXY 16 20 , cdarkOdds = 0 -- all rooms lit, for a gentle start , cmaxVoid = 1%10 , cextraStairs = 0 , cactorCoeff = 250 -- deep level with no kit, so slow spawning , cactorFreq = [("animal", 100)] , citemNum = 6 `d` 6 -- just one level, hard enemies, treasure , citemFreq = [("common item", 100), ("currency", 500)] , cescapeFreq = [("escape up", 1)] , cstairFreq = [] , cdesc = "" } brawl = rogue -- many random solid tiles, to break LOS, since it's a day -- and this scenario is not focused on ranged combat; -- also, sanctuaries against missiles in shadow under trees { csymbol = 'b' , cname = "Sunny woodland" , cfreq = [("caveBrawl", 1)] , cXminSize = 60 , cYminSize = 21 , ccellSize = DiceXY (2 `d` 5 + 5) 6 , cminPlaceSize = DiceXY 3 3 , cmaxPlaceSize = DiceXY 7 5 , cdarkOdds = 51 , cnightOdds = 0 , cdoorChance = 1 , copenChance = 0 , cextraStairs = 0 , chidden = 0 , cactorFreq = [] , citemNum = 5 `d` 6 , citemFreq = [("common item", 100)] , cplaceFreq = [("brawl", 1)] , cpassable = True , cdefTile = "brawlSetLit" , cdarkCorTile = "dirt Lit" , clitCorTile = "dirt Lit" , cstairFreq = [] , cfenceTileN = "outdoor outer fence" , cfenceTileE = "outdoor outer fence" , cfenceTileS = "outdoor outer fence" , cfenceTileW = "outdoor outer fence" , cdesc = "Sunlight falls through the trees and dapples on the ground." } shootout = rogue -- a scenario with strong missiles; -- few solid tiles, but only translucent tiles or walkable -- opaque tiles, to make scouting and sniping more interesting -- and to avoid obstructing view too much, since this -- scenario is about ranged combat at long range { csymbol = 'S' , cname = "Misty meadow" , cfreq = [("caveShootout", 1)] , ccellSize = DiceXY (1 `d` 2 + 6) 6 , cminPlaceSize = DiceXY 3 3 , cmaxPlaceSize = DiceXY 4 4 , cdarkOdds = 51 , cnightOdds = 0 , cauxConnects = 1%10 , cdoorChance = 1 , copenChance = 0 , cextraStairs = 0 , chidden = 0 , cactorFreq = [] , citemNum = 5 `d` 16 -- less items in inventory, more to be picked up, -- to reward explorer and aggressor and punish camper , citemFreq = [ ("common item", 30) , ("any arrow", 400), ("harpoon", 300), ("explosive", 50) ] -- Many consumable buffs are needed in symmetric maps -- so that aggressor prepares them in advance and camper -- needs to waste initial turns to buff for the defence. , cplaceFreq = [("shootout", 1)] , cpassable = True , cdefTile = "shootoutSetLit" , cdarkCorTile = "dirt Lit" , clitCorTile = "dirt Lit" , cstairFreq = [] , cfenceTileN = "outdoor outer fence" , cfenceTileE = "outdoor outer fence" , cfenceTileS = "outdoor outer fence" , cfenceTileW = "outdoor outer fence" , cdesc = "" } hunt = rogue -- a scenario with strong missiles for ranged and shade for melee { csymbol = 'H' , cname = "Noon swamp" , cfreq = [("caveHunt", 1)] , ccellSize = DiceXY (1 `d` 2 + 6) 6 , cminPlaceSize = DiceXY 3 3 , cmaxPlaceSize = DiceXY 4 4 , cdarkOdds = 51 , cnightOdds = 0 , cauxConnects = 1%10 , cdoorChance = 1 , copenChance = 0 , cextraStairs = 0 , chidden = 0 , cactorFreq = [] , citemNum = 5 `d` 10 , citemFreq = [ ("common item", 30) , ("any arrow", 400), ("harpoon", 300), ("explosive", 50) ] , cplaceFreq = [("brawl", 50), ("shootout", 100)] , cpassable = True , cdefTile = "shootoutSetLit" , cdarkCorTile = "dirt Lit" , clitCorTile = "dirt Lit" , cstairFreq = [] , cfenceTileN = "outdoor outer fence" , cfenceTileE = "outdoor outer fence" , cfenceTileS = "outdoor outer fence" , cfenceTileW = "outdoor outer fence" , cdesc = "" } escape = rogue -- a scenario with weak missiles, because heroes don't depend -- on them; dark, so solid obstacles are to hide from missiles, -- not view; obstacles are not lit, to frustrate the AI; -- lots of small lights to cross, to have some risks { csymbol = 'E' , cname = "Metropolitan park at dusk" -- "night" didn't fit , cfreq = [("caveEscape", 1)] , ccellSize = DiceXY (1 `d` 3 + 7) 6 , cminPlaceSize = DiceXY 5 3 , cmaxPlaceSize = DiceXY 9 9 -- bias towards larger lamp areas , cdarkOdds = 51 -- rooms always dark so that fence not visible from afar , cnightOdds = 51 -- always night , cauxConnects = 2 -- many lit trails, so easy to aim , cmaxVoid = 1%100 , cextraStairs = 0 , chidden = 0 , cactorFreq = [] , citemNum = 6 `d` 8 , citemFreq = [ ("common item", 30), ("gem", 150) , ("weak arrow", 500), ("harpoon", 400) , ("explosive", 100) ] , cplaceFreq = [("escape", 1)] , cpassable = True , cdefTile = "escapeSetDark" -- unlike in ambush, tiles not burning yet , cdarkCorTile = "safeTrailLit" -- let trails give off light , clitCorTile = "safeTrailLit" , cfenceTileN = "outdoor outer fence" , cfenceTileE = "outdoor outer fence" , cfenceTileS = "outdoor outer fence" , cfenceTileW = "outdoor outer fence" , cescapeFreq = [("escape outdoor down", 1)] , cstairFreq = [] , cdesc = "" } zoo = rogue -- few lights and many solids, to help the less numerous heroes { csymbol = 'Z' , cname = "Menagerie in flames" , cfreq = [("caveZoo", 1)] , ccellSize = DiceXY (1 `d` 3 + 7) 6 , cminPlaceSize = DiceXY 4 4 , cmaxPlaceSize = DiceXY 12 5 , cdarkOdds = 51 -- rooms always dark so that fence not visible from afar , cnightOdds = 51 -- always night , cauxConnects = 1%4 , cmaxVoid = 1%20 , cdoorChance = 7%10 , copenChance = 9%10 , cextraStairs = 0 , chidden = 0 , cactorFreq = [] , citemNum = 7 `d` 8 , citemFreq = [ ("common item", 100), ("light source", 1000) , ("starting weapon", 1000) ] , cplaceFreq = [("zoo", 1)] , cpassable = True , cdefTile = "zooSetDark" , cdarkCorTile = "safeTrailLit" -- let trails give off light , clitCorTile = "safeTrailLit" , cstairFreq = [] , cfenceTileN = "outdoor outer fence" , cfenceTileE = "outdoor outer fence" , cfenceTileS = "outdoor outer fence" , cfenceTileW = "outdoor outer fence" , cdesc = "" } ambush = rogue -- a scenario with strong missiles; -- dark, so solid obstacles are to hide from missiles, -- not view, and they are all lit, because stopped missiles -- are frustrating, while a few LOS-only obstacles are not lit; -- few small lights to cross, giving a chance to snipe; -- crucial difference wrt shootout and hunt is that trajectories -- of missiles are usually not seen, so enemy can't be guessed; -- camping doesn't pay off, because enemies can sneak and only -- active scouting, throwing flares and shooting discovers them { csymbol = 'M' , cname = "Burning metropolitan park" , cfreq = [("caveAmbush", 1)] , ccellSize = DiceXY (1 `d` 4 + 7) 6 , cminPlaceSize = DiceXY 5 3 , cmaxPlaceSize = DiceXY 9 9 -- bias towards larger lamp areas , cdarkOdds = 51 -- rooms always dark so that fence not visible from afar , cnightOdds = 51 -- always night , cauxConnects = 1%10 -- few lit trails, so hard to aim , cextraStairs = 0 , chidden = 0 , cactorFreq = [] , citemNum = 5 `d` 8 , citemFreq = [ ("common item", 30) , ("any arrow", 400), ("harpoon", 300), ("explosive", 50) ] , cplaceFreq = [("ambush", 1)] , cpassable = True , cdefTile = "ambushSetDark" , cdarkCorTile = "trailLit" -- let trails give off light , clitCorTile = "trailLit" , cstairFreq = [] , cfenceTileN = "outdoor outer fence" , cfenceTileE = "outdoor outer fence" , cfenceTileS = "outdoor outer fence" , cfenceTileW = "outdoor outer fence" , cdesc = "" } -- * Other caves; testing, Easter egg, future work battle = rogue -- few lights and many solids, to help the less numerous heroes { csymbol = 'B' , cname = "Old battle ground" , cfreq = [("caveBattle", 1)] , ccellSize = DiceXY (5 `d` 3 + 11) 5 -- cfenceApart results in 2 rows , cminPlaceSize = DiceXY 4 4 , cmaxPlaceSize = DiceXY 9 7 , cdarkOdds = 0 , cnightOdds = 51 -- always night , cauxConnects = 1%4 , cmaxVoid = 1%20 , cdoorChance = 2%10 , copenChance = 9%10 , cextraStairs = 0 , chidden = 0 , cactorFreq = [] , citemNum = 5 `d` 8 , citemFreq = [("common item", 100), ("light source", 200)] , cplaceFreq = [("battle", 50), ("rogue", 50)] , cpassable = True , cdefTile = "battleSetDark" , cdarkCorTile = "safeTrailLit" -- let trails give off light , clitCorTile = "safeTrailLit" , cfenceTileN = "outdoor outer fence" , cfenceTileE = "outdoor outer fence" , cfenceTileS = "outdoor outer fence" , cfenceTileW = "outdoor outer fence" , cfenceApart = True -- ensures no cut-off parts from collapsed , cstairFreq = [] , cdesc = "" } safari1 = brawl { cname = "Hunam habitat" , cfreq = [("caveSafari1", 1)] , cminPlaceSize = DiceXY 5 3 , cextraStairs = 1 , cstairFreq = [ ("outdoor walled staircase", 20) , ("outdoor closed staircase", 80) , ("outdoor tiny staircase", 1) ] , cdesc = "\"Act 1. Hunams scavenge in a forest in their usual disgusting way.\"" } safari2 = escape -- lamps instead of trees, but ok, it's only a simulation { cname = "Deep into the jungle" , cfreq = [("caveSafari2", 1)] , cextraStairs = 1 , cescapeFreq = [] , cstairFreq = [ ("outdoor walled staircase", 20) , ("outdoor closed staircase", 80) , ("outdoor tiny staircase", 1) ] , cdesc = "\"Act 2. In the dark pure heart of the jungle noble animals roam freely.\"" } safari3 = zoo -- glass rooms, but ok, it's only a simulation { cname = "Jungle in flames" , cfreq = [("caveSafari3", 1)] , cminPlaceSize = DiceXY 5 4 , cescapeFreq = [("escape outdoor down", 1)] , cextraStairs = 1 , cstairFreq = [ ("outdoor walled staircase", 20) , ("outdoor closed staircase", 80) , ("outdoor tiny staircase", 1) ] , cdesc = "\"Act 3. Jealous hunams set jungle on fire and flee.\"" } LambdaHack-0.9.5.0/GameDefinition/Content/ItemKind.hs0000644000000000000000000022566107346545000020373 0ustar0000000000000000-- | Item definitions. module Content.ItemKind ( content, items, otherItemContent ) where import Prelude () import Game.LambdaHack.Core.Prelude import Content.ItemKindActor import Content.ItemKindBlast import Content.ItemKindEmbed import Content.ItemKindOrgan import Content.ItemKindTemporary import Content.RuleKind import Game.LambdaHack.Content.ItemKind import Game.LambdaHack.Content.RuleKind import Game.LambdaHack.Core.Dice import Game.LambdaHack.Definition.Ability import Game.LambdaHack.Definition.Color import Game.LambdaHack.Definition.Defs import Game.LambdaHack.Definition.Flavour content :: [ItemKind] content = items ++ otherItemContent otherItemContent :: [ItemKind] otherItemContent = embeds ++ actors ++ organs ++ blasts ++ temporaries items :: [ItemKind] items = [sandstoneRock, dart, spike, spike2, slingStone, slingBullet, paralizingProj, harpoon, harpoon2, net, light1, light2, light3, blanket, flaskTemplate, flask1, flask2, flask3, flask4, flask5, flask6, flask7, flask8, flask9, flask10, flask11, flask12, flask13, flask14, flask15, flask16, flask17, potionTemplate, potion1, potion2, potion3, potion4, potion5, potion6, potion7, potion8, potion9, potion10, potion11, potion12, fragmentationBomb, concussionBomb, flashBomb, firecrackerBomb, ediblePlantTemplate, ediblePlant1, ediblePlant2, ediblePlant3, ediblePlant4, ediblePlant5, ediblePlant6, ediblePlant7, scrollTemplate, scroll1, scroll2, scroll3, scroll4, scroll5, scroll6, scroll7, scroll8, scroll9, scroll10, scroll11, scroll12, scroll13, jumpingPole, sharpeningTool, seeingItem, motionScanner, gorget, necklaceTemplate, necklace1, necklace2, necklace3, necklace4, necklace5, necklace6, necklace7, necklace8, necklace9, necklace10, imageItensifier, sightSharpening, ringTemplate, ring1, ring2, ring3, ring4, ring5, ring6, ring7, ring8, armorLeather, armorMail, gloveFencing, gloveGauntlet, gloveJousting, hatUshanka, capReinforced, helmArmored, buckler, shield, shield2, shield3, dagger, daggerDropBestWeapon, hammerTemplate, hammer1, hammer2, hammer3, hammerParalyze, hammerSpark, sword, swordImpress, swordNullify, halberd, halberd2, halberd3, halberdPushActor, wandTemplate, wand1, gemTemplate, gem1, gem2, gem3, gem4, gem5, currencyTemplate, currency, smokingJacket] sandstoneRock, dart, spike, spike2, slingStone, slingBullet, paralizingProj, harpoon, harpoon2, net, light1, light2, light3, blanket, flaskTemplate, flask1, flask2, flask3, flask4, flask5, flask6, flask7, flask8, flask9, flask10, flask11, flask12, flask13, flask14, flask15, flask16, flask17, potionTemplate, potion1, potion2, potion3, potion4, potion5, potion6, potion7, potion8, potion9, potion10, potion11, potion12, fragmentationBomb, concussionBomb, flashBomb, firecrackerBomb, ediblePlantTemplate, ediblePlant1, ediblePlant2, ediblePlant3, ediblePlant4, ediblePlant5, ediblePlant6, ediblePlant7, scrollTemplate, scroll1, scroll2, scroll3, scroll4, scroll5, scroll6, scroll7, scroll8, scroll9, scroll10, scroll11, scroll12, scroll13, jumpingPole, sharpeningTool, seeingItem, motionScanner, gorget, necklaceTemplate, necklace1, necklace2, necklace3, necklace4, necklace5, necklace6, necklace7, necklace8, necklace9, necklace10, imageItensifier, sightSharpening, ringTemplate, ring1, ring2, ring3, ring4, ring5, ring6, ring7, ring8, armorLeather, armorMail, gloveFencing, gloveGauntlet, gloveJousting, hatUshanka, capReinforced, helmArmored, buckler, shield, shield2, shield3, dagger, daggerDropBestWeapon, hammerTemplate, hammer1, hammer2, hammer3, hammerParalyze, hammerSpark, sword, swordImpress, swordNullify, halberd, halberd2, halberd3, halberdPushActor, wandTemplate, wand1, gemTemplate, gem1, gem2, gem3, gem4, gem5, currencyTemplate, currency, smokingJacket :: ItemKind -- Keep the dice rolls and sides in aspects small so that not too many -- distinct items are generated (for display in item lore and for narrative -- impact ("oh, I found the more powerful of the two variants of the item!", -- instead of "hmm, I found one of the countless variants, a decent one"). -- In particular, for unique items, unless they inherit aspects from -- a standard item, permit only a couple possible variants. -- This is especially important if an item kind has multiple random aspects. -- Instead multiply dice results, e.g., (1 `d` 3) * 5 instead of 1 `d` 15. -- -- Beware of non-periodic non-weapon durable items with beneficial effects -- and low timeout -- AI will starve applying such an item incessantly. -- * Item group symbols, partially from Nethack symbolProjectile, _symbolLauncher, symbolLight, symbolTool, symbolSpecial, symbolGold, symbolNecklace, symbolRing, symbolPotion, symbolFlask, symbolScroll, symbolTorsoArmor, symbolMiscArmor, symbolClothes, symbolShield, symbolPolearm, symbolEdged, symbolHafted, symbolWand, _symbolStaff, symbolFood :: Char symbolProjectile = rsymbolProjectile standardRules -- '|' _symbolLauncher = '}' symbolLight = '(' symbolTool = '(' symbolSpecial = '*' -- don't overuse, because it clashes with projectiles symbolGold = '$' -- also gems symbolNecklace = '"' symbolRing = '=' symbolPotion = '!' -- concoction, bottle, jar, vial, canister symbolFlask = '!' symbolScroll = '?' -- book, note, tablet, remote, chip, card symbolTorsoArmor = '[' symbolMiscArmor = '[' symbolClothes = '[' symbolShield = ']' symbolPolearm = ')' symbolEdged = ')' symbolHafted = ')' symbolWand = '/' -- magical rod, transmitter, pistol, rifle, instrument _symbolStaff = '_' -- scanner symbolFood = ',' -- also body part; distinct from floor: not middle dot -- * Generic items, for any epoch -- ** Thrown weapons sandstoneRock = ItemKind { isymbol = symbolProjectile , iname = "sandstone rock" , ifreq = [ ("sandstone rock", 1) , ("unreported inventory", 1) ] -- too weak to spam , iflavour = zipPlain [Green] , icount = 1 + 1 `d` 2 -- > 1, to let AI ignore sole pieces , irarity = [(1, 50), (10, 1)] , iverbHit = "hit" , iweight = 300 , idamage = 1 `d` 1 , iaspects = [ AddSkill SkHurtMelee $ -16 * 5 , SetFlag Fragile , toVelocity 70 ] -- not dense, irregular , ieffects = [] , idesc = "A lump of brittle sandstone rock." , ikit = [] } dart = ItemKind { isymbol = symbolProjectile , iname = "dart" , ifreq = [("common item", 100), ("any arrow", 50), ("weak arrow", 50)] , iflavour = zipPlain [BrRed] , icount = 1 + 4 `dL` 5 , irarity = [(1, 15), (10, 5)] , iverbHit = "prick" , iweight = 40 , idamage = 1 `d` 1 , iaspects = [AddSkill SkHurtMelee $ (-15 + 1 `d` 2 + 1 `dL` 3) * 5] -- only good against leather , ieffects = [] , idesc = "A sharp delicate dart with fins." , ikit = [] } spike = ItemKind { isymbol = symbolProjectile , iname = "spike" , ifreq = [("common item", 100), ("any arrow", 50), ("weak arrow", 50)] , iflavour = zipPlain [Cyan] , icount = 1 + 4 `dL` 5 , irarity = [(1, 10), (10, 8)] , iverbHit = "nick" , iweight = 150 , idamage = 2 `d` 1 , iaspects = [ AddSkill SkHurtMelee $ (-10 + 1 `d` 2 + 1 `dL` 3) * 5 -- heavy vs armor , SetFlag MinorEffects , toVelocity 70 ] -- hitting with tip costs speed , ieffects = [ Explode "single spark" -- when hitting enemy , OnSmash (Explode "single spark") ] -- at wall hit -- this results in a wordy item synopsis, but it's OK, the spark really -- is useful in some situations, not just a flavour , idesc = "A cruel long nail with small head." -- "Much inferior to arrows though, especially given the contravariance problems." -- funny, but destroy the suspension of disbelief; this is supposed to be a Lovecraftian horror and any hilarity must ensue from the failures in making it so and not from actively trying to be funny; also, mundane objects are not supposed to be scary or transcendental; the scare is in horrors from the abstract dimension visiting our ordinary reality; without the contrast there's no horror and no wonder, so also the magical items must be contrasted with ordinary XIX century and antique items , ikit = [] } spike2 = spike { ifreq = [("common item", 2), ("any arrow", 1), ("weak arrow", 1)] , icount = 6 `dL` 5 , iverbHit = "penetrate" , iweight = 200 , idamage = 4 `d` 1 , iaspects = [ AddSkill SkHurtMelee $ (-10 + 1 `d` 2 + 1 `dL` 3) * 5 , SetFlag MinorEffects , Odds (10 * 1 `dL` 10) [] [toVelocity 70] ] -- at deep levels sometimes even don't limit velocity , idesc = "A jagged skewer of rusty metal." } slingStone = ItemKind { isymbol = symbolProjectile , iname = "sling stone" , ifreq = [("common item", 5), ("any arrow", 100)] , iflavour = zipPlain [Blue] , icount = 1 + 3 `dL` 4 , irarity = [(1, 1), (10, 20)] , iverbHit = "batter" , iweight = 200 , idamage = 1 `d` 1 , iaspects = [ AddSkill SkHurtMelee $ (-10 + 1 `d` 2 + 1 `dL` 3) * 5 -- heavy, to bludgeon through armor , SetFlag MinorEffects , toVelocity 150 ] , ieffects = [ Explode "single spark" -- when hitting enemy , OnSmash (Explode "single spark") ] -- at wall hit , idesc = "A round stone, carefully sized and smoothed to fit the pouch of a standard string and cloth sling." , ikit = [] } slingBullet = ItemKind { isymbol = symbolProjectile , iname = "sling bullet" , ifreq = [("common item", 5), ("any arrow", 100)] , iflavour = zipPlain [BrBlack] , icount = 1 + 6 `dL` 4 , irarity = [(1, 1), (10, 15)] , iverbHit = "slug" , iweight = 28 , idamage = 1 `d` 1 , iaspects = [ AddSkill SkHurtMelee $ (-17 + 1 `d` 2 + 1 `dL` 3) * 5 -- not too good against armor , ToThrow $ ThrowMod 200 100 2 ] -- piercing , ieffects = [] , idesc = "Small almond-shaped leaden projectile that weighs more than the sling used to tie the bag. It doesn't drop out of the sling's pouch when swung and doesn't snag when released. Known to pierce through flesh, at least at maximum speed." -- we lie, it doesn't slow down in our model; but it stops piercing alright , ikit = [] } -- ** Exotic thrown weapons -- Identified, because shape (and name) says it all. Detailed aspects id by use. -- This is an extremely large value for @Paralyze@. Normally for such values -- we should instead use condition that disables (almost) all stats, -- except @SkWait@, so that the player can switch leader and not be -- helpless nor experience instadeath (unless his party is 1-person -- or the actor is isolated, but that's usually player's fault). paralizingProj = ItemKind { isymbol = symbolProjectile , iname = "bolas set" , ifreq = [("common item", 100)] , iflavour = zipPlain [BrGreen] , icount = 1 `dL` 4 , irarity = [(5, 5), (10, 5)] , iverbHit = "entangle" , iweight = 500 , idamage = 1 `d` 1 , iaspects = [AddSkill SkHurtMelee $ -14 * 5] , ieffects = [Paralyze 15, DropBestWeapon] , idesc = "Wood balls tied with hemp rope. The target enemy is tripped and bound to drop the main weapon, while fighting for balance." , ikit = [] } harpoon = ItemKind { isymbol = symbolProjectile , iname = "harpoon" , ifreq = [("common item", 100), ("harpoon", 100)] , iflavour = zipPlain [Brown] , icount = 1 `dL` 5 , irarity = [(10, 10)] , iverbHit = "hook" , iweight = 750 , idamage = 5 `d` 1 , iaspects = [AddSkill SkHurtMelee $ (-10 + 1 `d` 2 + 1 `dL` 3) * 5] , ieffects = [ PullActor (ThrowMod 200 50 1) -- 1 step, fast , Yell ] -- yell, because brutal , idesc = "The cruel, barbed head lodges in its victim so painfully that the weakest tug of the thin line sends the victim flying." , ikit = [] } harpoon2 = harpoon { iname = "whaling harpoon" , ifreq = [("common item", 5), ("harpoon", 2)] , icount = 2 `dL` 5 , iweight = 1000 , idamage = 10 `d` 1 , idesc = "With a brittle, barbed head and thick cord, this ancient weapon is designed for formidable prey." } net = ItemKind { isymbol = symbolProjectile , iname = "net" , ifreq = [("common item", 100)] , iflavour = zipPlain [BrGreen] , icount = 1 `dL` 3 , irarity = [(5, 5), (10, 7)] , iverbHit = "entangle" , iweight = 1000 , idamage = 2 `d` 1 , iaspects = [AddSkill SkHurtMelee $ -14 * 5] , ieffects = [ toOrganBad "slowed" (3 + 1 `d` 3) , DropItem maxBound 1 CEqp "torso armor" -- only one of each kind is dropped, because no rubbish -- in this group and so no risk of exploit , SendFlying (ThrowMod 100 50 1) ] -- 1 step; painful , idesc = "A wide net with weights along the edges. Entangles armor and restricts movement." , ikit = [] } -- ** Lights light1 = ItemKind { isymbol = symbolLight , iname = "wooden torch" , ifreq = [ ("common item", 100), ("light source", 100) , ("wooden torch", 1) ] , iflavour = zipPlain [Brown] , icount = 1 `dL` 4 , irarity = [(1, 40), (4, 1)] , iverbHit = "scorch" , iweight = 1000 , idamage = 0 , iaspects = [ AddSkill SkShine 3, AddSkill SkSight (-2) -- not only flashes, but also sparks, -- so unused by AI due to the mixed blessing , SetFlag Lobable, SetFlag Equipable , EqpSlot EqpSlotShine ] -- not Fragile; reusable flare , ieffects = [Burn 1] , idesc = "A heavy smoking wooden torch, improvised using a cloth soaked in tar, burning in an unsteady glow." , ikit = [] } light2 = ItemKind { isymbol = symbolLight , iname = "oil lamp" , ifreq = [("common item", 100), ("light source", 100)] , iflavour = zipPlain [BrYellow] , icount = 1 `dL` 2 , irarity = [(4, 10)] , iverbHit = "burn" , iweight = 1500 , idamage = 1 `d` 1 , iaspects = [ AddSkill SkShine 3, AddSkill SkSight (-1) , SetFlag Lobable, SetFlag Fragile, SetFlag Equipable , EqpSlot EqpSlotShine ] , ieffects = [ Burn 1 , toOrganBad "pacified" (2 + 1 `d` 2) , OnSmash (Explode "burning oil 2") ] , idesc = "A clay lamp filled with plant oil feeding a tiny wick." , ikit = [] } light3 = ItemKind { isymbol = symbolLight , iname = "brass lantern" , ifreq = [("common item", 100), ("light source", 100)] , iflavour = zipPlain [Red] , icount = 1 , irarity = [(10, 6)] , iverbHit = "burn" , iweight = 3000 , idamage = 2 `d` 1 , iaspects = [ AddSkill SkShine 4, AddSkill SkSight (-1) , SetFlag Lobable, SetFlag Fragile, SetFlag Equipable , EqpSlot EqpSlotShine ] , ieffects = [ Burn 1 , toOrganBad "pacified" (4 + 1 `d` 2) , OnSmash (Explode "burning oil 4") ] , idesc = "Very bright and very heavy brass lantern." , ikit = [] } blanket = ItemKind { isymbol = symbolLight , iname = "wool blanket" , ifreq = [("common item", 100), ("light source", 100), ("blanket", 1)] , iflavour = zipPlain [BrBlack] , icount = 1 , irarity = [(1, 1)] -- not every playthrough needs one , iverbHit = "swoosh" , iweight = 1000 , idamage = 0 , iaspects = [ AddSkill SkShine (-10) , AddSkill SkArmorMelee 2, AddSkill SkMaxCalm 5 , SetFlag Lobable, SetFlag Equipable ] -- not Fragile; reusable douse implement; -- douses torch, lamp and lantern in one action, -- both in equipment and when thrown at the floor , ieffects = [] , idesc = "Warm, comforting, and concealing, woven from soft wool." , ikit = [] } -- ** Exploding consumables, often intended to be thrown. -- Not identified, because they are perfect for the id-by-use fun, -- due to effects. They are fragile and upon hitting the ground explode -- for effects roughly corresponding to their normal effects. -- Whether to hit with them or explode them close to the target -- is intended to be an interesting tactical decision. -- -- Flasks are often not natural; maths, magic, distillery. -- In fact, they just cover all conditions, except those for stats. -- -- There is no flask nor condition of Calm depletion, -- because Calm reduced often via combat, etc. flaskTemplate = ItemKind { isymbol = symbolFlask , iname = "flask" , ifreq = [("flask unknown", 1)] , iflavour = zipGlassPlain darkCol ++ zipGlassFancy darkCol ++ zipLiquid darkCol -- ++ zipPlain darkCol ++ zipFancy darkCol , icount = 1 `dL` 3 , irarity = [(1, 7), (10, 3)] , iverbHit = "splash" , iweight = 500 , idamage = 0 , iaspects = [ HideAs "flask unknown", SetFlag Lobable, SetFlag Fragile , toVelocity 50 ] -- oily, bad grip , ieffects = [] , idesc = "A flask of oily liquid of a suspect color. Something seems to be moving inside. Double dose causes twice longer effect." , ikit = [] } flask1 = flaskTemplate { ifreq = [("common item", 100), ("explosive", 100), ("any vial", 100)] , icount = 1 `dL` 5 , irarity = [(10, 10)] , iaspects = ELabel "of strength renewal brew" : iaspects flaskTemplate , ieffects = [ toOrganGood "strengthened" (20 + 1 `d` 5) , toOrganNoTimer "regenerating" , OnSmash (Explode "dense shower") ] } flask2 = flaskTemplate { ifreq = [("common item", 100), ("explosive", 100), ("any vial", 100)] , iaspects = ELabel "of weakness brew" : iaspects flaskTemplate , ieffects = [ toOrganBad "weakened" (20 + 1 `d` 5) , OnSmash (Explode "sparse shower") ] } flask3 = flaskTemplate { ifreq = [("common item", 100), ("explosive", 100), ("any vial", 100)] , iaspects = ELabel "of melee protective balm" : iaspects flaskTemplate , ieffects = [ toOrganGood "protected from melee" (20 + 1 `d` 5) , OnSmash (Explode "melee protective balm") ] } flask4 = flaskTemplate { ifreq = [("common item", 100), ("explosive", 100), ("any vial", 100)] , iaspects = ELabel "of ranged protective balm" : iaspects flaskTemplate , ieffects = [ toOrganGood "protected from ranged" (20 + 1 `d` 5) , OnSmash (Explode "ranged protective balm") ] } flask5 = flaskTemplate { ifreq = [("common item", 100), ("explosive", 100), ("any vial", 100)] , iaspects = ELabel "of PhD defense questions" : iaspects flaskTemplate , ieffects = [ toOrganBad "defenseless" (20 + 1 `d` 5) , Impress , Detect DetectExit 20 , OnSmash (Explode "PhD defense question") ] } flask6 = flaskTemplate { ifreq = [("common item", 100), ("explosive", 100), ("any vial", 100)] , irarity = [(1, 1)] -- not every playthrough needs one , iaspects = ELabel "of resolution" : iaspects flaskTemplate , ieffects = [ toOrganGood "resolute" (500 + 1 `d` 200) -- long, for scouting , RefillCalm 60 -- not to make it a drawback, via @calmEnough@ , OnSmash (Explode "resolution dust") ] } flask7 = flaskTemplate { ifreq = [("common item", 100), ("explosive", 100), ("any vial", 100)] , icount = 1 -- too powerful en masse , iaspects = ELabel "of haste brew" : iaspects flaskTemplate , ieffects = [ toOrganGood "hasted" (20 + 1 `d` 5) , OnSmash (Explode "haste spray") ] } flask8 = flaskTemplate { ifreq = [("common item", 100), ("explosive", 100), ("any vial", 100)] , iaspects = ELabel "of eye drops" : iaspects flaskTemplate , ieffects = [ toOrganGood "far-sighted" (40 + 1 `d` 10) , OnSmash (Explode "eye drop") ] } flask9 = flaskTemplate { ifreq = [("common item", 100), ("explosive", 100), ("any vial", 100)] , irarity = [(10, 2)] -- not very useful right now , iaspects = ELabel "of smelly concoction" : iaspects flaskTemplate , ieffects = [ toOrganGood "keen-smelling" (40 + 1 `d` 10) , Detect DetectActor 10 -- make it at least slightly useful , OnSmash (Explode "smelly droplet") ] } flask10 = flaskTemplate { ifreq = [("common item", 100), ("explosive", 100), ("any vial", 100)] , irarity = [(10, 2)] -- not very useful right now , iaspects = ELabel "of cat tears" : iaspects flaskTemplate , ieffects = [ toOrganGood "shiny-eyed" (40 + 1 `d` 10) , OnSmash (Explode "eye shine") ] } flask11 = flaskTemplate { iname = "bottle" , ifreq = [("common item", 100), ("explosive", 100), ("any vial", 100)] , icount = 1 `d` 3 -- the only one sometimes giving away its identity , iaspects = ELabel "of whiskey" : iaspects flaskTemplate , ieffects = [ toOrganGood "drunk" (20 + 1 `d` 5) , Burn 1, RefillHP 3, Yell , OnSmash (Explode "whiskey spray") ] } flask12 = flaskTemplate { ifreq = [("common item", 100), ("explosive", 100), ("any vial", 100)] , icount = 1 , iaspects = ELabel "of bait cocktail" : iaspects flaskTemplate , ieffects = [ toOrganGood "drunk" (20 + 1 `d` 5) , Burn 1, RefillHP 3 -- risky exploit possible, good , Summon "mobile animal" 1 , OnSmash (Summon "mobile animal" 1) , OnSmash Impress -- mildly useful when thrown , OnSmash (Explode "waste") ] } -- The player has full control over throwing the flask at his party, -- so he can milk the explosion, so it has to be much weaker, so a weak -- healing effect is enough. OTOH, throwing a harmful flask at many enemies -- at once is not easy to arrange, so these explosions can stay powerful. flask13 = flaskTemplate { ifreq = [("common item", 100), ("explosive", 100), ("any vial", 100)] , irarity = [(1, 2), (10, 12)] , iaspects = ELabel "of regeneration brew" : iaspects flaskTemplate , ieffects = [ toOrganGood "rose-smelling" (80 + 1 `d` 20) , toOrganNoTimer "regenerating" , toOrganNoTimer "regenerating" -- x2 , OnSmash (Explode "youth sprinkle") ] } flask14 = flaskTemplate { ifreq = [("common item", 100), ("explosive", 100), ("any vial", 100)] , iaspects = ELabel "of poison" : iaspects flaskTemplate , ieffects = [ toOrganNoTimer "poisoned", toOrganNoTimer "poisoned" -- x2 , OnSmash (Explode "poison cloud") ] } flask15 = flaskTemplate { ifreq = [("common item", 100), ("explosive", 100), ("any vial", 100)] , irarity = [(10, 4)] , iaspects = ELabel "of slow resistance" : iaspects flaskTemplate , ieffects = [ toOrganNoTimer "slow resistant" , OnSmash (Explode "anti-slow mist") ] } flask16 = flaskTemplate { ifreq = [("common item", 100), ("explosive", 100), ("any vial", 100)] , irarity = [(10, 4)] , iaspects = ELabel "of poison resistance" : iaspects flaskTemplate , ieffects = [ toOrganNoTimer "poison resistant" , OnSmash (Explode "antidote mist") ] } flask17 = flaskTemplate { ifreq = [("common item", 100), ("explosive", 100), ("any vial", 100)] , iaspects = ELabel "of calamity" : iaspects flaskTemplate , ieffects = [ toOrganNoTimer "poisoned" , toOrganBad "weakened" (20 + 1 `d` 5) , toOrganBad "defenseless" (20 + 1 `d` 5) , OnSmash (Explode "glass hail") ] -- enough glass to cause that } -- Potions are often natural, including natural stats. -- They appear deeper than most flasks. Various configurations of effects. -- A different class of effects is on scrolls and mechanical items. -- Some are shared. potionTemplate = ItemKind { isymbol = symbolPotion , iname = "potion" , ifreq = [("potion unknown", 1)] , iflavour = zipLiquid brightCol ++ zipPlain brightCol ++ zipFancy brightCol , icount = 1 `dL` 3 , irarity = [(1, 10), (10, 6)] , iverbHit = "splash" , iweight = 200 , idamage = 0 , iaspects = [ HideAs "potion unknown", SetFlag Lobable, SetFlag Fragile , toVelocity 50 ] -- oily, bad grip , ieffects = [] , idesc = "A vial of bright, frothing concoction. The best that nature has to offer." , ikit = [] } potion1 = potionTemplate { iname = "vial" , ifreq = [("common item", 100), ("potion", 100), ("any vial", 100)] , icount = 3 `dL` 1 -- very useful, despite appearances , iaspects = ELabel "of rose water" : iaspects potionTemplate , ieffects = [ Impress, toOrganGood "rose-smelling" (80 + 1 `d` 20) , OnSmash ApplyPerfume, OnSmash (Explode "fragrance") ] } potion2 = potionTemplate { ifreq = [("treasure", 100), ("any vial", 100)] , icount = 1 , irarity = [(5, 8), (10, 8)] , iaspects = [ SetFlag Unique, ELabel "of Attraction" , SetFlag Precious, SetFlag Lobable, SetFlag Fragile , toVelocity 50 ] -- identified , ieffects = [ Dominate , toOrganGood "hasted" (20 + 1 `d` 5) , OnSmash (Explode "pheromone") , OnSmash (Explode "haste spray") ] , idesc = "The liquid fizzes with energy." } potion3 = potionTemplate { ifreq = [("common item", 100), ("potion", 100), ("any vial", 100)] , ieffects = [ RefillHP 5, DropItem 1 maxBound COrgan "poisoned" , OnSmash (Explode "healing mist") ] } potion4 = potionTemplate { ifreq = [("common item", 100), ("potion", 100), ("any vial", 100)] , irarity = [(1, 6), (10, 10)] , ieffects = [ RefillHP 10, DropItem maxBound maxBound COrgan "condition" , OnSmash (Explode "healing mist 2") ] } potion5 = potionTemplate -- needs to be common to show at least a portion of effects { ifreq = [("common item", 100), ("potion", 100), ("any vial", 100)] , icount = 3 `dL` 1 -- always as many as possible on this level -- without giving away potion identity , irarity = [(1, 12)] , ieffects = [ OneOf [ RefillHP 10, RefillHP 5, Burn 5 , DropItem 1 maxBound COrgan "poisoned" , toOrganGood "strengthened" (20 + 1 `d` 5) ] , OnSmash (OneOf [ Explode "dense shower" , Explode "sparse shower" , Explode "melee protective balm" , Explode "ranged protective balm" , Explode "PhD defense question" ]) ] } potion6 = potionTemplate -- needs to be common to show at least a portion of effects { ifreq = [("common item", 100), ("potion", 100), ("any vial", 100)] , icount = 3 `dL` 1 , irarity = [(10, 10)] , ieffects = [ Impress , OneOf [ RefillHP 20, RefillHP 10, Burn 10 , DropItem 1 maxBound COrgan "poisoned" , toOrganGood "hasted" (20 + 1 `d` 5) , toOrganBad "impatient" (2 + 1 `d` 2) ] , OnSmash (OneOf [ Explode "healing mist 2" , Explode "wounding mist" , Explode "distressing odor" , Explode "impatient mist" , Explode "haste spray" , Explode "slowness mist" , Explode "fragrance" , Explode "violent flash" ]) ] } potion7 = potionTemplate { iname = "ampoule" -- probably filled with nitroglycerine, but let's -- not mix fantasy with too much technical jargon , ifreq = [("common item", 100), ("potion", 100), ("any vial", 100)] , icount = 3 `dL` 1 , ieffects = [ DropItem 1 maxBound COrgan "condition" , OnSmash (Explode "violent concussion") ] -- not fragmentation nor glass hail, because not enough glass } potion8 = potionTemplate { ifreq = [("treasure", 100), ("any vial", 100)] , icount = 1 , irarity = [(10, 5)] , iaspects = [ SetFlag Unique, ELabel "of Love" , SetFlag Precious, SetFlag Lobable, SetFlag Fragile , toVelocity 50 ] -- identified , ieffects = [ RefillHP 60, RefillCalm (-60) , toOrganGood "rose-smelling" (80 + 1 `d` 20) , OnSmash (Explode "healing mist 2") , OnSmash (Explode "distressing odor") ] , idesc = "Perplexing swirls of intense, compelling colour." } potion9 = potionTemplate { ifreq = [("common item", 100), ("potion", 100), ("any vial", 100)] , irarity = [(10, 5)] , iaspects = ELabel "of grenadier focus" : iaspects potionTemplate , ieffects = [ toOrganGood "more projecting" (40 + 1 `d` 10) , toOrganBad "pacified" (5 + 1 `d` 3) -- the malus has to be weak, or would be too good -- when thrown at foes , OnSmash (Explode "more projecting dew") , OnSmash (Explode "pacified mist") ] , idesc = "Thick, sluggish fluid with violently-bursting bubbles." } potion10 = potionTemplate { ifreq = [("common item", 100), ("potion", 100), ("any vial", 100)] , irarity = [(10, 8)] , iaspects = ELabel "of frenzy" : iaspects potionTemplate , ieffects = [ Yell , toOrganGood "strengthened" (20 + 1 `d` 5) , toOrganBad "retaining" (5 + 1 `d` 3) , toOrganBad "frenzied" (40 + 1 `d` 10) , OnSmash (Explode "dense shower") , OnSmash (Explode "retaining mist") , OnSmash (Explode "retaining mist") ] } potion11 = potionTemplate { ifreq = [("common item", 100), ("potion", 100), ("any vial", 100)] , irarity = [(10, 8)] , iaspects = ELabel "of panic" : iaspects potionTemplate , ieffects = [ RefillCalm (-30) , toOrganGood "hasted" (20 + 1 `d` 5) , toOrganBad "weakened" (20 + 1 `d` 5) , toOrganBad "withholding" (10 + 1 `d` 5) , OnSmash (Explode "haste spray") , OnSmash (Explode "sparse shower") , OnSmash (Explode "withholding mist") ] } potion12 = potionTemplate { ifreq = [("common item", 100), ("potion", 100), ("any vial", 100)] , irarity = [(10, 8)] , iaspects = ELabel "of quicksilver" : iaspects potionTemplate , ieffects = [ toOrganGood "hasted" (20 + 1 `d` 5) , toOrganBad "blind" (10 + 1 `d` 5) , toOrganBad "immobile" (5 + 1 `d` 5) , OnSmash (Explode "haste spray") , OnSmash (Explode "iron filing") , OnSmash (Explode "immobile mist") ] } -- ** Explosives, with the only effect being @Explode@ fragmentationBomb = ItemKind { isymbol = symbolProjectile , iname = "clay pot" -- clay pot filled with black powder; fragmentation comes from the clay -- shards, so it's not obvious if it's a weapon or just storage method; -- deflagration, not detonation, so large mass and hard container -- required not to burn harmlessly; improvised short fuze , ifreq = [("common item", 100), ("explosive", 200)] , iflavour = zipPlain [Red] , icount = 1 `dL` 5 -- many, because not very intricate , irarity = [(5, 8), (10, 5)] , iverbHit = "thud" , iweight = 3000 -- low velocity due to weight , idamage = 1 `d` 1 -- heavy and hard , iaspects = [ ELabel "of black powder" , SetFlag Lobable, SetFlag Fragile ] , ieffects = [ Explode "focused fragmentation" , OnSmash (Explode "violent fragmentation") ] , idesc = "The practical application of science." , ikit = [] } concussionBomb = fragmentationBomb { iname = "satchel" -- slightly stabilized nitroglycerine in a soft satchel, hence -- no fragmentation, but huge shock wave despite small size and lack of -- strong container to build up pressure (hence only mild hearing loss); -- indoors helps the shock wave; unstable enough that no fuze required , iflavour = zipPlain [Magenta] , iverbHit = "flap" , iweight = 400 , idamage = 0 , iaspects = [ ELabel "of mining charges" , SetFlag Lobable, SetFlag Fragile , toVelocity 70 ] -- flappy and so slow , ieffects = [ Explode "focused concussion" , OnSmash (Explode "violent concussion") ] , idesc = "Avoid sudden movements." } -- Not flashbang, because powerful bang without fragmentation is harder -- to manufacture (requires an oxidizer and steel canister with holes). -- The bang would also paralyze and/or lower the movement skill -- (out of balance due to ear trauma). flashBomb = fragmentationBomb { iname = "magnesium ribbon" -- filled with magnesium flash powder , iflavour = zipPlain [BrYellow] -- avoid @BrWhite@; looks wrong in dark , iverbHit = "flash" , iweight = 400 , idamage = 0 , iaspects = [ SetFlag Lobable, SetFlag Fragile , toVelocity 70 ] -- bad shape for throwing , ieffects = [Explode "focused flash", OnSmash (Explode "violent flash")] , idesc = "For dramatic entrances and urgent exits." } firecrackerBomb = fragmentationBomb { iname = "roll" -- not fireworks, as they require outdoors , iflavour = zipPlain [BrMagenta] , irarity = [(1, 5), (5, 6)] -- a toy, if deadly , iverbHit = "crack" -- a pun, matches the verb from "ItemKindBlast" , iweight = 1000 , idamage = 0 , iaspects = [SetFlag Lobable, SetFlag Fragile] , ieffects = [Explode "firecracker", OnSmash (Explode "firecracker")] , idesc = "String and paper, concealing a deadly surprise." } -- ** Non-exploding consumables, not specifically designed for throwing -- Foods require only minimal apply skill to consume. Many animals can eat them. ediblePlantTemplate = ItemKind { isymbol = symbolFood , iname = "edible plant" , ifreq = [("edible plant unknown", 1)] , iflavour = zipPlain stdCol , icount = 1 `dL` 5 , irarity = [(1, 12), (10, 6)] -- let's feed the animals , iverbHit = "thump" , iweight = 50 , idamage = 0 , iaspects = [ HideAs "edible plant unknown" , toVelocity 30 ] -- low density, often falling apart , ieffects = [] , idesc = "Withered but fragrant bits of a colorful plant. Taste tolerably and break down easily, but only eating may reveal the full effects." , ikit = [] } ediblePlant1 = ediblePlantTemplate { iname = "overripe berry" , ifreq = [("common item", 100), ("edible plant", 100)] , ieffects = [RefillHP 1, toOrganBad "immobile" (5 + 1 `d` 5)] } ediblePlant2 = ediblePlantTemplate { iname = "frayed fungus" , ifreq = [("common item", 100), ("edible plant", 100)] , ieffects = [toOrganNoTimer "poisoned"] } ediblePlant3 = ediblePlantTemplate { iname = "thick leaf" , ifreq = [("common item", 100), ("edible plant", 100)] , ieffects = [DropItem 1 maxBound COrgan "poisoned"] } ediblePlant4 = ediblePlantTemplate { iname = "shrunk fruit" , ifreq = [("common item", 100), ("edible plant", 100)] , ieffects = [toOrganBad "blind" (10 + 1 `d` 10)] } ediblePlant5 = ediblePlantTemplate { iname = "fragrant herb" , ifreq = [("common item", 100), ("edible plant", 100)] , icount = 1 `dL` 9 , irarity = [(1, 12), (10, 5)] , iaspects = ELabel "of lethargy" : iaspects ediblePlantTemplate , ieffects = [ toOrganBad "slowed" (20 + 1 `d` 5) , toOrganNoTimer "regenerating" , toOrganNoTimer "regenerating" -- x2 , RefillCalm 5 ] } ediblePlant6 = ediblePlantTemplate { iname = "dull flower" , ifreq = [("common item", 100), ("edible plant", 100)] , ieffects = [PutToSleep] } ediblePlant7 = ediblePlantTemplate { iname = "spicy bark" , ifreq = [("common item", 100), ("edible plant", 100)] , ieffects = [InsertMove 20, toOrganBad "frenzied" (40 + 1 `d` 10)] } -- These require high apply skill to consume. scrollTemplate = ItemKind { isymbol = symbolScroll , iname = "scroll" , ifreq = [("scroll unknown", 1)] , iflavour = zipFancy stdCol ++ zipPlain stdCol , icount = 1 `dL` 3 , irarity = [(1, 14), (10, 7)] , iverbHit = "thump" , iweight = 50 , idamage = 0 , iaspects = [ HideAs "scroll unknown" , toVelocity 30 ] -- bad shape, even rolled up , ieffects = [] , idesc = "Scraps of haphazardly scribbled mysteries from beyond. Is this equation an alchemical recipe? Is this diagram an extradimensional map? Is this formula a secret call sign?" , ikit = [] } scroll1 = scrollTemplate { ifreq = [("treasure", 100), ("any scroll", 100)] , icount = 1 , irarity = [(5, 9), (10, 9)] -- mixed blessing, so found early for a unique , iaspects = [SetFlag Unique, ELabel "of Reckless Beacon"] ++ iaspects scrollTemplate , ieffects = [Summon "hero" 1, Summon "mobile animal" (2 + 1 `d` 2)] , idesc = "The bright flame and sweet-smelling smoke of this heavily infused scroll should attract natural creatures inhabiting the area, including human survivors, if any." } scroll2 = scrollTemplate { ifreq = [("common item", 100), ("any scroll", 100)] , irarity = [(1, 6), (10, 2)] , ieffects = [Ascend False] } scroll3 = scrollTemplate -- needs to be common to show at least a portion of effects { ifreq = [("common item", 100), ("any scroll", 100)] , icount = 3 `dL` 1 , irarity = [(1, 14)] , ieffects = [OneOf [ Teleport 5, Paralyze 10, InsertMove 30 , Detect DetectEmbed 12, Detect DetectHidden 20 ]] } scroll4 = scrollTemplate -- needs to be common to show at least a portion of effects { ifreq = [("common item", 100), ("any scroll", 100)] , icount = 3 `dL` 1 , irarity = [(10, 14)] , ieffects = [ Impress , OneOf [ Teleport 20, Ascend False, Ascend True , Summon "hero" 1, Summon "mobile animal" $ 1 `d` 2 , Detect DetectLoot 20 -- the most useful of detections , CreateItem CGround "common item" timerNone ] ] } scroll5 = scrollTemplate { ifreq = [("common item", 100), ("any scroll", 100)] , irarity = [(1, 6)] -- powerful, but low counts at the depths it appears on , ieffects = [InsertMove $ 20 + 1 `dL` 20] } scroll6 = scrollTemplate { ifreq = [("common item", 100), ("any scroll", 100)] , icount = 3 `dL` 1 , irarity = [(1, 20)] -- uncommon deep down, where all is known , iaspects = ELabel "of scientific explanation" : iaspects scrollTemplate , ieffects = [Composite [Identify, RefillCalm 10]] , idesc = "The most pressing existential concerns are met with a deeply satisfying scientific answer." } scroll7 = scrollTemplate { ifreq = [("common item", 100), ("any scroll", 100)] , irarity = [(10, 20)] -- at endgame a crucial item may be missing , iaspects = ELabel "of transmutation" : iaspects scrollTemplate , ieffects = [Composite [PolyItem, Explode "firecracker"]] } scroll8 = scrollTemplate { ifreq = [("treasure", 100), ("any scroll", 100)] , icount = 1 , irarity = [(10, 12)] , iaspects = [SetFlag Unique, ELabel "of Rescue Proclamation"] ++ iaspects scrollTemplate , ieffects = [Summon "hero" 1] , idesc = "A survivor of past exploration missions is found that enjoys, apparently, complete physiological integrity. We can pronounce him a comrade in arms and let him join our party." } scroll9 = scrollTemplate { ifreq = [("common item", 100), ("any scroll", 100)] , irarity = [(10, 4)] -- powerful, even if not ideal; scares newbies , ieffects = [Detect DetectAll 20] } scroll10 = scrollTemplate { ifreq = [("common item", 100), ("any scroll", 100)] , iaspects = ELabel "of cue interpretation" : iaspects scrollTemplate , ieffects = [Detect DetectActor 20] } scroll11 = scrollTemplate { ifreq = [("common item", 100), ("any scroll", 100)] , irarity = [(10, 11)] , ieffects = [PushActor (ThrowMod 400 200 1)] -- 8 steps, 4 turns } scroll12 = scrollTemplate { ifreq = [("common item", 100), ("any scroll", 100)] , irarity = [(10, 15)] , iaspects = ELabel "of similarity" : iaspects scrollTemplate , ieffects = [DupItem] } scroll13 = scrollTemplate { ifreq = [("common item", 100), ("any scroll", 100)] , irarity = [(10, 15)] , iaspects = ELabel "of transfiguration" : iaspects scrollTemplate , ieffects = [RerollItem] } -- ** Assorted tools jumpingPole = ItemKind { isymbol = symbolWand , iname = "jumping pole" , ifreq = [("common item", 100)] , iflavour = zipPlain [White] , icount = 1 , irarity = [(1, 3)] , iverbHit = "prod" , iweight = 10000 , idamage = 0 , iaspects = [ Timeout $ (2 + 1 `d` 2 - 1 `dL` 2) * 5 , SetFlag Durable ] , ieffects = [toOrganGood "hasted" 1] -- safe for AI, because it speeds up, so when AI applies it -- again and again, it gets its time back and is not stuck; -- in total, the explorations speed is unchanged, -- but it's useful when fleeing in the dark to make distance -- and when initiating combat, so it's OK that AI uses it , idesc = "Makes you vulnerable at take-off, but then you are free like a bird." , ikit = [] } sharpeningTool = ItemKind { isymbol = symbolTool , iname = "whetstone" , ifreq = [("common item", 100)] , iflavour = zipPlain [Blue] , icount = 1 , irarity = [(10, 10)] , iverbHit = "smack" , iweight = 400 , idamage = 0 , iaspects = [ AddSkill SkHurtMelee $ (1 `dL` 7) * 5 , SetFlag Equipable, EqpSlot EqpSlotHurtMelee ] , ieffects = [] , idesc = "A portable sharpening stone for keeping your weapons keen and true, without the need to set up camp, fish out tools and assemble a proper sharpening workshop." , ikit = [] } seeingItem = ItemKind { isymbol = symbolFood , iname = "giant pupil" , ifreq = [("common item", 100)] , iflavour = zipPlain [Red] , icount = 1 , irarity = [(1, 2)] , iverbHit = "gaze at" , iweight = 100 , idamage = 0 , iaspects = [ Timeout 3 , AddSkill SkSight 10 -- a spyglass for quick wields , AddSkill SkMaxCalm 30 -- to diminish clipping sight by Calm , AddSkill SkShine 2 -- to lit corridors when flying , SetFlag Periodic ] , ieffects = [ Detect DetectActor 20 -- rare enough , toOrganNoTimer "poisoned" -- really can't be worn , Summon "mobile monster" 1 ] , idesc = "A slimy, dilated green pupil torn out from some giant eye. Clear and focused, as if still alive." , ikit = [] } motionScanner = ItemKind { isymbol = symbolTool , iname = "draft detector" , ifreq = [("common item", 100), ("add nocto 1", 20)] , iflavour = zipPlain [BrRed] , icount = 1 , irarity = [(5, 2)] , iverbHit = "jingle" , iweight = 300 , idamage = 0 , iaspects = [ AddSkill SkNocto 1 , AddSkill SkArmorMelee (-15 + (1 `dL` 3) * 5) , AddSkill SkArmorRanged (-15 + (1 `dL` 3) * 5) , SetFlag Equipable, EqpSlot EqpSlotMiscBonus ] , ieffects = [] , idesc = "A silk flag with a bell for detecting sudden draft changes. May indicate a nearby corridor crossing or a fast enemy approaching in the dark. Is also very noisy." , ikit = [] } -- ** Periodic jewelry -- Morally these are the aspects, but we also need to add a fake @Timeout@, -- to let clients know that the not identified item is periodic jewelry. iaspects_necklaceTemplate :: [Aspect] iaspects_necklaceTemplate = [ HideAs "necklace unknown" , SetFlag Periodic, SetFlag Precious, SetFlag Equipable , toVelocity 50 ] -- not dense enough gorget = necklaceTemplate { iname = "Old Gorget" , ifreq = [("common item", 25), ("treasure", 25)] , iflavour = zipFancy [BrCyan] -- looks exactly the same as one of necklaces, -- but it's OK, it's an artifact , iaspects = [ SetFlag Unique , Timeout $ 5 - 1 `dL` 4 , AddSkill SkArmorMelee 3, AddSkill SkArmorRanged 2 , SetFlag Durable ] ++ iaspects_necklaceTemplate , ieffects = [RefillCalm 1] , idesc = "Highly ornamental, cold, large, steel medallion on a chain. Unlikely to offer much protection as an armor piece, but the old, worn engraving reassures you." } -- Not identified, because id by use, e.g., via periodic activations. Fun. necklaceTemplate = ItemKind { isymbol = symbolNecklace , iname = "necklace" , ifreq = [("necklace unknown", 1)] , iflavour = zipFancy stdCol ++ zipPlain brightCol , icount = 1 , irarity = [(4, 3), (10, 6)] , iverbHit = "whip" , iweight = 30 , idamage = 0 , iaspects = Timeout 1000000 -- fake, needed to display "charging"; the timeout itself -- won't be displayed thanks to periodic; as a side-effect, -- it can't be activated until identified, which is better -- than letting the player try to activate before the real -- cooldown is over and waste turn : iaspects_necklaceTemplate , ieffects = [] , idesc = "Menacing Greek symbols shimmer with increasing speeds along a chain of fine encrusted links. After a tense build-up, a prismatic arc shoots towards the ground and the iridescence subdues, becomes ordered and resembles a harmless ornament again, for a time." , ikit = [] } necklace1 = necklaceTemplate { ifreq = [("treasure", 100), ("any jewelry", 100)] , irarity = [(10, 3)] , iaspects = [ SetFlag Unique, ELabel "of Aromata" , Timeout $ (4 - 1 `dL` 3) * 10 -- priceless, so worth the long wait , SetFlag Durable ] ++ iaspects_necklaceTemplate , ieffects = [RefillHP 1] , idesc = "A cord of freshly dried herbs and healing berries." } necklace2 = necklaceTemplate { ifreq = [("treasure", 100), ("any jewelry", 100)] -- too nasty to call it just a "common item" , irarity = [(10, 3)] , iaspects = [ SetFlag Unique, ELabel "of Live Bait" , Timeout 30 , AddSkill SkOdor 2 , SetFlag Durable ] ++ iaspects_necklaceTemplate , ieffects = [ DropItem 1 1 COrgan "condition" -- mildly useful when applied , Impress , Summon "mobile animal" $ 1 `dL` 2 , Explode "waste" ] , idesc = "A cord hung with lumps of decaying meat. It's better not to think about the source." } necklace3 = necklaceTemplate { ifreq = [("common item", 100), ("any jewelry", 100)] , iaspects = [ ELabel "of fearful listening" , Timeout ((1 + 1 `d` 2) * 10) , AddSkill SkHearing 2 ] ++ iaspects_necklaceTemplate , ieffects = [ Detect DetectActor 10 -- can be applied; destroys the item , RefillCalm (-40) ] } necklace4 = necklaceTemplate { ifreq = [("common item", 100), ("any jewelry", 100)] , iaspects = Timeout ((3 + 1 `d` 3 - 1 `dL` 3) * 2) : iaspects_necklaceTemplate , ieffects = [Teleport $ 3 `d` 2] } necklace5 = necklaceTemplate { ifreq = [("common item", 100), ("any jewelry", 100)] , iaspects = [ ELabel "of escape" , Timeout $ (7 - 1 `dL` 5) * 10 ] ++ iaspects_necklaceTemplate , ieffects = [ Teleport $ 14 + 3 `d` 3 -- can be applied; destroys the item , Detect DetectExit 20 , Yell ] -- drawback when used for quick exploring , idesc = "A supple chain that slips through your fingers." } necklace6 = necklaceTemplate { ifreq = [("common item", 100), ("any jewelry", 100)] , iaspects = Timeout (1 + (1 `d` 3) * 2) : iaspects_necklaceTemplate , ieffects = [PushActor (ThrowMod 100 50 1)] -- 1 step, slow -- the @50@ is only for the case of very light actor, etc. } necklace7 = necklaceTemplate { ifreq = [("treasure", 100), ("any jewelry", 100)] , irarity = [(10, 1)] -- different gameplay for the actor that wears it , iaspects = [ SetFlag Unique, ELabel "of Overdrive" , Timeout 4 , AddSkill SkMaxHP 25 -- give incentive to cope with impatience , SetFlag Durable ] ++ iaspects_necklaceTemplate , ieffects = [ InsertMove $ 9 + 1 `d` 11 -- unpredictable , toOrganBad "impatient" 4] -- The same duration as timeout, to avoid spurious messages -- as well as unlimited accumulation of the duration. , idesc = "A string of beads in various colours, with no discernable pattern." } necklace8 = necklaceTemplate { ifreq = [("common item", 100), ("any jewelry", 100)] , irarity = [(4, 3)] -- entirely optional , iaspects = Timeout ((1 + 1 `d` 3) * 5) : iaspects_necklaceTemplate , ieffects = [Explode "spark"] } necklace9 = necklaceTemplate { ifreq = [("common item", 100), ("any jewelry", 100)] , iaspects = Timeout ((1 + 1 `d` 3) * 5) : iaspects_necklaceTemplate , ieffects = [Explode "fragrance"] } necklace10 = necklaceTemplate { ifreq = [("common item", 100), ("any jewelry", 100)] , iaspects = [ ELabel "of greed" , Timeout ((2 + 1 `d` 3) * 10) ] ++ iaspects_necklaceTemplate , ieffects = [ Detect DetectLoot 20 , Teleport 40 -- risky , toOrganBad "parsimonious" (5 + 1 `d` 3) ] -- hard to flee } -- ** Non-periodic jewelry imageItensifier = ItemKind { isymbol = symbolRing , iname = "light cone" , ifreq = [("treasure", 100), ("add nocto 1", 80)] , iflavour = zipFancy [BrYellow] , icount = 1 , irarity = [(5, 2)] , iverbHit = "bang" , iweight = 500 , idamage = 0 , iaspects = [ AddSkill SkNocto 1, AddSkill SkSight (-1) , AddSkill SkArmorMelee $ (-1 + 1 `dL` 6) * 3 , SetFlag Precious, SetFlag Equipable , EqpSlot EqpSlotMiscBonus ] , ieffects = [] , idesc = "Contraption of lenses and mirrors on a polished brass headband for capturing and strengthening light in dark environment. Hampers vision in daylight. Stackable." , ikit = [] } sightSharpening = ringTemplate -- small and round, so mistaken for a ring { iname = "sharp monocle" , ifreq = [("treasure", 20), ("add sight", 1)] -- it's has to be very rare, because it's powerful and not unique, -- and also because it looks exactly as one of necklaces, so it would -- be misleading when seen on the map , irarity = [(7, 1), (10, 12)] -- low @ifreq@ , iweight = 50 -- heavier that it looks, due to glass , iaspects = [ AddSkill SkSight $ 1 + 1 `dL` 2 , AddSkill SkHurtMelee $ (-1 + 1 `d` 3) * 3 , EqpSlot EqpSlotSight ] ++ iaspects ringTemplate , idesc = "Lets you better focus your weaker eye." } -- Don't add standard effects to rings, because they go in and out -- of eqp and so activating them would require UI tedium: looking for -- them in eqp and inv or even activating a wrong item by mistake. -- -- By general mechanisms, due to not having effects that could identify -- them by observing the effect, rings are identified on pickup. -- That's unlike necklaces, which provide the fun of id-by-use, because they -- have effects and when the effects are triggered, they get identified. ringTemplate = ItemKind { isymbol = symbolRing , iname = "ring" , ifreq = [("ring unknown", 1)] , iflavour = zipPlain stdCol ++ zipFancy darkCol , icount = 1 , irarity = [(10, 2)] -- the default very low , iverbHit = "knock" , iweight = 15 , idamage = 0 , iaspects = [HideAs "ring unknown", SetFlag Precious, SetFlag Equipable] , ieffects = [] , idesc = "It looks like an ordinary object, but it's in fact a generator of exceptional effects: adding to some of your natural qualities and subtracting from others." , ikit = [] } ring1 = ringTemplate { ifreq = [("common item", 100), ("any jewelry", 100)] , irarity = [(8, 4)] , iaspects = [ AddSkill SkSpeed $ 1 `dL` 3, AddSkill SkMaxHP (-10) , EqpSlot EqpSlotSpeed ] ++ iaspects ringTemplate } ring2 = ringTemplate { ifreq = [("treasure", 100), ("any jewelry", 100)] , iaspects = [ SetFlag Unique, ELabel "of Rush" , AddSkill SkSpeed $ (1 + 1 `dL` 2) * 2 , AddSkill SkMaxCalm (-40), AddSkill SkMaxHP (-20) , SetFlag Durable, EqpSlot EqpSlotSpeed ] ++ iaspects ringTemplate , idesc = "Roughly-shaped metal with shallow scratches marking it." } ring3 = ringTemplate { ifreq = [("common item", 100), ("any jewelry", 100)] , irarity = [(10, 8)] , iaspects = [ AddSkill SkMaxHP $ 5 + (1 `d` 2 + 1 `dL` 2) * 5 , AddSkill SkMaxCalm $ -30 + (1 `dL` 3) * 5 , EqpSlot EqpSlotMaxHP ] ++ iaspects ringTemplate } ring4 = ringTemplate { ifreq = [("common item", 100), ("any jewelry", 100)] , irarity = [(5, 1), (10, 9)] -- needed after other rings drop Calm , iaspects = [ AddSkill SkMaxCalm $ 20 + (1 `dL` 4) * 5 , EqpSlot EqpSlotMiscBonus ] ++ iaspects ringTemplate , idesc = "Cold, solid to the touch, perfectly round, engraved with solemn, strangely comforting, worn out words." } ring5 = ringTemplate { ifreq = [("common item", 100), ("any jewelry", 100)] , irarity = [(3, 4), (10, 8)] , iaspects = [ AddSkill SkHurtMelee $ (2 + 1 `d` 2 + (1 `dL` 2) * 2 ) * 3 , AddSkill SkMaxHP $ (-3 + 1 `dL` 3) * 10 , EqpSlot EqpSlotHurtMelee ] ++ iaspects ringTemplate } ring6 = ringTemplate -- weak skill per eqp slot, so can be without drawbacks { ifreq = [("common item", 100), ("any jewelry", 100)] , irarity = [(10, 3)] , iaspects = [ AddSkill SkShine 1 , EqpSlot EqpSlotShine ] ++ iaspects ringTemplate , idesc = "A sturdy ring with a large, shining stone." } ring7 = ringTemplate { ifreq = [("ring of opportunity sniper", 1) ] -- only for scenarios , irarity = [(1, 1)] , iaspects = [ ELabel "of opportunity sniper" , AddSkill SkProject 8 , EqpSlot EqpSlotProject ] ++ iaspects ringTemplate } ring8 = ringTemplate { ifreq = [("ring of opportunity grenadier", 1) ] -- only for scenarios , irarity = [(1, 1)] , iaspects = [ ELabel "of opportunity grenadier" , AddSkill SkProject 11 , EqpSlot EqpSlotProject ] ++ iaspects ringTemplate } -- ** Armor armorLeather = ItemKind { isymbol = symbolTorsoArmor , iname = "leather armor" , ifreq = [("common item", 100), ("torso armor", 1)] , iflavour = zipPlain [Brown] , icount = 1 , irarity = [(1, 9), (10, 3)] , iverbHit = "thud" , iweight = 7000 , idamage = 0 , iaspects = [ AddSkill SkHurtMelee (-2) , AddSkill SkArmorMelee $ (2 + 1 `dL` 4) * 5 , AddSkill SkArmorRanged $ (1 + 1 `dL` 2) * 3 , SetFlag Durable, SetFlag Equipable , EqpSlot EqpSlotArmorMelee ] , ieffects = [] , idesc = "A stiff jacket formed from leather boiled in bee wax, padded linen and horse hair. Protects from anything that is not too sharp. Smells much better than the rest of your garment." , ikit = [] } armorMail = armorLeather { iname = "ring armor" , ifreq = [("common item", 100), ("torso armor", 1), ("armor ranged", 50)] , iflavour = zipPlain [Cyan] , irarity = [(6, 9), (10, 3)] , iweight = 12000 , idamage = 0 , iaspects = [ AddSkill SkHurtMelee (-3) , AddSkill SkArmorMelee $ (2 + 1 `dL` 4) * 5 , AddSkill SkArmorRanged $ (4 + 1 `dL` 2) * 3 , AddSkill SkOdor 2 , SetFlag Durable, SetFlag Equipable , EqpSlot EqpSlotArmorRanged ] , ieffects = [] , idesc = "A long shirt with tiny iron rings sewn into it. Discourages foes from attacking your torso, especially with ranged weapons, which can't pierce the rings nor aim between them. The stiff fabric is hard to wash, though." } gloveFencing = ItemKind { isymbol = symbolMiscArmor , iname = "leather glove" , ifreq = [("common item", 100), ("misc armor", 1), ("armor ranged", 50)] , iflavour = zipPlain [White] , icount = 1 , irarity = [(5, 9), (10, 9)] , iverbHit = "flap" , iweight = 100 , idamage = 1 `d` 1 , iaspects = [ AddSkill SkHurtMelee $ (2 + 1 `d` 2 + 1 `dL` 2) * 3 , AddSkill SkArmorRanged $ (1 `dL` 2) * 3 , SetFlag Durable, SetFlag Equipable , EqpSlot EqpSlotHurtMelee , toVelocity 50 ] -- flaps and flutters , ieffects = [] , idesc = "A fencing glove from rough leather ensuring a good grip. Also quite effective in deflecting or even catching slow projectiles." , ikit = [] } gloveGauntlet = gloveFencing { iname = "steel gauntlet" , ifreq = [("common item", 100), ("misc armor", 1)] , iflavour = zipPlain [BrCyan] , irarity = [(1, 9), (10, 3)] , iweight = 300 , idamage = 2 `d` 1 , iaspects = [ AddSkill SkArmorMelee $ (1 + 1 `dL` 4) * 5 , SetFlag Durable, SetFlag Equipable , EqpSlot EqpSlotArmorMelee , toVelocity 50 ] -- flaps and flutters , idesc = "Long leather gauntlet covered in overlapping steel plates." } gloveJousting = gloveFencing { iname = "Tournament Gauntlet" , ifreq = [("common item", 100), ("misc armor", 1)] , iflavour = zipFancy [BrRed] , irarity = [(1, 3), (10, 3)] , iverbHit = "rasp" , iweight = 3000 , idamage = 3 `d` 1 , iaspects = [ SetFlag Unique , AddSkill SkHurtMelee $ (-7 + 1 `dL` 5) * 3 , AddSkill SkArmorMelee $ (2 + 1 `d` 2 + 1 `dL` 2) * 5 , AddSkill SkArmorRanged $ (1 + 1 `dL` 2) * 3 -- very random on purpose and can even be good on occasion -- or when ItemRerolled enough times , SetFlag Durable, SetFlag Equipable , EqpSlot EqpSlotArmorMelee , toVelocity 50 ] -- flaps and flutters , idesc = "Rigid, steel jousting handgear. If only you had a lance. And a horse to carry it all." } hatUshanka = ItemKind { isymbol = symbolMiscArmor , iname = "ushanka hat" , ifreq = [("common item", 100), ("misc armor", 1)] , iflavour = zipPlain [Brown] , icount = 1 , irarity = [(1, 6), (10, 1)] , iverbHit = "tickle" , iweight = 500 , idamage = 0 , iaspects = [ Timeout $ (2 + 1 `d` 2) * 3 , AddSkill SkArmorMelee 5, AddSkill SkHearing (-10) , SetFlag Periodic, SetFlag Durable, SetFlag Equipable , EqpSlot EqpSlotArmorMelee , toVelocity 50 ] -- flaps and flutters , ieffects = [RefillCalm 1] , idesc = "Soft and warm fur. It keeps your ears warm." , ikit = [] } capReinforced = ItemKind { isymbol = symbolMiscArmor , iname = "leather cap" , ifreq = [("common item", 100), ("misc armor", 1)] , iflavour = zipPlain [BrYellow] , icount = 1 , irarity = [(6, 9), (10, 3)] , iverbHit = "cut" , iweight = 1000 , idamage = 0 , iaspects = [ AddSkill SkArmorMelee $ (1 `d` 2) * 5 , AddSkill SkProject 1 -- the brim shields against blinding by light sources, etc. , SetFlag Durable, SetFlag Equipable , EqpSlot EqpSlotProject ] , ieffects = [] , idesc = "Boiled leather with a wide brim. It might soften a blow." , ikit = [] } helmArmored = ItemKind { isymbol = symbolMiscArmor , iname = "bucket helm" , ifreq = [("common item", 100), ("misc armor", 1)] , iflavour = zipPlain [BrCyan] , icount = 1 , irarity = [(6, 9), (10, 3)] , iverbHit = "bounce" , iweight = 2000 , idamage = 0 , iaspects = [ AddSkill SkArmorMelee $ (1 + 1 `dL` 4) * 5 , AddSkill SkArmorRanged $ (2 + 1 `dL` 2) * 3 -- headshot , AddSkill SkHearing (-7), AddSkill SkSight (-1) , AddSkill SkSmell (-5) , SetFlag Durable, SetFlag Equipable , EqpSlot EqpSlotArmorRanged ] , ieffects = [] , idesc = "Blocks out everything, including your senses." , ikit = [] } -- ** Shields -- Shield doesn't protect against ranged attacks to prevent -- micromanagement: walking with shield, melee without. -- Note that AI will pick them up but never wear and will use them at most -- as a way to push itself (but they won't recharge, not being in eqp). -- Being @Meleeable@ they will not be use as weapons either. -- This is OK, using shields smartly is totally beyond AI. buckler = ItemKind { isymbol = symbolShield , iname = "buckler" , ifreq = [("common item", 100)] , iflavour = zipPlain [Blue] , icount = 1 , irarity = [(4, 5)] , iverbHit = "bash" , iweight = 2000 , idamage = 0 -- safe to be used on self , iaspects = [ Timeout $ (3 + 1 `d` 3 - 1 `dL` 3) * 2 , AddSkill SkArmorMelee 40 -- not enough to compensate; won't be in eqp , AddSkill SkHurtMelee (-30) -- too harmful; won't be wielded as weapon , SetFlag MinorEffects, SetFlag Durable, SetFlag Meleeable , EqpSlot EqpSlotArmorMelee , toVelocity 50 ] -- unwieldy to throw , ieffects = [PushActor (ThrowMod 200 50 1)] -- 1 step, fast , idesc = "Heavy and unwieldy. Absorbs a percentage of melee damage, both dealt and sustained. Too small to intercept projectiles with. May serve as a counterweight to suddenly push forth." , ikit = [] } shield = buckler { iname = "shield" , irarity = [(8, 4)] -- the stronger variants add to total probability , iflavour = zipPlain [Green] , iweight = 4000 , idamage = 4 `d` 1 , iaspects = [ Timeout $ (3 + 1 `d` 3 - 1 `dL` 3) * 4 , AddSkill SkArmorMelee 80 -- not enough to compensate; won't be in eqp , AddSkill SkHurtMelee (-70) -- too harmful; won't be wielded as weapon , SetFlag MinorEffects, SetFlag Durable, SetFlag Meleeable , EqpSlot EqpSlotArmorMelee , toVelocity 50 ] -- unwieldy to throw , ieffects = [PushActor (ThrowMod 400 50 1)] -- 2 steps, fast , idesc = "Large and unwieldy. Absorbs a percentage of melee damage, both dealt and sustained. Too heavy to intercept projectiles with. Useful to push foes out of the way." } shield2 = shield { ifreq = [("common item", 3 * 3)] -- very low base rarity , iweight = 5000 , idamage = 8 `d` 1 , idesc = "A relic of long-past wars, heavy and with a central spike." } shield3 = shield2 { ifreq = [("common item", 1 * 3)] -- very low base rarity , iweight = 6000 , idamage = 12 `d` 1 } -- ** Weapons dagger = ItemKind { isymbol = symbolEdged , iname = "dagger" , ifreq = [("common item", 100), ("starting weapon", 200)] , iflavour = zipPlain [BrCyan] , icount = 1 , irarity = [(1, 40), (4, 1)] , iverbHit = "cut" , iweight = 800 , idamage = 6 `d` 1 , iaspects = [ Timeout 2 , AddSkill SkHurtMelee $ (-1 + 1 `d` 2 + 1 `dL` 2) * 3 , AddSkill SkArmorMelee $ (1 `d` 2) * 5 -- very common, so don't make too random , SetFlag Durable, SetFlag Meleeable , EqpSlot EqpSlotWeaponFast , toVelocity 40 ] -- ensuring it hits with the tip costs speed , ieffects = [] , idesc = "A short dagger for thrusting and parrying blows. Does not penetrate deeply, but is quick to move and hard to block. Especially useful in conjunction with a larger weapon." , ikit = [] } daggerDropBestWeapon = dagger { iname = "Double Dagger" , ifreq = [("treasure", 20)] , irarity = [(1, 3), (10, 3)] , iaspects = [SetFlag Unique] ++ iaspects dagger , ieffects = [DropBestWeapon, Yell] -- powerful and low timeout, but makes -- noise and useless against stupid foes , idesc = "A double dagger that a focused fencer can use to catch and twist away an opponent's blade." } hammerTemplate = ItemKind { isymbol = symbolHafted , iname = "war hammer" , ifreq = [("hammer unknown", 1)] , iflavour = zipFancy [BrMagenta] -- avoid "pink" , icount = 1 , irarity = [(5, 20), (8, 1)] , iverbHit = "club" , iweight = 1600 , idamage = 8 `d` 1 -- we are lying about the dice here, but the dungeon -- is too small and the extra-dice hammers too rare -- to subdivide this identification class by dice , iaspects = [ HideAs "hammer unknown" , SetFlag Durable, SetFlag Meleeable , toVelocity 40 ] -- ensuring it hits with the tip costs speed , ieffects = [] , idesc = "It may not cause extensive wounds, but neither does it harmlessly glance off heavy armour as blades and polearms tend to. There are so many shapes and types, some looking more like tools than weapons, that at a glance you can't tell what a particular specimen does. It's obvious, though, that any of them requires some time to recover after a swing." -- if it's really the average kind, the weak kind, the description stays; if not, it's replaced with one of the descriptions below at identification time , ikit = [] } hammer1 = hammerTemplate { ifreq = [("common item", 100), ("starting weapon", 70)] , iaspects = [Timeout 5, EqpSlot EqpSlotWeaponBig] ++ iaspects hammerTemplate } hammer2 = hammerTemplate { ifreq = [("common item", 20), ("starting weapon", 7)] , iverbHit = "gouge" , iaspects = [Timeout 3, EqpSlot EqpSlotWeaponFast] ++ iaspects hammerTemplate , idesc = "Upon closer inspection, this hammer turns out particularly handy and well balanced, with one thick and sturdy and two long and sharp points compensating the modest size." } hammer3 = hammerTemplate { ifreq = [("common item", 3), ("starting weapon", 1)] , iverbHit = "puncture" , iweight = 2400 -- weight gives it away , idamage = 12 `d` 1 , iaspects = [ Timeout 12 -- balance, or @DupItem@ would break the game , EqpSlot EqpSlotWeaponBig] ++ delete (HideAs "hammer unknown") (iaspects hammerTemplate) , idesc = "This hammer sports a long metal handle that increases the momentum of the sharpened head's swing, at the cost of long recovery." } hammerParalyze = hammerTemplate { iname = "Brute Hammer" , ifreq = [("treasure", 20)] , irarity = [(5, 1), (8, 6)] , iaspects = [ SetFlag Unique , Timeout 5 , EqpSlot EqpSlotWeaponBig ] ++ iaspects hammerTemplate , ieffects = [Paralyze 10] , idesc = "A huge shapeless lump of meteorite iron alloy on a sturdy pole. Nobody remains standing when this head connects." } hammerSpark = hammerTemplate { iname = "Grand Smithhammer" , ifreq = [("treasure", 20)] , irarity = [(5, 1), (8, 6)] , iweight = 2400 -- weight gives it away , idamage = 12 `d` 1 , iaspects = [ SetFlag Unique , Timeout 10 , EqpSlot EqpSlotWeaponBig , AddSkill SkShine 3] ++ delete (HideAs "hammer unknown") (iaspects hammerTemplate) , ieffects = [Explode "spark"] -- we can't use a focused explosion, because it would harm the hammer -- wielder as well, unlike this one , idesc = "Smiths of old wielded this heavy hammer and its sparks christened many a potent blade." } sword = ItemKind { isymbol = symbolEdged , iname = "sword" , ifreq = [("common item", 100), ("starting weapon", 30)] , iflavour = zipPlain [BrBlue] , icount = 1 , irarity = [(4, 1), (6, 20)] , iverbHit = "slash" , iweight = 2000 , idamage = 10 `d` 1 , iaspects = [ Timeout 7 , SetFlag Durable, SetFlag Meleeable , EqpSlot EqpSlotWeaponBig , toVelocity 40 ] -- ensuring it hits with the tip costs speed , ieffects = [] , idesc = "Difficult to master; deadly when used effectively. The steel is particularly hard and keen, but rusts quickly without regular maintenance." , ikit = [] } swordImpress = sword { iname = "Master's Sword" , ifreq = [("treasure", 20)] , irarity = [(5, 1), (8, 6)] , iaspects = [SetFlag Unique] ++ iaspects sword , ieffects = [Impress] , idesc = "A particularly well-balance blade, lending itself to impressive shows of fencing skill." } swordNullify = sword { iname = "Gutting Sword" , ifreq = [("treasure", 20)] , iverbHit = "pierce" , irarity = [(5, 1), (8, 6)] , iaspects = [SetFlag Unique, Timeout 3, EqpSlot EqpSlotWeaponFast] ++ (iaspects sword \\ [Timeout 7, EqpSlot EqpSlotWeaponBig]) , ieffects = [ DropItem 1 maxBound COrgan "condition" , RefillCalm (-10) , Yell ] , idesc = "Cold, thin blade that pierces deeply and sends its victim into abrupt, sobering shock." } halberd = ItemKind { isymbol = symbolPolearm , iname = "war scythe" , ifreq = [("common item", 100), ("starting weapon", 20)] , iflavour = zipPlain [BrYellow] , icount = 1 , irarity = [(5, 0), (8, 15)] , iverbHit = "impale" , iweight = 3000 , idamage = 12 `d` 1 , iaspects = [ Timeout 10 , AddSkill SkHurtMelee $ (-5 + 1 `dL` 3) * 5 -- useless against armor at game start , AddSkill SkArmorMelee 20 , SetFlag Durable, SetFlag Meleeable , EqpSlot EqpSlotWeaponBig , toVelocity 20 ] -- not balanced , ieffects = [] , idesc = "An improvised weapon made of scythe's blade attached to a long pole. Not often one succeeds in making enough space to swing it freely, but even when stuck between terrain obstacles it blocks approaches effectively and makes using other weapons difficult, both by friends and foes." , ikit = [] } halberd2 = halberd { iname = "halberd" , ifreq = [("common item", 3 * 2), ("starting weapon", 1)] , iweight = 4000 , iaspects = [AddSkill SkHurtMelee $ (-6 + 1 `dL` 4) * 10] -- balance, or @DupItem@ would break the game; -- together with @RerollItem@, it's allowed to, though ++ (iaspects halberd \\ [AddSkill SkHurtMelee $ (-6 + 1 `dL` 4) * 5]) , idamage = 18 `d` 1 , idesc = "A long haft with a sharp blade. Designed and refined for war." } halberd3 = halberd2 { iname = "bardiche" , ifreq = [("common item", 1 * 2)] -- compensating for low base rarity , iverbHit = "carve" , iweight = 5000 , idamage = 24 `d` 1 , idesc = "The reach of a spear but the edge of an axe." } halberdPushActor = halberd { iname = "Swiss Halberd" , ifreq = [("treasure", 20)] , irarity = [(7, 0), (9, 15)] , iaspects = [SetFlag Unique] ++ iaspects halberd , ieffects = [PushActor (ThrowMod 200 100 1)] -- 2 steps, slow , idesc = "A versatile polearm, with great reach and leverage. Foes are held at a distance." } -- ** Wands wandTemplate = ItemKind { isymbol = symbolWand , iname = "wand" , ifreq = [("wand unknown", 1)] , iflavour = zipFancy brightCol , icount = 1 , irarity = [] , iverbHit = "club" , iweight = 300 , idamage = 0 , iaspects = [ HideAs "wand unknown" , AddSkill SkShine 1, AddSkill SkSpeed (-1) -- pulsing with power, distracts , SetFlag Durable , toVelocity 125 ] -- magic , ieffects = [] , idesc = "Buzzing with dazzling light that shines even through appendages that handle it." -- will have math flavour , ikit = [] } wand1 = wandTemplate { ifreq = [] , ieffects = [] -- will be: emit a cone of sound shrapnel that makes enemy cover his ears and so drop '|' and '{' } -- ** Treasure gemTemplate = ItemKind { isymbol = symbolGold , iname = "gem" , ifreq = [("gem unknown", 1), ("valuable", 100)] , iflavour = zipPlain $ delete BrYellow brightCol -- natural, so not fancy , icount = 1 , irarity = [(3, 0), (10, 24)] , iverbHit = "tap" , iweight = 50 , idamage = 0 , iaspects = [HideAs "gem unknown", SetFlag Precious] , ieffects = [] , idesc = "Useless, and still worth around 100 gold each. Would gems of thought and pearls of artful design be valued that much in our age of Science and Progress!" , ikit = [] } gem1 = gemTemplate { ifreq = [ ("treasure", 100), ("gem", 100), ("any jewelry", 100) , ("valuable", 100) ] , irarity = [(3, 0), (6, 12), (10, 8)] , iaspects = [AddSkill SkShine 1, AddSkill SkSpeed (-1)] -- reflects strongly, distracts; so it glows in the dark, -- is visible on dark floor, but not too tempting to wear ++ iaspects gemTemplate } gem2 = gem1 { ifreq = [ ("treasure", 100), ("gem", 100), ("any jewelry", 100) , ("valuable", 100) ] , irarity = [(5, 0), (7, 25), (10, 8)] } gem3 = gem1 { ifreq = [ ("treasure", 100), ("gem", 100), ("any jewelry", 100) , ("valuable", 100) ] , irarity = [(7, 0), (8, 20), (10, 8)] } gem4 = gem1 { ifreq = [ ("treasure", 100), ("gem", 100), ("any jewelry", 100) , ("valuable", 100) ] , irarity = [(9, 0), (10, 70)] } gem5 = gem1 { isymbol = symbolSpecial , iname = "elixir" , ifreq = [ ("treasure", 100), ("gem", 25), ("any jewelry", 10) , ("valuable", 100) ] , iflavour = zipPlain [BrYellow] , irarity = [(1, 40), (10, 10)] , iaspects = [ ELabel "of youth", SetFlag Precious -- not hidden , AddSkill SkOdor (-1) ] , ieffects = [RefillCalm 10, RefillHP 40] , idesc = "A crystal vial of amber liquid, supposedly granting eternal youth and fetching 100 gold per piece. The main effect seems to be mild euphoria, but it admittedly smells good and heals minor ailments rather well." } currencyTemplate = ItemKind { isymbol = symbolGold , iname = "gold piece" , ifreq = [("currency unknown", 1), ("valuable", 1)] , iflavour = zipPlain [BrYellow] , icount = 10 + 1 `d` 20 + 1 `dL` 20 , irarity = [(1, 25), (10, 10)] , iverbHit = "tap" , iweight = 31 , idamage = 0 , iaspects = [HideAs "currency unknown", SetFlag Precious] , ieffects = [] , idesc = "Reliably valuable in every civilized plane of existence." , ikit = [] } currency = currencyTemplate { ifreq = [("treasure", 100), ("currency", 100), ("valuable", 1)] , iaspects = [AddSkill SkShine 1, AddSkill SkSpeed (-1)] ++ iaspects currencyTemplate } -- * LambdaHack-specific items -- ** Clothing smokingJacket = ItemKind { isymbol = symbolClothes , iname = "smoking jacket" , ifreq = [("common item", 100), ("misc clothing", 1), ("chic gear", 100)] , iflavour = zipFancy [BrGreen] , icount = 1 , irarity = [(1, 9), (10, 3)] , iverbHit = "stroke" , iweight = 5000 , idamage = 0 , iaspects = [ Timeout $ (1 `d` 2) * 3 , AddSkill SkSpeed 2 , AddSkill SkOdor 2 , SetFlag Periodic, SetFlag Durable, SetFlag Equipable , EqpSlot EqpSlotSpeed ] , ieffects = [RefillCalm 1] , idesc = "Wearing this velvet jacket, anyone would look dashing." , ikit = [] } LambdaHack-0.9.5.0/GameDefinition/Content/ItemKindActor.hs0000644000000000000000000005777007346545000021370 0ustar0000000000000000-- | Actor (or rather actor body trunk) definitions. module Content.ItemKindActor ( actors ) where import Prelude () import Game.LambdaHack.Core.Prelude import Game.LambdaHack.Content.ItemKind import Game.LambdaHack.Definition.Ability import Game.LambdaHack.Definition.Color import Game.LambdaHack.Definition.Defs import Game.LambdaHack.Definition.Flavour actors :: [ItemKind] actors = [warrior, warrior2, warrior3, warrior4, warrior5, scout, ranger, escapist, ambusher, soldier, civilian, civilian2, civilian3, civilian4, civilian5, eye, fastEye, nose, elbow, torsor, goldenJackal, griffonVulture, skunk, armadillo, gilaMonster, rattlesnake, hyena, komodoDragon, alligator, rhinoceros, beeSwarm, hornetSwarm, thornbush] -- LH-specific ++ [geyserBoiling, geyserArsenic, geyserSulfur] warrior, warrior2, warrior3, warrior4, warrior5, scout, ranger, escapist, ambusher, soldier, civilian, civilian2, civilian3, civilian4, civilian5, eye, fastEye, nose, elbow, torsor, goldenJackal, griffonVulture, skunk, armadillo, gilaMonster, rattlesnake, hyena, komodoDragon, alligator, rhinoceros, beeSwarm, hornetSwarm, thornbush :: ItemKind -- LH-specific geyserBoiling, geyserArsenic, geyserSulfur :: ItemKind -- Note that the actors that appear in the crawl scenario should -- be generated with at most ordinary ammo. Otherwise, farming them -- may be rational though boring endeavour. Any exceptions to that -- should be well thought of. E.g., unique guaranteed items on bosses -- are safe, just as restricted kinds of weak items. -- * Hunams warrior = ItemKind { isymbol = '@' , iname = "warrior" -- modified if initial actors in hero faction , ifreq = [("hero", 100), ("mobile", 1)] , iflavour = zipPlain [BrWhite] , icount = 1 , irarity = [(1, 5)] , iverbHit = "thud" , iweight = 80000 , idamage = 0 , iaspects = [ AddSkill SkMaxHP 80 -- partially from clothes and first aid , AddSkill SkMaxCalm 70 , AddSkill SkSpeed 20 , AddSkill SkNocto 2 , AddSkill SkWait 1 -- can lurk , AddSkill SkProject 2 -- can lob , AddSkill SkApply 2 -- can even apply periodic items , AddSkill SkOdor 1 , SetFlag Durable ] , ieffects = [] , idesc = "" -- "A hardened veteran of combat." , ikit = [ ("fist", COrgan), ("foot", COrgan) , ("eye 6", COrgan), ("ear 3", COrgan) , ("sapient brain", COrgan) ] } warrior2 = warrior { iname = "adventurer" -- , idesc = "" } warrior3 = warrior { iname = "blacksmith" -- , idesc = "" } warrior4 = warrior { iname = "forester" -- , idesc = "" } warrior5 = warrior { iname = "scientist" -- , idesc = "" } scout = warrior { iname = "scout" , ifreq = [("scout hero", 100), ("mobile", 1)] , ikit = ikit warrior ++ [ ("add sight", CEqp) , ("armor ranged", CEqp) , ("add nocto 1", CInv) ] -- , idesc = "" } ranger = warrior { iname = "ranger" , ifreq = [("ranger hero", 100), ("mobile", 1)] , ikit = ikit warrior ++ [ ("armor ranged", CEqp) , ("weak arrow", CInv) ] -- , idesc = "" } escapist = warrior { iname = "escapist" , ifreq = [("escapist hero", 100), ("mobile", 1)] , ikit = ikit warrior ++ [ ("add sight", CEqp) , ("armor ranged", CEqp) , ("weak arrow", CInv) -- mostly for probing , ("light source", CInv) , ("wooden torch", CInv) , ("blanket", CInv) ] -- , idesc = "" } ambusher = warrior { iname = "ambusher" , ifreq = [("ambusher hero", 100), ("mobile", 1)] , ikit = ikit warrior -- dark and numerous, so more kit without exploring ++ [ ("ring of opportunity sniper", CEqp) , ("any arrow", CSha) , ("weak arrow", CInv) , ("explosive", CSha) , ("light source", CEqp) , ("wooden torch", CInv) ] -- , idesc = "" } soldier = warrior { iname = "soldier" , ifreq = [("soldier hero", 100), ("mobile", 1)] , ikit = ikit warrior ++ [ ("starting weapon", CEqp) , ("explosive", CSha) ] -- , idesc = "" } civilian = warrior { iname = "clerk" , ifreq = [("civilian", 100), ("mobile", 1)] , iflavour = zipPlain [BrBlack] -- , idesc = "" } civilian2 = civilian { iname = "hairdresser" -- , idesc = "" } civilian3 = civilian { iname = "lawyer" -- , idesc = "" } civilian4 = civilian { iname = "peddler" -- , idesc = "" } civilian5 = civilian { iname = "tax collector" -- , idesc = "" } -- * Monsters -- They have bright colours, because they are not natural. eye = ItemKind { isymbol = 'e' , iname = "reducible eye" , ifreq = [ ("monster", 100), ("mobile", 1) , ("mobile monster", 100), ("scout monster", 10) ] , iflavour = zipFancy [BrRed] , icount = 1 , irarity = [(3, 0), (4, 10), (10, 8)] , iverbHit = "thud" , iweight = 80000 , idamage = 0 , iaspects = [ AddSkill SkMaxHP 16, AddSkill SkMaxCalm 70 , AddSkill SkSpeed 20, AddSkill SkNocto 2 , AddSkill SkAggression 1 , AddSkill SkProject 2 -- can lob , AddSkill SkApply 1 -- can even use cultural artifacts , SetFlag Durable ] , ieffects = [] , idesc = "Under your stare, it reduces to the bits that define its essence. Under introspection, the bits slow down and solidify into an arbitrary form again. It must be huge inside, for holographic principle to manifest so overtly." -- holographic principle is an anachronism for XIX or most of XX century, but "the cosmological scale effects" is too weak , ikit = [ ("lash", COrgan), ("pupil", COrgan) -- at least one non-timed , ("sapient brain", COrgan) ] -- no hearing, it's all eyes } fastEye = ItemKind { isymbol = 'j' , iname = "injective jaw" , ifreq = [ ("monster", 100), ("mobile", 1) , ("mobile monster", 100), ("scout monster", 60) ] , iflavour = zipFancy [BrBlue] , icount = 1 , irarity = [(3, 0), (4, 6), (10, 12)] , iverbHit = "thud" , iweight = 80000 , idamage = 0 , iaspects = [ AddSkill SkMaxHP 5, AddSkill SkMaxCalm 70 , AddSkill SkSpeed 30, AddSkill SkNocto 2 , AddSkill SkAggression 1 , SetFlag Durable ] , ieffects = [] , idesc = "Hungers but never eats. Bites but never swallows. Burrows its own image through, but never carries anything back." -- rather weak: not about injective objects, but puny, concrete, injective functions --- where's the madness in that? , ikit = [ ("tooth", COrgan), ("lip", COrgan) , ("speed gland 10", COrgan) , ("vision 6", COrgan), ("ear 3", COrgan) , ("sapient brain", COrgan) ] } nose = ItemKind -- depends solely on smell { isymbol = 'n' , iname = "point-free nose" , ifreq = [("monster", 100), ("mobile", 1), ("mobile monster", 100)] , iflavour = zipFancy [BrGreen] , icount = 1 , irarity = [(3, 0), (4, 5), (10, 7)] , iverbHit = "thud" , iweight = 80000 , idamage = 0 , iaspects = [ AddSkill SkMaxHP 30, AddSkill SkMaxCalm 30 , AddSkill SkSpeed 18, AddSkill SkNocto 2 , AddSkill SkAggression 1 , AddSkill SkProject (-1) -- can't project , SetFlag Durable ] , ieffects = [] , idesc = "No mouth, yet it devours everything around, constantly sniffing itself inward; pure movement structure, no constant point to focus one's maddened gaze on." , ikit = [ ("nose tip", COrgan), ("lip", COrgan) , ("nostril", COrgan) , ("sapient brain", COrgan) ] -- no sight nor hearing } elbow = ItemKind { isymbol = 'e' , iname = "commutative elbow" , ifreq = [ ("monster", 100), ("mobile", 1) , ("mobile monster", 100), ("scout monster", 30) ] , iflavour = zipFancy [BrMagenta] , icount = 1 , irarity = [(3, 0), (4, 1), (10, 12)] , iverbHit = "thud" , iweight = 80000 , idamage = 0 , iaspects = [ AddSkill SkMaxHP 8, AddSkill SkMaxCalm 80 , AddSkill SkSpeed 20, AddSkill SkNocto 2 , AddSkill SkProject 2 -- can lob , AddSkill SkApply 1 -- can even use cultural artifacts , AddSkill SkMelee (-1) , SetFlag Durable ] , ieffects = [] , idesc = "An arm strung like a bow. A few edges, but none keen enough. A few points, but none piercing. Deadly objects zip out of the void." , ikit = [ ("speed gland 5", COrgan), ("bark", COrgan) , ("vision 12", COrgan), ("ear 8", COrgan) -- too powerful to get stronger sight , ("sapient brain", COrgan) , ("any arrow", CSha), ("any arrow", CInv) , ("weak arrow", CInv), ("weak arrow", CInv) ] } torsor = ItemKind { isymbol = 'T' , iname = "Forgetful Torsor" , ifreq = [("monster", 100), ("mobile", 1)] , iflavour = zipFancy [BrCyan] , icount = 1 , irarity = [(9, 0), (10, 1000)] -- unique , iverbHit = "thud" , iweight = 80000 , idamage = 0 , iaspects = [ SetFlag Unique , AddSkill SkMaxHP 300, AddSkill SkMaxCalm 100 , AddSkill SkSpeed 15, AddSkill SkNocto 2 , AddSkill SkAggression 3 , AddSkill SkProject 2 -- can lob , AddSkill SkApply 1 -- can even use cultural artifacts , AddSkill SkAlter (-1) -- can't exit the gated level; a boss, -- but can dig rubble, ice , SetFlag Durable ] , ieffects = [] , idesc = "A principal homogeneous manifold, that acts freely and with enormous force, but whose stabilizers are trivial, making it rather helpless without a support group." , ikit = [ ("right torsion", COrgan), ("left torsion", COrgan) , ("pupil", COrgan), ("tentacle", COrgan) , ("ear 8", COrgan) , ("sapient brain", COrgan) , ("gem", CInv), ("gem", CInv), ("gem", CInv), ("gem", CInv) ] } -- "ground x" --- for immovable monster that can only tele or prob travel -- pullback -- skeletal -- * Animals -- They need rather strong melee, because they don't use items. -- They have dull colors, except for yellow, because there is no dull variant. goldenJackal = ItemKind -- basically a much smaller and slower hyena { isymbol = 'j' , iname = "golden jackal" , ifreq = [ ("animal", 100), ("mobile", 1), ("mobile animal", 100) , ("scavenger", 50) ] , iflavour = zipPlain [BrYellow] , icount = 1 , irarity = [(1, 4), (10, 2)] , iverbHit = "thud" , iweight = 13000 , idamage = 0 , iaspects = [ AddSkill SkMaxHP 15, AddSkill SkMaxCalm 70 , AddSkill SkSpeed 24, AddSkill SkNocto 2 , SetFlag Durable ] , ieffects = [] , idesc = "An opportunistic predator, feeding on carrion and the weak." , ikit = [ ("small jaw", COrgan) , ("eye 6", COrgan), ("nostril", COrgan), ("ear 8", COrgan) , ("animal brain", COrgan) ] } griffonVulture = ItemKind { isymbol = 'v' , iname = "griffon vulture" , ifreq = [ ("animal", 100), ("mobile", 1), ("mobile animal", 100) , ("scavenger", 30) ] , iflavour = zipPlain [BrYellow] , icount = 1 , irarity = [(1, 3), (10, 3)] , iverbHit = "thud" , iweight = 13000 , idamage = 0 , iaspects = [ AddSkill SkMaxHP 15, AddSkill SkMaxCalm 80 -- enough Calm to summon twice only if not attacked at all; -- loses a lot of sight after summoning , AddSkill SkSpeed 22, AddSkill SkNocto 2 , AddSkill SkAlter (-2) -- can't use normal stairs nor doors , AddSkill SkFlying 10 -- flies slowly, but far , SetFlag Durable ] -- Animals don't have leader, usually, so even if only one on level, -- it pays the communication overhead, so the speed is higher to get -- them on par with human leaders moving solo. Common random double moves, -- on either side, are just too bothersome. , ieffects = [] , idesc = "It soars high above, searching for vulnerable prey." , ikit = [ ("screeching beak", COrgan) -- in reality it grunts and hisses , ("small claw", COrgan) , ("eye 8", COrgan), ("ear 8", COrgan) -- can't shoot, so strong sight is OK , ("animal brain", COrgan) ] } skunk = ItemKind { isymbol = 's' , iname = "hog-nosed skunk" , ifreq = [("animal", 100), ("mobile", 1), ("mobile animal", 100)] , iflavour = zipPlain [White] , icount = 1 , irarity = [(1, 8), (5, 1)] , iverbHit = "thud" , iweight = 4000 , idamage = 0 , iaspects = [ AddSkill SkMaxHP 13, AddSkill SkMaxCalm 30 , AddSkill SkSpeed 22, AddSkill SkNocto 2 , AddSkill SkAlter (-2) -- can't use stairs nor doors , AddSkill SkOdor 5 -- and no smell skill, to let it leave smell , SetFlag Durable ] , ieffects = [] , idesc = "Its only defence is the terrible stench." , ikit = [ ("scent gland", COrgan) , ("small claw", COrgan), ("snout", COrgan) , ("eye 3", COrgan), ("ear 6", COrgan) , ("animal brain", COrgan) ] } armadillo = ItemKind { isymbol = 'a' , iname = "giant armadillo" , ifreq = [("animal", 100), ("mobile", 1), ("mobile animal", 100)] , iflavour = zipPlain [Brown] , icount = 1 , irarity = [(1, 7)] , iverbHit = "thud" , iweight = 80000 , idamage = 0 , iaspects = [ AddSkill SkMaxHP 13, AddSkill SkMaxCalm 30 , AddSkill SkSpeed 20, AddSkill SkNocto 2 , AddSkill SkAlter (-2) -- can't use normal stairs nor doors , SetFlag Durable ] , ieffects = [] , idesc = "When threatened, it rolls into a ball." , ikit = [ ("hooked claw", COrgan), ("snout", COrgan) , ("armored skin", COrgan), ("armored skin", COrgan) , ("eye 3", COrgan), ("nostril", COrgan), ("ear 6", COrgan) , ("animal brain", COrgan) ] } gilaMonster = ItemKind { isymbol = 'g' , iname = "Gila monster" , ifreq = [("animal", 100), ("mobile", 1), ("mobile animal", 100)] , iflavour = zipPlain [Magenta] , icount = 1 , irarity = [(2, 5), (10, 2)] , iverbHit = "thud" , iweight = 80000 , idamage = 0 , iaspects = [ AddSkill SkMaxHP 15, AddSkill SkMaxCalm 50 , AddSkill SkSpeed 18, AddSkill SkNocto 2 , AddSkill SkAlter (-2) -- can't use normal stairs nor doors , SetFlag Durable ] , ieffects = [] , idesc = "Numbing venom ensures that even the fastest prey has no escape." , ikit = [ ("venom tooth", COrgan), ("small claw", COrgan) , ("eye 3", COrgan), ("nostril", COrgan), ("ear 6", COrgan) , ("animal brain", COrgan) ] } rattlesnake = ItemKind { isymbol = 's' , iname = "rattlesnake" , ifreq = [("animal", 100), ("mobile", 1), ("mobile animal", 100)] , iflavour = zipPlain [Brown] , icount = 1 , irarity = [(5, 1), (10, 7)] , iverbHit = "thud" , iweight = 80000 , idamage = 0 , iaspects = [ AddSkill SkMaxHP 28, AddSkill SkMaxCalm 60 , AddSkill SkSpeed 16, AddSkill SkNocto 2 , AddSkill SkAlter (-2) -- can't use normal stairs nor doors , SetFlag Durable ] , ieffects = [] , idesc = "Beware its rattle - it serves as a warning of an agonising death." , ikit = [ ("venom fang", COrgan) -- when on cooldown, it's weaponless , ("rattle", COrgan) , ("eye 3", COrgan), ("nostril", COrgan), ("ear 6", COrgan) , ("animal brain", COrgan) ] } hyena = ItemKind { isymbol = 'h' , iname = "spotted hyena" , ifreq = [ ("animal", 100), ("mobile", 1), ("mobile animal", 100) , ("scavenger", 20) ] , iflavour = zipPlain [BrYellow] , icount = 1 , irarity = [(4, 1), (10, 5)] -- gets summoned often, so low base rarity , iverbHit = "thud" , iweight = 60000 , idamage = 0 , iaspects = [ AddSkill SkMaxHP 23, AddSkill SkMaxCalm 70 , AddSkill SkSpeed 32, AddSkill SkNocto 2 , SetFlag Durable ] , ieffects = [] , idesc = "Skulking in the shadows, waiting for easy prey." , ikit = [ ("jaw", COrgan) , ("eye 6", COrgan), ("nostril", COrgan), ("ear 8", COrgan) , ("animal brain", COrgan) ] } komodoDragon = ItemKind { isymbol = 'k' , iname = "Komodo dragon" , ifreq = [("animal", 100), ("mobile", 1), ("mobile animal", 100)] , iflavour = zipPlain [BrRed] -- speedy, so bright red , icount = 1 , irarity = [(9, 0), (10, 11)] , iverbHit = "thud" , iweight = 80000 , idamage = 0 , iaspects = [ AddSkill SkMaxHP 40, AddSkill SkMaxCalm 60 , AddSkill SkSpeed 17, AddSkill SkNocto 2 , AddSkill SkAggression 1 -- match the description , SetFlag Durable ] , ieffects = [] , idesc = "Larger and more aggressive than any other lizard, but as easily recovering from wounds as its lesser cousins." , ikit = [ ("large tail", COrgan), ("jaw", COrgan) , ("hooked claw", COrgan) , ("speed gland 5", COrgan), ("armored skin", COrgan) , ("eye 3", COrgan), ("nostril", COrgan), ("ear 3", COrgan) , ("animal brain", COrgan) ] } alligator = ItemKind { isymbol = 'a' , iname = "alligator" , ifreq = [("animal", 100), ("mobile", 1), ("mobile animal", 100)] , iflavour = zipPlain [Blue] , icount = 1 , irarity = [(9, 0), (10, 12)] , iverbHit = "thud" , iweight = 80000 , idamage = 0 , iaspects = [ AddSkill SkMaxHP 55, AddSkill SkMaxCalm 70 , AddSkill SkSpeed 18, AddSkill SkNocto 2 , AddSkill SkSwimming 100 -- swims better than walks , SetFlag Durable ] , ieffects = [] , idesc = "An armored predator from the dawn of time. You better not get within its reach." , ikit = [ ("huge tail", COrgan), ("large jaw", COrgan) , ("small claw", COrgan) , ("armored skin", COrgan) , ("eye 6", COrgan), ("ear 8", COrgan) , ("animal brain", COrgan) ] } rhinoceros = ItemKind { isymbol = 'R' , iname = "Maddened Rhinoceros" , ifreq = [("animal", 100), ("mobile", 1)] , iflavour = zipPlain [Brown] , icount = 1 , irarity = [(2, 0), (3, 1000), (4, 0)] -- unique , iverbHit = "thud" , iweight = 80000 , idamage = 0 , iaspects = [ SetFlag Unique , AddSkill SkMaxHP 90, AddSkill SkMaxCalm 60 , AddSkill SkSpeed 27, AddSkill SkNocto 2 , AddSkill SkAggression 2 , AddSkill SkAlter (-1) -- can't use normal stairs nor dig; -- a weak miniboss , SetFlag Durable ] , ieffects = [] , idesc = "The last of its kind. Blind with rage. Charges at deadly speed." , ikit = [ ("rhino horn", COrgan), ("snout", COrgan) , ("armored skin", COrgan) , ("eye 3", COrgan), ("ear 8", COrgan) , ("animal brain", COrgan) ] } -- * Non-animal animals beeSwarm = ItemKind { isymbol = 'b' , iname = "bee swarm" , ifreq = [("animal", 100), ("mobile", 1)] , iflavour = zipPlain [Brown] , icount = 1 , irarity = [(1, 3), (10, 4)] , iverbHit = "buzz" , iweight = 1000 , idamage = 0 , iaspects = [ AddSkill SkMaxHP 8, AddSkill SkMaxCalm 60 , AddSkill SkSpeed 30, AddSkill SkNocto 2 -- armor in sting , AddSkill SkAlter (-2) -- can't use normal stairs nor doors , AddSkill SkWait (-2) -- can't brace, sleep and lurk , AddSkill SkFlying 10 -- flies slowly, but far , SetFlag Durable ] , ieffects = [] , idesc = "Every bee would die for the queen." , ikit = [ ("bee sting", COrgan) -- weaponless when it's used up , ("vision 6", COrgan), ("ear 6", COrgan) , ("insect mortality", COrgan), ("animal brain", COrgan) ] } hornetSwarm = ItemKind { isymbol = 'h' , iname = "hornet swarm" , ifreq = [("animal", 100), ("mobile", 1), ("mobile animal", 100)] , iflavour = zipPlain [Magenta] , icount = 1 , irarity = [(5, 1), (10, 4)] -- should be many, because die after a time , iverbHit = "buzz" , iweight = 1000 , idamage = 0 , iaspects = [ AddSkill SkArmorMelee 80, AddSkill SkArmorRanged 40 , AddSkill SkMaxHP 8, AddSkill SkMaxCalm 70 , AddSkill SkSpeed 30, AddSkill SkNocto 2 , AddSkill SkAlter (-2) -- can't use normal stairs nor doors , AddSkill SkWait (-2) -- can't brace, sleep and lurk , AddSkill SkFlying 10 -- flies slowly, but far , SetFlag Durable ] , ieffects = [] , idesc = "A vicious cloud of stings and hate." , ikit = [ ("sting", COrgan) -- when on cooldown, it's weaponless , ("vision 6", COrgan), ("ear 6", COrgan) , ("insect mortality", COrgan), ("animal brain", COrgan) ] } thornbush = ItemKind { isymbol = 't' , iname = "thornbush" , ifreq = [("animal", 20), ("immobile animal", 20)] , iflavour = zipPlain [Brown] , icount = 1 , irarity = [(1, 13)] , iverbHit = "scrape" , iweight = 80000 , idamage = 0 , iaspects = [ AddSkill SkMaxHP 20, AddSkill SkMaxCalm 999 , AddSkill SkSpeed 22, AddSkill SkNocto 2 , AddSkill SkWait 1, AddSkill SkMelee 1 -- no brain , SetFlag Durable ] , ieffects = [] , idesc = "Each branch bears long, curved thorns." , ikit = [ ("thorn", COrgan) -- after all run out, it's weaponless , ("bark", COrgan) ] } geyserBoiling = ItemKind { isymbol = 'g' , iname = "geyser" , ifreq = [("animal", 8), ("immobile animal", 30)] , iflavour = zipPlain [Blue] , icount = 1 , irarity = [(1, 10), (10, 6)] , iverbHit = "thud" , iweight = 80000 , idamage = 0 , iaspects = [ AddSkill SkMaxHP 10, AddSkill SkMaxCalm 999 , AddSkill SkSpeed 11, AddSkill SkNocto 2 , AddSkill SkWait 1, AddSkill SkMelee 1 -- no brain , SetFlag Durable ] , ieffects = [] , idesc = "A jet of acidic water, hot enough to melt flesh." , ikit = [("boiling vent", COrgan), ("boiling fissure", COrgan)] } geyserArsenic = ItemKind { isymbol = 'g' , iname = "arsenic geyser" , ifreq = [("animal", 8), ("immobile animal", 40)] , iflavour = zipPlain [Cyan] , icount = 1 , irarity = [(1, 10), (10, 6)] , iverbHit = "thud" , iweight = 80000 , idamage = 0 , iaspects = [ AddSkill SkMaxHP 20, AddSkill SkMaxCalm 999 , AddSkill SkSpeed 22, AddSkill SkNocto 2, AddSkill SkShine 3 , AddSkill SkWait 1, AddSkill SkMelee 1 -- no brain , SetFlag Durable ] , ieffects = [] , idesc = "The sharp scent betrays the poison within the spray." , ikit = [("arsenic vent", COrgan), ("arsenic fissure", COrgan)] } geyserSulfur = ItemKind { isymbol = 'g' , iname = "sulfur geyser" , ifreq = [("animal", 8), ("immobile animal", 120)] , iflavour = zipPlain [BrYellow] -- exception, animal with bright color , icount = 1 , irarity = [(1, 10), (10, 6)] , iverbHit = "thud" , iweight = 80000 , idamage = 0 , iaspects = [ AddSkill SkMaxHP 20, AddSkill SkMaxCalm 999 , AddSkill SkSpeed 22, AddSkill SkNocto 2, AddSkill SkShine 3 , AddSkill SkWait 1, AddSkill SkMelee 1 -- no brain , SetFlag Durable ] , ieffects = [] , idesc = "The pool boils and bubbles, stinking of rotten eggs. Despite the smell, these waters purify and strengthen." , ikit = [("sulfur vent", COrgan), ("sulfur fissure", COrgan)] } LambdaHack-0.9.5.0/GameDefinition/Content/ItemKindBlast.hs0000644000000000000000000006524607346545000021362 0ustar0000000000000000-- | Blast definitions. module Content.ItemKindBlast ( blasts ) where import Prelude () import Game.LambdaHack.Core.Prelude import Game.LambdaHack.Definition.Ability import Game.LambdaHack.Definition.Color import Game.LambdaHack.Definition.Defs import Game.LambdaHack.Core.Dice import Game.LambdaHack.Definition.Flavour import Game.LambdaHack.Content.ItemKind blasts :: [ItemKind] blasts = [burningOil2, burningOil3, burningOil4, firecracker1, firecracker2, firecracker3, firecracker4, firecracker5, spreadFragmentation, spreadFragmentation8, focusedFragmentation, spreadConcussion, spreadConcussion8, focusedConcussion, spreadFlash, spreadFlash8, focusedFlash, singleSpark, glassPiece, focusedGlass, fragrance, pheromone, mistCalming, odorDistressing, mistHealing, mistHealing2, mistWounding, distortion, smoke, boilingWater, glue, waste, mistAntiSlow, mistAntidote, mistSleep, denseShower, sparseShower, protectingBalmMelee, protectingBalmRanged, vulnerabilityBalm, resolutionDust, hasteSpray, slownessMist, eyeDrop, ironFiling, smellyDroplet, eyeShine, whiskeySpray, youthSprinkle, poisonCloud, blastNoSkMove, blastNoSkMelee, blastNoSkDisplace, blastNoSkAlter, blastNoSkWait, blastNoSkMoveItem, blastNoSkProject, blastNoSkApply, blastBonusSkMove, blastBonusSkMelee, blastBonusSkDisplace, blastBonusSkAlter, blastBonusSkWait, blastBonusSkMoveItem, blastBonusSkProject, blastBonusSkApply] burningOil2, burningOil3, burningOil4, firecracker1, firecracker2, firecracker3, firecracker4, firecracker5, spreadFragmentation, spreadFragmentation8, focusedFragmentation, spreadConcussion, spreadConcussion8, focusedConcussion, spreadFlash, spreadFlash8, focusedFlash, singleSpark, glassPiece, focusedGlass, fragrance, pheromone, mistCalming, odorDistressing, mistHealing, mistHealing2, mistWounding, distortion, smoke, boilingWater, glue, waste, mistAntiSlow, mistAntidote, mistSleep, denseShower, sparseShower, protectingBalmMelee, protectingBalmRanged, vulnerabilityBalm, resolutionDust, hasteSpray, slownessMist, eyeDrop, ironFiling, smellyDroplet, eyeShine, whiskeySpray, youthSprinkle, poisonCloud, blastNoSkMove, blastNoSkMelee, blastNoSkDisplace, blastNoSkAlter, blastNoSkWait, blastNoSkMoveItem, blastNoSkProject, blastNoSkApply, blastBonusSkMove, blastBonusSkMelee, blastBonusSkDisplace, blastBonusSkAlter, blastBonusSkWait, blastBonusSkMoveItem, blastBonusSkProject, blastBonusSkApply :: ItemKind -- We take care (e.g., in burningOil below) that blasts are not faster -- than 100% fastest natural speed, or some frames would be skipped, -- which is a waste of perfectly good frames. -- * Parameterized blasts burningOil :: Int -> ItemKind burningOil n = ItemKind { isymbol = '*' , iname = "burning oil" , ifreq = [(toGroupName $ "burning oil" <+> tshow n, 1)] , iflavour = zipPlain [BrYellow] , icount = intToDice (4 + n * 4) , irarity = [(1, 1)] , iverbHit = "sear" , iweight = 1 , idamage = 0 , iaspects = [ toVelocity (min 100 $ n `div` 2 * 10) , SetFlag Fragile, SetFlag Blast , AddSkill SkShine 2 ] , ieffects = [ Burn 1 , toOrganBad "pacified" (1 `d` 2) ] -- slips and frantically puts out fire , idesc = "Sticky oil, burning brightly." , ikit = [] } burningOil2 = burningOil 2 -- 2 steps, 2 turns burningOil3 = burningOil 3 -- 3 steps, 2 turns burningOil4 = burningOil 4 -- 4 steps, 2 turns firecracker :: Int -> ItemKind firecracker n = ItemKind { isymbol = '*' , iname = "firecracker" , ifreq = [(toGroupName $ if n == 5 then "firecracker" else "firecracker" <+> tshow n, 1)] , iflavour = zipPlain [brightCol !! ((n + 2) `mod` length brightCol)] , icount = if n <= 3 then 1 `d` min 2 n else 2 + 1 `d` 2 , irarity = [(1, 1)] , iverbHit = if n >= 4 then "singe" else "crack" , iweight = 1 , idamage = 0 , iaspects = [ toVelocity 5 , SetFlag Fragile, SetFlag Blast , AddSkill SkShine $ intToDice $ 1 + n `div` 2 ] , ieffects = [if n >= 4 then Burn 1 else RefillCalm (-2)] ++ [DropBestWeapon | n >= 4] ++ [ OnSmash $ Explode $ toGroupName $ "firecracker" <+> tshow (n - 1) | n >= 2 ] , idesc = "Scraps of burnt paper, covering little pockets of black powder, buffeted by colorful explosions." , ikit = [] } firecracker5 = firecracker 5 firecracker4 = firecracker 4 firecracker3 = firecracker 3 firecracker2 = firecracker 2 firecracker1 = firecracker 1 -- * Focused blasts spreadFragmentation = ItemKind { isymbol = '*' , iname = "fragmentation burst" , ifreq = [("violent fragmentation", 1)] , iflavour = zipPlain [Red] , icount = 16 -- strong but few, so not always hits target , irarity = [(1, 1)] , iverbHit = "tear apart" , iweight = 1 , idamage = 3 `d` 1 -- deadly and adjacent actor hit by 2 on average; -- however, moderate armour blocks completely , iaspects = [ ToThrow $ ThrowMod 100 20 4 -- 4 steps, 1 turn , SetFlag Lobable, SetFlag Fragile, SetFlag Blast , AddSkill SkShine 3, AddSkill SkHurtMelee $ -12 * 5 ] , ieffects = [DropItem 1 1 COrgan "condition"] , idesc = "Flying shards, flame and smoke." , ikit = [] } spreadFragmentation8 = spreadFragmentation { iname = "fragmentation burst" , ifreq = [("fragmentation", 1)] , icount = 8 , iaspects = [ ToThrow $ ThrowMod 100 10 2 -- 2 steps, 1 turn , SetFlag Lobable, SetFlag Fragile, SetFlag Blast , AddSkill SkShine 3, AddSkill SkHurtMelee $ -12 * 5 ] -- smaller radius, so worse for area effect, but twice the direct damage } focusedFragmentation = ItemKind { isymbol = '`' , iname = "deflagration ignition" -- black powder , ifreq = [("focused fragmentation", 1)] , iflavour = zipPlain [BrYellow] , icount = 4 -- 32 in total vs 16; on average 4 hits , irarity = [(1, 1)] , iverbHit = "ignite" , iweight = 1 , idamage = 0 , iaspects = [ toLinger 0 -- 0 steps, 1 turn , SetFlag Fragile, SetFlag Blast ] -- when the target position is occupied, the explosion starts one step -- away, hence we set range to 0 steps, to limit dispersal , ieffects = [OnSmash $ Explode "fragmentation"] , idesc = idesc spreadFragmentation , ikit = [] } spreadConcussion = ItemKind { isymbol = '*' , iname = "concussion blast" , ifreq = [("violent concussion", 1)] , iflavour = zipPlain [Magenta] , icount = 16 , irarity = [(1, 1)] , iverbHit = "shock" , iweight = 1 , idamage = 1 `d` 1 -- only air pressure, so not as deadly as fragmentation, -- but armour can't block completely that easily , iaspects = [ ToThrow $ ThrowMod 100 20 4 -- 4 steps, 1 turn , SetFlag Lobable, SetFlag Fragile, SetFlag Blast , AddSkill SkShine 3, AddSkill SkHurtMelee $ -8 * 5 ] -- outdoors it has short range, but we only model indoors in the game; -- it's much faster than black powder shock wave, but we are beyond -- human-noticeable speed differences on short distances anyway , ieffects = [ DropItem maxBound 1 CEqp "misc armor" , PushActor (ThrowMod 400 25 1) -- 1 step, fast; after DropItem -- this produces spam for braced actors; too bad , toOrganBad "immobile" 3 -- no balance , toOrganBad "deafened" 23 ] , idesc = "Shock wave, hot gases, some fire and smoke." , ikit = [] } spreadConcussion8 = spreadConcussion { iname = "concussion blast" , ifreq = [("concussion", 1)] , icount = 8 , iaspects = [ ToThrow $ ThrowMod 100 10 2 -- 2 steps, 1 turn , SetFlag Lobable, SetFlag Fragile, SetFlag Blast , AddSkill SkShine 3, AddSkill SkHurtMelee $ -8 * 5 ] } focusedConcussion = ItemKind { isymbol = '`' , iname = "detonation ignition" -- nitroglycerine , ifreq = [("focused concussion", 1)] , iflavour = zipPlain [BrYellow] , icount = 4 , irarity = [(1, 1)] , iverbHit = "ignite" , iweight = 1 , idamage = 0 , iaspects = [ toLinger 0 -- 0 steps, 1 turn , SetFlag Fragile, SetFlag Blast ] , ieffects = [OnSmash $ Explode "concussion"] , idesc = idesc spreadConcussion , ikit = [] } spreadFlash = ItemKind { isymbol = '`' , iname = "magnesium flash" , ifreq = [("violent flash", 1)] , iflavour = zipPlain [BrWhite] , icount = 16 , irarity = [(1, 1)] , iverbHit = "dazzle" , iweight = 1 , idamage = 0 , iaspects = [ ToThrow $ ThrowMod 100 20 4 -- 4 steps, 1 turn , SetFlag Fragile, SetFlag Blast , AddSkill SkShine 5 ] , ieffects = [toOrganBad "blind" 5, toOrganBad "weakened" 20] -- Wikipedia says: blind for five seconds and afterimage -- for much longer, harming aim , idesc = "A very bright flash of fire." , ikit = [] } spreadFlash8 = spreadFlash { iname = "spark" , ifreq = [("spark", 1)] , icount = 8 , iverbHit = "blind" , iaspects = [ ToThrow $ ThrowMod 100 10 2 -- 2 steps, 1 turn , SetFlag Fragile, SetFlag Blast , AddSkill SkShine 5 ] } focusedFlash = ItemKind { isymbol = '`' , iname = "magnesium ignition" , ifreq = [("focused flash", 1)] , iflavour = zipPlain [BrYellow] , icount = 4 , irarity = [(1, 1)] , iverbHit = "ignite" , iweight = 1 , idamage = 0 , iaspects = [ toLinger 0 -- 0 steps, 1 turn , SetFlag Fragile, SetFlag Blast ] , ieffects = [OnSmash $ Explode "spark"] , idesc = idesc spreadFlash , ikit = [] } singleSpark = spreadFlash { iname = "single spark" , ifreq = [("single spark", 1)] , icount = 1 , iverbHit = "spark" , iaspects = [ toLinger 5 -- 1 step, 1 turn , SetFlag Fragile, SetFlag Blast , AddSkill SkShine 3 ] , ieffects = [] , idesc = "A glowing ember." , ikit = [] } glassPiece = ItemKind { isymbol = '*' , iname = "glass piece" , ifreq = [("glass hail", 1)] , iflavour = zipPlain [Blue] , icount = 8 , irarity = [(1, 1)] , iverbHit = "cut" , iweight = 1 , idamage = 2 `d` 1 , iaspects = [ ToThrow $ ThrowMod 100 20 4 -- 4 steps, 1 turn , SetFlag Fragile, SetFlag Blast , AddSkill SkHurtMelee $ -15 * 5 ] -- brittle, not too dense; armor blocks , ieffects = [] , idesc = "Swift, sharp edges." , ikit = [] } focusedGlass = glassPiece -- when blowing up windows { ifreq = [("focused glass hail", 1)] , icount = 4 , iaspects = [ toLinger 0 -- 0 steps, 1 turn , SetFlag Fragile, SetFlag Blast , AddSkill SkHurtMelee $ -15 * 5 ] , ieffects = [OnSmash $ Explode "glass hail"] } -- * Assorted blasts don't induce conditions or not mainly so fragrance = ItemKind { isymbol = '`' , iname = "fragrance" -- instant, fast fragrance , ifreq = [("fragrance", 1)] , iflavour = zipPlain [Magenta] , icount = 12 , irarity = [(1, 1)] , iverbHit = "engulf" , iweight = 1 , idamage = 0 , iaspects = [ toLinger 10 -- 2 steps, 1 turn , SetFlag Fragile, SetFlag Blast ] , ieffects = [Impress, toOrganGood "rose-smelling" 45] -- Linger 10, because sometimes it takes 2 turns due to starting just -- before actor turn's end (e.g., via a necklace). , idesc = "A pleasant scent." , ikit = [] } pheromone = ItemKind { isymbol = '`' , iname = "musky whiff" -- a kind of mist rather than fragrance , ifreq = [("pheromone", 1)] , iflavour = zipPlain [BrMagenta] , icount = 16 , irarity = [(1, 1)] , iverbHit = "tempt" , iweight = 1 , idamage = 0 , iaspects = [ toVelocity 10 -- 2 steps, 2 turns , SetFlag Fragile, SetFlag Blast ] , ieffects = [Dominate] , idesc = "A sharp, strong scent." , ikit = [] } mistCalming = ItemKind -- unused { isymbol = '`' , iname = "mist" , ifreq = [("calming mist", 1)] , iflavour = zipPlain [BrGreen] , icount = 8 , irarity = [(1, 1)] , iverbHit = "sooth" , iweight = 1 , idamage = 0 , iaspects = [ toVelocity 5 -- 1 step, 1 turn , SetFlag Fragile, SetFlag Blast ] , ieffects = [RefillCalm 2] , idesc = "A soothing, gentle cloud." , ikit = [] } odorDistressing = ItemKind { isymbol = '`' , iname = "distressing whiff" , ifreq = [("distressing odor", 1)] , iflavour = zipFancy [BrRed] -- salmon , icount = 8 , irarity = [(1, 1)] , iverbHit = "distress" , iweight = 1 , idamage = 0 , iaspects = [ toLinger 10 -- 2 steps, 1 turn , SetFlag Fragile, SetFlag Blast ] , ieffects = [ RefillCalm (-10) , toOrganBad "foul-smelling" (20 + 1 `d` 5) , toOrganBad "impatient" (2 + 1 `d` 2) ] , idesc = "It turns the stomach." -- and so can't stand still , ikit = [] } mistHealing = ItemKind { isymbol = '`' , iname = "mist" -- powerful, so slow and narrow , ifreq = [("healing mist", 1)] , iflavour = zipFancy [BrGreen] , icount = 8 , irarity = [(1, 1)] , iverbHit = "revitalize" , iweight = 1 , idamage = 0 , iaspects = [ toVelocity 5 -- 1 step, 1 turn , SetFlag Fragile, SetFlag Blast , AddSkill SkShine 1 ] , ieffects = [RefillHP 2] , idesc = "It fills the air with light and life." , ikit = [] } mistHealing2 = ItemKind { isymbol = '`' , iname = "mist" , ifreq = [("healing mist 2", 1)] , iflavour = zipPlain [Green] , icount = 8 , irarity = [(1, 1)] , iverbHit = "revitalize" , iweight = 1 , idamage = 0 , iaspects = [ toVelocity 5 -- 1 step, 1 turn , SetFlag Fragile, SetFlag Blast , AddSkill SkShine 2 ] , ieffects = [RefillHP 4] , idesc = "At its touch, wounds close and bruises fade." , ikit = [] } mistWounding = ItemKind { isymbol = '`' , iname = "mist" , ifreq = [("wounding mist", 1)] , iflavour = zipPlain [BrRed] , icount = 8 , irarity = [(1, 1)] , iverbHit = "devitalize" , iweight = 1 , idamage = 0 , iaspects = [ toVelocity 5 -- 1 step, 1 turn , SetFlag Fragile, SetFlag Blast ] , ieffects = [RefillHP (-2)] , idesc = "The air itself stings and itches." , ikit = [] } distortion = ItemKind { isymbol = 'v' , iname = "vortex" , ifreq = [("distortion", 1)] , iflavour = zipPlain [White] , icount = 8 -- braced are immune to Teleport; avoid failure messages , irarity = [(1, 1)] , iverbHit = "engulf" , iweight = 1 , idamage = 0 , iaspects = [ toLinger 10 -- 2 steps, 1 turn , SetFlag Lobable, SetFlag Fragile, SetFlag Blast ] , ieffects = [Teleport $ 15 + 1 `d` 10] , idesc = "The air shifts oddly, as though light is being warped." , ikit = [] } smoke = ItemKind -- when stuff burns out -- unused { isymbol = '`' , iname = "smoke fume" -- pluralizes better than 'smokes' , ifreq = [("smoke", 1)] , iflavour = zipPlain [BrBlack] , icount = 16 , irarity = [(1, 1)] , iverbHit = "choke" -- or "obscure" , iweight = 1 , idamage = 0 , iaspects = [ toVelocity 20 -- 4 steps, 2 turns , SetFlag Fragile, SetFlag Blast ] , ieffects = [toOrganBad "withholding" (5 + 1 `d` 3)] -- choking and tears, can roughly see, but not aim , idesc = "Twirling clouds of grey smoke." , ikit = [] } boilingWater = ItemKind { isymbol = '*' , iname = "boiling water" , ifreq = [("boiling water", 1)] , iflavour = zipPlain [White] , icount = 18 , irarity = [(1, 1)] , iverbHit = "boil" , iweight = 1 , idamage = 0 , iaspects = [ toVelocity 30 -- 6 steps, 2 turns , SetFlag Fragile, SetFlag Blast ] , ieffects = [Burn 1] , idesc = "It bubbles and hisses." , ikit = [] } glue = ItemKind { isymbol = '*' , iname = "hoof glue" , ifreq = [("glue", 1)] , iflavour = zipPlain [Cyan] , icount = 8 -- Paralyze doesn't stack; avoid failure messages , irarity = [(1, 1)] , iverbHit = "glue" , iweight = 1 , idamage = 0 , iaspects = [ toVelocity 20 -- 4 steps, 2 turns , SetFlag Fragile, SetFlag Blast ] , ieffects = [Paralyze 10] , idesc = "Thick and clinging." , ikit = [] } waste = ItemKind { isymbol = '*' , iname = "waste piece" , ifreq = [("waste", 1)] , iflavour = zipPlain [Brown] , icount = 16 , irarity = [(1, 1)] , iverbHit = "splosh" , iweight = 1 , idamage = 0 , iaspects = [toLinger 10, SetFlag Fragile, SetFlag Blast] , ieffects = [ toOrganBad "foul-smelling" (30 + 1 `d` 10) , toOrganBad "dispossessed" (10 + 1 `d` 5) ] , idesc = "Sodden and foul-smelling." , ikit = [] } mistAntiSlow = ItemKind { isymbol = '`' , iname = "mist" , ifreq = [("anti-slow mist", 1)] , iflavour = zipFancy [BrYellow] , icount = 8 , irarity = [(1, 1)] , iverbHit = "propel" , iweight = 1 , idamage = 0 , iaspects = [ toVelocity 5 -- 1 step, 1 turn , SetFlag Fragile, SetFlag Blast ] , ieffects = [DropItem 1 1 COrgan "slowed"] , idesc = "A cleansing rain." , ikit = [] } mistAntidote = ItemKind { isymbol = '`' , iname = "mist" , ifreq = [("antidote mist", 1)] , iflavour = zipFancy [BrBlue] , icount = 8 , irarity = [(1, 1)] , iverbHit = "cure" , iweight = 1 , idamage = 0 , iaspects = [ toVelocity 5 -- 1 step, 1 turn , SetFlag Fragile, SetFlag Blast ] , ieffects = [DropItem 1 maxBound COrgan "poisoned"] , idesc = "Washes away death's dew." , ikit = [] } mistSleep = ItemKind { isymbol = '`' , iname = "mist" , ifreq = [("sleep mist", 1)] , iflavour = zipFancy [BrMagenta] , icount = 8 , irarity = [(1, 1)] , iverbHit = "put to sleep" , iweight = 1 , idamage = 0 , iaspects = [ toVelocity 5 -- 1 step, 1 turn , SetFlag Fragile, SetFlag Blast ] , ieffects = [PutToSleep] , idesc = "Lulls weary warriors." , ikit = [] } -- * Condition-inducing blasts -- Almost all have @toLinger 10@, that travels 2 steps in 1 turn. -- These are very fast projectiles, not getting into the way of big -- actors and not burdening the engine for long. -- A few are slower 'mists'. denseShower = ItemKind { isymbol = '`' , iname = "dense shower" , ifreq = [("dense shower", 1)] , iflavour = zipFancy [Green] , icount = 12 , irarity = [(1, 1)] , iverbHit = "strengthen" , iweight = 1 , idamage = 0 , iaspects = [toLinger 10, SetFlag Fragile, SetFlag Blast] , ieffects = [toOrganGood "strengthened" 5] , idesc = "A thick rain of droplets." , ikit = [] } sparseShower = ItemKind { isymbol = '`' , iname = "sparse shower" , ifreq = [("sparse shower", 1)] , iflavour = zipFancy [Red] , icount = 8 , irarity = [(1, 1)] , iverbHit = "weaken" , iweight = 1 , idamage = 0 , iaspects = [toLinger 10, SetFlag Fragile, SetFlag Blast] , ieffects = [toOrganBad "weakened" 7] , idesc = "Light droplets that cling to clothing." , ikit = [] } protectingBalmMelee = ItemKind { isymbol = '`' , iname = "balm droplet" , ifreq = [("melee protective balm", 1)] , iflavour = zipFancy [Brown] , icount = 16 , irarity = [(1, 1)] , iverbHit = "balm" , iweight = 1 , idamage = 0 , iaspects = [toLinger 10, SetFlag Fragile, SetFlag Blast] , ieffects = [toOrganGood "protected from melee" (3 + 1 `d` 3)] , idesc = "A thick ointment that hardens the skin." , ikit = [] } protectingBalmRanged = ItemKind { isymbol = '`' , iname = "balm droplet" , ifreq = [("ranged protective balm", 1)] , iflavour = zipPlain [BrYellow] , icount = 16 , irarity = [(1, 1)] , iverbHit = "balm" , iweight = 1 , idamage = 0 , iaspects = [toLinger 10, SetFlag Fragile, SetFlag Blast] , ieffects = [toOrganGood "protected from ranged" (3 + 1 `d` 3)] , idesc = "Grease that protects from flying death." , ikit = [] } vulnerabilityBalm = ItemKind { isymbol = '?' , iname = "PhD defense question" , ifreq = [("PhD defense question", 1)] , iflavour = zipFancy [BrRed] , icount = 16 , irarity = [(1, 1)] , iverbHit = "nag" , iweight = 1 , idamage = 0 , iaspects = [toLinger 10, SetFlag Fragile, SetFlag Blast] , ieffects = [toOrganBad "defenseless" (3 + 1 `d` 3)] , idesc = "Only the most learned make use of this." , ikit = [] } resolutionDust = ItemKind { isymbol = '`' , iname = "resolution dust" , ifreq = [("resolution dust", 1)] , iflavour = zipPlain [Brown] , icount = 16 , irarity = [(1, 1)] , iverbHit = "calm" , iweight = 1 , idamage = 0 , iaspects = [toLinger 10, SetFlag Fragile, SetFlag Blast] , ieffects = [toOrganGood "resolute" (3 + 1 `d` 3)] -- short enough duration that @calmEnough@ not a big problem , idesc = "A handful of honest earth, to strengthen the soul." , ikit = [] } hasteSpray = ItemKind { isymbol = '`' , iname = "haste spray" , ifreq = [("haste spray", 1)] , iflavour = zipFancy [BrYellow] , icount = 16 , irarity = [(1, 1)] , iverbHit = "haste" , iweight = 1 , idamage = 0 , iaspects = [toLinger 10, SetFlag Fragile, SetFlag Blast] , ieffects = [toOrganGood "hasted" (3 + 1 `d` 3)] , idesc = "A quick spurt." , ikit = [] } slownessMist = ItemKind { isymbol = '`' , iname = "slowness mist" , ifreq = [("slowness mist", 1)] , iflavour = zipPlain [BrBlue] , icount = 8 , irarity = [(1, 1)] , iverbHit = "slow" , iweight = 0 , idamage = 0 , iaspects = [toVelocity 5, SetFlag Fragile, SetFlag Blast] -- 1 step, 1 turn, mist, slow , ieffects = [toOrganBad "slowed" (3 + 1 `d` 3)] , idesc = "Clammy fog, making each movement an effort." , ikit = [] } eyeDrop = ItemKind { isymbol = '`' , iname = "eye drop" , ifreq = [("eye drop", 1)] , iflavour = zipFancy [BrCyan] , icount = 16 , irarity = [(1, 1)] , iverbHit = "cleanse" , iweight = 1 , idamage = 0 , iaspects = [toLinger 10, SetFlag Fragile, SetFlag Blast] , ieffects = [toOrganGood "far-sighted" (3 + 1 `d` 3)] , idesc = "Not to be taken orally." , ikit = [] } ironFiling = ItemKind { isymbol = '`' , iname = "iron filing" , ifreq = [("iron filing", 1)] , iflavour = zipPlain [Red] , icount = 16 , irarity = [(1, 1)] , iverbHit = "blind" , iweight = 1 , idamage = 0 , iaspects = [toLinger 10, SetFlag Fragile, SetFlag Blast] , ieffects = [toOrganBad "blind" (10 + 1 `d` 10)] , idesc = "A shaving of bright metal." , ikit = [] } smellyDroplet = ItemKind { isymbol = '`' , iname = "smelly droplet" , ifreq = [("smelly droplet", 1)] , iflavour = zipFancy [Blue] , icount = 16 , irarity = [(1, 1)] , iverbHit = "sensitize" , iweight = 1 , idamage = 0 , iaspects = [toLinger 10, SetFlag Fragile, SetFlag Blast] , ieffects = [toOrganGood "keen-smelling" (5 + 1 `d` 3)] , idesc = "A viscous lump that stains the skin." , ikit = [] } eyeShine = ItemKind { isymbol = '`' , iname = "eye shine" , ifreq = [("eye shine", 1)] , iflavour = zipFancy [Cyan] , icount = 16 , irarity = [(1, 1)] , iverbHit = "smear" , iweight = 1 , idamage = 0 , iaspects = [toLinger 10, SetFlag Fragile, SetFlag Blast] , ieffects = [toOrganGood "shiny-eyed" (3 + 1 `d` 3)] , idesc = "They almost glow in the dark." , ikit = [] } whiskeySpray = ItemKind { isymbol = '`' , iname = "whiskey spray" , ifreq = [("whiskey spray", 1)] , iflavour = zipFancy [Brown] , icount = 16 , irarity = [(1, 1)] , iverbHit = "inebriate" , iweight = 1 , idamage = 0 , iaspects = [toLinger 10, SetFlag Fragile, SetFlag Blast] , ieffects = [toOrganGood "drunk" (3 + 1 `d` 3)] , idesc = "It burns in the best way." , ikit = [] } youthSprinkle = ItemKind { isymbol = '`' , iname = "youth sprinkle" , ifreq = [("youth sprinkle", 1)] , iflavour = zipFancy [BrGreen] , icount = 16 , irarity = [(1, 1)] , iverbHit = "sprinkle" , iweight = 1 , idamage = 0 , iaspects = [toLinger 10, SetFlag Fragile, SetFlag Blast] , ieffects = [ toOrganGood "rose-smelling" (40 + 1 `d` 20) , toOrganNoTimer "regenerating" ] , idesc = "Bright and smelling of the Spring." , ikit = [] } poisonCloud = ItemKind { isymbol = '`' , iname = "poison cloud" , ifreq = [("poison cloud", 1)] , iflavour = zipFancy [BrMagenta] , icount = 16 , irarity = [(1, 1)] , iverbHit = "poison" , iweight = 0 , idamage = 0 , iaspects = [ ToThrow $ ThrowMod 10 100 2 -- 2 steps, 2 turns , SetFlag Fragile, SetFlag Blast ] , ieffects = [toOrganNoTimer "poisoned"] , idesc = "Choking gas that stings the eyes." , ikit = [] } blastNoStat :: Text -> ItemKind blastNoStat grp = ItemKind { isymbol = '`' , iname = "mist" , ifreq = [(toGroupName $ grp <+> "mist", 1)] , iflavour = zipFancy [White] , icount = 12 , irarity = [(1, 1)] , iverbHit = "drain" , iweight = 1 , idamage = 0 , iaspects = [ toVelocity 10 -- 2 steps, 2 turns , SetFlag Fragile, SetFlag Blast ] , ieffects = [toOrganBad (toGroupName grp) (3 + 1 `d` 3)] , idesc = "Completely disables one personal faculty." , ikit = [] } blastNoSkMove = blastNoStat "immobile" blastNoSkMelee = blastNoStat "pacified" blastNoSkDisplace = blastNoStat "irreplaceable" blastNoSkAlter = blastNoStat "retaining" blastNoSkWait = blastNoStat "impatient" blastNoSkMoveItem = blastNoStat "dispossessed" blastNoSkProject = blastNoStat "withholding" blastNoSkApply = blastNoStat "parsimonious" blastBonusStat :: Text -> ItemKind blastBonusStat grp = ItemKind { isymbol = '`' , iname = "dew" , ifreq = [(toGroupName $ grp <+> "dew", 1)] , iflavour = zipFancy [White] , icount = 12 , irarity = [(1, 1)] , iverbHit = "elevate" , iweight = 1 , idamage = 0 , iaspects = [ toVelocity 10 -- 2 steps, 2 turns , SetFlag Fragile, SetFlag Blast ] , ieffects = [toOrganGood (toGroupName grp) (20 + 1 `d` 5)] , idesc = "Temporarily enhances the given personal faculty." , ikit = [] } blastBonusSkMove = blastBonusStat "more mobile" blastBonusSkMelee = blastBonusStat "more combative" blastBonusSkDisplace = blastBonusStat "more displacing" blastBonusSkAlter = blastBonusStat "more altering" blastBonusSkWait = blastBonusStat "more patient" blastBonusSkMoveItem = blastBonusStat "more tidy" blastBonusSkProject = blastBonusStat "more projecting" blastBonusSkApply = blastBonusStat "more practical" LambdaHack-0.9.5.0/GameDefinition/Content/ItemKindEmbed.hs0000644000000000000000000002711707346545000021324 0ustar0000000000000000-- | Definitions of items embedded in map tiles. module Content.ItemKindEmbed ( embeds ) where import Prelude () import Game.LambdaHack.Core.Prelude import Game.LambdaHack.Content.ItemKind import Game.LambdaHack.Core.Dice import Game.LambdaHack.Definition.Ability import Game.LambdaHack.Definition.Color import Game.LambdaHack.Definition.Defs import Game.LambdaHack.Definition.Flavour embeds :: [ItemKind] embeds = [scratchOnWall, obscenePictogram, subtleFresco, treasureCache, treasureCacheTrap, signboardExit, signboardEmbed, signboardMerchandise, fireSmall, fireBig, frost, rubble, doorwayTrapTemplate, doorwayTrap1, doorwayTrap2, doorwayTrap3, stairsUp, stairsDown, escape, staircaseTrapUp, staircaseTrapDown, pulpit, shallowWater, straightPath, frozenGround] scratchOnWall, obscenePictogram, subtleFresco, treasureCache, treasureCacheTrap, signboardExit, signboardEmbed, signboardMerchandise, fireSmall, fireBig, frost, rubble, doorwayTrapTemplate, doorwayTrap1, doorwayTrap2, doorwayTrap3, stairsUp, stairsDown, escape, staircaseTrapUp, staircaseTrapDown, pulpit, shallowWater, straightPath, frozenGround :: ItemKind -- Make sure very few walls are substantially useful, e.g., caches, -- and none that are secret. Otherwise the player will spend a lot of time -- bumping walls, which is boring compared to fights or dialogues -- and ever worse, the player will bump all secret walls, wasting time -- and foregoing the fun of guessing how to find entrance to a disjoint part -- of the level by bumping the least number of secret walls. scratchOnWall = ItemKind { isymbol = '?' , iname = "claw mark" , ifreq = [("scratch on wall", 1)] , iflavour = zipPlain [BrBlack] , icount = 1 , irarity = [(1, 1)] , iverbHit = "scratch" , iweight = 1000 , idamage = 0 , iaspects = [SetFlag Durable] , ieffects = [ VerbMsg "start making sense of the scratches" , Detect DetectHidden 3 ] , idesc = "A seemingly random series of scratches, carved deep into the wall." , ikit = [] } obscenePictogram = ItemKind { isymbol = '*' , iname = "obscene pictogram" , ifreq = [("obscene pictogram", 1)] , iflavour = zipPlain [BrMagenta] , icount = 1 , irarity = [(1, 1)] , iverbHit = "infuriate" , iweight = 1000 , idamage = 0 , iaspects = [Timeout 7, SetFlag Durable] , ieffects = [ VerbMsg "enter destructive rage at the sight of an obscene pictogram" , RefillCalm (-20) , OneOf [ toOrganGood "strengthened" (3 + 1 `d` 2) , CreateItem CInv "sandstone rock" timerNone ] ] , idesc = "It's not even anatomically possible." , ikit = [] } subtleFresco = ItemKind { isymbol = '*' , iname = "subtle fresco" , ifreq = [("subtle fresco", 1)] , iflavour = zipPlain [BrGreen] , icount = 1 , irarity = [(1, 1)] , iverbHit = "sooth" , iweight = 1000 , idamage = 0 , iaspects = [Timeout 7, SetFlag Durable] , ieffects = [ VerbMsg "feel refreshed by the subtle fresco" , toOrganGood "far-sighted" (3 + 1 `d` 2) , toOrganGood "keen-smelling" (3 + 1 `d` 2) ] -- hearing gets a boost through bracing, so no need here , idesc = "Expensive yet tasteful." , ikit = [] } treasureCache = ItemKind { isymbol = '0' , iname = "treasure cache" , ifreq = [("treasure cache", 1)] , iflavour = zipPlain [BrBlue] , icount = 1 , irarity = [(1, 1)] , iverbHit = "crash" , iweight = 10000 , idamage = 0 , iaspects = [SetFlag Durable] , ieffects = [CreateItem CGround "common item" timerNone] , idesc = "Glittering treasure, just waiting to be taken." , ikit = [] } treasureCacheTrap = ItemKind { isymbol = '^' , iname = "cache trap" , ifreq = [("treasure cache trap", 1)] , iflavour = zipPlain [Red] , icount = 1 , irarity = [(1, 1)] , iverbHit = "taint" , iweight = 1000 , idamage = 0 , iaspects = [] -- not Durable, springs at most once , ieffects = [OneOf [ toOrganBad "blind" (10 + 1 `d` 10) , RefillCalm (-99) , Explode "focused concussion" , RefillCalm (-1), RefillCalm (-1), RefillCalm (-1) ]] , idesc = "It's a trap!" , ikit = [] } signboardExit = ItemKind { isymbol = '?' , iname = "inscription" , ifreq = [("signboard", 50)] , iflavour = zipPlain [BrMagenta] , icount = 1 , irarity = [(1, 1)] , iverbHit = "whack" , iweight = 10000 , idamage = 0 , iaspects = [SetFlag Durable] , ieffects = [Detect DetectExit 100] , idesc = "Crude big arrows hastily carved by unknown hands." , ikit = [] } signboardEmbed = signboardExit { iname = "notice" , ifreq = [("signboard", 50)] , ieffects = [Detect DetectEmbed 12] , idesc = "The battered poster is untitled and unsigned." } signboardMerchandise = signboardExit { iname = "treasure map" , ifreq = [("signboard", 50)] , ieffects = [Detect DetectLoot 20] , idesc = "In equal parts cryptic and promising." } fireSmall = ItemKind { isymbol = '%' , iname = "small fire" , ifreq = [("small fire", 1)] , iflavour = zipPlain [BrRed] , icount = 1 , irarity = [(1, 1)] , iverbHit = "burn" , iweight = 10000 , idamage = 0 , iaspects = [SetFlag Durable] , ieffects = [Burn 1, Explode "single spark"] , idesc = "A few small logs, burning brightly." , ikit = [] } fireBig = fireSmall { isymbol = '0' , iname = "big fire" , ifreq = [("big fire", 1)] , ieffects = [ Burn 2 , CreateItem CInv "wooden torch" timerNone , Explode "spark" ] , idesc = "Glowing with light and warmth." , ikit = [] } frost = ItemKind { isymbol = '^' , iname = "frost" , ifreq = [("frost", 1)] , iflavour = zipPlain [BrBlue] , icount = 1 , irarity = [(1, 1)] , iverbHit = "burn" , iweight = 10000 , idamage = 0 , iaspects = [SetFlag Durable] , ieffects = [ Burn 1 -- sensory ambiguity between hot and cold , RefillCalm 20 -- cold reason , PushActor (ThrowMod 400 10 1) ] -- slippery ice , idesc = "Intricate patterns of shining ice." , ikit = [] } rubble = ItemKind { isymbol = '&' , iname = "rubble" , ifreq = [("rubble", 1)] , iflavour = zipPlain [BrYellow] , icount = 1 , irarity = [(1, 1)] , iverbHit = "bury" , iweight = 100000 , idamage = 0 , iaspects = [SetFlag Durable] , ieffects = [OneOf [ Explode "focused glass hail" , Summon "mobile animal" $ 1 `dL` 2 , toOrganNoTimer "poisoned" , CreateItem CGround "common item" timerNone , RefillCalm (-1), RefillCalm (-1), RefillCalm (-1) , RefillCalm (-1), RefillCalm (-1), RefillCalm (-1) ]] , idesc = "Broken chunks of rock and glass." , ikit = [] } doorwayTrapTemplate = ItemKind { isymbol = '+' , iname = "doorway trap" , ifreq = [("doorway trap unknown", 1)] , iflavour = zipPlain brightCol , icount = 1 , irarity = [(1, 1)] , iverbHit = "cripple" , iweight = 10000 , idamage = 0 , iaspects = [HideAs "doorway trap unknown"] -- not Durable, springs at most once , ieffects = [] , idesc = "Just turn the handle..." , ikit = [] } doorwayTrap1 = doorwayTrapTemplate { ifreq = [("doorway trap", 50)] , ieffects = [toOrganBad "blind" $ (1 `dL` 4) * 5] -- , idesc = "" } doorwayTrap2 = doorwayTrapTemplate { ifreq = [("doorway trap", 25)] , ieffects = [toOrganBad "slowed" $ (1 `dL` 4) * 10] -- , idesc = "" } doorwayTrap3 = doorwayTrapTemplate { ifreq = [("doorway trap", 25)] , ieffects = [toOrganBad "weakened" $ (1 `dL` 4) * 10 ] -- , idesc = "" } stairsUp = ItemKind { isymbol = '<' , iname = "flight" , ifreq = [("staircase up", 1)] , iflavour = zipPlain [BrWhite] , icount = 1 , irarity = [(1, 1)] , iverbHit = "crash" -- the verb is only used when the item hits, -- not when it's applied otherwise, e.g., from tile , iweight = 100000 , idamage = 0 , iaspects = [ELabel "of steps", SetFlag Durable] , ieffects = [Ascend True] , idesc = "Stairs that rise towards escape." , ikit = [] } stairsDown = stairsUp { isymbol = '>' , ifreq = [("staircase down", 1)] , ieffects = [Ascend False] , idesc = "" } escape = stairsUp { isymbol = 'E' , iname = "way" , ifreq = [("escape", 1)] , iflavour = zipPlain [BrYellow] , iaspects = [SetFlag Durable] , ieffects = [Escape] , idesc = "May this nightmare have an end?" } staircaseTrapUp = ItemKind { isymbol = '^' , iname = "staircase trap" , ifreq = [("staircase trap up", 1)] , iflavour = zipPlain [Red] , icount = 1 , irarity = [(1, 1)] , iverbHit = "buffet" , iweight = 10000 , idamage = 0 , iaspects = [] -- not Durable, springs at most once , ieffects = [ VerbMsg "be caught in an updraft" , Teleport $ 3 + 1 `dL` 10 ] , idesc = "A hidden spring, to help the unwary soar." , ikit = [] } -- Needs to be separate from staircaseTrapUp, to make sure the item is -- registered after up staircase (not only after down staircase) -- so that effects are invoked in the proper order and, e.g., teleport works. staircaseTrapDown = staircaseTrapUp { ifreq = [("staircase trap down", 1)] , iverbHit = "open up under" , ieffects = [ VerbMsg "tumble down the stairwell" , toOrganGood "drunk" (20 + 1 `d` 5) ] , idesc = "A treacherous slab, to teach those who are too proud." } pulpit = ItemKind { isymbol = '?' , iname = "lectern" , ifreq = [("pulpit", 1)] , iflavour = zipFancy [BrYellow] , icount = 1 , irarity = [(1, 1)] , iverbHit = "ask" , iweight = 10000 , idamage = 0 , iaspects = [] -- not Durable, springs at most once , ieffects = [ OneOf [ CreateItem CGround "any scroll" timerNone , Detect DetectAll 20 , toOrganBad "defenseless" $ (1 `dL` 6) * 10 , toOrganGood "drunk" (20 + 1 `d` 5) ] , Explode "PhD defense question" ] , idesc = "A dark wood stand, where strange priests once preached." , ikit = [] } shallowWater = ItemKind { isymbol = '~' , iname = "shallow water" , ifreq = [("shallow water", 1)] , iflavour = zipFancy [BrCyan] , icount = 1 , irarity = [(1, 1)] , iverbHit = "impede" , iweight = 10000 , idamage = 0 , iaspects = [SetFlag Durable] , ieffects = [ParalyzeInWater 2] , idesc = "" , ikit = [] } straightPath = ItemKind { isymbol = '.' , iname = "straight path" , ifreq = [("straight path", 1)] , iflavour = zipFancy [BrRed] , icount = 1 , irarity = [(1, 1)] , iverbHit = "propel" , iweight = 10000 , idamage = 0 , iaspects = [SetFlag Durable] , ieffects = [InsertMove 2] , idesc = "" , ikit = [] } frozenGround = ItemKind { isymbol = '.' , iname = "shade" , ifreq = [("frozen ground", 1)] , iflavour = zipFancy [BrBlue] , icount = 50 -- very thick ice and refreezes , irarity = [(1, 1)] , iverbHit = "betray" , iweight = 10000 , idamage = 0 , iaspects = [ELabel "of ice"] -- no Durable or some items would be impossible to pick up , ieffects = [PushActor (ThrowMod 400 10 1)] -- the high speed represents gliding rather than flying -- and so no need to lift actor's weight off the ground; -- low linger comes from abrupt halt over normal surface , idesc = "" , ikit = [] } LambdaHack-0.9.5.0/GameDefinition/Content/ItemKindOrgan.hs0000644000000000000000000004535107346545000021356 0ustar0000000000000000-- | Actor organ definitions. module Content.ItemKindOrgan ( organs ) where import Prelude () import Game.LambdaHack.Core.Prelude import Game.LambdaHack.Content.ItemKind import Game.LambdaHack.Core.Dice import Game.LambdaHack.Definition.Ability import Game.LambdaHack.Definition.Color import Game.LambdaHack.Definition.Defs import Game.LambdaHack.Definition.Flavour organs :: [ItemKind] organs = [fist, foot, hookedClaw, smallClaw, snout, smallJaw, jaw, largeJaw, antler, horn, rhinoHorn, tentacle, thorn, boilingFissure, arsenicFissure, sulfurFissure, beeSting, sting, venomTooth, venomFang, screechingBeak, largeTail, hugeTail, armoredSkin, bark, eye3, eye6, eye8, vision6, vision12, vision16, nostril, ear3, ear6, ear8, rattleOrgan, insectMortality, sapientBrain, animalBrain, speedGland5, speedGland10, scentGland, boilingVent, arsenicVent, sulfurVent, bonusHP, braced, asleep, impressed] -- LH-specific ++ [tooth, lash, noseTip, lip, torsionRight, torsionLeft, pupil] fist, foot, hookedClaw, smallClaw, snout, smallJaw, jaw, largeJaw, antler, horn, rhinoHorn, tentacle, thorn, boilingFissure, arsenicFissure, sulfurFissure, beeSting, sting, venomTooth, venomFang, screechingBeak, largeTail, hugeTail, armoredSkin, bark, eye3, eye6, eye8, vision6, vision12, vision16, nostril, ear3, ear6, ear8, rattleOrgan, insectMortality, sapientBrain, animalBrain, speedGland5, speedGland10, scentGland, boilingVent, arsenicVent, sulfurVent, bonusHP, braced, asleep, impressed :: ItemKind -- LH-specific tooth, lash, noseTip, lip, torsionRight, torsionLeft, pupil :: ItemKind -- Weapons -- * Human weapon organs fist = ItemKind { isymbol = ',' , iname = "fist" , ifreq = [("fist", 100)] , iflavour = zipPlain [Red] , icount = 2 , irarity = [(1, 1)] , iverbHit = "punch" , iweight = 2000 , idamage = 4 `d` 1 , iaspects = [SetFlag Durable, SetFlag Meleeable] , ieffects = [] , idesc = "Simple but effective." , ikit = [] } foot = fist { iname = "foot" , ifreq = [("foot", 50)] , iverbHit = "kick" , idamage = 4 `d` 1 , idesc = "A weapon you can still use if disarmed." -- great example of tutorial hints inside a flavourful text } -- * Other weapon organs hookedClaw = fist { iname = "hooked claw" , ifreq = [("hooked claw", 50)] , icount = 2 -- even if more, only the fore claws used for fighting , iverbHit = "hook" , idamage = 2 `d` 1 , iaspects = Timeout (12 - 1 `dL` 3) : iaspects fist , ieffects = [toOrganBad "slowed" 2] , idesc = "A curved talon." } smallClaw = fist { iname = "small claw" , ifreq = [("small claw", 50)] , iverbHit = "slash" , idamage = 2 `d` 1 , idesc = "A pearly spike." } snout = fist { iname = "snout" , ifreq = [("snout", 10)] , icount = 1 , iverbHit = "bite" , idamage = 2 `d` 1 , idesc = "Sensitive and wide-nostrilled." } smallJaw = fist { iname = "small jaw" , ifreq = [("small jaw", 20)] , icount = 1 , iverbHit = "rip" , idamage = 3 `d` 1 , idesc = "Filled with small, even teeth." } jaw = fist { iname = "jaw" , ifreq = [("jaw", 20)] , icount = 1 , iverbHit = "rip" , idamage = 5 `d` 1 , idesc = "Delivers a powerful bite." } largeJaw = fist { iname = "large jaw" , ifreq = [("large jaw", 100)] , icount = 1 , iverbHit = "crush" , idamage = 10 `d` 1 , iaspects = [Timeout $ 2 + 1 `d` 2] -- no effect, but limit raw damage ++ iaspects fist , idesc = "Enough to swallow anything in a single gulp." } antler = fist { iname = "antler" , ifreq = [("antler", 100)] , icount = 2 , iverbHit = "ram" , idamage = 4 `d` 1 , iaspects = [ Timeout $ 3 + (1 `d` 3) * 3 , AddSkill SkArmorMelee 10 ] -- bonus doubled ++ iaspects fist , ieffects = [PushActor (ThrowMod 100 50 1)] -- 1 step, slow , idesc = "" } horn = fist { iname = "horn" , ifreq = [("horn", 100)] , icount = 2 , iverbHit = "impale" , idamage = 5 `d` 1 , iaspects = [ AddSkill SkHurtMelee 10 , AddSkill SkArmorMelee 10 ] -- bonus doubled ++ iaspects fist , idesc = "Sharp and long, for defence or attack." } rhinoHorn = fist { iname = "ugly horn" -- made of keratin, unlike real horns , ifreq = [("rhino horn", 100)] , icount = 1 -- single, unlike real horns , iverbHit = "gore" , idamage = 5 `d` 1 , iaspects = [Timeout 5, AddSkill SkHurtMelee 20] ++ iaspects fist , ieffects = [Impress, Yell] -- the owner is a mid-boss, after all , idesc = "Very solid, considering it has the same composition as fingernails." } tentacle = fist { iname = "tentacle" , ifreq = [("tentacle", 50)] , icount = 4 , iverbHit = "slap" , idamage = 4 `d` 1 , idesc = "Damp and dextrous." } thorn = fist { iname = "thorn" , ifreq = [("thorn", 100)] , icount = 2 + 1 `d` 3 , iverbHit = "puncture" , idamage = 2 `d` 1 , iaspects = [SetFlag Meleeable] -- not Durable , ieffects = [VerbNoLonger "be not so thorny any more"] , idesc = "Sharp yet brittle." } boilingFissure = fist { iname = "fissure" , ifreq = [("boiling fissure", 100)] , icount = 5 + 1 `d` 5 , iverbHit = "hiss at" , idamage = 1 `d` 1 , iaspects = [ AddSkill SkHurtMelee 20 -- decreasing as count decreases , SetFlag Meleeable ] -- not Durable , ieffects = [ DropItem 1 1 COrgan "condition" -- useful; limited , VerbNoLonger "widen the crack, releasing pressure" ] , idesc = "A deep crack to the underworld." } arsenicFissure = boilingFissure { iname = "fissure" , ifreq = [("arsenic fissure", 100)] , icount = 3 + 1 `d` 3 , idamage = 2 `d` 1 , ieffects = [ toOrganBad "parsimonious" (5 + 1 `d` 3) -- weaken/poison, impacting intellectual abilities first , VerbNoLonger "stop exuding stupefying vapours" ] , idesc = "" } sulfurFissure = boilingFissure { iname = "fissure" , ifreq = [("sulfur fissure", 100)] , icount = 2 + 1 `d` 2 , idamage = 0 -- heal not via (negative) idamage, for armour would block it , ieffects = [ RefillHP 5 , VerbNoLonger "run out of the healing fumes" ] , idesc = "" } beeSting = fist { iname = "bee sting" , ifreq = [("bee sting", 100)] , icount = 1 , iverbHit = "sting" , idamage = 0 , iaspects = [ AddSkill SkArmorMelee 200, AddSkill SkArmorRanged 45 , SetFlag Meleeable ] -- not Durable , ieffects = [Paralyze 6, RefillHP 4] -- no special message when runs out, because it's 1 copy , idesc = "Painful, but beneficial." } sting = fist { iname = "sting" , ifreq = [("sting", 100)] , icount = 1 , iverbHit = "inject" , idamage = 1 `d` 1 , iaspects = [Timeout $ 10 - 1 `dL` 4, AddSkill SkHurtMelee 40] ++ iaspects fist , ieffects = [toOrganBad "retaining" (3 + 1 `d` 3)] , idesc = "Painful, debilitating and harmful." } venomTooth = fist { iname = "venom tooth" , ifreq = [("venom tooth", 100)] , icount = 2 , iverbHit = "bite" , idamage = 1 `d` 1 , iaspects = Timeout (7 - 1 `dL` 3) : iaspects fist , ieffects = [toOrganBad "slowed" (3 + 1 `d` 3)] , idesc = "A chilling numbness spreads from its bite." } venomFang = fist { iname = "venom fang" , ifreq = [("venom fang", 100)] , icount = 2 , iverbHit = "bite" , idamage = 0 , iaspects = Timeout (10 - 1 `dL` 5) : iaspects fist , ieffects = [toOrganNoTimer "poisoned"] , idesc = "Dripping with deadly venom." } screechingBeak = fist { iname = "screeching beak" , ifreq = [("screeching beak", 100)] , icount = 1 , iverbHit = "peck" , idamage = 3 `d` 1 , iaspects = Timeout (7 - 1 `dL` 3) : iaspects fist , ieffects = [Summon "scavenger" $ 1 `dL` 3] , idesc = "Both a weapon and a beacon, calling more scavengers to the meal." } largeTail = fist { iname = "large tail" , ifreq = [("large tail", 50)] , icount = 1 , iverbHit = "knock" , idamage = 7 `d` 1 , iaspects = [Timeout $ 2 + 1 `d` 2, AddSkill SkHurtMelee 20] ++ iaspects fist -- timeout higher, lest they regain push before closing again , ieffects = [PushActor (ThrowMod 200 50 1)] -- 1 step, fast , idesc = "Almost as long as the trunk." } hugeTail = largeTail { iname = "huge tail" , ifreq = [("huge tail", 50)] , iverbHit = "upend" , iaspects = [Timeout $ 3 + 1 `d` 2, AddSkill SkHurtMelee 20] ++ iaspects fist -- timeout higher, lest they regain push before closing again , ieffects = [PushActor (ThrowMod 400 50 1)] -- 2 steps, fast , idesc = "Slow but immensely heavy." } -- Non-weapons -- * Armor organs armoredSkin = ItemKind { isymbol = ',' , iname = "armored skin" , ifreq = [("armored skin", 100)] , iflavour = zipPlain [Red] , icount = 1 , irarity = [(1, 1)] , iverbHit = "bash" , iweight = 2000 , idamage = 0 , iaspects = [ AddSkill SkArmorMelee 30, AddSkill SkArmorRanged 15 , SetFlag Durable ] , ieffects = [] , idesc = "Homemade armour is just as good." -- hmm, it may get confused with leather armor jackets, etc. , ikit = [] } bark = armoredSkin { iname = "bark" , ifreq = [("bark", 100)] , idesc = "" } -- * Sense organs eye :: Int -> ItemKind eye n = armoredSkin { iname = "eye" , ifreq = [(toGroupName $ "eye" <+> tshow n, 100)] , icount = 2 , iverbHit = "glare at" , iaspects = [ AddSkill SkSight (intToDice n) , SetFlag Durable ] , idesc = "A piercing stare." } eye3 = eye 3 eye6 = eye 6 eye8 = eye 8 vision :: Int -> ItemKind vision n = armoredSkin { iname = "vision" , ifreq = [(toGroupName $ "vision" <+> tshow n, 100)] , iverbHit = "visualize" , iaspects = [ AddSkill SkSight (intToDice n) , SetFlag Durable ] , idesc = "" } vision6 = vision 6 vision12 = vision 12 vision16 = vision 16 nostril = armoredSkin { iname = "nostril" , ifreq = [("nostril", 100)] , icount = 2 , iverbHit = "snuff" , iaspects = [ AddSkill SkSmell 1 -- times 2, from icount , SetFlag Durable ] , idesc = "" } ear :: Int -> ItemKind ear n = armoredSkin { iname = "ear" , ifreq = [(toGroupName $ "ear" <+> tshow n, 100)] , icount = 2 , iverbHit = "overhear" , iaspects = [ AddSkill SkHearing (intToDice n) , SetFlag Durable ] , idesc = "" } ear3 = ear 3 ear6 = ear 6 ear8 = ear 8 -- * Assorted rattleOrgan = armoredSkin { iname = "rattle" , ifreq = [("rattle", 100)] , iverbHit = "announce" , iaspects = [ Timeout $ 10 + (1 `d` 3) * 10 -- long, to limit spam , SetFlag Periodic, SetFlag Durable ] , ieffects = [Yell, RefillCalm 5] , idesc = "" } insectMortality = armoredSkin { iname = "insect mortality" , ifreq = [("insect mortality", 100)] , iverbHit = "age" , iaspects = [ AddSkill SkAggression 2 -- try to attack before you die , Timeout $ 30 + (1 `d` 3) * 10 -- die very slowly , SetFlag Periodic, SetFlag Durable ] , ieffects = [RefillHP (-1), Yell] , idesc = "" } sapientBrain = armoredSkin { iname = "sapient brain" , ifreq = [("sapient brain", 100)] , iverbHit = "outbrain" , iaspects = [AddSkill sk 1 | sk <- [SkMove .. SkApply]] ++ [AddSkill SkMove 4] -- can move at once when waking up ++ [AddSkill SkAlter 4] -- can use all stairs; dig rubble, ice ++ [AddSkill SkWait 2] -- can brace and sleep ++ [AddSkill SkApply 1] -- can use most items, not just foods ++ [SetFlag Durable] , idesc = "" } animalBrain = armoredSkin { iname = "animal brain" , ifreq = [("animal brain", 100)] , iverbHit = "blank" , iaspects = [AddSkill sk 1 | sk <- [SkMove .. SkApply]] ++ [AddSkill SkMove 4] -- can move at once when waking up ++ [AddSkill SkAlter 2] -- can use normal stairs; can't dig ++ [AddSkill SkWait 2] -- can brace and sleep -- No @SkAppy@ bonus, so can only apply foods. ++ [AddSkill SkDisplace (-1)] -- no melee tactics ++ [AddSkill SkMoveItem (-1)] -- no item gathering ++ [AddSkill SkProject (-1)] -- nor item flinging ++ [SetFlag Durable] , idesc = "" } speedGland :: Int -> ItemKind speedGland n = armoredSkin { iname = "speed gland" , ifreq = [(toGroupName $ "speed gland" <+> tshow n, 100)] , iverbHit = "spit at" , iaspects = [ AddSkill SkSpeed $ intToDice n , Timeout $ intToDice (100 `div` n) , SetFlag Periodic, SetFlag Durable ] , ieffects = [RefillHP 1] , idesc = "" } speedGland5 = speedGland 5 speedGland10 = speedGland 10 scentGland = armoredSkin { iname = "scent gland" , ifreq = [("scent gland", 100)] , icount = 10 + 1 `d` 3 -- runs out , iverbHit = "spray at" , iaspects = [ Timeout $ (1 `d` 3) * 10 , SetFlag Periodic, SetFlag Fragile ] -- not Durable , ieffects = [ VerbNoLonger "look spent" , ApplyPerfume , Explode "distressing odor" ] -- keep explosion at the end to avoid the ambiguity of -- "of ([foo explosion] of [bar])" , idesc = "" } boilingVent = armoredSkin { iname = "vent" , ifreq = [("boiling vent", 100)] , iflavour = zipPlain [Blue] , iverbHit = "menace" , iaspects = [ Timeout $ (2 + 1 `d` 3) * 5 , SetFlag Periodic, SetFlag Durable ] , ieffects = [RefillHP 2, Explode "boiling water"] , idesc = "" } arsenicVent = armoredSkin { iname = "vent" , ifreq = [("arsenic vent", 100)] , iflavour = zipPlain [Cyan] , iverbHit = "menace" , iaspects = [ Timeout $ (2 + 1 `d` 3) * 5 , SetFlag Periodic, SetFlag Durable ] , ieffects = [RefillHP 2, Explode "sparse shower"] , idesc = "" } sulfurVent = armoredSkin { iname = "vent" , ifreq = [("sulfur vent", 100)] , iflavour = zipPlain [BrYellow] , iverbHit = "menace" , iaspects = [ Timeout $ (2 + 1 `d` 3) * 5 , SetFlag Periodic, SetFlag Durable ] , ieffects = [RefillHP 2, Explode "dense shower"] , idesc = "" } -- * Special bonusHP = armoredSkin { isymbol = 'H' -- '+' reserved for conditions , iname = "bonus HP" , ifreq = [("bonus HP", 1)] , iflavour = zipPlain [BrBlue] , iverbHit = "intimidate" , iweight = 0 , iaspects = [AddSkill SkMaxHP 1] , idesc = "Growing up in a privileged background gave you the training and the discrete garment accessories that improve your posture and resilience." } braced = armoredSkin { isymbol = 'B' , iname = "braced" , ifreq = [("braced", 1)] , iflavour = zipPlain [BrGreen] , iverbHit = "brace" , iweight = 0 , iaspects = [ AddSkill SkArmorMelee 50, AddSkill SkArmorRanged 25 , AddSkill SkHearing 10 , SetFlag Condition ] -- hack: display as condition , idesc = "Apart of increased resilience to attacks, being braced protects from displacement by foes and other forms of forced translocation, e.g., pushing or pulling." } asleep = armoredSkin { isymbol = 'S' , iname = "asleep" , ifreq = [("asleep", 1)] , iflavour = zipPlain [BrGreen] -- regenerates HP (very slowly) , icount = 5 , iverbHit = "slay" , iweight = 0 , iaspects = [AddSkill sk (-1) | sk <- [SkMove .. SkApply]] ++ [ AddSkill SkMelee 1, AddSkill SkAlter 1, AddSkill SkWait 1 , AddSkill SkSight (-3), AddSkill SkArmorMelee (-10) , SetFlag Condition ] -- hack: display as condition , idesc = "Sleep helps to regain health, albeit extremely slowly. Being asleep makes you vulnerable, with gradually diminishing effects as the slumber wears off over several turns. Any non-idle action, not only combat but even yawning or stretching removes a sizable portion of the sleepiness." } impressed = armoredSkin { isymbol = 'I' , iname = "impressed" , ifreq = [("impressed", 1), ("condition", 1)] , iflavour = zipPlain [BrRed] , iverbHit = "confuse" , iweight = 0 , iaspects = [ AddSkill SkMaxCalm (-1) -- to help player notice on HUD -- and to count as bad condition , SetFlag Fragile -- to announce "no longer" only when -- all impressions gone , SetFlag Condition ] -- this is really a condition, -- just not a timed condition , ieffects = [ OnSmash $ verbMsgLess "impressed" , OnSmash $ verbMsgNoLonger "impressed" ] -- not periodic, so no wear each turn, so only @OnSmash@ , idesc = "Being impressed by one's adversary sounds like fun, but on battlefield it equals treason. Almost. Throw in depleted battle calm and it leads to mindless desertion outright." } -- * LH-specific tooth = fist { iname = "tooth" , ifreq = [("tooth", 20)] , icount = 3 , iverbHit = "nail" , idamage = 2 `d` 1 , idesc = "" } lash = fist { iname = "lash" , ifreq = [("lash", 100)] , icount = 1 , iverbHit = "lash" , idamage = 3 `d` 1 , idesc = "" } noseTip = fist { iname = "tip" , ifreq = [("nose tip", 50)] , icount = 1 , iverbHit = "poke" , idamage = 2 `d` 1 , idesc = "" } lip = fist { iname = "lip" , ifreq = [("lip", 10)] , icount = 1 , iverbHit = "lap" , idamage = 1 `d` 1 , iaspects = Timeout (3 + 1 `d` 2) : iaspects fist , ieffects = [toOrganBad "weakened" (2 + 1 `dL` 3)] , idesc = "" } torsionRight = fist { iname = "right torsion" , ifreq = [("right torsion", 100)] , icount = 1 , iverbHit = "twist" , idamage = 13 `d` 1 , iaspects = [Timeout $ 5 + 1 `d` 5, AddSkill SkHurtMelee 20] ++ iaspects fist , ieffects = [toOrganBad "slowed" (3 + 1 `d` 3)] , idesc = "" } torsionLeft = fist { iname = "left torsion" , ifreq = [("left torsion", 100)] , icount = 1 , iverbHit = "untwist" , idamage = 13 `d` 1 , iaspects = [Timeout $ 5 + 1 `d` 5, AddSkill SkHurtMelee 20] ++ iaspects fist , ieffects = [toOrganBad "weakened" (3 + 1 `d` 3)] , idesc = "" } pupil = fist { iname = "pupil" , ifreq = [("pupil", 100)] , icount = 1 , iverbHit = "gaze at" , idamage = 1 `d` 1 , iaspects = [AddSkill SkSight 12, Timeout 12] ++ iaspects fist , ieffects = [DropItem 1 maxBound COrgan "condition", RefillCalm (-10)] -- can be useful for the player, but Calm drain is a risk , idesc = "" } LambdaHack-0.9.5.0/GameDefinition/Content/ItemKindTemporary.hs0000644000000000000000000001401707346545000022265 0ustar0000000000000000-- | Temporary pseudo-organ (condition) definitions. module Content.ItemKindTemporary ( temporaries ) where import Prelude () import Game.LambdaHack.Core.Prelude import Game.LambdaHack.Content.ItemKind import Game.LambdaHack.Core.Dice import Game.LambdaHack.Definition.Ability import Game.LambdaHack.Definition.Color import Game.LambdaHack.Definition.Defs import Game.LambdaHack.Definition.Flavour temporaries :: [ItemKind] temporaries = [tmpStrengthened, tmpWeakened, tmpProtectedMelee, tmpProtectedRanged, tmpVulnerable, tmpResolute, tmpFast20, tmpSlow10, tmpFarSighted, tmpBlind, tmpKeenSmelling, tmpFoulSmelling, tmpRoseSmelling, tmpNoctovision, tmpDeafened, tmpDeaf, tmpDrunk, tmpBonusSkAggresion, tmpNoSkMove, tmpNoSkMelee, tmpNoSkDisplace, tmpNoSkAlter, tmpNoSkWait, tmpNoSkMoveItem, tmpNoSkProject, tmpNoSkApply, tmpBonusSkMove, tmpBonusSkMelee, tmpBonusSkDisplace, tmpBonusSkAlter, tmpBonusSkWait, tmpBonusSkMoveItem, tmpBonusSkProject, tmpBonusSkApply, tmpRegenerating, tmpPoisoned, tmpSlow10Resistant, tmpPoisonResistant] tmpStrengthened, tmpWeakened, tmpProtectedMelee, tmpProtectedRanged, tmpVulnerable, tmpResolute, tmpFast20, tmpSlow10, tmpFarSighted, tmpBlind, tmpKeenSmelling, tmpFoulSmelling, tmpRoseSmelling, tmpNoctovision, tmpDeafened, tmpDeaf, tmpDrunk, tmpBonusSkAggresion, tmpNoSkMove, tmpNoSkMelee, tmpNoSkDisplace, tmpNoSkAlter, tmpNoSkWait, tmpNoSkMoveItem, tmpNoSkProject, tmpNoSkApply, tmpBonusSkMove, tmpBonusSkMelee, tmpBonusSkDisplace, tmpBonusSkAlter, tmpBonusSkWait, tmpBonusSkMoveItem, tmpBonusSkProject, tmpBonusSkApply, tmpRegenerating, tmpPoisoned, tmpSlow10Resistant, tmpPoisonResistant :: ItemKind -- The @name@ is be used in item description, so it should be an adjective -- describing the temporary set of aspects. -- The messages are needed also under @OnSmash@ to display when item removed -- via @DropItem@ and not via natural periodic activation. tmpAspects :: Text -> [Aspect] -> ItemKind tmpAspects name aspects = ItemKind { isymbol = '+' , iname = name , ifreq = [(toGroupName name, 1), ("condition", 1)] , iflavour = zipPlain [BrWhite] , icount = 1 , irarity = [(1, 1)] , iverbHit = "affect" , iweight = 0 , idamage = 0 , iaspects = -- timeout is 0; activates and vanishes soon, -- depending on initial timer setting aspects ++ [SetFlag Periodic, SetFlag Fragile, SetFlag Condition] , ieffects = [ OnSmash $ verbMsgLess name -- announce partial neutralization -- not spamming for normal periodic wear each turn , OnSmash $ verbMsgNoLonger name -- for forced neutralization , verbMsgNoLonger name ] -- for periodic wear of last copy , idesc = "" -- no description needed; powers are enough , ikit = [] } tmpEffects :: Text -> Dice -> [Effect] -> ItemKind tmpEffects name icount effects = let tmp = tmpAspects name [] in tmp { icount , ieffects = effects ++ ieffects tmp } tmpStrengthened = tmpAspects "strengthened" [AddSkill SkHurtMelee 20] tmpWeakened = tmpAspects "weakened" [AddSkill SkHurtMelee (-30)] -- don't cancel out ^ tmpProtectedMelee = tmpAspects "protected from melee" [AddSkill SkArmorMelee 50] tmpProtectedRanged = tmpAspects "protected from ranged" [AddSkill SkArmorRanged 25] tmpVulnerable = tmpAspects "defenseless" [ AddSkill SkArmorMelee (-50) , AddSkill SkArmorRanged (-25) ] tmpResolute = tmpAspects "resolute" [AddSkill SkMaxCalm 60] tmpFast20 = tmpAspects "hasted" [AddSkill SkSpeed 20] tmpSlow10 = tmpAspects "slowed" [AddSkill SkSpeed (-10)] tmpFarSighted = tmpAspects "far-sighted" [AddSkill SkSight 5] tmpBlind = tmpAspects "blind" [AddSkill SkSight (-99)] tmpKeenSmelling = tmpAspects "keen-smelling" [AddSkill SkSmell 2] tmpFoulSmelling = tmpAspects "foul-smelling" [AddSkill SkOdor 2] tmpRoseSmelling = tmpAspects "rose-smelling" [AddSkill SkOdor (-4)] tmpNoctovision = tmpAspects "shiny-eyed" [AddSkill SkNocto 2] tmpDeafened = tmpAspects "deafened" [AddSkill SkHearing (-10)] tmpDeaf = tmpAspects "deaf" [AddSkill SkHearing (-99)] tmpDrunk = tmpAspects "drunk" [ AddSkill SkHurtMelee 30 -- fury , AddSkill SkArmorMelee (-20) , AddSkill SkArmorRanged (-20) , AddSkill SkSight (-8) ] tmpBonusSkAggresion = tmpAspects "frenzied" [AddSkill SkAggression 5] tmpNoSkMove = tmpAspects "immobile" [AddSkill SkMove (-99)] tmpNoSkMelee = tmpAspects "pacified" [AddSkill SkMelee (-99)] tmpNoSkDisplace = tmpAspects "irreplaceable" [AddSkill SkDisplace (-99)] tmpNoSkAlter = tmpAspects "retaining" [AddSkill SkAlter (-99)] tmpNoSkWait = tmpAspects "impatient" [AddSkill SkWait (-99)] tmpNoSkMoveItem = tmpAspects "dispossessed" [AddSkill SkMoveItem (-99)] tmpNoSkProject = tmpAspects "withholding" [AddSkill SkProject (-99)] tmpNoSkApply = tmpAspects "parsimonious" [AddSkill SkApply (-99)] tmpBonusSkMove = tmpAspects "more mobile" [AddSkill SkMove 5] tmpBonusSkMelee = tmpAspects "more combative" [AddSkill SkMelee 5] tmpBonusSkDisplace = tmpAspects "more displacing" [AddSkill SkDisplace 5] tmpBonusSkAlter = tmpAspects "more altering" [AddSkill SkAlter 5] tmpBonusSkWait = tmpAspects "more patient" [AddSkill SkWait 5] tmpBonusSkMoveItem = tmpAspects "more tidy" [AddSkill SkMoveItem 5] tmpBonusSkProject = tmpAspects "more projecting" [AddSkill SkProject 8] -- TODO: 11, but let player control potion throwing by henchmen; -- beware also of capReinforced and other sources of the skill tmpBonusSkApply = tmpAspects "more practical" [AddSkill SkApply 5] tmpRegenerating = tmpEffects "regenerating" (4 + 1 `d` 2) [RefillHP 1] tmpPoisoned = tmpEffects "poisoned" (4 + 1 `d` 2) [RefillHP (-1)] tmpSlow10Resistant = tmpEffects "slow resistant" (8 + 1 `d` 4) [DropItem 1 1 COrgan "slowed"] tmpPoisonResistant = tmpEffects "poison resistant" (8 + 1 `d` 4) [DropItem 1 maxBound COrgan "poisoned"] LambdaHack-0.9.5.0/GameDefinition/Content/ModeKind.hs0000644000000000000000000006145607346545000020361 0ustar0000000000000000-- | Game mode definitions. module Content.ModeKind ( content ) where import Prelude () import Game.LambdaHack.Core.Prelude import Content.ModeKindPlayer import Game.LambdaHack.Content.CaveKind (CaveKind) import Game.LambdaHack.Content.ModeKind import Game.LambdaHack.Core.Dice import Game.LambdaHack.Definition.Defs content :: [ModeKind] content = [raid, brawl, shootout, hunt, escape, zoo, ambush, crawl, crawlEmpty, crawlSurvival, dig, see, safari, safariSurvival, battle, battleDefense, battleSurvival, defense, defenseEmpty, screensaverRaid, screensaverBrawl, screensaverShootout, screensaverHunt, screensaverEscape, screensaverZoo, screensaverAmbush, screensaverCrawl, screensaverSafari] raid, brawl, shootout, hunt, escape, zoo, ambush, crawl, crawlEmpty, crawlSurvival, dig, see, safari, safariSurvival, battle, battleDefense, battleSurvival, defense, defenseEmpty, screensaverRaid, screensaverBrawl, screensaverShootout, screensaverHunt, screensaverEscape, screensaverZoo, screensaverAmbush, screensaverCrawl, screensaverSafari :: ModeKind -- What other symmetric (two only-one-moves factions) and asymmetric vs crowd -- scenarios make sense (e.g., are good for a tutorial or for standalone -- extreme fun or are impossible as part of a crawl)? -- sparse melee at night: no, shade ambush in brawl is enough -- dense melee: no, keeping big party together is a chore and big enemy -- party is less fun than huge enemy party -- crowd melee in daylight: no, possible in crawl and at night is more fun -- sparse ranged at night: no, less fun than dense and if no reaction fire, -- just a camp fest or firing blindly -- dense ranged in daylight: no, less fun than at night with flares -- crowd ranged: no, fish in a barrel, less predictable and more fun inside -- crawl, even without reaction fire raid = ModeKind -- mini-crawl { msymbol = 'r' , mname = "solo raid (1)" , mfreq = [("solo", 1), ("raid", 1), ("campaign scenario", 1)] , mroster = rosterRaid , mcaves = cavesRaid , mendMsg = [ (Killed, "This expedition has gone wrong. However, scientific mind does not despair, but analyzes and corrects. Did you perchance awake one animal too many? Did you remember to try using all consumables at your disposal for your immediate survival? Did you choose a challenge with difficulty level within your means? Answer honestly, ponder wisely, experiment methodically.") , (Defeated, "Regrettably, the other team snatched the grant, while you were busy contemplating natural phenomena. Science is a competitive sport, as sad as it sounds. It's not enough to make a discovery, you have to get there first.") , (Escape, "You've got hold of the machine! Think of the hours of fun taking it apart and putting it back together again! That's a great first step on your quest to solve the typing problems of the world.") ] , mdesc = "An incredibly advanced typing machine worth 100 gold is buried at the exit of this maze. Be the first to find it and fund a research team that makes typing accurate and dependable forever." } brawl = ModeKind -- sparse melee in daylight, with shade for melee ambush { msymbol = 'k' , mname = "melee brawl (2)" , mfreq = [("melee", 1), ("brawl", 1), ("campaign scenario", 1)] , mroster = rosterBrawl , mcaves = cavesBrawl , mendMsg = [] , mdesc = "Your engineering team disagrees over a drink with some gentlemen scientists about premises of a relative completeness theorem and there's only one way to settle that. Remember to keep your party together, or the opposing team might be tempted to gang upon a solitary disputant." } -- The trajectory tip is important because of tactics of scout looking from -- behind a bush and others hiding in mist. If no suitable bushes, -- fire once and flee into mist or behind cover. Then whomever is out of LOS -- range or inside mist can shoot at the last seen enemy locations, -- adjusting aim according to sounds and incoming missile trajectories. -- If the scout can't find bushes or glass building to set a lookout, -- the other team members are more spotters and guardians than snipers -- and that's their only role, so a small party makes sense. shootout = ModeKind -- sparse ranged in daylight { msymbol = 's' , mname = "foggy shootout (3)" , mfreq = [("foggy", 1), ("shootout", 1), ("campaign scenario", 1)] , mroster = rosterShootout , mcaves = cavesShootout , mendMsg = [] , mdesc = "Whose arguments are most striking and whose ideas fly fastest? Let's scatter up, attack the problems from different angles and find out. (To display the trajectory of any soaring entity, point it with the crosshair in aiming mode.)" } hunt = ModeKind -- melee vs ranged with reaction fire in daylight { msymbol = 'h' , mname = "perilous hunt (4)" , mfreq = [("perilous", 1), ("hunt", 1), ("campaign scenario", 1)] , mroster = rosterHunt , mcaves = cavesHunt , mendMsg = [] , mdesc = "Who is the hunter and who is the prey?" } escape = ModeKind -- asymmetric ranged and stealth race at night { msymbol = 'e' , mname = "night escape (5)" , mfreq = [("night", 1), ("escape", 1), ("campaign scenario", 1)] , mroster = rosterEscape , mcaves = cavesEscape , mendMsg = [] , mdesc = "Dwelling into dark matters is dangerous, so avoid the crowd of firebrand disputants, catch any gems of thought, find a way out and bring back a larger team to shed new light on the field." } zoo = ModeKind -- asymmetric crowd melee at night { msymbol = 'b' , mname = "burning zoo (6)" , mfreq = [("burning", 1), ("zoo", 1), ("campaign scenario", 1)] , mroster = rosterZoo , mcaves = cavesZoo , mendMsg = [] , mdesc = "The heat of the dispute reaches the nearby Wonders of Science and Nature exhibition, igniting greenery, nets and cages. Crazed animals must be dissuaded from ruining precious scientific equipment and setting back the otherwise fruitful exchange of ideas." } -- The tactic is to sneak in the dark, highlight enemy with thrown torches -- (and douse thrown enemy torches with blankets) and only if this fails, -- actually scout using extended noctovision. -- With reaction fire, larger team is more fun. -- -- For now, while we have no shooters with timeout, massive ranged battles -- without reaction fire don't make sense, because then usually only one hero -- shoots (and often also scouts) and others just gather ammo. ambush = ModeKind -- dense ranged with reaction fire vs melee at night { msymbol = 'm' , mname = "ranged ambush (7)" , mfreq = [("ranged", 1), ("ambush", 1), ("campaign scenario", 1)] , mroster = rosterAmbush , mcaves = cavesAmbush , mendMsg = [] , mdesc = "Prevent hijacking of your ideas at all cost! Be stealthy, be observant, be aggressive. Fast execution is what makes or breaks a creative team." } crawl = ModeKind { msymbol = 'c' , mname = "deep crawl (long)" , mfreq = [("deep", 1), ("crawl", 1), ("campaign scenario", 1)] , mroster = rosterCrawl , mcaves = cavesCrawl , mendMsg = [ (Killed, "To think that followers of science and agents of enlightenment would earn death as their reward! Where did we err in our ways? Perhaps nature should not have been disturbed so brashly and the fell beasts woken up from their slumber so eagerly? Perhaps the gathered items should have been used for scientific experiments on the spot rather than hoarded as if of base covetousness? Or perhaps the challenge, chosen freely but without the foreknowledge of the grisly difficulty, was insurmountable and forlorn from the start, despite the enormous power of educated reason at out disposal?") , (Escape, "It's better to live to tell the tale than to choke on more than one can swallow. There was no more exquisite cultural artifacts and glorious scientific wonders in these forbidding tunnels anyway. Or were there?") ] , mdesc = "Enjoy the peaceful seclusion of these cold austere tunnels, but don't let wanton curiosity, greed and the ever-creeping abstraction madness keep you down there for too long. If you find survivors (whole or perturbed or segmented) of the past scientific missions, exercise extreme caution and engage or ignore at your discretion." } safari = ModeKind -- Easter egg available only via screensaver { msymbol = 'f' , mname = "safari" , mfreq = [("safari", 1)] , mroster = rosterSafari , mcaves = cavesSafari , mendMsg = [] , mdesc = "\"In this enactment you'll discover the joys of hunting the most exquisite of Earth's flora and fauna, both animal and semi-intelligent. Exit at the bottommost level.\" This is a drama script recovered from a monster nest debris." } -- * Testing modes dig = ModeKind { msymbol = 'd' , mname = "dig" , mfreq = [("dig", 1)] , mroster = rosterCrawlEmpty , mcaves = cavesDig , mendMsg = [] , mdesc = "Delve deeper!" } see = ModeKind { msymbol = 'a' , mname = "see" , mfreq = [("see", 1)] , mroster = rosterCrawlEmpty , mcaves = cavesSee , mendMsg = [] , mdesc = "See all!" } crawlEmpty = ModeKind { msymbol = 'c' , mname = "crawl empty" , mfreq = [("crawl empty", 1)] , mroster = rosterCrawlEmpty , mcaves = cavesCrawl , mendMsg = [] , mdesc = "Enjoy the free space." } crawlSurvival = ModeKind { msymbol = 'd' , mname = "crawl survival" , mfreq = [("crawl survival", 1)] , mroster = rosterCrawlSurvival , mcaves = cavesCrawl , mendMsg = [] , mdesc = "Lure the human intruders deeper and deeper." } safariSurvival = ModeKind { msymbol = 'u' , mname = "safari survival" , mfreq = [("safari survival", 1)] , mroster = rosterSafariSurvival , mcaves = cavesSafari , mendMsg = [] , mdesc = "In this enactment you'll discover the joys of being hunted among the most exquisite of Earth's flora and fauna, both animal and semi-intelligent." } battle = ModeKind { msymbol = 'b' , mname = "battle" , mfreq = [("battle", 1)] , mroster = rosterBattle , mcaves = cavesBattle , mendMsg = [] , mdesc = "Odds are stacked against those that unleash the horrors of abstraction." } battleDefense = ModeKind { msymbol = 'f' , mname = "battle defense" , mfreq = [("battle defense", 1)] , mroster = rosterBattleDefense , mcaves = cavesBattle , mendMsg = [] , mdesc = "Odds are stacked for those that breathe mathematics." } battleSurvival = ModeKind { msymbol = 'i' , mname = "battle survival" , mfreq = [("battle survival", 1)] , mroster = rosterBattleSurvival , mcaves = cavesBattle , mendMsg = [] , mdesc = "Odds are stacked for those that ally with the strongest." } defense = ModeKind -- perhaps a real scenario in the future { msymbol = 'e' , mname = "defense" , mfreq = [("defense", 1)] , mroster = rosterDefense , mcaves = cavesCrawl , mendMsg = [] , mdesc = "Don't let human interlopers defile your abstract secrets and flee unpunished!" } defenseEmpty = ModeKind { msymbol = 'e' , mname = "defense empty" , mfreq = [("defense empty", 1)] , mroster = rosterDefenseEmpty , mcaves = cavesCrawl , mendMsg = [] , mdesc = "Lord over." } -- * Screensaver modes screensave :: AutoLeader -> Roster -> Roster screensave auto r = let f [] = [] f ((player, initial) : rest) = (player {fleaderMode = LeaderAI auto}, initial) : rest in r {rosterList = f $ rosterList r} screensaverRaid = raid { mname = "auto-raid (1)" , mfreq = [("insert coin", 1), ("no confirms", 1)] , mroster = screensave (AutoLeader False False) rosterRaid } screensaverBrawl = brawl { mname = "auto-brawl (2)" , mfreq = [("no confirms", 1)] , mroster = screensave (AutoLeader False False) rosterBrawl } screensaverShootout = shootout { mname = "auto-shootout (3)" , mfreq = [("insert coin", 1), ("no confirms", 1)] , mroster = screensave (AutoLeader False False) rosterShootout } screensaverHunt = hunt { mname = "auto-hunt (4)" , mfreq = [("insert coin", 1), ("no confirms", 1)] , mroster = screensave (AutoLeader False False) rosterHunt } screensaverEscape = escape { mname = "auto-escape (5)" , mfreq = [("insert coin", 1), ("no confirms", 1)] , mroster = screensave (AutoLeader False False) rosterEscape } screensaverZoo = zoo { mname = "auto-zoo (6)" , mfreq = [("no confirms", 1)] , mroster = screensave (AutoLeader False False) rosterZoo } screensaverAmbush = ambush { mname = "auto-ambush (7)" , mfreq = [("no confirms", 1)] , mroster = screensave (AutoLeader False False) rosterAmbush } screensaverCrawl = crawl { mname = "auto-crawl (long)" , mfreq = [("no confirms", 1)] , mroster = screensave (AutoLeader False False) rosterCrawl } screensaverSafari = safari { mname = "auto-safari" , mfreq = [("insert coin", 1), ("no confirms", 1)] , mroster = -- changing leader by client needed, because of TFollow screensave (AutoLeader False True) rosterSafari } rosterRaid, rosterBrawl, rosterShootout, rosterHunt, rosterEscape, rosterZoo, rosterAmbush, rosterCrawl, rosterCrawlEmpty, rosterCrawlSurvival, rosterSafari, rosterSafariSurvival, rosterBattle, rosterBattleDefense, rosterBattleSurvival, rosterDefense, rosterDefenseEmpty :: Roster rosterRaid = Roster { rosterList = [ ( playerHero {fhiCondPoly = hiHeroShort} , [(-2, 1, "hero")] ) , ( playerAntiHero { fname = "Indigo Founder" , fhiCondPoly = hiHeroShort } , [(-2, 1, "hero")] ) , ( playerAnimal -- starting over escape , [(-2, 2, "animal")] ) , (playerHorror, []) ] -- for summoned monsters , rosterEnemy = [ ("Explorer", "Animal Kingdom") , ("Explorer", "Horror Den") , ("Indigo Founder", "Animal Kingdom") , ("Indigo Founder", "Horror Den") ] , rosterAlly = [] } rosterBrawl = Roster { rosterList = [ ( playerHero { fcanEscape = False , fhiCondPoly = hiHeroMedium } , [(-3, 3, "hero")] ) , ( playerAntiHero { fname = "Indigo Researcher" , fcanEscape = False , fhiCondPoly = hiHeroMedium } , [(-3, 3, "hero")] ) , (playerHorror, []) ] , rosterEnemy = [ ("Explorer", "Indigo Researcher") , ("Explorer", "Horror Den") , ("Indigo Researcher", "Horror Den") ] , rosterAlly = [] } -- Exactly one scout gets a sight boost, to help the aggressor, because he uses -- the scout for initial attack, while camper (on big enough maps) -- can't guess where the attack would come and so can't position his single -- scout to counter the stealthy advance. rosterShootout = Roster { rosterList = [ ( playerHero { fcanEscape = False , fhiCondPoly = hiHeroMedium } , [(-5, 1, "scout hero"), (-5, 2, "ranger hero")] ) , ( playerAntiHero { fname = "Indigo Researcher" , fcanEscape = False , fhiCondPoly = hiHeroMedium } , [(-5, 1, "scout hero"), (-5, 2, "ranger hero")] ) , (playerHorror, []) ] , rosterEnemy = [ ("Explorer", "Indigo Researcher") , ("Explorer", "Horror Den") , ("Indigo Researcher", "Horror Den") ] , rosterAlly = [] } rosterHunt = Roster { rosterList = [ ( playerHero { fcanEscape = False , fhiCondPoly = hiHeroMedium } , [(-6, 7, "soldier hero")] ) , ( playerAntiHero { fname = "Indigo Researcher" , fcanEscape = False , fhiCondPoly = hiHeroMedium } , [(-6, 1, "scout hero"), (-6, 6, "ambusher hero")] ) , (playerHorror, []) ] , rosterEnemy = [ ("Explorer", "Indigo Researcher") , ("Explorer", "Horror Den") , ("Indigo Researcher", "Horror Den") ] , rosterAlly = [] } rosterEscape = Roster { rosterList = [ ( playerHero {fhiCondPoly = hiHeroMedium} , [(-7, 1, "scout hero"), (-7, 2, "escapist hero")] ) , ( playerAntiHero { fname = "Indigo Researcher" , fcanEscape = False -- start on escape , fneverEmpty = False -- loot after killing , fhiCondPoly = hiHeroMedium } , [(-7, 1, "scout hero"), (-7, 6, "ambusher hero")] ) , (playerHorror, []) ] , rosterEnemy = [ ("Explorer", "Indigo Researcher") , ("Explorer", "Horror Den") , ("Indigo Researcher", "Horror Den") ] , rosterAlly = [] } rosterZoo = Roster { rosterList = [ ( playerHero { fcanEscape = False , fhiCondPoly = hiHeroLong } , [(-8, 5, "soldier hero")] ) , ( playerAnimal {fneverEmpty = True} , [(-8, 100, "mobile animal")] ) , (playerHorror, []) ] -- for summoned monsters , rosterEnemy = [ ("Explorer", "Animal Kingdom") , ("Explorer", "Horror Den") ] , rosterAlly = [] } rosterAmbush = Roster { rosterList = [ ( playerHero { fcanEscape = False , fhiCondPoly = hiHeroMedium } , [(-9, 1, "scout hero"), (-9, 5, "ambusher hero")] ) , ( playerAntiHero { fname = "Indigo Researcher" , fcanEscape = False , fhiCondPoly = hiHeroMedium } , [(-9, 12, "soldier hero")] ) , (playerHorror, []) ] , rosterEnemy = [ ("Explorer", "Indigo Researcher") , ("Explorer", "Horror Den") , ("Indigo Researcher", "Horror Den") ] , rosterAlly = [] } rosterCrawl = Roster { rosterList = [ ( playerHero , [(-1, 3, "hero")] ) , ( playerMonster , [(-4, 1, "scout monster"), (-4, 3, "monster")] ) , ( playerAnimal , -- Fun from the start to avoid empty initial level: [ (-1, 1 + 1 `d` 2, "animal") -- Huge battle at the end: , (-10, 100, "mobile animal") ] ) ] , rosterEnemy = [ ("Explorer", "Monster Hive") , ("Explorer", "Animal Kingdom") ] , rosterAlly = [("Monster Hive", "Animal Kingdom")] } rosterCrawlEmpty = Roster { rosterList = [ ( playerHero , [(-1, 1, "hero")] ) , (playerHorror, []) ] -- for spawned and summoned monsters , rosterEnemy = [] , rosterAlly = [] } rosterCrawlSurvival = rosterCrawl { rosterList = [ ( playerAntiHero , [(-1, 3, "hero")] ) , ( playerMonster , [(-4, 1, "scout monster"), (-4, 3, "monster")] ) , ( playerAnimal {fhasUI = True} , -- Fun from the start to avoid empty initial level: [ (-1, 1 + 1 `d` 2, "animal") -- Huge battle at the end: , (-10, 100, "mobile animal") ] ) ] } -- No horrors faction needed, because spawned heroes land in civilian faction. rosterSafari = Roster { rosterList = [ ( playerMonsterTourist , [(-4, 15, "monster")] ) , ( playerHunamConvict , [(-4, 2, "civilian")] ) , ( playerAnimalMagnificent , [(-7, 15, "mobile animal")] ) , ( playerAnimalExquisite -- start on escape , [(-10, 20, "mobile animal")] ) ] , rosterEnemy = [ ("Monster Tourist Office", "Hunam Convict") , ( "Monster Tourist Office" , "Animal Magnificent Specimen Variety" ) , ( "Monster Tourist Office" , "Animal Exquisite Herds and Packs Galore" ) , ( "Animal Magnificent Specimen Variety" , "Hunam Convict" ) , ( "Hunam Convict" , "Animal Exquisite Herds and Packs Galore" ) ] , rosterAlly = [ ( "Animal Magnificent Specimen Variety" , "Animal Exquisite Herds and Packs Galore" ) ] } rosterSafariSurvival = rosterSafari { rosterList = [ ( playerMonsterTourist { fleaderMode = LeaderAI $ AutoLeader True True , fhasUI = False } , [(-4, 15, "monster")] ) , ( playerHunamConvict , [(-4, 3, "civilian")] ) , ( playerAnimalMagnificent { fleaderMode = LeaderUI $ AutoLeader True False , fhasUI = True } , [(-7, 20, "mobile animal")] ) , ( playerAnimalExquisite , [(-10, 30, "mobile animal")] ) ] } rosterBattle = Roster { rosterList = [ ( playerHero { fcanEscape = False , fhiCondPoly = hiHeroLong } , [(-5, 5, "soldier hero")] ) , ( playerMonster {fneverEmpty = True} , [(-5, 35, "mobile monster")] ) , ( playerAnimal {fneverEmpty = True} , [(-5, 30, "mobile animal")] ) ] , rosterEnemy = [ ("Explorer", "Monster Hive") , ("Explorer", "Animal Kingdom") ] , rosterAlly = [("Monster Hive", "Animal Kingdom")] } rosterBattleDefense = rosterBattle { rosterList = [ ( playerHero { fcanEscape = False , fhiCondPoly = hiHeroLong , fleaderMode = LeaderAI $ AutoLeader False False , fhasUI = False } , [(-5, 5, "soldier hero")] ) , ( playerMonster { fneverEmpty = True , fhasUI = True } , [(-5, 35, "mobile monster")] ) , ( playerAnimal {fneverEmpty = True} , [(-5, 30, "mobile animal")] ) ] } rosterBattleSurvival = rosterBattle { rosterList = [ ( playerHero { fcanEscape = False , fhiCondPoly = hiHeroLong , fleaderMode = LeaderAI $ AutoLeader False False , fhasUI = False } , [(-5, 5, "soldier hero")] ) , ( playerMonster {fneverEmpty = True} , [(-5, 35, "mobile monster")] ) , ( playerAnimal { fneverEmpty = True , fhasUI = True } , [(-5, 30, "mobile animal")] ) ] } rosterDefense = rosterCrawl { rosterList = [ ( playerAntiHero , [(-1, 3, "hero")] ) , ( playerAntiMonster , [(-4, 1, "scout monster"), (-4, 3, "monster")] ) , ( playerAnimal , [ (-1, 1 + 1 `d` 2, "animal") , (-10, 100, "mobile animal") ] ) ] } rosterDefenseEmpty = rosterCrawl { rosterList = [ ( playerAntiMonster {fneverEmpty = True} , [(-4, 1, "scout monster")] ) , (playerHorror, []) ] -- for spawned and summoned animals , rosterEnemy = [] , rosterAlly = [] } cavesRaid, cavesBrawl, cavesShootout, cavesHunt, cavesEscape, cavesZoo, cavesAmbush, cavesCrawl, cavesDig, cavesSee, cavesSafari, cavesBattle :: Caves cavesRaid = [([-2], ["caveRaid"])] cavesBrawl = [([-3], ["caveBrawl"])] cavesShootout = [([-5], ["caveShootout"])] cavesHunt = [([-6], ["caveHunt"])] cavesEscape = [([-7], ["caveEscape"])] cavesZoo = [([-8], ["caveZoo"])] cavesAmbush = [([-9], ["caveAmbush"])] listCrawl :: [([Int], [GroupName CaveKind])] listCrawl = [ ([-1], ["caveOutermost"]) , ([-2], ["caveShallowRogue"]) , ([-3], ["caveEmpty"]) , ([-4, -5, -6], ["default random", "caveRogue", "caveArena"]) , ([-7, -8], ["caveRogue", "caveSmoking"]) , ([-9], ["caveLaboratory"]) , ([-10], ["caveMine"]) ] cavesCrawl = listCrawl renumberCaves :: Int -> ([Int], [GroupName CaveKind]) -> ([Int], [GroupName CaveKind]) renumberCaves offset (ns, l) = (map (+ offset) ns, l) cavesDig = concat $ zipWith (map . renumberCaves) [0, -10 ..] (replicate 100 listCrawl) cavesSee = let numberCaves n c = ([n], [c]) in zipWith numberCaves [-1, -2 ..] $ concatMap (replicate 8) allCaves allCaves :: [GroupName CaveKind] allCaves = [ "caveRaid", "caveBrawl", "caveShootout", "caveHunt", "caveEscape", "caveZoo" , "caveAmbush" , "caveRogue", "caveLaboratory", "caveEmpty", "caveArena", "caveSmoking" , "caveNoise", "caveMine" ] cavesSafari = [ ([-4], ["caveSafari1"]) , ([-7], ["caveSafari2"]) , ([-10], ["caveSafari3"]) ] cavesBattle = [([-5], ["caveBattle"])] LambdaHack-0.9.5.0/GameDefinition/Content/ModeKindPlayer.hs0000644000000000000000000001276507346545000021535 0ustar0000000000000000-- | Basic players definitions. module Content.ModeKindPlayer ( playerHero, playerAntiHero, playerCivilian , playerMonster, playerAntiMonster, playerAnimal , playerHorror, playerMonsterTourist, playerHunamConvict , playerAnimalMagnificent, playerAnimalExquisite , hiHeroShort, hiHeroMedium, hiHeroLong, hiDweller ) where import Prelude () import Game.LambdaHack.Core.Prelude import Game.LambdaHack.Content.ModeKind import Game.LambdaHack.Definition.Ability playerHero, playerAntiHero, playerCivilian, playerMonster, playerAntiMonster, playerAnimal, playerHorror, playerMonsterTourist, playerHunamConvict, playerAnimalMagnificent, playerAnimalExquisite :: Player playerHero = Player { fname = "Explorer" , fgroups = ["hero"] , fskillsOther = meleeAdjacent , fcanEscape = True , fneverEmpty = True , fhiCondPoly = hiHeroLong , fhasGender = True , ftactic = TExplore , fleaderMode = LeaderUI $ AutoLeader False False , fhasUI = True } playerAntiHero = playerHero { fleaderMode = LeaderAI $ AutoLeader True False , fhasUI = False } playerCivilian = Player { fname = "Civilian" , fgroups = ["hero", "civilian"] , fskillsOther = zeroSkills -- not coordinated by any leadership , fcanEscape = False , fneverEmpty = True , fhiCondPoly = hiHeroMedium , fhasGender = True , ftactic = TPatrol , fleaderMode = LeaderNull -- unorganized , fhasUI = False } playerMonster = Player { fname = "Monster Hive" , fgroups = ["monster", "mobile monster"] , fskillsOther = zeroSkills , fcanEscape = False , fneverEmpty = False , fhiCondPoly = hiDweller , fhasGender = False , ftactic = TExplore , fleaderMode = -- No point changing leader on level, since all move and they -- don't follow the leader. LeaderAI $ AutoLeader True True , fhasUI = False } playerAntiMonster = playerMonster { fleaderMode = LeaderUI $ AutoLeader True True , fhasUI = True } playerAnimal = Player { fname = "Animal Kingdom" , fgroups = ["animal", "mobile animal", "immobile animal", "scavenger"] , fskillsOther = zeroSkills , fcanEscape = False , fneverEmpty = False , fhiCondPoly = hiDweller , fhasGender = False , ftactic = TRoam -- can't pick up, so no point exploring , fleaderMode = LeaderNull , fhasUI = False } -- | A special player, for summoned actors that don't belong to any -- of the main players of a given game. E.g., animals summoned during -- a brawl game between two hero factions land in the horror faction. -- In every game, either all factions for which summoning items exist -- should be present or a horror player should be added to host them. playerHorror = Player { fname = "Horror Den" , fgroups = [horrorGroup] , fskillsOther = zeroSkills , fcanEscape = False , fneverEmpty = False , fhiCondPoly = [] , fhasGender = False , ftactic = TPatrol -- disoriented , fleaderMode = LeaderNull , fhasUI = False } playerMonsterTourist = playerAntiMonster { fname = "Monster Tourist Office" , fcanEscape = True , fneverEmpty = True -- no spawning , fhiCondPoly = hiHeroMedium , ftactic = TFollow -- follow-the-guide, as tourists do , fleaderMode = LeaderUI $ AutoLeader False False } playerHunamConvict = playerCivilian { fname = "Hunam Convict" , fleaderMode = LeaderAI $ AutoLeader True False } playerAnimalMagnificent = playerAnimal { fname = "Animal Magnificent Specimen Variety" , fneverEmpty = True } playerAnimalExquisite = playerAnimal { fname = "Animal Exquisite Herds and Packs Galore" , fneverEmpty = True } victoryOutcomes :: [Outcome] victoryOutcomes = [Conquer, Escape] hiHeroLong, hiHeroMedium, hiHeroShort, hiDweller :: HiCondPoly hiHeroShort = [ ( [(HiLoot, 100)] , [minBound..maxBound] ) , ( [(HiConst, 100)] , victoryOutcomes ) , ( [(HiSprint, -500)] -- speed matters, but only if fast enough , victoryOutcomes ) , ( [(HiSurvival, 10)] -- few points for surviving long , [minBound..maxBound] \\ victoryOutcomes ) ] hiHeroMedium = [ ( [(HiLoot, 200)] -- usually no loot, but if so, no harm , [minBound..maxBound] ) , ( [(HiConst, 200), (HiLoss, -10)] , victoryOutcomes ) , ( [(HiSprint, -500)] -- speed matters, but only if fast enough , victoryOutcomes ) , ( [(HiBlitz, -100)] -- speed matters always , victoryOutcomes ) , ( [(HiSurvival, 10)] -- few points for surviving long , [minBound..maxBound] \\ victoryOutcomes ) ] -- Heroes in long crawls rejoice in loot. hiHeroLong = [ ( [(HiLoot, 10000)] -- multiplied by fraction of collected , [minBound..maxBound] ) , ( [(HiSprint, -20000)] -- speedrun bonus, if below this number of turns , victoryOutcomes ) , ( [(HiBlitz, -100)] -- speed matters always , victoryOutcomes ) , ( [(HiSurvival, 10)] -- few points for surviving long , [minBound..maxBound] \\ victoryOutcomes ) ] -- Spawners get no points from loot, but try to kill -- all opponents fast or at least hold up for long. hiDweller = [ ( [(HiConst, 1000)] -- no loot, so big win reward , victoryOutcomes ) , ( [(HiConst, 1000), (HiLoss, -10)] , victoryOutcomes ) , ( [(HiSprint, -1000)] -- speedrun bonus, if below , victoryOutcomes ) , ( [(HiBlitz, -100)] -- speed matters , victoryOutcomes ) , ( [(HiSurvival, 100)] , [minBound..maxBound] \\ victoryOutcomes ) ] LambdaHack-0.9.5.0/GameDefinition/Content/PlaceKind.hs0000644000000000000000000007226007346545000020514 0ustar0000000000000000-- | Room, hall and passage definitions. module Content.PlaceKind ( content ) where import Prelude () import Game.LambdaHack.Core.Prelude import qualified Data.Text as T import Game.LambdaHack.Content.PlaceKind import Game.LambdaHack.Content.TileKind (TileKind) import Game.LambdaHack.Definition.Defs content :: [PlaceKind] content = [deadEnd, rect, rect2, rect3, rect4, rectWindows, glasshouse, glasshouse2, glasshouse3, pulpit, ruin, ruin2, collapsed, collapsed2, collapsed3, collapsed4, collapsed5, collapsed6, collapsed7, pillar, pillar2, pillar3, pillar4, pillar5, colonnade, colonnade2, colonnade3, colonnade4, colonnade5, colonnade6, lampPost, lampPost2, lampPost3, lampPost4, treeShade, fogClump, fogClump2, smokeClump, smokeClump2, smokeClump3FGround, bushClump, escapeDown, escapeDown2, escapeDown3, escapeDown4, escapeDown5, staircase1, staircase2, staircase3, staircase4, staircase5, staircase6, staircase7, staircase8, staircase9, staircase10, staircase11, staircase12, staircase13, staircase14, staircase15, staircase16, staircase17, staircase18, staircase19, staircase20, staircase21, staircase22, staircase23, staircase24, staircase25, staircase26, staircase27, staircase28, staircase29, staircase30, staircase31, staircase32, staircase33, staircase34, staircase35, staircase36, staircase37] -- automatically generated ++ generatedStairs ++ generatedEscapes deadEnd, rect, rect2, rect3, rect4, rectWindows, glasshouse, glasshouse2, glasshouse3, pulpit, ruin, ruin2, collapsed, collapsed2, collapsed3, collapsed4, collapsed5, collapsed6, collapsed7, pillar, pillar2, pillar3, pillar4, pillar5, colonnade, colonnade2, colonnade3, colonnade4, colonnade5, colonnade6, lampPost, lampPost2, lampPost3, lampPost4, treeShade, fogClump, fogClump2, smokeClump, smokeClump2, smokeClump3FGround, bushClump, escapeDown, escapeDown2, escapeDown3, escapeDown4, escapeDown5, staircase1, staircase2, staircase3, staircase4, staircase5, staircase6, staircase7, staircase8, staircase9, staircase10, staircase11, staircase12, staircase13, staircase14, staircase15, staircase16, staircase17, staircase18, staircase19, staircase20, staircase21, staircase22, staircase23, staircase24, staircase25, staircase26, staircase27, staircase28, staircase29, staircase30, staircase31, staircase32, staircase33, staircase34, staircase35, staircase36, staircase37 :: PlaceKind staircase :: PlaceKind -- template staircaseBasic :: [PlaceKind] staircaseBasic = [staircase1, staircase2, staircase3, staircase4, staircase5, staircase6, staircase7, staircase8, staircase9, staircase10, staircase11, staircase12, staircase13, staircase14, staircase15, staircase16, staircase17, staircase18, staircase19, staircase20, staircase21, staircase22, staircase23, staircase24, staircase25, staircase26, staircase27, staircase28, staircase29, staircase30, staircase31, staircase32, staircase33, staircase34, staircase35, staircase36, staircase37] generatedStairs :: [PlaceKind] generatedStairs = let gatedStairs = map switchStaircaseToGated staircaseBasic outdoorStairs = map switchStaircaseToOutdoor staircaseBasic stairsAll = staircaseBasic ++ gatedStairs ++ outdoorStairs in gatedStairs ++ outdoorStairs ++ map switchStaircaseToUp stairsAll ++ map switchStaircaseToDown stairsAll escapeDownBasic :: [PlaceKind] escapeDownBasic = [escapeDown, escapeDown2, escapeDown3, escapeDown4, escapeDown5] generatedEscapes :: [PlaceKind] generatedEscapes = let upEscapes = map switchEscapeToUp escapeDownBasic outdoorEscapes = map switchEscapeToOutdoorDown escapeDownBasic in upEscapes ++ outdoorEscapes -- The dots below are @Char.chr 183@, as defined in @TileKind.floorSymbol@. deadEnd = PlaceKind -- needs to have index 0 { psymbol = 'd' , pname = "a dead end" , pfreq = [] , prarity = [] , pcover = CStretch , pfence = FNone , ptopLeft = ["·"] , poverrideDark = [] , poverrideLit = [] } rect = PlaceKind -- Valid for any nonempty area, hence low frequency. { psymbol = 'r' , pname = "a chamber" , pfreq = [("rogue", 30), ("laboratory", 10)] , prarity = [(1, 10), (10, 6)] , pcover = CStretch , pfence = FNone , ptopLeft = [ "--" , "|·" ] , poverrideDark = [] , poverrideLit = [] } rect2 = rect { pname = "a pen" , pfreq = [("zoo", 3)] } rect3 = rect { pname = "a shed" , pfreq = [("brawl", 10), ("shootout", 1)] , poverrideDark = [ ('|', "wall Lit") -- visible from afar , ('-', "wallH Lit") ] , poverrideLit = [ ('|', "wall Lit") , ('-', "wallH Lit") ] } rect4 = rect3 { pname = "cabinet" , pfreq = [("arena", 10)] } rectWindows = PlaceKind { psymbol = 'w' , pname = "a hut" , pfreq = [("escape", 10), ("ambush", 7)] , prarity = [(1, 10), (10, 10)] , pcover = CStretch , pfence = FNone , ptopLeft = [ "-=" , "!·" ] , poverrideDark = [ ('=', "rectWindowsOver_=_Dark") , ('!', "rectWindowsOver_!_Dark") ] , poverrideLit = [ ('=', "rectWindowsOver_=_Lit") , ('!', "rectWindowsOver_!_Lit") ] } glasshouse = PlaceKind { psymbol = 'g' , pname = "a glasshouse" , pfreq = [("shootout", 4)] , prarity = [(1, 10), (10, 7)] , pcover = CStretch , pfence = FNone , ptopLeft = [ "==" , "!·" ] , poverrideDark = [ ('=', "glasshouseOver_=_Lit") -- visible from afar , ('!', "glasshouseOver_!_Lit") ] , poverrideLit = [ ('=', "glasshouseOver_=_Lit") , ('!', "glasshouseOver_!_Lit") ] } glasshouse2 = glasshouse { pname = "a glass cage" , pfreq = [("zoo", 10)] , poverrideDark = [ ('=', "glasshouseOver_=_Dark") , ('!', "glasshouseOver_!_Dark") ] , poverrideLit = [ ('=', "glasshouseOver_=_Lit") , ('!', "glasshouseOver_!_Lit") ] } glasshouse3 = glasshouse { pname = "a reading room" , pfreq = [("arena", 40)] } pulpit = PlaceKind { psymbol = 'p' , pname = "a stand dais" , pfreq = [("arena", 200), ("zoo", 200)] , prarity = [(1, 1)] , pcover = CMirror , pfence = FGround , ptopLeft = [ "==·" , "!··" , "··0" ] , poverrideDark = [ ('=', "glasshouseOver_=_Lit") , ('!', "glasshouseOver_!_Lit") , ('0', "pulpit") ] , poverrideLit = [ ('=', "glasshouseOver_=_Lit") , ('!', "glasshouseOver_!_Lit") , ('0', "pulpit") ] -- except for floor, this will all be lit, regardless of night/dark; OK } ruin = PlaceKind { psymbol = 'R' , pname = "ruins" , pfreq = [("battle", 330)] , prarity = [(1, 1)] , pcover = CStretch , pfence = FNone , ptopLeft = [ "--" , "|X" ] , poverrideDark = [] , poverrideLit = [] } ruin2 = ruin { pname = "blasted walls" , pfreq = [("ambush", 50)] , poverrideDark = [ ('|', "wall Lit") -- visible from afar , ('-', "wallH Lit") ] , poverrideLit = [ ('|', "wall Lit") , ('-', "wallH Lit") ] } collapsed = PlaceKind { psymbol = 'c' , pname = "a collapsed cavern" , pfreq = [("noise", 1)] -- no point taking up space if very little space taken, -- but if no other place can be generated, a failsafe is useful , prarity = [(1, 1)] , pcover = CStretch , pfence = FNone , ptopLeft = [ "0" ] , poverrideDark = [] , poverrideLit = [] } collapsed2 = collapsed { pfreq = [("noise", 1000), ("battle", 200)] , ptopLeft = [ "X0" , "00" ] } collapsed3 = collapsed { pfreq = [("noise", 2000), ("battle", 200)] , ptopLeft = [ "XX0" , "000" ] } collapsed4 = collapsed { pfreq = [("noise", 2000), ("battle", 200)] , ptopLeft = [ "XXX0" , "0000" ] } collapsed5 = collapsed { pfreq = [("noise", 3000), ("battle", 500)] , ptopLeft = [ "XX0" , "X00" , "000" ] } collapsed6 = collapsed { pfreq = [("noise", 4000), ("battle", 1000)] , ptopLeft = [ "XXX0" , "X000" , "0000" ] } collapsed7 = collapsed { pfreq = [("noise", 4000), ("battle", 1000)] , ptopLeft = [ "XXX0" , "XX00" , "0000" ] } pillar = PlaceKind { psymbol = 'p' , pname = "a hall" , pfreq = [("rogue", 600), ("laboratory", 2000)] , prarity = [(1, 1)] , pcover = CStretch , pfence = FNone -- Larger rooms require support pillars. , ptopLeft = [ "----" , "|···" , "|·0·" , "|···" ] , poverrideDark = [] , poverrideLit = [] } pillar2 = pillar { pfreq = [("rogue", 60), ("laboratory", 200)] , ptopLeft = [ "----" , "|0··" , "|···" , "|···" ] } pillar3 = pillar { pfreq = [("rogue", 8000), ("laboratory", 25000)] , ptopLeft = [ "-----" , "|0···" , "|····" , "|··0·" , "|····" ] } pillar4 = pillar { pname = "an exquisite hall" , pfreq = [("rogue", 30000), ("laboratory", 100000)] , ptopLeft = [ "-----" , "|&·0·" , "|····" , "|0·0·" , "|····" ] , poverrideDark = [('&', "cache")] , poverrideLit = [('&', "cache")] } pillar5 = pillar { pname = "a decorated hall" , pfreq = [("rogue", 30000), ("laboratory", 100000)] , ptopLeft = [ "-----" , "|&·0·" , "|····" , "|0···" , "|····" ] , poverrideDark = [('&', "cache")] , poverrideLit = [('&', "cache")] } colonnade = PlaceKind { psymbol = 'c' , pname = "a colonnade" , pfreq = [ ("rogue", 3), ("arena", 20), ("laboratory", 2) , ("empty", 10000), ("mine", 1000), ("brawl", 4) , ("escape", 40), ("ambush", 40) ] , prarity = [(1, 10), (10, 10)] , pcover = CAlternate , pfence = FFloor , ptopLeft = [ "0·" , "··" ] , poverrideDark = [] , poverrideLit = [] } colonnade2 = colonnade { prarity = [(1, 15), (10, 15)] , ptopLeft = [ "0·" , "·0" ] } colonnade3 = colonnade { prarity = [(1, 800), (10, 800)] , ptopLeft = [ "··0" , "·0·" , "0··" ] } colonnade4 = colonnade { prarity = [(1, 200), (10, 200)] , ptopLeft = [ "0··" , "·0·" , "··0" ] } colonnade5 = colonnade { prarity = [(1, 10), (10, 10)] , ptopLeft = [ "0··" , "··0" ] } colonnade6 = colonnade { prarity = [(1, 100), (10, 100)] , ptopLeft = [ "0·" , "··" , "·0" ] } lampPost = PlaceKind { psymbol = 'l' , pname = "a lamp-lit area" , pfreq = [("escape", 200), ("ambush", 200), ("zoo", 100), ("battle", 100)] , prarity = [(1, 1)] , pcover = CVerbatim , pfence = FNone , ptopLeft = [ "X·X" , "·0·" , "X·X" ] , poverrideDark = [('0', "lampPostOver_0"), ('·', "floorActorLit")] , poverrideLit = [('0', "lampPostOver_0"), ('·', "floorActorLit")] } lampPost2 = lampPost { ptopLeft = [ "···" , "·0·" , "···" ] } lampPost3 = lampPost { pfreq = [ ("escape", 3000), ("ambush", 3000), ("zoo", 50) , ("battle", 110) ] , ptopLeft = [ "XX·XX" , "X···X" , "··0··" , "X···X" , "XX·XX" ] } lampPost4 = lampPost { pfreq = [("escape", 3000), ("ambush", 3000), ("zoo", 50), ("battle", 60)] , ptopLeft = [ "X···X" , "·····" , "··0··" , "·····" , "X···X" ] } treeShade = PlaceKind { psymbol = 't' , pname = "a tree shade" , pfreq = [("brawl", 1000)] , prarity = [(1, 1)] , pcover = CMirror , pfence = FNone , ptopLeft = [ "··s" , "s0·" , "Xs·" ] , poverrideDark = [ ('0', "treeShadeOver_0_Dark") , ('s', "treeShadeOver_s_Dark") , ('·', "shaded ground") ] , poverrideLit = [ ('0', "treeShadeOver_0_Lit") , ('s', "treeShadeOver_s_Lit") , ('·', "shaded ground") ] } fogClump = PlaceKind { psymbol = 'f' , pname = "a foggy patch" , pfreq = [("shootout", 150), ("empty", 15)] , prarity = [(1, 1)] , pcover = CMirror , pfence = FNone , ptopLeft = [ "f;" , ";f" , ";X" ] , poverrideDark = [('f', "fogClumpOver_f_Dark"), (';', "fog Lit")] , poverrideLit = [('f', "fogClumpOver_f_Lit"), (';', "fog Lit")] } fogClump2 = fogClump { pfreq = [("shootout", 500), ("empty", 50)] , ptopLeft = [ "X;f" , "f;f" , ";;f" , "Xff" ] } smokeClump = PlaceKind { psymbol = 's' , pname = "a smoky patch" , pfreq = [("zoo", 50)] , prarity = [(1, 1)] , pcover = CMirror , pfence = FNone , ptopLeft = [ "f;" , ";f" , ";X" ] , poverrideDark = [ ('f', "smokeClumpOver_f_Dark"), (';', "smoke Lit") , ('·', "floorActorDark") ] , poverrideLit = [ ('f', "smokeClumpOver_f_Lit"), (';', "smoke Lit") , ('·', "floorActorLit") ] } smokeClump2 = smokeClump { pfreq = [("zoo", 500)] , ptopLeft = [ "X;f" , "f;f" , ";;f" , "Xff" ] } smokeClump3FGround = smokeClump { pname = "a burned out area" , pfreq = [("laboratory", 150)] , prarity = [(1, 1)] , pcover = CVerbatim , pfence = FGround , ptopLeft = [ ";f;" , "f·f" , "f·f" , ";f;" ] -- should not be used in caves with trails, because bushes should -- not grow over such artificial trails } bushClump = PlaceKind { psymbol = 'b' , pname = "a bushy patch" , pfreq = [("shootout", 80)] , prarity = [(1, 1)] , pcover = CMirror , pfence = FNone , ptopLeft = [ "f;" , ";X" -- one sure exit needed not to block a corner , ";f" ] , poverrideDark = [('f', "bushClumpOver_f_Dark"), (';', "bush Lit")] , poverrideLit = [('f', "bushClumpOver_f_Lit"), (';', "bush Lit")] -- should not be used in caves with trails, because bushes can't -- grow over such artificial trails } escapeDown = PlaceKind { psymbol = '>' , pname = "an escape down" , pfreq = [("escape down", 1)] , prarity = [(1, 1)] , pcover = CVerbatim , pfence = FGround , ptopLeft = [ ">" ] , poverrideDark = [ ('|', "wall Lit") -- visible from afar , ('-', "wallH Lit") ] , poverrideLit = [ ('|', "wall Lit") , ('-', "wallH Lit") ] } escapeDown2 = escapeDown { pfreq = [("escape down", 1000)] , pfence = FFloor , ptopLeft = [ "0·0" , "·>·" , "0·0" ] } escapeDown3 = escapeDown { pfreq = [("escape down", 2000)] , pfence = FNone , ptopLeft = [ "-----" , "|0·0|" , "|·>·|" , "|0·0|" , "-----" ] } escapeDown4 = escapeDown { pfreq = [("escape down", 1000)] , pcover = CMirror , pfence = FFloor , ptopLeft = [ "0··" , "·>·" , "··0" ] } escapeDown5 = escapeDown { pfreq = [("escape down", 2000)] , pcover = CMirror , pfence = FNone , ptopLeft = [ "-----" , "|0··|" , "|·>·|" , "|0·0|" , "-----" ] } staircase = PlaceKind { psymbol = '/' , pname = "a staircase" , pfreq = [("tiny staircase", 1)] -- no cover when arriving; low freq , prarity = [(1, 100), (10, 100)] , pcover = CVerbatim , pfence = FGround , ptopLeft = [ "<·>" ] , poverrideDark = [ ('<', "staircase up"), ('>', "staircase down") , ('I', "signboard") , ('|', "wall Lit"), ('-', "wallH Lit") ] -- seen from afar , poverrideLit = [ ('<', "staircase up"), ('>', "staircase down") , ('I', "signboard") , ('|', "wall Lit"), ('-', "wallH Lit") ] -- seen from afar } staircase1 = staircase { prarity = [(1, 1)] -- no cover when arriving; so low rarity } staircase2 = staircase { pfreq = [("tiny staircase", 3)] , prarity = [(1, 1)] , pfence = FGround , ptopLeft = [ "·<·>·" ] } staircase3 = staircase { prarity = [(1, 1)] , pfence = FFloor } staircase4 = staircase2 { pfence = FFloor , prarity = [(1, 1)] } staircase5 = staircase { pfreq = [("open staircase", 200)] -- no cover, open , pfence = FGround , ptopLeft = [ "0·0" , "···" , "<·>" , "···" , "0·0" ] } staircase6 = staircase { pfreq = [("open staircase", 300)] , pfence = FGround , ptopLeft = [ "0·0·0" , "·····" , "·<·>·" , "·····" , "0·0·0" ] } staircase7 = staircase { pfreq = [("open staircase", 500)] , pfence = FGround , ptopLeft = [ "0·0·0·0" , "·······" , "0·<·>·0" , "·······" , "0·0·0·0" ] } staircase8 = staircase { pfreq = [("open staircase", 2000)] , pfence = FGround , ptopLeft = [ "·0·I·0·" , "0·····0" , "··<·>··" , "0·····0" , "·0·0·0·" ] } staircase9 = staircase { pfreq = [("open staircase", 500)] , pfence = FGround , ptopLeft = [ "0·······0" , "···<·>···" , "0·······0" ] } staircase10 = staircase { pfreq = [("open staircase", 500)] , pfence = FGround , ptopLeft = [ "0·····0" , "··<·>··" , "0·····0" ] } staircase11 = staircase { pfreq = [("closed staircase", 2000)] -- weak cover, low freq , pfence = FFloor , ptopLeft = [ "·0·" , "0·0" , "···" , "<·>" , "···" , "0·0" , "·0·" ] } staircase12 = staircase { pfreq = [("closed staircase", 4000)] , pfence = FFloor , ptopLeft = [ "·0·0·" , "0·0·0" , "·····" , "·<·>·" , "·····" , "0·0·0" , "·0·0·" ] } staircase13 = staircase { pfreq = [("closed staircase", 6000)] , pfence = FFloor , ptopLeft = [ "·0·0·0·" , "0·0·0·0" , "·······" , "0·<·>·0" , "·······" , "0·0·0·0" , "·0·0·0·" ] } staircase14 = staircase { pfreq = [("closed staircase", 10000)] , pfence = FFloor , ptopLeft = [ "0·0·0·0" , "·0·0·0·" , "0·····0" , "··<·>··" , "0·····0" , "·0·0·0·" , "0·0·0·0" ] } staircase15 = staircase { pfreq = [("closed staircase", 20000)] , pfence = FFloor , ptopLeft = [ "·0·0·0·0·" , "0·0·0·0·0" , "·0·····0·" , "0··<·>··0" , "·0·····0·" , "0·0·0·0·0" , "·0·0·0·0·" ] } staircase16 = staircase { pfreq = [("closed staircase", 20000)] , pfence = FFloor , ptopLeft = [ "0·0·0·0·0" , "·0·0·0·0·" , "0·······0" , "·0·<·>·0·" , "0·······0" , "·0·0·0·0·" , "0·0·0·0·0" ] } staircase17 = staircase { pfreq = [("closed staircase", 20000)] , pfence = FFloor , ptopLeft = [ "0·0·0·0·0·0" , "·0·0·0·0·0·" , "0·0·····0·0" , "·0··<·>··0·" , "0·0·····0·0" , "·0·0·0·0·0·" , "0·0·0·0·0·0" ] } staircase18 = staircase { pfreq = [("closed staircase", 80000)] , pfence = FFloor , ptopLeft = [ "··0·0·0·0··" , "·0·0·0·0·0·" , "0·0·····0·0" , "·0··<·>··0·" , "0·0·····0·0" , "·0·0·0·0·0·" , "··0·0·0·0··" ] } staircase19 = staircase { pfreq = [("closed staircase", 20000)] , pfence = FFloor , ptopLeft = [ "·0·0·0·0·0·" , "0·0·0·0·0·0" , "·0·······0·" , "0·0·<·>·0·0" , "·0·······0·" , "0·0·0·0·0·0" , "·0·0·0·0·0·" ] } staircase20 = staircase { pfreq = [("closed staircase", 5000)] , pfence = FFloor , ptopLeft = [ "·0·0·0·0·0·" , "0·0·····0·0" , "·0··<·>··0·" , "0·0·····0·0" , "·0·0·I·0·0·" ] } staircase21 = staircase { pfreq = [("closed staircase", 5000)] , pfence = FFloor , ptopLeft = [ "0·0·I·0·0" , "·0·····0·" , "0··<·>··0" , "·0·····0·" , "0·0·0·0·0" ] } staircase22 = staircase { pfreq = [("closed staircase", 2000)] , pfence = FFloor , ptopLeft = [ "0·0·····0·0" , "·0··<·>··0·" , "0·0·····0·0" ] } staircase23 = staircase { pfreq = [("closed staircase", 1000)] , pfence = FFloor , ptopLeft = [ "·0·······0·" , "0·0·<·>·0·0" , "·0·······0·" ] } staircase24 = staircase { pfreq = [("closed staircase", 1000)] , pfence = FFloor , ptopLeft = [ "·0·····0·" , "0··<·>··0" , "·0·····0·" ] } staircase25 = staircase { pfreq = [("walled staircase", 10)] , pfence = FNone , ptopLeft = [ "-------" , "|·····|" , "|·<·>·|" , "|·····|" , "-------" ] } staircase26 = staircase { pfreq = [("walled staircase", 50)] , pfence = FNone , ptopLeft = [ "---------" , "|·······|" , "|··<·>··|" , "|·······|" , "---------" ] } staircase27 = staircase { pfreq = [("walled staircase", 100)] , pfence = FNone , ptopLeft = [ "---------" , "|0·····0|" , "|··<·>··|" , "|0·····0|" , "---------" ] } staircase28 = staircase { pfreq = [("walled staircase", 1000)] , pfence = FNone , ptopLeft = [ "-------" , "|·····|" , "|·····|" , "|·<·>·|" , "|·····|" , "|·····|" , "-------" ] } staircase29 = staircase { pfreq = [("walled staircase", 1000)] , pfence = FNone , ptopLeft = [ "-------" , "|0···0|" , "|·····|" , "|·<·>·|" , "|·····|" , "|0···0|" , "-------" ] } staircase30 = staircase { pfreq = [("walled staircase", 1000)] , pfence = FNone , ptopLeft = [ "-------" , "|0·0·0|" , "|·····|" , "|·<·>·|" , "|·····|" , "|0·0·0|" , "-------" ] } staircase31 = staircase { pfreq = [("walled staircase", 2000)] , pfence = FNone , ptopLeft = [ "---------" , "|·······|" , "|·······|" , "|··<·>··|" , "|·······|" , "|·······|" , "---------" ] } staircase32 = staircase { pfreq = [("walled staircase", 5000)] , pfence = FNone , ptopLeft = [ "---------" , "|0·····0|" , "|·······|" , "|··<·>··|" , "|·······|" , "|0·····0|" , "---------" ] } staircase33 = staircase { pfreq = [("walled staircase", 5000)] , pfence = FNone , ptopLeft = [ "---------" , "|0·0·0·0|" , "|·······|" , "|0·<·>·0|" , "|·······|" , "|0·0·0·0|" , "---------" ] } staircase34 = staircase { pfreq = [("walled staircase", 5000)] , pfence = FNone , ptopLeft = [ "---------" , "|·0·0·0·|" , "|0·····0|" , "|··<·>··|" , "|0·····0|" , "|·0·I·0·|" , "---------" ] } staircase35 = staircase { pfreq = [("walled staircase", 200)] , pfence = FNone , ptopLeft = [ "-----------" , "|·········|" , "|···<·>···|" , "|·········|" , "-----------" ] } staircase36 = staircase { pfreq = [("walled staircase", 500)] , pfence = FNone , ptopLeft = [ "-----------" , "|·0·····0·|" , "|0··<·>··0|" , "|·0·····0·|" , "-----------" ] } staircase37 = staircase { pfreq = [("walled staircase", 500)] , pfence = FNone , ptopLeft = [ "-----------" , "|0·······0|" , "|·0·<·>·0·|" , "|0·······0|" , "-----------" ] } switchStaircaseToUp :: PlaceKind -> PlaceKind switchStaircaseToUp s = s { psymbol = '<' , pname = pname s <+> "up" , pfreq = map (\(t, k) -> (toGroupName $ fromGroupName t <+> "up", k)) $ pfreq s , poverrideDark = ('>', "stair terminal Dark") : filter ((/= '>') . fst) (poverrideDark s) , poverrideLit = ('>', "stair terminal Lit") : filter ((/= '>') . fst) (poverrideLit s) } switchStaircaseToDown :: PlaceKind -> PlaceKind switchStaircaseToDown s = s { psymbol = '>' , pname = pname s <+> "down" , pfreq = map (\(t, k) -> (toGroupName $ fromGroupName t <+> "down", k)) $ pfreq s , poverrideDark = ('<', "stair terminal Dark") : filter ((/= '<') . fst) (poverrideDark s) , poverrideLit = ('<', "stair terminal Lit") : filter ((/= '<') . fst) (poverrideLit s) } overrideGated :: [(Char, GroupName TileKind)] overrideGated = [ ('<', "gated staircase up"), ('>', "gated staircase down") , ('I', "signboard") , ('|', "wall Lit"), ('-', "wallH Lit") ] -- visible from afar switchStaircaseToGated :: PlaceKind -> PlaceKind switchStaircaseToGated s = s { psymbol = 'g' , pname = T.unwords $ "a gated" : tail (T.words (pname s)) , pfreq = map (first (\t -> toGroupName $ "gated" <+> fromGroupName t)) $ pfreq s , poverrideDark = overrideGated , poverrideLit = overrideGated } overrideOutdoor :: [(Char, GroupName TileKind)] overrideOutdoor = [ ('<', "staircase outdoor up"), ('>', "staircase outdoor down") , ('I', "signboard") , ('|', "wall Lit"), ('-', "wallH Lit") ] -- visible from afar switchStaircaseToOutdoor :: PlaceKind -> PlaceKind switchStaircaseToOutdoor s = s { psymbol = 'o' , pname = "an outdoor area exit" , pfreq = map (first (\t -> toGroupName $ "outdoor" <+> fromGroupName t)) $ pfreq s , poverrideDark = overrideOutdoor , poverrideLit = overrideOutdoor } switchEscapeToUp :: PlaceKind -> PlaceKind switchEscapeToUp s = s { psymbol = '<' , pname = "an escape up" , pfreq = map (\(_, n) -> ("escape up", n)) $ pfreq s , poverrideDark = ('>', "escape up") : poverrideDark s , poverrideLit = ('>', "escape up") : poverrideLit s } switchEscapeToOutdoorDown :: PlaceKind -> PlaceKind switchEscapeToOutdoorDown s = s { pname = "outdoor escape route" , pfreq = map (\(_, n) -> ("escape outdoor down", n)) $ pfreq s , poverrideDark = ('>', "escape outdoor down") : poverrideDark s , poverrideLit = ('>', "escape outdoor down") : poverrideLit s } LambdaHack-0.9.5.0/GameDefinition/Content/RuleKind.hs0000644000000000000000000000211507346545000020367 0ustar0000000000000000{-# LANGUAGE TemplateHaskell #-} -- | Game rules and assorted game setup data. module Content.RuleKind ( standardRules ) where import Prelude () import Language.Haskell.TH.Syntax import System.FilePath import System.IO (readFile) -- Cabal import qualified Paths_LambdaHack as Self (getDataFileName, version) import Game.LambdaHack.Content.RuleKind standardRules :: RuleContent standardRules = RuleContent { rtitle = "LambdaHack" , rXmax = 80 , rYmax = 21 , rfontDir = $(do x <- qRunIO (Self.getDataFileName "GameDefinition/fonts") lift x) , rexeVersion = Self.version -- The strings containing the default configuration file -- included from config.ui.default. , rcfgUIName = "config.ui" <.> "ini" , rcfgUIDefault = $(do let path = "GameDefinition" "config.ui" <.> "default" qAddDependentFile path x <- qRunIO (readFile path) lift x) , rwriteSaveClips = 1000 , rleadLevelClips = 50 , rscoresFile = "LambdaHack.scores" , rnearby = 20 , rstairWordCarried = ["staircase"] -- only one, so inert , rsymbolProjectile = '|' } LambdaHack-0.9.5.0/GameDefinition/Content/TileKind.hs0000644000000000000000000005633607346545000020373 0ustar0000000000000000-- | Terrain tile definitions. module Content.TileKind ( content ) where import Prelude () import Game.LambdaHack.Core.Prelude import qualified Data.Text as T import Game.LambdaHack.Content.TileKind import Game.LambdaHack.Definition.Color import Game.LambdaHack.Definition.Defs content :: [TileKind] content = [unknown, unknownOuterFence, basicOuterFence, bedrock, wall, wallSuspect, wallObscured, wallH, wallSuspectH, wallObscuredDefacedH, wallObscuredFrescoedH, pillar, pillarCache, lampPost, signboardUnread, signboardRead, tree, treeBurnt, treeBurning, rubble, rubbleSpice, doorTrapped, doorClosed, doorTrappedH, doorClosedH, stairsUp, stairsTrappedUp, stairsOutdoorUp, stairsGatedUp, stairsDown, stairsTrappedDown, stairsOutdoorDown, stairsGatedDown, escapeUp, escapeDown, escapeOutdoorDown, wallGlass, wallGlassSpice, wallGlassH, wallGlassHSpice, pillarIce, pulpit, bush, bushBurnt, bushBurning, fog, fogDark, smoke, smokeDark, doorOpen, doorOpenH, floorCorridor, floorArena, floorDamp, floorDirt, floorDirtSpice, floorActor, floorActorItem, floorAshes, shallowWater, shallowWaterSpice, floorRed, floorBlue, floorGreen, floorBrown, floorArenaShade, outdoorFence ] ++ map makeDark ldarkable ++ map makeDarkColor ldarkColorable unknown, unknownOuterFence, basicOuterFence, bedrock, wall, wallSuspect, wallObscured, wallH, wallSuspectH, wallObscuredDefacedH, wallObscuredFrescoedH, pillar, pillarCache, lampPost, signboardUnread, signboardRead, tree, treeBurnt, treeBurning, rubble, rubbleSpice, doorTrapped, doorClosed, doorTrappedH, doorClosedH, stairsUp, stairsTrappedUp, stairsOutdoorUp, stairsGatedUp, stairsDown, stairsTrappedDown, stairsOutdoorDown, stairsGatedDown, escapeUp, escapeDown, escapeOutdoorDown, wallGlass, wallGlassSpice, wallGlassH, wallGlassHSpice, pillarIce, pulpit, bush, bushBurnt, bushBurning, fog, fogDark, smoke, smokeDark, doorOpen, doorOpenH, floorCorridor, floorArena, floorDamp, floorDirt, floorDirtSpice, floorActor, floorActorItem, floorAshes, shallowWater, shallowWaterSpice, floorRed, floorBlue, floorGreen, floorBrown, floorArenaShade, outdoorFence :: TileKind ldarkable :: [TileKind] ldarkable = [wall, wallSuspect, wallObscured, wallH, wallSuspectH, wallObscuredDefacedH, wallObscuredFrescoedH, doorTrapped, doorClosed, doorTrappedH, doorClosedH, wallGlass, wallGlassSpice, wallGlassH, wallGlassHSpice, doorOpen, doorOpenH, floorCorridor, shallowWater, shallowWaterSpice] ldarkColorable :: [TileKind] ldarkColorable = [tree, bush, floorArena, floorDamp, floorDirt, floorDirtSpice, floorActor, floorActorItem] -- Symbols to be used (the Nethack visual tradition imposes inconsistency): -- LOS noLOS -- Walk .|-#~ :; -- noWalk %^-| -| O&<>+ -- -- can be opened ^&+ -- can be closed |- -- some noWalk can be changed without opening, regardless of symbol -- not used yet: -- : (curtain, etc., not flowing, but solid and static) -- `' (not visible enough when immobile) -- Note that for AI hints and UI comfort, most multiple-use @Embed@ tiles -- should have a variant, which after first use transforms into a different -- colour tile without @ChangeTo@ and similar (which then AI no longer touches). -- If a tile is supposed to be repeatedly activated by AI (e.g., cache), -- it should keep @ChangeTo@ for the whole time. -- * Main tiles, in other games modified and some removed -- ** Not walkable -- *** Not clear unknown = TileKind -- needs to have index 0 and alter 1; no other with 1 { tsymbol = ' ' , tname = "unknown space" , tfreq = [("unknown space", 1)] , tcolor = defFG , tcolor2 = defFG , talter = 1 , tfeature = [Dark] } unknownOuterFence = TileKind { tsymbol = ' ' , tname = "unknown space" , tfreq = [("unknown outer fence", 1)] , tcolor = defFG , tcolor2 = defFG , talter = maxBound -- impenetrable , tfeature = [Dark] } basicOuterFence = TileKind { tsymbol = ' ' , tname = "impenetrable bedrock" , tfreq = [("basic outer fence", 1)] , tcolor = defFG , tcolor2 = defFG , talter = maxBound -- impenetrable , tfeature = [Dark] } bedrock = TileKind { tsymbol = ' ' , tname = "bedrock" , tfreq = [("fillerWall", 1), ("legendLit", 100), ("legendDark", 100)] , tcolor = defFG , tcolor2 = defFG , talter = 100 , tfeature = [Dark] -- Bedrock being dark is bad for AI (forces it to backtrack to explore -- bedrock at corridor turns) and induces human micromanagement -- if there can be corridors joined diagonally (humans have to check -- with the xhair if the dark space is bedrock or unexplored). -- Lit bedrock would be even worse for humans, because it's harder -- to guess which tiles are unknown and which can be explored bedrock. -- The setup of Allure is ideal, with lit bedrock that is easily -- distinguished from an unknown tile. However, LH follows the NetHack, -- not the Angband, visual tradition, so we can't improve the situation, -- unless we turn to subtle shades of black or non-ASCII glyphs, -- but that is yet different aesthetics. } wall = TileKind { tsymbol = '|' , tname = "granite wall" , tfreq = [ ("legendLit", 100), ("wall Lit", 100) , ("rectWindowsOver_!_Lit", 80) ] , tcolor = BrWhite , tcolor2 = defFG , talter = 100 , tfeature = [BuildAs "suspect vertical wall Lit"] } wallSuspect = TileKind -- only on client { tsymbol = '|' , tname = "suspect uneven wall" , tfreq = [("suspect vertical wall Lit", 1)] , tcolor = BrWhite , tcolor2 = defFG , talter = 2 , tfeature = [ RevealAs "trapped vertical door Lit" , ObscureAs "obscured vertical wall Lit" ] } wallObscured = TileKind { tsymbol = '|' , tname = "scratched wall" , tfreq = [("obscured vertical wall Lit", 1)] , tcolor = BrWhite , tcolor2 = defFG , talter = 5 , tfeature = [ Embed "scratch on wall" , HideAs "suspect vertical wall Lit" ] } wallH = TileKind { tsymbol = '-' , tname = "sandstone wall" , tfreq = [ ("legendLit", 100), ("wallH Lit", 100) , ("rectWindowsOver_=_Lit", 80) ] , tcolor = BrWhite , tcolor2 = defFG , talter = 100 , tfeature = [BuildAs "suspect horizontal wall Lit"] } wallSuspectH = TileKind -- only on client { tsymbol = '-' , tname = "suspect painted wall" , tfreq = [("suspect horizontal wall Lit", 1)] , tcolor = BrWhite , tcolor2 = defFG , talter = 2 , tfeature = [ RevealAs "trapped horizontal door Lit" , ObscureAs "obscured horizontal wall Lit" ] } wallObscuredDefacedH = TileKind { tsymbol = '-' , tname = "defaced wall" , tfreq = [("obscured horizontal wall Lit", 90)] , tcolor = BrWhite , tcolor2 = defFG , talter = 5 , tfeature = [ Embed "obscene pictogram" , HideAs "suspect horizontal wall Lit" ] } wallObscuredFrescoedH = TileKind { tsymbol = '-' , tname = "frescoed wall" , tfreq = [("obscured horizontal wall Lit", 10)] , tcolor = BrWhite , tcolor2 = defFG , talter = 5 , tfeature = [ Embed "subtle fresco" , HideAs "suspect horizontal wall Lit" ] -- a bit beneficial, but AI would loop if allowed to trigger -- so no @ConsideredByAI@ } pillar = TileKind { tsymbol = '0' , tname = "rock" , tfreq = [ ("cachable", 70) , ("stair terminal Lit", 100), ("stair terminal Dark", 100) , ("legendLit", 100), ("legendDark", 100) , ("emptySetLit", 20), ("noiseSetLit", 700) , ("powerSetDark", 700) , ("battleSetDark", 200), ("brawlSetLit", 50) , ("shootoutSetLit", 10), ("zooSetDark", 10) ] , tcolor = BrCyan -- not BrWhite, to tell from heroes , tcolor2 = Cyan , talter = 100 , tfeature = [] } pillarCache = TileKind { tsymbol = '0' , tname = "smoothed rock" , tfreq = [("cachable", 30), ("cache", 1), ("stair terminal Dark", 4)] -- treasure only in dark staircases , tcolor = BrBlue , tcolor2 = Blue , talter = 5 , tfeature = [ Embed "treasure cache", Embed "treasure cache trap" , ChangeTo "cachable", ConsideredByAI ] -- Not explorable, but prominently placed, so hard to miss. -- Very beneficial, so AI eager to trigger, unless wary of traps. } lampPost = TileKind { tsymbol = '0' , tname = "lamp post" , tfreq = [("lampPostOver_0", 1)] , tcolor = BrYellow , tcolor2 = Brown , talter = 100 , tfeature = [] } signboardUnread = TileKind -- client only, indicates never used by this faction { tsymbol = '0' , tname = "signboard" , tfreq = [("signboard unread", 1)] , tcolor = BrCyan , tcolor2 = Cyan , talter = 5 , tfeature = [ ConsideredByAI -- changes after use, so safe for AI , RevealAs "signboard" -- to display as hidden ] } signboardRead = TileKind { tsymbol = '0' , tname = "signboard" , tfreq = [("signboard", 1), ("escapeSetDark", 1)] , tcolor = BrCyan , tcolor2 = Cyan , talter = 5 , tfeature = [Embed "signboard", HideAs "signboard unread"] } tree = TileKind { tsymbol = '0' , tname = "tree" , tfreq = [ ("brawlSetLit", 140), ("shootoutSetLit", 10) , ("escapeSetLit", 35), ("ambushSetLit", 3) , ("treeShadeOver_0_Lit", 1) ] , tcolor = BrGreen , tcolor2 = Green , talter = 50 , tfeature = [] } treeBurnt = tree { tname = "burnt tree" , tfreq = [ ("ambushSetDark", 3), ("zooSetDark", 7), ("battleSetDark", 50) , ("tree with fire", 30) ] , tcolor = BrBlack , tcolor2 = BrBlack , tfeature = Dark : tfeature tree } treeBurning = tree { tname = "burning tree" , tfreq = [ ("ambushSetDark", 15), ("zooSetDark", 70) , ("tree with fire", 70) ] , tcolor = BrRed , tcolor2 = Red , talter = 5 , tfeature = Embed "big fire" : ChangeTo "tree with fire" : tfeature tree -- TODO: dousing off the tree will have more sense when it periodically -- explodes, hitting and lighting up the team and so betraying it } rubble = TileKind { tsymbol = '&' , tname = "rubble pile" , tfreq = [ ("rubble", 1), ("legendLit", 1), ("legendDark", 1) , ("stair terminal Lit", 4), ("stair terminal Dark", 4) , ("emptySetLit", 10), ("emptySetDark", 10) , ("noiseSetLit", 50), ("powerSetDark", 50) , ("zooSetDark", 100), ("ambushSetDark", 10) ] , tcolor = BrYellow , tcolor2 = Brown , talter = 4 -- boss can dig through , tfeature = [OpenTo "floorAshesLit", Embed "rubble"] -- It's not explorable, due to not being walkable nor clear and due -- to being a door (@OpenTo@), which is kind of OK, because getting -- the item is risky and, e.g., AI doesn't attempt it. -- Also, AI doesn't go out of its way to clear the way for heroes. } rubbleSpice = rubble { tfreq = [("smokeClumpOver_f_Lit", 1), ("smokeClumpOver_f_Dark", 1)] , tfeature = Spice : tfeature rubble } doorTrapped = TileKind { tsymbol = '+' , tname = "trapped door" , tfreq = [("trapped vertical door Lit", 1)] , tcolor = BrRed , tcolor2 = Red , talter = 2 , tfeature = [ Embed "doorway trap" , OpenTo "open vertical door Lit" , HideAs "suspect vertical wall Lit" ] } doorClosed = TileKind { tsymbol = '+' , tname = "closed door" , tfreq = [("closed vertical door Lit", 1)] , tcolor = Brown , tcolor2 = BrBlack , talter = 2 , tfeature = [OpenTo "open vertical door Lit"] -- never hidden } doorTrappedH = TileKind { tsymbol = '+' , tname = "trapped door" , tfreq = [("trapped horizontal door Lit", 1)] , tcolor = BrRed , tcolor2 = Red , talter = 2 , tfeature = [ Embed "doorway trap" , OpenTo "open horizontal door Lit" , HideAs "suspect horizontal wall Lit" ] } doorClosedH = TileKind { tsymbol = '+' , tname = "closed door" , tfreq = [("closed horizontal door Lit", 1)] , tcolor = Brown , tcolor2 = BrBlack , talter = 2 , tfeature = [OpenTo "open horizontal door Lit"] -- never hidden } stairsUp = TileKind { tsymbol = '<' , tname = "staircase up" , tfreq = [("staircase up", 9), ("ordinary staircase up", 1)] , tcolor = BrWhite , tcolor2 = defFG , talter = talterForStairs , tfeature = [Embed "staircase up", ConsideredByAI] } stairsTrappedUp = TileKind { tsymbol = '<' , tname = "windy staircase up" , tfreq = [("staircase up", 1)] , tcolor = BrRed , tcolor2 = Red , talter = talterForStairs , tfeature = [ Embed "staircase up", Embed "staircase trap up" , ConsideredByAI, ChangeTo "ordinary staircase up" ] -- AI uses despite the trap; exploration more important } stairsOutdoorUp = stairsUp { tname = "signpost pointing backward" , tfreq = [("staircase outdoor up", 1)] } stairsGatedUp = stairsUp { tname = "gated staircase up" , tfreq = [("gated staircase up", 1)] , talter = talterForStairs + 2 -- animals and bosses can't use } stairsDown = TileKind { tsymbol = '>' , tname = "staircase down" , tfreq = [("staircase down", 9), ("ordinary staircase down", 1)] , tcolor = BrWhite , tcolor2 = defFG , talter = talterForStairs , tfeature = [Embed "staircase down", ConsideredByAI] } stairsTrappedDown = TileKind { tsymbol = '>' , tname = "crooked staircase down" , tfreq = [("staircase down", 1)] , tcolor = BrRed , tcolor2 = Red , talter = talterForStairs , tfeature = [ Embed "staircase down", Embed "staircase trap down" , ConsideredByAI, ChangeTo "ordinary staircase down" ] } stairsOutdoorDown = stairsDown { tname = "signpost pointing forward" , tfreq = [("staircase outdoor down", 1)] } stairsGatedDown = stairsDown { tname = "gated staircase down" , tfreq = [("gated staircase down", 1)] , talter = talterForStairs + 2 -- animals and bosses can't use } escapeUp = TileKind { tsymbol = '<' , tname = "exit hatch up" , tfreq = [("legendLit", 1), ("legendDark", 1), ("escape up", 1)] , tcolor = BrYellow , tcolor2 = BrYellow , talter = 0 -- anybody can escape (or guard escape) , tfeature = [Embed "escape", ConsideredByAI] } escapeDown = TileKind { tsymbol = '>' , tname = "exit trapdoor down" , tfreq = [("legendLit", 1), ("legendDark", 1), ("escape down", 1)] , tcolor = BrYellow , tcolor2 = BrYellow , talter = 0 -- anybody can escape (or guard escape) , tfeature = [Embed "escape", ConsideredByAI] } escapeOutdoorDown = escapeDown { tname = "exit back to town" , tfreq = [("escape outdoor down", 1)] } -- *** Clear wallGlass = TileKind { tsymbol = '|' , tname = "polished crystal wall" , tfreq = [("glasshouseOver_!_Lit", 1)] , tcolor = BrBlue , tcolor2 = Blue , talter = 10 , tfeature = [BuildAs "closed vertical door Lit", Clear] } wallGlassSpice = wallGlass { tfreq = [("rectWindowsOver_!_Lit", 20)] , tfeature = Spice : tfeature wallGlass } wallGlassH = TileKind { tsymbol = '-' , tname = "polished crystal wall" , tfreq = [("glasshouseOver_=_Lit", 1)] , tcolor = BrBlue , tcolor2 = Blue , talter = 10 , tfeature = [BuildAs "closed horizontal door Lit", Clear] } wallGlassHSpice = wallGlassH { tfreq = [("rectWindowsOver_=_Lit", 20)] , tfeature = Spice : tfeature wallGlassH } pillarIce = TileKind { tsymbol = '^' , tname = "icy outcrop" , tfreq = [("powerSetDark", 300)] , tcolor = BrBlue , tcolor2 = Blue , talter = 4 -- boss can dig through , tfeature = [Clear, Embed "frost", OpenTo "shallow water Lit"] -- Is door, due to @OpenTo@, so is not explorable, but it's OK, because -- it doesn't generate items nor clues. This saves on the need to -- get each ice pillar into sight range when exploring level. } pulpit = TileKind { tsymbol = '%' , tname = "pulpit" , tfreq = [("pulpit", 1)] , tcolor = BrYellow , tcolor2 = Brown , talter = 5 , tfeature = [Clear, Embed "pulpit"] -- mixed blessing, so AI ignores, saved for player fun } bush = TileKind { tsymbol = '%' , tname = "bush" , tfreq = [ ("bush Lit", 1), ("shootoutSetLit", 30), ("escapeSetLit", 40) , ("ambushSetLit", 3), ("bushClumpOver_f_Lit", 1) ] , tcolor = BrGreen , tcolor2 = Green , talter = 10 , tfeature = [Clear] } bushBurnt = bush { tname = "burnt bush" , tfreq = [ ("battleSetDark", 30), ("zooSetDark", 30), ("ambushSetDark", 3) , ("bush with fire", 70) ] , tcolor = BrBlack , tcolor2 = BrBlack , tfeature = Dark : tfeature bush } bushBurning = bush { tname = "burning bush" , tfreq = [ ("ambushSetDark", 15), ("zooSetDark", 300) , ("bush with fire", 30) ] , tcolor = BrRed , tcolor2 = Red , talter = 5 , tfeature = Embed "small fire" : ChangeTo "bush with fire" : tfeature bush } -- ** Walkable -- *** Not clear fog = TileKind { tsymbol = ';' , tname = "faint fog" , tfreq = [ ("fog Lit", 1), ("emptySetLit", 50), ("noiseSetLit", 100) , ("shootoutSetLit", 20) , ("fogClumpOver_f_Lit", 60), ("fogClumpOver_f_Dark", 60) ] -- lit fog is OK for shootout, because LOS is mutual, as opposed -- to dark fog, and so camper has little advantage, especially -- on big maps, where he doesn't know on which side of fog patch to hide , tcolor = BrCyan , tcolor2 = Cyan , talter = 0 , tfeature = [Walkable, NoItem, OftenActor] } fogDark = fog { tname = "thick fog" , tfreq = [ ("emptySetDark", 50), ("powerSetDark", 100) , ("escapeSetDark", 50) ] , tfeature = Dark : tfeature fog } smoke = TileKind { tsymbol = ';' , tname = "billowing smoke" , tfreq = [ ("smoke Lit", 1), ("labTrailLit", 1), ("stair terminal Lit", 4) , ("smokeClumpOver_f_Lit", 3), ("smokeClumpOver_f_Dark", 3) ] , tcolor = Brown , tcolor2 = BrBlack , talter = 0 , tfeature = [Walkable, NoItem] -- not dark, embers } smokeDark = smoke { tname = "lingering smoke" , tfreq = [ ("stair terminal Dark", 4), ("ambushSetDark", 40) , ("zooSetDark", 20), ("battleSetDark", 5) ] , tfeature = Dark : tfeature smoke } -- *** Clear doorOpen = TileKind { tsymbol = '-' , tname = "open door" , tfreq = [("open vertical door Lit", 1)] , tcolor = Brown , tcolor2 = BrBlack , talter = 4 , tfeature = [ Walkable, Clear, NoItem, NoActor , CloseTo "closed vertical door Lit" ] } doorOpenH = TileKind { tsymbol = '|' , tname = "open door" , tfreq = [("open horizontal door Lit", 1)] , tcolor = Brown , tcolor2 = BrBlack , talter = 4 , tfeature = [ Walkable, Clear, NoItem, NoActor , CloseTo "closed horizontal door Lit" ] } floorCorridor = TileKind { tsymbol = '#' , tname = "corridor" , tfreq = [("floorCorridorLit", 1)] , tcolor = BrWhite , tcolor2 = defFG , talter = 0 , tfeature = [Walkable, Clear] } floorArena = floorCorridor { tsymbol = floorSymbol , tname = "stone floor" , tfreq = [ ("floorArenaLit", 1), ("arenaSetLit", 1), ("emptySetLit", 900) , ("zooSetLit", 600) ] } floorDamp = floorArena { tname = "damp stone floor" , tfreq = [ ("noiseSetLit", 600), ("powerSetLit", 600) , ("damp floor Lit", 1), ("stair terminal Lit", 20) ] } floorDirt = floorArena { tname = "dirt" , tfreq = [ ("shootoutSetLit", 1000), ("escapeSetLit", 1000) , ("ambushSetLit", 1000), ("battleSetLit", 1000) , ("brawlSetLit", 1000), ("dirt Lit", 1) ] } floorDirtSpice = floorDirt { tfreq = [("treeShadeOver_s_Lit", 1), ("bushClumpOver_f_Lit", 1)] , tfeature = Spice : tfeature floorDirt } floorActor = floorArena { tfreq = [("floorActorLit", 1)] , tfeature = OftenActor : tfeature floorArena } floorActorItem = floorActor { tfreq = [("legendLit", 100)] , tfeature = VeryOftenItem : tfeature floorActor } floorAshes = floorActor { tfreq = [ ("smokeClumpOver_f_Lit", 2), ("smokeClumpOver_f_Dark", 2) , ("floorAshesLit", 1), ("floorAshesDark", 1) ] , tname = "dirt and ash pile" , tcolor = Brown , tcolor2 = Brown } shallowWater = TileKind { tsymbol = '~' , tname = "water puddle" , tfreq = [ ("shallow water Lit", 1), ("legendLit", 100) , ("emptySetLit", 5), ("noiseSetLit", 20) , ("powerSetLit", 20), ("shootoutSetLit", 5) ] , tcolor = BrCyan , tcolor2 = Cyan , talter = 0 , tfeature = Embed "shallow water" : tfeature floorActor } shallowWaterSpice = shallowWater { tfreq = [("fogClumpOver_f_Lit", 40)] , tfeature = Spice : tfeature shallowWater } floorRed = floorCorridor { tsymbol = floorSymbol , tname = "brick pavement" , tfreq = [("trailLit", 70), ("safeTrailLit", 70)] , tcolor = BrRed , tcolor2 = Red , tfeature = [Embed "straight path", Trail, Walkable, Clear] } floorBlue = floorRed { tname = "frozen trail" , tfreq = [("trailLit", 100)] , tcolor = BrBlue , tcolor2 = Blue , tfeature = [Embed "frozen ground", Trail, Walkable, Clear] } floorGreen = floorRed { tname = "mossy stone path" , tfreq = [("trailLit", 70), ("safeTrailLit", 70)] , tcolor = BrGreen , tcolor2 = Green } floorBrown = floorRed { tname = "rotting mahogany deck" , tfreq = [("trailLit", 50), ("safeTrailLit", 50)] , tcolor = BrMagenta , tcolor2 = Magenta } floorArenaShade = floorActor { tname = "shaded ground" , tfreq = [("shaded ground", 1), ("treeShadeOver_s_Lit", 2)] , tcolor2 = BrBlack , tfeature = Dark : NoItem : tfeature floorActor } outdoorFence = TileKind { tsymbol = ' ' , tname = "event horizon" , tfreq = [("outdoor outer fence", 1)] , tcolor = defFG , tcolor2 = defFG , talter = maxBound -- impenetrable , tfeature = [Dark] } makeDark :: TileKind -> TileKind makeDark k = let darkText :: GroupName TileKind -> GroupName TileKind darkText t = maybe t (toGroupName . (<> "Dark")) $ T.stripSuffix "Lit" $ fromGroupName t darkFrequency = map (first darkText) $ tfreq k darkFeat (OpenTo t) = Just $ OpenTo $ darkText t darkFeat (CloseTo t) = Just $ CloseTo $ darkText t darkFeat (ChangeTo t) = Just $ ChangeTo $ darkText t darkFeat (HideAs t) = Just $ HideAs $ darkText t darkFeat (BuildAs t) = Just $ BuildAs $ darkText t darkFeat (RevealAs t) = Just $ RevealAs $ darkText t darkFeat (ObscureAs t) = Just $ ObscureAs $ darkText t darkFeat VeryOftenItem = Just OftenItem darkFeat OftenItem = Nothing -- items not common in the dark darkFeat feat = Just feat in k { tfreq = darkFrequency , tfeature = Dark : mapMaybe darkFeat (tfeature k) } makeDarkColor :: TileKind -> TileKind makeDarkColor k = (makeDark k) {tcolor2 = BrBlack} LambdaHack-0.9.5.0/GameDefinition/0000755000000000000000000000000007346545000014705 5ustar0000000000000000LambdaHack-0.9.5.0/GameDefinition/InGameHelp.txt0000644000000000000000000001704207346545000017423 0ustar0000000000000000This is a snapshot of in-game help, rendered with default config file. For more general gameplay information see https://github.com/LambdaHack/LambdaHack/blob/master/GameDefinition/PLAYING.md Minimal cheat sheet for casual play. Walk throughout a level with mouse or numeric keypad (left diagram below) or the Vi editor keys (right) or with a compact laptop setup (middle) that requires enabling in config.ui.ini. Run until disturbed with Shift or Control. Go-to with LMB (left mouse button). Run collectively via S-LMB (holding Shift). 7 8 9 7 8 9 y k u \|/ \|/ \|/ 4-5-6 u-i-o h-.-l /|\ /|\ /|\ 1 2 3 j k l b j n In aiming mode, the same keys (and mouse) move the x-hair (aiming crosshair). Press `KP_5` (`5` on keypad) to wait, bracing for impact, which reduces any damage taken and prevents displacement by foes. Press `S-KP_5` or `C-KP_5` (the same key with Shift or Control) to lurk 0.1 of a turn, without bracing. Displace enemies by running into them with Shift/Control or S-LMB. Search, open, descend and attack by bumping into walls, doors, stairs and enemies. The best melee weapon is automatically chosen from your equipment and from among your body parts. The following commands, joined with the basic set above, let you accomplish anything in the game, though not necessarily with the fewest keystrokes. You can also play the game exclusively with a mouse, or both mouse and keyboard. (See the ending help screens for mouse commands.) Lastly, you can select a command with arrows or mouse directly from the help screen or the dashboard and execute it on the spot. keys command E manage equipment of the leader g or , grab item(s) ESC open main menu/finish aiming RET or INS open dashboard/accept target SPACE clear messages and show history S-TAB cycle among all party members KP_* or ! cycle x-hair among enemies KP_/ or / cycle x-hair among items c close door % yell/yawn Here is the complete list of commands from the snapshot of in-game help. For more general gameplay information see https://github.com/LambdaHack/LambdaHack/blob/master/GameDefinition/PLAYING.md Item menu commands. keys command g or , grab item(s) d or . drop item(s) f fling projectile C-f auto-fling and keep choice a apply consumable C-a apply and keep choice p or i pack item e equip item s stash and share item Note how lower case item commands (pack an item, equip, stash) let you move items into a particular item store. Remaining item-related commands. keys command E manage equipment of the leader P or I manage inventory pack of the leader S manage the shared party stash G manage items on the ground A manage all owned items @ describe organs of the leader # show skill summary of the leader ~ display known lore Note how upper case item commands (manage Pack, Equipment, Stash, etc.) let you view and organize items within a particular item store. Once a menu is opened, you can switch stores at will, so each of the commands only determines the starting item store. Each store is accessible from the dashboard, as well. All terrain exploration and alteration commands. keys command TAB cycle among party members on the level S-TAB cycle among all party members c close door C open or close or alter = select (or deselect) party member _ deselect (or select) all on the level ; go to x-hair for 25 steps : run to x-hair collectively for 25 steps x explore nearest unknown spot X autoexplore 25 times R rest (wait 25 times) C-R heed (lurk 0.1 turns 100 times) 0, 1 ... 6 pick a particular actor as the new leader Aiming commands. keys command ESC open main menu/finish aiming RET or INS open dashboard/accept target KP_* or ! cycle x-hair among enemies KP_/ or / cycle x-hair among items + swerve the aiming line - unswerve the aiming line \ cycle aiming modes C-? set x-hair to nearest unknown spot C-/ set x-hair to nearest item C-{ set x-hair to nearest upstairs C-} set x-hair to nearest dnstairs < move aiming one level up > move aiming one level down BACKSPACE clear chosen item and x-hair Mouse overview. Screen area and UI mode (exploration/aiming) determine mouse click effects. First, we give an overview of effects of each button over the game map area. The list includes not only left and right buttons, but also the optional middle mouse button (MMB) and the mouse wheel, which is also used over menus, to page-scroll them. (For mice without RMB, one can use Control key with LMB and for mice without MMB, one can use C-RMB or C-S-LMB.) Next we show mouse button effects per screen area, in exploration mode and (if different) in aiming mode. keys command LMB go to pointer for 25 steps/fling at enemy S-LMB run to pointer collectively for 25 steps/fling at enemy RMB or C-LMB start aiming at enemy under pointer S-RMB open or close or alter at pointer MMB or C-RMB snap x-hair to floor under pointer WHEEL-UP swerve the aiming line WHEEL-DN unswerve the aiming line exploration LMB (left mouse button) RMB (right mouse button) message line clear messages and show history display help leader on map grab item(s) drop item(s) party on map pick new leader on screen select party member on screen the map area go to pointer for 25 steps set x-hair to enemy level number move aiming one level up move aiming one level down level caption open dashboard open main menu percent seen explore nearest unknown spot autoexplore 25 times x-hair info cycle x-hair among enemies cycle x-hair among items party roster pick new leader on screen select party member on screen Calm value yell/yawn yell/yawn HP gauge rest (wait 25 times) heed (lurk 0.1 turns 100 times) HP Value wait a turn, bracing for impact lurk 0.1 of a turn leader info auto-fling and keep choice clear chosen item and x-hair aiming mode LMB (left mouse button) RMB (right mouse button) the map area fling at enemy under pointer snap x-hair to enemy level caption accept target cancel aiming percent seen set x-hair to nearest upstairs set x-hair to nearest dnstairs Assorted commands. keys command SPACE clear messages and show history % yell/yawn C-s start new game C-x save and exit to desktop C-t toggle autoplay (insert coin) C-q quit game and start autoplay C-c exit to desktop without saving ? display help F1 display help immediately F12 open dashboard v voice again the recorded commands V voice recorded commands 100 times C-v voice recorded commands 1000 times C-V voice recorded commands 25 times ' start recording commands C-S save game backup C-P print screen LambdaHack-0.9.5.0/GameDefinition/Main.hs0000644000000000000000000000477607346545000016143 0ustar0000000000000000-- | The main source code file of LambdaHack the game. -- Module "TieKnot" is separated to make it usable in tests. module Main ( main ) where import Prelude () import Game.LambdaHack.Core.Prelude import Control.Concurrent.Async import qualified Control.Exception as Ex import qualified Options.Applicative as OA import System.Exit import qualified System.IO as SIO #ifndef USE_JSFILE import qualified GHC.IO.Handle import System.FilePath import Game.LambdaHack.Common.File (tryCreateDir) import Game.LambdaHack.Common.Misc #endif import Game.LambdaHack.Server (serverOptionsPI) import TieKnot -- | Parse commandline options, tie the engine, content and clients knot, -- run the game and handle exit. main :: IO () main = do -- This test is faulty with JS, because it reports the browser console -- is not a terminal, but then we can't open files to contain the logs. -- Also it bloats the outcome JS file, so disabled. #ifndef USE_JSFILE -- Special case hack, when the game is started not on a console. -- Without this, any attempt to output on stdout crashes a Windows exe -- (at least on Windows Vista) launched from the desktop or start menu. -- This is very crude and results in the inability to, e.g., process -- the output of @--help@ through a unix pipe. However, this should be -- effective on all Windows version, without the need to test all. isTerminal <- SIO.hIsTerminalDevice SIO.stdout unless isTerminal $ do dataDir <- appDataDir tryCreateDir dataDir fstdout <- SIO.openFile (dataDir "stdout.txt") SIO.WriteMode fstderr <- SIO.openFile (dataDir "stderr.txt") SIO.WriteMode GHC.IO.Handle.hDuplicateTo fstdout SIO.stdout GHC.IO.Handle.hDuplicateTo fstderr SIO.stderr #else -- Work around display of one character per line. SIO.hSetBuffering SIO.stderr SIO.LineBuffering #endif -- Fail here, not inside server code, so that savefiles are not removed, -- because they are not the source of the failure. !serverOptions <- OA.execParser serverOptionsPI resOrEx :: Either Ex.SomeException () <- Ex.try $ tieKnot serverOptions let unwrapEx e = #if MIN_VERSION_async(2,2,1) case Ex.fromException e of Just (ExceptionInLinkedThread _ ex) -> unwrapEx ex _ -> #endif e case resOrEx of Right () -> return () Left e -> case Ex.fromException $ unwrapEx e of Just ExitSuccess -> exitSuccess -- we are in the main thread, so here it really exits _ -> Ex.throwIO $ unwrapEx e LambdaHack-0.9.5.0/GameDefinition/MainMenu.ascii0000755000000000000000000000363007346545000017435 0ustar0000000000000000ffjjjjtti,:Lft: tDEGLLfGEKEDKP .iEDEGL.;iiij ... LLfffjjjti;.fL . GDDLfGDEDEtf ;LDWEGi,;iit .. WWELfffjjtt;.if.: .DEGLLGEDLti, ,tLKDG ,;itt. WWW#DLffjjtt;:;j... tDEGfLDEDGtK. LambdaHack itLEG::;itt. WWWWW Lfffjjti:.t... tDEGfLDEDL, tDGj.;itt. WWWKW GLffjjti: t, tDEGLGEEDj; tLDLi,ittj WWWEWG GLffjjti: tt .tDEGGDEDG: ;fEG :iitj WWWKKK GLfffjti: tt tDDLGDEDGf {{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{ ;jGG :iitj WWWKDWL DLffjjti: jt.DDLGDEDLD {{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{ ,jDG .ittj EWWWEDKj DLffjjti: jj.LGDEDLE {{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{ ,jDG ittj DKKWKDEKf GLffjjti::ff.EEDLE {{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{ ,fGG ittj GWKWEDEEt GLffjjji :fL.ELE {{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{ :tGL ittf EEWKKDGDEjt..DLfftjji.,fG:K, {{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{ ,fGj,.tjjf EfKGKDLGDDDGDGLffiiti ttf:. {{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{ .LG;i,;itt ..EDKEKEGjiLDDfGLLfijtii;fL: {{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{ jLj ,;tjtL . . KLEEKKDGLLLGLGLfffjji,;LL:, {{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{ tfL.fijffL ......jDKEEKKKKKEDGLffffji;;LL:. {{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{ EfGii tjff .......KtGDKEDEEDGLGLfffjti,;Lf: {{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{:Df j:jffL. .......::,E,tjjifL,,LLfffjji.;fL. {{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{;iififffL . ....::,;tjLGGGGGLfji;LLfffjjt.,jf.{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{j;i:jfff . :::::,;;;,iiiiiiii;;;;LLfffjjt,,;LL: ,iiijjfffL .. ::::,,;;;;;;;;;;;;;;;;;GLffffjt;j,jff,:: ;ifLjjijifffL .. ....::,,,,;;;;,,,,,,,,,:GLffffjjt:::tLiL;::. .;LLLLGj;i,ffLLL ... ..:::::,,,,,,,,,,,,,, Version X.X.X (frontend: xxx, engine: LambdaHack X.X.X). LambdaHack-0.9.5.0/GameDefinition/MoveKeys.txt0000755000000000000000000000213507346545000017214 0ustar0000000000000000Walk throughout a level with mouse or numeric keypad (left diagram below) or the Vi editor keys (right) or with a compact laptop setup (middle) that requires enabling in config.ui.ini. Run until disturbed with Shift or Control. Go-to with LMB (left mouse button). Run collectively via S-LMB (holding Shift). 7 8 9 7 8 9 y k u \|/ \|/ \|/ 4-5-6 u-i-o h-.-l /|\ /|\ /|\ 1 2 3 j k l b j n In aiming mode, the same keys (and mouse) move the x-hair (aiming crosshair). Press `KP_5` (`5` on keypad) to wait, bracing for impact, which reduces any damage taken and prevents displacement by foes. Press `S-KP_5` or `C-KP_5` (the same key with Shift or Control) to lurk 0.1 of a turn, without bracing. Displace enemies by running into them with Shift/Control or S-LMB. Search, open, descend and attack by bumping into walls, doors, stairs and enemies. The best melee weapon is automatically chosen from your equipment and from among your body parts. LambdaHack-0.9.5.0/GameDefinition/PLAYING.md0000644000000000000000000004376307346545000016347 0ustar0000000000000000Playing LambdaHack ================== The following blurb is a copy of the game intro screen. LambdaHack is a small dungeon crawler illustrating the roguelike game engine of the same name. Playing the game involves exploring spooky dungeons, alone or in a party of fearless explorers, avoiding and setting up ambushes, hiding in shadows from the gaze of unspeakable horrors, discovering secret passages and gorgeous magical treasure and making creative use of it all. The madness-inspiring abominations that multiply in the depths perform the same feats, due to their aberrant, abstract hyper-intelligence. They look out for any sign of weakness or indecision, ready to tirelessly chase the elusive heroes by sight, sound and smell. LambdaHack is a turn-based game. You issue a command. Then you watch its results unfold on the screen without you being able to intervene. Then all settles down and you have as much time as you want to inspect the battlefield and think about your next move. Once the few basic command keys and on-screen symbols are learned, mastery and enjoyment of the game is the matter of tactical skill and literary imagination. To be honest, a lot of imagination is required for this modest sample game, but it has its own distinct quirky mood and is playable and winnable. Contributions are welcome. Please offer feedback to mikolaj.konarski@funktory.com or, preferably, at any of the public forums. If the game window is too large for your screen or you experience other technical issues, please consult [README.md](https://github.com/LambdaHack/LambdaHack/blob/master/README.md) or describe your problem on gitter or the issue tracker. Game map -------- The map of any particular scenario consists of one or many levels and each level has a large number of tiles with a particular terrain kind on each. The game world is persistent, i.e., every time the player visits a level during a single game, its layout is the same. Terrain is depicted with non-letter and non-digit (except zero `0`) characters, the same as items lying on the ground, though blocky solid symbol are more likely to be non-passable terrain than items. In case of doubt, one of the aiming commands (keypad `/`, with default keybinding) cycles through all visible and remembered items on the level and another (keypad `*`, with default keybinding) through all foes. Also, pointing at a map position with `MMB` (middle mouse button) displays a short description of its contents. The basic terrain kinds are as follows. terrain type on-screen symbol wall (horizontal and vertical) - and | tree or rock or man-made column 0 rubble & bush, transparent obstacle % trap, ice obstacle ^ closed door + open door (horizontal and vertical) | and - corridor # smoke or fog ; ground . water ~ stairs or exit up < stairs or exit down > bedrock blank Actors are marked with lower and upper case letters and with characters `@` and `1` through `9` (but never `0`). Player-controlled heroes are always bright white and by default they are selected (e.g., to run together) so they have a blue highlight around their symbol. If player manages to control animals or other actors, they retain their letter and color, but gain a highlight as well. So, for example, the following map shows a room with a closed door, full of actors, connected by a corridor with a room with an open door, a pillar, a staircase down and rubble that obscures one of the corners. The lower row of the larger room is full of items. ------ ------ |@19.| |....&& |r...+#######-...0.>&&| |Ra..| |[?!,)$"=| ------ ---------- Heroes ------ The heroes are displayed on the map with bright white color (red if they are about to fall down) and symbols `@` and `1` through `9` (never `0`). The currently chosen party leader is yellow-highlighted on the map and his attributes are displayed at the bottom-most status line which, in its most complex form, looks as follows. *@12 2m/s Calm: 20/60 HP: 33/50 Leader: Haskell Alvin 6d1+5% 4d1 The line starts with the list of party members, with the current leader highlighted in yellow. Most commands involve only the leader, including movement with keyboard's keypad or `LMB` (left mouse button). If more heroes are selected (highlighted in blue), they run together whenever `:` or `S-LMB` (while holding Shift) over map area is pressed. Any sleeping hero is highlighted in green and can be woken up by yelling with `%`, which also taunts or stresses nearby enemies. Next on the bottom-most status line is the leader's current and maximum Calm (morale, composure, focus, attentiveness), then his current and maximum HP (hit points, health). The colon after "Calm" turning into a dot signifies that the leader is in a position without ambient illumination, making a stealthy conduct easier. A brace sign instead of a colon after "HP" means the leader is braced for combat (see section [Basic Commands](#basic-commands)). In the second half of the bottom-most status line, the leader's name is shown. Then come damage dice of the leader's melee weapons and leader's appendages, ordered by their power. The dice of the first recharged weapon, the one that would be used in this moment, is adorned with percentage damage bonus collected from the whole equipment of the leader. If the dice are displayed with upper-case `D` instead of lower-case `d`, the weapon has additional effects apart of the usual kinetic damage. The nature of the effects can be appraised via the `E`quipment screen. Weapon damage and other item properties are displayed using the dice notation `xdy`, which denotes `x` rolls of `y`-sided dice. A variant written `xdLy` is additionally scaled by the level depth in proportion to the maximal level depth (at the first level it's always one, then it grows up to full rolled value at the last level). Section [Monsters](#monsters) below describes combat resolution in detail, including the role of the percentage damage bonus. The second, the upper status line describes the current level in relation to the party. 5 Lofty hall [33% seen] X-hair: dire basilisk [**__] First comes the depth of the current level and its name. Then the percentage of its explorable tiles already seen by the heroes. The `X-hair` (aiming crosshair) is the common focus of the whole party, marked on the map with a red box and manipulated with mouse or movement keys in aiming mode. In this example, the crosshair points at a dire basilisk monster, with its hit points drawn as a bar. Instead of a monster, the `X-hair` area may describe a position on the map, a recently spotted item on the floor or an item in inventory selected for further action or, if none are available, a summary of the team status. For example, this form 5 Lofty hall [33% seen] X-hair: exact spot (71,12) p15 l10 indicates that the party is aiming at an exact spot on the map. At the end of the status line comes the length of the shortest path from the leader's position to the spot and the straight-line distance between the two points, one that a flung projectile would travel. Basic Commands -------------- This section is a copy of the few basic screens of in-game help. The help pages are automatically generated based on a game's keybinding content and on overrides in the player's config file. The remaining in-game help screens, not shown here, list all game commands grouped by categories in detail. A text snapshot of the complete in-game help is in [InGameHelp.txt](InGameHelp.txt). Walk throughout a level with mouse or numeric keypad (left diagram below) or the Vi editor keys (right) or with a compact laptop setup (middle) that requires enabling in config.ui.ini. Run until disturbed with Shift or Control. Go-to with LMB (left mouse button). Run collectively via S-LMB (holding Shift). 7 8 9 7 8 9 y k u \|/ \|/ \|/ 4-5-6 u-i-o h-.-l /|\ /|\ /|\ 1 2 3 j k l b j n In aiming mode, the same keys (and mouse) move the x-hair (aiming crosshair). Press `KP_5` (`5` on keypad) to wait, bracing for impact, which reduces any damage taken and prevents displacement by foes. Press `S-KP_5` or `C-KP_5` (the same key with Shift or Control) to lurk 0.1 of a turn, without bracing. Displace enemies by running into them with Shift/Control or S-LMB. Search, open, descend and attack by bumping into walls, doors, stairs and enemies. The best melee weapon is automatically chosen from your equipment and from among your body parts. The following commands, joined with the basic set above, let you accomplish anything in the game, though not necessarily with the fewest keystrokes. You can also play the game exclusively with a mouse, or both mouse and keyboard. (See the ending help screens for mouse commands.) Lastly, you can select a command with arrows or mouse directly from the help screen or the dashboard and execute it on the spot. keys command E manage equipment of the leader g or , grab item(s) ESC open main menu/finish aiming RET or INS open dashboard/accept target SPACE clear messages and show history S-TAB cycle among all party members KP_* or ! cycle x-hair among enemies KP_/ or / cycle x-hair among items c close door % yell/yawn Screen area and UI mode (exploration/aiming) determine mouse click effects. First, we give an overview of effects of each button over the game map area. The list includes not only left and right buttons, but also the optional middle mouse button (MMB) and the mouse wheel, which is also used over menus, to page-scroll them. (For mice without RMB, one can use Control key with LMB and for mice without MMB, one can use C-RMB or C-S-LMB.) keys command LMB go to pointer for 25 steps/fling at enemy S-LMB run to pointer collectively for 25 steps/fling at enemy RMB or C-LMB start aiming at enemy under pointer S-RMB open or close or alter at pointer MMB or C-RMB snap x-hair to floor under pointer WHEEL-UP swerve the aiming line WHEEL-DN unswerve the aiming line Advanced Commands ----------------- For ranged attacks, setting the aiming crosshair beforehand is not mandatory, because x-hair is set automatically as soon as a monster comes into view and can still be adjusted for as long as the missile to fling is not chosen. However, sometimes you want to examine the level map tile by tile or assign persistent personal targets to party members. The latter is essential in the rare cases when your henchmen (non-leader characters) can move autonomously or fire opportunistically (via innate skills or rare equipment). Also, if your henchman is adjacent to more than one enemy, setting his target makes him melee a particular foe. You can enter the aiming mode with the `*` keypad key that selects enemies or the `/` key that cycles among items on the floor and marks a tile underneath an item. You can move x-hair with direction keys and assign a personal target to the leader with a `RET` key (Return, Enter). The details of the shared x-hair mark are displayed in a status line close to the bottom of the screen, as explained in section [Heroes](#heroes) above. Commands for saving and exiting the current game, starting a new game, configuring convenience settings for the current game and challenges for the next game are listed in the main menu, brought up by the `ESC` key. Game difficulty, from the challenges menu, determines hitpoints at birth: difficulty below 5 multiplies hitpoints of player characters, difficulty over 5 multiplies hitpoints of their enemies. Of the convenience settings, the `suspect terrain` choice is particularly interesting, because it determines not only screen display of the level map, but also whether suspect tiles are considered for auto-explore and for the `C-?` command that marks the nearest unexplored position. The "lone wolf" challenge mode reduces player's starting actors to exactly one (consequently, this does not affect the initial 'raid' scenario). The "cold fish" challenge mode makes it impossible for player characters to be healed by actors from other factions (this is a significant restriction in the final 'crawl' scenario). For a person new to roguelikes, the 'raid' scenario offers a gentle introduction. The subsequent game scenarios lead the player along an optional story arc. They gradually introduce squad combat, stealth, opportunity fire, asymmetric battles and more. Starting from the second scenario, the player controls a whole team of characters and will develop his repertoire of squad formations, preferred rendezvous locations and the use of light sources. The last scenario, the crawl, is the only one that takes place in a multi-floor setting, spanning 10 varied levels, requiring lots of time and focus to beat and providing considerable replayability. The player has a choice of exploring a single level at a time or portions of many levels along a single staircase. The scenario is the gist and the main challenge of the game, involving strategic resource management and area denial elements. Compared to that, the smaller scenarios provide mostly tactical training and additional entertainment by trying to beat a high-score. They offer variety and a breather between the deaths^H^H^H^H^H^H the brave attempts at the long crawl scenario. Monsters -------- The life of the heroes is full of dangers. Monstrosities, natural and out of this world, roam the dark corridors and crawl from damp holes day and night. While heroes pay attention to all other party members and take care to move one at a time, monsters don't care about each other and all move at once, sometimes brutally colliding by accident. Monsters are depicted on the map with letters. Upper case letters are unique monsters, often guardians of dungeon levels, and lower case letters are the rabble. If there are humans not from our team, they are marked with `@` and `1` through `9` in other colours than white. When a hero walks and bumps into a monster or a monster attacks the hero, melee combat occurs. Hero *running* into and displacing a monster (with the `Shift` or `Control` key), or the other way around, does not inflict damage, but exchanges places. This gives the opponent a free blow, but can improve the tactical situation or aid escape. In some circumstances actors are immune to the displacing, e.g., when both parties form a continuous front-line. In melee combat, the best recharged equipped weapon (or the best fighting organ that is not on cooldown) of each opponent is taken into account for determining the damage and any extra effects of the blow. To determine the damage dealt, the outcome of the weapon's damage dice roll is multiplied by a percentage bonus. The bonus is calculated by taking the damage bonus (summed from the equipped items of the attacker, capped at 200%) minus the melee armor modifier of the defender (capped at 200%, as well), with the outcome bounded between -99% and 99%, which means that at least 1% of damage always gets through and the damage is always lower than twice the dice roll. The current leader's melee bonus, armor modifier and other detailed skills can be viewed via the `#` command. In ranged combat, the projectile is assumed to be attacking the defender in melee, using itself as the weapon, with the usual dice and damage bonus. This time, the ranged armor skill of the defender is taken into account and, additionally, the speed of the missile (based on shape and weight) figures in the calculation. You may propel any item from your inventory (by default you are offered only the appropriate items; press `+` to cycle item menu modes). Only items of a few kinds inflict any damage, but some have other effects, beneficial, detrimental or mixed. In-game detailed item descriptions contain melee and ranged damage estimates. They do not take into account damage from effects and, if bonuses are not known, guesses are based on averages for the item kind in question. The displayed figures are rounded, but the game internally keeps track of minute fractions of HP. The stress of combat drains Calm, gradually limiting viewing radius and, if Calm reaches zero and the actor is sufficiently impressed by his foes, making him defect and surrender to their domination. Whenever the monster's or hero's hit points reach zero, the combatant is incapacitated and promptly dies. When the last hero dies or is dominated, the scenario ends in defeat. On Winning and Dying -------------------- You win a scenario if you escape the location alive (which may prove difficult, because your foes tend to gradually build up the ambush squad blocking your escape route) or, in scenarios with no exit locations, if you eliminate all opposition. In the former case, your score is based predominantly on the gold and precious gems you've plundered. In the latter case, your score is most influenced by the number of turns you spent overcoming your foes (the quicker the victory, the better; the slower the demise, the better). Bonus points, affected by the number of heroes lost, are awarded only if you win. The score is heavily modified by the chosen game difficulty, but not by any other challenges. When all your heroes fall, you are going to invariably see a new foolhardy party of adventurers clamoring to be led into the unknown perils. They start their conquest from a new entrance, with no experience and no equipment, and new undaunted enemies bar their way. Lead the new hopeful explorers with wisdom and fortitude! LambdaHack-0.9.5.0/GameDefinition/PLAYING.md0000755000000000000000000004376307346545000016352 0ustar0000000000000000Playing LambdaHack ================== The following blurb is a copy of the game intro screen. LambdaHack is a small dungeon crawler illustrating the roguelike game engine of the same name. Playing the game involves exploring spooky dungeons, alone or in a party of fearless explorers, avoiding and setting up ambushes, hiding in shadows from the gaze of unspeakable horrors, discovering secret passages and gorgeous magical treasure and making creative use of it all. The madness-inspiring abominations that multiply in the depths perform the same feats, due to their aberrant, abstract hyper-intelligence. They look out for any sign of weakness or indecision, ready to tirelessly chase the elusive heroes by sight, sound and smell. LambdaHack is a turn-based game. You issue a command. Then you watch its results unfold on the screen without you being able to intervene. Then all settles down and you have as much time as you want to inspect the battlefield and think about your next move. Once the few basic command keys and on-screen symbols are learned, mastery and enjoyment of the game is the matter of tactical skill and literary imagination. To be honest, a lot of imagination is required for this modest sample game, but it has its own distinct quirky mood and is playable and winnable. Contributions are welcome. Please offer feedback to mikolaj.konarski@funktory.com or, preferably, at any of the public forums. If the game window is too large for your screen or you experience other technical issues, please consult [README.md](https://github.com/LambdaHack/LambdaHack/blob/master/README.md) or describe your problem on gitter or the issue tracker. Game map -------- The map of any particular scenario consists of one or many levels and each level has a large number of tiles with a particular terrain kind on each. The game world is persistent, i.e., every time the player visits a level during a single game, its layout is the same. Terrain is depicted with non-letter and non-digit (except zero `0`) characters, the same as items lying on the ground, though blocky solid symbol are more likely to be non-passable terrain than items. In case of doubt, one of the aiming commands (keypad `/`, with default keybinding) cycles through all visible and remembered items on the level and another (keypad `*`, with default keybinding) through all foes. Also, pointing at a map position with `MMB` (middle mouse button) displays a short description of its contents. The basic terrain kinds are as follows. terrain type on-screen symbol wall (horizontal and vertical) - and | tree or rock or man-made column 0 rubble & bush, transparent obstacle % trap, ice obstacle ^ closed door + open door (horizontal and vertical) | and - corridor # smoke or fog ; ground . water ~ stairs or exit up < stairs or exit down > bedrock blank Actors are marked with lower and upper case letters and with characters `@` and `1` through `9` (but never `0`). Player-controlled heroes are always bright white and by default they are selected (e.g., to run together) so they have a blue highlight around their symbol. If player manages to control animals or other actors, they retain their letter and color, but gain a highlight as well. So, for example, the following map shows a room with a closed door, full of actors, connected by a corridor with a room with an open door, a pillar, a staircase down and rubble that obscures one of the corners. The lower row of the larger room is full of items. ------ ------ |@19.| |....&& |r...+#######-...0.>&&| |Ra..| |[?!,)$"=| ------ ---------- Heroes ------ The heroes are displayed on the map with bright white color (red if they are about to fall down) and symbols `@` and `1` through `9` (never `0`). The currently chosen party leader is yellow-highlighted on the map and his attributes are displayed at the bottom-most status line which, in its most complex form, looks as follows. *@12 2m/s Calm: 20/60 HP: 33/50 Leader: Haskell Alvin 6d1+5% 4d1 The line starts with the list of party members, with the current leader highlighted in yellow. Most commands involve only the leader, including movement with keyboard's keypad or `LMB` (left mouse button). If more heroes are selected (highlighted in blue), they run together whenever `:` or `S-LMB` (while holding Shift) over map area is pressed. Any sleeping hero is highlighted in green and can be woken up by yelling with `%`, which also taunts or stresses nearby enemies. Next on the bottom-most status line is the leader's current and maximum Calm (morale, composure, focus, attentiveness), then his current and maximum HP (hit points, health). The colon after "Calm" turning into a dot signifies that the leader is in a position without ambient illumination, making a stealthy conduct easier. A brace sign instead of a colon after "HP" means the leader is braced for combat (see section [Basic Commands](#basic-commands)). In the second half of the bottom-most status line, the leader's name is shown. Then come damage dice of the leader's melee weapons and leader's appendages, ordered by their power. The dice of the first recharged weapon, the one that would be used in this moment, is adorned with percentage damage bonus collected from the whole equipment of the leader. If the dice are displayed with upper-case `D` instead of lower-case `d`, the weapon has additional effects apart of the usual kinetic damage. The nature of the effects can be appraised via the `E`quipment screen. Weapon damage and other item properties are displayed using the dice notation `xdy`, which denotes `x` rolls of `y`-sided dice. A variant written `xdLy` is additionally scaled by the level depth in proportion to the maximal level depth (at the first level it's always one, then it grows up to full rolled value at the last level). Section [Monsters](#monsters) below describes combat resolution in detail, including the role of the percentage damage bonus. The second, the upper status line describes the current level in relation to the party. 5 Lofty hall [33% seen] X-hair: dire basilisk [**__] First comes the depth of the current level and its name. Then the percentage of its explorable tiles already seen by the heroes. The `X-hair` (aiming crosshair) is the common focus of the whole party, marked on the map with a red box and manipulated with mouse or movement keys in aiming mode. In this example, the crosshair points at a dire basilisk monster, with its hit points drawn as a bar. Instead of a monster, the `X-hair` area may describe a position on the map, a recently spotted item on the floor or an item in inventory selected for further action or, if none are available, a summary of the team status. For example, this form 5 Lofty hall [33% seen] X-hair: exact spot (71,12) p15 l10 indicates that the party is aiming at an exact spot on the map. At the end of the status line comes the length of the shortest path from the leader's position to the spot and the straight-line distance between the two points, one that a flung projectile would travel. Basic Commands -------------- This section is a copy of the few basic screens of in-game help. The help pages are automatically generated based on a game's keybinding content and on overrides in the player's config file. The remaining in-game help screens, not shown here, list all game commands grouped by categories in detail. A text snapshot of the complete in-game help is in [InGameHelp.txt](InGameHelp.txt). Walk throughout a level with mouse or numeric keypad (left diagram below) or the Vi editor keys (right) or with a compact laptop setup (middle) that requires enabling in config.ui.ini. Run until disturbed with Shift or Control. Go-to with LMB (left mouse button). Run collectively via S-LMB (holding Shift). 7 8 9 7 8 9 y k u \|/ \|/ \|/ 4-5-6 u-i-o h-.-l /|\ /|\ /|\ 1 2 3 j k l b j n In aiming mode, the same keys (and mouse) move the x-hair (aiming crosshair). Press `KP_5` (`5` on keypad) to wait, bracing for impact, which reduces any damage taken and prevents displacement by foes. Press `S-KP_5` or `C-KP_5` (the same key with Shift or Control) to lurk 0.1 of a turn, without bracing. Displace enemies by running into them with Shift/Control or S-LMB. Search, open, descend and attack by bumping into walls, doors, stairs and enemies. The best melee weapon is automatically chosen from your equipment and from among your body parts. The following commands, joined with the basic set above, let you accomplish anything in the game, though not necessarily with the fewest keystrokes. You can also play the game exclusively with a mouse, or both mouse and keyboard. (See the ending help screens for mouse commands.) Lastly, you can select a command with arrows or mouse directly from the help screen or the dashboard and execute it on the spot. keys command E manage equipment of the leader g or , grab item(s) ESC open main menu/finish aiming RET or INS open dashboard/accept target SPACE clear messages and show history S-TAB cycle among all party members KP_* or ! cycle x-hair among enemies KP_/ or / cycle x-hair among items c close door % yell/yawn Screen area and UI mode (exploration/aiming) determine mouse click effects. First, we give an overview of effects of each button over the game map area. The list includes not only left and right buttons, but also the optional middle mouse button (MMB) and the mouse wheel, which is also used over menus, to page-scroll them. (For mice without RMB, one can use Control key with LMB and for mice without MMB, one can use C-RMB or C-S-LMB.) keys command LMB go to pointer for 25 steps/fling at enemy S-LMB run to pointer collectively for 25 steps/fling at enemy RMB or C-LMB start aiming at enemy under pointer S-RMB open or close or alter at pointer MMB or C-RMB snap x-hair to floor under pointer WHEEL-UP swerve the aiming line WHEEL-DN unswerve the aiming line Advanced Commands ----------------- For ranged attacks, setting the aiming crosshair beforehand is not mandatory, because x-hair is set automatically as soon as a monster comes into view and can still be adjusted for as long as the missile to fling is not chosen. However, sometimes you want to examine the level map tile by tile or assign persistent personal targets to party members. The latter is essential in the rare cases when your henchmen (non-leader characters) can move autonomously or fire opportunistically (via innate skills or rare equipment). Also, if your henchman is adjacent to more than one enemy, setting his target makes him melee a particular foe. You can enter the aiming mode with the `*` keypad key that selects enemies or the `/` key that cycles among items on the floor and marks a tile underneath an item. You can move x-hair with direction keys and assign a personal target to the leader with a `RET` key (Return, Enter). The details of the shared x-hair mark are displayed in a status line close to the bottom of the screen, as explained in section [Heroes](#heroes) above. Commands for saving and exiting the current game, starting a new game, configuring convenience settings for the current game and challenges for the next game are listed in the main menu, brought up by the `ESC` key. Game difficulty, from the challenges menu, determines hitpoints at birth: difficulty below 5 multiplies hitpoints of player characters, difficulty over 5 multiplies hitpoints of their enemies. Of the convenience settings, the `suspect terrain` choice is particularly interesting, because it determines not only screen display of the level map, but also whether suspect tiles are considered for auto-explore and for the `C-?` command that marks the nearest unexplored position. The "lone wolf" challenge mode reduces player's starting actors to exactly one (consequently, this does not affect the initial 'raid' scenario). The "cold fish" challenge mode makes it impossible for player characters to be healed by actors from other factions (this is a significant restriction in the final 'crawl' scenario). For a person new to roguelikes, the 'raid' scenario offers a gentle introduction. The subsequent game scenarios lead the player along an optional story arc. They gradually introduce squad combat, stealth, opportunity fire, asymmetric battles and more. Starting from the second scenario, the player controls a whole team of characters and will develop his repertoire of squad formations, preferred rendezvous locations and the use of light sources. The last scenario, the crawl, is the only one that takes place in a multi-floor setting, spanning 10 varied levels, requiring lots of time and focus to beat and providing considerable replayability. The player has a choice of exploring a single level at a time or portions of many levels along a single staircase. The scenario is the gist and the main challenge of the game, involving strategic resource management and area denial elements. Compared to that, the smaller scenarios provide mostly tactical training and additional entertainment by trying to beat a high-score. They offer variety and a breather between the deaths^H^H^H^H^H^H the brave attempts at the long crawl scenario. Monsters -------- The life of the heroes is full of dangers. Monstrosities, natural and out of this world, roam the dark corridors and crawl from damp holes day and night. While heroes pay attention to all other party members and take care to move one at a time, monsters don't care about each other and all move at once, sometimes brutally colliding by accident. Monsters are depicted on the map with letters. Upper case letters are unique monsters, often guardians of dungeon levels, and lower case letters are the rabble. If there are humans not from our team, they are marked with `@` and `1` through `9` in other colours than white. When a hero walks and bumps into a monster or a monster attacks the hero, melee combat occurs. Hero *running* into and displacing a monster (with the `Shift` or `Control` key), or the other way around, does not inflict damage, but exchanges places. This gives the opponent a free blow, but can improve the tactical situation or aid escape. In some circumstances actors are immune to the displacing, e.g., when both parties form a continuous front-line. In melee combat, the best recharged equipped weapon (or the best fighting organ that is not on cooldown) of each opponent is taken into account for determining the damage and any extra effects of the blow. To determine the damage dealt, the outcome of the weapon's damage dice roll is multiplied by a percentage bonus. The bonus is calculated by taking the damage bonus (summed from the equipped items of the attacker, capped at 200%) minus the melee armor modifier of the defender (capped at 200%, as well), with the outcome bounded between -99% and 99%, which means that at least 1% of damage always gets through and the damage is always lower than twice the dice roll. The current leader's melee bonus, armor modifier and other detailed skills can be viewed via the `#` command. In ranged combat, the projectile is assumed to be attacking the defender in melee, using itself as the weapon, with the usual dice and damage bonus. This time, the ranged armor skill of the defender is taken into account and, additionally, the speed of the missile (based on shape and weight) figures in the calculation. You may propel any item from your inventory (by default you are offered only the appropriate items; press `+` to cycle item menu modes). Only items of a few kinds inflict any damage, but some have other effects, beneficial, detrimental or mixed. In-game detailed item descriptions contain melee and ranged damage estimates. They do not take into account damage from effects and, if bonuses are not known, guesses are based on averages for the item kind in question. The displayed figures are rounded, but the game internally keeps track of minute fractions of HP. The stress of combat drains Calm, gradually limiting viewing radius and, if Calm reaches zero and the actor is sufficiently impressed by his foes, making him defect and surrender to their domination. Whenever the monster's or hero's hit points reach zero, the combatant is incapacitated and promptly dies. When the last hero dies or is dominated, the scenario ends in defeat. On Winning and Dying -------------------- You win a scenario if you escape the location alive (which may prove difficult, because your foes tend to gradually build up the ambush squad blocking your escape route) or, in scenarios with no exit locations, if you eliminate all opposition. In the former case, your score is based predominantly on the gold and precious gems you've plundered. In the latter case, your score is most influenced by the number of turns you spent overcoming your foes (the quicker the victory, the better; the slower the demise, the better). Bonus points, affected by the number of heroes lost, are awarded only if you win. The score is heavily modified by the chosen game difficulty, but not by any other challenges. When all your heroes fall, you are going to invariably see a new foolhardy party of adventurers clamoring to be led into the unknown perils. They start their conquest from a new entrance, with no experience and no equipment, and new undaunted enemies bar their way. Lead the new hopeful explorers with wisdom and fortitude! LambdaHack-0.9.5.0/GameDefinition/config.ui.default0000644000000000000000000000351107346545000020134 0ustar0000000000000000; This is a copy of the default UI settings config file ; that is embedded in the game binary. A user config file can override ; these options. Option names are case-sensitive and only ';' for comments ; is permitted. ; ; The game looks for the config file at the same path where saved games ; directory is located. E.g. on Linux the file is at ; ~/.LambdaHack/config.ui.ini ; and on Windows it can be at ; C:\Documents And Settings\user\Application Data\LambdaHack\config.ui.ini ; or at ; C:\Users\\AppData\Roaming\LambdaHack\config.ui.ini ; or elsewhere. [additional_commands] ; Angband compatibility (accept target) Cmd_2 = ("KP_Insert", ([CmdAim], "", ByAimMode AimModeCmd {exploration = ExecuteIfClear Dashboard, aiming = Accept})) [hero_names] HeroName_0 = ("Haskell Alvin", "he") HeroName_1 = ("Alonzo Barkley", "he") HeroName_2 = ("Ines Galenti", "she") HeroName_3 = ("Ernst Abraham", "he") HeroName_4 = ("Samuel Saunders", "he") HeroName_5 = ("Roger Robin", "he") HeroName_6 = ("Christopher Flatt", "he") [ui] ; These two are mutually exclusive: movementViKeys_hjklyubn = True movementLaptopKeys_uk8o79jl = False ; The font to use for scaling SDL2 display (best by multiples or 0.5): ;sdlFontFile = "16x16xw.woff" scalableFontSize = 16 sdlScalableSizeAdd = 0 sdlFontFile = "16x16xw.bdf" sdlBitmapSizeAdd = 0 ;sdlFontFile = "8x8xb.fnt" ;sdlFontFile = "8x8x.fnt" ;sdlBitmapSizeAdd = 2 ; New historyMax takes effect after removal of savefiles. historyMax = 5000 maxFps = 24 noAnim = False hpWarningPercent = 20 ; Uncomment to make all messages white. ; messageColors = [] overrideCmdline = "" ; Legacy: monospace fonts that have fixed size regardless of boldness (on some OSes at least) gtkFontFamily = "DejaVu Sans Mono,Consolas,Courier New,Liberation Mono,Courier,FreeMono,Monospace" ; sdlFonSizeAdd is now ignored ; runStopMsgs is now ignored LambdaHack-0.9.5.0/GameDefinition/config.ui.default0000755000000000000000000000351107346545000020137 0ustar0000000000000000; This is a copy of the default UI settings config file ; that is embedded in the game binary. A user config file can override ; these options. Option names are case-sensitive and only ';' for comments ; is permitted. ; ; The game looks for the config file at the same path where saved games ; directory is located. E.g. on Linux the file is at ; ~/.LambdaHack/config.ui.ini ; and on Windows it can be at ; C:\Documents And Settings\user\Application Data\LambdaHack\config.ui.ini ; or at ; C:\Users\\AppData\Roaming\LambdaHack\config.ui.ini ; or elsewhere. [additional_commands] ; Angband compatibility (accept target) Cmd_2 = ("KP_Insert", ([CmdAim], "", ByAimMode AimModeCmd {exploration = ExecuteIfClear Dashboard, aiming = Accept})) [hero_names] HeroName_0 = ("Haskell Alvin", "he") HeroName_1 = ("Alonzo Barkley", "he") HeroName_2 = ("Ines Galenti", "she") HeroName_3 = ("Ernst Abraham", "he") HeroName_4 = ("Samuel Saunders", "he") HeroName_5 = ("Roger Robin", "he") HeroName_6 = ("Christopher Flatt", "he") [ui] ; These two are mutually exclusive: movementViKeys_hjklyubn = True movementLaptopKeys_uk8o79jl = False ; The font to use for scaling SDL2 display (best by multiples or 0.5): ;sdlFontFile = "16x16xw.woff" scalableFontSize = 16 sdlScalableSizeAdd = 0 sdlFontFile = "16x16xw.bdf" sdlBitmapSizeAdd = 0 ;sdlFontFile = "8x8xb.fnt" ;sdlFontFile = "8x8x.fnt" ;sdlBitmapSizeAdd = 2 ; New historyMax takes effect after removal of savefiles. historyMax = 5000 maxFps = 24 noAnim = False hpWarningPercent = 20 ; Uncomment to make all messages white. ; messageColors = [] overrideCmdline = "" ; Legacy: monospace fonts that have fixed size regardless of boldness (on some OSes at least) gtkFontFamily = "DejaVu Sans Mono,Consolas,Courier New,Liberation Mono,Courier,FreeMono,Monospace" ; sdlFonSizeAdd is now ignored ; runStopMsgs is now ignored LambdaHack-0.9.5.0/GameDefinition/fonts/0000755000000000000000000000000007346545000016036 5ustar0000000000000000LambdaHack-0.9.5.0/GameDefinition/fonts/16x16x.fnt0000644000000000000000000002225507346545000017532 0ustar0000000000000000­$Mikolaj Konarski and others 2019; released under GNU GPL-2 `` X0ÿÿ ž$~~ž¾Þþ>^~ž¾Þþ>^~ž¾Þþ>^~ž¾Þþ>^~ž¾Þþ > ^ ~ ž ¾ Þ þ  > ^ ~ ž ¾ Þ þ  > ^ ~ ž ¾ Þ þ  > ^ ~ ž ¾ Þ þ  > ^ ~ ž ¾ Þ þ >^~ž¾Þþ>^~ž¾Þþ>^~ž¾Þþ>^~ž¾Þþ>^~ž¾Þþ>^~ž¾Þþ>^~ž¾Þþ>^~ž¾Þþ>^~ž¾Þþ>^~ž¾Þþ>^~ž¾Þþ>^~ž¾Þþ>^~ž¾Þþ>^~ž¾Þþ>^~ž¾Þþ>^~ž¾Þþ>^~ž¾Þþ>^~ž¾Þþ > ^ ~ ž ¾ Þ þ !>!^!~!ž!¾!Þ!þ!">"^"~"ž"¾"Þ"þ"#>#^#~#ž#¾#Þ#þ#$>$^$  €€ÀÀÀÀ€€€€À€0000 ?? ?? 00üü0000üü00111€ð˜€€€ð˜ŒŒ˜ð€6"6 0`À€8lDl888À`0`ÀÆl88|΀ÀÀ€ðÀ€€Àð€ÀàààààÀ€0pàøøàp0€€€€øø€€€€€ÀÀ€øø€ÀÀ€ 80 0`À€0001000ð Œ ð?ÀÀÀÀÀÀÀÀÀÀþ800?ð 8àü8ð ø  ø00000 ü ?000?8üð ð 00?000ðð ð?þ8pàÀ€  00à00ð ð008ð ü ð€ÀÀ€€ÀÀ€€ÀÀ€€ÀÀ€888à€€à8øøøøÀppÀ ð 8à€€À€8133318ð üøð ~ÀÀ` 0ø ?ð ø  ø0000000ø  øà0 0àüðü~üð0000000ð ÿ ð|| ü ??ü€€€€€€€€€üp? ð||>0`ÀÀ`0 ~þx|0`À€À`0>| >0`À€€€€€à?`?þ8pàÀ€þðð08 €À`0 à`````````à 0€À`0 þþ€Ààp00ø ü çxsø ü0````0ø ü0000< ü ç0```0ø øü?üøÀ00pç ü øx~ø ÀÀÀÀÀÀÀÀÿp ü øx~0`Àà0?þü~111111qpŒŒŒŒŒŒs~ð 0````0ø  øsxø ü0000ì ü y ü€88püø üøüx< ç|  0`ÀÀx ÌÌx0|| 0ÀÀ0 xp? ü ø?`8?þ8à€þð€€€€€€ð€€€€€€€€€€€€€€€ÀpÀ€€€90 œøð?? ??øüÀÀÀÀüø€€€øø€€€€€€€€€€€øø€€€øø€€€000`Àø ø  øpÀÀp0000000üÆÀÀÀøÀÀÀÆü?`?`Àü8pàÀ€ü€ÀÀ€88p`À€üø üÀpÀ3aaaa3|Ɔü€€Æ|?`8?`À€þ8à€þ| ``>0`À€€€€à€À€€€€ÀÀÀÀ€1111€€øŒ€€€€Œø€€?7?ðø ÀÀ€øø  € P ØØ P €08 8pàøø€øø€€ðøàðèø8ðà``3666663ðÌl lÌðð00üü8Ž8à8Ž?ü 7447544ðÌl,ÌŒÌlðàà à00à€€€øø€€€øøð8à€øðððÀ€  8 ç>>>ü0000000000€€À€€€€€€€øððø88à8Ž8àxppÀff~xppÀ|<`~||ppÀff~ €À€€à8 ð ~€ÀÀ` 0ø ? ~À€À` 0ø ? ~À`À` 0ø ? ~`ÀÀ` 0ø ? ~00À` 0ø ? ~À€À` 0ø ? 00yüÆÀÀÀøÀÀÀÆü0000000ø  øÀ€€ÀüðüÀ€üðüÀ`üðü``üðü??€ü€€€€€€€€ü??À€ü€€€€€€€€ü??À`ü€€€€€€€€ü??``ü€€€€€€€€üà0 Œ 0àx~`À? ŒÌl<  0000 €à0 0à 0000 À€à0 0à 0000 À`à0 0à 0000 `Àà0 0à 0000 ``à0 0à  0pàÀÀàp0 001367ì0hÌŒ 0à| €À ð| À€ ð| À` ð| 00 ð| À€>0`À€€€€ààð88ðàøü8pàp8|øp00€€ø ü çp00À€ø ü çp00€À`ø ü çp00`Àø ü çp00``ø ü çp00€@€ø ü ç>c1aa>|Ɔü€€Æ|0````0ø üÀ€0```0€€ø øü0```0À€ø øü0```0€À`ø øü0```0``ø øü€€ÀÀÀÀÀÀÿ`À€ÀÀÀÀÀÀÿ€À`ÀÀÀÀÀÀÿ00ÀÀÀÀÀÀÿ000`€À`0ø ðs~°àð 0````0€€ø  ø0````0À€ø  ø0````0€À`ø  ø0````0`Àø  ø0````0``ø  ø€€øø€€0038/ú<æ† øx€€< çxÀ€< çx€À`< çx``< çxpÀ€? ü øàøøàxp``? ü øAngband 16x16xLambdaHack-0.9.5.0/GameDefinition/fonts/16x16xw.bdf0000644000000000000000000017643407346545000017676 0ustar0000000000000000STARTFONT 2.1 FONT -Angband-16x16x-Medium-R-Normal--16-120-100-100-C-80-ISO10646-1 SIZE 12 100 100 FONTBOUNDINGBOX 16 16 0 -3 STARTPROPERTIES 20 FAMILY_NAME "16x16x" FOUNDRY "Angband" WEIGHT_NAME "Medium" SLANT "R" SETWIDTH_NAME "Normal" FONT_VERSION "1.0" COPYRIGHT "Mikolaj Konarski, Leon Marrick and others 2019; released under GNU GPL-2" CAP_HEIGHT 13 PIXEL_SIZE 16 POINT_SIZE 120 X_HEIGHT 8 RESOLUTION_X 100 RESOLUTION_Y 100 SPACING "C" AVERAGE_WIDTH 80 WEIGHT 10 QUAD_WIDTH 16 DEFAULT_CHAR 32 FONT_DESCENT 3 FONT_ASCENT 13 ENDPROPERTIES CHARS 385 STARTCHAR U+0007 ENCODING 7 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0000 0000 0000 0000 0000 0000 0000 0180 0000 0000 0000 0000 0000 0000 0000 ENDCHAR STARTCHAR U+0020 ENCODING 32 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0000 0000 0000 0000 0000 0000 0000 0000 0000 0000 0000 0000 0000 0000 0000 ENDCHAR STARTCHAR U+0021 ENCODING 33 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0000 0180 03C0 03C0 03C0 03C0 0180 0180 0180 0000 0180 03C0 0180 0000 0000 ENDCHAR STARTCHAR U+0022 ENCODING 34 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0630 0630 0630 0630 0000 0000 0000 0000 0000 0000 0000 0000 0000 0000 0000 ENDCHAR STARTCHAR U+0023 ENCODING 35 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0000 0C30 0C30 3FFC 3FFC 0C30 0C30 0C30 0C30 3FFC 3FFC 0C30 0C30 0000 0000 ENDCHAR STARTCHAR U+0024 ENCODING 36 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0180 0FF0 1998 3180 3180 1980 0FF0 0198 018C 018C 3198 1FF0 0180 0000 0000 ENDCHAR STARTCHAR U+0025 ENCODING 37 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0000 1C18 3618 2230 3660 1CC0 0180 0338 066C 0C44 186C 1838 0000 0000 0000 ENDCHAR STARTCHAR U+0026 ENCODING 38 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0000 07C0 0E60 1C30 0E60 07C0 0FC6 1C6C 3838 3838 1C7C 0FCE 0000 0000 0000 ENDCHAR STARTCHAR U+0027 ENCODING 39 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0180 03C0 03C0 0180 0300 0000 0000 0000 0000 0000 0000 0000 0000 0000 0000 ENDCHAR STARTCHAR U+0028 ENCODING 40 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0000 00F0 01C0 0380 0700 0700 0700 0700 0700 0380 01C0 00F0 0000 0000 0000 ENDCHAR STARTCHAR U+0029 ENCODING 41 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0000 0F00 0380 01C0 00E0 00E0 00E0 00E0 00E0 01C0 0380 0F00 0000 0000 0000 ENDCHAR STARTCHAR U+002A ENCODING 42 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0000 0000 0000 0630 0770 03E0 0FF8 0FF8 03E0 0770 0630 0000 0000 0000 0000 ENDCHAR STARTCHAR U+002B ENCODING 43 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0000 0000 0180 0180 0180 0180 1FF8 1FF8 0180 0180 0180 0180 0000 0000 0000 ENDCHAR STARTCHAR U+002C ENCODING 44 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0000 0000 0000 0000 0000 0000 0000 0000 0000 0180 03C0 03C0 0180 0700 0000 ENDCHAR STARTCHAR U+002D ENCODING 45 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0000 0000 0000 0000 0000 0000 1FF8 1FF8 0000 0000 0000 0000 0000 0000 0000 ENDCHAR STARTCHAR U+002E ENCODING 46 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0000 0000 0000 0000 0000 0000 0000 0000 0000 0180 03C0 03C0 0180 0000 0000 ENDCHAR STARTCHAR U+002F ENCODING 47 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0000 000C 001C 0030 0060 00C0 0180 0300 0600 0C00 3800 3000 0000 0000 0000 ENDCHAR STARTCHAR U+0030 ENCODING 48 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0000 0FF0 1818 300C 300C 300C 318C 300C 300C 300C 1818 0FF0 0000 0000 0000 ENDCHAR STARTCHAR U+0031 ENCODING 49 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0000 00C0 01C0 0FC0 00C0 00C0 00C0 00C0 00C0 00C0 00C0 3FFE 0000 0000 0000 ENDCHAR STARTCHAR U+0032 ENCODING 50 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0000 0FF0 3818 000C 000C 0038 01E0 0700 1C00 3000 3006 3FFC 0000 0000 0000 ENDCHAR STARTCHAR U+0033 ENCODING 51 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0000 07F0 1C18 000C 000C 0018 03F8 000C 0006 0006 380C 0FF8 0000 0000 0000 ENDCHAR STARTCHAR U+0034 ENCODING 52 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0000 300C 300C 300C 300C 300C 1FFC 000C 000C 000C 000C 000C 0000 0000 0000 ENDCHAR STARTCHAR U+0035 ENCODING 53 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0000 3FFC 3000 3000 3000 3FF0 0018 000C 000C 000C 3818 0FF0 0000 0000 0000 ENDCHAR STARTCHAR U+0036 ENCODING 54 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0000 07F0 0C18 1800 3000 3000 3FF0 3018 300C 300C 1818 0FF0 0000 0000 0000 ENDCHAR STARTCHAR U+0037 ENCODING 55 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0000 3FFE 000E 001C 0038 0070 00E0 01C0 0380 0700 0E00 1C00 0000 0000 0000 ENDCHAR STARTCHAR U+0038 ENCODING 56 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0000 07E0 0C30 1818 1818 0C30 0FF0 1818 300C 300C 1818 0FF0 0000 0000 0000 ENDCHAR STARTCHAR U+0039 ENCODING 57 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0000 0FF0 1818 300C 300C 180C 0FFC 000C 000C 000C 3818 0FF0 0000 0000 0000 ENDCHAR STARTCHAR U+003A ENCODING 58 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0000 0000 0000 0180 03C0 03C0 0180 0000 0000 0180 03C0 03C0 0180 0000 0000 ENDCHAR STARTCHAR U+003B ENCODING 59 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0000 0000 0000 0180 03C0 03C0 0180 0000 0000 0180 03C0 03C0 0180 0700 0000 ENDCHAR STARTCHAR U+003C ENCODING 60 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0000 0000 0038 00E0 0380 0E00 3800 3800 0E00 0380 00E0 0038 0000 0000 0000 ENDCHAR STARTCHAR U+003D ENCODING 61 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0000 0000 0000 0000 1FF8 1FF8 0000 0000 1FF8 1FF8 0000 0000 0000 0000 0000 ENDCHAR STARTCHAR U+003E ENCODING 62 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0000 0000 1C00 0700 01C0 0070 001C 001C 0070 01C0 0700 1C00 0000 0000 0000 ENDCHAR STARTCHAR U+003F ENCODING 63 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0000 07F0 0C18 180C 000C 000C 0038 00E0 0180 0000 0180 03C0 0180 0000 0000 ENDCHAR STARTCHAR U+0040 ENCODING 64 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0000 0FF0 1C18 380C 31FC 331C 331C 331C 31F8 3800 1C18 0FF0 0000 0000 0000 ENDCHAR STARTCHAR U+0041 ENCODING 65 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0000 0FC0 01C0 0360 0220 0630 0410 0FF8 0C18 180C 180C 7E3F 0000 0000 0000 ENDCHAR STARTCHAR U+0042 ENCODING 66 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0000 7FF0 1818 180C 180C 1818 1FF8 180C 1806 1806 180C 7FF8 0000 0000 0000 ENDCHAR STARTCHAR U+0043 ENCODING 67 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0000 0FF8 180C 3006 3000 3000 3000 3000 3000 3006 180C 0FF8 0000 0000 0000 ENDCHAR STARTCHAR U+0044 ENCODING 68 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0000 7FE0 1830 1818 180C 180C 180C 180C 180C 1818 1830 7FE0 0000 0000 0000 ENDCHAR STARTCHAR U+0045 ENCODING 69 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0000 7FFC 1806 1800 1800 1800 1FF0 1800 1800 1800 1806 7FFC 0000 0000 0000 ENDCHAR STARTCHAR U+0046 ENCODING 70 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0000 7FFC 1806 1800 1800 1800 1FF0 1800 1800 1800 1800 7E00 0000 0000 0000 ENDCHAR STARTCHAR U+0047 ENCODING 71 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0000 0FF0 1818 300C 3000 3000 3000 30FF 300C 300C 1818 0FF0 0000 0000 0000 ENDCHAR STARTCHAR U+0048 ENCODING 72 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0000 7C1F 180C 180C 180C 180C 1FFC 180C 180C 180C 180C 7C1F 0000 0000 0000 ENDCHAR STARTCHAR U+0049 ENCODING 73 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0000 3FFC 0180 0180 0180 0180 0180 0180 0180 0180 0180 3FFC 0000 0000 0000 ENDCHAR STARTCHAR U+004A ENCODING 74 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0000 003F 000C 000C 000C 000C 000C 000C 000C 000C 7018 1FF0 0000 0000 0000 ENDCHAR STARTCHAR U+004B ENCODING 75 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0000 7C3E 1818 1830 1860 18C0 1FC0 1860 1830 1818 180C 7C1F 0000 0000 0000 ENDCHAR STARTCHAR U+004C ENCODING 76 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0000 7E00 1800 1800 1800 1800 1800 1800 1800 1800 1803 7FFE 0000 0000 0000 ENDCHAR STARTCHAR U+004D ENCODING 77 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0000 780F 1C1C 1E3C 1B6C 19CC 188C 180C 180C 180C 180C 7C1F 0000 0000 0000 ENDCHAR STARTCHAR U+004E ENCODING 78 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0000 783F 180C 1C0C 1E0C 1B0C 198C 18CC 186C 183C 181C 7E0C 0000 0000 0000 ENDCHAR STARTCHAR U+004F ENCODING 79 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0000 07E0 0C30 1818 300C 300C 300C 300C 300C 1818 0C30 07E0 0000 0000 0000 ENDCHAR STARTCHAR U+0050 ENCODING 80 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0000 7FF8 180C 1806 1806 180C 1FF8 1800 1800 1800 1800 7E00 0000 0000 0000 ENDCHAR STARTCHAR U+0051 ENCODING 81 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0000 07E0 0C30 1818 300C 300C 300C 300C 300C 19D8 0CF0 07E0 0038 0000 0000 ENDCHAR STARTCHAR U+0052 ENCODING 82 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0000 7FF0 1818 180C 180C 1818 1FF0 18C0 1860 1830 1818 7C3F 0000 0000 0000 ENDCHAR STARTCHAR U+0053 ENCODING 83 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0000 0FF8 180C 3000 3000 1800 0FF8 000C 0006 0006 300C 1FF8 0000 0000 0000 ENDCHAR STARTCHAR U+0054 ENCODING 84 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0000 3FFC 6186 0180 0180 0180 0180 0180 0180 0180 0180 07E0 0000 0000 0000 ENDCHAR STARTCHAR U+0055 ENCODING 85 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0000 7C1F 180C 180C 180C 180C 180C 180C 180C 180C 0C18 07F0 0000 0000 0000 ENDCHAR STARTCHAR U+0056 ENCODING 86 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0000 7C1F 180C 180C 0C18 0C18 0630 0630 0360 0360 01C0 01C0 0000 0000 0000 ENDCHAR STARTCHAR U+0057 ENCODING 87 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0000 7C1F 180C 180C 180C 180C 188C 19CC 1B6C 1E3C 1C1C 180C 0000 0000 0000 ENDCHAR STARTCHAR U+0058 ENCODING 88 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0000 7C3E 1818 0C30 0660 03C0 0180 03C0 0660 0C30 1818 7C3E 0000 0000 0000 ENDCHAR STARTCHAR U+0059 ENCODING 89 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0000 7C3E 1818 0C30 0660 03C0 0180 0180 0180 0180 0180 07E0 0000 0000 0000 ENDCHAR STARTCHAR U+005A ENCODING 90 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0000 3FFE 601C 0038 0070 00E0 01C0 0380 0700 0E00 1C03 3FFE 0000 0000 0000 ENDCHAR STARTCHAR U+005B ENCODING 91 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0000 07F0 0600 0600 0600 0600 0600 0600 0600 0600 0600 07F0 0000 0000 0000 ENDCHAR STARTCHAR U+005C ENCODING 92 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0000 3000 3800 0C00 0600 0300 0180 00C0 0060 0030 001C 000C 0000 0000 0000 ENDCHAR STARTCHAR U+005D ENCODING 93 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0000 0FE0 0060 0060 0060 0060 0060 0060 0060 0060 0060 0FE0 0000 0000 0000 ENDCHAR STARTCHAR U+005E ENCODING 94 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0000 0180 03C0 0660 0C30 1818 300C 0000 0000 0000 0000 0000 0000 0000 0000 ENDCHAR STARTCHAR U+005F ENCODING 95 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0000 0000 0000 0000 0000 0000 0000 0000 0000 0000 0000 7FFE 7FFE 0000 0000 ENDCHAR STARTCHAR U+0060 ENCODING 96 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0700 0380 01C0 00E0 0000 0000 0000 0000 0000 0000 0000 0000 0000 0000 0000 ENDCHAR STARTCHAR U+0061 ENCODING 97 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0000 0000 0000 0000 1FF8 700C 000C 0FFC 180C 300C 301C 1FE7 0000 0000 0000 ENDCHAR STARTCHAR U+0062 ENCODING 98 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0000 7800 1800 1800 1800 1FF8 180C 1806 1806 1806 1C06 73FC 0000 0000 0000 ENDCHAR STARTCHAR U+0063 ENCODING 99 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0000 0000 0000 0000 1FF8 300C 6000 6000 6000 6000 3007 1FFC 0000 0000 0000 ENDCHAR STARTCHAR U+0064 ENCODING 100 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0000 003C 000C 000C 000C 0FFC 180C 300C 300C 300C 301C 1FE7 0000 0000 0000 ENDCHAR STARTCHAR U+0065 ENCODING 101 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0000 0000 0000 0000 1FF8 300C 600C 7FF8 6000 6000 3007 1FFC 0000 0000 0000 ENDCHAR STARTCHAR U+0066 ENCODING 102 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0000 0000 01FC 0606 0600 7FF8 0600 0600 0600 0600 0600 3FC0 0000 0000 0000 ENDCHAR STARTCHAR U+0067 ENCODING 103 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0000 0000 0000 0000 0FE7 181C 300C 300C 180C 0FFC 000C 700C 1FF8 0000 0000 ENDCHAR STARTCHAR U+0068 ENCODING 104 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0000 7800 1800 1800 1800 1FF8 180C 180C 180C 180C 180C 7E0F 0000 0000 0000 ENDCHAR STARTCHAR U+0069 ENCODING 105 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0000 00C0 00C0 0000 0000 1FC0 00C0 00C0 00C0 00C0 00C0 7FFF 0000 0000 0000 ENDCHAR STARTCHAR U+006A ENCODING 106 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0000 000C 000C 0000 0000 03FC 000C 000C 000C 000C 000C 700C 1FF8 0000 0000 ENDCHAR STARTCHAR U+006B ENCODING 107 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0000 7800 1800 1800 181E 1830 1860 18C0 1FE0 1830 1818 7E3F 0000 0000 0000 ENDCHAR STARTCHAR U+006C ENCODING 108 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0000 0000 FE00 0600 0600 0600 0600 0600 0600 0600 0607 01FC 0000 0000 0000 ENDCHAR STARTCHAR U+006D ENCODING 109 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0000 0000 0000 0000 7E70 318C 318C 318C 318C 318C 318C 718F 0000 0000 0000 ENDCHAR STARTCHAR U+006E ENCODING 110 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0000 0000 0000 0000 73F0 1C18 180C 180C 180C 180C 180C 7E0F 0000 0000 0000 ENDCHAR STARTCHAR U+006F ENCODING 111 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0000 0000 0000 0000 1FF8 300C 6006 6006 6006 6006 300C 1FF8 0000 0000 0000 ENDCHAR STARTCHAR U+0070 ENCODING 112 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0000 0000 0000 0000 73F8 1C0C 1806 1806 1806 1806 1FFC 1800 1800 1800 7800 ENDCHAR STARTCHAR U+0071 ENCODING 113 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0000 0000 0000 0000 0FEC 181C 300C 300C 300C 300C 1FFC 000C 000C 000C 000F ENDCHAR STARTCHAR U+0072 ENCODING 114 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0000 0000 0000 0000 79FC 0E07 0C00 0C00 0C00 0C00 0C00 7F80 0000 0000 0000 ENDCHAR STARTCHAR U+0073 ENCODING 115 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0000 0000 0000 0000 0FFC 3807 3800 0FF8 000C 0006 7006 1FFC 0000 0000 0000 ENDCHAR STARTCHAR U+0074 ENCODING 116 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0000 0000 0600 0600 0600 7FF8 0600 0600 0600 0600 0607 01FC 0000 0000 0000 ENDCHAR STARTCHAR U+0075 ENCODING 117 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0000 0000 0000 0000 783C 180C 180C 180C 180C 180C 181C 0FE7 0000 0000 0000 ENDCHAR STARTCHAR U+0076 ENCODING 118 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0000 0000 0000 0000 7C1F 180C 180C 0C18 0630 0360 01C0 01C0 0000 0000 0000 ENDCHAR STARTCHAR U+0077 ENCODING 119 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0000 0000 0000 0000 780F 180C 180C 180C 19CC 19CC 0F78 0630 0000 0000 0000 ENDCHAR STARTCHAR U+0078 ENCODING 120 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0000 0000 0000 0000 7C1F 180C 0630 01C0 01C0 0630 180C 7C1F 0000 0000 0000 ENDCHAR STARTCHAR U+0079 ENCODING 121 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0000 0000 0000 0000 783F 180C 180C 180C 180C 0FFC 000C 700C 1FF8 0000 0000 ENDCHAR STARTCHAR U+007A ENCODING 122 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0000 0000 0000 0000 3FFE 600E 0038 00E0 0380 0E00 3803 3FFE 0000 0000 0000 ENDCHAR STARTCHAR U+007B ENCODING 123 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0000 00F0 0180 0180 0180 0300 0E00 0300 0180 0180 0180 00F0 0000 0000 0000 ENDCHAR STARTCHAR U+007C ENCODING 124 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0000 0180 0180 0180 0180 0180 0180 0180 0180 0180 0180 0180 0180 0000 0000 ENDCHAR STARTCHAR U+007D ENCODING 125 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0000 0F00 0180 0180 0180 00C0 0070 00C0 0180 0180 0180 0F00 0000 0000 0000 ENDCHAR STARTCHAR U+007E ENCODING 126 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0000 0000 0000 0000 0000 0F0C 1F9C 39F8 30F0 0000 0000 0000 0000 0000 0000 ENDCHAR STARTCHAR U+00A0 ENCODING 160 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0000 0000 0000 0000 0000 0000 0000 0000 0000 0000 0000 0000 0000 0000 0000 ENDCHAR STARTCHAR U+00A1 ENCODING 161 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0000 0180 03C0 0180 0000 0180 0180 0180 03C0 03C0 03C0 03C0 0180 0000 0000 ENDCHAR STARTCHAR U+00A2 ENCODING 162 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0000 0180 0180 0FF8 198C 3180 3180 3180 3180 198C 0FF8 0180 0180 0000 0000 ENDCHAR STARTCHAR U+00A3 ENCODING 163 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 01F0 03F8 071C 060C 1FC0 1FC0 0600 1E00 3F00 3780 3FF8 1CF8 0000 0000 0000 ENDCHAR STARTCHAR U+00A4 ENCODING 164 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0000 0000 0180 05A0 0A50 05A0 1BD8 1BD8 05A0 0A50 05A0 0180 0000 0000 0000 ENDCHAR STARTCHAR U+00A5 ENCODING 165 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 300C 381C 1C38 0E70 07E0 1FF8 1FF8 0180 1FF8 1FF8 0180 0180 0000 0000 0000 ENDCHAR STARTCHAR U+00A6 ENCODING 166 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0000 0300 0300 0300 0300 0300 0000 0000 0300 0300 0300 0300 0300 0000 0000 ENDCHAR STARTCHAR U+00A7 ENCODING 167 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 07F0 0FF8 1C08 1800 1FE0 17F0 1018 1808 0FE8 07F8 0018 1038 1FF0 0FE0 0000 ENDCHAR STARTCHAR U+00A8 ENCODING 168 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0660 0660 0000 0000 0000 0000 0000 0000 0000 0000 0000 0000 0000 0000 0000 0000 ENDCHAR STARTCHAR U+00A9 ENCODING 169 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0000 0FF0 1818 33CC 366C 360C 360C 360C 366C 33CC 1818 0FF0 0000 0000 0000 ENDCHAR STARTCHAR U+00AA ENCODING 170 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0000 0FF0 1830 1830 0FFC 0000 1FFC 0000 0000 0000 0000 0000 0000 0000 0000 ENDCHAR STARTCHAR U+00AB ENCODING 171 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0000 0000 0000 0000 038E 0E38 38E0 0E38 038E 0000 0000 0000 0000 0000 0000 ENDCHAR STARTCHAR U+00AC ENCODING 172 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0000 0000 0000 0000 0000 0000 3FFC 000C 000C 000C 0000 0000 0000 0000 0000 ENDCHAR STARTCHAR U+00AE ENCODING 174 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0000 0FF0 1818 37CC 346C 342C 37CC 358C 34CC 346C 1818 0FF0 0000 0000 0000 ENDCHAR STARTCHAR U+00AF ENCODING 175 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 03E0 03E0 0000 0000 0000 0000 0000 0000 0000 0000 0000 0000 0000 0000 0000 0000 ENDCHAR STARTCHAR U+00B0 ENCODING 176 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 07E0 0C30 0C30 07E0 0000 0000 0000 0000 0000 0000 0000 0000 0000 0000 0000 ENDCHAR STARTCHAR U+00B1 ENCODING 177 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0180 0180 0180 1FF8 1FF8 0180 0180 0180 0000 1FF8 1FF8 0000 0000 0000 0000 ENDCHAR STARTCHAR U+00B2 ENCODING 178 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 07F0 1C18 0038 00E0 0380 0E00 1FF8 0000 0000 0000 0000 0000 0000 0000 0000 ENDCHAR STARTCHAR U+00B3 ENCODING 179 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 07F0 1C18 0018 01F0 0018 1C18 07F0 0000 0000 0000 0000 0000 0000 0000 0000 ENDCHAR STARTCHAR U+00B4 ENCODING 180 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 00C0 0180 0100 0000 0000 0000 0000 0000 0000 0000 0000 0000 0000 0000 0000 0000 ENDCHAR STARTCHAR U+00B5 ENCODING 181 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0000 0000 0000 0000 0C0C 0C0C 0C0C 0C0C 0C0C 0C0C 0C1C 0FE7 0C00 0C00 3800 ENDCHAR STARTCHAR U+00B6 ENCODING 182 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0000 1FFC 3E30 3E30 3E30 1E30 0630 0630 0630 0630 0630 0630 0000 0000 0000 ENDCHAR STARTCHAR U+00B7 ENCODING 183 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0000 0000 0000 0000 0000 0000 0180 0180 0000 0000 0000 0000 0000 0000 0000 ENDCHAR STARTCHAR U+00B8 ENCODING 184 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0000 0000 0000 0000 0000 0000 0000 0000 0000 0000 0000 0000 00C0 0060 01C0 ENDCHAR STARTCHAR U+00B9 ENCODING 185 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0180 0780 0180 0180 0180 0180 1FF8 0000 0000 0000 0000 0000 0000 0000 0000 ENDCHAR STARTCHAR U+00BA ENCODING 186 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0000 0FF0 1818 1818 0FF0 0000 1FF8 0000 0000 0000 0000 0000 0000 0000 0000 ENDCHAR STARTCHAR U+00BB ENCODING 187 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0000 0000 0000 0000 38E0 0E38 038E 0E38 38E0 0000 0000 0000 0000 0000 0000 ENDCHAR STARTCHAR U+00BC ENCODING 188 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0000 1800 7800 1800 181C 1870 01C0 0700 1C66 7066 007E 0006 0006 0000 0000 ENDCHAR STARTCHAR U+00BD ENCODING 189 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0000 1800 7800 1800 181C 1870 01C0 0700 1C7C 7006 003C 0060 007E 0000 0000 ENDCHAR STARTCHAR U+00BE ENCODING 190 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0000 7C00 0600 1E00 061C 7C70 01C0 0700 1C66 7066 007E 0006 0006 0000 0000 ENDCHAR STARTCHAR U+00BF ENCODING 191 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0000 0180 03C0 0180 0000 0180 00E0 0038 000C 000C 180C 0C18 07F0 0000 0000 ENDCHAR STARTCHAR U+00C0 ENCODING 192 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0180 00C0 0000 0FC0 0360 0220 0630 0410 0FF8 0C18 180C 180C 7E3F 0000 0000 0000 ENDCHAR STARTCHAR U+00C1 ENCODING 193 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 00C0 0180 0000 0FC0 0360 0220 0630 0410 0FF8 0C18 180C 180C 7E3F 0000 0000 0000 ENDCHAR STARTCHAR U+00C2 ENCODING 194 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 01C0 0360 0000 0FC0 0360 0220 0630 0410 0FF8 0C18 180C 180C 7E3F 0000 0000 0000 ENDCHAR STARTCHAR U+00C3 ENCODING 195 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0360 05C0 0000 0FC0 0360 0220 0630 0410 0FF8 0C18 180C 180C 7E3F 0000 0000 0000 ENDCHAR STARTCHAR U+00C4 ENCODING 196 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0630 0630 0000 0FC0 0360 0220 0630 0410 0FF8 0C18 180C 180C 7E3F 0000 0000 0000 ENDCHAR STARTCHAR U+00C5 ENCODING 197 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 03C0 0180 0000 0FC0 0360 0220 0630 0410 0FF8 0C18 180C 180C 7E3F 0000 0000 0000 ENDCHAR STARTCHAR U+00C6 ENCODING 198 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0000 0FFC 03C6 06C0 04C0 0CC0 0FF8 18C0 18C0 30C0 30C6 79FC 0000 0000 0000 ENDCHAR STARTCHAR U+00C7 ENCODING 199 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0000 0FF8 180C 3006 3000 3000 3000 3000 3000 3006 180C 0FF8 00C0 0060 01C0 ENDCHAR STARTCHAR U+00C8 ENCODING 200 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0180 00C0 0000 7FFC 1806 1800 1800 1FF0 1800 1800 1800 1806 7FFC 0000 0000 0000 ENDCHAR STARTCHAR U+00C9 ENCODING 201 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 00C0 0180 0000 7FFC 1806 1800 1800 1FF0 1800 1800 1800 1806 7FFC 0000 0000 0000 ENDCHAR STARTCHAR U+00CA ENCODING 202 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 01C0 0360 0000 7FFC 1806 1800 1800 1FF0 1800 1800 1800 1806 7FFC 0000 0000 0000 ENDCHAR STARTCHAR U+00CB ENCODING 203 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0660 0660 0000 7FFC 1806 1800 1800 1FF0 1800 1800 1800 1806 7FFC 0000 0000 0000 ENDCHAR STARTCHAR U+00CC ENCODING 204 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0300 0180 0000 3FFC 0180 0180 0180 0180 0180 0180 0180 0180 3FFC 0000 0000 0000 ENDCHAR STARTCHAR U+00CD ENCODING 205 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 00C0 0180 0000 3FFC 0180 0180 0180 0180 0180 0180 0180 0180 3FFC 0000 0000 0000 ENDCHAR STARTCHAR U+00CE ENCODING 206 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 01C0 0360 0000 3FFC 0180 0180 0180 0180 0180 0180 0180 0180 3FFC 0000 0000 0000 ENDCHAR STARTCHAR U+00CF ENCODING 207 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0660 0660 0000 3FFC 0180 0180 0180 0180 0180 0180 0180 0180 3FFC 0000 0000 0000 ENDCHAR STARTCHAR U+00D0 ENCODING 208 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0000 7FE0 1830 1818 180C 180C 7F8C 180C 180C 1818 1830 7FE0 0000 0000 0000 ENDCHAR STARTCHAR U+00D1 ENCODING 209 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0360 05C0 0000 783F 1C0C 1E0C 1B0C 198C 18CC 186C 183C 181C 7E0C 0000 0000 0000 ENDCHAR STARTCHAR U+00D2 ENCODING 210 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0300 0180 0000 07E0 0C30 1818 300C 300C 300C 300C 1818 0C30 07E0 0000 0000 0000 ENDCHAR STARTCHAR U+00D3 ENCODING 211 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 00C0 0180 0000 07E0 0C30 1818 300C 300C 300C 300C 1818 0C30 07E0 0000 0000 0000 ENDCHAR STARTCHAR U+00D4 ENCODING 212 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 01C0 0360 0000 07E0 0C30 1818 300C 300C 300C 300C 1818 0C30 07E0 0000 0000 0000 ENDCHAR STARTCHAR U+00D5 ENCODING 213 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0360 05C0 0000 07E0 0C30 1818 300C 300C 300C 300C 1818 0C30 07E0 0000 0000 0000 ENDCHAR STARTCHAR U+00D6 ENCODING 214 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0660 0660 0000 07E0 0C30 1818 300C 300C 300C 300C 1818 0C30 07E0 0000 0000 0000 ENDCHAR STARTCHAR U+00D7 ENCODING 215 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0000 0000 0000 0C30 0E70 07E0 03C0 03C0 07E0 0E70 0C30 0000 0000 0000 0000 ENDCHAR STARTCHAR U+00D8 ENCODING 216 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0000 07EC 0C18 1830 3068 30CC 318C 330C 360C 1C18 1830 37E0 0000 0000 0000 ENDCHAR STARTCHAR U+00D9 ENCODING 217 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0180 00C0 0000 7C1F 180C 180C 180C 180C 180C 180C 180C 0C18 07F0 0000 0000 0000 ENDCHAR STARTCHAR U+00DA ENCODING 218 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 00C0 0180 0000 7C1F 180C 180C 180C 180C 180C 180C 180C 0C18 07F0 0000 0000 0000 ENDCHAR STARTCHAR U+00DB ENCODING 219 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 01C0 0360 0000 7C1F 180C 180C 180C 180C 180C 180C 180C 0C18 07F0 0000 0000 0000 ENDCHAR STARTCHAR U+00DC ENCODING 220 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0630 0630 0000 7C1F 180C 180C 180C 180C 180C 180C 180C 0C18 07F0 0000 0000 0000 ENDCHAR STARTCHAR U+00DD ENCODING 221 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 00C0 0180 0000 7C3E 1818 0C30 0660 03C0 0180 0180 0180 0180 07E0 0000 0000 0000 ENDCHAR STARTCHAR U+00DE ENCODING 222 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 1800 1800 1FE0 1FF0 1838 1818 1818 1838 1FF0 1FE0 1800 1800 0000 0000 0000 ENDCHAR STARTCHAR U+00DF ENCODING 223 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0FF8 1FFC 181C 181C 1838 1870 18E0 1870 1838 181C 187C 19F8 0000 0000 0000 ENDCHAR STARTCHAR U+00E0 ENCODING 224 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0300 0180 0080 0000 1FF8 700C 000C 0FFC 180C 300C 301C 1FE7 0000 0000 0000 ENDCHAR STARTCHAR U+00E1 ENCODING 225 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 00C0 0180 0100 0000 1FF8 700C 000C 0FFC 180C 300C 301C 1FE7 0000 0000 0000 ENDCHAR STARTCHAR U+00E2 ENCODING 226 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0080 01C0 0360 0000 1FF8 700C 000C 0FFC 180C 300C 301C 1FE7 0000 0000 0000 ENDCHAR STARTCHAR U+00E3 ENCODING 227 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0000 0360 05C0 0000 1FF8 700C 000C 0FFC 180C 300C 301C 1FE7 0000 0000 0000 ENDCHAR STARTCHAR U+00E4 ENCODING 228 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0000 0660 0660 0000 1FF8 700C 000C 0FFC 180C 300C 301C 1FE7 0000 0000 0000 ENDCHAR STARTCHAR U+00E5 ENCODING 229 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0080 0140 0080 0000 1FF8 700C 000C 0FFC 180C 300C 301C 1FE7 0000 0000 0000 ENDCHAR STARTCHAR U+00E6 ENCODING 230 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0000 0000 0000 0000 3E7C 63C6 0186 1FFC 3180 6180 61C6 3E7C 0000 0000 0000 ENDCHAR STARTCHAR U+00E7 ENCODING 231 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0000 0000 0000 0000 1FF8 300C 6000 6000 6000 6000 3007 1FFC 00C0 0060 01C0 ENDCHAR STARTCHAR U+00E8 ENCODING 232 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0300 0180 0080 0000 1FF8 300C 600C 7FF8 6000 6000 3007 1FFC 0000 0000 0000 ENDCHAR STARTCHAR U+00E9 ENCODING 233 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 00C0 0180 0100 0000 1FF8 300C 600C 7FF8 6000 6000 3007 1FFC 0000 0000 0000 ENDCHAR STARTCHAR U+00EA ENCODING 234 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0080 01C0 0360 0000 1FF8 300C 600C 7FF8 6000 6000 3007 1FFC 0000 0000 0000 ENDCHAR STARTCHAR U+00EB ENCODING 235 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0000 0660 0660 0000 1FF8 300C 600C 7FF8 6000 6000 3007 1FFC 0000 0000 0000 ENDCHAR STARTCHAR U+00EC ENCODING 236 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0300 0180 0080 0000 0000 1FC0 00C0 00C0 00C0 00C0 00C0 7FFF 0000 0000 0000 ENDCHAR STARTCHAR U+00ED ENCODING 237 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0060 00C0 0080 0000 0000 1FC0 00C0 00C0 00C0 00C0 00C0 7FFF 0000 0000 0000 ENDCHAR STARTCHAR U+00EE ENCODING 238 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0080 01C0 0360 0000 0000 1FC0 00C0 00C0 00C0 00C0 00C0 7FFF 0000 0000 0000 ENDCHAR STARTCHAR U+00EF ENCODING 239 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0000 0330 0330 0000 0000 1FC0 00C0 00C0 00C0 00C0 00C0 7FFF 0000 0000 0000 ENDCHAR STARTCHAR U+00F0 ENCODING 240 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0360 0180 06C0 0060 0030 0FF8 181C 300C 300C 300C 1818 0FF0 0000 0000 0000 ENDCHAR STARTCHAR U+00F1 ENCODING 241 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0000 01B0 02E0 0000 73F0 1C18 180C 180C 180C 180C 180C 7E0F 0000 0000 0000 ENDCHAR STARTCHAR U+00F2 ENCODING 242 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0300 0180 0080 0000 1FF8 300C 6006 6006 6006 6006 300C 1FF8 0000 0000 0000 ENDCHAR STARTCHAR U+00F3 ENCODING 243 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 00C0 0180 0100 0000 1FF8 300C 6006 6006 6006 6006 300C 1FF8 0000 0000 0000 ENDCHAR STARTCHAR U+00F4 ENCODING 244 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0080 01C0 0360 0000 1FF8 300C 6006 6006 6006 6006 300C 1FF8 0000 0000 0000 ENDCHAR STARTCHAR U+00F5 ENCODING 245 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0000 0360 05C0 0000 1FF8 300C 6006 6006 6006 6006 300C 1FF8 0000 0000 0000 ENDCHAR STARTCHAR U+00F6 ENCODING 246 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0000 0660 0660 0000 1FF8 300C 6006 6006 6006 6006 300C 1FF8 0000 0000 0000 ENDCHAR STARTCHAR U+00F7 ENCODING 247 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0000 0000 0000 0180 0180 0000 1FF8 1FF8 0000 0180 0180 0000 0000 0000 0000 ENDCHAR STARTCHAR U+00F8 ENCODING 248 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0000 0000 0000 0000 0FFA 180E 303C 30E6 3386 1E06 380C 2FF8 0000 0000 0000 ENDCHAR STARTCHAR U+00F9 ENCODING 249 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0300 0180 0080 0000 783C 180C 180C 180C 180C 180C 181C 0FE7 0000 0000 0000 ENDCHAR STARTCHAR U+00FA ENCODING 250 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 00C0 0180 0100 0000 783C 180C 180C 180C 180C 180C 181C 0FE7 0000 0000 0000 ENDCHAR STARTCHAR U+00FB ENCODING 251 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0080 01C0 0360 0000 783C 180C 180C 180C 180C 180C 181C 0FE7 0000 0000 0000 ENDCHAR STARTCHAR U+00FC ENCODING 252 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0000 0660 0660 0000 783C 180C 180C 180C 180C 180C 181C 0FE7 0000 0000 0000 ENDCHAR STARTCHAR U+00FD ENCODING 253 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 00C0 0180 0100 0000 783F 180C 180C 180C 180C 0FFC 000C 700C 1FF8 0000 0000 ENDCHAR STARTCHAR U+00FE ENCODING 254 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0000 0000 1800 1800 1800 1FE0 1FF8 1818 1818 1FF8 1FE0 1800 1800 1800 0000 ENDCHAR STARTCHAR U+00FF ENCODING 255 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0000 0660 0660 0000 783F 180C 180C 180C 180C 0FFC 000C 700C 1FF8 0000 0000 ENDCHAR STARTCHAR U+0100 ENCODING 256 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 03E0 03E0 0000 0FC0 0360 0220 0630 0410 0FF8 0C18 180C 180C 7E3F 0000 0000 0000 ENDCHAR STARTCHAR U+0101 ENCODING 257 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0000 03E0 03E0 0000 1FF8 700C 000C 0FFC 180C 300C 301C 1FE7 0000 0000 0000 ENDCHAR STARTCHAR U+0102 ENCODING 258 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0220 01C0 0000 0FC0 0360 0220 0630 0410 0FF8 0C18 180C 180C 7E3F 0000 0000 0000 ENDCHAR STARTCHAR U+0103 ENCODING 259 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0220 01C0 0000 0000 1FF8 700C 000C 0FFC 180C 300C 301C 1FE7 0000 0000 0000 ENDCHAR STARTCHAR U+0104 ENCODING 260 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0000 0FC0 01C0 0360 0220 0630 0410 0FF8 0C18 180C 180C 7E3F 000C 0018 000E ENDCHAR STARTCHAR U+0105 ENCODING 261 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0000 0000 0000 0000 1FF8 700C 000C 0FFC 180C 300C 301C 1FE7 000C 0018 000E ENDCHAR STARTCHAR U+0106 ENCODING 262 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 00C0 0180 0000 0FF8 180C 3006 3000 3000 3000 3000 3006 180C 0FF8 0000 0000 0000 ENDCHAR STARTCHAR U+0107 ENCODING 263 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 00C0 0180 0100 0000 1FF8 300C 6000 6000 6000 6000 3007 1FFC 0000 0000 0000 ENDCHAR STARTCHAR U+0108 ENCODING 264 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 01C0 0360 0000 0FF8 180C 3006 3000 3000 3000 3000 3006 180C 0FF8 0000 0000 0000 ENDCHAR STARTCHAR U+0109 ENCODING 265 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0080 01C0 0360 0000 1FF8 300C 6000 6000 6000 6000 3007 1FFC 0000 0000 0000 ENDCHAR STARTCHAR U+010A ENCODING 266 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0180 0180 0000 0FF8 180C 3006 3000 3000 3000 3000 3006 180C 0FF8 0000 0000 0000 ENDCHAR STARTCHAR U+010B ENCODING 267 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0000 0180 0180 0000 1FF8 300C 6000 6000 6000 6000 3007 1FFC 0000 0000 0000 ENDCHAR STARTCHAR U+010C ENCODING 268 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0360 01C0 0000 0FF8 180C 3006 3000 3000 3000 3000 3006 180C 0FF8 0000 0000 0000 ENDCHAR STARTCHAR U+010D ENCODING 269 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0360 01C0 0080 0000 1FF8 300C 6000 6000 6000 6000 3007 1FFC 0000 0000 0000 ENDCHAR STARTCHAR U+010E ENCODING 270 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 06C0 0380 0000 7FE0 1830 1818 180C 180C 180C 180C 1818 1830 7FE0 0000 0000 0000 ENDCHAR STARTCHAR U+010F ENCODING 271 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0001 007B 001A 0018 0018 1FF8 3018 6018 6018 6018 6038 3FCE 0000 0000 0000 ENDCHAR STARTCHAR U+0110 ENCODING 272 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0000 7FE0 1830 1818 180C 180C 7F8C 180C 180C 1818 1830 7FE0 0000 0000 0000 ENDCHAR STARTCHAR U+0111 ENCODING 273 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0000 003C 000C 00FF 000C 0FFC 180C 300C 300C 300C 301C 1FE7 0000 0000 0000 ENDCHAR STARTCHAR U+0112 ENCODING 274 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 03E0 03E0 0000 7FFC 1806 1800 1800 1FF0 1800 1800 1800 1806 7FFC 0000 0000 0000 ENDCHAR STARTCHAR U+0113 ENCODING 275 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0000 03E0 03E0 0000 1FF8 300C 600C 7FF8 6000 6000 3007 1FFC 0000 0000 0000 ENDCHAR STARTCHAR U+0114 ENCODING 276 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0220 01C0 0000 7FFC 1806 1800 1800 1FF0 1800 1800 1800 1806 7FFC 0000 0000 0000 ENDCHAR STARTCHAR U+0115 ENCODING 277 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0220 01C0 0000 0000 1FF8 300C 600C 7FF8 6000 6000 3007 1FFC 0000 0000 0000 ENDCHAR STARTCHAR U+0116 ENCODING 278 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0180 0180 0000 7FFC 1806 1800 1800 1FF0 1800 1800 1800 1806 7FFC 0000 0000 0000 ENDCHAR STARTCHAR U+0117 ENCODING 279 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0000 0180 0180 0000 1FF8 300C 600C 7FF8 6000 6000 3007 1FFC 0000 0000 0000 ENDCHAR STARTCHAR U+0118 ENCODING 280 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0000 7FFC 1806 1800 1800 1800 1FF0 1800 1800 1800 1806 7FFC 00C0 0180 00E0 ENDCHAR STARTCHAR U+0119 ENCODING 281 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0000 0000 0000 0000 1FF8 300C 600C 7FF8 6000 6000 3007 1FFC 00C0 0180 00E0 ENDCHAR STARTCHAR U+011A ENCODING 282 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0360 01C0 0000 7FFC 1806 1800 1800 1FF0 1800 1800 1800 1806 7FFC 0000 0000 0000 ENDCHAR STARTCHAR U+011B ENCODING 283 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0360 01C0 0080 0000 1FF8 300C 600C 7FF8 6000 6000 3007 1FFC 0000 0000 0000 ENDCHAR STARTCHAR U+011C ENCODING 284 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 01C0 0360 0000 0FF0 1818 300C 3000 3000 30FF 300C 300C 1818 0FF0 0000 0000 0000 ENDCHAR STARTCHAR U+011D ENCODING 285 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0080 01C0 0360 0000 0FE7 181C 300C 300C 180C 0FFC 000C 700C 1FF8 0000 0000 ENDCHAR STARTCHAR U+011E ENCODING 286 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0220 01C0 0000 0FF0 1818 300C 3000 3000 30FF 300C 300C 1818 0FF0 0000 0000 0000 ENDCHAR STARTCHAR U+011F ENCODING 287 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0220 01C0 0000 0000 0FE7 181C 300C 300C 180C 0FFC 000C 700C 1FF8 0000 0000 ENDCHAR STARTCHAR U+0120 ENCODING 288 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0180 0180 0000 0FF0 1818 300C 3000 3000 30FF 300C 300C 1818 0FF0 0000 0000 0000 ENDCHAR STARTCHAR U+0121 ENCODING 289 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0180 0180 0000 0000 0FE7 181C 300C 300C 180C 0FFC 000C 700C 1FF8 0000 0000 ENDCHAR STARTCHAR U+0122 ENCODING 290 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0000 0FF0 1818 300C 3000 3000 3000 30FF 300C 300C 1818 0FF0 0180 00C0 0380 ENDCHAR STARTCHAR U+0123 ENCODING 291 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 00C0 0180 0180 0000 0FE7 181C 300C 300C 180C 0FFC 000C 700C 1FF8 0000 0000 ENDCHAR STARTCHAR U+0124 ENCODING 292 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 01C0 0360 0000 7C1F 180C 180C 180C 1FFC 180C 180C 180C 180C 7C1F 0000 0000 0000 ENDCHAR STARTCHAR U+0125 ENCODING 293 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0700 0D80 0000 7800 1800 1800 1FF8 180C 180C 180C 180C 180C 7E0F 0000 0000 0000 ENDCHAR STARTCHAR U+0126 ENCODING 294 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0000 7C1F 180C 3FFE 180C 180C 1FFC 180C 180C 180C 180C 7C1F 0000 0000 0000 ENDCHAR STARTCHAR U+0127 ENCODING 295 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0000 7800 1800 7F80 1800 1FF8 180C 180C 180C 180C 180C 7E0F 0000 0000 0000 ENDCHAR STARTCHAR U+0128 ENCODING 296 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0360 05C0 0000 3FFC 0180 0180 0180 0180 0180 0180 0180 0180 3FFC 0000 0000 0000 ENDCHAR STARTCHAR U+0129 ENCODING 297 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0000 0360 05C0 0000 0000 1FC0 00C0 00C0 00C0 00C0 00C0 7FFF 0000 0000 0000 ENDCHAR STARTCHAR U+012A ENCODING 298 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 07C0 07C0 0000 3FFC 0180 0180 0180 0180 0180 0180 0180 0180 3FFC 0000 0000 0000 ENDCHAR STARTCHAR U+012B ENCODING 299 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0000 03E0 03E0 0000 0000 1FC0 00C0 00C0 00C0 00C0 00C0 7FFF 0000 0000 0000 ENDCHAR STARTCHAR U+012C ENCODING 300 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0440 0380 0000 3FFC 0180 0180 0180 0180 0180 0180 0180 0180 3FFC 0000 0000 0000 ENDCHAR STARTCHAR U+012D ENCODING 301 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0220 01C0 0000 0000 0000 1FC0 00C0 00C0 00C0 00C0 00C0 7FFF 0000 0000 0000 ENDCHAR STARTCHAR U+012E ENCODING 302 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0000 3FFC 0180 0180 0180 0180 0180 0180 0180 0180 0180 3FFC 0180 0300 01C0 ENDCHAR STARTCHAR U+012F ENCODING 303 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0000 00C0 00C0 0000 0000 1FC0 00C0 00C0 00C0 00C0 00C0 7FFF 00C0 0180 00E0 ENDCHAR STARTCHAR U+0130 ENCODING 304 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0180 0180 0000 3FFC 0180 0180 0180 0180 0180 0180 0180 0180 3FFC 0000 0000 0000 ENDCHAR STARTCHAR U+0131 ENCODING 305 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0000 0000 0000 0000 0000 1FC0 00C0 00C0 00C0 00C0 00C0 7FFF 0000 0000 0000 ENDCHAR STARTCHAR U+0134 ENCODING 308 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 001C 0036 0000 003F 000C 000C 000C 000C 000C 000C 000C 7018 1FF0 0000 0000 0000 ENDCHAR STARTCHAR U+0135 ENCODING 309 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0008 001C 0036 0000 0000 03FC 000C 000C 000C 000C 000C 700C 1FF8 0000 0000 ENDCHAR STARTCHAR U+0136 ENCODING 310 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0000 7C3E 1818 1830 1860 18C0 1FC0 1860 1830 1818 180C 7C1F 0180 0180 0700 ENDCHAR STARTCHAR U+0137 ENCODING 311 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0000 7800 1800 1800 181E 1830 1860 18C0 1FE0 1830 1818 7E3F 0180 0180 0700 ENDCHAR STARTCHAR U+0138 ENCODING 312 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0000 0000 0000 0000 781E 1830 1860 18C0 1FE0 1830 1818 7E3F 0000 0000 0000 ENDCHAR STARTCHAR U+0139 ENCODING 313 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0600 0C00 0000 7E00 1800 1800 1800 1800 1800 1800 1800 1803 7FFE 0000 0000 0000 ENDCHAR STARTCHAR U+013A ENCODING 314 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0180 0300 0000 FE00 0600 0600 0600 0600 0600 0600 0600 0607 01FC 0000 0000 0000 ENDCHAR STARTCHAR U+013B ENCODING 315 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0000 7E00 1800 1800 1800 1800 1800 1800 1800 1800 1803 7FFE 00C0 0060 01C0 ENDCHAR STARTCHAR U+013C ENCODING 316 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0000 0000 FE00 0600 0600 0600 0600 0600 0600 0600 0607 01FC 00C0 0060 01C0 ENDCHAR STARTCHAR U+013D ENCODING 317 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0020 0060 7E40 1800 1800 1800 1800 1800 1800 1800 1800 1803 7FFE 0000 0000 0000 ENDCHAR STARTCHAR U+013E ENCODING 318 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0020 0060 FE40 0600 0600 0600 0600 0600 0600 0600 0607 01FC 0000 0000 0000 ENDCHAR STARTCHAR U+013F ENCODING 319 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0000 7E00 1800 1800 1800 18C0 18C0 1800 1800 1800 1803 7FFE 0000 0000 0000 ENDCHAR STARTCHAR U+0140 ENCODING 320 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0000 0000 FE00 0600 0600 0630 0630 0600 0600 0600 0607 01FC 0000 0000 0000 ENDCHAR STARTCHAR U+0141 ENCODING 321 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0000 7E00 1800 1800 18C0 1B80 1E00 3800 7800 1800 1803 7FFE 0000 0000 0000 ENDCHAR STARTCHAR U+0142 ENCODING 322 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0000 0000 FE00 0600 0600 06C0 0780 0E00 1E00 0600 0607 01FC 0000 0000 0000 ENDCHAR STARTCHAR U+0143 ENCODING 323 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 00C0 0180 0000 783F 1C0C 1E0C 1B0C 198C 18CC 186C 183C 181C 7E0C 0000 0000 0000 ENDCHAR STARTCHAR U+0144 ENCODING 324 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0060 00C0 0080 0000 73F0 1C18 180C 180C 180C 180C 180C 7E0F 0000 0000 0000 ENDCHAR STARTCHAR U+0145 ENCODING 325 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0000 783F 180C 1C0C 1E0C 1B0C 198C 18CC 186C 183C 181C 7E0C 0018 000C 0038 ENDCHAR STARTCHAR U+0146 ENCODING 326 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0000 0000 0000 0000 73F0 1C18 180C 180C 180C 180C 180C 7E0F 0018 000C 0038 ENDCHAR STARTCHAR U+0147 ENCODING 327 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0360 01C0 0000 783F 1C0C 1E0C 1B0C 198C 18CC 186C 183C 181C 7E0C 0000 0000 0000 ENDCHAR STARTCHAR U+0148 ENCODING 328 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0360 01C0 0080 0000 73F0 1C18 180C 180C 180C 180C 180C 7E0F 0000 0000 0000 ENDCHAR STARTCHAR U+0149 ENCODING 329 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 3000 7800 3000 6000 0000 73F0 1C18 180C 180C 180C 180C 180C 7E0F 0000 0000 0000 ENDCHAR STARTCHAR U+014A ENCODING 330 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0000 783F 180C 1C0C 1E0C 1B0C 198C 18CC 186C 183C 181C 7E0C 0018 0070 0000 ENDCHAR STARTCHAR U+014B ENCODING 331 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0000 0000 0000 0000 73F0 1C18 180C 180C 180C 180C 180C 7E0F 0018 0070 0000 ENDCHAR STARTCHAR U+014C ENCODING 332 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 03E0 03E0 0000 07E0 0C30 1818 300C 300C 300C 300C 1818 0C30 07E0 0000 0000 0000 ENDCHAR STARTCHAR U+014D ENCODING 333 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0000 03E0 03E0 0000 1FF8 300C 6006 6006 6006 6006 300C 1FF8 0000 0000 0000 ENDCHAR STARTCHAR U+014E ENCODING 334 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0220 01C0 0000 07E0 0C30 1818 300C 300C 300C 300C 1818 0C30 07E0 0000 0000 0000 ENDCHAR STARTCHAR U+014F ENCODING 335 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0220 01C0 0000 0000 1FF8 300C 6006 6006 6006 6006 300C 1FF8 0000 0000 0000 ENDCHAR STARTCHAR U+0150 ENCODING 336 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0360 06C0 0000 07E0 0C30 1818 300C 300C 300C 300C 1818 0C30 07E0 0000 0000 0000 ENDCHAR STARTCHAR U+0151 ENCODING 337 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0330 0660 0440 0000 1FF8 300C 6006 6006 6006 6006 300C 1FF8 0000 0000 0000 ENDCHAR STARTCHAR U+0152 ENCODING 338 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0000 0FFC 18C6 30C0 30C0 30C0 30F8 30C0 30C0 30C0 18C6 0FFC 0000 0000 0000 ENDCHAR STARTCHAR U+0153 ENCODING 339 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0000 0000 0000 0000 1E7C 33C6 6186 61FC 6180 6180 33C6 1E7C 0000 0000 0000 ENDCHAR STARTCHAR U+0154 ENCODING 340 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 00C0 0180 0000 7FF0 1818 180C 180C 1FF8 18C0 1860 1830 1818 7C3F 0000 0000 0000 ENDCHAR STARTCHAR U+0155 ENCODING 341 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0030 0060 0040 0000 79FC 0E07 0C00 0C00 0C00 0C00 0C00 7F80 0000 0000 0000 ENDCHAR STARTCHAR U+0156 ENCODING 342 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0000 7FF0 1818 180C 180C 1818 1FF0 18C0 1860 1830 1818 7C3F 0180 0180 0700 ENDCHAR STARTCHAR U+0157 ENCODING 343 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0000 0000 0000 0000 79FC 0E07 0C00 0C00 0C00 0C00 0C00 7F80 0C00 0600 1C00 ENDCHAR STARTCHAR U+0158 ENCODING 344 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0360 01C0 0000 7FF0 1818 180C 180C 1FF8 18C0 1860 1830 1818 7C3F 0000 0000 0000 ENDCHAR STARTCHAR U+0159 ENCODING 345 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 01B0 00E0 0040 0000 79FC 0E07 0C00 0C00 0C00 0C00 0C00 7F80 0000 0000 0000 ENDCHAR STARTCHAR U+015A ENCODING 346 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 00C0 0180 0000 0FF8 180C 3000 3000 1FF8 000C 0006 0006 300C 1FF8 0000 0000 0000 ENDCHAR STARTCHAR U+015B ENCODING 347 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0060 00C0 0080 0000 0FFC 3807 3800 0FF8 000C 0006 7006 1FFC 0000 0000 0000 ENDCHAR STARTCHAR U+015C ENCODING 348 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 01C0 0360 0000 0FF8 180C 3000 3000 1FF8 000C 0006 0006 300C 1FF8 0000 0000 0000 ENDCHAR STARTCHAR U+015D ENCODING 349 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0040 00E0 01B0 0000 0FFC 3807 3800 0FF8 000C 0006 7006 1FFC 0000 0000 0000 ENDCHAR STARTCHAR U+015E ENCODING 350 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0000 0FF8 180C 3000 3000 1800 0FF8 000C 0006 0006 300C 1FF8 0180 00C0 0380 ENDCHAR STARTCHAR U+015F ENCODING 351 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0000 0000 0000 0000 0FFC 3807 3800 0FF8 000C 0006 7006 1FFC 00C0 0060 01C0 ENDCHAR STARTCHAR U+0160 ENCODING 352 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0360 01C0 0000 0FF8 180C 3000 3000 1FF8 000C 0006 0006 300C 1FF8 0000 0000 0000 ENDCHAR STARTCHAR U+0161 ENCODING 353 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0360 01C0 0080 0000 0FFC 3807 3800 0FF8 000C 0006 7006 1FFC 0000 0000 0000 ENDCHAR STARTCHAR U+0162 ENCODING 354 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0000 3FFC 6186 0180 0180 0180 0180 0180 0180 0180 0180 07E0 0180 00C0 0380 ENDCHAR STARTCHAR U+0163 ENCODING 355 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0000 0000 0600 0600 0600 7FF8 0600 0600 0600 0600 0607 01FC 0060 0030 00E0 ENDCHAR STARTCHAR U+0164 ENCODING 356 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0360 01C0 0000 3FFC 6186 0180 0180 0180 0180 0180 0180 0180 07E0 0000 0000 0000 ENDCHAR STARTCHAR U+0165 ENCODING 357 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0020 0060 0640 0600 0600 7FF8 0600 0600 0600 0600 0607 01FC 0000 0000 0000 ENDCHAR STARTCHAR U+0166 ENCODING 358 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0000 3FFC 6186 0180 0180 0FF0 0180 0180 0180 0180 0180 07E0 0000 0000 0000 ENDCHAR STARTCHAR U+0167 ENCODING 359 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0000 0000 0600 0600 0600 7FF8 0600 0600 1FE0 0600 0607 01FC 0000 0000 0000 ENDCHAR STARTCHAR U+0168 ENCODING 360 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 01B0 02E0 0000 7C1F 180C 180C 180C 180C 180C 180C 180C 0C18 07F0 0000 0000 0000 ENDCHAR STARTCHAR U+0169 ENCODING 361 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0000 0360 05C0 0000 783C 180C 180C 180C 180C 180C 181C 0FE7 0000 0000 0000 ENDCHAR STARTCHAR U+016A ENCODING 362 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 03E0 03E0 0000 7C1F 180C 180C 180C 180C 180C 180C 180C 0C18 07F0 0000 0000 0000 ENDCHAR STARTCHAR U+016B ENCODING 363 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0000 03E0 03E0 0000 783C 180C 180C 180C 180C 180C 181C 0FE7 0000 0000 0000 ENDCHAR STARTCHAR U+016C ENCODING 364 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0220 01C0 0000 7C1F 180C 180C 180C 180C 180C 180C 180C 0C18 07F0 0000 0000 0000 ENDCHAR STARTCHAR U+016D ENCODING 365 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0220 01C0 0000 0000 783C 180C 180C 180C 180C 180C 181C 0FE7 0000 0000 0000 ENDCHAR STARTCHAR U+016E ENCODING 366 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 03C0 0180 0000 7C1F 180C 180C 180C 180C 180C 180C 180C 0C18 07F0 0000 0000 0000 ENDCHAR STARTCHAR U+016F ENCODING 367 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0100 0280 0100 0000 783C 180C 180C 180C 180C 180C 181C 0FE7 0000 0000 0000 ENDCHAR STARTCHAR U+0170 ENCODING 368 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 01B0 0360 0000 7C1F 180C 180C 180C 180C 180C 180C 180C 0C18 07F0 0000 0000 0000 ENDCHAR STARTCHAR U+0171 ENCODING 369 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0330 0660 0440 0000 783C 180C 180C 180C 180C 180C 181C 0FE7 0000 0000 0000 ENDCHAR STARTCHAR U+0172 ENCODING 370 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0000 7C1F 180C 180C 180C 180C 180C 180C 180C 180C 0C18 07F0 00C0 0180 00E0 ENDCHAR STARTCHAR U+0173 ENCODING 371 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0000 0000 0000 0000 783C 180C 180C 180C 180C 180C 181C 0FE7 000C 0018 000E ENDCHAR STARTCHAR U+0174 ENCODING 372 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 01C0 0360 0000 7C1F 180C 180C 180C 188C 19CC 1B6C 1E3C 1C1C 180C 0000 0000 0000 ENDCHAR STARTCHAR U+0175 ENCODING 373 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0080 01C0 0360 0000 780F 180C 180C 180C 19CC 19CC 0F78 0630 0000 0000 0000 ENDCHAR STARTCHAR U+0176 ENCODING 374 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 01C0 0360 0000 7C3E 1818 0C30 0660 03C0 0180 0180 0180 0180 07E0 0000 0000 0000 ENDCHAR STARTCHAR U+0177 ENCODING 375 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0080 01C0 0360 0000 783F 180C 180C 180C 180C 0FFC 000C 700C 1FF8 0000 0000 ENDCHAR STARTCHAR U+0178 ENCODING 376 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0660 0660 0000 7C3E 1818 0C30 0660 03C0 0180 0180 0180 0180 07E0 0000 0000 0000 ENDCHAR STARTCHAR U+0179 ENCODING 377 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 00C0 0180 0000 3FFC 6038 0070 00E0 01C0 0380 0700 0E00 1C06 3FFC 0000 0000 0000 ENDCHAR STARTCHAR U+017A ENCODING 378 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 00C0 0180 0100 0000 3FFE 600E 0038 00E0 0380 0E00 3803 3FFE 0000 0000 0000 ENDCHAR STARTCHAR U+017B ENCODING 379 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0180 0180 0000 3FFC 6038 0070 00E0 01C0 0380 0700 0E00 1C06 3FFC 0000 0000 0000 ENDCHAR STARTCHAR U+017C ENCODING 380 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0000 0180 0180 0000 3FFE 600E 0038 00E0 0380 0E00 3803 3FFE 0000 0000 0000 ENDCHAR STARTCHAR U+017D ENCODING 381 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0360 01C0 0000 3FFC 6038 0070 00E0 01C0 0380 0700 0E00 1C06 3FFC 0000 0000 0000 ENDCHAR STARTCHAR U+017E ENCODING 382 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0360 01C0 0080 0000 3FFE 600E 0038 00E0 0380 0E00 3803 3FFE 0000 0000 0000 ENDCHAR STARTCHAR U+0180 ENCODING 384 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0000 7800 1800 7F80 1800 1FF8 180C 1806 1806 1806 1C06 73FC 0000 0000 0000 ENDCHAR STARTCHAR U+0181 ENCODING 385 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0000 3FF0 4C18 4C0C 6C0C 0C18 0FF8 0C0C 0C06 0C06 0C0C 3FF8 0000 0000 0000 ENDCHAR STARTCHAR U+0187 ENCODING 391 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 000E 0013 0010 0FF8 180C 3006 3000 3000 3000 3000 3006 180C 0FF8 0000 0000 0000 ENDCHAR STARTCHAR U+0188 ENCODING 392 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0000 000E 0013 0010 1FF8 300C 6000 6000 6000 6000 3007 1FFC 0000 0000 0000 ENDCHAR STARTCHAR U+0189 ENCODING 393 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0000 7FE0 1830 1818 180C 180C 7F8C 180C 180C 1818 1830 7FE0 0000 0000 0000 ENDCHAR STARTCHAR U+018A ENCODING 394 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0000 3FF0 4C18 4C0C 6C06 0C06 0C06 0C06 0C06 0C0C 0C18 3FF0 0000 0000 0000 ENDCHAR STARTCHAR U+018E ENCODING 398 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0000 3FFE 6018 0018 0018 0018 0FF8 0018 0018 0018 6018 3FFE 0000 0000 0000 ENDCHAR STARTCHAR U+0193 ENCODING 403 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 001C 0026 0020 0FF0 1818 300C 3000 3000 30FF 300C 300C 1818 0FF0 0000 0000 0000 ENDCHAR STARTCHAR U+01C3 ENCODING 451 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0000 0180 03C0 03C0 03C0 03C0 0180 0180 0180 0000 0180 03C0 0180 0000 0000 ENDCHAR STARTCHAR U+01CD ENCODING 461 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0360 01C0 0000 0FC0 0360 0220 0630 0410 0FF8 0C18 180C 180C 7E3F 0000 0000 0000 ENDCHAR STARTCHAR U+01CE ENCODING 462 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0360 01C0 0080 0000 1FF8 700C 000C 0FFC 180C 300C 301C 1FE7 0000 0000 0000 ENDCHAR STARTCHAR U+01CF ENCODING 463 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0360 01C0 0000 3FFC 0180 0180 0180 0180 0180 0180 0180 0180 3FFC 0000 0000 0000 ENDCHAR STARTCHAR U+01D0 ENCODING 464 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0360 01C0 0080 0000 0000 1FC0 00C0 00C0 00C0 00C0 00C0 7FFF 0000 0000 0000 ENDCHAR STARTCHAR U+01D1 ENCODING 465 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0360 01C0 0000 07E0 0C30 1818 300C 300C 300C 300C 1818 0C30 07E0 0000 0000 0000 ENDCHAR STARTCHAR U+01D2 ENCODING 466 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0360 01C0 0080 0000 1FF8 300C 6006 6006 6006 6006 300C 1FF8 0000 0000 0000 ENDCHAR STARTCHAR U+01D3 ENCODING 467 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0360 01C0 0000 7C1F 180C 180C 180C 180C 180C 180C 180C 0C18 07F0 0000 0000 0000 ENDCHAR STARTCHAR U+01D4 ENCODING 468 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0360 01C0 0080 0000 783C 180C 180C 180C 180C 180C 181C 0FE7 0000 0000 0000 ENDCHAR STARTCHAR U+01DD ENCODING 477 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0000 0000 0000 0000 0FFC 1806 1803 0FFF 0003 0003 7006 1FFC 0000 0000 0000 ENDCHAR STARTCHAR U+01E2 ENCODING 482 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 01F0 01F0 0000 1FFC 06C6 04C0 0CC0 0FF8 18C0 18C0 30C0 30C6 79FC 0000 0000 0000 ENDCHAR STARTCHAR U+01E3 ENCODING 483 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0000 03E0 03E0 0000 3E7C 63C6 0186 1FFC 3180 6180 61C6 3E7C 0000 0000 0000 ENDCHAR STARTCHAR U+01E6 ENCODING 486 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0360 01C0 0000 0FF0 1818 300C 3000 3000 30FF 300C 300C 1818 0FF0 0000 0000 0000 ENDCHAR STARTCHAR U+01E7 ENCODING 487 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0360 01C0 0080 0000 0FE7 181C 300C 300C 180C 0FFC 000C 700C 1FF8 0000 0000 ENDCHAR STARTCHAR U+01EA ENCODING 490 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0000 07E0 0C30 1818 300C 300C 300C 300C 300C 1818 0C30 07E0 0180 0300 01C0 ENDCHAR STARTCHAR U+01EB ENCODING 491 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0000 0000 0000 0000 1FF8 300C 6006 6006 6006 6006 300C 1FF8 0180 0300 01C0 ENDCHAR STARTCHAR U+01EC ENCODING 492 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 03E0 03E0 0000 07E0 0C30 1818 300C 300C 300C 300C 1818 0C30 07E0 0180 0300 01C0 ENDCHAR STARTCHAR U+01ED ENCODING 493 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0000 03E0 03E0 0000 1FF8 300C 6006 6006 6006 6006 300C 1FF8 0180 0300 01C0 ENDCHAR STARTCHAR U+01F0 ENCODING 496 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0036 001C 0008 0000 0000 03FC 000C 000C 000C 000C 000C 700C 1FF8 0000 0000 ENDCHAR STARTCHAR U+01F4 ENCODING 500 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 00C0 0180 0000 0FF0 1818 300C 3000 3000 30FF 300C 300C 1818 0FF0 0000 0000 0000 ENDCHAR STARTCHAR U+01F5 ENCODING 501 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0060 00C0 0080 0000 0FE7 181C 300C 300C 180C 0FFC 000C 700C 1FF8 0000 0000 ENDCHAR STARTCHAR U+01F8 ENCODING 504 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0220 01C0 0000 783F 1C0C 1E0C 1B0C 198C 18CC 186C 183C 181C 7E0C 0000 0000 0000 ENDCHAR STARTCHAR U+01F9 ENCODING 505 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0220 01C0 0000 0000 73F0 1C18 180C 180C 180C 180C 180C 7E0F 0000 0000 0000 ENDCHAR STARTCHAR U+01FC ENCODING 508 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0060 00C0 0000 1FFC 06C6 04C0 0CC0 0FF8 18C0 18C0 30C0 30C6 79FC 0000 0000 0000 ENDCHAR STARTCHAR U+01FD ENCODING 509 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 00C0 0180 0100 0000 3E7C 63C6 0186 1FFC 3180 6180 61C6 3E7C 0000 0000 0000 ENDCHAR STARTCHAR U+01FE ENCODING 510 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 00C0 0180 0000 07D8 0C30 1868 30CC 318C 330C 360C 1C18 1830 37E0 0000 0000 0000 ENDCHAR STARTCHAR U+01FF ENCODING 511 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0060 00C0 0080 0000 0FFA 180E 303C 30E6 3386 1E06 380C 2FF8 0000 0000 0000 ENDCHAR STARTCHAR U+0202 ENCODING 514 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0380 0440 0000 0FC0 0360 0220 0630 0410 0FF8 0C18 180C 180C 7E3F 0000 0000 0000 ENDCHAR STARTCHAR U+0203 ENCODING 515 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 01C0 0220 0000 0000 1FF8 700C 000C 0FFC 180C 300C 301C 1FE7 0000 0000 0000 ENDCHAR STARTCHAR U+0206 ENCODING 518 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 01C0 0220 0000 7FFC 1806 1800 1800 1FF0 1800 1800 1800 1806 7FFC 0000 0000 0000 ENDCHAR STARTCHAR U+0207 ENCODING 519 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 01C0 0220 0000 0000 1FF8 300C 600C 7FF8 6000 6000 3007 1FFC 0000 0000 0000 ENDCHAR STARTCHAR U+020A ENCODING 522 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0380 0440 0000 3FFC 0180 0180 0180 0180 0180 0180 0180 0180 3FFC 0000 0000 0000 ENDCHAR STARTCHAR U+020B ENCODING 523 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 01C0 0220 0000 0000 0000 1FC0 00C0 00C0 00C0 00C0 00C0 7FFF 0000 0000 0000 ENDCHAR STARTCHAR U+020E ENCODING 526 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 01C0 0220 0000 07E0 0C30 1818 300C 300C 300C 300C 1818 0C30 07E0 0000 0000 0000 ENDCHAR STARTCHAR U+020F ENCODING 527 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 01C0 0220 0000 0000 1FF8 300C 6006 6006 6006 6006 300C 1FF8 0000 0000 0000 ENDCHAR STARTCHAR U+0212 ENCODING 530 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 01C0 0220 0000 7FF0 1818 180C 180C 1FF8 18C0 1860 1830 1818 7C3F 0000 0000 0000 ENDCHAR STARTCHAR U+0213 ENCODING 531 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 00E0 0110 0000 0000 79FC 0E07 0C00 0C00 0C00 0C00 0C00 7F80 0000 0000 0000 ENDCHAR STARTCHAR U+0216 ENCODING 534 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 01C0 0220 0000 7C1F 180C 180C 180C 180C 180C 180C 180C 0C18 07F0 0000 0000 0000 ENDCHAR STARTCHAR U+0217 ENCODING 535 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 01C0 0220 0000 0000 783C 180C 180C 180C 180C 180C 181C 0FE7 0000 0000 0000 ENDCHAR STARTCHAR U+0218 ENCODING 536 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0000 0FF8 180C 3000 3000 1800 0FF8 000C 0006 0006 300C 1FF8 0000 0180 0300 ENDCHAR STARTCHAR U+0219 ENCODING 537 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0000 0000 0000 0000 0FFC 3807 3800 0FF8 000C 0006 7006 1FFC 0000 00C0 0180 ENDCHAR STARTCHAR U+021A ENCODING 538 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0000 3FFC 6186 0180 0180 0180 0180 0180 0180 0180 0180 07E0 0000 0180 0300 ENDCHAR STARTCHAR U+021B ENCODING 539 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0000 0000 0600 0600 0600 7FF8 0600 0600 0600 0600 0607 01FC 0000 0060 00C0 ENDCHAR STARTCHAR U+021E ENCODING 542 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0360 01C0 0000 7C1F 180C 180C 180C 1FFC 180C 180C 180C 180C 7C1F 0000 0000 0000 ENDCHAR STARTCHAR U+021F ENCODING 543 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0D80 0700 0200 7800 1800 1800 1FF8 180C 180C 180C 180C 180C 7E0F 0000 0000 0000 ENDCHAR STARTCHAR U+0226 ENCODING 550 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0180 0180 0000 0FC0 0360 0220 0630 0410 0FF8 0C18 180C 180C 7E3F 0000 0000 0000 ENDCHAR STARTCHAR U+0227 ENCODING 551 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0000 0180 0180 0000 1FF8 700C 000C 0FFC 180C 300C 301C 1FE7 0000 0000 0000 ENDCHAR STARTCHAR U+0228 ENCODING 552 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0000 0000 7FFC 1806 1800 1800 1FF0 1800 1800 1800 1806 7FFC 00C0 0060 01C0 ENDCHAR STARTCHAR U+0229 ENCODING 553 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0000 0000 0000 0000 1FF8 300C 600C 7FF8 6000 6000 3007 1FFC 00C0 0060 01C0 ENDCHAR STARTCHAR U+022E ENCODING 558 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0180 0180 0000 07E0 0C30 1818 300C 300C 300C 300C 1818 0C30 07E0 0000 0000 0000 ENDCHAR STARTCHAR U+022F ENCODING 559 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0000 0180 0180 0000 1FF8 300C 6006 6006 6006 6006 300C 1FF8 0000 0000 0000 ENDCHAR STARTCHAR U+0232 ENCODING 562 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 03C0 03C0 0000 7C3E 1818 0C30 0660 03C0 0180 0180 0180 0180 07E0 0000 0000 0000 ENDCHAR STARTCHAR U+0233 ENCODING 563 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0000 03E0 03E0 0000 783F 180C 180C 180C 180C 0FFC 000C 700C 1FF8 0000 0000 ENDCHAR STARTCHAR U+0237 ENCODING 567 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0000 0000 0000 0000 0000 03FC 000C 000C 000C 000C 000C 700C 1FF8 0000 0000 ENDCHAR STARTCHAR U+2020 ENCODING 8224 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0000 0180 0180 0180 1FF8 1FF8 0180 0180 0180 0180 0180 0180 0180 0180 0000 ENDCHAR STARTCHAR U+2021 ENCODING 8225 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0000 0180 0180 0180 1FF8 1FF8 0180 0180 0180 1FF8 1FF8 0180 0180 0180 0000 ENDCHAR STARTCHAR U+2022 ENCODING 8226 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0000 0000 0000 0000 0000 0180 03C0 03C0 0180 0000 0000 0000 0000 0000 0000 ENDCHAR STARTCHAR U+2039 ENCODING 8249 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0000 0000 0000 0000 0070 01C0 0700 01C0 0070 0000 0000 0000 0000 0000 0000 ENDCHAR STARTCHAR U+203A ENCODING 8250 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0000 0000 0000 0000 0700 01C0 0070 01C0 0700 0000 0000 0000 0000 0000 0000 ENDCHAR STARTCHAR U+20AC ENCODING 8364 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 03F8 07FC 0E04 3FC0 3FC0 0C00 0C00 3FC0 3FC0 0E04 07FC 03F8 0000 0000 0000 ENDCHAR STARTCHAR U+22C5 ENCODING 8901 SWIDTH 1000 0 DWIDTH 16 0 BBX 16 16 0 -3 BITMAP 0000 0000 0000 0000 0000 0000 0000 0000 0180 0000 0000 0000 0000 0000 0000 0000 ENDCHAR ENDFONT LambdaHack-0.9.5.0/GameDefinition/fonts/16x16xw.woff0000644000000000000000000012734007346545000020074 0ustar0000000000000000wOFF®à×`DSIG®˜FFTM®Ä†ÈGDEF® $&'ªOS/2øJ`‰‹Ecmapü2Nž™—åcvt DÜLfpgm0±e´/§gasp®ÿÿglyf `¢ŘÚó¨ðhead€56™%,hhea¸ $ YhmtxDµ”ˆ¸locaT  Íy_žmaxpØ ©íname¬ð‡à|˜post®x ÿ;eprepä__ýÿP¦xœc`d``âÓ~Žïâùm¾2ȳ9En¤vnÓûBþ]asbr9˜@¢KÀ Cxœc`d``ùw•Íáÿ?6'  `pG~„\ xœc`as`üÂÀÊÀÀ"À’ÀÀÀðB330ø3Îc@ ü@Ê Æ÷vÊ ²+eùw•U„Q&ǬÀâ¤Ô Uxœ•RÛ„ |XŒCW†PñíP‡5XÀ-äÀ@ð¼›$,yl0Ë‹hiËF"»™“#Û&»³[åö¢ŒøË{µåYr@‰™…å» Ôå`‚%žX£Y‹*ǺŠÎçÀÑåŽûˆ˜K±‡ÕgMÂbHû£·)p*^£S~U¾­®_kÒû­¯ægo:®_s?ÝýÑ%þ¢Ì?¯8öš”×·Wk\™ˆ<çgž‰7hXº›xœ­’kLPÇÏ)E!Š\¢^!r)]èâNîw’¤’¤!„6÷"·a¹Ímîׄ…¹4}3ߘ06›Í†­íq¼ï;£ÏÎöüŸsyžÿÎùÿà+:!‘$»çÚSzÚ<ša4Á oŠ¨()’b)•2)—:y!¯ä|”ÏòE¾ËOQãa¼¯ñ3&È„˜pibLœ#Ô‘è¨}¦jù¼qpŠJ‰•MRâæynyÞÊùdy¾Éi0ÆxÓÒø›@lÂL„‰¶<G‚‹Gô½ÖéS}¬´F«µJ·êz-Ð|]ªyºHs5G³5K35]Ó4US4Y'ëx«£ê3êǼyùºÖõÞÿ0ìMÊшñ·ŽÆ=7› W§§[é¦4Ã_šÓ‚–øÑŠÖø@ÚH;ÚÓŽY:LˆU´ ¡t¥Ý £= §½éC_"ˆ¤QDC,ý@ñ$È@1˜! µg#Ib”õ{ cÇx&0‘ILf S™ÆtfÌLR˜E*³IcédÉ\²˜G¶½ÿvJØÉ.Ê9ÂIÎr†s\à<¹ÌU®PÁ5®SÉ nRÅmnq‡»Tó€û<¤V YÉrY,YÃi–³Ä²®"ÏâŽZ,pê´Õi·” /QC19äÿÙ_F¡Åùlf‡Å_þQüž'o¥ßlb±Ó„"ÖºO·²›-ì¡”½ìc?eäÝ?ÀqNpŒ¯Îªîêu®ô Tuž)xœ]Q»N[AÝ ÄØ 9Ú³™ï…6H ®.ÂÈvc9BÚ\äb\ÀP Qƒökh(S¤Mƒ $>Oˆ”™5‰¢4;;³sΙ3KÊ‘ªwi½ç©sHánƒf›~'¤ÚE€ÒõFFÚÁ#-63zåº}¿Áf4åN@yÏ[ÊCFÓN í¹2?ƒá>ÿË<ƒ–fšžZg!=„À|3nið5£YwýA_±:\ †ÓTÜõÇTÊÿ–æ\m¶63šwp!"?˜hj­@ÓŸ:¤z>Žb rùl¬ &¦¬?ÉDpa2]ÕT-3¾vpŸì,:ؤJsà°Už‚‡ã£ …ô-‰2KC„ƒØ*1BÄ$‡BN9w²?)P>’„1o’Òθa­qä50¨ÍÓ¾ÌfSÛ[‡0~GðÝ/Æ’>²¡6F„ØŽX `‘QU¾¡Æs/‹¹Ôþ3%`yúí_'­;6/emcŒ‚žß6ßùeÅݪ\çE¡»wU5Té”æC/gßãO…á ±àÍç}£@í ‹ šÁÞÞÿÑZuÄUÞ Ùo5³±¸ÿ…°K°PX±ŽY±F+X!°YK°RX!°€Y°+\X° E°+D° E²+°+D° E°+D° Eºÿ+±Fv+DY°+ LdÈÈÈ>jÚ®Üè.ž ’Ò 8r¢8vªè d  j 2 Ð , š , N Þà¸NÖ`Æ À0jÂŽÚŒH†Vº4Úæ–Hx¤Ôê"¦  Š þ!~!ê"~"Þ#$#r$"$\$Æ%B%Ä&8&¢&ö'z'Ì(,(Ú)T**†++l+ˆ+ò,N,N,ž-0-Ú.þ/®/Ö0¤0Ì1š1î2ˆ2°3’3ª3ò4<4 55B5¦5ì66<6|6Ò7j88Ä9r:&;;ø<Ú=Ò>°?œ@^A"A¶BJBäCnCÖD>D²EE¼F¸GfHHÈI’J6J²KœLDLìMšN:OOnPPÒQŒRTS&SÖT²UpVVÐW~Xyyèz²{d| |Þ}œ~>~ÒdÚ€^€æ0xò‚d‚ʃDƒƒÈ„H„Â…¶†ˆ‡:‡¦ˆˆ–‰‰|‰äŠBŠŠ‹‹tŒZêŽ~:æ‘À’Z’ò“ˆ”D”ü•Ì– —4—è˜Ä™Fš6šº›¤œ8¾žŒŸR 6 ö¡Ì¢”£ £ª¤<¤Â¥<¥¦¦d§ §ž¨ ¨Ä©Xªª°«l¬ ¬Ò­b®:®ö¯Ð°‚±L²²à³´.µµè¶€·8·æ¸~¹$¹Æº.ºô»L¼6½½z½þ¾¸¿~À4ÀØÁXÂ$ÂöÃÎĤÅ^ÆÆìÇÀÈ>ÉÉÐʾËjÌLÍ>ÎJÏJÐ2ÐðÑŒÒ@Ò²Ó"ÓØÔŽÕvÖÖ²×BØØÐÙXÙÚÚ„Û*ÛþÜœÝ<ÝöÞŠßßÜàbà ààá6ápáÂââ²âÌxœì½{Œ+ivVÅG7Ù|UñÙ$›M²É~²»Ù]¼}ïôÎÌîÌììkvô´”Y10ðe úËZ'#¬Á®…À±¥YÛyXVþ±í 6U$W ‘bÄÂ^Þ‰àÚÑ… «•`C;‹$6¢Ù$ÐÞÛ›ó;çûŠUl²o÷Þ]åŸÜg±Èî®ïœóï<Ç0#o›oE?g¾oDºá}ÏŒ¾gº±¾g˜=/Ï‹›=ãäÔ<”"oOÍ·†C#yã;¿ýFìu#eT £}6 7¥N©sµùÚîÐïÈÃépö¿"oà\~úò]óÐ0"æûÑV̹ô³Wcd˜FÏ &fÌHÄznÜ1ÝDß5á9ܨåÅè‘Vé‘’òHöÀnÓ_óý©y8¶Ì·.?¿FĘ~çWâ?KÏW7šÆ/£Õ}ßÔ«+TÏŒ½çÙŽC?p­7~ɨ%{nÉÁ¢s›ôvœÞNfúé­¾[{äEVÇ«ÒÏMàkjU|MÍ ¯‰9nÕòÊôTk úH‰>’¶è#¥2>R*ÐG²Ž×槽wFTaJµ…Z¶P¬Mïµíö¿Ì·ø¿éå§q}ùéaèŽ| ja}Ÿ!ºõŒñ¼™6F­p{àE£ï¹wœQ . ¼SzY¥—§xžœMϳGŒ=°Zÿ¬ïv`µ{×™l5ìLÏÛŠ½7Y9Æ¥[x+ôÞï<öž»by‡ô^j?–¢ËR…?æ ¼},C”z|r×fÕ¡ã&Zl/}@Ô<¦§Ø·göF1«ï©vãïòµ;téîZÞQpýœnwˆ‚åMºy_Þ¦W/B v~´’ÍŸŸ{{v~\Üènw+熷ҴónãÜ=¶G«‰MzŸé\"ržuΘÚg vô>ëØøŸ©^ÕÛgÕRÇÄéÓ‡fïò]ªyøŽy8|ø€þ¡_—ï¾sùé‹áƒCó[†ÃøÀ[¾P“<ëkyzãñ×é¥aqcJÿ|†÷IßxÞø˜ñ—Ì¿gŒ> ^¥ÞkÑ÷Fiºö2$oVý­Úýð`òbÌHÅzžý2Ý{ÑòŽcï¢àhcà=OŸmÞ%à Šm¯z‡(½F¼ÚvÜ5Ësˆ+ÇuˆætoÍr Ðsµ3ཕâ½åÕéÛ¶éçO ­7?4›½üQbÄÐ7Øwܱ¼RŒÔÁñ.tˆ“çÎä$n¤é;Ð7·ˆ9ƒ{ôñ½³âŒû=+ÑóÒô"Ý÷"kôH}º¶,7‹DìŒ%hI=kr&ßã¬ïæÞ>}¨ˆOT¸e\lÓÅÇñAï³ç®;Þkôµ[?â8“ËÖð©~”~ ‰ûšå}’>÷CŽ÷azµ÷šô/½J?ìÃÖääk~ ïý8mEï0c罜a)ºj³ ´Ïl—Ðo•àï( Œˆ MàkïîO‡æÉÄWY .†Ã‡úb:¼?¤?þ€©^¿ !ƒØ=yõá}‘¨©-Rküÿã¯ë]\\Ї H¶þdëÔxÑø„ùÓÆèrµ?ðîïv~é9ÄÐmˆ 4‚÷1¾øIÅ«Îh ú¶4ðRôgœZKd{ne0ɈŒØÎÄ0s¢ Úö/=ϯÚï%ú¾-úª¸ã¶,¯K¯ž{ óµ¾{B s8u'ÎBüü‰ ¿‰Ã7Ü‹•Ã(–><¾$w?æ¸w,ïœ4ÄÙˆ¨óe¥ °)¶åû‘’uë–·I¢Öï9Ìo÷`åáî8Ï™i ÷Ží®ž{÷Îíü—íõêá‘ÅšãÎ1}¢×?Á'Û=<÷ž7íü$«66énËvkçÞÚKô©¾òa|*e»ýr¦x-úÅ×)"þ5‰D£sö¼ •ƪ¾ùe¾¯™-ºfúä‹t©ù-§§/þç|íƒ h#úE:ÇŒ¼y›Îf×È?iŒâPÉ#†§œQ<†ƒ ¾šìL¨ ƒ"CrbºVß<¢=ìeˆŠ g”‰à“™Qt0{9bŠ­í!€ZÂÛ¦å7ÛÄÞÈV笶ì"]^»E”¨Ÿ»†ínœ“uH,O®1kE:[Rý•W‚ä‚Ó¡Ú\r¡oáž¾Àž‚±J´øã?`¸k}ü!"¬ âÎÈ4°3š¤”¦·¹ÇKÒâbÎ(¹†÷’ØskI\® ¼ŒÚE0`Ûd°tl’°·Øè›êÿaÎüóßÿÎsÑoÐSä ÒóQèù5ÙÓ´ScQ|ÓØ /×ÇŽæÍl>£xÕ¥ÙÌM¯aÛ§õ“b#{iÐ,“13 ±r3DÂxx·ÉÊ– ¥¤6¸ÐÆ|+^Œ¼A'RAü‡˜øÚoh—ÌCzx²c ÑOðh-)ãuÙ3 éH$¾)ƒ^ˆò<ôSš|VÂØ5Œ+‡üƒ¾SšiÜiPÓ^¹2 uÃÎ+¿Ñ1þ¹1² Ê´óù¢H«[wX{ ºÉMºYs&­¶'«º¾uÙÌ*Òbó¢ù¼2]7·hy-âN¸ŽåUé2E—|ˆŽfQÙ¼UŠyÚ±¸…­’©ú‡ á•-zA†TdÑ¥Œ,>‚5Ž$×LR,^¼A‰®&ÄŒ¶ýÃuÔâ=ö]l>Èà¢[l|ìœtr™½w¦8`ΰ^¹¸ˆüæýûС̦Õ׈VÍvCèpJUFQK«¡,ŸH´.Zê(ÅÇQ*Cœ¤p!ÎÓ¿1âŽùOKV?Km¨iä Ú=‡ÃwH­E~“Œ¯ÇëÃÀÏÞ7¾ª~v‡ØQ;²Ñ÷¼=ž‘·}o²3 ð‰è²µÂ—Ä¡Éæ*_nÒåÚ_Òé5©Ôø²¯²À¾ÙT/ÊtØ1²ͼ5âRU —4 U¨ÀŒv·«L`¯VàL4_€1’¶¿K$³9¶LHÝo4ˆ‹Û-c·vhGLðl 4em´Cæ‰smvè<óhJüºüê”y8¥‹iôs‡âñLbŽí~‡i÷?£=>âˆvÐ.O´3öxåÛâUÆr÷*™Þ$5vbìãL꛸¿Ã+UøÓÕW¤Oç„N±G^"K¦YÿÞF˹ÖÀÛ¤µ²bÓ›Z‘¹Û–ÛÁVp¼ôÙsì©£Ò[¯BäÍ()´øí. ¸¼×l‰‹ØÖÙBZù;#"EÞþä'Ÿ|ÁüNF¢Qä·A’×^>þŒÐæç_Ó´úÒÏO• ðûHÆMØ`ñB  ë¶Y`#a"˜À± ^œðk´„è]ç®i»)qW8âAžìÙôa´õðá㟋¼a¾™6ßÿö„D=ø³ëÆ?5F5ͧ”–q£Æ”¯ø|Ê­ÕRħóÉÍÑÃ(;…T¯áÀäÃÍSLo²Á”ÕÂ’›Wž³vîÆHiѽ‚3LÐ\(» Û+”ÙZ!±us¶]äóJ…ÏÁ ÆõI©<þ¹Øèq%ÚVš:åðµHöâò”… ½ñ×Ý6zÆŸ£M¬¼K+ç‹­|ƒqmk3Ñsö*G…@’Q:LÒqã{C9gk\èm‚8!NÁòöAœCæݯßm)UÝ…««¨³É¦²»e±RNï+f þÌ.¤Ѥ#z«»EâºJæ¨Wߥ Ÿ(n4ØÆën ë×sw‹­›B>Y" z)ÒñlÊj--’ÛQ†l`Çû:"ÎÆùoÂÀó‰©Ôö«S¶ßñëâÚö¤¸¼Ò™Ÿ4Ät¯h¾JT„t³Á1ç ­hx•2±¾pîV‰Ùd°¹±ü8gíîÑI”µÙúÝ^p8Oãeõdpš/ô¹ýÓ‹€O¤nß¿oðyü'ôÌoÒ37Iîу6Xè)ù¢E¼î:²'Îôæ¸G7Ém=Üß Ž#âž8“Õ¼ríÎ$ÖSÏõÝM$ðö•{뵈ᛖÇubC¾ÎA‡8½{ª‚ˆV‘¾¢)¡ÏäéF¶F7:–»­ŽxÁÞ™¶^ŠŒYo»-½´µARA*¤¢e*F WûùI¤T6wp8Úãh¡xŒã’+σ¬ (bŠÅ$Úìñ±ð*³É„»LF“(5µñØnB”è´{™ü0ÄÚÿƒk,æQÑ’Tò£ÝyðlégrlKËF.AÎÉzÈ(’-#ÆBfõ(ytƉ5#‹¨äd5αwRìÕ+vuôª= XÚ‘7f~AD|zîDï¯ed«(”CÐrd[xÇ.øþ̸-àÙ7àÕŒâù<›Ñjq݌ң[ƒÉšC³UérüÌžÑ73Êhk§v]_ÔX5 àP_ÅÄ&;Ý="½ÛÀÅr÷Iö7`„™î Uø{šºä¨`[±#d‘eâ á•”ËH“²ç<½:¥·ì ïá”lÚîþ¹wˆPR6_€ó[$Ûk¼º²³+W[Lí¬í5zôùÃü8•³ØãêÛ£4{Î^­0ó—Ýu{­â{ÇónâŠÏL›‚3e—Ù²‘êÀÝFÊZeÈ^3ÂoX„"‚›ï›‡´¿Ä“Æ;â—ùÑÇá›ü ¶¬¼Ä¾Æ©Ù7FGг-²>`ún‚ä[“‰éo8£bDÅaùªgwå¨HlH×È"Ù¥ÝbÅñ‘I+¦Ýt¾ÛäÞí@C÷HCX^&Å Ë®ƒ\á)~â…EïFâF7Ö›DåC=Ç°L'òd]î­[“ÈMõé…·š"ÏA$“=dA¥z8ÜG›üèÍýhm1m³pšèÜf§Â[K)SÙðNæïn³ì²XqH;''§fÇ·€$ †ÍöcÀR׃è¯üÃ×Á¬×Ÿ¼ÏÛDìæé“/òâÿ£ŸãíÈûk:;F`›•]"khÛøJ RV!"]uÝ!öl6Œ¸è1X®“dš_&¡Dw$á(Ñ&y,eAfºl!óìUê‡P¼lž¶GSY?iì¢)˵•CâVIÒý]D(ÚÊ/Qáf²â¶—¿™w³ç^,IwWIôm}­eÂôöœ—MÔˆý öŸÿˆ=ëWU؈ˆÆöãŸàí?&£óKÁxMÇ£èT"¹å‹[ ãBK<º­ÆÖ!É•ÐÎÒÊ(ÏÑéQ ʈV×DHTâLnÔÑq·<6åÌ•Ä™+ø‘ê:,K‡³“0.³[a‹• \5¯Á‰ˆÍ&lÇ>(‰¢‡hûGˆtÀ/ I«vûÃ!" ÓÈo!7ÛûÉG..Ľ‘½îÇßHN‘4-Gc:ôÖcïÍdiS‡éf]­{”â´O‹å§H;+R OQ¢Œ™ø{c;SMˆï_ê#móÒݪåÇsL–6»°~5¼2Y`nŠÒËfˆ:« ?@”}Zm·ý|$%úMQtO¾ © Ú^,$J^ ÍÿsxA22T2R1þv€"v`/¥¯,‘½"”[†· ‡·ç»lk­3%lq;Â6háF;HÛòò&çJ" R AוrE¸>[šÓ`~Ó’È“}øøë‘ßzòáh‹­–ói. àØ^KÁøKײlÅ ($—.qH²ÿ½þGøfeñÃÂ> =µ²…W^áØúÿjŒºzvg{ôV›qR«wWiuØÎ qíÔÖÜY¶5›,~£&'‘š$Ž£¶%YnãÍr-Ùc¯°Ã{¶‹=Ûæ=ËÙ%Ã+uéE{{çEÁÍ­ùhøÜNnûæ²ÞÍ[¼›¿È.ÜåÏD·¦h‘-M;ZY„çL?ö’Ø»+°ç;²KUœÞœÂÍ ÀýÑj*G·&ëI–€õ¨êˆíUYf•Ù^­ Vè<¨y.•J]’‘‘]ö½¬,‘‡¥£\L2A* ® G[9°²b[‰„ù-¨+ó[ä¤XyA.±¢åþMäNY¹0ÍgŠæƒ Ü ,ï–kíI}œžc|ïl^UßU~‚Ý–ðV¬Á)’"œ5ìÌ>,42ÖÙ˜‡¡>Úfûq»å´½K伇háq‡ˆØ†¡>Ú⺠/Eç…›<‰¢ï;]õRµµÆÔR³‡Ã“äTÛÍ$®¢¿”ÄjŸ*ÓjÙÕ|ÉÑÕ2Ùõ²r¶¤Uæ5,ÆÈU†dØMŠîÍH)…—!Ýë!IgÌ­SŽ de´lÃÏÕ7þ­’—ºÈKµqä댋 0t-DÅ`ÇݳX™rølOø‚šž$'ôG‡øpSž‡ý2ZÒ‘dñxUGý$ £ÈQpaG–w s3–—•ñv;K.ñŽXò;}”ñàªÍ%<ˆÀ‘êU9¯S­$áõ6Yomæ“pWØ‘koÛ(j0æ ‡R d¡´“v|ù·‚Ï+®šŸgeEzø§Px¥N2ùÚŠ³Å¸ÌDˆÆäÀ}+L_Zz”Ä ¶7£'¨7Ù,8Ê°lÙ| ó=ÓåK‹U ‚ÑŠ#)ìÌc&¸”ÔzLð|-:ã"½ Á{âãp,(3Iˆ.›ñò aší1¯ùC*²5;ªoà{Õ«$ u\n”éÛ¶¯Oßsg¦Z‚6aÁ¦+X´W‰¯­7Qsg¡ßÒÓþ»9~¨¯•‡„_ ùãu}0~qˆ/ÔIº£,vÝ‚j¸è±6ׂȦÈÆ•0ªGT®‡/vÄØSr\±§/ç$–èâ#®:ä4{yÀÄÞqÜ}öW«¸wY¤‰b[ìA¹¸KÞfŠ‹¥ìŒm©M`1íí÷äб{d“éëmÿ96Óƒc ½#„ä% ¿oW× Eö>pwìQKçn5ïÆàœ†¬ã¶¦+ ¼© å@h!öºOF¡íC­ßÌ·øM<`ƒš$Þ7¬ulgfÖÿa‰ZS׈¥YEmŠº–ï#äœnøi1h‘^µE+ª ¡’Vý‚Dq3•@CÑ’s¶l?Õí°é 8ž#Þæ4å˜ mqñ8™BË6uãMãNâu¬¿NrÕÐÉĆN&(_š„‡6µ·wHJ` dЧøâŒ3H£{Ã㲪0ÌcC…Lv÷êkD©]äd‹Žd–¢8dâ;Çœa<ã Ë&‰%5ØÞ‡ÔÄÍ­ÓÙ犬¬å‘XæéU_ÛÀ§ór¤šülÒ(¹Ö€tumwóÜ=Í{ûôªgÓ•õ‹g žl$Êâyφφ²:d`ÚäˆÈÛ3 ;oÀ¶_sÅ|Š¨*4ÓYÆéå»*⨠¬¹‚z¾ÂnÖ¡ë_£oÆ”V–<ѨRßÆÉÇ ïRÐû=VòzlK$….»{|Ùåd/³”¨z0'Áröms¹Æh›%Ë(²”àmÖ«Þ>‘ˆÜjì®x+YGòÄ!] în‰®Þ°˜oRêÂ:>EzL6¼½®ýÁM„^[Cí9[(:mÍÃ'_€NF"=†~Ͷ‡²åÿc¿ÿJzØ®æú™äX: výÌÝNçñ]ÒÈ“µæª—á­°f!1Éeùn%!R:c84_wTš¨’ØPõ2z ”©ZBëÒQà•·ˆÎ+ÊÌäüz4M"½ÆñD€Sç\ òåb©ÕÞÛg¡_›™©ôÖ¬…@E®‚9=?¬™úv<kì q ]ŽµéŒžú2äçFp9©Šªr²1‰†LÒ†r’Š¾3\08Ë‹å—FY\eeI,Sœ—àŠ8+UBQa6Ž•ñÑž¾ríJÃ!éɇ—}úäW§—]H°è2ä«þSU °ªk¤~BŠ]2üÈ£({«|ÔyqzÖZÜï©Y\ÌËGi„ë.`³kº¦ƒ/¨ŠJ(ׂVÍBœÜu·Lv ìæb ÇÂj™˜\³3níbµ6«1°W|1è°!*z YØ3xò ­ð´Ò?¾¸ˆ6}~¶‚¶vÏøCc´…¥¦TÙ,l^g¡Õƒ[“ ˜WE|dÙ¼ìƒæb©e³‘ "ζœNtt•2 3™ÝS¹ç^Š¿‡X”ØÏyß~Î[b\rr’‚bovî 5òåÕœÕØDkäGñ›…¾ „;hV½,ß¡ßL,í¸”wû°á’3’PC×bÀjÞò­f¡ö¾Šî³‡¹:Ògt°ï“_*™T-^K$nœ±[䣬‰g²ÖŸdäŠ,“š)©pи¦i¬[ÀŠâ @ÏØ™™•¬ÄNU–.´‘5MY µ?B”|¨ˆú„”úÉ9™HП4ÿš:Ÿ—SðüÅO@ UîÞsFŸ„±±<ÃFsWUñÉÇérÜ[îGqçe¡ó©3*E¤›¬ˆsµ³‹ïˆ[:ÔstO{$öu[>À±½}‡ƒÌ`*ú´^ï»y®ã­r_Ï(Ïô˃!EÇ—ØKì¨üÑ×¥ÆÀûˆèþªå}P,ñs9Ï?ˆïqþ<³Øý å¾„¦’V÷…­ì^œ-´WT-Ö÷¤y?@ŒªWÉ O¦3 ˆÿGl)±yéâÞÉ)íŽ3{tÜwØØ\ÓÍ¿JogéñPuÃçí•ümg¶sìšÑ uøp¨Û}x?M‡Á8… TðË ýÁë~ãÇ=ãÏT¾¤ÍqTÙo¶Úo¹‚¯®ö„£?(sJŠù¥ ë@ò¸«&wP¢ÓGÍ{´c‡wNÏ­ŠoJzjœll%È€‹Õ×SCdJÙY³¤å—|VT%‹Ì¦l2æHw›8RGàgÞ™GÞZrN…]e„UX€ä8ñ´ Ù?ißé°ñ–ª0lJ„…Ïm‡oc“ãAˆ`·õ)îáwøGØmÀlVÒèÐ =‰D7[mÉ-å­\Öó“•Õ˜ª ¬5¥šÒ°Ç…âê¼\3ïöÏõi¾°¤nIaNû@mRþMõG :ýåµ/€ò"ÐÛ³JÔ…÷«£ïéÎ]ˆEÜÐ]G\Ë/eªÚÓ|?ò6‚·äŸ"t®Õ/œ…" ºJâlþ÷¢ZýèçVëÏzvfÏmFgî?w„E{Y ÆžÕsKìÙ6ßBà™T3QéÛ~nóýÀsz <¹î1<¶ýn°ðæ&Ù#ßô¡ôYDûhÈ ôYÜ#rã?ûçÿÙp ÞD[´Fô€½HkŒ(/Þ¤M‡VR¸ °‚ñ¶¦Š_M®†µ°šDéaZúhÚ¾ò’¶(ö×P¢£ :/¹ò ™KU£m|A,ZtÕX襦©7;E¸€›Ñ1Ø ›¥&nNJRb[²Ðe41 þ¤ŽÍoõ]ë‘Wã`óÈâƒØ#6!*¾`è¢Ì²f¡‹/)–°7³¦…¸«ùQl-%ž&§³}óמ5êéô¿-Åà!rÓ˯>àªãhûñ×Q­÷ªx±eá¼>©ˆ/½v%~òËêdV)†@rß³9b 3 ÉÕ:Îɪ€gu<)JP%gc´dƒ“³A†E\Œ¿à⸛n&?J¨IµHo¦S0üëóÙW;PªRº§ 9jÇõÁ¿ö€ÄJ>{ƒIh“zMëBâyÝøE)±±Liy›” ë´*¬¾ÌMè“Õ$ß E“ØqÚ{ý8D©ýTöõæ*=©‹ùr5NØÁÄçl¥ŸcFxe;I›TO}.Y7K[µ•ý >~¹L(óhúíѬ N§$©òGuã¿ ’â–nTAɳ$‰dð'ñj>I|Œ É ¯û ÌGaz,á¶UØW« ›ÄL4x{ÑlL©Ä€W/«/Næ‹-ÒÖΫxñáÐXmEt/„…\­kö.”%iþ×Bû¶iüåÑå4úY¤¢]VÜ+ò‰7©¥q[|²ºÆ—ºš¢Å+Έ‹Î ëÜÂâÄ QEq¶(™/¼Ìœ%¬¬¥,›;;ǼõV±eÍ0gÙ ŸñµÀ—ÂÝáãŠÏÜ‹èçˆ×8­Zú†÷é­ Ãðí%²¨+ÆnŒŠ*wh§V´ qz5™àôRQÉ´©`Öûn™-[w/kßUÅ:Uf•»•8¿H½£vÀkcq%Ö’„/œµ,ç$Îô'¢‚ÿÉ#?ñä æÑ㯙‡‘O¡ þbøàâ2C\ý3Çýί¨½¹mü–ÔÞ‚S¢¤õc”3%•Ø‰Â›¬lÖrÄDÀ>¬bf¼¾ƒÄ¡ÝÆ¥Û`óÂÉ”K<òÒ5GŠ®;ŽXklŽÖ6twª¯Q4Ù”Ðj‹6p±M•D%¡ç ëUfü&R«hDã\¯Š,úqåÉk«‡æQ´%¥Õ‘ß~€Î¦Çå ][}_'Ûõ6Àf„òhão)maâx)Û™éëɪÐÐÁJ‹•ëãÚY¢Éê cRY:i­E*Ùf @!U<½ü™'¯N•¦Ã&òâån8š42Æâõ«*®+rýgŽGýžº5>.¡ÉVùáW“xxßØYÔVKÄqc-òÛ‘7íwHÚ.ˆ¾±×j™ã<Æ°¿¢d.­e.©dŽ[nè¡VWÒ­U Åöáñ5åmönÙUª¢Æ¼;ˆ“‹"=òΪ=PáâUv„v,8Ì“Lo€ÖÜÅF¢±+¢±ËÔÝÝuwƒ¢±ky]T¨·¤/ÈÍ;ãJ½KJ&ÄGŸŸ®%;ª$vëPµg£Æ¾_ÃM¢7ÜìÔ¥3|•Á 2tôsÛ˜/[¾áß^*†¾a‰ãŒ¹ùyU,AâË4ËŸ I\øÞ€Š |Ž|ƒxÿ’1ZSqaXÒä2’àù°BY4j œ;JsýÚAã8-:ÞNNmUÜ!´‘ߊ¼AÛùÉ+SúéœÿF›½K:®bü%ù¹Â@kf>¸øæVÉqtWv}%ÈŒŠåý,*GU¹ÄÒݬ¦ DËQ"¹Â}µ–êÎCÃùh5‘’¸£›ÆãÏf4PL?–KÚË—ðÎå¨TíŸÈÛO^Å_#dS}AÉ©-ú™œàš ±ëÐJPá Õkê× ®V!hˆz–\ÞGÊ[R8­MÊ*LÊ•Uî–4p&¯½n†j]B VKÖf7™>@ó­šËcuJì þ/w¤u£®ñ×–uOÏÛ$d^hccqËô’>éöíû¤d|9[U•ß*ùò´ieŽAR¦Zå ”¹©ò²æ/^\ .ßU4¨¿dŒb`vBhÿ$„`s £[ï#ñûdÍQ1œü+:#“¹j"œElOœ¬¢Ç‘sbRçÑ$ Ø› âµ—.q½áaTgÏݺ¸O'§•0“‘\m›úì.£/öñÏ]þ X-ˆõƒègµU}ùió[æ/ùý—ﲌÛdu~Öð…IŸLŸ›/ÉE ¤Ô‡á¨…3‹Œ¨Ñ:˜.‡l¢à8ó'-ìÌ|D[WÙu±®¼¼%CÉV]Ó>ÏÔ†—tlÁš¸ÿ„÷ñÏ]Ȫ÷W/`G¨EÍömÉø«S¸Þ²9Ú²yCYÑzË–yË’òxËJز…`à¾^AoÈ@ù›p£-õBt^¾k~žAf?úðül«Þg³çl_Rñ«¨n£'j˜›™ wsºuÇ5Ø”¸ðÏW·Ëó'%kÅþN¿š†u{RI ¿¼ª6aä™:)Þ%2v=I¤3›M쨘-ꦞŸdseì*%†‹.©“„ÜlÝ:ÇåuÑÏqv?úMZÿ㯳ûmäü§¯ý¼nž™†ì>:¯ à+T¢f9û˜’“Ë“ •# _1¸GQG²5"EÞ¯òÊ'uP[jjóºd©àƒ|ÌÎ52Cˆק·û]¾ËF´6µ6Ù³ÝPÈ1siO[“ö4nz†û“A¾¤y®APƒ8¹ºaM0r¿’©~š¾y:BÝ»b—N çÅøŠ8ëVqßø—3¤âCéE`dÉ]–¶©J @,µÝÜAn³üMú1F î# Ðç úŒ_>ª¥…\õ†seà‘ŠO£«€Ï–ÍnÈ tÑÀ!Ã}±2+¢bA\Ͻ ÜÅt†+Ý¢ýåln«£ÚÅû‡R6hÚî–ïDv|õh+i?¥­,è{ôÁ)7Þ³òšb—BºX³¥§Z¹éd¶ü3ÕÛ‚ä.c|ç2^Ž~“i:0îÏ2>l|Ìø¤ñCÆ_¢ò“æO$L£z³ƒr˜}t†<÷qlƒ—ö÷`Vü0ÝÝ"“p‡ËCH3Ž*xm ÐØ£Ò ¯ã£'&Œ¨ ß{åGé΀ïü{ 1ë½ú†ôÇQáƒ?ˆ/Dò?™±ñ…‹ÇègÜýËt—L~öàœóï÷ÝG£í¨6Q°±ô£¶wè+Œ8G Oˆú‡w蛟X“=©Ä¢} Î– ÷ÑÚù‹ØÛmD?ÎOúR{+Ñ›ÉgúÞé™Ëâå«Îøe¼í~d0ùa¾åýž\PFÙOü§!c ¢È7`þþÈO X•Ü!-ã¯ÌcŸê¿%a²ÄÊMþÒg*òQþ[üoϽ֟1ˆÍ?ýæï¾ùÓÂtu{“ ùŸß¡_Sÿå›oš¿8ÿq¹ü7úw~úÍK‹îÑ?æ?ô/qÛ˜ÕZÑo1Lýš ®C·û—TìäXï4äãéÔæmó>UU{hȨÊN4}t3À–ì0Ã`ô¶9tÝFкX#C|‹[3·h_z{ÇÂXDyµ£ˆ7B—Ƀ#ìĶdÈ>•¹‘ßÍ‹uq¸¯j% (qÇ™,¾.Šã—Ϥ9çlV;Í鶒´¬ëz­©.Íà¿‚1¯ÿC½P•ƒ7¶dÕùÕbdÕØSh¼‘†Ä¹Ï(†¿E9a JL`‘Da•¼ï$e&ø—ñ>ž‹‰_»äU”%¾Ã™Q¤ÀÞ\˜ÍxæŠ[V%·¶î?E¹ŸÅ`T\8ˆÖ´ˆ•~ØC\ç㉦ á°çBU`±K'-0)tV (ÚÎ ÇkÙ#TØ_N¤,{÷/Vò/­Å’ëîvïÐÁ#{’/l6·ƒð}†·†0Ðá×®r]ŠwŠî¤^(ðptgv%šÌ‰|gº3W÷*Ìj·ƒ±Z›Ï;‰)‘¶¥ÓJJ:¸=ä‹:>ÿª®ŒŸ!¼ûÙÄ/ª×SÆbyUEñ"óúHªnPÒ(ü¸~Ò"æûÄðØë …)ú³ª×`Ú·À›£ÍX£0ºCúÚL’žszV'ÕjžA†Ýää˜_Ÿ(ûãÎSHÑ'Õã~PÈ@_º¦úK#ígáH;úvìs·—muPcɇ訋ÂKØÆãÕln…×pmÜ?…¶²<ú.PÛâú)l÷’’©Ö÷‹ó¿>ô{Ä Å^£ „.Õ²h“âøa`ÐÌ›(g;J,?®ɪð " èõñS_’å4¤e'kqÖ‹ûD¹«8É·§:³1F³N³½fgU”^AérÑÇ@Š=ÚæaìõoOMõx}(0l£ xl/²ûÿs »Æÿ¬bíU >×4«vÄNm;®ÍØ~6á¹(©´[Ö ÝJÊ&ªÅÏ £{Å!SÜ¢ã7¯°“úìÉhøgĆ»Œá¯Á•jθÝéJOhŠ{Bݲð³!F¬•WÙ^/—Qeþ^w'Xb=ªÒÕií÷|¥ËwSjöbq•œ‰Sò•Þ0âƉž‡¢ç„Ä^a R̆"¾«~Ä«cOc.¾?ðg1â+d«}&öƒÄƒŠÑ1ÎŒçÍ–Ç:íÁ"÷ˆëE"àÈHmÁ †cð¤Pû»ÑañÆ~¾n%ÞÇèUÂdŽsË݇–ÆpÖg#nÜÒuôLŽÐn^—¶Æ"g…&[¢²ï2Fa˜tîÀøŒOßõA‰}…Ãf5Yd÷ä‹îõéÐØ÷UUQ®öý‹ó¶Ó@†m}¶¹½cT§ÍÖ‹Ÿ=|Øîü¸©-Ã<üH¶<¿Ûþ mñ.oñ?$èÍaäÇhÓ¿©Ë*ß>ùï‡æß^þ˯Dþïô—ðo,òÿõ›ì0Óíߥ #¿1¼üÞ*Ìj_·—t=å”k±Byûì-5×&eäà·*X¶£VÕ,†¨®½Ô}ãÄ*îò°vUµ‡§ îÉ[µV3 i")8#æ¬J”Á[>3Y&\þ*CŒÅ6d»!ÊÏ£ ØïˆIŠ^zwfÓø²¡yœXˈše9†—U *;ãÀ3œ›Æ2G+ûSÆ´âá?&ëP—žñ.]U×vÜ s†¾À ÿ»ÐŠ‹J¯c‚5}ã2B §ˆ¯Xû~Ÿ _•Œ•û\(Ö\p‘Å©Ì×¢€ÐH‚T׳pŽ«Q)ó4ª_Q·ÙàÐ⺔ç7”5áCþïÑ«®ãCû76ÉŽÅ%ÇÓ²Gy˜·çn‡|d©|v÷lIŸì*àçÙÔ¡™‰«BYÊé°µÙ…$©qC¡•ã¡Bì×·pˆ±Rô©ôtŽf§ÆŸ£>CeÃ3䞌0 'Ç>ò{ÇœÂ%FO 2)ÇøÆ®Ôþo;“•b_%'‰<_wÍâ- ¯óú¢„$±ã° :ês©¿OÛ? 4î¾TWö8]ËÐ!Š·}Š÷ó_Å·:¸ÝµuÕÃSi-m"~z»´ˆæœžÂVFrf1ñ×€¹AúïýÿÀµ#Bÿ™Ün;£ U‡Ûißë]‘a ÌÉ°$|ªJ—:ÜÛÔÔQ³Îµ nÎBˆuOdW¹ú'ôêé̔ܮÙù__Y-–¶8IåΓÞLxO”ðö5jy °h>¾Ž´ª°çL&ª-gèr!«º$¬ßÈñ.ÓW[ìßNîÿm0 zÜ KUMp1Ôc„^F,äŠ3êÌZºÉi=Hpæ[b×™$ q„N’$º)›/IµNrY¾ÌE¥%y“«RÄbŠJí êÕ€ËÊ•Ý=ÇÙl[Û–Èr9A¶%° `ò­èFÈ¢4BFIžÝ Ž„4Î9Dtë›x Cº;2QP¨°ÏUE€êô[“u E ÷Åïó`$Iê¼*&¡[«]ÉT(Äà¡Â6]y…ìÅmòŸ3?8ÐÑÑu“XL*!åûÑ÷Æ'û‡ †C™´N]h Œ!yžNáµ{&¹¾´5yN¾z@Ò|ÎõsTõvü¢¹ˆÀðãèn‹ NÕÐŒb#¨íríסgœÍ òǽgywpŒËá¾!<U¸¥¡R%S#_Ù 'Å4Dì%ñç|c®|€> ,áQ9:gT ÷P× 76Û0 ž;å‚bK&ËyY›'”2h™¥Õk|oV=¤øU™+ëˆ2ÓV;»œæÄÃpjÞ'^ j¿9}òÁ¦5ßšôŽðb>xÚ¦ÎrÆ\ðÖ¼ÿä#S™Õ4ÏÏWnÂÏFò'~íž•„Ÿsü<ø>òsB<l•=ô÷5“Ÿ³Þñ=m·7åéî }¼wžž§ôçi<¾C.ç)º4éO~mO1;öø&<=†Wë ø´ÙuƧ½ãïÙI뎱?ÇYzí>çsöyùw%uCÎ"Yô8OeþÞþ~ÀP Û»ûÐqÏÄNK‹Ë©6^éíí»,„œ2Ç• òñù;KøxþµyW‚u…ëYx14icúXH˸84Iÿšäf<<7^6?qžƒ‡‚ïM&ÚøÞî9f'œvœIë 9ùAŸ“/Ëwz8ùÊ"N*Öí9ÞK¾Àu;æd×™<'Ñ–ã>gñ™GèÉ}Éo`b€©ÇŽûüÍ™úaFò ¦Ï>ðý‡x÷¢0Ù¨‡0[_þÀÒíynKým¶§Þ¢íÝ0ùá~Ó>$ æþð)Û•7,}Ìß³±¿ ǸgîÞ„ãšã1Ì„ž´z OÕ¾ÏaG¾òH ÈVaö”2îôViÏGàåöçY¿ÞÄô2©Õ²$‹¼Ú€ìpôL‡ò¶|7ò8üçø{®ù{@›õPÚNò¶{oŽ¯Nïٷ댈¬.ãâCåsš‡ÍÅü›>d¶™¿ôpjÎëÛSãÜ|ù¦ú–Ù¶kñïâžcœÎq^»w}îËWß!î}àVšö9}Œ:þ1ÚWñþÑa_@©=Þ¸g70ŒÜâêñù¼VÁ§0¹FUC¤£kâÁ0ò¹'R>EÏf`›kjþuSFÒ—xd½ÌÀö'_™п8¹»ÛgWe{7ÁÐ:Ì,ÉvrŸh¸]iålë ÚaŸ·yò‡¶8Dñw÷)cÀŸÂ çÓ`­x‡ˆTï‡Ç xí}wxƒ±Ø-ºílÉ‚Ëwï›ÃËß7§è9^0Ž€ÞÙïS{t\ÅØB´-ˆº ÍñV{ P&¦r“r‘¡pž±ª-ž¬J157~un ̯Ðth±!5ªa°~„…ê˜ÜD刻y‚î÷êp«×Ï—Cø›3_ë šÿ“WĽF›*‘ÕNU@g,¦ÓcªšUÀ%m܈Nß j‚Ë$µ@¨5m,¢S s[<½=G§*jH×ÓIû/ è$.Ë<”£2O§Ð„¢SKa“5XwŽ;VB0ZŸN­z€Z»·‘*ÙÄu„ÆlÎÓkŸYWT²»ÎM‡ æÓƒ2zùÜËìÐÿ/œ NÔóØ#õ^ÿeºqo~ÌTÉÏxœ-X°(®³tˆA(¢ã'A¤¨T€J†\l éuêzŒ³¤®w'"e»ãƒÎŽø¼uàU£!nqѯÉP~<Ô ÷”Ò]ä¢÷46¼ÿ%%»‡s¥{="åî¹»m»;7‚ʈ7üB>¯µn€”Q…³é¸z:õ‡äL$ ïß2j9°3"ŸRI?9oJÛƒˆ£ŽwÛè±í>mrº­½ä¶oL[ ò»H¢Â™»%mÛôÅÛ7 mðX^D[³'ôBâêÃ:LÛcã½%´ÝƒÞ:`¨³Ûvƽm´užJáþS¤WõtA}ïJ c Oæh|ˆ9ÚîåíÂ?îÞ–Î7’Ý]°P~}a)••±¦ó³gÒy èÜæ²€ñi{@çà¹í:O¡ö²2ÿq«L¶ðÄQ­3á&™ÞAŒˆ.÷oSí?8÷¶"ûñ¹·¿ÃÁ¾[‹ù€C7cüò^È‹ûÃwîÏBñKÙáklÄ߃<éûÆW—p¥«œÓvŒ{?¯çÂÁ 46)j´…sîr)á{W ÿý‘sm-.$«˜‹ *&$z«‡±QôsFÇøoP“HkPmÆnEšŒ«e z•›´&+³þÎ.÷!%ü™Ìi)±Zã¦1X–ÆSsëV`Üuv Íõ&>ðêį̀ì&7†µÎ½ÄŠoúmû5h~›˜_k®A,Ä®{8œ2x_p‘„_@+Å­³s‰{ÊŒ™ÏA F (aãùÍjršŒOF;ö‡¸tÈfX¾È14àSKÎqÑUæ6 bzÜn)÷Ýß©xXðgLa6zqà”-ÎÀÔ/qÝqL¸¡€;WœMïžìºß¥WËDÖ€ÛÞk(ÏâܬZ߾ܑI5iGàœZ@¥˜DI½—‘C ªÚ½štõâéêîstµ· °‡S ö qf¿¥‹Yâ‹jIîϪ‹ y`ò›9H'¶Í^¹_Œ95¬Q½ ÍΪ]PŸÉâÌlÙïucÇø“%Ó08¨×$Kc§‰ ^C ™fc 3ÑÝ›ÈØP(¶¤ÛŠzúØ „§ôØŒf—£Än}ËO¢á5·8Vsý0`\ôÊ\ ó-1Þ¢Ÿ“èqä75e¥jYŒ·›ÑsGu»; XÅ Y£õ]ÓsÓìI[jKÍNkß–ž›\­ƒ©JÛ7¡gc‡ûƯ§çv ~º€žb¯-¢ç4[™Ñsݽ éÉçÕÞ@M { ”M¡jó*Un.¥êÄÚžcO§koFWÔæïc2{t^g›‰gú²ªËX@ÚC]‹±Œ¸(ÂätëFË؆5°ºªnÐZën9KvþÎÓi:Þˆ×Ⱥ+ËÜ£…“rÆ] ±,·û,ÉEgž¼»š¼DÈn‚½‡ïŽŒ÷fÙ+$œÒAÿþCs!ýt ißïwÍVxRÅ]>·h‹Žî&¸3UÚédÛaÇbýh•‘ä¹Ç•ˆÄh0­Àœ‹Ùˆ Mk7™Zj$HÎÂÙ[–Ô0 ¾¡æÜ~”Åsf`”"ªwI-?΂ã,¼£»œ+¿ÝX‹yͱhÂEP1šÎ[CýE*ÃMŒež%PÁ4]bŒ£¨FÍdo´*®ø“íÞŸÑVÛÝ‹ª$g Š/Q€L:Õr`÷Á4µÉ¬Wi“ð¬,ÃPºÛ];g|–`߶ ówÐ8ñlÍ¡¹]¦cîTM’cXî1a»Ë% ø¯d"ÿ[ÑÛɪƾÕg!ÜëK/™ØçÊç©q±„nr]qƹ<íÉ™é­o º'vÍmr›ÒfY63ÏŠìÔÂG± iXßíëÁ\î&¡ºwÓhü%ó,ÕsÎÀeô E¶)*®ÑìFó#}ÁB!U7=Cþ öQø°$6)8$z•yó«ûÅ¢T—_½¯˜¯ð}<®j]G4Äl‡¾¹2Ýa› xI ú*deäûMÆ>èdý‚™'Kf>X–Œ¸dQ ç\¾òSÇÛÙÿu×â1žG}¸¯1hZ­åu[ñö‘Ê¥ïÂCJóìÎUÛÑ´U·ƒK¸»7gqªxñ‰/L.‚X0ObÊÅ©‰·çxp ë9ìóÜS’k¬óèï ú·àAWÅf:xã þžÆcÙ ÿ$Dü§ý˜³Ð7!z ε|t‡ v Íð:ñ”߬–]Ñ|`®.”{x2ƒ×-,ö¼:Ž{ ì>;ñïÜ‚ø;fo²Ïô;û0ÕpI‡6EŸoIJd?ij7Ž0¾¶¾Á%&« \áÇ …_uø†Ö² ÀƒÏ`n-á†è)3Ð[@>4øÁsÒ—ñ#Šâàqg±Ýwå:ŸgdÆÝ2c¼ÕBíŽÈ~`[ìrf„s*iΓØp/Èèû³so÷ŽTš÷ö˜)ýåLñ:gªºü†Ì¹’âXÌžûÁ ÇuÒ‘²XˆG;dÝý›+\ê(¶Üî3såðögXˆƒ#Žæ±sî쪃øÙö„_ð„Ø>[¦–ØrŽ…tÒ)í‚ÎbúîTÙèè çÁ6YÓNç4ÁÝzQ$ïsããäP wÆÎa?áãNlõU¤y<àÛ¢¿æ_¶5:RIV„ÔbÏ8Rê88Rj]Q:'Ù’ŒŸ-ïu0ÇU ¡ç¹‡µ$0tŠ”’—YŸ êôØ®Êð)>æò­‹‡P™aãÉH*eeý/Nq_`û7CÌÎõi½ #{͇þóg£õÑõ´ÖÇh[å»'=ŸÜ"ÏùiÄ=¼R(°”¸#mIù‹H{ä›øs´=5¾5'Ç|ŽÆ¸ÕìÔâF©¶$0€yølDv®'2Ê‹Ÿì"&˵” 9>â=1)$Ì‘¼·Ëm§Ï–{^u>ÂèÌÞ;C9p¢ ¸W辬ž6ì‡]ã‡<•î×x7$øwMâ£Ö*Ïö I,È}sá´?í‚û¶ãñkÄĹ?ÂÄ\Cì{KHgŽôÚãø¾ T¼br,£¿vDPp»Ú ñ@cmgžÂ‰­ŽÛ©¢ÚsÀKp¤¶N[:œ¶Tê-ý®ªn¿›zÛ…ûá™ oråA¨ðv9[|Å ñ>â¿X™§ù‹Ì‰ïW½í÷OÞ¯¸ŠsU%·‹uŒ8ŠQÆþ-G?Ǹô)ãØ`Ôb…œãqÃɘ zÆP[Ëå1d$øHšl"Ã<Œ~óɯ¾óÎ; Âö® Îê[¿ÆskwÐÖU­ÅžÆ?ê@O)pû®ÀXf¸W@špdçœÉis=I¶ï)ÇX'í>¿js#ë¤sį:³©@qnÌæt¬(î¢jg='0LÕŸ.–šß¥?IËW¥û¼•6Ж\çÚsl!¯q„"Ô^ el¾¥ê9†¿xåö\ÇÎW©4—N]W¥ZXRŸÊ>~ô¸Å~øø3÷‡¦§ª—5l×p6†&6R‡A_²dtK™›YåÊɘ²0lµb¡ø)£$»KFI‡"su¼Y¨"|ÝRh°[ ›ÄÎRÃ&%€Ý8÷V@ïæN ÐGN#ºõóe(猜¹q”æ¡_W1?˜’‡‰q¤×f7ÍÑ«2rº‚ Z×nB¯Îzil»I²ÚöI¶€PÝ¡h‹«$—h;%§Ï[ºbž<ÓYh4DŸ]ãwÊ<Û]®m„‘Ðä@œ»ÖŸJ¨½%„ª‘M"ÃxÆ;™ *¾D›yÜámÙ¹…”ÛP®tm<¶Å8¼+öS¦šn_ g\¬Y½ÂÒƒ³ØFɨÑÉõß]¡„ÊÝp™ýiã\[ H5.G‹³ ˆVn Y6’¥­Èâå¡®6ë•÷éd Öz†É1Uë«RèÆÜHŽ¯ïÑtáäHv6£‚/Ëu›’˜»v¤äîµ#%u|»$h»)®yƒi“¨ÒxÚ´IFáÖ®:NU,AéoÄ+³(u˜ph¨™?åè7x–À…á®õ½40åÓ>¶}®/õ˜9]©Ç ¤P}™vÀ‹g çxé5ó½hÎ4g ó]5ÛªÒr:Å´â'_œÆ\ÁY 3î}…¬âø›tòüö.ƒ¹( Ýä)¿×󶻔·ãšEq.qˆþ\çt®n+®Ž‰«›ÈWßvˆhÀ[ÀKµqRÙa°ùå›à€õTcÒ:\ˆÝv⣠äkŽÅ$ºú‰«œ¨ËŽ%ÚS¸ŽîŠÅ•cÇŽŽ’j±.¼µnŒ±ØÈ(β[Ô´ 0A3û Õ×v˜Í²L¶©» ^õ¤,Zˆu#Sá¶ôú:#%yön€ø;(Ëɸº óÒ˜Ù\æZ±~~>ÀhûsÔBòmð4‡$Í_ ¸?[ⲶÈ÷·¿|š›pM$½ƒ~ {)Jî%™ Ol+œ$ø\ ž²ìYy€ñC9^Íë2LÒ$õ˜D§UC$åœ(ZZER/N½T2Ú“ XUÜ1î´BU|ÊD€žA€ºè7YU ø–] eýêrÏ•“U[÷V‰°‡’6¶¯Ç­²7¥ò6¿v!^Uìuh ˆµÙ»x¼.Gü[DEàZþÿX¯ßc¬×©:ÿ7Œ.]êȲ¨Ü¢*×ÏD¥…6@Ë™T›õ5™ˆèÎ$¾Å¯”(v!ŠÛ,Š -Šõ«Q™?é­¤È͇˜æœQ±Å‰Ã|8j£;ý-vú["1ÜÕ†/{-2;GÕÚ¦T°xÀ†1¼nSËÞÖœì¡zZ}¸"„8¼Ú—Ÿ6IüèÏ4$ƒL.Ò°÷/¦O>¢E0ŒÿÞ0þË0’9›LÕØm§lÞï= WŽS¡¿õ-½dß®\bêW`Ü%q©|GW½0ÛÆx®æÙÛv®ï t»ìÎu»Ô‘lm1Pͳu1Y–v1uw¼ÌaAý~X&ºzÆÄn½›à4cUújo'#{·˜ ¨y!³fÒô™°ü@ñÙÙ…Ú¡ótnâ\çõfø¤¼ Ž%_‘¬`DÁô ß ÷»õ=ß·y ö¬­W'Om½Ò`'X:×Øv:ß°Ùâ2S@®õ¾'ímaú.Ñ™—ôlÎH=§ÃþÑ_¬ Ø~WÕÙͧ.,œÞñ΂9ÓЬ+_ýú_´ 8ר´ï…Ĭ^Ó|JZ®È¸kZ7.ˆ*ÈeµØ{þ4täÉš}ÖlízS%oÊÅZܾDÃÿjœgH%áëîÜTN0,ªépßI•=‰ªÊÖpù=$¨:/A f¾Ê±ÓÀqèuê §g™©5¾ƒy'v—ˆxÊh!žvšxä¥kä/or$Bà:‘±‰8£µ ¿Òr“gú©=3¾{tàcƒ¢´h<à§Âð#)JlòñÀ5F ¿MÄ;=C¶\Wbv~œ/¬Wy'm.(FÔ9sî¹Tåˆ~Ûå¼5U ˆðûo?@»Ùãò—{1€¹†ZEµƒ”/Ž2v-y´Ùºgn-ÙCw"râŽïõîG ×{è¹ë÷n ”Ѳ“¾¼ú®wÒùÜNâþμn²‹¼Þ@•÷o¹ŸB>Çu*àu,ÛRÁ@xO¯séžò}ùUxϸ“îÞb'ʳöƒûêêæ¹7·y¸µÍ9wlT×IÏø÷`…ýÀë6QÐã^¼Þð$¸Ž09eá>:Ò8ªßí¾9~ÊÙÎkÝr›ôç¶É÷øx™ NY´ dXgç‰8Ÿa¹ï!B´PîŸE¾Ý^À ;x1ל‘>šéØ> ¯e··PÎ[±ŸAŽ•wzôš=øð‹Åö-P“çê²×Ü4FC„Èù•- "ñ-Ý{ÉΪ­èÝB†æªº™ÀÝÃ>JDÇǨbÙ!®oœB†É™p7}û©¨ªu¦Í=š@¬;LL†XÅÉ{àŒN¹æíô0ÙS]²Ä).M9££)´àÕV-iãÌ ¸g !8ÜÅ3éŸÉeéœÝâvÎNWr\ÇRƒQÐÍ­;gª­ÓhuæE¼²\ÆÜÝ"Ãu^ØõÔÝp+ÔÔ]F¦–º0,Ä–ùãý%2Ïšå@†<³½tzKñÊ ƒ:ígnìípÝ=¶ádÄzßÃ]¡ë·†V¹Ä6BQ׃ vš¯ð{*’S‚Û˜¢wÍt…õ¤¬âºL³Ä …U úƒZ¸ÊžqµžDzñ*@Èâi qŽ­ø{#‹Ú- \È;£ŠÅŠb’O”Æì$8f!ìØ3pÎè(À…)Љ|æ·¦ÓË7ƒé:-v‘é<b’$‘‘#—IycÊqU?Çú_+ •E’Š5E&¨'ÎáÕ‰UeŠX3-¢H(²–£¯ª1EjX\-Aª…óÒ5Kæ«¢9“·Y±LoFEÄölŒ3?*&Â4@:¬N-›Ÿ§ß—ŸödùÍ‹ûS(|-á¹¹Mã ái²M577áºq#Ó”Ñ!9î&ŸžÛê»éG˜bÀ­,–‘3ö³tõxàqž'Í’©É]¦<Û¹vî•0q¶Šæ:D„J G‡1#B3hCA¡™º\ Ù¾X3ÈNY‚Ÿ&ª#%Õi›\ÂBÂköÝÔ#ÕuŒì9qÔÊεc‚(6ˆ’VQQŵûÜ„`›Õ`Rx ›5‡á¥7|l†ÜŠ†BöíQhÚhRÍ'HP.lãGÃras‘AìÊ”ëüMæ cxÇ•áÁàÓü ·š Ã<È#Ëø¡ø}Ö^Ÿ}|7çÁÛ8ÁnSý>nÛt~ætÝøå0ÖõLðzn¤¥¨wÑ<Í6x×äD`r"0ˆ—–®ª=¶°S&þ2.gÉ¥å,IF_ÏËZ"­tExPs(^¤ú\öן>—‹T8ƒ5ãï.ÀŠÄH”ZD ˜tô ä^7HVÖ›mâõ$‡ ¢PÙLɦx^B¦‰_Eß 9àV†zÖf(‘5²ÏÂõJUão)ýŸhÆú µUò†ûÌâR® ¶„éÖúîú#/B‡¦BxeØ+ΤØ䢋¼¸Ç¥–Œx•¸×º$öÂå†WA¡D¦<Ϻpz&À8Í`Æ #ƒuªkÖçµNzMåŽÝµfY;æQLØ÷²´”bì‘k!¦ÕZ­òhÉÃÅdpoµN'ZšO©ô˜”H\E)­,Ž°¬/ðR» ê+[H¿´@ú•³ÑÒyX}…—i‹ê3!Y+¯–Œˆþé æÁxh’ý¬<Ú´öh“ÊÁŠHâwS&‚‘á’ô~äIÊêJºá\$ï„Ø#²KUeñ(Æ‚[!Þ4’1¢" 2³}.¤‹Y“’è9’ …ÀÛÜàÕªê†r}!Cˆò:3< $—%Þ2yC-$$ÒÉ#Ó3O€1ƒhïª HÉtOÇnòDfZy@¡áºLdÎ9a}ÿ¿ÖÞkWí*×9}Ñeêøœ3c¯õÿÿú/ßÿ}o3uÀzÆfå€"Ká`´ÎÃHõ¤÷û UÌËÍ›á<;$,¿“ƒÇìì Ôû™x)†—Wï¡òŠcúɵó¶5|ëw©;Ók7¾S·†­“S"zA²µv¨`Ïýj¥›6µKÍO.±sMí®lÍ..JJ¨Ñ&µ(H pg>¥Û(âÁ4|à·i䟻ÎôµÄ=Ÿ›[ÆðÐà¹/Ë_€îjxnp½»¥à:­Ï· Æ'{o5oÜŒúºãÕ½Ó 6vú*­ß¡°eˆý^J A,±¢.t_¿Ðý4Ñù¡US ÀÇܾI¶lâׂ¬.]6Zršß:Ýï°N’º…û«7Åý,P¥§}q1±39¡tŽ­á!QÂÔzbÕ‚o*çq+Ë:Ú#ËjÒ žº´¦·ß×ZkTZÓu™ßãR p0(„—s°wøíûÈG*ǼLa@¹è楆ü¹Râçú[Æ0®Þn¯°È¡°€óº±8½Ú úIƦÏðR7ýPIæ{JßS?TRVÜyPYG’1ʳòLj¬ÓáoUE8YqŸ–Ìv<*'Õ]údé[æÑý‹÷…ѳä¯Ü!E­ý0P;¿~¼ª¿)}aCåÔÀªéa ©u¡V¹R!Fw8^OnÁâ×ñcÕB ͉k[#þ/jÿoJ]F¹6iquµE}¼­-ª{7 Tã÷´›$E:†É öãýk}™Tú'^JîµÛ¹Æ0ö…¨¿/9×˜Ó ”xQªú³â6²ÈÇ‘&ö”VèeíXæÛ-Óí–%ñÙ¦)ó´“PîœïÑžþ†=ÌÓBI¾(þ¬eSí)ÓOg¸‰,åcÛü€l•î+¼ ¼+÷ ‘ú”oþÝ oª»vWÓ6“˜Ñ¼'šv­¨î¦ºcλlQÄ7LQÜ„lZZN€{ã"Ú úëã~*ÌÛ¿PŒî´újùâ¬(ƒ Y§Œ‚ñkš¯nàÇZA¦Z?:Õ}øNK"§Óž*î2mª²w”ϤÅÏ¥JçžT fѪÿ82êõPmzþ껫ù=üDfÀ]ïMÎ!eŸeCT†ß›ðQ=˜Ziz,¼G› ]XÚd"ͬ-¹Ç¯E¿‘÷?õ¯Ãü©âÍ »~•â¾•º ¸Ÿ5Òó¨ïE™'¿ÎKB$6«Îwò\ñi'úGÚi¾üeñ-ù½ä¦ñëÚIVìa‚üiJ3Üăª»QãD¤E‘Uú‰RH@dß(ÓWDðgŠô1ƒ E¥kŒ÷KEéZYRœ)C.Uü6sܶ%›±œ‡¤µ^@‰‡ƒ@ÄÑaH Òsÿ*úÞ‚©º–q™ˆ[¹½ÿtð@wƒ´•”t¿£×rVu7XU£ b/AÅöX®(;QŠÆ{òÖh”¨E¼ÍÏDúO±lIœ[Bë2äyE.*ééÙ’¿q5*…Æä ÊÁ¿Iù#.}r+~uŸ÷T[Ñ7Ï?~ªïjqíȸ2Ÿf(À½\´T½«#c̺Gé‹E¯Š®–%4k ¤l}l ³ÛfŒkTío:á0¨ÆŠ.¯Ù)šÇ"zb:h:×äq]λtýÝ#Ù¹èê~×e ö‰M¯ -ÈÇ\µŸÛIÉ£J 4rõÔœª5\‹²6•‘ÏAPwag_•x§~>­»ÕˆJVCn=!šµÞÏ÷nÌkÖ($¦ÝU®ø5ÑM™å< d«s©––Û=ŒGÍívŒ Ìãnv>ÒîpdÑG°¥Nw•çô”眦‰ žc:OèB®ØM®èN®n¤›\é×rÅí~ž8yó”“ǾlÝ2f4ÅoíÜŠ¢ŽùÃìa£CpᎿ¶PÓîVñ›»˜ïµÄßyKüåþ¹ôínÓ†ô#Þ¡3EBt•Iÿ@nöòw¸ó@_ÃÛ)àåx^Ä•ÞÝJ½nÕCô5÷Œÿ4á;â¾jà¡Ò=¡%ŒºØȨP.I6ªX‡\£á»Æ>ݵjèФ.íèw°CØq€;òü¬å)Ìäá•41ø šFÝ’,ÀO³øí*fàïÙÑÜ‚ŽÕÍV¤Sd±ÛªŽè@†8Fà˜=/ÑýâÇÞÑêJ¶â³<Ñ¥oÒ¯ïÆSóƒ©wãæTœÜÓÓQ”]°æKß~ïGoòõxû^=Ì dô'òõx¯ǶW^zû,²áBg\äíxgòí¸‘»+”oÇéøÇçS”‹¼“+áOÈ6 óŒè“± 'Ɔ¼#‹qcÌ}Pì…tÌ~Œã‘—¥¯¿,”ó…îì·åQ-Ÿ° i5ŸÀjÆôã ên'4Ý;EÑSçÞJrC¦ÙPÀ”ÇÎ{¼U¶A¢ñzlÀ©ìPTKLç´úhÀ¹+Û6†F´V×[|›wÚ€pn–¤ÝÏz½«[’¬mÞI›*[ÏqŽ>}Æèª÷%ìýþ•»[žPùO®dÙ6HGŒÄ/„5'žñþ¬gü$ .0ÇVk'ÛDlÚA_Ó¢{ˆX‡M±TÄ:L;ÇÞ«Íæ>‡§>}ÿ\†§¾nû}‚~#Žè7(óùá>V÷‰öpokqÉ#›nS\ÚF\Ú³=ÒÉzÁ©}|¢® ¯µ MÍ:)<öpós²À›­^ìð{À†Þk-ïL¼ÕmãÇÆ°dpe^AÝ™òŒ¦Œ7Uaÿì¿âÇ›m:y‘Šjp.Ë%µ°²²í²gÛå4/‹m1†¨B‹ô: ’>»é½ÎEõ:ãQŽƒBUœc!G] ¯}åY†?Ì|~¯2ŽM=ÉRo„¹v°güof¨Âtt"UKì<ëLä@L§³3Gf† ¶`u˜B^|n4vJ"°ˆwð1E˜e°ËF€a]H†À6ŒªØ1K³°<Àâ(N@geê{ÙžŽNÇøÑ9RRo蜈MâOS#J#š˜”…â³ ×ËQg¥ÛVšÀ¡gZFÀ§G½öaLßæœok'ó5ˆfÒ!Ì8ßÓ‰ó R#,pÆšºíC\ÎîböºÀ4a™Õ¥ûüXËÅ‚:h=ã¿ÎÑàZˆ§‚LöÏÛq¿¶ìYEŤqëÇ=CÙOçÑí¼ofœw_î^ò1N›ý‘{oÓæ#Ö¾€ö™ÓP\Òµ3ç_¦Ùž"Ð]L C°¾/ƒv¸¸ šî ¯©~Ø zí„´ònlX´x÷3ðµÏغƕiÍQ_tl¾‘ž”BÖe¡Àí4ú`Îù,¹^ôŠ Æxàq«#ù=_¹ä¯œ¥Iñú-3/êÆ|3Jû]k1¥F¯+Ö&å¿– u gƒOiö±,gfK7R*.%¯%q{¶‘‰¯bMB¤ )Ô§óE•x˧SE‰<—äN„[NËV$s~*Åu¡@ ^ç‘&ÔiÂ4uR¶-?1@†°YcÞÄ4ÖR’Ük‚=QçïgûÄ$ÜÙ÷ï^þÄ<Á¦ûÀÇhv_þ„”‘ä©iT‰~"òܦqlœ¿kP ç±MÈt/³ÁÝ9•æ*Šlwï̶ÇÅ|MÖÐjí @+Š3«ÔÅ—{é¡›"_Žë5‰hr#«¶GƒÐ’ö‹#Ü^&—h¥)/Áöˆ^b“»ë:S*Z :7P åá¯ÇÖVÊ[UèÆ6­Ì8¾¾!7‘òÛL|8ž$>È#T&JÉ/ÅŠeL3ˆM iD.Žôeµß°Ê[óÙ`éÛæwÅqKâŸú€§·æwÍÁ¨5<-Ko×ôÊlNjrt€a)Ëø1ªmBRK”o3 ê*JÊ•4Q%DìñÞ¶qÄ|{¸´PöñL1cé7Œ³³‹ú££×î4‰#ßàÕxËDⲯVp“(ÑZ•çèÅbg,I#*àÅóɸŽ†ldQiá.®H…ãpˆMæ®êÑá{Ï–~ëþåï`·îÈT"o•—ú^0xó‡}ãÌxË|×öp ¶0ÔnÏŽ±¾zpùiæ¼eðùŒy,ˆY:,å‰ Ã7Ñ/Çç;g’¿ötÏ‚¶Y àÔöì>p+OÈG÷|‡«íKj7E¥‰ËÄ2hÚÈjÜì1+1^ʼÁ4o÷hÊÜF„x^— š¸Ä=R $8—hAÏ0–Èá𥺿Qs¡ÈOzöð‚ЧâJŽÙŠ6D u7Úåÿ–|‹Ý¨ µñhÆI|Á­W©|uwá>›½}rŸnŸ»q/*‘”dLWšt¦¾îNt5ìN/>(eÍ'ECt5 j©yT€­&˜ÿ™k¼ÿ!yú³âtz¤÷ÒÞíHÊÃ<s¥ƒ)W:XàAHcá`. Äçƒm©µE¶FÂA‡¨\_ï¹95qáîäãúiVp&ÿ ô÷æÒ¬hïÍL¿7öÞì«÷æj‘÷FR•¾Æ{sxo$›ŸÛ;dw™—…éD~‹¿;ÂbÞË£8„¼=ûìúûsnšÚûó8{ì›y.&œfÞØ}å2äåQ¼²_áå C+Íz|ƒ ¥©÷GQ*z˜%Ÿ·»iü†A'”gU:³aDÁŒ×làá!ë“-äbt¦¢¤'Dúʪ§à%á¢@sjÔ uãYÔýçLÎf@tx˜!b‚Ljx'b5E€¦~DTtel¹«1q~QÔÒñjX¥òµ&Ì™ãê¸=±'Åa‰ÃÁö Tl¿¿ùËÔá!(¿.D}}Ó¿0ZÆ?7†uœKšLø1uŠŒ,Í—å曳Ѫ4k¤³ƒõS”À´l²~½×Ù‰/Cƒt'üJ;)͸×â‰3S1æUy@Xï®^«Z”žx“z NÕrÊâ82eI¾’ÅX ÌÜš‚ ÔÒ·Í?äå)ùÚÝ@Fˆ"x`¾L ´WÎüiûZPŸ°R²t¯ÙºO"ìªZâeL#¦ÖËÔ4eÿ•iœ^Θ<›w²¼´ÉÛ†›ow-ÙǽÇÇ )HÛ¨Wd_|…bõJLØv€"›à…Û¥ ’T)[0\Ž¶‰ÇbÅÛc.ìËÍ’,¯æÄÞÔZ÷äq~O˜¨Ô|§y¯Ó‡±ø–8lyß ä„7ÁËjÇÔ¬’ y¾:m±­Ç-Fú¨eRrã[ãp«Ú„ÑÅðr9q$îNVYÕ)Û£N£%T&Hpò=4E‘›ïЗ¥q6BÃâf¤ ŒXš3Š&¦ Úâg5=ó1•4œçŠJpÚZww<è¼ ±VöélìõØø?3ìõ8˜V9'lx9acÚv{‹Ù®J©–:z|W|ö„ ŸmøøÚÝ{,!<~å„°ýH>(’í¹Ùà@ÇX]7Œ#l‰OØõ–œã ºÚ–fÞêV…aŽ?x,ÂÏ°n• ’BnuùKõ UxʹOÙáøÐÓ¿V=ÚI¬Ää¾_l|;âØ{^¶Ø€ú`úyw¼±Ö [™Ÿ#†aCòD ’6Ã45ÌÖúŠl "[eE¶mÍÎÍ%¾q–°fÛ¶§äÙ(ÛÞc»Þ#»ÞÑîÉ}Xß®_{<.#_Þá<ÆzlzdVjl«¸È²ÄÙ÷îޜݞeC3I7é{OŽíÇÜn|þïî"uB"ëœ<Àܤiük‰›Õ2àíƒFêlö$…–äˆo-×L^‹tꜜ7Øjdµ ÍjW6m¿iPÔšñê©iPŒir!Q§4=Ò ªP·t vµËrË*b@~¼1e ŒISMv6Vß(…«L5€ilñöŽ×è–¾Œ±]ãÚ¬4Îp®ú€J9Göèòô,FØV˜V©OÖÓ«´l4×ê} ÿ ñAëÑ¢P‡Á†·E\±cô†‘lA…àϘÅ-j÷ˆÅ-"ÎfÇ êÀ`YŠ­`ƒ2Ýô›:âÎ!³ žŠy¦ I2Éõ±ÁéYFª4ÒºÈÖ‡eZ!.ƒÇ˦ñ`l…—®ÛÖ(ž  ªÜd.Â9“šâƒ9Ÿ±{­H).kDÿÂ~oI=ê&üÀÓ )¼™:…åò—‹×L2!'ëÁÙÆ©ñ¿ ‚ºaÄ ÚœUÖ¬nd+â¤I5œÛùè—nªjÛÞþ”ð§ÓxÝävͽFæ^Cý^ŽÔ¤Žx„'-{¼Ê÷³'Å'ÔPF ‹1ÛÑ0E´®h*¬T íe¢áÅmÚœÑ]µŠ o8þÇÝî\K!Çk§+.Þk;á€-/l¨ã÷ŸE}˜ŽTä™yüLxo?ðÚˆô‚‡üÓgÏ–¾)ȹË(§L¬ç¥úÒ]ãÈð†!÷ª,ãå\Oû CÓD¸Ù‰ø+ì""˜ÇU¦ÞI„`¼Ç÷W°‰ÉCÄuÀ)§@Œ?Xöüd•ƒú±s´Vmyòj¬ñÀ‹A(4¯Ä‰ãÀY0Zªá5IâwÓ„6äÉblÍDkœËŠLñ-jp2ÚðjüÅ-%­Ì¨\99£™à6ƒãk^ùÇ>2E êÇ|þ7à+«œ¿0¾›™CÑ¥{Þν0CçbG: ï—(—’¸µÿ&ùp‹ ÍðYÂ…ƒXK?;ÄùÐæ™ß~ƒ _‡ “],ŽEbq3ã•T1¡¨¢IϽb˜xŒš¥1j’+„H % |tЄϔ1¹íaj>Ú¥/t8«„­Û|äQuäŠD7ÍÜ“n j/‘•%"òh’G¸¹¨$±2ÜTˆ² sRzÏkÌÄu¯†H±†ý<¯¹ô\ÄѾLâ|‰~÷#ß-Ôn ùʼnql‚îÆ:퓘¬ÚÀ~þp±˜?L9ƒÛ8ì³;ÛÒN¥ ôpL_—Ñqâ*Oç(_¿UP?züìùìAÀm~W’€ÖEZu«ÿÑ[í–nAÜ‚m'fLS·íâröd§Šø$öˆ-e1¹…5ÞÌä#ÌgÂz¿Gè8¹E1â«Åéc ôz1úØ šTú›Ë}f–;¥{”ä(;&eB"î)Ñ~N‘9E*!rÚÎ!5nò|ƒ´RÜ÷è I•ª#îd¼Q,WÖqa=ËM%UñÞ'mWÖb&= –„[êßé Ü dš—ó÷Âì‰ïŸ>>ÿòF8‚ëÃÓ_ËP‰ßô“'Æ}ÐOžŸD_Ñ;ÞÒ½ãBœê¡í^³õ__àì®Ù;†׺/\û¾ðt†/\gFÅÒÉ)tËÆä*Ë´õ«_Ðà?]ÄÚµ>8i/í¿­ÙyGq̽y»>ÐíZák„énïz'K´¤ EìvÀ`w­Q2E‹N:3Z©‘¡:Yk´ÝÌÁf¶U:Ñp#§8Ã@¥ÖŠo›_7AÛ|Çw-ìñë×ï {|»€Žm­W²Õ¿ Ûê¡°ÕС¡'ö›c÷AŸ¬77i¯é´óaáFü¦¨ãNúîS^ª}zƒ?öT>i߬n¬‘ÌfÜJ¦m‹¥ãÞû8åÌ•E€Ú}"®ßzjefÅùë÷ÅßÅÓë¯dóS`ŒùÖ?Иëd#󯱻áùÂ5R$ñHv¯ÎÛý(íô_D öúæäfÂIÀ0*üdt,´³ÕŸz:§¤]pÊïÁðì¿:ó½H!c”9+Ÿz"}j¸QÄ.ºð¨a*IB‘ÝSÿ®`SìUÜ)¥î^AÍóPGS*³LMùé mÏäfY‘[õÙ:håª!åä³Lo+U4Ø?-Œu”8ZU‰£Uik¬J²hĩ׀,Z•á‚yÕHÆ®WÁ&~‡*v*[âðZÖ¨TfôßfC‚lZUñ»¹ÍkâÔÈ vi ÞAá4ZúGƒóRriM¨~áÙ@ö|5†*ß#á rã`¿‹naQr´¤?ÌÒ6ôËQº¹ Âý`è GÔP‚yW«RI3sVkS2gQe|&'nÔ.Ñ Žü·íaž¸õòK 5§Ìy›»¼]Ç[sÈ`0!ˆc‡4CGÌÎ 9òŒW%x+·IgéÔèS¼Ê(ÛI\;;7¹-,¸¸*ìziÙ„]G,gÑÇò¤z5€+θŸ3V­†Jú„°”÷¢´:äEPbNÊÁæ=ƒcÐúyñCˆ—Ò¨éi!÷Œÿ,500C:Tdem{´W¥ŽÑ‡@,Ös¢ŒE^’Üëö(HÅH`–É&ÏC iâ#ØÚ„+ˆʈÌhƱä Éˆ‚iŒ-”"7žW+»±rŸ(ãpKÛ’¨#fêÇDpHÕhg°æ‚À <è”R ÊŪ'qX©’ƒC{ê‡hö<ÿp \0Ð?C–ŒÆ[½kXúäùç”»ü1~\Ï6Ð÷—š|2Ö÷ͤ1ãï$Ír¶y.Õ½‘2߃šÒg/~p¯sþ²'E´{ó)JÜ?3ïåƵüâëâIÑ0%£i\b«v]jè”) /QG°.ý®$ðĘOœ÷'TG"eI[ë( ÓÔs§Ó_ÌÕé‹r·©IàTú #Çiû,ý 0ÄŸ¦§#mðòøÏÜ¥uXÈ2ìÈmô‘Ý©ç- +–º$ésUi1PóX=+g$tÀí´èâÜýž,xÜUzdâ u¤>ÙMmÇÂÇkpµ(¾fqŒhë:³xf€ÜÞäçùç\ì<›*åX–®…˜UyÁV«ƒº¸çµuqE²SZH?:)‹VÅ¥Š›$q—(†¸Ù5ëQIÜÀæ&‰û{:pšoàÛ»˜£L 1»³)’ö˜"i>óp6Òãh'œ)ˆv×1ÅG“À÷Ž°â¶õJ ÷°…äI0qð­ž ~Ÿ°ÙHCäPu¼]EµN[ßuõ‹9†YLùKú9{\Žá H¶Æ‰8}LÊÍæ,N2ç>X·¯0'TârtZnIŽ0²q$¶”LÁ r+(eÿÔ¡³¬Ãë" x ÑÚê¶òvÊ2›rI» ÜúgÃüúsÎXH¢å—°[û1ªd«î´¾™uAUÖuâNëËpɹ) ËÈT(IÜkQÒ’cB´¬=Ž'6z)*¯]ëÀæ’ÉÑt:´£À…1‰gP<êQN:œðÞYì!çgv´}æÍØà X@¾Ø ŠºF ü6Ì»h¢—:pTNî1YA± ÎðDNÅ&IûÆp[eqöË+‘ö6üöP¬^«T_Ïô'\ h&¾ž¥ógNyªÁ†¦Ñ¹ »ÚàÙ­Èù±"D!Š§?V!õcQ†í.- û¢^ïb_dçÆp@A ­—Ò@M:Qt+ȱÐи™ÄºFôK·)®D ãå#üŽ’м ÈÙƒþD’þÆêMŸRQ¢×€*£j~îÇw?–p-ë{â‚‹å i):r8ñ ê_ÖÄ.Y´Z¤ò˜^`J]Æ°çXœwlíäôWÅúõt&»½³‹_Ô2®}&n§i7‹¥V› G¢@s#QÉ"!Í^uOf‘Âö©ÁÂÔõ&ÕýÜOyù“ÄÛ ^ØÄØ`½yD¿òa=¯¡{:$Ô¶ùò—ï%ÿ‡ä¼4k²C,Š%þ€.KÁžÍ²&›2èÖ$hƦLF¡d(âñ¸\Ù^•³¤ª-?(”¨Î1‡¬²‡“}À%’¤†ƒÒ¡N}ÒzUïs.Òõ<1ä¡ …ò+«5—'¹?šE¤)­6¹Qmš&ã¹³ÖШ·è¯h ~n2·/3UˆpŠÒ ±þöS/QTy6Ç;¡rE‰ý«áQýWVè¿=À<üfÇp_ºò¹«(‘)+‡kó;°R+˶!XS¶ §¯@mÊjâ#òK¦4oè&±c]£.¶¯ù¾dãÔ½ˆ#DÖ¼âxt±¿#ÞÛ¾­Q¼zâÚ¸YgÞNxÛVÌK Ýýê~¸G}qMHE¢àlÉJÂåZ@Ðçhñ ‚YO`gFí,ƒxeëx½Ÿçï˜ýq¢~vPú^et9§G¯KÄQõ!ñƒaχPú}Eš—a(\ZÑdNZ0º-KŠ=t‘ ,\ÊB?¹aæ¢ë.‘XC3ª`s¾Hw`a¤½•vJŠ^Öb¦k$ôj~(z¬”è$׋–áÝÔ®–ÊW²¼±]CJ_o\ÓQ¥ôÝ£…Rú©M=Á÷ê)ñ°øû^e%ÙÄ)ò96D–ùww<ë' íE,tæ¦:sóÿã3÷Ê'ñ’«3ÿŽ_Hé•“~樠¸g;oH“ò¯Ò£§îåbG&—´ò¥èêÝ‚k8{Ýk@(¤9mHdO™Æ¥œO\ÊV‰ \Ž»i_¿Òõ,wçiú̽• …Ÿp˜Öú xÅ„æÇW„{*?zO= ÚYÔMþ¼Ÿ7á>úBáN¢44éKRqˆðýÔJ5ãÉ>©^ø5~áÑ…T¼(Y{hIblU)k¯®$­5/ˆ'JMÉ5Jh‡Ñ55âYkјԙ祕hZ-‚‹L+J75˜´+#ÁãÔ (YZ+RÎuÞ­vŽW7‰ ®ñâÂŒŸç—>y¸} ýàVX'âxô/#Э9棶Ÿ‘†ð¿n&ÚŸ“‰0‚l’ûwñT”Øõü3Èÿ»@öéÓ/ž{ªÄfNÚ)i€g¥œ ¨;˜oöêÍ7¼ox„(îDQu¢Õu¯—fž½Bš©ê†4 {¬AÌj<…üëÍó‰D…ÝÜÓ=éÓzÊ¢‰æ4;ð¬Óü®Çž\z4ÁAýÙ÷þ|êÏN)Î@ŸoØöøœo"cŸËºäP‰¦]G<Û=%?«ËÒîÉW"åÝ¥?´é¿#T‘–IäÑ׌Ý\ûê³çoD}6À\1S}Vc°XT~6 ?ÛUø£€j]íRtƒB´ªÎzÒ§³¤fÕ>zÙžæXY@øtJfv¡Œ)V^Wlvò 'dfõž-2«iÉy8½ÐaˆàÍ¢ÝB;Ð-¼~#ÝBwÿØ–Jçö¬ŽaA*£ãq:鑾êT 8'˜\A²Å¹¼v+xzíq^©¨­Ím&>»“ü óº‰ò5òõÏÐO|j|`žNõ Ij,>GùÍDñÝÅû‹oOõßë/~mþ¢»rbÓ¸—o‹0ø„}‹TuÏÅ·Þ³½Æã;^ãñëSG7¶&Üê ˜ž¸åXÉŒ²ÞínŠ7¬ïèÞ<¥å¾×é?êXvá>$/+ÝBÞç±N¤|Ö¨)îXÍŸÿžß0ÿª¡'Ρ„aBkûX²AbŸз7"Yqî`êxBëóâÃ5> ¦¹¤GF˜Ã7`ï`ÕäoO|_XÌÁ -ñwÏ¥j ’ ¯þWmg·Ë1#ù‹tïQv´-¾wg¥Ïò„tmqïÚ`Ëwãï‹nâO¼Ý'`Ð×mÆk_-3[)0ùX=9“bˤ{Ð#%DaÅ=^BþÌkåIoþòó€Ð.IÓpoꟼõ øïü÷ç®3‘ í\Ûó¶jßù†ø­¤k·5…²¶?yÍY¾ß3è„¡Ú¿Ù@¾)ž·¿|K;ÂÉooé)°Q„dþÅ@)`yŠ C‘R‡Hy¨hHC¥]ü½‹»FßxÏü&Ϲ€ ß“É(­×Ø£>­eéi¤©¹û^”[¢îÆ i÷í¨¬R´ Â™Ñ. ¾Æ§õâZŠ(Hå4{ô«&ƒ[ÚGô«¶„½OU•a#!WØ¡Wd±Ã(°-Ú—£u£#,Ä9oI‡wΉbâ-ñ7ßá¿Ù£…¹®ÍØÔFló*’q’ÿd²ç~€Ô(ßµ"! úäVOŧ·ÞŸZMÜvWCï4“+‰ØaZn¾ŒfS[丫±D¡ãí÷¨3>iý€9dg˜B0Jp ñk·„@þ¡ò÷÷±ŽfW¥º·)†¸ï[ÁËäÙHSé€yØ¿¾ñļ^û×4ÁG§»ý•ãÆ™±?ý¿=ˆÄþ=áÿŽ îtOcÿ$ØoÏ&ų €÷ýƶä¥"!ˆeñµeЖ:7i`&Ä-¨ );õ7Ê r%íd(H òö2w=Ž.‰‡3|r6ø à?Å]Àw=ú÷@ü¸ÃûÙÈ?ÎÆPhNãþzØæžÀýQ!ÙÑÄ5zr¿æ«¡ýN^ í§¸SÉ1ÇûÒÿ&a~§˜ßqK.’.©(JPÔ5¨Ÿv3!~Þ-„Âû¸oäü(oúm ëf1¾Ô%ʧFíR‡›{"WÅç7©4Ì‹©4W‰p¡åµ ¯êÑjÈy’$]RЕᒥ—%ªãm>Õí4ÍcP¼ÝÀm1°¹uðDl%LõR.˜ š'x¿œÇ>ÈÒ'/>ˆ4¨%"ώŽ¼<Ô3ÛX‰T‘¾˜ÜpoKy$¬¢B¦g/‘5Þ´òRÇ ¢{\NæåšÝx5N¹y¥¦èz–™ïÊc·R\¡I¶°C’ZÓÔªA‚¾FøCÊREêAÂï‚M'wwŸ9®ÖÄ;2^‰'Ò¥T+Â`!…Ð/õÒDµ`à áÄérôyÁ[¶¹‹|D PïY³T%‚"a¸¿“[¥¬³ããNKÆ÷ƒ¸S"íõЦ£BªÄ”úÀnh¸Ó2$Y$¬k4Kò@Òö<ê(äé8+·òÄß)&%ª‡á§›º.š„^j?»9ý0`S„8ýígôñ¦Eãoñ¦Dw¾.Œ&¹ÄÔùE.3W¢FR¡LKâMQû/(øðópºacôóÅâp·Iìé&°§ã ÿ|<rÈÍĦ3…,Õ¯VC”ú?D“jJI“8Ò#ã¿ÏÀ40£nó(Æ~4Gzüˆˆû,·˜eìM`§]äÕð¤‹éPkfŠ!õ_Õ™Úà:WÄÎ>ë…c¡Fÿ<ñkCF§ÃÓ$TTKaB`¢^p êt>Y\§“^+vtÝ{£ã5t:ßzÎñ _Ì ï.HqåWÓTvË—}¥Í©º·iê¼J¹1¤£7hMœ þ8Çóq1K±óuÄ•/÷|•Î‰w|¦Äò4ï\Îhÿ"¨ÑÙ”¼¶ß-ê¾ÚÊœÛ I,³Hç¸Å'Ú¢5E%3Aª^Cµ••ZÚ¢i9¶àµptÅeíĦ…9ý3 ˆ.{á[Ç@ïÿcz?Ð~íV÷¥,W¸ZÁÁâ<ß’?8–_‰ç»DBï_;{¼Kì¶;ÌÙù –;gÂH«Ý‹PBÚ‰÷v7Íí=Ëôæ#ž·çp{Ìl&·wGƒ8ÃêÜbIÆÝár´T!˜G˜¬ÒW²W§ÌbJHì° ]ãÂ<4† ÓìéúõhÈuD¬„‘/]〴Ov•(Èx§} týâuúˆ}@Ôï`¶¨ß%‹ú<"ê7º¨'e¥^gid´àû¯ ãwe†èø‰@zÌŒl}UýNhüUýÎMOã»=[ÒJeÄ~÷ KÊ E¿0¦²kÉK[7‰xežŽß^eý¨ÙًѤø«I’u'$Éä&^KÍ÷Ö ÚtRƒl¿Eɉ³kìï)‘)–ÂWU$ó{¶&õàSU¼{ÿéò’‡ãÉ5cÔ’¢Íù ³Žl1r®„VR-Tv¬®‹Håý¡‘(Œ*$™S—K¾BˆZHJåÓœ`Q¢â«aZå«HUó´±½’¦!UÊyrI! RÚÙLˆGÉ¡~0OÅÇŸ'mî Òú‡¾n”Së! må‰Ö5B:c™GtÆÖŠªÉuÉÀ@¸þB<šH”[©Á“Á#³Å¢.i?š,cR,êÐÄ‚ô§SjQÏ?7'ò97ù]™•f9+µ0ŸŸ³µT\3ª¬Åˆ* L«üx/û L<:FuZ¢”¦TYëÒœ?d–²ÅTàVNúd4»LãùÆDšZžà,NÚ4GÆôX[_2ôí¤¾÷&ûsb2kz_óâ?Â#^çû— zj&DÜ¡G5@e.Î\$‡ÁQ¼v¦Y‘íÿ{y¦)žÅ',›5%°¡”gÞÏ&™6BYbb˯¦iË|•©;±çµÇp„žØ’¦ÙÖ*@O¨á&¬€¤ÐºJá‰È3!•²zk“CV’nb]­ŠŠÊ]‹£P’f‡[Øö$Ýä¹Z²Iç©¡ØYù@D¤ºùK/¾&ÂÐë|dt ,éµôMa ò,Rõ@ïßw>˜†ïßSÁº `Êaè®þ‰×¯ïóß9öuÙÕ§ÁÚª¢Ü¦v½Zä¯F/Ñ¥mýyýy@ÃŽ¦ûó´±ÓäMTBp\»é#B>ûôýïާdÍïÏ›ŸšóóâN¹)¯õ8úò»Æ¿êË·å¥|ÕFüÞ«¯Ý£¦Õšîû¦{µƒŽA²‚£\µ^¯Ñ.© g4ØÍ®$7œî­cŸFéŠw¨ãE`9µfÎßí¨ßFï š^£j³ÎoÓ8¿¹í÷Õ·e_ÝIöœˆli.ÜSoI1…A—¨ªõo†Û±·ë„¾ ë±[¬–¢wÖݬ¹r=»ÃTÊœê°ûjÄ v…5ôÜq—±ûJ9©Í5?B€ÈÕ½i•zUêlZ-­ÁÞ±Ç{I|-”ñj¼Þ`ß³=üçC–¹Á.—©›%ÁjôÐWìa‹Þ±V•êX2F½á®>[ÜYÛ´Ù uJ üvûÑüvû„ê³j¾O´Û²ÏÜxtÛ=Ì1uÝ'ú´ãG3z‡Üjv_vg±ýþ=Â݉á›nº²{‡6[É·Ãû¬„Éö9ùœ>™qNM¹¤<£©úg~>¯¿d¿:£S †×ЩÏ+yÓOÁd ³¦ŸÊ½¦7Ç—n÷œíÏœCà‹%ìÆR`Ok.…±©Ë$*Ȇ„éqY$B‘¹oJ­€ÓkgÍâþuE”ŒÃ­êÉW!J×ÃÌïƒÁò£Aà$Ïž°Ú¿@óÉÎШ,±=ΧÿoÌ¥ÿ”Õá«¿µÜ2ø=s¯ÈéϧÆãÏKÈÓþr׍Š—~d¤ŒŸß pVz¼±ñÓÈ­—ýÙ¢:”ML-:è{ Þ6ƒøß6ÿäjySÜCÂøEƒ*rîÛ¡î&ÙÐ0ñ?dÄQp&iÏ~‰W3DÁ¹WãÉa|MÜÝ”Ùÿû¦’¥µDÅxh~|ºEä$÷¤°ûüsÖòþ÷³Æ1\Åÿ¾×²æ$ÍèaëÇ$l›úf2øf6Eü™»´¢ñŒ­Œßoµ‡Ê62œm¸9ú¶:܈–ßšÿí½üŽüéÛ:„¿Qú?âô2Ñô‹|!î)!îIiúFIÓ×?$'Ò{Õs"‚1"C÷™ïÇœñâ|~jFqVY㯠ѹO÷xªÜ£%ƒèôœxm~:˜4~J¯gÅ¥6Ò÷§3í¾Gõ]z =ú™Ëoù¯G‘¯ý;Éä ¤†„­UE—ìÅÊìÄCÑJðþ€Ao€¨Žé 9Î,²\ ì°)"ºÓKi¯U…¡HÜ¡4lGf¿¬´ µWÍ’³€|,ž@‡]©öµ³•¥’’«¿‚a$VoDçó:ÒYôýS_º¯fç ]¦æé…uÃÖLYÅ×8{ðZx÷ªŸGvÿ#óc‘°ýTdC^«éD{®aR[Ù]V†œQñíÿÍi´xœ}ÏJÃ@Æ¿Mk­‹ ^ÄÃDPº¥I©`{ê©bÿP„ÒsÚ,mlI`Û‚OàY|ŸÂg|ôæl²­T¥!Éþvæ›ovÀ^ >×x²,PÀ—eûâÔrçâÁr‡âÕò2âÃrGÎJŸÇ®sÃU"»Ç»ÇÄÁ°À Þ,;8yËÜ ÏrgâÙòrâÝrâÓr§†BLcw ´˜#f9ÇC9Ö†J¢Äj“Ñq–x!à5ÆV™*‚‡2\\¡Î¬9:ãÏçŒJ´Ë¤Æh MtÑOÖw‘\‰N8gþµâÈ×óiX¤¶Š#êøZ‡£)ùQ@ñb¢ôœ¼²{U'­fÊŸ«€–Q 45»}jöÚ’ÜhŒáú..qoÿhDã¡ñr/ïùÅFRbÀš3JŽ •ÈA(éþµ­ñ·­­ÝR­‡*ûV’iÓ{Z¦F›Ç"Ó“£^UV¤wûP?ð™±Äá–Ê¿}ä¶ù­—Üz+¾¬„”xœc`fƒÿ )@Š‘ %² ÿÿxœc`d``àb19&FFÆf ÉabFÓÕ¤'Øe‰¶Ø¾TQLambdaHack-0.9.5.0/GameDefinition/fonts/8x8x.fnt0000644000000000000000000000621307346545000017370 0ustar0000000000000000‹ Leon Marrick, 2005. Freeware. Share and enjoy!``,0ÿÿ † ~~†Ž–ž¦®¶¾ÆÎÖÞæîöþ&.6>FNV^fnv~†Ž–ž¦®¶¾ÆÎÖÞæîöþ&.6>FNV^fnv~†Ž–ž¦®¶¾ÆÎÖÞæîöþ&.6>FNV^fnv~†Ž–ž¦®¶¾ÆÎÖÞæîöþ&.6>FNV^fnv~†Ž–ž¦®¶¾ÆÎÖÞæîöþ    & . 6 > F N V ^ f n v ~ † Ž – ž ¦ ® ¶ ¾ Æ Î Ö Þ æ î ö þ     & . 6 > F N V ^ f n v ~ † Ž – ž ¦ ® ¶ ¾ Æ Î Ö Þ æ î ö þ     & . 6 > F N V ^ f n v ~ † Ž – ž ¦ ® ¶ ¾ Æ Î Ö Þ æ î ö þ     & . 6 > F N V ^ f n v ÿÿÿÿÿÿÿÿÛÿ·ý¿öß–ýU¯U»Uë€$H@ €@@<<8|||8 vªþ|ªT(~Õ«Õÿ«Õÿ~ÿZÛl(8(P 8lTl*"\zf(@@$$$((þ(þ((|Ð||D¤H$JD0Hh0JL6  l8Ö8l|< @@|‚‚’‚‚|0|B< <<  8D8Dšªœ@<$BB~BB|BB|BB|F:@@\bBB|<@@@<:FBB><@@\bBBB0< $@@DX`XD08ì’’’’\bBBBBB>\" >@<|< BBBF:DD((‚’’ªDD((DBBF:<| |`   2LUªUªUªUª"x x" 88V (T8T(D(|| $8X400ÿ  80@@08 (Tº|ºT( ¢ljŒ’l|º|l’ @D8F:<>F:<>F:(<>F:$<>F:<>F:~ ˜n<@@@<FNV^fnv~†Ž–ž¦®¶¾ÆÎÖÞæîöþ&.6>FNV^fnv~†Ž–ž¦®¶¾ÆÎÖÞæîöþ&.6>FNV^fnv~†Ž–ž¦®¶¾ÆÎÖÞæîöþ&.6>FNV^fnv~†Ž–ž¦®¶¾ÆÎÖÞæîöþ    & . 6 > F N V ^ f n v ~ † Ž – ž ¦ ® ¶ ¾ Æ Î Ö Þ æ î ö þ     & . 6 > F N V ^ f n v ~ † Ž – ž ¦ ® ¶ ¾ Æ Î Ö Þ æ î ö þ     & . 6 > F N V ^ f n v ~ † Ž – ž ¦ ® ¶ ¾ Æ Î Ö Þ æ î ö þ     & . 6 > F N V ^ f n v ÿÿÿÿÿÿÿÿÛÿ·ý¿öß–ýU¯U»Uë€$H@ €@@<<8|||8 vªþ|ªT(~Õ«Õÿ«Õÿ~ÿZÛl(8(P 8lTl*"\zf(@@<<$$$llþlþll|Ð||f¬Ø6jÌ8l8vÌÌv000  l8Ö8l~< 0`À€|ÆÆÖÆÆ|8<f< 0`0 <<0  0F>``|fff|>```>>fff>ff><``lvfff8<  L8``flxlf8<ÆîþÖÆlvfffff>\2000>p<|<fffn6ÆÆl8ÆÖþîÆÌx0xÌfff><~ 0~ p `0000`2ZLUªUªUªUª8dø`ød820ü0x¶@$Z<XØþØØÞ|ÀÀÀ|~`x`~~`x`~~`x`~$~`x`~<<<<<<$<<øÌFöFÌø(æöÞÎÆ<``|f|``$ff><8X8xbLambdaHack-0.9.5.0/GameDefinition/fonts/Fix15Mono-Bold.woff0000644000000000000000000030657407346545000021343 0ustar0000000000000000wOFF|ßèÎDSIGlhFFTM`€Ñ GDEFlp¸ôq–w;GPOSutì;¢È'¨GSUBm(LL@F„OS/2$X`˜búUcmap\ Ž.\ÅHcvt ¼rr?æfpgmt±e´/§gaspl`glyf)´?yI<ºqhead¨66"_hheaà!$éhmtx|Ý<-9ëÆloca0„@˜@maxp L“namei0¥ô^ÖÏpostlL þð2prep(”Ó×âI4¼"£›Ì_<õèÒaêØgH­ÿþ Txœc`d``^þï;ký‰¿‹YC€"È€õ< ? Ïà[TZxœc`fºÎ´‡•©‹)‚ÁB3Æ11ÚE¹98A’ , LíL Œ PàââÄ ÀÀûÿ?óòߘ—3r&00ÌÉ1 3mR ,„í>xœ˜ytÕÅÇïÌ<–° (% Y_äe#Hòò@e_„z¤Ô¶p\Ђ¶ZÛ£(²–¥ Rl ˆ† «"mmE(dQp=*tú™ÉÓZmÏéßsg~¿ßܹûÜùé­R!«D ETŠ¨¯%Ÿñ ú~I1$Ãô‘¾*SòÔIé’ô$W/”"5Uú#a5VŠŒH‚)”"}—$ëW$C4ýœdëW¡ãùcÐפ>&9êF鯦H~J õ‹R¦×I–-I&I‚f”¤ëãRfºHHÄ»`)óÖÌ3-ýàÔ–ñZž÷gþ4›÷ï@»A롱ð9Åwg¥¿™,)ú’dšxI5¿E§V’«ÖI…Q’¨j$Ý$ÛÜ*åjdê¿°þ%x¯‚Ãã<«ya¿bIÔo3¾OÒL#)ÕO€ƒ|û¢„õhz=‹ ~˺*)6m%UŸcüß;¹žÂ–‡!I* ièïmŸ…î|½ûÃ&_J/ÕUJô ž“f6ûä¡g!ö¨K˜g¹j+ãÈ9NJÔÓv™zÏV©EðZ-ú¾K‘bu·d«ŸÙÑz¾äè“ÒÇl”8³\ºš¬"Ùü_‘…Oœ/þ$Æ£T‘ãñ3ðK‰1W ï'Ȳzô³sLmŠí}¶¿’}ÏÊ€ïÂÜ'7éÓØñ})5%輇o^{¿ ›ræ« eØ|oo€Dôpä¸Þ^Ò?­I_]-ñ&Œ}|c›Ã2åJdó¨FÿŽø„øsÔŒ”)nO§³ßwëˆÓÛ¯F&ºú½¹þ=–JúÔ—£vr2~Ÿº8ÞÇûʆ9ñ<=’~@Ûzš‚>1Á4õr¤éIÞÞZ’fúztÃÜÑQÄ£‹Iç‹ èWÈõ2qòÄëö4±C,%c‡R]ck‰Ù½]ÚGIäO»$ég$@þ$éOÙç7àS¿wOý…ëZb×ÍWI}wäš‹wçcgÛoi¶AÞ¦›6Øn({^•Òœ<Í5Mä?_)Í©']'í=Ý uù° ûGçÄC&²e£…ø©94C?€oÏzâ<­ŠÒJ‰EÏþ~þ1óg˜ŸGæ•à¢LâÝxcÞ¿Ž¶D†jiâéêS}-þȔۉ±»ˆÓ!Ø>ÿFÈÃð(¢6w9¯"ä^3;Zµ‚æaëäûÜkD],j5q$q›Ëš)$ûù<ä;k©-v­6Ô×<ž³ï«yv–N°×}á—¯Vz›êÄšt)SwÛ©ø¼Ô|ßà§@žqà.ìÛ˜½?$¯gØÇU 5î=dØE®41è—­Ç#ÃMÒG}`óÉ¥tÕ=§ã‡ñöU5×nÔ§m–éh3ô64‡mžyÔfšT›ÅÚD|—ŽÍËt ¾z/“ˆ‰ß!öv99ŒšßLÊÍ@|L}ù„o].·ôß $"úò”côVÆg¥œµÉ¦ƒ·I…¡.b«b-Ó×üíè°R£CΕTïƒ8jP ñ<Ž¼^¦7a?òÝR‘k >#fšÜ€Ê8ë&Ró#ÄD9ë#ÔÃ|ö˜émºÂÿ ïÎÈ@ÖEL^©Ô›Cþ|Í¡D8ç‚ø*?æ˜éÈšMä›zÞ}†î_°®hÉÞÃyvŽñ•ÈÓÔËÔå›ðªÅ6?ç|ºšý©{ô}/“ cÏxö SW2ðMqfîr1ŒoÒ©™í¨NÇTäÊÓŸcãã¼Û(ùØ?l‚Œ`çzè °•ñeâð5dSÇÞb¾ûM¶‡á™ƒ?Ò¨8;ëk©á®Þ„©«¥ì{¶IàYº“Ã4G÷z¹–3)x šIèXƒ}úÂócd ¡g2ßugÜ\Í|¼þÌûç=ßÄp˜¸‚Ì™Ø(™ÚšjvÈÓæyyŽµ¹ø4›FˆÙ°þûlö9ìòËå]DßÂó<[A\b¾~M8³›‡]ˆå·‘+ßû L]è¼o¾çÙ«£‰,ï/ä þFȇ0=O„| “¯!ìògúà(û×¢Ç2Îôdí¯¥—§·±G 2œ„ï)ôh‹]ÎáË×é|r¾Ëáë}Ÿõ uqŠ='âïÛè_\ SW3Èý ŸìFÎuÉÉ’«×_%Rèãà^Î?¿Á>Ž¾ -“›Íj¹Ë‹½¼EæÓ¬‰%¯ÞC®è^Øt$¾ÌCï ï{¹G¯DO7 SküAüá—ÛÎ?Çб=¾Þj/ë7¸py„¿¥Äè`êHºë5éuÂøs*{ÜLÿ‘ ÿ$3 ׂdöýœƒÿNìÛÙSøËÅN†³3ü‚ø4ˆ/#|SFn rè3S‘/ =²‰‰â-ûd S˜ Ò—DÌ/ø>@gñ¾;¾ØîëÒXôŠÖ…ÉÑ ÆAjZÄd0wqpÜÇOÄå·™ˆ-‚à*xôDÆ <:€dÖ5gOÎMb~‚??ÏÊxÖOÂ_üùy+ö£nƒ~QúC µûÁn³Ùn0ÏÛ:ó0tô÷v™c7 gWû^Òc¶‹>ocÍ›öYPgöA÷Ù:r ›?#ž+ÀðXÛðÌÄØ8Óu—ùþ2ëê¡õ¶.ÐØî û=L|Ϥï›}g5Ðyà1°l±qzƒí̸Ñ,BֵеÐÈ[ËúýøìMßÿ7à`5-mÄ´µ½Æn`¯:s’5§—3…xkí íJmj Q˜{lq —5À8duçOSìÛ@ˆ+ìÓÉ&Zð}Kö9Á>'¡‡‘ï-Æ×csŠ°é>iClt%WºQ_RîäOƒ¼‰ÈµIº›©Q¾nMÀûñ?a¢ü†áÇaÞuøq=~¬3³Áö˾%²“sz¹¹‹š»ËÜ*ÀPÿl§ij»˜+m's‰o_.B¿ã—ÿKïŽ6þê­£r@ çr ‹d2Lño—ƒÍœåST^ãú#C®ÅƒÁľӡBv;êci˜¼¨?±!ß%Øï‘Ê5š5ê2k:K.žfQfbW‡E>®29_šÓ‹·ÒÛYO_¥›sßúš\îÀ÷.&¶ÈÕÐ"môÖÛèA6òœ9}ÒO=fÛß‹u³±ÔÑ\ÅÒÛ£5uîÛÜ!ÏZ#ßÛ‡¾;„ ©#Ô½R-%ôÍ}ÞÁä‘ûåà1!·wÄLôÉô}h?}'zÝ Íöã¾èR¤§&½Iss>}ìΞáÔÝZÖ±+è+ת:»T¶«ÕL;[}fŸQG¹sþÊNSKìïÕJî ½í  —Ú(¥~Í;Q­±T§ì*æUÜS—¨ã¶ZUÂçœ]§ÞµOúõ‹í<õˆ}DeÙq*Óörÿ tgrp»\CÑ—úZÄ}2~½Ü  f•r¿ÞG¼ï•.æήÝô°/ÉõæÏÜû×sŽm1æ-éaÞ‘|7Ѽ.ó8¯S©gîÎ4÷ó#$#ðóÁ<¯ Oÿ 0XŠÝé=¾ø@WlRÏyrÌõj;ðërü»Ò º›J±×¯a}?úŠGéqÞ Fo"~ÆÒ‹Uù{I¾ÈûrÆËèñID½ ï½ Ì“H£û¤Œq0 ‘«ZJ¸›—É»R¡¤?M:ë¡` HÁAζ¡øi{´ç|Šãùèbh;žÇñ|~] M€G˜ŒÙãéô©CÀpÆ.'Rá9z ¾¦1†£SÁ4úÆiØë^èUäÚðI<½g*t óeÐ?2¯‚>ÊwA—ѳ¹ù$Λ)ð˜½ú‡è+BœõEÀõ$Eœw!ÿ¾‡7ÌÝØÙc2ö8)åênÆë¸ï<ÜÁ¨=&€tô‹ÞãÑ1#j‹jhϪyžÊša`Œ·i!ãlÆô=.¾ ɳb³8ù½o¾ä| pwp}ä þ?V_ÝIJä¼å΢»ãÏû¢ôb“½Ô¬¯f>Ÿ?ÎÙ[Í=h%}ÿ\ä8ÝϱÞáCdq¨£AK|¾LÈ+ï4Ìé=ËÍxbë}Æð‘ã<ßD>;¼Àù~„µ°Í5¼/Ž>;@¬µ¬½܈ž‚ ×—g¸_›¯çÙG¼!°ýC÷,î‰Q¼ˆ.Ò{ŒÂFŸ1^ê냇6ªa¬²ž=ÌBú•ùð~ˆšòä©žæšÑøs Häî“ÀwI®×/÷E)p¼gEÇŒéG ¿ ú¢z8ù ‰ËlÝ _íÄGµäßzpžyžôVõÔéÉ­/ñºpOH0G%1@ŸØO½~êú´Ïùî‚dú¢3%ß×ÑXzËOY—mgø»W ò£ÂÖ»Aø­‡ÿÏT'íéM#K‘¾•šµƒ=žçŽºº“sÂý­B.÷t?ñø66hŠMŽPn£Ö®…¾=B¯ÅfOGôÝÈ–¯Ú?©ŸJšZÇóã¼?Ìù°zŒšúdR—×ðM¥û‡« ¨g¿áÝ!»,T먱5ÔæSö¸Ueï/ûdÙ1 Õ,•¹þ|ÐÈÛÈîâܘàïïH¬šcç«ùö×ß=Wô඾_:êÎv7ãþäOñ|µ:ŽÙ›¼)5ke‘ZE®.AéȽ„ÚîjüT;•úØÍôç¾ô°ý˜;t ½Î^¢F¨¡ ©ŸWè§è£ª¤-½Z ž·Õ×Ù½ÔÓNðN 'ºÐ íYÎÉVÎÖÔßûõr{™8HÖ3Dé¢9ÓZq¦õðÿTº¡s%=q'r¨‚ü¸ù3žL®àý Æý‘uyE]×îÙPÖpU=‰D :ª›k¥ô_¹+E+xœå–‹sTWÇ¿wϹ!0@„{ÎÞõÜ@ÓE&¼SBcðBÊ£¼:Ô`;E˜B©[‘¢•bÑ)â±(E”ŽíÐ0LgP(­²ÉÞ…Ž-#³°wýîž ãŒ3þfæ“ï7;Ù»÷ûûýÎï.€ ÷I{º6ñU'÷º@Aîu)þ¿/c3ò°=°ÉÙäìt2‘‘Ñ‘æȱÈÉÈ©È!E¾è. EQ&F‰*Q-Ö‰çÄV±Mìír½;,º%Ú¡ŠÕ U­¦©yj¾jP ÕFuXPgÔꊺ¦B¯»éb]ª£ÚÓ¾®+õd]«õv}@ÔÍúx¬(Ö7æņÆÇvÇ>ò"^¡×Û+öJ½¨7Ä+÷j¼Ç½ÞÛñH¼g</Ÿ6¬1ûÌAsÈ4›cæ„9iÞ1gÌysÑ|lnúÚëOô«ü%þ2¥¿ºloy—6q'f2¦îטön¤„i2m Ó¾' òDÓ _ŒÌ¥mDÓnûÄ'rktsôª‚*QZÕ¨i«ÍêˆjQïª êªº¡»0moÝOÔ:—¶¢3íÓ¹´Gÿ#m}lGìR.m/¦í/íoygZ÷siaº›µfÿ½´-æ”9mΙ÷͇æ ÓVÞK»Â_Å´nî8Ù´™ë™ óVæ`fJfh¦(ܾ¾¾®ç…sÃ9a}8#œŽËB“¾“¾¾ž¾–îH_M§ÒgSM©’T÷TA*?•—’)‘Š¤œ‚0HwƒOƒÛÁÍàFð¯àrp)¸¤‚ h Î Z‚7ƒ=ÁîàÙ`C°6øJP”=‚H²5ùzrirjrBr|rl²"9*y²ûïY]£ÿ'õ sÏè.„}שÝ,â&µ7ÉæºEíGJé9/z ‰æ-Ð̨™U²ÑÚ·HöY·Èìµ+H%=?CO¶HÖM×Zdö3-’5ÔOöFrŽõ‹d õA‹BåLjΤ¼zÜ"ù¼‹YäÔ¾9”êY${j‘¼¿X=a]åƒÔd7ýxê%ò=ûæE,’ýó -’}ôzÖHN§[$gÞëOX+9‹µHöÚb‘s¨å9—Zc‘œ o yœþQêrÂÙ— ¨o[$ç$±HÎG¼§ErNâìE¹HÏž™ÉÇôq*ç×p]æñµÅe¿|Δ?–~u¢Ååžð«,.÷…¿Äâr—ùË,îCTæ÷™ÛålúÌìsg¸c€²½wPÎlåÌárÚX«6ÖÊåμÃgÌÖßåÙ3÷8=sÀ­A^¤ »ü×óÈÉmftnèÿõcß)xÌ\~;ë‚|tå·¶nÜù=ð¢'z¡7ŠÐÅè‹~(A”bb¢\J1xˆã³l´2 Æ܇r~û{C1 Ãñ FàsøOˆ”™5‰¢4;;³sΙ3KÊ‘ªwi½ç©sHánƒf›~'¤ÚE€ÒõFFÚÁ#-63zåº}¿Áf4åN@yÏ[ÊCFÓN í¹2?ƒá>ÿË<ƒ–fšžZg!=„À|3nið5£YwýA_±:\ †ÓTÜõÇTÊÿ–æ\m¶63šwp!"?˜hj­@ÓŸ:¤z>Žb rùl¬ &¦¬?ÉDpa2]ÕT-3¾vpŸì,:ؤJsà°Už‚‡ã£ …ô-‰2KC„ƒØ*1BÄ$‡BN9w²?)P>’„1o’Òθa­qä50¨ÍÓ¾ÌfSÛ[‡0~GðÝ/Æ’>²¡6F„ØŽX `‘QU¾¡Æs/‹¹Ôþ3%`yúí_'­;6/emcŒ‚žß6ßùeÅݪ\çE¡»wU5Té”æC/gßãO…á ±àÍç}£@í ‹ šÁÞÞÿÑZuÄUÞ Ùo5³±xœÛÁø¿uc/ƒ÷Ž€ˆŒŒ}‘ÝØ´#7Dzo 2"e7°iÇD0l`UpÝÀ¬í²]Áuk/“6˜Ãä°‹A9 ™b‡q'T=P”Ó“I{#³[Ë äò(ù\@.7œË«àº‹³þ?\„¨€7 Îårùlà\ —ŸÆÜ ¢ *<éÿ"µöuPqzžP‹–ž¤¨ð°²«nj¸¶†˜Ô´wŽ‰|’Þ定sVƒœ¢”bS\`'%-075=+xœ]ÖytÖå•ðç÷J+VT¤´bÅ"ÈVED…!! jö= ¡,&‘I@¡$ VP¤(èhEEEBe•jØZFaЦ#‹‚-**:óátþ2çÜó¾ù=÷Þïrïï=Ogþ¢¸Åæb½C8«}müÿ“º~ºPx~v;‘% ¡mg1I,ûC8GîÏ: yç–„Ðnðü¼!œ¿Hì áÿ·—a¡ï…+Å¡:èÛÁgGŸõüE_¡Ï/û 9árѧ!t‚Ýi[Ç‹%bO¿šÂ%p/YBg¼;ŸáRx¿ž*ZCè2JÈír2„ËÒÄŽº¦ŠâtÝò.ÝÔwÓûòµ!tÇ¡»üëC詯Ž!ôÖã7— ¼úLr¯ ¹/-}ùÓv?®Ä÷ªq!ôWÓÆÕ´\]-pàû:®q>°H¨»¶VœøW\§ïõ|½þXƒø5æ`Ÿ7t¾ÇñýÆ5! (ð‚ëÐCˆç[¼ï t%è›@{‚Þ‰ô&қĿ$¾'©Mv–|*„a<fFÃèOÑ/…O)x¥ð"VŠÜ‡7…*'U]ê™ï8¤¶Þ¦Ò2ÂÐk}#ðÉ‘4ŒÔs¤ž#õ û&¾Üdn’w“¼QòFÉçf87Û›y~ -·Ð{ oo1ï[Õ¤ÁLƒ™3 f:Ìt˜éö#ætû–AwŸ3è΀•¡.V¬Ì9!dឥO–>Yúdé“­O¶yfó8›ÿ9m…çð%×<óÔä©ÉS“§&OM¾š|Øù°óaçÃÎ7Ã|¹p h-0‹‚íÂl x]ÈÿBEþ/ò±ÿ‹õ/¶Çż-æm±úbXŰƘÁ3Û»X «V)¬RX¥ö»Ô¾–â^æs,¼±ðÆÙ¯q4—Ó\Áß þV˜C…9Tè]¡wtŒ§c<ãõ¯÷x½'ð~ï&ðn‚>ô™¨ÏD}&êó;ù¿ãS¥^•zUêU©Ša’³IzýÞì&Ó3™žÉò&Ë›,o²¼)ò¦È›"o Ì)0§š×4z§Ñ;ÞÛøQEGU²0Ó*xÕÞÃj{\íýªöÎÖx·jäÔÈ©‘Scî5úÔà~;ìéM÷~L÷þMW;]ítµÓÕÖª­U[«¶Vm­Ú8ÍÀiN3pšÁã<žÁÛ<žav3íãL}gê;S¿™xÍÒk–΂3Ëlëè¨óYooëÍ£fÍ Ÿ/óéh”ߨg£çö´QN#ÌF<qn´—Mö²‰MΛàÝå=¸ËLî²wãp·œêðg_˜ëµ ñ]èûBßïÁï:î±?Äï^ó¼WÍ"^-òl ‹i\l§ã¼Øn.ö±×ûÌå~8÷ã¶Äþ< ~)ÎKyõ'–9_ãAÏTó ñg¹¼åž¯ õa\¶kÐñˆyÿ¯Õû1Xͼn6çf>5ãÙLG3ã°ÒŒVÑ¿ŠÞUø¯âñâI}WÓý”çO«{Ú.<£fÜ5x®ñ¬ù?gÏÓô¼½XË‹ut¯£{Œu´¬“»ÎÖy^€÷‚Ý{ÑÙz<ÖÓ÷o^¦åeó{çWä¾B_‹¾-ø·ÐÖb¿[ä¼êÙk~§^ƒó­ìØÚ6Øå vf#7šÝFßÿŒëëü~ÝÞmÒg3Þ›oö¾máã>nQ·UÎVœ·â¼¯­8¿áÙfo¶á»o:{“þ·œ½ ÿm\·óþµï˜ë»8¾Ë‹÷ôÛ¡vì¿ø|ßìßÇý3i•ÛʧVÜZÕìô|—ß]ôîâånßw;ßëöÂÜ‹Ï^3ø«gUó7Ü÷Ñ°gÿŽó‡Þ£Íê#{ûŸ?²×ûñØÏ«¸àõž€y@íÐ|_õ8h_êq·ƒô|ŸOhû„¯ÿ©ÇÉ=dî‡ìßÛ¿ÓòwïÌÿ˜Û§žÆÿz~”†£æ{ÔùQ>Õãücjùÿ˜9®÷q}NøüBÍxÿƒOÿäÓIû}Ò÷“ò¾¤å+º¾¢ñk}OÁù—oyÿYžVšÖïÕýp&ìÝÿ®Q¸L<¢(Yì Q¬Høµþïób½.>¢_áwI¼ð¼sšø4D—êùë¼ué+âD–ßežßŸ..]à^æ{WgîoQWZºêÕ7w¹¨.ÝÖ†èòTQ"pºÿËW‹Í‚Ý—„¨Ozàß·+…ž=ôï¡Ï6‚ÆžÅ(1NàØ×^¸õ­üÞÎ~Ó>D}äöqv¯ø8D}å÷Õ»Ÿÿ¯Äá*ùýÍ¢?ì«=û}šÓ@¼òêZÜ®3‹ë=ÔVðp0N¿Uƒü8þÆÑz㜠Ñ(=C[Äv¡ïPøñ0Ì#‘‡I0“a S;ÌYŠïÃy3ÜÜSõL…9’†Q°nÆß]+º•ÿîZÑ­|¸•i|Hs–Ƈ4ZÓà¦ñ!if’¦Wžiz¥›u:Žéú¤Ó–?Ý¥ó6]Ït=ÓõÌÐ3CÏ =3ôÌÐ3CÏ =3ôÌÐ3ƒ‡f™ÙIÈË”—)/S^¦¼Ly™ò2agÂ΂;Ë^eÑ›eæYò²ìA–ÝÈâq–~ÙôgÓ˜mÙò²ù•mþÙ8fãèeë—c¦9òrìPܸ9úåÀÍ›7G^.Ü\¸¹psõË…›+/W^®¼\y¹òòäåÉËãMoòxã^åÁÍ3÷<¸y'B”oùæŸï]Ë÷nä›Y¾yç{Oóiɧ%ß, xX ¯@¿ïM½)ЯÀ;_`' Z…¼B»PÈÃÂþ‚–Bs/ıÐûPh íN¡¼"¸E½…œ"˜Ez9/r^ä¼ÿb=ŠqrOŠÕãSl¦ÅÞéÑæ9š£y5ZíhúGã0š¦1¼c†cðt§Æà8†7cô-[·n ܵ%pKà–8/u^ê¼ÔüKá–ò¶”¾R¾–ÑVF[^ex•©/S_¦™þegrx?÷±¼Ë«±òÆâ8–ïãÔ–ëQî¬÷rÏËñ+W_£ÿr*äTÈ­p^Aóx³ï½ï·gåN”[Ic%ž•ò*õ©ÄµÒO²G“Î|òé÷¼˜l÷¦˜ÁN¡uŠùO3ïi¸M£ašyO3ïi°nóì6VÑà>¹GUúWé_¿ÊïA•¨²ßUö»Ú~Wó£zêBn5O«ùQcwÜ™£ø5<º¿·Ó1ÿéÞZŸµæê>¹ûF³ìë,|Ýo£Y0êxUçY®îºQ>uü¬ãC.î¾Qœz³«·õøÔÓRo&õö¼Þo€ûpÔ€kìsi ³®8 ÞG÷㨶œpœ×ßAËðæʧöòçãÕèÿF3iÄ£N#?šèl2Û&Z›œ79orÞä¼éÌ9-wÑq7¼»Íy!òþòîU{¯ç‹Ìk¼ÅøÝçü>üïÇk‰x—hYêl)–Ê[ª¿{jô'\—y¾ÌùC΂·Ün,·ËéYAû ù+xõ0nÛGøý=Á|̳fõÍj›Í¦YÍãð÷ó8/]¢•¸¯„·Ò^­òþ¬âÃ*xO˜Ïpž éI{õ$î¯Ñjs]m¯žRûœ§ìÕÓz<ë3¸=£ï¼Ö8sŸžõÛø,½ÏÁ|Îçóæô¼¹¬Ås-îkét¿Ö™ù <~Á®¼ˆû‹ðÖ›ýzþ¬·G/éý’9¾lÜm£Wð{EM }-t½j^Åõ5¾o0¯ 泑þøýÙ<^×ëux›ôÞ¤f›èÙì÷o³ß³Í<Ø›-xoÁi+¾[á½ç œ¶Ñ´Mý6>½©ï›jß’óì·Õ¼ g;®ïèñŽßwÍÞý5zÏî¾çsw˜ß_xú¾ú÷ñûÏÎ|ªmÅ£•ÆV³j5«V}w굓_;õßÉ×ôí’· î.þì²Ï»Ìj·g»Í`7ÜÝžíÖoÞ{øºGÞ{±Ç³½òöÒ¾—Gšã!|óå0n‡ùwÏÃæx÷#fq„Þ#þwŽÚ£æ~¯cfwLíg¼üLÎgæà.}ŽÃ縎çq¾—sœÏÇõp¥ŒNÀ9ãüþïøþOÜNês’ÿ_:ÿRîW¸|-ÿk¾–sŠÞSò¿áÍ7°¾åé·~?¿¥õ;:¾ƒù^§ùuZÓêOóõ{œ¾Wó½½ûîôp¯¹×ÆÂÊ‹z‹!k ±³æ„X›Ô;»cˆµ]bç¬ ±s…X»¸;oœø4ÄÎßbÈqwµ/ ± ;‹©bsˆuP×Á³NóB¬ó¾»t[ˆõ€ÕSß^%ÿŠ>ÿ?F =ûèÓVŸ5B~ýûœ ±+Ú‰îv_ßûêÑOÿ~‡Ø•µ!výa÷×ój}Èp:Ä®;°H<b×ö´]§öú¬sŒ ‚;Øç`xƒqþm{ã zÄù?NÍýE²Èž Y/¶ ý‡ ±¡Aà3îP ¥yh«8$N…X<ŒøN‚¿ñ4ÄÃÇ+~’À'~ÉÂ,âaÄó ~Ð'ž mœ8 |KÀ)V‚Ù$Ò—/hKœ ø’Ø$–‰ÕÂLqNÄ9ÑìñJÂ+ ¯$¼’ðNâc$³HZ(ø‘ÄŸ¤b‡ ?‰æ$þ&›E2ß“Õ$ã‘Ìçd\‡é;l‘ !Ån¥ð3…Άû8.©wöì™™d&!Ë„™L&I!„!„°/¢ ˆ ‹²‰Š¨¸ï¢‚[w­Õ{'C[-"u­]­mikûÚömk›öõg­mÕ*“ÿ9ç¹3™¨}ß·¿ßçóI&O.÷>ÏyÎsÎ÷¬WÐ ssˆ{´¥‚F0ÕBp\…XV«lÚ¹.–­áŸÊcY }Ê”[Ì #By•©A6IJŒ™\“…ÓY­YÃÅZ§âc Y‰~ ûBö†lÄ,,†_IN¥~e§_eJíx¯R#ÜËîTôð ‘ßAW}ZÊjè³2‰5(’Oreýášh]?-G$Ù™”òÉ¥ØÜétËd·ÔÔÝAwk["îóèÌ£E’©.–l ‡à£«µ ÇCsÅ&g®”ÉÎ\÷вÐPksŸÎáqèÚ¦ W4•¸g{*=žÊܺ=ÿ¼¶Uç<óU·§ûü)†&‹ÍfY¤ ÖÏ´Ûr#UO•WQè{Wø‹x(g²£`…•5PÅSkqEç•Mñ³Ž‹eT¶Ä³eT±ÁâÌÉ5¢ÑDX› 5’K6ÚÚÔ)kšpGÛœÖÖ9-y.«™›LÎMŠ¯äæ4‡©ìûìEñmÚ¿.¶DY­Q0…8“1Ys:+Z' ˆNÅDÖÓOŠ žm†L›N @DxþúPù®×qíßÎý‘r¤çœÍ5B™P%2%°VÙ“ËbŠË—H(‚nTq–Çã²&¦Ø+a@kUŒÖx<£ÕÀwkõ°Çf˜OuL.=­0]<®øp þ¿S©2yãY§CðÁÌ,nu:R-&W&” ÌÕ_ ”ѧå I6ðù¦ÂÑD*a ¿þ0ý §ào2\ ¿;¹Q³Ü½•Ô}WóŒf‰û†?}Cü.{f1s|W÷=VùÛ½Â{»ûQøo÷oa‰BÃØjqP³L(Bp2¥¸RBÑèFåpʧR ‹óZG‰Ó+ °H–V¼µ°1;lŒ¢Áu iÙ!}•é]ÞÊj:ðkCE:-[%ÙÜ2ùüÉfÖÚ–J&¼>¿!õVÂ!0xÃ0êòÀ/õî¶dk$Ú00sÁ«7Ÿµà¶…ó’koX¿õà‚¾‹.ó×Vl=+Ú6Y§þõšsŽœo>|§yæ‚FÝÓá5O]×*Š­Aé].`ï­šäžÐ ±±?ˆ_#þwg„…—…LÐK©Òf4@Ù”PÜúÑlØ_f²5(aøè0ÐG‡~”É51™ÎÚ8sÚœŠÌ©ã?霊~ªà?U8‘²%œq‘^6&¹2¢Á˜H’lIË:—¢Ñ§ÓJ…Hã+ƒñ $›Òr‰+ã7—¦‘’Ue@IcZK#ž@‰Ȩ¸pø­Ž!M5¼¼°p3?=¾x[k$”kSŽ-¹máÂ; ìÒ+r«{=q—”üÁÂç.|¾ª|nYÙ<ö››–,¾iqîRñùð™éâ¦ùu‘Eá3oÞ´dÑÍ‹^¬‹,¬Á3•û?âÇâ«B…P+U)ÔfLÈXÃhÖSƒ´’}‰¬Ç DQÎFPÎ*Up.HDºè¼ÈUN%4 ØG32bÀkjP¢0T¥ƒ‹iÙ%Éei9äÊ8J«‘dI±Y‘$A$I -×HÈb ¡˜FV“miÙä’­@ŽTk*I¶¥ÚRqd,§_"è KvVÝÌ ©d8”|òjV9ýw5X9µgéLÖ7·þŠÜ_¯šöÔÒGÖýò½µÚªÝ±È0«i˜ÓÔ0XŸû(29µö²óºÊ€²Œ SØ)áCñïp BFТÕ¢øRD”:֠ʨ)'7‹Ï}‡þMçØZvB³B°2ÙŽ ¥L£Šƒ.os¶¥üvæõT2˜yçÁVž··uí야ÀÚßß²pÛóû]uÅÐÂ-üùup¯G‹ï¥=­X ÷òw‰x~R•Ì©7ÔÍ^Ûº÷¼•<øÀÜ¡+®Z´ïùm ·¼ŸûÖû[à>iaƒ¸Jt vA2×áˆ)N¾€”?š0¤ü¿!jˆ¦Òчƒß®z¸îÁ½—mÞpé.Ö½Ú]wwï/ß2ÿÐ5ó/„{M¦‹Ãâd8aè™eCBaFØýxF`¸ÓŠ&àG¦1‘Αͧe1®˜¬£²6ž1™ñw&\f6áG³`ÂビY‘LøSÞ0H‰i'ïd§Nþdï‰lß7¾ÁiÛÆRÂ÷+p(“m´Fç¨bÆB5¥0+)*’ÄãáEÅÛ9¥mÖÆ>OÅ‚oÿ¨²£©««¹<•z€Ów–ð‰x‚í‚ýuãZp!¸ÃêÖ¦’Aï,ñâOöíÃk§½Ë*àÙˆJ šÕ„GÀHJUÑÁDL|“Õ£9­{UOϪÉ+{zVöÐó"c·Šoj&ÃóºPL2‹CÁñ rÚJåH)S4Bók‚"hš_c ñ³Èš_ƒßŠLîKQ§ì;ó­”æüô'÷¨+¦ýY¿st~á*>OÅbä²OqG³~·AÒÎ+ s’N#Q§xA/x„ ~€YE 5ÅìqfCqfE ë$p‚âGÀ ˜tV`7ü 5ÚP€ÃWûœúj—Ä”s\lM;Ân½ûHn[Ùð3 †¿^iDÚŸbË^~1÷ØËì½\îâ‹™xqî¿R‘H*B´›j6`³°_Èèq]`;M<Ã`i#f=Cõf!b"ŽM£‘ØKÔ¡‰é@é+Öq2›9™ÍDÚgËýÊ Þ³Nœ2;¥•ÍNÙtJ”MÍLfÍ*Ýݵ )á &’a³Ýx(gýñ ±éÚ3/îÙÃXóŒÁ<ïê ÎÓœ§¿‰îÉ®ÓY=ÉÉŒKÓrÙ`Z˜´Þ%¡„³ >ØAüI½Ó‡òQƒßÅâ~àk;3 Ád—Ø âÏ«¿úO3/i½ç!v0âU_]Ø?cwZJw•µìOoºrÍÞm»¯>kQKÒ±iì]ñ‹0¿°CÈq~˜ŸççÔfͦ øÃlq½Æ¹$ÁäpLÖŸV*죲„¼R"¨§k‡Y–! r@`’†ÀŒÃ(âAf;i!^IvsPˆƒÖo`©j-˜{´-áÃhUáPÓò¾ƒCçÈ«Ëzú/š±}á‚5?x¡«ü–‡§_³ëÍ¥ {ÚZÎß[ØÔ±h5[V7yÿ$ß]S×´ãºÚ€îWúìÂ…œîÖ”´64–‘!¾ŒVÈÃ?‚²ý4ˆ.Å¢ÉÏXþw[P‚ÙѪ趃h’-` ÀÁГÄT,zX«­¡œpû5ù¼ ”[Ѷßÿͳ®C3gÞÍn?Ÿ}/žÛù裻n¿=OûÛ€‡K„…Li¨”Ã6Ô®.cÀ ´wF3F>ÞhÁY–ÆdËiD¢^à'ÍË ƒxT‡Ö>ª”Áw'¡vf pÐKp%?~ôº» O©6ÀwÉ(e˜Ç‹LårÝ‚»RÉpW`7°•·-PÍÎB‘¦Us®?÷¦î®¢Ç•;5çðòÖÞëß¾véÂêÐŒ¶Ý~vÑö»ü©ó®ß6-E˜d¤x;ñ~•°MÈxp…¥°-®Ð+´Uz´°B›a”€7œU?0•…w9šUÀYˆ¬Ëý¦L6SŠ‘¤L%ÀÎŒSpÐF ð€!-k%áp4Z€V é `tÑ Â¡H*¿¶i÷Ì¿~swGÝ}ÛŒ+/ï_ÖÚµk«ràa±û¦é-aéÖÆYÓ9åΚֶñ¦3ž¹æ‚uýÝûiÏþ"n=ÓÉÉh‘¯Pà 710n#H|… Ä0P,ÊšÄîÜ'Øj±k÷g‰‰U ›[6G6~!² d˜©SÔ1ãý&!IH LÀlxÎÂðÐxÄíNÙ…Ãð¹Ì U#‚,΀!e_Z®sxËJ«QÛ+$Ù¥“RÁl®êZ.“”7ƒ! ô‚£˜œŽŠ d3‹êŸw1@•­½í•]'žë¨ˆ·ê¸ü—¬›wÇœúë*úçÇ£_±}yixVº½qcK&mè«îÝ›ZÝžº¯)™œÓPåšÄªæµx-}ÍÈícÿ)>4pþ^)p¶({ÅS,ðÍS|H†J"ƒô’Û©øÑ(¯‚ïnTFf ì¿_R´d‹øœhw 6*—2‚ž¥Ó„—»˜ÝN’Ñ.–Ò‡%!*ì`ÍÀí=·n~âÊï}'xÏÂkwIÝ3ëš~oÇÔëÙ7lŸvW_TuaÕ†i¶iOG{~ö¢&˜{÷ØïYHŒnm2@QY‡Q0kÉí ¡O —7°£²5Žjµˆê÷O_=ƒ¾Ö.ïî^ÞÍ]>}úòi‚jÇÏd-bpŽôIƉÏò¨Oð"ê‘mq>²GÇÆ¿Æ>ùçu¤“37ôzÊwÌZßÛ»î¯U¦¦Lm(iŸ|¯Ø³°«kQéØ.Á!îׯ îd­ßÆ ]ìï}¹ÅìËýŒmËÉg·Óüú…ÛÄ=ì-²ñKóȉ€j8ÀC¦€ª…¿ýbË™×Å–Û.¹ä‡û÷ãsâðœ-ü9©&–ÒyuqöDnIû{ÎzÉóÏìø뎿ÒsêàÌÔ¿”ÂÙÛ"dBˆº*¹?…»ÀÇr*?­v-˜¹ÕåF8- ®«ŠÏÒ *ZRWv°¬¾*z•Áž}5œ ðP ‹ÞŽ&™,J\Ï‚!­¤7ØY ÃaQumÀÔ­:¶¬sGÜjë¸5áí®KÕÌé,íœ3½{®¸r³¿á¼Ù®@YS·ta‹§¡*^Ù™óÏ…3jJh{ìÔWÁ>m¾(8È B%ð’3–òOf´§ÊøçÆXÖKŸ˜Ü“ݧ•ZXa­S©Çóo!)Q9îG‰Áh- 09œ–ë%ÅéEûÊ5bÖØ‚´nX.Ø¡‚-C°Ü(¸ÜzU]ø+ÉVU„pšCŽD\•Ñ0ÉTtjù%8Q #ðD\(9À( é[z¼ðÕ£e3¿0Õ u­˜»zð‚›6 •w”>²ñœêÅ5ú²¾FqaGûO¿uè±eó:ë[÷ÿáæÆÜÛšÛ¶ÿö¦9«rÿuíÔºª_˜ªN 44òg™…F°ÀÐó¡IpÅ®7  Ø=ÊaK Q€d£êªJ¸ƒîp4hë¬ùlÒÛr[îõ¶Uÿ¹]<~fî]w1+K^î‡ÍxîoU)œ+dìŒÃdÎ^•€‡ü>;>Ær©Š4–4–?.;œ Ž€”*C©¬U2Š›ô ™Ä^ ªÐ¯tÉ:œ˜D´Ô*ÁÔ‡£„‚XRýÞÿáã·÷§zÎÿ³ç®X²fù¢u‹ûÎ/\=uÀn™7páª=‘ó·F×â9JÁùx›ôíL!ãƹیymk1¸µŠý4m˜(bLA±!gHiÙòÒìžW´&òcqJ&5YÔ°£~}8¤¾²âû›‡†Þ¼òŠm}«#sV½|Ë’ÇÙÙnˆDÖ$öüõâêʳWOZ(¨²AeÚ3‡Ð®Z FJQî–“æc2¸odk œÊKÅdr‘>N¤Kö¿¾•[jݾ{϶Vñø/åؽ±³ø¼5ð< XsÄ!Š žF:Z û§3 öO‡ûgåÖ›¡„M€°À6åö¨j„&ñ?ýb‰”»õæN°‹Åã?ºCÙ¥>s<Óv=süyF=ψ 5ÎóD“jü*–‰“úÅrg{ôµ]¹w¸Š{ü*ìq‰p¥ñãúìyþ„=κÜ~‘cƽ_4r¸Oµ_Z„X½&2Ï^BŽnx4ÁE+B,ÑBÏ‹JP쀺d/wkZvXÔ#ÐkJÝ·3ˆ ‚‡ “:Z¢AI8‹Ý²qcã’à̶íÎÙÔ7õÊkÛñäéûØ*vASýòŠÒݹ3[½÷ïÈ=ÖG¶<ÒðFÚ·iêÉ6$ˆŒ².žv¤¢ÆXØ5 PQŒ#Äô$Lß/þ' úú䡇>çþÁÌg沚Ü/ÉoÏòOàÔW¦xF§áÀ?=H¤íÊ[‹ÈúxÞŒDSž«> Àp}N oç½÷²7ï½w/{iÏž\Ç^¸ËØ{âeð<'hT.Sç“͈K’Èž‚%eôçõFØž­=ÑÉ´P‘¹L%R¹¥«fø– ¹WØ[·ŸI®¸Ä>Ä‚"Âp‰ÿDK¸ÃÐT)MXãó4‘ïìÜúZôV«hÖ]üì~»h.éf§`©õ¾eg·æXvçªdîMu½Ã|mÂYBÆ„óÔùê䇃ùÚ@íÚœè´Q rÉáÔ_±þîg4uLÝ|JÑ8>ÒÉâ) ØÈfœº¨1™Õ©sZ¹#Id]æóJýÿç“À ¿Ï}ºýäèµÌtf®ØôÕ¹i_Sc?P}; >dzCruÜc—«ã>Eg“\ªÏÆa÷3ÖM“šàžùŒcF峇I:á3—‚bÞ‹`4“r&)(¤ 9^<3âw§™ Â.m^î{ô Ì ÐMÐÿ÷×ï¹#»c|b±x|ûÛ»ÿÀÎÚµE¥ÇBñ ½€ W¨Ú¯D§Ò£Z†ð`ÐÃGñz*AŸÀ}ÐèÇre4 9äKP9‚MY ] ôÓ „HþÚh$ì ‡Âd)%8ø ÙYêz¶íºÛU~(P’xTd챃Oô.êè.+빸§Œ­øò §žcï_ÐœÍd'¾rpGb£¼1žØX8¯ß:"Ö_9~^‰” ¥ÅF¤´ órѤ´ÅQºKê¢Ð¬„}Ð)g0áRl¾TŒ< p*Â%,7þþÚÍ—ö73W/Y¶@<~þ7Æs¿d¦Ül_üüf˜M3蟷È_´«È_dWýY#RÐŽJ'Œ>Š<­Ñ+Q‘§5Ì0šä¸Æhw—"•+Ð’/#’çG’4Â̾ ü­‡€“]R½>šm´™‘Y‡Ú'¤':‚(¤Í ×=0xöÐæSçÍ<°åWgÏ«Ý{Ýpdɲ»öô^åG Wõ5 6øj×Ý´ªeÅòŠŠpÐWYêª^¿búºÊj ÿÓ„W¦p¿¢jß“s‘• ªÜetä«ÓÏèu$µ™©AµtÀî7 úi/wþçCbê²Ëμ&¦Hvvý¾D²/%d$ÕoÉű¥ ü@|ʧbÆ8’ä bÖLC3 ¬ø E÷jt?ìíÜÑå}xʞ˾rÕÙ÷rÛf Õ×Í`·æýÛ»qìÐ 7M¾‹ º6 („w]z: È‘É ¯Ýôá©Üßô1yf.Ýg2Ðè%âш±ª*äå¡-†x¸•ÅŒ9¿ü¯ [Xxò=)/&C·,xb`ÑSpߟ²Ÿç¢b=Þ¿äœtÿF¸ÿ?H?G&žÒXÖ)]îŸpkþ*- küÁ©gïûÒÈK?Q¾–eÛØÌ·Þʽ»Žsh0îm†¸ÔT÷W“€[›b²‘vIòûÛ“þcÉo¡Y+OéæúÈm ß09QUgŠ´è­£²Þ™5ðybÀÐùy*“‚Í÷ßÏZsßÕ‰¯ìúdß»Mtˆß×  Ï°AÔÐöëŸýúÉî¬3÷⫯Â5sÆ:4µc_ãñ M …@Q<È(}Žø‹3µ³/Á3ÁÖ³ÛÄ›áZÁÒ&2WŠýñ‘g¶‘nzW¼U¬pî®âž^Ù@WWÆ*òUe5ÕèìÍjôB;šõ!RÞ% JÈ–G¨é°Ž*aXo †–MæBõJ)c°hw V”òüRp‘?´"!Å€þ “ãÕÔ©”y‚îöê æ¡€€ùÙÀ2ëÙ&p0 φz˜œ7–•ÔÉù(£¨”Ñš Iy&§ìF×·Ã)`zŽXÖMŸ(äÖÂÔСú¸-Õ–¤Éa8<ï—.î»ûvtÑnûMÿ‚drx½»¼ãzæßœ»fûáå%škæ% Õîz Î8úIšŠPg~W ž÷”(¢N÷⮹k`Iõ31ýÃ#ßÌ‚‚9cbá¿ü9÷³|œw@|hЫžV˜&A+Γ­tߌ•r÷¬Hw,NÃM8`3—B^jÀQ¸a ©ÔÄÖÖFk»²JÜ·ùÌ7§:7…/XÞÇç¢2yäpJaâ ›7‘È0Q]f¿•ÂL\q ²Áê*àÜWðìX/Ïló:)ä…Ü*¸JQ¼>Œ³é0ÿî†X): in\ú1&0‘™óßû.2O_Úíno»Öé›T¿MòMª݉™Ó¦Í]ÛÍvWø¹½ê·ü:VÀ:$a`ü¼Vñéóö©Ã¦*ÁñCÇìjtVeÑ û®·œ{ýÌyü¼¹;ç/š §mY<Ò™»)¯—Â<Ð62ÆÝ\{t‹ÜŽ™NôhœAXc¸÷ߪXŸ¦P5î¬Ç ²ÔhÒiÕÝŽ‚/‘|_ê’ÐQ_wmî+×>8óŽ™3ï`æL_øHÿÇÓ󇞚ÏåÀ,Ð anN¡qW.¨ˆV„»ü8Kîv"­(Õ«N”üÀ*fðæq—MÅ]n Õ­÷ZfÐ,Â]Q¯äS³8fÝh¨ß9uçê–U‹.š=ùPoGÇ@ê-ñ½©ÑÈ× _1;õ>;;6ÿøì.AõÝ„Ä0w;Ç;4wæâÜQPp ûÇñ]´Ï²'N[˜ÁSµ!&P´VNdôcÛT¼ã¢$?y ù$r!¤R4©Wý8wÿb<Щ¿þØà_Î~°«c µ¥çZÂ; gÒ?»îºú¬ÙˆvxœTÏà á.-’ÀîxÆŒ‘Z;å…¤1‰9Án8ðnÀn/¨hÑ]äUÆ@7œº¬Í,xò’…°Þ?pȽNŒ)‘—K ÝÑ¡cÄ¡*—4ê¹2Ò¹² ã `Ê«N´ÅÐŒ–Y¤çXýÀÜÀ±ë ÕWÝ>ïNvyîpmUU»øÌ;]‘ú¥¿É¯a>Eþñðï4¾tÁ³¹ÓÏŠîÜyìè™w þ¸ÏDÿŽø¿õïÜjÏÆknxª¯ÿ ¸ïÛ’»ƒÉgÞaës÷Òý›àþ§àþý;âç߉¢Ç€fzÓ7ž8qàùØ3#_¸‡ù?yâ‰ä~ Ö:÷Å·iÞ˜ëˆHÃhà[‘4ÚD¢0yt±¼øúŸ:U׎]¶¢kÇM®g§~ùoò¼?M³ÂD#Œé­~©;%dDƒ_˜¨ÑÒç|èA€§ñ†‚F¥ŠF¯Ãœ“póÉ{ûÚ÷7æ^v m­² ³§Î¼óCû6sK’r‹I†¸?íÂ3(ê&ø†&}ñõ|C–ÿoh ʽaÃŽm¬q÷…¹ïáç)=v{RÓ/Ô ž~dª@ùÑBl}L®9-ëã”od‹gj*P`Õ ÀªpÊ´¢`*DÉý°"ªÈ¢”ìD§òhÄýB5ìn &MÔòbŽ ¢w/%ãÉ(æ¬$¼èÖ­b…ø¸ƒÁÏ>†ßNc­é;šK.72[0´hPt°¦Éöi¬òÀâûæá™[KÊuº;MΞkwÁs§NWVºµoØìûÂbÕ'v·ð–f`>@ŽPW>—Ô›4÷Žš;>Q󯛀N_:E…Kž"é3àŠIäTÅ”J¤S%ä¸ãJ Ù³™u5X¤qÊF “lO(A PyÜo`vqxÁâAÑÎÎ:°O8|8 ÝY岸L@–¤J•p¸Ö©Â{ tÚd **GÜF»QÂúb¨•Å ÊH€Ã°šŒ¥¦ˆTŠyû»YD0µfáªöá…“C³ê–…­jZ/¨gÎ9‹ª&{£ó†+ãžAÊLï‹Õlôj.Y‹•,ùb%“kpÆ‹•LEÅJã¥wÂ=-9·µunÌ{™˜ÓÖ6'yæì¹Ü ¾·SÇÎ{Å, §5¹d³^¤ä‹a^—QËCéì4zä1ÒË—5qŠqèâ|~‰«>Aq %®ü°¢€i̇ăeRQˆæ´Zbƒ^Ñ Hžá„S,ÑH®ãL«7ø(͵B1z¼&üèp7[lN—›ê×ʼxÀ\·Y%hD‡?š\ǵ:ƒÙj£è4iMESþ6€‡~ƒÏƒ`NòÜ&æñ¡ÊÊ¡þ¡i?èꬮìêþ~÷к[ç̹õæñ&ÍZPQ14k~òêäü¾Áòò!Ö{Á”)LáüV þ¾xÖºKÈ8 ±m"+¹ì™9¡Hzô e½>Ð'/ 㔩ï ƒy &Øoe'[Ñg”¶ì¸P)QSݨp䮯ð“”)Q9‰; ëOÖÞñÌ÷.Ïf³ÇFFF.ç~Ë*r_îÞ³¾À>͹ù3’›˜ïG~x»¨5芢 IgÞqÇÙæÜb¿ªucOŠsw„6áaê1ìP%Œ»"ÜÔ‡[‹ªÅ ǬѩÄ)„ˆQE¹‡#0‰)¥ŽQ¥~E9ØÕ˜¿–ƒ“Ðîte õIü‘2¶Ê0~ŠƒÉånÁO¥RÆc!?ºCêp%¿M:.ZJƒ-Iä #O"󌪌 EF~E ”æOŠ“QŒL¦0Ésg§OaÛ¦(ëRk[ÛmëÍß~QǺ›${W´O³–Ü<<÷úà¢ÕõÁ¥gEYb ÑÜ{^·²tU¤$jñTfuÎ7öWçi_ÓP±øË}‹|e%¾Úxi©·’h9]¼T,ÓTP.@+ÕXÚ(6ÝZ^ÓH™Y¯ÅâA¬'Bò|ÔBñ˜ú}zË̾¾™ïÎêm‰ÍŸœÑÜ<#£¯åÉu«4¥â ¡½  o2Z-f¤òúÛJrïë1‹7ëàŹ !Cz®Q~šóò3[Ís5·• æQRÕ˜í­1G)%]úšIëð””ÕFèô†¢ð;ÉVËc_à¸3y nS‰+ã²–~ó9ë.O­-óVÀî>éè»ïÓ}}'ÿyŸýà£Çî»ï@ûê gÎn\Ú¶>›1ô:›sâȲeGNܽt)Û4zÇ£wæŽ>³©¥Ã—œ²¥¬#_ˆÛf-B¹P#ᕧ”ånE¢)M3ë¯*±Â–Y¿^h€%»âYMÇ R¦–(Sa%ïKõx¸'‚.0ó²F³¥„¬«j0öüîÉX)ÊHÁ¯ê`9D¶„ýR`W¨!W¾fC> ùTû*˜ãæQ`[ ¢C•Èé§ì¸g~êî™Á•Ìµ²²²1ퟷQ/;“»ñ–É-ƒ=ìÒ+­¡ÿŠªyEMËt¥e¹×7of§±iåÀ‡]‚ò»ì XY#ç–î´š C¡@½Ã:=¯±y½ì'7"–µËz§,œ攵§@HiÈÒW5<˜JREšú­ëÅëžzêºsþºrçΕï¬ûEúÇ?Iÿ’ã²µW8_f—:¡%Ÿœ¯FÓšxŽسËh¾ø=n†|äLè^Ñ~‰{sïÍ×…±çÿûº0¶‡ê´ “¬)§³QÖM“ð¨z:üü(À¡pòO5±l?15u„à ¯KãrS,[®­7Ÿ,K˜…5xžâ™iéH%ü›ˆSñ¨§3}#è†3kÒ˜é‘5iý¡ItpjÀà1ØT‚r$Ór“+«gk%©»‰GD[!™ÄxUº? {“<'ÝWîÔ¬Y§rwiË»Þôx{ûã›îZ¶î“©ñÛ¾pQCÃÚuõìž#—õ÷_vd?/j^ÇÚκèìÔyï²òeåuæ]6|©¶÷J¼íÇÆik(¦-Pô²¸xû–-Wb²Óâ‡`o— ÿèZ¢R@{,륓¥z·²n.ZxÅ@ÖbFaH(Íø%cÀjÌï01[ŠüoSÐwâã½à„k+m»œ‰ì@¢´4yŶҭ‰³‰sÄÁÖÈÐPdCtÁ‚èÒY ³&¡n¤ÜÂfX‘d!»P“- òû‚¾ÖÜÒÚniÍ*Ð"9m' £0ÆxÆFŠÜ¦¡ÒôŒÝV(AÒæ xx±HRÕá3Ù¹æG¯zôÑ«öìa¥{î»oÏ Ý˦ ?:5ºsÇÎÏ8ö K2/­ÛŠcX×(neK53xÛo˜öf×;âóWí^Íí¥°¸lÔrá|^¯ ƒ×¸¤‚ŸQ¶‚™]Aœ‹¾òr+y>,¼hCÙJ9£’^Å‚ai¯/©=Šä¦ò Tàåèž#ôÌ1pc¢%'—ˆ§ŽD+Y›{Lkìç´³ÞlÔ–/YÝèq¹þCüKîÉ¥I–få_~®=ØX[ï)¯›Ö´‚Ö—„5ÜF¹+}`ë <÷R ŒÈy6¬Nå6…3ËxF‹ažf1é,£Ü÷a4c–¡Žëš¶DPBï¶AŠ$îcç\µÿªM슓»>ÙkÑD?ù…½mâr©GøXø{ôtåË&_1êÈWŒæõqOK_<ÞÇZæ$“s’jÞB[ø* X^¢AHÃÜ_ò5™N+fóèˆÎl26dí£·IgBè$—–Ȩ(«½¤èqò«1óp*A•ùáP[M¨²­±Å¾,Þ:Ü3ã³¥*·ý@·¾uU7ðÎ2à—¹â~àµcaâÐN~zŒ[cµýÕ7'aÅU^¼µùZ|S Ê èy€M<Ô‚@1ƒÞÃô< ø+N)!¿6»±IÕƒ™'¸Í}ê©PцڷO9G£91¥¬,ýÜÑÝQ›;ص¿ëCÑwc{ÛÚzeë–Ks 7o=½½W –jöи³qf˜ ÃlÔa×a±×~²…ë0Ø÷§@VËVÐaF+ê0üªê°i ¬ ¯AýÖ ºë½÷¾z쥗æüäÇé_¬ûeš£ó gLÐŽ‰YgH·ù]ÁÖšÙ¯¨½ž Ðï+Æÿ—âߟËVÒïçÑßo Lü÷½„›ÆBbØÙXKs¡ñ£·ÌÒ)SKjÔ„Iµå† Ê-€Í£#f*ª1À1p»»&7Ð¥³Ar}Õîò«U5‚âR³ÈCRF0zhÇüXjÖÅ:Y³]$§;/-È3~S‹'”J`!MESM_ûºUw vn?цV{ÛìW ¢%â .jv7UÆ+;æmö7ˆådÑsÚÈÓœ«yÆj:§¨{ñÒÏ?1aüiu\£;%,?\¸þÕ ×-ŒsÂø[…ñW.å¶æ~2Ç!¸„˹GU‰Úµ<¯%(P ¨Ðî´b~§Ý€µ ô‘jÜ1TòÈn¿x÷NÕo)»šeÁ @ñ#ÌžaðÍá±;\î†'~Õ˜Ýát|”•ÂÂ~Ðð7 cILË×ÙŸ\_ Ýwm͹Ô¾1iæ±yâñ å­Ï\xä3±.^wû'Õ–Ôb7¬f0——È%1¥B_¨2‰ªL¢(0+J€ J±*‘·¾°ý5'/ú³¸}E ì«O•  ?vûŽoÏi‹7Ïïé—¸áSÅ(‹ÕÖUÍÝ•$ÁÖ{žÅ½ý&–/Ô}ƒxäo|?=~bÂøÓ…ñS-ŒS½D>û-ݧñ»tÿ7>üÄ„ñ§ ã§~6>þwº?ÿ朧âj.!âÌM MXˆÍˆjW|þø ¿Æ€f8¾˜ÆOÝ€ã7Àø\¸?Ž/¢ñWáøm0¾h‰ã+hü›7òxÇFÑÏÎ-’Îj÷‹É_¼ô¾û–Ò×S;wâúÊuÝØâi ÆüÊ…°pZ×Q`¨"ÎñD™ý¿ÔDF-löó6(û(¶ˆÁÃ<å¾·çÐa.i¶ËSJØû‘N®@_~ Œ¾ü@IEX=»ŠwõˆÒ½]Ò ’·¸·ˆQAwZ.“„³hy¾z‚Xj¦ öôÀž(~7Änî°h¿õùšú†+BSºn}¾¶~~x ül¥ke³«ì¬¡[ùø‹º5Á­_ÚÌ?4}é3SØcÚœO{q.…û9ö®øñt;£]kP÷ùSã'&Œ?]?+?Zÿ¦zýZ ø!ºOG åó áÖB®üctÜØ]¡Py•5[©^´4n^:„1O¾tH­q*ʳ¹ÙÜj¦ yEãVe¶vÈ JòþþÑ›ŸÙ¹vɲ•+WˆÇ·íÝuÑŸS{Ú0OæÿàŸ:á êl¨ ÁoäH©5ŒªÈ”:Ó¨\çÄ”Š¬•'¶X9ú‘ì£#F©Ð[˜*üA gô‰â'UuÀÌ KÇÝZ_¹—|V—ⱪKÐøsñžCvlÅL#Ú•k¥Œ3eh]­jE¼ˆ~*®<©^lÅÂÖÞ+õíºkõ¾–Òæ@M¯}Ûé%-CÍÉd]s¨:˜´2.º·ì®Ÿ5¯1V©žìkÿò¹U›ÕÓ›J}•±îX{8VÖÖ~æm¾iêp3ì_¯û*̨åãíØÿ@3Çq¿…]5Åã±ü8¬)º&¿[\[<^Q¸ÿ¦ ÷_S¸v5âg÷]U¬¥zÛ„ð†ªÏ*JÄ@!»H¦MÖÀçäx¶Ù¶5ØnvÊt=6 ß¦•ìœ€B5NE gº®å–§?—¢EžõpžÄè#{“ÜZiÄ`¡[KnÆòê{“”2,·õ¸2._9Ù¨‘0fô–Ó¯ýR¦¬¦?5“§Y’=<¿ÀŒ²8ÓÅù½z,xÇDœøxJ¤žÒçB)ôEÐëS›À Šöu×u G+k&õÌØ;©ášÜëöE“;zVlj«\twëÌÎzmuÿ4VqB¬Y›÷¥åþõûR·4kÖu×–n¨žŸ^ÔèŠ7NÚ6§óiÛ3l:G1«£VÅ ¦ndk¨~½\‹è¡JõòšrZ¹=â ÛÁFPÀÍ.ìnà(ÿÈctr’²X'¦ß†à6M¤E´OÌÇí¿t^ëÚu‰å¾ºÖÆ¡ž~çž­L¿°(;·ÓXÆdã8Â}òXxì*âíþ÷ˆ·ë8ïÑ8ñ6ß5a<–gƒÆ+ ×oRÇ|ýšîÿþëtÿp;M÷ÿºÿË\‡~ ã? û¿ÿ<Ýÿ$¿ >ûÝÿý—éþ/q‘„çÞK}ó"ýÅnrX蜱k¹C>«­-E֧̕(±{9È®rjx¦øÀ¤¯SMú¬Æl±Q %(}MkrJú’Rò6ù0KEPj±¬^`>u£ô”)b4‘ùŸq¢bS3§aç"¨§p¯òª‹÷£PG8”œºöðêIñ­‹¶M©KT-_¹usÏæ]þxÙÙ·ÎëÛ‡Ž~áðöi%¥k“éæ‡iƒµd ¯­ó•ëš×ñÍëç-˜ìo@š€˜Ó$OüŠä‰–Óª™ú² ͇? šG‹Æ‰æ||ׄñX~œ NÆO¯(ÜgS”Ë¥6Á.Î/„O¨Ñæ²%–51–ï©à¦`$Yg áYãXá—•œ¡ä).ª³»y§‡‹wN“Xû©žm¢'waë@+ü?¸cpp÷î}žš7²ÿ,ø4Bjl·øñnÁîæ±**] £[ 3Ï×+;`Áæm[MT¬€ 'ýøï¦È ÈñŸR‚>9årüA9þ@y0r|,rªA<:%­ªÝLF…årJÁnÀþ”½n*$Üãb—Šrä¤:/Û㬜z ššrí—›Û¯¬K­/»ÕèHyf•Œ«4tŸùùzŠx%` »àG;r¥|^ßxαWÇxaö!P^t¾±ó–XÈ‚BõZì–b(Ò"ð(‰2³½T¨“(™g¶ú1ùs²ûúÍýÛÄÔ>ÍKRî³>“ÛWXWEa]›æóñÍÀ\ë4ûÑVîB¬÷òeÅXa¬ Ë·×ÛÖG 6úsªÎu|° ãÔpº5i4«z…€p×Ä^²-–5‘³8ëña5%¶Ïôè0cò §½2 ‘{_Ò>YH·q9±GiÀ ·Æÿ‘pŽ¸hqûñ+ð´+<}\Ô¸ÜþÀ¸á­˜ljr€,HŠ™´t‚YXO ŠW­m)µGÙ$&ο'Ö_i­l^{`õŠæñ† 3%†³ŒÓ·÷—È÷®Á>ÿÕE…áGB&Š|Ò§Ô|’¯2’+bÙ@x5[Æ ¡‰E‹Ë&Óq®³Hm*Ä£äÒøˆÏÑdäUÕ1Åg¥˜l/IŠòª£«!‚Q¹É%7`ù‰\ƒ+¥"„‡8€1ªÒJ¾jÄ2Òˆà ¹þ’%,HŒï¿­`šŸ¨´VTöì9F@úWÕL¾¶Š6¤íE³Keã…MÀgSÏþD6HDK¶ŒÊ¯:OkÚ`¼ïû\Ï¿_týÓêõèSº²èúPþzÐÿÅ×?R¸ÿ î_^¸~xÂõ™ÂýOþ‹ûÏW¯G›ûqº>J6÷É2~ÿ8\¿MüÆg}Œ÷ù»0Á˜°„×`Šn¯Éç>¿ rÈ/TãyÂÊÕŒ—q37c.Ô$USÒIµ•=‘5òàŒÎUd“ZÐFÕצxœr-ñŒ“rÉœ©pâÇ L¯ˆé•þgž964t£1xáœmk˜Þ1·=y/dZ½jŽ”^uæé¢Z¦‚gÁ¿óòߊðÉ)Ž×¶×ûƒŽ®î£b|,ྮ¤pý Å÷×Ô®Vs_ûÇ4ÔߤóF¨÷¯%1¡Å T8ù¡ÖK ÍNÊŠšŒL‚‘â1{€‚Jù¶'v¤{9ÅjÈ_'(No^å‚dãÆãx;”°~ü&[SÅÝQæß³´ºÒZÕ¸nÏvµQJÃŒÉx´¦,Œq~Òˆw’ Výš‰y¢&Ê ÊBͽ©@l7ÜYjÈl¯â}î°8{íAã5àP`”»6´0yãkf Ë…ÏAú”sG¤EÊ”T…ðŠ@¡jmÿ§ŠÇÀj(ÏT‹ÄËÈRËÈšÛŽ6TZCMç8ÿðž|1™i¨¨š,"±I½\nOék²ÞýèiÅûŸ)ìÿÉ ü2n'ÌWùeÆIre’—|'›øxà„ûèú9gŠ1(¿þHáúç&\,\¿`Âõ®a}ñõõ…ë‡ó×çNj_U¯×°õâI÷©‰÷kSZ¿ðáÿ}•šÜËö¨ x³ÿwõj#}ÕS¿»£rwLéƒoSã5ls>UÃÖ‡5lÖñ¶žþÿç*6¥§Ÿ¸ìÿ¹š-Ò:% ×ÿýº¶dxöžºæžóþú¶ûš×ì,ëk÷Ó^M¼Ö@:ãT˜G`|Šæ×0>÷-'sÌ_~H½ üÂn^))ÛxtU6$²§ {ÍzŒT6‰-¾D[ôƒ’ }@V­ž¦õÄãu.w¡_ZâµHz/hÌ‘ƒüBŒ+ðLþ„WˆKü?‘ 7§zç¡~yèwØßV­‡ÿV嬬>÷Sö·B^úåâ?„”­T¥íHçŽÚûQû &`ÇJ\ Ÿ¶¬ã^õMÚì¥5¤ý$VýØÔ8à§hœ¿Ÿ;&^jãpª©¾Ä͵ Áö~ºrª©ëؼîÖ6̘}L\°*휽jgq= ¸`<Žp¸/xõqûÿ'd‹’ýÏ¿ÄÇÍ0þ;Òoß#ýö£q¿ÃH¿½ÿ"é·ŠãG ÷îgã×ÿ˜äÉû/‘¿J• ,ùº‹–œ ùº¨|ƒªÂÌù ÕùðîÙbx̓½û ÏpqFËj¹:qÆÕþ¢T­tYG3.z Ëƒtb•çP«Ñ±ŒÏ%ªIîEñèuQl>/!M=[Üýxî¯îß7ØGCç±?­?ó÷;ž®º0´¨q{2ç;ó'A7^ñRgý&ÖŒY¡¡¨t7Ž¹45‰l ÷UÇ)´úß։ίè·7 ¯xy”“¯AÅ‘‡ª8UŨ?V–·X%åØlG1`zHu-ñ‹Eâö K¥ªb’–šg”š|SѾn±½÷Î;[çìë>5ø϶áÎÎafïnkžé¸ ·aý• ª.öµÌïf¹—ò5‰*À%Þ©{OÜIú¦éï¤WVqŸæï^"b6ç$aÕO×Øãl°QBBó_ÐvyVÜGã“`|®øŒþ'Ç$ç‘~ê£þŽîÏôBËWM¬ð-ôB3¸Ã}TÙ{üŬè>óócËý†ÏM†{¶];I±©±\GŽš¥õÁø|´«„]c~ãN˜Û šsì[|Ϋ9¾‚ñCâÛùëaÎ_¢qXªØ,~¯?4ùÆ4­ŠÇàþd·Íçv› “ÝƯ?®^¯aÃÂ-9¥pýøý‡YUîiUç=C½Í.R½KFµŸàˆÎB é`¥)Z;Ij-Ï…*ʇÁlN2;Ña¸ô¥_‘Ä’91±ÓpJfÎWIéŒ œ˜ÕÆ“wRÀI)¿Î‹íË Mkzv8÷7vÈyæífVÝÉ–ýu`ñ…¯ü}¹P\GíÅz;Š·šŠê¨}è¹ÁrPÝgœ$9œ(9¨i0¯ø@“WË‚”ÕhÃ)ýó>S~C>18Ò ŒžJ6±³ÛïVË«»Ûv‰û6ç>¨[>ç¼ÊzVÙ²Î\!žýL!ž}BÍCAù|z Þ"߀†÷À^o¡=šüOÎ×Òx#ŒÏkñú·9¬-Š—g ÷?™æ÷ Áxaþ¿$qßîéWÄO@·— ×ð]•=€Ã´ª+ˆ:Sw4zŒ©Dƒû\A=»ÊM£#ºr Àgdd1ÀeäíGײGMà³P9c:ï.,­bÔëñæ«+KˆÖ<ÕLgN¿³ÄÁÂ)÷gê®›{­ÖIƒ¾ëÍgßÒ;x,Ô0³O¼iFcC¼:0´êÌMãÅØ“£XŒvp9õ›  õè™Ø“À:…baµ#®Úš âr€Zˆå=|…&}žf»ìФÏË›ôy¼yÿ´+€n<*ŒÆëh xø n Íû<¼ ÞÖÉÆûøm¼lÇŠéÙ‘Öâ~~-kÎoZ%UÕÔúúa 9Dµî%ª|÷œB7ißxw‰‰¼).µÚ½¬È_â’hK0¹]½€Â|Ÿ©}×ô†(µN(ÔÀ¯»®o€­n\»hJhVU3/… ùÕ£=Õ•9]µ‹Y$N( ¹û‹r3^¾b<†2Vˆqlçx)ºþ¹«Çc"ÁB¬DµGÇ®†ëgjNÓõƒtýKOŽ_¿¼pýµß,úƒH}«„›ÔkvôƒRCÀ|óyƒ!ßÓÌM“ÕyV¦¢.ôJÖ@‚Z-U­e”(cÁª(«C­ŠÂ4DPŸä¤ÌìoLƒnv)ÒžœSþ²ì•šˆûƒ†°³¯ô†„7ˆˆË¥6YéÛÏôô2ó«!ýž=úÈwso÷vݵá†Ö­žÖ“ÙJ¶ÙuaÏÖ­ιPz†I¸hçŸ6·ÄÇãÙà™R¡l°çÔóP’À·ðî;UpÖ¼8ÛDQmúQ©“¦Þæ1Âòë1úã> ùZÞ÷A®cþù$Ö5óHv 6”.‡e–h¨÷~Æ §¨Þ$WFò4ã'³”1Z]Dì’¤¸|X¸^…@‰Ü2õ’bF۹Υ0J\hRs.ڜȖŸ°‡\žJ2Søž¨ŽG­Wîž3ÓÝôΠ&÷ ë‚ú†Ž‹Ï‹»gÎÚ]'E‚¢X骭[ËLZÕ|³ÝÝP¿èÚëx°z(ZÏvÝÛ_娼dÅÜ=s§©ñ Ìa=A²<ù’åå|`™˜$Y¾ø{$Ë j¼döF’åÉ÷¸,¿ŠÆ·Âøt1Œ×·pY¾ªèþ™ÂýO‹ïËߟÍWï?øù#šO[Íg-÷Àø94Ÿ%¿§ùÔ_ÿtáúSŠ¯å¯gƒµ—7çþIý' ÷ ™䛪Ą–ŽrmL™¤‘Z¨r0þyjgÇŒ‰Q@/u[©¹cUum]c¬…·xÌ:¥²P˜¼p“ðíaaôÔµHJ¨.ÿB“ÿ»¦žBt<¸ù—= /»m^ǦukÛ(Èïøæ¿ê™Ýeb¸Ÿg ®±bžÐêR8g͘ÿžo ‡FëG±'{¾ë¬Ð/¡Eí—u8ýÕAZz4ŒNÊê².×âÂóÉÿ^uÑÅkžüù-vlío]õ­¶Df5ùÝæ¬0…ŠÖk)ðR¦ÀK'ÿ/ÍWy é#“oz…PÜ6=t.=wB—¨Ý3K Ý3K¨¢„©žg`‡¬Þ`szxú°÷ù*DÍÔÞšÞ|B[aùai2¶Û M¼¸gÊ`[¨²µ±ÅáÍ7[ô­õ uiÛDìó‡¹Î€°©¨‡Du¡Š¡ÐHKËÔ—Á…ŠûI x4…$×H ¬ªš—–bÕ¯«~RÆ]R•æåWÿºÍħø¶°“Å m'ú6÷µ®X77QªÚm9XÜ‚¢Q[•ß«àù¡{ßãû‚}Hž£ýJÙi¿ZUÙûU§é†ñ¥o’ ±w/í:.ž¢¼äs¸¶xÓ²6«™qW—mÜÕå¤R{¼ÐÆÜ<±yþ^ ÌVS¾Âv-ï’*Äp«Ž{èèQÜ /­Ê½Â¦¬úÕg¼+þ” «ãœŸéí‘- xpj0‹yŠ–)N~"ßiE,Eç`Þgóå݃¹H|Sy„lˆ„<ã<<”À\¢â-B7Üx7œt’¶æ»ßU{‚œ{®º%ç.Pû‚,8·³Çx¸ÇøjCqì?PÈ Xœ+Î{Ü_¸þåâë Cñ\í®?R¸þ95²Æ›C-û)a¨ù8õœ¥¼ôvBP¯L*žÏšÂ|N¸ÿéÂý_ZZ|ÿå…û/QcR=cñAà£j”‹j+[tÇå=xÁ|SÛ‘r ž\Ö ím1ÎçÂx¯¾’ CÖàôøK¸”}Ø% Í ?vŠÈè))î³MpÅ >¬fÖ£6Ä]òXϲš:{CÓ¹;w®ÿTgÜe—5%Ê“äÅšÓà8XX öt©FeU¾‹¥ L‰ñ›ìä¯àɺ'.tB³Ù±[ŒFõÍ1| -™ÀTÑ«u•©Âœ(»¤”aš›…·É¨ra6O€t*ýbbk˜‰¾»¶Tq§˜‚çnwoò³Mc þ»æîÀl û»ë;Li%ì æjœã¿"y¿¢‘°C¯P”—ût!/÷”p¸(ç#–Ïù`ƒó‹¯?Z¸þ›˜Ç«b¢Æé#Œ3ȯ70×Ys™„¢ë)\ÿ„ëëó׳á ×g ן\X|}¬pý|µN+ 6XHüdЀ)£ ­Úê »Qa#u®ãBG{{Røi§I´øµª_ßià 6V.ýó ê°çc¼¨ç#¾U&õµ oüþÆÆÍMº¯išy„–Öέ±¡õ¡ žªhýÖÜÑûfKøÜ·c/g¢ÙµÓyNôý4¾l¢ÙcÝD3µ6epìñ¿èú£>¢ñ>Û-¦ëŸý®¯Wq$à×£×Cݸö8û`|)ù(–üãÚ4> ÆwN9øõ7qÝãˆGT݃×ÊÓ˜}ç̆oOúLWÀüÛ-'öÌ¿èrB£¿ñ[ûaOvŒèÝ’ ¾ž PYŠ­y¦ ݼ .ñçF¹­¹Œ>€5„ÙܱJ””l7X"üTü‡`Êò¢ÈÆu䡪½‚»»8ÐÃ1¥iFSyÍ|—xe_SCGbÆ|Õ.žËrš½O)•ÀƒÎ#·ÞÓþØcâC7Ü0}5ÕXN…k>É_ƒ má©éÇk¿çVñÝîÕ«»©^¡W¼ŸíÒØþ‡šÙû·n¥g®c¯i‚0÷ÉBQ#wu2ó¨Ì(qYÑ™iðk=ŒÖ`õq_9âJ sBvb´Z4Œ²áÅ_½£Öãê{Üd+ûÔ7ó Id˜[žhlôÙç7/¶ô´ølâ»ìǹØ^å `¾¸ýE³œúwÌ¡~ºu‡§§D\»-ºvµìÜ=ÁÍ«vîVt¬„Õp_®ß0ù ]ëîzlÃ-›ˆ‡_šüµÈ ‰¯rÞßÊ×wv½Ù(~w÷U þ§šã©â8¶¢33õè­w·?ú˜xÃÁƒÓ/Æsûs áaÀU€¨ŽâÏ_·ÿ!¾éÔÛÇ6Œý‚Î^‡8}‹êò£ ´¼î—|Afþ. ÞtŒaCQÁÀ—ƒ/[áüß±Ô<ùüÉ楆%?\"þÁYUQQåœ ǹ/>™ðïœimt®šg ó/e/j*0;ò1œÿõb«pLÓÒráØ\œ?Œ}OœË.×´"êºå$“æß8‹äÄ”)=Ú~÷­â€*ÓRØçwÆ÷YíÐn,th7ýï;´Ã£+×P¼ÏS7ݲ·ý®uÚHâ…è×'¿TóŸýš¥°¤àÙ|ïS›švAØgK•›†"¹™OrèôO*«nêÏѲvgÙ,µ¿bî¤ðû±ç'þûq¹ë+ÈÝþ¦ÞF¼E¶¯©3€n;rÿö Nà…}cøV;ò±²R±ŠíºøP~b(ŸÎõÚÇ~ÎJÏ:K½^óõÿñzÍŽüõÿÿŸi¶z+ë; ü=UM±¬–l¶¼òÔ7/[NgE.¶°W–hQ[·Rõ¥ÒU äìmu¥¥u-z'UÕ9fÖöM!ÚÍÆ Òû1ÚŠ+®4úñ74q3К2zÏ•AWx7½È”f?È’¹ïˆÇs¿*÷&ßÄibÖЧv=GÈ5hMxoƒúö'ÓiLøÂWýiqF=UŒRG^~ˆùkûR>Þ‘*,µ¶ßbC9ù˜hóô´ï}ƒ]67—~‰jÈæ cÁ6ówXÓÚ#µÐÄÕ—Oe-<ဿ|Šj %šÕh‹L!a+2x½â5{÷=´‡ÝÊjs¿xüÌ«búq²uCÔgÑ‚ïd0PB7â“Mkz˜²‰¿ØJ1x ÙñW⺠R8dH6ŠÚßÛ×™k×™»$ñ ðþ1À3ûÏhϬSy¿eìfnGYëÇÚß]ç]M°Àzñ.ÌùdŸ|L}Oè½n@ÛÕµÕ­ö¦NÞå[s&7Z /mJžóK™‚*úflœ¨¸ éd7Ut. ªèô.w>¨btHü=ÇThÊ_X{ç104uÐÙ‡Æ ›u¸Œ±‡\æ¾~Ÿ9÷OÑýå½ç±ës_ …­;ófÖ<Ñœ»Ö¡1µjÎŒ†uoO©ëÆžô›ÄZ êÛÐÉÉ£<@G}e1Î/ð@ê›aF‡êÈ1q‡¡^XE­ŸB‘¶¾é_>kî³}½-[Wgêýé–亦YOÔ ÞsÍÓ3ÊM¤©† –º#\Ìó£èím”üˆoo+ó»°5B™Û¾’qÁø«Î,<Wbç­¼î³(‘F´6»‰œOvÞÚ @L3÷³à+˜ ¼NB?^'QT“WµRº÷úsvÎïÒqû²-ÓûþäÜÖH?¾ `†ZÕ×—™ÑØû$ÀZ"DÏrÌ–ú E³å7f”—«k© ïL)¬¥”‡âÔL,õaéh°R­Ž¿z.Oþr˜¾–^W‰>@XÊÆÿv+Â…V­}Ó·¬Ø[²fÚ}‡®ž±~‡6ÖßÔÔÿ©ùÖgeêØL!&‚Þ*s”ÍD1¦÷Äý”Ý”#ù$Îþ¡™ŸÇ)í‘{–‰«Þ¯þÆ`Òâr±Só,õ-t£ÝHv‚=ÂïÐxÃ4>þcOƒ³i¼±Ÿÿ“ƧŒýYÃhßï,Íaúú]à—’-Ÿ Æð?§JŸË5@éœç©y™z<¿~„çÖ5sÑ§Ô ÛÕç#ŠÞœÌAáÛ…ƒpÔ·¼~xfõNP“OhGé 8š,/Ñ•ö‹¥°04þ£ ­Þ…&zÿQ  Û¬>•m–Õä…5#YµÈ±'Hï 3ç“Ãüž^ôÓÁœøCLÈ…1N'ªð6\òÿ\ÓqâI45x¶þB|9ðÜÈÿ{¢"Þä4€êˆ„–‘²¡Û&r[Qaé¸êVR*Ï üY»Ã ©Ý<”Yt&+¼îè/Zb3žTDOSóÖî%•{.•Ÿõ´ojkß(]ÓO¦?ú°|÷£äSùøúu„¬—ÿ2wîÿ¹F%»IêÜ•Š˜¤ƒP´Â”]Æb(ÃdÎuÊÖ²Òÿ&Åïô?ñ,BqÔ±ÇqÿP#Kc÷ܮì¯[ð÷ Ì]C¬Ê!ôQ,ˆd_ÕŽ™Œ‚ÎVÌ(Ž¸Ÿ¦0_… ôË;N\yìJq¥ëØ»äŸ\ ÆÎ9GþØØ”;÷%¾.þó:‰tz·ìÙ+ïJŸ|oûäƒêäþí¸°~=ÖsëB迨ùÚ7‘7ÿaÝĉ?¢›ÈÖ٭ȇUÊÇÞ¬ºt'Ù¾Í×p‘(LÀHû°Î« {GQ–ÅSåÓH@~Ÿ\»é7mzbÜo¶°{´ŽaÌèœÇÍg­™úÖ`yR 6 œQš,Ìyy©v+SÀþÙÝ6ÀvûbCv,ƒë·D‡4|-#†D[ú¨b”IVš°! ðíþAŸÕf,r³h•»lȧƭ þÒÄy­|nÌ<%Ò@qW¯cª‡Xœiv kß 1 H\«aË—‡ˆ“Ñ»¨QìÖ»He~Aíú;ï¼mÓæwÖÞlœ®qïšyf¼A¬gé¦LÑm—¿:_ÛÙ©%Kî›EÈ"ÿ’Ì>4ƒÀœL¦ãàÇ9FŸ•ÎÑè¸ø èQçÄ`‹Å†¼zL·™b ¯©…0 i-=õ|LÌ%29&·¡bô€*¬UPuvX˜l8FhÕÓï<{ƒÊ³»rê¶ÉÕ¯¼òúã¹ØåÏF™ÉUòJKÝhâ’¿\²ÕùÀý!ˆåж¾J÷4rŒ8¦ál6_4e«×{›“‹9\L!ûPÉÅ阪Òj¬Œ4ØEŒLùÓ•|‰‚ÃÃàÔnÎF²×˜7\ãôD~ús,¿¾ñB¢½°qÇzù£¦šŽ»;êåÖï g.¼fæÌkiÚ°.m˻˗ÿiKúº çJÛ/1NŸçä3¶Oz霜Ãò#1–ÙÍòºô {]3…ÚB7Cm 93È>ï ¯oÇ×o{_w±×ƒÔ¯lÁ×ïø ¾žÎ^/A›jŠjSÉk}ôõÙhkÝÿG´µþÈÎÎ:úú˨‡‚[Êý€»œŽ4ÀUaŽNUCpÙ®Œ¯„y!IÁ¤w©#õ™¿4TKIAÊIg,/%‘ºÊm´æ_;=SŸˆ–7:™[^^¹où²_S”ºÎ™Ô>áìoÖ‡3t›ŒeUm­W’R9qûœV+o¿§>Ižp!÷¯ütYè {¡çi0Ó7I¬FPåAþk…zŽ · I{"ì@ |#c°J„=pµ»ü¨C–F KÙI@²âb5rÔ[ñè.ˆ®WDB¿„e‰*‹=í­RJ]LâˆjÉÑ{[ëV>?vscg÷Êê%O-hØ=saG…=T^S½¤î=qüÂXzÅ–±’qÖÒñ§Ö½CƧÕo½ºj~ùH#«<ž«ñˆŒU'Í0J™œB‹T#øu@kE 5âô»ýÀ«O}BÀþl:5ðàÀq¡Ðq¸(´†|RÛüÒNružÝZXoµ¶ž³µQZ8_ A¡ØÇ3+þ0qÞ…É#D‡T¯08‡k„Ÿ³{„ô ¬è”F  »mîô<a¿4h²xÌèÙÚ²©‡(è-~|ÇÄêãœýÕÓ83ÖîÁøæÇ= 5c'Õ“jŠ6ø”¶šîh¥ÅuÆ¢‘sÆœõYöý$+Ø:~|å—“×fÇ”O˜1ffn ×êeå6ïž²¹1{ìW_k(ñ„§±\ÀçtmFÊra ½ ¦Y2$Oж%Vc0Bí»únw0éŸNb9Š@Õ£x¨³‡[rY)]D!pس©¿>ŠÀo瘸üÚ¦‰gî¼ìù¹&Éß}“ÿÊ‹ìéjYôûÛ.½jÔ8sÆüñ“kfdÕdd/ÝX8{ÜL¶Nê‡ÄÕâB¶ð+`èe—|X¶"ÑlFtÈÍ"×9ìþdÅ£GàÖögP7&x$!¥í·¡»eÐa—ÜÅô{öÅÙGôtÕ CA»CÊ@g… ÂϪ>7¤lèN`ôÛ p»©óëÔà±kÐùaªåݧ&L<ŒÉ”6õô«¥¨þšoJÞ8U"_HCoåtÝ;!kÎŽY£k Î\XqlùC ìëæ¯{hFAYNi~Yî˜ù…ó}¹é#\7‡ÍeŽ¸c³¹žŸY)º&>;Wrrý@O …•!#¯!µ)ŠR.3ÆQQÎZ1,FîãøZCRýªör»yéEÍí}Ù#'B 2-Ö9­ýØ=’XxZ²} ÚÄpîÞF÷ج~a¥bµÒõA¸„‡ŒÌ—1òHt#5JœÑ~#ãú¥(ȹâ¹fLZ²Õ’5‚³^^€ikImŠA둵ä…Aå:G_wY°k—¼OÒOn…òc¤ÞØŽµO¾œùÔãò®§ÉŒ³—ψ[æÝRä]ªœIŸ‹ó1Ç;*©{†‡ˆÏ¦(Ÿý´ÜY̪'˜õè˜fšÑ¦´1aÆé¶"Õ›ƒ^Â%äÑß/Î/ÈûÂ’fÌ–­?Êná¸÷Ç8ÔÂsÓ;‘g5T97sLÙ¸)?7 Œ`ös°ãþEô'ˆ¹UUÄxš"’3®¯rKgá™{šNÓj¾"óå;Ë‹¦ÎضçÒó¨â92†îgÐN 7››Ýg\Sè[]JÎÓ.œ`[Y: æ\¨™4$q9O£ ÀIcažšŽch\8Å8” {€'ä2 VOÐÙæ²2> ?à×|^§Îk¨ÊÍ£k”.QºnÇT]?©º¹ó/3å/¶ÈÇÉÖ‰£uæx‘W\»az—õ‹Õk~±û¸ñ¸õ¥ÀDˬó[I¼Eàw Gcs©µCOKr[#ÔV£‚Q0™—`6±2ê½oew· i·ÍÎ~ Ðn[vÛ¢F„ünzC2?Gã6XHÙg½³iiÖíÿôƒþæ)²qÑ-µÕuçÏ"Þ°|—|y1©–Ÿák!G|ˆ®…€°ŒóÝsäŸ):àU¡ ƒÂVi©0/ôQNüHGüKÌ÷X˜P¥Í£2o9”…"© ##"¬÷ªJɸójÇœY]í _œ¹ô¦3oXø,i•WÆ ä¹Õiì»ç|ù_g¹H/YÏ`6>Ä<ÝB>°0äñš£Qf/=†\~ÉEBye…ðå´0f?eyX¥„&y*9ˆYMÏbžnlÁ<ö²Hݼ`êRaÅ:£IÜ‹µ;|8‡ÎàúªKkCE™Vÿ:sffQzÝÞÊ}íçÄÎ}_n¼ëº³»šmþ¹ZíJÏÖšºôñ36ï»g½|¬¼&^Áë¿æ¯¹ë[ä33Û&›¾Þ¯ßÿ'|c@Á½bBò—œ9‡½ÂØÇ5öq&¯Ý\@_ÿ¾þ`.¾¾Ýímǃâ[¯öª®Wò¬V:p©xy†Á„åúìê·ÎÂ(¦úOÚ#Ôá=Úo8B¯ƒ Mú·/©$¨T=ø ü¥Ÿ°|'$@¶èŽySk Ûäß½tKó©®›Ýë((‚ø;YKÆËO®]t –*9’íÔs ™tm,àÕq>§§Íå—÷Q†4ÀÃ"a°Ï V¶(ÂÔÒJ&_:VŒ8Þ5R¹Ážä¡žx5ËËÂ_pé‚[ÁˆM qtå¨V›×þþé3~WQØ6³aÓjùÝ>qÌö ›‹šÒÂËffgŒšKfŸÝûÈôú êL+nY3–ôl?­±á<÷cúä¸?°T±·Ó~eÑ^má·‡zKòï2³æSÇ)'ˆ]c,‘c`Ý´v ù#`ÜÇ‚Y 4~ bwLB8v{ÐŒä³8ZhB"?GA›ÐþfcuŸ]Œ@Í@ sì0G9HC5Š”’Hmz-ÉÞê*Ê!g\¸lÅ5yí•k5š§_rÊiÖqåb}´¸÷ÜÍ+.} gñ¢{îËÏͬþ#é¹öâ¶1ì¬,¡™+>)HÂ,f¿±¥G— ¢ž®…,¡u ü°øžZøîl5„.A=S ¡K' ¡»ãÜZÎÑ –^òâ-krO™Ÿ0§{-Ç…[ ¨þøظyµÆ“.ÿ™…ÖyŽwærÃøås,Ç 9M=Ä5ÉcŒwžÎêGÓóõaô}Ò„ °Š9áPÕƒV„äwêmpP)¬ öè6€¯cn‚× L·šš.^ ’A99S fv0Ýá4ù9oÙP:û‰Ú´PgdaŠÖB¬À™†³…`ˆO›ëk ñª¸7$ÒìãÈÎã—ôîjgÁèº%Ónš¾¤®nñtr™¾¤³±¦þ-[îß¿¶Aÿ{ç‡úúÕû׎6¼,½§¯'Þý]zÒ©“YH•%`ó¼BÏiŸPUÌfv¿C¤XˆJ¬„ÎFù HðZfÚ¡,Ô´éÏB‰Þx#AtÀ…ÙˆE:¡®. ­à|j(5B"bfÆq4htùB¬¿l ÓÎR³ÉǸrጮªŒë >ž5Ê1^Y «Èlhõ£Ë¦Nmlt8ÇÕßZš}mæ„ÀJSzZn ¿D¾·šÉŠØY¯Ž·˜˜ÛokÕ>[ZBó 7÷—“)n¡6N®°OÈNñ=!—¦cÚX9Ôk§ûSËJrt œÎ~3ìÖ%ãÌL+ ÖzEÿïïĵn¤­áH" €GÙ<2dÁAk0fe+À#m€W}¨%6àö§1M ÈÏø[jN\vGf­w‘ø”ÄNaN(ϯŒ“we~õȦ¶t)íu¥‹â²Þñgd·6Õ4‹•¥ò+óˆ› ®µwŒ)\ÑFÖGäC#"6²½waÀ=ÏÓ03ûÂäÝÒ‰ŒO¦T|îsð!OãÈm¨Æ4• 9¦:‘t"1DåÄl‹‹gURd±ªA‡ÓíÁôµ‹‡!&2@¤Ž“ ¡‡ÄóL<­9ÒšËÖ|òûÛ1¯ ŒðßuÉáŒgŸ­ žÛäöê~ôå¼kµ wᘓÁ•»jn¦Í5'9JÁß0[àbqJ/:õ€s  < b—à:¡6Q¾"Ã8fô¶Íw\ôÛL@§÷ÆGÏn¹nó%K¯ûÈ´¿·îxX|ƒÞÛ!ÀÁ{žócØ/f/›Ì 6+œÓOÊÁŽñ˜Aj’þWW4‡´¼êºõæò—?Ò]8ýâ9£k:N;­l)™³tÊíç®YR߯*5bTwA¯?ìugg…ò;i{h{¶‰“„ˆ0AH ¯Î„$;†AÝÒÏüH(4Dû0ð ÒèìiéÙ$w ØgÎèꉧN*˜rlñ)!»M eXF7åxÁò)yžàØ ³ {}‘€;˜æψ«˜Ž-tíj¶š(yz›6˜l‡àÐFìˆ)±‹¦b8¡¹¤¼Á^&•Qvi¢Xá”Ï}´nl ·dêxhçívÇ §üW6-tÜzé™éŸ råPëvÈêAœ€•/6ú|/ÒK2¥ZÈø[¸•UcZ&6è° GyvKyoé”G«Ÿ©« äM|èOb4>+º‘æÍ°9NqÊ ÖŽ‡û1o_–’ÃÒ˜ *ª…I6sà¦e\M$LÂ~!áÑ­ü[²?]ÞñÈ¿ ¿$ù£ ¸ ÏnÎKÅoèýÐÊïz0cÀ¸T¬JÛ–‡ÏP ó‘„/x´ß{D4™½>ÀT~R.÷8«Np<¿ƒ CtÑÞü2ÛËbÇì²¹€tç—Ú_ÖtÌ* -ZöpËœŠpõÖy±©§‘[ç”ÃÏ#;…/íOˆQ¹E[­!ãŒo¢ªå -}|úgpÝ~m)€›4¡£p¢ëBG•7-@]DD»xPßMøÝ ßéµ K&`õ˜já.$zêBWïg)öÛ0˜TAŒ#´»@3’¸Ò/!#w¯Z¶dGîâ™õÇÚþúWBvÍ’s_&"Þ%~Ë"%cj€;]T¶×‡ ÌŒ0°H—)ì7± ý.$3 NÙ¿'“c„^ZA‰<"î|hZhÉþrâ#Ù鮳Ê\—/{ -ü­èn?o¾ü_Ç[Žw]qEç„/ÈÆH–ÜÊÖ ¬uȲIÍÎ&C·éeý~zoZðÞ„ \’ü’|ù÷¯¤^’¸$½xIzØ%™¤<Ñú1ê0Kœ@‡xÁ`’†_‰šœ.܃ÑÒ¦Iô,é%î´R¸åW{EOÊý—/?‰Xù¯ÊÍÚ²añ\ä²ÈÿÊ£Þ!aºÃÍA`ß]4 xD0#‚Y<"˜Ï#‚ M˜?Ò€Ùƒ ¯z×€Ã3B ”¼Äè`˜áâU©ÑAOHbs¨æÊÙõÞ [Èø±Þ®u““ïhµ_ev¦ïXÞÝWº«ukK]Þgç_rÑÖ‰[[Ç4e…Ý.…3Ú­¶…Ǫ'O¼¼k.›3ðUNÇœz¯ov(`3w Ó?°²g ÆÈHÜR3$¯Ã,/’ÝÖ×4È_5{Ç.€ðª*ÙùÍ`«;žC~§A=äɯƒÞ‰qá'©§û ?ò¸ÑßLjyNQ¬y‰}ø£à÷ŠgŽ»ñ#ûDäÜ¢wÿRñkúû‘?+ýüˆÚ/>¸ß0Ž–*¥¨DùU•(ì­Í-ýt¡@0¬ö!¨žÇ/yÇ òO½E¼Þs cŽ9šÆ_dg8Ô jLhu±XLÉÁÀ¶óз#T,§Ë PNwã'YG?üÂQ©Â5GŽlÈ‘-ý ù…tôàKˆ#}Ëž°†öÛŽ>2úÛ-ì=C)@@ ΄>‡úf:g˜sT¸_c´Ú@ÑK9ÓÈXÇ‚Nxgø¡çG ”;R ¢šˆÆï1h*&|Ú1ïíÒ«Í¢V\ýÄLbñŽøwù2íا{ ÎkË7Et6ÊûÀþþÖÛè:‹xÜ8 ã|âxåé†ô î£zöòŠè(&¿Ý¯÷“hÂ¥ >àðDr:—“:ân—BY£–Îm?HŽ»`òµ†ÓÀR«N²”x}Ê°>”èª"n5_Ü‘üŠy376?ÿ|_Ãۥ͹ ^IZ”pþÜÞQR;Éå!}wþoºNý°N!š¦ #?ujö!ëIK1\L8 ­ÁÓ͵Næ†ñ%[”Î<$Kg©2ºT+&ö6­ÙyƱö¦Ê —_ÞÕwǬ=OLžÌÚðõºè‚‚Ø(N–ß{®>ÚÞ¸u4‹Go÷.m·S€v±•Å¶QÀUEí;¬„ fhxî%> &#FA%ÔÆbp’bpàÉzyGÒÑž`›ÙË+¼ð?ê©zÂ1΋a¾32qçö§ŸY!ÿiÓvḱ}̼ xH>F4ôkÙò÷H£üÛ5¤jõHÂ㡸wÜ°w\<Ÿ=lû8\êöñ0PÛ>ÞDlÎ1MÇ´…oh¸Eâxuï8~¸w€ÆpØ®¹>uÃ|OÌÊNáøï7qŸÈßá>±³5˜Ö«ñõïñõG¿b¯÷ÿ\³¸^DC¹^êyMìñ.q7ú^å‚2;J!…ÆŽY(-¿\!ó¤ÕðHOj1…7RÐzàû÷={V¬:Övð Ÿ §¾T~çüoâ'xœÇjƳ§Ó(.¼+Xàä•øÞ^ðµŸ×øAÖM—0çÒ½m9á. †¸´âÒ qiéÞÖZD ÛÛZ™ÿ¬äˆÍFžŽ³­Á-m(Ï+Êr†ÄÐö@ÓƮٙWì}ûX›Xsƃ½¦ÙAÏw;óƒJMÖnü½XP8T_ü?«™ªùéš©”:BÄZSkÑúá|¬ Óî Ù@˜Õ ŠMP2H‡!~ìif³±“ö9öòx2;•þž/*œQ÷³š%#¬¯"z·bÜ{;W[6s³h@Ðh1Nà(Ã$ð'C¾KØ!ßš‡ùÖÃukÞÿ„¹ûšÒ¸´pø¢ÎsÍ«=í©}‚˜9˜{:}à³Ä#E½ùØCÏUn8ø ß²µ¹SèR]@öÉñžS¢ÆÕ†‚"–g­9þÚ·7él„\h?8’°{-1àhƒR§´(¤“r“eNy8ÃN@;©b( ‹™Í›idYÍ=bA'Hçc¤]­eòþŒZ&7àö%»èV'êo”’‚š ·l;°qÓÍÛnÎ!ÖÀiÕ£ƒŸ°b·©~–ä_cœ4ÉxüÖ¯ “'HEGé\y@;²G~ÍØ]Ú¡'•”ŽÔòuîc5NÙxFP›é7xw-åçœÕ‚n&Ál*þi; "¾&ˆø²8o¿¹ŒW=á0+¤_(% -¸t¡jµü,7´èÍzç¥xý0…5Ÿo„"44ªì|¿%ÛCíS¸ÏÌì€aºßâì·ÁôØÙ;ö2.Žƒd7ò€<òØX¬Ã§‡O¶”M’ÒX>Q"ú/qxVŠÞºÂ˜9¤q#K‰†¡¶ºfe<ô'VGT·ÛŠ7d†ôŒ{RÑ›–ÜüV/ù¦ã©k®¾ÿÛë£+ViGoF×m´\S5î ØÛtÞ4¼£½Bš0‡Y§ý¾’^ãRòÓûÏkSÛƨÃíÌ_ãèc(r¢¶(T@Ò8ÍÂ…ß½°“f…#†eL†»œÀï²ýzQmð¼~§gÚ´ksÈÀ.ñЇ5áʼ²ÍÖÄ›ÖÉ7ÁÁ«ø Ì™IÔ^ç§(÷#†4’I½£],!ËêÁÍLõÍ•¨Œ¬&¡‘¤dº±YàO<°ì©«¯¾Ó²îî¹ éýýÉïoÚ_WÅs&¯Ó»- ðOå 8vfÈ HÌ[´$°×ÒQgÕ¥Çõ<è/ã &ÀŒ5½„µ±X×)Yp?rÓ,® —’Èp’Šh{Ë®?Xå³ÉNêåçMl^²êå_˜±÷Ñ–9U¿]·`zõÌ¢‘¿¾÷›)#¸_ŽÚ{O .!z3(àW® ´?h «P²”™fA›i—ŠŽñX°2ïXˆz§ßŽ%9°- Y+¿¹ŒN Ædƒ®„;]Ý9ÐÌþdç§1cãD&ó‰Û›õÝÛ–MÏ-3[ÛôŒ3·5×nÏmÉ£×ÓGW^ÝÙ·ýðÀ/o–_"½´²¤dåK+‹™ÝQε(ó07iÅ)>ÕÅ)èmŪv‹†…‰lh{B¹‹‘ƒèmnäC±˜E¡ê§ä–ù½˪žÇà†ºª*j%_·ñÒˆñÀŽ¡Œó»ç&iÕ¯Zu¬í»ïÈkµ¿Ç:f:W@DhÒ(vÔÀ„0(\ûQ‘N ”o 9³ý0NhlN*]?žx˜:.£ë·CvHgqjýŒøšñï%²3$×€Û €±Û‘K^kQ¤êX&WkàRóðpfM^Ï=k«ë ;ni+Ôϸ´«§ºqûù…¾+&t6÷5‘’uWÌKse—d„"‘ÚòI£×ß¼±žøowÓø1ôLi¡ÛÄqAб),ú3.Ðù¼6ÐðòO_HQží÷á¡Á+”Hƒ‹±”¬,Š”ÆâÑ:«õyY¹O†„Ir&=“8 Åçgûºª”“*dIÎ1´l#®sꪶK»®]¿j—©vìÚ¥vÖf‹vÿ¤¦’:›´®«cù„ìÜi£A,…`JEwj,@uÝ;â0Ÿßðï}~7óù5-We|}÷UéßpR¯cŸÞqÖby“ ÖË7jìÎ1õ§Ô¶ÞFÛ:Üç‡ûü†¤Ïo:¹ÏŸœð–¾Óï¹öòý·ž"ºŸy†Îð»ï²ú„¿ásp~¨þ>¦ìuIß„æxª_N=šǼ,Ó™m³‹Rß]ZstYK§'½óÁcŸ’_ÛzQG¶ÂÁp×õ îu z¾®Ñ+á & bå`ÀäÇȃ’Éãlž<Î>*ôqÌ`Îâ^0Û ¶ìÕLq<¢¡ÿù<qLÎsk—¼œ»Û¬ÕëWÞ½AoÒ³è–MZŽ}z¨nA•ü")·—äß«ÎÃ\ä±KåùQæÁœŒ½XU×áF®§ EÅf×}¤oÃyéãyÉ°øÜ_ç1~BàfRDJ̃ՇÂZ|ôÅOF«1+Ä<Ü,æ1ê®ÞüaÌãÆ<¬)1ë°˜‡Ñ€~?‘0_Ë"z>J~{Ãí÷?ªü¸«sUv]›]äà±O_²¯6—W±êñÔ«ÎF‚Æží[¸ïúó£ÇŠX&Áj‰úF˜[iªh€Sµ¡htÈÅîf}^méòú8Qƹ. DÆ-%4 s3ÂÅ®B›„äšÈ÷âÂÜäÙWÂ&Ô² æÓ)¹öê¨_ò{Ñœƒ™¯¡ŠänKÔ°6èÝ\,ÈP7¦¯zMíôê:ÏÞŽØšêŽKwg8ÊÒ¼ÎÌ GÆ7áæ1}\1]ri9m_U4nY Pú™íÛ‘$ýì,É.‘É&eÉ_dµßÖÁÚ‚ûX_‚:<«Š 7ņzHA‚Ñ¥8ŠüÁV¬tƒã§Íªá.?¯dþ5ÓÇH$'T_e´kT_ß¼ fÎ"µo>‘›ùðاODg«{ú¿p ‡n³ÿ1‘–]ÛÖo½@é2é;ö© Œù—xϬN>/a°D‡GEÄÿçQ‘ÆBX c›ÜÉF*s#â¹sŽ‹âÃ,bP*û ÿ£XˆÞž aQ°7–íU£ ˜Ñ&úѤdë5ÿêk;f\ó²;zç‘ýò³yÓóî³Ü‹ú¢½?²Võ»b`vÜaÄý<Ì|µHœÀ®T³eX¤‹Ä!ÑæÇÌNüAˆ…´\`¿eýÚ=9£êë3H7ãýs~=Qñ¼ò§p¶ãøA[—ò¶NJ&‹)qC2bÖ:ûσ´ôuܱkÿìyãÆ6ÏÝ}=Í8=ofƒl£w©ÆÊÇ×4cÄç¤Ãdà¥%âvÐÛÄ­A”¡ñ)AzæÓóÏ Æ¨×jSˆ:!’Ïâ Ì_ÍÉ6Wê1Ëo“°ûÚ%uM¥Ëß¼ºaܾw–VNϯ·dMÞ¬œ¬Ö·Ý’ƒÜ>Ÿ‹¿¥íu ™Â™Ü‹S1x%¡v@:¬>‡UO@'ÐMê5àb™¸" ÇÒ€Á*Õ&ã@¸ºü,ðapTB ¨Q0|H}N>µ•°83­çM4ÎYýF÷s ­Ï›ÃkddvŽè~ñ´Mò_¾iídòm¹¹íºrÕxǹ¸\JD,'°,I†ŽüÙ˜v`žGÏÌQNÔÖ“ƒYO~Þ%òÇ0 Q»r1ÀT¢“$.ûϯ¬ExàƒÅ=ÎéÞqÿ?û6_¹fúœËß*¹{Á±O&§L¾ZÕ=_ÜCmï4СÆszĦC¥Ðú=ÖYÆ,SŽ¸]üJÈ&ÐOa7mRE;U´3~¨¢.ëÏB}¥¢ÞÊ‚…Y¡¬ü˜GȉkPÑDøàbu°ÉËâüj– éäªÚLÅ–T©Ä,% ®½|[s{ÙœeÓ§wä%¶×·Nk—Ÿ·f|h}ZCi g2¥m¬w{“vøaÐÎýW vÆÛl j°–öV;Ãe'­T„±ì^@ïYԽűM^Æ"e—‚ èe€rƒ‘÷J'’÷BÂ\ÑÆ˯iºdë SzøH…ü‚ëÎÞÚñÓ®?ûbdî]¸fÉÖ¹c›éœ~ê™h?Δa´±E p;æVÓézqNÿñGœÓY?Ï!/0¬ð¬níoâ;è§ᦂbˆhȇ˔¹Fàù‚^X½~؆Pa€•oáYæc !_2 q"'pðë\UðAÑB­¥„!Èy\¹W¥ÊÑ·RO[¦ÁHfÛ._vÚ¶¾9}f] Yo‹Ž¶uH¾²ÛŸ¼eÎý½äÎëÏj®/\X¨žÇD[# xcl ÷4äJ¹9À‘qB½?@bø†¨M—ØùÂôéÁ£q±Ž¹X<ݬÄÓÀdö©' Æûñ¦£þŽÒ‡–{v8¿Y½÷Â=Ä®W_÷‹î|ð®™³¾újIΔ\¶ÿ@ËøZñ+:'§aÝ3ý}®ÅÐp-rÝBÀ¬Çý›‰õÐã¹®`)µí?ŸZèAM¨ßµ ª ÒƒgR¹ðÓÞOâŠZ~ùÖ/o2ëáا2L8ÃÅå ¯ ¹¼.Ýbd²×¹°Á-+ÌêO‹)m&+„p ÑlV¥(¢ ÙÙÀÿÝü鹌¡ jôGbþQ]¿öÈáÑ«?saq‰Ñ9h0††~O᪹‹LE­Þ :Ë€Mèr‘’9‘S‹,"iEÆÚw!aÉeUïZºaƒŠ˜öG5Öÿ"0¹ŒÄøWz G`¿'iw§m)›˜—kÛ—›_Ú¹§ÜZö)ï[WÝsÉ’§33>ÿ<þôi×ôä-ºõ£ËZËÊçã¼M¡{ø/`§“Ýœ5Ü`íÒ{ÑAõ!æê‡LiÑšðÈ…ù‘[ÌÜt”L¦G®ËÎ\¢™\pä:]j¨’¯c›ƒ¯c³¨¦4%×X…k™±©ù+XÍ#×øõ¯‹îÝ»gÿMèšÑ ó§L™ßvú6ŠyM|YT½ Ï÷c?–(ý0¨ÊoC‚Rò "Š\k²üÎP›jgz¸>—ÄJ^OÚd.ô†6SXmrù˜¾'=ƒm·¯¿Lþ¢o:ØN“É“óV9·Ï›9÷þùäIùÖ¼i¹˜Ãü\S*>)„ ^ƒIºj‘¨Yj9\éÔ"éόׂ¾9ËÍ„˜UÂÈsH2!gŒÀÂ4¤äð×&¬V-G$• –d32ÐA3\Ù[¹ºñýÍÕÑœ¼)šW^!“¦—æ”ÔÍ”o͘ > ¿Ùuáùι Ö-_ ÍÏ%Õò[ˆ%ü\Ü@ï«Lá¼Ôág–•…öÃæ XU¶Ðfbe²#0“ ëŒØ´ 6--m&íI:òÜéH²)°R[j'zé…mà :jLÚZü£Ýät´»ZwM´žqWÍج܉æ½{µíþlw}]b¥¹™š[§l­kl[rÃÞ4vÛéo“{\#bþÖld<ãÌQdX¯hTJ»XŽÖÈ«DÚÆ!jìZí¬xËScÃîXAôËϾ¸qAùæÊ¿8¿òœÿü׿þI–~­úI¿Å³Ô.Ô§>FõGž™°¢¸4p+ê~ì¡Ïýó¹Kg•¬*íܾ²¼Šûè’‘`¹Bû Uå{Y´rP0X¹~–Hë'±!Ik„Bz¯R\Ÿ0Ù¢*©«›M¤›‘‚X>§”>¼êËÝãñ–öëK¥l°Vsz“ú}ôÕ’õ† «›U>Z$Z„¢KX©`»ˆ;BwfâöÞÎo®:»-°4}Ò¶šö-ŽŠâýr?é<ÖFŒò×Ä$CÿþŠœBôê}ýÖíø„SùŠ¥]„ÊC=ãð2{!U8&Ú”°Ij‡ÜìÖK/O¼$›œðø`&ô^\£*:LˆH<⥓ѲuùÌço_ÛR0?Ò¸>ÚñÕÂ(½ôd"ûtÿéAe-ü Ïišµ0Ad©‡]œ“Ü‹|ÜCgç…l«""í&ê$Ð;°U¸4 ¨ÃlHªÛ®îÝ#V^2ýy«‹¶\³è̵ä²gçÌyV>¸màKœóÔSêý3Ú>áW¬]ƒ&³M‚õ+4­ImƼ|l1Ôoÿkšð#Gt )LׂóÈáG×þµ…üÌ¥sÓ%L!úŽñˆ0HŒ'+ÖˆÑd¶8¥Ôº¥á½ ?ÞWe3о.ï=G Ÿê)çOl=§µ}õ¢ydä“&Ý(¿ò ýC_r Ï¡ËâÇtüýB:!,6$X¬ðuc$úûÓ£Cj’A!³+ƒ@×щÂÊPõÁéêñ3A2›®Lö[ùõr®&ßï*…L»[w®%¯îèáÇo|ÿ9|SË2$i:j£Ž®ûäƒãøzzi"fìO;bOá=Ó‘ÃGîøê÷øž­´ßR énsÁQˆž[ Žj„1Õ…iu0¢V›ËíñÒÒX–púÙeÈ7â ë7£?>q{ßrhÖ„º-…y«óFl.šòdÏLØoÿnÖ¬ß%WýzJ\ð»ß±Ø‹ÆÁ÷#bPÐ1Éý˜ðè?ri¬0¬&/Vß•þ¨bD'w%·1¬x &ô¡ÓU›9¹pÜà/hÙö·=äÞÆ’—룫6·¯%Y3Z­9¢èþóµ“&]+¿ð2ýC~{É%Û¼K3€|1ÍÃgQ34³lH˲‚²þôׇŒŒ8`ŒéPG#"ñ Àn²PmBÌ⎵[… Ñv‘±àUVÇDÈÑUå¦ÐËÿJ¬X=R=rüôW›Ï˜>#zãíD”Ÿ©»ÿɺ_ïë¶n|H3oþ¦Ro¾/HëxJõ˜LW  «³ûaWu½*ŽÅs4eØþ µ•Dff@«¡­BÂc‡Uî•P'‚VM`h‰G‹-äºa“×÷eI…eÿý•ü°˜÷fͲîòîÁ¶@FpÜí…µ=V3´wRe£?ÝgÍ•z.[{ÆíG„\N¿ÛÒ[£¹E ©]:ƒ6ìsÔɸÞvjËññ´Së™þäçâ'€¯ò1PäH¤¿ÿæ(â+‘×æiÁ<˜¬%Š‘Ú0K¯Ymg逤CL"EO®ò­m+ö{f¯A~û9z?EŽ´3­3=ǹsˆ8Ž>#ª<ƒÝ MÐÛOò„I¤~§^àe )ZœHÉãó¯ ¬˜T8"Ý”éÔËÇÓc©ok]£uzäÚGêôh?Ô|猈³…óP¿\$~+ìG;þA|o}oŽp©úÃkÖRßìŸÔ®4ÒS9$<Ânñ!+sGƒNÂfâ³8K6»¼ÎBuBU€\°C:ÖtRÏê=ŒŸ¬†-_†ø¥º„¯žÖþ#BÂã§ÈãõùÕÚLXÃlq:D¯¹¥´ô¢Œihá%|tR—äs(_2s9ÁˆsæçøY.‡Xk§-¨ãõÌÜ¢ܼ©YR8{ÁÆÌË}å•æè½dÆ£ò•w!ßÊïoÝJÒ·v²<σ¹=c•±zçÃÀ!ò‚z®å ß¼pbˆEš³Áìì c\w7Ú‚´¿wiìØßËSûëÓ0pKºðS=Ž?òîUÃzìûé¸Ü@ Á:¯‰•†,Ö@ZÞ?è¶;Ùm IévË•éïܺlÑ9… ¾77Î46,k0ÎÔÏþólEÙìLù‰ƒwlZ ï';Í|þ}ÿSŸ?þöùSè‘5g¼|Ï~ù_fM˜6³­C4õtvöL§ß$ŸN?óù·¡íZõùef °~Rú‘ ú±i'óû½ÜïG†Eˆà°ú@mx`xà ÂpQSÇÿ#ó;S÷oÛµÿý¾ÉgožN®ë,*꬙s_¹N~µµ‰cXïDÜr H“z-׶;Q¯ Ä™ôÐ9£ÀxÎhVT>à`gˆŽêa½@]'2á[X½²NÑqœ?RÀÕ\â1?+‰û׫×ÖW6tVOèX»&Ý¿aãœÈCt·¬Y3~ihi›õC2OsöÂÌÚÓ1w’#^„<¢aagý¹Œ4,{LË /(t–h±“¿‚ZL*$„8ÈNAçÜ I ?ÁYš¢›Ý[#M¢Îý;›ö Í _RÓÓÏ¡°¬_HÅ"£ô Ћ­— ×Õoî­,oì¨Ì ­o˨+sŸ¾©=³á²ºwÄ¿*È¿â‚çå¬ìÔÅÿAæ§ù6OË{°µA©ùÓtÒ{sLjÍŸ ƈ»#ÐÁ4a¿ŒvÄ;‹¼xø³t¢bǤ0]"P H.ºKo¸a'Ú KxWê3Ć)ù Ó>£…´ÝˆÃk¯!Á}q/bºgñÜ·†»Ð­`Õ ËI¡‘Gvpë£̲ZL&ø®¥³kµ .QP%´é`U–^°ýË'‹Q§|Îë¯ SíÎsÉ Âq-Õ´-§ Lm‹ÈÛ"+?^ÖÓ°¶˜~f[ât;ò¶PŸ®zâ-ì{mñ[[.~í5^ßEmÞû±F~ã õœœssÈT™P榥³ÒÃt ¯¥Cj:Ö²`éÇ{ÒAŒÀ†úŽfêeð¼àÜ›E1rKZ–Z $…}³ŠþNCùúÅ߭ߦ°1ó¤‘ÖŽuOZCòù¦äóí6åùZiXÝD€¾ïà–ŽM™£9$vÍ»ïr[ãiäø8õ„~Ó»Yã†~ƒV/js#|Ë-ÑûOƒèΤ2xz¬Mô K=‡œf!‚< )ZÄe|`£óeØäÒÄ+«ãÎÍ}7þëîû‚ñj¨°Ù·°Z¹jÿ~ùYn³\œöóZÁJÏ'3¬\b¢ç“Ñn3Û-•0êQYÛŽ”vh¯ÑŽ"Û?»½è?Î|ï2N/‡1`jYÂôÄ6;¦ðÑÃÏÞ:†oÛKû­¥ ‹Ù>¸eý„Õ™° gz¿¥”ÜÇâ™)u°BJÞ<¤ïm¹²²ÒÕ{í–Gn½ÖUY)º_[·îµ¯ä÷>Ù°á…#ä8WË8‹¾sZ¸:LjZtÈ$¹ ó °Çî¼%·ê-q.+0ep¢LRh¨¸FIn’ÚÛ·÷<±ïƃõ}óÇŽ¿6YW.ú¿¦m]‘l«Šž¶Y¸W$ €hXn4ÎMÁd{MÿÃö2„LrX¥¢Ž¾èºûº+nºm ½O¬ê™!-ëùCÅ‹Uʸ~ pÚ†×ܳšHK²îÐ7 +®Z…6AaUáø`˜¦ŽÙWÓ¹±¯ÿž#³®Go–?%n® ùq4ç@¤mxëqRÛ ò6NÚÓ¿kC8u¢Ä°à—×_|íí7w÷‘ýkx]ٯإ¬¦Ø`xXRÎ?»¢q;`ÇÀn†mäT]C1Ê%V¸ÜíaXÒ~òÚbE·ü,ÏxE W™6.;#÷#®taJÅámÔ´&¥6ª?h6Ø’ÀÞ“´ üØ.ŽâoÙäéF ?BHËÏÎÏçÑÇ™ÊÛdJæaŒ°v¬ÁÒ… Ü£vF ÅÆÌÆŠ µXò7`D¨W= 6. Ö#3@Ê<› Бù†©Gräw|ï}èÛt¤´g,€ŠµÝ_v•o’5ÀÌ@⓹M†5Àc¸z‚{Hn`Uß=0åÅt˜?óíP8›?;s@ÝR¬KC:’M…•Ø-H–Ϊt¡)i ¤näà©4êÒ$ & ²Z :FÆ¥Ç SÁ pÔ&t~(…%Õ­átÖ ¡=rNÝÎÆ^zXeV‡Ê§„F…v­§ùu¸k¼|ôÅ~ßTïx²$!É ±õتó1×Ú·t^ d}sÐ7Ž†° B X¾é¬oÜ]3ò2Õô ¥oè›+¥o®í›Bo†}¤õpÀÁÁ’ r]ýy,lh̬vådO¬d_|¾è~=8}âw/¥}³˜F-·ÿ‰Ü"ÏÅ:º•â!ñi!G(†Š‚lÂ,?ÆËg¡kÖ[” È>/ºÃƒÆläå+Á°#§é¦S5a{;âèç§OŒ¤ý‹Ð‹þ3Oé ÑïwÑ/ «B™-!©Hì.&ˆèu%Ü‚¤ (3•s¬šé/-+5 ¾Q$Ÿ1Û ûƒ—<“òsôñ܉¯4]P>»²9§aþ¼zsi×Àܺª¼ò®YåáüßO$§UŽ ų?øpÚ#Ftg¤y\ØÒ»ozçUg¨k5+jº}Ǹ)%§dC§+¨­œ-Œ"DWàös„`Œ”´r‘ÂwÊáCaæ…À{Í%TÅ\…aHk²g"_}us]zX×€?-Ó!ÉuŸUpxüö|È% Xˆ“‹N¤×|XôþpX >±i÷ŠÖÙù¹cL“Ù>ã¦êhNuSg}nè•f²4Ø ¤#¹êJ÷”­Úú5/­\Ž¯io0œ¿|diæØ’pàÉ2½'#èTA%qì” e2ò CV&ÙÁŸ÷òºÀÎC“-†‹Â+ µn?®†Ì[ iP0{Q‹ã§¨ à')ÎÐÚžÀ:i÷Êõ·”(ï^qðŠøÛ¥í5iSì£J¥yŸN£s;E¡¯íO+ bŸ6s>±Y ì‰Tæ  ( ,éYkOËC·|ÈNÀnY 9oL3‹sÞºÀyË4Uõ<ƒ½N€Û°¤²pÑ#õ¹E½E+ÎÛHôÓR¨p«l¾úØ« ߨ2ÇÈiMïÊ»'Ô!¨ä` +0Œp9Z±¦ ÄÌJeCʱ¾ÊL½•¢e¨ÖY±ëz¤x¶óÏ­W{ÅøöíòxzU‹qÄäwa={v²”ëdÏ6ýoŸu^Ë®uuc©×ïé…LúŽæ ‚æläJ©/WpÜ_ж‘Hea¦ÑíT5ºë¦¼ßÇÀ—ºR]Úbµæ5@u 1""1³áY!—×PUòľÛïûì#Ñ-o"ûòeéÏxŒ m™Œv妊‘Ô²ØÍ„Y½–¤ˆÇÄdW¯b°vÍ& +³ï •Oÿ寨ˆÑ©þ^â: däv8b)ˆh/ÞTÂB“‘ªØTÿí«ß¸cW_3ïé§ç%±ï_ -z€å!!eaÇ”£V:Çíü7V‰ÓS`=\·ïƒéø¶K@ž[|Ëìt΄X|;u2F!e8‡nU 'ãéE|´k›¹jöo¤çg+™³cñçÔiý׃ºØ:éâœ?çŒÈtQí¸{íV…‡È€þ B,ˆ½ÒYéž·«•œüó@Z©Cv¨h 8VvZËÜææõ^V¦H'0¥ZÆ$ªœ ÌdK%d£oýó{ËWxäùbÛŠrç+ÛX­{¯…>Ci»ÑR›/þïšoýxÐjÒSßÂ’,QSšüÆVµ¹Kseý¼”ܳl™ü¯Q#÷ Ö¼K| q+…R©ßU‰‹–úlpœzR™•œ*³ÈÉYa¯ßVÆ ¯0æŽËÌ…¸UÐÿÖ»8Ü&…r‰ù?úœüZ¤]×l8ó )’/䔸ã3³Uþ†¶•Žì€K—lë0ñA¥­Ô!³™AèÈšD :5Ø>)½8•ÒGVùÈ[†Õ˺FõMØ虣Ô?6E>Ä!„ H–ûÙIÇ0w€C妲&åîØ°éz¢žÚ¼œ?7þP `°DQ‹ ù_‰C±Op¨ü´YÕœ¡ ØÀ@&ë@E¼±|ÄéželÄjâ†O>4¯Êgš5ñÌ$wVêóËÖ"CŸ›-5 ³ÕIJ ›Ú6ª:Ú£Y(£­wÃô»ØÏFVÙaŽ¢Þ#x_: ÂBV[åP†˜u¨Jí s]_k}i¤¯/=«Þå™zŒsñü&”šz¬3š5³“†‡.°TÃ!9KI.°dôI8˜ †W‹`à÷ƒP%H"U,cu —+Œ½½¢ªÑ->ü@IOñvÌ¿$µÔ/ÔFgÇ·.Y{+™”ÒE$¼QUÈ‹<ó"Å%V„áÕWûfïhíìË-l+~à”=nÖTùÒ“Q%f¸íÏÅ·¨íòÝ£ÓÍ`ä˜DèPÈ€KF,â´ÄX;2¤c™%z•°]àcâ°Ijµ`ùˆ*r˜¨&‡+aLçÚ.ÔŽ°ºìóG3À 뀬÷‡Q²‡B˜€øõt° ACùÅY‘VAN~^¬}­hf¯¯É¸îÒ¯uòåbû¤¢úШŽ³¹ÎØÓNª?¬Ø4Šª.Ï §WŠ7ûòçtû¼S&]ÝT¯Éxêì>&Ï ^?²mÈ;«ºaê[~3Ãé±" G$rˆ…:'„øX䦌…AJhÒQâ1aJc Y’ßÁFcÐlç M@á„7ÈAZ1¡XVGLJ¬d+<0ʘ”’¼FECÝžVë*b\!Êô{¢Õ†ŽÍ7n4övê×ÅÒq²¤¬"''½øÔ—žœí–:ÆŸµŠ´Æ5ŽÁñÐà)bƒ[Q¾4úsÐ%K‘\#X™? Gå Ã1"¹@J¢ƒyŽÆâD†ŪFòá©Jž¸TòèR)¤>wà ¢´Ó#©W“æ æT€Ûbu¢ë&•Íü ̆±ÈÊ+¨E*eù”ýÔòáEq ˯ªŒçk~r1•×tŽ››c-¹xù”}öŸZV#]¾hf•ažq\]{Y‘p´)o`¹™+²ˆÀycOZð&nWZ °¢s" °H€?‡Ø‘$¶;RI€+ú;BÂî†\&¬r:`ræ!¤&|å¨ÎÀøMS9-0 *f`ìÖÁºÍÞ?T‡×´œ&X;hH RjS‰üeñâ¶ëŒ•ËšbS¸ZéZÙ9»…'¬uSpó+SZãyIûð¼$Ž¾O«1…p“ ‰™,kJ.E]Þ `Ìøo®Ÿ9Öµ’T©`+š´+y• ò¥´‘¯gsTú©mLRyL'¶Ñ”ÒF+S1Ç 0‡™½ 0%¯’‚=bÉ•¥gœ;ª½¶µ€1%½Â9ÂñW“ù©Ѧœþcù)5Çr¢eiK#—›2É'IC±)¦'‹º—ì*¬‘e[p…©ùÚ–ËÑwœúSy¨ŸJ>ýTCXÞ q¶˜té[´dGaf]puaÞüÂ[pÏ:Ñ/<Át¨Îà€4»i¸ûçPš‹I¥ŸÌ Œ€Ãšt§y~¹àú݃¤ðLêg@âì<06Ã}À?‡êø¥¶ Öƒ¹}ÀÁgýç·Xú–uŒé›ïùåÚî‹©ó7ë¡;š"Ïûô ‰¬ªàþH=ïÜX3µ‹Ï—™!ºúµ1E¨J¡ü N­OQ30üó=µÎIs$áôí—ŽDQ“AV…S“„f˜CúíÒ€èò2µ6¬ùaå—zƒ»6…« çX·¶&¢ñy š†üçfLy<Ô³x}a¥‘˜§FºÇ’#lŽð•Ô_$7“Ã[»«ä7‘köM‹ç¦ôMä}S™Ö•eå}ã¤koøreªÊ—<ÚïL雨Iég\ùt­ëÄ~ RËΡxª+È/€nydLÎ -Õod,Y²² Ö¨×5ßÕA´œ† ô¡™ -tÖ¤{U®ŽêE‰Â”ïT°/@Çì‹-̾®ó˱ö¿IDû"½Î>½úù‡7¤~>¨|^XÁ? ý|Ú3Æá÷¥Ç?×Ô"¿Äí#“:H»U¤ç¿’œ"hß §ˆîw…¬Fx*ßDmk¿°•)^‚tì€EÃhÔ†D—ТáãAƒÓ’T rÑáBZ~ 6)/"dªy~‰Î!,1Æ åò²|¡(¡ìÄ-z¥Ô§2’-FÙ lp ³בï´ËÞhk‹îZñäåWÈ[.¾ôÞ1GK¦†Ã‹zâ3‹Kî—ûþëðÖ¥ÝÝK¾:ÐPs iÂZ¥?ŠŸ¦ÞMÑif¼›ÈÁÈ$@‰œ ¯Cg¬L´1áæA2õµÙœè‰!~\¤VNBœ é{ÍÉn0´œ¢˜–Gã7\£!¯šïØÔ¨ïû>/Š>ü|« ®‘+ñó9lŒP4 >_E ½‹Wž¨2€n»Ñ¬´vŽ¤ô`¦`ûö(älŒþHÇLì„ñdÊFàÐtôED¼µ¤6E€Â›:¶º¾f/Ù¾g¼Ã§íº³S/ßI¦§ÜQIJoR8¤-J€ÃX«rICè½µ¥–ýÊ#Ú)7«:`—"'ÜXA¥§>Ù³Lÿƒg1îêS¯w}õÛŒ¾öw-]Äå8Ž8§«÷¹øŽCY6ŽC#k[õs~ƒµg V.C×4» VYöPþ3´2!èþ˜#:àÁ²Zëqáw›©xÀ€TúêL²R µó4º4 ²¢ÛÎâ/š~~Vœˆ*µt…~;TTŸS™>©£öõ×WíY0ù>(¹(TªY^»rÑ)ÐBÚ€~ˆ)ýмFÖë‡ñ¤ý0b?Œj?Œÿ¶xÀlrÕð~Ž§W6µµ‘\ò3.»`ÞäûæHã‹Y!Ì‚KamÐñ ¦s2÷s»Õ7,Ë«aàÈ£ Ög…·³OšŽí~ÓõÃt¬‡§cOyëbö¦¯ÊÆÀðt¬ÿÄt,+NMÇ+¥@ûðÔ¬7¥ê$b!å{ûÕ¾}o|r¸kù…ëgϵ–ÜHÍÓ^É i ‰QþFÉI5.ÌÿlçuÞ@LÍ×âHèp$ú=¯ÿܽ |”EÒ8ÜýÌ}fŽLfrg29€f’L!$„"r ˆ·"**¢¢²®÷¬«¾ÞëÎ$ˆŠ·àñ×UƒâµËÊ®"«è»*™|]Õý<óLw÷;~ ™t÷ôQU]UÝ]GÌœv@Hè“÷‡¥D®ð•gŠÏ„z}Igˆ?`Ôð bËéÒ‚õ¸ê ¸ß’J ð|éÚwŸ¿iöâ+Λ1+<©4²åvþüÐoÄQ½ìå—…Ï×OèÓ9:ù¾®©`ØŠt6xx“C™CðþÂã@Jü2Œ¿Há]—›Ñ‡1#.7@ö‘Õ«îرù÷Ý¿»lí£±mqÚt*u3¨~}jâY'ÿyôÅ•_ÏÏ¡q-Åh*Vî¿¢œŠÁõZypvúsh°Á½ƒß¹hýŽK.ÿúå+îî¾mËáé»·mÛ=ýð[o¡ŽÌþùÈ ÒÎ=Ý1×­s‚8Œ:UNªHÙ“78 ¹ ² ¼jGRà….‘Ý¡îÎç—ÜŸøb{ƬYKæÎ?÷ÓUï@óÏ«þø^ãAîêqDοû>Þ³ƒ·‡‡[gB¤hOñ×¹ˆ\ u§•çeÖåŠìAQ›³Ë‚üø)©­°¨˜ÓXËêÖÙÄ]ˆ;";gˆ¥¡ñ._[Mu $½zmyyaÞÌRÓú3.›°´$gFÛ´©ô3fŸX;Ö7ª¶ãVDô¨ Õç´µŠ{í.¼Çj—mú˜ÀO òä>€Ót\Jº“¶éÒ!8¼Õ^¯x‘‘÷« ¾B>·’@ðÙÝ7äÍÛtòey?»ý÷4Sj>oéém§d>öø¦s–†*…ߛӹDÌi' ˆ1þˆH’ÎÁ«š“¯ÿœœŽ£Í©T†×c÷®-*?êªÜ17?rÉ%18ÍšVÕ–} Ó)gê8ƒQ¹SäÑÍ ƒ› ÝðŠXºž9:2¨œA/ü¾8Ò¦¼n@úRo.©>‘¾T‡‰KUï$¦õÁÐêT[Àbi³Ý˜ÉŹº×ÉŽBê…Ñ׈¼‡9Ž» o¸TÿÆÔéÕfc^]]‡¯°µ÷PoÏpdy‰OžL·>|Çï§ËkÞÉp kF_›\¾fät>auŸÑ·äÌ*Ö,bF4½ùs®ê’“©CÙš³vE³Ý™Y>¶fö¯zÍšL~÷éËLFHƒ ›[µf7_³OY3Oÿ‚F¼ÉÝ‹†”ÏUYF‘å) ˜¯Ó/:súœFKuæ°ß’Óþ‘8;=cÒíl/\sõÜiTsé“còsù›À7Òkè{ ûRg(!¨å—œ å6>éy …„ó _N¸ã…ó ”x;ÄMƒ‡ Üé9„‚+G5Î.&‹Q=¸¤, ò€†?~ýÚõ9é%EÆ«ôs.¢Òò²ŒµÒÖÄg4Dׄ›7\6¡¤æúÄÇ"vá;¨Ó‹ÜcZÆì´xÜóÀ ™æZn[d7ñk]H#Ǿ¢Á÷<tg±ó·Lï‹šr)ËñjmÅÃÝú•—Ÿv:•F¬Y“˜w=#¨Ë¯\¶ä±7ex'¾Ãœ.ÏW%q¾ècÇânÅœÑ|Ú-Ìq¾Vþ²‡‰­¨Yx­šuÌb8g ;Š†è®ç›BÆ;õ g½¹œþþÜsßV7olqû™u g/|Ï¿‘H/“"Ù˜{(‡é/& OKO÷úM6LŽÒmó›àƼ˜ç"³C.²¨ |’õ©!ˆƒ% Áðô\lëB"¢|`¿`c‘Žv\6'Ff)½“L‡ÔHum¤’Êþ&ܯb$5 •¾S]ZR{ʉ“&ŽgÕïj;ç\{Ò)§LýcÎ /6ó®…S—Zß~ÝË'›ìã.,ŸW^ybmygÙùK«j›¦š]-ÇÔ~P*aë\Nº )÷%â7éà)åñš¹ç Þ+ÆzX¡+/-[/–&›â0.Kò1²oLÒðH¿ú4n:bW–YIÃUè0RàëÒ+ë*©›2~tS~Ë3ÒsóZ;?7Úl»»½cÊ䛧Ž]ðÆc7ß>r´ÞZ7¼ÂßÑ<­´.'qAC 8«mê%¹“ÐG6ñ}Î…­oUx¢ÝLÌ"n°+g×fî"ž'üØféI3wzj.aùAÜ'ÐÉMÔïáI;)O6÷HÉ0,ÞÆ¥ù"Ï°X߃(_ÛHW.¬Ïˆá¸£Sìâ”Î%­çŠáÿìm´a_¿ŒJâ˜ÍMQ©ù•èâ³ÎŸó£©™–²àÀͦXN·3¡ìGþt¿ˆ@dñ†E6g£)–uDåeóߟNQt\F÷® kÿ‘ÎïK þ´¢^f²ó®MŸÉÄÔ¿  uk f7Š©ÕŒ&3c¡ºFë2bSi@p¶‡ƒ}À]*”Ÿ´|»ƒšgÍYæªË—/_·¢¹ÊlΫ«eúOÛχ¾ü2ñ\âêJ¤gïêXû^ÔAW [nsF˜‡Ióm¡‰ÊÁ_¨;Î<\yÔíèv¹lYìßuÇÅÕ§+¹§RA›ôVTõ¹n#Œç ¸˜¤Rc›9íª%«®^±xêưÙòq¥Mé_~™zo¸bçhÐg0&“¦m<`¹¢X¬òˆgðä¦Df‚%ñÇÝ4 Q̳{8ìœüA>êêåÀKÈx B.ů¹ÇºøŠõ×m¾·sCMñ¹g—J[žòlbgâ7´¢íotæWü³½¯PSÍä7Pþ25ÿ2ËR"-q/î‚ì¤{'ßMÅ%nÊ *•[,ËA06*†ÖƒGþlg—Ùv6LQ+1þËgGäR“ç ÚÏ2´ÎÛ‘qîÆsW_·Ö±æäÖQÅÓ†Øs²*ƒKÿÞòÙ›‰ÞÄ¡WŸ_ñíÈ™|OG^_ äzÁbý_#NãXóðÖà­j Å-v—§æŒ¦cœ ±&mOÌkE xòÈâö•æPWº¢§Yáøœ‡X«$;÷!é ¦¤ãëyÌ"2Fæ8cZ/¿pcÒ¦‘†ýÄ /Pý5ƒ|Ù^ª}ÑR:ßyßu×Å;ƒ—Ûù4³`ֆő³?këy?ÿ,ÙΪýDyÏùžá+›I—aäy¡GzeScà- œøPžÓQ V¶q‡ˆÝ[†¹9„E-¸«#…E‹èªË89ûTƒc£d®†Û8cÙ`i›éŠúñ.Äk,¼–¸ºÌ.Ô¥Ùù9 ïEÈlºizfºBººlùÐ.àdÖó<5x_$ˆd:Û ”j#B/Z;ÖÍŸSµhé5egÌÓ$þ*µ ­lj{hQZà ÍÈêl]^pÔÛ[hÑÄ’žòEÁÉA×o×ù}—Nh=cÞzý¤!óƬkk wh#ûN”~B¶Z ¿×öJç -À´>ø‚õ}¶#†ÂïSÙïï`¾©Y~Ùæü´÷’ãˆ8úÇÓH±£âqD”ø10f„cvùx)à•¬¡Ôàæ±DfÍØ8ò–ö{¦Î/YZ·§ëó¹`ú¾¬lZåÉ¿-ŸœÁ£0Ù/üÔ[Ts‘RçbègÓ5p.1«]9¤Ì†G©=£öÂÈíES ~ÿ †iòŸPܼªpbq Ï<(ËÐ?`΄W¸'m´XH§¼/*OÜ”U¬“£â—À-U<—ß?êñÌÆØœì Rú 'ö8±ûrb÷ó{_9½ææ1½Ûá›/Ä[]1>g{œMåAŸh–ËÆ ’âàuëäiD0-žŽ…Kól<Î×¾hXÇ¥#óª ¦•Öçæ_\k2æ×Eø±>ñ¿þ[wE¦Vx3NðäÑ¥aG"*u¨Î÷¹Ò› Åä™$ìð°³Q2³Šá4eT‡[X'C ³’”þ‚, X¸+Zèèö0±S$ ŸKÀ~ ‹9]°.Y Ý2$Â…lÛpP` sÉ 3re.(âÊ.ËM“‹67\Ù>Á¨æ܈«0|C¡c“Ñ\í+Gé9еý>q- ì‹_b´æ'· ºÏUlẠÀeÊ&"û¸ši€×«‚úùÁÚ.p°Îå‰P,Áð¢"\ncš‡{ IŸ'Ó º‰eƒwN}̤¼mˆ›ƒ£,¸rÍú—Œ™;oôèœH^prÞÈœõkøýAâ_ý¢0zAãDnËùF+…äV±ö<Å6Öž1øÚý@6Üw»¯½]K`íy|íy<ö£ì_‘—/¯ÝkÏP­=#uí~Œ« Ž„o~‰Àæñêk¯îÏàêkáÎaÚ{zT±K,d®*o§†ûrw™ñíÙ¬NÇàn? ²v ɨ|¤ô‚ÑE˜aLx3ƒUŸF[/"L(qJ¤V¦„;Fzw+ïß<ßàÕ\Ä•Ç`s1%çb:Э×eÇ3þ8É3îÂô™@fô}†\›»eAu<§¸Î™ô½â¢n»œ"ÁÎ}¯¢FGÔ ä€÷‚˜ðlRÀܱ,ÜË©¼Ò9“nY€Oî“'\³æ¾¬êwKÓõàœuhøšóÏ`€Ú?:’ôÏbs½[úç‰Å¹Ú„–Þ…j.¦6ŒÜˆÖÃçj2‹¥=éb »ÒîAg­¨ÕÉ3¥(ÑHõèã"¹×-+ƒRvßvîúζ•é³Š†ŽkD®ü“§¼  m,Ì®N<ÁæWÒ—‹vóŠ¡‘û2 p›iFR^}z ÜS+Á¨OåAè¼ê<ü‚4?õy#^dÂ1”ý‡›£!ÝjΨºÿÈý÷Y6âŸæ˜´Úé#´âž@‹ÏEÁ¹å°óØN>„îCÈp ã&‡Ý GƒÊ@ã-py3*Ùž„O ’Mæf—ç´T•ÓVLÍ›QE1»íây·Á‘TjÂ,·ßÀ¬4h |ߤ”ºHW&ž œéáp8žƒ/À1R ueæ`W/D¶ ¡VÐe²ÙY«X¾þ@Üêò«qI8fÕsŸ§!ÁhvO,Ë|®>s™JPd&~®#a¼ ¶®x:/3‡º3Ò‹¥x1ö5à ÄÄö`Lì¸{³cñPD|á?»P4Z+Ñ}ÛÊ7äG„<± ùqÇóå_ñ\®Ê¨£2–f7"j+X ‡#æ¬çû´Jú'«ÍžæàçEÉb¾æ:»µ™:Œ‚"çD²@‰åÁœ<¤¡7\¨ËÉÈ0ÛßiœíkXоvÉò̶Ö§í“V¬(Ô²l] †Ü÷øªØŽWBPÇÇœ¦ÑÞ>qXÑ'<Æ8Ï˙ͤC µŽÀ@|Hƒâ£8‰Òþø(ø8@Z@ÊÅtóŽŒ"Ž ·‚ ·@ç¿> þ™9>úª¦?2*2*Üñâµýnd2‚Ç@†ѥ˄ø×I\ô ʦ…*êó\.£õ‹Ö¾Æy—.Z–Ѿ̾Ý6õÂ%C4Ú¬Z[._ó¨’W£`Á´Ug–^Åí!Ææwhó™ÇNiw kÚ,ã˜ÅÍ ïÈÂ+o;ƒ¼3„ןé íü\;Ü€æÃþ-VçKЂ:IjÌnAµкì6ôu;ôÙä?NÝ[M§7+^–8?—¿Ú:EþRôlæž/à©&÷4RI©¿¦TaÀ0èk¯*®Ó»èo«.IO<”÷ÛŠÜÞs&Q%k‹šL2ê%ßÝw…GXsjžG9ù82djû‚ÄKÑS÷FgGd˜¼¶¦ù &È01 ‘'€ÇÕx‚%^ ¯È™”$€ã¥fådñÓ±@T QA®lØp étìaT»*¯P£ñÐßÏHOÄó.¯tZguPéðí¶²É—] §·^¼®xˆÑžóhbFâo B™Þê¡öÅ;»dx×åÂ_ ÎœL¦?v4-sŠ¿Ö/‡`“¹fÿðÝÛ‘kP.®±àa¨dX~Z=Tµ6½u¥Ã×z|éŠ*TŠÿÖè¿Õq4ÿ-sŠÿV·Ù`M†sÃT¼ƒ;q©¦Ã¸¾±ꊕkT‡ üØ9ú_š'…dD5Ø>/ìKç±ò¿@NB2«sŽååýÛïíçÂÝä6$³Ê1·a«ºýJûgÕý£¿ï¹èŸizš ØCìEŸ'7e¿tç3Gƒó™ÌÛ7ö}#õhÆ9 é}ZV®Ù9•—êW~X¯n?V)ß]3xyOöàå{ ^¾·I]¾M)u‚º|»Rþ^ËÁL³Hz‰•¯odëÕììÛÜw)+¡_ùá¾ë±¼›•ï–v8t=¹r’hv÷­é»ûêbuoˆº‡°®§o­¨ƒïÝÅêX@Íø–øÎf^¾Ê÷Â7XùK¬ü^é(_ å¯öÝÑgýl‘^„òUPþ^ß('¶¾KÞîE<Œáëî_~ø{^ž6=¿{…ƒ—÷/ß3iðò½Üº¡O:áw5E¸&>Gøe²òsxyÂ5ñ–ÇÙºNFØ]M¾p]«‚kj]®ð½“DÝw„CVý½Ôº½rÉë+”Ú.ÿá%è0—•ãå_ ¼¾T—UÊwg ^ÞÓ;xùžæÁË÷úÕåÛ”òWËÕåÛ•ò÷<¾9 ŽÛŽË8|¿Pàû"/¯ëßGiÞ ðM­K…ïâ.gø¦Ö)ðEúÝÊèꆅ‚•½ðGFÃPWH*ÆõBþÝÿGD¼”q8xXùɼü_ˆ—yy9–UÊwÛxùÐ~å=ß Þ~Oýàå{½êòmJù«uùv¥ü=K/ãþ×…ÔxÉB,¯àxáûa+ƒÅ„áuÔ)ðr±Šg‰:›À‹\ßkuÅ/êï¥ÖíUê/mˆ—ëhp¼ŒA¼\G‡õà ¼ùß‚ðq¼LPû®`9ÇKB]>V)ß]>xykðò=3/ß[Ëá ö9_J/³ò½œo;ž€÷¯yy‡ó·œo÷}£ù˜•è–*¾Íê>uŽþ|›Õ=ÍëÈ×DáÜÊ÷žu𙎷}„ðÊ×ãVèxÛ‡¯å}.Ó/ßm¼¼çÛÁË÷Ô ^¾7C]¾M)µP]¾])ÏÌáËØ•f#Òëmõ\þYdù§‡´uù¡MBÝ ^G³ûÑã#ÚeH[·QŸ ­«m͇·%„É“E«ó„ŽÒ¯ü°ð¯âíÇ*廧^ÞÓ0X9à ¹|Ðö{ç«ÛoSÊ_]¡.ß®”¿7ʉBé ÒÜ]Yœ3Vàö=/÷sZüFÑ! ÝÜE=ƒèuƒèœÞî"ÿèO‹¬n—¨ûj^¼MÔ}>Èžïu÷Ûó¨3ÎÇu&ÒR¥Ö¥Z”ò•U*]Û£®AZòÕ:H‹R¾2_%Û°=Ê6Ò"x—Í-²l&+Ý*ž‹í‘ç’¡›p™Ñ"Ë ²Ò¤âØ>ÆÛQó”¥|åy\Ö¶Ç=«äÏgå3±ý¶±½QEØé´LQÓI‹R¾rŠ ·jm@щ AWvhèri?‘uæÔz¦3¨/ä:¯êwWóú¿þB}OÖÑë÷Ì?zýÞÆÔz>ÿmÊü˜n2?^¿]©g:¶º¾ïV?CÑ©\׆šl¬¡_=êܪú.V¿Sè×÷h±»oußØâR1FŒµyV´yÛôÀÁ6ëEèg׹χ{”^¦(õ7(:y€ï$¬?‘ï'V«¢›ønÂú™BfTkoTtôßQXÂé¹¾BÍ Ïú0¹縓¼O8¬¶X>ÏÚ|(ÚlÄ6‡É&Ñæw)mƪÚì&;Ù¦‡Ÿ[ŽÚfùò˜mö’—m³MÕæUòç~møÚ·«ÖþÙ‘ºö¾l¿a\‡†Ð] [|õ>Váõ„LâSQÿ“ ]®ÐKsÈ4ð—$ èòT:o€óYló©hýd‹6Ù.J?«úÉQéÀjjùD´aô¢¢Ò…ÕóÕX…*XM5òþ›ÏÖ]¢ÈÃB“¸êD–—©õL^¦ÔóïUê™ÜŒFÝAåOÐ=JêY9fè‚Œ¨`j—!b‚E’¡.8=0ÜW^žaŸ\9Ó_Õ\•a“î]i·¤§{K.°ç§ûàM2¨1*1,R¶ÿ ê`¯7yüøXçd…15“ßfÙƒH{â:Lí ¶Ú9´,^À=cüCÈîi´@ºÖhú\¸ºÒ¶¨9áÕ>Û‹ãZ«‚c¥õ-••-ÁÏkƈV¤û6a‘J¦´¨dÊ—d[?yúkó£ihs­¨»'E&©¿ÿÝ€ïó{Ÿró”ÐUŸí+Ô™¶&W Ú¶‹ïÞ-öp„6 M)æ´jÀrÈ˲š—gBùk‰#Jû}X^6IÝž­Vz•—7ñö?âZ½þ„´½ñ'>òSýF¥Vú†f,£Yˆé9(zq‰ Ñ6I^C]ykS ®3ç÷ =Yú³ Ýå¯@÷þ5}aÂl¥³Q×%;;å«À‡ØW…4–þ]³õS@:I47÷‰#1Cþ7ØN FØ~ôôÊt ×`,3²Œ¬N\Sì²Wà>Id¥@f^˜œ']Ó+©Hožò•±ÓY9;?˜_\•a/h\Òh÷•œ™Þ ]Ý’&v‘Í•î›î¯¨ð»ŠsÊGyUg ¿|Ö SÄY£ÎÈký y-œ£‰Ïs4ÃÅC2‰b‘šåhÖN-ºÅ=|;„”€öÝ™'8"â o¸5VcY,- }òÜiº³¡ žŸ¦$]¶¦±MéäŽEnôœÍæ9†Á:ÆWÍwuëL9~„š{V4†úÌÕæÊξ…è<†¦5N‘£ÐÍ°*ïÖá6Ú±¨¨¤¤ùµE×Tͬ¬œIW\ÞPR7«ªj½ç¼ÄM#Ëó§Pò·æÊŠ–Jj:ñ‘šÉøqxÜý+¾ï¦_¢¾qÝ[¨oìMòð…È{Ë'¨y2Ä8…—·sžüò¸ZÆ/ß<&¿„ä¾@Mµ•ÍÍ¡!óBOó}·µ¼b\Öy ÖræûkúÞ«ô¼Wîë5ï= ÙNœ$xov( x¯%u†czF4i²NI8ó™ªÒó:xv!¯ "lé-iˆî4‹ÐSô"£è)©jŠà¼0·JZœQR¡RYò–Žªw]˜e׌¹0Ç%ë.'–Wø‡yËs‹’w©~ù^†N÷2~V>y¨yn+¿HvÒ9L !â/½`òÕåƒýÇsøþ)åû'jwäø€Å Uâf²ÒÐlè 4‘Í-‡ïB¾‰ ƒñ® ƒ×ý Æ}Ù¹°A²œ1]ûYèêÖ;ÝøÎotv›óCàc‰+VTŠFë˜{•òþ±‚ÞŒÌÂbîùÞŸ˜²%ŒÑ¬ÀýÓ5?nÚR½ºsÈ#9›ZO×j~È«j=ºUšõ¬úqmUUmqzJ⑪aSNZ»é7ë·7äJ·`Ëÿ/Ã,æË˱<b]ùE¥õÿÌÔ|{0˜-}aáMcÛ…Yö ôWÄtÂ…xÞîþXý†XЯüðÕý"ò{þ&ð”AM¯#ìƒ$BÞéûûZöô`8`û´€žÏ>³ [—‚‹xz*:j †3üèð`¼†³þzŽnFÂA€y–³[—_^‡»ºÜN?&snÕ›CC(®qu—„kác?´T EËÜX~€ý,9fJ‘qÈ9Çàˆ*ªjcŠ*æÖŽâ-Ëš”ÞÜPXÕòÙ_è訪ꀷ[¸X™íBŸrnXo(ðƒ9oS•¯UÊ_$7"¯ËÊ/G^ßæ2ÀƒåÃYù&^.ôòŸ±ÞbßÄ{ª›‡)o±x.›)ùÙ^30)ä&3Ź̮œË\¡n‹AcTâ¹1N¯ÄHãV³pãf²÷¨“GCƒðÝTkãYWdè:U¼¢¾ªµ¹¹uÞ ³F´¶VV¶JW `ÿµù& Ïei~ê}Y_ÙÊþ¬xaÎ+£›Ûp‚ýw%Ã¥3éxM ›)68¼q_¹ôÚ…ë§$ïZ”;¤/§¤Þ1Êê‡Jn¨·c_‘Á¾÷Ý”þwSp§ïSÞ~žwúOŠ» V~iêÍF+×úþ¡©EÚ5©õ†jVžÆË}œf²ž¡qC9½+¥}#£¥oyy¶ï3âø'Á¼ùWfrÆ”DŒ&'aÙ×øµôÌú çñº6òö±î2@dGÊ[Ë r:CÒ»måmÙç-àwã¨$}Gײ¾Ý$JØ×Á&Y„Ä <gœô•V¯F?¡# ]ù m#ØvçÖT´=ñèm5VhËÖ½˜iüt ÃÄyC˜^3¶o¨woFµ9"Ò•LHƒ‰FAH‘ßüüo¬´²w#üíŒtÂý }šü¤ñ3“~”!Ò7p1!- h)¯CkNwu €XKê Úg•—ÔvÖJ¾a·Ä²O®®f}5°¾ê¾4©}iÀ…ÏÌûŠ”p )6`GíôéXÎI55%Coa}êë }ìÔx}y“}}ý §T2dô-x†§OK l^’Aj š‘C´HØæconó8‘eÑ VùQ·+–æÄ1màâ!ÄPD›³}íèS§U5{fYidÆúí¨`á-±œª’êYšÜi5Õ0‡QôeiŒ&—ÍÁ‹sð¡G Á±%00’ƒ‡0à+³`bw)‘îŠÙ¼©0cçytâ“=¬„ ìÉžýrsÃÔ“kòÛéË ’lùžÊ’›b9Áö±¬ñ&~ŸÁàJF¸zHA³u²0;-‹»8œ½j8ƒÝ:D¡tŬ5ÔÅdä£Ê‡D&×Ú]ãî«鬱¹*V«GUP¦WWt€æ™Ê 5Iò|vfU|t ý``âR’×üèLÖQmh¤h„çµ#ªüÊ΀³æÉ›Ÿ|òfzûºßüf]b)½b;£Êƒl§-ã«h5…!¦bÔêÒap ë;N(8®Fm|Ni!äûìT éC!Œdd´²s¨ÝUi&°‹ïraö 1¡›Gìà0†ôiŸ1a\Ó“OÂäØ?7\vÕ¥7ÜpéU—Ýp›ßò K?g»ÙOØ&†øëF0Â5"·Šëð«ØÒ²Ó¹¶³s Í\Íþídœ ±ï+é6&Ó $Q[“ˆŸjχ¡;+û¾ÙâÁ5’R RÙÒ@MÂ8êž4$G‚Óp”þ?ÃmápÛ}øïý¡¶êê¶ü¶P~Kþ 4g 5}ÿ+='½ÌffE_ábRAj¨FäÁ+Ç2ê u9Àø¶X [cqË¢¹L[‹V‡cV;$÷§[¶²˜ŸÕS¨§ÑZTù´”¡(Öï[$/ÅÙw OA™3é¦Jø‚¼ 舅Ùoeü7FW4ß–dј†Tî&1¢©ÜMcT‚Ï­ÜÍj%Ê#’ƒ#2‚ÈvÆÒ-‘•íãúúX°„Éþ!õ±²0û9T$«ŒMÚ¸PˆQ?÷à*vvÛœù…üž¥Ø«órx òè‹Õ%…’øéæ;½ Vü^#]˜Ñ»‘¶oi7éŽñwÿ‹¼ nwczüûfû–¶Ä;‹<ìó(:íOc·^Û4ù„+&Jcš:']11ñó˜Bk>½¹…ý(HXXݘMl.ô·`\wâ¤s¤rˆÏ©aÔkhܹpݺ…_/ú`ôëoŒF9XÍÚLåmšhiÄë1T_rÉü§ŸžòÆë£?XÄóyDÈ5ùŒÓhÈhÕ0B ‚H|I¨&/¼aûP/HÏ ímþ™’‰}â]¡Ïù0õŒž”« bϨÄÔˆ„Ý´”ÖI£O§–ü/œóâ­—?z}Æ_§µxþeYY Ýi—Ø6­uTå%Å—¬‚³¨/@¿”¶2þ`'N’Mºå¨‚ú]v"RºÄ3 Lú£?O#ø1MÏóÙ{ÀÕă§2Y<Ï ãçà,…žN÷ýã*%’«“'GM þ¾yý˜œÎ5MNȳÙ1ÿ`45“«Û ™xág±s褣F–ÉO UÃ!-ƒN>É{ îp©ão–ê=¡õ¯O¬žøJgë • 'mŸßšU9mÈ”ÛùW%.z{êŒÙ÷-.ºÃ,Íÿ¦wKîÂÚŠðH†ó¦›\~L'ˆ˜?Ý næá%0Ó]¸÷YlL;Áâ¸^¿Á»ª^ƒgAþ ˜!‚ÿEü5~ˆ_ï÷2¼L±S}вò¾¼ÄnZ[pÏJiìïÇe´ŽÐ5N¿7þ&%ófLñ¯òŠ[ÒÛ‹iæMã'77ŽŸtvóäQõ¦sÝtËm"Ê圞ћÂQ1¬¥y´PرÎP\«Ã¶…µHc¢¤ íÒm?À6¦]º1„´ÛÉTÝtŒ(–ÎUKð0fúYÜÂï°0.R®Ž‡ª1ò©Bí„p5騆+ž¤Ð2ÚÔØظ£ç‘ûwÖ¾ñÆý÷—<>ç”Ì3O¬_BO:ç½sëO<óÌoWÖÕÀ½9ãC…Òÿ²“S.D=s)1xÁ¥8ýqâžž( ¡çµ7Î×07C2T F¯eÊO¦3¦³ÕCV®4‡ßÍm< ø†hš'Ã+^ jäÔëùíd5D0÷º§bùü•[—^¹dXiñèæŽÿÛêºfÒ×ôÑÒóoº¡é¾‘ŽåÓ‡~sÂœ†qŒ×t0¼ü =…Ú0øÍ~""çs8 ÏE<!Üå†íÀEŽù>7Ûe^±Ä¢~òQ¯ÈG m&"ã¹\›ÌÅ ¿qçEÅœ=7þ;Ò¬™ñ"Ë®˜¦êG]T‚ Ø Ï c¶Èl(g{ŠõèPËu:]Ý.¯/”HS"»ÝYÙÈ—¼™¼I Ÿ)šV‡/¢ë¸;\‚Á¯4Œ\¦°qe`'Y§ì¸ñZmî¹oÖæÑüºGëªúᎴ°Ó–¶ö~qÇõ?ôN²7_ÿ-]þá…+÷]øÊRàƺú#è;Ç4š#ÒvÆÞ rΟX£jêÊ06_&;éÓC§Q7ÞØÆõ~9~ußt¨óê¤ ù1jßµcÔ—ß<Ïãji+c’ÆȪì1kåQÛ.×€*Cþ'I£U~Á6Ü":µ‘‰D¥^¤öFÂî@iMu$`”ð 7%™úÚ›Õ'ÀfTwƧ¼þQ¿ë‡&¿Dýý%t=Ö—&¿ÿµúûKè:¬Ÿ‚߇ú3sR¿ÖÆú§XýY†Ôúµ„¿5+ã÷©ëO£c±~¦RvQjý8¬/L~ÿ{uý2ºë§'ççO­?EÜ»*ýW¦ÖÏÃúMX¿•ÕŸ;w°úròG¤Ì_Ãê?'<×öš1ÒìD]À£ˆÁ Æ¡°á‡°_œ<2ž›z zÐÞ2ò©a8ݸyù©S%SïO —o¦ãiç̉íuEã&Î$<Ö»¦DêbZÙ¤Ëý²Ã›§¤gôˆ …­xqç8GR˜Ûù9ÎÎ…té²×o‚igZW”îanáÂ\ÃÏxÞ¯ÿ·Ó8¢ú]1BQ ¾±ãý;_{#ãéÝZ½Æ]Ö­ƒw”¬}í#,·;º­v +·Á¿]ì_•K­µ¾‹5Oõ±ýÕÚtz‹UpÚïwqÚt›¨¡´’–²=o§i´Š®¥«gÍ^í»1½¶j½†Mì]0Ö?,7QFßÉ*/hãçÑQ 'Èø0b$4q‘+ãÕ1?’–iÄĎε‘Q’iê© +7/_ØIMëíg&¢‰è̉ãŠxßÁ¾ýšbév†“/;Hc’mŽ]¶TtPŽ*À|› ö]Qêˆj9:¬6hg³ ´m”ÑauDM v#¨cŒÕ¾¿^€:º%ªe`×À¿;J–4™Ý“•!‚ժனïbŪÀG[%‹]£5 ¤ü&c âÍ£^gØ Á¼48gNUmú¾šªÙ³hÚ‚¶‚ò,úN¢,·<ì‚Ä^£áĤ}Bºu¯¨Sl…Œ ½y¸cÄRŸÜ Iˆ]qææwJ«&,›´™ž™Ø´yê’‰½×užz"솙uã ýu3/$vÍl_X4®a&ƯÍÑjÖLzâÅ Éq³`¶.MI» '‘/„WSGLæ3Ø[Ìý·Œ`Pl »Ãåå¯ß¯à2SK;Ç¥½ÿÖb›Ï¹‹éáF®Zc[¯Úú¼bìß½þ4oëuDÓÞ3L@³Þw¼?óµÞAñ.oC³£Ûh6°rü›Ü¶NGwšÓ-o|í –¤;º3Ò½ŒBXK…ë’LÄ‚¬ïbÍU”3Ú*™¬i™­ÁèL¯Tý¡¿\%hŠÐìèRyƒsò*Gò‚½=‡oõªŸ µ¶ã©I÷Á._À÷}~ynïlFxm =HwcÈPM¾t qxÏe Ç$HT…jƒ9q«BppìQ"î÷ :yüœˆ»Øk€×Ô@ó¨'ŽÉ–š?pzG6Ñ·%Ìf£¤_CßÈXg4'[D§ ÉËÜÀ龂oa㧑±$ª Bd =¨çz¼ÅÖšxêNj]&LSc²šø¥\æÄ v˜Š^'˜S„ê ¥ÛP Ii}»iªó³´4c“^r%Ì×Óif㺌DÈ´ÁíÌnM<.Ïé1KãøGëiy4Û{sFN”–?sÖ=gáü‹ûKoiFãüÏçRL¬€gD"R8·ñ%9ùkˆ…‰Ì$ÀÏD0}-þ&O˜åÿ<“’MǸ°Lºy6¾†¤ì…MeìäJ1‚Oi1N§?œí;ìÍi8ýÈé¤ :,Ñ“pdäädÐC½I§ØÜÇ0ØÿCÀþR‘9ÄDÝÁ¸6 {‚×Fn›o¡õ¡¸“cÂ’gýÞèN6mº>Œ‰H·ÞÀxÒ˜Á!gç°É& <<èáìèê¯1ÑaIÄo¨`H“E¿¥W$NN ÷f—K ´¡ô>÷ÍÍÞìhâÄ;ÑÇYÏ<ÃñPÚw¯ô¶t×r+;;`¤1¾[0šŽSü…I´PHØ"À9*ÀÏQ€s Þý^…«Œ&Ôeôè¢i•Œü¬L³Tÿ#LVX–¬vÑÄ’<<Éwòa'äÑH{aZêÅü¾¥çxû²NPoEb?Ízª·ä‚ ­:¦pùƒÖH_;ÎQä3 Ø1"Š!çù4(šÎÓ}êC Aüô—Nå l>g—éÅ[”l°Á£šéº<’dbœ“‰ºˆ“|–Ôbhòš’@a}hÆøK¦¼|YÍyeÄÊÏÎßÚ°Nj˜X}ÛuËZæ_»¢ì¯/L^?iä¡Õcî*ªã<¾¯ãõ[àýÀL0‚²’3%¦15âS-¼Óª^fáõM¯>VE0iTïµ~OÀ ñ Î iqÃ/Þ*5^xá‘ïšü‡Ë—Z¼¥ll+ +ˆýçgHÔ²Í"©®Á•0gÆÒ«‰”²aü^;Õ~õ•JÜúÃtù¹_8÷Âg[ž¿PØwŸ¥ÙÇ°ÙHÿyÍðŸÉcç2=ýOdþ äç¾/èrZÃBŸ`d˜­YNŒ¤Pœ ôAž˜P 3Æ  ³Oº#nÊ A•¿?Ÿé¿ù4±4N_/OÜ$}¼ª×ŽVcÈ9šeL˜¤c6¦S ãoð@íe$äÙ…ÑÀÈCˆ1ÎÁo©2hnù—Œ^¶jŒ6wV¿Jró[¸\g7%3\,hø-i-ÜÃyñ)€‡–„kf•ª¤„±«êÇLZ±ijñ’–NštÆ Ë‡”,¸´êÄŠ°7+\Jí¾ê¡'M+þéŸÎZXY}öÖ³‡WU†iåKõõCËÎRþR=‡U¡Ò¿¤å ú£”HÝ`æž ¯wóŸñ:Y˜(f†I:-¿q2Ê1EŠUu%-´³Omí÷}poÇÚ†%«–4P:küÅãÙÿ‰è¬!­CØÿ‰ØxÅ—X3?ƒq]9?+¾¹Ø Õ0+鶸LÆ2 z…SÒ1ÅNä¹Ç'#Æ6ç‘þ, ”ú4xAˆ™lÂKÃ+¢ÙÖBÆ€B½âè—•Ï-óÚø²Ê“Jß›½ó´ôübé¹¹‹ü§¥÷6>ÃùÆHr‰t=Èæ6„: ;#{#QGó–!‚œ—}*ÓÈö!;fª`r üïÀÏÿù_1ã]±Lçºhö®>|þ0–;*A0Ä´y¬\¿kÇß=Ϻ{·N«w—EL§w0>šéèÎÊÌfŠÝEŦӳ_“ªz+ƒì[ð#Íúû6ˆl•™(R©íZÞžæÈÌÊPÛcN­Ä]ÏÝ\çÅJ Ù§ô!ì“7‡}ÊˉpBy`3.W)êy~æÔ¢‘9/ßV\_`Ÿ¡þ4±ºmb ¥0V7ÖcÉÌ®¬ke?³²ÖuåY²räß ¾Õ¥ó˜¾áf»µÊ0ª›4‡ *áèÓLD5þˆrß±¿~Ci¤åžIéܳ:k;îx0qÿÙµ¿]3}íU³ÖN_sMålØïd˜äÆ£}—…qAÁ—-±`޻ÊïÞ1¢ 1}ÒA lWà;‚Ma]Åâo})1‚ÿ¶f͟׬ykíZ¸¯Dþz“Ë`Ä-FŒÐ³%&RȨ‹½6j`:¥§™%N£w„)‹N»ö¡3/]y~tÕ*¤S"-8z?4¢óè ¬Ÿ‘ôÎÄ’0ý.aÊú \xÉY]{?ôÃÎU´„jèÅlÕn°ƒ›6•1›bù2¢³®®“Ž.ÊÌ,ÊÂ}ñ;ŒR6Ó4Ld<ç"BWÀ î˜*•1E“™œ¤EÁd`|Dƒ¿aÞ*@$8œé@ jŒ")Q±ÎYì¯)Ö5Ó…tQï:iDâ³Ä´úoK¼6æGEþÕN–JÓé¢#UD“YZ >ôüÎÆ¢di)hàr‚q^»dOœ¿”º/ºûŸ°ÒŒYÈTÂE‘±!#(Ùq¦KIoÑ2Ždd^U¥ …‹7C"RhN‘&NÅ„Æ î“°j+ÏÏË8Of<‘nÖ|Éæä2y¢Æœ<ÞZ‘ ù@Œû™Åµ£`ua…ÅmÌMkûùÇgxn†íï$°Ec(Æ´™Òl¢ 2{Ù¥‘RC©Á;>Û+-¤Ï%{·x³Oµ{÷â={ïÞ=ë™I’ß›x&±3çZ6lhÙpåØ«®{%‘ûËúMcú¥èW„„عævPR,õf¿¹Xî|ñì<ÛÛû ÓÜúuÏ誔è¦I1M¤™af!9—\Nndšúò3‰Vã%œÞJªH%eLº)¿•ë³ùÁø8üÔµdÃmEÞPWþ8h–ŸÍšMÆÎÜÄtßï }úÊP(m vÙæ]‘BÑ¢ów([ð}$6“ ø}1E±Åë`´|*–tŸxj‡±,6Â| :";‘ý8Õ[Ϊ¯àÕç]±œUÏb峂±óØ+±ÕàÇ| {£kµ± ôéÖó=€Ó’*†ÓòúØäq<'cÝìšGÞÂÕM#º @ Ù¿PÏN¡xÕJŠäÖ¢¶&bà¸pCºH‡ ’Œ½ý~ü‡õºHuiDµgù´y³GY‰áF«Õa¥ ÁÄ?Œ½/Y].«´Éêzµ&'ãÈr_VƒÕØeFë«q|œg´Þk5.‚‹X©Ëz&|dÿì´—ÀÇ%Xz6|dÿH¹ãêÚZ£uýéÌ1lHcüs¹Éeš|žR'öY }*ó<în#ØmëVL•á›Áò5,ßjóxÖ¡ÄôJ¶p ‡‘Rñ i@“ÒÂÞIü첟¾¥‚¥À÷qvÁ.[X—ûI®# ñþɀВìsð9‚ù:,ziB†Qûh¹2M>Oi¼ Ë£Ìó»`·-¬[1UÎW¿f}H#Á«=X°ásû^—FŸÄ“éÉ`†$ ]Ôx2©¨Ôϸ6šx81#Î;“cŒ1døo sPæ§cؾ ³qLdAª «—cLŽ#™øÁLjãtŒò Q££Ûh$vH§ŽŽiöC}û€‡s ?ÒÃ%Íl\+Ž;™G#0ý1àéÃãj 2³ÅqMèmÓ­5š˜ÒIÙJiË ~8bÇyà0.—ñåæÎN: ˜=£\%ϯÂã— "íÛ§ÂêlŒ®mŠ€i?ôý`(`ËÁÊwxo 2M>vŽ=}?´8ð´ch{$W’–’°ý4{¼àÅQ(©cûbŸŒ¿T¹Å晲¯ðVžÀ‚ô:yòÈ‚Î::µ“3¶ŸŠ@”Éò[^ÇYö놉ˆaš`à ?1Lá:¤aˆ§08-©–bì7F’@Œˆ:#܈tŒ@$$¨”]{,*†¯*uû¨¯SæÞ¸¹›•÷ ‡eT:Æ¡è FF(p›`þnQÖ¡Ã:;ñ¡· ²÷WáÐ1(Å ûR£ãPŽk›-àÛÿG7!ˆ¹ˆà›‘ÏÁ$ïE…ŽþK Ž( nBÃн…ò”û×Òð``Ž0710+$ÌÇЄ™)ðÕ„û¡RtŒ H>Ú º‘¥5I‡QPtv "EÝWSÇôJ!Ÿú '0ì2éIÊg'ÈUnªBj~>*SA.2äÁ¸~£Ø¸ÃåqSiÆ%l\¢æ¬ ˜ÊÅŽë†÷twÊ7l½Œ¹)º>®WàÁt ꎬ1P+‚•"‘0¹îÿÙqáÍql¼ñ7J÷ï;¤B›8üí×ãÍq\x㞙츰oß!k”4°1ÿr8ÓÀ™ãX8 ‹•6ìó^cêµÎŽÒˆ¨@*£ŒëïšYÉý,óê~›ôX|ÏêÒ¡ñ¸ ªY‡Zôù=tê*Fƒœ7wY_Öœ"ë.`Ê`¨3Êó¥Ädì‡7eШ14ȸ´Ë‚mׂ#'G¦µ¥SŒÝÀÆž!=@ÿçø3²±uê±!¥ÔQ×lIY³¿¦]Ë×}ðPgʺ ¤µ¯þ·@,/•/”óæC⌣™y\xäç‘£ã3ÏyØ™gé>ÿ6qÀcãð´À¨û’¤d$÷äcàÏ0(þŽ¶VKÊZý5#aÜÞ§Õèûµø;6håeâ"ôq½MSŽo(Ó!uªÚdî'Z“~çæãð;D*ôRK2b“¼å.ÎaŽ‚_#®À£ Õ¿f6ÕlšäÙ|+r2 9ýyn*$nßÿd*²3 —“nª\ÿ z~ >ÝÇI0úàCƒm¬Á,ÙËÕ&#(A¦ÝÞ7P¸žýÎe èŸ&sªþ9øfIEN@èûx2L™Œz.¿zß8Ž'^ƒ8.âY`_ÿáU´a#+úïëà{’1ËÛÆŽq- +4´À4¬øhG$+C’5‰$H«—Ö]ŠCÂè}ûVÉ›¨Sèc 6š2yn¿¸‡´ª=µ„•md?NŠZÃ2 ¥  ¡@MDPѪ䮒öu*g‰Ïq~g€U$Sè2£ŽdØpXƒ†e2'ù C¯;Xštë,ÖAéÊ”JWiªý&âÀc*|°áU]E[8¿TøY’ðÓÉð3³ùøü4òü€ÐØ» 8?­#P•ç·&¦ä­Ir~&$Iùû:eÊï,¡íYÈ)¿Ž/ýj¶Q¡´I TÍ ’¸´ù¿v.¿–-DTl¡I°…nIRæóȲcsˆˆŠC4!‡HdjþôȱŸS jQÃãß‘aÿ6 J$Õû¥dâ ´2§VÙÎÀÁŽDcåD'×á%|Ó,Ä7M©ßWs~ë§áQµ`,“v ©s1õ.ìißA—ngGŸC‡X +¹ß0!7NAÃÓ_êCò„ÂÎ@& ;;:áž‹qýÕÀþa= +­üûÕ÷#âûcÙ¨û*öL`=ãØzNëÉR4v-ª ²uÔ8MΑ/49û;;ïˆHxª?(ë7'×o> ¾òÄ7ÜUâ_f“ï¨&ðIàwå*¾$^j•›\è:ÔeDÄÙÉ}ª•UOòU•ëP= ‡”·Ðl†{œM LUF?sùnÖ„>ãêaŒhþÞÿõV+€cl¬·ž`+Â'WÍ0~G.‰±à½ÐÂh Yõl(žŒM:Œƒ¤,Ì*?Gµ4°2³Í(}ÍÜÒÉ6jüÉX~”}+qiç+Ôô¬n;å÷ÙfÏ/dx¼'‘›r¥£ºÔ†’çYø-²` /¬ ˜©o¬žƒÝñ¢üù…‹G$xÜOž_9@韜üéUè7¾ã¸“ðð¢ Ù®õ(ºž‹Á Tƒ± tT<à,­á¯8æÎlèýÈ2ïaËÔ¬oª_á™Ã-‰ëõe¿y*S ,Å;°0§âÃF§|7 ¿³šøùŽÇ§ ©ž>™ËÃ$w— Ú-Êë”Èîìiï\´J¼¾òó³„﯋ðÍÐB&(£±U™’$J‘îd91¢^±'N¥dœ¸Æb–­rOâñUø@;©óx†nfðüBÏ$·QE“Îz<¶tI&Yò¤Í° Í©H›ßZex¸‡ÀÕ©owTb}é¥XÔrý7jߪEòQ_aÁ¯f¿4;ž”ÃIƒ^ÑMžÆ‘=¾ËhQ6„#B`ܧò ;‹qè1tOgïþ}«öwJ]G÷€¶EýŽ þýtWìv © £G6 X¿vY"A¬6õƒª'ù¨š|X•Ù)çýRò~ ¼° Éj¡<9éú“p J¹.‹Vž…j ²$ñIJÈ"5ªñM$ ôšTÙ30†`Z6VhÉØ`"–ìä&&bâyèç[SD‹àÄt8ß)ö°)çí³Bæ‹2ù`§Âé_d¼ з#y®…¢E2½JÖªl”Ñ›äd/èž¿YH¤ì^ðžÈ’|õRÝÓÂý—j’ì6‘c(E¹ 8µ;:;_I¾+éAY®Á;j»Ø iuMàÔÖP¿½´gã8ÑÂ}¢ÅȽ!e›Ž3…{ä`J ÀÁw0Z‘Y8ì‘#„ùƒM ;§Dð[ìÓ/¨ñ2à椂Qm:S©ß"K‡÷óóï=üîdå+LVZÄݽÆ÷' ]H}.Ä7Èü‹¾ABtJ·sÙ)tž´Ex e§IÆ ;,#“2‡Ô˜±'e¨ã—e(Dâ´³ {TØM¸£úáÄïÑqÀ‰´1ñ/jÜ®à…³°C߯™'øǤ~ÒœRûí}O?á#£Ä¤ DÛÏšùX3è¬üžÔV<]õ]µ…L“GéL¡RÂzT)ÑoR–þg!dbLj¬Zµ/)6¶@ Êäú/ UˆšyŒ2›2ßJÂ!eå@%àðcãu‚ßiÔ\ŒC%9+„ ÎL†ÌÎÂ^5!67ˆ ô’ÆéŦЋ ¹¸q ‚-u Pó¯ˆ*³7E‘WØœ,„»rˆŸmçí¹òûKß[™ªùÚ ' ¼ÏɯGUÓrb Wt*„³€ÚGZÌW`y ÖÚ.v¡‚ìänÿNà‘/ é$^²!l綦ìHìHL¥‡ 7jŽéæÑIÎ1Þ!®ƒU§‡º¸:‡Ug„DèR5õª$œÌMaãvnW³ÔÎþ²®‚,—~+Mýoű¬Êê{ß½þ±>1å×õŸ Ñ/†ŠÒ¿;B õl)“õ.|êjXÿw°þ-äL8©±!ÄžçqñUóWú¤1“>EÀµ÷žyý| à qtk5F7„-2ªâ2Dµ•lÎÂeKcrÊÁÕJ1%’×Pj¨ùðÃú¬Çï{òÉzùnsMß>ºÍ5Ý$l®ñ>Û ›h Å -¹1“ßì°zDÄFø5}³3 ¹ýèöÙíÜ n’ðõÙO{ŽiÿM7Éöß`[wt{îöCÿAÿpÏ0bl)°9t( ¦×k梾¡²÷J½&Ñ_3†Ne§Z|6ïLžÁC¨‡¥ó[Kï8¼ÏA]ª¹¬‡6pã!¢²™7ô[SÊM úAÑ=ü…¹qÃÎÇt¸z<vÉ»`Ocu ;Åñä'ÍIs¿<žAÀÐ2a+ƒÓéwŽ×X’öº`®'013ñ ‡?··¤Àî+NÐXN¼²“ŸU4'÷]¡noHiïõ;ý ýʼnkøš4'Æ_naíÇ@ûÆÞ7„màÝä'ÖÞ«à,›T+`_+Íè}è'X|'t/Ýz”ï¸Ùw:à;të‘““ß‘ÎI~g¤À8”}'aÕ.þù.Åvð>Mù1¾3¾£+øé/ªï|y\ßQùDH3Žã;¶~ß±û;ô¹~¾ÏÇw.ì÷ ã;åý¾S~ OSÛ“O´·¦´¿µ_û[ás2á?ZCÒËך»…jã´Õ!ŸH))#A&2’4‘2ŽK&“ÉÉd69…œJN#§“³ÈyäB²†\J® W‘kÉoÈMä6rù¹¨p°ŠºùWG߃ K0šuù#† #«¨š±î¡7¡‚mßaSWß»*«Ò¹êžW BŒ—O[{ÿkPÁ4ÉxÅIÿÏëPa Æ«ç¬ì¨`øxÍÜ+ÿð.T¤ã ‹®‹V1jñõ[?‚Š¢`|âù›_ø *ŠYÅ Üýâ׬‚F£Ù=£MDk´:Òs ŠXa< ݪF›¨Þdwfä–@YŽX e…CÊ«ªëZÛ'BËfÑrhåðÚúƶŽIвÙ;ZvN›1gþ¢gŸ-—‹–S¦Ïœ·`ə箄–˱› åªµëÖ_}ÝÍ·o†–7Š–]rÙ†k6Ýzçhy£#ö$´¼çþ‡‹ÆwîzZî-ÿÀÃÇþôôs/AËŽØçÐò•×Þ|罿øò+hù™h¹û·zÞÿxÿß²ÂØ?Åý¿'0Š†=àXí¬ {4ý~–Š¿îÿŸ´ë ü3áÿ²Ì ·N˜ð)c•&ô~7A:8a‘—'h³&@ñ­øËÿ§ëA&Î&mLîúû¸ùŽü/ù™ôQ 5P M£n¦ÚgÓ| ¥´Œ©ða¡#im¡ãè:™žHO¦³é)ôTz=žEÏ£Ò5ôRz½Š^KCo¢·Ñ»èïè}ôAú(ý#í¦Ûè“ôú<}™¾JÿÓb÷Òè'ºY¤ë6Æív2µþcZBϤ~p»þÀNÆhÿB‡Ð³évà{Nl´ÚNo ï V¶“ü‰$hÓy{X£îôÛo3²V;¨D;ètŸà9;ÉNª¥éÍôCèê& ºª'ûh!]N» ÑÍÐ(B>¤Et#ÆOš9wÁb¨½jO$ïÒ\º˜þZqýrcYüäÙ§œz48ü|OGÑ+)²Ãë‚;ÉòÍ¡‹ècÐäJh2™¼N=t.ýèãì+¯ƒÉ>FÓºž"K=ZýùšÖЋé‹ÐÑzÖÑ ä5šNçÐû¡ÉÅÐdy‘ÚèIônèèü‹×CG÷“¯h5]K_€V@«»É_i½€>­e'/P+¤ €&« É8²‹i'½:"«ÖBG›É´œžOwB+ ­î!_Ò*ºŠî‚ŽÖ°ŽÆ’稙©ÑwB“uФ…¼Bt½:Ò®[ÝKþNCt5}NH‹ä!rˆÖÑueɬ£1duÑYô^hr54i"oRO‚ŽŒW_=B¾eGË)Ê#´Š’ÑÑôjŠÒêZÖÑ(ògšEÒG É Ðd$yÐ¥4 Yo¸:ê"?Ñfº‘þYˆ©$NŽÐVz}:º‹u4œ|F‡Ñséh’ÍäR~ ´,}ø²ï‚>ž¦z:‰ÞJ?†Ç=×_<´×vú—`t9“\’Þlwep[f>0Ú´™ ‰í;¡£ë—õ¬à¡œVeIç©Ž_/äBJ nÔD—9b›,¬0%Ðoo¹$È»¢eÞ®˜dyïCöï:bK å”@[ŸäÇ›Œ1‘/È—ä+rˆ&ÿb«&T “éY¼ÄÈš<ûDïô)›ÂNšK c€hËØ× …XrÓ^ ØÃ,vÄR¨ÝOƒäŸäò#饔ê`¼0#¢*F‘uŒ¼G3·SÏOÒ<²€,$Føn5Q;uÒ šIý´˜ÅÁ«/aÄ9ÑÕFKÙæ<_àˆÍƒÁi%ÎN¡õ´‘Ž¡céxz >?ŸÑëZFjë•\ÇXÆÍ8ø2—ÌメSèt:“Σ è2z=ÿƒzðaôvº™ÞCï§Ñ(#'ŠÎuÄfáà+éEôzÝ@¯¡×ÓßÒ[`ð™8øNº‹¾@_¡¯Ñ7é;ô=ä;Ñ™Ž'èãÄ—Ó;èú{ú}˜ÆèVú óDÎÊPíˆÆf¡¸œèˆM‡¯Ð§é³ô%º›¾AߢïÒ÷)èPñ“ÄW@ýÍôŸNVøý”È ˜¤g¿žð`E*Ÿcü­ öWÕ?ÄË¥ášRöÓÉzÖ¨~²j4s{~±^ùëþå~ ÿ¥~ä6†côc8Î~þ[ó9®~Ú†«þ„:BáñÕãÃéR þ ŸX5qøöÿÐŽùVGÇ„ ©& ð'4>åÏ„ ìo•ø É?ûµ‚?ƒôu\óʜؑüO=Á‰ÿ›üÃKhÇ­Ÿu$;:${G¯«£C3‚5£;Ž¼ =$Þéè «:zbõ÷‹^Ž\¬|‰ÆáK4õì+Çý-õP0Ø/| ûl,ÞŸü%vP?ΑŽ2;B*•;‹QLeêÁ Li9‰ÌdLrYL–‘3È9är¹˜\F®$×ëÉoÉ-ä¦Yüž©)3'F¶’'ÈSäYò"ÙM^'o‘wÉûä#ò)ù+ _“JY¤kœgM—ÜûÒßAfÎd2Ó²öž¾el:œgm«·<·ªN‚´(«6ïúX_C0Î$o8“YEñy·=ù |§a2\Œ7SY|hÅðšzh<)œ{ëÊãXcÿé¿éÞ mÁxþòMÿWs_Wq$ÜýÞ›7÷Ì{oNF£Ñh4ëiN]ÖáC–e[–oø¾0¶¹ 1æB’€aI „Ó‡°ÉÌh¸ ÂØN6›d€“plÈ&bé¯ê~#É6$Ùÿßÿÿ~ŽÑt¿~=UÕÕÕUÝU]Å£ø WëMŸýæËø 'QªÜxå=/áƒð bëÁoýÌN”|Û¯Î3Svxvºÿgø`A¢äÚ{ýƒÌ”] Ô}7=ö[%㥇Ÿc¦ì:x`¸ì®Þa U¢$^qäÅ÷tMŠæÿÀ"å§ëb›IùÅËO[‡m§+…N4ûfÎYº% ø½åÆ­;AØñe¸d;Ññ°žmc”•@(‚t(…,v²yÛ®=çžá%—c'½“+~ñØ®wÜ…-3J!‰-¯úü5×}å«·Þy7¶lÓ[Þó­âýƒñú¶lS -ØòÞo—xô»ß{öûزYoùÒŽþì—¯që5߬àµl}æW~øÓÿÕ¯ßüÝ»ØršÞ’ë8Üœ/¼_Þ|ùÇÖœ]uÔDÖþÖfž°òãåó'þ³ù° w¹æýÍ;~Žýhˆ˜yÇ@Åú“¿øó„ïÛ‰M,vgÊYÁI{Õ™Ï<Ñ&6=úhy_ðŸþξàД}AôÃ<ëïï=Ó¦±Mì=ÿï¼3ìóþæþ#Û¥§Mú.ýÔ}dóДù;ܯºüêäuló’o_×ø>?ÛWgg Ѳ‡§þs ³N8i›'Àg³~~„€¸Ž«Â;°Ÿ €¿ÜË °űý'Ãògö~”¿/M¼À”ÿFSn H „ãÃ(@ñ¿CCtÀï^«û¹êTꃅ×RK@ã T€¦ÐMÒ)C(¼+¼}ÜÅèPîozzœ…aFÒìçø† óM$ÂV!ÈÎnØ-~,ÉßÇc”b'A!xüuîŸJˆeïI«~[,úN±4FîûË2Gr¯TƒÎýæ‰ÎêرÈÏŽï:?ƒÝŽP¼#q&ô[ýb×!žµ·UŠöëÅ~yFMàcuÀï×ê7/R={é'Ú­¢Ž±?mñÝÛÙ»è{>9º½ÑdÄPç«Çþë‘G°Ã‘Ý:<Â_XŸþSᙄPd@0ÞwÄðÿ5™š2ç”!á÷ºí¿ÃÏ´j*?Ó¯ÿñ3žþrꔹaj‚Î ý °nL…Id’ßÅ]‰Utƒ„ÏÉ¿þÍö*ŠB}ˆðåö¶''¶wÕÐf_wëý'¡ýë'´?©U“8XÔqB{\÷Šâ 4ÕW2³DøÇîÆwÆþÀ়gÄl-SÞÔO¢ ÓŒìNf³ úrõz?o½õæ›å¾¨ãk_»ç]|\ ýÙH$Þ&ž×¶ –%ž.ECVLîÕç]“/‡Rpër"†w{;ðZf³UªŒ0I¡ZU-oî(„¢ªV‚©ë0NˆŒ¤äõ8¼Ó›‰ŒL¬>V‘y>y¯Çé<|½tîî¹÷ÿâ~Ó‚Ënºâºûýõé-}«û—?uݹsÌ:08øÁ¶©ÔŠt²i}ê¡Õýý«k…J>Rðñ¬póåYBŠÊ2}±¿Ù³Ü{äᶃ?¹],ñä\¦êòæÇ®&ÌëBGE‰}ÑD¨“NXÊùi­èKåêkS?øð¹±7î®?Ozúf™žÌúõ±»èê×^{•Ã‚4öÿß‘½I&{'ÉdoÏ Pmîé _~Óeœd×MPlÛŠtŠùà€H 9 ¯¡ö5„P7N…:ÐFákTawt‡ákx’?šðiPÕŠV± ¯y«E%âÃoamT I5xi·[-Z43»^ç|DÅÌ{1Àº2ìÂ6 jÞØ‘i£î ­>…Ÿrd¨u~’#1=opU^?÷¶ Ò¼ýÛ‡fì_;¿ïSýê甊Xeel o=“Ö)uzãFä­¾ýªZ¡ën@7á46¦5zpIÐY 5ãÔ踩Õ3x@ŠÉ!ÑyDxú³òGy <2K„—ÿ:ø…00õ0!‹ H‹©Î,ù;KÌâq M“<’â¿] äÑi@ ùÀܹœ9tà™W̾lÁ$4&†óT˜ £y¦®‚« “aâÙèÑ‹Ma|[2ñ[jü,1=KðG nƒˆšN†ÈXË7¥2¦ÝtŸ}þëœáag¯Ý?WdLK¤N˜K.¼Y)_²±•‘ƒ¥ÊÇô´ºóäRÈ‚xϹÝ6u:Ù,8 Ë~QÙ-öS‡*WÃ/`Ÿ2Ÿ„NœLSˆõ ŸÔʇkbŽëž—k \®áRÊpI*¬Ü§À¥ Í“çù¨ç¦Oä+òUÉ1…^Ê$½t‘îœFÍ üT°âåô‡³… \Š úoÇ©üU“áô¡„ÿ`$iÕ ÌõÌc@-}þÐùæŠgÒYŸ?—+žýˆÊæÎЛ7Ç_Ôõ’•å>È +!9¹”Ê¡b AÎ z'Þ¸|¶®k™ø%ÆØ]ÉÁswÜLû è¾NAfmx>Ï¢éãÆ‹áÅÜ^žÑ·àÃ4˜&¾Â|@É`±JzÂË•L‘ÞÞ)# ë£kÏ9pÎZü¨ŒÏ^4{Ú4ø@ƒÎ?°³§g'~ü«^ë±Ô!é¼8—g×1Ê»€4b*URLxs93žÅÇÊc—ĉ,> R`Äm.ž`oœÒS¤ô$ƒ¢_{ë÷®½ {ÛþíÓ¹vуpõĦø„^ 0•áa–9<nÀ£NÂBN˜È*dæ aÊð˜„ÇÎàI©)}"€êVƒôj¡šøñ[è“Ó·ïßÖMÔxœølû p.ú˜I=á³`JÌ™ ›f„èAÌ{avQðÑHje ûë„þËýñ|îzŸª0å¶rØR©Ù‰ý¤WÐGà ›³sñÒ@/ÖŸL9|e ¨eâr“©ä¡õzG X½¨ <ÀlZø˜SîiàSnH1èøŽä |SFW jà é½ê±ÓÀ_€¯ åô³A6F?Ñ=¸y dŠ“›gF R09a EžíÂ¥óQ™¯z™HaB–‘˜E§3ÐE¬<ØïÚiyÜìåqc‰C”2•ò”ÿ®¹ü»t’w\¬Ãù¦w„IЦœt_N¿F`â_üMÛªh;0›ç¿aküãíkXû“íž·KÔ¦‰¾™ý%<­Û ©O¶¿J×+þÆ–Â…c×Ѫ±_OaÿpßSl»ò’§ô}üǧö-*¬o™¤Oê›b°GÁÄòèã`ƒŠ.±Dè Ï?(Ä&MÇï›Ã,#ÌÆ2ÌE‰ÍI,÷-¦Ñè}Ó½ïã?›è]œK¾Ñ?Å Ç/0yKò¤ý Wæ0´Ù|êþ˜À˜yƒE_}•¶½újyÿâŠ2NÿÿÚŒ&â|F3è!çr«•Í]A§zÞ–,™-¢–‹òrLЃ'H9Æ»‡j¯“p½?üh€p†\/äø¸‹ñÄ¢h¹åÆÉ(ÖÕ ß3îÍÁ²…Ûñ±—Ç^ž æoFn˜Ü‹*¡ÌŸ2†} ÑïÑhB…€óù$¼¦dy8-=‡WäðNÙïÁ{ ؤÖôø; ˆF~Ãt* æO€…yâû‰0œFªŸCM¦†"- ´íø;|õ›Æ®¸á”q;eOÎÌÇÍhù8:H,; ˜7–#æ'€Áe±Ö@LÆ%m{™“â77ÜÀ÷'„¯3¾ö‚~¶Cçlç„fí³ 9jÕÌSqý^üE?Æ”z¹¡„¼Žš˜†©ÆÌNžwÌæ,ëÙ>ffJÚ(•=§0~Ž¯éX½§>•A÷Àh=ÝyÀæØ~Ñó?½þµC¹…“ìKÿ2X>fnw¼:rÈ6Âyje>;06õ<œG .ÀÃéB<œˆ‡KÏ¢­ãáu!RÇì˜Q#q2YUóÞŽ|@û8ƒ&D}™ú”qá“xÛÂÜ¡×6\:|ÙSðÈX¼æØ1ÐYv2Þ“ñ‹°T©0<*u<&­ NôJ>œè3š¹fìçhÝ<œŽ‡ñPÔ¼­#ïþX<Ü^_&Å4CÍ9{ÿa„ùðý¦K6¾ CÊC[v¡íÚ)vǬíŽ×ú–§V¾mÉ}"“›‹ó•ë<\e<\'àáâx8.e _Ùt¾rWžÊW(P³¹Z`) S?—]ì³ñÚ”=Ѳ[Ö8V~„˜HŽøÄ.¡t¢jÒJÚaÅ™KN#;é ¤EDÚMÄëú`2Jä7¥J.®w¯KC ƒP0×ödޓȯIÚ=iGc~VªÔl"UÐle¢`s€z¾„¿%&1R~V¯3ùàÑ’%Z)}ØUP53ãù4 kýLž-c¦Rè¶6–,ÄMº±iCš6(…ÕÐt×d—Ç‹±[^ÝòŸûÔ¿óľLì+Á\Îûxà5«±áê5¼á›+ŸúOÞpµ’ßùx~’_û8uûÖîdi7Šnö…e¼ÄÄ[`ŠYªÇ²ê6k¸¦¹­£‹3µb´³7¥ÔbcÓÌæ ¦º¾££°Ò£j÷54&:ºYë´z±÷ -? K´Që´Öyøµ]í³È–p<™™9€nZ…(fÉ«©g;²él/aVºjê©—#¸E…‘f˜œ.«èy½n£Çè«MÐLVß»‚F˜úP6NTd0q4ôþì®Ôs>¶ÝUkd¹îêsšÓn²9*Ô†Áª„ˈlŽm·VÙ»ãâ†3Ò+»ƒ õÉù•îH2I.©­u;My–¿Æï¯ùlƒÉ´Åª…á9±u>ÅípÈŠ½ÒJe›*Tš}ÎN%çq]ês(õ }ŠËî?¶e >¯vssZ›7OKç"~Äw³ÑXÕ\¥lø+j|¤”@Øé3W ªÍëútC½âð©~›[éCÙb`: ^¶’‰‘’%ÿ®ïð(ÜgS“gÛ,Õ…p†–êø“PcfLDT,5´à³|&UjIx° 86ÇLK;Ë!„*îR6Yå›”B5pk„'JGªM¥VƬ˜)Í¿EØV&®u˜²¨^cZ¼ÊŽ|“zŸÅ)VÕqì[YŠ¡jõ>³"E“¦Pµ„˜T³GøöeQ¶ÑŽ“%šÀ%A–o„})o²>åõàÞeVßÄ,ÿíYxø™û—Žþùa÷Òýù hr÷•·­énªySèW|k“\9}Ú´éÏ‚Á†§Pf0ÁAÉy›»º’©ÎÎä™g\µÊn6{Á—êúÊJöÉ÷‚…‡ý} Mê1¿)_mºT¬61bÄ’%_%£p$Uò•sê¡E¢ Ê8“™@Þ … ÈŸ5J¡×0ë±Â4ø[ŠÇ*µdqxD”úÐص¬Ïn ©eTó*æw,¯Ó…êJõ6”£øµ¾¼ÙëØôýê7Î{ã_M?uÕùÆveáò…JK¼/ï+²ÏI"ÝÙ¾`Aû´ÖÖiŸ-S>¹~9<ßœ@•ù#)VãyBm"Nä«R¥FN’È{Ê nó®d>‘(™yÁ–,š, ïp&(°V>z/oN–B<ßÍB6@ã˃[h›”‹µQwÑZŒou*ø]qrÑW·ôE‘Å·Ö*£‘ZÅÕX„Ï©ñ­`ÜÂÿüø¢¶èȇÕ|EG¾‘±/QGýuÓšö QI7#éÍ*Ë®wj ¨³4…™T6W2¯Ëò¢ÌòúRžZƒde£§X×XŸ‹Õ—åSv9-º+™̶‰Ê{öÈuk£û²}­ÝÍgDWE k.Ú»öš÷ñðHt±O:ã É·8:R=-¯ŽŽxäÝ»eÏHt8R;¸¾·w}‡n0˜<Šz˜•²öQªæbAs)ȘÖTIÓ³'KžJ¬+yô-'afóVp¿ì Fï¼;YN ¶Saš—ÝÜXT˜Æ¢`œº“ñ2JLüTƒ‰3+`ÝÕ0£ UÀ¦E©2Ä– äT–JΕΈ÷úÜ@$Ý¿ LZ¦S÷úô®ìzzڪϾõàÁ•kÒ«/X»özÑÆz'¶©{™iI|ÇŽøbÓò]:’Ëé›ÄOÂäQRô¡„ räÂåŒÑys¢dá$±rif—Ú`uv©G ‡<Ø Ã«B€˜›#á¦Õ㿲TÒy{KÞÚ‚"Ó†©¤­JÁ‘ú€ä-t“+—Ç ¡žÿ,^Ÿ™Ÿæ€NM a\p ÕÜX'©yðÌaubûr`œjj¬‡Ö.=×/#N¦qÇ•½wú?#ÿÂÖ$KÂõц]Wì0­¾fݺkö¬l¨ø²@ Ö£Â&¿Ÿ~¹yËœxüÎ ^¡,ŸãyŒW2å3tNO²heû~–z²ää§5h ;q­&"ßaÌ¥rla%Ó‹iÕqYõ¥|]ñ'ýÝ››3™õW]Õº%Ó²©Ûÿd¼ÿ³3:V/_±tIÓšE­3>Û" arí‰0„’EùÖ`!*0¬·|±&ËzZÃáª`pº*L¦2 vf©Ÿ’›^çèórŸÖDI8©OÁZ–×ÔSÃ2?bJ¾½œ¾Ì2îµÑÚ”¯ô]ï æ±?Ìÿm±ú óÜØØUÞÊòµaìè$OÙf3fbçÉ×3jŒÎ¢³ŸzïðõlëŠ7ôRÌ•U?~‡x¿ðôYIXw BYôî,\Y"'¤¯¯¡õO²®è³Çÿ<%g=èÒ‰ñ/I &K¨D=´™f„&Å=8?L0Ã{|M°£»ö[ìûÃ4K i|”6Hf'Ìà{˜Ú‘€ð˜]ÖÔ˜O'Jg°%Ééd¼këF½ê×äßà};VýšgU|fù±£¥ø™ÎGÊCTð(ô‹ñ7^ø™)¬-÷¿Ýf!5 ï¾yÛ= ïîå/ܦžGOðÒJá;P ðR@ÉW`²è@¹|!Q¨°{ˆæÐ!ô£1U»íÆÕïÿñƒí ò¤šÚo»øt²’l%ÛÈŸÈŸÉz `‚GvíòuR/eŠÏ=j¿lI“3Ènrù<¹šŒ’ùy•ü–¼MÞ¥Fj¦~¥¨5å¿©åÿ££pÛ½ªÖï„‘›F@ΓûȘüÏÈÏÉ/È[´…&°õ3j¿Èãd1æ‡È—‰Jî=æEò ùWòr”ü„üˆøò&m¥m4ï¼ =ÕaœfO¨ù§:òßÑ ¡GPÇ8# <‘ìÈïQG­gƒm7jÅ–íû±íéjŸµszÿÚ­ûÎ?pñ§/c¨6iý yx¶ô’dYBV“Ïo’oÌ“GÈ äC2´˜FØ+!µß¦‡`’ÎûЗ ˆÔ¤D@8?Óõß´~ ľ èüˆ¼ÌÂN_%ïƒÂ §j¥6ª;2o_«Þ\K~4eKØ[Záíw˜¡œÍëÁ"J%½©,êù n†X„}n‡ayÜëc‡h”á_¯OŽÔ·ÐúX}.A³9ßäÿç"˜Mjrn&Kew*™óá;¨Á†h ÔVXÛ1|=X©l&}ƒÈ5º‹eà-X’pç, Ê-þ[+»Aƒõ©EHçRÕ4›I'hªð_PZj#·¯6–I£9—  ûŒ ÁìÈøã:—ŠEœˆ5úX®o7v[+;i½ÌÚ8)¾ÑB3¼E¦LþTõÌ€l쥠:Ázhºô:ºåê½[Ÿ•CmÑl¹a¦Q¶øª=Õ²»K©KuÖWù¦ÕšL²Í&KÁ3ú·‡Ó®tD°L‹4IÖªy’;wž¸^:OôÌõ÷.x)(deØì—ìC~Y^.öµ5ãöJ1Ÿdu7$g§Í¨RË4›\¬7( ÿüu¿Ù¿QUªmSìö‘š'õU¹ƒa‡ÁàÒ´Œ˜œ·|EÓÒN»ÍlÕ—uCÅÒ>©I˜9¿Ijcn[й@¸&Qa7¨ÓzeÑMgìXÙnª´ªÆ(©vA Sº³bu…Ó²‹²ê±Äé‘t55µØ+©Ò꤆ÚJ1¼,ú_Z&n°i5tWǺ:ÓÖÓç7;¢‰ˆlÓB™*·6m¶±+c•ˆâ´Ù=u^¸Ç£x%§£;ØRŒ¶ ÕkšV6v§ºMµ›¢3ìÞP]K³4'd%ɶH—!–H Þ&©Ò.{YU´U¹}º,´"ªÑ•Œ‰Á6™VIö¨Õ’d™–5›Ç, F‹–hÎ…+>­[ôô´·[<¢;^åÝQÕbq›•sU–f ÑŒU<­>¥Énè0Uy¼l_º×-šEƒgö,¯d;*¨"~y…Á5:l É#­¨2‹ªDMBD’BŠDe©M4ËiêM~ßUvü~é«Â Ûž‰ú&}œ+pAxšk¨µÉÑXÅÓ ‰kxùšDéjžþùΫ¯êüúD©ûU¢””I|K*¥´žT÷-¶›í¹7™,màù/œ˜m…¶”B+ˆó,çYžz!?ï?Æõª÷7?ÑÏ7÷.Pòû/ìmû Îã£gí=ÇÕ8z6~ƒÑó/ØTNjXù³;ŠPºÖý{÷uö9ç_ÐÂÿ¡'•™õ²¬·>¿Í®CÕñiË–_ü…›nþÚíwÉîûÞ³¯°ÍµÐ°$kV+5·¬Zó+¬Rû5±¶T휭ÛÎ8÷S¯½ñ&Ö.Ôò# Ÿ¯> «ÐUŸûâu×ß~V¿¡ö©Îé‹V­ÛzæÈ%Ÿ9òìsÏÿÅ×Ø–¡V\¶ü—(µ¥;þåø-­õ©ªæ‰7·º³]÷=ôèw_úñϱqRÍ?Ñ‘Z+†ªŸD³³&Keï.öR_.›K¡(Ê–Ó¼¾GÀÝFx(RjAìÀœ ’bHDo ìzo5õ¢hٕٕÂÅMPÜ_« AAîÁ[Øo= ·“Ç24B R ¤b5õ8¨å¥Ïè¡WoDIFÏLâ `ª¥si•õ±6v{Ùoö ;Až‚EXŸi‡ÂÖo¢¤óÈ9o*Ù ëLV,² ‚dqHr8$B‚¥}å´½‚[’?·¢!`r/ûR§°Àój¡öŒ(Î8{‹0C^qìâpY&Á$›ÌÛoÛ;( ™54™Ü­ ¡ÆZjÐê@|ì_pVPKº×EíV¬ïµ4(r,•mq‹ É¶NE’›ÜJ·äײ7µ÷IËe94Ç*ù[‡-+ûKBÀáÖdÉ‘”Ýî5q9º8*"²7n“„ £ÅJÿeF2 »Ò/ʪР‡h Z$ï¬ÙLiwoÚ').ÚXeŠø v%jòµzÉš‰24[e®Qd›ÃbT£nÑUÕâ0öôxÄnÙã Éá\ó@B³<¯Wë«4—Éâ¢bÔ.UQË\1–t‰ —¢j…€Ï]eÕ¬3—Z5!ˆDa—$}^Ñ h5ýDT°9•°?`4EÙ,¶I2•*4øˆ&*©¢Ù]k0‰nÌ/Ÿ ?£ÿ,Ì%FXÛ½$H¢ %HŽL}‡m|õ$òmGq[g|Z)L‡ßÅg|/w`Húdà˜/;âÂîfKkáŸjš†ÕWC\.sÐÒó¦¡84—J"Ÿº-Ai²Ù,KV–Á&¨›d3ÉÆAÐ"b…I‘âÙ¢IͪI„¹"HjÉæ78d‹Sø“Ãn4IqÅf°Ø%IÑ6H·Aq¸­*ðKðY}q0û¦c@cj¡YÚC躄Śo¦»è9âRÜû7µîj]ën>QëîgÕ¥W¸d Æ¡ëáuzø.]éÞDÖ“½Ð(Ý›ø–Ïë?yÅ¥×Ë*ø¹‰üGG¢2S¼½So/¨ã.Vë˜RëP G`Xnáêø7n9Òþ>b·À ]ì…ÙS^˜­¾GáïÎdé1Þî1veÎÉŠú³ ¨?«+êç.à}ÿ{rÿ}%ÿÜãwûyï㣷Dû÷•Ñç¿ÿHú𳕓¾u(çŸÿÂ÷ÝïsÏOøË(àûTíÕëWnÛð§?£Yð¨¯.•©ÿ õÑ”®GTP‘¹ú¿‹ì!ÈA0 ¤8Eý7Q h½´Ž ßÐ ¿Ù]¸å0Ô à[ 1ÿ€]¾òS0þ”ú·@zµÒS«»ÔüWáÏl4êÉmä&r;hÌw€ð:,Äm4C~L§Ó^Ú‡¿ð=µ?œ&1r-¹Ü:øË aƒêL“4Eûé :‡Òaº.¥Ëéit-»®e ¾û¬ö0©¦gÒݸ¦<Æ–ŽG *D§{ÙFå.݈ØËŒˆ³ñM`Dìø¾°ŒˆŽîuýÛÎÛwáE—~šÞ¬õ×ÀÀ7ž b-¹‚|ƒÜ 8?@b¨Ù@Ù2Ãt]FWTëª t ݆ààï¼¢~´$î(ù h³_è×ÀX{©tVhŒ {T­>T™ ým45^2ÿ‹‰\65d04ìÔ³2Bs`¹ÏŸ{ýƒÃD­§™ØàðÈ‘²½ÁÌ‹O28dhð§Z¾ÈÞ`¿À—]ÏÉæ[Š{h:6ÅÚóTs£ Üfýƒ~äoY™ ‹Ãs²ÅQïõáïÆ|Þ$è\+{@A€Ïj u2¢Rïs£íäuCpdÄjÁ\¹~óvo _)·µz%´VfɲÅv‡ew§oíŒýñ¨ÑhtX-ÁåWl¯f¶Šr€±â Iîì¹Òzé\É;¨+6‡Ðâ—ÌX‘úÚoÊj~©[q7É’Òi“5Á·ÉÑ`L榊¶ßäߨyý6-v[D4·à¢¡"Éš¦¥…äü{›–t‰V€²hr:ég†Ê,4T"`¨T‚R>_èÜŒ]wôÉ’[è=M•P@…á7m°T²E:ì_ãvËIìØíÝ‘tÈÔâ Ž¤CŽPþ¤¥ãX*.A–€–.[:$(²Üà7¨°lyM6)KU .)¦Š:IÒ,rXðÊ·m6o`¶MT²ºÐ¶q4ŸbÛô¹*@ÐM³Çòq¶Í´$Ø6°êûŒ'X7Z«þ]ÛFÐ,&K<'j>U8Õ´Ùcõˆb š›6V‹f±xÕmgµU´|‘7oêÄIûÆßöØ7§»l(:b£ 8-²ã8 ¢ÑöY 6Ùïíqšà‘ §Û¡̪Mp:)ǼAb{…m„º^A‘¢†'}¾TÁe<–w&‹2¬ã‹»@åí©1âÀ4@ï#¼±Øgc—û™O„ŸpŸ7óu9Vtº™í£š‹nv®äÖÌ…Jt*ñ³mp<6±à†jQ6™€f;¦Ž¼¬²=OLþ”Άq&ÊU”§&äwˆ¶ ï¡îá¦ä-=tkßØ‹k^ú2ýúîÆÅÛ"ÛÜ ºÆVíÚE;ÆVÓ¯sÇßžðÄñÓLgª¨âi¯Í„7õÌCVðuDÑ ?8ªfˆ†ÑŠ$W"vÛ1v"ªf˜€GÁX rÚ‚Àƒ·Aµ££àCl<ìh×TƆ©|g¦–m’"j)#CjNòôowíªsx«Û²C «7§Tlú "–YÚª*Çïj5å^4LÿSŽÆc»uô`UèÿOið;Xˆ5ÇjRGa\s°hÍ"Cd„¬€EkÙI΢Ëu¦.ÐÊò+RúùY)ÛÀN¸g§JY®ƒÍJ–l.¬+6Í;3•J•l\›‹ÍÝž㶓ûŒ¤J¼ý" ÕÙìÍÆ• Wˆ4~ÔãuMÉ|L)dhc±¡¹»éeõÅÙóA)ß«æBûùÉÒÞþLvAÔv¨ÛÍ<ïPm>ýÚ0€ÄáàqO>¦Ž*Þó7Èh÷YÄh0ÙŽ¼s{Uí>³4cÉÊuøl‡:ºfýæ3ðëvmtãÖÓö²³¢¬´$G0”é]¹f+÷YUâs6ãW›~ßâÒÏáó꨷u˜uҥ݉ú×­ßË´)‘Á"î°Á:”Â=4ÙëF½Ìêø'Þ¥ÀêAÉÇšLÄ(»rØ6ƒk3)xŠ‹3zG¸X¼G•=–ëÑ~¬—»®ü­yÿÊ+ßû?¬——ÏèñJO> fU÷ò ÎøܪT:Ý–K­ºJB붼ñÆé›C-™3ÕeëN_j3ì¼Óµ+³vÅÚÕ›o Õ{V¬_š=Ãh;ýŠÝ­-«W·t7¯Þ¿J~šú|ôiyU5¾ôímÛ¾TÚ´¤R1˜åò/;²ÔÓ³X¡ßöj‹ú|cÍìÖÄÑ¢«gì¯Ë‚"N*âƒtþñ;èÈR ”wO´¯×C#¢²b=~ºg©W–ÏZàò,KjÅ›þ8{öæE~2>N:aÎ_T"$&E4ˆ½ã0Ö¦FèOlF¹eùH¼¦cxÊ(Ñ|%?B±1?XR~ë±¼Ÿ;#Ê ¯‚åƒsGÁïVµ¢MÙq–Z°›Pöìü¤Ë«-N±CÖ¶¬’M…½`nUçÒ5‘r´aïU7ÑÀU}W}ѱúÖ5½cÿup(Ú¶_GÝ·ÞzðàaÚ²ù´Õ›úI¦.š­c²cz{„n°§õx£%ÓÒo•géa¬,ý•`žH»ƒ£Í, žA0‡`ž8sªKé+ƒ1IéÕ—ŒU?W¤_6Ö¹o6ÂÎÈp ÐЃ~½,²Ï ¿éÂx¬¡z´ ;Ž•ÏþlfvÐYUø(cFynÇ3çQqzØ”w•=rŒ5ÆšL€{áÆTÃÁÿØÑ^¿éºL9þÂóÓgL?ÐE_îên[ºeþÊþó÷®\Ó=0mÅYŒ_!|`ª{–ûˆG`¡eÖ®9Q°Àø*‰‚ዲКãXÞfeŒ%z¡Y˜¯Dè0š†pùQÑËEÑŠšeó5ïP}¸Šh#Í¥’lÓTcÈ&ÑŸ0—Ï»`hÕ7×F†gì^°ðôgvíÊÎ\ßsÉï¿àîK·nÝÞ4ÒعhMËð™#šiÉ‚Îu¹lù\úá:ÀÅÁóG`âÉÀ‚‹“!èZ¢{¶³4ÝÎDÞ~4oHl–aÊÆÂZl˜sÏÎrÚ1ƃlv} $¢sc.ãò‰©¿Ø­¶>õ›GÿxðÊÁÁ;„à6ú½ÌØ¥wÞyÞÕWó¸y ñ5Âtâ'—¢„4ö™t›Ö{“Z΂˜w$ VœG,ù Ó_Xö §;ÃÈ,êûX!Àò¿Àü1QÓ+«£¢Qõ2/äR0Ið”ºÜl ©y'ôÚÖyàO¶ìÍÕ´Æ¿ñÊ-ç]ßEÇÕ±{æÞ¾i¿¹Ê=ª™±»ÝG÷œu­/·ùÊݽ9" , Ï/¬ñ{IÑÐ_MD–6+ÙCnôäµ#Ìí§à[“¨•áüWÍǘ'OЇÕv‚IÆù.-EE%XiWóVô]ÁøcIe1&èÛ“K2U̘‰ˆeÒµ‘Þ¯,<¸«¯;~ó^ÓêKW¦{öí.\úu¡ï ýç.§lLÒæõÁmk{³;¾pÎ̇>{ÆæÁ¾˜÷`üBa7È™Tò»ÿ ,,Ep!lôùÅ8´žf„Ž±Ç¥³è3ûvÿF+IèrÐÅGjÀTÏ‹”©ÊX2 Ɖøm¿ùX^ÆYTkfÂý"f ÍkX]ß«ÍÌ£¸ý2ûý|-ó3k£žJ¦uU*zBC%¨D¶ká:ÝåMY´PÑ‹ÆÖsÙÆìO0Œt[6=«»½)Ôóèwº«’íWv_ò§ 7/¸nhÚ¢ù›«&ë»ÏûôY«µs:Ú›N£työð¬OåÖµçnnÎd†«µZ½ ÕíohA?©éã ÿsÐ ¼±F³Ñ?ü©N$+€ ^@Ó« +ç•dÁäà\á-åjAÒ'üÃ3_­ 51WN-ÍŒg†7ÿÁ:Îò…ŒÝÈôš9OèÞwÚ{Õú±oë¾Ïä>3¸i Ú~=õ_‘=72ó®K¿½§zOdãðô­ß:+ Ö¢qÕr¾Î _14²ìËIÑÈ"óa EC»a"Ûdc¡C¸Ä@úùÎZêýŸÝÊwÖ,JÞúxÁÙŒ;kdÔbuzÙ6ÙÄ7vÂä0: 7†è±`ÇÐU*J%ö*2,z>0½‹ ÑúÞKèš‹/;ì1…o™;=Ü=2hø]ýØcc_ÿ.=sy†nˆœ3vH;ûs¹}ýž‡q±¬ß—éë·—Lyᆉj·±X%¿ŽUc•¼ø§÷r¬œJ^y¼àN|VNÅàX•¿1¬ì8_„Ž¼_- A•7pÙÉA­Ý+ѪàOq« nˆÚUtßÕÅ f]~ÈÿûšÖÑÑæQ?­:xëmco®|bim12?¶hð\×ø‡ôv:tWsåÑBL%Á`ܲ\@èJ‡ÑÖ<ƒ -p²k‘]`Ç{<ó½DÏ(æ~VvŒëZ~zaÙšûÎ Í®¬œ}Û𪻮øñÚiõc@Ó»–ê5å8¨ GÔ X„[-ËÁâPEÑYU¬¨ 3;ZªáºœYÕ5æÿª¨(y¯–w³Ì/!ŠãÎõ”á2S `j3½@ót†·5>hÐÖuÆZüí}ŸZ24«)~Ú]ËÛrª#ì·[*íJGª-žUŒ‘HK¦pÝp‚™¼ŽK"–?;UŽ ”'i%g‘¿«  Œ[$Ç„.ó'tLnÿ•7ø–75ímŸñJøî… çµ·—izEÿ°ƒÜ?Œåš@ƒ?ÎF"µZ²ê×±ùÑ· ]áÜ`œ*Ì“T±sW8Lµåá4GJ8¸è³P®D*]ZÑ¡yÙ(ˆ>ô¯ô@¥•ßmPÐÐãRqw0ê{uªk35ÆZç˜H¦·®Õ_Q_éžOM¶ë#•©þßLä‚š3l}bA£-·m:ó Ÿ(`ñoà¾Á”ê‹n«³,¼È)DÞ{´äàPãî‹ÄÁ¨l38y„¾Â6+ò*2 ½\Là¼ÈݳÌ]ш\ÌÿgX¤sËþ¦æÊšÖÔ¥3—/j¨Žtúg ß°Éßk™YÙÚi ¢Î¥r_·ñ?Ñ­l®†ù\HösÊ‚fÄú\?­»iÇÕï-š9ö—Æ—ÙZ2gðv“ ©#¤è¢üâ̼`ÖÏácLðèU({ˆÊ·f¢>¶^[•Êjîù·p™ÃVmîÊx¿6’s#‚õrÎÍ×k¹+ …F‡â+·?xöõMí­ÚŒ€'”­Zª³:ÃѶ֞Å 7µï úíŠÙqžb7ÙàoÂäåûô€Ýœ¸D——XèH”T>f^}ÌXüjÉ9ÉiNôWLf¿mï© 6œÊÌÉXÔ 5D`çË2 Jâ6u¤kÍ‹¿ðŠYgćv红Q”Ë;¶ô M_µÁµÐT]ØvÜþ½•î¡áQ°”7Œo¦çñû¡è94,”`ÜZ»U(/'þ†˜…!-{¹æ˜¸mFq+l™·Ðß^áa.o‘ßd‚fñTÞvž"o… ty;R"º¼¥gÒ»&o½"‹CŸäÄîÿˆ¼uåþ{ò6Ú˜"oéáO¸ü.? éíÂw€·Îç4=Qæ:˜!æ`†Ø©â—‰ºO¿¸“'[X2YÄ2÷aÎÛTn˜•…±ëDaܱÿ¢O¯w®hjÚN¿Ùÿ¯Ò¸L󳀟Ü(ÍbùNfêÛ0e³›Mƒ’Ái2Ûõ !<,g­ e;ËXoG³ÍÎïñÐøÀ`8žÝÄÝ êÖð5­huº¸LFuh¨©6Æ|Ø™¾+çM~œ0ÞPïóOÅôŽ\°ßúÄpJb˜/‡Mxæ˶ñô¾ßLwÒåˆRÅç ¿#ãc­rmLÈ ›£”{ ú¼úŒ°>wŒïÁ>¡î6œNV·s| ûBÞc:³•,âò„iË®m“&.hÂÜ|'Ú£5̱²Ùf±²Àû‚ÅŒó²Q`²Åhb³ }.êEWÊÕ™—NÏKx.ö s†²Ù¡Ìñwèƒcƒî­kÆgœ£[^*XÙA„#¬ÃÁâ/ N»#`m,…œ\5jÙÊ?[ù¦:Šº¼Ô’QÕî·«ÞÊ îدzqèÜx–Z¤FW9²LÄd,n£Cp{õmõú2ìmÁ†¡ô—RžÞx®v0·yÝõ7w\Ý‹l_ÑQ—n¹«·º«“¡îá3–†߃?â<±J‰<~>á²ñG0ÂsÄE ë¾ú'(‚²Ê"Y?¾eüO¬Í½ã’_‰ÍP×3¾A¯»êžbu}ãõº×ÆWÒ âôeý:öµg|%yÊ"±ÏÁ6¨—ŽßFÆé£Ä‹7‡5ÁÄÝ©_”eÇ­ÜI³kÆ@wX‰F•p÷ÀÚ;>5+Û칩/Øš:ôõÑÔ¾¤²f®÷åC±‰§¼l_(Õ*5ÓgϘ1»¡58ýÖnègÖ§î¸`6ÀºŠzH•Ø¼xñxרk¢îñ÷ÄV¨»dì¿è¹Œ†_ QñFz‹"ˆÄ¡¼Ê5¬üAË4*܆e¢¼åñïÑ(킲HöŒ qÖÇ:*ˆzÞù‹ËͤGøš° Þ9óÝf(W@ùs¬|ÑPÿé!ÿ eQ2/› ¡îB¨»‘Õ™Ççð:øÿtÁ,”à½ÍOc9KæEa3”·JXö¯:Å•P6þûxj¼–îîSiÚ!|Þ|ÿ¨ð,”ã&,·³;ñy£ˆå(?ÇÊM*–ƒPÞÀÊ ÿ†eÜ“¼ß'[>Ä2Þù;|N¶Uaù:r£øˆÐí—.ŽÃ<›C¦ÓµTe÷4NÊS{Rf>L<‡zÇ~K½Ó/þô’%<Îàbº‚üË'äXÄ×ú©÷â… ÙúLZh­©²ŒíçSåÔ哉‚§$1Õç¼×‚­$R²hf›gf#´œL"<‘·œ˜¡6Ó9²eáÂ-–ŒŒ,:ß@óä^á à£Çê²ï‹ô?Éa¡ên_ ×Mo'û„CP÷Õñv^GBäba?}h¶â×X^F~ VÓoM7ð÷ˆC„=P~èa|n#× Ýô—P?…Ï?"N!+lrÍóø\‚1i> ý­fåCä,ñaAÆ1Y„eu<"¬×Ay9òPÖ) ³÷«Œe ÞogïŸö ÿ½íB€^Ïw?ÇŸ$Äè>x>ò}üý—Éz=Ïo¼Ÿû‰IÄþ¤•¬¿ðÜváu(/xÛŸ5þ¦0Mxæ‹i|—QdÙøŸ…×_ÃØæw¤ŸŽ mЧã^|î€þò9‡á”¾ÂørXÆòå„H{ÅP^² ßÿ+àО/|Ÿ7@ù1,¬Æ2¿WPï`Ïz'½Cø ”Ï~Qÿ=Á/Ü ï‹ÿV>/ibeé×,×äØcäñï3»ãÚ¬‚Á\¾œ‰48imn°yV“¯m¤²4ÐÜ4вá”ô%ò;X{D¢ý¶ËÉ+EAéªûü0ýå1õ-h;Gx—®‚¶Íùi÷;bïþ}KÙý³ðìâìÎ.í”ñ{3 Wے̃$XaiÛÞfYa\ñÊrñsJuUUµ2kù2¼ZxWÅ"žã¸X>ÕÚÙGŽ´åñ¬þeËú/ã9‚?¤}Ìg˜ !¯[¡fß+1Å+DF ³©±l¯¹5p‡JaÚ Þ¶@Ì@CíÅŒ;Îú?zš€ö…â»6’FBÙ¦VÇÊdzñŒ™oÍU«]ŽKûäôš>†ïï£ømk Vn¼æ+íGŽˆÍ—]Тn1WøP¨ob¾)ÂÉ©r`•…_>‹:*~w™ÝÉŽhyšgí¤Pî¹­³f ¼;g ¥e@ŒÏji™Õ’˜‘€OäáTïbwÛ–„?b“¦ÜÇû5ŸÐï`v$›],ƤRóSúž69¾Ý?‰3÷íG1 cÿ6ýH<Êdça†K‚Ý×$eÛúæÉèc£„Ç’£ 2~— S³÷ Fz<…Ùà«Ç0׸íñE,5^y<»Í;Ï`¾ùÚã˸Þüâñ\W<žE/üàñnL-Ñ{ÎpõÆ)±8À5|õ¸éàšÇMìw<q+xçñnŸ=¾€›Àã‹8hDOc§ñÉãl6y|­æ¯ N{<‹*ÜòxKá7<€Æ>GÅq …!„#á:! G0n×­‚÷], æ³íÑ2Z´îp‡â¼ÅS§<‘ò¶,}®Ÿ#󼚫ŒÖÄYì)Å} {ήéÓžyŠkx ÷u¥OÕP†I•È /^½PÉ{é.ÄÝ6Ë-Ù9P²•Ÿê4M¤Ÿ?ϸWç™$ÙPvTªöòLy­‘±O''Nt-5ã@_ŸÄˤȈïÓRîçéN~Fáv6Lƒr ˆ¸ çÂû•OÎHê=1V™¬Å³„­’6Ϫ~nö•t£éɹ±~i‰WÛ‹6¾Õßk>÷‰³À.U”gÉ^¤^ëy…¯”)mn£îÂÊÌcÞö¯¥mS¡I›ü$BÓ8[åÞ ézÄÙගßõÏ•±îRZ¸çymØo¤MRÇ£KI¤2ÉPs(ùÞOßz=7EnÜÇæ©uçÖ¤5Io%làžpžçxèÄfÜ[ð„¢`›µ‘+M›µ5îÆzbLNcWJ6ž=‘yy8TYYhu¨Ì(É2YÛø;ÿàø÷Nm[V$ê¡ÃûØÝ‘k£s)‘kå7WUÑëtŽ£AÍ òÑ"Ùtí[VÿJ궷ÁÙò¨‹`›n” sÜY2qÒþLŽ&*8¦ûØ”åJ}: êsÂÿ»^©XÛ…ÊÄö—ø—-9òUG±äFR¦ÓLF]R‚ýÓ´ÙhKW©‘oû…÷)t}90º¨Ê¨ÔiÄ6îl÷7ñº?Bxœc`fƒoŒ°1²!ÿÿxœÏÉm‚Q …Ñkßx—hB¡0@ 0tÀÏÌŠIY  `Ë°ç =Y:²ô¤Ï0Ÿš5vp¤`(k*zDÕ¾a–³hE+ÉeÓÞª^ƒù¯×áÞð?¹é-¹í¹ë=¹Ï!Œ#Ž@Ž9–'œÈS.å7ò–{ùÀ£|âY¾ð"_y“ï|ÈÏHÃ"_ðÈÆ@N"c3ysyÿjþÐþžPójó*w5ë"«¨Üßýkä.xœÝW{P”×?wÏ=,å)oD­Ñ©‘šØ™¦Iˆ‚1 "â—‡Åð² ´Ô‹MJM65&ñ™Ú‡‰tlš¶ÆhÒv2iÓÉt2ijfœLÇÚD;Ö阞{öCa%nþJf2wöܳßw¾ó;÷žóßý@@¨º„Q`[š›W žV/dæëðÉ'Γ _!ˆ‚hˆi q÷Chvî 'lÈ.ÏqÂÎ%Ù%N8°ÄÍòÌŠìr'\Èwå9UhaÞ §šïvå;UA Û¨Í%n¾Òп¹1é~P@ {@‹à€!-BZ„´p´hÐ"ÒÏ"Áãih…¾*#÷VyZj`¤º¡nì¯ö65ÂÁÍž*x±¡©ªNŠ|Eäi‘oˆ|Kä_D¾'ò}‘D^ô¶56Ãå&žàZSsµWAK[e‹ niÛÜ¢"ZùºŠÝVÓܤ’9N›ÄjædH=Ad¢ÈH–hÅoþ‡‰ "2TdH-Ò.’¬=0Eúv%^°Ì^˜‘¾ Œ™ip/äB”ÂzØ^h‡í° ž„AxÂq8 ¯ÂYx þ çáŸpþ§´r¨X•¦æ«E²×}˜:Ó÷Ÿ¬ëôuk¾Çš ¬yƒ5W[s¿¬ÈFOÓ)ëÊ»¾ÕÑ{Öÿk¾9èNköZóQkþК/ú<ýÇžèÓì‹ìe>_öfŸ½Çš{}s°Ûw?Ø ¾ì{2øzH¥h:äxèHX¯£Óg^é³ ï›„s´…ž¤©G‡Ò ô,4@'m£ú4‹õoÑVz†Úè{¼º'h€^¢ßÐctˆ¾C¯ÑËôSú5õR;åÑrÓé!*¤TDùT¬rÕ2õ ZNTB¯Ò+ô+ú-¡×é4ý’ÞP=ªWíV}ª_ ¨a5¢FùÊäÑ;aìö}~£Â°Æ°ßð÷ïïóÓíoF0Ž7Ž±—ÞLy‚~O»èÛ´“NÒý„§ÝÔOߧ§è´—ŽÑÏèôszž~DGé  ´†½ø8îÆïbîÁ§qq÷á0Žà(>/àA<„‡ñÅcx_—ñ$Žái| ÏàëxßÆ?áŸñü;¾ÿÀóø^À‹ø/¼„ÿÆðc¼ŠÿÅkµÖv¬CôWô\}‡ž§çë|] ]ºX—êUºL—ë5F+éaj FòRm¦G¨™Z¨•þÀY¹Äٸ߬…Zh…nèãNs€ûÌ)Þå·á]ø|¤gëxê¦íÔÉú@;èQêb}¦žF?¤a:A:I;ÉÃx|':µ’JYOVƯ¢U¬§BGRMe¬O×áS ­f=MGpt©œõ:’ãÜDkXwê(Ž¸–Ö²ž®£9ö:ZÇz†ŽáUÔÓzÐ:ŽFhˆösÇ:ËËF}´‡-2u,Ò>:ÌWž£A^o wpwâ\Ä}>I:*8¡¯èB]bú9!KÅ•9Q·ñ“z¼ ˜~?^{·¹3ùùTãó¸³Lè+¦Ÿ·´s}Ÿ˜TÛ\Ó“< °G,G¬8^ÓõRåŽKäVKÿ4«¬ø­2ŸågLìa¬MÒø^g™\ s8ëI:Y§èTÎ`gËÉ™É`¶±qGV‹àax.÷´9ÎÆï|¤Ž× zšv@×Z›×:RGéh£ãt¬0îm2Ä~Ä W⮺©ªz„F?³—í\ÃÃSv¬!Ú÷¼ðâUÙÁÙÍ2ö«dÍæÔ d×c¬óÅts#n•ÿJ‡ÞÖÂhª·ü$O²RýR?¬[m²¸«Þ´Q’Û`“UýU~ÂÍgùB¹0:^aûzȲøó8¿Ç¥´ŠÊh5•ÓZKëh=3ê~z–ùó&{Ö<Â\¹‡ÙÂÇþ,q˜y⹉LÁxY#L½¿3¸rÓ™nòWx`Æð ^µzŸß+äÎW2±÷ñŠ‚ ê¤.êñ„ÿÛ„ó 㟲øþ>§7™ý ÷ÖËzˆ²xË0V•°”á¨vCÝÊ@ܹ?–nmút‰tÝdÉ„×ï \ž]”Ã2Oò±\ÞCUÈ™Œß Z)ùMô˯R}|×ÁüÖÁ»T_aŽó[ hfµ9à`¾*†fª Hd^Ú©Ì6ci˜æ2»œ‡y†W¸L1`¢ñÃè¶0P0Â#Z¼'ˆ÷â=Süζξæýè¼QåÑ7<îäª3¾ìâ+’ùw1Ä1ë.ƒéâw–Ä>9¶ ÆbæÓQ¸Yô,<ã…æÌw`5¯éXÇØA%#ÅLDâsÏ(#¼tÁ›+x o±àÝ'x9‚·\ðŠoµày¯Nð¼‚×"x[¯Sö°Óïþò®Õ×SlüuÒó¹¯VÉWÕç¿æñÕÆ~þbÖ<ùd`:ÒVÑl–fãÞáby¶˜/-óû²| MøšâŒÀkNdÎä*È⡘‘ '»y dHK†Èø„0ã‘û±ÉS¸ä)Nò”"yš)yš'yZ(yºKòôMÉSŽä)_ò´RòT.yªx>x*x*ø>ð§¾ÜžÎñyäm çç!ÿøcà|p~’Íx–NÈÙçm€Nø ð”$’™ÚIÛŸ þ$ø“`ú¼yàIàIIíDÁQp3x6øãà'=;åFp¸j¬Í‘÷ ¡ï¢òÇÁ'ñ§ÁŸß¾ügÁ}¿á÷ÓŸü8—xç,p?àõ$tÈÈŸF?? ΀νàYÁ³øüpÐŽí5°9Ë"øNp9¸óŸïeÚg¯€#`js/Ú“áËi6õüÄ×y 6?å? Wô¡/wÑ·¿£Þ…³ ù4ð´$Ž½¿ý·Ñ'oƒ¯ƒßNtÊÀÁÁgƒsÁñý~k°­ ý _%o¡Í›à›ÐúŸË°ùç8ÿrÅogät0N}Ù¿E߈Œúÿè¶ÿu°Žû’À·Gû|ä}Š`\øòJ&&`Ì’m¼g¸:Èë / ÞK$a±ýóø¥8ÿ÷åõàzȧƒ§C><ò—Á/ûò‘S°aЗœCŸ›…èçÂDùÈ»àȧýãëO?ùðgC7¼ó·Á3C3HüxgcBÓf*8òûaÃýèg&v±ã‹ìƒü9ÈÿžéÃb\[ ù°ÏÁ3>7¦ôm9ÃïÃdcûÞYû©\L’ÇÆ»Ï3À3h‚ißÞ ¾òæeíøcóqñ¹íÐç}ž‰ÿ¬<ælLöåŸ? y6øÈ'Œå‹à¾á¤gTÁ*ÆE+¸r–ÙÜÇÚÌƽû`'mSÓxó‡Ý v¦C':ðòlhbž=?°32&GÎÉûògèxŒß3êç¬<4•‘÷=Ú=Wÿ¨þÈc~u4¡ °Áö-ôc±Åo'wÇb;#OŒþÈ0£ä²P9{ûI\>‹cÜog4/$ê³ù"xG°3–ü~¦ñÇL³±œ ýXŽðõ¿ ¦ó"ïÚMŠo•Wþ^ß.—ÆÅ™}:îZ ÅùÝ̽sq/ö"† 2c¶…ΣÀL<¤ó„jp5ͧLœåîÄÎÆj6¿ÇÚ÷埥qr6w4ÀΆ¤8³3Bâç¨4?>À¾ ÈÙÜÍÆ@¬‘9Ú36oäºÁÝqs†Ä¸Çú¼ ¶!ù¿×ÿ^¼#þ:]¸¶ üyðçiß‚ißÆbiÄóÂTî"wÕ»|7‰ÎÛüGÈýü|&)à³øI ÿ?™”óOðÏ’gùF¾‘tðM|y‰oç?Gñ|'YÂwñ_"_ä—ó«Èk|ßCÖñ«ùµäk¼÷Czù×ù^òÿ&ÿuò&¿•ÿ&ÙÂïáÏ“üþ—äüÿ.ù7þ=þ&ù-+Ä‘ßy6…¸güXȽȵÇ[—÷—ø¹ªÚ;ê¼£Þ;š¼£Õ;Ú½£Ã;xÇ"ïXâ˽c•w¬ñŽõ^ßlôŽ-o÷~ïòŽ>ïéß@¯lÅù*2áaœ_ƒä$ÎÍ€É+8ÿäÿáŸyG鈩ó)B#Ù5ÆËžöÏѳÑE„^#7åOõ‰?Õ'þTŸø¿©OØ=öZ{ƒ½ÉÞjï°÷Øûìƒö»ß>iŸ±ÏÛöûš=lßrGs'ÅIw²œ\'ß)rJœR§Ü©rjN£Óâ´9óœNg¡³ØYæ¬tV;ëœ^g³³ÍÙéìuö;‡œ£Îqç”sÖ¹à\r®:CÎ0 Ka#ì†SÃáìð¸pA¸8¼1¼%¼=¼+Ü>>>>>>¾¾ _ßtyWq-7ꦹ™nŽ›çºã݉n™[éÖ¸ÓÝ·ÙåÎuç»]n·»Ô]áö¸kÝ î&w«»ÃÝãîsºGÜ~÷¤{Æ=ï¸WÜkî°{+"D´ˆI‰¤G²"¹‘üHQ¤$R)TEj#3"‘–H[d^¤3²0²8²,²2²:².ÒÙÙÙÙÙ99999¹¹¹ŠÜˆ’¨5¢n45šÍŽŽ‹D‹£¢“¢Ñêh]´>Úmúñü-ÄÑ·0oÀjœC4}ÑôIä°X¾LÌ‘ØA´ŽÍS}qÁ\a÷hŽoNªGÄÖ±‰u¥bpq’;W k€4ÜëEp[â:-®~Du^LªQýG“ê;“Á“¡9+y—©¡<.—0í3sô&¶×>»n¼ƒÐõŒÏ€ÏÏŒ›K±óŸŸ?›4W êS˜³ׂÓ\J×>6¦br¼ßXÍÅo'¶e&ÍGÑ>];ÕXºvBNß×¼`\ûíÿöüíÜù]ÐÇ<˜“ÐçtÍ@çÓSÑÎTÈÓ_Ò!×c­ïp´?™qÇèwÀ´&ÂÔˆ9 mZqµ¿Ä±Yz¦®_ûÛp-[Ÿ¥ãeb艓[ ÿhŒ¹ŒÐäQ.døAF'7ôŒ¾ÏˆKä¯øC£Ü ?wþ1¸‹ßëq/x ø ðLè|ü9\û&¸œ‚{Á0cì“ÃcÌE`3åû΂ÆÚÈ[h¾:2è3xEò}þŠoÿ$/0Üíë‡óÛ¤1‡Üd¸Œ¹t߆€bøFç^¿Gõýþ|¶ ÀÎÆÎJÆÎJÆÎ ÆΊ1;yº¶Xk±6&_B›÷ŽÙOã$µ?àcjÀ ?ÀèäÀælÆ~Z'p/Zƒ°aâ©‚mÔ÷vÃæ§ÿã^è /­¸1lfìŸÂØ 1öÿ,ζ1›K~:§DB›è·‘!Ü‹Ú– P›# Ûî×¼•mßh ¤}‚XG.3ü1æ4Ø 0còŒN}Ó÷yæ˜ßòÈM¤6 öA¦ÁβÀ¶Qßæ:Ðæ“ÁXc‘áZØ@¹•áçØÓ÷9š¸×4Æ?1¾ÈÝ°u1² v"’OƒçÉKÐAm‚ü%®Õ‚øpˆÄçw–ip™ÍûÁؼ+ipo’<;‰Ù\Æ~ËaóËKGŠH,®‚ƒ¸úEðñ1æ>Š¾¥ü0Ãyc×q•2«{Ы”Wù4p}ø1ð_ –^—ƒ¯‚i\Ó¸:¦qµ÷úwØð,x#Ãó>›)ÿ„á1:?„Í´Íïßô9ˆ·;ÀoÃþ5°áAØÿU0c«ÁÔ·¿<¯¯ó˜Æ±¯i[{Q?§\È°È0õsÊ­ ?ÏèP?éûüîEýüoûWBNýüË`êç-`êç3ÁÔÏÀÔÏŸÿ~?_ÊøÌ—(3ò“—¡Ïó¿Î_!ñë–Ùõ Ëð«@§¶ÑÑDßãÜ«¾SZïar_Ÿü°ó³k¥.pWÒšè%\Kçoì8Íaú„ËïÇ›=Û0'$7’ÖJ¯@畤õ;öÙï¬<.>`ö øFçíàÿIsBŸÜnMÄö òÝÈÆϟ»xLççT>…‰Û4.½ùN¼ ¶ÍØwÍÄ{±ßJ{p­_—ç‰ÍÍö¿‹rŸã:ˆÀ½Ì½L$n·€ÈÜ«Ü«Dá>Ïý Q¹/sß#iÜ÷¹Ãdw„û%y*d„¾E愾ú6wW軡#Þ¬àXè'^.þYè-oñëÐ5o…òGZ±uÎ:‹ïø[YȲ…qBP,L& BµP'Ô MB«Ð.t „EÂa¹°JX#¬6 [„íÂ.¡O8 Ž '„ÓÂ9á¢pY® 7E^TDKŒŠib¦˜#扅âxq¢X&VŠ5ât±Alg‰sÅùb—Ø-.Wˆ=âZqƒ¸IÜ*î÷ˆûăâ±_<)žÏ‹âñš8,Þ’I“)EJ—²¤\)_*’J¤R©\ª’j¥R£Ô"µIó¤Ni¡´XZ&­”VKë¤^i³´MÚ)í•öK‡¤£Òqé”tVº ]’®JCÒ ™È’lÈ®œ*gÈÙò8¹@.–'È“ä ¹Z®“ëå&¹Un—;äò"y‰¼\^%¯‘×Ëå-òvy—Ü'ËÇäòiùœ|Q¾,Ê×å› ¯(Š¥D•4%SÉQò”Be¼2Q)S*•eºÒ 4+³”¹Ê|¥KéV–*+”e­²AÙ¤lUv({”}ÊAåˆÒ¯œTÎ(ç•åŠrMVn©‚ª©Žš¢¦«Yj®š¯©%j©Z®V©µê µQmQÛÔyj§ºP]¬.SWª«Õuj¯ºYݦîT÷ªûÕCêQõ¸zJ=«^P/©WÕ!õ†F4I34WKÕ2´lmœV k´IZ…V­ÕiõZ“ÖªµkÚm‘¶D[®­ÒÖhëµÚm»¶KëÓh‡µcÚ í´vN»¨]ÖµëÚM×ÝÒ£zšž©çèyz¡>^Ÿ¨—é•z>]oЛõYú\}¾Þ¥wëKõz¾Vß oÒ·ê;ô=ú>ý ~Dï×Oêgôóú€~E¿¦ë· ÁÐ ÇH1Ò,#×È7ŠŒ£Ô(7ªŒZc†Ñh´mÆ<£ÓXh,6–+ÕÆ:£×Øll3v{ýÆ!ã¨qÜ8eœ5.—Œ«ÆqÃ$¦d¦k¦šf¶9Î,0‹Í æ$³Â¬6ëÌz³Él5ÛÍs¹È\b.7W™kÌõæFs‹¹ÝÜeö™ÌÃæ1ó„yÚnŸ²ÏÚìKöU{ȾáGr ÇuR 'Ûç8ÅÎg’SáT;uN½Óä´:^<ãŽüÊ?£¢ÂfêLp&ó5‘~¡¤ÙðNd´ØΟO€O0_ý?Ëèç$Uÿhukzb•/С­šÒvèWÌ>Øܛي»cì¾±6骊«Mªf<~ŒÕ.÷LRu´–¹öð Ì—ÔñL%37®Ò5@âwu°Õ9fç9 ~Ø—`†ÀKl‡\BÆ~—‘ýA?$Þ‹Ýˤ‰+v•q9òVlÇX4ðT{‚÷»Â³ágtG+l`º{ 6Ëòy|Ð?~›Â˜ÍtFÄqС٠•äÃÌ® *§ÕéÞD_%ï}ò;°s‚ Cþ> ž f;c3FT³É«Ðy5‰¿þ¸Ü ^ ^Š6ÙX¬¾ãZÖ?ÓƒY«ÏìΘƒñ˜È¬³c†Õ!´Jüçй'ðy)ÞŸß—ýxǃþ÷+–‡Áÿ Æ.rüð l`g±š–ûGwÆÀžZ Ÿ\º-û;TBÁûe«¯Œ<1~²ýÉú*Ûç¬>CØx{w /ýåÔWS㾤 $øóÃcq‰/q±ëÃÊ™|Á>›GâbãJÛYåß7ý~ˆU³âÇþ¨OFâsÙÈ÷ÁtfÏ꿤HN~•¤Ïȃ÷…Ý9q1Ÿý"ìP‡ÍÌŠ/èOúÞÙ¼€‹ä•Dy\Îýrºj#¿H’310î‹›»Ùɬ>»b]^–x-KÙ1~[9Vú¤+Q·ó)¶º÷Ûÿ0­ì±óúeöå¸j@¢>ÝF¿Ú`·tðuïvrvNB«ˆY¿WŸÝUO+Æ?ÆNbZ¡_]™'§•ÒS3¹ƒuHþSp(.ïP}ækoÜü¡ LwþÍÓÝcL.‹‹½ùŽ™ƒQ_åt>¬œîÀ{òRðܱ9O°Û’Éqïˆ#±sKv¾ÄŽ_öyÙùÒíú!ãycúýïÛ?íIsv,°öÓÝØm<òè\bâÍìØdÇãŸAóó)Ol!þ8Ï&y²2ò¹‹,&kÉ#dé%Ud#ùyš|“ì%/>ò+ò"ù5ù-ù*¹îeúœåõé·¸®”à&ysÙß„„N†ÄJ±ÎË ¤RBò½s%1¼Ù²F’BÒÑzìÌý‹¿“žœÁLU m\#×,~ÏëÞëôÇ‹Ä"þ× ÿ?ü*›¿¨ñ¿Šçç@ÿ¿küûûóe¿êèûD·wøóÏÞÑó¿ôäxZïyR¼s®÷„¾ýÞPçõæ?þßÜL®•kóÞ¥¿VðýÊÿB“Šï9¶Ï–{OÂy>ex?i$“ä Copyright (C) This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. Also add information on how to contact you by electronic and paper mail. If the program is interactive, make it output a short notice like this when it starts in an interactive mode: Gnomovision version 69, Copyright (C) year name of author Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'. This is free software, and you are welcome to redistribute it under certain conditions; type `show c' for details. The hypothetical commands `show w' and `show c' should show the appropriate parts of the General Public License. Of course, the commands you use may be called something other than `show w' and `show c'; they could even be mouse-clicks or menu items--whatever suits your program. You should also get your employer (if you work as a programmer) or your school, if any, to sign a "copyright disclaimer" for the program, if necessary. Here is a sample; alter the names: Yoyodyne, Inc., hereby disclaims all copyright interest in the program `Gnomovision' (which makes passes at compilers) written by James Hacker. , 1 April 1989 Ty Coon, President of Vice This General Public License does not permit incorporating your program into proprietary programs. If your program is a subroutine library, you may consider it more useful to permit linking proprietary applications with the library. If this is what you want to do, use the GNU Lesser General Public License instead of this License. LambdaHack-0.9.5.0/GameDefinition/fonts/LICENSE.Fix15Mono-Bold0000644000000000000000000001064307346545000021451 0ustar0000000000000000Digitized data copyright (c) 2012-2015, The Mozilla Foundation and Telefonica S.A. with Reserved Font Name < Fira >, This Font Software is licensed under the SIL Open Font License, Version 1.1. This license is copied below, and is also available with a FAQ at: http://scripts.sil.org/OFL ----------------------------------------------------------- SIL OPEN FONT LICENSE Version 1.1 - 26 February 2007 ----------------------------------------------------------- PREAMBLE The goals of the Open Font License (OFL) are to stimulate worldwide development of collaborative font projects, to support the font creation efforts of academic and linguistic communities, and to provide a free and open framework in which fonts may be shared and improved in partnership with others. The OFL allows the licensed fonts to be used, studied, modified and redistributed freely as long as they are not sold by themselves. The fonts, including any derivative works, can be bundled, embedded, redistributed and/or sold with any software provided that any reserved names are not used by derivative works. The fonts and derivatives, however, cannot be released under any other type of license. The requirement for fonts to remain under this license does not apply to any document created using the fonts or their derivatives. DEFINITIONS "Font Software" refers to the set of files released by the Copyright Holder(s) under this license and clearly marked as such. This may include source files, build scripts and documentation. "Reserved Font Name" refers to any names specified as such after the copyright statement(s). "Original Version" refers to the collection of Font Software components as distributed by the Copyright Holder(s). "Modified Version" refers to any derivative made by adding to, deleting, or substituting -- in part or in whole -- any of the components of the Original Version, by changing formats or by porting the Font Software to a new environment. "Author" refers to any designer, engineer, programmer, technical writer or other person who contributed to the Font Software. PERMISSION & CONDITIONS Permission is hereby granted, free of charge, to any person obtaining a copy of the Font Software, to use, study, copy, merge, embed, modify, redistribute, and sell modified and unmodified copies of the Font Software, subject to the following conditions: 1) Neither the Font Software nor any of its individual components, in Original or Modified Versions, may be sold by itself. 2) Original or Modified Versions of the Font Software may be bundled, redistributed and/or sold with any software, provided that each copy contains the above copyright notice and this license. These can be included either as stand-alone text files, human-readable headers or in the appropriate machine-readable metadata fields within text or binary files as long as those fields can be easily viewed by the user. 3) No Modified Version of the Font Software may use the Reserved Font Name(s) unless explicit written permission is granted by the corresponding Copyright Holder. This restriction only applies to the primary font name as presented to the users. 4) The name(s) of the Copyright Holder(s) or the Author(s) of the Font Software shall not be used to promote, endorse or advertise any Modified Version, except to acknowledge the contribution(s) of the Copyright Holder(s) and the Author(s) or with their explicit written permission. 5) The Font Software, modified or unmodified, in part or in whole, must be distributed entirely under this license, and must not be distributed under any other license. The requirement for fonts to remain under this license does not apply to any document created using the Font Software. TERMINATION This license becomes null and void if any of the above conditions are not met. DISCLAIMER THE FONT SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO ANY WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT OF COPYRIGHT, PATENT, TRADEMARK, OR OTHER RIGHT. IN NO EVENT SHALL THE COPYRIGHT HOLDER BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, INCLUDING ANY GENERAL, SPECIAL, INDIRECT, INCIDENTAL, OR CONSEQUENTIAL DAMAGES, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF THE USE OR INABILITY TO USE THE FONT SOFTWARE OR FROM OTHER DEALINGS IN THE FONT SOFTWARE. LambdaHack-0.9.5.0/GameDefinition/game-src/Client/UI/Content/0000755000000000000000000000000007346545000021550 5ustar0000000000000000LambdaHack-0.9.5.0/GameDefinition/game-src/Client/UI/Content/Input.hs0000644000000000000000000003004307346545000023203 0ustar0000000000000000-- | The default game key-command mapping to be used for UI. Can be overridden -- via macros in the config file. module Client.UI.Content.Input ( standardKeysAndMouse #ifdef EXPOSE_INTERNAL -- * Internal operations , closeDoorTriggers, applyTs #endif ) where import Prelude () import Game.LambdaHack.Core.Prelude import Game.LambdaHack.Client.UI.Content.Input import Game.LambdaHack.Client.UI.HumanCmd import qualified Game.LambdaHack.Content.TileKind as TK import Game.LambdaHack.Definition.Defs -- | Description of default key-command bindings. -- -- In addition to these commands, mouse and keys have a standard meaning -- when navigating various menus. standardKeysAndMouse :: InputContentRaw standardKeysAndMouse = InputContentRaw $ map evalKeyDef $ -- All commands are defined here, except some movement and leader picking -- commands. All commands are shown on help screens except debug commands -- and macros with empty descriptions. -- The order below determines the order on the help screens. -- Remember to put commands that show information (e.g., enter aiming -- mode) first. -- Main menu [ ("e", ([CmdMainMenu], "enter challenges menu>", ChallengesMenu)) , ("s", ([CmdMainMenu], "start new game", GameRestart)) , ("x", ([CmdMainMenu], "save and exit to desktop", GameExit)) , ("v", ([CmdMainMenu], "visit settings menu>", SettingsMenu)) , ("t", ([CmdMainMenu], "toggle autoplay (insert coin)", AutomateToggle)) , ("?", ([CmdMainMenu], "see command help", Help)) , ("F12", ([CmdMainMenu], "switch to dashboard", Dashboard)) , ("Escape", ([CmdMainMenu], "back to playing", AutomateBack)) -- Minimal command set, in the desired presentation order. -- A lot of these are not necessary, but may be familiar to new players. , ("E", ( [CmdMinimal, CmdItem, CmdDashboard] , "manage equipment of the leader" , ChooseItemMenu (MStore CEqp) )) , ("g", addCmdCategory CmdMinimal $ grabItems "grab item(s)") , ("Escape", ( [CmdMinimal, CmdAim] , "open main menu/finish aiming" , ByAimMode AimModeCmd { exploration = ExecuteIfClear MainMenuAutoOff , aiming = Cancel } )) , ("C-Escape", ([CmdNoHelp], "", MainMenuAutoOn)) -- required by frontends; not shown , ("Return", ( [CmdMinimal, CmdAim] , "open dashboard/accept target" , ByAimMode AimModeCmd { exploration = ExecuteIfClear Dashboard , aiming = Accept } )) , ("space", ( [CmdMinimal, CmdMeta] , "clear messages and show history" , ExecuteIfClear LastHistory )) , ("Tab", ( [CmdMove] , "cycle among party members on the level" , MemberCycle )) -- listed here to keep proper order , ("BackTab", ( [CmdMinimal, CmdMove] , "cycle among all party members" , MemberBack )) , ("KP_Multiply", ( [CmdMinimal, CmdAim] , "cycle x-hair among enemies" , AimEnemy )) , ("KP_Divide", ([CmdMinimal, CmdAim], "cycle x-hair among items", AimItem)) , ("c", ( [CmdMinimal, CmdMove] , descTs closeDoorTriggers , AlterDir closeDoorTriggers )) , ("%", ([CmdMinimal, CmdMeta], "yell/yawn", Yell)) -- Item menu, first part of item use commands , ("comma", grabItems "") , ("d", dropItems "drop item(s)") , ("period", dropItems "") , ("f", addCmdCategory CmdItemMenu $ projectA flingTs) , ("C-f", addCmdCategory CmdItemMenu $ replaceDesc "auto-fling and keep choice" $ projectI flingTs) , ("a", addCmdCategory CmdItemMenu $ applyI applyTs) , ("C-a", addCmdCategory CmdItemMenu $ replaceDesc "apply and keep choice" $ applyIK applyTs) , ("p", moveItemTriple [CGround, CEqp, CSha] CInv "item" False) , ("i", replaceDesc "" $ moveItemTriple [CGround, CEqp, CSha] CInv "item" False) , ("e", moveItemTriple [CGround, CInv, CSha] CEqp "item" False) , ("s", moveItemTriple [CGround, CInv, CEqp] CSha "and share item" False) -- Terrain exploration and alteration , ("C", ([CmdMove], "open or close or alter", AlterDir [])) , ("=", ( [CmdMove], "select (or deselect) party member", SelectActor) ) , ("_", ([CmdMove], "deselect (or select) all on the level", SelectNone)) , ("semicolon", ( [CmdMove] , "go to x-hair for 25 steps" , Macro ["C-semicolon", "C-quotedbl", "C-V"] )) , ("colon", ( [CmdMove] , "run to x-hair collectively for 25 steps" , Macro ["C-colon", "C-quotedbl", "C-V"] )) , ("x", ( [CmdMove] , "explore nearest unknown spot" , autoexploreCmd )) , ("X", ( [CmdMove] , "autoexplore 25 times" , autoexplore25Cmd )) , ("R", ([CmdMove], "rest (wait 25 times)", Macro ["KP_Begin", "C-V"])) , ("C-R", ( [CmdMove], "heed (lurk 0.1 turns 100 times)" , Macro ["C-KP_Begin", "V"] )) -- Item use, continued , ("P", ( [CmdItem, CmdDashboard] , "manage inventory pack of the leader" , ChooseItemMenu (MStore CInv) )) , ("I", ( [CmdItem, CmdDashboard] , "" , ChooseItemMenu (MStore CInv) )) , ("S", ( [CmdItem, CmdDashboard] , "manage the shared party stash" , ChooseItemMenu (MStore CSha) )) , ("G", ( [CmdItem, CmdDashboard] , "manage items on the ground" , ChooseItemMenu (MStore CGround) )) , ("A", ( [CmdItem, CmdDashboard] , "manage all owned items" , ChooseItemMenu MOwned )) , ("@", ( [CmdItem, CmdDashboard] , "describe organs of the leader" , ChooseItemMenu MOrgans )) , ("#", ( [CmdItem, CmdDashboard] , "show skill summary of the leader" , ChooseItemMenu MSkills )) , ("~", ( [CmdItem] , "display known lore" , ChooseItemMenu (MLore SItem) )) -- Dashboard, in addition to commands marked above , ("safeD0", ([CmdInternal, CmdDashboard], "", Cancel)) -- blank line ] ++ map (\(k, slore) -> ("safeD" ++ show (k :: Int) , ( [CmdInternal, CmdDashboard] , "display" <+> ppSLore slore <+> "lore" , ChooseItemMenu (MLore slore) ))) (zip [1..] [minBound..maxBound]) ++ [ ("safeD98", ( [CmdInternal, CmdDashboard] , "display place lore" , ChooseItemMenu MPlaces) ) , ("safeD99", ([CmdInternal, CmdDashboard], "", Cancel)) -- blank line -- Aiming , ("!", ([CmdAim], "", AimEnemy)) , ("/", ([CmdAim], "", AimItem)) , ("+", ([CmdAim], "swerve the aiming line", EpsIncr True)) , ("-", ([CmdAim], "unswerve the aiming line", EpsIncr False)) , ("\\", ([CmdAim], "cycle aiming modes", AimFloor)) , ("C-?", ( [CmdAim] , "set x-hair to nearest unknown spot" , XhairUnknown )) , ("C-/", ( [CmdAim] , "set x-hair to nearest item" , XhairItem )) , ("C-{", ( [CmdAim] , "set x-hair to nearest upstairs" , XhairStair True )) , ("C-}", ( [CmdAim] , "set x-hair to nearest dnstairs" , XhairStair False )) , ("<", ([CmdAim], "move aiming one level up" , AimAscend 1)) , ("C-<", ( [CmdNoHelp], "move aiming 10 levels up" , AimAscend 10) ) , (">", ([CmdAim], "move aiming one level down", AimAscend (-1))) -- 'lower' would be misleading in some games, just as 'deeper' , ("C->", ( [CmdNoHelp], "move aiming 10 levels down" , AimAscend (-10)) ) , ("BackSpace" , ( [CmdAim] , "clear chosen item and x-hair" , ComposeUnlessError ClearTargetIfItemClear ItemClear)) -- Assorted (first few cloned from main menu) , ("C-s", ([CmdMeta], "start new game", GameRestart)) , ("C-x", ([CmdMeta], "save and exit to desktop", GameExit)) , ("C-t", ([CmdMeta], "toggle autoplay (insert coin)", Automate)) , ("C-q", ([CmdMeta], "quit game and start autoplay", GameQuit)) , ("C-c", ([CmdMeta], "exit to desktop without saving", GameDrop)) , ("?", ([CmdMeta], "display help", Hint)) , ("F1", ([CmdMeta, CmdDashboard], "display help immediately", Help)) , ("F12", ([CmdMeta], "open dashboard", Dashboard)) , ("v", ([CmdMeta], "voice again the recorded commands", Repeat 1)) , ("V", repeatTriple 100) , ("C-v", repeatTriple 1000) , ("C-V", repeatTriple 25) , ("'", ([CmdMeta], "start recording commands", Record)) , ("C-S", ([CmdMeta], "save game backup", GameSave)) , ("C-P", ([CmdMeta], "print screen", PrintScreen)) -- Dashboard, in addition to commands marked above , ("safeD101", ([CmdInternal, CmdDashboard], "display history", AllHistory)) -- Mouse , ( "LeftButtonRelease" , mouseLMB goToCmd "go to pointer for 25 steps/fling at enemy" ) , ( "S-LeftButtonRelease" , mouseLMB runToAllCmd "run to pointer collectively for 25 steps/fling at enemy" ) , ("RightButtonRelease", mouseRMB) , ("C-LeftButtonRelease", replaceDesc "" mouseRMB) -- Mac convention , ( "S-RightButtonRelease" , ([CmdMouse], "open or close or alter at pointer", AlterWithPointer []) ) , ("MiddleButtonRelease", mouseMMB) , ("C-RightButtonRelease", replaceDesc "" mouseMMB) , ( "C-S-LeftButtonRelease", addCmdCategory CmdNoHelp $ replaceDesc "" mouseMMB ) , ("WheelNorth", ([CmdMouse], "swerve the aiming line", Macro ["+"])) , ("WheelSouth", ([CmdMouse], "unswerve the aiming line", Macro ["-"])) -- Debug and others not to display in help screens , ("C-semicolon", ( [CmdNoHelp] , "move one step towards the x-hair" , MoveOnceToXhair )) , ("C-colon", ( [CmdNoHelp] , "run collectively one step towards the x-hair" , RunOnceToXhair )) , ("C-quotedbl", ( [CmdNoHelp] , "continue towards the x-hair" , ContinueToXhair )) , ("C-comma", ([CmdNoHelp], "run once ahead", RunOnceAhead)) , ("safe1", ( [CmdInternal] , "go to pointer for 25 steps" , goToCmd )) , ("safe2", ( [CmdInternal] , "run to pointer collectively" , runToAllCmd )) , ("safe3", ( [CmdInternal] , "pick new leader on screen" , PickLeaderWithPointer )) , ("safe4", ( [CmdInternal] , "select party member on screen" , SelectWithPointer )) , ("safe5", ( [CmdInternal] , "set x-hair to enemy" , AimPointerEnemy )) , ("safe6", ( [CmdInternal] , "fling at enemy under pointer" , aimFlingCmd )) , ("safe7", ( [CmdInternal, CmdDashboard] , "open main menu" , MainMenuAutoOff )) , ("safe8", ( [CmdInternal] , "cancel aiming" , Cancel )) , ("safe9", ( [CmdInternal] , "accept target" , Accept )) , ("safe10", ( [CmdInternal] , "wait a turn, bracing for impact" , Wait )) , ("safe11", ( [CmdInternal] , "lurk 0.1 of a turn" , Wait10 )) , ("safe12", ( [CmdInternal] , "snap x-hair to enemy" , XhairPointerEnemy )) ] ++ map defaultHeroSelect [0..6] closeDoorTriggers :: [TriggerTile] closeDoorTriggers = [ TriggerTile { ttverb = "close" , ttobject = "door" , ttfeature = TK.CloseTo "closed vertical door Lit" } , TriggerTile { ttverb = "close" , ttobject = "door" , ttfeature = TK.CloseTo "closed horizontal door Lit" } , TriggerTile { ttverb = "close" , ttobject = "door" , ttfeature = TK.CloseTo "closed vertical door Dark" } , TriggerTile { ttverb = "close" , ttobject = "door" , ttfeature = TK.CloseTo "closed horizontal door Dark" } ] applyTs :: [TriggerItem] applyTs = [TriggerItem { tiverb = "apply" , tiobject = "consumable" , tisymbols = "!,?/" }] LambdaHack-0.9.5.0/GameDefinition/game-src/Client/UI/Content/Screen.hs0000644000000000000000000000502007346545000023320 0ustar0000000000000000{-# LANGUAGE TemplateHaskell #-} -- | The default screen layout and features definition. module Client.UI.Content.Screen ( standardLayoutAndFeatures ) where import Prelude () import Game.LambdaHack.Core.Prelude import qualified Data.EnumMap.Strict as EM import Language.Haskell.TH.Syntax import System.IO import Game.LambdaHack.Client.UI.Content.Screen -- | Description of default screen layout and features. standardLayoutAndFeatures :: ScreenContent standardLayoutAndFeatures = ScreenContent { rwidth = 80 , rheight = 24 -- ASCII art for the main menu. Only pure 7-bit ASCII characters are allowed, -- except for character 183 ('·'), which is rendered as very tiny middle dot. -- The encoding should be utf-8-unix. -- When displayed in the main menu screen, the picture is overwritten -- with game and engine version strings and keybindings. -- The keybindings overwrite places marked with left curly brace signs. -- This sign is forbidden anywhere else in the picture. -- The picture and the whole main menu is displayed dull white on black. -- The glyphs, or at least the character cells, are perfect squares. -- The picture for LambdaHack should be exactly 24 rows by 80 columns. , rmainMenuArt = $(do let path = "GameDefinition/MainMenu.ascii" qAddDependentFile path x <- qRunIO $ do handle <- openFile path ReadMode hSetEncoding handle utf8 hGetContents handle lift x) , rintroScreen = $(do let path = "GameDefinition/PLAYING.md" qAddDependentFile path x <- qRunIO $ do handle <- openFile path ReadMode hSetEncoding handle utf8 hGetContents handle let paragraphs :: [String] -> [String] -> [[String]] paragraphs [] rows = [reverse rows] paragraphs (l : ls) rows = if null l then reverse rows : paragraphs ls [] else paragraphs ls (l : rows) intro = case paragraphs (lines x) [] of _title : _blurb : par1 : par2 : _rest -> ["", ""] ++ par1 ++ [""] ++ par2 ++ ["", ""] _ -> error "not enough paragraphs in intro screen text" lift intro) , rmoveKeysScreen = $(do let path = "GameDefinition/MoveKeys.txt" qAddDependentFile path x <- qRunIO $ do handle <- openFile path ReadMode hSetEncoding handle utf8 hGetContents handle lift $ lines x) , rapplyVerbMap = EM.fromList [('!', "quaff"), (',', "eat"), ('?', "read")] } LambdaHack-0.9.5.0/GameDefinition/game-src/Implementation/0000755000000000000000000000000007346545000021370 5ustar0000000000000000LambdaHack-0.9.5.0/GameDefinition/game-src/Implementation/MonadClientImplementation.hs0000644000000000000000000001407307346545000027034 0ustar0000000000000000{-# LANGUAGE GeneralizedNewtypeDeriving #-} -- | The implementation of our custom game client monads. Just as any other -- component of the library, this implementation can be substituted. module Implementation.MonadClientImplementation ( executorCli #ifdef EXPOSE_INTERNAL -- * Internal operations , CliState(..), CliImplementation(..) #endif ) where import Prelude () import Game.LambdaHack.Core.Prelude import Control.Concurrent import qualified Control.Monad.IO.Class as IO import Control.Monad.Trans.State.Strict hiding (State) import Game.LambdaHack.Atomic (MonadStateWrite (..)) import Game.LambdaHack.Client import qualified Game.LambdaHack.Client.BfsM as BfsM import Game.LambdaHack.Client.HandleAtomicM import Game.LambdaHack.Client.HandleResponseM import Game.LambdaHack.Client.LoopM import Game.LambdaHack.Client.MonadClient import Game.LambdaHack.Client.State import Game.LambdaHack.Client.UI import Game.LambdaHack.Client.UI.SessionUI import Game.LambdaHack.Common.Kind import Game.LambdaHack.Common.Types import Game.LambdaHack.Common.MonadStateRead import qualified Game.LambdaHack.Common.Save as Save import Game.LambdaHack.Common.State import Game.LambdaHack.Server (ChanServer (..)) data CliState = CliState { cliState :: State -- ^ current global state , cliClient :: StateClient -- ^ current client state , cliSession :: Maybe SessionUI -- ^ UI state, empty for AI clients , cliDict :: ChanServer -- ^ this client connection information , cliToSave :: Save.ChanSave (StateClient, Maybe SessionUI) -- ^ connection to the save thread } -- | Client state transformation monad. newtype CliImplementation a = CliImplementation { runCliImplementation :: StateT CliState IO a } deriving (Monad, Functor, Applicative) instance MonadStateRead CliImplementation where {-# INLINE getsState #-} getsState f = CliImplementation $ gets $ f . cliState instance MonadStateWrite CliImplementation where {-# INLINE modifyState #-} modifyState f = CliImplementation $ state $ \cliS -> let !newCliS = cliS {cliState = f $ cliState cliS} in ((), newCliS) {-# INLINE putState #-} putState newCliState = CliImplementation $ state $ \cliS -> let !newCliS = cliS {cliState = newCliState} in ((), newCliS) instance MonadClientRead CliImplementation where {-# INLINE getsClient #-} getsClient f = CliImplementation $ gets $ f . cliClient liftIO = CliImplementation . IO.liftIO instance MonadClient CliImplementation where {-# INLINE modifyClient #-} modifyClient f = CliImplementation $ state $ \cliS -> let !newCliS = cliS {cliClient = f $ cliClient cliS} in ((), newCliS) instance MonadClientSetup CliImplementation where saveClient = CliImplementation $ do toSave <- gets cliToSave cli <- gets cliClient msess <- gets cliSession IO.liftIO $ Save.saveToChan toSave (cli, msess) restartClient = CliImplementation $ state $ \cliS -> case cliSession cliS of Just sess -> let !newSess = (emptySessionUI (sUIOptions sess)) { schanF = schanF sess , sccui = sccui sess , shistory = shistory sess , sstart = sstart sess , sgstart = sgstart sess , sallTime = sallTime sess , snframes = snframes sess , sallNframes = sallNframes sess } !newCliS = cliS {cliSession = Just newSess} in ((), newCliS) Nothing -> ((), cliS) instance MonadClientUI CliImplementation where {-# INLINE getsSession #-} getsSession f = CliImplementation $ gets $ f . fromJust . cliSession {-# INLINE modifySession #-} modifySession f = CliImplementation $ state $ \cliS -> let !newCliSession = f $ fromJust $ cliSession cliS !newCliS = cliS {cliSession = Just newCliSession} in ((), newCliS) updateClientLeader aid = do s <- getState modifyClient $ updateLeader aid s getCacheBfs = BfsM.getCacheBfs getCachePath = BfsM.getCachePath instance MonadClientReadResponse CliImplementation where receiveResponse = CliImplementation $ do ChanServer{responseS} <- gets cliDict IO.liftIO $ takeMVar responseS instance MonadClientWriteRequest CliImplementation where sendRequestAI scmd = CliImplementation $ do ChanServer{requestAIS} <- gets cliDict IO.liftIO $ putMVar requestAIS scmd sendRequestUI scmd = CliImplementation $ do ChanServer{requestUIS} <- gets cliDict IO.liftIO $ putMVar (fromJust requestUIS) scmd clientHasUI = CliImplementation $ do mSession <- gets cliSession return $! isJust mSession instance MonadClientAtomic CliImplementation where {-# INLINE execUpdAtomic #-} execUpdAtomic _ = return () -- handleUpdAtomic, until needed, save resources -- Don't catch anything; assume exceptions impossible. {-# INLINE execPutState #-} execPutState = putState -- | Run the main client loop, with the given arguments and empty -- initial states, in the @IO@ monad. executorCli :: CCUI -> UIOptions -> ClientOptions -> COps -> Bool -> FactionId -> ChanServer -> IO () executorCli ccui sUIOptions clientOptions cops isUI fid cliDict = let cliSession | isUI = Just $ emptySessionUI sUIOptions | otherwise = Nothing stateToFileName (cli, _) = ssavePrefixCli (soptions cli) <> Save.saveNameCli cops (sside cli) totalState cliToSave = CliState { cliState = updateCOpsAndCachedData (const cops) emptyState -- state is empty, so the cached data is left empty and untouched , cliClient = emptyStateClient fid , cliDict , cliToSave , cliSession } m = loopCli ccui sUIOptions clientOptions exe = evalStateT (runCliImplementation m) . totalState in Save.wrapInSaves cops stateToFileName exe LambdaHack-0.9.5.0/GameDefinition/game-src/Implementation/MonadServerImplementation.hs0000644000000000000000000002101107346545000027052 0ustar0000000000000000{-# LANGUAGE GeneralizedNewtypeDeriving #-} -- | The implementation of our custom game server monads. Just as any other -- component of the library, this implementation can be substituted. module Implementation.MonadServerImplementation ( executorSer #ifdef EXPOSE_INTERNAL -- * Internal operations , SerState(..), SerImplementation(..) #endif ) where import Prelude () import Game.LambdaHack.Core.Prelude import Control.Concurrent import qualified Control.Exception as Ex import qualified Control.Monad.IO.Class as IO import Control.Monad.Trans.State.Strict hiding (State) import qualified Data.EnumMap.Strict as EM import qualified Data.Text.IO as T import Options.Applicative (defaultPrefs, execParserPure, handleParseResult) import System.Exit (ExitCode (ExitSuccess)) import System.FilePath import System.IO (hFlush, stdout) import Game.LambdaHack.Atomic import Game.LambdaHack.Client import Game.LambdaHack.Common.File import Game.LambdaHack.Common.Kind import Game.LambdaHack.Common.Misc import Game.LambdaHack.Common.MonadStateRead import qualified Game.LambdaHack.Common.Save as Save import Game.LambdaHack.Common.State import Game.LambdaHack.Common.Thread import Game.LambdaHack.Server import Game.LambdaHack.Server.BroadcastAtomic import Game.LambdaHack.Server.HandleAtomicM import Game.LambdaHack.Server.MonadServer import Game.LambdaHack.Server.ProtocolM import Game.LambdaHack.Server.ServerOptions import Game.LambdaHack.Server.State import Implementation.MonadClientImplementation (executorCli) data SerState = SerState { serState :: State -- ^ current global state , serServer :: StateServer -- ^ current server state , serDict :: ConnServerDict -- ^ client-server connection information , serToSave :: Save.ChanSave (State, StateServer) -- ^ connection to the save thread } -- | Server state transformation monad. newtype SerImplementation a = SerImplementation {runSerImplementation :: StateT SerState IO a} deriving (Monad, Functor, Applicative) instance MonadStateRead SerImplementation where {-# INLINE getsState #-} getsState f = SerImplementation $ gets $ f . serState instance MonadStateWrite SerImplementation where {-# INLINE modifyState #-} modifyState f = SerImplementation $ state $ \serS -> let !newSerS = serS {serState = f $ serState serS} in ((), newSerS) {-# INLINE putState #-} putState newSerState = SerImplementation $ state $ \serS -> let !newSerS = serS {serState = newSerState} in ((), newSerS) instance MonadServer SerImplementation where {-# INLINE getsServer #-} getsServer f = SerImplementation $ gets $ f . serServer {-# INLINE modifyServer #-} modifyServer f = SerImplementation $ state $ \serS -> let !newSerS = serS {serServer = f $ serServer serS} in ((), newSerS) chanSaveServer = SerImplementation $ gets serToSave liftIO = SerImplementation . IO.liftIO instance MonadServerComm SerImplementation where {-# INLINE getsDict #-} getsDict f = SerImplementation $ gets $ f . serDict {-# INLINE modifyDict #-} modifyDict f = SerImplementation $ state $ \serS -> let !newSerS = serS {serDict = f $ serDict serS} in ((), newSerS) liftIO = SerImplementation . IO.liftIO instance MonadServerAtomic SerImplementation where execUpdAtomic cmd = do oldState <- getState (ps, atomicBroken, executedOnServer) <- handleCmdAtomicServer cmd when executedOnServer $ cmdAtomicSemSer oldState cmd handleAndBroadcast ps atomicBroken (UpdAtomic cmd) execUpdAtomicSer cmd = SerImplementation $ StateT $ \cliS -> do cliSNewOrE <- Ex.try $ execStateT (runSerImplementation $ handleUpdAtomic cmd) cliS case cliSNewOrE of Left AtomicFail{} -> return (False, cliS) Right !cliSNew -> -- We know @cliSNew@ differs only in @serState@. return (True, cliSNew) execUpdAtomicFid fid cmd = SerImplementation $ StateT $ \cliS -> do -- Don't catch anything; assume exceptions impossible. let sFid = sclientStates (serServer cliS) EM.! fid cliSNew <- execStateT (runSerImplementation $ handleUpdAtomic cmd) cliS {serState = sFid} -- We know @cliSNew@ differs only in @serState@. let serServerNew = (serServer cliS) {sclientStates = EM.insert fid (serState cliSNew) $ sclientStates $ serServer cliS} !newCliS = cliS {serServer = serServerNew} return ((), newCliS) execUpdAtomicFidCatch fid cmd = SerImplementation $ StateT $ \cliS -> do let sFid = sclientStates (serServer cliS) EM.! fid cliSNewOrE <- Ex.try $ execStateT (runSerImplementation $ handleUpdAtomic cmd) cliS {serState = sFid} case cliSNewOrE of Left AtomicFail{} -> return (False, cliS) Right cliSNew -> do -- We know @cliSNew@ differs only in @serState@. let serServerNew = (serServer cliS) {sclientStates = EM.insert fid (serState cliSNew) $ sclientStates $ serServer cliS} !newCliS = cliS {serServer = serServerNew} return (True, newCliS) execSfxAtomic sfx = do ps <- posSfxAtomic sfx handleAndBroadcast ps [] (SfxAtomic sfx) execSendPer = sendPer -- Don't inline this, to keep GHC hard work inside the library -- for easy access of code analysis tools. -- | Run the main server loop, with the given arguments and empty -- initial states, in the @IO@ monad. executorSer :: COps -> CCUI -> ServerOptions -> UIOptions -> IO () executorSer cops ccui soptionsNxtCmdline sUIOptions = do soptionsNxtRaw <- case uCmdline sUIOptions of [] -> return soptionsNxtCmdline args -> handleParseResult $ execParserPure defaultPrefs serverOptionsPI args -- Options for the clients modified with the configuration file. let clientOptions = applyUIOptions cops sUIOptions $ sclientOptions soptionsNxtRaw soptionsNxt = soptionsNxtRaw {sclientOptions = clientOptions} -- Partially applied main loop of the clients. executorClient = executorCli ccui sUIOptions clientOptions cops -- Wire together game content, the main loop of game clients -- and the game server loop. let stateToFileName (_, ser) = ssavePrefixSer (soptions ser) <> Save.saveNameSer cops totalState serToSave = SerState { serState = updateCOpsAndCachedData (const cops) emptyState -- state is empty, so the cached data is left empty and untouched , serServer = emptyStateServer , serDict = EM.empty , serToSave } m = loopSer soptionsNxt executorClient exe = evalStateT (runSerImplementation m) . totalState exeWithSaves = Save.wrapInSaves cops stateToFileName exe defPrefix = ssavePrefixSer defServerOptions bkpOneSave name = do dataDir <- appDataDir let path bkp = dataDir "saves" bkp <> name b <- doesFileExist (path "") when b $ renameFile (path "") (path "bkp.") bkpAllSaves = unless (sbenchmark $ sclientOptions soptionsNxt) $ do T.hPutStrLn stdout "The game crashed, so savefiles are moved aside." bkpOneSave $ defPrefix <> Save.saveNameSer cops forM_ [-99..99] $ \n -> bkpOneSave $ defPrefix <> Save.saveNameCli cops (toEnum n) -- Wait for clients to exit even in case of server crash -- (or server and client crash), which gives them time to save -- and report their own inconsistencies, if any. Ex.handle (\ex -> case Ex.fromException ex of Just ExitSuccess -> -- User-forced shutdown, not crash, so the intention is -- to keep old saves and also clients may be not ready to save. Ex.throwIO ex _ -> do Ex.uninterruptibleMask_ $ threadDelay 1000000 -- let clients report their errors and save when (ssavePrefixSer soptionsNxt == defPrefix) bkpAllSaves hFlush stdout Ex.throwIO ex -- crash eventually, which kills clients ) exeWithSaves -- T.hPutStrLn stdout "Server exiting, waiting for clients." -- hFlush stdout waitForChildren childrenServer -- no crash, wait for clients indefinitely -- T.hPutStrLn stdout "Server exiting now." -- hFlush stdout LambdaHack-0.9.5.0/GameDefinition/game-src/0000755000000000000000000000000007346545000016403 5ustar0000000000000000LambdaHack-0.9.5.0/GameDefinition/game-src/TieKnot.hs0000644000000000000000000001407407346545000020322 0ustar0000000000000000-- | Here the knot of engine code pieces, frontend and the game-specific -- content definitions is tied, resulting in an executable game. module TieKnot ( tieKnotForAsync, tieKnot ) where import Prelude () import Game.LambdaHack.Core.Prelude import Control.Concurrent import Control.Concurrent.Async import qualified Control.Exception as Ex import qualified Data.Primitive.PrimArray as PA import GHC.Compact import qualified System.Random as R import Game.LambdaHack.Client import qualified Game.LambdaHack.Client.UI.Content.Input as IC import qualified Game.LambdaHack.Client.UI.Content.Screen as SC import Game.LambdaHack.Client.UI.ContentClientUI import Game.LambdaHack.Common.Kind import Game.LambdaHack.Common.Misc import Game.LambdaHack.Common.Point (speedupHackXSize) import qualified Game.LambdaHack.Common.Tile as Tile import qualified Game.LambdaHack.Content.CaveKind as CK import qualified Game.LambdaHack.Content.ItemKind as IK import qualified Game.LambdaHack.Content.ModeKind as MK import qualified Game.LambdaHack.Content.PlaceKind as PK import qualified Game.LambdaHack.Content.RuleKind as RK import qualified Game.LambdaHack.Content.TileKind as TK import Game.LambdaHack.Server import qualified Client.UI.Content.Input as Content.Input import qualified Client.UI.Content.Screen as Content.Screen import qualified Content.CaveKind import qualified Content.ItemKind import qualified Content.ModeKind import qualified Content.PlaceKind import qualified Content.RuleKind import qualified Content.TileKind import Implementation.MonadServerImplementation (executorSer) -- | Tie the LambdaHack engine client, server and frontend code -- with the game-specific content definitions, and run the game. -- -- The custom monad types to be used are determined by the @executorSer@ -- call, which in turn calls @executorCli@. If other functions are used -- in their place- the types are different and so the whole pattern -- of computation differs. Which of the frontends is run inside the UI client -- depends on the flags supplied when compiling the engine library. -- Similarly for the choice of native vs JS builds. tieKnotForAsync :: ServerOptions -> IO () tieKnotForAsync options@ServerOptions{ sallClear , sboostRandomItem , sdungeonRng } = do -- Set the X size of the dungeon from content ASAP, before it's used. speedupHackXSizeThawed <- PA.unsafeThawPrimArray speedupHackXSize PA.writePrimArray speedupHackXSizeThawed 0 $ RK.rXmax Content.RuleKind.standardRules void $ PA.unsafeFreezePrimArray speedupHackXSizeThawed -- This setup ensures the boosting option doesn't affect generating initial -- RNG for dungeon, etc., and also, that setting dungeon RNG on commandline -- equal to what was generated last time, ensures the same item boost. initialGen <- maybe R.getStdGen return sdungeonRng let soptionsNxt = options {sdungeonRng = Just initialGen} boostedItems = IK.boostItemKindList initialGen Content.ItemKind.items coitem = IK.makeData $ if sboostRandomItem then boostedItems ++ Content.ItemKind.otherItemContent else Content.ItemKind.content coItemSpeedup = speedupItem coitem cotile = TK.makeData coitem Content.TileKind.content coTileSpeedup = Tile.speedupTile sallClear cotile coplace = PK.makeData cotile Content.PlaceKind.content cocave = CK.makeData coitem coplace cotile Content.CaveKind.content -- Common content operations, created from content definitions. -- Evaluated fully to discover errors ASAP and to free memory. -- Fail here, not inside server code, so that savefiles are not removed, -- because they are not the source of the failure. copsRaw = COps { cocave , coitem , comode = MK.makeData cocave coitem Content.ModeKind.content , coplace , corule = RK.makeData Content.RuleKind.standardRules , cotile , coItemSpeedup , coTileSpeedup } benchmark = sbenchmark $ sclientOptions soptionsNxt -- Evaluating for compact regions catches all kinds of errors in content ASAP, -- even in unused items. -- -- Not using @compactWithSharing@, because it helps with residency, -- but nothing else and costs a bit at startup. #ifdef USE_JSFILE let cops = copsRaw -- until GHCJS implements GHC.Compact #else cops <- getCompact <$> compact copsRaw #endif -- Parse UI client configuration file. -- It is reparsed at each start of the game executable. -- Fail here, not inside client code, so that savefiles are not removed, -- because they are not the source of the failure. sUIOptions <- mkUIOptions cops benchmark -- Client content operations containing default keypresses -- and command descriptions. let !ccui = CCUI { coinput = IC.makeData sUIOptions Content.Input.standardKeysAndMouse , coscreen = SC.makeData Content.Screen.standardLayoutAndFeatures } -- Wire together game content, the main loops of game clients -- and the game server loop. executorSer cops ccui soptionsNxt sUIOptions -- | Runs tieKnotForAsync in an async and applies the main thread workaround. tieKnot :: ServerOptions -> IO () tieKnot serverOptions = do #ifdef USE_JSFILE -- Hard to tweak the config file when in the browser, so hardwire. let serverOptionsJS = serverOptions {sdumpInitRngs = True} a <- async $ tieKnotForAsync serverOptionsJS wait a #else let fillWorkaround = -- Set up void workaround if nothing specific required. void $ tryPutMVar workaroundOnMainThreadMVar $ return () -- Avoid the bound thread that would slow down the communication. a <- async $ tieKnotForAsync serverOptions `Ex.finally` fillWorkaround link a -- Run a (possibly void) workaround. It's needed for OSes/frontends -- that need to perform some actions on the main thread -- (not just any bound thread), e.g., newer OS X drawing with SDL2. workaround <- takeMVar workaroundOnMainThreadMVar workaround wait a #endif LambdaHack-0.9.5.0/LICENSE0000644000000000000000000000271407346545000013034 0ustar0000000000000000BSD 3-Clause License All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. 3. Neither the name of the copyright holder nor the names of its contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. LambdaHack-0.9.5.0/LambdaHack.cabal0000644000000000000000000004355507346545000014772 0ustar0000000000000000cabal-version: 2.2 name: LambdaHack -- The package version. See the Haskell package versioning policy (PVP) -- for standards guiding when and how versions should be incremented. -- http://www.haskell.org/haskellwiki/Package_versioning_policy -- PVP summary:+-+------- breaking API changes -- | | +----- minor or non-breaking API additions -- | | | +--- code changes with no API change version: 0.9.5.0 synopsis: A game engine library for tactical squad ASCII roguelike dungeon crawlers description: LambdaHack is a Haskell game engine library for ASCII roguelike games of arbitrary theme, size and complexity, with optional tactical squad combat. It's packaged together with a sample dungeon crawler in fantasy setting that can be tried out in the browser at . (It runs fastest on Chrome. Keyboard commands and savefiles are supported only on recent enough versions of browsers. Mouse should work everywhere.) . Please see the changelog file for recent improvements and the issue tracker for short-term plans. Long term goals include multiplayer tactical squad combat, in-game content creation, auto-balancing and persistent content modification based on player behaviour. Contributions are welcome. . Games known to use the LambdaHack library: . * Allure of the Stars, a near-future Sci-Fi game, . * Space Privateers, an adventure game set in far future, . Note: All modules in this library are kept visible, to let games override and reuse them. OTOH, to reflect that some modules are implementation details relative to others, the source code adheres to the following convention. If a module has the same name as a directory, the module is the exclusive interface to the directory. No references to the modules in the directory are allowed except from the interface module. This policy is only binding when developing the library --- library users are free to access any modules, since the library authors are in no position to guess their particular needs. . This is a workaround .cabal file, flattened to eliminated internal libraries until generating haddocks for them is fixed. The original .cabal file is stored in the github repo. homepage: https://lambdahack.github.io bug-reports: http://github.com/LambdaHack/LambdaHack/issues license: BSD-3-Clause license-file: COPYLEFT tested-with: GHC==8.2.2, GHC==8.4.4, GHC==8.6.5 data-files: GameDefinition/config.ui.default, GameDefinition/fonts/16x16xw.woff, GameDefinition/fonts/16x16xw.bdf, GameDefinition/fonts/16x16x.fnt, GameDefinition/fonts/8x8xb.fnt, GameDefinition/fonts/8x8x.fnt, GameDefinition/fonts/LICENSE.16x16x, GameDefinition/fonts/Fix15Mono-Bold.woff, GameDefinition/fonts/LICENSE.Fix15Mono-Bold, GameDefinition/InGameHelp.txt, GameDefinition/PLAYING.md, README.md, CHANGELOG.md, LICENSE, COPYLEFT, CREDITS extra-source-files: GameDefinition/config.ui.default, GameDefinition/MainMenu.ascii, GameDefinition/MoveKeys.txt, GameDefinition/PLAYING.md, Makefile author: Andres Loeh, Mikolaj Konarski and others maintainer: Mikolaj Konarski category: Game Engine, Game build-type: Simple source-repository head type: git location: git://github.com/LambdaHack/LambdaHack.git flag vty description: switch to the vty frontend (screen reader friendly) default: False manual: True flag curses description: switch to the curses frontend (not fully supported) default: False manual: True flag gtk description: switch to the GTK frontend (not fully supported) default: False manual: True flag sdl description: switch to the SDL2 frontend default: False manual: True flag jsaddle description: switch to the JSaddle frontend (may be bit-rotted) default: False manual: True flag with_expensive_assertions description: turn on expensive assertions of well-tested code default: False manual: True flag release description: prepare for a release (expose internal functions and types, etc.) default: True manual: True flag supportNodeJS description: compile so that the JS blob works in terminal with NodeJS default: True manual: True common options default-language: Haskell2010 default-extensions: MonoLocalBinds, ScopedTypeVariables, OverloadedStrings BangPatterns, RecordWildCards, NamedFieldPuns, MultiWayIf, LambdaCase, DefaultSignatures, InstanceSigs, MonadFailDesugaring, StrictData, CPP other-extensions: TemplateHaskell, MultiParamTypeClasses, RankNTypes, TypeFamilies, FlexibleContexts, FlexibleInstances, DeriveFunctor, FunctionalDependencies, GeneralizedNewtypeDeriving, TupleSections, DeriveFoldable, DeriveTraversable, ExistentialQuantification, GADTs, StandaloneDeriving, DataKinds, KindSignatures, DeriveGeneric ghc-options: -Wall -Wcompat -Worphans -Wincomplete-uni-patterns -Wincomplete-record-updates -Wimplicit-prelude -Wmissing-home-modules -Widentities -Wredundant-constraints -Wmissing-export-lists -Wpartial-fields ghc-options: -Wall-missed-specialisations ghc-options: -fno-ignore-asserts -fexpose-all-unfoldings -fspecialise-aggressively -fsimpl-tick-factor=200 if flag(with_expensive_assertions) cpp-options: -DWITH_EXPENSIVE_ASSERTIONS if flag(release) cpp-options: -DEXPOSE_INTERNAL ghcjs-options: -DUSE_JSFILE if !flag(supportNodeJS) ghcjs-options: -DREMOVE_TELETYPE common exe-options ghc-options: -threaded -rtsopts -- (Ignored by GHCJS) Minimize median lag at the cost of occasional bigger -- GC lag, which fortunately sometimes fits into idle time between turns): -- (Ignored by GHCJS) Avoid frequent GCs. Only idle-GC during a break in -- gameplay (5s), not between slow keystrokes. ghc-options: "-with-rtsopts=-A99m -I5" -- Haskell GC in GHCJS every 10s. ghcjs-options: -DGHCJS_GC_INTERVAL=10000 -- This is the largest GHCJS_BUSY_YIELD value that does not cause dropped frames -- on my machine with default --maxFps. ghcjs-options: -DGHCJS_BUSY_YIELD=50 ghcjs-options: -dedupe if !flag(supportNodeJS) ghcjs-options: -DGHCJS_BROWSER library import: options hs-source-dirs: definition-src, engine-src, GameDefinition/game-src, GameDefinition exposed-modules: Game.LambdaHack.Core.Dice Game.LambdaHack.Core.Frequency Game.LambdaHack.Core.Prelude Game.LambdaHack.Core.Random Game.LambdaHack.Definition.Ability Game.LambdaHack.Definition.Color Game.LambdaHack.Definition.ContentData Game.LambdaHack.Definition.Defs Game.LambdaHack.Definition.Flavour Game.LambdaHack.Content.CaveKind Game.LambdaHack.Content.ItemKind Game.LambdaHack.Content.ModeKind Game.LambdaHack.Content.PlaceKind Game.LambdaHack.Content.RuleKind Game.LambdaHack.Content.TileKind Game.LambdaHack.Atomic Game.LambdaHack.Atomic.CmdAtomic Game.LambdaHack.Atomic.HandleAtomicWrite Game.LambdaHack.Atomic.MonadStateWrite Game.LambdaHack.Atomic.PosAtomicRead Game.LambdaHack.Client Game.LambdaHack.Client.AI Game.LambdaHack.Client.AI.ConditionM Game.LambdaHack.Client.AI.PickActionM Game.LambdaHack.Client.AI.PickActorM Game.LambdaHack.Client.AI.PickTargetM Game.LambdaHack.Client.AI.Strategy Game.LambdaHack.Client.Bfs Game.LambdaHack.Client.BfsM Game.LambdaHack.Client.ClientOptions Game.LambdaHack.Client.CommonM Game.LambdaHack.Client.HandleAtomicM Game.LambdaHack.Client.HandleResponseM Game.LambdaHack.Client.LoopM Game.LambdaHack.Client.MonadClient Game.LambdaHack.Client.Preferences Game.LambdaHack.Client.Request Game.LambdaHack.Client.Response Game.LambdaHack.Client.State Game.LambdaHack.Client.UI Game.LambdaHack.Client.UI.ActorUI Game.LambdaHack.Client.UI.Animation Game.LambdaHack.Client.UI.Content.Input Game.LambdaHack.Client.UI.Content.Screen Game.LambdaHack.Client.UI.ContentClientUI Game.LambdaHack.Client.UI.DrawM Game.LambdaHack.Client.UI.DisplayAtomicM Game.LambdaHack.Client.UI.EffectDescription Game.LambdaHack.Client.UI.Frame Game.LambdaHack.Client.UI.FrameM Game.LambdaHack.Client.UI.Frontend Game.LambdaHack.Client.UI.Frontend.Chosen Game.LambdaHack.Client.UI.Frontend.Common Game.LambdaHack.Client.UI.Frontend.Teletype Game.LambdaHack.Client.UI.HandleHelperM Game.LambdaHack.Client.UI.HandleHumanGlobalM Game.LambdaHack.Client.UI.HandleHumanLocalM Game.LambdaHack.Client.UI.HandleHumanM Game.LambdaHack.Client.UI.HumanCmd Game.LambdaHack.Client.UI.InventoryM Game.LambdaHack.Client.UI.ItemDescription Game.LambdaHack.Client.UI.ItemSlot Game.LambdaHack.Client.UI.Key Game.LambdaHack.Client.UI.KeyBindings Game.LambdaHack.Client.UI.MonadClientUI Game.LambdaHack.Client.UI.Msg Game.LambdaHack.Client.UI.MsgM Game.LambdaHack.Client.UI.Overlay Game.LambdaHack.Client.UI.RunM Game.LambdaHack.Client.UI.SessionUI Game.LambdaHack.Client.UI.Slideshow Game.LambdaHack.Client.UI.SlideshowM Game.LambdaHack.Client.UI.UIOptions Game.LambdaHack.Client.UI.UIOptionsParse Game.LambdaHack.Common.Analytics Game.LambdaHack.Common.Area Game.LambdaHack.Common.Actor Game.LambdaHack.Common.ActorState Game.LambdaHack.Common.Faction Game.LambdaHack.Common.File Game.LambdaHack.Common.HighScore Game.LambdaHack.Common.Item Game.LambdaHack.Common.ItemAspect Game.LambdaHack.Common.Kind Game.LambdaHack.Common.Level Game.LambdaHack.Common.Misc Game.LambdaHack.Common.MonadStateRead Game.LambdaHack.Common.Perception Game.LambdaHack.Common.PointArray Game.LambdaHack.Common.Point Game.LambdaHack.Common.ReqFailure Game.LambdaHack.Common.RingBuffer Game.LambdaHack.Common.Save Game.LambdaHack.Common.State Game.LambdaHack.Common.Thread Game.LambdaHack.Common.Tile Game.LambdaHack.Common.Time Game.LambdaHack.Common.Types Game.LambdaHack.Common.Vector Game.LambdaHack.Server Game.LambdaHack.Server.BroadcastAtomic Game.LambdaHack.Server.Commandline Game.LambdaHack.Server.CommonM Game.LambdaHack.Server.DebugM Game.LambdaHack.Server.DungeonGen Game.LambdaHack.Server.DungeonGen.AreaRnd Game.LambdaHack.Server.DungeonGen.Cave Game.LambdaHack.Server.DungeonGen.Place Game.LambdaHack.Server.EndM Game.LambdaHack.Server.Fov Game.LambdaHack.Server.FovDigital Game.LambdaHack.Server.HandleAtomicM Game.LambdaHack.Server.HandleEffectM Game.LambdaHack.Server.HandleRequestM Game.LambdaHack.Server.ItemRev Game.LambdaHack.Server.ItemM Game.LambdaHack.Server.LoopM Game.LambdaHack.Server.MonadServer Game.LambdaHack.Server.PeriodicM Game.LambdaHack.Server.ProtocolM Game.LambdaHack.Server.ServerOptions Game.LambdaHack.Server.StartM Game.LambdaHack.Server.State exposed-modules: Content.CaveKind Content.ItemKind Content.ItemKindEmbed Content.ItemKindActor Content.ItemKindOrgan Content.ItemKindBlast Content.ItemKindTemporary Content.ModeKind Content.ModeKindPlayer Content.PlaceKind Content.RuleKind Content.TileKind TieKnot Client.UI.Content.Input Client.UI.Content.Screen Implementation.MonadClientImplementation Implementation.MonadServerImplementation other-modules: Paths_LambdaHack autogen-modules: Paths_LambdaHack build-depends: assert-failure >= 0.1.2 && < 0.2, async >= 2, base >= 4.10 && < 99, base-compat >= 0.8.0, binary >= 0.8, bytestring >= 0.9.2 , containers >= 0.5.3.0, deepseq >= 1.3, directory >= 1.1.0.1, enummapset >= 0.5.2.2, filepath >= 1.2.0.1, ghc-prim, hashable >= 1.1.2.5, hsini >= 0.2, keys >= 3, miniutter >= 0.5.0.0, optparse-applicative >= 0.13, pretty-show >= 1.6, primitive >= 0.6.1.0, random >= 1.1, stm >= 2.4, time >= 1.4, text >= 0.11.2.3, transformers >= 0.4, unordered-containers >= 0.2.3, vector >= 0.11, vector-binary-instances >= 0.2.3.1, template-haskell >= 2.6, ghc-compact if impl(ghcjs) || flag(jsaddle) { exposed-modules: Game.LambdaHack.Client.UI.Frontend.Dom build-depends: ghcjs-dom >= 0.9.1.1 cpp-options: -DUSE_BROWSER } else { if flag(vty) { exposed-modules: Game.LambdaHack.Client.UI.Frontend.Vty build-depends: vty >= 5 cpp-options: -DUSE_VTY } else { if flag(curses) { exposed-modules: Game.LambdaHack.Client.UI.Frontend.Curses build-depends: hscurses >= 1.4.1 cpp-options: -DUSE_CURSES } else { if flag(gtk) { exposed-modules: Game.LambdaHack.Client.UI.Frontend.Gtk build-depends: gtk3 >= 0.12.1 cpp-options: -DUSE_GTK } else { exposed-modules: Game.LambdaHack.Client.UI.Frontend.Sdl build-depends: sdl2 >= 2, sdl2-ttf >= 2 cpp-options: -DUSE_SDL } } } } if impl(ghcjs) { other-modules: Game.LambdaHack.Common.JSFile } else { other-modules: Game.LambdaHack.Common.HSFile build-depends: zlib >= 0.5.3.1 } executable LambdaHack import: options, exe-options main-is: GameDefinition/Main.hs build-depends: ,LambdaHack ,async ,base ,filepath ,optparse-applicative test-suite test import: options, exe-options type: exitcode-stdio-1.0 main-is: test/test.hs build-depends: ,LambdaHack ,async ,base ,filepath ,optparse-applicative LambdaHack-0.9.5.0/Makefile0000755000000000000000000006355107346545000013500 0ustar0000000000000000play: dist/build/LambdaHack/LambdaHack --dbgMsgSer --logPriority 4 --savePrefix play --dumpInitRngs shot: dist/build/LambdaHack/LambdaHack --dbgMsgSer --logPriority 4 --savePrefix play --dumpInitRngs --printEachScreen expose-lore: dist/build/LambdaHack/LambdaHack --dbgMsgSer --logPriority 4 --savePrefix know --newGame 5 --dumpInitRngs --gameMode crawl --knowItems --exposePlaces --exposeItems --exposeActors --showItemSamples --benchmark --noAnim --maxFps 1000 dig-lore: dist/build/LambdaHack/LambdaHack --dbgMsgSer --logPriority 4 --savePrefix know --newGame 5 --dumpInitRngs --gameMode dig --knowItems --exposePlaces --exposeItems --exposeActors --showItemSamples --benchmark --noAnim --maxFps 1000 see-caves: dist/build/LambdaHack/LambdaHack --dbgMsgSer --logPriority 4 --savePrefix know --newGame 5 --dumpInitRngs --gameMode see --knowItems --exposePlaces --exposeItems --exposeActors --showItemSamples --benchmark --noAnim --maxFps 1000 configure-debug: cabal configure --enable-profiling --profiling-detail=all-functions -fwith_expensive_assertions --disable-optimization configure-prof: cabal configure --enable-profiling --profiling-detail=exported-functions ghcjs-new-build: cabal new-build -j1 --ghcjs --disable-library-profiling --disable-profiling . chrome-log: google-chrome --enable-logging --v=1 file:///home/mikolaj/r/lambdahack.github.io/index.html & chrome-prof: google-chrome --no-sandbox --js-flags="--logfile=%t.log --prof" ../lambdahack.github.io/index.html minific: npx google-closure-compiler dist-newstyle/build/x86_64-linux/ghcjs-8.6.0.1/LambdaHack-0.9.5.0/x/LambdaHack/build/LambdaHack/LambdaHack.jsexe/all.js --compilation_level=ADVANCED_OPTIMIZATIONS --isolation_mode=IIFE --assume_function_wrapper --externs=dist-newstyle/build/x86_64-linux/ghcjs-8.6.0.1/LambdaHack-0.9.5.0/x/LambdaHack/build/LambdaHack/LambdaHack.jsexe/all.js.externs --jscomp_off="*" > ../lambdahack.github.io/lambdahack.all.js minificForNode: npx google-closure-compiler dist-newstyle/build/x86_64-linux/ghcjs-8.6.0.1/LambdaHack-0.9.5.0/x/LambdaHack/build/LambdaHack/LambdaHack.jsexe/all.js --compilation_level=ADVANCED_OPTIMIZATIONS --isolation_mode=IIFE --assume_function_wrapper --externs=dist-newstyle/build/x86_64-linux/ghcjs-8.6.0.1/LambdaHack-0.9.5.0/x/LambdaHack/build/LambdaHack/LambdaHack.jsexe/all.js.externs --externs=/home/mikolaj/r/closure-compiler/contrib/nodejs/assert.js --externs=/home/mikolaj/r/closure-compiler/contrib/nodejs/child_process.js --externs=/home/mikolaj/r/closure-compiler/contrib/nodejs/crypto.js --externs=/home/mikolaj/r/closure-compiler/contrib/nodejs/dns.js --externs=/home/mikolaj/r/closure-compiler/contrib/nodejs/events.js --externs=/home/mikolaj/r/closure-compiler/contrib/nodejs/globals.js --externs=/home/mikolaj/r/closure-compiler/contrib/nodejs/https.js --externs=/home/mikolaj/r/closure-compiler/contrib/nodejs/os.js --externs=/home/mikolaj/r/closure-compiler/contrib/nodejs/punycode.js --externs=/home/mikolaj/r/closure-compiler/contrib/nodejs/readline.js --externs=/home/mikolaj/r/closure-compiler/contrib/nodejs/stream.js --externs=/home/mikolaj/r/closure-compiler/contrib/nodejs/tls.js --externs=/home/mikolaj/r/closure-compiler/contrib/nodejs/url.js --externs=/home/mikolaj/r/closure-compiler/contrib/nodejs/vm.js --externs=/home/mikolaj/r/closure-compiler/contrib/nodejs/buffer.js --externs=/home/mikolaj/r/closure-compiler/contrib/nodejs/cluster.js --externs=/home/mikolaj/r/closure-compiler/contrib/nodejs/dgram.js --externs=/home/mikolaj/r/closure-compiler/contrib/nodejs/domain.js --externs=/home/mikolaj/r/closure-compiler/contrib/nodejs/fs.js --externs=/home/mikolaj/r/closure-compiler/contrib/nodejs/http.js --externs=/home/mikolaj/r/closure-compiler/contrib/nodejs/net.js --externs=/home/mikolaj/r/closure-compiler/contrib/nodejs/path.js --externs=/home/mikolaj/r/closure-compiler/contrib/nodejs/querystring.js --externs=/home/mikolaj/r/closure-compiler/contrib/nodejs/repl.js --externs=/home/mikolaj/r/closure-compiler/contrib/nodejs/string_decoder.js --externs=/home/mikolaj/r/closure-compiler/contrib/nodejs/tty.js --externs=/home/mikolaj/r/closure-compiler/contrib/nodejs/util.js --externs=/home/mikolaj/r/closure-compiler/contrib/nodejs/zlib.js --jscomp_off="*" > ../lambdahack.github.io/lambdahack.all.js # Low delay to display animations swiftly and not bore the public too much. # Delay can't be lower than 2, because browsers sometimes treat delay 1 # specially and add their extra delay. create-gif : find ~/.LambdaHack/screenshots/ -name 'prtscn*.bmp' -print0 | xargs -0 -r mogrify -format gif gifsicle -O3 --careful -d2 -l ~/.LambdaHack/screenshots/prtscn*.gif -o ~/.LambdaHack/screenshots/screenshot.gif frontendRaid: dist/build/LambdaHack/LambdaHack --dbgMsgSer --logPriority 4 --savePrefix test --newGame 5 --dumpInitRngs --automateAll --gameMode raid --exposeActors frontendBrawl: dist/build/LambdaHack/LambdaHack --dbgMsgSer --logPriority 4 --savePrefix test --newGame 5 --dumpInitRngs --automateAll --gameMode brawl frontendShootout: dist/build/LambdaHack/LambdaHack --dbgMsgSer --logPriority 4 --savePrefix test --newGame 5 --dumpInitRngs --automateAll --gameMode shootout frontendHunt: dist/build/LambdaHack/LambdaHack --dbgMsgSer --logPriority 4 --savePrefix test --newGame 5 --dumpInitRngs --automateAll --gameMode hunt frontendEscape: dist/build/LambdaHack/LambdaHack --dbgMsgSer --logPriority 4 --savePrefix test --newGame 3 --dumpInitRngs --automateAll --gameMode escape frontendZoo: dist/build/LambdaHack/LambdaHack --dbgMsgSer --logPriority 4 --savePrefix test --newGame 2 --dumpInitRngs --automateAll --gameMode zoo --exposeActors frontendAmbush: dist/build/LambdaHack/LambdaHack --dbgMsgSer --logPriority 4 --savePrefix test --newGame 5 --dumpInitRngs --automateAll --gameMode ambush frontendCrawl: dist/build/LambdaHack/LambdaHack --dbgMsgSer --logPriority 4 --savePrefix test --newGame 1 --dumpInitRngs --automateAll --gameMode crawl --exposeItems --exposeActors frontendCrawlEmpty: dist/build/LambdaHack/LambdaHack --dbgMsgSer --logPriority 4 --savePrefix test --newGame 1 --dumpInitRngs --automateAll --gameMode "crawl empty" frontendSafari: dist/build/LambdaHack/LambdaHack --dbgMsgSer --logPriority 4 --savePrefix test --newGame 2 --dumpInitRngs --automateAll --gameMode safari --exposeActors frontendSafariSurvival: dist/build/LambdaHack/LambdaHack --dbgMsgSer --logPriority 4 --savePrefix test --newGame 5 --dumpInitRngs --automateAll --gameMode "safari survival" --exposeActors frontendBattle: dist/build/LambdaHack/LambdaHack --dbgMsgSer --logPriority 4 --savePrefix test --newGame 4 --dumpInitRngs --automateAll --gameMode battle --exposeActors frontendBattleDefense: dist/build/LambdaHack/LambdaHack --dbgMsgSer --logPriority 4 --savePrefix test --newGame 6 --dumpInitRngs --automateAll --gameMode "battle defense" --exposeActors frontendBattleSurvival: dist/build/LambdaHack/LambdaHack --dbgMsgSer --logPriority 4 --savePrefix test --newGame 6 --dumpInitRngs --automateAll --gameMode "battle survival" --exposeActors frontendDefense: dist/build/LambdaHack/LambdaHack --dbgMsgSer --logPriority 4 --savePrefix test --newGame 9 --dumpInitRngs --automateAll --gameMode defense --exposeItems --exposeActors frontendDefenseEmpty: dist/build/LambdaHack/LambdaHack --dbgMsgSer --logPriority 4 --savePrefix test --newGame 9 --dumpInitRngs --automateAll --gameMode "defense empty" fastCrawl: dist/build/LambdaHack/LambdaHack --dbgMsgSer --logPriority 4 --savePrefix test --newGame 1 --dumpInitRngs --automateAll --gameMode crawl --exposeItems --exposeActors --showItemSamples --noAnim --maxFps 100000 benchMemoryAnim: dist/build/LambdaHack/LambdaHack --dbgMsgSer --logPriority 4 --newGame 1 --maxFps 100000 --benchmark --stopAfterFrames 33000 --automateAll --keepAutomated --gameMode crawl --setDungeonRng 120 --setMainRng 47 --frontendNull --noAnim +RTS -s -A1M -RTS benchBattle: dist/build/LambdaHack/LambdaHack --dbgMsgSer --logPriority 4 --newGame 3 --noAnim --maxFps 100000 --frontendNull --benchmark --stopAfterFrames 1500 --automateAll --keepAutomated --gameMode battle --setDungeonRng 7 --setMainRng 7 benchAnimBattle: dist/build/LambdaHack/LambdaHack --dbgMsgSer --logPriority 4 --newGame 3 --maxFps 100000 --frontendNull --benchmark --stopAfterFrames 7000 --automateAll --keepAutomated --gameMode battle --setDungeonRng 7 --setMainRng 7 benchFrontendBattle: dist/build/LambdaHack/LambdaHack --dbgMsgSer --logPriority 4 --newGame 3 --noAnim --maxFps 100000 --benchmark --stopAfterFrames 2000 --automateAll --keepAutomated --gameMode battle --setDungeonRng 7 --setMainRng 7 benchCrawl: dist/build/LambdaHack/LambdaHack --dbgMsgSer --logPriority 4 --newGame 1 --noAnim --maxFps 100000 --frontendNull --benchmark --stopAfterFrames 7000 --automateAll --keepAutomated --gameMode crawl --setDungeonRng 0 --setMainRng 0 benchFrontendCrawl: dist/build/LambdaHack/LambdaHack --dbgMsgSer --logPriority 4 --newGame 1 --noAnim --maxFps 100000 --benchmark --stopAfterFrames 7000 --automateAll --keepAutomated --gameMode crawl --setDungeonRng 0 --setMainRng 0 benchDig: dist/build/LambdaHack/LambdaHack --dbgMsgSer --logPriority 4 --newGame 1 --noAnim --maxFps 100000 --frontendNull --benchmark --stopAfterFrames 1 --automateAll --keepAutomated --gameMode dig --setDungeonRng 0 --setMainRng 0 benchNull: benchBattle benchAnimBattle benchCrawl bench: benchBattle benchAnimBattle benchFrontendBattle benchCrawl benchFrontendCrawl nativeBenchCrawl: dist/build/LambdaHack/LambdaHack --dbgMsgSer --logPriority 4 --newGame 1 --noAnim --maxFps 100000 --frontendNull --benchmark --stopAfterFrames 2000 --automateAll --keepAutomated --gameMode crawl --setDungeonRng 0 --setMainRng 0 nativeBenchBattle: dist/build/LambdaHack/LambdaHack --dbgMsgSer --logPriority 4 --newGame 3 --noAnim --maxFps 100000 --frontendNull --benchmark --stopAfterFrames 1000 --automateAll --keepAutomated --gameMode battle --setDungeonRng 0 --setMainRng 0 nativeBench: nativeBenchBattle nativeBenchCrawl nodeBenchCrawl: node dist/build/LambdaHack/LambdaHack.jsexe/all.js --dbgMsgSer --logPriority 4 --newGame 1 --noAnim --maxFps 100000 --frontendNull --benchmark --stopAfterFrames 2000 --automateAll --keepAutomated --gameMode crawl --setDungeonRng 0 --setMainRng 0 nodeBenchBattle: node dist/build/LambdaHack/LambdaHack.jsexe/all.js --dbgMsgSer --logPriority 4 --newGame 3 --noAnim --maxFps 100000 --frontendNull --benchmark --stopAfterFrames 1000 --automateAll --keepAutomated --gameMode battle --setDungeonRng 0 --setMainRng 0 nodeBench: nodeBenchBattle nodeBenchCrawl test-travis: test-sniff test-short test-medium benchNull test: test-sniff test-short test-medium benchNull test-short: test-short-new test-short-load test-medium: testRaid-medium testBrawl-medium testShootout-medium testHunt-medium testEscape-medium testZoo-medium testAmbush-medium testCrawl-medium testCrawlEmpty-medium testCrawl-medium-know testSafari-medium testSafariSurvival-medium testBattle-medium testBattleDefense-medium testBattleSurvival-medium testDig-medium testDefenseEmpty-medium test-sniff: dist/build/LambdaHack/LambdaHack --dbgMsgSer --logPriority 4 --newGame 5 --noAnim --maxFps 100000 --frontendTeletype --benchmark --stopAfterFrames 1 --dumpInitRngs --automateAll --keepAutomated --gameMode raid --sniff 2> /tmp/teletypetest.log testRaid-medium: dist/build/LambdaHack/LambdaHack --dbgMsgSer --logPriority 4 --boostRandomItem --newGame 5 --maxFps 100000 --frontendTeletype --benchmark --stopAfterSeconds 20 --dumpInitRngs --automateAll --keepAutomated --gameMode raid 2> /tmp/teletypetest.log testBrawl-medium: dist/build/LambdaHack/LambdaHack --dbgMsgSer --logPriority 4 --boostRandomItem --newGame 5 --maxFps 100000 --frontendTeletype --benchmark --stopAfterSeconds 20 --dumpInitRngs --automateAll --keepAutomated --gameMode brawl 2> /tmp/teletypetest.log testShootout-medium: dist/build/LambdaHack/LambdaHack --dbgMsgSer --logPriority 4 --boostRandomItem --newGame 5 --maxFps 100000 --frontendTeletype --benchmark --stopAfterSeconds 20 --dumpInitRngs --automateAll --keepAutomated --gameMode shootout 2> /tmp/teletypetest.log testHunt-medium: dist/build/LambdaHack/LambdaHack --dbgMsgSer --logPriority 4 --boostRandomItem --newGame 5 --maxFps 100000 --frontendTeletype --benchmark --stopAfterSeconds 20 --dumpInitRngs --automateAll --keepAutomated --gameMode hunt 2> /tmp/teletypetest.log testEscape-medium: dist/build/LambdaHack/LambdaHack --dbgMsgSer --logPriority 4 --boostRandomItem --newGame 3 --maxFps 100000 --frontendTeletype --benchmark --stopAfterSeconds 40 --dumpInitRngs --automateAll --keepAutomated --gameMode escape 2> /tmp/teletypetest.log testZoo-medium: dist/build/LambdaHack/LambdaHack --dbgMsgSer --logPriority 4 --boostRandomItem --newGame 2 --maxFps 100000 --frontendTeletype --benchmark --stopAfterSeconds 40 --dumpInitRngs --automateAll --keepAutomated --gameMode zoo 2> /tmp/teletypetest.log testAmbush-medium: dist/build/LambdaHack/LambdaHack --dbgMsgSer --logPriority 4 --boostRandomItem --newGame 5 --noAnim --maxFps 100000 --frontendTeletype --benchmark --stopAfterSeconds 20 --dumpInitRngs --automateAll --keepAutomated --gameMode ambush 2> /tmp/teletypetest.log testCrawl-medium: dist/build/LambdaHack/LambdaHack --dbgMsgSer --logPriority 4 --newGame 1 --noAnim --maxFps 100000 --frontendTeletype --benchmark --stopAfterSeconds 200 --dumpInitRngs --automateAll --keepAutomated --gameMode crawl 2> /tmp/teletypetest.log testCrawlEmpty-medium: dist/build/LambdaHack/LambdaHack --dbgMsgSer --logPriority 4 --newGame 1 --noAnim --maxFps 100000 --frontendTeletype --benchmark --stopAfterSeconds 40 --dumpInitRngs --automateAll --keepAutomated --gameMode "crawl empty" 2> /tmp/teletypetest.log testCrawl-medium-know: dist/build/LambdaHack/LambdaHack --dbgMsgSer --logPriority 4 --boostRandomItem --savePrefix know --newGame 1 --noAnim --maxFps 100000 --frontendTeletype --benchmark --stopAfterSeconds 100 --dumpInitRngs --automateAll --keepAutomated --gameMode crawl --knowItems --exposePlaces --exposeItems --exposeActors --showItemSamples 2> /tmp/teletypetest.log testSafari-medium: dist/build/LambdaHack/LambdaHack --dbgMsgSer --logPriority 4 --boostRandomItem --newGame 2 --noAnim --maxFps 100000 --frontendTeletype --benchmark --stopAfterSeconds 100 --dumpInitRngs --automateAll --keepAutomated --gameMode safari 2> /tmp/teletypetest.log testSafariSurvival-medium: dist/build/LambdaHack/LambdaHack --dbgMsgSer --logPriority 4 --boostRandomItem --newGame 8 --noAnim --maxFps 100000 --frontendTeletype --benchmark --stopAfterSeconds 40 --dumpInitRngs --automateAll --keepAutomated --gameMode "safari survival" 2> /tmp/teletypetest.log testBattle-medium: dist/build/LambdaHack/LambdaHack --dbgMsgSer --logPriority 4 --boostRandomItem --newGame 3 --noAnim --maxFps 100000 --frontendTeletype --benchmark --stopAfterSeconds 20 --dumpInitRngs --automateAll --keepAutomated --gameMode battle 2> /tmp/teletypetest.log testBattleDefense-medium: dist/build/LambdaHack/LambdaHack --dbgMsgSer --logPriority 4 --boostRandomItem --newGame 7 --noAnim --maxFps 100000 --frontendTeletype --benchmark --stopAfterSeconds 40 --dumpInitRngs --automateAll --keepAutomated --gameMode "battle defense" 2> /tmp/teletypetest.log testBattleSurvival-medium: dist/build/LambdaHack/LambdaHack --dbgMsgSer --logPriority 4 --boostRandomItem --newGame 7 --noAnim --maxFps 100000 --frontendTeletype --benchmark --stopAfterSeconds 40 --dumpInitRngs --automateAll --keepAutomated --gameMode "battle survival" 2> /tmp/teletypetest.log testDefense-medium: dist/build/LambdaHack/LambdaHack --dbgMsgSer --logPriority 4 --newGame 9 --noAnim --maxFps 100000 --frontendLazy --benchmark --stopAfterSeconds 200 --dumpInitRngs --automateAll --keepAutomated --gameMode defense 2> /tmp/teletypetest.log testDig-medium: dist/build/LambdaHack/LambdaHack --dbgMsgSer --logPriority 4 --newGame 1 --noAnim --maxFps 100000 --frontendTeletype --benchmark --stopAfterFrames 100 --dumpInitRngs --automateAll --keepAutomated --gameMode dig 2> /tmp/teletypetest.log testDefenseEmpty-medium: dist/build/LambdaHack/LambdaHack --dbgMsgSer --logPriority 4 --boostRandomItem --newGame 9 --noAnim --maxFps 100000 --frontendTeletype --benchmark --stopAfterSeconds 40 --dumpInitRngs --automateAll --keepAutomated --gameMode "defense empty" 2> /tmp/teletypetest.log testCrawl-appveyor: dist/build/LambdaHack/LambdaHack --dbgMsgSer --logPriority 4 --newGame 1 --noAnim --maxFps 100000 --frontendNull --benchmark --stopAfterSeconds 800 --dumpInitRngs --automateAll --keepAutomated --gameMode crawl testDefense-appveyor: dist/build/LambdaHack/LambdaHack --dbgMsgSer --logPriority 4 --newGame 9 --noAnim --maxFps 100000 --frontendLazy --benchmark --stopAfterSeconds 800 --dumpInitRngs --automateAll --keepAutomated --gameMode defense test-short-new: dist/build/LambdaHack/LambdaHack --dbgMsgSer --logPriority 4 --boostRandomItem --newGame 5 --savePrefix raid --dumpInitRngs --automateAll --keepAutomated --gameMode raid --frontendTeletype --stopAfterSeconds 2 2> /tmp/teletypetest.log dist/build/LambdaHack/LambdaHack --dbgMsgSer --logPriority 4 --boostRandomItem --newGame 5 --savePrefix brawl --dumpInitRngs --automateAll --keepAutomated --gameMode brawl --showItemSamples --frontendTeletype --stopAfterSeconds 2 2> /tmp/teletypetest.log dist/build/LambdaHack/LambdaHack --dbgMsgSer --logPriority 4 --boostRandomItem --newGame 5 --savePrefix shootout --dumpInitRngs --automateAll --keepAutomated --gameMode shootout --showItemSamples --frontendTeletype --stopAfterSeconds 2 2> /tmp/teletypetest.log dist/build/LambdaHack/LambdaHack --dbgMsgSer --logPriority 4 --boostRandomItem --newGame 5 --savePrefix hunt --dumpInitRngs --automateAll --keepAutomated --gameMode hunt --showItemSamples --frontendTeletype --stopAfterSeconds 2 2> /tmp/teletypetest.log dist/build/LambdaHack/LambdaHack --dbgMsgSer --logPriority 4 --boostRandomItem --newGame 5 --savePrefix escape --dumpInitRngs --automateAll --keepAutomated --gameMode escape --showItemSamples --frontendTeletype --stopAfterSeconds 2 2> /tmp/teletypetest.log dist/build/LambdaHack/LambdaHack --dbgMsgSer --logPriority 4 --boostRandomItem --newGame 5 --savePrefix zoo --dumpInitRngs --automateAll --keepAutomated --gameMode zoo --frontendTeletype --stopAfterSeconds 2 2> /tmp/teletypetest.log dist/build/LambdaHack/LambdaHack --dbgMsgSer --logPriority 4 --boostRandomItem --newGame 5 --savePrefix ambush --dumpInitRngs --automateAll --keepAutomated --gameMode ambush --frontendTeletype --stopAfterSeconds 2 2> /tmp/teletypetest.log dist/build/LambdaHack/LambdaHack --dbgMsgSer --logPriority 4 --boostRandomItem --newGame 5 --savePrefix crawl --dumpInitRngs --automateAll --keepAutomated --gameMode crawl --frontendTeletype --stopAfterSeconds 2 2> /tmp/teletypetest.log dist/build/LambdaHack/LambdaHack --dbgMsgSer --logPriority 4 --boostRandomItem --newGame 5 --savePrefix safari --dumpInitRngs --automateAll --keepAutomated --gameMode safari --frontendTeletype --stopAfterSeconds 2 2> /tmp/teletypetest.log dist/build/LambdaHack/LambdaHack --dbgMsgSer --logPriority 4 --boostRandomItem --newGame 5 --savePrefix safariSurvival --dumpInitRngs --automateAll --keepAutomated --gameMode "safari survival" --showItemSamples --frontendTeletype --stopAfterSeconds 2 2> /tmp/teletypetest.log dist/build/LambdaHack/LambdaHack --dbgMsgSer --logPriority 4 --boostRandomItem --newGame 5 --savePrefix battle --showItemSamples --dumpInitRngs --automateAll --keepAutomated --gameMode battle --frontendTeletype --stopAfterSeconds 2 2> /tmp/teletypetest.log dist/build/LambdaHack/LambdaHack --dbgMsgSer --logPriority 4 --boostRandomItem --newGame 5 --savePrefix battleDefense --dumpInitRngs --automateAll --keepAutomated --gameMode "battle defense" --frontendTeletype --stopAfterSeconds 2 2> /tmp/teletypetest.log dist/build/LambdaHack/LambdaHack --dbgMsgSer --logPriority 4 --boostRandomItem --newGame 5 --savePrefix battleSurvival --dumpInitRngs --automateAll --keepAutomated --gameMode "battle survival" --frontendTeletype --stopAfterSeconds 2 2> /tmp/teletypetest.log # "--setDungeonRng 0 --setMainRng 0" is needed for determinism relative to seed # generated before game save test-short-load: dist/build/LambdaHack/LambdaHack --dbgMsgSer --logPriority 4 --boostRandomItem --savePrefix raid --dumpInitRngs --automateAll --keepAutomated --gameMode raid --frontendTeletype --stopAfterSeconds 2 --setDungeonRng 0 --setMainRng 0 2> /tmp/teletypetest.log dist/build/LambdaHack/LambdaHack --dbgMsgSer --logPriority 4 --boostRandomItem --savePrefix brawl --dumpInitRngs --automateAll --keepAutomated --gameMode brawl --frontendTeletype --stopAfterSeconds 2 --setDungeonRng 0 --setMainRng 0 2> /tmp/teletypetest.log dist/build/LambdaHack/LambdaHack --dbgMsgSer --logPriority 4 --boostRandomItem --savePrefix shootout --dumpInitRngs --automateAll --keepAutomated --gameMode shootout --frontendTeletype --stopAfterSeconds 2 --setDungeonRng 0 --setMainRng 0 2> /tmp/teletypetest.log dist/build/LambdaHack/LambdaHack --dbgMsgSer --logPriority 4 --boostRandomItem --savePrefix hunt --dumpInitRngs --automateAll --keepAutomated --gameMode hunt --frontendTeletype --stopAfterSeconds 2 --setDungeonRng 0 --setMainRng 0 2> /tmp/teletypetest.log dist/build/LambdaHack/LambdaHack --dbgMsgSer --logPriority 4 --boostRandomItem --savePrefix escape --dumpInitRngs --automateAll --keepAutomated --gameMode escape --frontendTeletype --stopAfterSeconds 2 --setDungeonRng 0 --setMainRng 0 2> /tmp/teletypetest.log dist/build/LambdaHack/LambdaHack --dbgMsgSer --logPriority 4 --boostRandomItem --savePrefix zoo --dumpInitRngs --automateAll --keepAutomated --gameMode zoo --frontendTeletype --stopAfterSeconds 2 --setDungeonRng 0 --setMainRng 0 2> /tmp/teletypetest.log dist/build/LambdaHack/LambdaHack --dbgMsgSer --logPriority 4 --boostRandomItem --savePrefix ambush --dumpInitRngs --automateAll --keepAutomated --gameMode ambush --frontendTeletype --stopAfterSeconds 2 --setDungeonRng 0 --setMainRng 0 2> /tmp/teletypetest.log dist/build/LambdaHack/LambdaHack --dbgMsgSer --logPriority 4 --boostRandomItem --savePrefix crawl --dumpInitRngs --automateAll --keepAutomated --gameMode crawl --frontendTeletype --stopAfterSeconds 2 --setDungeonRng 0 --setMainRng 0 2> /tmp/teletypetest.log dist/build/LambdaHack/LambdaHack --dbgMsgSer --logPriority 4 --boostRandomItem --savePrefix safari --dumpInitRngs --automateAll --keepAutomated --gameMode safari --frontendTeletype --stopAfterSeconds 2 --setDungeonRng 0 --setMainRng 0 2> /tmp/teletypetest.log dist/build/LambdaHack/LambdaHack --dbgMsgSer --logPriority 4 --boostRandomItem --savePrefix safariSurvival --dumpInitRngs --automateAll --keepAutomated --gameMode "safari survival" --frontendTeletype --stopAfterSeconds 2 --setDungeonRng 0 --setMainRng 0 2> /tmp/teletypetest.log dist/build/LambdaHack/LambdaHack --dbgMsgSer --logPriority 4 --boostRandomItem --savePrefix battle --dumpInitRngs --automateAll --keepAutomated --gameMode battle --frontendTeletype --stopAfterSeconds 2 --setDungeonRng 0 --setMainRng 0 2> /tmp/teletypetest.log dist/build/LambdaHack/LambdaHack --dbgMsgSer --logPriority 4 --boostRandomItem --savePrefix battleDefense --dumpInitRngs --automateAll --keepAutomated --gameMode "battle defense" --frontendTeletype --stopAfterSeconds 2 --setDungeonRng 0 --setMainRng 0 2> /tmp/teletypetest.log dist/build/LambdaHack/LambdaHack --dbgMsgSer --logPriority 4 --boostRandomItem --savePrefix battleSurvival --dumpInitRngs --automateAll --keepAutomated --gameMode "battle survival" --frontendTeletype --stopAfterSeconds 2 --setDungeonRng 0 --setMainRng 0 2> /tmp/teletypetest.log build-binary-common: mkdir -p LambdaHackTheGame/GameDefinition/fonts cabal v1-install --force-reinstalls --disable-library-profiling --disable-profiling --disable-documentation --enable-optimization --only-dependencies cabal v1-configure --disable-library-profiling --disable-profiling --enable-optimization --prefix=/ --datadir=. --datasubdir=. cabal v1-build exe:LambdaHack cabal v1-copy --destdir=LambdaHackTheGameInstall ([ -f "LambdaHackTheGameInstall/bin/LambdaHack" ] && mv LambdaHackTheGameInstall/bin/LambdaHack LambdaHackTheGame) || exit 0 ([ -f "LambdaHackTheGameInstall/msys64/bin/LambdaHack.exe" ] && mv LambdaHackTheGameInstall/msys64/bin/LambdaHack.exe LambdaHackTheGame) || exit 0 ([ -f "LambdaHackTheGameInstall/msys32/bin/LambdaHack.exe" ] && mv LambdaHackTheGameInstall/msys32/bin/LambdaHack.exe LambdaHackTheGame) || exit 0 # cabal new-build --disable-library-profiling --disable-profiling --disable-documentation --only-dependencies . # cabal new-install --disable-library-profiling --disable-profiling --disable-documentation --datadir=. --datasubdir=. --install-method=copy --installdir=LambdaHackTheGame --enable-executable-stripping exe:LambdaHack cp GameDefinition/config.ui.default LambdaHackTheGame/GameDefinition cp GameDefinition/fonts/16x16xw.woff LambdaHackTheGame/GameDefinition/fonts cp GameDefinition/fonts/16x16xw.bdf LambdaHackTheGame/GameDefinition/fonts cp GameDefinition/fonts/16x16x.fnt LambdaHackTheGame/GameDefinition/fonts cp GameDefinition/fonts/8x8xb.fnt LambdaHackTheGame/GameDefinition/fonts cp GameDefinition/fonts/8x8x.fnt LambdaHackTheGame/GameDefinition/fonts cp GameDefinition/fonts/LICENSE.16x16x LambdaHackTheGame/GameDefinition/fonts cp GameDefinition/fonts/Fix15Mono-Bold.woff LambdaHackTheGame/GameDefinition/fonts cp GameDefinition/fonts/LICENSE.Fix15Mono-Bold LambdaHackTheGame/GameDefinition/fonts cp GameDefinition/InGameHelp.txt LambdaHackTheGame/GameDefinition cp GameDefinition/PLAYING.md LambdaHackTheGame/GameDefinition cp README.md LambdaHackTheGame cp CHANGELOG.md LambdaHackTheGame cp LICENSE LambdaHackTheGame cp COPYLEFT LambdaHackTheGame cp CREDITS LambdaHackTheGame build-binary-ubuntu: build-binary-common LambdaHackTheGame/LambdaHack --version > /dev/null; \ LH_VERSION=$$(cat ~/.LambdaHack/stdout.txt); \ tar -czf LambdaHack_$${LH_VERSION}_ubuntu-16.04-amd64.tar.gz LambdaHackTheGame build-binary-macosx: build-binary-common LambdaHackTheGame/LambdaHack --version > /dev/null; \ LH_VERSION=$$(cat ~/.LambdaHack/stdout.txt); \ OS_VERSION=$$(sw_vers -productVersion); \ tar -czf LambdaHack_$${LH_VERSION}_macosx-$${OS_VERSION}-amd64.tar.gz LambdaHackTheGame new-build-dev: cabal new-build --datadir=. --disable-optimization -j1 LambdaHack-0.9.5.0/README.md0000644000000000000000000003237607346545000013315 0ustar0000000000000000LambdaHack ========== [![Build Status](https://travis-ci.org/LambdaHack/LambdaHack.svg?branch=master)](https://travis-ci.org/LambdaHack/LambdaHack) [![Hackage](https://img.shields.io/hackage/v/LambdaHack.svg)](https://hackage.haskell.org/package/LambdaHack) [![Join the chat at https://gitter.im/LambdaHack/LambdaHack](https://badges.gitter.im/LambdaHack/LambdaHack.svg)](https://gitter.im/LambdaHack/LambdaHack?utm_source=badge&utm_medium=badge&utm_campaign=pr-badge&utm_content=badge) LambdaHack is a Haskell[1] game engine library for ASCII roguelike[2] games of arbitrary theme, size and complexity, with optional tactical squad combat. It's packaged together with a sample dungeon crawler in wierd fantasy setting that can be tried out in the browser at http://lambdahack.github.io. (It runs fastest on Chrome. Keyboard commands and savefiles are supported only on recent enough versions of browsers. Mouse should work everywhere.) As an example of the engine's capabilities, here is a showcase of shooting down explosive projectiles. A couple were shot down close enough to enemies to harm them. Others exploded closer to our party members and took out of the air the projectiles that would otherwise harm them. ![gameplay screenshot](https://raw.githubusercontent.com/LambdaHack/media/master/screenshot/allureofthestars.com.shooting.down.explosives.gif) This was a semi-automatic stealthy speedrun of the escape scenario of the sample game that comes with the engine. Small bitmap font. The enemy gang has a huge numerical and equipment superiority. Our team loots the area on auto-pilot until the first foe is spotted. Then they scout out enemy positions. Then hero 1 draws enemies and unfortunately enemy fire as well, which is when he valiantly shoots down explosives to avoid the worst damage. Then heroine 2 sneaks behind enemy lines to reach the remaining treasure. That accomplished, the captain signals retreat and leaves for the next area (the zoo). Using the engine ---------------- To use the engine, you need to specify the content to be procedurally generated. You specify what the game world is made of (entities, their relations, physics and lore) and the engine builds the world and runs it. The library lets you compile a ready-to-play game binary, using either the supplied or a custom-made main loop. Several frontends are available (SDL2 is the default for desktop and there is a JavaScript browser frontend) and many other generic engine components are easily overridden, but the fundamental source of flexibility lies in the strict and type-safe separation of code from the content and of clients (human and AI-controlled) from the server. Please see the changelog file for recent improvements and the issue tracker for short-term plans. Long term goals include multiplayer tactical squad combat, in-game content creation, auto-balancing and persistent content modification based on player behaviour. Contributions are welcome. Please offer feedback to mikolaj.konarski@funktory.com or, preferably, at any of the public forums. Other games known to use the LambdaHack library: * Allure of the Stars[6], a near-future Sci-Fi game * Space Privateers[8], an adventure game set in far future Note: the engine and the example game are bundled together in a single Hackage[3] package released under the permissive `BSD3` license. You are welcome to create your own games by forking and modifying the single package, but please consider eventually splitting your changes into a separate content-only package that depends on the upstream engine library. This will help us exchange ideas and share improvements to the common codebase. Alternatively, you can already start the development in separation by cloning and rewriting Allure of the Stars[10] and mix and merge with the example LambdaHack game rules at will. Note that the LambdaHack sample game derives from the Hack/Nethack visual and narrative tradition[9], while Allure of the Stars uses the more free-form Moria/Angband style (it also uses the `AGPL` license, and `BSD3 + AGPL = AGPL`, so make sure you want to liberate your code and content to such an extent). When creating a new game based on LambdaHack I've found it useful to place completely new content at the end of the content files to distinguish from merely modified original LambdaHack content and thus help merging with new releases. Removals of LambdaHack content merge reasonably well, so there are no special considerations. When modifying individual content items, it makes sense to keep their Haskell identifier names and change only in-game names and possibly frequency group names. Installation of the sample game from binary archives ---------------------------------------------------- The game runs rather slowly in the browser (fastest on Chrome) and you are limited to only one font, though it's scalable. Also, savefiles are prone to corruption on the browser, e.g., when it's closed while the game is still saving progress (which takes a long time). Hence, after trying out the game, you may prefer to use a native binary for your architecture, if it exists. Pre-compiled game binaries are available through the release page[11] (and, for Windows, dev versions continuously from AppVeyor[18]). To use a pre-compiled binary archive, unpack it and run the executable in the unpacked directory or use program shortcuts from the installer, if available. On Linux, make sure you have the SDL2 libraries installed on your system (e.g., libsdl2-2.0-0 and libsdl2-ttf-2.0-0 on Ubuntu). For Windows (XP no longer supported), the SDL2 and all other needed libraries are already contained in the game's binary archive. Screen and keyboard configuration --------------------------------- The game UI can be configured via a config file. The default settings, the same that are built into the binary, are in [GameDefinition/config.ui.default](https://github.com/LambdaHack/LambdaHack/blob/master/GameDefinition/config.ui.default). When the game is run for the first time, the file is copied to the default user data folder, which is `~/.LambdaHack/` on Linux, `C:\Users\\AppData\Roaming\LambdaHack\` (or `C:\Documents And Settings\user\Application Data\LambdaHack\` or something else altogether) on Windows, and in RMB menu, under `Inspect/Application/Local Storage` when run inside the Chrome browser. Screen font and consequently window size can be changed by editing the config file in the user data folder. The default bitmap font `16x16xw.bdf` covers most national characters in the Latin alphabet (e.g. to give custom names to player characters) and results in a game window of exactly 720p (standard HD) dimensions. The `8x8xb.fnt` bitmap font results in a tiny window and covers latin-1 characters only. The scalable `16x16xw.woff` font results in window sizes dependent on the `scalableFontSize` parameter in the config file. With `scalableFontSize = 16` it should look almost the same as the pixel-perfect `16x16xw.bdf`. If you don't have a numeric keypad, you can use the Vi editor keys (aka roguelike keys) or mouse for movement or you can enable the compact laptop keys (uk8o79jl) in the config file. If numeric keypad doesn't work, toggling the Num Lock key sometimes helps. If running with the Shift key and keypad keys doesn't work, try Control key instead. The game is fully playable with mouse only, as well as with keyboard only, but the most efficient combination for some players is mouse for go-to, inspecting, and aiming at distant positions and keyboard for everything else. If you are using a terminal frontend, e.g. the best supported vty frontend, numeric keypad (e.g., keypad '*' and '/') may not work correctly depending on versions of the libraries, terminfo and terminal emulators. Toggling the Num Lock key may help or make issues worse. As a workaround for the vty frontend, numbers are used for movement, which sadly prevents the number keys from selecting heroes. The commands that require pressing Control and Shift together won't work either, but fortunately they are not crucial to gameplay. Some effort has been put to help using the vty frontend with screen readers, but without feedback it's hard to say how accesible that setup is. As a side effect of screen reader support, there is no aiming line nor path in vty frontend. Screen readers may also work better with animations turned off using `--noAnim` or the corresponding config file option. Note that unicode and cursor support are now necessary for correct output. Compilation of the library and sample game from source ------------------------------------------------------ If you want to compile native binaries from the source code, use Cabal (already a part of your OS distribution, or available within The Haskell Platform[7]), which also takes care of all the dependencies. The recommended frontend is based on SDL2, so you need the SDL2 libraries for your OS. On Linux, remember to install the -dev versions as well, e.g., libsdl2-dev and libsdl2-ttf-dev on Ubuntu Linux 16.04. (Compilation to JavaScript for the browser is more complicated and requires the ghcjs[15] compiler and optionally the Google Closure Compiler[16] as well.) The latest official version of the LambdaHack library can be downloaded, compiled for SDL2 and installed automatically by Cabal from Hackage[3] as follows cabal update cabal install LambdaHack For a newer snapshot, clone the source code from github[5] and run Cabal from the main directory cabal install There is a built-in black and white line terminal frontend, suitable for teletype terminals or a keyboard and a printer (but it's going to use a lot of paper, unless you disable animations with `--noAnim`). To compile with one of the less rudimentary terminal frontends (in which case you are on your own regarding font choice and color setup and you won't have the spiffy colorful squares outlining special positions that exist in SDL2 frontend, but only crude cursor highlights), use Cabal flags, e.g, cabal install -fvty Testing and debugging --------------------- The [Makefile](https://github.com/LambdaHack/LambdaHack/blob/master/Makefile) contains many sample test commands. Numerous tests that use the screensaver game modes (AI vs. AI) and the teletype frontend are gathered in `make test`. Of these, travis runs `test-travis` on each push to github. Test commands with prefix `frontend` start AI vs. AI games with the standard, user-friendly frontend. Run `LambdaHack --help` to see a brief description of all debug options. Of these, the `--sniff` option is very useful (though verbose and initially cryptic), for displaying the traffic between clients and the server. Some options in the config file may prove useful too, though they mostly overlap with commandline options (and will be totally merged at some point). You can use HPC with the game as follows (details vary according to HPC version). cabal clean cabal install --enable-coverage make test hpc report --hpcdir=dist/hpc/dyn/mix/LambdaHack --hpcdir=dist/hpc/dyn/mix/LambdaHack-xxx/ LambdaHack hpc markup --hpcdir=dist/hpc/dyn/mix/LambdaHack --hpcdir=dist/hpc/dyn/mix/LambdaHack-xxx/ LambdaHack A quick manual playing session after the automated tests would be in order, as well, since the tests don't touch the topmost UI layer. Note that a debug option of the form `--stopAfter*` is required to cleanly terminate any automated test. This is needed to gather any HPC info, because HPC requires a clean exit to save data files. Coding style ------------ Stylish Haskell is used for slight auto-formatting at buffer save; see [.stylish-haskell.yaml](https://github.com/LambdaHack/LambdaHack/blob/master/.stylish-haskell.yaml). As defined in the file, indentation is 2 spaces wide and screen is 80-columns wide. Spaces are used, not tabs. Spurious whitespace avoided. Spaces around arithmetic operators encouraged. Generally, relax and try to stick to the style apparent in a file you are editing. Put big formatting changes in separate commits. Haddocks are provided for all module headers and for all functions and types from major modules, in particular the modules that are interfaces for a whole directory of modules. Apart of that, only very important functions and types are distinguished by having a haddock. If minor ones have comments, they should not be haddocks and they are permitted to describe implementation details and be out of date. Prefer assertions to comments, unless too verbose. Further information ------------------- For more information, visit the wiki[4] and see [PLAYING.md](https://github.com/LambdaHack/LambdaHack/blob/master/GameDefinition/PLAYING.md), [CREDITS](https://github.com/LambdaHack/LambdaHack/blob/master/CREDITS) and [COPYLEFT](https://github.com/LambdaHack/LambdaHack/blob/master/COPYLEFT). Have fun! [1]: https://www.haskell.org/ [2]: http://roguebasin.roguelikedevelopment.org/index.php?title=Berlin_Interpretation [3]: https://hackage.haskell.org/package/LambdaHack [4]: https://github.com/LambdaHack/LambdaHack/wiki [5]: https://github.com/LambdaHack/LambdaHack [6]: http://allureofthestars.com [7]: https://www.haskell.org/platform [8]: https://github.com/tuturto/space-privateers [9]: https://github.com/LambdaHack/LambdaHack/wiki/Sample-dungeon-crawler [10]: https://github.com/AllureOfTheStars/Allure [11]: https://github.com/LambdaHack/LambdaHack/releases [15]: https://github.com/ghcjs/ghcjs [16]: https://www.npmjs.com/package/google-closure-compiler LambdaHack-0.9.5.0/Setup.hs0000644000000000000000000000005707346545000013461 0ustar0000000000000000import Distribution.Simple main = defaultMain LambdaHack-0.9.5.0/definition-src/Game/LambdaHack/Content/0000755000000000000000000000000007346545000021172 5ustar0000000000000000LambdaHack-0.9.5.0/definition-src/Game/LambdaHack/Content/CaveKind.hs0000644000000000000000000002005107346545000023210 0ustar0000000000000000-- | The type of cave kinds. module Game.LambdaHack.Content.CaveKind ( CaveKind(..), makeData #ifdef EXPOSE_INTERNAL -- * Internal operations , validateSingle, validateAll #endif ) where import Prelude () import Game.LambdaHack.Core.Prelude import qualified Data.Text as T import Game.LambdaHack.Content.ItemKind (ItemKind) import Game.LambdaHack.Content.PlaceKind (PlaceKind) import Game.LambdaHack.Content.TileKind (TileKind) import qualified Game.LambdaHack.Core.Dice as Dice import Game.LambdaHack.Core.Random import Game.LambdaHack.Definition.ContentData import Game.LambdaHack.Definition.Defs -- | Parameters for the generation of dungeon levels. -- Warning: for efficiency, avoid embedded items in any of the common tiles. data CaveKind = CaveKind { csymbol :: Char -- ^ a symbol , cname :: Text -- ^ short description , cfreq :: Freqs CaveKind -- ^ frequency within groups , cXminSize :: X -- ^ minimal X size of the whole cave , cYminSize :: Y -- ^ minimal Y size of the whole cave , ccellSize :: Dice.DiceXY -- ^ size of a map cell holding a place , cminPlaceSize :: Dice.DiceXY -- ^ minimal size of places; for merging , cmaxPlaceSize :: Dice.DiceXY -- ^ maximal size of places; for growing , cdarkOdds :: Dice.Dice -- ^ the odds a place is dark -- (level-scaled dice roll > 50) , cnightOdds :: Dice.Dice -- ^ the odds the cave is dark -- (level-scaled dice roll > 50) , cauxConnects :: Rational -- ^ a proportion of extra connections , cmaxVoid :: Rational -- ^ at most this proportion of rooms may be void , cminStairDist :: Int -- ^ minimal distance between stairs , cextraStairs :: Dice.Dice -- ^ extra stairs on top of from above , cdoorChance :: Chance -- ^ the chance of a door in an opening , copenChance :: Chance -- ^ if there's a door, is it open? , chidden :: Int -- ^ if not open, hidden one in n times , cactorCoeff :: Int -- ^ the lower, the more monsters spawn , cactorFreq :: Freqs ItemKind -- ^ actor groups to consider , citemNum :: Dice.Dice -- ^ number of initial items in the cave , citemFreq :: Freqs ItemKind -- ^ item groups to consider , cplaceFreq :: Freqs PlaceKind -- ^ place groups to consider , cpassable :: Bool -- ^ are passable default tiles permitted , labyrinth :: Bool -- ^ waste of time for AI to explore , cdefTile :: GroupName TileKind -- ^ the default cave tile , cdarkCorTile :: GroupName TileKind -- ^ the dark cave corridor tile , clitCorTile :: GroupName TileKind -- ^ the lit cave corridor tile , cwallTile :: GroupName TileKind -- ^ the tile used for @FWall@ fence , ccornerTile :: GroupName TileKind -- ^ tile used for the fence corners , cfenceTileN :: GroupName TileKind -- ^ the outer fence N wall , cfenceTileE :: GroupName TileKind -- ^ the outer fence E wall , cfenceTileS :: GroupName TileKind -- ^ the outer fence S wall , cfenceTileW :: GroupName TileKind -- ^ the outer fence W wall , cfenceApart :: Bool -- ^ are places touching fence banned , clegendDarkTile :: GroupName TileKind -- ^ the dark place plan legend , clegendLitTile :: GroupName TileKind -- ^ the lit place plan legend , cescapeFreq :: Freqs PlaceKind -- ^ escape groups, if any , cstairFreq :: Freqs PlaceKind -- ^ place groups for created stairs , cstairAllowed :: Freqs PlaceKind -- ^ extra groups for inherited , cdesc :: Text -- ^ full cave description } deriving Show -- No Eq and Ord to make extending logically sound -- | Catch caves with not enough space for all the places. Check the size -- of the cave descriptions to make sure they fit on screen. Etc. validateSingle :: CaveKind -> [Text] validateSingle CaveKind{..} = let (minCellSizeX, minCellSizeY) = Dice.infDiceXY ccellSize (minMinSizeX, minMinSizeY) = Dice.infDiceXY cminPlaceSize (maxMinSizeX, maxMinSizeY) = Dice.supDiceXY cminPlaceSize (minMaxSizeX, minMaxSizeY) = Dice.infDiceXY cmaxPlaceSize in [ "cname longer than 25" | T.length cname > 25 ] ++ [ "cXminSize < 20" | cXminSize < 20 ] ++ [ "cYminSize < 20" | cYminSize < 20 ] ++ [ "minCellSizeX < 1" | minCellSizeX < 1 ] ++ [ "minCellSizeY < 1" | minCellSizeY < 1 ] ++ [ "minCellSizeX < 6 && stairs" | minCellSizeX < 6 && not (null cstairFreq && null cescapeFreq) ] ++ [ "minCellSizeY < 4 && stairs" | minCellSizeY < 4 && not (null cstairFreq && null cescapeFreq) ] ++ [ "minMinSizeX < 5 && stairs" | minMinSizeX < 5 && not (null cstairFreq && null cescapeFreq) ] ++ [ "minMinSizeY < 3 && stairs" | minMinSizeY < 3 && not (null cstairFreq && null cescapeFreq) ] ++ [ "minMinSizeX < 1" | minMinSizeX < 1 ] ++ [ "minMinSizeY < 1" | minMinSizeY < 1 ] ++ [ "minMaxSizeX < maxMinSizeX" | minMaxSizeX < maxMinSizeX ] ++ [ "minMaxSizeY < maxMinSizeY" | minMaxSizeY < maxMinSizeY ] ++ [ "cextraStairs < 0" | Dice.infDice cextraStairs < 0 ] ++ [ "chidden < 0" | chidden < 0 ] ++ [ "cactorCoeff < 0" | cactorCoeff < 0 ] ++ [ "citemNum < 0" | Dice.infDice citemNum < 0 ] ++ [ "stairs suggested, but not defined" | Dice.supDice cextraStairs > 0 && null cstairFreq ] -- | Validate all cave kinds. -- Note that names don't have to be unique: we can have several variants -- of a cave with a given name. validateAll :: ContentData ItemKind -> ContentData PlaceKind -> ContentData TileKind -> [CaveKind] -> ContentData CaveKind -> [Text] validateAll coitem coplace cotile content cocave = let missingActorFreq = filter (not . omemberGroup coitem) $ concatMap (map fst . cactorFreq) content missingItemFreq = filter (not . omemberGroup coitem) $ concatMap (map fst . citemFreq) content missingPlaceFreq = filter (not . omemberGroup coplace) $ concatMap (map fst . cplaceFreq) content missingEscapeGroup = filter (not . omemberGroup coplace . fst) $ concatMap cescapeFreq content missingStairFreq = filter (not . omemberGroup coplace) $ concatMap (map fst . cstairFreq) content tileGroupFuns = [ cdefTile, cdarkCorTile, clitCorTile, cwallTile , cfenceTileN, cfenceTileE, cfenceTileS, cfenceTileW , clegendDarkTile, clegendLitTile ] g kind = map ($ kind) tileGroupFuns missingTileFreq = filter (not . omemberGroup cotile) $ concatMap g content in [ "cactorFreq item groups not in content:" <+> tshow missingActorFreq | not $ null missingActorFreq ] ++ [ "citemFreq item groups not in content:" <+> tshow missingItemFreq | not $ null missingItemFreq ] ++ [ "cplaceFreq place groups not in content:" <+> tshow missingPlaceFreq | not $ null missingPlaceFreq ] ++ [ "cescapeFreq place groups not in content:" <+> tshow missingEscapeGroup | not $ null missingEscapeGroup ] ++ [ "cstairFreq place groups not in content:" <+> tshow missingStairFreq | not $ null missingStairFreq ] ++ [ "tile groups not in content:" <+> tshow missingTileFreq | not $ null missingTileFreq ] ++ [ "no cave defined for \"default random\"" | not $ omemberGroup cocave "default random" ] makeData :: ContentData ItemKind -> ContentData PlaceKind -> ContentData TileKind -> [CaveKind] -> ContentData CaveKind makeData coitem coplace cotile = makeContentData "CaveKind" cname cfreq validateSingle (validateAll coitem coplace cotile) LambdaHack-0.9.5.0/definition-src/Game/LambdaHack/Content/ItemKind.hs0000644000000000000000000004376507346545000023251 0ustar0000000000000000{-# LANGUAGE DeriveGeneric #-} -- | The type of kinds of weapons, treasure, organs, blasts, etc. module Game.LambdaHack.Content.ItemKind ( ItemKind(..), makeData , Aspect(..), Effect(..), DetectKind(..), TimerDice, ThrowMod(..) , boostItemKindList, forApplyEffect , strengthOnSmash, getDropOrgans, getMandatoryHideAsFromKind, isEffEscape , isEffEscapeOrAscend, timeoutAspect, onSmashEffect, damageUsefulness , verbMsgNoLonger, verbMsgLess, toVelocity, toLinger , timerNone, isTimerNone, foldTimer, toOrganBad, toOrganGood, toOrganNoTimer #ifdef EXPOSE_INTERNAL -- * Internal operations , boostItemKind, validateSingle, validateAll, validateDups, validateDamage , hardwiredItemGroups #endif ) where import Prelude () import Game.LambdaHack.Core.Prelude import Data.Binary import Data.Hashable (Hashable) import qualified Data.Text as T import GHC.Generics (Generic) import qualified System.Random as R import qualified Game.LambdaHack.Core.Dice as Dice import qualified Game.LambdaHack.Definition.Ability as Ability import Game.LambdaHack.Definition.ContentData import Game.LambdaHack.Definition.Defs import Game.LambdaHack.Definition.Flavour -- | Item properties that are fixed for a given kind of items. -- Of these, aspects and effects are jointly called item powers. -- Note that this type is mutually recursive with 'Effect' and `Aspect`. data ItemKind = ItemKind { isymbol :: Char -- ^ map symbol , iname :: Text -- ^ generic name; is pluralized if needed , ifreq :: Freqs ItemKind -- ^ frequency within groups , iflavour :: [Flavour] -- ^ possible flavours , icount :: Dice.Dice -- ^ created in that quantity , irarity :: Rarity -- ^ rarity on given depths , iverbHit :: Text -- ^ the verb for hitting , iweight :: Int -- ^ weight in grams , idamage :: Dice.Dice -- ^ basic kinetic damage , iaspects :: [Aspect] -- ^ affect the actor continuously , ieffects :: [Effect] -- ^ cause the effects when triggered , ikit :: [(GroupName ItemKind, CStore)] -- ^ accompanying organs and equipment , idesc :: Text -- ^ description } deriving (Show, Generic) -- No Eq and Ord to make extending logically sound -- | Aspects of items. Aspect @AddSkill@ is additive (starting at 0) -- for all items wielded by an actor and it affects the actor. -- The others affect only the item in question, not the actor carrying it, -- and so are not additive in any sense. data Aspect = Timeout Dice.Dice -- ^ specifies the cooldown before an item may be -- applied again; if a copy of an item is applied -- manually (not via periodic activation), -- all effects on a single copy of the item are -- disabled until the copy recharges for the given -- time expressed in game turns; all copies -- recharge concurrently | AddSkill Ability.Skill Dice.Dice -- ^ bonus to a skill; in content, avoid boosting -- skills such as SkApply via permanent equipment, -- to avoid micromanagement through swapping items -- among party members before each skill use | SetFlag Ability.Flag -- ^ item feature | ELabel Text -- ^ extra label of the item; it's not pluralized | ToThrow ThrowMod -- ^ parameters modifying a throw | HideAs (GroupName ItemKind) -- ^ until identified, presents as this unique kind | EqpSlot Ability.EqpSlot -- ^ AI and UI flag that leaks item intended use | Odds Dice.Dice [Aspect] [Aspect] -- ^ if level-scaled dice roll > 50, -- pick the former aspects, otherwise the latter deriving (Show, Eq, Generic) -- | Effects of items. Can be invoked by the item wielder to affect -- another actor or the wielder himself. Many occurences in the same item -- are possible. data Effect = Burn Dice.Dice -- ^ burn with this damage | Explode (GroupName ItemKind) -- ^ explode producing this group of blasts | RefillHP Int -- ^ modify HP of the actor by this amount | RefillCalm Int -- ^ modify Calm of the actor by this amount | Dominate -- ^ change actor's allegiance | Impress -- ^ make actor susceptible to domination | PutToSleep -- ^ put actor to sleep, also calming him | Yell -- ^ make the actor yell/yawn, waking him and others up | Summon (GroupName ItemKind) Dice.Dice -- ^ summon the given number of actors of this group | Ascend Bool -- ^ ascend to another level of the dungeon | Escape -- ^ escape from the dungeon | Paralyze Dice.Dice -- ^ paralyze for this many game clips | ParalyzeInWater Dice.Dice -- ^ paralyze for this many game clips due to water | InsertMove Dice.Dice -- ^ give actor this many extra tenths of actor move | Teleport Dice.Dice -- ^ teleport actor across rougly this distance | CreateItem CStore (GroupName ItemKind) TimerDice -- ^ create an item of the group and insert into the store with the given -- random timer | DropItem Int Int CStore (GroupName ItemKind) -- ^ make the actor drop items of the given group from the given store; -- the first integer says how many item kinds to drop, the second, -- how many copies of each kind to drop; for non-organs, beware of -- not dropping all, or cluttering store with rubbish becomes beneficial | PolyItem -- ^ get a suitable (i.e., numerous enough) non-unique common item stack -- on the floor and polymorph it to a stack of random common items, -- with current depth coefficient | RerollItem -- ^ get a suitable (i.e., with any random aspects) single item -- (even unique) on the floor and change the random bonuses -- of the items randomly, with maximal depth coefficient | DupItem -- ^ exactly duplicate a single non-unique, non-valuable item on the floor | Identify -- ^ find a suitable (i.e., not identified) item, starting from -- the floor, and identify it | Detect DetectKind Int -- ^ detect something on the map in the given radius | SendFlying ThrowMod -- ^ send an actor flying (push or pull, depending) | PushActor ThrowMod -- ^ push an actor | PullActor ThrowMod -- ^ pull an actor | DropBestWeapon -- ^ make the actor drop its best weapon | ActivateInv Char -- ^ activate all items with this symbol in inventory; space character -- means all symbols | ApplyPerfume -- ^ remove all smell on the level | OneOf [Effect] -- ^ trigger one of the effects with equal probability | OnSmash Effect -- ^ trigger the effect when item smashed (not when applied nor meleed); | Composite [Effect] -- ^ only fire next effect if previous fully activated | VerbNoLonger Text -- ^ a sentence with the actor causing the effect as subject and the given -- text as verb is emitted when the activation causes item to expire; -- no spam is emitted if a projectile | VerbMsg Text -- ^ a sentence with the actor causing the effect as subject and the given -- text as verb is emitted whenever the item is activated; -- no spam is emitted if a projectile deriving (Show, Eq, Generic) data DetectKind = DetectAll | DetectActor | DetectLoot | DetectExit | DetectHidden | DetectEmbed deriving (Show, Eq, Generic) -- | Specification of how to randomly roll a timer at item creation -- to obtain a fixed timer for the item's lifetime. data TimerDice = TimerNone | TimerGameTurn Dice.Dice | TimerActorTurn Dice.Dice deriving (Eq, Generic) instance Show TimerDice where show TimerNone = "0" show (TimerGameTurn nDm) = show nDm ++ " " ++ if nDm == 1 then "turn" else "turns" show (TimerActorTurn nDm) = show nDm ++ " " ++ if nDm == 1 then "move" else "moves" -- | Parameters modifying a throw of a projectile or flight of pushed actor. -- Not additive and don't start at 0. data ThrowMod = ThrowMod { throwVelocity :: Int -- ^ fly with this percentage of base throw speed , throwLinger :: Int -- ^ fly for this percentage of 2 turns , throwHP :: Int -- ^ start flight with this many HP } deriving (Show, Eq, Ord, Generic) instance Binary Effect instance Binary DetectKind instance Binary TimerDice instance Binary ThrowMod instance Hashable ThrowMod boostItemKindList :: R.StdGen -> [ItemKind] -> [ItemKind] boostItemKindList _ [] = [] boostItemKindList initialGen l = let (r, _) = R.randomR (0, length l - 1) initialGen in case splitAt r l of (pre, i : post) -> pre ++ boostItemKind i : post _ -> error $ "" `showFailure` l boostItemKind :: ItemKind -> ItemKind boostItemKind i = let mainlineLabel (label, _) = label `elem` ["common item", "curious item", "treasure"] in if any mainlineLabel (ifreq i) then i { ifreq = ("common item", 10000) : filter (not . mainlineLabel) (ifreq i) , iaspects = delete (SetFlag Ability.Unique) $ iaspects i } else i -- | Whether the effect has a chance of exhibiting any potentially -- noticeable behaviour, except when the item is destroyed. -- We assume at least one of @OneOf@ effects must be noticeable. forApplyEffect :: Effect -> Bool forApplyEffect eff = case eff of OnSmash{} -> False Composite effs -> any forApplyEffect effs VerbNoLonger{} -> False VerbMsg{} -> False ParalyzeInWater{} -> False -- barely noticeable, spams when resisted _ -> True isEffEscape :: Effect -> Bool isEffEscape Escape{} = True isEffEscape (OneOf l) = any isEffEscape l isEffEscape (Composite l) = any isEffEscape l isEffEscape _ = False isEffEscapeOrAscend :: Effect -> Bool isEffEscapeOrAscend Ascend{} = True isEffEscapeOrAscend Escape{} = True isEffEscapeOrAscend (OneOf l) = any isEffEscapeOrAscend l isEffEscapeOrAscend (Composite l) = any isEffEscapeOrAscend l isEffEscapeOrAscend _ = False timeoutAspect :: Aspect -> Bool timeoutAspect Timeout{} = True timeoutAspect _ = False onSmashEffect :: Effect -> Bool onSmashEffect OnSmash{} = True onSmashEffect _ = False strengthOnSmash :: ItemKind -> [Effect] strengthOnSmash = let f (OnSmash eff) = [eff] f _ = [] in concatMap f . ieffects getDropOrgans :: ItemKind -> [GroupName ItemKind] getDropOrgans = let f (DropItem _ _ COrgan grp) = [grp] f Impress = ["impressed"] f (OneOf l) = concatMap f l -- even remote possibility accepted f (Composite l) = concatMap f l -- not certain, but accepted f _ = [] in concatMap f . ieffects -- Anything under @Odds@ is ignored, because it's not mandatory. getMandatoryHideAsFromKind :: ItemKind -> Maybe (GroupName ItemKind) getMandatoryHideAsFromKind itemKind = let f (HideAs grp) = [grp] f _ = [] in listToMaybe $ concatMap f (iaspects itemKind) damageUsefulness :: ItemKind -> Double damageUsefulness itemKind = let v = min 1000 (10 * Dice.meanDice (idamage itemKind)) in assert (v >= 0) v verbMsgNoLonger :: Text -> Effect verbMsgNoLonger name = VerbNoLonger $ "be no longer" <+> name verbMsgLess :: Text -> Effect verbMsgLess name = VerbMsg $ "look less" <+> name toVelocity :: Int -> Aspect toVelocity n = ToThrow $ ThrowMod n 100 1 toLinger :: Int -> Aspect toLinger n = ToThrow $ ThrowMod 100 n 1 timerNone :: TimerDice timerNone = TimerNone isTimerNone :: TimerDice -> Bool isTimerNone tim = tim == TimerNone foldTimer :: a -> (Dice.Dice -> a) -> (Dice.Dice -> a) -> TimerDice -> a foldTimer a fgame factor tim = case tim of TimerNone -> a TimerGameTurn nDm -> fgame nDm TimerActorTurn nDm -> factor nDm toOrganBad :: GroupName ItemKind -> Dice.Dice -> Effect toOrganBad grp nDm = assert (Dice.infDice nDm > 0 `blame` "dice at organ creation should always roll above zero" `swith` (grp, nDm)) $ CreateItem COrgan grp (TimerGameTurn nDm) toOrganGood :: GroupName ItemKind -> Dice.Dice -> Effect toOrganGood grp nDm = assert (Dice.infDice nDm > 0 `blame` "dice at organ creation should always roll above zero" `swith` (grp, nDm)) $ CreateItem COrgan grp (TimerActorTurn nDm) toOrganNoTimer :: GroupName ItemKind -> Effect toOrganNoTimer grp = CreateItem COrgan grp TimerNone -- | Catch invalid item kind definitions. validateSingle :: ItemKind -> [Text] validateSingle ik@ItemKind{..} = ["iname longer than 23" | T.length iname > 23] ++ ["icount < 0" | Dice.infDice icount < 0] ++ validateRarity irarity ++ validateDamage idamage -- Reject duplicate Timeout, because it's not additive. ++ (let ts = filter timeoutAspect iaspects in ["more than one Timeout specification" | length ts > 1]) ++ [ "Conflicting Fragile and Durable" | SetFlag Ability.Fragile `elem` iaspects && SetFlag Ability.Durable `elem` iaspects ] ++ (let f :: Aspect -> Bool f EqpSlot{} = True f _ = False ts = filter f iaspects in [ "EqpSlot specified but not Equipable nor Meleeable" | length ts > 0 && SetFlag Ability.Equipable `notElem` iaspects && SetFlag Ability.Meleeable `notElem` iaspects ]) ++ [ "Redundant Equipable or Meleeable" | SetFlag Ability.Equipable `elem` iaspects && SetFlag Ability.Meleeable `elem` iaspects ] ++ [ "Conflicting Durable and Blast" | SetFlag Ability.Durable `elem` iaspects && SetFlag Ability.Blast `elem` iaspects ] ++ [ "Conflicting Durable and Condition" | SetFlag Ability.Durable `elem` iaspects && SetFlag Ability.Condition `elem` iaspects ] ++ [ "Conflicting Blast and Condition" | SetFlag Ability.Blast `elem` iaspects && SetFlag Ability.Condition `elem` iaspects ] ++ (let f :: Aspect -> Bool f ELabel{} = True f _ = False ts = filter f iaspects in ["more than one ELabel specification" | length ts > 1]) ++ (let f :: Aspect -> Bool f ToThrow{} = True f _ = False ts = filter f iaspects in ["more than one ToThrow specification" | length ts > 1]) ++ (let f :: Aspect -> Bool f HideAs{} = True f _ = False ts = filter f iaspects in ["more than one HideAs specification" | length ts > 1]) ++ concatMap (validateDups ik) (map SetFlag [minBound .. maxBound]) ++ (let f :: Effect -> Bool f VerbMsg{} = True f _ = False in validateOnlyOne ieffects "VerbMsg" f) -- may be duplicated if nested ++ (let f :: Effect -> Bool f VerbNoLonger{} = True f _ = False in validateOnlyOne ieffects "VerbNoLonger" f) -- may be duped if nested ++ (validateNotNested ieffects "OnSmash" onSmashEffect) -- duplicates permitted -- We only check there are no duplicates at top level. If it may be nested, -- it may presumably be duplicated inside the nesting as well. validateOnlyOne :: [Effect] -> Text -> (Effect -> Bool) -> [Text] validateOnlyOne effs t f = let ts = filter f effs in ["more than one" <+> t <+> "specification" | length ts > 1] -- We check it's not nested one nor more levels. validateNotNested :: [Effect] -> Text -> (Effect -> Bool) -> [Text] validateNotNested effs t f = let g (OneOf l) = any f l || any g l g (OnSmash effect) = f effect || g effect g (Composite l) = any f l || any g l g _ = False ts = filter g effs in [ "effect" <+> t <+> "should be specified at top level, not nested" | length ts > 0 ] validateDups :: ItemKind -> Aspect -> [Text] validateDups ItemKind{..} feat = let ts = filter (== feat) iaspects in ["more than one" <+> tshow feat <+> "specification" | length ts > 1] validateDamage :: Dice.Dice -> [Text] validateDamage dice = [ "potentially negative dice:" <+> tshow dice | Dice.infDice dice < 0] -- | Validate all item kinds. validateAll :: [ItemKind] -> ContentData ItemKind -> [Text] validateAll content coitem = let missingKitGroups = [ cgroup | k <- content , (cgroup, _) <- ikit k , not $ omemberGroup coitem cgroup ] f :: Aspect -> Bool f HideAs{} = True f _ = False wrongHideAsGroups = [ cgroup | k <- content , let (cgroup, notSingleton) = case find f (iaspects k) of Just (HideAs grp) | not $ oisSingletonGroup coitem grp -> (grp, True) _ -> (undefined, False) , notSingleton ] g :: Effect -> Maybe (GroupName ItemKind) g (Explode grp) = Just grp g (Summon grp _) = Just grp g (CreateItem _ grp _) = Just grp g (DropItem _ _ _ grp) = Just grp g _ = Nothing missingEffectGroups = [ (iname k, absGroups) | k <- content , let grps = mapMaybe g $ ieffects k absGroups = filter (not . omemberGroup coitem) grps , not $ null absGroups ] missingHardwiredGroups = filter (not . omemberGroup coitem) hardwiredItemGroups in [ "no ikit groups in content:" <+> tshow missingKitGroups | not $ null missingKitGroups ] ++ [ "HideAs groups not singletons:" <+> tshow wrongHideAsGroups | not $ null wrongHideAsGroups ] ++ [ "mentioned groups not in content:" <+> tshow missingEffectGroups | not $ null missingEffectGroups ] ++ [ "hardwired groups not in content:" <+> tshow missingHardwiredGroups | not $ null missingHardwiredGroups ] hardwiredItemGroups :: [GroupName ItemKind] hardwiredItemGroups = -- From Preferences.hs: ["condition", "common item"] -- the others are optional: -- "curious item", "treasure", "any scroll", "any vial", -- "potion", "explosive", "any jewelry" -- Assorted: ++ ["bonus HP", "braced", "asleep", "impressed", "currency", "mobile"] makeData :: [ItemKind] -> ContentData ItemKind makeData = makeContentData "ItemKind" iname ifreq validateSingle validateAll LambdaHack-0.9.5.0/definition-src/Game/LambdaHack/Content/ModeKind.hs0000644000000000000000000002256107346545000023226 0ustar0000000000000000{-# LANGUAGE DeriveGeneric #-} -- | The type of kinds of game modes. module Game.LambdaHack.Content.ModeKind ( ModeKind(..), makeData , Caves, Roster(..), Outcome(..) , HiCondPoly, HiSummand, HiPolynomial, HiIndeterminant(..) , Player(..), LeaderMode(..), AutoLeader(..) , horrorGroup, genericEndMessages #ifdef EXPOSE_INTERNAL -- * Internal operations , validateSingle, validateAll , validateSingleRoster, validateSinglePlayer, hardwiredModeGroups #endif ) where import Prelude () import Game.LambdaHack.Core.Prelude import Data.Binary import qualified Data.Text as T import GHC.Generics (Generic) import Game.LambdaHack.Content.CaveKind (CaveKind) import Game.LambdaHack.Content.ItemKind (ItemKind) import qualified Game.LambdaHack.Core.Dice as Dice import qualified Game.LambdaHack.Definition.Ability as Ability import Game.LambdaHack.Definition.ContentData import Game.LambdaHack.Definition.Defs -- | Game mode specification. data ModeKind = ModeKind { msymbol :: Char -- ^ a symbol , mname :: Text -- ^ short description , mfreq :: Freqs ModeKind -- ^ frequency within groups , mroster :: Roster -- ^ players taking part in the game , mcaves :: Caves -- ^ arena of the game , mendMsg :: [(Outcome, Text)] -- ^ messages displayed at particular game ends; -- if no message, the screen is skipped , mdesc :: Text -- ^ description } deriving Show -- | Requested cave groups for particular level intervals. type Caves = [([Int], [GroupName CaveKind])] -- | The specification of players for the game mode. data Roster = Roster { rosterList :: [(Player, [(Int, Dice.Dice, GroupName ItemKind)])] -- ^ players in the particular team and levels, numbers and groups -- of their initial members , rosterEnemy :: [(Text, Text)] -- ^ the initial enmity matrix , rosterAlly :: [(Text, Text)] -- ^ the initial aliance matrix } deriving Show -- | Outcome of a game. data Outcome = Killed -- ^ the faction was eliminated | Defeated -- ^ the faction lost the game in another way | Camping -- ^ game is supended | Conquer -- ^ the player won by eliminating all rivals | Escape -- ^ the player escaped the dungeon alive | Restart -- ^ game is restarted deriving (Show, Eq, Ord, Enum, Bounded, Generic) instance Binary Outcome -- | Conditional polynomial representing score calculation for this player. type HiCondPoly = [HiSummand] type HiSummand = (HiPolynomial, [Outcome]) type HiPolynomial = [(HiIndeterminant, Double)] data HiIndeterminant = HiConst | HiLoot | HiSprint | HiBlitz | HiSurvival | HiKill | HiLoss deriving (Show, Eq, Ord, Generic) instance Binary HiIndeterminant -- | Properties of a particular player. data Player = Player { fname :: Text -- ^ name of the player , fgroups :: [GroupName ItemKind] -- ^ names of actor groups that may naturally -- fall under player's control, e.g., upon -- spawning or summoning , fskillsOther :: Ability.Skills -- ^ fixed skill modifiers to the non-leader -- actors; also summed with skills implied -- by ftactic (which is not fixed) , fcanEscape :: Bool -- ^ the player can escape the dungeon , fneverEmpty :: Bool -- ^ the faction declared killed if no actors , fhiCondPoly :: HiCondPoly -- ^ score polynomial for the player , fhasGender :: Bool -- ^ whether actors have gender , ftactic :: Ability.Tactic -- ^ non-leaders behave according to this -- tactic; can be changed during the game , fleaderMode :: LeaderMode -- ^ the mode of switching the leader , fhasUI :: Bool -- ^ does the faction have a UI client -- (for control or passive observation) } deriving (Show, Eq, Generic) instance Binary Player -- | If a faction with @LeaderUI@ and @LeaderAI@ has any actor, it has a leader. data LeaderMode = LeaderNull -- ^ faction can have no leader, is whole under AI control | LeaderAI AutoLeader -- ^ leader under AI control | LeaderUI AutoLeader -- ^ leader under UI control, assumes @fhasUI@ deriving (Show, Eq, Ord, Generic) instance Binary LeaderMode data AutoLeader = AutoLeader { autoDungeon :: Bool -- ^ leader switching between levels is automatically done by the server -- and client is not permitted to change to leaders from other levels -- (the frequency of leader level switching done by the server -- is controlled by @RuleKind.rleadLevelClips@); -- if the flag is @False@, server still does a subset -- of the automatic switching, e.g., when the old leader dies -- and no other actor of the faction resides on his level, -- but the client (particularly UI) is expected to do changes as well , autoLevel :: Bool -- ^ client is discouraged from leader switching (e.g., because -- non-leader actors have the same skills as leader); -- server is guaranteed to switch leader within a level very rarely, -- e.g., when the old leader dies; -- if the flag is @False@, server still does a subset -- of the automatic switching, but the client is expected to do more, -- because it's advantageous for that kind of a faction } deriving (Show, Eq, Ord, Generic) instance Binary AutoLeader horrorGroup :: GroupName ItemKind horrorGroup = "horror" genericEndMessages :: [(Outcome, Text)] genericEndMessages = [ (Killed, "Let's hope a rescue party arrives in time!" ) , (Defeated, "Let's hope your new overlords let you live." ) , (Camping, "See you soon, stronger and braver!" ) , (Conquer, "Can it be done in a better style, though?" ) , (Escape, "Can it be done more efficiently, though?" ) , (Restart, "This time for real." ) ] -- | Catch invalid game mode kind definitions. validateSingle :: ModeKind -> [Text] validateSingle ModeKind{..} = [ "mname longer than 20" | T.length mname > 20 ] ++ let f cave@(ns, l) = [ "not enough or too many levels for required cave groups:" <+> tshow cave | length ns /= length l ] in concatMap f mcaves ++ validateSingleRoster mcaves mroster -- | Checks, in particular, that there is at least one faction with fneverEmpty -- or the game would get stuck as soon as the dungeon is devoid of actors. validateSingleRoster :: Caves -> Roster -> [Text] validateSingleRoster caves Roster{..} = [ "no player keeps the dungeon alive" | all (not . fneverEmpty . fst) rosterList ] ++ [ "not exactly one UI client" | length (filter (fhasUI . fst) rosterList) /= 1 ] ++ concatMap (validateSinglePlayer . fst) rosterList ++ let checkPl field pl = [ pl <+> "is not a player name in" <+> field | all ((/= pl) . fname . fst) rosterList ] checkDipl field (pl1, pl2) = [ "self-diplomacy in" <+> field | pl1 == pl2 ] ++ checkPl field pl1 ++ checkPl field pl2 in concatMap (checkDipl "rosterEnemy") rosterEnemy ++ concatMap (checkDipl "rosterAlly") rosterAlly ++ let keys = concatMap fst caves f (_, l) = concatMap g l g i3@(ln, _, _) = [ "initial actor levels not among caves:" <+> tshow i3 | ln `notElem` keys ] in concatMap f rosterList validateSinglePlayer :: Player -> [Text] validateSinglePlayer Player{..} = [ "fname empty:" <+> fname | T.null fname ] ++ [ "no UI client, but UI leader:" <+> fname | not fhasUI && case fleaderMode of LeaderUI _ -> True _ -> False ] ++ [ "fskillsOther not negative:" <+> fname | any ((>= 0) . snd) $ Ability.skillsToList fskillsOther ] -- | Validate game mode kinds together. validateAll :: ContentData CaveKind -> ContentData ItemKind -> [ModeKind] -> ContentData ModeKind -> [Text] validateAll cocave coitem content comode = let caveGroups = concatMap snd . mcaves missingCave = filter (not . omemberGroup cocave) $ concatMap caveGroups content f Roster{rosterList} = concatMap (\(p, l) -> delete horrorGroup (fgroups p) ++ map (\(_, _, grp) -> grp) l) rosterList missingRosterItems = filter (not . omemberGroup coitem) $ concatMap (f . mroster) content hardwiredAbsent = filter (not . omemberGroup comode) hardwiredModeGroups in [ "cave groups not in content:" <+> tshow missingCave | not $ null missingCave ] ++ [ "roster item groups not in content:" <+> tshow missingRosterItems | not $ null missingRosterItems ] ++ [ "Hardwired groups not in content:" <+> tshow hardwiredAbsent | not $ null hardwiredAbsent ] hardwiredModeGroups :: [GroupName ModeKind] hardwiredModeGroups = ["campaign scenario", "insert coin"] makeData :: ContentData CaveKind -> ContentData ItemKind -> [ModeKind] -> ContentData ModeKind makeData cocave coitem = makeContentData "ModeKind" mname mfreq validateSingle (validateAll cocave coitem) LambdaHack-0.9.5.0/definition-src/Game/LambdaHack/Content/PlaceKind.hs0000644000000000000000000001004207346545000023355 0ustar0000000000000000{-# LANGUAGE DeriveGeneric #-} -- | The type of kinds of rooms, halls and passages. module Game.LambdaHack.Content.PlaceKind ( PlaceKind(..), makeData , Cover(..), Fence(..) , PlaceEntry(..), deadEndId #ifdef EXPOSE_INTERNAL -- * Internal operations , validateSingle, validateAll #endif ) where import Prelude () import Game.LambdaHack.Core.Prelude import Data.Binary import Data.Char (chr) import qualified Data.Text as T import GHC.Generics (Generic) import Game.LambdaHack.Content.TileKind (TileKind) import Game.LambdaHack.Definition.ContentData import Game.LambdaHack.Definition.Defs -- | Parameters for the generation of small areas within a dungeon level. data PlaceKind = PlaceKind { psymbol :: Char -- ^ a symbol , pname :: Text -- ^ short description, singular or plural , pfreq :: Freqs PlaceKind -- ^ frequency within groups , prarity :: Rarity -- ^ rarity on given depths , pcover :: Cover -- ^ how to fill whole place using the corner , pfence :: Fence -- ^ whether to fence place with solid border , ptopLeft :: [Text] -- ^ plan of the top-left corner of the place , poverrideDark :: [(Char, GroupName TileKind)] -- ^ dark legend override , poverrideLit :: [(Char, GroupName TileKind)] -- ^ lit legend override } deriving Show -- No Eq and Ord to make extending logically sound -- | A method of filling the whole area (except for CVerbatim and CMirror, -- which are just placed in the middle of the area) by transforming -- a given corner. data Cover = CAlternate -- ^ reflect every other corner, overlapping 1 row and column | CStretch -- ^ fill symmetrically 4 corners and stretch their borders | CReflect -- ^ tile separately and symmetrically quarters of the place | CVerbatim -- ^ just build the given interior, without filling the area | CMirror -- ^ build the given interior in one of 4 mirrored variants deriving (Show, Eq) -- | The choice of a fence type for the place. data Fence = FWall -- ^ put a solid wall fence around the place | FFloor -- ^ leave an empty space, like the room's floor | FGround -- ^ leave an empty space, like the cave's ground | FNone -- ^ skip the fence and fill all with the place proper deriving (Show, Eq) data PlaceEntry = PEntry (ContentId PlaceKind) | PAround (ContentId PlaceKind) | PEnd (ContentId PlaceKind) deriving (Show, Eq, Generic) instance Binary PlaceEntry deadEndId :: ContentId PlaceKind {-# INLINE deadEndId #-} deadEndId = toContentId 0 validateOverride :: [(Char, GroupName TileKind)] -> [Text] validateOverride ov = let symbols = sort $ map fst ov duplicated = filter (uncurry (==)) $ zip symbols (chr 0 : symbols) in if null duplicated then [] else [ "duplicated override symbols:" <+> T.pack (intersperse ' ' $ map fst duplicated) ] -- | Catch invalid place kind definitions. In particular, verify that -- the top-left corner map is rectangular and not empty. validateSingle :: PlaceKind -> [Text] validateSingle PlaceKind{..} = let dxcorner = case ptopLeft of [] -> 0 l : _ -> T.length l in [ "top-left corner empty" | dxcorner == 0 ] ++ [ "top-left corner not rectangular" | any (/= dxcorner) (map T.length ptopLeft) ] ++ validateRarity prarity ++ validateOverride poverrideDark ++ validateOverride poverrideLit -- | Validate all place kinds. validateAll :: ContentData TileKind -> [PlaceKind] -> ContentData PlaceKind -> [Text] validateAll cotile content _ = let overrides place = poverrideDark place ++ poverrideLit place missingOverride = filter (not . omemberGroup cotile) $ concatMap (map snd . overrides) content in [ "override tile groups not in content:" <+> tshow missingOverride | not $ null missingOverride ] makeData :: ContentData TileKind -> [PlaceKind] -> ContentData PlaceKind makeData cotile = makeContentData "PlaceKind" pname pfreq validateSingle (validateAll cotile) LambdaHack-0.9.5.0/definition-src/Game/LambdaHack/Content/RuleKind.hs0000644000000000000000000000427207346545000023250 0ustar0000000000000000-- | The type of game rules and assorted game data. module Game.LambdaHack.Content.RuleKind ( RuleContent(..), emptyRuleContent, makeData #ifdef EXPOSE_INTERNAL -- * Internal operations , validateSingle #endif ) where import Prelude () import Game.LambdaHack.Core.Prelude import Data.Version import Game.LambdaHack.Definition.Defs -- | The type of game rules and assorted game data. data RuleContent = RuleContent { rtitle :: Text -- ^ title of the game (not lib) , rXmax :: X -- ^ maximum level width; for now, -- keep equal to ScreenContent.rwidth , rYmax :: Y -- ^ maximum level height; for now, -- keep equal to ScreenContent.rheight - 3 , rfontDir :: FilePath -- ^ font directory for the game (not lib) , rexeVersion :: Version -- ^ version of the game , rcfgUIName :: FilePath -- ^ name of the UI config file , rcfgUIDefault :: String -- ^ the default UI settings config file , rwriteSaveClips :: Int -- ^ game saved that often (not on browser) , rleadLevelClips :: Int -- ^ server switches leader level that often , rscoresFile :: FilePath -- ^ name of the scores file , rnearby :: Int -- ^ what is a close distance between actors , rstairWordCarried :: [Text] -- ^ words that can't be dropped from stair -- name as it goes through levels , rsymbolProjectile :: Char } emptyRuleContent :: RuleContent emptyRuleContent = RuleContent { rtitle = "" , rXmax = 0 , rYmax = 0 , rfontDir = "" , rexeVersion = makeVersion [] , rcfgUIName = "" , rcfgUIDefault = "" , rwriteSaveClips = 0 , rleadLevelClips = 0 , rscoresFile = "" , rnearby = 0 , rstairWordCarried = [] , rsymbolProjectile = '0' } -- | Catch invalid rule kind definitions. validateSingle :: RuleContent -> [Text] validateSingle _ = [] makeData :: RuleContent -> RuleContent makeData rc = let singleOffenders = validateSingle rc in assert (null singleOffenders `blame` "Rule Content not valid" `swith` singleOffenders) rc LambdaHack-0.9.5.0/definition-src/Game/LambdaHack/Content/TileKind.hs0000644000000000000000000002312207346545000023231 0ustar0000000000000000{-# LANGUAGE DeriveGeneric #-} -- | The type of kinds of terrain tiles. module Game.LambdaHack.Content.TileKind ( TileKind(..), Feature(..) , makeData , isUknownSpace, unknownId , isSuspectKind, isOpenableKind, isClosableKind , talterForStairs, floorSymbol #ifdef EXPOSE_INTERNAL -- * Internal operations , validateSingle, validateAll , validateDups, hardwiredTileGroups #endif ) where import Prelude () import Game.LambdaHack.Core.Prelude import Control.DeepSeq import Data.Binary import qualified Data.Char as Char import Data.Hashable import GHC.Generics (Generic) import Game.LambdaHack.Content.ItemKind (ItemKind) import Game.LambdaHack.Definition.Color import Game.LambdaHack.Definition.ContentData import Game.LambdaHack.Definition.Defs -- | The type of kinds of terrain tiles. See @Tile.hs@ for explanation -- of the absence of a corresponding type @Tile@ that would hold -- particular concrete tiles in the dungeon. -- Note that tile names (and any other content names) should not be plural -- (that would lead to "a stairs"), so "road with cobblestones" is fine, -- but "granite cobblestones" is wrong. -- -- Tile kind for unknown space has the minimal @ContentId@ index. -- The @talter@ for unknown space is @1@ and no other tile kind has that value. data TileKind = TileKind { tsymbol :: Char -- ^ map symbol , tname :: Text -- ^ short description , tfreq :: Freqs TileKind -- ^ frequency within groups , tcolor :: Color -- ^ map color , tcolor2 :: Color -- ^ map color when not in FOV , talter :: Word8 -- ^ minimal skill needed to alter the tile , tfeature :: [Feature] -- ^ properties } deriving Show -- No Eq and Ord to make extending logically sound -- | All possible terrain tile features. data Feature = Embed (GroupName ItemKind) -- ^ initially an item of this group is embedded; -- we assume the item has effects and is supposed to be triggered | OpenTo (GroupName TileKind) -- ^ goes from a closed to (randomly closed or) open tile when altered | CloseTo (GroupName TileKind) -- ^ goes from an open to (randomly opened or) closed tile when altered | ChangeTo (GroupName TileKind) -- ^ alters tile, but does not change walkability | HideAs (GroupName TileKind) -- ^ when hidden, looks as the unique tile of the group | BuildAs (GroupName TileKind) -- ^ when generating, may be transformed to the unique tile of the group | RevealAs (GroupName TileKind) -- ^ when generating in opening, can be revealed to belong to the group | ObscureAs (GroupName TileKind) -- ^ when generating in solid wall, can be revealed to belong to the group | Walkable -- ^ actors can walk through | Clear -- ^ actors can see through | Dark -- ^ is not lit with an ambient light | OftenItem -- ^ initial items often generated there | VeryOftenItem -- ^ initial items very often generated there | OftenActor -- ^ initial actors often generated there | NoItem -- ^ no items ever generated there | NoActor -- ^ no actors ever generated there | ConsideredByAI -- ^ even if otherwise uninteresting, taken into -- account for triggering by AI | Trail -- ^ used for visible trails throughout the level | Spice -- ^ in place normal legend and in override, -- don't roll a tile kind only once per place, -- but roll for each position; one non-spicy -- (according to frequencies of non-spicy) and -- at most one spicy (according to their frequencies) -- is rolled per place and then, once for each -- position, one of the two is semi-randomly chosen -- (according to their individual frequencies only) deriving (Show, Eq, Ord, Generic) instance Binary Feature instance Hashable Feature instance NFData Feature -- | Validate a single tile kind. validateSingle :: TileKind -> [Text] validateSingle t@TileKind{..} = [ "suspect tile is walkable" | Walkable `elem` tfeature && isSuspectKind t ] ++ [ "openable tile is open" | Walkable `elem` tfeature && isOpenableKind t ] ++ [ "closable tile is closed" | Walkable `notElem` tfeature && isClosableKind t ] ++ [ "walkable tile is considered for triggering by AI" | Walkable `elem` tfeature && ConsideredByAI `elem` tfeature ] ++ [ "trail tile not walkable" | Walkable `notElem` tfeature && Trail `elem` tfeature ] ++ [ "OftenItem and NoItem on a tile" | OftenItem `elem` tfeature && NoItem `elem` tfeature ] ++ [ "OftenActor and NoActor on a tile" | OftenItem `elem` tfeature && NoItem `elem` tfeature ] ++ (let f :: Feature -> Bool f OpenTo{} = True f CloseTo{} = True f ChangeTo{} = True f _ = False ts = filter f tfeature in [ "more than one OpenTo, CloseTo and ChangeTo specification" | length ts > 1 ]) ++ (let f :: Feature -> Bool f HideAs{} = True f _ = False ts = filter f tfeature in ["more than one HideAs specification" | length ts > 1]) ++ (let f :: Feature -> Bool f BuildAs{} = True f _ = False ts = filter f tfeature in ["more than one BuildAs specification" | length ts > 1]) ++ concatMap (validateDups t) [ Walkable, Clear, Dark, OftenItem, OftenActor, NoItem, NoActor , ConsideredByAI, Trail, Spice ] validateDups :: TileKind -> Feature -> [Text] validateDups TileKind{..} feat = let ts = filter (== feat) tfeature in ["more than one" <+> tshow feat <+> "specification" | length ts > 1] -- | Validate all tile kinds. -- -- We don't check it any more, but if tiles look the same on the map -- (symbol and color), their substantial features should be the same, too, -- unless there is a good reason they shouldn't. Otherwise the player has -- to inspect manually all the tiles with this look to see if any is special. -- This tends to be tedious. Note that tiles may freely differ wrt text blurb, -- dungeon generation rules, AI preferences, etc., whithout causing the tedium. validateAll :: ContentData ItemKind -> [TileKind] -> ContentData TileKind -> [Text] validateAll coitem content cotile = let g :: Feature -> Maybe (GroupName TileKind) g (OpenTo grp) = Just grp g (CloseTo grp) = Just grp g (ChangeTo grp) = Just grp g (HideAs grp) = Just grp g (BuildAs grp) = Just grp g (RevealAs grp) = Just grp g (ObscureAs grp) = Just grp g _ = Nothing missingTileGroups = [ (tname k, absGroups) | k <- content , let grps = mapMaybe g $ tfeature k absGroups = filter (not . omemberGroup cotile) grps , not $ null absGroups ] h :: Feature -> Maybe (GroupName ItemKind) h (Embed grp) = Just grp h _ = Nothing missingItemGroups = [ (tname k, absGroups) | k <- content , let grps = mapMaybe h $ tfeature k absGroups = filter (not . omemberGroup coitem) grps , not $ null absGroups ] missingHardwiredGroups = filter (not . omemberGroup cotile) hardwiredTileGroups in [ "unknown tile (the first) should be the unknown one" | talter (head content) /= 1 || tname (head content) /= "unknown space" ] ++ [ "no tile other than the unknown (the first) should require skill 1" | all (\tk -> talter tk == 1) (tail content) ] ++ [ "only unknown tile may have talter 1" | any ((== 1) . talter) $ tail content ] ++ [ "mentioned tile groups not in content:" <+> tshow missingTileGroups | not $ null missingTileGroups ] ++ [ "embedded item groups not in content:" <+> tshow missingItemGroups | not $ null missingItemGroups ] ++ [ "hardwired groups not in content:" <+> tshow missingHardwiredGroups | not $ null missingHardwiredGroups ] hardwiredTileGroups :: [GroupName TileKind] hardwiredTileGroups = [ "unknown space", "legendLit", "legendDark", "unknown outer fence" , "basic outer fence" ] isUknownSpace :: ContentId TileKind -> Bool {-# INLINE isUknownSpace #-} isUknownSpace tt = toContentId 0 == tt unknownId :: ContentId TileKind {-# INLINE unknownId #-} unknownId = toContentId 0 isSuspectKind :: TileKind -> Bool isSuspectKind t = let getTo RevealAs{} = True getTo ObscureAs{} = True getTo _ = False in any getTo $ tfeature t isOpenableKind :: TileKind -> Bool isOpenableKind t = let getTo OpenTo{} = True getTo _ = False in any getTo $ tfeature t isClosableKind :: TileKind -> Bool isClosableKind t = let getTo CloseTo{} = True getTo _ = False in any getTo $ tfeature t talterForStairs :: Word8 talterForStairs = 3 floorSymbol :: Char.Char floorSymbol = Char.chr 183 -- Alter skill schema: -- 0 can be altered by everybody (escape) -- 1 unknown only -- 2 openable and suspect -- 3 stairs -- 4 closable -- 5 changeable (e.g., caches) -- 10 weak obstructions -- 50 considerable obstructions -- 100 walls -- maxBound impenetrable walls, etc., can never be altered makeData :: ContentData ItemKind -> [TileKind] -> ContentData TileKind makeData coitem = makeContentData "TileKind" tname tfreq validateSingle (validateAll coitem) LambdaHack-0.9.5.0/definition-src/Game/LambdaHack/Core/0000755000000000000000000000000007346545000020450 5ustar0000000000000000LambdaHack-0.9.5.0/definition-src/Game/LambdaHack/Core/Dice.hs0000644000000000000000000002305407346545000021654 0ustar0000000000000000{-# LANGUAGE DeriveGeneric, GeneralizedNewtypeDeriving #-} -- | Representation of dice scaled with current level depth. module Game.LambdaHack.Core.Dice ( -- * Frequency distribution for casting dice scaled with level depth Dice, AbsDepth(..), castDice, d, dL, z, zL, intToDice, minDice, maxDice , infsupDice, supDice, infDice, meanDice, reduceDice -- * Dice for rolling a pair of integer parameters representing coordinates. , DiceXY(..), supDiceXY, infDiceXY, meanDiceXY ) where import Prelude () import Game.LambdaHack.Core.Prelude import Data.Binary import Data.Hashable (Hashable) import GHC.Generics (Generic) -- | Multiple dice rolls, some scaled with current level depth, in which case -- the sum of all rolls is scaled in proportion to current depth -- divided by maximal dungeon depth. -- -- The simple dice should have positive number of rolls and number of sides. -- -- The @Num@ instance doesn't have @abs@ nor @signum@ defined, -- because the functions for computing infimum, supremum and mean dice -- results would be too costly. data Dice = DiceI Int | DiceD Int Int | DiceDL Int Int | DiceZ Int Int | DiceZL Int Int | DicePlus Dice Dice | DiceTimes Dice Dice | DiceNegate Dice | DiceMin Dice Dice | DiceMax Dice Dice deriving (Eq, Generic) instance Show Dice where show = stripOuterParens . showDiceWithParens stripOuterParens :: String -> String stripOuterParens s@('(' : rest) = case uncons $ reverse rest of Just (')', middle) -> reverse middle _ -> s stripOuterParens s = s showDiceWithParens :: Dice -> String showDiceWithParens = sh where sh dice1 = case dice1 of DiceI k -> show k DiceD n k -> show n ++ "d" ++ show k DiceDL n k -> show n ++ "dL" ++ show k DiceZ n k -> show n ++ "z" ++ show k DiceZL n k -> show n ++ "zL" ++ show k DicePlus d1 (DiceNegate d2) -> wrapInParens $ sh d1 ++ "-" ++ sh d2 DicePlus (DiceNegate d1) d2 -> wrapInParens $ "-" ++ sh d1 ++ "+" ++ sh d2 DicePlus d1 (DicePlus d2 d3) -> sh $ DicePlus (DicePlus d1 d2) d3 DicePlus (DicePlus d1 d2) d3 -> wrapInParens $ stripOuterParens (sh $ DicePlus d1 d2) ++ "+" ++ sh d3 DicePlus d1 d2 -> wrapInParens $ sh d1 ++ "+" ++ sh d2 DiceTimes d1 d2 -> wrapInParens $ sh d1 ++ "*" ++ sh d2 DiceNegate d1 -> wrapInParens $ "-" ++ sh d1 DiceMin d1 d2 -> wrapInParens $ "min" ++ sh d1 ++ sh d2 DiceMax d1 d2 -> wrapInParens $ "max" ++ sh d1 ++ sh d2 wrapInParens :: String -> String wrapInParens "" = "" wrapInParens t = "(" <> t <> ")" instance Binary Dice instance Num Dice where d1 + d2 = DicePlus d1 d2 d1 * d2 = DiceTimes d1 d2 d1 - d2 = d1 + DiceNegate d2 negate = DiceNegate abs = undefined -- very costly to compute mean exactly signum = undefined -- very costly to compute mean exactly fromInteger n = DiceI (fromInteger n) -- | Absolute depth in the dungeon. When used for the maximum depth -- of the whole dungeon, this can be different than dungeon size, -- e.g., when the dungeon is branched, and it can even be different -- than the length of the longest branch, if levels at some depths are missing. newtype AbsDepth = AbsDepth Int deriving (Show, Eq, Ord, Hashable, Binary) -- | Cast dice scaled with current level depth. When scaling, we round up, -- so that the value of @1 `dL` 1@ is 1 even at the lowest level. -- -- The implementation calls RNG as many times as there are dice rolls, -- which is costly, so content should prefer to case fewer dice -- and then multiply them by a constant. If rounded results are not desired -- (often they are, to limit the number of distinct item varieties -- in inventory), another dice may be added to the result. -- -- A different possible implementation, with dice represented as @Frequency@, -- makes only one RNG call per dice, but due to lists lengths proportional -- to the maximal value of the dice, it's is intractable for 1000d1000 -- and problematic already for 100d100. castDice :: forall m. Monad m => ((Int, Int) -> m Int) -> AbsDepth -> AbsDepth -> Dice -> m Int castDice randomR (AbsDepth lvlDepth) (AbsDepth maxDepth) dice = do let !_A = assert (lvlDepth >= 0 && lvlDepth <= maxDepth `blame` "invalid depth for dice rolls" `swith` (lvlDepth, maxDepth)) () castNK n start k = if start == k then return $! n * k else do let f !acc 0 = return acc f acc count = do r <- randomR (start, k) f (acc + r) (count - 1) f 0 n scaleL k = (k * max 1 lvlDepth) `divUp` max 1 maxDepth castD :: Dice -> m Int castD dice1 = case dice1 of DiceI k -> return k DiceD n k -> castNK n 1 k DiceDL n k -> scaleL <$> castNK n 1 k DiceZ n k -> castNK n 0 (k - 1) DiceZL n k -> scaleL <$> castNK n 0 (k - 1) DicePlus d1 d2 -> do k1 <- castD d1 k2 <- castD d2 return $! k1 + k2 DiceTimes d1 d2 -> do k1 <- castD d1 k2 <- castD d2 return $! k1 * k2 DiceNegate d1 -> do k <- castD d1 return $! negate k DiceMin d1 d2 -> do k1 <- castD d1 k2 <- castD d2 return $! min k1 k2 DiceMax d1 d2 -> do k1 <- castD d1 k2 <- castD d2 return $! max k1 k2 castD dice -- | A die, rolled the given number of times. E.g., @1 `d` 2@ rolls 2-sided -- die one time. d :: Int -> Int -> Dice d n k = assert (n > 0 && k > 0 `blame` "die must be positive" `swith` (n, k)) $ DiceD n k -- | A die rolled the given number of times, with the result scaled -- with dungeon level depth. dL :: Int -> Int -> Dice dL n k = assert (n > 0 && k > 0 `blame` "die must be positive" `swith` (n, k)) $ DiceDL n k -- | A die, starting from zero, ending at one less than the bound, -- rolled the given number of times. E.g., @1 `z` 1@ always rolls zero. z :: Int -> Int -> Dice z n k = assert (n > 0 && k > 0 `blame` "die must be positive" `swith` (n, k)) $ DiceZ n k -- | A die, starting from zero, ending at one less than the bound, -- rolled the given number of times, -- with the result scaled with dungeon level depth. zL :: Int -> Int -> Dice zL n k = assert (n > 0 && k > 0 `blame` "die must be positive" `swith` (n, k)) $ DiceZL n k intToDice :: Int -> Dice intToDice = DiceI minDice :: Dice -> Dice -> Dice minDice = DiceMin maxDice :: Dice -> Dice -> Dice maxDice = DiceMax -- | Minimal and maximal possible value of the dice. -- -- @divUp@ in the implementation corresponds to @ceiling@, -- applied to results of @meanDice@ elsewhere in the code, -- and prevents treating 1d1-power effects (on shallow levels) as null effects. infsupDice :: Dice -> (Int, Int) infsupDice dice1 = case dice1 of DiceI k -> (k, k) DiceD n k -> (n, n * k) DiceDL n k -> (1, n * k) -- bottom and top level considered DiceZ n k -> (0, n * (k - 1)) DiceZL n k -> (0, n * (k - 1)) -- bottom and top level considered DicePlus d1 d2 -> let (infD1, supD1) = infsupDice d1 (infD2, supD2) = infsupDice d2 in (infD1 + infD2, supD1 + supD2) DiceTimes (DiceI k) d2 -> let (infD2, supD2) = infsupDice d2 in if k >= 0 then (k * infD2, k * supD2) else (k * supD2, k * infD2) DiceTimes d1 (DiceI k) -> let (infD1, supD1) = infsupDice d1 in if k >= 0 then (infD1 * k, supD1 * k) else (supD1 * k, infD1 * k) -- Multiplication other than the two cases above is unlikely, but here it is. DiceTimes d1 d2 -> let (infD1, supD1) = infsupDice d1 (infD2, supD2) = infsupDice d2 options = [infD1 * infD2, infD1 * supD2, supD1 * supD2, supD1 * infD2] in (minimum options, maximum options) DiceNegate d1 -> let (infD1, supD1) = infsupDice d1 in (negate supD1, negate infD1) DiceMin d1 d2 -> let (infD1, supD1) = infsupDice d1 (infD2, supD2) = infsupDice d2 in (min infD1 infD2, min supD1 supD2) DiceMax d1 d2 -> let (infD1, supD1) = infsupDice d1 (infD2, supD2) = infsupDice d2 in (max infD1 infD2, max supD1 supD2) -- | Maximal value of dice. The scaled part taken assuming median level. supDice :: Dice -> Int supDice = snd . infsupDice -- | Minimal value of dice. The scaled part taken assuming median level. infDice :: Dice -> Int infDice = fst . infsupDice -- | Mean value of dice. The scaled part taken assuming median level. meanDice :: Dice -> Double meanDice dice1 = case dice1 of DiceI k -> fromIntegral k DiceD n k -> fromIntegral (n * (k + 1)) / 2 DiceDL n k -> fromIntegral (n * (k + 1)) / 4 DiceZ n k -> fromIntegral (n * k) / 2 DiceZL n k -> fromIntegral (n * k) / 4 DicePlus d1 d2 -> meanDice d1 + meanDice d2 DiceTimes d1 d2 -> meanDice d1 * meanDice d2 -- I hope this is that simple DiceNegate d1 -> negate $ meanDice d1 DiceMin d1 d2 -> min (meanDice d1) (meanDice d2) -- crude approximation, only exact if the distributions disjoint DiceMax d1 d2 -> max (meanDice d1) (meanDice d2) -- crude approximation reduceDice :: Dice -> Maybe Int reduceDice d1 = let (infD1, supD1) = infsupDice d1 in if infD1 == supD1 then Just infD1 else Nothing -- | Dice for rolling a pair of integer parameters pertaining to, -- respectively, the X and Y cartesian 2D coordinates. data DiceXY = DiceXY Dice Dice deriving (Show, Generic) instance Binary DiceXY -- | Maximal value of DiceXY. supDiceXY :: DiceXY -> (Int, Int) supDiceXY (DiceXY x y) = (supDice x, supDice y) -- | Minimal value of DiceXY. infDiceXY :: DiceXY -> (Int, Int) infDiceXY (DiceXY x y) = (infDice x, infDice y) -- | Mean value of DiceXY. meanDiceXY :: DiceXY -> (Double, Double) meanDiceXY (DiceXY x y) = (meanDice x, meanDice y) LambdaHack-0.9.5.0/definition-src/Game/LambdaHack/Core/Frequency.hs0000644000000000000000000001056607346545000022755 0ustar0000000000000000{-# LANGUAGE DeriveFoldable, DeriveGeneric, DeriveTraversable, TupleSections #-} -- | A list of entities with relative frequencies of appearance. module Game.LambdaHack.Core.Frequency ( -- * The @Frequency@ type Frequency -- * Construction , uniformFreq, toFreq -- * Transformation , scaleFreq, renameFreq, setFreq -- * Consumption , nullFreq, runFrequency, nameFrequency , minFreq, maxFreq, mostFreq ) where import Prelude () import Game.LambdaHack.Core.Prelude import Control.Applicative import Data.Int (Int32) import Data.Ord (comparing) import GHC.Generics (Generic) -- | The frequency distribution type. Not normalized (operations may -- or may not group the same elements and sum their frequencies). -- However, elements with zero frequency are removed upon construction. -- -- The @Eq@ instance compares raw representations, not relative, -- normalized frequencies, so operations don't need to preserve -- the expected equalities. data Frequency a = Frequency { runFrequency :: [(Int, a)] -- ^ give acces to raw frequency values , nameFrequency :: Text -- ^ short description for debug, etc. } deriving (Show, Eq, Ord, Foldable, Traversable, Generic) _maxBound32 :: Integer _maxBound32 = toInteger (maxBound :: Int32) instance Monad Frequency where Frequency xs name >>= f = Frequency [ #ifdef WITH_EXPENSIVE_ASSERTIONS assert (toInteger p * toInteger q <= _maxBound32 `blame` (name, map fst xs)) #endif (p * q, y) | (p, x) <- xs , (q, y) <- runFrequency (f x) ] ("bind (" <> name <> ")") instance Functor Frequency where fmap f (Frequency xs name) = Frequency (map (second f) xs) name instance Applicative Frequency where {-# INLINE pure #-} pure x = Frequency [(1, x)] "pure" Frequency fs fname <*> Frequency ys yname = Frequency [ #ifdef WITH_EXPENSIVE_ASSERTIONS assert (toInteger p * toInteger q <= _maxBound32 `blame` (fname, map fst fs, yname, map fst ys)) #endif (p * q, f y) | (p, f) <- fs , (q, y) <- ys ] ("(" <> fname <> ") <*> (" <> yname <> ")") instance MonadPlus Frequency where mplus (Frequency xs xname) (Frequency ys yname) = let name = case (xs, ys) of ([], []) -> "[]" ([], _) -> yname (_, []) -> xname _ -> "(" <> xname <> ") ++ (" <> yname <> ")" in Frequency (xs ++ ys) name mzero = Frequency [] "[]" instance Alternative Frequency where (<|>) = mplus empty = mzero -- | Uniform discrete frequency distribution. uniformFreq :: Text -> [a] -> Frequency a uniformFreq name l = Frequency (map (1,) l) name -- | Takes a name and a list of frequencies and items -- into the frequency distribution. toFreq :: Text -> [(Int, a)] -> Frequency a toFreq name l = #ifdef WITH_EXPENSIVE_ASSERTIONS assert (all (\(p, _) -> toInteger p <= _maxBound32) l `blame` (name, map fst l)) $ #endif Frequency (filter ((> 0 ) . fst) l) name -- | Scale frequency distribution, multiplying it -- by a positive integer constant. scaleFreq :: Show a => Int -> Frequency a -> Frequency a scaleFreq n (Frequency xs name) = assert (n > 0 `blame` "non-positive frequency scale" `swith` (name, n, xs)) $ let multN p = #ifdef WITH_EXPENSIVE_ASSERTIONS assert (toInteger p * toInteger n <= _maxBound32 `blame` (n, Frequency xs name)) $ #endif p * n in Frequency (map (first multN) xs) name -- | Change the description of the frequency. renameFreq :: Text -> Frequency a -> Frequency a renameFreq newName fr = fr {nameFrequency = newName} -- | Set frequency of an element. setFreq :: Eq a => Frequency a -> a -> Int -> Frequency a setFreq (Frequency xs name) x n = let xsNew = [(n, x) | n <= 0] ++ filter ((/= x) . snd) xs in Frequency xsNew name -- | Test if the frequency distribution is empty. nullFreq :: Frequency a -> Bool nullFreq (Frequency fs _) = null fs minFreq :: Ord a => Frequency a -> Maybe a minFreq fr = if nullFreq fr then Nothing else Just $ minimum fr maxFreq :: Ord a => Frequency a -> Maybe a maxFreq fr = if nullFreq fr then Nothing else Just $ maximum fr mostFreq :: Frequency a -> Maybe a mostFreq fr = if nullFreq fr then Nothing else Just $ snd $ maximumBy (comparing fst) $ runFrequency fr LambdaHack-0.9.5.0/definition-src/Game/LambdaHack/Core/Prelude.hs0000644000000000000000000001077607346545000022417 0ustar0000000000000000{-# LANGUAGE TypeFamilies #-} {-# OPTIONS_GHC -Wno-orphans #-} -- | Custom Prelude, compatible across many GHC versions. module Game.LambdaHack.Core.Prelude ( module Prelude.Compat , module Control.Monad.Compat , module Data.List.Compat , module Data.Maybe , module Data.Semigroup.Compat , module Control.Exception.Assert.Sugar , Text, (<+>), tshow, divUp, sum, (<$$>), partitionM, length, null , (***), (&&&), first, second ) where import Prelude () import Prelude.Compat hiding (appendFile, length, null, readFile, sum, writeFile, (<>)) import Control.Applicative import Control.Arrow (first, second, (&&&), (***)) import Control.DeepSeq import Control.Exception.Assert.Sugar (allB, assert, blame, showFailure, swith) import Control.Monad.Compat import Data.Binary import qualified Data.EnumMap.Strict as EM import qualified Data.EnumSet as ES import qualified Data.Fixed as Fixed import Data.Hashable import qualified Data.HashMap.Strict as HM import Data.Key import Data.List.Compat hiding (length, null, sum) import qualified Data.List.Compat as List import Data.Maybe import Data.Semigroup.Compat (Semigroup ((<>))) import Data.Text (Text) import qualified Data.Text as T (pack) import qualified Data.Time as Time import NLP.Miniutter.English ((<+>)) import qualified NLP.Miniutter.English as MU -- | Show and pack the result. tshow :: Show a => a -> Text tshow x = T.pack $ show x infixl 7 `divUp` -- | Integer division, rounding up. divUp :: Integral a => a -> a -> a {-# INLINE divUp #-} divUp n k = (n + k - 1) `div` k sum :: Num a => [a] -> a sum = foldl' (+) 0 infixl 4 <$$> (<$$>) :: (Functor f, Functor g) => (a -> b) -> f (g a) -> f (g b) h <$$> m = fmap h <$> m partitionM :: Applicative m => (a -> m Bool) -> [a] -> m ([a], [a]) {-# INLINE partitionM #-} partitionM p = foldr (\a -> liftA2 (\b -> (if b then first else second) (a :)) (p a)) (pure ([], [])) -- | A version specialized to lists to avoid errors such as taking length -- of @Maybe [a]@ instead of @[a]@. -- Such errors are hard to detect, because the type of elements of the list -- is not constrained. length :: [a] -> Int length = List.length -- | A version specialized to lists to avoid errors such as taking null -- of @Maybe [a]@ instead of @[a]@. -- Such errors are hard to detect, because the type of elements of the list -- is not constrained. null :: [a] -> Bool null = List.null -- Data.Binary orphan instances instance (Enum k, Binary k, Binary e) => Binary (EM.EnumMap k e) where put m = put (EM.size m) >> mapM_ put (EM.toAscList m) get = EM.fromDistinctAscList <$> get instance (Enum k, Binary k) => Binary (ES.EnumSet k) where put m = put (ES.size m) >> mapM_ put (ES.toAscList m) get = ES.fromDistinctAscList <$> get instance Binary Time.NominalDiffTime where get = fmap realToFrac (get :: Get Fixed.Pico) put = (put :: Fixed.Pico -> Put) . realToFrac instance (Hashable k, Eq k, Binary k, Binary v) => Binary (HM.HashMap k v) where get = fmap HM.fromList get put = put . HM.toList -- Data.Key orphan instances type instance Key (EM.EnumMap k) = k instance Zip (EM.EnumMap k) where {-# INLINE zipWith #-} zipWith = EM.intersectionWith instance Enum k => ZipWithKey (EM.EnumMap k) where {-# INLINE zipWithKey #-} zipWithKey = EM.intersectionWithKey instance Enum k => Keyed (EM.EnumMap k) where {-# INLINE mapWithKey #-} mapWithKey = EM.mapWithKey instance Enum k => FoldableWithKey (EM.EnumMap k) where {-# INLINE foldrWithKey #-} foldrWithKey = EM.foldrWithKey instance Enum k => TraversableWithKey (EM.EnumMap k) where traverseWithKey f = fmap EM.fromDistinctAscList . traverse (\(k, v) -> (,) k <$> f k v) . EM.toAscList instance Enum k => Indexable (EM.EnumMap k) where {-# INLINE index #-} index = (EM.!) instance Enum k => Lookup (EM.EnumMap k) where {-# INLINE lookup #-} lookup = EM.lookup instance Enum k => Adjustable (EM.EnumMap k) where {-# INLINE adjust #-} adjust = EM.adjust -- Data.Hashable orphan instances instance (Enum k, Hashable k, Hashable e) => Hashable (EM.EnumMap k e) where hashWithSalt s x = hashWithSalt s (EM.toAscList x) instance (Enum k, Hashable k) => Hashable (ES.EnumSet k) where hashWithSalt s x = hashWithSalt s (ES.toAscList x) -- Control.DeepSeq orphan instances instance NFData MU.Part instance NFData MU.Person instance NFData MU.Polarity LambdaHack-0.9.5.0/definition-src/Game/LambdaHack/Core/Random.hs0000644000000000000000000000771607346545000022237 0ustar0000000000000000-- | Representation of probabilities and random computations. module Game.LambdaHack.Core.Random ( -- * The @Rng@ monad Rnd -- * Random operations , randomR, random, oneOf, shuffle, frequency -- * Fractional chance , Chance, chance -- * Casting dice scaled with level , castDice, oddsDice, castDiceXY -- * Specialized monadic folds , foldrM, foldlM' #ifdef EXPOSE_INTERNAL -- * Internal operations , rollFreq #endif ) where import Prelude () import Game.LambdaHack.Core.Prelude import qualified Control.Monad.Trans.State.Strict as St import Data.Ratio import qualified System.Random as R import qualified Game.LambdaHack.Core.Dice as Dice import Game.LambdaHack.Core.Frequency -- | The monad of computations with random generator state. type Rnd a = St.State R.StdGen a -- | Get a random object within a range with a uniform distribution. randomR :: (R.Random a) => (a, a) -> Rnd a {-# INLINE randomR #-} randomR = St.state . R.randomR -- | Get a random object of a given type with a uniform distribution. random :: (R.Random a) => Rnd a {-# INLINE random #-} random = St.state R.random -- | Get any element of a list with equal probability. oneOf :: [a] -> Rnd a oneOf [] = error $ "oneOf []" `showFailure` () oneOf [x] = return x oneOf xs = do r <- randomR (0, length xs - 1) return $! xs !! r -- | Generates a random permutation. Naive, but good enough for small inputs. shuffle :: Eq a => [a] -> Rnd [a] shuffle [] = return [] shuffle l = do x <- oneOf l (x :) <$> shuffle (delete x l) -- | Gen an element according to a frequency distribution. frequency :: Show a => Frequency a -> Rnd a {-# INLINE frequency #-} frequency = St.state . rollFreq -- | Randomly choose an item according to the distribution. rollFreq :: Show a => Frequency a -> R.StdGen -> (a, R.StdGen) rollFreq fr g = case runFrequency fr of [] -> error $ "choice from an empty frequency" `showFailure` nameFrequency fr [(n, x)] | n <= 0 -> error $ "singleton void frequency" `showFailure` (nameFrequency fr, n, x) [(_, x)] -> (x, g) -- speedup fs -> let sumf = foldl' (\ !acc (!n, _) -> acc + n) 0 fs (r, ng) = R.randomR (1, sumf) g frec :: Int -> [(Int, a)] -> a frec !m [] = error $ "impossible roll" `showFailure` (nameFrequency fr, fs, m) frec m ((n, x) : _) | m <= n = x frec m ((n, _) : xs) = frec (m - n) xs in assert (sumf > 0 `blame` "frequency with nothing to pick" `swith` (nameFrequency fr, fs)) (frec r fs, ng) -- | Fractional chance. type Chance = Rational -- | Give @True@, with probability determined by the fraction. chance :: Chance -> Rnd Bool chance r = do let n = numerator r d = denominator r k <- randomR (1, d) return (k <= n) -- | Cast dice scaled with current level depth. -- Note that at the first level, the scaled dice are always ignored. castDice :: Dice.AbsDepth -> Dice.AbsDepth -> Dice.Dice -> Rnd Int castDice = Dice.castDice randomR -- | Cast dice scaled with current level depth and return @True@ -- if the results is greater than 50. oddsDice :: Dice.AbsDepth -> Dice.AbsDepth -> Dice.Dice -> Rnd Bool oddsDice ldepth totalDepth dice = do c <- castDice ldepth totalDepth dice return $! c > 50 -- | Cast dice, scaled with current level depth, for coordinates. castDiceXY :: Dice.AbsDepth -> Dice.AbsDepth -> Dice.DiceXY -> Rnd (Int, Int) castDiceXY ldepth totalDepth (Dice.DiceXY dx dy) = do x <- castDice ldepth totalDepth dx y <- castDice ldepth totalDepth dy return (x, y) foldrM :: Foldable t => (a -> b -> Rnd b) -> b -> t a -> Rnd b foldrM f z0 xs = let f' x (z, g) = St.runState (f x z) g in St.state $ \g -> foldr f' (z0, g) xs foldlM' :: Foldable t => (b -> a -> Rnd b) -> b -> t a -> Rnd b foldlM' f z0 xs = let f' (z, g) x = St.runState (f z x) g in St.state $ \g -> foldl' f' (z0, g) xs LambdaHack-0.9.5.0/definition-src/Game/LambdaHack/Definition/0000755000000000000000000000000007346545000021650 5ustar0000000000000000LambdaHack-0.9.5.0/definition-src/Game/LambdaHack/Definition/Ability.hs0000644000000000000000000002134107346545000023602 0ustar0000000000000000{-# LANGUAGE DeriveGeneric, GeneralizedNewtypeDeriving #-} -- | Abilities of items, actors and factions. module Game.LambdaHack.Definition.Ability ( Skill(..), Skills, Flag(..), Flags(..), Tactic(..), EqpSlot(..) , getSk, addSk, checkFl, skillsToList , zeroSkills, addSkills, sumScaledSkills , nameTactic, describeTactic, tacticSkills , blockOnly, meleeAdjacent, meleeAndRanged, ignoreItems #ifdef EXPOSE_INTERNAL -- * Internal operations , compactSkills, scaleSkills #endif ) where import Prelude () import Game.LambdaHack.Core.Prelude import Data.Binary import qualified Data.EnumMap.Strict as EM import qualified Data.EnumSet as ES import Data.Hashable (Hashable) import GHC.Generics (Generic) -- | Actor and faction skills. They are a subset of actor aspects. -- See 'Game.LambdaHack.Client.UI.EffectDescription.skillDesc' -- for documentation. data Skill = -- Stats, that is skills affecting permitted actions. SkMove | SkMelee | SkDisplace | SkAlter | SkWait | SkMoveItem | SkProject | SkApply -- Assorted skills. | SkSwimming | SkFlying | SkHurtMelee | SkArmorMelee | SkArmorRanged | SkMaxHP | SkMaxCalm | SkSpeed | SkSight -- ^ FOV radius, where 1 means a single tile FOV | SkSmell | SkShine | SkNocto | SkHearing | SkAggression | SkOdor deriving (Show, Eq, Ord, Generic, Enum, Bounded) -- | Strength of particular skills. This is cumulative from actor -- organs and equipment and so pertain to an actor as well as to items. -- -- This representation is sparse, so better than a record when there are more -- item kinds (with few skills) than actors (with many skills), -- especially if the number of skills grows as the engine is developed. -- It's also easier to code and maintain. -- -- The tree is by construction sparse, so the derived equality is semantical. newtype Skills = Skills {skills :: EM.EnumMap Skill Int} deriving (Show, Eq, Ord, Generic, Hashable, Binary) -- | Item flag aspects. data Flag = Fragile -- ^ as a projectile, break at target tile, even if no hit; -- also, at each periodic activation a copy is destroyed -- and all other copies require full cooldown (timeout) | Lobable -- ^ drop at target tile, even if no hit | Durable -- ^ don't break even when hitting or applying | Equipable -- ^ AI and UI flag: consider equipping (may or may not -- have 'EqpSlot', e.g., if the benefit is periodic) | Meleeable -- ^ AI and UI flag: consider meleeing with | Precious -- ^ AI and UI flag: don't risk identifying by use; -- also, can't throw or apply if not calm enough; -- also may be used for UI flavour or AI hints | Blast -- ^ the item is an explosion blast particle | Condition -- ^ item is a condition (buff or de-buff) of an actor -- and is displayed as such; -- this differs from belonging to the @condition@ group, -- which doesn't guarantee display as a condition, -- but governs removal by items that drop @condition@ | Unique -- ^ at most one copy can ever be generated | Periodic -- ^ at most one of any copies without cooldown (timeout) -- activates each turn; the cooldown required after -- activation is specified in @Timeout@ (or is zero); -- the initial cooldown can also be specified -- as @TimerDice@ in @CreateItem@ effect; uniquely, this -- activation never destroys a copy, unless item is fragile; -- all this happens only for items in equipment or organs | MinorEffects -- ^ override: the effects on this item are considered -- minor and so not causing identification on use, -- and so this item will identify on pick-up deriving (Show, Eq, Ord, Generic, Enum, Bounded) newtype Flags = Flags {flags :: ES.EnumSet Flag} deriving (Show, Eq, Ord, Generic, Hashable, Binary) -- | Tactic of non-leader actors. Apart of determining AI operation, -- each tactic implies a skill modifier, that is added to the non-leader skills -- defined in @fskillsOther@ field of @Player@. data Tactic = TExplore -- ^ if enemy nearby, attack, if no items, etc., explore unknown | TFollow -- ^ always follow leader's target or his position if no target | TFollowNoItems -- ^ follow but don't do any item management nor use | TMeleeAndRanged -- ^ only melee and do ranged combat | TMeleeAdjacent -- ^ only melee (or wait) | TBlock -- ^ always only wait, even if enemy in melee range | TRoam -- ^ if enemy nearby, attack, if no items, etc., roam randomly | TPatrol -- ^ find an open and uncrowded area, patrol it according -- to sight radius and fallback temporarily to @TRoam@ -- when enemy is seen by the faction and is within -- the actor's sight radius deriving (Show, Eq, Ord, Enum, Bounded, Generic) instance Binary Tactic instance Hashable Tactic -- | AI and UI hints about the role of the item. data EqpSlot = EqpSlotMove | EqpSlotMelee | EqpSlotDisplace | EqpSlotAlter | EqpSlotWait | EqpSlotMoveItem | EqpSlotProject | EqpSlotApply | EqpSlotSwimming | EqpSlotFlying | EqpSlotHurtMelee | EqpSlotArmorMelee | EqpSlotArmorRanged | EqpSlotMaxHP | EqpSlotSpeed | EqpSlotSight | EqpSlotShine | EqpSlotMiscBonus | EqpSlotWeaponFast | EqpSlotWeaponBig deriving (Show, Eq, Ord, Enum, Bounded, Generic) instance Binary Skill where put = putWord8 . toEnum . fromEnum get = fmap (toEnum . fromEnum) getWord8 instance Binary Flag where put = putWord8 . toEnum . fromEnum get = fmap (toEnum . fromEnum) getWord8 instance Binary EqpSlot where put = putWord8 . toEnum . fromEnum get = fmap (toEnum . fromEnum) getWord8 instance Hashable Skill instance Hashable Flag instance Hashable EqpSlot getSk :: Skill -> Skills -> Int {-# INLINE getSk #-} getSk sk (Skills skills) = EM.findWithDefault 0 sk skills addSk :: Skill -> Int -> Skills -> Skills addSk sk n = addSkills (Skills $ EM.singleton sk n) checkFl :: Flag -> Flags -> Bool {-# INLINE checkFl #-} checkFl flag (Flags flags) = flag `ES.member` flags skillsToList :: Skills -> [(Skill, Int)] skillsToList (Skills sk) = EM.assocs sk zeroSkills :: Skills zeroSkills = Skills EM.empty compactSkills :: EM.EnumMap Skill Int -> EM.EnumMap Skill Int compactSkills = EM.filter (/= 0) addSkills :: Skills -> Skills -> Skills addSkills (Skills sk1) (Skills sk2) = Skills $ compactSkills $ EM.unionWith (+) sk1 sk2 scaleSkills :: Int -> EM.EnumMap Skill Int -> EM.EnumMap Skill Int scaleSkills n = EM.map (n *) sumScaledSkills :: [(Skills, Int)] -> Skills sumScaledSkills l = Skills $ compactSkills $ EM.unionsWith (+) $ map (\(Skills sk, k) -> scaleSkills k sk) l nameTactic :: Tactic -> Text nameTactic TExplore = "explore" nameTactic TFollow = "follow freely" nameTactic TFollowNoItems = "follow only" nameTactic TMeleeAndRanged = "fight only" nameTactic TMeleeAdjacent = "melee only" nameTactic TBlock = "block only" nameTactic TRoam = "roam freely" nameTactic TPatrol = "patrol area" describeTactic :: Tactic -> Text describeTactic TExplore = "investigate unknown positions, chase targets" describeTactic TFollow = "follow leader's target or position, grab items" describeTactic TFollowNoItems = "follow leader's target or position, ignore items" describeTactic TMeleeAndRanged = "engage in both melee and ranged combat, don't move" describeTactic TMeleeAdjacent = "engage exclusively in melee, don't move" describeTactic TBlock = "block and wait, don't move" describeTactic TRoam = "move freely, chase targets" describeTactic TPatrol = "find and patrol an area (WIP)" tacticSkills :: Tactic -> Skills tacticSkills TExplore = zeroSkills tacticSkills TFollow = zeroSkills tacticSkills TFollowNoItems = ignoreItems tacticSkills TMeleeAndRanged = meleeAndRanged tacticSkills TMeleeAdjacent = meleeAdjacent tacticSkills TBlock = blockOnly tacticSkills TRoam = zeroSkills tacticSkills TPatrol = zeroSkills minusTen, blockOnly, meleeAdjacent, meleeAndRanged, ignoreItems :: Skills -- To make sure only a lot of weak items can override move-only-leader, etc. minusTen = Skills $ EM.fromDistinctAscList $ zip [SkMove .. SkApply] (repeat (-10)) blockOnly = Skills $ EM.delete SkWait $ skills minusTen meleeAdjacent = Skills $ EM.delete SkMelee $ skills blockOnly -- Melee and reaction fire. meleeAndRanged = Skills $ EM.delete SkProject $ skills meleeAdjacent ignoreItems = Skills $ EM.fromList $ zip [SkMoveItem, SkProject, SkApply] (repeat (-10)) LambdaHack-0.9.5.0/definition-src/Game/LambdaHack/Definition/Color.hs0000644000000000000000000001552507346545000023272 0ustar0000000000000000{-# LANGUAGE DeriveGeneric, GeneralizedNewtypeDeriving, MagicHash, TypeFamilies #-} -- | Colours and text attributes. module Game.LambdaHack.Definition.Color ( -- * Colours Color(..) , defFG, isBright, darkCol, brightCol, stdCol, legalFgCol, colorToRGB -- * Complete text attributes , Highlight (..), Attr(..) , highlightToColor, defAttr -- * Characters with attributes , AttrChar(..), AttrCharW32(..) , attrCharToW32, attrCharFromW32 , fgFromW32, bgFromW32, charFromW32, attrFromW32, attrEnumFromW32 , spaceAttrW32, retAttrW32, attrChar2ToW32, attrChar1ToW32 ) where import Prelude () import Game.LambdaHack.Core.Prelude import Control.DeepSeq import Data.Binary import Data.Bits (unsafeShiftL, unsafeShiftR, (.&.)) import qualified Data.Char as Char import Data.Hashable (Hashable) import Data.Word (Word32) import GHC.Exts (Int (I#)) import GHC.Generics (Generic) import GHC.Prim (int2Word#) import GHC.Word (Word32 (W32#)) -- | Colours supported by the major frontends. data Color = Black | Red | Green | Brown | Blue | Magenta | Cyan | White | AltWhite -- only use for frontend hacks | BrBlack | BrRed | BrGreen | BrYellow | BrBlue | BrMagenta | BrCyan | BrWhite deriving (Show, Read, Eq, Ord, Enum, Generic) instance Binary Color where put = putWord8 . toEnum . fromEnum get = fmap (toEnum . fromEnum) getWord8 instance Hashable Color instance NFData Color -- | The default colours, to optimize attribute setting. defFG :: Color defFG = White -- | A helper for the terminal frontends that display bright via bold. isBright :: Color -> Bool isBright c = c > BrBlack -- | Colour sets. darkCol, brightCol, stdCol, legalFgCol :: [Color] darkCol = [Red .. Cyan] brightCol = [BrRed .. BrCyan] -- BrBlack is not really that bright stdCol = darkCol ++ brightCol legalFgCol = White : BrWhite : BrBlack : stdCol -- | Translationg to heavily modified Linux console color RGB values. -- -- Warning: SDL frontend sadly duplicates this code. colorToRGB :: Color -> Text colorToRGB Black = "#000000" colorToRGB Red = "#D50505" colorToRGB Green = "#059D05" colorToRGB Brown = "#CA4A05" colorToRGB Blue = "#0556F4" colorToRGB Magenta = "#AF0EAF" colorToRGB Cyan = "#059696" colorToRGB White = "#B8BFCB" colorToRGB AltWhite = "#C4BEB1" colorToRGB BrBlack = "#6F5F5F" colorToRGB BrRed = "#FF5555" colorToRGB BrGreen = "#65F136" colorToRGB BrYellow = "#EBD642" colorToRGB BrBlue = "#4D98F4" colorToRGB BrMagenta = "#FF77FF" colorToRGB BrCyan = "#52F4E5" colorToRGB BrWhite = "#FFFFFF" -- | For reference, the original Linux console colors. -- Good old retro feel and more useful than xterm (e.g. brown). _olorToRGB :: Color -> Text _olorToRGB Black = "#000000" _olorToRGB Red = "#AA0000" _olorToRGB Green = "#00AA00" _olorToRGB Brown = "#AA5500" _olorToRGB Blue = "#0000AA" _olorToRGB Magenta = "#AA00AA" _olorToRGB Cyan = "#00AAAA" _olorToRGB White = "#AAAAAA" _olorToRGB AltWhite = "#AAAAAA" _olorToRGB BrBlack = "#555555" _olorToRGB BrRed = "#FF5555" _olorToRGB BrGreen = "#55FF55" _olorToRGB BrYellow = "#FFFF55" _olorToRGB BrBlue = "#5555FF" _olorToRGB BrMagenta = "#FF55FF" _olorToRGB BrCyan = "#55FFFF" _olorToRGB BrWhite = "#FFFFFF" -- | Additional map cell highlight, e.g., a colorful square around the cell -- or a colorful background. -- -- Note: the highlight underscored by the terminal cursor is -- the maximal element of this type present of this screen. data Highlight = HighlightNone | HighlightGreen | HighlightBlue | HighlightGrey | HighlightWhite | HighlightMagenta | HighlightRed | HighlightYellow | HighlightYellowAim | HighlightRedAim | HighlightNoneCursor deriving (Show, Eq, Ord, Enum, Bounded, Generic) highlightToColor :: Highlight -> Color highlightToColor hi = case hi of HighlightNone -> Black -- should be transparent, but is OK in web frontend HighlightGreen -> Green HighlightBlue -> Blue HighlightGrey -> BrBlack HighlightWhite -> White -- bright, but no saturation, so doesn't obscure HighlightMagenta -> BrMagenta -- usually around white, so bright is fine HighlightRed -> Red HighlightYellow -> BrYellow -- obscures, but mostly used around bright white HighlightYellowAim -> BrYellow HighlightRedAim -> Red HighlightNoneCursor -> Black -- | Text attributes: foreground color and highlight. data Attr = Attr { fg :: Color -- ^ foreground colour , bg :: Highlight -- ^ highlight } deriving (Show, Eq, Ord) -- | The default attribute, to optimize attribute setting. defAttr :: Attr defAttr = Attr defFG HighlightNone -- | Character to display, with its attribute. data AttrChar = AttrChar { acAttr :: Attr , acChar :: Char } deriving (Show, Eq, Ord) -- This implementation is faster than @Int@, because some vector updates -- can be done without going to and from @Int@. -- | Optimized representation of 'AttrChar'. newtype AttrCharW32 = AttrCharW32 {attrCharW32 :: Word32} deriving (Show, Eq, Ord, Enum, Binary) attrCharToW32 :: AttrChar -> AttrCharW32 attrCharToW32 AttrChar{acAttr=Attr{..}, acChar} = AttrCharW32 $ toEnum $ unsafeShiftL (fromEnum fg) 8 + fromEnum bg + unsafeShiftL (Char.ord acChar) 16 attrCharFromW32 :: AttrCharW32 -> AttrChar attrCharFromW32 !w = AttrChar (attrFromW32 w) (charFromW32 w) fgFromW32 :: AttrCharW32 -> Color {-# INLINE fgFromW32 #-} fgFromW32 w = toEnum $ unsafeShiftR (fromEnum $ attrCharW32 w) 8 .&. (2 ^ (8 :: Int) - 1) bgFromW32 :: AttrCharW32 -> Highlight {-# INLINE bgFromW32 #-} bgFromW32 w = toEnum $ fromEnum $ attrCharW32 w .&. (2 ^ (8 :: Int) - 1) charFromW32 :: AttrCharW32 -> Char {-# INLINE charFromW32 #-} charFromW32 w = Char.chr $ unsafeShiftR (fromEnum $ attrCharW32 w) 16 attrFromW32 :: AttrCharW32 -> Attr {-# INLINE attrFromW32 #-} attrFromW32 w = Attr (fgFromW32 w) (bgFromW32 w) attrEnumFromW32 :: AttrCharW32 -> Int {-# INLINE attrEnumFromW32 #-} attrEnumFromW32 !w = fromEnum $ attrCharW32 w .&. (2 ^ (16 :: Int) - 1) spaceAttrW32 :: AttrCharW32 spaceAttrW32 = attrCharToW32 $ AttrChar defAttr ' ' retAttrW32 :: AttrCharW32 retAttrW32 = attrCharToW32 $ AttrChar defAttr '\n' attrChar2ToW32 :: Color -> Char -> AttrCharW32 {-# INLINE attrChar2ToW32 #-} attrChar2ToW32 fg acChar = case unsafeShiftL (fromEnum fg) 8 + unsafeShiftL (Char.ord acChar) 16 of I# i -> AttrCharW32 $ W32# (int2Word# i) {- the hacks save one allocation (?) (before fits-in-32bits check) compared to AttrCharW32 $ toEnum $ unsafeShiftL (fromEnum fg) 8 + unsafeShiftL (Char.ord acChar) 16 -} attrChar1ToW32 :: Char -> AttrCharW32 {-# INLINE attrChar1ToW32 #-} attrChar1ToW32 = let fgNum = unsafeShiftL (fromEnum White) 8 in \acChar -> case fgNum + unsafeShiftL (Char.ord acChar) 16 of I# i -> AttrCharW32 $ W32# (int2Word# i) LambdaHack-0.9.5.0/definition-src/Game/LambdaHack/Definition/ContentData.hs0000644000000000000000000001537307346545000024421 0ustar0000000000000000-- | A game requires the engine provided by the library, perhaps customized, -- and game content, defined completely afresh for the particular game. -- The possible kinds of content are fixed in the library and all defined -- within the library source code directory. On the other hand, game content, -- is defined in the directory hosting the particular game definition. -- -- Content of a given kind is just a list of content items. -- After the list is verified and the data preprocessed, it's held -- in the @ContentData@ datatype. module Game.LambdaHack.Definition.ContentData ( ContentData , validateRarity, validFreqs , emptyContentData, makeContentData , okind, omemberGroup, oisSingletonGroup, ouniqGroup, opick , ofoldlWithKey', ofoldlGroup', omapVector, oimapVector, olength ) where import Prelude () import Game.LambdaHack.Core.Prelude import Data.Function import qualified Data.Map.Strict as M import qualified Data.Text as T import qualified Data.Vector as V import Game.LambdaHack.Core.Frequency import Game.LambdaHack.Core.Random import Game.LambdaHack.Definition.Defs -- | Verified and preprocessed content data of a particular kind. data ContentData c = ContentData { contentVector :: V.Vector c , groupFreq :: M.Map (GroupName c) [(Int, (ContentId c, c))] } maxContentId :: ContentId k maxContentId = toContentId maxBound validateRarity :: Rarity -> [Text] validateRarity rarity = let sortedRarity = sortOn fst rarity in [ "rarity not sorted" | sortedRarity /= rarity ] ++ [ "rarity depth thresholds not unique" | map head (groupBy ((==) `on` fst) sortedRarity) /= sortedRarity ] ++ [ "rarity depth not between 0 and 10" | case (sortedRarity, reverse sortedRarity) of ((lowest, _) : _, (highest, _) : _) -> lowest <= 0 || highest > 10 _ -> False ] validFreqs :: Freqs a -> Bool validFreqs freqs = all ((> 0) . snd) freqs && let groups = sort $ map fst freqs in all (uncurry (/=)) $ zip groups ("" : groups) -- this also catches empty group names emptyContentData :: ContentData a emptyContentData = ContentData V.empty M.empty makeContentData :: Show c => String -> (c -> Text) -- ^ name of the content itme, used for validation -> (c -> Freqs c) -- ^ frequency in groups, for validation and preprocessing -> (c -> [Text]) -- ^ validate a content item and list all offences -> ([c] -> ContentData c -> [Text]) -- ^ validate the whole defined content of this type -- and list all offence -> [c] -- ^ all content of this type -> ContentData c {-# INLINE makeContentData #-} makeContentData contentName getName getFreq validateSingle validateAll content = -- The @force@ is needed for @GHC.Compact@. let contentVector = V.force $ V.fromList content groupFreq = let tuples = [ (cgroup, (n, (i, k))) | (i, k) <- zip (map toContentId [0..]) content , (cgroup, n) <- getFreq k , n > 0 ] f !m (!cgroup, !nik) = M.insertWith (++) cgroup [nik] m in foldl' f M.empty tuples contentData = ContentData {..} singleOffenders = [ (offences, a) | a <- content , let offences = validateSingle a ++ ["empty name" | T.null (getName a)] , not (null offences) ] allOffences = validateAll content contentData freqsOffenders = filter (not . validFreqs . getFreq) content in assert (null freqsOffenders `blame` contentName ++ ": some Freqs values not valid" `swith` freqsOffenders) $ assert (null singleOffenders `blame` contentName ++ ": some content items not valid" `swith` singleOffenders) $ assert (null allOffences `blame` contentName ++ ": the content set is not valid" `swith` allOffences) $ assert (V.length contentVector <= contentIdIndex maxContentId `blame` contentName ++ ": the content has too many elements") contentData -- | Content element at given id. okind :: ContentData a -> ContentId a -> a {-# INLINE okind #-} okind ContentData{contentVector} !i = contentVector V.! contentIdIndex i omemberGroup :: ContentData a -> GroupName a -> Bool omemberGroup ContentData{groupFreq} cgroup = cgroup `M.member` groupFreq oisSingletonGroup :: ContentData a -> GroupName a -> Bool oisSingletonGroup ContentData{groupFreq} cgroup = case M.lookup cgroup groupFreq of Just [_] -> True _ -> False -- | The id of the unique member of a singleton content group. ouniqGroup :: Show a => ContentData a -> GroupName a -> ContentId a ouniqGroup ContentData{groupFreq} !cgroup = let freq = let assFail = error $ "no unique group" `showFailure` (cgroup, groupFreq) in M.findWithDefault assFail cgroup groupFreq in case freq of [(n, (i, _))] | n > 0 -> i l -> error $ "not unique" `showFailure` (cgroup, l) -- | Pick a random id belonging to a group and satisfying a predicate. opick :: Show a => ContentData a -> GroupName a -> (a -> Bool) -> Rnd (Maybe (ContentId a)) opick ContentData{groupFreq} !cgroup !p = case M.lookup cgroup groupFreq of Just freqRaw -> let freq = toFreq "opick" $ filter (p . snd . snd) freqRaw in if nullFreq freq then return Nothing else Just . fst <$> frequency freq _ -> return Nothing -- | Fold strictly over all content @a@. ofoldlWithKey' :: ContentData a -> (b -> ContentId a -> a -> b) -> b -> b ofoldlWithKey' ContentData{contentVector} f z = V.ifoldl' (\ !a !i !c -> f a (toContentId $ toEnum i) c) z contentVector -- | Fold over the given group only. ofoldlGroup' :: ContentData a -> GroupName a -> (b -> Int -> ContentId a -> a -> b) -> b -> b ofoldlGroup' ContentData{groupFreq} cgroup f z = case M.lookup cgroup groupFreq of Just freq -> foldl' (\ !acc (!p, (!i, !a)) -> f acc p i a) z freq _ -> error $ "no group '" ++ show cgroup ++ "' among content that has groups " ++ show (M.keys groupFreq) `showFailure` () omapVector :: ContentData a -> (a -> b) -> V.Vector b omapVector d f = V.map f $ contentVector d oimapVector :: ContentData a -> (ContentId a -> a -> b) -> V.Vector b oimapVector d f = V.imap (\i a -> f (toContentId $ toEnum i) a) $ contentVector d -- | Size of content @a@. olength :: ContentData a -> Int olength ContentData{contentVector} = V.length contentVector LambdaHack-0.9.5.0/definition-src/Game/LambdaHack/Definition/Defs.hs0000644000000000000000000001231007346545000023062 0ustar0000000000000000{-# LANGUAGE DeriveGeneric, GeneralizedNewtypeDeriving, TypeFamilies #-} -- | Basic types for content definitions. module Game.LambdaHack.Definition.Defs ( X, Y , GroupName, toGroupName, fromGroupName , Freqs, Rarity, linearInterpolation , ContentId, toContentId, fromContentId, contentIdIndex , CStore(..), ppCStore, ppCStoreIn, verbCStore , SLore(..), ItemDialogMode(..), ppSLore, headingSLore , ppItemDialogMode, ppItemDialogModeIn, ppItemDialogModeFrom ) where import Prelude () import Game.LambdaHack.Core.Prelude import Control.DeepSeq import Data.Binary import Data.Hashable import Data.String (IsString (..)) import qualified Data.Text as T import GHC.Generics (Generic) -- | X spacial dimension for points and vectors. type X = Int -- | Y xpacial dimension for points and vectors. type Y = Int -- If ever needed, we can use a symbol table here, since content -- is never serialized. But we'd need to cover the few cases -- (e.g., @litemFreq@) where @GroupName@ goes into savegame. newtype GroupName a = GroupName {fromGroupName :: Text} deriving (Show, Eq, Ord, Hashable, Binary, Generic) instance IsString (GroupName a) where fromString = GroupName . T.pack instance NFData (GroupName a) toGroupName :: Text -> GroupName a {-# INLINE toGroupName #-} toGroupName = GroupName -- | For each group that the kind belongs to, denoted by a @GroupName@ -- in the first component of a pair, the second component of a pair shows -- how common the kind is within the group. type Freqs a = [(GroupName a, Int)] -- | Rarity on given depths. type Rarity = [(Double, Int)] -- We assume @dataset@ is sorted and between 0 and 10. linearInterpolation :: Int -> Int -> Rarity -> Int linearInterpolation !levelDepth !totalDepth !dataset = let findInterval :: (Double, Int) -> Rarity -> ((Double, Int), (Double, Int)) findInterval x1y1 [] = (x1y1, (11, 0)) findInterval !x1y1 ((!x, !y) : rest) = if fromIntegral levelDepth * 10 <= x * fromIntegral totalDepth then (x1y1, (x, y)) else findInterval (x, y) rest ((x1, y1), (x2, y2)) = findInterval (0, 0) dataset in ceiling $ fromIntegral y1 + fromIntegral (y2 - y1) * (fromIntegral levelDepth * 10 - x1 * fromIntegral totalDepth) / ((x2 - x1) * fromIntegral totalDepth) -- | Content identifiers for the content type @c@. newtype ContentId c = ContentId Word16 deriving (Show, Eq, Ord, Enum, Binary, Generic) instance Hashable (ContentId c) toContentId :: Word16 -> ContentId c {-# INLINE toContentId #-} toContentId = ContentId fromContentId :: ContentId c -> Word16 {-# INLINE fromContentId #-} fromContentId (ContentId k) = k contentIdIndex :: ContentId k -> Int {-# INLINE contentIdIndex #-} contentIdIndex (ContentId k) = fromEnum k -- | Actor's item stores. data CStore = CGround | COrgan | CEqp | CInv | CSha deriving (Show, Read, Eq, Ord, Enum, Bounded, Generic) instance Binary CStore instance NFData CStore ppCStore :: CStore -> (Text, Text) ppCStore CGround = ("on", "the ground") ppCStore COrgan = ("in", "body") ppCStore CEqp = ("in", "equipment") ppCStore CInv = ("in", "pack") -- "inventory pack" overflows text too easily ppCStore CSha = ("in", "shared stash") ppCStoreIn :: CStore -> Text ppCStoreIn c = let (tIn, t) = ppCStore c in tIn <+> t verbCStore :: CStore -> Text verbCStore CGround = "drop" verbCStore COrgan = "implant" verbCStore CEqp = "equip" verbCStore CInv = "pack" verbCStore CSha = "stash" -- | Item slot and lore categories. data SLore = SItem | SOrgan | STrunk | SCondition | SBlast | SEmbed deriving (Show, Read, Eq, Ord, Enum, Bounded, Generic) instance Binary SLore instance NFData SLore data ItemDialogMode = MStore CStore -- ^ a leader's store | MOrgans -- ^ leader's organs | MOwned -- ^ all party's items | MSkills -- ^ not items, but determined by leader's items | MLore SLore -- ^ not party's items, but all known generalized items | MPlaces -- ^ not items at all, but definitely a lore deriving (Show, Read, Eq, Ord, Generic) instance NFData ItemDialogMode instance Binary ItemDialogMode ppSLore :: SLore -> Text ppSLore SItem = "item" ppSLore SOrgan = "organ" ppSLore STrunk = "creature" ppSLore SCondition = "condition" ppSLore SBlast = "blast" ppSLore SEmbed = "terrain" headingSLore :: SLore -> Text headingSLore SItem = "miscellaneous item" headingSLore SOrgan = "vital anatomic organ" headingSLore STrunk = "living creature" headingSLore SCondition = "momentary bodily condition" headingSLore SBlast = "explosion blast particle" headingSLore SEmbed = "landmark feature" ppItemDialogMode :: ItemDialogMode -> (Text, Text) ppItemDialogMode (MStore cstore) = ppCStore cstore ppItemDialogMode MOrgans = ("in", "body") ppItemDialogMode MOwned = ("in", "our possession") ppItemDialogMode MSkills = ("among", "skills") ppItemDialogMode (MLore slore) = ("among", ppSLore slore <+> "lore") ppItemDialogMode MPlaces = ("among", "place lore") ppItemDialogModeIn :: ItemDialogMode -> Text ppItemDialogModeIn c = let (tIn, t) = ppItemDialogMode c in tIn <+> t ppItemDialogModeFrom :: ItemDialogMode -> Text ppItemDialogModeFrom c = let (_tIn, t) = ppItemDialogMode c in "from" <+> t LambdaHack-0.9.5.0/definition-src/Game/LambdaHack/Definition/Flavour.hs0000644000000000000000000001276107346545000023631 0ustar0000000000000000{-# LANGUAGE DeriveGeneric #-} -- | The appearance of in-game items, as communicated to the player. module Game.LambdaHack.Definition.Flavour ( -- * The @Flavour@ type Flavour(Flavour) , -- * Constructors zipPlain, zipFancy, zipLiquid, zipGlassPlain, zipGlassFancy , -- * Accessors flavourToColor, flavourToName -- * Assorted , colorToPlainName, colorToFancyName, colorToTeamName #ifdef EXPOSE_INTERNAL -- * Internal operations , FancyName, colorToLiquidName, colorToGlassPlainName, colorToGlassFancyName #endif ) where import Prelude () import Game.LambdaHack.Core.Prelude import Data.Binary import Data.Bits (unsafeShiftL, unsafeShiftR, (.&.)) import Data.Hashable (Hashable (hashWithSalt), hashUsing) import GHC.Generics (Generic) import Game.LambdaHack.Definition.Color data FancyName = Plain | Fancy | Liquid | GlassPlain | GlassFancy deriving (Show, Eq, Ord, Enum, Bounded, Generic) -- | The type of item flavours. data Flavour = Flavour { fancyName :: FancyName -- ^ how fancy should the colour description be , baseColor :: Color -- ^ the colour of the flavour } deriving (Show, Eq, Ord, Generic) instance Enum Flavour where fromEnum Flavour{..} = unsafeShiftL (fromEnum fancyName) 8 + fromEnum baseColor toEnum n = Flavour (toEnum $ unsafeShiftR n 8) (toEnum $ n .&. (2 ^ (8 :: Int) - 1)) instance Hashable Flavour where hashWithSalt = hashUsing fromEnum instance Binary Flavour where put = put . (fromIntegral :: Int -> Word16) . fromEnum get = fmap (toEnum . (fromIntegral :: Word16 -> Int)) get -- | Turn a colour set into a flavour set. zipPlain, zipFancy, zipLiquid, zipGlassPlain, zipGlassFancy :: [Color] -> [Flavour] zipPlain = map (Flavour Plain) zipFancy = map (Flavour Fancy) zipLiquid = map (Flavour Liquid) zipGlassPlain = map (Flavour GlassPlain) zipGlassFancy = map (Flavour GlassFancy) -- | Get the underlying base colour of a flavour. flavourToColor :: Flavour -> Color flavourToColor Flavour{baseColor} = baseColor -- | Construct the full name of a flavour. flavourToName :: Flavour -> Text flavourToName Flavour{fancyName=Plain, ..} = colorToPlainName baseColor flavourToName Flavour{fancyName=Fancy, ..} = colorToFancyName baseColor flavourToName Flavour{fancyName=Liquid, ..} = colorToLiquidName baseColor flavourToName Flavour{fancyName=GlassPlain, ..} = colorToGlassPlainName baseColor flavourToName Flavour{fancyName=GlassFancy, ..} = colorToGlassFancyName baseColor -- | Human-readable names for item colors. The plain set. colorToPlainName :: Color -> Text colorToPlainName Black = "black" colorToPlainName Red = "red" colorToPlainName Green = "green" colorToPlainName Brown = "brown" colorToPlainName Blue = "blue" colorToPlainName Magenta = "purple" colorToPlainName Cyan = "cyan" colorToPlainName White = "ivory" colorToPlainName AltWhite = error "colorToPlainName: illegal color" colorToPlainName BrBlack = "gray" colorToPlainName BrRed = "coral" colorToPlainName BrGreen = "lime" colorToPlainName BrYellow = "yellow" colorToPlainName BrBlue = "azure" colorToPlainName BrMagenta = "pink" colorToPlainName BrCyan = "aquamarine" colorToPlainName BrWhite = "white" -- | Human-readable names for item colors. The fancy set. colorToFancyName :: Color -> Text colorToFancyName Black = "smoky-black" colorToFancyName Red = "apple-red" colorToFancyName Green = "forest-green" colorToFancyName Brown = "mahogany" colorToFancyName Blue = "royal-blue" colorToFancyName Magenta = "indigo" colorToFancyName Cyan = "teal" colorToFancyName White = "silver-gray" colorToFancyName AltWhite = error "colorToFancyName: illegal color" colorToFancyName BrBlack = "charcoal" colorToFancyName BrRed = "salmon" colorToFancyName BrGreen = "emerald" colorToFancyName BrYellow = "amber" colorToFancyName BrBlue = "sky-blue" colorToFancyName BrMagenta = "magenta" colorToFancyName BrCyan = "turquoise" colorToFancyName BrWhite = "ghost-white" -- | Human-readable names for item colors. The liquid set. colorToLiquidName :: Color -> Text colorToLiquidName Black = "tarry" colorToLiquidName Red = "bloody" colorToLiquidName Green = "moldy" colorToLiquidName Brown = "muddy" colorToLiquidName Blue = "oily" colorToLiquidName Magenta = "swirling" colorToLiquidName Cyan = "bubbling" colorToLiquidName White = "cloudy" colorToLiquidName AltWhite = error "colorToLiquidName: illegal color" colorToLiquidName BrBlack = "pitchy" colorToLiquidName BrRed = "red-speckled" colorToLiquidName BrGreen = "sappy" colorToLiquidName BrYellow = "golden" colorToLiquidName BrBlue = "blue-speckled" colorToLiquidName BrMagenta = "hazy" colorToLiquidName BrCyan = "misty" colorToLiquidName BrWhite = "shining" -- | Human-readable names for item colors. The plain glass set. colorToGlassPlainName :: Color -> Text colorToGlassPlainName color = colorToPlainName color <+> "glass" -- | Human-readable names for item colors. The fancy glass set. colorToGlassFancyName :: Color -> Text colorToGlassFancyName color = colorToFancyName color <+> "crystal" -- | Simple names for team colors (bright colours preferred). colorToTeamName :: Color -> Text colorToTeamName BrBlack = "black" colorToTeamName BrRed = "red" colorToTeamName BrGreen = "green" colorToTeamName BrYellow = "yellow" colorToTeamName BrBlue = "blue" colorToTeamName BrMagenta = "pink" colorToTeamName BrCyan = "cyan" colorToTeamName BrWhite = "white" colorToTeamName c = colorToFancyName c LambdaHack-0.9.5.0/engine-src/Game/LambdaHack/0000755000000000000000000000000007346545000016675 5ustar0000000000000000LambdaHack-0.9.5.0/engine-src/Game/LambdaHack/Atomic.hs0000644000000000000000000000157507346545000020455 0ustar0000000000000000-- | Atomic game state transformations, their representation and semantics. -- -- See -- . module Game.LambdaHack.Atomic ( -- * Re-exported from "Game.LambdaHack.Atomic.CmdAtomic" CmdAtomic(..), UpdAtomic(..), HearMsg(..), SfxAtomic(..), SfxMsg(..) -- * Re-exported from "Game.LambdaHack.Atomic.HandleAtomicWrite" , handleUpdAtomic -- * Re-exported from "Game.LambdaHack.Atomic.PosAtomicRead" , PosAtomic(..), posUpdAtomic, posSfxAtomic, breakUpdAtomic , seenAtomicCli, seenAtomicSer -- * Re-exported from "Game.LambdaHack.Atomic.MonadStateWrite" , MonadStateWrite(..), AtomicFail(..) ) where import Prelude () import Game.LambdaHack.Atomic.CmdAtomic import Game.LambdaHack.Atomic.HandleAtomicWrite import Game.LambdaHack.Atomic.MonadStateWrite import Game.LambdaHack.Atomic.PosAtomicRead LambdaHack-0.9.5.0/engine-src/Game/LambdaHack/Atomic/0000755000000000000000000000000007346545000020111 5ustar0000000000000000LambdaHack-0.9.5.0/engine-src/Game/LambdaHack/Atomic/CmdAtomic.hs0000644000000000000000000002730707346545000022316 0ustar0000000000000000-- | A set of atomic commands shared by client and server. -- These are the largest building blocks that have no components -- that can be observed in isolation. -- -- We try to make atomic commands respect the laws of energy and mass -- conservation, unless they really can't, e.g., monster spawning. -- For example item removal from inventory is not an atomic command, -- but item dropped from the inventory to the ground is. This makes -- it easier to undo the commands. In principle, the commands are the only -- way to affect the basic game state ('State'). -- -- See -- . module Game.LambdaHack.Atomic.CmdAtomic ( CmdAtomic(..), UpdAtomic(..), HearMsg(..), SfxAtomic(..), SfxMsg(..) , undoUpdAtomic, undoSfxAtomic, undoCmdAtomic ) where import Prelude () import Game.LambdaHack.Core.Prelude import Data.Int (Int64) import qualified System.Random as R -- Dependence on ClientOptions is an anomaly. Instead, probably the raw -- remaining commandline should be passed and parsed by the client to extract -- client and ui options from and singnal an error if anything was left. import Game.LambdaHack.Client.ClientOptions import Game.LambdaHack.Common.Actor import Game.LambdaHack.Common.Analytics import Game.LambdaHack.Common.Faction import Game.LambdaHack.Common.Item import qualified Game.LambdaHack.Common.ItemAspect as IA import Game.LambdaHack.Common.Perception import Game.LambdaHack.Common.Point import Game.LambdaHack.Common.ReqFailure import Game.LambdaHack.Common.State import Game.LambdaHack.Common.Time import Game.LambdaHack.Common.Types import Game.LambdaHack.Common.Vector import Game.LambdaHack.Content.ItemKind (ItemKind) import qualified Game.LambdaHack.Content.ItemKind as IK import qualified Game.LambdaHack.Content.PlaceKind as PK import Game.LambdaHack.Content.TileKind (TileKind) import qualified Game.LambdaHack.Core.Dice as Dice import qualified Game.LambdaHack.Definition.Ability as Ability import Game.LambdaHack.Definition.Defs -- | Abstract syntax of atomic commands, that is, atomic game state -- transformations. data CmdAtomic = UpdAtomic UpdAtomic -- ^ atomic updates | SfxAtomic SfxAtomic -- ^ atomic special effects deriving Show -- deriving (Show, Eq, Generic) -- -- instance Binary CmdAtomic -- | Abstract syntax of atomic updates, that is, atomic commands -- that really change the 'State'. Most of them are an encoding of a game -- state diff, though they also carry some intentional hints -- that help clients determine whether and how to communicate it to players. data UpdAtomic = -- Create/destroy actors and items. UpdCreateActor ActorId Actor [(ItemId, Item)] | UpdDestroyActor ActorId Actor [(ItemId, Item)] | UpdCreateItem ItemId Item ItemQuant Container | UpdDestroyItem ItemId Item ItemQuant Container | UpdSpotActor ActorId Actor [(ItemId, Item)] | UpdLoseActor ActorId Actor [(ItemId, Item)] | UpdSpotItem Bool ItemId Item ItemQuant Container | UpdLoseItem Bool ItemId Item ItemQuant Container | UpdSpotItemBag Container ItemBag [(ItemId, Item)] | UpdLoseItemBag Container ItemBag [(ItemId, Item)] -- Move actors and items. | UpdMoveActor ActorId Point Point | UpdWaitActor ActorId Watchfulness Watchfulness | UpdDisplaceActor ActorId ActorId | UpdMoveItem ItemId Int ActorId CStore CStore -- Change actor attributes. | UpdRefillHP ActorId Int64 | UpdRefillCalm ActorId Int64 | UpdTrajectory ActorId (Maybe ([Vector], Speed)) (Maybe ([Vector], Speed)) -- Change faction attributes. | UpdQuitFaction FactionId (Maybe Status) (Maybe Status) (Maybe (FactionAnalytics, GenerationAnalytics)) | UpdLeadFaction FactionId (Maybe ActorId) (Maybe ActorId) | UpdDiplFaction FactionId FactionId Diplomacy Diplomacy | UpdTacticFaction FactionId Ability.Tactic Ability.Tactic | UpdAutoFaction FactionId Bool | UpdRecordKill ActorId (ContentId ItemKind) Int -- Alter map. | UpdAlterTile LevelId Point (ContentId TileKind) (ContentId TileKind) | UpdAlterExplorable LevelId Int | UpdAlterGold Int | UpdSearchTile ActorId Point (ContentId TileKind) | UpdHideTile ActorId Point (ContentId TileKind) | UpdSpotTile LevelId [(Point, ContentId TileKind)] | UpdLoseTile LevelId [(Point, ContentId TileKind)] | UpdSpotEntry LevelId [(Point, PK.PlaceEntry)] | UpdLoseEntry LevelId [(Point, PK.PlaceEntry)] | UpdAlterSmell LevelId Point Time Time | UpdSpotSmell LevelId [(Point, Time)] | UpdLoseSmell LevelId [(Point, Time)] -- Assorted. | UpdTimeItem ItemId Container ItemTimer ItemTimer | UpdAgeGame [LevelId] | UpdUnAgeGame [LevelId] | UpdDiscover Container ItemId (ContentId ItemKind) IA.AspectRecord | UpdCover Container ItemId (ContentId ItemKind) IA.AspectRecord | UpdDiscoverKind Container ItemKindIx (ContentId ItemKind) | UpdCoverKind Container ItemKindIx (ContentId ItemKind) | UpdDiscoverAspect Container ItemId IA.AspectRecord | UpdCoverAspect Container ItemId IA.AspectRecord | UpdDiscoverServer ItemId IA.AspectRecord | UpdCoverServer ItemId IA.AspectRecord | UpdPerception LevelId Perception Perception | UpdRestart FactionId PerLid State Challenge ClientOptions R.StdGen | UpdRestartServer State | UpdResume FactionId PerLid | UpdResumeServer State | UpdKillExit FactionId | UpdWriteSave | UpdHearFid FactionId HearMsg -- in @UpdAtomic@ to let AI analyze and count deriving Show -- | Symbolic representation of text messages about heard noises, -- sent by server to clients and shown to players and used by AI. data HearMsg = HearUpd Bool UpdAtomic | HearStrike (ContentId ItemKind) | HearSummon Bool (GroupName ItemKind) Dice.Dice | HearTaunt Text deriving Show -- | Abstract syntax of atomic special effects, that is, atomic commands -- that only display special effects and don't change 'State' nor client state. data SfxAtomic = SfxStrike ActorId ActorId ItemId CStore | SfxRecoil ActorId ActorId ItemId CStore | SfxSteal ActorId ActorId ItemId CStore | SfxRelease ActorId ActorId ItemId CStore | SfxProject ActorId ItemId CStore | SfxReceive ActorId ItemId CStore | SfxApply ActorId ItemId CStore | SfxCheck ActorId ItemId CStore | SfxTrigger ActorId Point | SfxShun ActorId Point | SfxEffect FactionId ActorId IK.Effect Int64 | SfxMsgFid FactionId SfxMsg | SfxRestart | SfxCollideTile ActorId Point | SfxTaunt Bool ActorId deriving Show -- | Symbolic representation of text messages sent by server to clients -- and shown to players. data SfxMsg = SfxUnexpected ReqFailure | SfxExpected Text ReqFailure | SfxFizzles | SfxNothingHappens | SfxVoidDetection IK.DetectKind | SfxUnimpressed ActorId | SfxSummonLackCalm ActorId | SfxSummonTooManyOwn ActorId | SfxSummonTooManyAll ActorId | SfxSummonFailure ActorId | SfxLevelNoMore | SfxLevelPushed | SfxBracedImmune ActorId | SfxEscapeImpossible | SfxStasisProtects | SfxWaterParalysisResisted | SfxTransImpossible | SfxIdentifyNothing | SfxPurposeNothing | SfxPurposeTooFew Int Int | SfxPurposeUnique | SfxPurposeNotCommon | SfxRerollNothing | SfxRerollNotRandom | SfxDupNothing | SfxDupUnique | SfxDupValuable | SfxColdFish | SfxTimerExtended LevelId ActorId ItemId CStore (Delta Time) | SfxCollideActor LevelId ActorId ActorId deriving Show undoUpdAtomic :: UpdAtomic -> Maybe UpdAtomic undoUpdAtomic cmd = case cmd of UpdCreateActor aid body ais -> Just $ UpdDestroyActor aid body ais UpdDestroyActor aid body ais -> Just $ UpdCreateActor aid body ais UpdCreateItem iid item k c -> Just $ UpdDestroyItem iid item k c UpdDestroyItem iid item k c -> Just $ UpdCreateItem iid item k c UpdSpotActor aid body ais -> Just $ UpdLoseActor aid body ais UpdLoseActor aid body ais -> Just $ UpdSpotActor aid body ais UpdSpotItem verbose iid item k c -> Just $ UpdLoseItem verbose iid item k c UpdLoseItem verbose iid item k c -> Just $ UpdSpotItem verbose iid item k c UpdSpotItemBag c bag ais -> Just $ UpdLoseItemBag c bag ais UpdLoseItemBag c bag ais -> Just $ UpdSpotItemBag c bag ais UpdMoveActor aid fromP toP -> Just $ UpdMoveActor aid toP fromP UpdWaitActor aid fromWS toWS -> Just $ UpdWaitActor aid toWS fromWS UpdDisplaceActor source target -> Just $ UpdDisplaceActor target source UpdMoveItem iid k aid c1 c2 -> Just $ UpdMoveItem iid k aid c2 c1 UpdRefillHP aid n -> Just $ UpdRefillHP aid (-n) UpdRefillCalm aid n -> Just $ UpdRefillCalm aid (-n) UpdTrajectory aid fromT toT -> Just $ UpdTrajectory aid toT fromT UpdQuitFaction fid fromSt toSt manalytics -> Just $ UpdQuitFaction fid toSt fromSt manalytics UpdLeadFaction fid source target -> Just $ UpdLeadFaction fid target source UpdDiplFaction fid1 fid2 fromDipl toDipl -> Just $ UpdDiplFaction fid1 fid2 toDipl fromDipl UpdTacticFaction fid toT fromT -> Just $ UpdTacticFaction fid fromT toT UpdAutoFaction fid st -> Just $ UpdAutoFaction fid (not st) UpdRecordKill aid ikind k -> Just $ UpdRecordKill aid ikind (-k) UpdAlterTile lid p fromTile toTile -> Just $ UpdAlterTile lid p toTile fromTile UpdAlterExplorable lid delta -> Just $ UpdAlterExplorable lid (-delta) UpdAlterGold delta -> Just $ UpdAlterGold (-delta) UpdSearchTile aid p toTile -> Just $ UpdHideTile aid p toTile UpdHideTile aid p toTile -> Just $ UpdSearchTile aid p toTile UpdSpotTile lid ts -> Just $ UpdLoseTile lid ts UpdLoseTile lid ts -> Just $ UpdSpotTile lid ts UpdSpotEntry lid ts -> Just $ UpdLoseEntry lid ts UpdLoseEntry lid ts -> Just $ UpdSpotEntry lid ts UpdAlterSmell lid p fromSm toSm -> Just $ UpdAlterSmell lid p toSm fromSm UpdSpotSmell lid sms -> Just $ UpdLoseSmell lid sms UpdLoseSmell lid sms -> Just $ UpdSpotSmell lid sms UpdTimeItem iid c fromIt toIt -> Just $ UpdTimeItem iid c toIt fromIt UpdAgeGame lids -> Just $ UpdUnAgeGame lids UpdUnAgeGame lids -> Just $ UpdAgeGame lids UpdDiscover c iid ik arItem -> Just $ UpdCover c iid ik arItem UpdCover c iid ik arItem -> Just $ UpdDiscover c iid ik arItem UpdDiscoverKind c ix ik -> Just $ UpdCoverKind c ix ik UpdCoverKind c ix ik -> Just $ UpdDiscoverKind c ix ik UpdDiscoverAspect c iid arItem -> Just $ UpdCoverAspect c iid arItem UpdCoverAspect c iid arItem -> Just $ UpdDiscoverAspect c iid arItem UpdDiscoverServer iid arItem -> Just $ UpdCoverServer iid arItem UpdCoverServer iid arItem -> Just $ UpdDiscoverServer iid arItem UpdPerception lid outPer inPer -> Just $ UpdPerception lid inPer outPer UpdRestart{} -> Just cmd -- here history ends; change direction UpdRestartServer{} -> Just cmd -- here history ends; change direction UpdResume{} -> Nothing UpdResumeServer{} -> Nothing UpdKillExit{} -> Nothing UpdWriteSave -> Nothing UpdHearFid{} -> Nothing undoSfxAtomic :: SfxAtomic -> SfxAtomic undoSfxAtomic cmd = case cmd of SfxStrike source target iid cstore -> SfxRecoil source target iid cstore SfxRecoil source target iid cstore -> SfxStrike source target iid cstore SfxSteal source target iid cstore -> SfxRelease source target iid cstore SfxRelease source target iid cstore -> SfxSteal source target iid cstore SfxProject aid iid cstore -> SfxReceive aid iid cstore SfxReceive aid iid cstore -> SfxProject aid iid cstore SfxApply aid iid cstore -> SfxCheck aid iid cstore SfxCheck aid iid cstore -> SfxApply aid iid cstore SfxTrigger aid p -> SfxShun aid p SfxShun aid p -> SfxTrigger aid p SfxEffect{} -> cmd -- not ideal? SfxMsgFid{} -> cmd SfxRestart -> cmd SfxCollideTile{} -> cmd SfxTaunt{} -> cmd undoCmdAtomic :: CmdAtomic -> Maybe CmdAtomic undoCmdAtomic (UpdAtomic cmd) = UpdAtomic <$> undoUpdAtomic cmd undoCmdAtomic (SfxAtomic sfx) = Just $ SfxAtomic $ undoSfxAtomic sfx LambdaHack-0.9.5.0/engine-src/Game/LambdaHack/Atomic/HandleAtomicWrite.hs0000644000000000000000000007440107346545000024016 0ustar0000000000000000{-# LANGUAGE FlexibleContexts #-} -- | Semantics of atomic commands shared by client and server. -- -- See -- . module Game.LambdaHack.Atomic.HandleAtomicWrite ( handleUpdAtomic #ifdef EXPOSE_INTERNAL -- * Internal operations , updCreateActor, updDestroyActor, updCreateItem, updDestroyItem , updSpotItemBag, updLoseItemBag , updMoveActor, updWaitActor, updDisplaceActor, updMoveItem , updRefillHP, updRefillCalm , updTrajectory, updQuitFaction, updLeadFaction , updDiplFaction, updTacticFaction, updAutoFaction, updRecordKill , updAlterTile, updAlterExplorable, updSearchTile, updSpotTile, updLoseTile , updAlterSmell, updSpotSmell, updLoseSmell, updTimeItem , updAgeGame, updUnAgeGame, ageLevel, updDiscover, updCover , updDiscoverKind, discoverKind, updCoverKind , updDiscoverAspect, discoverAspect, updCoverAspect , updDiscoverServer, updCoverServer , updRestart, updRestartServer, updResumeServer #endif ) where import Prelude () import Game.LambdaHack.Core.Prelude import qualified Data.EnumMap.Strict as EM import Data.Int (Int64) import Game.LambdaHack.Atomic.CmdAtomic import Game.LambdaHack.Atomic.MonadStateWrite import Game.LambdaHack.Common.Actor import Game.LambdaHack.Common.ActorState import Game.LambdaHack.Common.Faction import Game.LambdaHack.Common.Item import qualified Game.LambdaHack.Common.ItemAspect as IA import Game.LambdaHack.Common.Kind import Game.LambdaHack.Common.Level import Game.LambdaHack.Common.MonadStateRead import Game.LambdaHack.Common.Perception import Game.LambdaHack.Common.State import qualified Game.LambdaHack.Common.Tile as Tile import Game.LambdaHack.Common.Time import Game.LambdaHack.Common.Types import Game.LambdaHack.Common.Vector import Game.LambdaHack.Content.ItemKind (ItemKind) import Game.LambdaHack.Content.ModeKind import qualified Game.LambdaHack.Content.PlaceKind as PK import Game.LambdaHack.Content.TileKind (TileKind, unknownId) import Game.LambdaHack.Common.Point import qualified Game.LambdaHack.Common.PointArray as PointArray import qualified Game.LambdaHack.Definition.Ability as Ability import Game.LambdaHack.Definition.Defs -- | The game-state semantics of atomic game commands. -- There is no corresponding definition for special effects (@SfxAtomic@), -- because they don't modify 'State'. -- -- For each of the commands, we are guaranteed that the client, -- the command is addressed to, perceives all the positions the command -- affects (as computed by 'Game.LambdaHack.Atomic.PosAtomicRead.posUpdAtomic'). -- In the code for each semantic function we additonally verify -- the client is aware of any relevant items and/or actors and we throw -- the @AtomicFail@ exception if it's not. -- The server keeps copies of all clients' states and, before sending a command -- to a client, applies it to the client's state copy. -- If @AtomicFail@ is signalled, the command is ignored for that client. -- This enables simpler server code that addresses commands to all clients -- that can see it, even though not all are able to process it. handleUpdAtomic :: MonadStateWrite m => UpdAtomic -> m () handleUpdAtomic cmd = case cmd of UpdCreateActor aid body ais -> updCreateActor aid body ais UpdDestroyActor aid body ais -> updDestroyActor aid body ais UpdCreateItem iid item kit c -> updCreateItem iid item kit c UpdDestroyItem iid item kit c -> updDestroyItem iid item kit c UpdSpotActor aid body ais -> updCreateActor aid body ais UpdLoseActor aid body ais -> updDestroyActor aid body ais UpdSpotItem _ iid item kit c -> updCreateItem iid item kit c UpdLoseItem _ iid item kit c -> updDestroyItem iid item kit c UpdSpotItemBag c bag ais -> updSpotItemBag c bag ais UpdLoseItemBag c bag ais -> updLoseItemBag c bag ais UpdMoveActor aid fromP toP -> updMoveActor aid fromP toP UpdWaitActor aid fromWS toWS -> updWaitActor aid fromWS toWS UpdDisplaceActor source target -> updDisplaceActor source target UpdMoveItem iid k aid c1 c2 -> updMoveItem iid k aid c1 c2 UpdRefillHP aid n -> updRefillHP aid n UpdRefillCalm aid n -> updRefillCalm aid n UpdTrajectory aid fromT toT -> updTrajectory aid fromT toT UpdQuitFaction fid fromSt toSt _ -> updQuitFaction fid fromSt toSt UpdLeadFaction fid source target -> updLeadFaction fid source target UpdDiplFaction fid1 fid2 fromDipl toDipl -> updDiplFaction fid1 fid2 fromDipl toDipl UpdTacticFaction fid toT fromT -> updTacticFaction fid toT fromT UpdAutoFaction fid st -> updAutoFaction fid st UpdRecordKill aid ikind k -> updRecordKill aid ikind k UpdAlterTile lid p fromTile toTile -> updAlterTile lid p fromTile toTile UpdAlterExplorable lid delta -> updAlterExplorable lid delta UpdAlterGold delta -> updAlterGold delta UpdSearchTile aid p toTile -> updSearchTile aid p toTile UpdHideTile{} -> undefined UpdSpotTile lid ts -> updSpotTile lid ts UpdLoseTile lid ts -> updLoseTile lid ts UpdSpotEntry lid ts -> updSpotEntry lid ts UpdLoseEntry lid ts -> updLoseEntry lid ts UpdAlterSmell lid p fromSm toSm -> updAlterSmell lid p fromSm toSm UpdSpotSmell lid sms -> updSpotSmell lid sms UpdLoseSmell lid sms -> updLoseSmell lid sms UpdTimeItem iid c fromIt toIt -> updTimeItem iid c fromIt toIt UpdAgeGame lids -> updAgeGame lids UpdUnAgeGame lids -> updUnAgeGame lids UpdDiscover c iid ik arItem -> updDiscover c iid ik arItem UpdCover c iid ik arItem -> updCover c iid ik arItem UpdDiscoverKind c ix ik -> updDiscoverKind c ix ik UpdCoverKind c ix ik -> updCoverKind c ix ik UpdDiscoverAspect c iid arItem -> updDiscoverAspect c iid arItem UpdCoverAspect c iid arItem -> updCoverAspect c iid arItem UpdDiscoverServer iid arItem -> updDiscoverServer iid arItem UpdCoverServer iid arItem -> updCoverServer iid arItem UpdPerception _ outPer inPer -> assert (not (nullPer outPer && nullPer inPer)) (return ()) UpdRestart _ _ s _ _ _ -> updRestart s UpdRestartServer s -> updRestartServer s UpdResume{} -> return () UpdResumeServer s -> updResumeServer s UpdKillExit{} -> return () UpdWriteSave -> return () UpdHearFid{} -> return () -- Note: after this command, usually a new leader -- for the party should be elected (in case this actor is the only one alive). updCreateActor :: MonadStateWrite m => ActorId -> Actor -> [(ItemId, Item)] -> m () updCreateActor aid body ais = do -- The exception is possible, e.g., when we teleport and so see our actor -- at the new location, but also the location is part of new perception, -- so @UpdSpotActor@ is sent. let f Nothing = Just body f (Just b) = assert (body == b `blame` (aid, body, b)) $ atomicFail $ "actor already added" `showFailure` (aid, body, b) modifyState $ updateActorD $ EM.alter f aid let g Nothing = Just [aid] g (Just l) = #ifdef WITH_EXPENSIVE_ASSERTIONS -- Not so much expensive, as doubly impossible. assert (aid `notElem` l `blame` "actor already added" `swith` (aid, body, l)) #endif (Just $ aid : l) let h Nothing = Just aid h (Just aid2) = error $ "an actor already present there" `showFailure` (aid, body, aid2) updateLevel (blid body) $ if bproj body then updateProjMap (EM.alter g (bpos body)) else updateBigMap (EM.alter h (bpos body)) addAis ais actorMaxSk <- getsState $ maxSkillsFromActor body modifyState $ updateActorMaxSkills $ EM.insert aid actorMaxSk -- If a leader dies, a new leader should be elected on the server -- before this command is executed (not checked). updDestroyActor :: MonadStateWrite m => ActorId -> Actor -> [(ItemId, Item)] -> m () updDestroyActor aid body ais = do -- Assert that actor's items belong to @sitemD@. Do not remove those -- that do not appear anywhere else, for simplicity and speed. itemD <- getsState sitemD let match (iid, item) = itemsMatch (itemD EM.! iid) item let !_A = assert (allB match ais `blame` "destroyed actor items not found" `swith` (aid, body, ais, itemD)) () -- Remove actor from @sactorD@. let f Nothing = error $ "actor already removed" `showFailure` (aid, body) f (Just b) = assert (b == body `blame` "inconsistent destroyed actor body" `swith` (aid, body, b)) Nothing modifyState $ updateActorD $ EM.alter f aid let g Nothing = error $ "actor already removed" `showFailure` (aid, body) g (Just l) = #ifdef WITH_EXPENSIVE_ASSERTIONS -- Not so much expensive, as doubly impossible. assert (aid `elem` l `blame` "actor already removed" `swith` (aid, body, l)) #endif (let l2 = delete aid l in if null l2 then Nothing else Just l2) let h Nothing = error $ "actor already removed" `showFailure` (aid, body) h (Just _aid2) = #ifdef WITH_EXPENSIVE_ASSERTIONS -- Not so much expensive, as doubly impossible. assert (aid == _aid2 `blame` "actor already removed" `swith` (aid, body, _aid2)) #endif Nothing updateLevel (blid body) $ if bproj body then updateProjMap (EM.alter g (bpos body)) else updateBigMap (EM.alter h (bpos body)) modifyState $ updateActorMaxSkills $ EM.delete aid -- Create a few copies of an item that is already registered for the dungeon -- (in @sitemRev@ field of @StateServer@). -- -- Number of copies may be zero, when the item is only created as a sample -- to let the player know what can potentially be genereated in the dungeon. updCreateItem :: MonadStateWrite m => ItemId -> Item -> ItemQuant -> Container -> m () updCreateItem iid item kit@(k, _) c = do addAis [(iid, item)] when (k > 0) $ do insertItemContainer iid kit c case c of CActor aid store -> when (store `elem` [CEqp, COrgan]) $ addItemToActorMaxSkills iid item k aid _ -> return () -- Destroy some copies (possibly not all) of an item. updDestroyItem :: MonadStateWrite m => ItemId -> Item -> ItemQuant -> Container -> m () updDestroyItem iid item kit@(k, _) c = assert (k > 0) $ do deleteItemContainer iid kit c -- Do not remove the item from @sitemD@ nor from @sitemRev@ -- nor from @DiscoveryAspect@, @ItemIxMap@, etc. -- It's incredibly costly and not particularly noticeable for the player. -- Moreover, copies of the item may reappear in the future -- and then we save computation and the player remembers past discovery. -- However, assert the item is registered in @sitemD@. itemD <- getsState sitemD let !_A = assert ((case iid `EM.lookup` itemD of Nothing -> False Just item0 -> itemsMatch item0 item) `blame` "item already removed" `swith` (iid, item, itemD)) () case c of CActor aid store -> when (store `elem` [CEqp, COrgan]) $ addItemToActorMaxSkills iid item (-k) aid _ -> return () updSpotItemBag :: MonadStateWrite m => Container -> ItemBag -> [(ItemId, Item)] -> m () updSpotItemBag c bag ais = do addAis ais -- The case of empty bag is for a hack to help identifying sample items. when (not $ EM.null bag) $ do let !_A = assert (EM.size bag == length ais) () insertBagContainer bag c case c of CActor aid store -> when (store `elem` [CEqp, COrgan]) $ forM_ ais $ \(iid, item) -> addItemToActorMaxSkills iid item (fst $ bag EM.! iid) aid _ -> return () updLoseItemBag :: MonadStateWrite m => Container -> ItemBag -> [(ItemId, Item)] -> m () updLoseItemBag c bag ais = assert (EM.size bag > 0 && EM.size bag == length ais) $ do deleteBagContainer bag c -- Do not remove the items from @sitemD@ nor from @sitemRev@, -- It's incredibly costly and not noticeable for the player. -- However, assert the items are registered in @sitemD@. itemD <- getsState sitemD let match (iid, item) = itemsMatch (itemD EM.! iid) item let !_A = assert (allB match ais `blame` "items already removed" `swith` (c, bag, ais, itemD)) () case c of CActor aid store -> when (store `elem` [CEqp, COrgan]) $ forM_ ais $ \(iid, item) -> addItemToActorMaxSkills iid item (- (fst $ bag EM.! iid)) aid _ -> return () updMoveActor :: MonadStateWrite m => ActorId -> Point -> Point -> m () updMoveActor aid fromP toP = assert (fromP /= toP) $ do body <- getsState $ getActorBody aid let !_A = assert (fromP == bpos body `blame` "unexpected moved actor position" `swith` (aid, fromP, toP, bpos body, body)) () newBody = body {bpos = toP, boldpos = Just fromP} updateActor aid $ const newBody moveActorMap aid body newBody updWaitActor :: MonadStateWrite m => ActorId -> Watchfulness -> Watchfulness -> m () updWaitActor aid fromWS toWS = assert (fromWS /= toWS) $ do body <- getsState $ getActorBody aid let !_A = assert (fromWS == bwatch body `blame` "unexpected actor wait state" `swith` (aid, fromWS, bwatch body, body)) () updateActor aid $ \b -> b {bwatch = toWS} updDisplaceActor :: MonadStateWrite m => ActorId -> ActorId -> m () updDisplaceActor source target = assert (source /= target) $ do sbody <- getsState $ getActorBody source tbody <- getsState $ getActorBody target let spos = bpos sbody tpos = bpos tbody snewBody = sbody {bpos = tpos, boldpos = Just spos} tnewBody = tbody {bpos = spos, boldpos = Just tpos} updateActor source $ const snewBody updateActor target $ const tnewBody swapActorMap source sbody target tbody updMoveItem :: MonadStateWrite m => ItemId -> Int -> ActorId -> CStore -> CStore -> m () updMoveItem iid k aid s1 s2 = assert (k > 0 && s1 /= s2) $ do b <- getsState $ getActorBody aid bag <- getsState $ getBodyStoreBag b s1 case iid `EM.lookup` bag of Nothing -> error $ "" `showFailure` (iid, k, aid, s1, s2) Just (_, it) -> do deleteItemActor iid (k, take k it) aid s1 insertItemActor iid (k, take k it) aid s2 case s1 of CEqp -> case s2 of COrgan -> return () _ -> do itemBase <- getsState $ getItemBody iid addItemToActorMaxSkills iid itemBase (-k) aid COrgan -> case s2 of CEqp -> return () _ -> do itemBase <- getsState $ getItemBody iid addItemToActorMaxSkills iid itemBase (-k) aid _ -> when (s2 `elem` [CEqp, COrgan]) $ do itemBase <- getsState $ getItemBody iid addItemToActorMaxSkills iid itemBase k aid updRefillHP :: MonadStateWrite m => ActorId -> Int64 -> m () updRefillHP aid nRaw = updateActor aid $ \b -> -- Make rescue easier by not going into negative HP the first time. let newRawHP = bhp b + nRaw newHP = if bhp b <= 0 then newRawHP else max 0 newRawHP n = newHP - bhp b in b { bhp = newHP , bhpDelta = let oldD = bhpDelta b in case compare n 0 of EQ -> ResDelta { resCurrentTurn = (0, 0) , resPreviousTurn = resCurrentTurn oldD } LT -> oldD {resCurrentTurn = ( fst (resCurrentTurn oldD) + n , snd (resCurrentTurn oldD) )} GT -> oldD {resCurrentTurn = ( fst (resCurrentTurn oldD) , snd (resCurrentTurn oldD) + n )} } updRefillCalm :: MonadStateWrite m => ActorId -> Int64 -> m () updRefillCalm aid n = updateActor aid $ \b -> b { bcalm = max 0 $ bcalm b + n , bcalmDelta = let oldD = bcalmDelta b in case compare n 0 of EQ -> ResDelta { resCurrentTurn = (0, 0) , resPreviousTurn = resCurrentTurn oldD } LT -> oldD {resCurrentTurn = ( fst (resCurrentTurn oldD) + n , snd (resCurrentTurn oldD) )} GT -> oldD {resCurrentTurn = ( fst (resCurrentTurn oldD) , snd (resCurrentTurn oldD) + n )} } updTrajectory :: MonadStateWrite m => ActorId -> Maybe ([Vector], Speed) -> Maybe ([Vector], Speed) -> m () updTrajectory aid fromT toT = assert (fromT /= toT) $ do body <- getsState $ getActorBody aid let !_A = assert (fromT == btrajectory body `blame` "unexpected actor trajectory" `swith` (aid, fromT, toT, body)) () updateActor aid $ \b -> b {btrajectory = toT} updQuitFaction :: MonadStateWrite m => FactionId -> Maybe Status -> Maybe Status -> m () updQuitFaction fid fromSt toSt = do let !_A = assert (fromSt /= toSt `blame` (fid, fromSt, toSt)) () fact <- getsState $ (EM.! fid) . sfactionD let !_A = assert (fromSt == gquit fact `blame` "unexpected actor quit status" `swith` (fid, fromSt, toSt, fact)) () let adj fa = fa {gquit = toSt} updateFaction fid adj -- The previous leader is assumed to be alive. updLeadFaction :: MonadStateWrite m => FactionId -> Maybe ActorId -> Maybe ActorId -> m () updLeadFaction fid source target = assert (source /= target) $ do fact <- getsState $ (EM.! fid) . sfactionD let !_A = assert (fleaderMode (gplayer fact) /= LeaderNull) () -- @PosNone@ ensures this mtb <- getsState $ \s -> flip getActorBody s <$> target let !_A = assert (maybe True (not . bproj) mtb `blame` (fid, source, target, mtb, fact)) () let !_A = assert (source == gleader fact `blame` "unexpected actor leader" `swith` (fid, source, target, mtb, fact)) () let adj fa = fa {_gleader = target} updateFaction fid adj updDiplFaction :: MonadStateWrite m => FactionId -> FactionId -> Diplomacy -> Diplomacy -> m () updDiplFaction fid1 fid2 fromDipl toDipl = assert (fid1 /= fid2 && fromDipl /= toDipl) $ do fact1 <- getsState $ (EM.! fid1) . sfactionD fact2 <- getsState $ (EM.! fid2) . sfactionD let !_A = assert (fromDipl == EM.findWithDefault Unknown fid2 (gdipl fact1) && fromDipl == EM.findWithDefault Unknown fid1 (gdipl fact2) `blame` "unexpected actor diplomacy status" `swith` (fid1, fid2, fromDipl, toDipl, fact1, fact2)) () let adj fid fact = fact {gdipl = EM.insert fid toDipl (gdipl fact)} updateFaction fid1 (adj fid2) updateFaction fid2 (adj fid1) updTacticFaction :: MonadStateWrite m => FactionId -> Ability.Tactic -> Ability.Tactic -> m () updTacticFaction fid toT fromT = do let adj fact = let player = gplayer fact in assert (ftactic player == fromT) $ fact {gplayer = player {ftactic = toT}} updateFaction fid adj updAutoFaction :: MonadStateWrite m => FactionId -> Bool -> m () updAutoFaction fid st = updateFaction fid (\fact -> assert (isAIFact fact == not st) $ fact {gplayer = automatePlayer st (gplayer fact)}) -- Record a given number (usually just 1, or -1 for undo) of actor kills -- for score calculation. updRecordKill :: MonadStateWrite m => ActorId -> ContentId ItemKind -> Int -> m () updRecordKill aid ikind k = do b <- getsState $ getActorBody aid let !_A = assert (not (bproj b) `blame` (aid, b)) let alterKind mn = let n = fromMaybe 0 mn + k in if n == 0 then Nothing else Just n adjFact fact = fact {gvictims = EM.alter alterKind ikind $ gvictims fact} updateFaction (bfid b) adjFact -- The death of a dominated actor counts as the dominating faction's loss -- for score purposes, so human nor AI can't treat such actor as disposable, -- which means domination will not be as cruel, as frustrating, -- as it could be and there is a higher chance of getting back alive -- the actor, the human player has grown attached to. -- Alter an attribute (actually, the only, the defining attribute) -- of a visible tile. This is similar to e.g., @UpdTrajectory@. -- -- Removing and creating embedded items when altering a tile -- is done separately via @UpdCreateItem@ and @UpdDestroyItem@. updAlterTile :: MonadStateWrite m => LevelId -> Point -> ContentId TileKind -> ContentId TileKind -> m () updAlterTile lid p fromTile toTile = assert (fromTile /= toTile) $ do COps{coTileSpeedup} <- getsState scops lvl <- getLevel lid let t = lvl `at` p if t /= fromTile then atomicFail "tile to alter is different than assumed" else do let adj ts = ts PointArray.// [(p, toTile)] updateLevel lid $ updateTile adj case ( Tile.isExplorable coTileSpeedup fromTile , Tile.isExplorable coTileSpeedup toTile ) of (False, True) -> updateLevel lid $ \lvl2 -> lvl2 {lseen = lseen lvl + 1} (True, False) -> updateLevel lid $ \lvl2 -> lvl2 {lseen = lseen lvl - 1} _ -> return () updAlterExplorable :: MonadStateWrite m => LevelId -> Int -> m () updAlterExplorable lid delta = assert (delta /= 0) $ updateLevel lid $ \lvl -> lvl {lexpl = lexpl lvl + delta} updAlterGold :: MonadStateWrite m => Int -> m () updAlterGold delta = assert (delta /= 0) $ modifyState $ updateGold (+ delta) -- Showing to the client the embedded items, if any, is done elsewhere. updSearchTile :: MonadStateWrite m => ActorId -> Point -> ContentId TileKind -> m () updSearchTile aid p toTile = do COps{cotile} <- getsState scops b <- getsState $ getActorBody aid lvl <- getLevel $ blid b let t = lvl `at` p if t == toTile then atomicFail "tile already searched" else assert (Just t == Tile.hideAs cotile toTile) $ do updLoseTile (blid b) [(p, t)] updSpotTile (blid b) [(p, toTile)] -- not the hidden version this one time -- Notice previously invisible tiles. This is done in bulk, -- because it often involves dozens of tiles per move. -- We verify that the old tiles at the positions in question -- are indeed unknown. updSpotTile :: MonadStateWrite m => LevelId -> [(Point, ContentId TileKind)] -> m () updSpotTile lid ts = assert (not $ null ts) $ do COps{coTileSpeedup} <- getsState scops let unk tileMap (p, _) = tileMap PointArray.! p == unknownId adj tileMap = assert (all (unk tileMap) ts) $ tileMap PointArray.// ts updateLevel lid $ updateTile adj let f (_, t1) = when (Tile.isExplorable coTileSpeedup t1) $ updateLevel lid $ \lvl -> lvl {lseen = lseen lvl + 1} mapM_ f ts -- Stop noticing previously visible tiles. It verifies -- the state of the tiles before wiping them out. updLoseTile :: MonadStateWrite m => LevelId -> [(Point, ContentId TileKind)] -> m () updLoseTile lid ts = assert (not $ null ts) $ do COps{coTileSpeedup} <- getsState scops let matches tileMap (p, ov) = tileMap PointArray.! p == ov tu = map (second (const unknownId)) ts adj tileMap = assert (all (matches tileMap) ts) $ tileMap PointArray.// tu updateLevel lid $ updateTile adj let f (_, t1) = when (Tile.isExplorable coTileSpeedup t1) $ updateLevel lid $ \lvl -> lvl {lseen = lseen lvl - 1} mapM_ f ts updSpotEntry :: MonadStateWrite m => LevelId -> [(Point, PK.PlaceEntry)] -> m () updSpotEntry lid ts = assert (not $ null ts) $ do let alt en Nothing = Just en alt en (Just oldEn) = atomicFail $ "entry already added" `showFailure` (lid, ts, en, oldEn) f (p, en) = EM.alter (alt en) p upd m = foldr f m ts updateLevel lid $ updateEntry upd updLoseEntry :: MonadStateWrite m => LevelId -> [(Point, PK.PlaceEntry)] -> m () updLoseEntry lid ts = assert (not $ null ts) $ do let alt en Nothing = error $ "entry already removed" `showFailure` (lid, ts, en) alt en (Just oldEn) = assert (en == oldEn `blame` "unexpected lost entry" `swith` (lid, ts, en, oldEn)) Nothing f (p, en) = EM.alter (alt en) p upd m = foldr f m ts updateLevel lid $ updateEntry upd updAlterSmell :: MonadStateWrite m => LevelId -> Point -> Time -> Time -> m () updAlterSmell lid p fromSm' toSm' = do let fromSm = if fromSm' == timeZero then Nothing else Just fromSm' toSm = if toSm' == timeZero then Nothing else Just toSm' alt sm = assert (sm == fromSm `blame` "unexpected tile smell" `swith` (lid, p, fromSm, toSm, sm)) toSm updateLevel lid $ updateSmell $ EM.alter alt p updSpotSmell :: MonadStateWrite m => LevelId -> [(Point, Time)] -> m () updSpotSmell lid sms = assert (not $ null sms) $ do let alt sm Nothing = Just sm alt sm (Just oldSm) = error $ "smell already added" `showFailure` (lid, sms, sm, oldSm) f (p, sm) = EM.alter (alt sm) p upd m = foldr f m sms updateLevel lid $ updateSmell upd updLoseSmell :: MonadStateWrite m => LevelId -> [(Point, Time)] -> m () updLoseSmell lid sms = assert (not $ null sms) $ do let alt sm Nothing = error $ "smell already removed" `showFailure` (lid, sms, sm) alt sm (Just oldSm) = assert (sm == oldSm `blame` "unexpected lost smell" `swith` (lid, sms, sm, oldSm)) Nothing f (p, sm) = EM.alter (alt sm) p upd m = foldr f m sms updateLevel lid $ updateSmell upd updTimeItem :: MonadStateWrite m => ItemId -> Container -> ItemTimer -> ItemTimer -> m () updTimeItem iid c fromIt toIt = assert (fromIt /= toIt) $ do bag <- getsState $ getContainerBag c case iid `EM.lookup` bag of Just (k, it) -> do let !_A = assert (fromIt == it `blame` (k, it, iid, c, fromIt, toIt)) () deleteItemContainer iid (k, fromIt) c insertItemContainer iid (k, toIt) c Nothing -> error $ "" `showFailure` (bag, iid, c, fromIt, toIt) updAgeGame :: MonadStateWrite m => [LevelId] -> m () updAgeGame lids = do modifyState $ updateTime $ flip timeShift (Delta timeClip) mapM_ (ageLevel (Delta timeClip)) lids updUnAgeGame :: MonadStateWrite m => [LevelId] -> m () updUnAgeGame lids = do modifyState $ updateTime $ flip timeShift (timeDeltaReverse $ Delta timeClip) mapM_ (ageLevel (timeDeltaReverse $ Delta timeClip)) lids ageLevel :: MonadStateWrite m => Delta Time -> LevelId -> m () ageLevel delta lid = updateLevel lid $ \lvl -> lvl {ltime = timeShift (ltime lvl) delta} updDiscover :: MonadStateWrite m => Container -> ItemId -> ContentId ItemKind -> IA.AspectRecord -> m () updDiscover _c iid ik arItem = do itemD <- getsState sitemD COps{coItemSpeedup} <- getsState scops let kmIsConst = IA.kmConst $ getKindMean ik coItemSpeedup discoKind <- getsState sdiscoKind let discoverAtMostAspect = do discoAspect <- getsState sdiscoAspect if kmIsConst || iid `EM.member` discoAspect then atomicFail "item already fully discovered" else discoverAspect iid arItem case EM.lookup iid itemD of Nothing -> atomicFail "discovered item unheard of" Just item -> case jkind item of IdentityObvious _ -> discoverAtMostAspect IdentityCovered ix _ik -> case EM.lookup ix discoKind of Just{} -> discoverAtMostAspect Nothing -> do discoverKind ix ik unless kmIsConst $ discoverAspect iid arItem resetActorMaxSkills updCover :: Container -> ItemId -> ContentId ItemKind -> IA.AspectRecord -> m () updCover _c _iid _ik _arItem = undefined updDiscoverKind :: MonadStateWrite m => Container -> ItemKindIx -> ContentId ItemKind -> m () updDiscoverKind _c ix kmKind = do discoKind <- getsState sdiscoKind if ix `EM.member` discoKind then atomicFail "item kind already discovered" else do discoverKind ix kmKind resetActorMaxSkills discoverKind :: MonadStateWrite m => ItemKindIx -> ContentId ItemKind -> m () discoverKind ix kindId = do let f Nothing = Just kindId f Just{} = error $ "already discovered" `showFailure` (ix, kindId) modifyState $ updateDiscoKind $ \discoKind1 -> EM.alter f ix discoKind1 updCoverKind :: Container -> ItemKindIx -> ContentId ItemKind -> m () updCoverKind _c _ix _ik = undefined updDiscoverAspect :: MonadStateWrite m => Container -> ItemId -> IA.AspectRecord -> m () updDiscoverAspect _c iid arItem = do COps{coItemSpeedup} <- getsState scops itemD <- getsState sitemD case EM.lookup iid itemD of Nothing -> atomicFail "discovered item unheard of" Just item -> do -- Here the kind information is exact, hence @getItemKindIdServer@. kindId <- getsState $ getItemKindIdServer item discoAspect <- getsState sdiscoAspect let kmIsConst = IA.kmConst $ getKindMean kindId coItemSpeedup if kmIsConst || iid `EM.member` discoAspect then atomicFail "item arItem already discovered" else do discoverAspect iid arItem resetActorMaxSkills discoverAspect :: MonadStateWrite m => ItemId -> IA.AspectRecord -> m () discoverAspect iid arItem = do let f Nothing = Just arItem f Just{} = error $ "already discovered" `showFailure` (iid, arItem) -- At this point we know the item is not @kmConst@. modifyState $ updateDiscoAspect $ \discoAspect1 -> EM.alter f iid discoAspect1 updCoverAspect :: Container -> ItemId -> IA.AspectRecord -> m () updCoverAspect _c _iid _arItem = undefined updDiscoverServer :: MonadStateWrite m => ItemId -> IA.AspectRecord -> m () updDiscoverServer iid arItem = modifyState $ updateDiscoAspect $ \discoAspect1 -> EM.insert iid arItem discoAspect1 updCoverServer :: MonadStateWrite m => ItemId -> IA.AspectRecord -> m () updCoverServer iid arItem = modifyState $ updateDiscoAspect $ \discoAspect1 -> assert (discoAspect1 EM.! iid == arItem) $ EM.delete iid discoAspect1 updRestart :: MonadStateWrite m => State -> m () updRestart = putState updRestartServer :: MonadStateWrite m => State -> m () updRestartServer = putState updResumeServer :: MonadStateWrite m => State -> m () updResumeServer = putState LambdaHack-0.9.5.0/engine-src/Game/LambdaHack/Atomic/MonadStateWrite.hs0000644000000000000000000003624107346545000023525 0ustar0000000000000000-- | The monad for writing to the main game state. module Game.LambdaHack.Atomic.MonadStateWrite ( MonadStateWrite(..), AtomicFail(..), atomicFail , updateLevel, updateActor, updateFaction , moveActorMap, swapActorMap , insertBagContainer, insertItemContainer, insertItemActor , deleteBagContainer, deleteItemContainer, deleteItemActor , addAis, itemsMatch, addItemToActorMaxSkills, resetActorMaxSkills #ifdef EXPOSE_INTERNAL -- * Internal operations , insertItemFloor, insertItemEmbed , insertItemOrgan, insertItemEqp, insertItemInv, insertItemSha , deleteItemFloor, deleteItemEmbed , deleteItemOrgan, deleteItemEqp, deleteItemInv, deleteItemSha , rmFromBag #endif ) where import Prelude () import Game.LambdaHack.Core.Prelude import qualified Control.Exception as Ex import qualified Data.EnumMap.Strict as EM import qualified Data.EnumSet as ES import Data.Key (mapWithKeyM_) import Game.LambdaHack.Common.Actor import Game.LambdaHack.Common.ActorState import Game.LambdaHack.Common.Faction import Game.LambdaHack.Common.Item import qualified Game.LambdaHack.Common.ItemAspect as IA import Game.LambdaHack.Common.Level import Game.LambdaHack.Common.MonadStateRead import Game.LambdaHack.Common.State import Game.LambdaHack.Common.Types import Game.LambdaHack.Common.Point import qualified Game.LambdaHack.Definition.Ability as Ability import Game.LambdaHack.Definition.Defs -- | The monad for writing to the main game state. Atomic updates (@UpdAtomic@) -- are given semantics in this monad. class MonadStateRead m => MonadStateWrite m where modifyState :: (State -> State) -> m () putState :: State -> m () -- | Exception signifying that atomic action failed because -- the information it carries is inconsistent with the client's state, -- (e.g., because the client knows too little to understand the command -- or already deduced the state change from earlier commands -- or is confused, amnesiac or sees illusory actors or tiles). -- Whenever we know the failure is logically impossible, -- we don't throw the @AtomicFail@ exception, but insert a normal assertion -- or @error@ call, which are never caught nor handled. newtype AtomicFail = AtomicFail String deriving Show instance Ex.Exception AtomicFail atomicFail :: String -> a atomicFail = Ex.throw . AtomicFail -- INLIning offers no speedup, increases alloc and binary size. -- EM.alter not necessary, because levels not removed, so little risk -- of adjusting at absent index. updateLevel :: MonadStateWrite m => LevelId -> (Level -> Level) -> m () updateLevel lid f = modifyState $ updateDungeon $ EM.adjust f lid -- INLIning doesn't help despite probably canceling the alt indirection. -- perhaps it's applied automatically due to INLINABLE. updateActor :: MonadStateWrite m => ActorId -> (Actor -> Actor) -> m () updateActor aid f = do let alt Nothing = error $ "no body to update" `showFailure` aid alt (Just b) = Just $ f b modifyState $ updateActorD $ EM.alter alt aid updateFaction :: MonadStateWrite m => FactionId -> (Faction -> Faction) -> m () updateFaction fid f = do let alt Nothing = error $ "no faction to update" `showFailure` fid alt (Just fact) = Just $ f fact modifyState $ updateFactionD $ EM.alter alt fid moveActorMap :: MonadStateWrite m => ActorId -> Actor -> Actor -> m () moveActorMap aid body newBody = do let rmBig Nothing = error $ "actor already removed" `showFailure` (aid, body) rmBig (Just _aid2) = #ifdef WITH_EXPENSIVE_ASSERTIONS assert (aid == _aid2 `blame` "actor already removed" `swith` (aid, body, _aid2)) #endif Nothing addBig Nothing = Just aid addBig (Just aid2) = error $ "an actor already present there" `showFailure` (aid, body, aid2) updBig = EM.alter addBig (bpos newBody) . EM.alter rmBig (bpos body) let rmProj Nothing = error $ "actor already removed" `showFailure` (aid, body) rmProj (Just l) = #ifdef WITH_EXPENSIVE_ASSERTIONS assert (aid `elem` l `blame` "actor already removed" `swith` (aid, body, l)) #endif (let l2 = delete aid l in if null l2 then Nothing else Just l2) addProj Nothing = Just [aid] addProj (Just l) = Just $ aid : l updProj = EM.alter addProj (bpos newBody) . EM.alter rmProj (bpos body) updateLevel (blid body) $ if bproj body then updateProjMap updProj else updateBigMap updBig swapActorMap :: MonadStateWrite m => ActorId -> Actor -> ActorId -> Actor -> m () swapActorMap source sbody target tbody = do let addBig aid1 aid2 Nothing = error $ "actor already removed" `showFailure` (aid1, aid2, source, sbody, target, tbody) addBig _aid1 aid2 (Just _aid) = #ifdef WITH_EXPENSIVE_ASSERTIONS assert (_aid == _aid1 `blame` "wrong actor present" `swith` (_aid, _aid1, aid2, sbody, tbody)) #endif (Just aid2) updBig = EM.alter (addBig source target) (bpos sbody) . EM.alter (addBig target source) (bpos tbody) if not (bproj sbody) && not (bproj tbody) then updateLevel (blid sbody) $ updateBigMap updBig else do moveActorMap source sbody tbody moveActorMap target tbody sbody insertBagContainer :: MonadStateWrite m => ItemBag -> Container -> m () insertBagContainer bag c = case c of CFloor lid pos -> do let alt Nothing = Just bag alt (Just bag2) = atomicFail $ "floor bag not empty" `showFailure` (bag2, lid, pos, bag) updateLevel lid $ updateFloor $ EM.alter alt pos CEmbed lid pos -> do let alt Nothing = Just bag alt (Just bag2) = atomicFail $ "embed bag not empty" `showFailure` (bag2, lid, pos, bag) updateLevel lid $ updateEmbed $ EM.alter alt pos CActor aid store -> -- Very unlikely case, so we prefer brevity over performance. mapWithKeyM_ (\iid kit -> insertItemActor iid kit aid store) bag CTrunk{} -> return () insertItemContainer :: MonadStateWrite m => ItemId -> ItemQuant -> Container -> m () insertItemContainer iid kit c = case c of CFloor lid pos -> insertItemFloor iid kit lid pos CEmbed lid pos -> insertItemEmbed iid kit lid pos CActor aid store -> insertItemActor iid kit aid store CTrunk{} -> return () -- New @kit@ lands at the front of the list. insertItemFloor :: MonadStateWrite m => ItemId -> ItemQuant -> LevelId -> Point -> m () insertItemFloor iid kit lid pos = let bag = EM.singleton iid kit mergeBag = EM.insertWith (EM.unionWith mergeItemQuant) pos bag in updateLevel lid $ updateFloor mergeBag insertItemEmbed :: MonadStateWrite m => ItemId -> ItemQuant -> LevelId -> Point -> m () insertItemEmbed iid kit lid pos = let bag = EM.singleton iid kit mergeBag = EM.insertWith (EM.unionWith mergeItemQuant) pos bag in updateLevel lid $ updateEmbed mergeBag insertItemActor :: MonadStateWrite m => ItemId -> ItemQuant -> ActorId -> CStore -> m () insertItemActor iid kit aid cstore = case cstore of CGround -> do b <- getsState $ getActorBody aid insertItemFloor iid kit (blid b) (bpos b) COrgan -> insertItemOrgan iid kit aid CEqp -> insertItemEqp iid kit aid CInv -> insertItemInv iid kit aid CSha -> do b <- getsState $ getActorBody aid insertItemSha iid kit (bfid b) insertItemOrgan :: MonadStateWrite m => ItemId -> ItemQuant -> ActorId -> m () insertItemOrgan iid kit aid = do arItem <- getsState $ aspectRecordFromIid iid let bag = EM.singleton iid kit upd = EM.unionWith mergeItemQuant bag updateActor aid $ \b -> b { borgan = upd (borgan b) , bweapon = if IA.checkFlag Ability.Meleeable arItem then bweapon b + 1 else bweapon b } insertItemEqp :: MonadStateWrite m => ItemId -> ItemQuant -> ActorId -> m () insertItemEqp iid kit aid = do arItem <- getsState $ aspectRecordFromIid iid let bag = EM.singleton iid kit upd = EM.unionWith mergeItemQuant bag updateActor aid $ \b -> b { beqp = upd (beqp b) , bweapon = if IA.checkFlag Ability.Meleeable arItem then bweapon b + 1 else bweapon b } insertItemInv :: MonadStateWrite m => ItemId -> ItemQuant -> ActorId -> m () insertItemInv iid kit aid = do let bag = EM.singleton iid kit upd = EM.unionWith mergeItemQuant bag updateActor aid $ \b -> b {binv = upd (binv b)} insertItemSha :: MonadStateWrite m => ItemId -> ItemQuant -> FactionId -> m () insertItemSha iid kit fid = do let bag = EM.singleton iid kit upd = EM.unionWith mergeItemQuant bag updateFaction fid $ \fact -> fact {gsha = upd (gsha fact)} deleteBagContainer :: MonadStateWrite m => ItemBag -> Container -> m () deleteBagContainer bag c = case c of CFloor lid pos -> do let alt Nothing = atomicFail $ "floor bag already empty" `showFailure` (lid, pos, bag) alt (Just bag2) = assert (bag == bag2) Nothing updateLevel lid $ updateFloor $ EM.alter alt pos CEmbed lid pos -> do let alt Nothing = atomicFail $ "embed bag already empty" `showFailure` (lid, pos, bag) alt (Just bag2) = assert (bag == bag2 `blame` (bag, bag2)) Nothing updateLevel lid $ updateEmbed $ EM.alter alt pos CActor aid store -> -- Very unlikely case, so we prefer brevity over performance. mapWithKeyM_ (\iid kit -> deleteItemActor iid kit aid store) bag CTrunk{} -> error $ "" `showFailure` c deleteItemContainer :: MonadStateWrite m => ItemId -> ItemQuant -> Container -> m () deleteItemContainer iid kit c = case c of CFloor lid pos -> deleteItemFloor iid kit lid pos CEmbed lid pos -> deleteItemEmbed iid kit lid pos CActor aid store -> deleteItemActor iid kit aid store CTrunk{} -> error $ "" `showFailure` c deleteItemFloor :: MonadStateWrite m => ItemId -> ItemQuant -> LevelId -> Point -> m () deleteItemFloor iid kit lid pos = let rmFromFloor (Just bag) = let nbag = rmFromBag kit iid bag in if EM.null nbag then Nothing else Just nbag rmFromFloor Nothing = error $ "item already removed" `showFailure` (iid, kit, lid, pos) in updateLevel lid $ updateFloor $ EM.alter rmFromFloor pos deleteItemEmbed :: MonadStateWrite m => ItemId -> ItemQuant -> LevelId -> Point -> m () deleteItemEmbed iid kit lid pos = let rmFromFloor (Just bag) = let nbag = rmFromBag kit iid bag in if EM.null nbag then Nothing else Just nbag rmFromFloor Nothing = error $ "item already removed" `showFailure` (iid, kit, lid, pos) in updateLevel lid $ updateEmbed $ EM.alter rmFromFloor pos deleteItemActor :: MonadStateWrite m => ItemId -> ItemQuant -> ActorId -> CStore -> m () deleteItemActor iid kit aid cstore = case cstore of CGround -> do b <- getsState $ getActorBody aid deleteItemFloor iid kit (blid b) (bpos b) COrgan -> deleteItemOrgan iid kit aid CEqp -> deleteItemEqp iid kit aid CInv -> deleteItemInv iid kit aid CSha -> do b <- getsState $ getActorBody aid deleteItemSha iid kit (bfid b) deleteItemOrgan :: MonadStateWrite m => ItemId -> ItemQuant -> ActorId -> m () deleteItemOrgan iid kit aid = do arItem <- getsState $ aspectRecordFromIid iid updateActor aid $ \b -> b { borgan = rmFromBag kit iid (borgan b) , bweapon = if IA.checkFlag Ability.Meleeable arItem then bweapon b - 1 else bweapon b } deleteItemEqp :: MonadStateWrite m => ItemId -> ItemQuant -> ActorId -> m () deleteItemEqp iid kit aid = do arItem <- getsState $ aspectRecordFromIid iid updateActor aid $ \b -> b { beqp = rmFromBag kit iid (beqp b) , bweapon = if IA.checkFlag Ability.Meleeable arItem then bweapon b - 1 else bweapon b } deleteItemInv :: MonadStateWrite m => ItemId -> ItemQuant -> ActorId -> m () deleteItemInv iid kit aid = updateActor aid $ \b -> b {binv = rmFromBag kit iid (binv b)} deleteItemSha :: MonadStateWrite m => ItemId -> ItemQuant -> FactionId -> m () deleteItemSha iid kit fid = updateFaction fid $ \fact -> fact {gsha = rmFromBag kit iid (gsha fact)} -- Removing the part of the kit from the back of the list, -- so that @DestroyItem kit (CreateItem kit x) == x@. rmFromBag :: ItemQuant -> ItemId -> ItemBag -> ItemBag rmFromBag kit@(k, rmIt) iid bag = let rfb Nothing = error $ "rm from empty slot" `showFailure` (k, iid, bag) rfb (Just (n, it)) = case compare n k of LT -> error $ "rm more than there is" `showFailure` (n, kit, iid, bag) EQ -> assert (rmIt == it `blame` (rmIt, it, n, kit, iid, bag)) Nothing GT -> assert (rmIt == take k it `blame` (rmIt, take k it, n, kit, iid, bag)) $ Just (n - k, take (n - k) it) in EM.alter rfb iid bag -- Actor's items may or may not be already present in @sitemD@, -- regardless if they are already present otherwise in the dungeon. -- We re-add them all to save time determining which really need it. -- If collision occurs, pick the item found on easier level. addAis :: MonadStateWrite m => [(ItemId, Item)] -> m () addAis ais = do let h item1 item2 = assert (itemsMatch item1 item2 `blame` "inconsistent added items" `swith` (item1, item2, ais)) item2 -- keep the first found level forM_ ais $ \(iid, item) -> do let f = case jkind item of IdentityObvious _ -> id IdentityCovered ix _ -> updateItemIxMap $ EM.insertWith ES.union ix (ES.singleton iid) modifyState $ f . updateItemD (EM.insertWith h iid item) itemsMatch :: Item -> Item -> Bool itemsMatch item1 item2 = jkind item1 == jkind item2 -- Note that nothing else needs to be the same, since items are merged -- and clients have different views on dungeon items than the server. addItemToActorMaxSkills :: MonadStateWrite m => ItemId -> Item -> Int -> ActorId -> m () addItemToActorMaxSkills iid itemBase k aid = do arItem <- getsState $ aspectRecordFromItem iid itemBase let f actorMaxSk = Ability.sumScaledSkills [(actorMaxSk, 1), (IA.aSkills arItem, k)] modifyState $ updateActorMaxSkills $ EM.adjust f aid resetActorMaxSkills :: MonadStateWrite m => m () resetActorMaxSkills = do -- Each actor's equipment and organs would need to be inspected, -- the iid looked up, e.g., if it wasn't in old discoKind, but is in new, -- and then aspect record updated, so it's simpler and not much more -- expensive to generate new sactorMaxSkills. Optimize only after profiling. -- Also note this doesn't get invoked on the server, because it bails out -- earlier, upon noticing the item is already fully known. actorMaxSk <- getsState maxSkillsInDungeon modifyState $ updateActorMaxSkills $ const actorMaxSk LambdaHack-0.9.5.0/engine-src/Game/LambdaHack/Atomic/PosAtomicRead.hs0000644000000000000000000003213107346545000023137 0ustar0000000000000000-- | Representation and computation of visiblity of atomic commands -- by clients. -- -- See -- . module Game.LambdaHack.Atomic.PosAtomicRead ( PosAtomic(..), posUpdAtomic, posSfxAtomic , breakUpdAtomic, seenAtomicCli, seenAtomicSer #ifdef EXPOSE_INTERNAL -- * Internal operations , posProjBody, singleAid, doubleAid, singleContainer #endif ) where import Prelude () import Game.LambdaHack.Core.Prelude import qualified Data.EnumMap.Strict as EM import qualified Data.EnumSet as ES import Game.LambdaHack.Atomic.CmdAtomic import Game.LambdaHack.Common.Actor import Game.LambdaHack.Common.ActorState import Game.LambdaHack.Common.Faction import Game.LambdaHack.Common.MonadStateRead import Game.LambdaHack.Common.Perception import Game.LambdaHack.Common.Point import Game.LambdaHack.Common.State import Game.LambdaHack.Common.Types import Game.LambdaHack.Definition.Defs -- All functions here that take an atomic action are executed -- in the state just before the action is executed. -- | The type representing visibility of atomic commands to factions, -- based on the position of the command, etc. Note that the server -- sees and smells all positions. Also note that hearing is not covered -- because it gives very restricted information, so hearing doesn't equal -- seeing (and we assume smelling actors get lots of data from smells). data PosAtomic = PosSight LevelId [Point] -- ^ whomever sees all the positions, notices | PosFidAndSight [FactionId] LevelId [Point] -- ^ observers and the faction notice | PosSmell LevelId [Point] -- ^ whomever smells all the positions, notices | PosFid FactionId -- ^ only the faction notices, server doesn't | PosFidAndSer (Maybe LevelId) FactionId -- ^ faction and server notices | PosSer -- ^ only the server notices | PosAll -- ^ everybody notices | PosNone -- ^ never broadcasted, but sent manually deriving (Show, Eq) -- | Produce the positions where the atomic update takes place or, more -- generally, the conditions under which the update can be noticed by -- a client. -- -- The goal of this mechanics is to ensure that atomic commands involving -- some positions visible by a client convey similar information as the client -- would get by directly observing the changes -- of the portion of server state limited to the visible positions. -- Consequently, when the visible commands are later applied -- to the client's state, the state stays consistent -- --- in sync with the server state and correctly limited by visiblity. -- There is some wiggle room both in what "in sync" and -- "visible" means and how they propagate through time. -- -- E.g., @UpdDisplaceActor@ in a black room between two enemy actors, -- with only one actor carrying a 0-radius light would not be -- distinguishable by looking at the state (or the screen) from @UpdMoveActor@ -- of the illuminated actor, hence such @UpdDisplaceActor@ should not be -- observable, but @UpdMoveActor@ in similar cotext would be -- (or the former should be perceived as the latter). -- However, to simplify, we assign as strict visibility -- requirements to @UpdMoveActor@ as to @UpdDisplaceActor@ and fall back -- to @UpdSpotActor@ (which provides minimal information that does not -- contradict state) if the visibility is lower. posUpdAtomic :: MonadStateRead m => UpdAtomic -> m PosAtomic posUpdAtomic cmd = case cmd of UpdCreateActor _ body _ -> return $! posProjBody body UpdDestroyActor _ body _ -> return $! posProjBody body UpdCreateItem _ _ _ c -> singleContainer c UpdDestroyItem _ _ _ c -> singleContainer c UpdSpotActor _ body _ -> return $! posProjBody body UpdLoseActor _ body _ -> return $! posProjBody body UpdSpotItem _ _ _ _ c -> singleContainer c UpdLoseItem _ _ _ _ c -> singleContainer c UpdSpotItemBag c _ _ -> singleContainer c UpdLoseItemBag c _ _ -> singleContainer c UpdMoveActor aid fromP toP -> do b <- getsState $ getActorBody aid -- Non-projectile actors are never totally isolated from envirnoment; -- they hear, feel air movement, etc. return $! if bproj b then PosSight (blid b) [fromP, toP] else PosFidAndSight [bfid b] (blid b) [fromP, toP] UpdWaitActor aid _ _ -> singleAid aid UpdDisplaceActor source target -> doubleAid source target UpdMoveItem _ _ _ _ CSha -> error $ "" `showFailure` cmd -- shared stash is private UpdMoveItem _ _ _ CSha _ -> error $ "" `showFailure` cmd UpdMoveItem _ _ aid _ _ -> singleAid aid UpdRefillHP aid _ -> singleAid aid UpdRefillCalm aid _ -> singleAid aid UpdTrajectory aid _ _ -> singleAid aid UpdQuitFaction{} -> return PosAll UpdLeadFaction fid _ _ -> return $ PosFidAndSer Nothing fid UpdDiplFaction{} -> return PosAll UpdTacticFaction fid _ _ -> return $! PosFidAndSer Nothing fid UpdAutoFaction{} -> return PosAll UpdRecordKill aid _ _ -> singleAid aid UpdAlterTile lid p _ _ -> return $! PosSight lid [p] UpdAlterExplorable{} -> return PosAll -- Can't have @PosSight@, because we'd end up with many accessible -- unknown tiles, but the game reporting 'all seen'. UpdAlterGold{} -> return PosAll UpdSearchTile aid p _ -> do b <- getsState $ getActorBody aid return $! PosFidAndSight [bfid b] (blid b) [bpos b, p] UpdHideTile aid p _ -> do b <- getsState $ getActorBody aid return $! PosFidAndSight [bfid b] (blid b) [bpos b, p] UpdSpotTile lid ts -> do let ps = map fst ts return $! PosSight lid ps UpdLoseTile lid ts -> do let ps = map fst ts return $! PosSight lid ps UpdSpotEntry lid ts -> do let ps = map fst ts return $! PosSight lid ps UpdLoseEntry lid ts -> do let ps = map fst ts return $! PosSight lid ps UpdAlterSmell lid p _ _ -> return $! PosSmell lid [p] UpdSpotSmell lid sms -> do let ps = map fst sms return $! PosSmell lid ps UpdLoseSmell lid sms -> do let ps = map fst sms return $! PosSmell lid ps UpdTimeItem _ c _ _ -> singleContainer c UpdAgeGame _ -> return PosAll UpdUnAgeGame _ -> return PosAll UpdDiscover c _ _ _ -> singleContainer c UpdCover c _ _ _ -> singleContainer c UpdDiscoverKind c _ _ -> singleContainer c UpdCoverKind c _ _ -> singleContainer c UpdDiscoverAspect c _ _ -> singleContainer c UpdCoverAspect c _ _ -> singleContainer c UpdDiscoverServer{} -> return PosSer UpdCoverServer{} -> return PosSer UpdPerception{} -> return PosNone UpdRestart fid _ _ _ _ _ -> return $! PosFid fid UpdRestartServer _ -> return PosSer UpdResume _ _ -> return PosNone UpdResumeServer _ -> return PosSer UpdKillExit fid -> return $! PosFid fid UpdWriteSave -> return PosAll UpdHearFid fid _ -> return $! PosFid fid -- | Produce the positions where the atomic special effect takes place. posSfxAtomic :: MonadStateRead m => SfxAtomic -> m PosAtomic posSfxAtomic cmd = case cmd of SfxStrike _ _ _ CSha -> return PosNone -- shared stash is private SfxStrike _ target _ _ -> singleAid target SfxRecoil _ _ _ CSha -> return PosNone -- shared stash is private SfxRecoil _ target _ _ -> singleAid target SfxSteal _ _ _ CSha -> return PosNone -- shared stash is private SfxSteal _ target _ _ -> singleAid target SfxRelease _ _ _ CSha -> return PosNone -- shared stash is private SfxRelease _ target _ _ -> singleAid target SfxProject aid _ cstore -> singleContainer $ CActor aid cstore SfxReceive aid _ cstore -> singleContainer $ CActor aid cstore SfxApply aid _ cstore -> singleContainer $ CActor aid cstore SfxCheck aid _ cstore -> singleContainer $ CActor aid cstore SfxTrigger aid p -> do body <- getsState $ getActorBody aid if bproj body then return $! PosSight (blid body) [bpos body, p] else return $! PosFidAndSight [bfid body] (blid body) [bpos body, p] SfxShun aid p -> do body <- getsState $ getActorBody aid if bproj body then return $! PosSight (blid body) [bpos body, p] else return $! PosFidAndSight [bfid body] (blid body) [bpos body, p] SfxEffect _ aid _ _ -> singleAid aid -- sometimes we don't see source, OK SfxMsgFid fid _ -> return $! PosFid fid SfxRestart -> return PosAll SfxCollideTile aid _ -> singleAid aid SfxTaunt _ aid -> singleAid aid posProjBody :: Actor -> PosAtomic posProjBody body = if bproj body then PosSight (blid body) [bpos body] else PosFidAndSight [bfid body] (blid body) [bpos body] singleAid :: MonadStateRead m => ActorId -> m PosAtomic singleAid aid = do body <- getsState $ getActorBody aid return $! posProjBody body doubleAid :: MonadStateRead m => ActorId -> ActorId -> m PosAtomic doubleAid source target = do sb <- getsState $ getActorBody source tb <- getsState $ getActorBody target -- No @PosFidAndSight@ instead of @PosSight@, because both positions -- need to be seen to have the enemy actor in client's state. return $! assert (blid sb == blid tb) $ PosSight (blid sb) [bpos sb, bpos tb] singleContainer :: MonadStateRead m => Container -> m PosAtomic singleContainer (CFloor lid p) = return $! PosSight lid [p] singleContainer (CEmbed lid p) = return $! PosSight lid [p] singleContainer (CActor aid CSha) = do -- shared stash is private b <- getsState $ getActorBody aid return $! PosFidAndSer (Just $ blid b) (bfid b) singleContainer (CActor aid _) = singleAid aid singleContainer (CTrunk fid lid p) = return $! PosFidAndSight [fid] lid [p] -- | Decompose an atomic action that is outside a client's visiblity. -- The decomposed actions give less information that the original command, -- but some of them may fall within the visibility range of the client. -- The original action may give more information than even the total sum -- of all actions it's broken into. E.g., @UpdMoveActor@ -- informs about the continued existence of the actor between -- moves vs popping out of existence and then back in. -- -- This is computed in server's @State@ from before performing the command. breakUpdAtomic :: MonadStateRead m => UpdAtomic -> m [UpdAtomic] breakUpdAtomic cmd = case cmd of UpdMoveActor aid fromP toP -> do -- We assume other factions don't see leaders and we know the actor's -- faction always sees the atomic command and no other commands -- may be inserted between the two below, so the leader doesn't -- need to be updated, even when aid is the leader. b <- getsState $ getActorBody aid ais <- getsState $ getCarriedAssocsAndTrunk b return [ UpdLoseActor aid b ais , UpdSpotActor aid b {bpos = toP, boldpos = Just fromP} ais ] UpdDisplaceActor source target -> do sb <- getsState $ getActorBody source sais <- getsState $ getCarriedAssocsAndTrunk sb tb <- getsState $ getActorBody target tais <- getsState $ getCarriedAssocsAndTrunk tb -- The order ensures the invariant that no two big actors occupy the same -- position is maintained. The actions about leadership are required -- to keep faction data (identify of the leader) consistent with actor -- data (the actor that is the leader exists). Here, for speed -- and simplicity we violate the property that in a faction -- that has leaders, if any eligible actor is alive, -- the leader is set, because for a moment there may be no leader, -- even though other actors of the faction may exist. msleader <- getsState $ gleader . (EM.! bfid sb) . sfactionD mtleader <- getsState $ gleader . (EM.! bfid tb) . sfactionD return $ [ UpdLeadFaction (bfid sb) msleader Nothing | Just source == msleader ] ++ [ UpdLeadFaction (bfid tb) mtleader Nothing | Just target == mtleader ] ++ [ UpdLoseActor source sb sais , UpdLoseActor target tb tais , UpdSpotActor source sb { bpos = bpos tb , boldpos = Just $ bpos sb } sais , UpdSpotActor target tb { bpos = bpos sb , boldpos = Just $ bpos tb } tais ] ++ [ UpdLeadFaction (bfid sb) Nothing msleader | Just source == msleader ] ++ [ UpdLeadFaction (bfid tb) Nothing mtleader | Just target == mtleader ] _ -> return [] -- | Given the client, its perception and an atomic command, determine -- if the client notices the command. seenAtomicCli :: Bool -> FactionId -> Perception -> PosAtomic -> Bool seenAtomicCli knowEvents fid per posAtomic = case posAtomic of PosSight _ ps -> all (`ES.member` totalVisible per) ps || knowEvents PosFidAndSight fids _ ps -> fid `elem` fids || all (`ES.member` totalVisible per) ps || knowEvents PosSmell _ ps -> all (`ES.member` totalSmelled per) ps || knowEvents PosFid fid2 -> fid == fid2 PosFidAndSer _ fid2 -> fid == fid2 PosSer -> False PosAll -> True PosNone -> error $ "no position possible" `showFailure` fid -- | Determine whether the server would see a command that has -- the given visibilty conditions. seenAtomicSer :: PosAtomic -> Bool seenAtomicSer posAtomic = case posAtomic of PosFid _ -> False PosNone -> error $ "no position possible" `showFailure` posAtomic _ -> True LambdaHack-0.9.5.0/engine-src/Game/LambdaHack/Client.hs0000644000000000000000000000204107346545000020444 0ustar0000000000000000-- | Semantics of responses that are sent from server to clients, -- in terms of client state transformations, -- and semantics of human commands and AI moves, in terms of requests -- to be sent from the client to the server. -- -- See -- . module Game.LambdaHack.Client ( -- * Re-exported from "Game.LambdaHack.Client.LoopM" loopCli -- * Re-exported from "Game.LambdaHack.Client.Request" , RequestAI, ReqAI(..), RequestUI, ReqUI(..), RequestTimed(..) -- * Re-exported from "Game.LambdaHack.Client.Response" , Response (..) -- * Re-exported from "Game.LambdaHack.Client.ClientOptions" , ClientOptions(..), defClientOptions -- * Re-exported from "Game.LambdaHack.Client.UI" , CCUI , UIOptions, applyUIOptions, uCmdline, mkUIOptions ) where import Prelude () import Game.LambdaHack.Client.ClientOptions import Game.LambdaHack.Client.LoopM import Game.LambdaHack.Client.Request import Game.LambdaHack.Client.Response import Game.LambdaHack.Client.UI LambdaHack-0.9.5.0/engine-src/Game/LambdaHack/Client/0000755000000000000000000000000007346545000020113 5ustar0000000000000000LambdaHack-0.9.5.0/engine-src/Game/LambdaHack/Client/AI.hs0000644000000000000000000000625507346545000020750 0ustar0000000000000000-- | Ways for the client to use AI to produce server requests, based on -- the client's view of the game state. module Game.LambdaHack.Client.AI ( queryAI #ifdef EXPOSE_INTERNAL -- * Internal operations , pickActorAndAction #endif ) where import Prelude () import Game.LambdaHack.Core.Prelude import qualified Data.EnumMap.Strict as EM import Game.LambdaHack.Client.AI.PickActionM import Game.LambdaHack.Client.AI.PickActorM import Game.LambdaHack.Client.MonadClient import Game.LambdaHack.Client.Request import Game.LambdaHack.Client.State import Game.LambdaHack.Common.Faction import Game.LambdaHack.Common.MonadStateRead import Game.LambdaHack.Common.State import Game.LambdaHack.Common.Types import Game.LambdaHack.Common.Point -- | Handle the move of an actor under AI control (regardless if the whole -- faction is under human or computer control). queryAI :: MonadClient m => ActorId -> m RequestAI queryAI aid = do -- @sleader@ may be different from @gleader@ due to @stopPlayBack@, -- but only leaders may change faction leader, so we fix that beforehand: side <- getsClient sside mleader <- getsState $ gleader . (EM.! side) . sfactionD mleaderCli <- getsClient sleader unless (Just aid == mleader || mleader == mleaderCli) $ -- @aid@ is not the leader, so he can't change leader later on, -- so we match the leaders here modifyClient $ \cli -> cli {_sleader = mleader} (aidToMove, treq, oldFlee) <- pickActorAndAction Nothing aid (aidToMove2, treq2) <- case treq of ReqWait | mleader == Just aid -> do -- Leader waits; a waste; try once to pick a yet different leader -- or at least a non-waiting action. Undo state changes in @pickAction@: modifyClient $ \cli -> cli { _sleader = mleader , sfleeD = case oldFlee of Just p -> EM.insert aidToMove p $ sfleeD cli Nothing -> EM.delete aidToMove $ sfleeD cli } (a, t, _) <- pickActorAndAction (Just aidToMove) aid return (a, t) _ -> return (aidToMove, treq) return ( ReqAITimed treq2 , if aidToMove2 /= aid then Just aidToMove2 else Nothing ) -- | Pick an actor to move and an action for him to perform, given an optional -- previous candidate actor and action and the server-proposed actor. pickActorAndAction :: MonadClient m => Maybe ActorId -> ActorId -> m (ActorId, RequestTimed, Maybe Point) -- This inline would speeds up execution by 15% and decreases allocation by 15%, -- but it'd bloat JS code without speeding it up. -- {-# INLINE pickActorAndAction #-} pickActorAndAction maid aid = do mleader <- getsClient sleader aidToMove <- if mleader == Just aid then pickActorToMove maid else do setTargetFromTactics aid return aid oldFlee <- getsClient $ EM.lookup aidToMove . sfleeD -- Trying harder (@retry@) whenever no better leader found and so at least -- a non-waiting action should be found. -- If a new leader found, there is hope (but we don't check) -- that he gets a non-waiting action without any desperate measures. let retry = maybe False (aidToMove ==) maid treq <- pickAction aidToMove retry return (aidToMove, treq, oldFlee) LambdaHack-0.9.5.0/engine-src/Game/LambdaHack/Client/AI/0000755000000000000000000000000007346545000020404 5ustar0000000000000000LambdaHack-0.9.5.0/engine-src/Game/LambdaHack/Client/AI/ConditionM.hs0000644000000000000000000004511107346545000023005 0ustar0000000000000000-- | Assorted conditions used later on in AI logic. module Game.LambdaHack.Client.AI.ConditionM ( condAimEnemyPresentM , condAimEnemyRememberedM , condAimNonEnemyPresentM , condAimEnemyNoMeleeM , condInMeleeM , condAimCrucialM , condTgtNonmovingEnemyM , condAnyFoeAdjM , condAdjTriggerableM , meleeThreatDistList , condBlocksFriendsM , condFloorWeaponM , condNoEqpWeaponM , condCanProjectM , condProjectListM , benAvailableItems , hinders , condDesirableFloorItemM , benGroundItems , desirableItem , condSupport , condSoloM , condShineWouldBetrayM , fleeList ) where import Prelude () import Game.LambdaHack.Core.Prelude import qualified Data.EnumMap.Strict as EM import Data.Ord import Game.LambdaHack.Client.Bfs import Game.LambdaHack.Client.CommonM import Game.LambdaHack.Client.MonadClient import Game.LambdaHack.Client.State import Game.LambdaHack.Common.Actor import Game.LambdaHack.Common.ActorState import Game.LambdaHack.Common.Faction import Game.LambdaHack.Common.Item import qualified Game.LambdaHack.Common.ItemAspect as IA import Game.LambdaHack.Common.Kind import Game.LambdaHack.Common.Level import Game.LambdaHack.Common.MonadStateRead import Game.LambdaHack.Common.ReqFailure import Game.LambdaHack.Common.State import qualified Game.LambdaHack.Common.Tile as Tile import Game.LambdaHack.Common.Time import Game.LambdaHack.Common.Types import Game.LambdaHack.Common.Vector import qualified Game.LambdaHack.Content.ItemKind as IK import Game.LambdaHack.Content.ModeKind import Game.LambdaHack.Content.RuleKind import qualified Game.LambdaHack.Core.Dice as Dice import Game.LambdaHack.Common.Point import qualified Game.LambdaHack.Definition.Ability as Ability import Game.LambdaHack.Definition.Defs -- All conditions are (partially) lazy, because they are not always -- used in the strict monadic computations they are in. -- | Require that the target enemy is visible by the party. condAimEnemyPresentM :: MonadClient m => ActorId -> m Bool condAimEnemyPresentM aid = do btarget <- getsClient $ getTarget aid return $ case btarget of Just (TEnemy _) -> True _ -> False -- | Require that the target enemy is remembered on the actor's level. condAimEnemyRememberedM :: MonadClient m => ActorId -> m Bool condAimEnemyRememberedM aid = do b <- getsState $ getActorBody aid btarget <- getsClient $ getTarget aid return $ case btarget of Just (TPoint (TEnemyPos _) lid _) -> lid == blid b _ -> False -- | Require that the target non-enemy is visible by the party. condAimNonEnemyPresentM :: MonadClient m => ActorId -> m Bool condAimNonEnemyPresentM aid = do btarget <- getsClient $ getTarget aid return $ case btarget of Just (TNonEnemy _) -> True _ -> False -- | Require that the target enemy is visible by the party and doesn't melee. condAimEnemyNoMeleeM :: MonadClient m => ActorId -> m Bool condAimEnemyNoMeleeM aid = do btarget <- getsClient $ getTarget aid case btarget of Just (TEnemy aid2) -> do b2 <- getsState $ getActorBody aid2 actorMaxSkills <- getsState sactorMaxSkills return $ actorCanMelee actorMaxSkills aid2 b2 _ -> return False condInMeleeM :: MonadClient m => LevelId -> m Bool condInMeleeM lid = do condInMelee <- getsClient scondInMelee case EM.lookup lid condInMelee of Just inM -> return inM Nothing -> do side <- getsClient sside inM <- getsState $ inMelee side lid modifyClient $ \cli -> cli {scondInMelee = EM.insert lid inM condInMelee} return inM -- | Require that the target is crucial to success, e.g., an item, -- or that it's not too far away and so the changes to get it are high. condAimCrucialM :: MonadClient m => ActorId -> m Bool condAimCrucialM aid = do b <- getsState $ getActorBody aid mtgtMPath <- getsClient $ EM.lookup aid . stargetD return $ case mtgtMPath of Just TgtAndPath{tapTgt=TEnemy _} -> True Just TgtAndPath{tapTgt=TPoint tgoal lid _, tapPath=Just AndPath{pathLen}} -> lid == blid b && (pathLen < 10 -- close enough to get there first || tgoal `notElem` [TUnknown, TKnown]) Just TgtAndPath{tapTgt=TVector{}, tapPath=Just AndPath{pathLen}} -> pathLen < 7 -- the constant in @vToTgt@, where only -- non-crucial targets are produced; this will also -- prevent animals from sleep close to cave edges _ -> False -- includes the case of target with no path -- | Check if the target is a nonmoving enemy. condTgtNonmovingEnemyM :: MonadClient m => ActorId -> m Bool condTgtNonmovingEnemyM aid = do btarget <- getsClient $ getTarget aid case btarget of Just (TEnemy enemy) -> do actorMaxSk <- getsState $ getActorMaxSkills enemy return $ Ability.getSk Ability.SkMove actorMaxSk <= 0 _ -> return False -- | Require that any non-dying foe is adjacent, except projectiles -- that (possibly) explode upon contact. condAnyFoeAdjM :: MonadStateRead m => ActorId -> m Bool condAnyFoeAdjM aid = getsState $ anyFoeAdj aid -- | Require the actor stands on or adjacent to a triggerable tile -- (e.g., stairs). condAdjTriggerableM :: MonadClient m => ActorId -> m Bool condAdjTriggerableM aid = do COps{coTileSpeedup} <- getsState scops b <- getsState $ getActorBody aid lvl <- getLevel $ blid b actorSk <- currentSkillsClient aid let alterSkill = Ability.getSk Ability.SkAlter actorSk alterMinSkill p = Tile.alterMinSkill coTileSpeedup $ lvl `at` p underFeet p = p == bpos b -- if enter and alter, be more permissive -- Before items are applied (which AI attempts even if apply -- skills too low), tile must be alerable, hence both checks. hasTriggerable p = (underFeet p || alterSkill >= fromEnum (alterMinSkill p)) && p `EM.member` lembed lvl return $ any hasTriggerable $ bpos b : vicinityUnsafe (bpos b) -- | Produce the chess-distance-sorted list of non-low-HP, -- melee-cabable foes on the level. We don't consider path-distance, -- because we are interested in how soon the foe can close in to hit us, -- which can diverge greately from path distance for short distances, -- e.g., when terrain gets revealed. We don't consider non-moving actors, -- because they can't chase us and also because they can't be aggresive -- so to resolve the stalemate, the opposing AI has to be aggresive -- by ignoring them and closing in to melee distance. meleeThreatDistList :: ActorId -> State -> [(Int, (ActorId, Actor))] meleeThreatDistList aid s = let actorMaxSkills = sactorMaxSkills s b = getActorBody aid s allAtWar = foeRegularAssocs (bfid b) (blid b) s strongActor (aid2, b2) = let actorMaxSk = actorMaxSkills EM.! aid2 nonmoving = Ability.getSk Ability.SkMove actorMaxSk <= 0 in not (hpTooLow b2 actorMaxSk || nonmoving) && actorCanMelee actorMaxSkills aid2 b2 allThreats = filter strongActor allAtWar addDist (aid2, b2) = (chessDist (bpos b) (bpos b2), (aid2, b2)) in sortBy (comparing fst) $ map addDist allThreats -- | Require the actor blocks the paths of any of his party members. condBlocksFriendsM :: MonadClient m => ActorId -> m Bool condBlocksFriendsM aid = do b <- getsState $ getActorBody aid targetD <- getsClient stargetD let blocked aid2 = aid2 /= aid && case EM.lookup aid2 targetD of Just TgtAndPath{tapPath=Just AndPath{pathList=q : _}} | q == bpos b -> True _ -> False any blocked <$> getsState (fidActorRegularIds (bfid b) (blid b)) -- | Require the actor stands over a weapon that would be auto-equipped. condFloorWeaponM :: MonadStateRead m => ActorId -> m Bool condFloorWeaponM aid = any (IA.checkFlag Ability.Meleeable . aspectRecordFull . snd) <$> getsState (fullAssocs aid [CGround]) -- | Check whether the actor has no weapon in equipment. condNoEqpWeaponM :: MonadStateRead m => ActorId -> m Bool condNoEqpWeaponM aid = all (not . IA.checkFlag Ability.Meleeable . aspectRecordFull . snd) <$> getsState (fullAssocs aid [CEqp]) -- | Require that the actor can project any items. condCanProjectM :: MonadClient m => Int -> ActorId -> m Bool condCanProjectM skill aid = if skill < 1 then return False else -- shortcut -- Compared to conditions in @projectItem@, range and charge are ignored, -- because they may change by the time the position for the fling -- is reached. not . null <$> condProjectListM skill aid condProjectListM :: MonadClient m => Int -> ActorId -> m [(Benefit, CStore, ItemId, ItemFull, ItemQuant)] condProjectListM skill aid = do condShineWouldBetray <- condShineWouldBetrayM aid condAimEnemyPresent <- condAimEnemyPresentM aid discoBenefit <- getsClient sdiscoBenefit getsState $ projectList discoBenefit skill aid condShineWouldBetray condAimEnemyPresent projectList :: DiscoveryBenefit -> Int -> ActorId -> Bool -> Bool -> State -> [(Benefit, CStore, ItemId, ItemFull, ItemQuant)] projectList discoBenefit skill aid condShineWouldBetray condAimEnemyPresent s = let b = getActorBody aid s actorMaxSk = getActorMaxSkills aid s calmE = calmEnough b actorMaxSk condNotCalmEnough = not calmE heavilyDistressed = -- Actor hit by a projectile or similarly distressed. deltasSerious (bcalmDelta b) -- This detects if the value of keeping the item in eqp is in fact < 0. hind = hinders condShineWouldBetray condAimEnemyPresent heavilyDistressed condNotCalmEnough actorMaxSk q (Benefit{benInEqp, benFling}, _, _, itemFull, _) = let arItem = aspectRecordFull itemFull in benFling < 0 && (not benInEqp -- can't wear, so OK to risk losing or breaking || not (IA.checkFlag Ability.Meleeable arItem) -- anything else expendable && hind itemFull) -- hinders now, so possibly often, so away! && permittedProjectAI skill calmE itemFull stores = [CEqp, CInv, CGround] ++ [CSha | calmE] in filter q $ benAvailableItems discoBenefit aid stores s -- | Produce the list of items from the given stores available to the actor -- and the items' values. benAvailableItems :: DiscoveryBenefit -> ActorId -> [CStore] -> State -> [(Benefit, CStore, ItemId, ItemFull, ItemQuant)] benAvailableItems discoBenefit aid cstores s = let b = getActorBody aid s ben cstore bag = [ (discoBenefit EM.! iid, cstore, iid, itemToFull iid s, kit) | (iid, kit) <- EM.assocs bag] benCStore cs = ben cs $ getBodyStoreBag b cs s in concatMap benCStore cstores hinders :: Bool -> Bool -> Bool -> Bool -> Ability.Skills -> ItemFull -> Bool hinders condShineWouldBetray condAimEnemyPresent heavilyDistressed condNotCalmEnough -- guess that enemies have projectiles and used them now or recently actorMaxSk itemFull = let arItem = aspectRecordFull itemFull itemShine = 0 < IA.getSkill Ability.SkShine arItem -- @condAnyFoeAdj@ is not checked, because it's transient and also item -- management is unlikely to happen during melee, anyway itemShineBad = condShineWouldBetray && itemShine in -- In the presence of enemies (seen, or unseen but distressing) -- actors want to hide in the dark. (condAimEnemyPresent || condNotCalmEnough || heavilyDistressed) && itemShineBad -- even if it's a weapon, take it off -- Fast actors want to hit hard, because they hit much more often -- than receive hits. || gearSpeed actorMaxSk > speedWalk && not (IA.checkFlag Ability.Meleeable arItem) -- in case it's the only weapon && 0 > IA.getSkill Ability.SkHurtMelee arItem -- | Require that the actor stands over a desirable item. condDesirableFloorItemM :: MonadClient m => ActorId -> m Bool condDesirableFloorItemM aid = not . null <$> benGroundItems aid -- | Produce the list of items on the ground beneath the actor -- that are worth picking up. benGroundItems :: MonadClient m => ActorId -> m [(Benefit, CStore, ItemId, ItemFull, ItemQuant)] benGroundItems aid = do cops <- getsState scops b <- getsState $ getActorBody aid fact <- getsState $ (EM.! bfid b) . sfactionD discoBenefit <- getsClient sdiscoBenefit let canEsc = fcanEscape (gplayer fact) isDesirable (ben, _, _, itemFull, _) = desirableItem cops canEsc (benPickup ben) (aspectRecordFull itemFull) (itemKind itemFull) 99 -- fake, becuase no time is wasted walking to item filter isDesirable <$> getsState (benAvailableItems discoBenefit aid [CGround]) desirableItem :: COps -> Bool -> Double -> IA.AspectRecord -> IK.ItemKind -> Int -> Bool desirableItem COps{corule=RuleContent{rsymbolProjectile}} canEsc benPickup arItem itemKind k = let loneProjectile = IK.isymbol itemKind == rsymbolProjectile && k == 1 && Dice.infDice (IK.icount itemKind) > 1 -- never generated as lone; usually means weak useful = if canEsc then benPickup > 0 || IA.checkFlag Ability.Precious arItem else -- A hack to prevent monsters from picking up -- treasure meant for heroes. let preciousNotUseful = IA.isHumanTrinket itemKind in benPickup > 0 && not preciousNotUseful in useful && not loneProjectile condSupport :: MonadClient m => Int -> ActorId -> m Bool {-# INLINE condSupport #-} condSupport param aid = do btarget <- getsClient $ getTarget aid condAimEnemyPresent <- condAimEnemyPresentM aid condAimEnemyRemembered <- condAimEnemyRememberedM aid getsState $ strongSupport param aid btarget condAimEnemyPresent condAimEnemyRemembered strongSupport :: Int -> ActorId -> Maybe Target -> Bool -> Bool -> State -> Bool strongSupport param aid btarget condAimEnemyPresent condAimEnemyRemembered s = -- The smaller the area scanned for friends, the lower number required. let actorMaxSkills = sactorMaxSkills s actorMaxSk = actorMaxSkills EM.! aid n = min 2 param - Ability.getSk Ability.SkAggression actorMaxSk b = getActorBody aid s mtgtPos = aidTgtToPos aid (blid b) btarget s approaching b2 = case mtgtPos of Just tgtPos | condAimEnemyPresent || condAimEnemyRemembered -> chessDist (bpos b2) tgtPos <= 1 + param _ -> False closeEnough b2 = let dist = chessDist (bpos b) (bpos b2) in dist > 0 && (dist <= param || approaching b2) closeAndStrong (aid2, b2) = closeEnough b2 && actorCanMelee actorMaxSkills aid2 b2 friends = friendRegularAssocs (bfid b) (blid b) s closeAndStrongFriends = filter closeAndStrong friends in n <= 0 || not (null (drop (n - 1) closeAndStrongFriends)) -- optimized: length closeAndStrongFriends >= n condSoloM :: MonadClient m => ActorId -> m Bool condSoloM aid = do b <- getsState $ getActorBody aid let isSingleton [_] = True isSingleton _ = False isSingleton <$> getsState (friendRegularList (bfid b) (blid b)) -- | Require that the actor stands in the dark and so would be betrayed -- by his own equipped light, condShineWouldBetrayM :: MonadStateRead m => ActorId -> m Bool condShineWouldBetrayM aid = do b <- getsState $ getActorBody aid aInAmbient <- getsState $ actorInAmbient b return $ not aInAmbient -- tile is dark, so actor could hide -- | Produce a list of acceptable adjacent points to flee to. fleeList :: MonadClient m => ActorId -> m ([(Int, Point)], [(Int, Point)]) fleeList aid = do COps{coTileSpeedup} <- getsState scops mtgtMPath <- getsClient $ EM.lookup aid . stargetD -- Prefer fleeing along the path to target, unless the target is a foe, -- in which case flee in the opposite direction. let etgtPath = case mtgtMPath of Just TgtAndPath{ tapPath=Just AndPath{pathList, pathGoal} , tapTgt } -> case tapTgt of TEnemy{} -> Left pathGoal TPoint TEnemyPos{} _ _ -> Left pathGoal _ -> Right pathList _ -> Right [] fleeD <- getsClient sfleeD -- But if fled previous turn, prefer even more fleeing further this turn. let eOldFleeOrTgt = case EM.lookup aid fleeD of Nothing -> etgtPath Just p -> Left p b <- getsState $ getActorBody aid lvl <- getLevel $ blid b posFoes <- getsState $ map bpos . foeRegularList (bfid b) (blid b) let myVic = vicinityUnsafe $ bpos b dist p | null posFoes = 100 | otherwise = minimum $ map (chessDist p) posFoes dVic = map (dist &&& id) myVic -- Flee, if possible. Direct access required; not enough time to open. -- Can't be occupied. accWalkUnocc p = Tile.isWalkable coTileSpeedup (lvl `at` p) && not (occupiedBigLvl p lvl) && not (occupiedProjLvl p lvl) accWalkVic = filter (accWalkUnocc . snd) dVic gtVic = filter ((> dist (bpos b)) . fst) accWalkVic eqVicRaw = filter ((== dist (bpos b)) . fst) accWalkVic (eqVicOld, eqVic) = partition ((== boldpos b) . Just . snd) eqVicRaw accNonWalkUnocc p = not (Tile.isWalkable coTileSpeedup (lvl `at` p)) && Tile.isEasyOpen coTileSpeedup (lvl `at` p) && not (occupiedBigLvl p lvl) && not (occupiedProjLvl p lvl) accNonWalkVic = filter (accNonWalkUnocc . snd) dVic gtEqNonVic = filter ((>= dist (bpos b)) . fst) accNonWalkVic ltAllVic = filter ((< dist (bpos b)) . fst) dVic rewardPath mult (d, p) = case eOldFleeOrTgt of Right tgtPathList | p `elem` tgtPathList -> (100 * mult * d, p) Right tgtPathList | any (adjacent p) tgtPathList -> (10 * mult * d, p) Left pathGoal | bpos b /= pathGoal -> let venemy = towards (bpos b) pathGoal vflee = towards (bpos b) p sq = euclidDistSqVector venemy vflee skew = case compare sq 2 of GT -> 100 * sq EQ -> 10 * sq LT -> sq -- going towards enemy (but may escape adjacent foes) in (mult * skew * d, p) _ -> (mult * d, p) -- far from target path or even on target goal goodVic = map (rewardPath 10000) gtVic ++ map (rewardPath 100) eqVic badVic = map (rewardPath 1) $ gtEqNonVic ++ eqVicOld ++ ltAllVic return (goodVic, badVic) LambdaHack-0.9.5.0/engine-src/Game/LambdaHack/Client/AI/PickActionM.hs0000644000000000000000000014613407346545000023112 0ustar0000000000000000-- | AI procedure for picking the best action for an actor. module Game.LambdaHack.Client.AI.PickActionM ( pickAction #ifdef EXPOSE_INTERNAL -- * Internal operations , actionStrategy, waitBlockNow, yellNow , pickup, equipItems, yieldUnneeded, unEquipItems , groupByEqpSlot, bestByEqpSlot, harmful, meleeBlocker, meleeAny , trigger, projectItem, ApplyItemGroup, applyItem, flee , displaceFoe, displaceBlocker, displaceTgt , chase, moveTowards, moveOrRunAid #endif ) where import Prelude () import Game.LambdaHack.Core.Prelude import Data.Either import qualified Data.EnumMap.Strict as EM import qualified Data.EnumSet as ES import Data.Function import Data.Ratio import Game.LambdaHack.Client.AI.ConditionM import Game.LambdaHack.Client.AI.Strategy import Game.LambdaHack.Client.Bfs import Game.LambdaHack.Client.BfsM import Game.LambdaHack.Client.CommonM import Game.LambdaHack.Client.MonadClient import Game.LambdaHack.Client.Request import Game.LambdaHack.Client.State import Game.LambdaHack.Common.Actor import Game.LambdaHack.Common.ActorState import Game.LambdaHack.Common.Faction import Game.LambdaHack.Common.Item import qualified Game.LambdaHack.Common.ItemAspect as IA import Game.LambdaHack.Common.Kind import Game.LambdaHack.Common.Level import Game.LambdaHack.Common.Misc import Game.LambdaHack.Common.MonadStateRead import Game.LambdaHack.Common.Point import qualified Game.LambdaHack.Common.PointArray as PointArray import Game.LambdaHack.Common.ReqFailure import Game.LambdaHack.Common.State import qualified Game.LambdaHack.Common.Tile as Tile import Game.LambdaHack.Common.Time import Game.LambdaHack.Common.Types import Game.LambdaHack.Common.Vector import qualified Game.LambdaHack.Content.ItemKind as IK import Game.LambdaHack.Content.ModeKind import Game.LambdaHack.Core.Frequency import Game.LambdaHack.Core.Random import Game.LambdaHack.Definition.Ability import qualified Game.LambdaHack.Definition.Ability as Ability import Game.LambdaHack.Definition.Defs -- | Pick the most desirable AI ation for the actor. pickAction :: MonadClient m => ActorId -> Bool -> m RequestTimed {-# INLINE pickAction #-} pickAction aid retry = do side <- getsClient sside body <- getsState $ getActorBody aid let !_A = assert (bfid body == side `blame` "AI tries to move enemy actor" `swith` (aid, bfid body, side)) () let !_A = assert (not (bproj body) `blame` "AI gets to manually move its projectiles" `swith` (aid, bfid body, side)) () -- Reset fleeing flag. May then be set in @flee@. stratAction <- actionStrategy aid retry let bestAction = bestVariant stratAction !_A = assert (not (nullFreq bestAction) -- equiv to nullStrategy `blame` "no AI action for actor" `swith` (stratAction, aid, body)) () -- Run the AI: chose an action from those given by the AI strategy. rndToAction $ frequency bestAction -- AI strategy based on actor's sight, smell, etc. -- Never empty. actionStrategy :: forall m. MonadClient m => ActorId -> Bool -> m (Strategy RequestTimed) {-# INLINE actionStrategy #-} actionStrategy aid retry = do mleader <- getsClient sleader body <- getsState $ getActorBody aid condInMelee <- condInMeleeM $ blid body condAimEnemyPresent <- condAimEnemyPresentM aid condAimEnemyNoMelee <- condAimEnemyNoMeleeM aid condAimEnemyRemembered <- condAimEnemyRememberedM aid condAimNonEnemyPresent <- condAimNonEnemyPresentM aid condAimCrucial <- condAimCrucialM aid condAnyFoeAdj <- condAnyFoeAdjM aid threatDistL <- getsState $ meleeThreatDistList aid (fleeL, badVic) <- fleeList aid modifyClient $ \cli -> cli {sfleeD = EM.delete aid (sfleeD cli)} condSupport1 <- condSupport 1 aid condSupport3 <- condSupport 3 aid condSolo <- condSoloM aid -- solo fighters aggresive canDeAmbientL <- getsState $ canDeAmbientList body actorSk <- currentSkillsClient aid condCanProject <- condCanProjectM (getSk SkProject actorSk) aid condAdjTriggerable <- condAdjTriggerableM aid condBlocksFriends <- condBlocksFriendsM aid condNoEqpWeapon <- condNoEqpWeaponM aid condEnoughGear <- condEnoughGearM aid condFloorWeapon <- condFloorWeaponM aid condDesirableFloorItem <- condDesirableFloorItemM aid condTgtNonmovingEnemy <- condTgtNonmovingEnemyM aid explored <- getsClient sexplored actorMaxSkills <- getsState sactorMaxSkills friends <- getsState $ friendRegularList (bfid body) (blid body) let anyFriendOnLevelAwake = any (\b -> bwatch b /= WSleep && bpos b /= bpos body) friends actorMaxSk = actorMaxSkills EM.! aid prefersSleepWhenAwake = case bwatch body of WSleep -> Ability.getSk Ability.SkMoveItem actorMaxSk <= -10 _ -> prefersSleep actorMaxSk -- nm @WWake@ mayFallAsleep = not condAimEnemyRemembered && mayContinueSleep && canSleep actorSk mayContinueSleep = not condAimEnemyPresent && not (hpFull body actorSk) && not uneasy && not condAnyFoeAdj && (anyFriendOnLevelAwake -- friend guards the sleeper || prefersSleepWhenAwake) -- or he doesn't care dozes = case bwatch body of WWait n -> n > 0 _ -> False && mayFallAsleep && Just aid /= mleader -- best teammate for a task so stop dozing lidExplored = ES.member (blid body) explored panicFleeL = fleeL ++ badVic condHpTooLow = hpTooLow body actorMaxSk heavilyDistressed = -- actor hit by a proj or similarly distressed deltasSerious (bcalmDelta body) condNotCalmEnough = not (calmEnough body actorMaxSk) uneasy = heavilyDistressed || condNotCalmEnough speed1_5 = speedScale (3%2) (gearSpeed actorMaxSk) -- Max skills used, because we need to know if can melee as leader. condCanMelee = actorCanMelee actorMaxSkills aid body condMeleeBad = not ((condSolo || condSupport1) && condCanMelee) condThreat n = not $ null $ takeWhile ((<= n) . fst) threatDistL threatAdj = takeWhile ((== 1) . fst) threatDistL condManyThreatAdj = length threatAdj >= 2 condFastThreatAdj = any (\(_, (aid2, _)) -> let ar2 = actorMaxSkills EM.! aid2 in gearSpeed ar2 > speed1_5) threatAdj actorShines = Ability.getSk SkShine actorMaxSk > 0 aCanDeLightL | actorShines = [] | otherwise = canDeAmbientL aCanDeLight = not $ null aCanDeLightL canFleeFromLight = not $ null $ aCanDeLightL `intersect` map snd fleeL abInMaxSkill sk = getSk sk actorMaxSk > 0 runSkills = [SkMove, SkDisplace] -- not @SkAlter@, to ground sleepers stratToFreq :: Int -> m (Strategy RequestTimed) -> m (Frequency RequestTimed) stratToFreq scale mstrat = do st <- mstrat return $! if scale == 0 then mzero else scaleFreq scale $ bestVariant st -- Order matters within the list, because it's summed with .| after -- filtering. Also, the results of prefix, distant and suffix -- are summed with .| at the end. prefix, suffix:: [([Skill], m (Strategy RequestTimed), Bool)] prefix = [ ( [SkApply] , applyItem aid ApplyFirstAid , not condAnyFoeAdj && condHpTooLow) , ( [SkAlter] , trigger aid ViaStairs -- explore next or flee via stairs, even if to wrong level; -- in the latter case, may return via different stairs later on , condAdjTriggerable && not condAimEnemyPresent && ((condNotCalmEnough || condHpTooLow) -- flee && condMeleeBad && condThreat 1 || (lidExplored || condEnoughGear) -- explore && not condDesirableFloorItem) ) , ( [SkDisplace] , displaceFoe aid -- only swap with an enemy to expose him -- and only if a friend is blocked by us , condAnyFoeAdj && condBlocksFriends) -- later checks foe eligible , ( [SkMoveItem] , pickup aid True , condNoEqpWeapon -- we assume organ weapons usually inferior && condFloorWeapon && not condHpTooLow && abInMaxSkill SkMelee ) , ( [SkAlter] , trigger aid ViaEscape , condAdjTriggerable && not condAimEnemyPresent && not condDesirableFloorItem ) -- collect the last loot , ( runSkills , flee aid fleeL , -- Flee either from melee, if our melee is bad and enemy close -- or from missiles, if hit and enemies are only far away, -- can fling at us and we can't well fling at them. not condFastThreatAdj && if | condThreat 1 -> -- Here we don't check @condInMelee@ because regardless -- of whether our team melees (including the fleeing ones), -- endangered actors should flee from very close foes. not condCanMelee || condManyThreatAdj && not condSupport1 && not condSolo | not condInMelee && (condThreat 2 || condThreat 5 && canFleeFromLight) -> -- Don't keep fleeing if just hit, because too close -- to enemy to get out of his range, most likely, -- and so melee him instead, unless can't melee at all. not condCanMelee || not condSupport3 && not condSolo && not heavilyDistressed | condThreat 5 || not condInMelee && condAimEnemyNoMelee && condCanMelee -> -- Too far to flee from melee, too close from ranged, -- not in ambient, so no point fleeing into dark; advance. -- Or the target enemy doesn't melee and melee enemies -- far away, so chase him. False | otherwise -> -- If I'm hit, they are still in range to fling at me, -- even if I can't see them. And probably far away. -- Too far to close in for melee; can't shoot; flee from -- ranged attack and prepare ambush for later on. not condInMelee && heavilyDistressed && (not condCanProject || canFleeFromLight) ) , ( [SkMelee] , meleeBlocker aid -- only melee blocker , condAnyFoeAdj -- if foes, don't displace, otherwise friends: || not (abInMaxSkill SkDisplace) -- displace friends, if possible && condAimEnemyPresent ) -- excited -- So animals block each other until hero comes and then -- the stronger makes a show for him and kills the weaker. , ( [SkAlter] , trigger aid ViaNothing , not condInMelee -- don't incur overhead && condAdjTriggerable && not condAimEnemyPresent ) , ( [SkDisplace] -- prevents some looping movement , displaceBlocker aid retry -- fires up only when path blocked , retry || not condDesirableFloorItem ) , ( [SkMelee] , meleeAny aid , condAnyFoeAdj ) -- won't flee nor displace, so let it melee , ( runSkills , flee aid panicFleeL -- ultimate panic mode; open tiles, if needed , condAnyFoeAdj ) ] -- Order doesn't matter, scaling does. -- These are flattened in @stratToFreq@ (taking only the best variant) -- and then summed, so if any of these can fire, it will. -- If none can, @suffix@ is tried. -- Only the best variant of @chase@ is taken, but it's almost always -- good, and if not, the @chase@ in @suffix@ may fix that. -- The scaling values for @stratToFreq@ need to be so low-resolution -- or we get 32bit @Freqency@ overflows, which would bite us in JS. distant :: [([Skill], m (Frequency RequestTimed), Bool)] distant = [ ( [SkMoveItem] , stratToFreq (if condInMelee then 2 else 20000) $ yieldUnneeded aid -- 20000 to unequip ASAP, unless is thrown , True ) , ( [SkMoveItem] , stratToFreq 1 $ equipItems aid -- doesn't take long, very useful if safe , not (condInMelee || condDesirableFloorItem || uneasy) ) , ( [SkProject] , stratToFreq (if condTgtNonmovingEnemy then 20 else 3) -- not too common, to leave missiles for pre-melee dance $ projectItem aid -- equivalent of @condCanProject@ called inside , condAimEnemyPresent && not condInMelee ) , ( [SkApply] , stratToFreq 1 $ applyItem aid ApplyAll -- use any potion or scroll , condAimEnemyPresent || condThreat 9 ) -- can affect enemies , ( runSkills , stratToFreq (if | condInMelee -> 400 -- friends pummeled by target, go to help | not condAimEnemyPresent -> 2 -- if enemy only remembered investigate anyway | otherwise -> 20) $ chase aid (not condInMelee && (condThreat 12 || heavilyDistressed) && aCanDeLight) retry , condCanMelee && (if condInMelee then condAimEnemyPresent else (condAimEnemyPresent || condAimEnemyRemembered || condAimNonEnemyPresent) && (not (condThreat 2) || heavilyDistressed -- if under fire, do something! || not condMeleeBad) -- this results in animals in corridor never attacking -- (unless distressed by, e.g., being hit by missiles), -- because they can't swarm opponent, which is logical, -- and in rooms they do attack, so not too boring; -- two aliens attack always, because more aggressive && not condDesirableFloorItem) ) ] suffix = [ ( [SkMoveItem] , pickup aid False -- e.g., to give to other party members , not condInMelee && not dozes ) , ( [SkMoveItem] , unEquipItems aid -- late, because these items not bad , not condInMelee && not dozes ) , ( [SkWait] , waitBlockNow -- try to fall asleep, rarely , bwatch body `notElem` [WSleep, WWake] && mayFallAsleep && prefersSleep actorMaxSk && not condAimCrucial) , ( runSkills , chase aid (not condInMelee && heavilyDistressed && aCanDeLight) retry , not dozes && if condInMelee then condCanMelee && condAimEnemyPresent else not (condThreat 2) || not condMeleeBad ) ] fallback = -- Wait until friends sidestep; ensures strategy never empty. -- Also, this is what non-leader heroes do, unless they melee. [ ( [SkWait] , case bwatch body of WSleep -> yellNow -- we know actor doesn't want to sleep, -- so celebrate wake up with a bang _ -> waitBlockNow -- block, etc. , True ) , ( runSkills -- if can't block, at least change something , chase aid (not condInMelee && heavilyDistressed && aCanDeLight) True , not condInMelee || condCanMelee && condAimEnemyPresent ) , ( [SkDisplace] -- if can't brace, at least change something , displaceBlocker aid True , True ) , ( [] , yellNow -- desperate fallback , True ) ] -- Check current, not maximal skills, since this can be a leader as well -- as non-leader action. let abInSkill sk = getSk sk actorSk > 0 checkAction :: ([Skill], m a, Bool) -> Bool checkAction (abts, _, cond) = (null abts || any abInSkill abts) && cond sumS abAction = do let as = filter checkAction abAction strats <- mapM (\(_, m, _) -> m) as return $! msum strats sumF abFreq = do let as = filter checkAction abFreq strats <- mapM (\(_, m, _) -> m) as return $! msum strats combineWeighted as = liftFrequency <$> sumF as sumPrefix <- sumS prefix comDistant <- combineWeighted distant sumSuffix <- sumS suffix sumFallback <- sumS fallback return $! if bwatch body == WSleep && abInSkill SkWait && mayContinueSleep -- no check of @canSleep@, because sight lowered by sleeping then returN "sleep" ReqWait else sumPrefix .| comDistant .| sumSuffix .| sumFallback waitBlockNow :: MonadClient m => m (Strategy RequestTimed) waitBlockNow = return $! returN "wait" ReqWait yellNow :: MonadClient m => m (Strategy RequestTimed) yellNow = return $! returN "yell" ReqYell pickup :: MonadClient m => ActorId -> Bool -> m (Strategy RequestTimed) pickup aid onlyWeapon = do benItemL <- benGroundItems aid b <- getsState $ getActorBody aid -- This calmE is outdated when one of the items increases max Calm -- (e.g., in pickup, which handles many items at once), but this is OK, -- the server accepts item movement based on calm at the start, not end -- or in the middle. -- The calmE is inaccurate also if an item not IDed, but that's intended -- and the server will ignore and warn (and content may avoid that, -- e.g., making all rings identified) actorMaxSk <- getsState $ getActorMaxSkills aid let calmE = calmEnough b actorMaxSk isWeapon (_, _, _, itemFull, _) = IA.checkFlag Ability.Meleeable $ aspectRecordFull itemFull filterWeapon | onlyWeapon = filter isWeapon | otherwise = id prepareOne (oldN, l4) (Benefit{benInEqp}, _, iid, itemFull, (itemK, _)) = let prep newN toCStore = (newN, (iid, itemK, CGround, toCStore) : l4) n = oldN + itemK arItem = aspectRecordFull itemFull in if | calmE && IA.goesIntoSha arItem && not onlyWeapon -> prep oldN CSha | benInEqp && eqpOverfull b n -> if onlyWeapon then (oldN, l4) else prep oldN (if calmE then CSha else CInv) | benInEqp -> prep n CEqp | not onlyWeapon -> prep oldN CInv | otherwise -> (oldN, l4) (_, prepared) = foldl' prepareOne (0, []) $ filterWeapon benItemL return $! if null prepared then reject else returN "pickup" $ ReqMoveItems prepared -- This only concerns items that can be equipped, that is with a slot -- and with @inEqp@ (which implies @goesIntoEqp@). -- Such items are moved between any stores, as needed. In this case, -- from inv or sha to eqp. equipItems :: MonadClient m => ActorId -> m (Strategy RequestTimed) equipItems aid = do body <- getsState $ getActorBody aid actorMaxSk <- getsState $ getActorMaxSkills aid let calmE = calmEnough body actorMaxSk eqpAssocs <- getsState $ kitAssocs aid [CEqp] invAssocs <- getsState $ kitAssocs aid [CInv] shaAssocs <- getsState $ kitAssocs aid [CSha] condShineWouldBetray <- condShineWouldBetrayM aid condAimEnemyPresent <- condAimEnemyPresentM aid discoBenefit <- getsClient sdiscoBenefit let improve :: CStore -> (Int, [(ItemId, Int, CStore, CStore)]) -> ( [(Int, (ItemId, ItemFullKit))] , [(Int, (ItemId, ItemFullKit))] ) -> (Int, [(ItemId, Int, CStore, CStore)]) improve fromCStore (oldN, l4) (bestInv, bestEqp) = let n = 1 + oldN in case (bestInv, bestEqp) of ((_, (iidInv, _)) : _, []) | not (eqpOverfull body n) -> (n, (iidInv, 1, fromCStore, CEqp) : l4) ((vInv, (iidInv, _)) : _, (vEqp, _) : _) | vInv > vEqp && not (eqpOverfull body n) -> (n, (iidInv, 1, fromCStore, CEqp) : l4) _ -> (oldN, l4) heavilyDistressed = -- Actor hit by a projectile or similarly distressed. deltasSerious (bcalmDelta body) -- We filter out unneeded items. In particular, we ignore them in eqp -- when comparing to items we may want to equip, so that the unneeded -- but powerful items don't fool us. -- In any case, the unneeded items should be removed from equip -- in @yieldUnneeded@ earlier or soon after this check. -- In other stores we need to filter, for otherwise we'd have -- a loop of equip/yield. filterNeeded (_, (itemFull, _)) = not $ hinders condShineWouldBetray condAimEnemyPresent heavilyDistressed (not calmE) actorMaxSk itemFull bestThree = bestByEqpSlot discoBenefit (filter filterNeeded eqpAssocs) (filter filterNeeded invAssocs) (filter filterNeeded shaAssocs) bEqpInv = foldl' (improve CInv) (0, []) $ map (\(eqp, inv, _) -> (inv, eqp)) bestThree bEqpBoth | calmE = foldl' (improve CSha) bEqpInv $ map (\(eqp, _, sha) -> (sha, eqp)) bestThree | otherwise = bEqpInv (_, prepared) = bEqpBoth return $! if null prepared then reject else returN "equipItems" $ ReqMoveItems prepared yieldUnneeded :: MonadClient m => ActorId -> m (Strategy RequestTimed) yieldUnneeded aid = do body <- getsState $ getActorBody aid actorMaxSk <- getsState $ getActorMaxSkills aid let calmE = calmEnough body actorMaxSk eqpAssocs <- getsState $ kitAssocs aid [CEqp] condShineWouldBetray <- condShineWouldBetrayM aid condAimEnemyPresent <- condAimEnemyPresentM aid discoBenefit <- getsClient sdiscoBenefit -- Here and in @unEquipItems@ AI may hide from the human player, -- in shared stash, the Ring of Speed And Bleeding, -- which is a bit harsh, but fair. However any subsequent such -- rings will not be picked up at all, so the human player -- doesn't lose much fun. Additionally, if AI learns alchemy later on, -- they can repair the ring, wield it, drop at death and it's -- in play again. let heavilyDistressed = -- Actor hit by a projectile or similarly distressed. deltasSerious (bcalmDelta body) csha = if calmE then CSha else CInv yieldSingleUnneeded (iidEqp, (itemEqp, (itemK, _))) = if | harmful discoBenefit iidEqp -> [(iidEqp, itemK, CEqp, CInv)] -- harmful not shared | hinders condShineWouldBetray condAimEnemyPresent heavilyDistressed (not calmE) actorMaxSk itemEqp -> [(iidEqp, itemK, CEqp, csha)] | otherwise -> [] yieldAllUnneeded = concatMap yieldSingleUnneeded eqpAssocs return $! if null yieldAllUnneeded then reject else returN "yieldUnneeded" $ ReqMoveItems yieldAllUnneeded -- This only concerns items that can be equipped, that is with a slot -- and with @inEqp@ (which implies @goesIntoEqp@). -- Such items are moved between any stores, as needed. In this case, -- from inv or eqp to sha. unEquipItems :: MonadClient m => ActorId -> m (Strategy RequestTimed) unEquipItems aid = do body <- getsState $ getActorBody aid actorMaxSk <- getsState $ getActorMaxSkills aid let calmE = calmEnough body actorMaxSk eqpAssocs <- getsState $ kitAssocs aid [CEqp] invAssocs <- getsState $ kitAssocs aid [CInv] shaAssocs <- getsState $ kitAssocs aid [CSha] condShineWouldBetray <- condShineWouldBetrayM aid condAimEnemyPresent <- condAimEnemyPresentM aid discoBenefit <- getsClient sdiscoBenefit let improve :: CStore -> ( [(Int, (ItemId, ItemFullKit))] , [(Int, (ItemId, ItemFullKit))] ) -> [(ItemId, Int, CStore, CStore)] improve fromCStore (bestSha, bestEOrI) = case bestEOrI of ((vEOrI, (iidEOrI, bei)) : _) | getK bei > 1 && betterThanSha vEOrI bestSha -> -- To share the best items with others, if they care. [(iidEOrI, getK bei - 1, fromCStore, CSha)] (_ : (vEOrI, (iidEOrI, bei)) : _) | betterThanSha vEOrI bestSha -> -- To share the second best items with others, if they care. [(iidEOrI, getK bei, fromCStore, CSha)] ((vEOrI, (_, _)) : _) | fromCStore == CEqp && eqpOverfull body 1 && worseThanSha vEOrI bestSha -> -- To make place in eqp for an item better than any ours. -- Even a minor boost is removed only if sha has a better one. [(fst $ snd $ last bestEOrI, 1, fromCStore, CSha)] _ -> [] getK (_, (itemK, _)) = itemK betterThanSha _ [] = True betterThanSha vEOrI ((vSha, _) : _) = vEOrI > vSha worseThanSha _ [] = False worseThanSha vEOrI ((vSha, _) : _) = vEOrI < vSha heavilyDistressed = -- Actor hit by a projectile or similarly distressed. deltasSerious (bcalmDelta body) -- Here we don't need to filter out items that hinder (except in sha) -- because they are moved to sha and will be equipped by another actor -- at another time, where hindering will be completely different. -- If they hinder and we unequip them, all the better. -- We filter sha to consider only eligible items in @worseThanSha@. filterNeeded (_, (itemFull, _)) = not $ hinders condShineWouldBetray condAimEnemyPresent heavilyDistressed (not calmE) actorMaxSk itemFull bestThree = bestByEqpSlot discoBenefit eqpAssocs invAssocs (filter filterNeeded shaAssocs) bInvSha = concatMap (improve CInv . (\(_, inv, sha) -> (sha, inv))) bestThree bEqpSha = concatMap (improve CEqp . (\(eqp, _, sha) -> (sha, eqp))) bestThree prepared = if calmE then bInvSha ++ bEqpSha else [] return $! if null prepared then reject else returN "unEquipItems" $ ReqMoveItems prepared groupByEqpSlot :: [(ItemId, ItemFullKit)] -> EM.EnumMap EqpSlot [(ItemId, ItemFullKit)] groupByEqpSlot is = let f (iid, itemFullKit) = let arItem = aspectRecordFull $ fst itemFullKit in case IA.aEqpSlot arItem of Nothing -> Nothing Just es -> Just (es, [(iid, itemFullKit)]) withES = mapMaybe f is in EM.fromListWith (++) withES bestByEqpSlot :: DiscoveryBenefit -> [(ItemId, ItemFullKit)] -> [(ItemId, ItemFullKit)] -> [(ItemId, ItemFullKit)] -> [( [(Int, (ItemId, ItemFullKit))] , [(Int, (ItemId, ItemFullKit))] , [(Int, (ItemId, ItemFullKit))] )] bestByEqpSlot discoBenefit eqpAssocs invAssocs shaAssocs = let eqpMap = EM.map (\g -> (g, [], [])) $ groupByEqpSlot eqpAssocs invMap = EM.map (\g -> ([], g, [])) $ groupByEqpSlot invAssocs shaMap = EM.map (\g -> ([], [], g)) $ groupByEqpSlot shaAssocs appendThree (g1, g2, g3) (h1, h2, h3) = (g1 ++ h1, g2 ++ h2, g3 ++ h3) eqpInvShaMap = EM.unionsWith appendThree [eqpMap, invMap, shaMap] bestSingle = strongestSlot discoBenefit bestThree eqpSlot (g1, g2, g3) = (bestSingle eqpSlot g1, bestSingle eqpSlot g2, bestSingle eqpSlot g3) in EM.elems $ EM.mapWithKey bestThree eqpInvShaMap harmful :: DiscoveryBenefit -> ItemId -> Bool harmful discoBenefit iid = -- Items that are known, perhaps recently discovered, and it's now revealed -- they should not be kept in equipment, should be unequipped -- (either they are harmful or they waste eqp space). not $ benInEqp $ discoBenefit EM.! iid -- Everybody melees in a pinch, even though some prefer ranged attacks. meleeBlocker :: MonadClient m => ActorId -> m (Strategy RequestTimed) meleeBlocker aid = do b <- getsState $ getActorBody aid actorMaxSk <- getsState $ getActorMaxSkills aid fact <- getsState $ (EM.! bfid b) . sfactionD actorSk <- currentSkillsClient aid mtgtMPath <- getsClient $ EM.lookup aid . stargetD case mtgtMPath of Just TgtAndPath{ tapTgt=TEnemy{} , tapPath=Just AndPath{pathList=q : _, pathGoal} } | q == pathGoal -> return reject -- not a real blocker, but goal enemy Just TgtAndPath{tapPath=Just AndPath{pathList=q : _, pathGoal}} -> do -- We prefer the goal position, so that we can kill the foe and enter it, -- but we accept any @q@ as well. lvl <- getLevel (blid b) let maim | adjacent (bpos b) pathGoal = Just pathGoal | adjacent (bpos b) q = Just q | otherwise = Nothing -- MeleeDistant lBlocker = case maim of Nothing -> [] Just aim -> posToAidsLvl aim lvl case lBlocker of aid2 : _ -> do body2 <- getsState $ getActorBody aid2 actorMaxSk2 <- getsState $ getActorMaxSkills aid2 -- No problem if there are many projectiles at the spot. We just -- attack the first one. if | actorDying body2 || bproj body2 -- displacing saves a move, so don't melee && getSk SkDisplace actorSk > 0 -> return reject | isFoe (bfid b) fact (bfid body2) -- at war with us, so hit, not displace || isFriend (bfid b) fact (bfid body2) -- don't start a war && getSk SkDisplace actorSk <= 0 -- can't displace && getSk SkMove actorSk > 0 -- blocked move && 3 * bhp body2 < bhp b -- only get rid of weak friends && gearSpeed actorMaxSk2 <= gearSpeed actorMaxSk -> do mel <- maybeToList <$> pickWeaponClient aid aid2 return $! liftFrequency $ uniformFreq "melee in the way" mel | otherwise -> return reject [] -> return reject _ -> return reject -- probably no path to the enemy, if any -- Everybody melees in a pinch, skills and weapons allowing, -- even though some prefer ranged attacks. meleeAny :: MonadClient m => ActorId -> m (Strategy RequestTimed) meleeAny aid = do b <- getsState $ getActorBody aid fact <- getsState $ (EM.! bfid b) . sfactionD adjBigAssocs <- getsState $ adjacentBigAssocs b let foe (_, b2) = isFoe (bfid b) fact (bfid b2) && bhp b2 > 0 adjFoes = map fst $ filter foe adjBigAssocs btarget <- getsClient $ getTarget aid mtargets <- case btarget of Just (TEnemy aid2) -> do b2 <- getsState $ getActorBody aid2 return $! if adjacent (bpos b2) (bpos b) && foe (aid2, b2) then Just [aid2] else Nothing _ -> return Nothing let adjTargets = fromMaybe adjFoes mtargets mels <- mapM (pickWeaponClient aid) adjTargets let freq = uniformFreq "melee adjacent" $ catMaybes mels return $! liftFrequency freq -- The level the actor is on is either explored or the actor already -- has a weapon equipped, so no need to explore further, he tries to find -- enemies on other levels. -- We don't verify any embedded item is targeted by the actor, but at least -- the actor doesn't target a visible enemy at this point. -- TODO: In @actionStrategy@ we require minimal @SkAlter@ even for the case -- of triggerable tile underfoot. A quirk; a specialization of AI actors. trigger :: MonadClient m => ActorId -> FleeViaStairsOrEscape -> m (Strategy RequestTimed) trigger aid fleeVia = do b <- getsState $ getActorBody aid lvl <- getLevel (blid b) let f pos = case EM.lookup pos $ lembed lvl of Nothing -> Nothing Just bag -> Just (pos, bag) pbags = mapMaybe f $ bpos b : vicinityUnsafe (bpos b) efeat <- embedBenefit fleeVia aid pbags return $! liftFrequency $ toFreq "trigger" [ (ceiling benefit, ReqAlter pos) | (benefit, (pos, _)) <- efeat ] projectItem :: MonadClient m => ActorId -> m (Strategy RequestTimed) projectItem aid = do btarget <- getsClient $ getTarget aid b <- getsState $ getActorBody aid mfpos <- getsState $ aidTgtToPos aid (blid b) btarget seps <- getsClient seps case (btarget, mfpos) of (_, Just fpos) | adjacent (bpos b) fpos -> return reject (Just TEnemy{}, Just fpos) -> do mnewEps <- makeLine False b fpos seps case mnewEps of Just newEps -> do actorSk <- currentSkillsClient aid let skill = getSk SkProject actorSk -- ProjectAimOnself, ProjectBlockActor, ProjectBlockTerrain -- and no actors or obstacles along the path. benList <- condProjectListM skill aid localTime <- getsState $ getLocalTime (blid b) let coeff CGround = 2 -- pickup turn saved coeff COrgan = error $ "" `showFailure` benList coeff CEqp = 1000 -- must hinder currently (or be very potent); -- note: not larger, to avoid Int32 overflow coeff CInv = 1 coeff CSha = 1 fRanged (Benefit{benFling}, cstore, iid, itemFull, kit) = -- If the item is discharged, neither the kinetic hit nor -- any effects activate, so no point projecting. -- This changes in time, so recharging is not included -- in @condProjectListM@, but checked here, just before fling. let recharged = hasCharge localTime itemFull kit arItem = aspectRecordFull itemFull trange = IA.totalRange arItem $ itemKind itemFull bestRange = chessDist (bpos b) fpos + 2 -- margin for fleeing rangeMult = -- penalize wasted or unsafely low range 10 + max 0 (10 - abs (trange - bestRange)) benR = coeff cstore * benFling in if trange >= chessDist (bpos b) fpos && recharged then Just ( - ceiling (benR * fromIntegral rangeMult / 10) , ReqProject fpos newEps iid cstore ) else Nothing benRanged = mapMaybe fRanged benList return $! liftFrequency $ toFreq "projectItem" benRanged _ -> return reject _ -> return reject data ApplyItemGroup = ApplyAll | ApplyFirstAid deriving Eq applyItem :: MonadClient m => ActorId -> ApplyItemGroup -> m (Strategy RequestTimed) applyItem aid applyGroup = do actorSk <- currentSkillsClient aid b <- getsState $ getActorBody aid condShineWouldBetray <- condShineWouldBetrayM aid condAimEnemyPresent <- condAimEnemyPresentM aid localTime <- getsState $ getLocalTime (blid b) actorMaxSk <- getsState $ getActorMaxSkills aid let calmE = calmEnough b actorMaxSk condNotCalmEnough = not calmE heavilyDistressed = -- Actor hit by a projectile or similarly distressed. deltasSerious (bcalmDelta b) skill = getSk SkApply actorSk -- This detects if the value of keeping the item in eqp is in fact < 0. hind = hinders condShineWouldBetray condAimEnemyPresent heavilyDistressed condNotCalmEnough actorMaxSk permittedActor itemFull kit = either (const False) id $ permittedApply localTime skill calmE itemFull kit disqualify :: Bool -> IK.Effect -> Bool -- These effects tweak items, which is only situationally beneficial -- and not really the best idea while in combat. disqualify _ IK.PolyItem = True disqualify _ IK.RerollItem = True disqualify _ IK.DupItem = True disqualify _ IK.Identify = True -- This is usually the main effect of item and it's useless without Calm. disqualify durable IK.Summon{} = durable && (bcalm b < xM 30 || condNotCalmEnough) disqualify durable (IK.OneOf l) = any (disqualify durable) l disqualify durable (IK.Composite l) = any (disqualify durable) l disqualify _ _ = False q (Benefit{benInEqp}, _, _, itemFull@ItemFull{itemKind}, kit) = let arItem = aspectRecordFull itemFull durable = IA.checkFlag Durable arItem in (not benInEqp -- can't wear, so OK to break || durable -- can wear, but can't break, even better || not (IA.checkFlag Ability.Meleeable arItem) -- anything else expendable && hind itemFull) -- hinders now, so possibly often, so away! && permittedActor itemFull kit && not (any (disqualify durable) $ IK.ieffects itemKind) && not (IA.isHumanTrinket itemKind) -- hack for elixir of youth -- Organs are not taken into account, because usually they are either -- melee items, so harmful, or periodic, so charging between activations. -- The case of a weak weapon curing poison is too rare to incur overhead. stores = [CEqp, CInv, CGround] ++ [CSha | calmE] discoBenefit <- getsClient sdiscoBenefit benList <- getsState $ benAvailableItems discoBenefit aid stores getKind <- getsState $ flip getIidKind let (myBadGrps, myGoodGrps) = partitionEithers $ mapMaybe (\iid -> let itemKind = getKind iid in if isJust $ lookup "condition" $ IK.ifreq itemKind then Just $ if benInEqp (discoBenefit EM.! iid) then Left $ toGroupName $ IK.iname itemKind -- conveniently, @iname@ matches @ifreq@ else Right $ toGroupName $ IK.iname itemKind else Nothing) (EM.keys $ borgan b) coeff CGround = 2 -- pickup turn saved coeff COrgan = error $ "" `showFailure` benList coeff CEqp = 1 coeff CInv = 1 coeff CSha = 1 fTool benAv@( Benefit{benApply}, cstore, iid , itemFull@ItemFull{itemKind}, _ ) = let -- Don't include @Ascend@ nor @Teleport@, because maybe no foe near. -- Don't include @OneOf@ because other effects may kill you. getHP (IK.RefillHP p) | p > 0 = True getHP (IK.Composite l) = any getHP l getHP _ = False heals = any getHP $ IK.ieffects itemKind dropsGrps = IK.getDropOrgans itemKind -- @Impress@ effect included dropsBadOrgans = not (null myBadGrps) && ("condition" `elem` dropsGrps || not (null (dropsGrps `intersect` myBadGrps))) dropsImpressed = "impressed" `elem` myBadGrps && ("condition" `elem` dropsGrps || "impressed" `elem` dropsGrps) dropsGoodOrgans = not (null myGoodGrps) && ("condition" `elem` dropsGrps || not (null (dropsGrps `intersect` myGoodGrps))) wastesDrop = not dropsBadOrgans && not (null dropsGrps) wastesHP = hpEnough b actorMaxSk && heals durable = IA.checkFlag Durable $ aspectRecordFull itemFull situationalBenApply = if | dropsBadOrgans -> if dropsImpressed then benApply + 1000 -- crucial else benApply + 20 | wastesDrop || wastesHP -> benApply - 10 | otherwise -> benApply benR = ceiling situationalBenApply * if cstore == CEqp && not durable then 1000 -- must hinder currently (or be very potent) else coeff cstore canApply = situationalBenApply > 0 && case applyGroup of ApplyFirstAid -> q benAv && (heals || dropsImpressed) -- when low HP, Calm easy to deplete, so impressed crucial ApplyAll -> q benAv && not dropsGoodOrgans && (dropsImpressed || not wastesHP) -- waste healing only if it drops impressed; -- otherwise apply anything beneficial at will in if canApply then Just (benR, ReqApply iid cstore) else Nothing benTool = mapMaybe fTool benList return $! liftFrequency $ toFreq "applyItem" benTool -- If low on health or alone, flee in panic, close to the path to target -- and as far from the attackers, as possible. Usually fleeing from -- foes will lead towards friends, but we don't insist on that. flee :: MonadClient m => ActorId -> [(Int, Point)] -> m (Strategy RequestTimed) flee aid fleeL = do b <- getsState $ getActorBody aid -- Regardless if fleeing accomplished, mark the need. modifyClient $ \cli -> cli {sfleeD = EM.insert aid (bpos b) (sfleeD cli)} let vVic = map (second (`vectorToFrom` bpos b)) fleeL str = liftFrequency $ toFreq "flee" vVic mapStrategyM (moveOrRunAid aid) str -- The result of all these conditions is that AI displaces rarely, -- but it can't be helped as long as the enemy is smart enough to form fronts. displaceFoe :: MonadClient m => ActorId -> m (Strategy RequestTimed) displaceFoe aid = do COps{coTileSpeedup} <- getsState scops b <- getsState $ getActorBody aid lvl <- getLevel $ blid b fact <- getsState $ (EM.! bfid b) . sfactionD friends <- getsState $ friendRegularList (bfid b) (blid b) adjBigAssocs <- getsState $ adjacentBigAssocs b let foe (_, b2) = isFoe (bfid b) fact (bfid b2) adjFoes = filter foe adjBigAssocs walkable p = -- DisplaceAccess Tile.isWalkable coTileSpeedup (lvl `at` p) notLooping body p = -- avoid displace loops boldpos body /= Just p || actorWaits body nFriends body = length $ filter (adjacent (bpos body) . bpos) friends nFrNew = nFriends b + 1 qualifyActor (aid2, body2) = do let tpos = bpos body2 case posToAidsLvl tpos lvl of [_] -> do actorMaxSk <- getsState $ getActorMaxSkills aid2 dEnemy <- getsState $ dispEnemy aid aid2 actorMaxSk -- DisplaceDying, DisplaceBraced, DisplaceImmobile, -- DisplaceSupported let nFrOld = nFriends body2 return $! if walkable (bpos body2) -- DisplaceAccess && dEnemy && nFrOld < nFrNew && notLooping b (bpos body2) then Just (nFrOld * nFrOld, ReqDisplace aid2) else Nothing _ -> return Nothing -- DisplaceProjectiles foes <- mapM qualifyActor adjFoes return $! liftFrequency $ toFreq "displaceFoe" $ catMaybes foes displaceBlocker :: MonadClient m => ActorId -> Bool -> m (Strategy RequestTimed) displaceBlocker aid retry = do b <- getsState $ getActorBody aid actorMaxSkills <- getsState sactorMaxSkills let condCanMelee = actorCanMelee actorMaxSkills aid b mtgtMPath <- getsClient $ EM.lookup aid . stargetD case mtgtMPath of Just TgtAndPath{ tapTgt=TEnemy{} , tapPath=Just AndPath{pathList=q : _, pathGoal} } | q == pathGoal -- not a real blocker but goal; only displace if can't -- melee (e.g., followed leader) and desperate && not (retry && condCanMelee) -> return reject Just TgtAndPath{tapPath=Just AndPath{pathList=q : _}} | adjacent (bpos b) q -> -- not veered off target too much displaceTgt aid q retry _ -> return reject -- goal reached displaceTgt :: MonadClient m => ActorId -> Point -> Bool -> m (Strategy RequestTimed) displaceTgt source tpos retry = do COps{coTileSpeedup} <- getsState scops b <- getsState $ getActorBody source let !_A = assert (adjacent (bpos b) tpos) () lvl <- getLevel $ blid b let walkable p = -- DisplaceAccess Tile.isWalkable coTileSpeedup (lvl `at` p) notLooping body p = -- avoid displace loops boldpos body /= Just p || actorWaits body if walkable tpos && notLooping b tpos then do mleader <- getsClient sleader case posToAidsLvl tpos lvl of [] -> return reject [aid2] | Just aid2 /= mleader -> do b2 <- getsState $ getActorBody aid2 mtgtMPath <- getsClient $ EM.lookup aid2 . stargetD enemyTgt <- condAimEnemyPresentM source enemyPos <- condAimEnemyRememberedM source enemyTgt2 <- condAimEnemyPresentM aid2 enemyPos2 <- condAimEnemyRememberedM aid2 case mtgtMPath of Just TgtAndPath{tapPath=Just AndPath{pathList=q : _}} | q == bpos b -- friend wants to swap || bwatch b2 `elem` [WSleep, WWake] -- friend sleeps, not cares || retry -- desperate && not (boldpos b == Just tpos -- and no displace loop && not (actorWaits b)) || (enemyTgt || enemyPos) && not (enemyTgt2 || enemyPos2) -> -- he doesn't have Enemy target and I have, so push him aside, -- because, for heroes, he will never be a leader, so he can't -- step aside himself return $! returN "displace friend" $ ReqDisplace aid2 Just _ | bwatch b2 `notElem` [WSleep, WWake] -> return reject _ -> do -- an enemy or ally or dozing or disoriented friend --- swap tfact <- getsState $ (EM.! bfid b2) . sfactionD actorMaxSk <- getsState $ getActorMaxSkills aid2 dEnemy <- getsState $ dispEnemy source aid2 actorMaxSk -- DisplaceDying, DisplaceBraced, DisplaceImmobile, -- DisplaceSupported if not (isFoe (bfid b2) tfact (bfid b)) || dEnemy then return $! returN "displace other" $ ReqDisplace aid2 else return reject _ -> return reject -- DisplaceProjectiles or trying to displace leader else return reject chase :: MonadClient m => ActorId -> Bool -> Bool -> m (Strategy RequestTimed) chase aid avoidAmbient retry = do COps{coTileSpeedup} <- getsState scops body <- getsState $ getActorBody aid fact <- getsState $ (EM.! bfid body) . sfactionD mtgtMPath <- getsClient $ EM.lookup aid . stargetD lvl <- getLevel $ blid body let isAmbient pos = Tile.isLit coTileSpeedup (lvl `at` pos) && Tile.isWalkable coTileSpeedup (lvl `at` pos) -- if solid, will be altered and perhaps darkened str <- case mtgtMPath of Just TgtAndPath{tapPath=Just AndPath{pathList=q : _, ..}} | pathGoal == bpos body -> return reject -- done; picking up items, etc. | not $ avoidAmbient && isAmbient q -> -- With no leader, the goal is vague, so permit arbitrary detours. moveTowards aid q pathGoal (fleaderMode (gplayer fact) == LeaderNull || retry) _ -> return reject -- goal reached or banned ambient lit tile if avoidAmbient && nullStrategy str then chase aid False retry else mapStrategyM (moveOrRunAid aid) str moveTowards :: MonadClient m => ActorId -> Point -> Point -> Bool -> m (Strategy Vector) moveTowards aid target goal relaxed = do b <- getsState $ getActorBody aid actorSk <- currentSkillsClient aid let source = bpos b alterSkill = getSk SkAlter actorSk !_A = assert (adjacent source target `blame` (source, target, aid, b, goal)) () fact <- getsState $ (EM.! bfid b) . sfactionD salter <- getsClient salter noFriends <- getsState $ \s p -> all (isFoe (bfid b) fact . bfid . snd) (posToAidAssocs p (blid b) s) -- don't kill own projectiles let lalter = salter EM.! blid b -- Only actors with SkAlter can search for hidden doors, etc. enterableHere p = alterSkill >= fromEnum (lalter PointArray.! p) if noFriends target && enterableHere target then return $! returN "moveTowards target" $ target `vectorToFrom` source else do -- This lets animals mill around, even when blocked, -- because they have nothing to lose (unless other animals melee). -- Blocked heroes instead don't become leaders and don't move -- until friends sidestep to let them reach their goal. let goesBack p = Just p == boldpos b nonincreasing p = chessDist source goal >= chessDist p goal isSensible | relaxed = \p -> noFriends p && enterableHere p | otherwise = \p -> nonincreasing p && not (goesBack p) && noFriends p && enterableHere p sensible = [ ((goesBack p, chessDist p goal), v) | v <- moves, let p = source `shift` v, isSensible p ] sorted = sortOn fst sensible groups = map (map snd) $ groupBy ((==) `on` fst) sorted freqs = map (liftFrequency . uniformFreq "moveTowards") groups return $! foldr (.|) reject freqs -- Actor moves or searches or alters or attacks. -- This function is very general, even though it's often used in contexts -- when only one or two of the many cases can possibly occur. moveOrRunAid :: MonadClient m => ActorId -> Vector -> m (Maybe RequestTimed) moveOrRunAid source dir = do COps{coTileSpeedup} <- getsState scops sb <- getsState $ getActorBody source actorSk <- currentSkillsClient source let lid = blid sb lvl <- getLevel lid let walkable = -- DisplaceAccess Tile.isWalkable coTileSpeedup (lvl `at` tpos) notLooping body p = -- avoid displace loops boldpos body /= Just p || actorWaits body spos = bpos sb -- source position tpos = spos `shift` dir -- target position t = lvl `at` tpos -- We start by checking actors at the target position, -- which gives a partial information (actors can be invisible), -- as opposed to accessibility (and items) which are always accurate -- (tiles can't be invisible). case posToAidsLvl tpos lvl of [target] | walkable && getSk SkDisplace actorSk > 0 && notLooping sb tpos -> do -- @target@ can be a foe, as well as a friend. tb <- getsState $ getActorBody target tfact <- getsState $ (EM.! bfid tb) . sfactionD actorMaxSk <- getsState $ getActorMaxSkills target dEnemy <- getsState $ dispEnemy source target actorMaxSk -- DisplaceDying, DisplaceBraced, DisplaceImmobile, DisplaceSupported if isFoe (bfid tb) tfact (bfid sb) && not dEnemy then return Nothing else return $ Just $ ReqDisplace target [] | walkable && getSk SkMove actorSk > 0 -> -- Movement requires full access. The potential invisible actor is hit. return $ Just $ ReqMove dir [] | not walkable && getSk SkAlter actorSk >= Tile.alterMinWalk coTileSpeedup t -- AlterUnwalked -- Only possible if items allowed inside unwalkable tiles: && EM.notMember tpos (lfloor lvl) -> -- AlterBlockItem -- Not walkable, but alter skill suffices, so search or alter the tile. -- We assume that unalterable unwalkable tiles are protected -- by high skill req. We don't alter walkable tiles (e.g., close doors). return $ Just $ ReqAlter tpos _ -> return Nothing -- can't displace, move nor alter LambdaHack-0.9.5.0/engine-src/Game/LambdaHack/Client/AI/PickActorM.hs0000644000000000000000000004347507346545000022751 0ustar0000000000000000-- | Picking the AI actor to move and refreshing leader and non-leader targets. module Game.LambdaHack.Client.AI.PickActorM ( pickActorToMove, setTargetFromTactics ) where import Prelude () import Game.LambdaHack.Core.Prelude import qualified Data.EnumMap.Strict as EM import Data.Ratio import Game.LambdaHack.Client.AI.ConditionM import Game.LambdaHack.Client.AI.PickTargetM import Game.LambdaHack.Client.Bfs import Game.LambdaHack.Client.BfsM import Game.LambdaHack.Client.MonadClient import Game.LambdaHack.Client.State import Game.LambdaHack.Common.Actor import Game.LambdaHack.Common.ActorState import Game.LambdaHack.Common.Faction import Game.LambdaHack.Common.Misc import Game.LambdaHack.Common.MonadStateRead import Game.LambdaHack.Common.Point import Game.LambdaHack.Common.State import Game.LambdaHack.Common.Time import Game.LambdaHack.Common.Types import Game.LambdaHack.Content.ModeKind import Game.LambdaHack.Core.Frequency import Game.LambdaHack.Core.Random import qualified Game.LambdaHack.Definition.Ability as Ability -- | Pick a new leader from among the actors on the current level. -- Refresh the target of the new leader, even if unchanged. pickActorToMove :: MonadClient m => Maybe ActorId -> m ActorId {-# INLINE pickActorToMove #-} pickActorToMove maidToAvoid = do actorMaxSkills <- getsState sactorMaxSkills mleader <- getsClient sleader let oldAid = fromMaybe (error $ "" `showFailure` maidToAvoid) mleader oldBody <- getsState $ getActorBody oldAid let side = bfid oldBody arena = blid oldBody fact <- getsState $ (EM.! side) . sfactionD -- Find our actors on the current level only. ours <- getsState $ fidActorRegularAssocs side arena let pickOld = do void $ refreshTarget (oldAid, oldBody) return oldAid oursNotSleeping = filter (\(_, b) -> bwatch b /= WSleep) ours case oursNotSleeping of _ | -- Keep the leader: faction discourages client leader change on level, -- so will only be changed if waits (maidToAvoid) -- to avoid wasting his higher mobility. -- This is OK for monsters even if in melee, because both having -- a meleeing actor a leader (and higher DPS) and rescuing actor -- a leader (and so faster to get in melee range) is good. -- And we are guaranteed that only the two classes of actors are -- not waiting, with some exceptions (urgent unequip, flee via starts, -- melee-less trying to flee, first aid, etc.). snd (autoDungeonLevel fact) && isNothing maidToAvoid -> pickOld [] -> pickOld [(aidNotSleeping, bNotSleeping)] -> do -- Target of asleep actors won't change unless foe adjacent, -- which is caught without recourse to targeting. void $ refreshTarget (aidNotSleeping, bNotSleeping) return aidNotSleeping _ -> do -- At this point we almost forget who the old leader was -- and treat all party actors the same, eliminating candidates -- until we can't distinguish them any more, at which point we prefer -- the old leader, if he is among the best candidates -- (to make the AI appear more human-like and easier to observe). let refresh aidBody = do mtgt <- refreshTarget aidBody return (aidBody, mtgt) oursTgtRaw <- mapM refresh oursNotSleeping fleeD <- getsClient sfleeD let goodGeneric (_, Nothing) = Nothing goodGeneric (_, Just TgtAndPath{tapPath=Nothing}) = Nothing -- this case means melee-less heroes adjacent to foes, etc. -- will never flee if melee is happening; but this is rare; -- this also ensures even if a lone actor melees and nobody -- can come to rescue, he will become and remain the leader, -- because otherwise an explorer would need to become a leader -- and fighter will be 1 clip slower for the whole fight, -- just for a few turns of exploration in return; -- -- also note that when the fighter then becomes a leader -- he may gain quite a lot of time via @swapTime@, -- and so be able to get a double blow on opponents -- or a safe blow and a withdraw (but only once); this is a mild -- exploit that encourages ambush camping (with a non-leader), -- but it's also a rather fun exploit and a straightforward -- consequence of the game mechanics, so it's OK for now goodGeneric ((aid, b), Just tgt) = case maidToAvoid of Nothing | not (aid == oldAid && actorWaits b) -> -- Not the old leader that was stuck last turn -- because he is likely to be still stuck. Just ((aid, b), tgt) Just aidToAvoid | aid /= aidToAvoid -> -- Not an attempted leader stuck this turn. Just ((aid, b), tgt) _ -> Nothing oursTgt = mapMaybe goodGeneric oursTgtRaw -- This should be kept in sync with @actionStrategy@. actorVulnerable ((aid, body), _) = do condInMelee <- condInMeleeM $ blid body let actorMaxSk = actorMaxSkills EM.! aid threatDistL <- getsState $ meleeThreatDistList aid (fleeL, _) <- fleeList aid condSupport1 <- condSupport 1 aid condSupport3 <- condSupport 3 aid condSolo <- condSoloM aid -- solo fighters aggresive canDeAmbientL <- getsState $ canDeAmbientList body let condCanFlee = not (null fleeL) speed1_5 = speedScale (3%2) (gearSpeed actorMaxSk) condCanMelee = actorCanMelee actorMaxSkills aid body condThreat n = not $ null $ takeWhile ((<= n) . fst) threatDistL threatAdj = takeWhile ((== 1) . fst) threatDistL condManyThreatAdj = length threatAdj >= 2 condFastThreatAdj = any (\(_, (aid2, _)) -> let actorMaxSk2 = actorMaxSkills EM.! aid2 in gearSpeed actorMaxSk2 > speed1_5) threatAdj heavilyDistressed = -- Actor hit by a projectile or similarly distressed. deltasSerious (bcalmDelta body) actorShines = Ability.getSk Ability.SkShine actorMaxSk > 0 aCanDeLightL | actorShines = [] | otherwise = canDeAmbientL canFleeFromLight = not $ null $ aCanDeLightL `intersect` map snd fleeL return $! -- This is a part of the condition for @flee@ in @PickActionM@. not condFastThreatAdj && if | condThreat 1 -> not condCanMelee || condManyThreatAdj && not condSupport1 && not condSolo | not condInMelee && (condThreat 2 || condThreat 5 && canFleeFromLight) -> not condCanMelee || not condSupport3 && not condSolo && not heavilyDistressed -- Not used: | condThreat 5 ... -- because actor should be picked anyway, to try to melee. | otherwise -> not condInMelee && heavilyDistressed -- Different from @PickActionM@: && not (EM.member aid fleeD) -- Make him a leader even if can't delight, etc. -- because he may instead take off light or otherwise -- cope with being pummeled by projectiles. -- He is still vulnerable, just not necessarily needs -- to flee, but may cover himself otherwise. -- && (not condCanProject || canFleeFromLight) && condCanFlee actorFled ((aid, _), _) = EM.member aid fleeD actorHearning (_, TgtAndPath{ tapTgt=TPoint TEnemyPos{} _ _ , tapPath=Nothing }) = return False actorHearning (_, TgtAndPath{ tapTgt=TPoint TEnemyPos{} _ _ , tapPath=Just AndPath{pathLen} }) | pathLen <= 2 = return False -- noise probably due to fleeing target actorHearning ((_aid, b), _) = do allFoes <- getsState $ foeRegularList side (blid b) let closeFoes = filter ((<= 3) . chessDist (bpos b) . bpos) allFoes actorHears = deltasHears (bcalmDelta b) return $! actorHears -- e.g., actor hears an enemy && null closeFoes -- the enemy not visible; a trap! -- AI has to be prudent and not lightly waste leader for meleeing, -- even if his target is distant actorMeleeing ((aid, _), _) = condAnyFoeAdjM aid (oursVulnerable, oursSafe) <- partitionM actorVulnerable oursTgt let (oursFled, oursNotFled) = partition actorFled oursSafe (oursMeleeing, oursNotMeleeing) <- partitionM actorMeleeing oursNotFled (oursHearing, oursNotHearing) <- partitionM actorHearning oursNotMeleeing let actorRanged ((aid, body), _) = not $ actorCanMelee actorMaxSkills aid body targetTEnemy (_, TgtAndPath{tapTgt=TEnemy _}) = True targetTEnemy ( (_, b) , TgtAndPath{tapTgt=TPoint (TEnemyPos _) lid _} ) = lid == blid b targetTEnemy _ = False actorNoSupport ((aid, _), _) = do threatDistL <- getsState $ meleeThreatDistList aid condSupport2 <- condSupport 2 aid let condThreat n = not $ null $ takeWhile ((<= n) . fst) threatDistL -- If foes far, friends may still come, so we let him move. -- The net effect is that lone heroes close to foes freeze -- until support comes. return $! condThreat 5 && not condSupport2 (oursRanged, oursNotRanged) = partition actorRanged oursNotHearing (oursTEnemyAll, oursOther) = partition targetTEnemy oursNotRanged notSwapReady abt@((_, b), _) (ab2, Just t2@TgtAndPath{tapPath= Just AndPath{pathList=q : _}}) = let source = bpos b tenemy = targetTEnemy abt tenemy2 = targetTEnemy (ab2, t2) -- Copied from 'displaceTowards': in not (q == source -- friend wants to swap || tenemy && not tenemy2) notSwapReady _ _ = True -- These are not necessarily stuck (perhaps can go around), -- but their current path is blocked by friends. -- As soon as friends move, path is recalcuated and they may -- become unstuck. targetBlocked abt@((aid, _), TgtAndPath{tapPath}) = case tapPath of Just AndPath{pathList= q : _} -> any (\abt2@((aid2, body2), _) -> aid2 /= aid -- in case pushed on goal && bpos body2 == q && notSwapReady abt abt2) oursTgtRaw _ -> False (oursTEnemyBlocked, oursTEnemy) = partition targetBlocked oursTEnemyAll (oursNoSupportRaw, oursSupportRaw) <- if length oursTEnemy <= 2 then return ([], oursTEnemy) else partitionM actorNoSupport oursTEnemy let (oursNoSupport, oursSupport) = if length oursSupportRaw <= 1 -- make sure picks random enough then ([], oursTEnemy) else (oursNoSupportRaw, oursSupportRaw) (oursBlocked, oursPos) = partition targetBlocked $ oursRanged ++ oursOther -- Lower overhead is better. overheadOurs :: ((ActorId, Actor), TgtAndPath) -> Int overheadOurs ((aid, _), TgtAndPath{tapPath=Nothing}) = 100 + if aid == oldAid then 1 else 0 overheadOurs abt@( (aid, b) , TgtAndPath{tapPath=Just AndPath{pathLen=d,pathGoal}} ) = -- Keep proper formation. Too dense and exploration takes -- too long; too sparse and actors fight alone. -- Note that right now, while we set targets separately for each -- hero, perhaps on opposite borders of the map, -- we can't help that sometimes heroes are separated. let maxSpread = 3 + length oursNotSleeping lDist p = [ chessDist (bpos b2) p | (aid2, b2) <- oursNotSleeping, aid2 /= aid] pDist p = let ld = lDist p in assert (not $ null ld) $ minimum ld aidDist = pDist (bpos b) -- Negative, if the goal gets us closer to the party. diffDist = pDist pathGoal - aidDist -- If actor already at goal or equidistant, count it as closer. sign = if diffDist <= 0 then -1 else 1 formationValue = sign * (abs diffDist `max` maxSpread) * (aidDist `max` maxSpread) ^ (2 :: Int) fightValue | targetTEnemy abt = - fromEnum (bhp b `div` (10 * oneM)) | otherwise = 0 in formationValue `div` 3 + fightValue + (if targetBlocked abt then 5 else 0) + (case d of 0 -> -400 -- do your thing ASAP and retarget 1 -> -200 -- prevent others from occupying the tile _ -> if d < 8 then d `div` 4 else 2 + d `div` 10) + (if aid == oldAid then 1 else 0) positiveOverhead sk = let ov = 200 - overheadOurs sk in if ov <= 0 then 1 else ov candidates = [ oursVulnerable , oursSupport , oursNoSupport , oursPos , oursFled -- if just fled, keep him safe, out of action , oursMeleeing ++ oursTEnemyBlocked -- make melee a leader to displace or at least melee -- without overhead if all others blocked , oursHearing , oursBlocked ] case filter (not . null) candidates of l : _ -> do let freq = toFreq "candidates for AI leader" $ map (positiveOverhead &&& id) l ((aid, b), _) <- rndToAction $ frequency freq s <- getState modifyClient $ updateLeader aid s -- When you become a leader, stop following old leader, but follow -- his target, if still valid, to avoid distraction. condInMelee <- condInMeleeM $ blid b when (ftactic (gplayer fact) `elem` [Ability.TFollow, Ability.TFollowNoItems] && not condInMelee) $ void $ refreshTarget (aid, b) return aid _ -> return oldAid -- | Inspect the tactics of the actor and set his target according to it. setTargetFromTactics :: MonadClient m => ActorId -> m () {-# INLINE setTargetFromTactics #-} setTargetFromTactics oldAid = do mleader <- getsClient sleader let !_A = assert (mleader /= Just oldAid) () oldBody <- getsState $ getActorBody oldAid moldTgt <- getsClient $ EM.lookup oldAid . stargetD condInMelee <- condInMeleeM $ blid oldBody let side = bfid oldBody arena = blid oldBody fact <- getsState $ (EM.! side) . sfactionD let explore = void $ refreshTarget (oldAid, oldBody) setPath mtgt = case (mtgt, moldTgt) of (Nothing, _) -> return False ( Just TgtAndPath{tapTgt=leaderTapTgt}, Just TgtAndPath{tapTgt=oldTapTgt,tapPath=Just oldTapPath} ) | leaderTapTgt == oldTapTgt -- targets agree && bpos oldBody == pathSource oldTapPath -> do -- nominal path void $ refreshTarget (oldAid, oldBody) return True -- already on target (Just TgtAndPath{tapTgt=leaderTapTgt}, _) -> do tap <- createPath oldAid leaderTapTgt case tap of TgtAndPath{tapPath=Nothing} -> return False _ -> do modifyClient $ \cli -> cli {stargetD = EM.insert oldAid tap (stargetD cli)} return True follow = case mleader of -- If no leader at all (forced @TFollow@ tactic on an actor -- from a leaderless faction), fall back to @TExplore@. Nothing -> explore _ | bwatch oldBody == WSleep -> -- We could check skills, but it would be more complex. explore Just leader -> do onLevel <- getsState $ memActor leader arena -- If leader not on this level, fall back to @TExplore@. if not onLevel || condInMelee then explore else do -- Copy over the leader's target, if any, or follow his position. mtgt <- getsClient $ EM.lookup leader . stargetD tgtPathSet <- setPath mtgt unless tgtPathSet $ do let nonEnemyPath = Just TgtAndPath { tapTgt = TNonEnemy leader , tapPath = Nothing } nonEnemyPathSet <- setPath nonEnemyPath unless nonEnemyPathSet -- If no path even to the leader himself, explore. explore case ftactic $ gplayer fact of Ability.TExplore -> explore Ability.TFollow -> follow Ability.TFollowNoItems -> follow Ability.TMeleeAndRanged -> explore -- needs to find ranged targets Ability.TMeleeAdjacent -> explore -- probably not needed, but may change Ability.TBlock -> return () -- no point refreshing target Ability.TRoam -> explore -- @TRoam@ is checked again inside @explore@ Ability.TPatrol -> explore -- WIP LambdaHack-0.9.5.0/engine-src/Game/LambdaHack/Client/AI/PickTargetM.hs0000644000000000000000000006125507346545000023123 0ustar0000000000000000{-# LANGUAGE TupleSections #-} -- | Let AI pick the best target for an actor. module Game.LambdaHack.Client.AI.PickTargetM ( refreshTarget #ifdef EXPOSE_INTERNAL -- * Internal operations , computeTarget #endif ) where import Prelude () import Game.LambdaHack.Core.Prelude import qualified Data.EnumMap.Strict as EM import qualified Data.EnumSet as ES import Game.LambdaHack.Client.AI.ConditionM import Game.LambdaHack.Client.Bfs import Game.LambdaHack.Client.BfsM import Game.LambdaHack.Client.CommonM import Game.LambdaHack.Client.MonadClient import Game.LambdaHack.Client.State import Game.LambdaHack.Common.Actor import Game.LambdaHack.Common.ActorState import Game.LambdaHack.Common.Faction import Game.LambdaHack.Common.Item import Game.LambdaHack.Common.Kind import Game.LambdaHack.Common.Level import Game.LambdaHack.Common.MonadStateRead import Game.LambdaHack.Common.Point import qualified Game.LambdaHack.Common.PointArray as PointArray import Game.LambdaHack.Common.State import qualified Game.LambdaHack.Common.Tile as Tile import Game.LambdaHack.Common.Time import Game.LambdaHack.Common.Types import Game.LambdaHack.Common.Vector import Game.LambdaHack.Content.ModeKind import Game.LambdaHack.Content.RuleKind import Game.LambdaHack.Content.TileKind (isUknownSpace) import Game.LambdaHack.Core.Frequency import Game.LambdaHack.Core.Random import qualified Game.LambdaHack.Definition.Ability as Ability -- | Verify and possibly change the target of an actor. This function both -- updates the target in the client state and returns the new target explicitly. refreshTarget :: MonadClient m => (ActorId, Actor) -> m (Maybe TgtAndPath) -- This inline would speeds up execution by 5% and decreases allocation by 10%, -- but it'd bloat JS code without speeding it up. -- {-# INLINE refreshTarget #-} refreshTarget (aid, body) = do side <- getsClient sside let !_A = assert (bfid body == side `blame` "AI tries to move an enemy actor" `swith` (aid, body, side)) () let !_A = assert (not (bproj body) `blame` "AI gets to manually move its projectiles" `swith` (aid, body, side)) () mtarget <- computeTarget aid case mtarget of Nothing -> do -- Melee in progress and the actor can't contribute -- and would slow down others if he acted. -- Or he's just asleep. modifyClient $ \cli -> cli {stargetD = EM.delete aid (stargetD cli)} return Nothing Just tgtMPath -> do -- _debugoldTgt <- getsClient $ EM.lookup aid . stargetD -- Choose a target from those proposed by AI for the actor. modifyClient $ \cli -> cli {stargetD = EM.insert aid tgtMPath (stargetD cli)} return mtarget -- let _debug = T.unpack -- $ "\nHandleAI symbol:" <+> tshow (bsymbol body) -- <> ", aid:" <+> tshow aid -- <> ", pos:" <+> tshow (bpos body) -- <> "\nHandleAI oldTgt:" <+> tshow _debugoldTgt -- <> "\nHandleAI strTgt:" <+> tshow stratTarget -- <> "\nHandleAI target:" <+> tshow tgtMPath -- trace _debug $ return $ Just tgtMPath computeTarget :: forall m. MonadClient m => ActorId -> m (Maybe TgtAndPath) {-# INLINE computeTarget #-} computeTarget aid = do cops@COps{corule=RuleContent{rXmax, rYmax, rnearby}, coTileSpeedup} <- getsState scops b <- getsState $ getActorBody aid mleader <- getsClient sleader salter <- getsClient salter -- We assume the actor eventually becomes a leader (or has the same -- set of skills as the leader, anyway) and set his target accordingly. actorMaxSkills <- getsState sactorMaxSkills condInMelee <- condInMeleeM $ blid b let lalter = salter EM.! blid b actorMaxSk = actorMaxSkills EM.! aid alterSkill = Ability.getSk Ability.SkAlter actorMaxSk lvl <- getLevel $ blid b let stepAccesible :: [Point] -> Bool stepAccesible (q : _) = -- Effectively, only @alterMinWalk@ is checked, because real altering -- is not done via target path, but action after end of path. alterSkill >= fromEnum (lalter PointArray.! q) stepAccesible [] = False mtgtMPath <- getsClient $ EM.lookup aid . stargetD oldTgtUpdatedPath <- case mtgtMPath of Just TgtAndPath{tapTgt,tapPath=Nothing} -> -- This case is especially for TEnemyPos that would be lost otherwise. -- This is also triggered by @UpdLeadFaction@. Just <$> createPath aid tapTgt Just tap@TgtAndPath{tapTgt,tapPath=Just AndPath{..}} -> do mvalidPos <- getsState $ aidTgtToPos aid (blid b) (Just tapTgt) return $! if | isNothing mvalidPos -> Nothing -- wrong level | bpos b == pathGoal-> mtgtMPath -- goal reached; stay there picking up items | pathSource == bpos b -> -- no move -- If next step not accessible, something serious happened, -- so reconsider the target, not only path. if stepAccesible pathList then mtgtMPath else Nothing | otherwise -> case break (== bpos b) pathList of (crossed, _ : rest) -> -- step or many steps along path if null rest then Nothing -- path to the goal was partial, so tiles -- discovered or altered, so reconsider target else let newPath = AndPath{ pathSource = bpos b , pathList = rest , pathGoal , pathLen = pathLen - length crossed - 1 } in if stepAccesible rest then Just tap{tapPath=Just newPath} else Nothing (_, []) -> Nothing -- veered off the path, e.g., due to push -- by enemy or congestion, so serious, -- so reconsider target, not only path Nothing -> return Nothing -- no target assigned yet fact <- getsState $ (EM.! bfid b) . sfactionD allFoes <- getsState $ foeRegularAssocs (bfid b) (blid b) let canMove = Ability.getSk Ability.SkMove actorMaxSk > 0 || Ability.getSk Ability.SkDisplace actorMaxSk > 0 -- Needed for now, because AI targets and shoots enemies -- based on the path to them, not LOS to them: || Ability.getSk Ability.SkProject actorMaxSk > 0 canAlter = Ability.getSk Ability.SkAlter actorMaxSk >= 4 actorMinSk <- getsState $ actorCurrentSkills Nothing aid condCanProject <- condCanProjectM (Ability.getSk Ability.SkProject actorMaxSk) aid let condCanMelee = actorCanMelee actorMaxSkills aid b condHpTooLow = hpTooLow b actorMaxSk friends <- getsState $ friendRegularList (bfid b) (blid b) let canEscape = fcanEscape (gplayer fact) canSmell = Ability.getSk Ability.SkSmell actorMaxSk > 0 meleeNearby | canEscape = rnearby `div` 2 | otherwise = rnearby rangedNearby = 2 * meleeNearby -- Don't target nonmoving actors, including sleeping, unless -- they have loot or attack ours or at heroes, because nonmoving -- can't be lured nor ambushed nor can chase us. -- -- This is KISS, but not ideal, because AI doesn't fling at nonmoving -- actors but only at moving ones and so probably doesn't use -- ranged combat as much as would be optimal. worthTargetting aidE body = do actorMaxSkE <- getsState $ getActorMaxSkills aidE factE <- getsState $ (EM.! bfid body) . sfactionD let attacksFriends = any (adjacent (bpos body) . bpos) friends nonmoving = Ability.getSk Ability.SkMove actorMaxSkE <= 0 && bwatch body /= WWake -- will start moving very soon hasLoot = not (EM.null (beqp body)) || not (EM.null (binv body)) -- even consider "unreported inventory", for speed and KISS isHero = fhasGender (gplayer factE) return $! not nonmoving || hasLoot || attacksFriends || isHero targetableMelee body = let attacksFriends = any (adjacent (bpos body) . bpos) friends -- 3 is -- 1 from condSupport1 -- + 2 from foe being 2 away from friend before he closed in -- + 1 for as a margin for ambush, given than actors exploring -- can't physically keep adjacent all the time n | Ability.getSk Ability.SkAggression actorMaxSk >= 2 = rangedNearby -- boss never waits | condInMelee = if attacksFriends then 4 else 2 -- attack even if foe not in melee, to create another -- skirmish and perhaps overwhelm them in this one; -- also, this looks more natural; also sometimes the foe -- would attack our friend in a couple of turns anyway, -- but we may be too far from him at that time | otherwise = meleeNearby in condCanMelee && chessDist (bpos body) (bpos b) <= n -- Even when missiles run out, the non-moving foe will still be -- targeted, which is fine, since he is weakened by ranged, so should be -- meleed ASAP, even if without friends. targetableRanged body = (not condInMelee || Ability.getSk Ability.SkAggression actorMaxSk >= 2) -- boss fires at will && chessDist (bpos body) (bpos b) < rangedNearby && condCanProject targetableEnemy (aidE, body) = if adjacent (bpos body) (bpos b) then return True -- target regardless of anything, e.g., to flee else do worth <- worthTargetting aidE body return $! worth && (targetableRanged body || targetableMelee body) nearbyFoes <- filterM targetableEnemy allFoes discoBenefit <- getsClient sdiscoBenefit fleeD <- getsClient sfleeD getKind <- getsState $ flip getIidKind getArItem <- getsState $ flip aspectRecordFromIid let desirableIid (iid, (k, _)) = let Benefit{benPickup} = discoBenefit EM.! iid in desirableItem cops canEscape benPickup (getArItem iid) (getKind iid) k desirableBagFloor bag = any desirableIid $ EM.assocs bag desirableFloor (_, (_, bag)) = desirableBagFloor bag focused = gearSpeed actorMaxSk < speedWalk || condHpTooLow couldMoveLastTurn = -- approximated; could have changed let actorSk = if mleader == Just aid then actorMaxSk else actorMinSk in Ability.getSk Ability.SkMove actorSk > 0 isStuck = actorWaits b && couldMoveLastTurn slackTactic = ftactic (gplayer fact) `elem` [ Ability.TMeleeAndRanged, Ability.TMeleeAdjacent , Ability.TBlock, Ability.TRoam, Ability.TPatrol ] setPath :: Target -> m (Maybe TgtAndPath) setPath tgt = do let take7 tap@TgtAndPath{tapTgt=TEnemy{}} = tap -- @TEnemy@ needed for projecting, even by roaming actors take7 tap@TgtAndPath{tapPath=Just AndPath{..}} = -- Best path only followed 7 moves; then straight on. Cheaper. let path7 = take 7 pathList vOld = towards (bpos b) pathGoal pNew = shiftBounded rXmax rYmax (bpos b) vOld walkable = Tile.isWalkable coTileSpeedup $ lvl `at` pNew tapTgt = TVector vOld in if bpos b == pathGoal -- goal reached, so better know the tgt || not walkable -- can't walk, so don't chase a vector then tap else TgtAndPath{ tapTgt , tapPath=Just AndPath{pathList=path7, ..} } take7 tap = tap tgtpath <- createPath aid tgt return $ Just $ if slackTactic then take7 tgtpath else tgtpath pickNewTarget = pickNewTargetIgnore Nothing pickNewTargetIgnore :: Maybe ActorId -> m (Maybe TgtAndPath) pickNewTargetIgnore maidToIgnore = do let f aidToIgnore = filter ((/= aidToIgnore) . fst) nearbyFoes notIgnoredFoes = maybe nearbyFoes f maidToIgnore cfoes <- closestFoes notIgnoredFoes aid case cfoes of (_, (aid2, _)) : _ -> setPath $ TEnemy aid2 [] | condInMelee -> return Nothing -- don't slow down fighters -- this looks a bit strange, because teammates stop in their tracks -- all around the map (unless very close to the combatant), -- but the intuition is, not being able to help immediately, -- and not being too friendly to each other, they just wait and see -- and also shout to the teammate to flee and lure foes into ambush [] -> do citemsRaw <- closestItems aid let citems = toFreq "closestItems" $ filter desirableFloor citemsRaw if nullFreq citems then do ctriggersRaw <- closestTriggers ViaAnything aid let ctriggers = toFreq "ctriggers" ctriggersRaw if nullFreq ctriggers then do -- Tracking enemies is more important than exploring, but smell -- is unreliable and may lead to allies, not foes, so avoid it. smpos <- if canSmell then closestSmell aid else return [] case smpos of [] -> do let vToTgt v0 = do let vFreq = toFreq "vFreq" $ (20, v0) : map (1,) moves v <- rndToAction $ frequency vFreq -- Items and smells, etc. considered every 7 moves. let pathSource = bpos b tra = trajectoryToPathBounded rXmax rYmax pathSource (replicate 7 v) pathList = map head $ group tra pathGoal = last pathList pathLen = length pathList return $ Just $ TgtAndPath { tapTgt = TVector v , tapPath = if pathLen == 0 then Nothing else Just AndPath{..} } oldpos = fromMaybe (bpos b) (boldpos b) vOld = bpos b `vectorToFrom` oldpos pNew = shiftBounded rXmax rYmax (bpos b) vOld if slackTactic && not isStuck && isUnit vOld && bpos b /= pNew -- both are needed, e.g., when just teleported -- or when the shift bounded by level borders && Tile.isWalkable coTileSpeedup (lvl `at` pNew) then vToTgt vOld else do upos <- closestUnknown aid case upos of Nothing -> do -- If can't move (and so no BFS data), no info gained. -- Or if can't alter and possibly stuck among rubble. when (canMove && canAlter) $ modifyClient $ \cli -> cli {sexplored = ES.insert (blid b) (sexplored cli)} ctriggersRaw2 <- closestTriggers ViaExit aid let ctriggers2 = toFreq "ctriggers2" ctriggersRaw2 if nullFreq ctriggers2 then do afoes <- closestFoes allFoes aid case afoes of (_, (aid2, _)) : _ -> -- All stones turned, time to win or die. setPath $ TEnemy aid2 [] -> do furthest <- furthestKnown aid setPath $ TPoint TKnown (blid b) furthest else do (p, (p0, bag)) <- rndToAction $ frequency ctriggers2 setPath $ TPoint (TEmbed bag p0) (blid b) p Just p -> setPath $ TPoint TUnknown (blid b) p (_, (p, _)) : _ -> setPath $ TPoint TSmell (blid b) p else do (p, (p0, bag)) <- rndToAction $ frequency ctriggers setPath $ TPoint (TEmbed bag p0) (blid b) p else do (p, bag) <- rndToAction $ frequency citems setPath $ TPoint (TItem bag) (blid b) p tellOthersNothingHere pos = do let f TgtAndPath{tapTgt} = case tapTgt of TPoint _ lid p -> p /= pos || lid /= blid b _ -> True modifyClient $ \cli -> cli {stargetD = EM.filter f (stargetD cli)} pickNewTarget updateTgt :: TgtAndPath -> m (Maybe TgtAndPath) updateTgt TgtAndPath{tapPath=Nothing} = pickNewTarget updateTgt tap@TgtAndPath{tapPath=Just AndPath{..},tapTgt} = case tapTgt of TEnemy a -> do body <- getsState $ getActorBody a if | (condInMelee -- fight close foes or nobody at all || not focused && not (null nearbyFoes)) -- prefers closer foes && a `notElem` map fst nearbyFoes -- old one not close enough || blid body /= blid b -- wrong level || actorDying body -> -- foe already dying pickNewTarget | EM.member aid fleeD -> pickNewTarget -- forget enemy positions to prevent attacking them again soon | otherwise -> do -- If there are no unwalkable tiles on the path to enemy, -- he gets target @TEnemy@ and then, even if such tiles emerge, -- the target updated by his moves remains @TEnemy@. -- Conversely, he is stuck with @TBlock@ if initial target had -- unwalkable tiles, for as long as they remain. Harmless quirk. mpath <- getCachePath aid $ bpos body case mpath of Nothing -> pickNewTargetIgnore (Just a) -- enemy became unreachable Just AndPath{pathList=[]} -> pickNewTargetIgnore (Just a) -- he is his own enemy Just AndPath{pathList= q : _} -> -- If in melee and path blocked by actors (even proj.) -- change target for this turn due to urgency. -- Because of @condInMelee@ new target will be enemy, -- if any other is left, or empty target. -- If not in melee, keep target and consider your options -- (wait until blocking actors move or displace or melee). -- We don't want to wander away in search of loot, only to -- turn around next turn when the enemy is again considered. if not condInMelee || not (occupiedBigLvl q lvl) && not (occupiedProjLvl q lvl) then return $ Just tap{tapPath=mpath} else pickNewTargetIgnore (Just a) -- In this case, need to retarget, to focus on foes that melee ours -- and not, e.g., on remembered foes or items. _ | condInMelee -> pickNewTarget TPoint _ lid _ | lid /= blid b -> pickNewTarget -- wrong level TPoint tgoal lid pos -> case tgoal of TEnemyPos _ -- chase last position even if foe hides | bpos b == pos -> tellOthersNothingHere pos | EM.member aid fleeD -> pickNewTarget -- forget enemy positions to prevent attacking them again soon | otherwise -> do -- Here pick the closer enemy, remembered or seen, to avoid -- loops when approaching new enemy obscures him behind obstacle -- but reveals the previously remembered one, etc. let remainingDist = chessDist (bpos b) pos if any (\(_, b3) -> chessDist (bpos b) (bpos b3) < remainingDist) nearbyFoes then pickNewTarget else return $ Just tap _ | not $ null nearbyFoes -> pickNewTarget -- prefer close foes to anything else -- Below we check the target could not be picked again in -- pickNewTarget (e.g., an item got picked up by our teammate) -- and only in this case it is invalidated. -- This ensures targets are eventually reached (unless a foe -- shows up) and not changed all the time mid-route -- to equally interesting, but perhaps a bit closer targets, -- most probably already targeted by other actors. TEmbed bag p -> assert (adjacent pos p) $ do -- First, stairs and embedded items from @closestTriggers@. -- We don't check skills, because they normally don't change -- or we can put some equipment back and recover them. -- We don't determine if the stairs or embed are interesting -- (this changes with time), but allow the actor -- to reach them and then retarget. The two things we check -- is whether the embedded bag is still there, or used up -- and whether we happen to be already adjacent to @p@, -- even though not necessarily at @pos@. bag2 <- getsState $ getEmbedBag lid p -- not @pos@ if | bag /= bag2 -> pickNewTarget -- others will notice soon enough | adjacent (bpos b) p -> -- regardless if at @pos@ or not setPath $ TPoint TKnown lid (bpos b) -- stay there one turn (high chance to become leader) -- to enable triggering; if trigger fails -- (e.g, changed skills), will retarget next turn (@TAny@) | otherwise -> return $ Just tap TItem bag -> do bag2 <- getsState $ getFloorBag lid pos if | bag /= bag2 -> pickNewTarget -- others will notice soon enough | bpos b == pos -> setPath $ TPoint TKnown lid (bpos b) -- stay there one turn (high chance to become leader) -- to enable pickup; if pickup fails, will retarget | otherwise -> return $ Just tap TSmell -> if not canSmell || let sml = EM.findWithDefault timeZero pos (lsmell lvl) in sml <= ltime lvl then pickNewTarget -- others will notice soon enough else return $ Just tap TBlock -> do -- e.g., door or first unknown tile of an area let t = lvl `at` pos if isStuck -- not a very important target, because blocked || alterSkill < fromEnum (lalter PointArray.! pos) -- tile was searched or altered or skill lowered || Tile.isWalkable coTileSpeedup t -- tile is no longer unwalkable, so was explored -- so time to recalculate target then pickNewTarget -- others will notice soon enough else return $ Just tap TUnknown -> let t = lvl `at` pos in if lexpl lvl <= lseen lvl || not (isUknownSpace t) then pickNewTarget -- others will notice soon enough else return $ Just tap TKnown -> if bpos b == pos || isStuck || alterSkill < fromEnum (lalter PointArray.! pos) -- tile was searched or altered or skill lowered then pickNewTarget -- others unconcerned else return $ Just tap _ | not $ null nearbyFoes -> pickNewTarget -- prefer close foes to any vector TNonEnemy _ | mleader == Just aid -> -- a leader, never follow pickNewTarget TNonEnemy a -> do body <- getsState $ getActorBody a if blid body /= blid b -- wrong level then pickNewTarget else do -- Update path. If impossible, pick another target. mpath <- getCachePath aid $ bpos body case mpath of Nothing -> pickNewTarget Just AndPath{pathList=[]} -> pickNewTarget _ -> return $ Just tap{tapPath=mpath} TVector{} -> if pathLen > 1 then return $ Just tap else pickNewTarget if canMove then case oldTgtUpdatedPath of Nothing -> pickNewTarget Just tap -> updateTgt tap else return Nothing LambdaHack-0.9.5.0/engine-src/Game/LambdaHack/Client/AI/Strategy.hs0000644000000000000000000000767607346545000022562 0ustar0000000000000000{-# LANGUAGE DeriveFoldable, DeriveTraversable, TupleSections #-} -- | AI strategies to direct actors not controlled directly by human players. -- No operation in this module involves the @State@ type or any of our -- client/server monads types. module Game.LambdaHack.Client.AI.Strategy ( Strategy, nullStrategy, liftFrequency , (.|), reject, (.=>), only, bestVariant, renameStrategy, returN, mapStrategyM ) where import Prelude () import Game.LambdaHack.Core.Prelude import Control.Applicative import Data.Int (Int32) import Game.LambdaHack.Core.Frequency -- | A strategy is a choice of (non-empty) frequency tables -- of possible actions. -- -- Currently, the way we use it, the list could have at most one element -- (we filter out void frequencies early and only ever access the first). -- except for the argument of @mapStrategyM@, which may even be process -- to the end of the list, if no earlier strategies can be transformed -- into non-null ones. newtype Strategy a = Strategy { runStrategy :: [Frequency a] } deriving (Show, Foldable, Traversable) _maxBound32 :: Integer _maxBound32 = toInteger (maxBound :: Int32) instance Monad Strategy where m >>= f = normalizeStrategy $ Strategy [ toFreq name [ #ifdef WITH_EXPENSIVE_ASSERTIONS assert (toInteger p * toInteger q <= _maxBound32) #endif (p * q, b) | (p, a) <- runFrequency x , y <- runStrategy (f a) , (q, b) <- runFrequency y ] | x <- runStrategy m , let name = "Strategy_bind (" <> nameFrequency x <> ")"] instance Functor Strategy where fmap f (Strategy fs) = Strategy (map (fmap f) fs) instance Applicative Strategy where {-# INLINE pure #-} pure x = Strategy $ return $! uniformFreq "Strategy_pure" [x] (<*>) = ap instance MonadPlus Strategy where mzero = Strategy [] mplus (Strategy xs) (Strategy ys) = Strategy (xs ++ ys) instance Alternative Strategy where (<|>) = mplus empty = mzero normalizeStrategy :: Strategy a -> Strategy a normalizeStrategy (Strategy fs) = Strategy $ filter (not . nullFreq) fs nullStrategy :: Strategy a -> Bool nullStrategy strat = null $ runStrategy strat -- | Strategy where only the actions from the given single frequency table -- can be picked. liftFrequency :: Frequency a -> Strategy a liftFrequency f = normalizeStrategy $ Strategy $ return f infixr 2 .| -- | Strategy with the actions from both argument strategies, -- with original frequencies. (.|) :: Strategy a -> Strategy a -> Strategy a (.|) = mplus -- | Strategy with no actions at all. reject :: Strategy a reject = mzero infix 3 .=> -- | Conditionally accepted strategy. (.=>) :: Bool -> Strategy a -> Strategy a p .=> m | p = m | otherwise = mzero -- | Strategy with all actions not satisfying the predicate removed. -- The remaining actions keep their original relative frequency values. only :: (a -> Bool) -> Strategy a -> Strategy a only p s = normalizeStrategy $ do x <- s p x .=> return x -- | When better choices are towards the start of the list, -- this is the best frequency of the strategy. bestVariant :: Strategy a -> Frequency a bestVariant (Strategy []) = mzero bestVariant (Strategy (f : _)) = f -- | Overwrite the description of all frequencies within the strategy. renameStrategy :: Text -> Strategy a -> Strategy a renameStrategy newName (Strategy fs) = Strategy $ map (renameFreq newName) fs -- | Like 'return', but pick a name of the single frequency. returN :: Text -> a -> Strategy a returN name x = Strategy $ return $! uniformFreq name [x] mapStrategyM :: Monad m => (a -> m (Maybe b)) -> Strategy a -> m (Strategy b) mapStrategyM f s = do let mapFreq freq = do let g (k, a) = do mb <- f a return $! (k,) <$> mb lbm <- mapM g $ runFrequency freq return $! toFreq "mapStrategyM" $ catMaybes lbm ls = runStrategy s lt <- mapM mapFreq ls return $! normalizeStrategy $ Strategy lt LambdaHack-0.9.5.0/engine-src/Game/LambdaHack/Client/Bfs.hs0000644000000000000000000003430207346545000021163 0ustar0000000000000000{-# LANGUAGE DeriveGeneric, GeneralizedNewtypeDeriving, RankNTypes, TypeFamilies #-} -- | Breadth first search algorithm. module Game.LambdaHack.Client.Bfs ( BfsDistance, MoveLegal(..) , subtractBfsDistance, minKnownBfs, apartBfs, maxBfsDistance, fillBfs , AndPath(..), actorsAvoidedDist, findPathBfs , accessBfs #ifdef EXPOSE_INTERNAL -- * Internal operations , succBfsDistance, predBfsDistance, abortedUnknownBfs #endif ) where import Prelude () import Game.LambdaHack.Core.Prelude import Control.Monad.ST.Strict (ST, runST) import Data.Binary import Data.Bits (Bits, complement, (.&.), (.|.)) import qualified Data.EnumMap.Strict as EM import qualified Data.IntMap.Strict as IM import qualified Data.Primitive.PrimArray as PA import qualified Data.Vector.Unboxed as U import qualified Data.Vector.Unboxed.Mutable as VM import GHC.Exts (inline) import GHC.Generics (Generic) import Game.LambdaHack.Common.Level import Game.LambdaHack.Common.Vector import Game.LambdaHack.Common.Point import qualified Game.LambdaHack.Common.PointArray as PointArray import Game.LambdaHack.Definition.Defs -- | Weighted distance between points along shortest paths. newtype BfsDistance = BfsDistance {bfsDistance :: Word8} deriving (Show, Eq, Ord, Bits) instance PointArray.UnboxRepClass BfsDistance where type UnboxRep BfsDistance = Word8 toUnboxRepUnsafe = bfsDistance fromUnboxRep = BfsDistance -- | State of legality of moves between adjacent points. data MoveLegal = MoveBlocked | MoveToOpen | MoveToClosed | MoveToUnknown deriving Eq succBfsDistance :: BfsDistance -> BfsDistance succBfsDistance d = BfsDistance $ bfsDistance d + 1 predBfsDistance :: BfsDistance -> BfsDistance predBfsDistance d = BfsDistance $ bfsDistance d - 1 subtractBfsDistance :: BfsDistance -> BfsDistance -> Int subtractBfsDistance d1 d2 = fromEnum $ bfsDistance d1 - bfsDistance d2 -- | The minimal distance value assigned to paths that don't enter -- any unknown tiles. minKnownBfs :: BfsDistance minKnownBfs = BfsDistance 128 -- | The distance value that denotes no legal path between points, -- either due to blocked tiles or pathfinding aborted at earlier tiles, -- e.g., due to unknown tiles. apartBfs :: BfsDistance apartBfs = predBfsDistance minKnownBfs -- | Maximum value of the type. maxBfsDistance :: BfsDistance maxBfsDistance = BfsDistance (maxBound :: Word8) -- | The distance value that denotes that path search was aborted -- at this tile due to too large actual distance -- and that the tile was unknown. -- It is also a true distance value for this tile. abortedUnknownBfs :: BfsDistance abortedUnknownBfs = predBfsDistance apartBfs -- | Create and fill a BFS array for the given level. -- Unsafe array operations are OK here, because the intermediate -- values of the vector don't leak anywhere outside nor are kept unevaluated -- and so they can't be overwritten by the unsafe side-effect. -- -- When computing move cost, we assume doors openable at no cost, -- because other actors use them, too, so the cost is shared and the extra -- visiblity is valuable, too. We treat unknown tiles specially. -- Whether suspect tiles are considered openable depends on @smarkSuspect@. -- -- Instead of a BFS queue (list) we use the two tabs (arrays), for (JS) speed. fillBfs :: PointArray.Array Word8 -> Word8 -> Point -> (PA.PrimArray PointI, PA.PrimArray PointI) -> PointArray.Array BfsDistance fillBfs !lalter !alterSkill !source (!tabA, !tabB) = runST $ do let arr = PointArray.replicateA (PointArray.axsize lalter) (PointArray.aysize lalter) apartBfs vThawed <- U.unsafeThaw $ PointArray.avector arr tabAThawed <- PA.unsafeThawPrimArray tabA tabBThawed <- PA.unsafeThawPrimArray tabB fillBfsThawed lalter alterSkill (fromEnum source) (tabAThawed, tabBThawed) vThawed void $ PA.unsafeFreezePrimArray tabAThawed void $ PA.unsafeFreezePrimArray tabBThawed void $ U.unsafeFreeze vThawed return arr type QueueIx = Int type NextQueueIx = Int -- So very low-level that not even under EXPOSE_INTERNAL. fillBfsThawed :: forall s. PointArray.Array Word8 -> Word8 -> PointI -> (PA.MutablePrimArray s PointI, PA.MutablePrimArray s PointI) -> U.MVector s Word8 -> ST s () fillBfsThawed !lalter !alterSkill !sourceI (!tabAThawed, !tabBThawed) !vThawed = do let unsafeReadI :: PointI -> ST s BfsDistance {-# INLINE unsafeReadI #-} unsafeReadI p = BfsDistance <$> VM.unsafeRead vThawed p unsafeWriteI :: PointI -> BfsDistance -> ST s () {-# INLINE unsafeWriteI #-} unsafeWriteI p c = VM.unsafeWrite vThawed p (bfsDistance c) -- The two tabs (arrays) are used as a staged, optimized queue. -- The first tab is for writes, the second one for reads. -- They switch places in each recursive @bfs@ call. bfs :: PA.MutablePrimArray s PointI -> PA.MutablePrimArray s PointI -> BfsDistance -> QueueIx -> ST s () bfs !tabReadThawed !tabWriteThawed !distance !prevQueueIx = do let unsafeReadCurrent :: QueueIx -> ST s PointI {-# INLINE unsafeReadCurrent #-} unsafeReadCurrent = PA.readPrimArray tabReadThawed unsafeWriteNext :: QueueIx -> PointI -> ST s () {-# INLINE unsafeWriteNext #-} unsafeWriteNext = PA.writePrimArray tabWriteThawed -- The accumulator and the result represent the index into the next -- queue tab, incremented after each write. processQueue :: QueueIx -> NextQueueIx -> ST s NextQueueIx processQueue !currentQueueIx !acc1 = if currentQueueIx == -1 then return acc1 -- all queued positions inspected else do pos <- unsafeReadCurrent currentQueueIx let processMove :: (X, Y) -> NextQueueIx -> ST s NextQueueIx {-# INLINE processMove #-} processMove move acc2 = do let p = pos + inline fromEnum (uncurry Vector move) pDist <- unsafeReadI p if pDist /= apartBfs then return acc2 -- the position visited already else do let alter :: Word8 !alter = lalter `PointArray.accessI` p if | alterSkill < alter -> return acc2 | alter == 1 -> do let distCompl = distance .&. complement minKnownBfs unsafeWriteI p distCompl return acc2 | otherwise -> do unsafeWriteI p distance unsafeWriteNext acc2 p return $! acc2 + 1 -- Innermost loop over @moves@ manually unrolled for (JS) speed: return acc1 >>= processMove (-1, -1) >>= processMove (0, -1) >>= processMove (1, -1) >>= processMove (1, 0) >>= processMove (1, 1) >>= processMove (0, 1) >>= processMove (-1, 1) >>= processMove (-1, 0) -- Recursive call to process next queue element: >>= processQueue (currentQueueIx - 1) acc3 <- processQueue (prevQueueIx - 1) 0 let distanceNew = succBfsDistance distance if acc3 == 0 || distanceNew == maxBfsDistance then return () -- no more close enough dungeon positions else bfs tabWriteThawed tabReadThawed distanceNew acc3 VM.unsafeWrite vThawed sourceI (bfsDistance minKnownBfs) PA.writePrimArray tabAThawed 0 sourceI bfs tabAThawed tabBThawed (succBfsDistance minKnownBfs) 1 data AndPath = AndPath { pathSource :: Point -- never included in @pathList@ , pathList :: [Point] , pathGoal :: Point -- needn't be @last pathList@ , pathLen :: Int -- needn't be @length pathList@ } deriving (Show, Generic) instance Binary AndPath actorsAvoidedDist :: Int actorsAvoidedDist = 5 -- | Find a path, without the source position, with the smallest length. -- The @eps@ coefficient determines which direction (of the closest -- directions available) that path should prefer, where 0 means north-west -- and 1 means north. The path tries hard to avoid actors and tries to avoid -- tiles that need altering and ambient light. Actors are avoided only close -- to the start of the path, because elsewhere they are likely to move -- before they are reached. Even projectiles are avoided, -- which sometimes has the effect of choosing a safer route -- (regardless if the projectiles are friendly fire or not). -- -- An unwelcome side effect of avoiding actors is that friends will sometimes -- avoid displacing and instead perform two separate moves, wasting 1 turn -- in total. But in corridors they will still displace and elsewhere -- this scenario was quite rare already. findPathBfs :: BigActorMap -> PointArray.Array Word8 -> (PointI -> Bool) -> Point -> Point -> Int -> PointArray.Array BfsDistance -> Maybe AndPath {-# INLINE findPathBfs #-} findPathBfs lbig lalter fovLit pathSource pathGoal sepsRaw arr@PointArray.Array{..} = let !pathGoalI = fromEnum pathGoal !pathSourceI = fromEnum pathSource eps = sepsRaw `mod` 4 (mc1, mc2) = splitAt eps movesCardinalI (md1, md2) = splitAt eps movesDiagonalI -- Prefer cardinal directions when closer to the target, so that -- the enemy can't easily disengage. prefMoves = mc2 ++ reverse mc1 ++ md2 ++ reverse md1 -- fuzz track :: PointI -> BfsDistance -> [Point] -> [Point] track !pos !oldDist !suffix | oldDist == minKnownBfs = assert (pos == pathSourceI) suffix track pos oldDist suffix | oldDist == succBfsDistance minKnownBfs = let !posP = toEnum pos in posP : suffix -- avoid calculating minP and dist for the last call track pos oldDist suffix = let !dist = predBfsDistance oldDist minChild :: PointI -> Bool -> Word8 -> [VectorI] -> PointI minChild !minP _ _ [] = minP minChild minP maxDark minAlter (mv : mvs) = let !p = pos + mv backtrackingMove = BfsDistance (arr `PointArray.accessI` p) /= dist in if backtrackingMove then minChild minP maxDark minAlter mvs else let free = fromEnum (bfsDistance dist) < actorsAvoidedDist || p `IM.notMember` EM.enumMapToIntMap lbig alter | free = lalter `PointArray.accessI` p | otherwise = maxBound-1 -- occupied; disaster dark = not $ fovLit p -- Prefer paths without actors and through -- more easily opened tiles and, secondly, -- in the ambient dark (even if light carried, -- because it can be taken off at any moment). in if | alter == 0 && dark -> p -- speedup | alter < minAlter -> minChild p dark alter mvs | dark > maxDark && alter == minAlter -> minChild p dark alter mvs | otherwise -> minChild minP maxDark minAlter mvs -- @maxBound@ means not alterable, so some child will be lower !newPos = minChild pos{-dummy-} False maxBound prefMoves #ifdef WITH_EXPENSIVE_ASSERTIONS !_A = assert (newPos /= pos) () #endif !posP = toEnum pos in track newPos dist (posP : suffix) !goalDist = BfsDistance $ arr `PointArray.accessI` pathGoalI pathLen = fromEnum $ bfsDistance $ goalDist .&. complement minKnownBfs pathList = track pathGoalI (goalDist .|. minKnownBfs) [] andPath = AndPath{..} in assert (BfsDistance (arr `PointArray.accessI` pathSourceI) == minKnownBfs) $ if goalDist /= apartBfs && pathLen < 2 * chessDist pathSource pathGoal then Just andPath else let f :: (Point, Int, Int, Int) -> Point -> BfsDistance -> (Point, Int, Int, Int) f acc@(pAcc, dAcc, chessAcc, sumAcc) p d = if d <= abortedUnknownBfs -- works in visible secrets mode only || d /= apartBfs && adjacent p pathGoal -- works for stairs then let dist = fromEnum $ bfsDistance $ d .&. complement minKnownBfs chessNew = chessDist p pathGoal sumNew = dist + 2 * chessNew resNew = (p, dist, chessNew, sumNew) in case compare sumNew sumAcc of LT -> resNew EQ -> case compare chessNew chessAcc of LT -> resNew EQ -> case compare dist dAcc of LT -> resNew EQ | euclidDistSq p pathGoal < euclidDistSq pAcc pathGoal -> resNew _ -> acc _ -> acc _ -> acc else acc initAcc = (originPoint, maxBound, maxBound, maxBound) (pRes, dRes, _, sumRes) = PointArray.ifoldlA' f initAcc arr in if sumRes == maxBound || goalDist /= apartBfs && pathLen < sumRes then if goalDist /= apartBfs then Just andPath else Nothing else let pathList2 = track (fromEnum pRes) (BfsDistance (toEnum dRes) .|. minKnownBfs) [] in Just AndPath{pathList = pathList2, pathLen = sumRes, ..} -- | Access a BFS array and interpret the looked up distance value. accessBfs :: PointArray.Array BfsDistance -> Point -> Maybe Int accessBfs bfs p = let dist = bfs PointArray.! p in if PointArray.axsize bfs == 0 || dist == apartBfs then Nothing else Just $ fromEnum $ bfsDistance $ dist .&. complement minKnownBfs LambdaHack-0.9.5.0/engine-src/Game/LambdaHack/Client/BfsM.hs0000644000000000000000000005450507346545000021307 0ustar0000000000000000{-# LANGUAGE TupleSections #-} -- | Breadth first search and related algorithms using the client monad. module Game.LambdaHack.Client.BfsM ( invalidateBfsAid, invalidateBfsPathAid , invalidateBfsLid, invalidateBfsPathLid , invalidateBfsAll, invalidateBfsPathAll , createBfs, getCacheBfsAndPath, getCacheBfs , getCachePath, createPath, condBFS , furthestKnown, closestUnknown, closestSmell , FleeViaStairsOrEscape(..) , embedBenefit, closestTriggers, condEnoughGearM, closestItems, closestFoes #ifdef EXPOSE_INTERNAL , unexploredDepth, updatePathFromBfs #endif ) where import Prelude () import Game.LambdaHack.Core.Prelude import qualified Data.EnumMap.Strict as EM import qualified Data.EnumSet as ES import Data.Ord import Data.Word import Game.LambdaHack.Client.Bfs import Game.LambdaHack.Client.CommonM import Game.LambdaHack.Client.MonadClient import Game.LambdaHack.Client.State import Game.LambdaHack.Common.Actor import Game.LambdaHack.Common.ActorState import Game.LambdaHack.Common.Faction import Game.LambdaHack.Common.Item import qualified Game.LambdaHack.Common.ItemAspect as IA import Game.LambdaHack.Common.Kind import Game.LambdaHack.Common.Level import Game.LambdaHack.Common.MonadStateRead import Game.LambdaHack.Common.State import qualified Game.LambdaHack.Common.Tile as Tile import Game.LambdaHack.Common.Time import Game.LambdaHack.Common.Types import Game.LambdaHack.Common.Vector import qualified Game.LambdaHack.Content.ItemKind as IK import Game.LambdaHack.Content.ModeKind import Game.LambdaHack.Content.RuleKind import Game.LambdaHack.Content.TileKind (isUknownSpace) import Game.LambdaHack.Common.Point import qualified Game.LambdaHack.Common.PointArray as PointArray import Game.LambdaHack.Core.Random import qualified Game.LambdaHack.Definition.Ability as Ability import Game.LambdaHack.Definition.Defs invalidateBfsAid :: MonadClient m => ActorId -> m () invalidateBfsAid aid = modifyClient $ \cli -> cli {sbfsD = EM.insert aid BfsInvalid (sbfsD cli)} invalidateBfsPathAid :: MonadClient m => ActorId -> m () invalidateBfsPathAid aid = do let f BfsInvalid = BfsInvalid f (BfsAndPath bfsArr _) = BfsAndPath bfsArr EM.empty modifyClient $ \cli -> cli {sbfsD = EM.adjust f aid (sbfsD cli)} invalidateBfsLid :: MonadClient m => LevelId -> m () invalidateBfsLid lid = do side <- getsClient sside let f (_, b) = blid b == lid && bfid b == side && not (bproj b) as <- getsState $ filter f . EM.assocs . sactorD mapM_ (invalidateBfsAid . fst) as invalidateBfsPathLid :: MonadClient m => LevelId -> Point -> m () invalidateBfsPathLid lid pos = do side <- getsClient sside let f (_, b) = blid b == lid && bfid b == side && not (bproj b) && chessDist pos (bpos b) < actorsAvoidedDist -- rough approximation, but kicks in well before blockage as <- getsState $ filter f . EM.assocs . sactorD mapM_ (invalidateBfsPathAid . fst) as invalidateBfsAll :: MonadClient m => m () invalidateBfsAll = modifyClient $ \cli -> cli {sbfsD = EM.map (const BfsInvalid) (sbfsD cli)} invalidateBfsPathAll :: MonadClient m => m () invalidateBfsPathAll = do let f BfsInvalid = BfsInvalid f (BfsAndPath bfsArr _) = BfsAndPath bfsArr EM.empty modifyClient $ \cli -> cli {sbfsD = EM.map f (sbfsD cli)} createBfs :: MonadClientRead m => Bool -> Word8 -> ActorId -> m (PointArray.Array BfsDistance) createBfs canMove alterSkill0 aid = if canMove then do b <- getsState $ getActorBody aid salter <- getsClient salter let source = bpos b lalter = salter EM.! blid b alterSkill = max 1 alterSkill0 -- We increase 0 skill to 1, to also path through unknown tiles. -- Since there are no other tiles that require skill 1, this is safe. stabs <- getsClient stabs return $! fillBfs lalter alterSkill source stabs else return PointArray.empty updatePathFromBfs :: MonadClient m => Bool -> BfsAndPath -> ActorId -> Point -> m (PointArray.Array BfsDistance, Maybe AndPath) updatePathFromBfs canMove bfsAndPathOld aid !target = do COps{coTileSpeedup} <- getsState scops let (oldBfsArr, oldBfsPath) = case bfsAndPathOld of (BfsAndPath bfsArr bfsPath) -> (bfsArr, bfsPath) BfsInvalid -> error $ "" `showFailure` (bfsAndPathOld, aid, target) let bfsArr = oldBfsArr if not canMove then return (bfsArr, Nothing) else do b <- getsState $ getActorBody aid let lid = blid b seps <- getsClient seps salter <- getsClient salter lvl <- getLevel lid let !lalter = salter EM.! lid fovLit p = Tile.isLit coTileSpeedup $ PointArray.fromUnboxRep $ ltile lvl `PointArray.accessI` p !source = bpos b !mpath = findPathBfs (EM.delete source $ lbig lvl) -- don't sidestep oneself lalter fovLit source target seps bfsArr !bfsPath = maybe oldBfsPath (\path -> EM.insert target path oldBfsPath) mpath bap = BfsAndPath bfsArr bfsPath modifyClient $ \cli -> cli {sbfsD = EM.insert aid bap $ sbfsD cli} return (bfsArr, mpath) -- | Get cached BFS array and path or, if not stored, generate and store first. getCacheBfsAndPath :: forall m. MonadClient m => ActorId -> Point -> m (PointArray.Array BfsDistance, Maybe AndPath) getCacheBfsAndPath aid target = do mbfs <- getsClient $ EM.lookup aid . sbfsD case mbfs of Just bap@(BfsAndPath bfsArr bfsPath) -> case EM.lookup target bfsPath of Nothing -> do (!canMove, _) <- condBFS aid updatePathFromBfs canMove bap aid target mpath@Just{} -> return (bfsArr, mpath) _ -> do (canMove, alterSkill) <- condBFS aid !bfsArr <- createBfs canMove alterSkill aid let bfsPath = EM.empty updatePathFromBfs canMove (BfsAndPath bfsArr bfsPath) aid target -- | Get cached BFS array or, if not stored, generate and store first. getCacheBfs :: MonadClient m => ActorId -> m (PointArray.Array BfsDistance) getCacheBfs aid = do mbfs <- getsClient $ EM.lookup aid . sbfsD case mbfs of Just (BfsAndPath bfsArr _) -> return bfsArr _ -> do (canMove, alterSkill) <- condBFS aid !bfsArr <- createBfs canMove alterSkill aid let bfsPath = EM.empty modifyClient $ \cli -> cli {sbfsD = EM.insert aid (BfsAndPath bfsArr bfsPath) (sbfsD cli)} return bfsArr -- | Get cached BFS path or, if not stored, generate and store first. getCachePath :: MonadClient m => ActorId -> Point -> m (Maybe AndPath) getCachePath aid target = do b <- getsState $ getActorBody aid let source = bpos b if | source == target -> return $ Just $ AndPath (bpos b) [] target 0 -- speedup | otherwise -> snd <$> getCacheBfsAndPath aid target createPath :: MonadClient m => ActorId -> Target -> m TgtAndPath createPath aid tapTgt = do COps{coTileSpeedup} <- getsState scops b <- getsState $ getActorBody aid lvl <- getLevel $ blid b let stopAtUnwalkable tapPath@(Just AndPath{..}) = let (walkable, rest) = -- Unknown tiles are not walkable, so path stops at first such. -- which is good, because by the time actor reaches the tile, -- it is known and target is recalculated with new info. span (Tile.isWalkable coTileSpeedup . at lvl) pathList in case rest of [] -> TgtAndPath{..} [g] | g == pathGoal -> TgtAndPath{..} newGoal : _ -> let newTgt = TPoint TBlock (blid b) newGoal newPath = AndPath{ pathSource = bpos b , pathList = walkable ++ [newGoal] , pathGoal = newGoal , pathLen = length walkable + 1 } in TgtAndPath{tapTgt = newTgt, tapPath = Just newPath} stopAtUnwalkable Nothing = TgtAndPath{tapTgt, tapPath=Nothing} mpos <- getsState $ aidTgtToPos aid (blid b) (Just tapTgt) case mpos of Nothing -> return TgtAndPath{tapTgt, tapPath=Nothing} Just p -> do path <- getCachePath aid p return $! stopAtUnwalkable path condBFS :: MonadClientRead m => ActorId -> m (Bool, Word8) condBFS aid = do side <- getsClient sside -- We assume the actor eventually becomes a leader (or has the same -- set of skills as the leader, anyway). Otherwise we'd have -- to reset BFS after leader changes, but it would still lead to -- wasted movement if, e.g., non-leaders move but only leaders open doors -- and leader change is very rare. actorMaxSk <- getsState $ getActorMaxSkills aid let alterSkill = min (maxBound - 1) -- @maxBound :: Word8@ means unalterable (toEnum $ max 0 $ Ability.getSk Ability.SkAlter actorMaxSk) canMove = Ability.getSk Ability.SkMove actorMaxSk > 0 || Ability.getSk Ability.SkDisplace actorMaxSk > 0 || Ability.getSk Ability.SkProject actorMaxSk > 0 smarkSuspect <- getsClient smarkSuspect fact <- getsState $ (EM.! side) . sfactionD let underAI = isAIFact fact -- Under UI, playing a hero party, we let AI set our target each -- turn for henchmen that can't move and can't alter, usually to TUnknown. -- This is rather useless, but correct. enterSuspect = smarkSuspect > 0 || underAI skill | enterSuspect = alterSkill -- dig and search as skill allows | otherwise = 0 -- only walkable tiles return (canMove, skill) -- keep it lazy -- | Furthest (wrt paths) known position. furthestKnown :: MonadClient m => ActorId -> m Point furthestKnown aid = do bfs <- getCacheBfs aid getMaxIndex <- rndToAction $ oneOf [ PointArray.maxIndexA , PointArray.maxLastIndexA ] let furthestPos = getMaxIndex bfs dist = bfs PointArray.! furthestPos return $! assert (dist > apartBfs `blame` (aid, furthestPos, dist)) furthestPos -- | Closest reachable unknown tile position, if any. -- -- Note: some of these tiles are behind suspect tiles and they are chosen -- in preference to more distant directly accessible unknown tiles. -- This is in principle OK, but in dungeons with few hidden doors -- AI is at a disadvantage (and with many hidden doors, it fares as well -- as a human that deduced the dungeon properties). Changing Bfs to accomodate -- all dungeon styles would be complex and would slow down the engine. -- -- If the level has inaccessible open areas (at least from the stairs AI used) -- the level will be nevertheless here finally marked explored, -- to enable transition to other levels. -- We should generally avoid such levels, because digging and/or trying -- to find other stairs leading to disconnected areas is not KISS -- so we don't do this in AI, so AI is at a disadvantage. -- -- If the closest unknown is more than 126 tiles away from the targetting -- actor, the level will marked as explored. We could complicate the code -- and not mark if the unknown is too far as opposed to inaccessible, -- but then if it is both too distant and inaccessible, AI would be -- permanently stuck on such levels. To cope with this, escapes need to be -- placed on open or small levels, or in dispersed enough that they don't -- appear in such potentially unexplored potions of caves. Other than that, -- this is rather harmless and hard to exploit, so let it be. -- The principled way to fix this would be to extend BFS to @Word16@, -- but then it takes too long to compute on maze levels, so we'd need -- to optimize hard for JS. closestUnknown :: MonadClient m => ActorId -> m (Maybe Point) closestUnknown aid = do body <- getsState $ getActorBody aid lvl <- getLevel $ blid body bfs <- getCacheBfs aid let closestPoss = PointArray.minIndexesA bfs dist = bfs PointArray.! head closestPoss !_A = assert (lexpl lvl >= lseen lvl) () return $! if lexpl lvl <= lseen lvl -- Some unknown may still be visible and even pathable, but we already -- know from global level info that they are inaccessible. || dist >= apartBfs -- Global level info may tell us that terrain was changed and so -- some new explorable tile appeared, but we don't care about those -- and we know we already explored all initially seen unknown tiles -- and it's enough for us (otherwise we'd need to hunt all around -- the map for tiles altered by enemies). then Nothing else let unknownAround pos = let vic = vicinityUnsafe pos countUnknown :: Int -> Point -> Int countUnknown c p = if isUknownSpace $ lvl `at` p then c + 1 else c in foldl' countUnknown 0 vic cmp = comparing unknownAround in Just $ maximumBy cmp closestPoss -- | Finds smells closest to the actor, except under the actor, -- because actors consume smell only moving over them, not standing. -- Of the closest, prefers the newest smell. closestSmell :: MonadClient m => ActorId -> m [(Int, (Point, Time))] closestSmell aid = do body <- getsState $ getActorBody aid Level{lsmell, ltime} <- getLevel $ blid body let smells = filter (\(p, sm) -> sm > ltime && p /= bpos body) (EM.assocs lsmell) case smells of [] -> return [] _ -> do bfs <- getCacheBfs aid let ts = mapMaybe (\x@(p, _) -> fmap (,x) (accessBfs bfs p)) smells return $! sortBy (comparing (fst &&& absoluteTimeNegate . snd . snd)) ts data FleeViaStairsOrEscape = ViaStairs | ViaStairsUp | ViaStairsDown | ViaEscape | ViaExit -- can change whenever @sexplored@ changes | ViaNothing | ViaAnything deriving (Show, Eq) embedBenefit :: MonadClientRead m => FleeViaStairsOrEscape -> ActorId -> [(Point, ItemBag)] -> m [(Double, (Point, ItemBag))] embedBenefit fleeVia aid pbags = do COps{coTileSpeedup} <- getsState scops dungeon <- getsState sdungeon explored <- getsClient sexplored b <- getsState $ getActorBody aid actorSk <- if fleeVia `elem` [ViaAnything, ViaExit] -- targeting, possibly when not a leader then getsState $ getActorMaxSkills aid else currentSkillsClient aid let alterSkill = Ability.getSk Ability.SkAlter actorSk fact <- getsState $ (EM.! bfid b) . sfactionD lvl <- getLevel (blid b) unexploredTrue <- unexploredDepth True (blid b) unexploredFalse <- unexploredDepth False (blid b) condEnoughGear <- condEnoughGearM aid discoBenefit <- getsClient sdiscoBenefit getKind <- getsState $ flip getIidKind let alterMinSkill p = Tile.alterMinSkill coTileSpeedup $ lvl `at` p lidExplored = ES.member (blid b) explored allExplored = ES.size explored == EM.size dungeon -- Ignoring the number of items, because only one of each @iid@ -- is triggered at the same time, others are left to be used later on. -- Taking the kind the item hides under into consideration, because -- it's a best guess only, for AI and UI. iidToEffs iid = IK.ieffects $ getKind iid feats bag = concatMap iidToEffs $ EM.keys bag -- For simplicity, we assume at most one exit at each position. -- AI uses exit regardless of traps or treasures at the spot. bens (_, bag) = case find IK.isEffEscapeOrAscend $ feats bag of Just IK.Escape{} -> -- Escape (or guard) only after exploring, for high score, etc. let escapeOrGuard = fcanEscape (gplayer fact) || fleeVia `elem` [ViaExit] -- target to guard after explored in if fleeVia `elem` [ViaAnything, ViaEscape, ViaExit] && escapeOrGuard && allExplored then 10 else 0 -- don't escape prematurely Just (IK.Ascend up) -> -- change levels sensibly, in teams let easier = up /= (fromEnum (blid b) > 0) unexpForth = if up then unexploredTrue else unexploredFalse unexpBack = if not up then unexploredTrue else unexploredFalse -- Forbid loops via peeking at unexplored and getting back. aiCond = if unexpForth then easier && condEnoughGear || (not unexpBack || easier) && lidExplored else easier && allExplored && null (lescape lvl) -- Prefer one direction of stairs, to team up -- and prefer embed (may, e.g., create loot) over stairs. v = if aiCond then if easier then 10 else 1 else 0 in case fleeVia of ViaStairsUp | up -> 1 ViaStairsDown | not up -> 1 ViaStairs -> v ViaExit -> v ViaAnything -> v _ -> 0 -- don't ascend prematurely _ -> if fleeVia `elem` [ViaNothing, ViaAnything] then -- Actor uses the embedded item on himself, hence @benApply@. -- Let distance be the deciding factor and also prevent -- overflow on 32-bit machines. let sacrificeForExperiment = 101 -- single explosion acceptable sumBen = sum $ map (\iid -> benApply $ discoBenefit EM.! iid) (EM.keys bag) in min 1000 $ sacrificeForExperiment + sumBen else 0 underFeet p = p == bpos b -- if enter and alter, be more permissive -- Only actors with high enough @SkAlter@ can trigger terrain. -- If apply skill not high enough for embedded items, AI will only -- guard such tiles, assuming they must be advanced and so crucial. f (p, _) = underFeet p || alterSkill >= fromEnum (alterMinSkill p) benFeats = map (\pbag -> (bens pbag, pbag)) $ filter f pbags considered (benefitAndSacrifice, (p, _bag)) = benefitAndSacrifice > 0 -- For speed and to avoid greedy AI loops, only experiment with few. && Tile.consideredByAI coTileSpeedup (lvl `at` p) return $! filter considered benFeats -- | Closest (wrt paths) AI-triggerable tiles with embedded items. -- In AI, the level the actor is on is either explored or the actor already -- has a weapon equipped, so no need to explore further, he tries to find -- enemies on other levels, but before that, he triggers other tiles -- in hope of some loot or beneficial effect to enter next level with. closestTriggers :: MonadClient m => FleeViaStairsOrEscape -> ActorId -> m [(Int, (Point, (Point, ItemBag)))] closestTriggers fleeVia aid = do COps{corule=RuleContent{rXmax, rYmax}} <- getsState scops b <- getsState $ getActorBody aid lvl <- getLevel (blid b) let pbags = EM.assocs $ lembed lvl efeat <- embedBenefit fleeVia aid pbags -- The advantage of targeting the tiles in vicinity of triggers is that -- triggers don't need to be pathable (and so AI doesn't bump into them -- by chance while walking elsewhere) and that many accesses to the tiles -- are more likely to be targeted by different AI actors (even starting -- from the same location), so there is less risk of clogging stairs and, -- OTOH, siege of stairs or escapes is more effective. bfs <- getCacheBfs aid let vicTrigger (cid, (p0, bag)) = map (\p -> (cid, (p, (p0, bag)))) $ vicinityBounded rXmax rYmax p0 vicAll = concatMap vicTrigger efeat return $! let mix (benefit, ppbag) dist = let maxd = subtractBfsDistance maxBfsDistance apartBfs v = fromIntegral $ (1 + maxd - dist) ^ (2 :: Int) in (ceiling $ benefit * v, ppbag) in mapMaybe (\bpp@(_, (p, _)) -> mix bpp <$> accessBfs bfs p) vicAll -- | Check whether the actor has enough gear to go look for enemies. -- We assume weapons in equipment are better than any among organs -- or at least provide some essential diversity. -- Disabled if, due to tactic, actors follow leader and so would -- repeatedly move towards and away form stairs at leader change, -- depending on current leader's gear. -- Number of items of a single kind is ignored, because variety is needed. condEnoughGearM :: MonadClientRead m => ActorId -> m Bool condEnoughGearM aid = do b <- getsState $ getActorBody aid fact <- getsState $ (EM.! bfid b) . sfactionD let followTactic = ftactic (gplayer fact) `elem` [Ability.TFollow, Ability.TFollowNoItems] eqpAssocs <- getsState $ fullAssocs aid [CEqp] invAssocs <- getsState $ getActorAssocs aid CInv return $ not followTactic -- keep it lazy && (any (IA.checkFlag Ability.Meleeable . aspectRecordFull . snd) eqpAssocs || length eqpAssocs + length invAssocs >= 5) unexploredDepth :: MonadClientRead m => Bool -> LevelId -> m Bool unexploredDepth !up !lidCurrent = do dungeon <- getsState sdungeon explored <- getsClient sexplored let allExplored = ES.size explored == EM.size dungeon unexploredD = let unex !lid = allExplored && not (null $ lescape $ dungeon EM.! lid) || ES.notMember lid explored || unexploredD lid in any unex . ascendInBranch dungeon up return $ unexploredD lidCurrent -- keep it lazy -- | Closest (wrt paths) items. closestItems :: MonadClient m => ActorId -> m [(Int, (Point, ItemBag))] closestItems aid = do actorMaxSk <- getsState $ getActorMaxSkills aid if Ability.getSk Ability.SkMoveItem actorMaxSk <= 0 then return [] else do body <- getsState $ getActorBody aid Level{lfloor} <- getLevel $ blid body if EM.null lfloor then return [] else do bfs <- getCacheBfs aid let mix pbag dist = let maxd = subtractBfsDistance maxBfsDistance apartBfs -- Beware of overflowing 32-bit integers. -- Here distance is the only factor influencing frequency. -- Whether item is desirable is checked later on. v = (maxd * 10) `div` (dist + 1) in (v, pbag) return $! mapMaybe (\(p, bag) -> mix (p, bag) <$> accessBfs bfs p) (EM.assocs lfloor) -- | Closest (wrt paths) enemy actors. closestFoes :: MonadClient m => [(ActorId, Actor)] -> ActorId -> m [(Int, (ActorId, Actor))] closestFoes foes aid = case foes of [] -> return [] _ -> do bfs <- getCacheBfs aid let ds = mapMaybe (\x@(_, b) -> fmap (,x) (accessBfs bfs (bpos b))) foes return $! sortBy (comparing fst) ds LambdaHack-0.9.5.0/engine-src/Game/LambdaHack/Client/ClientOptions.hs0000644000000000000000000000643307346545000023247 0ustar0000000000000000{-# LANGUAGE DeriveGeneric #-} -- | Options that affect the behaviour of the client. module Game.LambdaHack.Client.ClientOptions ( ClientOptions(..), defClientOptions ) where import Prelude () import Game.LambdaHack.Core.Prelude import Data.Binary import GHC.Generics (Generic) -- | Options that affect the behaviour of the client (but not game rules). data ClientOptions = ClientOptions { sgtkFontFamily :: Maybe Text -- ^ Font family to use for the GTK main game window. , sdlFontFile :: Maybe Text -- ^ Font file to use for the SDL2 main game window. , sdlScalableSizeAdd :: Maybe Int -- ^ Pixels to add to map cells on top of scalable font max glyph height. -- To get symmetric padding, add an even number. , sdlBitmapSizeAdd :: Maybe Int -- ^ Pixels to add to map cells on top of fixed font max glyph height. -- To get symmetric padding, add an even number. , sscalableFontSize :: Maybe Int -- ^ Font size to use for the main game window. , slogPriority :: Maybe Int -- ^ How much to log (e.g., from SDL). 1 is all, 5 is errors, the default. , smaxFps :: Maybe Int -- ^ Maximal frames per second. -- This is better low and fixed, to avoid jerkiness and delays -- that tell the player there are many intelligent enemies on the level. -- That's better than scaling AI sofistication down based -- on the FPS setting and machine speed. , sdisableAutoYes :: Bool -- ^ Never auto-answer all prompts, even if under AI control. , snoAnim :: Maybe Bool -- ^ Don't show any animations. , snewGameCli :: Bool -- ^ Start a new game, overwriting the save file. , sbenchmark :: Bool -- ^ Don't create directories and files and show time stats. , stitle :: Maybe Text , sfontDir :: Maybe FilePath , ssavePrefixCli :: String -- ^ Prefix of the save game file name. , sfrontendTeletype :: Bool -- ^ Whether to use the stdout/stdin frontend. , sfrontendNull :: Bool -- ^ Whether to use null (no input/output) frontend. , sfrontendLazy :: Bool -- ^ Whether to use lazy (output not even calculated) frontend. , sdbgMsgCli :: Bool -- ^ Show clients' internal debug messages. , sstopAfterSeconds :: Maybe Int , sstopAfterFrames :: Maybe Int , sprintEachScreen :: Bool , sexposePlaces :: Bool , sexposeItems :: Bool , sexposeActors :: Bool } deriving (Show, Eq, Generic) instance Binary ClientOptions -- | Default value of client options. defClientOptions :: ClientOptions defClientOptions = ClientOptions { sgtkFontFamily = Nothing , sdlFontFile = Nothing , sdlScalableSizeAdd = Nothing , sdlBitmapSizeAdd = Nothing , sscalableFontSize = Nothing , slogPriority = Nothing , smaxFps = Nothing , sdisableAutoYes = False , snoAnim = Nothing , snewGameCli = False , sbenchmark = False , stitle = Nothing , sfontDir = Nothing , ssavePrefixCli = "" , sfrontendTeletype = False , sfrontendNull = False , sfrontendLazy = False , sdbgMsgCli = False , sstopAfterSeconds = Nothing , sstopAfterFrames = Nothing , sprintEachScreen = False , sexposePlaces = False , sexposeItems = False , sexposeActors = False } LambdaHack-0.9.5.0/engine-src/Game/LambdaHack/Client/CommonM.hs0000644000000000000000000001717007346545000022022 0ustar0000000000000000-- | Common client monad operations. module Game.LambdaHack.Client.CommonM ( getPerFid, aidTgtToPos, makeLine , currentSkillsClient, pickWeaponClient , updateSalter, createSalter ) where import Prelude () import Game.LambdaHack.Core.Prelude import qualified Data.EnumMap.Strict as EM import Game.LambdaHack.Client.MonadClient import Game.LambdaHack.Client.Request import Game.LambdaHack.Client.State import qualified Game.LambdaHack.Definition.Ability as Ability import Game.LambdaHack.Common.Actor import Game.LambdaHack.Common.ActorState import Game.LambdaHack.Definition.Defs import Game.LambdaHack.Common.Faction import Game.LambdaHack.Common.Item import qualified Game.LambdaHack.Common.ItemAspect as IA import Game.LambdaHack.Common.Kind import Game.LambdaHack.Common.Level import Game.LambdaHack.Common.MonadStateRead import Game.LambdaHack.Common.Perception import Game.LambdaHack.Common.Point import qualified Game.LambdaHack.Common.PointArray as PointArray import Game.LambdaHack.Core.Random import Game.LambdaHack.Common.State import qualified Game.LambdaHack.Common.Tile as Tile import Game.LambdaHack.Common.Types import Game.LambdaHack.Common.Vector import Game.LambdaHack.Content.RuleKind import Game.LambdaHack.Content.TileKind (TileKind, isUknownSpace) -- | Get the current perception of a client. getPerFid :: MonadClientRead m => LevelId -> m Perception getPerFid lid = do fper <- getsClient sfper let assFail = error $ "no perception at given level" `showFailure` (lid, fper) return $! EM.findWithDefault assFail lid fper -- | Calculate the position of an actor's target. aidTgtToPos :: ActorId -> LevelId -> Maybe Target -> State -> Maybe Point aidTgtToPos _ _ Nothing _ = Nothing aidTgtToPos aid lidV (Just tgt) s = case tgt of TEnemy a -> let body = getActorBody a s in if blid body == lidV then Just (bpos body) else Nothing TNonEnemy a -> let body = getActorBody a s in if blid body == lidV then Just (bpos body) else Nothing TPoint _ lid p -> if lid == lidV then Just p else Nothing TVector v -> let COps{corule=RuleContent{rXmax, rYmax}} = scops s b = getActorBody aid s shifted = shiftBounded rXmax rYmax (bpos b) v in if shifted == bpos b && v /= Vector 0 0 then Nothing else Just shifted -- | Counts the number of steps until the projectile would hit a non-projectile -- actor or obstacle. Starts searching with the given eps and returns -- the first found eps for which the number reaches the distance between -- actor and target position, or Nothing if none can be found. makeLine :: MonadStateRead m => Bool -> Actor -> Point -> Int -> m (Maybe Int) makeLine onlyFirst body fpos epsOld = do COps{corule=RuleContent{rXmax, rYmax}, coTileSpeedup} <- getsState scops lvl <- getLevel (blid body) let dist = chessDist (bpos body) fpos calcScore eps = case bla rXmax rYmax eps (bpos body) fpos of Just bl -> let blDist = take (dist - 1) bl -- goal not checked; actor well aware noActor p = p == fpos || not (occupiedBigLvl p lvl) accessibleUnknown tpos = let tt = lvl `at` tpos in Tile.isWalkable coTileSpeedup tt || isUknownSpace tt accessU = all noActor blDist && all accessibleUnknown blDist accessFirst | not onlyFirst = False | otherwise = all noActor (take 1 blDist) && all accessibleUnknown (take 1 blDist) nUnknown = length $ filter (isUknownSpace . (lvl `at`)) blDist in if | accessU -> - nUnknown | accessFirst -> -10000 | otherwise -> minBound Nothing -> error $ "" `showFailure` (body, fpos, epsOld) tryLines curEps (acc, _) | curEps == epsOld + dist = acc tryLines curEps (acc, bestScore) = let curScore = calcScore curEps newAcc = if curScore > bestScore then (Just curEps, curScore) else (acc, bestScore) in tryLines (curEps + 1) newAcc return $! if | dist <= 0 -> Nothing -- ProjectAimOnself | calcScore epsOld > minBound -> Just epsOld -- keep old | otherwise -> tryLines (epsOld + 1) (Nothing, minBound) -- generate best -- @MonadStateRead@ would be enough, but the logic is sound only on client. currentSkillsClient :: MonadClientRead m => ActorId -> m Ability.Skills currentSkillsClient aid = do body <- getsState $ getActorBody aid side <- getsClient sside -- Newest Leader in sleader, not yet in sfactionD. mleader <- if bfid body == side then getsClient sleader else do fact <- getsState $ (EM.! bfid body) . sfactionD return $! gleader fact getsState $ actorCurrentSkills mleader aid -- keep it lazy -- Client has to choose the weapon based on its partial knowledge, -- because if server chose it, it would leak item discovery information. -- -- Note that currently the aspects of the target actor are not considered, -- because all weapons share the sum of all source actor aspects and only differ -- in damage (equally important for all targets) and effects (really hard -- to tell which is better for which target or even which is better -- for the same target, so it's random). If only individual weapon's +toHit -- was applied to the target, situation would be much more complex, -- which is precisely why we keep it as is and let the player make choices -- by equipping and unequipping weapons instead. Content should ensure -- that the rule of thumb (which AI uses) that more weapons is better -- should give good results almost always, at least at the start of the game, -- to limit micromanagement and to spare newbies. -- -- Note that situation is completely different with choosing projectiles -- against a particular foe, even before (potential) splash damage -- that hits multiple tagets comes into the equation. AI has to be very -- primitive and random here as well. pickWeaponClient :: MonadClient m => ActorId -> ActorId -> m (Maybe RequestTimed) pickWeaponClient source target = do eqpAssocs <- getsState $ kitAssocs source [CEqp] bodyAssocs <- getsState $ kitAssocs source [COrgan] actorSk <- currentSkillsClient source let kitAssRaw = eqpAssocs ++ bodyAssocs kitAss = filter (IA.checkFlag Ability.Meleeable . aspectRecordFull . fst . snd) kitAssRaw discoBenefit <- getsClient sdiscoBenefit strongest <- pickWeaponM False (Just discoBenefit) kitAss actorSk source case strongest of [] -> return Nothing iis@((maxS, _) : _) -> do let maxIis = map snd $ takeWhile ((== maxS) . fst) iis (_, (iid, _)) <- rndToAction $ oneOf maxIis -- Prefer COrgan, to hint to the player to trash the equivalent CEqp item. let cstore = if isJust (lookup iid bodyAssocs) then COrgan else CEqp return $ Just $ ReqMelee target iid cstore updateSalter :: MonadClient m => LevelId -> [(Point, ContentId TileKind)] -> m () updateSalter lid pts = do COps{coTileSpeedup} <- getsState scops let pas = map (second $ toEnum . Tile.alterMinWalk coTileSpeedup) pts f = (PointArray.// pas) modifyClient $ \cli -> cli {salter = EM.adjust f lid $ salter cli} createSalter :: State -> AlterLid createSalter s = let COps{coTileSpeedup} = scops s f Level{ltile} = PointArray.mapA (toEnum . Tile.alterMinWalk coTileSpeedup) ltile in EM.map f $ sdungeon s LambdaHack-0.9.5.0/engine-src/Game/LambdaHack/Client/HandleAtomicM.hs0000644000000000000000000004413307346545000023121 0ustar0000000000000000-- | Handle atomic commands received by the client. module Game.LambdaHack.Client.HandleAtomicM ( MonadClientSetup(..) , cmdAtomicSemCli #ifdef EXPOSE_INTERNAL -- * Internal operations , invalidateInMelee, wipeBfsIfItemAffectsSkills, tileChangeAffectsBfs , createActor, destroyActor , addItemToDiscoBenefit, perception , discoverKind, discoverKindAndAspect, coverKind, coverAspectAndKind , discoverAspect, coverAspect , killExit #endif ) where import Prelude () import Game.LambdaHack.Core.Prelude import qualified Data.EnumMap.Strict as EM import qualified Data.EnumSet as ES import qualified Data.Map.Strict as M import Data.Ord import Game.LambdaHack.Atomic import Game.LambdaHack.Client.Bfs import Game.LambdaHack.Client.BfsM import Game.LambdaHack.Client.CommonM import Game.LambdaHack.Client.MonadClient import Game.LambdaHack.Client.Preferences import Game.LambdaHack.Client.State import Game.LambdaHack.Common.Actor import Game.LambdaHack.Common.ActorState import Game.LambdaHack.Common.Faction import Game.LambdaHack.Common.Item import Game.LambdaHack.Common.Kind import Game.LambdaHack.Common.Level import Game.LambdaHack.Common.MonadStateRead import Game.LambdaHack.Common.Perception import Game.LambdaHack.Common.State import qualified Game.LambdaHack.Common.Tile as Tile import Game.LambdaHack.Common.Types import qualified Game.LambdaHack.Content.CaveKind as CK import Game.LambdaHack.Content.ModeKind import Game.LambdaHack.Content.TileKind (TileKind) import Game.LambdaHack.Definition.Defs -- | Client monad for saving and restarting games. class MonadClient m => MonadClientSetup m where saveClient :: m () restartClient :: m () -- | Effect of atomic actions on client state. It is calculated -- with the global state from after the command is executed -- (except where the supplied @oldState@ is used). cmdAtomicSemCli :: MonadClientSetup m => State -> UpdAtomic -> m () {-# INLINE cmdAtomicSemCli #-} cmdAtomicSemCli oldState cmd = case cmd of UpdCreateActor aid b ais -> createActor aid b ais UpdDestroyActor aid b _ -> destroyActor aid b True UpdCreateItem iid _ _ (CActor aid store) -> do wipeBfsIfItemAffectsSkills [store] aid addItemToDiscoBenefit iid UpdCreateItem iid _ _ _ -> addItemToDiscoBenefit iid UpdDestroyItem _ _ _ (CActor aid store) -> wipeBfsIfItemAffectsSkills [store] aid UpdDestroyItem{} -> return () UpdSpotActor aid b ais -> createActor aid b ais UpdLoseActor aid b _ -> destroyActor aid b False UpdSpotItem _ iid _ _ (CActor aid store) -> do wipeBfsIfItemAffectsSkills [store] aid addItemToDiscoBenefit iid UpdSpotItem _ iid _ _ _ -> addItemToDiscoBenefit iid UpdLoseItem _ _ _ _ (CActor aid store) -> wipeBfsIfItemAffectsSkills [store] aid UpdLoseItem{} -> return () UpdSpotItemBag (CActor aid store) _bag ais -> do wipeBfsIfItemAffectsSkills [store] aid mapM_ (addItemToDiscoBenefit . fst) ais UpdSpotItemBag _ _ ais -> mapM_ (addItemToDiscoBenefit . fst) ais UpdLoseItemBag (CActor aid store) _bag _ais -> wipeBfsIfItemAffectsSkills [store] aid UpdLoseItemBag{} -> return () UpdMoveActor aid _ _ -> do invalidateBfsAid aid b <- getsState $ getActorBody aid -- Too costly to take projectiles into account. If blocked by them, -- instead we wait for them to move aside or we hit them. -- They are still considered whenever an actor moves himself -- and so his whole BFS data is invalidated. unless (bproj b) $ invalidateBfsPathLid (blid b) $ bpos b invalidateInMelee (blid b) UpdWaitActor aid _fromW toW -> -- So that we can later ignore such actors when updating targets -- and not risk they beling pushed/displaces and targets getting wrong. when (toW == WSleep) $ modifyClient $ updateTarget aid (const Nothing) UpdDisplaceActor source target -> do invalidateBfsAid source invalidateBfsAid target b <- getsState $ getActorBody source unless (bproj b) $ invalidateBfsPathLid (blid b) $ bpos b tb <- getsState $ getActorBody target unless (bproj tb) $ invalidateBfsPathLid (blid tb) $ bpos tb invalidateInMelee (blid b) UpdMoveItem _ _ aid s1 s2 -> wipeBfsIfItemAffectsSkills [s1, s2] aid UpdRefillHP{} -> return () UpdRefillCalm{} -> return () UpdTrajectory{} -> return () UpdQuitFaction fid _ toSt _ -> do side <- getsClient sside when (side == fid && maybe False ((/= Camping) . stOutcome) toSt) $ do let won = case toSt of Just Status{stOutcome=Conquer} -> True Just Status{stOutcome=Escape} -> True _ -> False when won $ do gameModeId <- getsState sgameModeId scurChal <- getsClient scurChal let sing = M.singleton scurChal 1 f = M.unionWith (+) g = EM.insertWith f gameModeId sing modifyClient $ \cli -> cli {svictories = g $ svictories cli} UpdLeadFaction fid source target -> do side <- getsClient sside when (side == fid) $ do mleader <- getsClient sleader let !_A = assert (mleader == source -- somebody changed the leader for us || mleader == target -- we changed the leader ourselves `blame` "unexpected leader" `swith` (cmd, mleader)) () modifyClient $ \cli -> cli {_sleader = target} UpdDiplFaction{} -> return () UpdAutoFaction{} -> -- @condBFS@ depends on the setting we change here (e.g., smarkSuspect). invalidateBfsAll UpdRecordKill{} -> return () UpdTacticFaction{} -> do -- Clear all targets except the leader's. mleader <- getsClient sleader mtgt <- case mleader of Nothing -> return Nothing Just leader -> getsClient $ EM.lookup leader . stargetD modifyClient $ \cli -> let stargetD | Just tgt <- mtgt , Just leader <- mleader = EM.singleton leader tgt | otherwise = EM.empty in cli {stargetD} UpdAlterTile lid p fromTile toTile -> do updateSalter lid [(p, toTile)] cops <- getsState scops let lvl = (EM.! lid) . sdungeon $ oldState t = lvl `at` p let !_A = assert (t == fromTile) () when (tileChangeAffectsBfs cops fromTile toTile) $ invalidateBfsLid lid UpdAlterExplorable{} -> return () UpdAlterGold{} -> return () UpdSearchTile aid p toTile -> do COps{cotile} <- getsState scops b <- getsState $ getActorBody aid let lid = blid b updateSalter lid [(p, toTile)] cops <- getsState scops let lvl = (EM.! lid) . sdungeon $ oldState t = lvl `at` p let !_A = assert (Just t == Tile.hideAs cotile toTile) () -- The following check is needed even if we verity in content -- that searching doesn't change clarity and light of tiles, -- because it modifies skill needed to alter the tile and even -- walkability and changeability. when (tileChangeAffectsBfs cops t toTile) $ invalidateBfsLid lid UpdHideTile{} -> return () UpdSpotTile lid ts -> do updateSalter lid ts cops <- getsState scops let lvl = (EM.! lid) . sdungeon $ oldState affects (p, toTile) = let fromTile = lvl `at` p in tileChangeAffectsBfs cops fromTile toTile bs = map affects ts when (or bs) $ invalidateBfsLid lid UpdLoseTile lid ts -> do updateSalter lid ts invalidateBfsLid lid -- from known to unknown tiles UpdSpotEntry{} -> return () UpdLoseEntry{} -> return () UpdAlterSmell{} -> return () UpdSpotSmell{} -> return () UpdLoseSmell{} -> return () UpdTimeItem{} -> return () UpdAgeGame{} -> return () UpdUnAgeGame{} -> return () UpdDiscover _ iid _ _ -> do item <- getsState $ getItemBody iid case jkind item of IdentityObvious _ik -> discoverAspect iid IdentityCovered ix _ik -> if ix `EM.notMember` sdiscoKind oldState then discoverKindAndAspect ix else discoverAspect iid UpdCover _ iid _ _ -> do item <- getsState $ getItemBody iid newState <- getState case jkind item of IdentityObvious _ik -> coverAspect iid IdentityCovered ix _ik -> if ix `EM.member` sdiscoKind newState then coverAspectAndKind ix else coverAspect iid UpdDiscoverKind _c ix _ik -> discoverKind ix UpdCoverKind _c ix _ik -> coverKind ix UpdDiscoverAspect _c iid _arItem -> discoverAspect iid UpdCoverAspect _c iid _arItem -> coverAspect iid UpdDiscoverServer{} -> error "server command leaked to client" UpdCoverServer{} -> error "server command leaked to client" UpdPerception lid outPer inPer -> perception lid outPer inPer UpdRestart side sfper s scurChal soptions srandom -> do COps{cocave, comode} <- getsState scops fact <- getsState $ (EM.! side) . sfactionD snxtChal <- getsClient snxtChal svictories <- getsClient svictories stabs <- getsClient stabs let f !acc _p !i _a = i : acc modes = zip [0..] $ ofoldlGroup' comode "campaign scenario" f [] g :: (Int, ContentId ModeKind) -> Int g (_, mode) = case EM.lookup mode svictories of Nothing -> 0 Just cm -> fromMaybe 0 (M.lookup snxtChal cm) (snxtScenario, _) = minimumBy (comparing g) modes h lvl = CK.labyrinth (okind cocave $ lkind lvl) && not (fhasGender $ gplayer fact) -- Not to burrow through a labyrinth instead of leaving it for -- the human player and to prevent AI losing time there instead -- of congregating at exits. sexplored = EM.keysSet $ EM.filter h $ sdungeon s cli = emptyStateClient side putClient cli { sexplored -- , sundo = [UpdAtomic cmd] , sfper , srandom , scurChal , snxtChal , snxtScenario , scondInMelee = EM.empty , svictories , soptions , stabs } salter <- getsState createSalter modifyClient $ \cli1 -> cli1 {salter} restartClient UpdRestartServer{} -> return () UpdResume _side sfperNew -> do #ifdef WITH_EXPENSIVE_ASSERTIONS sfperOld <- getsClient sfper let !_A = assert (sfperNew == sfperOld `blame` (_side, sfperNew, sfperOld)) () #endif modifyClient $ \cli -> cli {sfper = sfperNew} salter <- getsState createSalter modifyClient $ \cli -> cli {salter} UpdResumeServer{} -> return () UpdKillExit _fid -> killExit UpdWriteSave -> saveClient UpdHearFid{} -> return () -- This field is only needed in AI client, but it's on-demand for each level -- and so fairly cheap. invalidateInMelee :: MonadClient m => LevelId -> m () invalidateInMelee lid = modifyClient $ \cli -> cli {scondInMelee = EM.delete lid (scondInMelee cli)} -- For now, only checking the stores. wipeBfsIfItemAffectsSkills :: MonadClient m => [CStore] -> ActorId -> m () wipeBfsIfItemAffectsSkills stores aid = unless (null $ intersect stores [CEqp, COrgan]) $ invalidateBfsAid aid tileChangeAffectsBfs :: COps -> ContentId TileKind -> ContentId TileKind -> Bool tileChangeAffectsBfs COps{coTileSpeedup} fromTile toTile = Tile.alterMinWalk coTileSpeedup fromTile /= Tile.alterMinWalk coTileSpeedup toTile createActor :: MonadClient m => ActorId -> Actor -> [(ItemId, Item)] -> m () createActor aid b ais = do side <- getsClient sside fact <- getsState $ (EM.! side) . sfactionD let affect3 tap@TgtAndPath{..} = case tapTgt of TPoint (TEnemyPos a) _ _ | a == aid -> let tgt | isFoe side fact (bfid b) = TEnemy a -- still a foe | otherwise = TPoint TKnown (blid b) (bpos b) in TgtAndPath tgt Nothing _ -> tap modifyClient $ \cli -> cli {stargetD = EM.map affect3 (stargetD cli)} mapM_ (addItemToDiscoBenefit . fst) ais unless (bproj b) $ invalidateBfsPathLid (blid b) $ bpos b invalidateInMelee (blid b) destroyActor :: MonadClient m => ActorId -> Actor -> Bool -> m () destroyActor aid b destroy = do when destroy $ modifyClient $ updateTarget aid (const Nothing) -- gc modifyClient $ \cli -> cli {sbfsD = EM.delete aid $ sbfsD cli} -- gc let affect tgt = case tgt of TEnemy a | a == aid -> if destroy then -- If *really* nothing more interesting, the actor will -- go to last known location to perhaps find other foes. TPoint TKnown (blid b) (bpos b) else -- If enemy only hides (or we stepped behind obstacle) find him. TPoint (TEnemyPos a) (blid b) (bpos b) TNonEnemy a | a == aid -> TPoint TKnown (blid b) (bpos b) _ -> tgt affect3 TgtAndPath{..} = let newMPath = case tapPath of Just AndPath{pathGoal} | pathGoal /= bpos b -> Nothing _ -> tapPath -- foe slow enough, so old path good in TgtAndPath (affect tapTgt) newMPath modifyClient $ \cli -> cli {stargetD = EM.map affect3 (stargetD cli)} unless (bproj b) $ invalidateBfsPathLid (blid b) $ bpos b invalidateInMelee (blid b) addItemToDiscoBenefit :: MonadClient m => ItemId -> m () addItemToDiscoBenefit iid = do cops <- getsState scops discoBenefit <- getsClient sdiscoBenefit case EM.lookup iid discoBenefit of Just{} -> return () -- already there, with real or provisional aspect record, -- but we haven't learned anything new about the item Nothing -> do side <- getsClient sside factionD <- getsState sfactionD itemFull <- getsState $ itemToFull iid let benefit = totalUsefulness cops side factionD itemFull modifyClient $ \cli -> cli {sdiscoBenefit = EM.insert iid benefit (sdiscoBenefit cli)} perception :: MonadClient m => LevelId -> Perception -> Perception -> m () perception lid outPer inPer = do -- Clients can't compute FOV on their own, because they don't know -- if unknown tiles are clear or not. Server would need to send -- info about properties of unknown tiles, which complicates -- and makes heavier the most bulky data set in the game: tile maps. -- Note we assume, but do not check that @outPer@ is contained -- in current perception and @inPer@ has no common part with it. -- It would make the already very costly operation even more expensive. {- perOld <- getPerFid lid -- Check if new perception is already set in @cmdAtomicFilterCli@ -- or if we are doing undo/redo, which does not involve filtering. -- The data structure is strict, so the cheap check can't be any simpler. let interAlready per = Just $ totalVisible per `ES.intersection` totalVisible perOld unset = maybe False ES.null (interAlready inPer) || maybe False (not . ES.null) (interAlready outPer) when unset $ do -} let adj Nothing = error $ "no perception to alter" `showFailure` lid adj (Just per) = Just $ addPer (diffPer per outPer) inPer f = EM.alter adj lid modifyClient $ \cli -> cli {sfper = f (sfper cli)} discoverKind :: MonadClient m => ItemKindIx -> m () discoverKind = discoverKindAndAspect discoverKindAndAspect :: MonadClient m => ItemKindIx -> m () discoverKindAndAspect ix = do cops <- getsState scops -- Wipe out BFS, because the player could potentially learn that his items -- affect his actors' skills relevant to BFS. invalidateBfsAll side <- getsClient sside factionD <- getsState sfactionD itemToF <- getsState $ flip itemToFull let benefit iid = totalUsefulness cops side factionD (itemToF iid) itemIxMap <- getsState $ (EM.! ix) . sitemIxMap -- Possibly overwrite earlier, provisional benefits. forM_ (ES.elems itemIxMap) $ \iid -> modifyClient $ \cli -> cli {sdiscoBenefit = EM.insert iid (benefit iid) (sdiscoBenefit cli)} coverKind :: ItemKindIx -> m () coverKind = coverAspectAndKind coverAspectAndKind :: ItemKindIx -> m () coverAspectAndKind _ix = undefined discoverAspect :: MonadClient m => ItemId -> m () discoverAspect iid = do cops <- getsState scops -- Wipe out BFS, because the player could potentially learn that his items -- affect his actors' skills relevant to BFS. invalidateBfsAll side <- getsClient sside factionD <- getsState sfactionD itemFull <- getsState $ itemToFull iid let benefit = totalUsefulness cops side factionD itemFull -- Possibly overwrite earlier, provisional benefits. modifyClient $ \cli -> cli {sdiscoBenefit = EM.insert iid benefit (sdiscoBenefit cli)} coverAspect :: ItemId -> m () coverAspect _iid = undefined killExit :: MonadClient m => m () killExit = do side <- getsClient sside debugPossiblyPrint $ "Client" <+> tshow side <+> "quitting." modifyClient $ \cli -> cli {squit = True} -- Verify that the not saved caches are equal to future reconstructed. -- Otherwise, save/restore would change game state. sactorMaxSkills2 <- getsState sactorMaxSkills salter <- getsClient salter sbfsD <- getsClient sbfsD alter <- getsState createSalter actorMaxSkills <- getsState maxSkillsInDungeon let f aid = do (canMove, alterSkill) <- condBFS aid bfsArr <- createBfs canMove alterSkill aid let bfsPath = EM.empty return (aid, BfsAndPath bfsArr bfsPath) actorD <- getsState sactorD lbfsD <- mapM f $ EM.keys actorD -- Some freshly generated bfses are not used for comparison, but at least -- we check they don't violate internal assertions themselves. Hence the bang. let bfsD = EM.fromDistinctAscList lbfsD g BfsInvalid !_ = True g _ BfsInvalid = False g (BfsAndPath bfsArr1 _) (BfsAndPath bfsArr2 _) = bfsArr1 == bfsArr2 subBfs = EM.isSubmapOfBy g let !_A1 = assert (salter == alter `blame` "wrong accumulated salter on side" `swith` (side, salter, alter)) () !_A2 = assert (sactorMaxSkills2 == actorMaxSkills `blame` "wrong accumulated sactorMaxSkills on side" `swith` (side, sactorMaxSkills2, actorMaxSkills)) () !_A3 = assert (sbfsD `subBfs` bfsD `blame` "wrong accumulated sbfsD on side" `swith` (side, sbfsD, bfsD)) () return () LambdaHack-0.9.5.0/engine-src/Game/LambdaHack/Client/HandleResponseM.hs0000644000000000000000000000460307346545000023501 0ustar0000000000000000{-# LANGUAGE FlexibleContexts #-} -- | Semantics of responses sent by the server to clients. module Game.LambdaHack.Client.HandleResponseM ( MonadClientWriteRequest(..) , MonadClientAtomic(..) , handleResponse ) where import Prelude () import Game.LambdaHack.Core.Prelude import Game.LambdaHack.Atomic (UpdAtomic) import Game.LambdaHack.Client.AI import Game.LambdaHack.Client.HandleAtomicM import Game.LambdaHack.Client.MonadClient import Game.LambdaHack.Client.Request import Game.LambdaHack.Client.Response import Game.LambdaHack.Client.UI import Game.LambdaHack.Common.MonadStateRead import Game.LambdaHack.Common.State -- | Client monad in which one can send requests to the client. class MonadClient m => MonadClientWriteRequest m where sendRequestAI :: RequestAI -> m () sendRequestUI :: RequestUI -> m () clientHasUI :: m Bool -- | Monad for executing atomic game state transformations on a client. class MonadClient m => MonadClientAtomic m where -- | Execute an atomic update that changes the client's 'State'. execUpdAtomic :: UpdAtomic -> m () -- | Put state that is intended to be the result of performing -- an atomic update by the server on its copy of the client's 'State'. execPutState :: State -> m () -- | Handle server responses. -- -- Note that for clients communicating with the server over the net, -- @RespUpdAtomicNoState@ should be used, because executing a single command -- is cheaper than sending the whole state over the net. -- However, for the standalone exe mode, with clients in the same process -- as the server, a pointer to the state set with @execPutState@ is cheaper. handleResponse :: ( MonadClientSetup m , MonadClientUI m , MonadClientAtomic m , MonadClientWriteRequest m ) => Response -> m () handleResponse cmd = case cmd of RespUpdAtomic newState cmdA -> do oldState <- getState execPutState newState cmdAtomicSemCli oldState cmdA hasUI <- clientHasUI when hasUI $ displayRespUpdAtomicUI cmdA RespUpdAtomicNoState cmdA -> do oldState <- getState execUpdAtomic cmdA cmdAtomicSemCli oldState cmdA hasUI <- clientHasUI when hasUI $ displayRespUpdAtomicUI cmdA RespQueryAI aid -> do cmdC <- queryAI aid sendRequestAI cmdC RespSfxAtomic sfx -> displayRespSfxAtomicUI sfx RespQueryUI -> do cmdH <- queryUI sendRequestUI cmdH LambdaHack-0.9.5.0/engine-src/Game/LambdaHack/Client/LoopM.hs0000644000000000000000000001033607346545000021500 0ustar0000000000000000{-# LANGUAGE FlexibleContexts #-} -- | The main loop of the client, processing human and computer player -- moves turn by turn. module Game.LambdaHack.Client.LoopM ( MonadClientReadResponse(..) , loopCli #ifdef EXPOSE_INTERNAL -- * Internal operations , initAI, initUI #endif ) where import Prelude () import Game.LambdaHack.Core.Prelude import Game.LambdaHack.Atomic import Game.LambdaHack.Client.ClientOptions import Game.LambdaHack.Client.HandleAtomicM import Game.LambdaHack.Client.HandleResponseM import Game.LambdaHack.Client.MonadClient import Game.LambdaHack.Client.Response import Game.LambdaHack.Client.State import Game.LambdaHack.Client.UI -- | Client monad in which one can receive responses from the server. class MonadClient m => MonadClientReadResponse m where receiveResponse :: m Response initAI :: MonadClient m => m () initAI = do side <- getsClient sside debugPossiblyPrint $ "AI client" <+> tshow side <+> "initializing." initUI :: (MonadClient m, MonadClientUI m) => CCUI -> m () initUI sccui@CCUI{coscreen} = do side <- getsClient sside soptions <- getsClient soptions debugPossiblyPrint $ "UI client" <+> tshow side <+> "initializing." -- Start the frontend. schanF <- chanFrontend coscreen soptions modifySession $ \sess -> sess {schanF, sccui} -- | The main game loop for an AI or UI client. It receives responses from -- the server, changes internal client state accordingly, analyzes -- ensuing human or AI commands and sends resulting requests to the server. -- Depending on whether it's an AI or UI client, it sends AI or human player -- requests. -- -- The loop is started in client state that is empty except for -- the @sside@ and @seps@ fields, see 'emptyStateClient'. loopCli :: ( MonadClientSetup m , MonadClientUI m , MonadClientAtomic m , MonadClientReadResponse m , MonadClientWriteRequest m ) => CCUI -> UIOptions -> ClientOptions -> m () loopCli ccui sUIOptions soptions = do modifyClient $ \cli -> cli {soptions} hasUI <- clientHasUI if not hasUI then initAI else initUI ccui -- Warning: state and client state are invalid here, e.g., sdungeon -- and sper are empty. restoredG <- tryRestore restored <- case restoredG of Just (cli, msess) | not $ snewGameCli soptions -> do -- Restore game. schanF <- getsSession schanF sccui <- getsSession sccui maybe (return ()) (\sess -> modifySession $ const sess {schanF, sccui, sUIOptions}) msess putClient cli {soptions} return True Just (_, msessR) -> do -- Preserve previous history, if any (--newGame). maybe (return ()) (\sessR -> modifySession $ \sess -> sess {shistory = shistory sessR}) msessR return False _ -> return False -- At this point @ClientState@ not overriten dumbly and @State@ valid. tabA <- createTabBFS tabB <- createTabBFS modifyClient $ \cli -> cli {stabs = (tabA, tabB)} side <- getsClient sside cmd1 <- receiveResponse case (restored, cmd1) of (True, RespUpdAtomic _ UpdResume{}) -> return () (True, RespUpdAtomic _ UpdRestart{}) -> when hasUI $ promptAdd "Ignoring an old savefile and starting a new game." (False, RespUpdAtomic _ UpdResume{}) -> error $ "Savefile of client " ++ show side ++ " not usable." `showFailure` () (False, RespUpdAtomic _ UpdRestart{}) -> return () (True, RespUpdAtomicNoState UpdResume{}) -> undefined (True, RespUpdAtomicNoState UpdRestart{}) -> when hasUI $ promptAdd "Ignoring an old savefile and starting a new game." (False, RespUpdAtomicNoState UpdResume{}) -> error $ "Savefile of client " ++ show side ++ " not usable." `showFailure` () (False, RespUpdAtomicNoState UpdRestart{}) -> return () _ -> error $ "unexpected command" `showFailure` (side, restored, cmd1) handleResponse cmd1 -- State and client state now valid. let cliendKindText = if not hasUI then "AI" else "UI" debugPossiblyPrint $ cliendKindText <+> "client" <+> tshow side <+> "started." loop debugPossiblyPrint $ cliendKindText <+> "client" <+> tshow side <+> "stopped." where loop = do cmd <- receiveResponse handleResponse cmd quit <- getsClient squit unless quit loop LambdaHack-0.9.5.0/engine-src/Game/LambdaHack/Client/MonadClient.hs0000644000000000000000000000600307346545000022643 0ustar0000000000000000-- | Basic client monad and related operations. module Game.LambdaHack.Client.MonadClient ( -- * Basic client monads MonadClientRead ( getsClient , liftIO -- exposed only to be implemented, not used ) , MonadClient(modifyClient) -- * Assorted primitives , getClient, putClient , debugPossiblyPrint, createTabBFS, rndToAction, rndToActionForget ) where import Prelude () import Game.LambdaHack.Core.Prelude import Control.Monad.ST.Strict (stToIO) import qualified Control.Monad.Trans.State.Strict as St import Data.Bits (finiteBitSize, xor, (.&.)) import qualified Data.Primitive.PrimArray as PA import qualified Data.Text.IO as T import System.IO (hFlush, stdout) import qualified System.Random as R import Game.LambdaHack.Client.ClientOptions import Game.LambdaHack.Client.State import Game.LambdaHack.Common.Kind import Game.LambdaHack.Common.MonadStateRead import Game.LambdaHack.Common.Point import Game.LambdaHack.Common.State import Game.LambdaHack.Common.Time import Game.LambdaHack.Content.RuleKind import Game.LambdaHack.Core.Random -- | Monad for reading client state. class MonadStateRead m => MonadClientRead m where getsClient :: (StateClient -> a) -> m a -- We do not provide a MonadIO instance, so that outside -- nobody can subvert the action monads by invoking arbitrary IO. liftIO :: IO a -> m a -- | Monad for writing to client state. class MonadClientRead m => MonadClient m where modifyClient :: (StateClient -> StateClient) -> m () getClient :: MonadClientRead m => m StateClient getClient = getsClient id putClient :: MonadClient m => StateClient -> m () putClient s = modifyClient (const s) debugPossiblyPrint :: MonadClient m => Text -> m () debugPossiblyPrint t = do sdbgMsgCli <- getsClient $ sdbgMsgCli . soptions when sdbgMsgCli $ liftIO $ do T.hPutStrLn stdout t hFlush stdout createTabBFS :: MonadClient m => m (PA.PrimArray PointI) createTabBFS = do COps{corule=RuleContent{rXmax, rYmax}} <- getsState scops liftIO $ stToIO $ do tabAMutable <- PA.newPrimArray (rXmax * rYmax) -- always enough PA.unsafeFreezePrimArray tabAMutable -- | Invoke pseudo-random computation with the generator kept in the state. rndToAction :: MonadClient m => Rnd a -> m a rndToAction r = do gen1 <- getsClient srandom let (a, gen2) = St.runState r gen1 modifyClient $ \cli -> cli {srandom = gen2} return a -- | Invoke pseudo-random computation, don't change generator kept in state. -- Modify the used generator by @xoring@ with current global game time. rndToActionForget :: MonadClientRead m => Rnd a -> m a rndToActionForget r = do gen <- getsClient srandom let i = fst $ R.next gen time <- getsState stime -- Prevent overflow from @Int64@ to @Int@. let positiveIntSize = finiteBitSize (1 :: Int) - 1 oneBitsPositiveInt = 2 ^ positiveIntSize - 1 timeSmallBits = fromEnum $ timeTicks time .&. oneBitsPositiveInt genNew = R.mkStdGen $ i `xor` timeSmallBits return $! St.evalState r genNew LambdaHack-0.9.5.0/engine-src/Game/LambdaHack/Client/Preferences.hs0000644000000000000000000007273207346545000022723 0ustar0000000000000000-- | Actor preferences for targets and actions, based on actor aspects. module Game.LambdaHack.Client.Preferences ( totalUsefulness #ifdef EXPOSE_INTERNAL -- * Internal operations , effectToBenefit , averageTurnValue, avgItemDelay, avgItemLife, durabilityMult , organBenefit, recBenefit, fakeItem, aspectToBenefit, aspectRecordToBenefit #endif ) where import Prelude () import Game.LambdaHack.Core.Prelude import qualified Data.EnumMap.Strict as EM import Game.LambdaHack.Common.Faction import Game.LambdaHack.Common.Item import qualified Game.LambdaHack.Common.ItemAspect as IA import Game.LambdaHack.Common.Kind import Game.LambdaHack.Common.Misc import Game.LambdaHack.Common.Time import Game.LambdaHack.Common.Types import Game.LambdaHack.Content.ItemKind (ItemKind) import qualified Game.LambdaHack.Content.ItemKind as IK import Game.LambdaHack.Content.ModeKind import qualified Game.LambdaHack.Core.Dice as Dice import qualified Game.LambdaHack.Definition.Ability as Ability import Game.LambdaHack.Definition.Defs import Game.LambdaHack.Definition.Flavour -- | How much AI benefits from applying the effect. -- The first component is benefit when applied to self, the second -- is benefit (preferably negative) when applied to enemy. -- This represents benefit from using the effect every @avgItemDelay@ turns, -- so if the item is not durable, the value is adjusted down elsewhere. -- The benefit includes the drawback of having to use the actor's turn, -- except when there is battle and item is a weapon and so there is usually -- nothing better to do than to melee, or when the actor is stuck or idle -- or laying in wait or luring an enemy from a safe distance. -- So there is less than @averageTurnValue@ included in each benefit, -- so in case when turn is not spent, e.g, periodic activation or conditions, -- the difference in value is only slight. effectToBenefit :: COps -> FactionId -> FactionDict -> IK.Effect -> (Double, Double) effectToBenefit cops fid factionD eff = let delta x = (x, x) in case eff of IK.Burn d -> delta $ -(min 1500 $ 15 * Dice.meanDice d) -- often splash damage, armor doesn't block (but HurtMelee doesn't boost) IK.Explode "single spark" -> delta (-1) -- hardwired; probing and flavour IK.Explode "fragrance" -> (1, -5) -- hardwired; situational IK.Explode _ -> -- There is a risk the explosion is focused and harmful to self -- or not focused and beneficial to nearby foes, but not to self. -- It's too costly to analyze, so we assume applying an exploding -- item is a bad idea and it's better to project it at foes. -- Due to this assumption, healing explosives should be wrapped -- in @OnSmash@, or else they are counted as an incentive for throwing -- an item at foes, which in that case is counterproductive. delta (-100) IK.RefillHP p -> delta $ if p > 0 then min 2000 (20 * fromIntegral p) else max (-1000) (10 * fromIntegral p) -- one HP healed is worth a bit more than one HP dealed to enemy, -- because if the actor survives, he may deal damage many times; -- however, AI is mostly for non-heroes that fight in suicidal crowds, -- so the two values are kept close enough to maintain berserk approach IK.RefillCalm p -> delta $ if p > 0 then min 100 (fromIntegral p) else max (-500) (5 * fromIntegral p) IK.Dominate -> (0, -100) -- I obtained an actor with, say 10HP, -- worth 200, and enemy lost him, another 100; -- divided by 3, because impression needed first IK.Impress -> (0, -20) IK.PutToSleep -> (10, -50) -- can affect friends, but more often enemies IK.Yell -> (-5, -10) -- usually uncontrollably wakes up enemies, so bad IK.Summon grp d -> -- contrived by not checking if enemies also control -- that group; safe for normal dungeon crawl content; -- not correct for symmetric scenarios, but let it be let ben = Dice.meanDice d * 200 -- the new actor can have, say, 10HP fact = factionD EM.! fid friendlyHasGrp fid2 = isFriend fid fact fid2 && grp `elem` fgroups (gplayer $ factionD EM.! fid2) in -- Prefer applying summoning items to flinging them; the actor gets -- spawned further from for, but it's more robust if any friendlyHasGrp $ EM.keys factionD then (ben, -1) else (-ben * 3, 1) -- the foe may spawn during battle and gang up IK.Ascend{} -> (-99, 99) -- note the reversed values: only change levels sensibly, in teams, -- and don't remove enemy too far, he may be easy to kill -- and may have loot IK.Escape{} -> (-9999, 9999) -- even if can escape, loots first and then -- handles escape as a special case -- The following two are expensive, because they ofen activate -- while in melee, in which case each turn is worth x HP, where x -- is the average effective weapon damage in the game, which would -- be ~5. (Plus a huge risk factor for any non-spawner faction.) -- So, each turn in battle is worth ~100. And on average, in and out -- of battle, let's say each turn is worth ~10. IK.Paralyze d -> delta $ -20 * Dice.meanDice d -- clips IK.ParalyzeInWater d -> delta $ -10 * Dice.meanDice d -- clips; resistable IK.InsertMove d -> delta $ 10 * Dice.meanDice d -- turns IK.Teleport d -> if Dice.meanDice d <= 8 then (0, 0) -- annoying either way else (-9, -1) -- for self, don't derail exploration -- for foes, fight with one less at a time IK.CreateItem COrgan "condition" _ -> (1, -1) -- varied, big bunch, but try to create it anyway IK.CreateItem COrgan grp timer -> -- assumed temporary let turnTimer = IK.foldTimer 1 Dice.meanDice Dice.meanDice timer -- copy count used instead of timer for organs with many copies (total, count) = organBenefit turnTimer grp cops fid factionD in delta $ total / fromIntegral count -- the same when created in me and in foe -- average over all matching grps; simplified: rarities ignored IK.CreateItem _ "treasure" _ -> (100, 0) -- assumed not temporary IK.CreateItem _ "common item" _ -> (70, 0) IK.CreateItem _ "curious item" _ -> (70, 0) IK.CreateItem _ "any scroll" _ -> (50, 0) IK.CreateItem _ "any vial" _ -> (50, 0) IK.CreateItem _ "potion" _ -> (50, 0) IK.CreateItem _ "explosive" _ -> (50, 0) IK.CreateItem _ "any jewelry" _ -> (100, 0) IK.CreateItem _ grp _ -> -- assumed not temporary and @grp@ tiny let (total, count) = recBenefit grp cops fid factionD in (total / fromIntegral count, 0) IK.DropItem _ _ COrgan "condition" -> delta 30 -- save for curing own bad conditions IK.DropItem ngroup kcopy COrgan grp -> -- assumed temporary -- Simplified: we assume actor has an average number of copies -- (and none have yet run out, e.g., prompt curing of poisoning) -- of a single kind of organ (and so @ngroup@ doesn't matter) -- of average benefit and that @kcopy@ is such that all copies -- are dropped. Separately we add bonuses for @ngroup@ and @kcopy@. -- Remaining time of the organ is arbitrarily assumed to be 20 turns. let turnTimer = 20 (total, count) = organBenefit turnTimer grp cops fid factionD boundBonus n = if n == maxBound then 10 else 0 in delta $ boundBonus ngroup + boundBonus kcopy - total / fromIntegral count -- the same when dropped from me and foe IK.DropItem{} -> delta (-10) -- depends a lot on what is dropped IK.PolyItem -> (1, 0) -- may fizzle, so AI never uses (could loop) IK.RerollItem -> (1, 0) -- may fizzle, so AI never uses (could loop) IK.DupItem -> (1, 0) -- may fizzle, so AI never uses (could loop) IK.Identify -> (1, 0) -- may fizzle, so AI never uses (could loop) IK.Detect IK.DetectAll radius -> (fromIntegral radius * 2, 0) IK.Detect IK.DetectLoot radius -> (fromIntegral radius * 2, 0) IK.Detect IK.DetectExit radius -> (fromIntegral radius / 2, 0) IK.Detect _ radius -> (fromIntegral radius, 0) IK.SendFlying _ -> (0, -100) -- very context dependent, but lack of control IK.PushActor _ -> (0, -100) -- is deadly on some maps, leading to harm; IK.PullActor _ -> (0, -100) -- pushing others may crush them against wall IK.DropBestWeapon -> delta $ -50 -- often a whole turn wasted == InsertMove IK.ActivateInv ' ' -> delta $ -200 -- brutal and deadly IK.ActivateInv _ -> delta $ -50 -- depends on the items IK.ApplyPerfume -> delta 0 -- depends on smell sense of friends and foes IK.OneOf efs -> let bs = map (effectToBenefit cops fid factionD) efs f (self, foe) (accSelf, accFoe) = (self + accSelf, foe + accFoe) (effSelf, effFoe) = foldr f (0, 0) bs in (effSelf / fromIntegral (length bs), effFoe / fromIntegral (length bs)) IK.OnSmash _ -> delta 0 -- can be beneficial; we'd need to analyze explosions, range, etc. IK.VerbNoLonger{} -> delta 0 -- flavour only, no benefit IK.VerbMsg{} -> delta 0 -- flavour only, no benefit IK.Composite [] -> delta 0 IK.Composite (eff1 : _) -> effectToBenefit cops fid factionD eff1 -- for simplicity; so in content make sure to place initial animations -- among normal effects, not at the start of composite effect -- (animations should not fail, after all), and start composite -- effect with the main thing -- See the comment for @Paralyze@. averageTurnValue :: Double averageTurnValue = 10 -- Average delay between desired item uses. Some items are best activated -- every turn, e.g., healing (but still, on average, the activation would be -- useless some of the time, namely when HP is at max, which is rare, -- or when some combat boost is already lasting, which is probably also rare). -- However, e.g., for detection, activating every few turns is enough. -- Also, sometimes actor has many activable items, so he doesn't want to use -- the less powerful ones as often as when they are alone. -- For weapons, it depends. Sometimes a weapon with disorienting effect -- should be used once every couple of turns and stronger raw damage -- weapons all the remaining time. In other cases a single weapon -- with a devastating effect would ideally be available each turn. -- We don't want to undervalue rarely used items with long timeouts -- and we think that most interesting gameplay comes from alternating -- item use, so we arbitrarily set the full value timeout to 3. avgItemDelay :: Double avgItemDelay = 3 -- The average time between consumable item being found -- (and enough skill obtained to use it) and the item -- not being worth using any more. We specifically ignore -- item not being used any more, because it is not durable and is consumed. -- However we do consider actor mortality (especially common for spawners) -- and item contending with many other very different but valuable items -- that all vie for the same turn needed to activate them (especially common -- for non-spawners). Another reason is item getting obsolete or duplicated, -- by finding a strictly better item or an identical item. -- The @avgItemLife@ constant only makes sense for items with non-periodic -- effects, because the effects' benefit is not cumulated -- by just placing them in equipment and they cost a turn to activate. -- We set the value to 30, assuming if the actor finds an item, then he is -- most likely at an unlooted level, so he will find more loot soon, -- or he is in a battle, so he will die soon (or win even more loot). avgItemLife :: Double avgItemLife = 30 -- The value of durable item is this many times higher than non-durable, -- because the item will on average be activated this many times -- before it stops being used. durabilityMult :: Double durabilityMult = avgItemLife / avgItemDelay -- We assume the organ is temporary (@Fragile@ and @Periodic@) -- and also that it doesn't provide any functionality, -- e.g., detection or raw damage. However, we take into account effects -- knowing in some temporary organs, e.g., poison or regeneration, -- they are triggered at each item copy destruction. They are applied to self, -- hence we take the self component of valuation. We multiply by the count -- of created/dropped organs, because for conditions it determines -- how many times the effect is applied, before the last copy expires. -- -- The temporary organs are not durable nor in infnite copies, so to give -- continous benefit, organ has to be recreated each @turnTimer@ turns. -- Creation takes a turn, so incurs @averageTurnValue@ cost. -- That's how the lack of durability impacts their value, not via -- @durabilityMult@, which however may be applied to organ creating item. -- So, on average, maintaining the organ costs @averageTurnValue/turnTimer@. -- So, if an item lasts @averageTurnValue@ and can be created at will, it's -- almost as valuable as permanent. This makes sense even if the item creating -- the organ is not durable, but the timer is huge. One may think the lack -- of durability should be offset by the timer, but remember that average -- item life @avgItemLife@ is rather low, so either a new item will be found -- soon and so the long timer doesn't matter or the actor will die -- or the gameplay context will change (e.g., out of battle) and so the effect -- will no longer be useful. -- -- When considering the effects, we just use their standard valuation, -- despite them not using up actor's turn to be applied each turn, -- because, similarly as for periodic items, we don't control when they -- are applied and we can't stop/restart them. -- -- We assume, only one of the timer and count mechanisms is present at once -- (@count@ or @turnTimer@ is 1). -- We assume no organ has effect that drops its group or creates its group; -- otherwise we'd loop. organBenefit :: Double -> GroupName ItemKind -> COps -> FactionId -> FactionDict -> (Double, Int) organBenefit turnTimer grp cops@COps{coitem} fid factionD = let f (!sacc, !pacc) !p _ !kind = let count = Dice.meanDice (IK.icount kind) paspect asp = fromIntegral p * count * turnTimer -- the aspect stays for this many turns' * aspectToBenefit asp peffect eff = fromIntegral p * count -- this many consecutive effects will be generated, if any * fst (effectToBenefit cops fid factionD eff) in ( sacc + (sum (map paspect $ IK.iaspects kind) + sum (map peffect $ IK.ieffects kind)) - averageTurnValue -- the cost of 1 turn spent acquiring the organ -- (or of inflexibility of periodic items) , pacc + p ) in ofoldlGroup' coitem grp f (0, 0) -- We assume no item has effect that drops its group or creates its group; -- otherwise we'd loop. recBenefit :: GroupName ItemKind -> COps -> FactionId -> FactionDict -> (Double, Int) recBenefit grp cops@COps{coitem, coItemSpeedup} fid factionD = let f (!sacc, !pacc) !p !kindId !kind = let km = getKindMean kindId coItemSpeedup recPickup = benPickup $ totalUsefulness cops fid factionD (fakeItem kindId kind km) in ( sacc + Dice.meanDice (IK.icount kind) * recPickup , pacc + p ) in ofoldlGroup' coitem grp f (0, 0) fakeItem :: ContentId IK.ItemKind -> IK.ItemKind -> IA.KindMean -> ItemFull fakeItem kindId kind km = let jkind = IdentityObvious kindId jfid = Nothing -- the default jflavour = Flavour (toEnum 0) (toEnum 0) -- dummy itemBase = Item{..} itemDisco = ItemDiscoMean km in ItemFull itemBase kindId kind itemDisco True -- The value of aspect bonus is supposed to be, roughly, the benefit -- of having that bonus on actor for one turn (as if equipping didn't cost -- any time). Comparing or adding this value later on to the benefit of one-time -- applying the item makes sense, especially if the item is durable, -- but even if not, as lont as I have many items relative to equipment slots. -- If I have scarcity of items, the value should be higher, because if I apply -- a non-durable item, it no longer benefits me, but if I wear it, -- it can benefit me next turn also. The time cost of equipping balances this -- to some extent, just as @durabilityMult@ and the equipment slot limit. -- -- Value of aspects and effects is linked by some deep economic principles -- which I'm unfortunately ignorant of. E.g., average weapon hits for 5HP, -- so it's worth 50 per turn, so that should also be the worth per turn -- of equpping a sword oil that doubles damage via @AddHurtMelee@. -- Which almost matches up, since 100% effective oil is worth 100. -- Perhaps oil is worth double (despite cap, etc.), because it's addictive -- and raw weapon damage is not; so oil stays and old weapons get trashed. -- However, using the weapon in combat costs 100 (the value of extra -- battle turn). However, one turn per turn is almost free, because something -- has to be done to move the time forward. If the oil required wasting a turn -- to affect next strike, then we'd have two turns per turn, so the cost -- would be real and 100% oil would not have any significant good or bad effect -- any more, but 200% oil (if not for the cap) would still be worth it. -- -- Anyway, that suggests that the current scaling of effect vs aspect values -- is reasonable. What is even more important is consistency among aspects -- so that, e.g., a shield or a torch is never equipped by AI, but oil lamp is. -- Valuation of effects, and more precisely, more the signs than absolute -- values, ensures that both shield and torch get auto-picked up so that -- the human player can nevertheless equip them in very special cases. aspectToBenefit :: IK.Aspect -> Double aspectToBenefit asp = case asp of IK.Timeout{} -> 0 IK.AddSkill Ability.SkMove p -> Dice.meanDice p * 5 IK.AddSkill Ability.SkMelee p -> Dice.meanDice p * 5 IK.AddSkill Ability.SkDisplace p -> Dice.meanDice p * 5 IK.AddSkill Ability.SkAlter p -> Dice.meanDice p * 5 IK.AddSkill Ability.SkWait p -> Dice.meanDice p * 5 IK.AddSkill Ability.SkMoveItem p -> Dice.meanDice p * 5 IK.AddSkill Ability.SkProject p -> Dice.meanDice p * 5 IK.AddSkill Ability.SkApply p -> Dice.meanDice p * 5 IK.AddSkill Ability.SkSwimming p -> Dice.meanDice p IK.AddSkill Ability.SkFlying p -> Dice.meanDice p IK.AddSkill Ability.SkHurtMelee p -> Dice.meanDice p -- offence favoured IK.AddSkill Ability.SkArmorMelee p -> Dice.meanDice p / 4 -- only partial protection IK.AddSkill Ability.SkArmorRanged p -> Dice.meanDice p / 8 IK.AddSkill Ability.SkMaxHP p -> Dice.meanDice p IK.AddSkill Ability.SkMaxCalm p -> Dice.meanDice p / 5 IK.AddSkill Ability.SkSpeed p -> Dice.meanDice p * 25 -- 1 speed ~ 5% melee; times 5 for no caps, escape, pillar-dancing, etc.; -- OTOH, it's 1 extra turn each 20 turns, so 100/20, so 5; figures IK.AddSkill Ability.SkSight p -> Dice.meanDice p * 5 IK.AddSkill Ability.SkSmell p -> Dice.meanDice p IK.AddSkill Ability.SkShine p -> Dice.meanDice p * 2 IK.AddSkill Ability.SkNocto p -> Dice.meanDice p * 10 -- > sight + light; stealth, slots IK.AddSkill Ability.SkHearing p -> Dice.meanDice p IK.AddSkill Ability.SkAggression _ -> 0 -- dunno IK.AddSkill Ability.SkOdor p -> - Dice.meanDice p -- makes one trackable IK.SetFlag{} -> 0 IK.ELabel{} -> 0 IK.ToThrow{} -> 0 -- counted elsewhere IK.HideAs{} -> 0 IK.EqpSlot{} -> 0 IK.Odds{} -> 0 -- Should be already rolled; if not, can't tell easily. -- In particular, any timeouts there or @Periodic@ flags -- would be ignored, so they should be avoided under @Odds@ -- in not fully-identified items, because they are so crucial -- for evaluation. aspectRecordToBenefit :: IA.AspectRecord -> [Double] aspectRecordToBenefit arItem = map aspectToBenefit $ IA.aspectRecordToList arItem -- | Compute the whole 'Benefit' structure, containing various facets -- of AI item preference, for an item with the given effects and aspects. totalUsefulness :: COps -> FactionId -> FactionDict -> ItemFull -> Benefit totalUsefulness cops fid factionD itemFull@ItemFull{itemKind, itemSuspect} = let arItem = aspectRecordFull itemFull -- If the item is periodic, we only add effects to equipment benefit, -- because we assume it's in equipment and then -- we can't effectively apply it, because it's never recharged, -- because it activates as soon as recharged. -- We ignore the rare case of a periodic item kept in backpack -- to be applied manually. AI is too silly to choose it and we -- certainly don't want AI to destroy periodic items out of silliness. -- We don't assign a special bonus or malus due to being periodic, -- because periodic items are bad in that one can't -- activate them at will and they take equipment space, -- and good in that one saves a turn, not having -- to manually activate them. Additionally, no weapon can be periodic, -- because damage would be applied to the fighter, so a large class -- of items with timeout is excluded from the consideration. -- Generally, periodic seems more helpful on items with low timeout -- and obviously beneficial effects, e.g., frequent periodic healing -- or nearby detection is better, but infrequent periodic teleportation -- or harmful outward explosion is worse. But the rule is not strict -- and also dependent on gameplay context of the moment, -- hence no numerical value. periodic = IA.checkFlag Ability.Periodic arItem -- Timeout between 0 and 1 means item usable each turn, so we consider -- it equivalent to a permanent item --- one without timeout restriction. -- Timeout 2 means two such items are needed to use the effect each turn, -- so a single such item may be worth half of the permanent value. -- E.g., when item heals 1 HP each turn, that's precisly the calculation. timeout = fromIntegral $ IA.aTimeout arItem scalePeriodic value = value / max 1 timeout -- With non-periodic items, when we need to expend a turn to apply the -- item or, e.g., we lose the opportunity to use another weapon if we hit -- with this one, the loss of value due to timeout is lower. -- Also, by the time cooldown recharges, one of combatants is often dead -- or fled, so some effects are no longer useful (but 1 HP gain is). -- To balance all that, we consider a square root of timeout -- and assume we need to spend turn on other actions at least every other -- turn (hence @max 2@). Note that this makes AI like powerful weapons -- with high timeout a bit more, though it still prefers low timeouts. timeoutSqrt = sqrt $ max 2 timeout scaleTimeout v = v / timeoutSqrt (effSelf, effFoe) = let effPairs = map (effectToBenefit cops fid factionD) (IK.ieffects itemKind) f (self, foe) (accSelf, accFoe) = (self + accSelf, foe + accFoe) in foldr f (0, 0) effPairs -- Durability doesn't have any numerical impact on @eqpSum, -- because item is never consumed by just being stored in equipment. -- Also no numerical impact for flinging, because we can't fling it again -- in the same skirmish and also enemy can pick up and fling back. -- Only @benMeleeAvg@ and @benApply@ are affected, regardless if the item -- is in equipment or not. As summands of @benPickup@ they should be -- impacted by durability, because picking an item to be used -- only once is less advantageous than when the item is durable. -- For deciding which item to apply or melee with, they should be -- impacted, because it makes more sense to use an item that is durable -- and save the option for using non-durable item for the future, e.g., -- when both items have timeouts, starting with durable is beneficial, -- because it recharges while the non-durable is prepared and used. durable = IA.checkFlag Ability.Durable arItem -- For applying, we add the self part only. benApply = max 0 $ -- because optional; I don't need to apply if periodic then 0 -- because always in eqp and so never recharged else scaleTimeout (effSelf + effDice) -- hits self with kintetic dice too, when applying / if durable then 1 else durabilityMult effDice = - IK.damageUsefulness itemKind -- For melee, we add the foe part only. benMelee = if periodic then 0 -- because never recharged, so never ready for melee else effFoe + effDice -- @AddHurtMelee@ already in @eqpSum@ benMeleeAvg = scaleTimeout benMelee / if durable then 1 else durabilityMult -- Experimenting is fun, but it's better to risk foes' skin than ours, -- so we only buff flinging, not applying, when item not identified. -- It's also more gameplay fun when enemies throw at us rather than -- when they use items on themselves. benFling = min benFlingRaw $ if itemSuspect then -10 else 0 -- If periodic, we assume the item was in equipment, so effects -- were activated before flinging, so when projectile hits, -- it's discharged, so no kintetic damage value nor effect benefit -- is added to @benFling@. -- However, if item is not periodic, we assume the item was recharged, -- and so all the effects are activated at projectile impact, -- hence their full value is added to the kinetic damage value. benFlingRaw = min 0 $ if periodic then 0 else effFoe + benFlingDice benFlingDice | IK.idamage itemKind == 0 = 0 -- speedup | otherwise = assert (v <= 0) v where -- We assume victim completely unbuffed and not blocking. If not, -- let's hope the actor is similarly buffed to compensate. hurtMult = armorHurtCalculation True (IA.aSkills arItem) Ability.zeroSkills dmg = Dice.meanDice $ IK.idamage itemKind rawDeltaHP = ceiling $ fromIntegral hurtMult * xD dmg / 100 -- For simplicity, we ignore range bonus/malus and @Lobable@. IK.ThrowMod{IK.throwVelocity} = IA.aToThrow arItem speed = speedFromWeight (IK.iweight itemKind) throwVelocity v = - fromIntegral (modifyDamageBySpeed rawDeltaHP speed) * 10 / xD 1 -- 1 damage valued at 10, just as in @damageUsefulness@ -- If item is periodic, we factor in the self value of effects, -- because they are applied to self, whether the actor wants it or not. -- We don't add a bonus of @averageTurnValue@ to the value of periodic -- effects, even though they save a turn, by being auto-applied, -- because on the flip side, player is not in control of the precise -- timing of their activation and also occasionally needs to spend a turn -- unequipping them to prevent activation. Note also that periodic -- activations don't consume the item, whether it's durable or not. aspectBenefits = aspectRecordToBenefit arItem eqpBens = sum $ aspectBenefits ++ [scalePeriodic (effSelf + effDice) | periodic] -- Equipped items may incur crippling maluses via aspects (but rather -- not via periodic effects). Examples of crippling maluses are zeroing -- melee or move skills. AI can't live with those and can't -- value those competently against any equally enormous bonuses -- the item might provide to compensate and so be even considered. cripplingDrawback = not (null aspectBenefits) && minimum aspectBenefits < -20 eqpSum = eqpBens - if cripplingDrawback then 100 else 0 -- If a weapon heals enemy at impact, given choice, it won't be used -- for melee, but can be equipped anyway, for beneficial aspects. -- OTOH, cif it harms wearer too much, it won't be worn -- but still may be flung and so may be worth picking up. (benInEqp, benPickupRaw) | IA.checkFlag Ability.Meleeable arItem -- the flag probably known even if item not identified && (benMelee < 0 || itemSuspect) && eqpSum >= -20 = ( True -- equip, melee crucial and only weapons in eqp can be used , eqpSum + maximum [benApply, - benMeleeAvg, 0] ) -- apply or melee or not | (IA.goesIntoEqp arItem || isJust (lookup "condition" $ IK.ifreq itemKind)) -- hack to record benefit, to use it in calculations later on && (eqpSum > 0 || itemSuspect) = -- weapon or other equippable ( True -- equip; long time bonus usually outweighs fling or apply , eqpSum -- possibly spent turn equipping, so reap the benefits + if durable then benApply -- apply or not but don't fling else 0) -- don't remove from equipment by using up | otherwise = (False, max benApply (- benFling)) -- apply or fling benPickup = max benPickupRaw $ if itemSuspect then 10 else 0 in Benefit{..} LambdaHack-0.9.5.0/engine-src/Game/LambdaHack/Client/Request.hs0000644000000000000000000000326107346545000022101 0ustar0000000000000000-- | Abstract syntax of requests. -- -- See -- . module Game.LambdaHack.Client.Request ( RequestAI, ReqAI(..), RequestUI, ReqUI(..), RequestTimed(..) ) where import Prelude () import Game.LambdaHack.Core.Prelude import qualified Game.LambdaHack.Definition.Ability as Ability import Game.LambdaHack.Definition.Defs import Game.LambdaHack.Common.Faction import Game.LambdaHack.Common.Point import Game.LambdaHack.Common.Types import Game.LambdaHack.Common.Vector import Game.LambdaHack.Content.ModeKind -- | Requests sent by AI clients to the server. If faction leader is to be -- changed, it's included as the second component. type RequestAI = (ReqAI, Maybe ActorId) -- | Possible forms of requests sent by AI clients. data ReqAI = ReqAINop | ReqAITimed RequestTimed deriving Show -- | Requests sent by UI clients to the server. If faction leader is to be -- changed, it's included as the second component. type RequestUI = (ReqUI, Maybe ActorId) -- | Possible forms of requests sent by UI clients. data ReqUI = ReqUINop | ReqUITimed RequestTimed | ReqUIGameRestart (GroupName ModeKind) Challenge | ReqUIGameDropAndExit | ReqUIGameSaveAndExit | ReqUIGameSave | ReqUITactic Ability.Tactic | ReqUIAutomate deriving Show -- | Requests that take game time. data RequestTimed = ReqMove Vector | ReqMelee ActorId ItemId CStore | ReqDisplace ActorId | ReqAlter Point | ReqWait | ReqWait10 | ReqYell | ReqMoveItems [(ItemId, Int, CStore, CStore)] | ReqProject Point Int ItemId CStore | ReqApply ItemId CStore deriving Show LambdaHack-0.9.5.0/engine-src/Game/LambdaHack/Client/Response.hs0000644000000000000000000000222107346545000022242 0ustar0000000000000000-- | Abstract syntax of responses. -- -- See -- . module Game.LambdaHack.Client.Response ( Response(..) ) where import Prelude () import Game.LambdaHack.Core.Prelude import Game.LambdaHack.Atomic import Game.LambdaHack.Common.Types import Game.LambdaHack.Common.State -- | Abstract syntax of responses sent by server to an AI or UI client -- (or a universal client that can handle both roles, which is why -- this type is not separated into distinct AI and UI types). -- A response tells a client how to update game state or what information -- to send to the server. data Response = RespUpdAtomicNoState UpdAtomic -- ^ change @State@ by performing this atomic update | RespUpdAtomic State UpdAtomic -- ^ put the given @State@, which results from performing the atomic update | RespQueryAI ActorId -- ^ compute an AI move for the actor and send (the semantics of) it | RespSfxAtomic SfxAtomic -- ^ perform special effects (animations, messages, etc.) | RespQueryUI -- ^ prompt the human player for a command and send (the semantics of) it deriving Show LambdaHack-0.9.5.0/engine-src/Game/LambdaHack/Client/State.hs0000644000000000000000000002013007346545000021523 0ustar0000000000000000{-# LANGUAGE DeriveGeneric #-} -- | Client-specific game state components. module Game.LambdaHack.Client.State ( StateClient(..), AlterLid, BfsAndPath(..) , TgtAndPath(..), Target(..), TGoal(..) , emptyStateClient, cycleMarkSuspect , updateTarget, getTarget, updateLeader, sside, sleader ) where import Prelude () import Game.LambdaHack.Core.Prelude import Data.Binary import qualified Data.EnumMap.Strict as EM import qualified Data.EnumSet as ES import qualified Data.Map.Strict as M import qualified Data.Primitive.PrimArray as PA import GHC.Generics (Generic) import qualified System.Random as R import Game.LambdaHack.Client.Bfs import Game.LambdaHack.Client.ClientOptions import Game.LambdaHack.Common.Actor import Game.LambdaHack.Common.ActorState import Game.LambdaHack.Common.Faction import Game.LambdaHack.Common.Item import Game.LambdaHack.Common.Perception import Game.LambdaHack.Common.Point import qualified Game.LambdaHack.Common.PointArray as PointArray import Game.LambdaHack.Common.State import Game.LambdaHack.Common.Types import Game.LambdaHack.Common.Vector import Game.LambdaHack.Content.ModeKind (ModeKind) import Game.LambdaHack.Definition.Defs -- | Client state, belonging to a single faction. data StateClient = StateClient { seps :: Int -- ^ a parameter of the aiming digital line , stargetD :: EM.EnumMap ActorId TgtAndPath -- ^ targets of our actors in the dungeon; this is only useful for AI -- and for directing henchmen, in particular with following tactics, -- where henchmen go to the leader's target , sfleeD :: EM.EnumMap ActorId Point -- ^ the position when fleeing requested , sexplored :: ES.EnumSet LevelId -- ^ the set of fully explored levels , sbfsD :: EM.EnumMap ActorId BfsAndPath -- ^ pathfinding data for our actors , sundo :: () -- [CmdAtomic] -- ^ atomic commands performed to date , sdiscoBenefit :: DiscoveryBenefit -- ^ remembered AI benefits of items; could be recomputed at resume, -- but they are costly to generate and not too large , sfper :: PerLid -- ^ faction perception indexed by level , salter :: AlterLid -- ^ cached alter skill data for positions , srandom :: R.StdGen -- ^ current random generator , _sleader :: Maybe ActorId -- ^ candidate new leader of the faction; -- Faction.gleader is the old leader , _sside :: FactionId -- ^ faction controlled by the client , squit :: Bool -- ^ exit the game loop , scurChal :: Challenge -- ^ current game challenge setup , snxtChal :: Challenge -- ^ next game challenge setup , snxtScenario :: Int -- ^ next game scenario number , smarkSuspect :: Int -- ^ whether to mark suspect features , scondInMelee :: EM.EnumMap LevelId Bool -- ^ whether we are in melee, per level , svictories :: EM.EnumMap (ContentId ModeKind) (M.Map Challenge Int) -- ^ won games at particular difficulty lvls , soptions :: ClientOptions -- ^ client options , stabs :: (PA.PrimArray PointI, PA.PrimArray PointI) -- ^ Instead of a BFS queue (list) we use these two arrays, -- for (JS) speed. They need to be per-client distinct, -- because sometimes multiple clients interleave BFS computation. } deriving Show type AlterLid = EM.EnumMap LevelId (PointArray.Array Word8) -- | Pathfinding distances to all reachable positions of an actor -- and a shortest paths to some of the positions. data BfsAndPath = BfsInvalid | BfsAndPath (PointArray.Array BfsDistance) (EM.EnumMap Point AndPath) deriving Show -- | Actor's target and a path to it, if any. data TgtAndPath = TgtAndPath {tapTgt :: Target, tapPath :: Maybe AndPath} deriving (Show, Generic) instance Binary TgtAndPath -- | The type of na actor target. data Target = TEnemy ActorId -- ^ target an enemy | TNonEnemy ActorId -- ^ target a friend or neutral | TPoint TGoal LevelId Point -- ^ target a concrete spot | TVector Vector -- ^ target position relative to actor deriving (Show, Eq, Ord, Generic) instance Binary Target -- | The goal of an actor. data TGoal = TEnemyPos ActorId -- ^ last seen position of the targeted actor | TEmbed ItemBag Point -- ^ embedded item that can be triggered; -- in @TPoint (TEmbed bag p) _ q@ usually @bag@ is -- embbedded in @p@ and @q@ is an adjacent open tile | TItem ItemBag -- ^ item lying on the ground | TSmell -- ^ smell potentially left by enemies | TBlock -- ^ a blocking tile to be approached (and, e.g., revealed -- to be walkable or altered or searched) | TUnknown -- ^ an unknown tile to be explored | TKnown -- ^ a known tile to be patrolled deriving (Show, Eq, Ord, Generic) instance Binary TGoal -- | Initial empty game client state. emptyStateClient :: FactionId -> StateClient emptyStateClient _sside = StateClient { seps = fromEnum _sside , stargetD = EM.empty , sfleeD = EM.empty , sexplored = ES.empty , sbfsD = EM.empty , sundo = () , sdiscoBenefit = EM.empty , sfper = EM.empty , salter = EM.empty , srandom = R.mkStdGen 42 -- will get modified in this and future games , _sleader = Nothing -- no heroes yet alive , _sside , squit = False , scurChal = defaultChallenge , snxtChal = defaultChallenge , snxtScenario = 0 , smarkSuspect = 1 , scondInMelee = EM.empty , svictories = EM.empty , soptions = defClientOptions , stabs = (undefined, undefined) } -- | Cycle the 'smarkSuspect' setting. cycleMarkSuspect :: StateClient -> StateClient cycleMarkSuspect s@StateClient{smarkSuspect} = s {smarkSuspect = (smarkSuspect + 1) `mod` 3} -- | Update target parameters within client state. updateTarget :: ActorId -> (Maybe Target -> Maybe Target) -> StateClient -> StateClient updateTarget aid f cli = let f2 tp = case f $ fmap tapTgt tp of Nothing -> Nothing Just tgt -> Just $ TgtAndPath tgt Nothing -- reset path in cli {stargetD = EM.alter f2 aid (stargetD cli)} -- | Get target parameters from client state. getTarget :: ActorId -> StateClient -> Maybe Target getTarget aid cli = fmap tapTgt $ EM.lookup aid $ stargetD cli -- | Update picked leader within state. Verify actor's faction. updateLeader :: ActorId -> State -> StateClient -> StateClient updateLeader leader s cli = let side1 = bfid $ getActorBody leader s side2 = sside cli in assert (side1 == side2 `blame` "enemy actor becomes our leader" `swith` (side1, side2, leader, s)) $ cli {_sleader = Just leader} sside :: StateClient -> FactionId sside = _sside sleader :: StateClient -> Maybe ActorId sleader = _sleader instance Binary StateClient where put StateClient{..} = do put seps put stargetD put sfleeD put sexplored put sdiscoBenefit put (show srandom) put _sleader put _sside put scurChal put snxtChal put snxtScenario put smarkSuspect put scondInMelee put svictories #ifdef WITH_EXPENSIVE_ASSERTIONS put sfper #endif get = do seps <- get stargetD <- get sfleeD <- get sexplored <- get sdiscoBenefit <- get g <- get _sleader <- get _sside <- get scurChal <- get snxtChal <- get snxtScenario <- get smarkSuspect <- get scondInMelee <- get svictories <- get let sbfsD = EM.empty sundo = () salter = EM.empty srandom = read g squit = False soptions = defClientOptions stabs = (undefined, undefined) #ifndef WITH_EXPENSIVE_ASSERTIONS sfper = EM.empty #else sfper <- get #endif return $! StateClient{..} LambdaHack-0.9.5.0/engine-src/Game/LambdaHack/Client/UI.hs0000644000000000000000000001772107346545000020774 0ustar0000000000000000-- | Ways for the client to use player input via UI to produce server -- requests, based on the client's view (visualized for the player) -- of the game state. module Game.LambdaHack.Client.UI ( -- * Querying the human player queryUI -- * UI monad and session type , MonadClientUI(..), SessionUI(..) -- * Updating UI state wrt game state changes , displayRespUpdAtomicUI, displayRespSfxAtomicUI -- * Startup and initialization , CCUI(..) , UIOptions, applyUIOptions, uCmdline, mkUIOptions -- * Operations exposed for "Game.LambdaHack.Client.LoopM" , ChanFrontend, chanFrontend, promptAdd, tryRestore #ifdef EXPOSE_INTERNAL -- * Internal operations , humanCommand #endif ) where import Prelude () import Game.LambdaHack.Core.Prelude import qualified Data.EnumMap.Strict as EM import qualified Data.EnumSet as ES import qualified Data.Map.Strict as M import qualified Data.Text as T import Game.LambdaHack.Client.ClientOptions import Game.LambdaHack.Client.MonadClient import Game.LambdaHack.Client.Request import Game.LambdaHack.Client.State import Game.LambdaHack.Client.UI.Content.Input import Game.LambdaHack.Client.UI.ContentClientUI import Game.LambdaHack.Client.UI.DisplayAtomicM import Game.LambdaHack.Client.UI.FrameM import Game.LambdaHack.Client.UI.Frontend import Game.LambdaHack.Client.UI.HandleHelperM import Game.LambdaHack.Client.UI.HandleHumanM import qualified Game.LambdaHack.Client.UI.Key as K import Game.LambdaHack.Client.UI.MonadClientUI import Game.LambdaHack.Client.UI.Msg import Game.LambdaHack.Client.UI.MsgM import Game.LambdaHack.Client.UI.Overlay import Game.LambdaHack.Client.UI.SessionUI import Game.LambdaHack.Client.UI.Slideshow import Game.LambdaHack.Client.UI.SlideshowM import Game.LambdaHack.Client.UI.UIOptions import Game.LambdaHack.Client.UI.UIOptionsParse import Game.LambdaHack.Common.Actor import Game.LambdaHack.Common.ActorState import Game.LambdaHack.Common.Faction import Game.LambdaHack.Common.MonadStateRead import Game.LambdaHack.Common.State import Game.LambdaHack.Common.Types import Game.LambdaHack.Content.ModeKind -- | Handle the move of a human player. queryUI :: (MonadClient m, MonadClientUI m) => m RequestUI queryUI = do side <- getsClient sside fact <- getsState $ (EM.! side) . sfactionD if isAIFact fact then do recordHistory keyPressed <- anyKeyPressed if keyPressed && fleaderMode (gplayer fact) /= LeaderNull then do -- Menu is entered in @displayRespUpdAtomicUI@ at @UpdAutoFaction@. discardPressedKey -- Regaining control of faction cancels --stopAfter*. modifyClient $ \cli -> cli {soptions = (soptions cli) { sstopAfterSeconds = Nothing , sstopAfterFrames = Nothing }} return (ReqUIAutomate, Nothing) -- stop AI else do -- As long as UI faction is under AI control, check, once per move, -- for benchmark game stop. stopAfterFrames <- getsClient $ sstopAfterFrames . soptions bench <- getsClient $ sbenchmark . soptions let exitCmd = if bench then ReqUIGameDropAndExit else ReqUIGameSaveAndExit case stopAfterFrames of Nothing -> do stopAfterSeconds <- getsClient $ sstopAfterSeconds . soptions case stopAfterSeconds of Nothing -> return (ReqUINop, Nothing) Just stopS -> do exit <- elapsedSessionTimeGT stopS if exit then do tellAllClipPS return (exitCmd, Nothing) -- ask server to exit else return (ReqUINop, Nothing) Just stopF -> do allNframes <- getsSession sallNframes gnframes <- getsSession snframes if allNframes + gnframes >= stopF then do tellAllClipPS return (exitCmd, Nothing) -- ask server to exit else return (ReqUINop, Nothing) else do let mleader = gleader fact !_A = assert (isJust mleader) () req <- humanCommand leader2 <- getLeaderUI -- Don't send the leader switch to the server with these commands, -- to avoid leader death at resume if his HP <= 0. That would violate -- the principle that save and reload doesn't change game state. let saveCmd cmd = case cmd of ReqUIGameDropAndExit -> True ReqUIGameSaveAndExit -> True ReqUIGameSave -> True _ -> False return (req, if mleader /= Just leader2 && not (saveCmd req) then Just leader2 else Nothing) -- | Let the human player issue commands until any command takes time. humanCommand :: forall m. (MonadClient m, MonadClientUI m) => m ReqUI humanCommand = do modifySession $ \sess -> sess { slastLost = ES.empty , shintMode = HintAbsent } let loop :: Maybe ActorId -> m ReqUI loop mOldLeader = do report <- getsSession $ newReport . shistory hintMode <- getsSession shintMode -- Hints are not considered non-empty reports. modifySession $ \sess -> sess {sreportNull = nullReport report || hintMode == HintShown} case hintMode of HintAbsent -> return () HintShown -> modifySession $ \sess -> sess {shintMode = HintWiped} HintWiped -> modifySession $ \sess -> sess {shintMode = HintAbsent} slidesRaw <- reportToSlideshowKeep [] over <- case unsnoc slidesRaw of Nothing -> return [] Just (allButLast, (ov, _)) -> if allButLast == emptySlideshow then -- Display the only generated slide while waiting for next key. -- Strip the "--end-" prompt from it. return $! init ov else do -- Show, one by one, all slides, awaiting confirmation for each. void $ getConfirms ColorFull [K.spaceKM, K.escKM] slidesRaw -- Indicate that report wiped out. modifySession $ \sess -> sess {sreportNull = True} -- Display base frame at the end. return [] LastRecord seqCurrent seqPrevious k <- getsSession slastRecord let slastRecord | k == 0 = LastRecord [] seqCurrent 0 | otherwise = LastRecord [] (seqCurrent ++ seqPrevious) (k - 1) modifySession $ \sess -> sess {slastRecord} leader <- getLeaderUI b <- getsState $ getActorBody leader when (bhp b <= 0 && Just leader /= mOldLeader) $ displayMore ColorBW "If you move, the exertion will kill you. Consider asking for first aid instead." km <- promptGetKey ColorFull over False [] abortOrCmd <- do -- Look up the key. CCUI{coinput=InputContent{bcmdMap}} <- getsSession sccui case km `M.lookup` bcmdMap of Just (_, _, cmd) -> do modifySession $ \sess -> sess {swaitTimes = if swaitTimes sess > 0 then - swaitTimes sess else 0} cmdHumanSem cmd _ -> let msgKey = "unknown command <" <> K.showKM km <> ">" in weaveJust <$> failWith (T.pack msgKey) -- The command was failed or successful and if the latter, -- possibly took some time. case abortOrCmd of Right cmdS -> -- Exit the loop and let other actors act. No next key needed -- and no report could have been generated. return cmdS Left Nothing -> loop $ Just leader Left (Just err) -> do -- Avoid "*never mind*". let l0 = ["*never mind*", "*aiming started*"] t = showFailError err if t `elem` l0 then msgAdd0 MsgAlert t else msgAdd MsgAlert t loop $ Just leader loop Nothing LambdaHack-0.9.5.0/engine-src/Game/LambdaHack/Client/UI/0000755000000000000000000000000007346545000020430 5ustar0000000000000000LambdaHack-0.9.5.0/engine-src/Game/LambdaHack/Client/UI/ActorUI.hs0000644000000000000000000000531307346545000022274 0ustar0000000000000000{-# LANGUAGE DeriveGeneric #-} -- | UI aspects of actors. module Game.LambdaHack.Client.UI.ActorUI ( ActorUI(..), ActorDictUI , keySelected, partActor, partPronoun , ppCStoreWownW, ppContainerWownW, tryFindActor, tryFindHeroK ) where import Prelude () import Game.LambdaHack.Core.Prelude import Data.Binary import qualified Data.Char as Char import qualified Data.EnumMap.Strict as EM import GHC.Generics (Generic) import qualified NLP.Miniutter.English as MU import Game.LambdaHack.Common.Actor import Game.LambdaHack.Common.State import Game.LambdaHack.Common.Types import qualified Game.LambdaHack.Definition.Color as Color import Game.LambdaHack.Definition.Defs data ActorUI = ActorUI { bsymbol :: Char -- ^ individual map symbol , bname :: Text -- ^ individual name , bpronoun :: Text -- ^ individual pronoun , bcolor :: Color.Color -- ^ individual map color } deriving (Show, Eq, Generic) instance Binary ActorUI type ActorDictUI = EM.EnumMap ActorId ActorUI keySelected :: (ActorId, Actor, ActorUI) -> (Bool, Bool, Bool, Char, Color.Color, ActorId) keySelected (aid, Actor{bhp, bwatch}, ActorUI{bsymbol, bcolor}) = (bhp > 0, bwatch /= WSleep, bsymbol /= '@', bsymbol, bcolor, aid) -- | The part of speech describing the actor. partActor :: ActorUI -> MU.Part partActor b = MU.Text $ bname b -- | The part of speech containing the actor's pronoun. partPronoun :: ActorUI -> MU.Part partPronoun b = MU.Text $ bpronoun b ppCStoreWownW :: Bool -> CStore -> MU.Part -> [MU.Part] ppCStoreWownW addPrepositions store owner = let (preposition, noun) = ppCStore store prep = [MU.Text preposition | addPrepositions] in prep ++ case store of CGround -> [MU.Text noun, "under", owner] CSha -> [MU.Text noun] _ -> [MU.WownW owner (MU.Text noun) ] ppContainerWownW :: (ActorId -> MU.Part) -> Bool -> Container -> [MU.Part] ppContainerWownW ownerFun addPrepositions c = case c of CFloor{} -> ["nearby"] CEmbed{} -> ["embedded nearby"] CActor aid store -> let owner = ownerFun aid in ppCStoreWownW addPrepositions store owner CTrunk{} -> error $ "" `showFailure` c tryFindActor :: State -> (ActorId -> Actor -> Bool) -> Maybe (ActorId, Actor) tryFindActor s p = find (uncurry p) $ EM.assocs $ sactorD s tryFindHeroK :: ActorDictUI -> FactionId -> Int -> State -> Maybe (ActorId, Actor) tryFindHeroK d fid k s = let c | k == 0 = '@' | k > 0 && k < 10 = Char.intToDigit k | otherwise = ' ' -- no hero with such symbol in tryFindActor s (\aid body -> maybe False ((== c) . bsymbol) (EM.lookup aid d) && bfid body == fid) LambdaHack-0.9.5.0/engine-src/Game/LambdaHack/Client/UI/Animation.hs0000644000000000000000000002016207346545000022704 0ustar0000000000000000{-# LANGUAGE TupleSections #-} -- | Screen frames and animations. module Game.LambdaHack.Client.UI.Animation ( Animation, renderAnim , pushAndDelay, twirlSplash, blockHit, blockMiss, subtleHit , deathBody, shortDeathBody, actorX, teleport, swapPlaces, fadeout #ifdef EXPOSE_INTERNAL -- * Internal operations , blank, cSym, mapPosToOffset, mzipSingleton, mzipPairs #endif ) where import Prelude () import Game.LambdaHack.Core.Prelude import Data.Bits import qualified Data.EnumMap.Strict as EM import Game.LambdaHack.Client.UI.Content.Screen import Game.LambdaHack.Client.UI.Frame import Game.LambdaHack.Client.UI.Overlay import Game.LambdaHack.Definition.Color import Game.LambdaHack.Common.Point import Game.LambdaHack.Core.Random -- | Animation is a list of frame modifications to play one by one, -- where each modification if a map from positions to level map symbols. newtype Animation = Animation [IntOverlay] deriving (Eq, Show) -- | Render animations on top of a screen frame. -- -- Located in this module to keep @Animation@ abstract. renderAnim :: PreFrame -> Animation -> PreFrames renderAnim basicFrame (Animation anim) = let modifyFrame :: IntOverlay -> PreFrame modifyFrame am = overlayFrame am basicFrame modifyFrames :: (IntOverlay, IntOverlay) -> Maybe PreFrame modifyFrames (am, amPrevious) = if am == amPrevious then Nothing else Just $ modifyFrame am in Just basicFrame : map modifyFrames (zip anim ([] : anim)) blank :: Maybe AttrCharW32 blank = Nothing cSym :: Color -> Char -> Maybe AttrCharW32 cSym color symbol = Just $ attrChar2ToW32 color symbol mapPosToOffset :: ScreenContent -> (Point, AttrCharW32) -> (Int, [AttrCharW32]) mapPosToOffset ScreenContent{rwidth} (Point{..}, attr) = ((py + 1) * rwidth + px, [attr]) mzipSingleton :: ScreenContent -> Point -> Maybe AttrCharW32 -> IntOverlay mzipSingleton coscreen p1 mattr1 = map (mapPosToOffset coscreen) $ let mzip (pos, mattr) = fmap (pos,) mattr in catMaybes [mzip (p1, mattr1)] mzipPairs :: ScreenContent -> (Point, Point) -> (Maybe AttrCharW32, Maybe AttrCharW32) -> IntOverlay mzipPairs coscreen (p1, p2) (mattr1, mattr2) = map (mapPosToOffset coscreen) $ let mzip (pos, mattr) = fmap (pos,) mattr in catMaybes $ if p1 /= p2 then [mzip (p1, mattr1), mzip (p2, mattr2)] else -- If actor affects himself, show only the effect, -- not the action. [mzip (p1, mattr1)] pushAndDelay :: Animation pushAndDelay = Animation [[]] -- | Attack animation. A part of it also reused for self-damage and healing. twirlSplash :: ScreenContent -> (Point, Point) -> Color -> Color -> Animation twirlSplash coscreen poss c1 c2 = Animation $ map (mzipPairs coscreen poss) [ (blank , cSym BrCyan '\'') , (blank , cSym BrYellow '\'') , (blank , cSym BrYellow '^') , (cSym c1 '\\',cSym BrCyan '^') , (cSym c1 '|', cSym BrCyan '^') , (cSym c1 '%', blank) , (cSym c1 '/', blank) , (cSym c1 '-', blank) , (cSym c1 '\\',blank) , (cSym c2 '|', blank) , (cSym c2 '%', blank) ] -- | Attack that hits through a block. blockHit :: ScreenContent -> (Point, Point) -> Color -> Color -> Animation blockHit coscreen poss c1 c2 = Animation $ map (mzipPairs coscreen poss) [ (blank , cSym BrCyan '\'') , (blank , cSym BrYellow '\'') , (blank , cSym BrYellow '^') , (blank , cSym BrCyan '^') , (cSym BrBlue '{', cSym BrCyan '\'') , (cSym BrBlue '{', cSym BrYellow '\'') , (cSym BrBlue '{', cSym BrYellow '\'') , (cSym BrBlue '}', blank) , (cSym BrBlue '}', blank) , (cSym BrBlue '}', blank) , (cSym c1 '\\',blank) , (cSym c1 '|', blank) , (cSym c1 '/', blank) , (cSym c1 '-', blank) , (cSym c2 '\\',blank) , (cSym c2 '|', blank) , (cSym c2 '/', blank) ] -- | Attack that is blocked. blockMiss :: ScreenContent -> (Point, Point) -> Animation blockMiss coscreen poss = Animation $ map (mzipPairs coscreen poss) [ (blank , cSym BrCyan '\'') , (blank , cSym BrYellow '^') , (cSym BrBlue '{', cSym BrYellow '\'') , (cSym BrBlue '{', cSym BrCyan '\'') , (cSym BrBlue '{', blank) , (cSym BrBlue '}', blank) , (cSym BrBlue '}', blank) , (cSym Blue '}', blank) , (cSym Blue '}', blank) ] -- | Attack that is subtle (e.g., damage dice 0). subtleHit :: ScreenContent -> Point -> Animation subtleHit coscreen pos = Animation $ map (mzipSingleton coscreen pos) [ cSym BrCyan '\'' , cSym BrYellow '\'' , cSym BrYellow '^' , cSym BrCyan '^' , cSym BrCyan '\'' ] -- | Death animation for an organic body. deathBody :: ScreenContent -> Point -> Animation deathBody coscreen pos = Animation $ map (mzipSingleton coscreen pos) [ cSym Red '%' , cSym Red '-' , cSym Red '-' , cSym Red '\\' , cSym Red '\\' , cSym Red '|' , cSym Red '|' , cSym Red '%' , cSym Red '%' , cSym Red '%' , cSym Red '%' , cSym Red ';' , cSym Red ';' ] -- | Death animation for an organic body, short version (e.g., for enemies). shortDeathBody :: ScreenContent -> Point -> Animation shortDeathBody coscreen pos = Animation $ map (mzipSingleton coscreen pos) [ cSym Red '%' , cSym Red '-' , cSym Red '\\' , cSym Red '|' , cSym Red '%' , cSym Red '%' , cSym Red '%' , cSym Red ';' , cSym Red ',' ] -- | Mark actor location animation. actorX :: ScreenContent -> Point -> Animation actorX coscreen pos = Animation $ map (mzipSingleton coscreen pos) [ cSym BrRed 'X' , cSym BrRed 'X' , blank , blank ] -- | Actor teleport animation. teleport :: ScreenContent -> (Point, Point) -> Animation teleport coscreen poss = Animation $ map (mzipPairs coscreen poss) [ (cSym BrMagenta 'o', cSym Magenta '.') , (cSym BrMagenta 'O', cSym Magenta '.') , (cSym Magenta 'o', cSym Magenta 'o') , (cSym Magenta '.', cSym BrMagenta 'O') , (cSym Magenta '.', cSym BrMagenta 'o') , (cSym Magenta '.', blank) , (blank , blank) ] -- | Swap-places animation, both hostile and friendly. swapPlaces :: ScreenContent -> (Point, Point) -> Animation swapPlaces coscreen poss = Animation $ map (mzipPairs coscreen poss) [ (cSym BrMagenta 'o', cSym Magenta 'o') , (cSym BrMagenta 'd', cSym Magenta 'p') , (cSym BrMagenta '.', cSym Magenta 'p') , (cSym Magenta 'p', cSym Magenta '.') , (cSym Magenta 'p', cSym BrMagenta 'd') , (cSym Magenta 'p', cSym BrMagenta 'd') , (cSym Magenta 'o', blank) , (blank , blank) ] fadeout :: ScreenContent -> Bool -> Int -> Rnd Animation fadeout ScreenContent{rwidth, rheight} out step = do let xbound = rwidth - 1 ybound = rheight - 1 margin = (rwidth - 2 * rheight) `div` 2 - 2 edge = EM.fromDistinctAscList $ zip [1..] ".%&%;:,." fadeChar !r !n !x !y = let d = x - 2 * y ndy = n - d - 2 * ybound ndx = n + d - xbound - 1 -- @-1@ for asymmetry mnx = if ndy > 0 && ndx > 0 then min ndy ndx else max ndy ndx v3 = (r `xor` (x * y)) `mod` 3 k | mnx < 3 || mnx > 10 = mnx | (min x (xbound - x - y) + n + v3) `mod` 15 < 11 && mnx > 6 = mnx - v3 | (x + 3 * y + v3) `mod` 30 < 19 = mnx + 1 | otherwise = mnx in EM.findWithDefault ' ' k edge rollFrame !n = do r <- random let fadeAttr !y !x = attrChar1ToW32 $ fadeChar r n x y fadeLine !y = let x1 :: Int {-# INLINE x1 #-} x1 = min xbound (n - 2 * (ybound - y)) x2 :: Int {-# INLINE x2 #-} x2 = max 0 (xbound - (n - 2 * y)) in [ (y * rwidth, map (fadeAttr y) [0..x1]) , (y * rwidth + x2, map (fadeAttr y) [x2..xbound]) ] return $! concatMap fadeLine [0..ybound] fs | out = [3, 3 + step .. rwidth - margin] | otherwise = [rwidth - margin, rwidth - margin - step .. 1] ++ [0] -- no remnants of fadein onscreen, in case of lag Animation <$> mapM rollFrame fs LambdaHack-0.9.5.0/engine-src/Game/LambdaHack/Client/UI/Content/0000755000000000000000000000000007346545000022042 5ustar0000000000000000LambdaHack-0.9.5.0/engine-src/Game/LambdaHack/Client/UI/Content/Input.hs0000644000000000000000000002201707346545000023477 0ustar0000000000000000-- | The type of definitions of key-command mappings to be used for the UI -- and shorthands for specifying command triples in the content files. module Game.LambdaHack.Client.UI.Content.Input ( InputContentRaw(..), InputContent(..), makeData , evalKeyDef , addCmdCategory, replaceDesc, moveItemTriple, repeatTriple , mouseLMB, mouseMMB, mouseRMB , goToCmd, runToAllCmd, autoexploreCmd, autoexplore25Cmd , aimFlingCmd, projectI, projectA, flingTs, applyIK, applyI , grabItems, dropItems, descIs, descTs, defaultHeroSelect #ifdef EXPOSE_INTERNAL -- * Internal operations , replaceCmd, projectICmd, grabCmd, dropCmd #endif ) where import Prelude () import Game.LambdaHack.Core.Prelude import qualified Data.Char as Char import qualified Data.Map.Strict as M import qualified NLP.Miniutter.English as MU import Game.LambdaHack.Client.UI.HumanCmd import qualified Game.LambdaHack.Client.UI.Key as K import Game.LambdaHack.Client.UI.UIOptions import Game.LambdaHack.Common.Misc import Game.LambdaHack.Definition.Defs -- | Key-command mappings to be specified in content and used for the UI. newtype InputContentRaw = InputContentRaw [(K.KM, CmdTriple)] -- | Bindings and other information about human player commands. data InputContent = InputContent { bcmdMap :: M.Map K.KM CmdTriple -- ^ binding of keys to commands , bcmdList :: [(K.KM, CmdTriple)] -- ^ the properly ordered list -- of commands for the help menu , brevMap :: M.Map HumanCmd [K.KM] -- ^ and from commands to their keys } -- | Create binding of keys to movement and other standard commands, -- as well as commands defined in the config file. makeData :: UIOptions -- ^ UI client options -> InputContentRaw -- ^ default key bindings from the content -> InputContent -- ^ concrete binding makeData UIOptions{uCommands, uVi, uLaptop} (InputContentRaw copsClient) = let waitTriple = ([CmdMove], "", Wait) wait10Triple = ([CmdMove], "", Wait10) moveXhairOr n cmd v = ByAimMode $ AimModeCmd { exploration = cmd v , aiming = MoveXhair v n } bcmdList = (if | uVi -> filter (\(k, _) -> k `notElem` [K.mkKM "period", K.mkKM "C-period"]) | uLaptop -> filter (\(k, _) -> k `notElem` [K.mkKM "i", K.mkKM "C-i", K.mkKM "I"]) | otherwise -> id) copsClient ++ uCommands ++ [ (K.mkKM "KP_Begin", waitTriple) , (K.mkKM "C-KP_Begin", wait10Triple) , (K.mkKM "KP_5", wait10Triple) , (K.mkKM "C-KP_5", wait10Triple) ] ++ (if | uVi -> [ (K.mkKM "period", waitTriple) , (K.mkKM "C-period", wait10Triple) ] -- yell on % always | uLaptop -> [ (K.mkKM "i", waitTriple) , (K.mkKM "C-i", wait10Triple) , (K.mkKM "I", wait10Triple) ] | otherwise -> []) ++ K.moveBinding uVi uLaptop (\v -> ([CmdMove], "", moveXhairOr 1 MoveDir v)) (\v -> ([CmdMove], "", moveXhairOr 10 RunDir v)) rejectRepetitions t1 t2 = error $ "duplicate key" `showFailure` (t1, t2) in InputContent { bcmdMap = M.fromListWith rejectRepetitions [ (k, triple) | (k, triple@(cats, _, _)) <- bcmdList , all (`notElem` [CmdMainMenu]) cats ] , bcmdList , brevMap = M.fromListWith (flip (++)) $ concat [ [(cmd, [k])] | (k, (cats, _desc, cmd)) <- bcmdList , all (`notElem` [CmdMainMenu, CmdDebug, CmdNoHelp]) cats ] } evalKeyDef :: (String, CmdTriple) -> (K.KM, CmdTriple) evalKeyDef (t, triple@(cats, _, _)) = let km = if CmdInternal `elem` cats then K.KM K.NoModifier $ K.Unknown t else K.mkKM t in (km, triple) addCmdCategory :: CmdCategory -> CmdTriple -> CmdTriple addCmdCategory cat (cats, desc, cmd) = (cat : cats, desc, cmd) replaceDesc :: Text -> CmdTriple -> CmdTriple replaceDesc desc (cats, _, cmd) = (cats, desc, cmd) replaceCmd :: HumanCmd -> CmdTriple -> CmdTriple replaceCmd cmd (cats, desc, _) = (cats, desc, cmd) moveItemTriple :: [CStore] -> CStore -> MU.Part -> Bool -> CmdTriple moveItemTriple stores1 store2 object auto = let verb = MU.Text $ verbCStore store2 desc = makePhrase [verb, object] in ([CmdItemMenu], desc, MoveItem stores1 store2 Nothing auto) repeatTriple :: Int -> CmdTriple repeatTriple n = ( [CmdMeta] , "voice recorded commands" <+> tshow n <+> "times" , Repeat n ) -- @AimFloor@ is not there, but @AimEnemy@ and @AimItem@ almost make up for it. mouseLMB :: HumanCmd -> Text -> CmdTriple mouseLMB goToOrRunTo desc = ([CmdMouse], desc, ByAimMode aimMode) where aimMode = AimModeCmd { exploration = ByArea $ common ++ -- exploration mode [ (CaMapLeader, grabCmd) , (CaMapParty, PickLeaderWithPointer) , (CaMap, goToOrRunTo) , (CaArenaName, Dashboard) , (CaPercentSeen, autoexploreCmd) ] , aiming = ByArea $ common ++ -- aiming mode [ (CaMap, aimFlingCmd) , (CaArenaName, Accept) , (CaPercentSeen, XhairStair True) ] } common = [ (CaMessage, ExecuteIfClear LastHistory) , (CaLevelNumber, AimAscend 1) , (CaXhairDesc, AimEnemy) -- inits aiming and then cycles enemies , (CaSelected, PickLeaderWithPointer) -- , (CaCalmGauge, Macro ["KP_Begin", "C-V"]) , (CaCalmValue, Yell) , (CaHPGauge, Macro ["KP_Begin", "C-V"]) , (CaHPValue, Wait) , (CaLeaderDesc, projectICmd flingTs) ] mouseMMB :: CmdTriple mouseMMB = ( [CmdMouse] , "snap x-hair to floor under pointer" , XhairPointerFloor ) mouseRMB :: CmdTriple mouseRMB = ( [CmdMouse] , "start aiming at enemy under pointer" , ByAimMode aimMode ) where aimMode = AimModeCmd { exploration = ByArea $ common ++ [ (CaMapLeader, dropCmd) , (CaMapParty, SelectWithPointer) , (CaMap, AimPointerEnemy) , (CaArenaName, MainMenuAutoOff) , (CaPercentSeen, autoexplore25Cmd) ] , aiming = ByArea $ common ++ [ (CaMap, XhairPointerEnemy) -- hack; same effect, but matches LMB , (CaArenaName, Cancel) , (CaPercentSeen, XhairStair False) ] } common = [ (CaMessage, Hint) , (CaLevelNumber, AimAscend (-1)) , (CaXhairDesc, AimItem) , (CaSelected, SelectWithPointer) -- , (CaCalmGauge, Macro ["C-KP_Begin", "V"]) , (CaCalmValue, Yell) , (CaHPGauge, Macro ["C-KP_Begin", "V"]) , (CaHPValue, Wait10) , (CaLeaderDesc, ComposeUnlessError ClearTargetIfItemClear ItemClear) ] -- This is duplicated wrt content, instead of included via @semicolon@, -- because the C- commands are less likely to be modified by the player. goToCmd :: HumanCmd goToCmd = Macro ["MiddleButtonRelease", "C-semicolon", "C-quotedbl", "C-V"] -- This is duplicated wrt content, instead of included via @colon@, -- because the C- commands are less likely to be modified by the player. runToAllCmd :: HumanCmd runToAllCmd = Macro ["MiddleButtonRelease", "C-colon", "C-quotedbl", "C-V"] autoexploreCmd :: HumanCmd autoexploreCmd = Macro ["C-?", "C-quotedbl", "C-V"] autoexplore25Cmd :: HumanCmd autoexplore25Cmd = Macro ["'", "C-?", "C-quotedbl", "'", "C-V"] aimFlingCmd :: HumanCmd aimFlingCmd = ComposeIfLocal AimPointerEnemy (projectICmd flingTs) projectICmd :: [TriggerItem] -> HumanCmd projectICmd ts = ComposeUnlessError (ChooseItemProject ts) Project projectI :: [TriggerItem] -> CmdTriple projectI ts = ([], descIs ts, projectICmd ts) projectA :: [TriggerItem] -> CmdTriple projectA ts = let fling = Compose2ndLocal Project ItemClear flingICmd = ComposeUnlessError (ChooseItemProject ts) fling in replaceCmd (ByAimMode AimModeCmd { exploration = AimTgt , aiming = flingICmd }) (projectI ts) flingTs :: [TriggerItem] flingTs = [TriggerItem { tiverb = "fling" , tiobject = "projectile" , tisymbols = "" }] applyIK :: [TriggerItem] -> CmdTriple applyIK ts = ([], descIs ts, ComposeUnlessError (ChooseItemApply ts) Apply) applyI :: [TriggerItem] -> CmdTriple applyI ts = let apply = Compose2ndLocal Apply ItemClear in ([], descIs ts, ComposeUnlessError (ChooseItemApply ts) apply) grabCmd :: HumanCmd grabCmd = MoveItem [CGround] CEqp (Just "grab") True -- @CEqp@ is the implicit default; refined in HandleHumanGlobalM grabItems :: Text -> CmdTriple grabItems t = ([CmdItemMenu], t, grabCmd) dropCmd :: HumanCmd dropCmd = MoveItem [CEqp, CInv, CSha] CGround Nothing False dropItems :: Text -> CmdTriple dropItems t = ([CmdItemMenu], t, dropCmd) descIs :: [TriggerItem] -> Text descIs [] = "trigger an item" descIs (t : _) = makePhrase [tiverb t, tiobject t] descTs :: [TriggerTile] -> Text descTs [] = "alter a tile" descTs (t : _) = makePhrase [ttverb t, ttobject t] defaultHeroSelect :: Int -> (String, CmdTriple) defaultHeroSelect k = ([Char.intToDigit k], ([CmdMeta], "", PickLeader k)) LambdaHack-0.9.5.0/engine-src/Game/LambdaHack/Client/UI/Content/Screen.hs0000644000000000000000000000312707346545000023620 0ustar0000000000000000-- | The type of definitions of screen layout and features. module Game.LambdaHack.Client.UI.Content.Screen ( ScreenContent(..), makeData #ifdef EXPOSE_INTERNAL -- * Internal operations , validateSingle #endif ) where import Prelude () import Game.LambdaHack.Core.Prelude import qualified Data.EnumMap.Strict as EM import qualified Data.Text as T import Game.LambdaHack.Definition.Defs -- | Screen layout and features definition. data ScreenContent = ScreenContent { rwidth :: X -- ^ screen width , rheight :: Y -- ^ screen height , rmainMenuArt :: Text -- ^ the ASCII art for the main menu , rintroScreen :: [String] -- ^ the intro screen (first help screen) text , rmoveKeysScreen :: [String] -- ^ the fixed move key help blurb , rapplyVerbMap :: EM.EnumMap Char T.Text -- ^ verbs to use for apply actions } -- | Catch invalid rule kind definitions. validateSingle :: ScreenContent -> [Text] validateSingle ScreenContent{rmainMenuArt} = let ts = T.lines rmainMenuArt tsNot80 = filter ((/= 80) . T.length) ts in case tsNot80 of [] -> [ "rmainMenuArt doesn't have at least 24 lines, but " <> tshow (length ts) | length ts < 24] tNot80 : _ -> ["rmainMenuArt has a line with length other than 80:" <> tNot80] makeData :: ScreenContent -> ScreenContent makeData sc = let singleOffenders = validateSingle sc in assert (null singleOffenders `blame` "Screen Content" ++ ": some content items not valid" `swith` singleOffenders) sc LambdaHack-0.9.5.0/engine-src/Game/LambdaHack/Client/UI/ContentClientUI.hs0000644000000000000000000000154607346545000024001 0ustar0000000000000000-- | General content types and operations. module Game.LambdaHack.Client.UI.ContentClientUI ( CCUI(..), emptyCCUI ) where import Prelude () import qualified Data.EnumMap.Strict as EM import qualified Data.Map.Strict as M import Game.LambdaHack.Client.UI.Content.Input import Game.LambdaHack.Client.UI.Content.Screen -- | Operations for all content types, gathered together. data CCUI = CCUI { coinput :: InputContent , coscreen :: ScreenContent } emptyCCUI :: CCUI emptyCCUI = CCUI { coinput = InputContent M.empty [] M.empty , coscreen = ScreenContent { rwidth = 0 , rheight = 0 , rmainMenuArt = "" , rintroScreen = [] , rmoveKeysScreen = [] , rapplyVerbMap = EM.empty } } LambdaHack-0.9.5.0/engine-src/Game/LambdaHack/Client/UI/DisplayAtomicM.hs0000644000000000000000000024114707346545000023654 0ustar0000000000000000{-# LANGUAGE TupleSections #-} -- | Display atomic commands received by the client. module Game.LambdaHack.Client.UI.DisplayAtomicM ( displayRespUpdAtomicUI, displayRespSfxAtomicUI #ifdef EXPOSE_INTERNAL -- * Internal operations , updateItemSlot, markDisplayNeeded, lookAtMove , aidVerbMU, aidVerbMU0, aidVerbDuplicateMU , itemVerbMU, itemAidVerbMU , createActorUI, destroyActorUI, spotItem, moveActor, displaceActorUI , moveItemUI, quitFactionUI , displayGameOverLoot, displayGameOverAnalytics , discover, ppSfxMsg, strike #endif ) where import Prelude () import Game.LambdaHack.Core.Prelude import qualified Data.Char as Char import qualified Data.EnumMap.Strict as EM import qualified Data.EnumSet as ES import Data.Key (mapWithKeyM_) import qualified Data.Ord as Ord import qualified Data.Text as T import Data.Tuple import GHC.Exts (inline) import qualified NLP.Miniutter.English as MU import Game.LambdaHack.Atomic import Game.LambdaHack.Client.ClientOptions import Game.LambdaHack.Client.MonadClient import Game.LambdaHack.Client.State import Game.LambdaHack.Client.UI.ActorUI import Game.LambdaHack.Client.UI.Animation import Game.LambdaHack.Client.UI.Content.Screen import Game.LambdaHack.Client.UI.ContentClientUI import Game.LambdaHack.Client.UI.DrawM import Game.LambdaHack.Client.UI.EffectDescription import Game.LambdaHack.Client.UI.FrameM import Game.LambdaHack.Client.UI.HandleHelperM import Game.LambdaHack.Client.UI.ItemDescription import Game.LambdaHack.Client.UI.ItemSlot import qualified Game.LambdaHack.Client.UI.Key as K import Game.LambdaHack.Client.UI.MonadClientUI import Game.LambdaHack.Client.UI.Msg import Game.LambdaHack.Client.UI.MsgM import Game.LambdaHack.Client.UI.Overlay import Game.LambdaHack.Client.UI.SessionUI import Game.LambdaHack.Client.UI.SlideshowM import Game.LambdaHack.Client.UI.UIOptions import Game.LambdaHack.Common.Actor import Game.LambdaHack.Common.ActorState import Game.LambdaHack.Common.Analytics import Game.LambdaHack.Common.Faction import Game.LambdaHack.Common.Item import qualified Game.LambdaHack.Common.ItemAspect as IA import Game.LambdaHack.Common.Kind import Game.LambdaHack.Common.Level import Game.LambdaHack.Common.Misc import Game.LambdaHack.Common.MonadStateRead import Game.LambdaHack.Common.Point import Game.LambdaHack.Common.ReqFailure import Game.LambdaHack.Common.State import qualified Game.LambdaHack.Common.Tile as Tile import Game.LambdaHack.Common.Time import Game.LambdaHack.Common.Types import Game.LambdaHack.Content.CaveKind (cdesc) import qualified Game.LambdaHack.Content.ItemKind as IK import Game.LambdaHack.Content.ModeKind import Game.LambdaHack.Content.RuleKind import qualified Game.LambdaHack.Content.TileKind as TK import qualified Game.LambdaHack.Core.Dice as Dice import Game.LambdaHack.Core.Frequency import Game.LambdaHack.Core.Random import qualified Game.LambdaHack.Definition.Ability as Ability import qualified Game.LambdaHack.Definition.Color as Color import Game.LambdaHack.Definition.Defs import Game.LambdaHack.Definition.Flavour -- * RespUpdAtomicUI -- | Visualize atomic updates sent to the client. This is done -- in the global state after the command is executed and after -- the client state is modified by the command. -- Don't modify client state (except a few fields), but only client -- session (e.g., by displaying messages). This is enforced by types. displayRespUpdAtomicUI :: MonadClientUI m => UpdAtomic -> m () {-# INLINE displayRespUpdAtomicUI #-} displayRespUpdAtomicUI cmd = case cmd of -- Create/destroy actors and items. UpdCreateActor aid body _ -> createActorUI True aid body UpdDestroyActor aid body _ -> destroyActorUI True aid body UpdCreateItem iid _item kit c -> do recordItemLid iid c updateItemSlot c iid case c of CActor aid store -> do case store of COrgan -> do arItem <- getsState $ aspectRecordFromIid iid if IA.checkFlag Ability.Condition arItem then do bag <- getsState $ getContainerBag c let more = case EM.lookup iid bag of Nothing -> False Just kit2 -> fst kit2 /= fst kit verb = MU.Text $ "become" <+> case fst kit of 1 -> if more then "more" else "" k -> (if more then "additionally" else "") <+> tshow k <> "-fold" -- This describes all such items already among organs, -- which is useful, because it shows "charging". itemAidVerbMU MsgBecome aid verb iid (Left Nothing) COrgan else do ownerFun <- partActorLeaderFun let wown = ppContainerWownW ownerFun True c itemVerbMU MsgItemCreation iid kit (MU.Text $ makePhrase $ "grow" : wown) c _ -> do ownerFun <- partActorLeaderFun let wown = ppContainerWownW ownerFun True c itemVerbMU MsgItemCreation iid kit (MU.Text $ makePhrase $ "appear" : wown) c CEmbed lid _ -> markDisplayNeeded lid CFloor lid _ -> do itemVerbMU MsgItemCreation iid kit (MU.Text $ "appear" <+> ppContainer c) c markDisplayNeeded lid CTrunk{} -> error $ "" `showFailure` c UpdDestroyItem iid _ kit c -> do itemVerbMU MsgItemDestruction iid kit "disappear" c lid <- getsState $ lidFromC c markDisplayNeeded lid UpdSpotActor aid body _ -> createActorUI False aid body UpdLoseActor aid body _ -> destroyActorUI False aid body UpdSpotItem verbose iid _ kit c -> spotItem verbose iid kit c {- UpdLoseItem False _ _ _ _ -> return () -- The message is rather cryptic, so let's disable it until it's decided -- if anemy inventories should be displayed, etc. UpdLoseItem True iid _ kit c@(CActor aid store) | store /= CSha -> do -- Actor putting an item into shared stash, most probably. side <- getsClient sside b <- getsState $ getActorBody aid subject <- partActorLeader aid b let ownW = ppCStoreWownW store subject verb = MU.Text $ makePhrase $ "be removed from" : ownW when (bfid b == side) $ itemVerbMU iid kit verb c -} UpdLoseItem{} -> return () UpdSpotItemBag c bag _ -> mapWithKeyM_ (\iid kit -> spotItem True iid kit c) bag UpdLoseItemBag{} -> return () -- Move actors and items. UpdMoveActor aid source target -> moveActor aid source target UpdWaitActor{} -> return () UpdDisplaceActor source target -> displaceActorUI source target UpdMoveItem iid k aid c1 c2 -> moveItemUI iid k aid c1 c2 -- Change actor attributes. UpdRefillHP _ 0 -> return () UpdRefillHP aid hpDelta -> do CCUI{coscreen} <- getsSession sccui aidVerbMU MsgNumeric aid $ MU.Text $ (if hpDelta > 0 then "heal" else "lose") <+> tshow (abs hpDelta `divUp` oneM) <+> "HP" b <- getsState $ getActorBody aid arena <- getArenaUI side <- getsClient sside if | bproj b && (EM.null (beqp b) || isNothing (btrajectory b)) -> return () -- ignore caught proj or one hitting a wall | bhp b <= 0 && hpDelta < 0 && (bfid b == side && not (bproj b) || arena == blid b) -> do let (firstFall, hurtExtra) = case (bfid b == side, bproj b) of (True, True) -> ("drop down", "tumble down") (True, False) -> ("fall down", "suffers woeful mutilation") (False, True) -> ("plummet", "crash") (False, False) -> ("collapse", "be reduced to a bloody pulp") verbDie = if alreadyDeadBefore then hurtExtra else firstFall alreadyDeadBefore = bhp b - hpDelta <= 0 tfact <- getsState $ (EM.! bfid b) . sfactionD bUI <- getsSession $ getActorUI aid subjectRaw <- partActorLeader aid let subject = if alreadyDeadBefore || subjectRaw == "you" then subjectRaw else partActor bUI -- avoid "fallen" msgDie = makeSentence [MU.SubjectVerbSg subject verbDie] targetIsFoe = isFoe (bfid b) tfact side targetIsFriend = isFriend (bfid b) tfact side msgClass | bproj b = MsgDeath | targetIsFoe = MsgDeathGood | targetIsFriend = MsgDeathBad | otherwise = MsgDeath msgAdd msgClass msgDie -- We show death anims only if not dead already before this refill. let deathAct | alreadyDeadBefore = twirlSplash coscreen (bpos b, bpos b) Color.Red Color.Red | bfid b == side = deathBody coscreen (bpos b) | otherwise = shortDeathBody coscreen (bpos b) unless (bproj b) $ animate (blid b) deathAct | otherwise -> do when (hpDelta >= bhp b && bhp b > 0) $ aidVerbMU MsgWarning aid "return from the brink of death" mleader <- getsClient sleader when (Just aid == mleader) $ do actorMaxSk <- getsState $ getActorMaxSkills aid -- Regenerating actors never stop gaining HP, so we need to stop -- reporting it after they reach full HP for the first time. -- Also, no spam for non-leaders. when (bhp b >= xM (Ability.getSk Ability.SkMaxHP actorMaxSk) && bhp b - hpDelta < xM (Ability.getSk Ability.SkMaxHP actorMaxSk)) $ msgAdd MsgVeryRare "You recover your health fully." when (bfid b == side && not (bproj b)) $ do markDisplayNeeded (blid b) when (hpDelta < 0) $ do sUIOptions <- getsSession sUIOptions currentWarning <- getsState $ checkWarningHP sUIOptions aid (bhp b) when currentWarning $ do previousWarning <- getsState $ checkWarningHP sUIOptions aid (bhp b - hpDelta) unless previousWarning $ aidVerbMU0 MsgDeathThreat aid "be down to a dangerous health level" UpdRefillCalm _ 0 -> return () UpdRefillCalm aid calmDelta -> do side <- getsClient sside b <- getsState $ getActorBody aid when (bfid b == side && not (bproj b)) $ do if | calmDelta > 0 -> -- regeneration or effect markDisplayNeeded (blid b) | calmDelta == minusM1 -> do fact <- getsState $ (EM.! side) . sfactionD s <- getState let closeFoe (!p, aid2) = -- mimics isHeardFoe let b2 = getActorBody aid2 s in inline chessDist p (bpos b) <= 3 && not (actorWaitsOrSleeps b2) -- uncommon && inline isFoe side fact (bfid b2) -- costly anyCloseFoes = any closeFoe $ EM.assocs $ lbig $ sdungeon s EM.! blid b unless anyCloseFoes $ do -- obvious where the feeling comes from duplicated <- aidVerbDuplicateMU MsgHeardClose aid "hear something" unless duplicated stopPlayBack | otherwise -> -- low deltas from hits; displayed elsewhere return () when (calmDelta < 0) $ do sUIOptions <- getsSession sUIOptions currentWarning <- getsState $ checkWarningCalm sUIOptions aid (bcalm b) when currentWarning $ do previousWarning <- getsState $ checkWarningCalm sUIOptions aid (bcalm b - calmDelta) unless previousWarning $ -- This messages is not shown if impression happens after -- Calm is low enough. However, this is rare and HUD shows the red. aidVerbMU0 MsgDeathThreat aid "have grown agitated and impressed enough to be in danger of defecting" UpdTrajectory _ _ mt -> -- if projectile dies just after, force one frame when (maybe True (null . fst) mt) pushFrame -- Change faction attributes. UpdQuitFaction fid _ toSt manalytics -> quitFactionUI fid toSt manalytics UpdLeadFaction fid (Just source) (Just target) -> do fact <- getsState $ (EM.! fid) . sfactionD lidV <- viewedLevelUI when (isAIFact fact) $ markDisplayNeeded lidV -- This faction can't run with multiple actors, so this is not -- a leader change while running, but rather server changing -- their leader, which the player should be alerted to. when (noRunWithMulti fact) stopPlayBack actorD <- getsState sactorD case EM.lookup source actorD of Just sb | bhp sb <= 0 -> assert (not $ bproj sb) $ do -- Regardless who the leader is, give proper names here, not 'you'. sbUI <- getsSession $ getActorUI source tbUI <- getsSession $ getActorUI target let subject = partActor tbUI object = partActor sbUI msgAdd MsgLeader $ makeSentence [ MU.SubjectVerbSg subject "take command" , "from", object ] _ -> return () lookAtMove target UpdLeadFaction _ Nothing (Just target) -> lookAtMove target UpdLeadFaction{} -> return () UpdDiplFaction fid1 fid2 _ toDipl -> do name1 <- getsState $ gname . (EM.! fid1) . sfactionD name2 <- getsState $ gname . (EM.! fid2) . sfactionD let showDipl Unknown = "unknown to each other" showDipl Neutral = "in neutral diplomatic relations" showDipl Alliance = "allied" showDipl War = "at war" msgAdd MsgDiplomacy $ name1 <+> "and" <+> name2 <+> "are now" <+> showDipl toDipl <> "." UpdTacticFaction{} -> return () UpdAutoFaction fid b -> do side <- getsClient sside lidV <- viewedLevelUI markDisplayNeeded lidV when (fid == side) $ do unless b $ addPressedControlEsc -- sets @swasAutomated@, enters main menu setFrontAutoYes b -- now can stop auto-accepting prompts UpdRecordKill{} -> return () -- Alter map. UpdAlterTile lid p fromTile toTile -> do markDisplayNeeded lid COps{cotile} <- getsState scops let feats = TK.tfeature $ okind cotile fromTile toAlter feat = case feat of TK.OpenTo tgroup -> Just tgroup TK.CloseTo tgroup -> Just tgroup TK.ChangeTo tgroup -> Just tgroup _ -> Nothing groupsToAlterTo = mapMaybe toAlter feats freq = map fst $ filter (\(_, q) -> q > 0) $ TK.tfreq $ okind cotile toTile when (null $ intersect freq groupsToAlterTo) $ do -- Player notices @fromTile can't be altered into @toTIle@, -- which is uncanny, so we produce a message. -- This happens when the player missed an earlier search of the tile -- performed by another faction. let subject = "" -- a hack, because we don't handle adverbs well verb = "turn into" msg = makeSentence [ "the", MU.Text $ TK.tname $ okind cotile fromTile , "at position", MU.Text $ tshow p , "suddenly" -- adverb , MU.SubjectVerbSg subject verb , MU.AW $ MU.Text $ TK.tname $ okind cotile toTile ] msgAdd MsgTileDisco msg UpdAlterExplorable lid _ -> markDisplayNeeded lid UpdAlterGold{} -> return () -- not displayed on HUD UpdSearchTile aid _p toTile -> do COps{cotile} <- getsState scops subject <- partActorLeader aid let fromTile = fromMaybe (error $ show toTile) $ Tile.hideAs cotile toTile subject2 = MU.Text $ TK.tname $ okind cotile fromTile object = MU.Text $ TK.tname $ okind cotile toTile let msg = makeSentence [ MU.SubjectVerbSg subject "reveal" , "that the" , MU.SubjectVerbSg subject2 "be" , MU.AW object ] unless (subject2 == object) $ msgAdd MsgTileDisco msg UpdHideTile{} -> return () UpdSpotTile{} -> return () UpdLoseTile{} -> return () UpdSpotEntry{} -> return () UpdLoseEntry{} -> return () UpdAlterSmell{} -> return () UpdSpotSmell{} -> return () UpdLoseSmell{} -> return () -- Assorted. UpdTimeItem{} -> return () UpdAgeGame{} -> do sdisplayNeeded <- getsSession sdisplayNeeded time <- getsState stime let clipN = time `timeFit` timeClip clipMod = clipN `mod` clipsInTurn ping = clipMod == 0 when (sdisplayNeeded || ping) pushFrame UpdUnAgeGame{} -> return () UpdDiscover c iid _ _ -> discover c iid UpdCover{} -> return () -- don't spam when doing undo UpdDiscoverKind{} -> return () -- don't spam when server tweaks stuff UpdCoverKind{} -> return () -- don't spam when doing undo UpdDiscoverAspect{} -> return () -- don't spam when server tweaks stuff UpdCoverAspect{} -> return () -- don't spam when doing undo UpdDiscoverServer{} -> error "server command leaked to client" UpdCoverServer{} -> error "server command leaked to client" UpdPerception{} -> return () UpdRestart fid _ _ _ _ _ -> do COps{cocave, corule} <- getsState scops sstart <- getsSession sstart when (sstart == 0) resetSessionStart history <- getsSession shistory if lengthHistory history == 0 then do let title = rtitle corule msgAdd MsgAdmin $ "Welcome to" <+> title <> "!" -- Generate initial history. Only for UI clients. shistory <- defaultHistory modifySession $ \sess -> sess {shistory} else recordHistory lid <- getArenaUI lvl <- getLevel lid mode <- getGameMode curChal <- getsClient scurChal fact <- getsState $ (EM.! fid) . sfactionD let loneMode = case ginitial fact of [] -> True [(_, 1, _)] -> True _ -> False msgAdd MsgWarning $ "New game started in" <+> mname mode <+> "mode." msgAdd MsgAdmin $ mdesc mode let desc = cdesc $ okind cocave $ lkind lvl unless (T.null desc) $ do msgAdd0 MsgFocus "You take in your surroundings." msgAdd0 MsgLandscape desc -- We can fool the player only once (per scenario), but let's not do it -- in the same way each time. TODO: PCG blurb <- rndToActionForget $ oneOf [ "You think you saw movement." , "Something catches your peripherial vision." , "You think you felt a tremor under your feet." , "A whiff of chilly air passes around you." , "You notice a draft just when it dies down." , "The ground nearby is stained along some faint lines." , "Scarce black motes slowly settle on the ground." , "The ground in the immediate area is empty, as if just swiped." ] msgAdd MsgWarning blurb when (cwolf curChal && not loneMode) $ msgAdd MsgWarning "Being a lone wolf, you begin without companions." when (lengthHistory history > 1) $ fadeOutOrIn False setFrontAutoYes $ isAIFact fact when (isAIFact fact) $ do -- Prod the frontend to flush frames and start showing them continuously. slides <- reportToSlideshow [] void $ getConfirms ColorFull [K.spaceKM, K.escKM] slides -- Forget the furious keypresses when dying in the previous game. resetPressedKeys UpdRestartServer{} -> return () UpdResume fid _ -> do COps{cocave} <- getsState scops resetSessionStart fact <- getsState $ (EM.! fid) . sfactionD setFrontAutoYes $ isAIFact fact unless (isAIFact fact) $ do lid <- getArenaUI lvl <- getLevel lid mode <- getGameMode msgAdd MsgAlert $ "Continuing" <+> mname mode <> "." msgAdd MsgPrompt $ mdesc mode let desc = cdesc $ okind cocave $ lkind lvl unless (T.null desc) $ do msgAdd MsgPromptFocus "You remember your surroundings." msgAdd MsgPrompt desc displayMore ColorFull "Are you up for the challenge?" promptAdd0 "Prove yourself!" UpdResumeServer{} -> return () UpdKillExit{} -> frontendShutdown UpdWriteSave -> msgAdd MsgSpam "Saving backup." UpdHearFid _ hearMsg -> do mleader <- getsClient sleader case mleader of Just{} -> return () -- will display stuff when leader moves Nothing -> do lidV <- viewedLevelUI markDisplayNeeded lidV recordHistory msg <- ppHearMsg hearMsg msgAdd MsgHeard msg updateItemSlot :: MonadClientUI m => Container -> ItemId -> m () updateItemSlot c iid = do arItem <- getsState $ aspectRecordFromIid iid ItemSlots itemSlots <- getsSession sslots let slore = IA.loreFromContainer arItem c lSlots = itemSlots EM.! slore case lookup iid $ map swap $ EM.assocs lSlots of Nothing -> do let l = assignSlot lSlots f = EM.insert l iid newSlots = ItemSlots $ EM.adjust f slore itemSlots modifySession $ \sess -> sess {sslots = newSlots} Just _l -> return () -- slot already assigned markDisplayNeeded :: MonadClientUI m => LevelId -> m () markDisplayNeeded lid = do lidV <- viewedLevelUI when (lidV == lid) $ modifySession $ \sess -> sess {sdisplayNeeded = True} lookAtMove :: MonadClientUI m => ActorId -> m () lookAtMove aid = do mleader <- getsClient sleader body <- getsState $ getActorBody aid side <- getsClient sside aimMode <- getsSession saimMode when (not (bproj body) && bfid body == side && isNothing aimMode) $ do -- aiming does a more extensive look itemsBlurb <- lookAtItems True (bpos body) aid let msgClass = if Just aid == mleader then MsgAtFeetMajor else MsgAtFeet msgAdd msgClass itemsBlurb fact <- getsState $ (EM.! bfid body) . sfactionD adjBigAssocs <- getsState $ adjacentBigAssocs body adjProjAssocs <- getsState $ adjacentProjAssocs body if not (bproj body) && bfid body == side then do let foe (_, b2) = isFoe (bfid body) fact (bfid b2) adjFoes = filter foe $ adjBigAssocs ++ adjProjAssocs unless (null adjFoes) stopPlayBack else when (isFoe (bfid body) fact side) $ do let our (_, b2) = bfid b2 == side adjOur = filter our adjBigAssocs unless (null adjOur) stopPlayBack aidVerbMU :: MonadClientUI m => MsgClass -> ActorId -> MU.Part -> m () aidVerbMU msgClass aid verb = do subject <- partActorLeader aid msgAdd msgClass $ makeSentence [MU.SubjectVerbSg subject verb] aidVerbMU0 :: MonadClientUI m => MsgClass -> ActorId -> MU.Part -> m () aidVerbMU0 msgClass aid verb = do subject <- partActorLeader aid msgAdd0 msgClass $ makeSentence [MU.SubjectVerbSg subject verb] aidVerbDuplicateMU :: MonadClientUI m => MsgClass -> ActorId -> MU.Part -> m Bool aidVerbDuplicateMU msgClass aid verb = do subject <- partActorLeader aid msgAddDuplicate (makeSentence [MU.SubjectVerbSg subject verb]) msgClass 1 itemVerbMU :: MonadClientUI m => MsgClass -> ItemId -> ItemQuant -> MU.Part -> Container -> m () itemVerbMU msgClass iid kit@(k, _) verb c = assert (k > 0) $ do lid <- getsState $ lidFromC c localTime <- getsState $ getLocalTime lid itemFull <- getsState $ itemToFull iid side <- getsClient sside factionD <- getsState sfactionD let arItem = aspectRecordFull itemFull subject = partItemWs side factionD k localTime itemFull kit msg | k > 1 && not (IA.checkFlag Ability.Condition arItem) = makeSentence [MU.SubjectVerb MU.PlEtc MU.Yes subject verb] | otherwise = makeSentence [MU.SubjectVerbSg subject verb] msgAdd msgClass msg -- We assume the item is inside the specified container. -- So, this function can't be used for, e.g., @UpdDestroyItem@. itemAidVerbMU :: MonadClientUI m => MsgClass -> ActorId -> MU.Part -> ItemId -> Either (Maybe Int) Int -> CStore -> m () itemAidVerbMU msgClass aid verb iid ek cstore = do body <- getsState $ getActorBody aid bag <- getsState $ getBodyStoreBag body cstore side <- getsClient sside factionD <- getsState sfactionD -- The item may no longer be in @c@, but it was case iid `EM.lookup` bag of Nothing -> error $ "" `showFailure` (aid, verb, iid, cstore) Just kit@(k, _) -> do itemFull <- getsState $ itemToFull iid let lid = blid body localTime <- getsState $ getLocalTime lid subject <- partActorLeader aid let object = case ek of Left (Just n) -> assert (n <= k `blame` (aid, verb, iid, cstore)) $ partItemWs side factionD n localTime itemFull kit Left Nothing -> let (name, powers) = partItem side factionD localTime itemFull kit in MU.Phrase [name, powers] Right n -> assert (n <= k `blame` (aid, verb, iid, cstore)) $ let (name1, powers) = partItemShort side factionD localTime itemFull kit in MU.Phrase ["the", MU.Car1Ws n name1, powers] msg = makeSentence [MU.SubjectVerbSg subject verb, object] msgAdd msgClass msg createActorUI :: MonadClientUI m => Bool -> ActorId -> Actor -> m () createActorUI born aid body = do CCUI{coscreen} <- getsSession sccui side <- getsClient sside when (bfid body == side && not (bproj body)) $ do let upd = ES.insert aid modifySession $ \sess -> sess {sselected = upd $ sselected sess} factionD <- getsState sfactionD let fact = factionD EM.! bfid body localTime <- getsState $ getLocalTime $ blid body itemFull@ItemFull{itemBase, itemKind} <- getsState $ itemToFull (btrunk body) actorUI <- getsSession sactorUI let arItem = aspectRecordFull itemFull unless (aid `EM.member` actorUI) $ do UIOptions{uHeroNames} <- getsSession sUIOptions let baseColor = flavourToColor $ jflavour itemBase basePronoun | not (bproj body) && IK.isymbol itemKind == '@' && fhasGender (gplayer fact) = "he" | otherwise = "it" nameFromNumber fn k = if k == 0 then makePhrase [MU.Ws $ MU.Text fn, "Captain"] else fn <+> tshow k heroNamePronoun k = if gcolor fact /= Color.BrWhite then (nameFromNumber (fname $ gplayer fact) k, "he") else fromMaybe (nameFromNumber (fname $ gplayer fact) k, "he") $ lookup k uHeroNames (n, bsymbol) <- if | bproj body -> return (0, if IA.checkFlag Ability.Blast arItem then IK.isymbol itemKind else '*') | baseColor /= Color.BrWhite -> return (0, IK.isymbol itemKind) | otherwise -> do let hasNameK k bUI = bname bUI == fst (heroNamePronoun k) && bcolor bUI == gcolor fact findHeroK k = isJust $ find (hasNameK k) (EM.elems actorUI) mhs = map findHeroK [0..] n = fromMaybe (error $ show mhs) $ elemIndex False mhs return (n, if 0 < n && n < 10 then Char.intToDigit n else '@') let (object1, object2) = partItemShortest (bfid body) factionD localTime itemFull (1, []) (bname, bpronoun) = if | bproj body -> let adj = case btrajectory body of Just (tra, _) | length tra < 5 -> "falling" _ -> "flying" in (makePhrase [adj, object1, object2], basePronoun) | baseColor /= Color.BrWhite -> let name = makePhrase [object1, object2] in ( if IA.checkFlag Ability.Unique arItem then makePhrase [MU.Capitalize $ MU.Text $ "the" <+> name] else name , basePronoun ) | otherwise -> heroNamePronoun n bcolor | bproj body = if IA.checkFlag Ability.Blast arItem then baseColor else Color.BrWhite | baseColor == Color.BrWhite = gcolor fact | otherwise = baseColor bUI = ActorUI{..} modifySession $ \sess -> sess {sactorUI = EM.insert aid bUI actorUI} let verb = MU.Text $ if born then if bfid body == side then "join you" else "appear suddenly" else "be spotted" mapM_ (\(iid, store) -> do let c = if not (bproj body) && iid == btrunk body then CTrunk (bfid body) (blid body) (bpos body) else CActor aid store updateItemSlot c iid recordItemLid iid c) ((btrunk body, CEqp) -- store will be overwritten, unless projectile : filter ((/= btrunk body) . fst) (getCarriedIidCStore body)) -- Don't spam if the actor was already visible (but, e.g., on a tile that is -- invisible this turn (in that case move is broken down to lose+spot) -- or on a distant tile, via teleport while the observer teleported, too). lastLost <- getsSession slastLost if | EM.null actorUI && bfid body == side -> return () -- don't speak about yourself in 3rd person | born && bproj body -> pushFrame -- make sure first position displayed | ES.member aid lastLost || bproj body -> markDisplayNeeded (blid body) | otherwise -> do aidVerbMU MsgActorSpot aid verb animate (blid body) $ actorX coscreen (bpos body) when (bfid body /= side) $ do when (not (bproj body) && isFoe (bfid body) fact side) $ do -- Aim even if nobody can shoot at the enemy. Let's home in on him -- and then we can aim or melee. We set permit to False, because it's -- technically very hard to check aimability here, because we are -- in-between turns and, e.g., leader's move has not yet been taken -- into account. modifySession $ \sess -> sess {sxhair = Just $ TEnemy aid} foes <- getsState $ foeRegularList side (blid body) unless (ES.member aid lastLost || length foes > 1) $ msgAdd0 MsgFirstEnemySpot "You are not alone!" stopPlayBack destroyActorUI :: MonadClientUI m => Bool -> ActorId -> Actor -> m () destroyActorUI destroy aid b = do trunk <- getsState $ getItemBody $ btrunk b let baseColor = flavourToColor $ jflavour trunk unless (baseColor == Color.BrWhite) $ -- keep setup for heroes, etc. modifySession $ \sess -> sess {sactorUI = EM.delete aid $ sactorUI sess} let affect tgt = case tgt of Just (TEnemy a) | a == aid -> Just $ if destroy then -- If *really* nothing more interesting, the actor will -- go to last known location to perhaps find other foes. TPoint TKnown (blid b) (bpos b) else -- If enemy only hides (or we stepped behind obstacle) find him. TPoint (TEnemyPos a) (blid b) (bpos b) Just (TNonEnemy a) | a == aid -> Just $ TPoint TKnown (blid b) (bpos b) _ -> tgt modifySession $ \sess -> sess {sxhair = affect $ sxhair sess} unless (bproj b) $ modifySession $ \sess -> sess {slastLost = ES.insert aid $ slastLost sess} side <- getsClient sside fact <- getsState $ (EM.! side) . sfactionD let gameOver = isJust $ gquit fact -- we are the UI faction, so we determine unless gameOver $ do when (bfid b == side && not (bproj b)) $ do stopPlayBack let upd = ES.delete aid modifySession $ \sess -> sess {sselected = upd $ sselected sess} when destroy $ do displayMore ColorBW "Alas!" mleader <- getsClient sleader when (isJust mleader) -- This is especially handy when the dead actor was a leader -- on a different level than the new one: clearAimMode -- If pushed, animate spotting again, to draw attention to pushing. markDisplayNeeded (blid b) spotItem :: MonadClientUI m => Bool -> ItemId -> ItemQuant -> Container -> m () spotItem verbose iid kit c = do -- This is due to a move, or similar, which will be displayed, -- so no extra @markDisplayNeeded@ needed here and in similar places. recordItemLid iid c ItemSlots itemSlots <- getsSession sslots arItem <- getsState $ aspectRecordFromIid iid let slore = IA.loreFromContainer arItem c case lookup iid $ map swap $ EM.assocs $ itemSlots EM.! slore of Nothing -> do -- never seen or would have a slot updateItemSlot c iid case c of CFloor lid p -> do sxhairOld <- getsSession sxhair case sxhairOld of Just TEnemy{} -> return () -- probably too important to overwrite Just (TPoint TEnemyPos{} _ _) -> return () _ -> do -- Don't steal xhair if it's only an item on another level. -- For enemies, OTOH, capture xhair to alarm player. lidV <- viewedLevelUI when (lid == lidV) $ do bag <- getsState $ getFloorBag lid p modifySession $ \sess -> sess {sxhair = Just $ TPoint (TItem bag) lidV p} itemVerbMU MsgItemSpot iid kit "be located" c _ -> return () _ -> return () -- this item or another with the same @iid@ -- seen already (has a slot assigned), so old news when verbose $ case c of CActor aid store | store `elem` [CEqp, CInv, CGround, CSha] -> do -- Actor fetching an item from or to shared stash, most probably. subject <- partActorLeader aid let ownW = ppCStoreWownW False store subject verb = MU.Text $ makePhrase $ "be added to" : ownW itemVerbMU MsgItemMove iid kit verb c _ -> return () recordItemLid :: MonadClientUI m => ItemId -> Container -> m () recordItemLid iid c = do mjlid <- getsSession $ EM.lookup iid . sitemUI when (isNothing mjlid) $ do lid <- getsState $ lidFromC c modifySession $ \sess -> sess {sitemUI = EM.insert iid lid $ sitemUI sess} moveActor :: MonadClientUI m => ActorId -> Point -> Point -> m () moveActor aid source target = do -- If source and target tile distant, assume it's a teleportation -- and display an animation. Note: jumps and pushes go through all -- intervening tiles, so won't be considered. Note: if source or target -- not seen, the (half of the) animation would be boring, just a delay, -- not really showing a transition, so we skip it (via 'breakUpdAtomic'). -- The message about teleportation is sometimes shown anyway, just as the X. CCUI{coscreen} <- getsSession sccui body <- getsState $ getActorBody aid if adjacent source target then markDisplayNeeded (blid body) else do let ps = (source, target) animate (blid body) $ teleport coscreen ps lookAtMove aid displaceActorUI :: MonadClientUI m => ActorId -> ActorId -> m () displaceActorUI source target = do CCUI{coscreen} <- getsSession sccui mleader <- getsClient sleader sb <- getsState $ getActorBody source tb <- getsState $ getActorBody target spart <- partActorLeader source tpart <- partActorLeader target let msgClass = if mleader `elem` map Just [source, target] then MsgAction -- to avoid run after displace; configurable else MsgActionMinor msg = makeSentence [MU.SubjectVerbSg spart "displace", tpart] msgAdd msgClass msg when (bfid sb /= bfid tb) $ do lookAtMove source lookAtMove target side <- getsClient sside -- Ours involved, but definitely not requested by player via UI. when (side `elem` [bfid sb, bfid tb] && mleader /= Just source) stopPlayBack let ps = (bpos tb, bpos sb) animate (blid sb) $ swapPlaces coscreen ps moveItemUI :: MonadClientUI m => ItemId -> Int -> ActorId -> CStore -> CStore -> m () moveItemUI iid k aid cstore1 cstore2 = do let verb = verbCStore cstore2 b <- getsState $ getActorBody aid fact <- getsState $ (EM.! bfid b) . sfactionD let underAI = isAIFact fact mleader <- getsClient sleader ItemSlots itemSlots <- getsSession sslots case lookup iid $ map swap $ EM.assocs $ itemSlots EM.! SItem of Just _l -> -- So far organs can't be put into backpack, so no need to call -- @updateItemSlot@ to add or reassign lore category. if cstore1 == CGround && Just aid == mleader && not underAI then itemAidVerbMU MsgItemMove aid (MU.Text verb) iid (Right k) cstore2 else when (not (bproj b) && bhp b > 0) $ -- don't announce death drops itemAidVerbMU MsgItemMove aid (MU.Text verb) iid (Left $ Just k) cstore2 Nothing -> error $ "" `showFailure` (iid, k, aid, cstore1, cstore2) quitFactionUI :: MonadClientUI m => FactionId -> Maybe Status -> Maybe (FactionAnalytics, GenerationAnalytics) -> m () quitFactionUI fid toSt manalytics = do ClientOptions{sexposeItems} <- getsClient soptions fact <- getsState $ (EM.! fid) . sfactionD let fidName = MU.Text $ gname fact person = if fhasGender $ gplayer fact then MU.PlEtc else MU.Sg3rd horror = isHorrorFact fact camping = maybe True ((== Camping) . stOutcome) toSt side <- getsClient sside when (fid == side && not camping) $ do tellGameClipPS resetGameStart mode <- getGameMode allNframes <- getsSession sallNframes let startingPart = case toSt of _ | horror -> Nothing -- Ignore summoned actors' factions. Just Status{stOutcome=Killed} -> Just "be eliminated" Just Status{stOutcome=Defeated} -> Just "be decisively defeated" Just Status{stOutcome=Camping} -> Just "order save and exit" Just Status{stOutcome=Conquer} -> Just "vanquish all foes" Just Status{stOutcome=Escape} -> Just "achieve victory" Just Status{stOutcome=Restart, stNewGame=Just gn} -> Just $ MU.Text $ "order mission restart in" <+> fromGroupName gn <+> "mode" Just Status{stOutcome=Restart, stNewGame=Nothing} -> error $ "" `showFailure` (fid, toSt) Nothing -> Nothing -- server wipes out Camping for savefile middlePart = case toSt of _ | fid /= side -> Nothing Just Status{stOutcome} -> lookup stOutcome $ mendMsg mode Nothing -> Nothing partingPart = case toSt of _ | fid /= side || allNframes == -1 -> Nothing Just Status{stOutcome} -> lookup stOutcome genericEndMessages Nothing -> Nothing case startingPart of Nothing -> return () Just sp -> let msgClass = if fid == side then MsgOutcome else MsgDiplomacy in msgAdd msgClass $ makeSentence [MU.SubjectVerb person MU.Yes fidName sp] case (toSt, partingPart) of (Just status, Just pp) -> do isNoConfirms <- isNoConfirmsGame go <- if isNoConfirms then return False else displaySpaceEsc ColorFull "" recordHistory -- we are going to exit or restart, so record and clear, but only once (itemBag, total) <- getsState $ calculateTotal side when go $ do case middlePart of Nothing -> return () Just sp1 -> do factionD <- getsState sfactionD itemToF <- getsState $ flip itemToFull let getTrunkFull (_, b) = itemToF $ btrunk b ourTrunks <- getsState $ map getTrunkFull . fidActorNotProjGlobalAssocs side let smartFaction fact2 = fleaderMode (gplayer fact2) /= LeaderNull smartEnemy trunkFull = any (smartFaction . snd) $ filter (\(fid2, _) -> fid2 /= side) $ possibleActorFactions (itemKind trunkFull) factionD smartEnemyOurs = filter smartEnemy ourTrunks uniqueActor trunkFull = IA.checkFlag Ability.Unique $ aspectRecordFull trunkFull smartUniqueEnemyCaptured = any uniqueActor smartEnemyOurs smartEnemyCaptured = not $ null smartEnemyOurs sp2 | smartUniqueEnemyCaptured = "\nOh, wait, who is this, towering behind your escaping crew? This changes everything. For everybody. Everywhere. Forever. Did you plan for this? What was exactly the idea and who decided to carry it through?" | smartEnemyCaptured = "\nOh, wait, who is this, hunched among your escaping crew? Suddenly, this makes your crazy story credible. Suddenly, the door of knowledge opens again. How will you play that move?" | otherwise = "" msgAdd0 MsgPlot $ sp1 <> sp2 void $ displaySpaceEsc ColorFull "" case manalytics of Nothing -> return () Just (factionAn, generationAn) -> cycleLore [] [ displayGameOverLoot (itemBag, total) generationAn , displayGameOverAnalytics factionAn generationAn , displayGameOverLore SEmbed True generationAn , displayGameOverLore SOrgan True generationAn , displayGameOverLore SCondition sexposeItems generationAn , displayGameOverLore SBlast True generationAn ] unless isNoConfirms $ do -- Show score for any UI client after any kind of game exit, -- even though it's saved only for human UI clients at game over -- (that is not a noConfirms or benchmark game). scoreSlides <- scoreToSlideshow total status void $ getConfirms ColorFull [K.spaceKM, K.escKM] scoreSlides -- The last prompt stays onscreen during shutdown, etc. when (not isNoConfirms || camping) $ void $ displaySpaceEsc ColorFull pp _ -> return () displayGameOverLoot :: MonadClientUI m => (ItemBag, Int) -> GenerationAnalytics -> m K.KM displayGameOverLoot (heldBag, total) generationAn = do ClientOptions{sexposeItems} <- getsClient soptions COps{coitem} <- getsState scops ItemSlots itemSlots <- getsSession sslots -- We assume "gold grain", not "grain" with label "of gold": let currencyName = IK.iname $ okind coitem $ ouniqGroup coitem "currency" lSlotsRaw = EM.filter (`EM.member` heldBag) $ itemSlots EM.! SItem generationItem = generationAn EM.! SItem (itemBag, lSlots) = if sexposeItems then let generationBag = EM.map (\k -> (-k, [])) generationItem bag = heldBag `EM.union` generationBag slots = EM.fromAscList $ zip allSlots $ EM.keys bag in (bag, slots) else (heldBag, lSlotsRaw) promptFun iid itemFull2 k = let worth = itemPrice 1 $ itemKind itemFull2 lootMsg = if worth == 0 then "" else let pile = if k == 1 then "exemplar" else "hoard" in makeSentence $ ["this treasure", pile, "is worth"] ++ (if k > 1 then [ MU.Cardinal k, "times"] else []) ++ [MU.CarWs worth $ MU.Text currencyName] holdsMsg = let n = generationItem EM.! iid in if | max 0 k == 1 && n == 1 -> "You keep the only specimen extant:" | max 0 k == 0 && n == 1 -> "You don't have the only hypothesized specimen:" | max 0 k == 0 && n == 0 -> "No such specimen was recorded:" | otherwise -> makePhrase [ "You hold" , MU.CardinalAWs (max 0 k) "piece" , "out of" , MU.Car n , "scattered:" ] in lootMsg <+> holdsMsg dungeonTotal <- getsState sgold let promptGold = spoilsBlurb currencyName total dungeonTotal -- Total number of items is meaningless in the presence of so much junk. prompt = promptGold <+> (if sexposeItems then "Non-positive count means none held but this many generated." else "") examItem = displayItemLore itemBag 0 promptFun viewLoreItems "GameOverLoot" lSlots itemBag prompt examItem displayGameOverAnalytics :: MonadClientUI m => FactionAnalytics -> GenerationAnalytics -> m K.KM displayGameOverAnalytics factionAn generationAn = do ClientOptions{sexposeActors} <- getsClient soptions side <- getsClient sside ItemSlots itemSlots <- getsSession sslots let ourAn = akillCounts $ EM.findWithDefault emptyAnalytics side factionAn foesAn = EM.unionsWith (+) $ concatMap EM.elems $ catMaybes $ map (`EM.lookup` ourAn) [KillKineticMelee .. KillOtherPush] trunkBagRaw = EM.map (, []) foesAn lSlotsRaw = EM.filter (`EM.member` trunkBagRaw) $ itemSlots EM.! STrunk killedBag = EM.fromList $ map (\iid -> (iid, trunkBagRaw EM.! iid)) (EM.elems lSlotsRaw) generationTrunk = generationAn EM.! STrunk (trunkBag, lSlots) = if sexposeActors then let generationBag = EM.map (\k -> (-k, [])) generationTrunk bag = killedBag `EM.union` generationBag slots = EM.fromAscList $ zip allSlots $ EM.keys bag in (bag, slots) else (killedBag, lSlotsRaw) total = sum $ filter (> 0) $ map fst $ EM.elems trunkBag promptFun :: ItemId -> ItemFull-> Int -> Text promptFun iid _ k = let n = generationTrunk EM.! iid in makePhrase [ "You recall the adversary, which you killed" , MU.CarWs (max 0 k) "time", "out of" , MU.CarWs n "individual", "reported:" ] prompt = makeSentence ["your team vanquished", MU.CarWs total "adversary"] -- total reported would include our own, so not given <+> (if sexposeActors then "Non-positive count means none killed but this many reported." else "") examItem = displayItemLore trunkBag 0 promptFun viewLoreItems "GameOverAnalytics" lSlots trunkBag prompt examItem displayGameOverLore :: MonadClientUI m => SLore -> Bool -> GenerationAnalytics -> m K.KM displayGameOverLore slore exposeCount generationAn = do let generationLore = generationAn EM.! slore generationBag = EM.map (\k -> (if exposeCount then k else 1, [])) generationLore total = sum $ map fst $ EM.elems generationBag slots = EM.fromAscList $ zip allSlots $ EM.keys generationBag promptFun :: ItemId -> ItemFull-> Int -> Text promptFun _ _ k = makeSentence [ "this", MU.Text (ppSLore slore), "manifested during your quest" , MU.CarWs k "time" ] prompt | total == 0 = makeSentence [ "you didn't experience any" , MU.Ws $ MU.Text (headingSLore slore) , "this time" ] | otherwise = makeSentence [ "you experienced the following variety of" , MU.CarWs total $ MU.Text (headingSLore slore) ] examItem = displayItemLore generationBag 0 promptFun viewLoreItems ("GameOverLore" ++ show slore) slots generationBag prompt examItem discover :: MonadClientUI m => Container -> ItemId -> m () discover c iid = do COps{coitem} <- getsState scops lid <- getsState $ lidFromC c globalTime <- getsState stime localTime <- getsState $ getLocalTime lid itemFull <- getsState $ itemToFull iid bag <- getsState $ getContainerBag c side <- getsClient sside factionD <- getsState sfactionD (noMsg, nameWhere) <- case c of CActor aidOwner storeOwner -> do bOwner <- getsState $ getActorBody aidOwner partOwner <- partActorLeader aidOwner let name = if bproj bOwner then [] else ppCStoreWownW True storeOwner partOwner isOurOrgan = bfid bOwner == side && storeOwner == COrgan -- assume own faction organs known intuitively return (isOurOrgan, name) CTrunk _ _ p | p == originPoint -> return (True, []) -- the special reveal at game over, using fake @CTrunk@; don't spam _ -> return (False, []) let kit = EM.findWithDefault (1, []) iid bag knownName = partItemMediumAW side factionD localTime itemFull kit -- Make sure the two names in the message differ. We may end up with -- "the pair turns out to be a pair of trousers of destruction", -- but that's almost sensible. The fun of English. name = IK.iname $ okind coitem $ case jkind $ itemBase itemFull of IdentityObvious ik -> ik IdentityCovered _ix ik -> ik -- fake kind; we talk about appearances flav = flavourToName $ jflavour $ itemBase itemFull unknownName = MU.Phrase $ [MU.Text flav, MU.Text name] ++ nameWhere msg = makeSentence ["the", MU.SubjectVerbSg unknownName "turn out to be", knownName] unless (noMsg || globalTime == timeZero) $ -- no spam about initial equipment msgAdd MsgItemDisco msg ppHearMsg :: MonadClientUI m => HearMsg -> m Text ppHearMsg hearMsg = case hearMsg of HearUpd local cmd -> do COps{coTileSpeedup} <- getsState scops let sound = case cmd of UpdDestroyActor{} -> "shriek" UpdCreateItem{} -> "clatter" UpdTrajectory{} -> "thud" -- Something hits a non-walkable tile. UpdAlterTile _ _ _ toTile -> if Tile.isDoor coTileSpeedup toTile then "creaking sound" else "rumble" UpdAlterExplorable _ k -> if k > 0 then "grinding noise" else "fizzing noise" _ -> error $ "" `showFailure` cmd distant = if local then [] else ["distant"] msg = makeSentence [ "you hear" , MU.AW $ MU.Phrase $ distant ++ [sound] ] return $! msg HearStrike ik -> do COps{coitem} <- getsState scops let verb = IK.iverbHit $ okind coitem ik msg = makeSentence [ "you hear something", MU.Text verb, "someone"] return $! msg HearSummon isProj grp p -> do let verb = if isProj then "something lure" else "somebody summon" object = if p == 1 -- works, because exact number sent, not dice then MU.Text $ fromGroupName grp else MU.Ws $ MU.Text $ fromGroupName grp return $! makeSentence ["you hear", verb, object] HearTaunt t -> return $! makeSentence ["you overhear", MU.Text t] -- * RespSfxAtomicUI -- | Display special effects (text, animation) sent to the client. -- Don't modify client state (except a few fields), but only client -- session (e.g., by displaying messages). This is enforced by types. displayRespSfxAtomicUI :: MonadClientUI m => SfxAtomic -> m () {-# INLINE displayRespSfxAtomicUI #-} displayRespSfxAtomicUI sfx = case sfx of SfxStrike source target iid store -> strike False source target iid store SfxRecoil source target _ _ -> do spart <- partActorLeader source tpart <- partActorLeader target msgAdd MsgAction $ makeSentence [MU.SubjectVerbSg spart "shrink away from", tpart] SfxSteal source target iid store -> strike True source target iid store SfxRelease source target _ _ -> do spart <- partActorLeader source tpart <- partActorLeader target msgAdd MsgAction $ makeSentence [MU.SubjectVerbSg spart "release", tpart] SfxProject aid iid cstore -> itemAidVerbMU MsgAction aid "fling" iid (Left $ Just 1) cstore SfxReceive aid iid cstore -> itemAidVerbMU MsgAction aid "receive" iid (Left $ Just 1) cstore SfxApply aid iid cstore -> do CCUI{coscreen=ScreenContent{rapplyVerbMap}} <- getsSession sccui ItemFull{itemKind} <- getsState $ itemToFull iid let actionPart = case EM.lookup (IK.isymbol itemKind) rapplyVerbMap of Just verb -> MU.Text verb Nothing -> "use" itemAidVerbMU MsgAction aid actionPart iid (Left $ Just 1) cstore SfxCheck aid iid cstore -> itemAidVerbMU MsgAction aid "deapply" iid (Left $ Just 1) cstore SfxTrigger aid p -> do COps{cotile} <- getsState scops b <- getsState $ getActorBody aid lvl <- getLevel $ blid b let name = TK.tname $ okind cotile $ lvl `at` p (msgClass, verb) = if p == bpos b then (MsgActionMinor, "walk over") else (MsgAction, "exploit") -- TODO: "struggle" when harmful, "wade through" when deep, etc. -- possibly use the verb from the first embedded item, -- but it's meant to go with the item as subject, no the actor -- TODO: "harass" when somebody else suffers the effect aidVerbMU msgClass aid $ MU.Text $ verb <+> name SfxShun aid _p -> aidVerbMU MsgAction aid "shun it" SfxEffect fidSource aid effect hpDelta -> do CCUI{coscreen} <- getsSession sccui b <- getsState $ getActorBody aid bUI <- getsSession $ getActorUI aid side <- getsClient sside mleader <- getsClient sleader let fid = bfid b isOurCharacter = fid == side && not (bproj b) isOurAlive = isOurCharacter && bhp b > 0 isOurLeader = Just aid == mleader feelLookHP = feelLook MsgEffect feelLookCalm adjective = when (bhp b > 0) $ feelLook MsgEffectMinor adjective feelLook msgClass adjective = let verb = if isOurCharacter then "feel" else "look" in aidVerbMU msgClass aid $ MU.Text $ verb <+> adjective case effect of IK.Burn{} -> do feelLookHP "burned" let ps = (bpos b, bpos b) animate (blid b) $ twirlSplash coscreen ps Color.BrRed Color.Brown IK.Explode{} -> return () -- lots of visual feedback IK.RefillHP p | p == 1 -> return () -- no spam from regeneration IK.RefillHP p | p == -1 -> return () -- no spam from poison IK.RefillHP{} | hpDelta > 0 -> do feelLookHP "healthier" let ps = (bpos b, bpos b) animate (blid b) $ twirlSplash coscreen ps Color.BrGreen Color.Green IK.RefillHP{} -> do feelLookHP "wounded" let ps = (bpos b, bpos b) animate (blid b) $ twirlSplash coscreen ps Color.BrRed Color.Red IK.RefillCalm{} | bproj b -> return () IK.RefillCalm p | p == 1 -> return () -- no spam from regen items IK.RefillCalm p | p > 0 -> feelLookCalm "calmer" IK.RefillCalm _ -> feelLookCalm "agitated" IK.Dominate -> do -- For subsequent messages use the proper name, never "you". let subject = partActor bUI if fid /= fidSource then do -- Before domination, possibly not seen if actor (yet) not ours. if | bcalm b == 0 -> -- sometimes only a coincidence, but nm aidVerbMU MsgEffectMinor aid $ MU.Text "yield, under extreme pressure" | isOurAlive -> aidVerbMU MsgEffectMinor aid $ MU.Text "black out, dominated by foes" | otherwise -> aidVerbMU MsgEffectMinor aid $ MU.Text "decide abruptly to switch allegiance" fidName <- getsState $ gname . (EM.! fid) . sfactionD let verb = "be no longer controlled by" msgAdd MsgEffectMajor $ makeSentence [MU.SubjectVerbSg subject verb, MU.Text fidName] when isOurAlive $ displayMoreKeep ColorFull "" else do -- After domination, possibly not seen, if actor (already) not ours. fidSourceName <- getsState $ gname . (EM.! fidSource) . sfactionD let verb = "be now under" msgAdd MsgEffectMajor $ makeSentence [MU.SubjectVerbSg subject verb, MU.Text fidSourceName, "control"] IK.Impress -> aidVerbMU MsgEffectMinor aid "be awestruck" IK.PutToSleep -> aidVerbMU MsgEffectMajor aid "be put to sleep" IK.Yell -> aidVerbMU MsgMisc aid "start" IK.Summon grp p -> do let verb = if bproj b then "lure" else "summon" object = (if p == 1 -- works, because exact number sent, not dice then MU.AW else MU.Ws) $ MU.Text $ fromGroupName grp aidVerbMU MsgEffectMajor aid $ MU.Phrase [verb, object] IK.Ascend up -> do COps{cocave} <- getsState scops aidVerbMU MsgEffectMajor aid $ MU.Text $ "find a way" <+> if up then "upstairs" else "downstairs" when isOurLeader $ do destinations <- getsState $ whereTo (blid b) (bpos b) up . sdungeon case destinations of (lid, _) : _ -> do -- only works until different levels possible lvl <- getLevel lid let desc = cdesc $ okind cocave $ lkind lvl unless (T.null desc) $ do msgAdd0 MsgLandscape desc msgAdd0 MsgFocus "You turn your attention to nearby positions." [] -> return () -- spell fizzles; normally should not be sent IK.Escape{} | isOurCharacter -> do ours <- getsState $ fidActorNotProjGlobalAssocs side when (length ours > 1) $ do let object = partActor bUI msgAdd MsgOutcome $ "The team joins" <+> makePhrase [object] <> ", forms a perimeter, repacks its belongings and leaves triumphant." IK.Escape{} -> return () IK.Paralyze{} -> aidVerbMU MsgEffect aid "be paralyzed" IK.ParalyzeInWater{} -> aidVerbMU MsgEffectMinor aid "move with difficulty" IK.InsertMove d -> if Dice.supDice d >= 10 then aidVerbMU MsgEffect aid "act with extreme speed" else aidVerbMU MsgEffectMinor aid "move swiftly" IK.Teleport t | Dice.supDice t <= 9 -> aidVerbMU MsgEffectMinor aid "blink" IK.Teleport{} -> aidVerbMU MsgEffect aid "teleport" IK.CreateItem{} -> return () IK.DropItem _ _ COrgan _ -> return () IK.DropItem{} -> aidVerbMU MsgEffect aid "be stripped" IK.PolyItem -> do subject <- partActorLeader aid let ppstore = MU.Text $ ppCStoreIn CGround msgAdd MsgEffect $ makeSentence [ MU.SubjectVerbSg subject "repurpose", "what lies", ppstore , "to a common item of the current level" ] IK.RerollItem -> do subject <- partActorLeader aid let ppstore = MU.Text $ ppCStoreIn CGround msgAdd MsgEffect $ makeSentence [ MU.SubjectVerbSg subject "reshape", "what lies", ppstore , "striving for the highest possible standards" ] IK.DupItem -> do subject <- partActorLeader aid let ppstore = MU.Text $ ppCStoreIn CGround msgAdd MsgEffect $ makeSentence [MU.SubjectVerbSg subject "multiply", "what lies", ppstore] IK.Identify -> do subject <- partActorLeader aid pronoun <- partPronounLeader aid msgAdd MsgEffectMinor $ makeSentence [ MU.SubjectVerbSg subject "look at" , MU.WownW pronoun $ MU.Text "inventory" , "intensely" ] IK.Detect d _ -> do subject <- partActorLeader aid let verb = MU.Text $ detectToVerb d object = MU.Ws $ MU.Text $ detectToObject d msgAdd MsgEffectMinor $ makeSentence [MU.SubjectVerbSg subject verb, object] -- Don't make it modal if all info remains after no longer seen. unless (d `elem` [IK.DetectHidden, IK.DetectExit]) $ displayMore ColorFull "" IK.SendFlying{} -> aidVerbMU MsgEffect aid "be sent flying" IK.PushActor{} -> aidVerbMU MsgEffect aid "be pushed" IK.PullActor{} -> aidVerbMU MsgEffect aid "be pulled" IK.DropBestWeapon -> aidVerbMU MsgEffectMajor aid "be disarmed" IK.ActivateInv{} -> return () IK.ApplyPerfume -> msgAdd MsgEffectMinor "The fragrance quells all scents in the vicinity." IK.OneOf{} -> return () IK.OnSmash{} -> error $ "" `showFailure` sfx IK.VerbNoLonger t -> aidVerbMU MsgNoLonger aid $ MU.Text t IK.VerbMsg t -> aidVerbMU MsgEffectMinor aid $ MU.Text t IK.Composite{} -> error $ "" `showFailure` sfx SfxMsgFid _ sfxMsg -> do mleader <- getsClient sleader case mleader of Just{} -> return () -- will display stuff when leader moves Nothing -> do lidV <- viewedLevelUI markDisplayNeeded lidV recordHistory mmsg <- ppSfxMsg sfxMsg case mmsg of Just (msgClass, msg) -> msgAdd msgClass msg Nothing -> return () SfxRestart -> fadeOutOrIn True SfxCollideTile source pos -> do COps{cotile} <- getsState scops sb <- getsState $ getActorBody source lvl <- getLevel $ blid sb spart <- partActorLeader source let object = MU.AW $ MU.Text $ TK.tname $ okind cotile $ lvl `at` pos msgAdd MsgVeryRare $! makeSentence [MU.SubjectVerbSg spart "collide", "painfully with", object] SfxTaunt voluntary aid -> do spart <- partActorLeader aid (_heardSubject, verb) <- displayTaunt voluntary rndToActionForget aid msgAdd MsgMisc $! makeSentence [MU.SubjectVerbSg spart (MU.Text verb)] ppSfxMsg :: MonadClientUI m => SfxMsg -> m (Maybe (MsgClass, Text)) ppSfxMsg sfxMsg = case sfxMsg of SfxUnexpected reqFailure -> return $ Just ( MsgWarning , "Unexpected problem:" <+> showReqFailure reqFailure <> "." ) SfxExpected itemName reqFailure -> return $ Just ( MsgWarning , "The" <+> itemName <+> "is not triggered:" <+> showReqFailure reqFailure <> "." ) SfxFizzles -> return $ Just (MsgWarning, "It didn't work.") SfxNothingHappens -> return $ Just (MsgMisc, "Nothing happens.") SfxVoidDetection d -> return $ Just ( MsgMisc , makeSentence ["no new", MU.Text $ detectToObject d, "detected"] ) SfxUnimpressed aid -> do msbUI <- getsSession $ EM.lookup aid . sactorUI case msbUI of Nothing -> return Nothing Just sbUI -> do let subject = partActor sbUI verb = "be unimpressed" return $ Just (MsgWarning, makeSentence [MU.SubjectVerbSg subject verb]) SfxSummonLackCalm aid -> do msbUI <- getsSession $ EM.lookup aid . sactorUI case msbUI of Nothing -> return Nothing Just sbUI -> do let subject = partActor sbUI verb = "lack Calm to summon" return $ Just (MsgWarning, makeSentence [MU.SubjectVerbSg subject verb]) SfxSummonTooManyOwn aid -> do msbUI <- getsSession $ EM.lookup aid . sactorUI case msbUI of Nothing -> return Nothing Just sbUI -> do let subject = partActor sbUI verb = "can't keep track of their numerous friends, let alone summon any more" return $ Just (MsgWarning, makeSentence [subject, verb]) SfxSummonTooManyAll aid -> do msbUI <- getsSession $ EM.lookup aid . sactorUI case msbUI of Nothing -> return Nothing Just sbUI -> do let subject = partActor sbUI verb = "can't keep track of everybody around, let alone summon anyone else" return $ Just (MsgWarning, makeSentence [subject, verb]) SfxSummonFailure aid -> do msbUI <- getsSession $ EM.lookup aid . sactorUI case msbUI of Nothing -> return Nothing Just sbUI -> do let subject = partActor sbUI verb = "fail to summon anything" return $ Just (MsgWarning, makeSentence [MU.SubjectVerbSg subject verb]) SfxLevelNoMore -> return $ Just (MsgWarning, "No more levels in this direction.") SfxLevelPushed -> return $ Just (MsgWarning, "You notice somebody pushed to another level.") SfxBracedImmune aid -> do msbUI <- getsSession $ EM.lookup aid . sactorUI case msbUI of Nothing -> return Nothing Just sbUI -> do let subject = partActor sbUI verb = "be braced and so immune to translocation" return $ Just (MsgMisc, makeSentence [MU.SubjectVerbSg subject verb]) -- too common SfxEscapeImpossible -> return $ Just ( MsgWarning , "Escaping outside is unthinkable for members of this faction." ) SfxStasisProtects -> return $ Just ( MsgMisc -- too common , "Paralysis and speed surge require recovery time." ) SfxWaterParalysisResisted -> return Nothing -- don't spam SfxTransImpossible -> return $ Just (MsgWarning, "Translocation not possible.") SfxIdentifyNothing -> return $ Just (MsgWarning, "Nothing to identify.") SfxPurposeNothing -> return $ Just ( MsgWarning , "The purpose of repurpose cannot be availed without an item" <+> ppCStoreIn CGround <> "." ) SfxPurposeTooFew maxCount itemK -> return $ Just ( MsgWarning , "The purpose of repurpose is served by" <+> tshow maxCount <+> "pieces of this item, not by" <+> tshow itemK <> "." ) SfxPurposeUnique -> return $ Just (MsgWarning, "Unique items can't be repurposed.") SfxPurposeNotCommon -> return $ Just (MsgWarning, "Only ordinary common items can be repurposed.") SfxRerollNothing -> return $ Just ( MsgWarning , "The shape of reshape cannot be assumed without an item" <+> ppCStoreIn CGround <> "." ) SfxRerollNotRandom -> return $ Just (MsgWarning, "Only items of variable shape can be reshaped.") SfxDupNothing -> return $ Just ( MsgWarning , "Mutliplicity won't rise above zero without an item" <+> ppCStoreIn CGround <> "." ) SfxDupUnique -> return $ Just (MsgWarning, "Unique items can't be multiplied.") SfxDupValuable -> return $ Just (MsgWarning, "Valuable items can't be multiplied.") SfxColdFish -> return $ Just ( MsgMisc -- repeatable , "Healing attempt from another faction is thwarted by your cold fish attitude." ) SfxTimerExtended lid aid iid cstore delta -> do aidSeen <- getsState $ memActor aid lid if aidSeen then do b <- getsState $ getActorBody aid bUI <- getsSession $ getActorUI aid aidPronoun <- partPronounLeader aid -- assume almost always a prior message mentions the object factionD <- getsState sfactionD localTime <- getsState $ getLocalTime (blid b) itemFull <- getsState $ itemToFull iid side <- getsClient sside let kit = (1, []) (name, powers) = partItem (bfid b) factionD localTime itemFull kit storeOwn = ppCStoreWownW True cstore aidPronoun cond = [ "condition" | IA.checkFlag Ability.Condition $ aspectRecordFull itemFull ] -- Note that when enemy actor causes the extension to himsefl, -- the player is not notified at all. So the shorter blurb below -- is the middle ground. (msgClass, parts) | bfid b == side = ( MsgLongerUs , ["the", name, powers] ++ cond ++ storeOwn ++ ["will now last"] ++ [MU.Text $ timeDeltaInSecondsText delta] ++ ["longer"] ) | otherwise = -- avoid TMI for not our actors -- Ideally we'd use a pronoun here, but the action (e.g., hit) -- that caused this extension can be invisible to some onlookers. -- So their narrative context needs to be taken into account. ( MsgLonger , [partItemShortWownW side factionD (partActor bUI) localTime itemFull (1, [])] ++ cond ++ ["is extended"] ) return $ Just (msgClass, makeSentence parts) else return Nothing SfxCollideActor lid source target -> do sourceSeen <- getsState $ memActor source lid targetSeen <- getsState $ memActor target lid if sourceSeen && targetSeen then do spart <- partActorLeader source tpart <- partActorLeader target return $ Just ( MsgWarning , makeSentence [MU.SubjectVerbSg spart "collide", "awkwardly with", tpart] ) else return Nothing strike :: MonadClientUI m => Bool -> ActorId -> ActorId -> ItemId -> CStore -> m () strike catch source target iid cstore = assert (source /= target) $ do CCUI{coscreen} <- getsSession sccui tb <- getsState $ getActorBody target sourceSeen <- getsState $ memActor source (blid tb) if not sourceSeen then animate (blid tb) $ subtleHit coscreen (bpos tb) else do hurtMult <- getsState $ armorHurtBonus source target sb <- getsState $ getActorBody source sMaxSk <- getsState $ getActorMaxSkills source spart <- partActorLeader source tpart <- partActorLeader target spronoun <- partPronounLeader source tpronoun <- partPronounLeader target tbUI <- getsSession $ getActorUI target localTime <- getsState $ getLocalTime (blid tb) bag <- getsState $ getBodyStoreBag sb cstore itemFullWeapon <- getsState $ itemToFull iid let kitWeapon = EM.findWithDefault (1, []) iid bag side <- getsClient sside factionD <- getsState sfactionD tfact <- getsState $ (EM.! bfid tb) . sfactionD eqpOrgKit <- getsState $ kitAssocs target [CEqp, COrgan] orgKit <- getsState $ kitAssocs target [COrgan] let notCond (_, (itemFullArmor, _)) = not $ IA.checkFlag Ability.Condition $ aspectRecordFull itemFullArmor isOrdinaryCond (_, (itemFullArmor, _)) = isJust $ lookup "condition" $ IK.ifreq $ itemKind itemFullArmor rateArmor (iidArmor, (itemFullArmor, (k, _))) = ( k * IA.getSkill Ability.SkArmorMelee (aspectRecordFull itemFullArmor) , ( iidArmor , itemFullArmor ) ) abs15 (v, _) = abs v >= 15 condArmor = filter abs15 $ map rateArmor $ filter isOrdinaryCond orgKit fstGt0 (v, _) = v > 0 eqpAndOrgArmor = filter fstGt0 $ map rateArmor $ filter notCond eqpOrgKit mblockArmor <- case eqpAndOrgArmor of [] -> return Nothing _ -> Just <$> rndToActionForget (frequency $ toFreq "msg armor" eqpAndOrgArmor) let (blockWithWhat, blockWithWeapon) = case mblockArmor of Nothing -> ([], False) Just (iidArmor, itemFullArmor) -> let (object1, object2) = partItemShortest (bfid tb) factionD localTime itemFullArmor (1, []) name | iidArmor == btrunk tb = "trunk" | otherwise = MU.Phrase [object1, object2] in ( ["with", MU.WownW tpronoun name] , Dice.supDice (IK.idamage $ itemKind itemFullArmor) > 0 ) verb = MU.Text $ IK.iverbHit $ itemKind itemFullWeapon partItemChoice = if iid `EM.member` borgan sb then partItemShortWownW side factionD spronoun localTime else partItemShortAW side factionD localTime weaponName = partItemChoice itemFullWeapon kitWeapon sleepy = if bwatch tb `elem` [WSleep, WWake] && tpart /= "you" && bhp tb > 0 then "the sleepy" else "" -- For variety, attack adverb is based on attacker's and weapon's -- damage potential as compared to victim's current HP. -- We are not taking into account victim's armor yet. sHurt = armorHurtCalculation (bproj sb) sMaxSk Ability.zeroSkills sDamage = let dmg = Dice.supDice $ IK.idamage $ itemKind itemFullWeapon rawDeltaHP = fromIntegral sHurt * xM dmg `divUp` 100 speedDeltaHP = case btrajectory sb of Just (_, speed) | bproj sb -> - modifyDamageBySpeed rawDeltaHP speed _ -> - rawDeltaHP in min 0 speedDeltaHP deadliness = 1000 * (- sDamage) `div` max 1 (bhp tb) strongly | deadliness >= 10000 = "artfully" | deadliness >= 5000 = "madly" | deadliness >= 2000 = "mercilessly" | deadliness >= 1000 = "murderously" -- one blow can wipe out all HP | deadliness >= 700 = "devastatingly" | deadliness >= 500 = "vehemently" | deadliness >= 400 = "forcefully" | deadliness >= 350 = "sturdily" | deadliness >= 300 = "accurately" | deadliness >= 20 = "" -- common, terse case, between 2% and 30% | deadliness >= 10 = "cautiously" | deadliness >= 5 = "guardedly" | deadliness >= 3 = "hesitantly" | deadliness >= 2 = "clumsily" | deadliness >= 1 = "haltingly" | otherwise = "feebly" -- Here we take into account armor, so we look at @hurtMult@, -- so we finally convey the full info about effectiveness of the strike. blockHowWell -- under some conditions, the message not shown at all | hurtMult > 90 = "incompetently" | hurtMult > 80 = "too late" | hurtMult > 70 = "too slowly" | hurtMult > 20 = if | deadliness >= 2000 -> "marginally" | deadliness >= 1000 -> "partially" | deadliness >= 100 -> "partly" -- common | deadliness >= 50 -> "to an extent" | deadliness >= 20 -> "to a large extent" | deadliness >= 5 -> "for the major part" | otherwise -> "for the most part" | hurtMult > 1 = if | actorWaits tb -> "doggedly" | hurtMult > 10 -> "nonchalantly" | otherwise -> "bemusedly" | otherwise = "almost completely" -- 1% always gets through, but if fast missile, can be deadly blockPhrase = let (subjectBlock, verbBlock) = if | not $ bproj sb -> (tpronoun, if blockWithWeapon then "parry" else "block") | tpronoun == "it" || projectileHitsWeakly && tpronoun /= "you" -> -- Avoid ambiguity. (partActor tbUI, if actorWaits tb then "deflect it" else "fend it off") | otherwise -> (tpronoun, if actorWaits tb then "avert it" else "ward it off") in MU.SubjectVerbSg subjectBlock verbBlock surprisinglyGoodDefense = deadliness >= 20 && hurtMult <= 70 surprisinglyBadDefense = deadliness < 20 && hurtMult > 70 yetButAnd | surprisinglyGoodDefense = ", but" | surprisinglyBadDefense = ", yet" | otherwise = " and" -- no surprises projectileHitsWeakly = bproj sb && deadliness < 20 msgArmor = if not projectileHitsWeakly -- ensures if attack msg terse, armor message -- mentions object, so we know who is hit && hurtMult > 90 && (null condArmor || deadliness < 100) then "" -- at most minor armor, relatively to skill -- of the hit, so we don't talk about blocking, -- unless a condition is at play, too else yetButAnd <+> makePhrase ([blockPhrase, blockHowWell] ++ blockWithWhat) ps = (bpos tb, bpos sb) basicAnim | hurtMult > 70 = twirlSplash coscreen ps Color.BrRed Color.Red | hurtMult > 1 = blockHit coscreen ps Color.BrRed Color.Red | otherwise = blockMiss coscreen ps targetIsFoe = bfid sb == side -- no big news if others hit our foes && isFoe (bfid tb) tfact side targetIsFriend = isFriend (bfid tb) tfact side -- warning if anybody hits our friends msgClassMelee = if targetIsFriend then MsgMeleeUs else MsgMelee msgClassRanged = if targetIsFriend then MsgRangedUs else MsgRanged -- The messages about parrying and immediately afterwards dying -- sound goofy, but there is no easy way to prevent that. -- And it's consistent. -- If/when death blow instead sets HP to 1 and only the next below 1, -- we can check here for HP==1; also perhaps actors with HP 1 should -- not be able to block. if | catch -> do -- charge not needed when catching let msg = makeSentence [MU.SubjectVerbSg spart "catch", tpart, "skillfully"] msgAdd MsgVeryRare msg animate (blid tb) $ blockHit coscreen ps Color.BrGreen Color.Green | not (hasCharge localTime itemFullWeapon kitWeapon) -> do -- Can easily happen with a thrown discharged item. -- Much less plausible with a wielded weapon. -- Theoretically possible if the weapon not identified -- (then timeout is a mean estimate), but they usually should be, -- even in foes' possession. let msg = if bproj sb then makePhrase [MU.Capitalize $ MU.SubjectVerbSg spart "connect"] <> ", but it may be completely discharged." else makePhrase [ MU.Capitalize $ MU.SubjectVerbSg spart "try" , "to", verb, tpart, "with" , weaponName ] <> ", but it may be not readied yet." msgAdd MsgVeryRare msg -- and no animation | bproj sb && bproj tb -> do -- server sends unless both are blasts -- Short message. msgAdd MsgVeryRare $ makeSentence [MU.SubjectVerbSg spart "intercept", tpart] -- Basic non-bloody animation regardless of stats. animate (blid tb) $ blockHit coscreen ps Color.BrBlue Color.Blue | IK.idamage (itemKind itemFullWeapon) == 0 -> do let adverb = if bproj sb then "lightly" else "delicately" msg = makeSentence $ [MU.SubjectVerbSg spart verb, tpart, adverb] ++ if bproj sb then [] else ["with", weaponName] msgAdd msgClassMelee msg -- too common for color animate (blid tb) $ subtleHit coscreen (bpos sb) | bproj sb -> do -- more terse than melee, because sometimes very spammy let msgRangedPowerful | targetIsFoe = MsgRangedPowerfulWe | targetIsFriend = MsgRangedPowerfulUs | otherwise = msgClassRanged (attackParts, msgRanged) | projectileHitsWeakly = ( [MU.SubjectVerbSg spart "connect"] -- weak, so terse , msgClassRanged ) | deadliness >= 300 = ( [MU.SubjectVerbSg spart verb, tpart, "powerfully"] , if targetIsFriend || deadliness >= 700 then msgRangedPowerful else msgClassRanged ) | otherwise = ( [MU.SubjectVerbSg spart verb, tpart] -- strong, for a proj , msgClassRanged ) msgAdd msgRanged $ makePhrase [MU.Capitalize $ MU.Phrase attackParts] <> msgArmor <> "." animate (blid tb) basicAnim | bproj tb -> do -- much less emotion and the victim not active. let attackParts = [MU.SubjectVerbSg spart verb, tpart, "with", weaponName] msgAdd MsgMelee $ makeSentence attackParts animate (blid tb) basicAnim | otherwise -> do -- ordinary melee let msgMeleeInteresting | targetIsFoe = MsgMeleeInterestingWe | targetIsFriend = MsgMeleeInterestingUs | otherwise = msgClassMelee msgMeleePowerful | targetIsFoe = MsgMeleePowerfulWe | targetIsFriend = MsgMeleePowerfulUs | otherwise = msgClassMelee attackParts = [ MU.SubjectVerbSg spart verb, sleepy, tpart, strongly , "with", weaponName ] (tmpInfluenceBlurb, msgClassInfluence) = if null condArmor || T.null msgArmor then ("", msgClassMelee) else let (armor, (_, itemFullArmor)) = maximumBy (Ord.comparing $ abs . fst) condArmor (object1, object2) = partItemShortest (bfid tb) factionD localTime itemFullArmor (1, []) name = makePhrase [object1, object2] msgText = if hurtMult > 20 && not surprisinglyGoodDefense || surprisinglyBadDefense then (if armor <= -15 then ", due to being" else assert (armor >= 15) ", regardless of being") <+> name else (if armor >= 15 then ", thanks to being" else assert (armor <= -15) ", despite being") <+> name in (msgText, msgMeleeInteresting) msgClass = if targetIsFriend && deadliness >= 300 || deadliness >= 2000 then msgMeleePowerful else msgClassInfluence msgAdd msgClass $ makePhrase [MU.Capitalize $ MU.Phrase attackParts] <> msgArmor <> tmpInfluenceBlurb <> "." animate (blid tb) basicAnim LambdaHack-0.9.5.0/engine-src/Game/LambdaHack/Client/UI/DrawM.hs0000644000000000000000000010504407346545000022002 0ustar0000000000000000-- {-# OPTIONS_GHC -fprof-auto #-} -- | Display game data on the screen using one of the available frontends -- (determined at compile time with cabal flags). module Game.LambdaHack.Client.UI.DrawM ( targetDesc, targetDescXhair, drawHudFrame , checkWarningHP, checkWarningCalm #ifdef EXPOSE_INTERNAL -- * Internal operations , drawFrameTerrain, drawFrameContent , drawFramePath, drawFrameActor, drawFrameExtra, drawFrameStatus , drawArenaStatus, drawLeaderStatus, drawLeaderDamage, drawSelected , checkWarnings #endif ) where import Prelude () import Game.LambdaHack.Core.Prelude import Control.Monad.ST.Strict import qualified Data.Char as Char import qualified Data.EnumMap.Strict as EM import qualified Data.EnumSet as ES import Data.Int (Int64) import qualified Data.IntMap.Strict as IM import qualified Data.IntSet as IS import qualified Data.Text as T import qualified Data.Vector.Unboxed as U import qualified Data.Vector.Unboxed.Mutable as VM import Data.Word (Word16, Word32) import GHC.Exts (inline) import qualified NLP.Miniutter.English as MU import Game.LambdaHack.Client.Bfs import Game.LambdaHack.Client.CommonM import Game.LambdaHack.Client.MonadClient import Game.LambdaHack.Client.State import Game.LambdaHack.Client.UI.ActorUI import Game.LambdaHack.Client.UI.Frame import Game.LambdaHack.Client.UI.Frontend (frontendName) import Game.LambdaHack.Client.UI.ItemDescription import Game.LambdaHack.Client.UI.MonadClientUI import Game.LambdaHack.Client.UI.Overlay import Game.LambdaHack.Client.UI.SessionUI import Game.LambdaHack.Client.UI.UIOptions import Game.LambdaHack.Common.Actor import Game.LambdaHack.Common.ActorState import Game.LambdaHack.Common.Faction import Game.LambdaHack.Common.Item import qualified Game.LambdaHack.Common.ItemAspect as IA import Game.LambdaHack.Common.Kind import Game.LambdaHack.Common.Level import Game.LambdaHack.Common.Misc import Game.LambdaHack.Common.MonadStateRead import Game.LambdaHack.Common.Perception import Game.LambdaHack.Common.Point import qualified Game.LambdaHack.Common.PointArray as PointArray import Game.LambdaHack.Common.State import qualified Game.LambdaHack.Common.Tile as Tile import Game.LambdaHack.Common.Time import Game.LambdaHack.Common.Types import Game.LambdaHack.Common.Vector import Game.LambdaHack.Content.CaveKind (cname) import qualified Game.LambdaHack.Content.ItemKind as IK import qualified Game.LambdaHack.Content.ModeKind as MK import Game.LambdaHack.Content.RuleKind import Game.LambdaHack.Content.TileKind (TileKind, isUknownSpace) import qualified Game.LambdaHack.Content.TileKind as TK import qualified Game.LambdaHack.Core.Dice as Dice import qualified Game.LambdaHack.Definition.Ability as Ability import qualified Game.LambdaHack.Definition.Color as Color import Game.LambdaHack.Definition.Defs targetDesc :: MonadClientUI m => Maybe Target -> m (Maybe Text, Maybe Text) targetDesc mtarget = do arena <- getArenaUI lidV <- viewedLevelUI mleader <- getsClient sleader let describeActorTarget aid = do side <- getsClient sside b <- getsState $ getActorBody aid bUI <- getsSession $ getActorUI aid actorMaxSk <- getsState $ getActorMaxSkills aid let percentage = 100 * bhp b `div` xM (max 5 $ Ability.getSk Ability.SkMaxHP actorMaxSk) chs n = "[" <> T.replicate n "*" <> T.replicate (4 - n) "_" <> "]" stars = chs $ fromEnum $ max 0 $ min 4 $ percentage `div` 20 hpIndicator = if bfid b == side then Nothing else Just stars return (Just $ bname bUI, hpIndicator) case mtarget of Just (TEnemy aid) -> describeActorTarget aid Just (TNonEnemy aid) -> describeActorTarget aid Just (TPoint tgoal lid p) -> case tgoal of TEnemyPos{} -> do let hotText = if lid == lidV && arena == lidV then "hot spot" <+> tshow p else "a hot spot on level" <+> tshow (abs $ fromEnum lid) return (Just hotText, Nothing) _ -> do -- the other goals can be invalidated by now anyway and it's -- better to say what there is rather than what there isn't pointedText <- if lid == lidV && arena == lidV then do bag <- getsState $ getFloorBag lid p case EM.assocs bag of [] -> return $! "exact spot" <+> tshow p [(iid, kit@(k, _))] -> do localTime <- getsState $ getLocalTime lid itemFull <- getsState $ itemToFull iid side <- getsClient sside factionD <- getsState sfactionD let (name, powers) = partItem side factionD localTime itemFull kit return $! makePhrase [MU.Car1Ws k name, powers] _ -> return $! "many items at" <+> tshow p else return $! "an exact spot on level" <+> tshow (abs $ fromEnum lid) return (Just pointedText, Nothing) Just TVector{} -> case mleader of Nothing -> return (Just "a relative shift", Nothing) Just aid -> do tgtPos <- getsState $ aidTgtToPos aid lidV mtarget let invalidMsg = "an invalid relative shift" validMsg p = "shift to" <+> tshow p return (Just $ maybe invalidMsg validMsg tgtPos, Nothing) Nothing -> return (Nothing, Nothing) targetDescXhair :: MonadClientUI m => m (Maybe Text, Maybe (Text, Watchfulness)) targetDescXhair = do sxhair <- getsSession sxhair (mhairDesc, mxhairHP) <- targetDesc sxhair case mxhairHP of Nothing -> return (mhairDesc, Nothing) Just tHP -> do let aid = case sxhair of Just (TEnemy a) -> a Just (TNonEnemy a) -> a _ -> error $ "HP text for non-actor target" `showFailure` sxhair watchfulness <- bwatch <$> getsState (getActorBody aid) return $ (mhairDesc, Just (tHP, watchfulness)) drawFrameTerrain :: forall m. MonadClientUI m => LevelId -> m (U.Vector Word32) drawFrameTerrain drawnLevelId = do COps{corule=RuleContent{rXmax}, cotile, coTileSpeedup} <- getsState scops StateClient{smarkSuspect} <- getClient -- Not @ScreenContent@, because indexing in level's data. Level{ltile=PointArray.Array{avector}, lembed} <- getLevel drawnLevelId totVisible <- totalVisible <$> getPerFid drawnLevelId frameStatus <- drawFrameStatus drawnLevelId let dis :: PointI -> ContentId TileKind -> Color.AttrCharW32 {-# INLINE dis #-} dis pI tile = let TK.TileKind{tsymbol, tcolor, tcolor2} = okind cotile tile -- @smarkSuspect@ can be turned off easily, so let's overlay it -- over both visible and remembered tiles. fg :: Color.Color fg | smarkSuspect > 0 && Tile.isSuspect coTileSpeedup tile = Color.BrMagenta | smarkSuspect > 1 && Tile.isHideAs coTileSpeedup tile = Color.Magenta | -- Converting maps is cheaper than converting points -- and this function is a bottleneck, so we hack a bit. pI `IS.member` ES.enumSetToIntSet totVisible -- If all embeds spent, mark it with darker colour. && not (Tile.isEmbed coTileSpeedup tile && pI `IM.notMember` EM.enumMapToIntMap lembed) = tcolor | otherwise = tcolor2 in Color.attrChar2ToW32 fg tsymbol g :: PointI -> Word16 -> Word32 g !pI !tile = Color.attrCharW32 $ dis pI (toContentId tile) caveVector :: U.Vector Word32 caveVector = U.imap g avector messageVector = U.replicate rXmax (Color.attrCharW32 Color.spaceAttrW32) statusVector = U.fromListN (2 * rXmax) $ map Color.attrCharW32 frameStatus -- The vector package is so smart that the 3 vectors are not allocated -- separately at all, but written to the big vector at once. -- But even with double allocation it would be faster than writing -- to a mutable vector via @FrameForall@. return $ U.concat [messageVector, caveVector, statusVector] drawFrameContent :: forall m. MonadClientUI m => LevelId -> m FrameForall drawFrameContent drawnLevelId = do COps{corule=RuleContent{rXmax}} <- getsState scops SessionUI{smarkSmell} <- getSession -- Not @ScreenContent@, because indexing in level's data. Level{lsmell, ltime, lfloor} <- getLevel drawnLevelId itemToF <- getsState $ flip itemToFull let {-# INLINE viewItemBag #-} viewItemBag _ floorBag = case EM.toDescList floorBag of (iid, _kit) : _ -> viewItem $ itemToF iid [] -> error $ "lfloor not sparse" `showFailure` () viewSmell :: PointI -> Time -> Color.AttrCharW32 {-# INLINE viewSmell #-} viewSmell pI sml = let fg = toEnum $ pI `rem` 13 + 2 smlt = smellTimeout `timeDeltaSubtract` (sml `timeDeltaToFrom` ltime) in Color.attrChar2ToW32 fg (timeDeltaToDigit smellTimeout smlt) mapVAL :: forall a s. (PointI -> a -> Color.AttrCharW32) -> [(PointI, a)] -> FrameST s {-# INLINE mapVAL #-} mapVAL f l v = do let g :: (PointI, a) -> ST s () g (!pI, !a0) = do let w = Color.attrCharW32 $ f pI a0 VM.write v (pI + rXmax) w mapM_ g l -- We don't usually show embedded items, because normally we don't -- want them to clutter the display. If they are really important, -- the tile they reside on has special colours and changes as soon -- as the item disappears. In the remaining cases, the main menu -- UI setting for suspect terrain highlights most tiles with embeds. upd :: FrameForall upd = FrameForall $ \v -> do mapVAL viewItemBag (IM.assocs $ EM.enumMapToIntMap lfloor) v when smarkSmell $ mapVAL viewSmell (filter ((> ltime) . snd) $ IM.assocs $ EM.enumMapToIntMap lsmell) v return upd drawFramePath :: forall m. MonadClientUI m => LevelId -> m FrameForall drawFramePath drawnLevelId = do SessionUI{saimMode} <- getSession if isNothing saimMode then return $! FrameForall $ \_ -> return () else do COps{corule=RuleContent{rXmax, rYmax}, coTileSpeedup} <- getsState scops StateClient{seps} <- getClient -- Not @ScreenContent@, because pathing in level's map. Level{ltile=PointArray.Array{avector}} <- getLevel drawnLevelId totVisible <- totalVisible <$> getPerFid drawnLevelId mleader <- getsClient sleader mpos <- getsState $ \s -> bpos . (`getActorBody` s) <$> mleader xhairPosRaw <- xhairToPos let xhairPos = fromMaybe (fromMaybe originPoint mpos) xhairPosRaw bline <- case mleader of Just leader -> do Actor{bpos, blid} <- getsState $ getActorBody leader return $! if blid /= drawnLevelId then [] else fromMaybe [] $ bla rXmax rYmax seps bpos xhairPos _ -> return [] mpath <- maybe (return Nothing) (\aid -> do mtgtMPath <- getsClient $ EM.lookup aid . stargetD case mtgtMPath of Just TgtAndPath{tapPath=tapPath@(Just AndPath{pathGoal})} | pathGoal == xhairPos -> return tapPath _ -> getCachePath aid xhairPos) mleader assocsAtxhair <- getsState $ posToAidAssocs xhairPos drawnLevelId let lpath = if null bline then [] else maybe [] pathList mpath shiftedBTrajectory = case assocsAtxhair of (_, Actor{btrajectory = Just p, bpos = prPos}) : _-> trajectoryToPath prPos (fst p) _ -> [] shiftedLine = if null shiftedBTrajectory then bline else shiftedBTrajectory acOnPathOrLine :: Char.Char -> Point -> ContentId TileKind -> Color.AttrCharW32 acOnPathOrLine !ch !p0 !tile = let fgOnPathOrLine = case ( ES.member p0 totVisible , Tile.isWalkable coTileSpeedup tile ) of _ | isUknownSpace tile -> Color.BrBlack _ | Tile.isSuspect coTileSpeedup tile -> Color.BrMagenta (True, True) -> Color.BrGreen (True, False) -> Color.BrCyan (False, True) -> Color.Green (False, False) -> Color.Cyan in Color.attrChar2ToW32 fgOnPathOrLine ch mapVTL :: forall s. (Point -> ContentId TileKind -> Color.AttrCharW32) -> [Point] -> FrameST s mapVTL f l v = do let g :: Point -> ST s () g !p0 = do let pI = fromEnum p0 tile = avector U.! pI w = Color.attrCharW32 $ f p0 (toContentId tile) VM.write v (pI + rXmax) w mapM_ g l upd :: FrameForall upd = FrameForall $ \v -> do mapVTL (acOnPathOrLine ';') lpath v mapVTL (acOnPathOrLine '*') shiftedLine v -- overwrites path return upd drawFrameActor :: forall m. MonadClientUI m => LevelId -> m FrameForall drawFrameActor drawnLevelId = do COps{corule=RuleContent{rXmax}} <- getsState scops SessionUI{sactorUI, sselected, sUIOptions} <- getSession -- Not @ScreenContent@, because indexing in level's data. Level{lbig, lproj} <- getLevel drawnLevelId SessionUI{saimMode} <- getSession side <- getsClient sside mleader <- getsClient sleader s <- getState let {-# INLINE viewBig #-} viewBig aid = let Actor{bhp, bfid, btrunk, bwatch} = getActorBody aid s ActorUI{bsymbol, bcolor} = sactorUI EM.! aid Item{jfid} = getItemBody btrunk s symbol | bhp > 0 = bsymbol | otherwise = '%' dominated = maybe False (/= bfid) jfid leaderColor = if isJust saimMode then Color.HighlightYellowAim else Color.HighlightYellow bg = if | mleader == Just aid -> leaderColor | bwatch == WSleep -> Color.HighlightGreen | dominated -> if bfid == side -- dominated by us then Color.HighlightWhite else Color.HighlightMagenta | ES.member aid sselected -> Color.HighlightBlue | otherwise -> Color.HighlightNone fg | bfid /= side || bhp <= 0 = bcolor | otherwise = let (hpCheckWarning, calmCheckWarning) = checkWarnings sUIOptions aid s in if hpCheckWarning || calmCheckWarning then Color.Red else bcolor in Color.attrCharToW32 $ Color.AttrChar Color.Attr{..} symbol {-# INLINE viewProj #-} viewProj as = case as of aid : _ -> let ActorUI{bsymbol, bcolor} = sactorUI EM.! aid bg = Color.HighlightNone fg = bcolor in Color.attrCharToW32 $ Color.AttrChar Color.Attr{..} bsymbol [] -> error $ "lproj not sparse" `showFailure` () mapVAL :: forall a s. (a -> Color.AttrCharW32) -> [(PointI, a)] -> FrameST s {-# INLINE mapVAL #-} mapVAL f l v = do let g :: (PointI, a) -> ST s () g (!pI, !a0) = do let w = Color.attrCharW32 $ f a0 VM.write v (pI + rXmax) w mapM_ g l upd :: FrameForall upd = FrameForall $ \v -> do mapVAL viewProj (IM.assocs $ EM.enumMapToIntMap lproj) v mapVAL viewBig (IM.assocs $ EM.enumMapToIntMap lbig) v -- big actor overlay projectiles return upd drawFrameExtra :: forall m. MonadClientUI m => ColorMode -> LevelId -> m FrameForall drawFrameExtra dm drawnLevelId = do COps{corule=RuleContent{rXmax, rYmax}} <- getsState scops SessionUI{saimMode, smarkVision} <- getSession -- Not @ScreenContent@, because indexing in level's data. totVisible <- totalVisible <$> getPerFid drawnLevelId mxhairPos <- xhairToPos mtgtPos <- do mleader <- getsClient sleader case mleader of Nothing -> return Nothing Just leader -> do mtgt <- getsClient $ getTarget leader getsState $ aidTgtToPos leader drawnLevelId mtgt let visionMarks = if smarkVision then IS.toList $ ES.enumSetToIntSet totVisible else [] backlightVision :: Color.AttrChar -> Color.AttrChar backlightVision ac = case ac of Color.AttrChar (Color.Attr fg _) ch -> Color.AttrChar (Color.Attr fg Color.HighlightGrey) ch writeSquare !hi (Color.AttrChar (Color.Attr fg bg) ch) = let hiUnlessLeader | bg == Color.HighlightYellow = bg | otherwise = hi in Color.AttrChar (Color.Attr fg hiUnlessLeader) ch turnBW (Color.AttrChar _ ch) = Color.AttrChar Color.defAttr ch mapVL :: forall s. (Color.AttrChar -> Color.AttrChar) -> [PointI] -> FrameST s mapVL f l v = do let g :: PointI -> ST s () g !pI = do w0 <- VM.read v (pI + rXmax) let w = Color.attrCharW32 . Color.attrCharToW32 . f . Color.attrCharFromW32 . Color.AttrCharW32 $ w0 VM.write v (pI + rXmax) w mapM_ g l -- Here @rXmax@ and @rYmax@ are correct, because we are not -- turning the whole screen into black&white, but only the level map. lDungeon = [0..rXmax * rYmax - 1] xhairColor = if isJust saimMode then Color.HighlightRedAim else Color.HighlightRed upd :: FrameForall upd = FrameForall $ \v -> do when (isJust saimMode) $ mapVL backlightVision visionMarks v case mtgtPos of Nothing -> return () Just p -> mapVL (writeSquare Color.HighlightGrey) [fromEnum p] v case mxhairPos of -- overwrites target Nothing -> return () Just p -> mapVL (writeSquare xhairColor) [fromEnum p] v when (dm == ColorBW) $ mapVL turnBW lDungeon v return upd drawFrameStatus :: MonadClientUI m => LevelId -> m AttrLine drawFrameStatus drawnLevelId = do cops@COps{corule=RuleContent{rXmax=_rXmax}} <- getsState scops SessionUI{sselected, saimMode, swaitTimes, sitemSel} <- getSession mleader <- getsClient sleader xhairPos <- xhairToPos mbfs <- maybe (return Nothing) (\aid -> Just <$> getCacheBfs aid) mleader (mhairDesc, mxhairHPWatchfulness) <- targetDescXhair lvl <- getLevel drawnLevelId side <- getsClient sside fact <- getsState $ (EM.! side) . sfactionD (mblid, mbpos, mbodyUI) <- case mleader of Just leader -> do Actor{bpos, blid} <- getsState $ getActorBody leader bodyUI <- getsSession $ getActorUI leader return (Just blid, Just bpos, Just bodyUI) Nothing -> return (Nothing, Nothing, Nothing) let widthX = 80 widthTgt = 39 widthStatus = widthX - widthTgt - 1 arenaStatus = drawArenaStatus cops lvl widthStatus leaderStatusWidth = 23 leaderStatus <- drawLeaderStatus swaitTimes (selectedStatusWidth, selectedStatus) <- drawSelected drawnLevelId (widthStatus - leaderStatusWidth) sselected let speedStatusWidth = widthStatus - leaderStatusWidth - selectedStatusWidth speedDisplay <- case mleader of Nothing -> return [] Just leader -> do actorMaxSk <- getsState $ getActorMaxSkills leader kitAssRaw <- getsState $ kitAssocs leader [CEqp, COrgan] let speed = Ability.getSk Ability.SkSpeed actorMaxSk unknownBonus = unknownSpeedBonus $ map (fst . snd) kitAssRaw speedString = displaySpeed speed ++ if unknownBonus then "?" else "" conditionBonus = conditionSpeedBonus $ map snd kitAssRaw cspeed = case compare conditionBonus 0 of EQ -> Color.White GT -> Color.Green LT -> Color.Red return $! map (Color.attrChar2ToW32 cspeed) speedString let speedStatus = if length speedDisplay >= speedStatusWidth then [] else speedDisplay ++ [Color.spaceAttrW32] displayPathText mp mt = let (plen, llen) | Just target <- mp , Just bfs <- mbfs , Just bpos <- mbpos , mblid == Just drawnLevelId = ( fromMaybe 0 (accessBfs bfs target) , chessDist bpos target ) | otherwise = (0, 0) pText | plen == 0 = "" | otherwise = "p" <> tshow plen lText | llen == 0 = "" | otherwise = "l" <> tshow llen text = fromMaybe (pText <+> lText) mt in if T.null text then "" else " " <> text -- The indicators must fit, they are the actual information. pathCsr = displayPathText xhairPos (fst <$> mxhairHPWatchfulness) trimTgtDesc n t = assert (not (T.null t) && n > 2 `blame` (t, n)) $ if T.length t <= n then t else T.take (n - 3) t <> "..." -- The indicators must fit, they are the actual information. widthXhairOrItem = widthTgt - T.length pathCsr - 8 nMember = MU.Ord $ 1 + sum (EM.elems $ gvictims fact) fallback = if MK.fleaderMode (gplayer fact) == MK.LeaderNull then "This faction never picks a leader" else makePhrase ["Waiting for", nMember, "team member to spawn"] leaderName bUI = trimTgtDesc (widthTgt - 8) (bname bUI) leaderBlurbLong = maybe fallback (\bUI -> "Leader:" <+> leaderName bUI) mbodyUI leaderBlurbShort = maybe fallback leaderName mbodyUI ours <- getsState $ fidActorNotProjGlobalAssocs side let na = length ours nl = ES.size $ ES.fromList $ map (blid . snd) ours ns = EM.size $ gsha fact -- To be replaced by something more useful. teamBlurb = textToAL $ trimTgtDesc widthTgt $ makePhrase [ "Team:" , MU.CarWs na "actor", "on" , MU.CarWs nl "level" <> "," , "stash", MU.Car ns ] markSleepTgtDesc | (snd <$> mxhairHPWatchfulness) /= Just WSleep = textToAL | otherwise = textFgToAL Color.Green xhairBlurb = maybe teamBlurb (\t -> textToAL (if isJust saimMode then "x-hair>" else "X-hair:") <+:> markSleepTgtDesc (trimTgtDesc widthXhairOrItem t)) mhairDesc tgtOrItem | Just (iid, fromCStore, _) <- sitemSel , Just leader <- mleader = do b <- getsState $ getActorBody leader bag <- getsState $ getBodyStoreBag b fromCStore case iid `EM.lookup` bag of Nothing -> return (xhairBlurb, pathCsr) Just kit@(k, _) -> do localTime <- getsState $ getLocalTime (blid b) itemFull <- getsState $ itemToFull iid factionD <- getsState sfactionD let (name, powers) = partItem (bfid b) factionD localTime itemFull kit t = makePhrase [MU.Car1Ws k name, powers] return (textToAL $ "Item:" <+> trimTgtDesc (widthTgt - 6) t, "") | otherwise = return (xhairBlurb, pathCsr) (xhairLine, pathXhairOrNull) <- tgtOrItem damageStatus <- maybe (return []) (drawLeaderDamage widthTgt) mleader let damageStatusWidth = length damageStatus withForLeader = widthTgt - damageStatusWidth - 1 leaderBottom = if | T.length leaderBlurbShort > withForLeader -> "" | T.length leaderBlurbLong > withForLeader -> leaderBlurbShort | otherwise -> leaderBlurbLong damageGap = emptyAttrLine $ widthTgt - damageStatusWidth - T.length leaderBottom xhairGap = emptyAttrLine (widthTgt - T.length pathXhairOrNull - length xhairLine) xhairStatus = xhairLine ++ xhairGap ++ textToAL pathXhairOrNull selectedGap = emptyAttrLine (widthStatus - leaderStatusWidth - selectedStatusWidth - length speedStatus) status = arenaStatus <+:> xhairStatus <> selectedStatus ++ selectedGap ++ speedStatus ++ leaderStatus <+:> (textToAL leaderBottom ++ damageGap ++ damageStatus) -- Keep it at least partially lazy, to avoid allocating the whole list: return #ifdef WITH_EXPENSIVE_ASSERTIONS $ assert (length status == 2 * _rXmax `blame` map Color.charFromW32 status) #endif status -- | Draw the whole screen: level map and status area. drawHudFrame :: MonadClientUI m => ColorMode -> LevelId -> m PreFrame drawHudFrame dm drawnLevelId = do baseTerrain <- drawFrameTerrain drawnLevelId updContent <- drawFrameContent drawnLevelId updPath <- drawFramePath drawnLevelId updActor <- drawFrameActor drawnLevelId updExtra <- drawFrameExtra dm drawnLevelId let upd = FrameForall $ \v -> do unFrameForall updContent v -- vty frontend is screen-reader friendly, so avoid visual fluff unless (frontendName == "vty") $ unFrameForall updPath v unFrameForall updActor v unFrameForall updExtra v return (baseTerrain, upd) -- Comfortably accomodates 3-digit level numbers and 25-character -- level descriptions (currently enforced max). drawArenaStatus :: COps -> Level -> Int -> AttrLine drawArenaStatus COps{cocave} Level{lkind, ldepth=Dice.AbsDepth ld, lseen, lexpl} width = let ck = okind cocave lkind seenN = 100 * lseen `div` max 1 lexpl seenTxt | seenN >= 100 = "all" | otherwise = T.justifyLeft 3 ' ' (tshow seenN <> "%") lvlN = T.justifyLeft 2 ' ' (tshow ld) seenStatus = "[" <> seenTxt <+> "seen]" in textToAL $ T.justifyLeft width ' ' $ T.take 29 (lvlN <+> T.justifyLeft 26 ' ' (cname ck)) <+> seenStatus drawLeaderStatus :: MonadClientUI m => Int -> m AttrLine drawLeaderStatus waitT = do time <- getsState stime let calmHeaderText = "Calm" hpHeaderText = "HP" slashes = ["/", "|", "\\", "|"] waitGlobal = timeFit time timeTurn sUIOptions <- getsSession sUIOptions mleader <- getsClient sleader case mleader of Just leader -> do b <- getsState $ getActorBody leader actorMaxSk <- getsState $ getActorMaxSkills leader (hpCheckWarning, calmCheckWarning) <- getsState $ checkWarnings sUIOptions leader bdark <- getsState $ \s -> not (actorInAmbient b s) let showTrunc x = let t = show x in if length t > 3 then if x > 0 then "***" else "---" else t waitSlash | bwatch b == WSleep = waitGlobal | otherwise = abs waitT -- This is a valuable feedback for the otherwise hard to observe -- 'wait' command or for passing of time when sole leader sleeps. slashPick = slashes !! (max 0 waitSlash `mod` length slashes) addColor c = map (Color.attrChar2ToW32 c) checkDelta ResDelta{..} | fst resCurrentTurn < 0 || fst resPreviousTurn < 0 = addColor Color.BrRed -- alarming news have priority | snd resCurrentTurn > 0 || snd resPreviousTurn > 0 = addColor Color.BrGreen | otherwise = stringToAL -- only if nothing at all noteworthy checkSleep body resDelta | bwatch body == WSleep = addColor Color.Green | otherwise = checkDelta resDelta calmAddAttr = checkSleep b $ bcalmDelta b -- We only show ambient light, because in fact client can't tell -- if a tile is lit, because it it's seen it may be due to ambient -- or dynamic light or due to infravision. darkPick | bdark = "." | otherwise = ":" calmHeader = calmAddAttr $ calmHeaderText <> darkPick calmText = showTrunc (bcalm b `divUp` oneM) <> (if bdark then slashPick else "/") <> showTrunc (max 0 $ Ability.getSk Ability.SkMaxCalm actorMaxSk) bracePick | actorWaits b = "}" | otherwise = ":" hpAddAttr = checkDelta $ bhpDelta b hpHeader = hpAddAttr $ hpHeaderText <> bracePick hpText = showTrunc (bhp b `divUp` oneM) <> (if not bdark then slashPick else "/") <> showTrunc (max 0 $ Ability.getSk Ability.SkMaxHP actorMaxSk) justifyRight n t = replicate (n - length t) ' ' ++ t colorWarning w = if w then addColor Color.Red else stringToAL return $! calmHeader <> colorWarning calmCheckWarning (justifyRight 7 calmText) <+:> hpHeader <> colorWarning hpCheckWarning (justifyRight 7 hpText) Nothing -> do -- This is a valuable feedback for passing of time while faction -- leaderless and especially while temporarily actor-less.. let slashPick = slashes !! (max 0 waitGlobal `mod` length slashes) return $! stringToAL (calmHeaderText ++ ": --" ++ slashPick ++ "--") <+:> stringToAL (hpHeaderText <> ": --/--") drawLeaderDamage :: MonadClientUI m => Int -> ActorId -> m AttrLine drawLeaderDamage width leader = do kitAssRaw <- getsState $ kitAssocs leader [CEqp, COrgan] actorSk <- leaderSkillsClientUI actorMaxSk <- getsState $ getActorMaxSkills leader let hasTimeout itemFull = let arItem = aspectRecordFull itemFull timeout = IA.aTimeout arItem in timeout > 0 hasEffect itemFull = any IK.forApplyEffect $ IK.ieffects $ itemKind itemFull ppDice :: (Int, ItemFullKit) -> [(Bool, AttrLine)] ppDice (nch, (itemFull, (k, _))) = let tdice = show $ IK.idamage $ itemKind itemFull tdiceEffect = if hasEffect itemFull then map Char.toUpper tdice else tdice in if hasTimeout itemFull then replicate (k - nch) (False, map (Color.attrChar2ToW32 Color.Cyan) tdiceEffect) ++ replicate nch (True, map (Color.attrChar2ToW32 Color.BrCyan) tdiceEffect) else [(True, map (Color.attrChar2ToW32 Color.BrBlue) tdiceEffect)] lbonus :: AttrLine lbonus = let bonusRaw = Ability.getSk Ability.SkHurtMelee actorMaxSk bonus = min 200 $ max (-200) bonusRaw unknownBonus = unknownMeleeBonus $ map (fst . snd) kitAssRaw tbonus = if bonus == 0 then if unknownBonus then "+?" else "" else (if bonus > 0 then "+" else "") <> show bonus <> (if bonus /= bonusRaw then "$" else "") <> if unknownBonus then "%?" else "%" conditionBonus = conditionMeleeBonus $ map snd kitAssRaw cbonus = case compare conditionBonus 0 of EQ -> Color.White GT -> Color.Green LT -> Color.Red in map (Color.attrChar2ToW32 cbonus) tbonus let kitAssOnlyWeapons = filter (IA.checkFlag Ability.Meleeable . aspectRecordFull . fst . snd) kitAssRaw discoBenefit <- getsClient sdiscoBenefit strongest <- map (second snd . snd) <$> pickWeaponM True (Just discoBenefit) kitAssOnlyWeapons actorSk leader let (lT, lRatherNoT) = span (hasTimeout . fst . snd) strongest strongestToDisplay = lT ++ take 1 lRatherNoT lToDisplay = concatMap ppDice strongestToDisplay (ldischarged, lrest) = span (not . fst) lToDisplay lWithBonus = case map snd lrest of [] -> [] -- unlikely; means no timeout-free organ l1 : rest -> (l1 ++ lbonus) : rest lFlat = intercalate [Color.spaceAttrW32] $ map snd ldischarged ++ lWithBonus lFits = if length lFlat > width then take (width - 3) lFlat ++ stringToAL "..." else lFlat return $! lFits drawSelected :: MonadClientUI m => LevelId -> Int -> ES.EnumSet ActorId -> m (Int, AttrLine) drawSelected drawnLevelId width selected = do mleader <- getsClient sleader side <- getsClient sside sactorUI <- getsSession sactorUI ours <- getsState $ filter (not . bproj . snd) . inline actorAssocs (== side) drawnLevelId let oursUI = map (\(aid, b) -> (aid, b, sactorUI EM.! aid)) ours viewOurs (aid, Actor{bhp, bwatch}, ActorUI{bsymbol, bcolor}) = -- Sleep considered before being selected, because sleeping -- actors can't move, so selection is mostly irrelevant. -- Domination not considered at all, because map already shows it -- and so here is the only place where selection is conveyed. let bg = if | mleader == Just aid -> Color.HighlightYellow | bwatch == WSleep -> Color.HighlightGreen | ES.member aid selected -> Color.HighlightBlue | otherwise -> Color.HighlightNone sattr = Color.Attr {Color.fg = bcolor, bg} in Color.attrCharToW32 $ Color.AttrChar sattr $ if bhp > 0 then bsymbol else '%' maxViewed = width - 2 len = length oursUI star = let fg = case ES.size selected of 0 -> Color.BrBlack n | n == len -> Color.BrWhite _ -> Color.defFG char = if len > maxViewed then '$' else '*' in Color.attrChar2ToW32 fg char viewed = map viewOurs $ take maxViewed $ sortOn keySelected oursUI return (min width (len + 2), [star] ++ viewed ++ [Color.spaceAttrW32]) checkWarningHP :: UIOptions -> ActorId -> Int64 -> State -> Bool checkWarningHP UIOptions{uhpWarningPercent} leader hp s = let actorMaxSk = getActorMaxSkills leader s maxHp = Ability.getSk Ability.SkMaxHP actorMaxSk in hp <= xM (uhpWarningPercent * maxHp `div` 100) checkWarningCalm :: UIOptions -> ActorId -> Int64 -> State -> Bool checkWarningCalm UIOptions{uhpWarningPercent} leader calm s = let b = getActorBody leader s actorMaxSk = getActorMaxSkills leader s isImpression iid = maybe False (> 0) $ lookup "impressed" $ IK.ifreq $ getIidKind iid s isImpressed = any isImpression $ EM.keys $ borgan b maxCalm = Ability.getSk Ability.SkMaxCalm actorMaxSk in calm <= xM (uhpWarningPercent * maxCalm `div` 100) && isImpressed checkWarnings :: UIOptions -> ActorId -> State -> (Bool, Bool) checkWarnings uiOptions leader s = let b = getActorBody leader s in ( checkWarningHP uiOptions leader (bhp b) s , checkWarningCalm uiOptions leader (bcalm b) s ) LambdaHack-0.9.5.0/engine-src/Game/LambdaHack/Client/UI/EffectDescription.hs0000644000000000000000000004633107346545000024373 0ustar0000000000000000-- | Description of effects. module Game.LambdaHack.Client.UI.EffectDescription ( DetailLevel(..), effectToSuffix, detectToObject, detectToVerb , skillName, skillDesc, skillToDecorator, skillSlots , kindAspectToSuffix, aspectToSentence, affixDice #ifdef EXPOSE_INTERNAL -- * Internal operations , slotToSentence, tmodToSuff, affixBonus, wrapInParens, wrapInChevrons #endif ) where import Prelude () import Game.LambdaHack.Core.Prelude import qualified Data.Text as T import qualified NLP.Miniutter.English as MU import Game.LambdaHack.Common.Actor import Game.LambdaHack.Common.Misc import Game.LambdaHack.Common.Time import Game.LambdaHack.Content.ItemKind import qualified Game.LambdaHack.Core.Dice as Dice import Game.LambdaHack.Definition.Ability import Game.LambdaHack.Definition.Defs data DetailLevel = DetailNone | DetailLow | DetailMedium | DetailHigh | DetailAll deriving (Eq, Ord, Enum, Bounded) -- | Suffix to append to a basic content name if the content causes the effect. -- -- We show absolute time in seconds, not @moves@, because actors can have -- different speeds (and actions can potentially take different time intervals). -- We call the time taken by one player move, when walking, a @move@. -- @Turn@ and @clip@ are used mostly internally, the former as an absolute -- time unit. -- We show distances in @steps@, because one step, from a tile to another -- tile, is always 1 meter. We don't call steps @tiles@, reserving -- that term for the context of terrain kinds or units of area. effectToSuffix :: DetailLevel -> Effect -> Text effectToSuffix detailLevel effect = case effect of Burn d -> wrapInParens (tshow d <+> if Dice.supDice d > 1 then "burns" else "burn") Explode t -> "of" <+> fromGroupName t <+> "explosion" RefillHP p | p > 0 -> "of healing" <+> wrapInParens (affixBonus p) RefillHP 0 -> error $ "" `showFailure` effect RefillHP p -> "of wounding" <+> wrapInParens (affixBonus p) RefillCalm p | p > 0 -> "of soothing" <+> wrapInParens (affixBonus p) RefillCalm 0 -> error $ "" `showFailure` effect RefillCalm p -> "of dismaying" <+> wrapInParens (affixBonus p) Dominate -> "of domination" Impress -> "of impression" PutToSleep -> "of sleep" Yell -> "of alarm" -- minor, but if under timeout, differentiates items Summon grp d -> makePhrase [ "of summoning" , if Dice.supDice d <= 1 then "" else MU.Text $ tshow d , MU.Ws $ MU.Text $ fromGroupName grp ] ApplyPerfume -> "of smell removal" Ascend True -> "of ascending" Ascend False -> "of descending" Escape{} -> "of escaping" Paralyze dice -> let time = case Dice.reduceDice dice of Nothing -> tshow dice <+> "* 0.05s" Just p -> let dt = timeDeltaScale (Delta timeClip) p in timeDeltaInSecondsText dt in "of paralysis for" <+> time ParalyzeInWater dice -> let time = case Dice.reduceDice dice of Nothing -> tshow dice <+> "* 0.05s" Just p -> let dt = timeDeltaScale (Delta timeClip) p in timeDeltaInSecondsText dt in "of retardation for" <+> time InsertMove dice -> let moves = case Dice.reduceDice dice of Nothing -> tshow dice <+> "tenths of a move" Just p -> let (d, m) = p `divMod` 10 in if m == 0 then makePhrase [MU.CarWs d "move"] else makePhrase [MU.Car1Ws p "tenth", "of a move"] in "of speed surge for" <+> moves Teleport dice | Dice.supDice dice <= 9 -> "of blinking" <+> wrapInParens (tshow dice) Teleport dice -> "of teleport" <+> wrapInParens (tshow dice) CreateItem COrgan grp tim -> let stime = if isTimerNone tim then "" else "for" <+> tshow tim <> ":" in "(keep" <+> stime <+> fromGroupName grp <> ")" CreateItem{} -> "of gain" DropItem n k store grp -> let (preT, postT) = if | n == 1 && k == maxBound -> ("one", "kind") | n == maxBound && k == maxBound -> ("all", "kinds") | otherwise -> ("", "") (verb, fromStore) = if store == COrgan then ("nullify", "") else ("drop", "from" <+> snd (ppCStore store)) in "of" <+> verb <+> preT <+> fromGroupName grp <+> postT <+> fromStore PolyItem -> "of repurpose on the ground" RerollItem -> "of deeply reshape on the ground" DupItem -> "of multiplication on the ground" Identify -> "of identify" Detect d radius -> "of" <+> detectToObject d <+> "location" <+> wrapInParens (tshow radius) SendFlying tmod -> "of impact" <+> tmodToSuff "" tmod PushActor tmod -> "of pushing" <+> tmodToSuff "" tmod PullActor tmod -> "of pulling" <+> tmodToSuff "" tmod DropBestWeapon -> "of disarming" ActivateInv ' ' -> "of backpack burst" ActivateInv symbol -> "of burst '" <> T.singleton symbol <> "'" OneOf l -> let subject = if length l <= 5 then "marvel" else "wonder" header = makePhrase ["of", MU.CardinalWs (length l) subject] marvels = T.intercalate ", " $ map (effectToSuffix detailLevel) l in if detailLevel >= DetailAll && marvels /= "" then header <+> "[" <> marvels <> "]" else header -- of no wonders :) OnSmash _ -> "" -- printed inside a separate section VerbNoLonger _ -> "" -- no description for a flavour effect VerbMsg _ -> "" -- no description for an effect that prints a description Composite effs -> T.intercalate " and then " $ filter (/= "") $ map (effectToSuffix detailLevel) effs detectToObject :: DetectKind -> Text detectToObject d = case d of DetectAll -> "detail" DetectActor -> "intruder" DetectLoot -> "merchandise" DetectExit -> "exit" DetectHidden -> "secret" DetectEmbed -> "feature" detectToVerb :: DetectKind -> Text detectToVerb d = case d of DetectAll -> "map all" DetectActor -> "spot nearby" DetectLoot -> "locate nearby" DetectExit -> "learn nearby" DetectHidden -> "uncover nearby" DetectEmbed -> "notice nearby" slotToSentence :: EqpSlot -> Text slotToSentence es = case es of EqpSlotMove -> "Those unskilled in locomotion equip it." EqpSlotMelee -> "Those unskilled in close combat equip it." EqpSlotDisplace -> "Those unskilled in moving in crowds equip it." EqpSlotAlter -> "Those unskilled in terrain alteration equip it." EqpSlotWait -> "Those unskilled in watchfulness equip it." EqpSlotMoveItem -> "Those unskilled in inventory management equip it." EqpSlotProject -> "Those unskilled in item flinging equip it." EqpSlotApply -> "Those unskilled in applying items equip it." EqpSlotSwimming -> "Useful to any that wade or swim in water." EqpSlotFlying -> "Those not afraid to fly, put it on." EqpSlotHurtMelee -> "Veteran melee fighters are known to devote equipment slot to it." EqpSlotArmorMelee -> "Worn by people in risk of melee wounds." EqpSlotArmorRanged -> "People scared of shots in the dark wear it." EqpSlotMaxHP -> "The frail wear it to increase their Hit Point capacity." EqpSlotSpeed -> "The sluggish equip it to speed up their whole life." EqpSlotSight -> "The short-sighted wear it to notice their demise sooner." EqpSlotShine -> "Explorers brave enough to highlight themselves put it in their equipment." EqpSlotMiscBonus -> "Those that don't scorn minor bonuses may equip it." EqpSlotWeaponFast -> "Close range fighters pick it as their mainstay weapon." EqpSlotWeaponBig -> "Close range fighters pick it as their opening weapon." skillName :: Skill -> Text skillName SkMove = "move stat" skillName SkMelee = "melee stat" skillName SkDisplace = "displace stat" skillName SkAlter = "alter tile stat" skillName SkWait = "wait stat" skillName SkMoveItem = "manage items stat" skillName SkProject = "fling stat" skillName SkApply = "apply stat" skillName SkSwimming = "swimming" skillName SkFlying = "flying" skillName SkHurtMelee = "to melee damage" skillName SkArmorMelee = "melee armor" skillName SkArmorRanged = "ranged armor" skillName SkMaxHP = "max HP" skillName SkMaxCalm = "max Calm" skillName SkSpeed = "speed" skillName SkSight = "sight radius" skillName SkSmell = "smell radius" skillName SkShine = "shine radius" skillName SkNocto = "night vision radius" skillName SkHearing = "hearing radius" skillName SkAggression = "aggression level" skillName SkOdor = "odor level" skillDesc :: Skill -> Text skillDesc skill = let skName = skillName skill capSkillName = "The '" <> skName <> "' skill" capStatName = "The '" <> T.unwords (init $ T.words skName) <> "' stat" in case skill of SkMove -> capStatName <+> "determines whether the character can move. Actors not capable of movement can't be dominated." SkMelee -> capStatName <+> "determines whether the character can melee. Actors that can't melee can still cause damage by flinging missiles or by ramming (being pushed) at opponents." SkDisplace -> capStatName <+> "determines whether the character can displace adjacent actors. In some cases displacing is not possible regardless of skill: when the target is braced, dying, has no move skill or when both actors are supported by adjacent friendly units. Missiles can be displaced always, unless more than one occupies the map location." SkAlter -> capStatName <+> "determines which kinds of terrain can be altered or triggered by the character. Opening doors and searching suspect tiles require skill 2, some stairs require 3, closing doors requires 4, others require 4 or 5. Actors not smart enough to be capable of using stairs can't be dominated." SkWait -> capStatName <+> "determines whether the character can wait, brace for combat (potentially blocking the effects of some attacks), sleep and lurk." SkMoveItem -> capStatName <+> "determines whether the character can pick up items and manage inventory." SkProject -> capStatName <+> "determines which kinds of items the character can propel. Items that can be lobbed to explode at a precise location, such as flasks, require skill 3. Other items travel until they meet an obstacle and skill 1 is enough to fling them. In some cases, e.g., of too intricate or two awkward items at low Calm, throwing is not possible regardless of the skill value." SkApply -> capStatName <+> "determines which kinds of items the character can activate. Items that assume literacy require skill 2, others can be used already at skill 1. In some cases, e.g., when the item needs recharging, has no possible effects or is too intricate for the character Calm level, applying may not be possible." SkSwimming -> capSkillName <+> "is the degree of avoidance of bad effects of terrain containing water, whether shallow or deep." SkFlying -> capSkillName <+> "is the degree of avoidance of bad effects of any hazards spread on the ground." SkHurtMelee -> capSkillName <+> "is a percentage of additional damage dealt by the actor (either a character or a missile) with any weapon. The value is capped at 200%, then the armor percentage of the defender is subtracted from it and the resulting total is capped at 99%." SkArmorMelee -> capSkillName <+> "is a percentage of melee damage avoided by the actor. The value is capped at 200%, then the extra melee damage percentage of the attacker is subtracted from it and the resulting total is capped at 99% (always at least 1% of damage gets through). It includes 50% bonus from being braced for combat, if applicable." SkArmorRanged -> capSkillName <+> "is a percentage of ranged damage avoided by the actor. The value is capped at 200%, then the extra melee damage percentage of the attacker is subtracted from it and the resulting total is capped at 99% (always at least 1% of damage gets through). It includes 25% bonus from being braced for combat, if applicable." SkMaxHP -> capSkillName <+> "is a cap on HP of the actor, except for some rare effects able to overfill HP. At any direct enemy damage (but not, e.g., incremental poisoning damage or wounds inflicted by mishandling a device) HP is cut back to the cap." SkMaxCalm -> capSkillName <+> "is a cap on Calm of the actor, except for some rare effects able to overfill Calm. At any direct enemy damage (but not, e.g., incremental poisoning damage or wounds inflicted by mishandling a device) Calm is lowered, sometimes very significantly and always at least back down to the cap." SkSpeed -> capSkillName <+> "is expressed in meters per second, which corresponds to map location (1m by 1m) per two standard turns (0.5s each). Thus actor at standard speed of 2m/s moves one location per standard turn." SkSight -> capSkillName <+> "is the limit of visibility in light. The radius is measured from the middle of the map location occupied by the character to the edge of the furthest covered location." SkSmell -> capSkillName <+> "determines the maximal area smelled by the actor. The radius is measured from the middle of the map location occupied by the character to the edge of the furthest covered location." SkShine -> capSkillName <+> "determines the maximal area lit by the actor. The radius is measured from the middle of the map location occupied by the character to the edge of the furthest covered location." SkNocto -> capSkillName <+> "is the limit of visibility in dark. The radius is measured from the middle of the map location occupied by the character to the edge of the furthest covered location." SkHearing -> capSkillName <+> "is the limit of hearing. The radius is measured from the middle of the map location occupied by the character to the edge of the furthest covered location." SkAggression -> "The '" <> skName <> "' property" <+> "represents the willingness of the actor to engage in combat, especially close quarters, and conversely, to break engagement when overpowered." SkOdor -> "The '" <> skName <> "' property" <+> "represents the ability to communicate (more specifically, communicate one's presence) through personal odor. Zero or less means the odor is not trackable." skillToDecorator :: Skill -> Actor -> Int -> Text skillToDecorator skill b t = let tshow200 n = let n200 = min 200 $ max (-200) n in tshow n200 <> if n200 /= n then "$" else "" -- Some values can be negative, for others 0 is equivalent but shorter. tshowRadius r = case compare r 0 of GT -> tshow (r - 1) <> ".5m" EQ -> "0m" LT -> tshow (r + 1) <> ".5m" in case skill of SkMove -> tshow t SkMelee -> tshow t SkDisplace -> tshow t SkAlter -> tshow t SkWait -> tshow t SkMoveItem -> tshow t SkProject -> tshow t SkApply -> tshow t SkSwimming -> tshow t SkFlying -> tshow t SkHurtMelee -> tshow200 t <> "%" SkArmorMelee -> "[" <> tshow200 t <> "%]" SkArmorRanged -> "{" <> tshow200 t <> "%}" SkMaxHP -> tshow $ max 0 t SkMaxCalm -> tshow $ max 0 t SkSpeed -> T.pack $ displaySpeed t SkSight -> let tcapped = min (fromEnum $ bcalm b `div` xM 5) t in tshowRadius tcapped <+> if tcapped == t then "" else "(max" <+> tshowRadius t <> ")" SkSmell -> tshowRadius t SkShine -> tshowRadius t SkNocto -> tshowRadius t SkHearing -> tshowRadius t SkAggression -> tshow t SkOdor -> tshow t skillSlots :: [Skill] skillSlots = [minBound .. maxBound] tmodToSuff :: Text -> ThrowMod -> Text tmodToSuff verb ThrowMod{..} = let vSuff | throwVelocity == 100 = "" | otherwise = "v=" <> tshow throwVelocity <> "%" tSuff | throwLinger == 100 = "" | otherwise = "t=" <> tshow throwLinger <> "%" hSuff | throwHP == 1 = "" | otherwise = "pierce=" <> tshow throwHP in if vSuff == "" && tSuff == "" && hSuff == "" then "" else verb <+> "with" <+> vSuff <+> tSuff <+> hSuff kindAspectToSuffix :: Aspect -> Text kindAspectToSuffix aspect = case aspect of Timeout{} -> "" -- printed specially AddSkill SkMove t -> wrapInParens $ affixDice t <+> "move" AddSkill SkMelee t -> wrapInParens $ affixDice t <+> "melee" AddSkill SkDisplace t -> wrapInParens $ affixDice t <+> "displace" AddSkill SkAlter t -> wrapInParens $ affixDice t <+> "alter" AddSkill SkWait t -> wrapInParens $ affixDice t <+> "wait" AddSkill SkMoveItem t -> wrapInParens $ affixDice t <+> "manage items" AddSkill SkProject t -> wrapInParens $ affixDice t <+> "fling" AddSkill SkApply t -> wrapInParens $ affixDice t <+> "apply" AddSkill SkSwimming t -> wrapInParens $ affixDice t <+> "swimming" AddSkill SkFlying t -> wrapInParens $ affixDice t <+> "flying" AddSkill SkHurtMelee _ -> "" -- printed together with dice, even if dice is zero AddSkill SkArmorMelee t -> "[" <> affixDice t <> "%]" AddSkill SkArmorRanged t -> "{" <> affixDice t <> "%}" AddSkill SkMaxHP t -> wrapInParens $ affixDice t <+> "HP" AddSkill SkMaxCalm t -> wrapInParens $ affixDice t <+> "Calm" AddSkill SkSpeed t -> wrapInParens $ affixDice t <+> "speed" AddSkill SkSight t -> wrapInParens $ affixDice t <+> "sight" AddSkill SkSmell t -> wrapInParens $ affixDice t <+> "smell" AddSkill SkShine t -> wrapInParens $ affixDice t <+> "shine" AddSkill SkNocto t -> wrapInParens $ affixDice t <+> "night vision" AddSkill SkHearing t -> wrapInParens $ affixDice t <+> "hearing" AddSkill SkAggression t -> wrapInParens $ affixDice t <+> "aggression" AddSkill SkOdor t -> wrapInParens $ affixDice t <+> "odor" SetFlag Fragile -> wrapInChevrons "fragile" SetFlag Lobable -> wrapInChevrons "can be lobbed" SetFlag Durable -> wrapInChevrons "durable" SetFlag Equipable -> "" SetFlag Meleeable -> "" SetFlag Precious -> "" SetFlag Blast -> "" SetFlag Condition -> "" SetFlag Unique -> "" -- marked by capital letters in name SetFlag Periodic -> "" -- printed specially SetFlag MinorEffects -> "" -- cryptic override ELabel{} -> "" -- too late ToThrow tmod -> wrapInChevrons $ tmodToSuff "flies" tmod HideAs{} -> "" EqpSlot{} -> "" -- used in @slotToSentence@ instead Odds{} -> "" aspectToSentence :: Aspect -> Maybe Text aspectToSentence feat = case feat of Timeout{} -> Nothing AddSkill{} -> Nothing SetFlag Fragile -> Nothing SetFlag Lobable -> Nothing SetFlag Durable -> Nothing SetFlag Equipable -> Nothing SetFlag Meleeable -> Just "It is considered for melee strikes by default." SetFlag Precious -> Just "It seems precious." SetFlag Blast -> Nothing SetFlag Condition -> Nothing SetFlag Unique -> Nothing SetFlag Periodic -> Nothing SetFlag MinorEffects -> Nothing ELabel{} -> Nothing ToThrow{} -> Nothing HideAs{} -> Nothing EqpSlot es -> Just $ slotToSentence es Odds{} -> Just "Individual specimens sometimes have yet other properties." affixBonus :: Int -> Text affixBonus p = case compare p 0 of EQ -> "0" LT -> tshow p GT -> "+" <> tshow p wrapInParens :: Text -> Text wrapInParens "" = "" wrapInParens t = "(" <> t <> ")" wrapInChevrons :: Text -> Text wrapInChevrons "" = "" wrapInChevrons t = "<" <> t <> ">" affixDice :: Dice.Dice -> Text affixDice d = maybe "+?" affixBonus $ Dice.reduceDice d LambdaHack-0.9.5.0/engine-src/Game/LambdaHack/Client/UI/Frame.hs0000644000000000000000000001161507346545000022022 0ustar0000000000000000{-# LANGUAGE RankNTypes, TypeFamilies #-} -- | Screen frames. module Game.LambdaHack.Client.UI.Frame ( FrameST, FrameForall(..), FrameBase(..), Frame, PreFrame, PreFrames , SingleFrame(..) , blankSingleFrame, overlayFrame, overlayFrameWithLines #ifdef EXPOSE_INTERNAL -- * Internal operations , truncateAttrLine #endif ) where import Prelude () import Game.LambdaHack.Core.Prelude import Control.Monad.ST.Strict import qualified Data.Vector.Generic as G import qualified Data.Vector.Unboxed as U import qualified Data.Vector.Unboxed.Mutable as VM import Data.Word import Game.LambdaHack.Client.UI.Content.Screen import Game.LambdaHack.Client.UI.Overlay import qualified Game.LambdaHack.Common.PointArray as PointArray import qualified Game.LambdaHack.Definition.Color as Color import Game.LambdaHack.Definition.Defs type FrameST s = G.Mutable U.Vector s Word32 -> ST s () -- | Efficiently composable representation of an operation -- on a frame, that is, on a mutable vector. When the composite operation -- is eventually performed, the vector is frozen to become a 'SingleFrame'. newtype FrameForall = FrameForall {unFrameForall :: forall s. FrameST s} -- | Action that results in a base frame, to be modified further. newtype FrameBase = FrameBase {unFrameBase :: forall s. ST s (G.Mutable U.Vector s Word32)} -- | A frame, that is, a base frame and all its modifications. type Frame = (FrameBase, FrameForall) -- | Components of a frame, before it's decided if the first can be overwritten -- in-place or needs to be copied. type PreFrame = (U.Vector Word32, FrameForall) -- | Sequence of screen frames, including delays. Potentially based on a single -- base frame. type PreFrames = [Maybe PreFrame] -- | Representation of an operation of overwriting a frame with a single line -- at the given row. writeLine :: Int -> AttrLine -> FrameForall {-# INLINE writeLine #-} writeLine offset l = FrameForall $ \v -> do let writeAt _ [] = return () writeAt off (ac32 : rest) = do VM.write v off (Color.attrCharW32 ac32) writeAt (off + 1) rest writeAt offset l -- | An overlay that fits on the screen (or is meant to be truncated on display) -- and is padded to fill the whole screen -- and is displayed as a single game screen frame. -- -- Note that we don't provide a list of color-highlighed positions separately, -- because overlays need to obscure not only map, but the highlights as well. newtype SingleFrame = SingleFrame {singleFrame :: PointArray.Array Color.AttrCharW32} deriving (Eq, Show) blankSingleFrame :: ScreenContent -> SingleFrame blankSingleFrame ScreenContent{rwidth, rheight} = SingleFrame $ PointArray.replicateA rwidth rheight Color.spaceAttrW32 -- | Truncate the overlay: for each line, if it's too long, it's truncated -- and if there are too many lines, excess is dropped and warning is appended. truncateLines :: ScreenContent -> Bool -> Overlay -> Overlay truncateLines ScreenContent{rwidth, rheight} onBlank l = let canvasLength = if onBlank then rheight else rheight - 2 topLayer = if length l <= canvasLength then l ++ [[] | length l < canvasLength && length l > 3] else take (canvasLength - 1) l ++ [stringToAL "--a portion of the text trimmed--"] f lenPrev lenNext layerLine = truncateAttrLine rwidth layerLine (max lenPrev lenNext) lens = map (min (rwidth - 1) . length) topLayer in zipWith3 f (0 : lens) (drop 1 lens ++ [0]) topLayer -- | Add a space at the message end, for display overlayed over the level map. -- Also trim (do not wrap!) too long lines. truncateAttrLine :: X -> AttrLine -> X -> AttrLine truncateAttrLine w xs lenMax = case compare w (length xs) of LT -> let discarded = drop w xs in if all (== Color.spaceAttrW32) discarded then take w xs else take (w - 1) xs ++ [Color.attrChar2ToW32 Color.BrBlack '$'] EQ -> xs GT -> let xsSpace = if | null xs -> xs | last xs == Color.spaceAttrW32 -> xs ++ [Color.spaceAttrW32] | otherwise -> xs ++ [Color.spaceAttrW32, Color.spaceAttrW32] whiteN = max (40 - length xsSpace) (1 + lenMax - length xsSpace) in xsSpace ++ replicate whiteN Color.spaceAttrW32 -- | Overlays either the game map only or the whole empty screen frame. -- We assume the lines of the overlay are not too long nor too many. overlayFrame :: IntOverlay -> PreFrame -> PreFrame overlayFrame ov (m, ff) = (m, FrameForall $ \v -> do unFrameForall ff v mapM_ (\(offset, l) -> unFrameForall (writeLine offset l) v) ov) overlayFrameWithLines :: ScreenContent -> Bool -> Overlay -> PreFrame -> PreFrame overlayFrameWithLines coscreen@ScreenContent{rwidth} onBlank l fr = let ov = map (\(y, al) -> (y * rwidth, al)) $ zip [0..] $ truncateLines coscreen onBlank l in overlayFrame ov fr LambdaHack-0.9.5.0/engine-src/Game/LambdaHack/Client/UI/FrameM.hs0000644000000000000000000001575207346545000022145 0ustar0000000000000000-- | A set of Frame monad operations. module Game.LambdaHack.Client.UI.FrameM ( pushFrame, promptGetKey, stopPlayBack, animate, fadeOutOrIn #ifdef EXPOSE_INTERNAL -- * Internal operations , drawOverlay, renderFrames, resetPlayBack #endif ) where import Prelude () import Game.LambdaHack.Core.Prelude import qualified Data.EnumMap.Strict as EM import qualified Data.Vector.Unboxed as U import Game.LambdaHack.Client.ClientOptions import Game.LambdaHack.Client.MonadClient import Game.LambdaHack.Client.State import Game.LambdaHack.Client.UI.Animation import Game.LambdaHack.Client.UI.Content.Screen import Game.LambdaHack.Client.UI.ContentClientUI import Game.LambdaHack.Client.UI.DrawM import Game.LambdaHack.Client.UI.Frame import qualified Game.LambdaHack.Client.UI.Key as K import Game.LambdaHack.Client.UI.MonadClientUI import Game.LambdaHack.Client.UI.Msg import Game.LambdaHack.Client.UI.MsgM import Game.LambdaHack.Client.UI.Overlay import Game.LambdaHack.Client.UI.SessionUI import Game.LambdaHack.Common.ActorState import Game.LambdaHack.Common.Faction import Game.LambdaHack.Common.MonadStateRead import Game.LambdaHack.Common.State import Game.LambdaHack.Common.Types import qualified Game.LambdaHack.Definition.Color as Color -- | Draw the current level with the overlay on top. -- If the overlay is too long, it's truncated. -- Similarly, for each line of the overlay, if it's too wide, it's truncated. drawOverlay :: MonadClientUI m => ColorMode -> Bool -> Overlay -> LevelId -> m PreFrame drawOverlay dm onBlank topTrunc lid = do CCUI{coscreen=coscreen@ScreenContent{rwidth, rheight}} <- getsSession sccui basicFrame <- if onBlank then do let m = U.replicate (rwidth * rheight) (Color.attrCharW32 Color.spaceAttrW32) return (m, FrameForall $ \_v -> return ()) else drawHudFrame dm lid return $! overlayFrameWithLines coscreen onBlank topTrunc basicFrame -- | Push the frame depicting the current level to the frame queue. -- Only one line of the report is shown, as in animations, -- because it may not be our turn, so we can't clear the message -- to see what is underneath. pushFrame :: MonadClientUI m => m () pushFrame = do -- The delay before reaction to keypress was too long in case of many -- projectiles flying and ending flight, so frames need to be skipped. keyPressed <- anyKeyPressed unless keyPressed $ do lidV <- viewedLevelUI report <- getReportUI let truncRep = [renderReport report] frame <- drawOverlay ColorFull False truncRep lidV displayFrames lidV [Just frame] promptGetKey :: MonadClientUI m => ColorMode -> Overlay -> Bool -> [K.KM] -> m K.KM promptGetKey dm ov onBlank frontKeyKeys = do lidV <- viewedLevelUI keyPressed <- anyKeyPressed report <- getsSession $ newReport . shistory let msgDisturbs = anyInReport disturbsResting report lastPlayOld <- getsSession slastPlay km <- case lastPlayOld of km : kms | not keyPressed && (null frontKeyKeys || km `elem` frontKeyKeys) && not msgDisturbs -> do frontKeyFrame <- drawOverlay dm onBlank ov lidV displayFrames lidV [Just frontKeyFrame] modifySession $ \sess -> sess {slastPlay = kms} msgAdd MsgMacro $ "Voicing '" <> tshow km <> "'." return km _ : _ -> do -- We can't continue playback, so wipe out old slastPlay, srunning, etc. resetPlayBack resetPressedKeys let ov2 = [textFgToAL Color.BrYellow "*interrupted*" | keyPressed] ++ ov frontKeyFrame <- drawOverlay dm onBlank ov2 lidV recordHistory connFrontendFrontKey frontKeyKeys frontKeyFrame [] -> do -- If we ask for a key, then we don't want to run any more -- and we want to avoid changing leader back to initial run leader -- at the nearest @stopPlayBack@, etc. modifySession $ \sess -> sess {srunning = Nothing} frontKeyFrame <- drawOverlay dm onBlank ov lidV when (dm /= ColorFull) $ do side <- getsClient sside fact <- getsState $ (EM.! side) . sfactionD unless (isAIFact fact) $ -- don't forget special autoplay keypresses -- Forget the furious keypresses just before a special event. resetPressedKeys recordHistory connFrontendFrontKey frontKeyKeys frontKeyFrame LastRecord seqCurrent seqPrevious k <- getsSession slastRecord let slastRecord = LastRecord (km : seqCurrent) seqPrevious k modifySession $ \sess -> sess { slastRecord , sdisplayNeeded = False } return km stopPlayBack :: MonadClientUI m => m () stopPlayBack = msgAdd0 MsgStopPlayback "!" resetPlayBack :: MonadClientUI m => m () resetPlayBack = do lastPlayOld <- getsSession slastPlay unless (null lastPlayOld) $ do modifySession $ \sess -> sess {slastPlay = []} LastRecord _ _ k <- getsSession slastRecord when (k > 0) $ do -- Needed to properly cancel macros that contain apostrophes. modifySession $ \sess -> sess {slastRecord = LastRecord [] [] 0} promptAdd0 "Macro recording aborted." srunning <- getsSession srunning case srunning of Nothing -> return () Just RunParams{runLeader} -> do -- Switch to the original leader, from before the run start, -- unless dead or unless the faction never runs with multiple -- (but could have the leader changed automatically meanwhile). side <- getsClient sside fact <- getsState $ (EM.! side) . sfactionD arena <- getArenaUI memA <- getsState $ memActor runLeader arena when (memA && not (noRunWithMulti fact)) $ updateClientLeader runLeader modifySession (\sess -> sess {srunning = Nothing}) -- | Render animations on top of the current screen frame. renderFrames :: MonadClientUI m => LevelId -> Animation -> m PreFrames renderFrames arena anim = do report <- getReportUI let truncRep = [renderReport report] basicFrame <- drawOverlay ColorFull False truncRep arena snoAnim <- getsClient $ snoAnim . soptions return $! if fromMaybe False snoAnim then [Just basicFrame] else renderAnim basicFrame anim -- | Render and display animations on top of the current screen frame. animate :: MonadClientUI m => LevelId -> Animation -> m () animate arena anim = do -- The delay before reaction to keypress was too long in case of many -- projectiles hitting actors, so frames need to be skipped. keyPressed <- anyKeyPressed unless keyPressed $ do frames <- renderFrames arena anim displayFrames arena frames fadeOutOrIn :: MonadClientUI m => Bool -> m () fadeOutOrIn out = do arena <- getArenaUI CCUI{coscreen} <- getsSession sccui animMap <- rndToActionForget $ fadeout coscreen out 2 animFrs <- renderFrames arena animMap displayFrames arena (tail animFrs) -- no basic frame between fadeout and in LambdaHack-0.9.5.0/engine-src/Game/LambdaHack/Client/UI/Frontend.hs0000644000000000000000000001732207346545000022550 0ustar0000000000000000{-# LANGUAGE GADTs, KindSignatures, RankNTypes #-} -- | Display game data on the screen and receive user input -- using one of the available raw frontends and derived operations. module Game.LambdaHack.Client.UI.Frontend ( -- * Connection and initialization FrontReq(..), ChanFrontend(..), chanFrontendIO -- * Re-exported part of the raw frontend , frontendName #ifdef EXPOSE_INTERNAL -- * Internal operations , FrontSetup, getKey, fchanFrontend, display, defaultMaxFps, microInSec , frameTimeoutThread, lazyStartup, nullStartup, seqFrame #endif ) where import Prelude () import Game.LambdaHack.Core.Prelude import Control.Concurrent import Control.Concurrent.Async import qualified Control.Concurrent.STM as STM import Control.Monad.ST.Strict import Data.IORef import qualified Data.Vector.Generic as G import qualified Data.Vector.Unboxed as U import Data.Word import Game.LambdaHack.Client.ClientOptions import Game.LambdaHack.Client.UI.Content.Screen import Game.LambdaHack.Client.UI.Frame import qualified Game.LambdaHack.Client.UI.Frontend.Chosen as Chosen import Game.LambdaHack.Client.UI.Frontend.Common import qualified Game.LambdaHack.Client.UI.Frontend.Teletype as Teletype import Game.LambdaHack.Client.UI.Key (KMP (..)) import qualified Game.LambdaHack.Client.UI.Key as K import Game.LambdaHack.Common.Point import qualified Game.LambdaHack.Common.PointArray as PointArray import qualified Game.LambdaHack.Definition.Color as Color -- | The instructions sent by clients to the raw frontend, indexed -- by the returned value. data FrontReq :: * -> * where -- | Show a frame. FrontFrame :: Frame -> FrontReq () -- | Perform an explicit delay of the given length. FrontDelay :: Int -> FrontReq () -- | Flush frames, display a frame and ask for a keypress. FrontKey :: [K.KM] -> Frame -> FrontReq KMP -- | Tell if a keypress is pending. FrontPressed :: FrontReq Bool -- | Discard a key in the queue, if any. FrontDiscardKey :: FrontReq () -- | Discard all keys in the queue. FrontResetKeys :: FrontReq () -- | Add a key to the queue. FrontAdd :: KMP -> FrontReq () -- | Set in the frontend that it should auto-answer prompts. FrontAutoYes :: Bool -> FrontReq () -- | Shut the frontend down. FrontShutdown :: FrontReq () -- | Take screenshot. FrontPrintScreen :: FrontReq () -- | Connection channel between a frontend and a client. Frontend acts -- as a server, serving keys, etc., when given frames to display. newtype ChanFrontend = ChanFrontend (forall a. FrontReq a -> IO a) -- | Machinery allocated for an individual frontend at its startup, -- unchanged for its lifetime. data FrontSetup = FrontSetup { fautoYesRef :: IORef Bool , fasyncTimeout :: Async () , fdelay :: MVar Int } -- | Initialize the frontend chosen by the player via client options. chanFrontendIO :: ScreenContent -> ClientOptions -> IO ChanFrontend chanFrontendIO coscreen soptions = do let startup | sfrontendNull soptions = nullStartup coscreen | sfrontendLazy soptions = lazyStartup coscreen #ifndef REMOVE_TELETYPE | sfrontendTeletype soptions = Teletype.startup coscreen #endif | otherwise = Chosen.startup coscreen soptions maxFps = fromMaybe defaultMaxFps $ smaxFps soptions delta = max 1 $ microInSec `div` maxFps rf <- startup fautoYesRef <- newIORef $ not $ sdisableAutoYes soptions fdelay <- newMVar 0 fasyncTimeout <- async $ frameTimeoutThread delta fdelay rf -- Warning: not linking @fasyncTimeout@, so it'd better not crash. let fs = FrontSetup{..} return $ fchanFrontend fs rf -- Display a frame, wait for any of the specified keys (for any key, -- if the list is empty). Repeat if an unexpected key received. getKey :: FrontSetup -> RawFrontend -> [K.KM] -> Frame -> IO KMP getKey fs rf@RawFrontend{fchanKey} keys frame = do autoYes <- readIORef $ fautoYesRef fs if autoYes && (null keys || K.spaceKM `elem` keys) then do display rf frame return $! KMP {kmpKeyMod = K.spaceKM, kmpPointer = originPoint} else do -- Wait until timeout is up, not to skip the last frame of animation. display rf frame kmp <- STM.atomically $ STM.readTQueue fchanKey if null keys || kmpKeyMod kmp `elem` keys then return kmp else getKey fs rf keys frame -- Read UI requests from the client and send them to the frontend, fchanFrontend :: FrontSetup -> RawFrontend -> ChanFrontend fchanFrontend fs@FrontSetup{..} rf = ChanFrontend $ \case FrontFrame frontFrame -> display rf frontFrame FrontDelay k -> modifyMVar_ fdelay $ return . (+ k) FrontKey frontKeyKeys frontKeyFrame -> getKey fs rf frontKeyKeys frontKeyFrame FrontPressed -> do noKeysPending <- STM.atomically $ STM.isEmptyTQueue (fchanKey rf) return $! not noKeysPending FrontDiscardKey -> void $ STM.atomically $ STM.tryReadTQueue (fchanKey rf) FrontResetKeys -> resetChanKey (fchanKey rf) FrontAdd kmp -> STM.atomically $ STM.writeTQueue (fchanKey rf) kmp FrontAutoYes b -> writeIORef fautoYesRef b FrontShutdown -> do cancel fasyncTimeout -- In case the last frame display is pending: void $ tryTakeMVar $ fshowNow rf fshutdown rf FrontPrintScreen -> fprintScreen rf display :: RawFrontend -> Frame -> IO () display rf@RawFrontend{fshowNow, fcoscreen=ScreenContent{rwidth, rheight}} (m, upd) = do let new :: forall s. ST s (G.Mutable U.Vector s Word32) new = do v <- unFrameBase m unFrameForall upd v return v singleFrame = PointArray.Array rwidth rheight (U.create new) putMVar fshowNow () -- 1. wait for permission to display; 3. ack fdisplay rf $ SingleFrame singleFrame defaultMaxFps :: Int defaultMaxFps = 24 microInSec :: Int microInSec = 1000000 -- This thread is canceled forcefully, because the @threadDelay@ -- may be much longer than an acceptable shutdown time. frameTimeoutThread :: Int -> MVar Int -> RawFrontend -> IO () frameTimeoutThread delta fdelay RawFrontend{..} = do let loop = do threadDelay delta let delayLoop = do delay <- readMVar fdelay when (delay > 0) $ do threadDelay $ delta * delay modifyMVar_ fdelay $ return . subtract delay delayLoop delayLoop let showFrameAndRepeatIfKeys = do -- @fshowNow@ is full at this point, unless @saveKM@ emptied it, -- in which case we wait below until @display@ fills it takeMVar fshowNow -- 2. permit display -- @fshowNow@ is ever empty only here, unless @saveKM@ empties it readMVar fshowNow -- 4. wait for ack before starting delay -- @fshowNow@ is full at this point noKeysPending <- STM.atomically $ STM.isEmptyTQueue fchanKey unless noKeysPending $ do void $ swapMVar fdelay 0 -- cancel delays lest they accumulate showFrameAndRepeatIfKeys showFrameAndRepeatIfKeys loop loop -- | The name of the chosen frontend. frontendName :: String frontendName = Chosen.frontendName lazyStartup :: ScreenContent -> IO RawFrontend lazyStartup coscreen = createRawFrontend coscreen (\_ -> return ()) (return ()) nullStartup :: ScreenContent -> IO RawFrontend nullStartup coscreen = createRawFrontend coscreen seqFrame (return ()) seqFrame :: SingleFrame -> IO () seqFrame SingleFrame{singleFrame} = let seqAttr () attr = Color.colorToRGB (Color.fgFromW32 attr) `seq` Color.bgFromW32 attr `seq` Color.charFromW32 attr == ' ' `seq` () in return $! PointArray.foldlA' seqAttr () singleFrame LambdaHack-0.9.5.0/engine-src/Game/LambdaHack/Client/UI/Frontend/0000755000000000000000000000000007346545000022207 5ustar0000000000000000LambdaHack-0.9.5.0/engine-src/Game/LambdaHack/Client/UI/Frontend/Chosen.hs0000644000000000000000000000110607346545000023760 0ustar0000000000000000-- | Re-export the operations of the chosen raw frontend -- (determined at compile time with cabal flags). module Game.LambdaHack.Client.UI.Frontend.Chosen ( startup, frontendName ) where import Prelude () #ifdef USE_CURSES import Game.LambdaHack.Client.UI.Frontend.Curses #elif USE_VTY import Game.LambdaHack.Client.UI.Frontend.Vty #elif USE_GTK import Game.LambdaHack.Client.UI.Frontend.Gtk #elif USE_SDL import Game.LambdaHack.Client.UI.Frontend.Sdl #elif USE_BROWSER import Game.LambdaHack.Client.UI.Frontend.Dom #else import Game.LambdaHack.Client.UI.Frontend.Sdl #endif LambdaHack-0.9.5.0/engine-src/Game/LambdaHack/Client/UI/Frontend/Common.hs0000644000000000000000000000641107346545000023775 0ustar0000000000000000-- | Screen frames and animations. module Game.LambdaHack.Client.UI.Frontend.Common ( RawFrontend(..) , startupBound, createRawFrontend, resetChanKey, saveKMP , modifierTranslate ) where import Prelude () import Game.LambdaHack.Core.Prelude import Control.Concurrent import qualified Control.Concurrent.STM as STM import Game.LambdaHack.Client.UI.Content.Screen import Game.LambdaHack.Client.UI.Frame import Game.LambdaHack.Client.UI.Key (KMP (..)) import qualified Game.LambdaHack.Client.UI.Key as K import Game.LambdaHack.Common.Misc import Game.LambdaHack.Common.Point -- | Raw frontend definition. The minimal closed set of values that need -- to depend on the specifics of the chosen frontend. data RawFrontend = RawFrontend { fdisplay :: SingleFrame -> IO () , fshutdown :: IO () , fshowNow :: MVar () , fchanKey :: STM.TQueue KMP , fprintScreen :: IO () , fcoscreen :: ScreenContent } -- | Start up a frontend on a bound thread. -- -- In fact, it is started on the very main thread, via a hack, because -- apparently some SDL backends are not thread-safe -- (; -- "this should only be run in the thread that initialized the video subsystem, -- and for extra safety, you should consider only doing those things -- on the main thread in any case") -- and at least the newer OS X obtusely requires the main thread, see -- https://github.com/AllureOfTheStars/Allure/issues/79 -- In case any other exotic architecture requires the main thread, -- we make the hack the default for all (on frontends that require a bound -- thread, e.g., SLD2 or GTK). startupBound :: (MVar RawFrontend -> IO ()) -> IO RawFrontend startupBound k = do rfMVar <- newEmptyMVar putMVar workaroundOnMainThreadMVar $ k rfMVar -- The following would run frontend on a bound thread, but it's not enough: -- a <- asyncBound $ k rfMVar -- link a takeMVar rfMVar createRawFrontend :: ScreenContent -> (SingleFrame -> IO ()) -> IO () -> IO RawFrontend createRawFrontend fcoscreen fdisplay fshutdown = do -- Set up the channel for keyboard input. fchanKey <- STM.atomically STM.newTQueue -- Create the session record. fshowNow <- newEmptyMVar return $! RawFrontend { fdisplay , fshutdown , fshowNow , fchanKey , fprintScreen = return () -- dummy, except fro SDL2 , fcoscreen } -- | Empty the keyboard channel. resetChanKey :: STM.TQueue KMP -> IO () resetChanKey fchanKey = do res <- STM.atomically $ STM.tryReadTQueue fchanKey when (isJust res) $ resetChanKey fchanKey saveKMP :: RawFrontend -> K.Modifier -> K.Key -> Point -> IO () saveKMP !rf !modifier !key !kmpPointer = do -- Instantly show any frame waiting for display. void $ tryTakeMVar $ fshowNow rf let kmp = KMP{kmpKeyMod = K.KM{..}, kmpPointer} unless (key == K.DeadKey) $ -- Store the key in the channel. STM.atomically $ STM.writeTQueue (fchanKey rf) kmp -- | Translates modifiers to our own encoding. modifierTranslate :: Bool -> Bool -> Bool -> Bool -> K.Modifier modifierTranslate modCtrl modShift modAlt modMeta | modCtrl && modShift = K.ControlShift | modCtrl = K.Control | modAlt || modMeta = K.Alt | modShift = K.Shift | otherwise = K.NoModifier LambdaHack-0.9.5.0/engine-src/Game/LambdaHack/Client/UI/Frontend/Curses.hs0000644000000000000000000001710307346545000024011 0ustar0000000000000000-- | Text frontend based on HSCurses. This frontend is not fully supported -- due to the limitations of the curses library (keys, colours, last character -- of the last line). module Game.LambdaHack.Client.UI.Frontend.Curses ( startup, frontendName ) where import Prelude () import Game.LambdaHack.Core.Prelude import Control.Concurrent.Async import Data.Char (chr, ord) import qualified Data.Map.Strict as M import qualified UI.HSCurses.Curses as C import qualified UI.HSCurses.CursesHelper as C import Game.LambdaHack.Client.ClientOptions import Game.LambdaHack.Client.UI.Content.Screen import Game.LambdaHack.Client.UI.Frame import Game.LambdaHack.Client.UI.Frontend.Common import qualified Game.LambdaHack.Client.UI.Key as K import Game.LambdaHack.Common.Point import qualified Game.LambdaHack.Common.PointArray as PointArray import qualified Game.LambdaHack.Definition.Color as Color -- | Session data maintained by the frontend. data FrontendSession = FrontendSession { swin :: C.Window -- ^ the window to draw to , sstyles :: M.Map (Color.Color, Color.Color) C.CursesStyle -- ^ map from fore/back colour pairs to defined curses styles } -- | The name of the frontend. frontendName :: String frontendName = "curses" -- | Starts the main program loop using the frontend input and output. startup :: ScreenContent -> ClientOptions -> IO RawFrontend startup coscreen _soptions = do C.start void $ C.cursSet C.CursorInvisible let s = [ ((fg, bg), C.Style (toFColor fg) (toBColor bg)) | -- Almost no more color combinations possible: 15*4, 64 is max. fg <- Color.legalFgCol , bg <- [Color.Black, Color.Blue, Color.White, Color.BrBlack] ] nr <- C.colorPairs when (nr < length s) $ C.end >> error ("terminal has too few color pairs" `showFailure` nr) let (ks, vs) = unzip s ws <- C.convertStyles vs let swin = C.stdScr sstyles = M.fromDistinctAscList (zip ks ws) sess = FrontendSession{..} rf <- createRawFrontend coscreen (display coscreen sess) shutdown let storeKeys :: IO () storeKeys = do K.KM{..} <- keyTranslate <$> C.getKey C.refresh saveKMP rf modifier key originPoint storeKeys void $ async storeKeys return $! rf shutdown :: IO () shutdown = C.end -- | Output to the screen via the frontend. display :: ScreenContent -> FrontendSession -> SingleFrame -> IO () display coscreen FrontendSession{..} SingleFrame{singleFrame} = do -- let defaultStyle = C.defaultCursesStyle -- Terminals with white background require this: let defaultStyle = sstyles M.! (Color.defFG, Color.Black) C.erase C.setStyle defaultStyle -- We need to remove the last character from the status line, -- because otherwise it would overflow a standard size xterm window, -- due to the curses historical limitations. let sf = chunk $ map Color.attrCharFromW32 $ PointArray.toListA singleFrame level = init sf ++ [init $ last sf] nm = zip [0..] $ map (zip [0..]) level chunk [] = [] chunk l = let (ch, r) = splitAt (rwidth coscreen) l in ch : chunk r sequence_ [ C.setStyle (M.findWithDefault defaultStyle acAttr2 sstyles) >> C.mvWAddStr swin y x [acChar] | (y, line) <- nm , (x, Color.AttrChar{acAttr=Color.Attr{..}, ..}) <- line , let acAttr2 = case bg of Color.HighlightNone -> (fg, Color.Black) Color.HighlightGreen -> (fg, Color.Black) -- too few bgs Color.HighlightBlue -> if fg /= Color.Blue then (fg, Color.Blue) else (fg, Color.BrBlack) Color.HighlightGrey -> if fg /= Color.BrBlack then (fg, Color.BrBlack) else (fg, Color.defFG) Color.HighlightWhite -> (fg, Color.Black) Color.HighlightMagenta -> (fg, Color.Black) Color.HighlightRed -> if fg /= Color.Red then (fg, Color.Red) else (fg, Color.defFG) Color.HighlightYellow -> (Color.Black, Color.defFG) Color.HighlightYellowAim -> (Color.Black, Color.defFG) Color.HighlightRedAim -> if fg /= Color.Red then (fg, Color.Red) else (fg, Color.defFG) Color.HighlightNoneCursor -> (fg, Color.Black) ] C.refresh keyTranslate :: C.Key -> K.KM keyTranslate e = (\(key, modifier) -> K.KM modifier key) $ case e of C.KeyChar '\ESC' -> (K.Esc, K.NoModifier) C.KeyExit -> (K.Esc, K.NoModifier) C.KeyChar '\n' -> (K.Return, K.NoModifier) C.KeyChar '\r' -> (K.Return, K.NoModifier) C.KeyEnter -> (K.Return, K.NoModifier) C.KeyChar ' ' -> (K.Space, K.NoModifier) C.KeyChar '\t' -> (K.Tab, K.NoModifier) C.KeyBTab -> (K.BackTab, K.NoModifier) C.KeyBackspace -> (K.BackSpace, K.NoModifier) C.KeyUp -> (K.Up, K.NoModifier) C.KeyDown -> (K.Down, K.NoModifier) C.KeyLeft -> (K.Left, K.NoModifier) C.KeySLeft -> (K.Left, K.NoModifier) C.KeyRight -> (K.Right, K.NoModifier) C.KeySRight -> (K.Right, K.NoModifier) C.KeyHome -> (K.Home, K.NoModifier) C.KeyEnd -> (K.End, K.NoModifier) C.KeyPPage -> (K.PgUp, K.NoModifier) C.KeyNPage -> (K.PgDn, K.NoModifier) C.KeyBeg -> (K.Begin, K.NoModifier) C.KeyB2 -> (K.Begin, K.NoModifier) C.KeyClear -> (K.Begin, K.NoModifier) C.KeyIC -> (K.Insert, K.NoModifier) -- No KP_ keys; see C.KeyChar c -- This case needs to be considered after Tab, since, apparently, -- on some terminals ^i == Tab and Tab is more important for us. | ord '\^A' <= ord c && ord c <= ord '\^Z' -> -- Alas, only lower-case letters. (K.Char $ chr $ ord c - ord '\^A' + ord 'a', K.Control) -- Movement keys are more important than leader picking, -- so disabling the latter and interpreting the keypad numbers -- as movement: | c `elem` ['1'..'9'] -> (K.KP c, K.NoModifier) | otherwise -> (K.Char c, K.NoModifier) _ -> (K.Unknown (show e), K.NoModifier) toFColor :: Color.Color -> C.ForegroundColor toFColor Color.Black = C.BlackF toFColor Color.Red = C.DarkRedF toFColor Color.Green = C.DarkGreenF toFColor Color.Brown = C.BrownF toFColor Color.Blue = C.DarkBlueF toFColor Color.Magenta = C.PurpleF toFColor Color.Cyan = C.DarkCyanF toFColor Color.White = C.WhiteF toFColor Color.AltWhite = C.WhiteF toFColor Color.BrBlack = C.GreyF toFColor Color.BrRed = C.RedF toFColor Color.BrGreen = C.GreenF toFColor Color.BrYellow = C.YellowF toFColor Color.BrBlue = C.BlueF toFColor Color.BrMagenta = C.MagentaF toFColor Color.BrCyan = C.CyanF toFColor Color.BrWhite = C.BrightWhiteF toBColor :: Color.Color -> C.BackgroundColor toBColor Color.Black = C.BlackB toBColor Color.Red = C.DarkRedB toBColor Color.Green = C.DarkGreenB toBColor Color.Brown = C.BrownB toBColor Color.Blue = C.DarkBlueB toBColor Color.Magenta = C.PurpleB toBColor Color.Cyan = C.DarkCyanB toBColor Color.White = C.WhiteB toBColor _ = C.BlackB -- a limitation of curses LambdaHack-0.9.5.0/engine-src/Game/LambdaHack/Client/UI/Frontend/Dom.hs0000644000000000000000000002541107346545000023265 0ustar0000000000000000-- | Text frontend running in a browser. module Game.LambdaHack.Client.UI.Frontend.Dom ( startup, frontendName ) where import Prelude () import Game.LambdaHack.Core.Prelude import Control.Concurrent import qualified Control.Monad.IO.Class as IO import Control.Monad.Trans.Reader (ask) import qualified Data.Char as Char import Data.IORef import qualified Data.Vector as V import qualified Data.Vector.Unboxed as U import Data.Word (Word32) import GHCJS.DOM (currentDocument, currentWindow) import GHCJS.DOM.CSSStyleDeclaration (setProperty) import GHCJS.DOM.Document (createElement, getBodyUnchecked) import GHCJS.DOM.Element (Element (Element), setInnerHTML) import GHCJS.DOM.ElementCSSInlineStyle (getStyle) import GHCJS.DOM.EventM (EventM, mouseAltKey, mouseButton, mouseCtrlKey, mouseMetaKey, mouseShiftKey, on, preventDefault, stopPropagation) import GHCJS.DOM.GlobalEventHandlers (contextMenu, keyDown, mouseDown, mouseUp, wheel) import GHCJS.DOM.HTMLCollection (itemUnsafe) import GHCJS.DOM.HTMLTableElement (HTMLTableElement (HTMLTableElement), getRows, setCellPadding, setCellSpacing) import GHCJS.DOM.HTMLTableRowElement (HTMLTableRowElement (HTMLTableRowElement), getCells) import GHCJS.DOM.KeyboardEvent (getAltGraphKey, getAltKey, getCtrlKey, getKey, getMetaKey, getShiftKey) import GHCJS.DOM.Node (appendChild_, replaceChild_, setTextContent) import GHCJS.DOM.NonElementParentNode (getElementByIdUnsafe) import GHCJS.DOM.RequestAnimationFrameCallback import GHCJS.DOM.Types (CSSStyleDeclaration, DOM, HTMLDivElement (HTMLDivElement), HTMLTableCellElement (HTMLTableCellElement), IsMouseEvent, Window, runDOM, unsafeCastTo) import GHCJS.DOM.WheelEvent (getDeltaY) import GHCJS.DOM.Window (requestAnimationFrame_) import Game.LambdaHack.Client.ClientOptions import Game.LambdaHack.Client.UI.Content.Screen import Game.LambdaHack.Client.UI.Frame import Game.LambdaHack.Client.UI.Frontend.Common import qualified Game.LambdaHack.Client.UI.Key as K import Game.LambdaHack.Common.Area import Game.LambdaHack.Common.Point import qualified Game.LambdaHack.Common.PointArray as PointArray import Game.LambdaHack.Content.TileKind (floorSymbol) import qualified Game.LambdaHack.Definition.Color as Color -- | Session data maintained by the frontend. data FrontendSession = FrontendSession { scurrentWindow :: Window , scharCells :: V.Vector (HTMLTableCellElement, CSSStyleDeclaration) , spreviousFrame :: IORef SingleFrame } -- | The name of the frontend. frontendName :: String frontendName = "browser" -- | Starts the main program loop using the frontend input and output. startup :: ScreenContent -> ClientOptions -> IO RawFrontend startup coscreen soptions = do rfMVar <- newEmptyMVar flip runDOM undefined $ runWeb coscreen soptions rfMVar takeMVar rfMVar runWeb :: ScreenContent -> ClientOptions -> MVar RawFrontend -> DOM () runWeb coscreen ClientOptions{..} rfMVar = do -- Init the document. Just doc <- currentDocument Just scurrentWindow <- currentWindow body <- getBodyUnchecked doc pageStyle <- getStyle body setProp pageStyle "background-color" (Color.colorToRGB Color.Black) setProp pageStyle "color" (Color.colorToRGB Color.AltWhite) -- Create the session record. divBlockRaw <- createElement doc ("div" :: Text) divBlock <- unsafeCastTo HTMLDivElement divBlockRaw let cell = "" ++ [Char.chr 160] row = "" ++ concat (replicate (rwidth coscreen) cell) rows = concat (replicate (rheight coscreen) row) tableElemRaw <- createElement doc ("table" :: Text) tableElem <- unsafeCastTo HTMLTableElement tableElemRaw -- Get rid of table spacing. Spurious hacks just in case. setCellPadding tableElem ("0" :: Text) setCellSpacing tableElem ("0" :: Text) appendChild_ divBlock tableElem setInnerHTML tableElem rows scharCells <- flattenTable coscreen tableElem spreviousFrame <- newIORef $ blankSingleFrame coscreen let sess = FrontendSession{..} rf <- IO.liftIO $ createRawFrontend coscreen (display sess) shutdown let readMod = do modCtrl <- ask >>= getCtrlKey modShift <- ask >>= getShiftKey modAlt <- ask >>= getAltKey modMeta <- ask >>= getMetaKey modAltG <- ask >>= getAltGraphKey return $! modifierTranslate modCtrl modShift (modAlt || modAltG) modMeta void $ doc `on` keyDown $ do keyId <- ask >>= getKey modifier <- readMod -- This is currently broken at least for Shift-F1, etc., so won't be used: -- keyLoc <- ask >>= getKeyLocation -- let onKeyPad = case keyLoc of -- 3 {-KEY_LOCATION_NUMPAD-} -> True -- _ -> False let key = K.keyTranslateWeb keyId (modifier == K.Shift) modifierNoShift = case modifier of -- to prevent S-!, etc. K.Shift -> K.NoModifier K.ControlShift -> K.Control _ -> modifier -- IO.liftIO $ do -- putStrLn $ "keyId: " ++ keyId -- putStrLn $ "key: " ++ K.showKey key -- putStrLn $ "modifier: " ++ show modifier when (key == K.Esc) $ IO.liftIO $ resetChanKey (fchanKey rf) IO.liftIO $ saveKMP rf modifierNoShift key originPoint -- Pass through C-+ and others, but disable special behaviour on Tab, etc. let browserKeys = "+-0tTnNdxcv" unless (modifier == K.Alt || modifier == K.Control && key `elem` map K.Char browserKeys || key == K.DeadKey) $ do -- NumLock in particular preventDefault stopPropagation -- Handle mouseclicks, per-cell. let setupMouse i a = let Point{..} = punindex (rwidth coscreen) i in handleMouse rf a px py V.imapM_ setupMouse scharCells -- Display at the end to avoid redraw. Replace "Please wait". gameMap <- getElementByIdUnsafe doc ("gameMap" :: Text) pleaseWait <- getElementByIdUnsafe doc ("pleaseWait" :: Text) replaceChild_ gameMap divBlock pleaseWait IO.liftIO $ putMVar rfMVar rf -- send to client only after the whole webpage is set up -- because there is no @mainGUI@ to start accepting shutdown :: IO () shutdown = return () -- nothing to clean up setProp :: CSSStyleDeclaration -> Text -> Text -> DOM () setProp style propRef propValue = setProperty style propRef propValue (Nothing :: Maybe Text) -- | Let each table cell handle mouse events inside. handleMouse :: RawFrontend -> (HTMLTableCellElement, CSSStyleDeclaration) -> Int -> Int -> DOM () handleMouse rf (cell, _) cx cy = do let readMod :: IsMouseEvent e => EventM HTMLTableCellElement e K.Modifier readMod = do modCtrl <- mouseCtrlKey modShift <- mouseShiftKey modAlt <- mouseAltKey modMeta <- mouseMetaKey return $! modifierTranslate modCtrl modShift modAlt modMeta saveWheel = do wheelY <- ask >>= getDeltaY modifier <- readMod let mkey = if | wheelY < -0.01 -> Just K.WheelNorth | wheelY > 0.01 -> Just K.WheelSouth | otherwise -> Nothing -- probably a glitch pointer = Point cx cy maybe (return ()) (\key -> IO.liftIO $ saveKMP rf modifier key pointer) mkey saveMouse = do -- but <- mouseButton modifier <- readMod let key = case but of 0 -> K.LeftButtonRelease 1 -> K.MiddleButtonRelease 2 -> K.RightButtonRelease -- not handled in contextMenu _ -> K.LeftButtonRelease -- any other is alternate left pointer = Point cx cy -- IO.liftIO $ putStrLn $ -- "m: " ++ show but ++ show modifier ++ show pointer IO.liftIO $ saveKMP rf modifier key pointer void $ cell `on` wheel $ do saveWheel preventDefault stopPropagation void $ cell `on` contextMenu $ do preventDefault stopPropagation void $ cell `on` mouseUp $ do saveMouse preventDefault stopPropagation void $ cell `on` mouseDown $ do -- Just disable selecting a region. preventDefault stopPropagation -- | Get the list of all cells of an HTML table. flattenTable :: ScreenContent -> HTMLTableElement -> DOM (V.Vector (HTMLTableCellElement, CSSStyleDeclaration)) flattenTable coscreen table = do rows <- getRows table let f y = do rowsItem <- itemUnsafe rows y unsafeCastTo HTMLTableRowElement rowsItem lrow <- mapM f [0 .. toEnum (rheight coscreen - 1)] let getC :: HTMLTableRowElement -> DOM [(HTMLTableCellElement, CSSStyleDeclaration)] getC row = do cells <- getCells row let g x = do cellsItem <- itemUnsafe cells x cell <- unsafeCastTo HTMLTableCellElement cellsItem style <- getStyle cell return (cell, style) mapM g [0 .. toEnum (rwidth coscreen - 1)] lrc <- mapM getC lrow return $! V.fromListN (rwidth coscreen * rheight coscreen) $ concat lrc -- | Output to the screen via the frontend. display :: FrontendSession -- ^ frontend session data -> SingleFrame -- ^ the screen frame to draw -> IO () display FrontendSession{..} !curFrame = flip runDOM undefined $ do let setChar :: Int -> (Word32, Word32) -> DOM Int setChar !i (!w, !wPrev) | w == wPrev = return $! i + 1 setChar i (w, _) = do let Point{..} = toEnum i Color.AttrChar{acAttr=Color.Attr{fg=fgRaw,bg}, acChar} = Color.attrCharFromW32 $ Color.AttrCharW32 w fg | py `mod` 2 == 0 && fgRaw == Color.White = Color.AltWhite | otherwise = fgRaw (!cell, !style) = scharCells V.! i if | acChar == ' ' -> setTextContent cell $ Just [Char.chr 160] | acChar == floorSymbol && not (Color.isBright fg) -> setTextContent cell $ Just [Char.chr 8901] | otherwise -> setTextContent cell $ Just [acChar] setProp style "color" $ Color.colorToRGB fg setProp style "border-color" $ Color.colorToRGB $ Color.highlightToColor bg return $! i + 1 !prevFrame <- readIORef spreviousFrame writeIORef spreviousFrame curFrame -- This continues asynchronously, if can't otherwise. callback <- newRequestAnimationFrameCallbackSync $ \_ -> U.foldM'_ setChar 0 $ U.zip (PointArray.avector $ singleFrame curFrame) (PointArray.avector $ singleFrame prevFrame) -- This attempts to ensure no redraws while callback executes -- and a single redraw when it completes. requestAnimationFrame_ scurrentWindow callback LambdaHack-0.9.5.0/engine-src/Game/LambdaHack/Client/UI/Frontend/Gtk.hs0000644000000000000000000002430007346545000023267 0ustar0000000000000000{-# OPTIONS_GHC -Wno-unused-do-bind #-} -- | Text frontend based on Gtk. module Game.LambdaHack.Client.UI.Frontend.Gtk ( startup, frontendName ) where import Prelude () import Game.LambdaHack.Core.Prelude hiding (Alt) import Control.Concurrent import qualified Control.Monad.IO.Class as IO import Data.Bits (unsafeShiftL) import qualified Data.IntMap.Strict as IM import Data.IORef import qualified Data.Text as T import qualified Game.LambdaHack.Common.PointArray as PointArray import Graphics.UI.Gtk hiding (Point) import System.Exit (exitFailure) import Game.LambdaHack.Client.ClientOptions import Game.LambdaHack.Client.UI.Content.Screen import Game.LambdaHack.Client.UI.Frame import Game.LambdaHack.Client.UI.Frontend.Common import qualified Game.LambdaHack.Client.UI.Key as K import Game.LambdaHack.Common.Point import qualified Game.LambdaHack.Definition.Color as Color import Game.LambdaHack.Definition.Defs -- | Session data maintained by the frontend. data FrontendSession = FrontendSession { sview :: TextView -- ^ the widget to draw to , stags :: IM.IntMap TextTag -- ^ text color tags for fg/bg } -- | The name of the frontend. frontendName :: String frontendName = "gtk" -- | Set up and start the main GTK loop providing input and output. -- -- Because of Windows, GTK needs to be on a bound thread, -- so we can't avoid the communication overhead of bound threads. startup :: ScreenContent -> ClientOptions -> IO RawFrontend startup coscreen soptions = startupBound $ startupFun coscreen soptions startupFun :: ScreenContent -> ClientOptions -> MVar RawFrontend -> IO () startupFun coscreen soptions@ClientOptions{..} rfMVar = do -- Init GUI. unsafeInitGUIForThreadedRTS -- Text attributes. let emulateBox Color.Attr{..} = case bg of Color.HighlightNone -> (fg, Color.Black) Color.HighlightGreen -> if fg /= Color.Green then (fg, Color.Green) else (fg, Color.BrBlack) Color.HighlightBlue -> if fg /= Color.Blue then (fg, Color.Blue) else (fg, Color.BrBlack) Color.HighlightGrey -> if fg /= Color.BrBlack then (fg, Color.BrBlack) else (fg, Color.defFG) Color.HighlightWhite -> (fg, Color.Black) Color.HighlightMagenta -> (fg, Color.Black) Color.HighlightRed -> if fg /= Color.Red then (fg, Color.Red) else (fg, Color.defFG) Color.HighlightYellow -> (Color.Black, Color.defFG) -- no cursor Color.HighlightYellowAim -> (Color.Black, Color.defFG) Color.HighlightRedAim -> if fg /= Color.Red then (fg, Color.Red) else (fg, Color.defFG) Color.HighlightNoneCursor -> (fg, Color.Black) ttt <- textTagTableNew stags <- IM.fromDistinctAscList <$> mapM (\ak -> do tt <- textTagNew Nothing textTagTableAdd ttt tt doAttr tt (emulateBox ak) return (fromAttr ak, tt)) [ Color.Attr{fg, bg} | fg <- Color.legalFgCol , bg <- [minBound..maxBound] ] -- Text buffer. tb <- textBufferNew (Just ttt) -- Create text view. sview <- textViewNewWithBuffer tb textViewSetEditable sview False textViewSetCursorVisible sview False widgetDelEvents sview [SmoothScrollMask, TouchMask] widgetAddEvents sview [ScrollMask] let sess = FrontendSession{..} rf <- createRawFrontend coscreen (display coscreen sess) shutdown putMVar rfMVar rf let modTranslate mods = modifierTranslate (Control `elem` mods) (Shift `elem` mods) (any (`elem` mods) [Alt, Alt2, Alt3, Alt4, Alt5]) (any (`elem` mods) [Meta, Super]) sview `on` keyPressEvent $ do n <- eventKeyName mods <- eventModifier let key = K.keyTranslate $ T.unpack n md = modTranslate mods modifier = case modifier of -- to prevent S-!, etc. K.Shift -> K.NoModifier K.ControlShift -> K.Control _ -> modifier pointer = originPoint when (key == K.Esc) $ IO.liftIO $ resetChanKey (fchanKey rf) IO.liftIO $ saveKMP rf modifier key pointer return True -- Set the font specified in config, if any. f <- fontDescriptionFromString $ fromMaybe "Monospace" sgtkFontFamily <+> maybe "16" tshow sscalableFontSize <> "px" widgetModifyFont sview (Just f) IO.liftIO $ do textViewSetLeftMargin sview 3 textViewSetRightMargin sview 3 -- Take care of the mouse events. sview `on` scrollEvent $ do IO.liftIO $ resetChanKey (fchanKey rf) scrollDir <- eventScrollDirection (wx, wy) <- eventCoordinates mods <- eventModifier let modifier = modTranslate mods -- Shift included IO.liftIO $ do (bx, by) <- textViewWindowToBufferCoords sview TextWindowText (round wx, round wy) (iter, _) <- textViewGetIterAtPosition sview bx by cx <- textIterGetLineOffset iter cy <- textIterGetLine iter let pointer = Point cx cy -- Store the mouse event coords in the keypress channel. storeK key = saveKMP rf modifier key pointer case scrollDir of ScrollUp -> storeK K.WheelNorth ScrollDown -> storeK K.WheelSouth _ -> return () -- ignore any fancy new gizmos return True -- disable selection currentfont <- newIORef f Just defDisplay <- displayGetDefault cursor <- cursorNewForDisplay defDisplay Tcross -- Target Crosshair Arrow sview `on` buttonPressEvent $ return True -- disable selection sview `on` buttonReleaseEvent $ do IO.liftIO $ resetChanKey (fchanKey rf) but <- eventButton (wx, wy) <- eventCoordinates mods <- eventModifier let modifier = modTranslate mods -- Shift included IO.liftIO $ do when (but == RightButton && modifier == K.Control) $ do fsd <- fontSelectionDialogNew ("Choose font" :: String) cf <- readIORef currentfont fds <- fontDescriptionToString cf fontSelectionDialogSetFontName fsd (fds :: String) fontSelectionDialogSetPreviewText fsd ("eee...@.##+##" :: String) resp <- dialogRun fsd when (resp == ResponseOk) $ do fn <- fontSelectionDialogGetFontName fsd case fn :: Maybe String of Just fn' -> do fd <- fontDescriptionFromString fn' writeIORef currentfont fd widgetModifyFont sview (Just fd) Nothing -> return () widgetDestroy fsd mdrawWin <- displayGetWindowAtPointer defDisplay let setCursor (drawWin, _, _) = drawWindowSetCursor drawWin (Just cursor) maybe (return ()) setCursor mdrawWin (bx, by) <- textViewWindowToBufferCoords sview TextWindowText (round wx, round wy) (iter, _) <- textViewGetIterAtPosition sview bx by cx <- textIterGetLineOffset iter cy <- textIterGetLine iter let mkey = case but of LeftButton -> Just K.LeftButtonRelease MiddleButton -> Just K.MiddleButtonRelease RightButton -> Just K.RightButtonRelease _ -> Nothing -- probably a glitch pointer = Point cx cy -- Store the mouse event coords in the keypress channel. maybe (return ()) (\key -> IO.liftIO $ saveKMP rf modifier key pointer) mkey return True -- Modify default colours. let black = Color minBound minBound minBound -- Color.defBG == Color.Black white = Color 0xB800 0xBF00 0xCB00 -- Color.defFG == Color.White widgetModifyBg sview StateNormal black widgetModifyFg sview StateNormal white -- Set up the main window. w <- windowNew containerAdd w sview -- We assume it's intentional window kill by the player, -- so game is not saved, unlike with assertion failure, etc. w `on` deleteEvent $ IO.liftIO $ do putStrLn "Window killed" mainQuit exitFailure widgetShowAll w mainGUI shutdown :: IO () shutdown = postGUISync mainQuit fromAttr :: Color.Attr -> Int fromAttr Color.Attr{..} = unsafeShiftL (fromEnum fg) 8 + fromEnum bg doAttr :: TextTag -> (Color.Color, Color.Color) -> IO () doAttr tt (fg, bg) | fg == Color.defFG && bg == Color.Black = return () | fg == Color.defFG = set tt [textTagBackground := Color.colorToRGB bg] | bg == Color.Black = set tt $ extraAttr ++ [textTagForeground := Color.colorToRGB fg] | otherwise = set tt $ extraAttr ++ [ textTagForeground := Color.colorToRGB fg , textTagBackground := Color.colorToRGB bg ] extraAttr :: [AttrOp TextTag] extraAttr = [textTagWeight := fromEnum WeightBold] -- , textTagStretch := StretchUltraExpanded -- | Add a frame to be drawn. display :: ScreenContent -> FrontendSession -> SingleFrame -> IO () display coscreen FrontendSession{..} SingleFrame{singleFrame} = do let f !w (!n, !l) = if n == -1 then (rwidth coscreen - 2, Color.charFromW32 w : '\n' : l) else (n - 1, Color.charFromW32 w : l) (_, levelChar) = PointArray.foldrA' f (rwidth coscreen - 1, []) singleFrame !gfChar = T.pack levelChar postGUISync $ do tb <- textViewGetBuffer sview textBufferSetText tb gfChar ib <- textBufferGetStartIter tb ie <- textIterCopy ib let defEnum = fromAttr Color.defAttr setTo :: (X, Int) -> Color.AttrCharW32 -> IO (X, Int) setTo (!lx, !previous) !w | (lx + 1) `mod` (rwidth coscreen + 1) /= 0 = do let current :: Int current = Color.attrEnumFromW32 w if current == previous then return (lx + 1, previous) else do textIterSetOffset ie lx when (previous /= defEnum) $ textBufferApplyTag tb (stags IM.! previous) ib ie textIterSetOffset ib lx return (lx + 1, current) setTo (lx, previous) w = setTo (lx + 1, previous) w (lx, previous) <- PointArray.foldMA' setTo (-1, defEnum) singleFrame textIterSetOffset ie lx when (previous /= defEnum) $ textBufferApplyTag tb (stags IM.! previous) ib ie LambdaHack-0.9.5.0/engine-src/Game/LambdaHack/Client/UI/Frontend/Sdl.hs0000644000000000000000000006077007346545000023277 0ustar0000000000000000-- | Text frontend based on SDL2. module Game.LambdaHack.Client.UI.Frontend.Sdl ( startup, frontendName #ifdef EXPOSE_INTERNAL -- * Internal operations , FontAtlas, FrontendSession(..), startupFun, shutdown, forceShutdown , display, drawFrame, printScreen, modTranslate, keyTranslate, colorToRGBA #endif ) where import Prelude () import Game.LambdaHack.Core.Prelude import Control.Concurrent import qualified Data.Char as Char import qualified Data.EnumMap.Strict as EM import Data.IORef import qualified Data.Text as T import Data.Time.Clock.POSIX import Data.Time.LocalTime import qualified Data.Vector.Unboxed as U import Data.Word (Word32, Word8) import Foreign.C.String (withCString) import Foreign.C.Types (CInt) import Foreign.Ptr (nullPtr) import Foreign.Storable (peek) import System.Directory import System.Exit (exitSuccess) import System.FilePath import qualified SDL import qualified SDL.Font as TTF import SDL.Input.Keyboard.Codes import qualified SDL.Internal.Types import qualified SDL.Raw.Basic as SDL (logSetAllPriority) import qualified SDL.Raw.Enum import qualified SDL.Raw.Types import qualified SDL.Raw.Video import qualified SDL.Vect as Vect import Game.LambdaHack.Client.ClientOptions import Game.LambdaHack.Client.UI.Content.Screen import Game.LambdaHack.Client.UI.Frame import Game.LambdaHack.Client.UI.Frontend.Common import qualified Game.LambdaHack.Client.UI.Key as K import Game.LambdaHack.Common.File import Game.LambdaHack.Common.Misc import Game.LambdaHack.Common.Point import qualified Game.LambdaHack.Common.PointArray as PointArray import Game.LambdaHack.Content.TileKind (floorSymbol) import qualified Game.LambdaHack.Definition.Color as Color type FontAtlas = EM.EnumMap Color.AttrCharW32 SDL.Texture -- | Session data maintained by the frontend. data FrontendSession = FrontendSession { swindow :: SDL.Window , srenderer :: SDL.Renderer , sfont :: TTF.Font , satlas :: IORef FontAtlas , stexture :: IORef SDL.Texture , spreviousFrame :: IORef SingleFrame , sforcedShutdown :: IORef Bool , scontinueSdlLoop :: IORef Bool , sframeQueue :: MVar SingleFrame , sframeDrawn :: MVar () } -- | The name of the frontend. frontendName :: String frontendName = "sdl" -- | Set up and start the main loop providing input and output. -- -- Because of Windows and OS X, SDL2 needs to be on a bound thread, -- so we can't avoid the communication overhead of bound threads. startup :: ScreenContent -> ClientOptions -> IO RawFrontend startup coscreen soptions = startupBound $ startupFun coscreen soptions startupFun :: ScreenContent -> ClientOptions -> MVar RawFrontend -> IO () startupFun coscreen soptions@ClientOptions{..} rfMVar = do SDL.initialize [SDL.InitEvents] -- lowest: pattern SDL_LOG_PRIORITY_VERBOSE = (1) :: LogPriority -- our default: pattern SDL_LOG_PRIORITY_ERROR = (5) :: LogPriority SDL.logSetAllPriority $ toEnum $ fromMaybe 5 slogPriority let title = fromJust stitle fontFileName = T.unpack (fromJust sdlFontFile) fontFileOrig | isRelative fontFileName = fromJust sfontDir fontFileName | otherwise = fontFileName (fontFileExists, fontFile) <- do fontFileOrigExists <- doesFileExist fontFileOrig if fontFileOrigExists then return (True, fontFileOrig) else do -- Handling old font format specified in old game config files. let fontFileAlt = dropExtension fontFileOrig <.> "fnt" fontFileAltExists <- doesFileExist fontFileAlt return (fontFileAltExists, fontFileAlt) unless fontFileExists $ fail $ "Font file does not exist: " ++ fontFileOrig let fontSize = fromJust sscalableFontSize -- will be ignored for bitmap fonts TTF.initialize sfont <- TTF.load fontFile fontSize let isBitmapFile = "fon" `isSuffixOf` T.unpack (fromJust sdlFontFile) || "fnt" `isSuffixOf` T.unpack (fromJust sdlFontFile) || "bdf" `isSuffixOf` T.unpack (fromJust sdlFontFile) || "FON" `isSuffixOf` T.unpack (fromJust sdlFontFile) || "FNT" `isSuffixOf` T.unpack (fromJust sdlFontFile) || "BDF" `isSuffixOf` T.unpack (fromJust sdlFontFile) sdlSizeAdd = fromJust $ if isBitmapFile then sdlBitmapSizeAdd else sdlScalableSizeAdd boxSize <- (+ sdlSizeAdd) <$> TTF.height sfont -- The hacky log priority 0 tells SDL frontend to init and quit at once, -- for testing on CIs without graphics access. if slogPriority == Just 0 then do rf <- createRawFrontend coscreen (\_ -> return ()) (return ()) putMVar rfMVar rf TTF.free sfont TTF.quit SDL.quit else do -- The code below fails without access to a graphics system. SDL.initialize [SDL.InitVideo] let screenV2 = SDL.V2 (toEnum $ rwidth coscreen * boxSize) (toEnum $ rheight coscreen * boxSize) windowConfig = SDL.defaultWindow {SDL.windowInitialSize = screenV2} rendererConfig = SDL.RendererConfig { rendererType = if sbenchmark then SDL.AcceleratedRenderer else SDL.AcceleratedVSyncRenderer , rendererTargetTexture = True } swindow <- SDL.createWindow title windowConfig srenderer <- SDL.createRenderer swindow (-1) rendererConfig let initTexture = do texture <- SDL.createTexture srenderer SDL.ARGB8888 SDL.TextureAccessTarget screenV2 SDL.rendererRenderTarget srenderer SDL.$= Just texture SDL.rendererDrawBlendMode srenderer SDL.$= SDL.BlendNone SDL.rendererDrawColor srenderer SDL.$= colorToRGBA Color.Black SDL.clear srenderer -- clear the texture SDL.rendererRenderTarget srenderer SDL.$= Nothing SDL.copy srenderer texture Nothing Nothing -- clear the backbuffer return texture texture <- initTexture satlas <- newIORef EM.empty stexture <- newIORef texture spreviousFrame <- newIORef $ blankSingleFrame coscreen sforcedShutdown <- newIORef False scontinueSdlLoop <- newIORef True sframeQueue <- newEmptyMVar sframeDrawn <- newEmptyMVar let sess = FrontendSession{..} rfWithoutPrintScreen <- createRawFrontend coscreen (display sess) (shutdown sess) let rf = rfWithoutPrintScreen {fprintScreen = printScreen sess} putMVar rfMVar rf let pointTranslate :: forall i. (Enum i) => Vect.Point Vect.V2 i -> Point pointTranslate (SDL.P (SDL.V2 x y)) = Point (fromEnum x `div` boxSize) (fromEnum y `div` boxSize) redraw = do -- Textures may be trashed and even invalid, especially on Windows. atlas <- readIORef satlas writeIORef satlas EM.empty oldTexture <- readIORef stexture newTexture <- initTexture mapM_ SDL.destroyTexture $ EM.elems atlas SDL.destroyTexture oldTexture writeIORef stexture newTexture prevFrame <- readIORef spreviousFrame writeIORef spreviousFrame (blankSingleFrame coscreen) -- to overwrite each char drawFrame soptions sess prevFrame loopSDL :: IO () loopSDL = do me <- SDL.pollEvent -- events take precedence over frames case me of Nothing -> do mfr <- tryTakeMVar sframeQueue case mfr of Just fr -> do -- Don't present an unchanged backbuffer. -- This doesn't improve FPS; probably equal frames happen -- very rarely, if at all, which is actually very good. prevFrame <- readIORef spreviousFrame unless (prevFrame == fr) $ do -- Some SDL2 (OpenGL) backends are very thread-unsafe, -- so we need to ensure we draw on the same (bound) OS thread -- that initialized SDL, hence we have to poll frames. drawFrame soptions sess fr -- We can't print screen in @display@ due to thread-unsafety. when sprintEachScreen $ printScreen sess putMVar sframeDrawn () -- signal that drawing ended Nothing -> threadDelay $ if sbenchmark then 150 else 15000 -- 60 polls per second, so keyboard snappy enough; -- max 6000 FPS when benchmarking Just e -> handleEvent e continueSdlLoop <- readIORef scontinueSdlLoop if continueSdlLoop then loopSDL else do TTF.free sfont TTF.quit SDL.destroyRenderer srenderer SDL.destroyWindow swindow SDL.quit forcedShutdown <- readIORef sforcedShutdown when forcedShutdown exitSuccess -- not in the main thread, so no exit yet, see "Main" handleEvent e = case SDL.eventPayload e of SDL.KeyboardEvent keyboardEvent | SDL.keyboardEventKeyMotion keyboardEvent == SDL.Pressed -> do let sym = SDL.keyboardEventKeysym keyboardEvent ksm = SDL.keysymModifier sym shiftPressed = SDL.keyModifierLeftShift ksm || SDL.keyModifierRightShift ksm key = keyTranslate shiftPressed $ SDL.keysymKeycode sym modifier = modTranslate ksm modifierNoShift = case modifier of -- to prevent S-!, etc. K.Shift -> K.NoModifier K.ControlShift -> K.Control _ -> modifier p <- SDL.getAbsoluteMouseLocation when (key == K.Esc) $ resetChanKey (fchanKey rf) saveKMP rf modifierNoShift key (pointTranslate p) SDL.MouseButtonEvent mouseButtonEvent | SDL.mouseButtonEventMotion mouseButtonEvent == SDL.Released -> do modifier <- modTranslate <$> SDL.getModState let key = case SDL.mouseButtonEventButton mouseButtonEvent of SDL.ButtonLeft -> K.LeftButtonRelease SDL.ButtonMiddle -> K.MiddleButtonRelease SDL.ButtonRight -> K.RightButtonRelease _ -> K.LeftButtonRelease -- any other is spare left p = SDL.mouseButtonEventPos mouseButtonEvent saveKMP rf modifier key (pointTranslate p) SDL.MouseWheelEvent mouseWheelEvent -> do modifier <- modTranslate <$> SDL.getModState let SDL.V2 _ y = SDL.mouseWheelEventPos mouseWheelEvent mkey = case (compare y 0, SDL.mouseWheelEventDirection mouseWheelEvent) of (EQ, _) -> Nothing (LT, SDL.ScrollNormal) -> Just K.WheelSouth (GT, SDL.ScrollNormal) -> Just K.WheelNorth (LT, SDL.ScrollFlipped) -> Just K.WheelNorth (GT, SDL.ScrollFlipped) -> Just K.WheelSouth p <- SDL.getAbsoluteMouseLocation maybe (return ()) (\key -> saveKMP rf modifier key (pointTranslate p)) mkey SDL.WindowClosedEvent{} -> forceShutdown sess SDL.QuitEvent -> forceShutdown sess SDL.WindowRestoredEvent{} -> redraw SDL.WindowExposedEvent{} -> redraw -- needed on Windows -- Probably not needed, because no textures nor their content lost: -- SDL.WindowShownEvent{} -> redraw _ -> return () loopSDL shutdown :: FrontendSession -> IO () shutdown FrontendSession{..} = writeIORef scontinueSdlLoop False forceShutdown :: FrontendSession -> IO () forceShutdown sess@FrontendSession{..} = do writeIORef sforcedShutdown True shutdown sess -- | Add a frame to be drawn. display :: FrontendSession -- ^ frontend session data -> SingleFrame -- ^ the screen frame to draw -> IO () display FrontendSession{..} curFrame = do continueSdlLoop <- readIORef scontinueSdlLoop if continueSdlLoop then do putMVar sframeQueue curFrame -- Wait until the frame is drawn. takeMVar sframeDrawn else do forcedShutdown <- readIORef sforcedShutdown when forcedShutdown $ -- When there's a forced shutdown, ignore displaying one frame -- and don't occupy the CPU creating new ones and moving on with the game -- (possibly also saving the new game state, surprising the player), -- but delay the server and client thread(s) for a long time -- and let the SDL-init thread clean up and exit via @exitSuccess@ -- to avoid exiting via "thread blocked". threadDelay 50000 drawFrame :: ClientOptions -- ^ client options -> FrontendSession -- ^ frontend session data -> SingleFrame -- ^ the screen frame to draw -> IO () drawFrame ClientOptions{..} FrontendSession{..} curFrame = do let isBitmapFile = "fon" `isSuffixOf` T.unpack (fromJust sdlFontFile) || "fnt" `isSuffixOf` T.unpack (fromJust sdlFontFile) || "bdf" `isSuffixOf` T.unpack (fromJust sdlFontFile) || "FON" `isSuffixOf` T.unpack (fromJust sdlFontFile) || "FNT" `isSuffixOf` T.unpack (fromJust sdlFontFile) || "BDF" `isSuffixOf` T.unpack (fromJust sdlFontFile) sdlSizeAdd = fromJust $ if isBitmapFile then sdlBitmapSizeAdd else sdlScalableSizeAdd boxSize <- (+ sdlSizeAdd) <$> TTF.height sfont let tt2 = Vect.V2 (toEnum boxSize) (toEnum boxSize) vp :: Int -> Int -> Vect.Point Vect.V2 CInt vp x y = Vect.P $ Vect.V2 (toEnum x) (toEnum y) drawHighlight !x !y !color = do SDL.rendererDrawColor srenderer SDL.$= colorToRGBA color let rect = SDL.Rectangle (vp (x * boxSize) (y * boxSize)) tt2 SDL.drawRect srenderer $ Just rect SDL.rendererDrawColor srenderer SDL.$= colorToRGBA Color.Black -- reset back to black chooseAndDrawHighlight !x !y !bg = case bg of Color.HighlightNone -> return () _ -> drawHighlight x y $ Color.highlightToColor bg setChar :: Int -> (Word32, Word32) -> IO Int setChar !i (!w, !wPrev) | w == wPrev = return $! i + 1 setChar i (w, _) = do atlas <- readIORef satlas let Point{..} = toEnum i Color.AttrChar{acAttr=Color.Attr{fg=fgRaw,bg}, acChar=acCharRaw} = Color.attrCharFromW32 $ Color.AttrCharW32 w fg | py `mod` 2 == 0 && fgRaw == Color.White = Color.AltWhite | otherwise = fgRaw ac = Color.attrChar2ToW32 fg acCharRaw -- textTexture <- case EM.lookup ac atlas of Nothing -> do -- Make all visible floors bold (no bold fold variant for 16x16x, -- so only the dot can be bold). let acChar = if not (Color.isBright fg) && acCharRaw == floorSymbol -- 0xb7 then if isBitmapFile then Char.chr 7 -- hack else Char.chr 8901 -- 0x22c5 else acCharRaw textSurfaceRaw <- TTF.shadedGlyph sfont (colorToRGBA fg) (colorToRGBA Color.Black) acChar Vect.V2 sw sh <- SDL.surfaceDimensions textSurfaceRaw let width = min boxSize $ fromEnum sw height = min boxSize $ fromEnum sh xsrc = max 0 (fromEnum sw - width) `div` 2 ysrc = max 0 (fromEnum sh - height) `div` 2 srcR = SDL.Rectangle (vp xsrc ysrc) (Vect.V2 (toEnum width) (toEnum height)) xtgt = (boxSize - width) `divUp` 2 ytgt = (boxSize - height) `div` 2 tgtR = vp xtgt ytgt textSurface <- SDL.createRGBSurface tt2 SDL.ARGB8888 SDL.surfaceFillRect textSurface Nothing (colorToRGBA Color.Black) -- We resize surface rather than texture to set the resulting -- texture as @TextureAccessStatic@ via @createTextureFromSurface@, -- which otherwise we wouldn't be able to do. void $ SDL.surfaceBlit textSurfaceRaw (Just srcR) textSurface (Just tgtR) SDL.freeSurface textSurfaceRaw textTexture <- SDL.createTextureFromSurface srenderer textSurface SDL.freeSurface textSurface writeIORef satlas $ EM.insert ac textTexture atlas return textTexture Just textTexture -> return textTexture let tgtR = SDL.Rectangle (vp (px * boxSize) (py * boxSize)) tt2 SDL.copy srenderer textTexture Nothing (Just tgtR) -- Potentially overwrite a portion of the glyph. chooseAndDrawHighlight px py bg return $! i + 1 texture <- readIORef stexture prevFrame <- readIORef spreviousFrame writeIORef spreviousFrame curFrame SDL.rendererRenderTarget srenderer SDL.$= Just texture SDL.rendererDrawColor srenderer SDL.$= colorToRGBA Color.Black U.foldM'_ setChar 0 $ U.zip (PointArray.avector $ singleFrame curFrame) (PointArray.avector $ singleFrame prevFrame) SDL.rendererRenderTarget srenderer SDL.$= Nothing SDL.copy srenderer texture Nothing Nothing -- clear the backbuffer SDL.present srenderer -- It can't seem to cope with SDL_PIXELFORMAT_INDEX8, so we are stuck -- with huge bitmaps. printScreen :: FrontendSession -> IO () printScreen FrontendSession{..} = do dataDir <- appDataDir tryCreateDir dataDir tryCreateDir $ dataDir "screenshots" utcTime <- getCurrentTime timezone <- getTimeZone utcTime let unspace = map $ \c -> case c of -- prevent the need for backquoting ' ' -> '_' ':' -> '.' _ -> c dateText = unspace $ take 25 $ show $ utcToLocalTime timezone utcTime fileName = dataDir "screenshots" "prtscn" <> dateText <.> "bmp" SDL.Internal.Types.Renderer renderer = srenderer Vect.V2 sw sh <- SDL.get $ SDL.windowSize swindow ptrOut <- SDL.Raw.Video.createRGBSurface 0 sw sh 32 0 0 0 0 surfaceOut <- peek ptrOut void $ SDL.Raw.Video.renderReadPixels renderer nullPtr SDL.Raw.Enum.SDL_PIXELFORMAT_ARGB8888 (SDL.Raw.Types.surfacePixels surfaceOut) (sw * 4) withCString fileName $ \fileNameCString -> void $! SDL.Raw.Video.saveBMP ptrOut fileNameCString SDL.Raw.Video.freeSurface ptrOut -- | Translates modifiers to our own encoding. modTranslate :: SDL.KeyModifier -> K.Modifier modTranslate m = modifierTranslate (SDL.keyModifierLeftCtrl m || SDL.keyModifierRightCtrl m) (SDL.keyModifierLeftShift m || SDL.keyModifierRightShift m) (SDL.keyModifierLeftAlt m || SDL.keyModifierRightAlt m || SDL.keyModifierAltGr m) False keyTranslate :: Bool -> SDL.Keycode -> K.Key keyTranslate shiftPressed n = case n of KeycodeEscape -> K.Esc KeycodeReturn -> K.Return KeycodeBackspace -> K.BackSpace KeycodeTab -> if shiftPressed then K.BackTab else K.Tab KeycodeSpace -> K.Space KeycodeExclaim -> K.Char '!' KeycodeQuoteDbl -> K.Char '"' KeycodeHash -> K.Char '#' KeycodePercent -> K.Char '%' KeycodeDollar -> K.Char '$' KeycodeAmpersand -> K.Char '&' KeycodeQuote -> if shiftPressed then K.Char '"' else K.Char '\'' KeycodeLeftParen -> K.Char '(' KeycodeRightParen -> K.Char ')' KeycodeAsterisk -> K.Char '*' KeycodePlus -> K.Char '+' KeycodeComma -> if shiftPressed then K.Char '<' else K.Char ',' KeycodeMinus -> if shiftPressed then K.Char '_' else K.Char '-' KeycodePeriod -> if shiftPressed then K.Char '>' else K.Char '.' KeycodeSlash -> if shiftPressed then K.Char '?' else K.Char '/' Keycode1 -> if shiftPressed then K.Char '!' else K.Char '1' Keycode2 -> if shiftPressed then K.Char '@' else K.Char '2' Keycode3 -> if shiftPressed then K.Char '#' else K.Char '3' Keycode4 -> if shiftPressed then K.Char '$' else K.Char '4' Keycode5 -> if shiftPressed then K.Char '%' else K.Char '5' Keycode6 -> if shiftPressed then K.Char '^' else K.Char '6' Keycode7 -> if shiftPressed then K.Char '&' else K.Char '7' Keycode8 -> if shiftPressed then K.Char '*' else K.Char '8' Keycode9 -> if shiftPressed then K.Char '(' else K.Char '9' Keycode0 -> if shiftPressed then K.Char ')' else K.Char '0' KeycodeColon -> K.Char ':' KeycodeSemicolon -> if shiftPressed then K.Char ':' else K.Char ';' KeycodeLess -> K.Char '<' KeycodeEquals -> if shiftPressed then K.Char '+' else K.Char '=' KeycodeGreater -> K.Char '>' KeycodeQuestion -> K.Char '?' KeycodeAt -> K.Char '@' KeycodeLeftBracket -> if shiftPressed then K.Char '{' else K.Char '[' KeycodeBackslash -> if shiftPressed then K.Char '|' else K.Char '\\' KeycodeRightBracket -> if shiftPressed then K.Char '}' else K.Char ']' KeycodeCaret -> K.Char '^' KeycodeUnderscore -> K.Char '_' KeycodeBackquote -> if shiftPressed then K.Char '~' else K.Char '`' KeycodeUp -> K.Up KeycodeDown -> K.Down KeycodeLeft -> K.Left KeycodeRight -> K.Right KeycodeHome -> K.Home KeycodeEnd -> K.End KeycodePageUp -> K.PgUp KeycodePageDown -> K.PgDn KeycodeInsert -> K.Insert KeycodeDelete -> K.Delete KeycodePrintScreen -> K.PrintScreen KeycodeClear -> K.Begin KeycodeKPClear -> K.Begin KeycodeKPDivide -> if shiftPressed then K.Char '?' else K.Char '/' -- KP and normal are merged here KeycodeKPMultiply -> K.KP '*' KeycodeKPMinus -> K.Char '-' -- KP and normal are merged here KeycodeKPPlus -> K.Char '+' -- KP and normal are merged here KeycodeKPEnter -> K.Return KeycodeKPEquals -> K.Return -- in case of some funny layouts KeycodeKP1 -> if shiftPressed then K.KP '1' else K.End KeycodeKP2 -> if shiftPressed then K.KP '2' else K.Down KeycodeKP3 -> if shiftPressed then K.KP '3' else K.PgDn KeycodeKP4 -> if shiftPressed then K.KP '4' else K.Left KeycodeKP5 -> if shiftPressed then K.KP '5' else K.Begin KeycodeKP6 -> if shiftPressed then K.KP '6' else K.Right KeycodeKP7 -> if shiftPressed then K.KP '7' else K.Home KeycodeKP8 -> if shiftPressed then K.KP '8' else K.Up KeycodeKP9 -> if shiftPressed then K.KP '9' else K.PgUp KeycodeKP0 -> if shiftPressed then K.KP '0' else K.Insert KeycodeKPPeriod -> K.Char '.' -- dot and comma are merged here KeycodeKPComma -> K.Char '.' -- to sidestep national standards KeycodeF1 -> K.Fun 1 KeycodeF2 -> K.Fun 2 KeycodeF3 -> K.Fun 3 KeycodeF4 -> K.Fun 4 KeycodeF5 -> K.Fun 5 KeycodeF6 -> K.Fun 6 KeycodeF7 -> K.Fun 7 KeycodeF8 -> K.Fun 8 KeycodeF9 -> K.Fun 9 KeycodeF10 -> K.Fun 10 KeycodeF11 -> K.Fun 11 KeycodeF12 -> K.Fun 12 KeycodeLCtrl -> K.DeadKey KeycodeLShift -> K.DeadKey KeycodeLAlt -> K.DeadKey KeycodeLGUI -> K.DeadKey KeycodeRCtrl -> K.DeadKey KeycodeRShift -> K.DeadKey KeycodeRAlt -> K.DeadKey KeycodeRGUI -> K.DeadKey KeycodeMode -> K.DeadKey KeycodeNumLockClear -> K.DeadKey KeycodeUnknown -> K.Unknown "KeycodeUnknown" _ -> let i = fromEnum $ unwrapKeycode n in if | 97 <= i && i <= 122 && shiftPressed -> K.Char $ Char.chr $ i - 32 | 32 <= i && i <= 126 -> K.Char $ Char.chr i | otherwise -> K.Unknown $ show n sDL_ALPHA_OPAQUE :: Word8 sDL_ALPHA_OPAQUE = 255 -- This code is sadly duplicated from "Game.LambdaHack.Definition.Color". colorToRGBA :: Color.Color -> SDL.V4 Word8 colorToRGBA Color.Black = SDL.V4 0 0 0 sDL_ALPHA_OPAQUE colorToRGBA Color.Red = SDL.V4 0xD5 0x05 0x05 sDL_ALPHA_OPAQUE colorToRGBA Color.Green = SDL.V4 0x05 0x9D 0x05 sDL_ALPHA_OPAQUE colorToRGBA Color.Brown = SDL.V4 0xCA 0x4A 0x05 sDL_ALPHA_OPAQUE colorToRGBA Color.Blue = SDL.V4 0x05 0x56 0xF4 sDL_ALPHA_OPAQUE colorToRGBA Color.Magenta = SDL.V4 0xAF 0x0E 0xAF sDL_ALPHA_OPAQUE colorToRGBA Color.Cyan = SDL.V4 0x05 0x96 0x96 sDL_ALPHA_OPAQUE colorToRGBA Color.White = SDL.V4 0xB8 0xBF 0xCB sDL_ALPHA_OPAQUE colorToRGBA Color.AltWhite = SDL.V4 0xC4 0xBE 0xB1 sDL_ALPHA_OPAQUE colorToRGBA Color.BrBlack = SDL.V4 0x6F 0x5F 0x5F sDL_ALPHA_OPAQUE colorToRGBA Color.BrRed = SDL.V4 0xFF 0x55 0x55 sDL_ALPHA_OPAQUE colorToRGBA Color.BrGreen = SDL.V4 0x65 0xF1 0x36 sDL_ALPHA_OPAQUE colorToRGBA Color.BrYellow = SDL.V4 0xEB 0xD6 0x42 sDL_ALPHA_OPAQUE colorToRGBA Color.BrBlue = SDL.V4 0x4D 0x98 0xF4 sDL_ALPHA_OPAQUE colorToRGBA Color.BrMagenta = SDL.V4 0xFF 0x77 0xFF sDL_ALPHA_OPAQUE colorToRGBA Color.BrCyan = SDL.V4 0x52 0xF4 0xE5 sDL_ALPHA_OPAQUE colorToRGBA Color.BrWhite = SDL.V4 0xFF 0xFF 0xFF sDL_ALPHA_OPAQUE LambdaHack-0.9.5.0/engine-src/Game/LambdaHack/Client/UI/Frontend/Teletype.hs0000644000000000000000000000547407346545000024350 0ustar0000000000000000-- | Line terminal text frontend based on stdin/stdout, intended for logging -- tests, but may be used on a teletype terminal, or with keyboard and printer. module Game.LambdaHack.Client.UI.Frontend.Teletype ( startup, frontendName ) where import Prelude () import Game.LambdaHack.Core.Prelude import Control.Concurrent.Async import Data.Char (chr, ord) import qualified System.IO as SIO import Game.LambdaHack.Client.UI.Content.Screen import Game.LambdaHack.Client.UI.Frame import Game.LambdaHack.Client.UI.Frontend.Common import qualified Game.LambdaHack.Client.UI.Key as K import qualified Game.LambdaHack.Definition.Color as Color import Game.LambdaHack.Common.Point import qualified Game.LambdaHack.Common.PointArray as PointArray import Game.LambdaHack.Content.TileKind (floorSymbol) -- No session data maintained by this frontend -- | The name of the frontend. frontendName :: String frontendName = "teletype" -- | Set up the frontend input and output. startup :: ScreenContent -> IO RawFrontend startup coscreen = do rf <- createRawFrontend coscreen (display coscreen) shutdown let storeKeys :: IO () storeKeys = do l <- SIO.getLine -- blocks here, so no polling let c = case l of [] -> '\n' -- empty line counts as RET hd : _ -> hd K.KM{..} = keyTranslate c saveKMP rf modifier key originPoint storeKeys void $ async storeKeys return $! rf shutdown :: IO () shutdown = SIO.hFlush SIO.stdout >> SIO.hFlush SIO.stderr -- | Output to the screen via the frontend. display :: ScreenContent -> SingleFrame -> IO () display coscreen SingleFrame{singleFrame} = let f w l = let acCharRaw = Color.charFromW32 w acChar = if acCharRaw == floorSymbol then '.' else acCharRaw in acChar : l levelChar = chunk $ PointArray.foldrA f [] singleFrame chunk [] = [] chunk l = let (ch, r) = splitAt (rwidth coscreen) l in ch : chunk r in SIO.hPutStrLn SIO.stderr $ unlines levelChar keyTranslate :: Char -> K.KM keyTranslate e = (\(key, modifier) -> K.KM modifier key) $ case e of '\ESC' -> (K.Esc, K.NoModifier) '\n' -> (K.Return, K.NoModifier) '\r' -> (K.Return, K.NoModifier) ' ' -> (K.Space, K.NoModifier) '\t' -> (K.Tab, K.NoModifier) c | ord '\^A' <= ord c && ord c <= ord '\^Z' -> -- Alas, only lower-case letters. (K.Char $ chr $ ord c - ord '\^A' + ord 'a', K.Control) -- Movement keys are more important than leader picking, -- so disabling the latter and interpreting the keypad numbers -- as movement: | c `elem` ['1'..'9'] -> (K.KP c, K.NoModifier) | otherwise -> (K.Char c, K.NoModifier) LambdaHack-0.9.5.0/engine-src/Game/LambdaHack/Client/UI/Frontend/Vty.hs0000644000000000000000000001323007346545000023324 0ustar0000000000000000-- | Text frontend based on Vty. module Game.LambdaHack.Client.UI.Frontend.Vty ( startup, frontendName ) where import Prelude () import Game.LambdaHack.Core.Prelude import Control.Concurrent.Async import Data.Ord (comparing) import Graphics.Vty import qualified Graphics.Vty as Vty import Game.LambdaHack.Client.ClientOptions import Game.LambdaHack.Client.UI.Content.Screen import Game.LambdaHack.Client.UI.Frame import Game.LambdaHack.Client.UI.Frontend.Common import qualified Game.LambdaHack.Client.UI.Key as K import Game.LambdaHack.Common.Point import qualified Game.LambdaHack.Common.PointArray as PointArray import Game.LambdaHack.Content.TileKind (floorSymbol) import qualified Game.LambdaHack.Definition.Color as Color -- | Session data maintained by the frontend. newtype FrontendSession = FrontendSession { svty :: Vty -- ^ internal vty session } -- | The name of the frontend. frontendName :: String frontendName = "vty" -- | Starts the main program loop using the frontend input and output. startup :: ScreenContent -> ClientOptions -> IO RawFrontend startup coscreen _soptions = do svty <- mkVty mempty let sess = FrontendSession{..} rf <- createRawFrontend coscreen (display coscreen sess) (Vty.shutdown svty) let storeKeys :: IO () storeKeys = do e <- nextEvent svty -- blocks here, so no polling case e of EvKey n mods -> saveKMP rf (modTranslate mods) (keyTranslate n) originPoint _ -> return () storeKeys void $ async storeKeys return $! rf -- | Output to the screen via the frontend. display :: ScreenContent -> FrontendSession -> SingleFrame -> IO () display coscreen FrontendSession{svty} SingleFrame{singleFrame} = do let img = foldr (<->) emptyImage . map (foldr (<|>) emptyImage . map (\w -> char (setAttr $ Color.attrFromW32 w) (squashChar $ Color.charFromW32 w))) $ chunk $ PointArray.toListA singleFrame pic1 = picForImage img Point{..} = PointArray.maxIndexByA (comparing Color.bgFromW32) singleFrame pic2 = pic1 {picCursor = AbsoluteCursor px py} chunk [] = [] chunk l = let (ch, r) = splitAt (rwidth coscreen) l in ch : chunk r update svty pic2 keyTranslate :: Key -> K.Key keyTranslate n = case n of KEsc -> K.Esc KEnter -> K.Return (KChar ' ') -> K.Space (KChar '\t') -> K.Tab KBackTab -> K.BackTab KBS -> K.BackSpace KUp -> K.Up KDown -> K.Down KLeft -> K.Left KRight -> K.Right KHome -> K.Home KEnd -> K.End KPageUp -> K.PgUp KPageDown -> K.PgDn KBegin -> K.Begin KCenter -> K.Begin KIns -> K.Insert -- S-KP_5 and C-KP_5 are still not correctly handled in vty -- on some terminals so we have to use 1--9 for movement instead of -- leader change. (KChar c) | c `elem` ['1'..'9'] -> K.KP c -- movement, not leader change | otherwise -> K.Char c _ -> K.Unknown (show n) -- | Translates modifiers to our own encoding. modTranslate :: [Modifier] -> K.Modifier modTranslate mods = modifierTranslate (MCtrl `elem` mods) (MShift `elem` mods) (MAlt `elem` mods) False -- A hack to get bright colors via the bold attribute. Depending on terminal -- settings this is needed or not and the characters really get bold or not. -- HSCurses does this by default, but in Vty you have to request the hack. hack :: Color.Color -> Attr -> Attr hack c a = if Color.isBright c then withStyle a bold else a setAttr :: Color.Attr -> Attr setAttr Color.Attr{..} = -- This optimization breaks display for white background terminals: -- if (fg, bg) == Color.defAttr -- then def_attr -- else let (fg1, bg1) = case bg of Color.HighlightNone -> (fg, Color.Black) Color.HighlightGreen -> if fg /= Color.Green then (fg, Color.Green) else (fg, Color.BrBlack) Color.HighlightBlue -> if fg /= Color.Blue then (fg, Color.Blue) else (fg, Color.BrBlack) Color.HighlightGrey -> if fg /= Color.BrBlack then (fg, Color.BrBlack) else (fg, Color.defFG) Color.HighlightWhite -> (fg, Color.Black) Color.HighlightMagenta -> (fg, Color.Black) Color.HighlightRed -> if fg /= Color.Red then (fg, Color.Red) else (fg, Color.defFG) Color.HighlightYellow -> (fg, Color.Black) -- cursor used instead Color.HighlightYellowAim -> (Color.Black, Color.defFG) Color.HighlightRedAim -> if fg /= Color.Red then (fg, Color.Red) else (fg, Color.defFG) Color.HighlightNoneCursor -> (fg, Color.Black) in hack fg1 $ hack bg1 $ defAttr { attrForeColor = SetTo (aToc fg1) , attrBackColor = SetTo (aToc bg1) } squashChar :: Char -> Char squashChar c = if c == floorSymbol then '.' else c aToc :: Color.Color -> Color aToc Color.Black = black aToc Color.Red = red aToc Color.Green = green aToc Color.Brown = yellow aToc Color.Blue = blue aToc Color.Magenta = magenta aToc Color.Cyan = cyan aToc Color.White = white aToc Color.AltWhite = white aToc Color.BrBlack = brightBlack aToc Color.BrRed = brightRed aToc Color.BrGreen = brightGreen aToc Color.BrYellow = brightYellow aToc Color.BrBlue = brightBlue aToc Color.BrMagenta = brightMagenta aToc Color.BrCyan = brightCyan aToc Color.BrWhite = brightWhite LambdaHack-0.9.5.0/engine-src/Game/LambdaHack/Client/UI/HandleHelperM.hs0000644000000000000000000007205107346545000023441 0ustar0000000000000000-- | Helper functions for both inventory management and human commands. module Game.LambdaHack.Client.UI.HandleHelperM ( FailError, showFailError, MError, mergeMError, FailOrCmd, failWith , failSer, failMsg, weaveJust , memberCycle, memberBack, partyAfterLeader, pickLeader, pickLeaderWithPointer , itemOverlay, skillsOverlay, placesFromState, placeParts, placesOverlay , pickNumber, lookAtItems, lookAtPosition , displayItemLore, viewLoreItems, cycleLore, spoilsBlurb #ifdef EXPOSE_INTERNAL -- * Internal operations , lookAtTile, lookAtActors #endif ) where import Prelude () import Game.LambdaHack.Core.Prelude import qualified Data.Char as Char import qualified Data.EnumMap.Strict as EM import qualified Data.EnumSet as ES import qualified Data.Text as T import qualified NLP.Miniutter.English as MU import Game.LambdaHack.Client.ClientOptions import Game.LambdaHack.Client.CommonM import Game.LambdaHack.Client.MonadClient import Game.LambdaHack.Client.State import Game.LambdaHack.Client.UI.ActorUI import Game.LambdaHack.Client.UI.Content.Screen import Game.LambdaHack.Client.UI.ContentClientUI import Game.LambdaHack.Client.UI.EffectDescription import Game.LambdaHack.Client.UI.ItemDescription import Game.LambdaHack.Client.UI.ItemSlot import qualified Game.LambdaHack.Client.UI.Key as K import Game.LambdaHack.Client.UI.MonadClientUI import Game.LambdaHack.Client.UI.Msg import Game.LambdaHack.Client.UI.MsgM import Game.LambdaHack.Client.UI.Overlay import Game.LambdaHack.Client.UI.SessionUI import Game.LambdaHack.Client.UI.Slideshow import Game.LambdaHack.Client.UI.SlideshowM import Game.LambdaHack.Common.Actor import Game.LambdaHack.Common.ActorState import Game.LambdaHack.Common.Faction import Game.LambdaHack.Common.Item import qualified Game.LambdaHack.Common.ItemAspect as IA import Game.LambdaHack.Common.Kind import Game.LambdaHack.Common.Level import Game.LambdaHack.Common.Misc import Game.LambdaHack.Common.MonadStateRead import Game.LambdaHack.Common.Perception import Game.LambdaHack.Common.Point import Game.LambdaHack.Common.ReqFailure import Game.LambdaHack.Common.State import Game.LambdaHack.Common.Time import Game.LambdaHack.Common.Types import qualified Game.LambdaHack.Content.ItemKind as IK import qualified Game.LambdaHack.Content.PlaceKind as PK import qualified Game.LambdaHack.Content.TileKind as TK import qualified Game.LambdaHack.Definition.Ability as Ability import qualified Game.LambdaHack.Definition.Color as Color import Game.LambdaHack.Definition.Defs -- | Message describing the cause of failure of human command. newtype FailError = FailError {failError :: Text} deriving Show showFailError :: FailError -> Text showFailError (FailError err) = "*" <> err <> "*" type MError = Maybe FailError mergeMError :: MError -> MError -> MError mergeMError Nothing Nothing = Nothing mergeMError merr1@Just{} Nothing = merr1 mergeMError Nothing merr2@Just{} = merr2 mergeMError (Just err1) (Just err2) = Just $ FailError $ failError err1 <+> "and" <+> failError err2 type FailOrCmd a = Either FailError a failWith :: MonadClientUI m => Text -> m (FailOrCmd a) failWith err = assert (not $ T.null err) $ return $ Left $ FailError err failSer :: MonadClientUI m => ReqFailure -> m (FailOrCmd a) failSer = failWith . showReqFailure failMsg :: MonadClientUI m => Text -> m MError failMsg err = assert (not $ T.null err) $ return $ Just $ FailError err weaveJust :: FailOrCmd a -> Either MError a weaveJust (Left ferr) = Left $ Just ferr weaveJust (Right a) = Right a -- | Switches current member to the next on the level, if any, wrapping. memberCycle :: MonadClientUI m => Bool -> m MError memberCycle verbose = do side <- getsClient sside fact <- getsState $ (EM.! side) . sfactionD lidV <- viewedLevelUI leader <- getLeaderUI body <- getsState $ getActorBody leader hs <- partyAfterLeader leader let (autoDun, _) = autoDungeonLevel fact case filter (\(_, b, _) -> blid b == lidV) hs of _ | autoDun && lidV /= blid body -> failMsg $ showReqFailure NoChangeDunLeader [] -> failMsg "cannot pick any other member on this level" (np, b, _) : _ -> do success <- pickLeader verbose np let !_A = assert (success `blame` "same leader" `swith` (leader, np, b)) () return Nothing -- | Switches current member to the previous in the whole dungeon, wrapping. memberBack :: MonadClientUI m => Bool -> m MError memberBack verbose = do side <- getsClient sside fact <- getsState $ (EM.! side) . sfactionD leader <- getLeaderUI hs <- partyAfterLeader leader let (autoDun, _) = autoDungeonLevel fact case reverse hs of _ | autoDun -> failMsg $ showReqFailure NoChangeDunLeader [] -> failMsg "no other member in the party" (np, b, _) : _ -> do success <- pickLeader verbose np let !_A = assert (success `blame` "same leader" `swith` (leader, np, b)) () return Nothing partyAfterLeader :: MonadClientUI m => ActorId -> m [(ActorId, Actor, ActorUI)] partyAfterLeader leader = do side <- getsState $ bfid . getActorBody leader sactorUI <- getsSession sactorUI allOurs <- getsState $ fidActorNotProjGlobalAssocs side -- not only on level let allOursUI = map (\(aid, b) -> (aid, b, sactorUI EM.! aid)) allOurs hs = sortOn keySelected allOursUI i = fromMaybe (-1) $ findIndex (\(aid, _, _) -> aid == leader) hs (lt, gt) = (take i hs, drop (i + 1) hs) return $! gt ++ lt -- | Select a faction leader. False, if nothing to do. pickLeader :: MonadClientUI m => Bool -> ActorId -> m Bool pickLeader verbose aid = do leader <- getLeaderUI saimMode <- getsSession saimMode if leader == aid then return False -- already picked else do body <- getsState $ getActorBody aid bodyUI <- getsSession $ getActorUI aid let !_A = assert (not (bproj body) `blame` "projectile chosen as the leader" `swith` (aid, body)) () -- Even if it's already the leader, give his proper name, not 'you'. let subject = partActor bodyUI when verbose $ msgAdd MsgDone $ makeSentence [subject, "picked as a leader"] -- Update client state. updateClientLeader aid -- Move the xhair, if active, to the new level. case saimMode of Nothing -> return () Just _ -> modifySession $ \sess -> sess {saimMode = Just $ AimMode $ blid body} -- Inform about items, etc. itemsBlurb <- lookAtItems True (bpos body) aid when verbose $ msgAdd MsgAtFeet itemsBlurb return True pickLeaderWithPointer :: MonadClientUI m => m MError pickLeaderWithPointer = do CCUI{coscreen=ScreenContent{rheight}} <- getsSession sccui lidV <- viewedLevelUI side <- getsClient sside fact <- getsState $ (EM.! side) . sfactionD arena <- getArenaUI sactorUI <- getsSession sactorUI ours <- getsState $ filter (not . bproj . snd) . actorAssocs (== side) lidV let oursUI = map (\(aid, b) -> (aid, b, sactorUI EM.! aid)) ours viewed = sortOn keySelected oursUI (autoDun, _) = autoDungeonLevel fact pick (aid, b) = if | blid b /= arena && autoDun -> failMsg $ showReqFailure NoChangeDunLeader | otherwise -> do void $ pickLeader True aid return Nothing Point{..} <- getsSession spointer -- Pick even if no space in status line for the actor's symbol. if | py == rheight - 1 && px == 0 -> memberBack True | py == rheight - 1 -> case drop (px - 1) viewed of [] -> return Nothing -- relaxed, due to subtleties of display of selected actors (aid, b, _) : _ -> pick (aid, b) | otherwise -> case find (\(_, b, _) -> bpos b == Point px (py - mapStartY)) oursUI of Nothing -> failMsg "not pointing at an actor" Just (aid, b, _) -> pick (aid, b) itemOverlay :: MonadClientUI m => SingleItemSlots -> LevelId -> ItemBag -> m OKX itemOverlay lSlots lid bag = do localTime <- getsState $ getLocalTime lid itemToF <- getsState $ flip itemToFull side <- getsClient sside factionD <- getsState sfactionD combGround <- getsState $ combinedGround side combOrgan <- getsState $ combinedOrgan side combEqp <- getsState $ combinedEqp side combInv <- getsState $ combinedInv side shaBag <- getsState $ \s -> gsha $ sfactionD s EM.! side discoBenefit <- getsClient sdiscoBenefit let !_A = assert (all (`elem` EM.elems lSlots) (EM.keys bag) `blame` (lid, bag, lSlots)) () markEqp iid t = if | (iid `EM.member` combOrgan || iid `EM.member` combEqp) && iid `EM.notMember` combInv && iid `EM.notMember` shaBag && iid `EM.notMember` combGround -> T.snoc (T.init t) ']' -- all ready to fight with | iid `EM.member` shaBag -> T.snoc (T.init t) '}' -- some spares in shared stash | otherwise -> t pr (l, iid) = case EM.lookup iid bag of Nothing -> Nothing Just kit@(k, _) -> let itemFull = itemToF iid colorSymbol = if isJust $ lookup "condition" $ IK.ifreq $ itemKind itemFull then let color = if benInEqp (discoBenefit EM.! iid) then Color.BrGreen else Color.BrRed in Color.attrChar2ToW32 color (IK.isymbol $ itemKind itemFull) else viewItem itemFull phrase = makePhrase [partItemWsRanged side factionD k localTime itemFull kit] al = textToAL (markEqp iid $ slotLabel l) <+:> [colorSymbol] <+:> textToAL phrase kx = (Right l, (undefined, 0, length al)) in Just ([al], kx) (ts, kxs) = unzip $ mapMaybe pr $ EM.assocs lSlots renumber y (km, (_, x1, x2)) = (km, (y, x1, x2)) return (concat ts, zipWith renumber [0..] kxs) skillsOverlay :: MonadClientRead m => ActorId -> m OKX skillsOverlay aid = do b <- getsState $ getActorBody aid actorMaxSk <- getsState $ getActorMaxSkills aid let prSlot :: (Y, SlotChar) -> Ability.Skill -> (Text, KYX) prSlot (y, c) skill = let skName = skillName skill fullText t = makePhrase [ MU.Text $ slotLabel c , MU.Text $ T.justifyLeft 22 ' ' skName , MU.Text t ] valueText = skillToDecorator skill b $ Ability.getSk skill actorMaxSk ft = fullText valueText in (ft, (Right c, (y, 0, T.length ft))) (ts, kxs) = unzip $ zipWith prSlot (zip [0..] allSlots) skillSlots return (map textToAL ts, kxs) placesFromState :: ContentData PK.PlaceKind -> ClientOptions -> State -> EM.EnumMap (ContentId PK.PlaceKind) (ES.EnumSet LevelId, Int, Int, Int) placesFromState coplace ClientOptions{sexposePlaces} = let addEntries (es1, ne1, na1, nd1) (es2, ne2, na2, nd2) = (ES.union es1 es2, ne1 + ne2, na1 + na2, nd1 + nd2) insertZeros !em !pk _ = EM.insert pk (ES.empty, 0, 0, 0) em initialPlaces | not sexposePlaces = EM.empty | otherwise = ofoldlWithKey' coplace insertZeros EM.empty placesFromLevel :: (LevelId, Level) -> EM.EnumMap (ContentId PK.PlaceKind) (ES.EnumSet LevelId, Int, Int, Int) placesFromLevel (lid, Level{lentry}) = let f (PK.PEntry pk) em = EM.insertWith addEntries pk (ES.singleton lid, 1, 0, 0) em f (PK.PAround pk) em = EM.insertWith addEntries pk (ES.singleton lid, 0, 1, 0) em f (PK.PEnd pk) em = EM.insertWith addEntries pk (ES.singleton lid, 0, 0, 1) em in EM.foldr' f initialPlaces lentry in EM.unionsWith addEntries . map placesFromLevel . EM.assocs . sdungeon placeParts :: (ES.EnumSet LevelId, Int, Int, Int) -> [MU.Part] placeParts (_, ne, na, nd) = ["(" <> MU.CarWs ne "entrance" <> ")" | ne > 0] ++ ["(" <> MU.CarWs na "surrounding" <> ")" | na > 0] ++ ["(" <> MU.CarWs nd "end" <> ")" | nd > 0] placesOverlay :: MonadClientRead m => m OKX placesOverlay = do COps{coplace} <- getsState scops soptions <- getsClient soptions places <- getsState $ placesFromState coplace soptions let prSlot :: (Y, SlotChar) -> (ContentId PK.PlaceKind, (ES.EnumSet LevelId, Int, Int, Int)) -> (Text, KYX) prSlot (y, c) (pk, (es, ne, na, nd)) = let placeName = PK.pname $ okind coplace pk parts = placeParts (es, ne, na, nd) markPlace t = if ne + na + nd == 0 then T.snoc (T.init t) '>' else t ft = makePhrase $ MU.Text (markPlace $ slotLabel c) : MU.Text placeName : parts in (ft, (Right c, (y, 0, T.length ft))) (ts, kxs) = unzip $ zipWith prSlot (zip [0..] allSlots) $ EM.assocs places return (map textToAL ts, kxs) pickNumber :: MonadClientUI m => Bool -> Int -> m (Either MError Int) pickNumber askNumber kAll = assert (kAll >= 1) $ do let shownKeys = [ K.returnKM, K.spaceKM, K.mkChar '+', K.mkChar '-' , K.backspaceKM, K.escKM ] frontKeyKeys = shownKeys ++ map K.mkChar ['0'..'9'] gatherNumber kCur = assert (1 <= kCur && kCur <= kAll) $ do let kprompt = "Choose number:" <+> tshow kCur promptAdd0 kprompt sli <- reportToSlideshow shownKeys ekkm <- displayChoiceScreen "" ColorFull False sli frontKeyKeys case ekkm of Left kkm -> case K.key kkm of K.Char '+' -> gatherNumber $ if kCur + 1 > kAll then 1 else kCur + 1 K.Char '-' -> gatherNumber $ if kCur - 1 < 1 then kAll else kCur - 1 K.Char l | kCur * 10 + Char.digitToInt l > kAll -> gatherNumber $ if Char.digitToInt l == 0 then kAll else min kAll (Char.digitToInt l) K.Char l -> gatherNumber $ kCur * 10 + Char.digitToInt l K.BackSpace -> gatherNumber $ max 1 (kCur `div` 10) K.Return -> return $ Right kCur K.Esc -> weaveJust <$> failWith "never mind" K.Space -> return $ Left Nothing _ -> error $ "unexpected key" `showFailure` kkm Right sc -> error $ "unexpected slot char" `showFailure` sc if | kAll == 1 || not askNumber -> return $ Right kAll | otherwise -> do res <- gatherNumber kAll case res of Right k | k <= 0 -> error $ "" `showFailure` (res, kAll) _ -> return res -- | Produces a textual description of the tile at a position. lookAtTile :: MonadClientUI m => Bool -- ^ can be seen right now? -> Point -- ^ position to describe -> ActorId -- ^ the actor that looks -> LevelId -- ^ level the position is at -> m Text lookAtTile canSee p aid lidV = do cops@COps{cotile, coplace} <- getsState scops side <- getsClient sside factionD <- getsState sfactionD b <- getsState $ getActorBody aid lvl <- getLevel lidV embeds <- getsState $ getEmbedBag lidV p itemToF <- getsState $ flip itemToFull seps <- getsClient seps mnewEps <- makeLine False b p seps localTime <- getsState $ getLocalTime lidV getKind <- getsState $ flip getIidKind let aims = isJust mnewEps tkid = lvl `at` p tile = okind cotile tkid vis | TK.tname tile == "unknown space" = "that is" | not canSee = "you remember" | not aims = "you are aware of" | otherwise = "you see" tilePart = MU.AW $ MU.Text $ TK.tname tile entrySentence pk blurb = makeSentence [blurb, MU.Text $ PK.pname $ okind coplace pk] elooks = case EM.lookup p $ lentry lvl of Nothing -> "" Just (PK.PEntry pk) -> entrySentence pk "it is an entrance to" Just (PK.PAround pk) -> entrySentence pk "it surrounds" Just (PK.PEnd pk) -> entrySentence pk "it ends" itemLook (iid, kit@(k, _)) = let itemFull = itemToF iid arItem = aspectRecordFull itemFull nWs = partItemWs side factionD k localTime itemFull kit verb = if k == 1 || IA.checkFlag Ability.Condition arItem then "is" else "are" ik = itemKind itemFull desc = IK.idesc ik in makeSentence ["There", verb, nWs] <+> desc ilooks = T.intercalate " " $ map itemLook $ sortEmbeds cops getKind tkid embeds return $! makeSentence [vis, tilePart] <+> elooks <+> ilooks -- | Produces a textual description of actors at a position. lookAtActors :: MonadClientUI m => Point -- ^ position to describe -> LevelId -- ^ level the position is at -> m Text lookAtActors p lidV = do side <- getsClient sside inhabitants <- getsState $ \s -> posToAidAssocs p lidV s sactorUI <- getsSession sactorUI let inhabitantsUI = map (\(aid2, b2) -> (aid2, b2, sactorUI EM.! aid2)) inhabitants factionD <- getsState sfactionD localTime <- getsState $ getLocalTime lidV s <- getState let actorsBlurb = case inhabitants of [] -> "" (_, body) : rest -> let itemFull = itemToFull (btrunk body) s bfact = factionD EM.! bfid body -- Even if it's the leader, give his proper name, not 'you'. subjects = map (\(_, _, bUI) -> partActor bUI) inhabitantsUI -- No "a" prefix even if singular and inanimate, to distinguish -- from items lying on the floor (and to simplify code). (subject, person) = squashedWWandW subjects resideVerb = case bwatch body of WWatch -> "be here" WWait 0 -> "idle here" WWait _ -> "brace for impact" WSleep -> "sleep here" WWake -> "be waking up" guardVerbs = guardItemVerbs body bfact s verbs = resideVerb : guardVerbs projDesc | not $ bproj body = "" | otherwise = let kit = beqp body EM.! btrunk body ps = [partItemMediumAW side factionD localTime itemFull kit] tailWords = tail . T.words . makePhrase in if tailWords ps == tailWords subjects then "" else makeSentence $ "this is" : ps factDesc = case jfid $ itemBase itemFull of Just tfid | tfid /= bfid body -> let dominatedBy = if bfid body == side then "us" else gname bfact tfact = factionD EM.! tfid in "Originally of" <+> gname tfact <> ", now fighting for" <+> dominatedBy <> "." _ | bfid body == side -> "" -- just one of us _ | bproj body -> "Launched by" <+> gname bfact <> "." _ -> "One of" <+> gname bfact <> "." idesc = IK.idesc $ itemKind itemFull -- If many different actors, only list names. sameTrunks = all (\(_, b) -> btrunk b == btrunk body) rest desc = if sameTrunks then projDesc <+> factDesc <+> idesc else "" -- Both description and faction blurb may be empty. pdesc = if desc == "" then "" else "(" <> desc <> ")" onlyIs = bwatch body == WWatch && null guardVerbs in if | bhp body <= 0 && not (bproj body) -> makeSentence (MU.SubjectVerbSg (head subjects) "lie here" : if null guardVerbs then [] else [ MU.SubjectVVxV "and" MU.Sg3rd MU.No "and" guardVerbs , "any more" ]) <+> case subjects of _ : projs@(_ : _) -> let (subjectProjs, personProjs) = squashedWWandW projs in makeSentence [MU.SubjectVerb personProjs MU.Yes subjectProjs "can be seen"] _ -> "" | null rest || onlyIs -> makeSentence [MU.SubjectVVxV "and" person MU.Yes subject verbs] <+> pdesc | otherwise -> makeSentence [subject, "can be seen"] <+> if onlyIs then "" else makeSentence [MU.SubjectVVxV "and" MU.Sg3rd MU.Yes (head subjects) verbs] return $! actorsBlurb guardItemVerbs :: Actor -> Faction -> State -> [MU.Part] guardItemVerbs body _fact s = -- In reality, currently the client knows all the items -- in eqp and inv of the foe, but we may remove the knowledge -- in the future and, anyway, it would require a dedicated -- UI mode beyond a couple of items per actor. -- -- OTOH, shares stash is currently secret for other factions, so that -- case would never be triggered except for our own actors. -- We may want to relax that secrecy, but there are technical hurdles. let toReport iid = let itemKind = getIidKind iid s in fromMaybe 0 (lookup "unreported inventory" (IK.ifreq itemKind)) <= 0 itemsSize = length $ filter toReport $ EM.keys (beqp body) ++ EM.keys (binv body) belongingsVerbs | itemsSize == 1 = ["fondle a trinket"] | itemsSize > 1 = ["guard a hoard"] | otherwise = [] in if bproj body then [] else belongingsVerbs -- ++ ["defend a shared stash" | not $ EM.null $ gsha fact] -- | Produces a textual description of items at a position. lookAtItems :: MonadClientUI m => Bool -- ^ can be seen right now? -> Point -- ^ position to describe -> ActorId -- ^ the actor that looks -> m Text lookAtItems canSee p aid = do itemToF <- getsState $ flip itemToFull b <- getsState $ getActorBody aid -- Not using @viewedLevelUI@, because @aid@ may be temporarily not a leader. saimMode <- getsSession saimMode let lidV = maybe (blid b) aimLevelId saimMode localTime <- getsState $ getLocalTime lidV subject <- partActorLeader aid is <- getsState $ getFloorBag lidV p side <- getsClient sside factionD <- getsState sfactionD let standingOn = p == bpos b && lidV == blid b verb = MU.Text $ if | standingOn -> if bhp b > 0 then "stand on" else "fall over" | canSee -> "notice" | otherwise -> "remember" nWs (iid, kit@(k, _)) = partItemWs side factionD k localTime (itemToF iid) kit object = case EM.assocs is of ii : _ : _ : _ | standingOn && bfid b == side -> MU.Phrase [nWs ii, "and other items"] -- the actor is ours, so can see details with inventory commands iis -> MU.WWandW $ map nWs iis -- Here @squashedWWandW@ is not needed, because identical items at the same -- position are already merged in the floor item bag and multiple identical -- messages concerning different positions are merged with -- to distinguish from a stack of items at a single position. return $! if EM.null is then "" else makeSentence [MU.SubjectVerbSg subject verb, object] -- | Produces a textual description of everything at the requested -- level's position. lookAtPosition :: MonadClientUI m => LevelId -> Point -> m Text lookAtPosition lidV p = do leader <- getLeaderUI per <- getPerFid lidV let canSee = ES.member p (totalVisible per) -- Show general info about current position. tileBlurb <- lookAtTile canSee p leader lidV actorsBlurb <- lookAtActors p lidV itemsBlurb <- lookAtItems canSee p leader Level{lsmell, ltime} <- getLevel lidV let smellBlurb = case EM.lookup p lsmell of Just sml | sml > ltime -> let Delta t = smellTimeout `timeDeltaSubtract` (sml `timeDeltaToFrom` ltime) seconds = t `timeFitUp` timeSecond in "A smelly body passed here around" <+> tshow seconds <> "s ago." _ -> "" return $! tileBlurb <+> actorsBlurb <+> itemsBlurb <+> smellBlurb displayItemLore :: MonadClientUI m => ItemBag -> Int -> (ItemId -> ItemFull -> Int -> Text) -> Int -> SingleItemSlots -> m Bool displayItemLore itemBag meleeSkill promptFun slotIndex lSlots = do CCUI{coscreen=ScreenContent{rwidth, rheight}} <- getsSession sccui side <- getsClient sside arena <- getArenaUI let lSlotsElems = EM.elems lSlots lSlotsBound = length lSlotsElems - 1 iid2 = lSlotsElems !! slotIndex kit2@(k, _) = itemBag EM.! iid2 itemFull2 <- getsState $ itemToFull iid2 localTime <- getsState $ getLocalTime arena factionD <- getsState sfactionD -- The hacky level 0 marks items never seen, but sent by server at gameover. jlid <- getsSession $ fromMaybe (toEnum 0) <$> EM.lookup iid2 . sitemUI let attrLine = itemDesc True side factionD meleeSkill CGround localTime jlid itemFull2 kit2 ov = splitAttrLine rwidth attrLine keys = [K.spaceKM, K.escKM] ++ [K.upKM | slotIndex /= 0] ++ [K.downKM | slotIndex /= lSlotsBound] promptAdd0 $ promptFun iid2 itemFull2 k slides <- overlayToSlideshow (rheight - 2) keys (ov, []) km <- getConfirms ColorFull keys slides case K.key km of K.Space -> return True K.Up -> displayItemLore itemBag meleeSkill promptFun (slotIndex - 1) lSlots K.Down -> displayItemLore itemBag meleeSkill promptFun (slotIndex + 1) lSlots K.Esc -> return False _ -> error $ "" `showFailure` km viewLoreItems :: MonadClientUI m => String -> SingleItemSlots -> ItemBag -> Text -> (Int -> SingleItemSlots -> m Bool) -> m K.KM viewLoreItems menuName lSlotsRaw trunkBag prompt examItem = do CCUI{coscreen=ScreenContent{rheight}} <- getsSession sccui arena <- getArenaUI itemToF <- getsState $ flip itemToFull let keysPre = [K.spaceKM, K.mkChar '/', K.mkChar '?', K.escKM] lSlots = sortSlotMap itemToF lSlotsRaw promptAdd0 prompt io <- itemOverlay lSlots arena trunkBag itemSlides <- overlayToSlideshow (rheight - 2) keysPre io let keyOfEKM (Left km) = km keyOfEKM (Right SlotChar{slotChar}) = [K.mkChar slotChar] allOKX = concatMap snd $ slideshow itemSlides keysMain = keysPre ++ concatMap (keyOfEKM . fst) allOKX viewAtSlot slot = do let ix0 = fromMaybe (error $ show slot) (findIndex (== slot) $ EM.keys lSlots) go2 <- examItem ix0 lSlots if go2 then viewLoreItems menuName lSlots trunkBag prompt examItem else return K.escKM ekm <- displayChoiceScreen menuName ColorFull False itemSlides keysMain case ekm of Left km | km == K.spaceKM -> return km Left km | km == K.mkChar '/' -> return km Left km | km == K.mkChar '?' -> return km Left km | km == K.escKM -> return km Left K.KM{key=K.Char l} -> viewAtSlot $ SlotChar 0 l -- other prefixes are not accessible via keys; tough luck; waste of effort Left km -> error $ "" `showFailure` km Right slot -> viewAtSlot slot cycleLore :: MonadClientUI m => [m K.KM] -> [m K.KM] -> m () cycleLore _ [] = return () cycleLore seen (m : rest) = do -- @seen@ is needed for SPACE to end cycling km <- m if | km == K.spaceKM -> cycleLore (m : seen) rest | km == K.mkChar '/' -> if null rest then cycleLore [] (reverse $ m : seen) else cycleLore (m : seen) rest | km == K.mkChar '?' -> case seen of prev : ps -> cycleLore ps (prev : m : rest) [] -> case reverse (m : rest) of prev : ps -> cycleLore ps [prev] [] -> error "cycleLore: screens disappeared" | km == K.escKM -> return () | otherwise -> error "cycleLore: unexpected key" spoilsBlurb :: Text -> Int -> Int -> Text spoilsBlurb currencyName total dungeonTotal = if | dungeonTotal == 0 -> "All your spoils are of the practical kind." | total == 0 -> "You haven't found any genuine treasure yet." | otherwise -> makeSentence [ "your spoils are worth" , MU.CarAWs total $ MU.Text currencyName , "out of the rumoured total" , MU.Cardinal dungeonTotal ] LambdaHack-0.9.5.0/engine-src/Game/LambdaHack/Client/UI/HandleHumanGlobalM.hs0000644000000000000000000020722307346545000024414 0ustar0000000000000000-- | Semantics of "Game.LambdaHack.Client.UI.HumanCmd" -- client commands that return server requests. -- A couple of them do not take time, the rest does. -- Here prompts and menus are displayed, but any feedback resulting -- from the commands (e.g., from inventory manipulation) is generated later on, -- by the server, for all clients that witness the results of the commands. module Game.LambdaHack.Client.UI.HandleHumanGlobalM ( -- * Meta commands byAreaHuman, byAimModeHuman , composeIfLocalHuman, composeUnlessErrorHuman, compose2ndLocalHuman , loopOnNothingHuman, executeIfClearHuman -- * Global commands that usually take time , waitHuman, waitHuman10, yellHuman, moveRunHuman , runOnceAheadHuman, moveOnceToXhairHuman , runOnceToXhairHuman, continueToXhairHuman , moveItemHuman, projectHuman, applyHuman , alterDirHuman, alterWithPointerHuman , helpHuman, hintHuman, dashboardHuman, itemMenuHuman, chooseItemMenuHuman , mainMenuHuman, mainMenuAutoOnHuman, mainMenuAutoOffHuman , settingsMenuHuman, challengesMenuHuman , gameScenarioIncr, gameDifficultyIncr, gameWolfToggle, gameFishToggle -- * Global commands that never take time , gameRestartHuman, gameQuitHuman, gameDropHuman, gameExitHuman, gameSaveHuman , tacticHuman, automateHuman, automateToggleHuman, automateBackHuman #ifdef EXPOSE_INTERNAL -- * Internal operations , areaToRectangles, meleeAid, displaceAid, moveSearchAlter, goToXhair , multiActorGoTo, moveOrSelectItem, selectItemsToMove, moveItems, projectItem , applyItem, alterTile, alterTileAtPos, verifyAlters, verifyEscape, guessAlter , artWithVersion, generateMenu, nxtGameMode #endif ) where import Prelude () import Game.LambdaHack.Core.Prelude -- Cabal import qualified Paths_LambdaHack as Self (version) import qualified Data.EnumMap.Strict as EM import qualified Data.EnumSet as ES import qualified Data.Map.Strict as M import qualified Data.Text as T import Data.Version import qualified NLP.Miniutter.English as MU import Game.LambdaHack.Client.Bfs import Game.LambdaHack.Client.BfsM import Game.LambdaHack.Client.CommonM import Game.LambdaHack.Client.MonadClient import Game.LambdaHack.Client.Request import Game.LambdaHack.Client.State import Game.LambdaHack.Client.UI.ActorUI import Game.LambdaHack.Client.UI.Content.Input import Game.LambdaHack.Client.UI.Content.Screen import Game.LambdaHack.Client.UI.ContentClientUI import Game.LambdaHack.Client.UI.FrameM import Game.LambdaHack.Client.UI.Frontend (frontendName) import Game.LambdaHack.Client.UI.HandleHelperM import Game.LambdaHack.Client.UI.HandleHumanLocalM import Game.LambdaHack.Client.UI.HumanCmd import Game.LambdaHack.Client.UI.InventoryM import Game.LambdaHack.Client.UI.ItemDescription import qualified Game.LambdaHack.Client.UI.Key as K import Game.LambdaHack.Client.UI.KeyBindings import Game.LambdaHack.Client.UI.MonadClientUI import Game.LambdaHack.Client.UI.Msg import Game.LambdaHack.Client.UI.MsgM import Game.LambdaHack.Client.UI.Overlay import Game.LambdaHack.Client.UI.RunM import Game.LambdaHack.Client.UI.SessionUI import Game.LambdaHack.Client.UI.Slideshow import Game.LambdaHack.Client.UI.SlideshowM import Game.LambdaHack.Client.UI.UIOptions import Game.LambdaHack.Common.Actor import Game.LambdaHack.Common.ActorState import Game.LambdaHack.Common.Area import Game.LambdaHack.Common.Faction import Game.LambdaHack.Common.Item import qualified Game.LambdaHack.Common.ItemAspect as IA import Game.LambdaHack.Common.Kind import Game.LambdaHack.Common.Level import Game.LambdaHack.Common.Misc import Game.LambdaHack.Common.MonadStateRead import Game.LambdaHack.Common.Point import Game.LambdaHack.Common.ReqFailure import Game.LambdaHack.Common.State import qualified Game.LambdaHack.Common.Tile as Tile import Game.LambdaHack.Common.Types import Game.LambdaHack.Common.Vector import qualified Game.LambdaHack.Content.ItemKind as IK import Game.LambdaHack.Content.ModeKind import Game.LambdaHack.Content.RuleKind import Game.LambdaHack.Content.TileKind (TileKind) import qualified Game.LambdaHack.Content.TileKind as TK import Game.LambdaHack.Core.Random import qualified Game.LambdaHack.Definition.Ability as Ability import Game.LambdaHack.Definition.Defs -- * ByArea -- | Pick command depending on area the mouse pointer is in. -- The first matching area is chosen. If none match, only interrupt. byAreaHuman :: MonadClientUI m => (HumanCmd -> m (Either MError ReqUI)) -> [(CmdArea, HumanCmd)] -> m (Either MError ReqUI) byAreaHuman cmdAction l = do pointer <- getsSession spointer let pointerInArea a = do rs <- areaToRectangles a return $! any (inside pointer) $ catMaybes rs cmds <- filterM (pointerInArea . fst) l case cmds of [] -> do stopPlayBack return $ Left Nothing (_, cmd) : _ -> cmdAction cmd -- Many values here are shared with "Game.LambdaHack.Client.UI.DrawM". areaToRectangles :: MonadClientUI m => CmdArea -> m [Maybe Area] areaToRectangles ca = map toArea <$> do CCUI{coscreen=ScreenContent{rwidth, rheight}} <- getsSession sccui case ca of CaMessage -> return [(0, 0, rwidth - 1, 0)] CaMapLeader -> do -- takes preference over @CaMapParty@ and @CaMap@ leader <- getLeaderUI b <- getsState $ getActorBody leader let Point{..} = bpos b return [(px, mapStartY + py, px, mapStartY + py)] CaMapParty -> do -- takes preference over @CaMap@ lidV <- viewedLevelUI side <- getsClient sside ours <- getsState $ filter (not . bproj) . map snd . actorAssocs (== side) lidV let rectFromB Point{..} = (px, mapStartY + py, px, mapStartY + py) return $! map (rectFromB . bpos) ours CaMap -> return [( 0, mapStartY, rwidth - 1, mapStartY + rheight - 4 )] CaLevelNumber -> let y = rheight - 2 in return [(0, y, 1, y)] CaArenaName -> let y = rheight - 2 x = (rwidth - 1) `div` 2 - 11 in return [(3, y, x, y)] CaPercentSeen -> let y = rheight - 2 x = (rwidth - 1) `div` 2 in return [(x - 9, y, x, y)] CaXhairDesc -> let y = rheight - 2 x = (rwidth - 1) `div` 2 + 2 in return [(x, y, rwidth - 1, y)] CaSelected -> let y = rheight - 1 x = (rwidth - 1) `div` 2 in return [(0, y, x - 24, y)] CaCalmGauge -> let y = rheight - 1 x = (rwidth - 1) `div` 2 in return [(x - 22, y, x - 18, y)] CaCalmValue -> let y = rheight - 1 x = (rwidth - 1) `div` 2 in return [(x - 17, y, x - 11, y)] CaHPGauge -> let y = rheight - 1 x = (rwidth - 1) `div` 2 in return [(x - 9, y, x - 6, y)] CaHPValue -> let y = rheight - 1 x = (rwidth - 1) `div` 2 in return [(x - 6, y, x, y)] CaLeaderDesc -> let y = rheight - 1 x = (rwidth - 1) `div` 2 + 2 in return [(x, y, rwidth - 1, y)] -- * ByAimMode byAimModeHuman :: MonadClientUI m => m (Either MError ReqUI) -> m (Either MError ReqUI) -> m (Either MError ReqUI) byAimModeHuman cmdNotAimingM cmdAimingM = do aimMode <- getsSession saimMode if isNothing aimMode then cmdNotAimingM else cmdAimingM -- * ComposeIfLocal composeIfLocalHuman :: MonadClientUI m => m (Either MError ReqUI) -> m (Either MError ReqUI) -> m (Either MError ReqUI) composeIfLocalHuman c1 c2 = do slideOrCmd1 <- c1 case slideOrCmd1 of Left merr1 -> do slideOrCmd2 <- c2 case slideOrCmd2 of Left merr2 -> return $ Left $ mergeMError merr1 merr2 _ -> return slideOrCmd2 _ -> return slideOrCmd1 -- * ComposeUnlessError composeUnlessErrorHuman :: MonadClientUI m => m (Either MError ReqUI) -> m (Either MError ReqUI) -> m (Either MError ReqUI) composeUnlessErrorHuman c1 c2 = do slideOrCmd1 <- c1 case slideOrCmd1 of Left Nothing -> c2 _ -> return slideOrCmd1 -- * Compose2ndLocal compose2ndLocalHuman :: MonadClientUI m => m (Either MError ReqUI) -> m (Either MError ReqUI) -> m (Either MError ReqUI) compose2ndLocalHuman c1 c2 = do slideOrCmd1 <- c1 case slideOrCmd1 of Left merr1 -> do slideOrCmd2 <- c2 case slideOrCmd2 of Left merr2 -> return $ Left $ mergeMError merr1 merr2 _ -> return slideOrCmd1 -- ignore second request, keep effect req -> do void c2 -- ignore second request, keep effect return req -- * LoopOnNothing loopOnNothingHuman :: MonadClientUI m => m (Either MError ReqUI) -> m (Either MError ReqUI) loopOnNothingHuman cmd = do res <- cmd case res of Left Nothing -> loopOnNothingHuman cmd _ -> return res -- * ExecuteIfClear executeIfClearHuman :: MonadClientUI m => m (Either MError ReqUI) -> m (Either MError ReqUI) executeIfClearHuman c1 = do sreportNull <- getsSession sreportNull if sreportNull then c1 else return $ Left Nothing -- * Wait -- | Leader waits a turn (and blocks, etc.). waitHuman :: MonadClientUI m => m (FailOrCmd RequestTimed) waitHuman = do actorSk <- leaderSkillsClientUI if Ability.getSk Ability.SkWait actorSk > 0 then do modifySession $ \sess -> sess {swaitTimes = abs (swaitTimes sess) + 1} return $ Right ReqWait else failSer WaitUnskilled -- * Wait10 -- | Leader waits a 1/10th of a turn (and doesn't block, etc.). waitHuman10 :: MonadClientUI m => m (FailOrCmd RequestTimed) waitHuman10 = do actorSk <- leaderSkillsClientUI if Ability.getSk Ability.SkWait actorSk >= 4 then do modifySession $ \sess -> sess {swaitTimes = abs (swaitTimes sess) + 1} return $ Right ReqWait10 else failSer WaitUnskilled -- * Yell -- | Leader yells or yawns, if sleeping. yellHuman :: MonadClientUI m => m (FailOrCmd RequestTimed) yellHuman = do actorSk <- leaderSkillsClientUI if Ability.getSk Ability.SkWait actorSk > 0 -- If waiting drained and really, potentially, no other possible action, -- still allow yelling. || Ability.getSk Ability.SkMove actorSk <= 0 || Ability.getSk Ability.SkDisplace actorSk <= 0 || Ability.getSk Ability.SkMelee actorSk <= 0 then return $ Right ReqYell else failSer WaitUnskilled -- * MoveDir and RunDir moveRunHuman :: (MonadClient m, MonadClientUI m) => Bool -> Bool -> Bool -> Bool -> Vector -> m (FailOrCmd RequestTimed) moveRunHuman initialStep finalGoal run runAhead dir = do actorSk <- leaderSkillsClientUI arena <- getArenaUI leader <- getLeaderUI sb <- getsState $ getActorBody leader fact <- getsState $ (EM.! bfid sb) . sfactionD -- Start running in the given direction. The first turn of running -- succeeds much more often than subsequent turns, because we ignore -- most of the disturbances, since the player is mostly aware of them -- and still explicitly requests a run, knowing how it behaves. sel <- getsSession sselected let runMembers = if runAhead || noRunWithMulti fact then [leader] else ES.toList (ES.delete leader sel) ++ [leader] runParams = RunParams { runLeader = leader , runMembers , runInitial = True , runStopMsg = Nothing , runWaiting = 0 } macroRun25 = ["C-comma", "C-V"] when (initialStep && run) $ do modifySession $ \cli -> cli {srunning = Just runParams} when runAhead $ modifySession $ \cli -> cli {slastPlay = map K.mkKM macroRun25 ++ slastPlay cli} -- When running, the invisible actor is hit (not displaced!), -- so that running in the presence of roving invisible -- actors is equivalent to moving (with visible actors -- this is not a problem, since runnning stops early enough). let tpos = bpos sb `shift` dir -- We start by checking actors at the target position, -- which gives a partial information (actors can be invisible), -- as opposed to accessibility (and items) which are always accurate -- (tiles can't be invisible). tgts <- getsState $ posToAidAssocs tpos arena case tgts of [] -> do -- move or search or alter runStopOrCmd <- moveSearchAlter run dir case runStopOrCmd of Left stopMsg -> return $ Left stopMsg Right runCmd -> -- Don't check @initialStep@ and @finalGoal@ -- and don't stop going to target: door opening is mundane enough. return $ Right runCmd [(target, _)] | run && initialStep && Ability.getSk Ability.SkDisplace actorSk > 0 -> -- No @stopPlayBack@: initial displace is benign enough. -- Displacing requires accessibility, but it's checked later on. displaceAid target _ : _ : _ | run && initialStep && Ability.getSk Ability.SkDisplace actorSk > 0 -> failSer DisplaceMultiple (target, tb) : _ | not run && initialStep && finalGoal && bfid tb == bfid sb && not (bproj tb) -> do stopPlayBack -- don't ever auto-repeat leader choice -- We always see actors from our own faction. -- Select one of adjacent actors by bumping into him. Takes no time. success <- pickLeader True target let !_A = assert (success `blame` "bump self" `swith` (leader, target, tb)) () failWith "by bumping" (target, tb) : _ | not run && initialStep && finalGoal && (bfid tb /= bfid sb || bproj tb) && Ability.getSk Ability.SkMelee actorSk > 0 -> do stopPlayBack -- don't ever auto-repeat melee -- No problem if there are many projectiles at the spot. We just -- attack the first one. meleeAid target _ : _ -> failWith "actor in the way" -- | Actor attacks an enemy actor or his own projectile. meleeAid :: (MonadClient m, MonadClientUI m) => ActorId -> m (FailOrCmd RequestTimed) meleeAid target = do leader <- getLeaderUI sb <- getsState $ getActorBody leader tb <- getsState $ getActorBody target sfact <- getsState $ (EM.! bfid sb) . sfactionD mel <- pickWeaponClient leader target case mel of Nothing -> failWith "nothing to melee with" Just wp -> do let returnCmd = do -- Set personal target to enemy, so that AI, if it takes over -- the actor, is likely to continue the fight even if the foe flees. modifyClient $ updateTarget leader $ const $ Just $ TEnemy target -- Also set xhair to see the foe's HP, because it's automatically -- set to any new spotted actor, so it needs to be reset -- and also it's not useful as permanent ranged target anyway. modifySession $ \sess -> sess {sxhair = Just $ TEnemy target} return $ Right wp res | bproj tb || isFoe (bfid sb) sfact (bfid tb) = returnCmd | isFriend (bfid sb) sfact (bfid tb) = do let !_A = assert (bfid sb /= bfid tb) () go1 <- displayYesNo ColorBW "You are bound by an alliance. Really attack?" if not go1 then failWith "attack canceled" else returnCmd | otherwise = do go2 <- displayYesNo ColorBW "This attack will start a war. Are you sure?" if not go2 then failWith "attack canceled" else returnCmd res -- Seeing the actor prevents altering a tile under it, but that -- does not limit the player, he just doesn't waste a turn -- on a failed altering. -- | Actor swaps position with another. displaceAid :: MonadClientUI m => ActorId -> m (FailOrCmd RequestTimed) displaceAid target = do COps{coTileSpeedup} <- getsState scops leader <- getLeaderUI sb <- getsState $ getActorBody leader tb <- getsState $ getActorBody target let dozes = bwatch tb `elem` [WSleep, WWake] tfact <- getsState $ (EM.! bfid tb) . sfactionD actorMaxSk <- getsState $ getActorMaxSkills target dEnemy <- getsState $ dispEnemy leader target actorMaxSk let immobile = Ability.getSk Ability.SkMove actorMaxSk <= 0 tpos = bpos tb adj = checkAdjacent sb tb atWar = isFoe (bfid tb) tfact (bfid sb) if | not adj -> failSer DisplaceDistant | not (bproj tb) && atWar && actorDying tb -> failSer DisplaceDying | not (bproj tb) && atWar && actorWaits tb -> failSer DisplaceBraced | not (bproj tb) && atWar && immobile && not dozes -> -- roots weak if the tree sleeps failSer DisplaceImmobile | not dEnemy && atWar -> failSer DisplaceSupported | otherwise -> do let lid = blid sb lvl <- getLevel lid -- Displacing requires full access. if Tile.isWalkable coTileSpeedup $ lvl `at` tpos then case posToAidsLvl tpos lvl of [] -> error $ "" `showFailure` (leader, sb, target, tb) [_] -> return $ Right $ ReqDisplace target _ -> failSer DisplaceMultiple else failSer DisplaceAccess -- | Leader moves or searches or alters. No visible actor at the position. moveSearchAlter :: MonadClientUI m => Bool -> Vector -> m (FailOrCmd RequestTimed) moveSearchAlter run dir = do COps{cotile, coTileSpeedup} <- getsState scops actorSk <- leaderSkillsClientUI leader <- getLeaderUI sb <- getsState $ getActorBody leader actorMaxSk <- getsState $ getActorMaxSkills leader let calmE = calmEnough sb actorMaxSk moveSkill = Ability.getSk Ability.SkMove actorSk alterSkill = Ability.getSk Ability.SkAlter actorSk applySkill = Ability.getSk Ability.SkApply actorSk spos = bpos sb -- source position tpos = spos `shift` dir -- target position itemToF <- getsState $ flip itemToFull localTime <- getsState $ getLocalTime (blid sb) embeds <- getsState $ getEmbedBag (blid sb) tpos lvl <- getLevel $ blid sb blurb <- lookAtPosition (blid sb) tpos let t = lvl `at` tpos alterMinSkill = Tile.alterMinSkill coTileSpeedup t canApplyEmbeds = any canApplyEmbed $ EM.assocs embeds canApplyEmbed (iid, kit) = let itemFull = itemToF iid legal = permittedApply localTime applySkill calmE itemFull kit -- Let even completely unskilled actors trigger basic embeds. in either (const False) (const True) legal alterable = Tile.isModifiable coTileSpeedup t || not (EM.null embeds) underFeet = tpos == spos -- if enter and alter, be more permissive runStopOrCmd <- if -- Movement requires full access. | Tile.isWalkable coTileSpeedup t -> if moveSkill > 0 then -- A potential invisible actor is hit. War started without asking. return $ Right $ ReqMove dir else failSer MoveUnskilled -- Not walkable, so search and/or alter the tile. | run -> do -- Explicit request to examine the terrain. promptAdd0 blurb failWith $ if alterable then "potentially alterable" else "not alterable" | not alterable -> do let name = MU.Text $ TK.tname $ okind cotile t failWith $ makePhrase ["there is no point kicking", MU.AW name] -- misclick? related to AlterNothing but no searching possible; -- we don't show tile description, because it only comes from -- embedded items and here probably there are none (can be all -- charging, but that's rare) | not underFeet && alterSkill <= 1 -> failSer AlterUnskilled | not (Tile.isSuspect coTileSpeedup t) && not underFeet && alterSkill < alterMinSkill -> do -- Rather rare (requires high skill), so describe the tile. promptAdd0 blurb failSer AlterUnwalked | not $ Tile.isModifiable coTileSpeedup t || canApplyEmbeds -> do -- Rather rare (charging embeds or too low skill for embeds -- that are, e.g., `?`), so describe the tile. -- Unfortunately this includes cases when an actor can exploit -- signboard when hidden, but can't later on when revealed. promptAdd0 blurb failWith "unable to exploit the terrain" | EM.member tpos $ lfloor lvl -> failSer AlterBlockItem | occupiedBigLvl tpos lvl || occupiedProjLvl tpos lvl -> -- Don't mislead describing terrain, if other actor is to blame. failSer AlterBlockActor | otherwise -> do -- promising verAlters <- verifyAlters (blid sb) tpos case verAlters of Right () -> return $ Right $ ReqAlter tpos Left err -> return $ Left err -- We don't use ReqMove, because we don't hit invisible actors, -- e.g., hidden in a wall. If server performed an attack for free -- on the invisible actor anyway, the player (or AI) -- would be tempted to repeatedly hit random walls -- in hopes of killing a monster residing within. -- If the action had a cost, misclicks would incur the cost, too. -- Right now the player may repeatedly alter tiles trying to learn -- about invisible pass-wall actors, but when an actor detected, -- it costs a turn and does not harm the invisible actors, -- so it's not so tempting. return $! runStopOrCmd -- * RunOnceAhead runOnceAheadHuman :: MonadClientUI m => m (Either MError RequestTimed) runOnceAheadHuman = do side <- getsClient sside fact <- getsState $ (EM.! side) . sfactionD leader <- getLeaderUI keyPressed <- anyKeyPressed srunning <- getsSession srunning -- When running, stop if disturbed. If not running, stop at once. case srunning of Nothing -> do stopPlayBack return $ Left Nothing Just RunParams{runMembers} | noRunWithMulti fact && runMembers /= [leader] -> do stopPlayBack msgAdd MsgRunStop "run stop: automatic leader change" return $ Left Nothing Just _runParams | keyPressed -> do discardPressedKey stopPlayBack msgAdd MsgRunStop "run stop: key pressed" weaveJust <$> failWith "interrupted" Just runParams -> do arena <- getArenaUI runOutcome <- continueRun arena runParams case runOutcome of Left stopMsg -> do stopPlayBack msgAdd MsgRunStop ("run stop:" <+> stopMsg) return $ Left Nothing Right runCmd -> return $ Right runCmd -- * MoveOnceToXhair moveOnceToXhairHuman :: (MonadClient m, MonadClientUI m) => m (FailOrCmd RequestTimed) moveOnceToXhairHuman = goToXhair True False goToXhair :: (MonadClient m, MonadClientUI m) => Bool -> Bool -> m (FailOrCmd RequestTimed) goToXhair initialStep run = do aimMode <- getsSession saimMode -- Movement is legal only outside aiming mode. if isJust aimMode then failWith "cannot move in aiming mode" else do leader <- getLeaderUI b <- getsState $ getActorBody leader xhairPos <- xhairToPos case xhairPos of Nothing -> failWith "crosshair position invalid" Just c | c == bpos b -> failWith "position reached" Just c -> do running <- getsSession srunning case running of -- Don't use running params from previous run or goto-xhair. Just paramOld | not initialStep -> do arena <- getArenaUI runOutcome <- multiActorGoTo arena c paramOld case runOutcome of Left stopMsg -> return $ Left stopMsg Right (finalGoal, dir) -> moveRunHuman initialStep finalGoal run False dir _ -> do let !_A = assert (initialStep || not run) () (bfs, mpath) <- getCacheBfsAndPath leader c xhairMoused <- getsSession sxhairMoused case mpath of _ | xhairMoused && isNothing (accessBfs bfs c) -> failWith "no route to crosshair (press again to go there anyway)" _ | initialStep && adjacent (bpos b) c -> do let dir = towards (bpos b) c moveRunHuman initialStep True run False dir Nothing -> failWith "no route to crosshair" Just AndPath{pathList=[]} -> failWith "almost there" Just AndPath{pathList = p1 : _} -> do let finalGoal = p1 == c dir = towards (bpos b) p1 moveRunHuman initialStep finalGoal run False dir multiActorGoTo :: (MonadClient m, MonadClientUI m) => LevelId -> Point -> RunParams -> m (FailOrCmd (Bool, Vector)) multiActorGoTo arena c paramOld = case paramOld of RunParams{runMembers = []} -> failWith "selected actors no longer there" RunParams{runMembers = r : rs, runWaiting} -> do onLevel <- getsState $ memActor r arena if not onLevel then do let paramNew = paramOld {runMembers = rs} multiActorGoTo arena c paramNew else do sL <- getState modifyClient $ updateLeader r sL let runMembersNew = rs ++ [r] paramNew = paramOld { runMembers = runMembersNew , runWaiting = 0} b <- getsState $ getActorBody r (bfs, mpath) <- getCacheBfsAndPath r c xhairMoused <- getsSession sxhairMoused case mpath of _ | xhairMoused && isNothing (accessBfs bfs c) -> failWith "no route to crosshair (press again to go there anyway)" Nothing -> failWith "no route to crosshair" Just AndPath{pathList=[]} -> failWith "almost there" Just AndPath{pathList = p1 : _} -> do let finalGoal = p1 == c dir = towards (bpos b) p1 tgts <- getsState $ posToAids p1 arena case tgts of [] -> do modifySession $ \sess -> sess {srunning = Just paramNew} return $ Right (finalGoal, dir) [target] | target `elem` rs || runWaiting <= length rs -> -- Let r wait until all others move. Mark it in runWaiting -- to avoid cycles. When all wait for each other, fail. multiActorGoTo arena c paramNew{runWaiting=runWaiting + 1} _ -> failWith "actor in the way" -- * RunOnceToXhair runOnceToXhairHuman :: (MonadClient m, MonadClientUI m) => m (FailOrCmd RequestTimed) runOnceToXhairHuman = goToXhair True True -- * ContinueToXhair continueToXhairHuman :: (MonadClient m, MonadClientUI m) => m (FailOrCmd RequestTimed) continueToXhairHuman = goToXhair False False{-irrelevant-} -- * MoveItem moveItemHuman :: forall m. MonadClientUI m => [CStore] -> CStore -> Maybe MU.Part -> Bool -> m (FailOrCmd RequestTimed) moveItemHuman cLegalRaw destCStore mverb auto = do actorSk <- leaderSkillsClientUI if Ability.getSk Ability.SkMoveItem actorSk > 0 then moveOrSelectItem cLegalRaw destCStore mverb auto else failSer MoveItemUnskilled -- This cannot be structured as projecting or applying, with @ByItemMode@ -- and @ChooseItemToMove@, because at least in case of grabbing items, -- more than one item is chosen, which doesn't fit @sitemSel@. Separating -- grabbing of multiple items as a distinct command is too high a price. moveOrSelectItem :: forall m. MonadClientUI m => [CStore] -> CStore -> Maybe MU.Part -> Bool -> m (FailOrCmd RequestTimed) moveOrSelectItem cLegalRaw destCStore mverb auto = do itemSel <- getsSession sitemSel modifySession $ \sess -> sess {sitemSel = Nothing} -- prevent surprise case itemSel of Just (iid, fromCStore, _) | fromCStore /= destCStore && fromCStore `elem` cLegalRaw -> do leader <- getLeaderUI b <- getsState $ getActorBody leader bag <- getsState $ getBodyStoreBag b fromCStore case iid `EM.lookup` bag of Nothing -> -- the case of old selection or selection from another actor moveItemHuman cLegalRaw destCStore mverb auto Just (k, it) -> assert (k > 0) $ do itemFull <- getsState $ itemToFull iid let eqpFree = eqpFreeN b kToPick | destCStore == CEqp = min eqpFree k | otherwise = k if kToPick == 0 then failWith "no more items can be equipped" else do socK <- pickNumber (not auto) kToPick case socK of Left Nothing -> moveItemHuman cLegalRaw destCStore mverb auto Left (Just err) -> return $ Left err Right kChosen -> let is = ( fromCStore , [(iid, (itemFull, (kChosen, take kChosen it)))] ) in moveItems cLegalRaw is destCStore _ -> do mis <- selectItemsToMove cLegalRaw destCStore mverb auto case mis of Left err -> return $ Left err Right (fromCStore, [(iid, _)]) | cLegalRaw /= [CGround] -> do modifySession $ \sess -> sess {sitemSel = Just (iid, fromCStore, False)} moveItemHuman cLegalRaw destCStore mverb auto Right is -> moveItems cLegalRaw is destCStore selectItemsToMove :: forall m. MonadClientUI m => [CStore] -> CStore -> Maybe MU.Part -> Bool -> m (FailOrCmd (CStore, [(ItemId, ItemFullKit)])) selectItemsToMove cLegalRaw destCStore mverb auto = do let !_A = assert (destCStore `notElem` cLegalRaw) () let verb = fromMaybe (MU.Text $ verbCStore destCStore) mverb leader <- getLeaderUI b <- getsState $ getActorBody leader -- This calmE is outdated when one of the items increases max Calm -- (e.g., in pickup, which handles many items at once), but this is OK, -- the server accepts item movement based on calm at the start, not end -- or in the middle. -- The calmE is inaccurate also if an item not IDed, but that's intended -- and the server will ignore and warn (and content may avoid that, -- e.g., making all rings identified) actorMaxSk <- getsState $ getActorMaxSkills leader lastItemMove <- getsSession slastItemMove let calmE = calmEnough b actorMaxSk cLegalE | calmE = cLegalRaw | destCStore == CSha = [] | otherwise = delete CSha cLegalRaw cLegal = case lastItemMove of Just (lastFrom, lastDest) | lastDest == destCStore && lastFrom `elem` cLegalE -> lastFrom : delete lastFrom cLegalE _ -> cLegalE prompt = makePhrase ["What to", verb] promptEqp = makePhrase ["What consumable to", verb] (promptGeneric, psuit) = -- We prune item list only for eqp, because other stores don't have -- so clear cut heuristics. So when picking up a stash, either grab -- it to auto-store things, or equip first using the pruning -- and then pack/stash the rest selectively or en masse. if destCStore == CEqp && cLegalRaw /= [CGround] then (promptEqp, return $ SuitsSomething $ \itemFull _kit -> IA.goesIntoEqp $ aspectRecordFull itemFull) else (prompt, return SuitsEverything) ggi <- getFull psuit (\_ _ _ cCur _ -> prompt <+> ppItemDialogModeFrom cCur) (\_ _ _ cCur _ -> promptGeneric <+> ppItemDialogModeFrom cCur) cLegalRaw cLegal (not auto) True case ggi of Right (l, (MStore fromCStore, _)) -> do modifySession $ \sess -> sess {slastItemMove = Just (fromCStore, destCStore)} return $ Right (fromCStore, l) Left err -> failWith err _ -> error $ "" `showFailure` ggi moveItems :: forall m. MonadClientUI m => [CStore] -> (CStore, [(ItemId, ItemFullKit)]) -> CStore -> m (FailOrCmd RequestTimed) moveItems cLegalRaw (fromCStore, l) destCStore = do leader <- getLeaderUI b <- getsState $ getActorBody leader actorMaxSk <- getsState $ getActorMaxSkills leader discoBenefit <- getsClient sdiscoBenefit let calmE = calmEnough b actorMaxSk ret4 :: [(ItemId, ItemFullKit)] -> Int -> m [(ItemId, Int, CStore, CStore)] ret4 [] _ = return [] ret4 ((iid, (itemFull, (itemK, _))) : rest) oldN = do let k = itemK !_A = assert (k > 0) () inEqp = benInEqp $ discoBenefit EM.! iid retRec toCStore = do let n = oldN + if toCStore == CEqp then k else 0 l4 <- ret4 rest n return $ (iid, k, fromCStore, toCStore) : l4 issueWarning = do let fullWarn = if eqpOverfull b (oldN + 1) then EqpOverfull else EqpStackFull msgAdd MsgWarning $ "Warning:" <+> showReqFailure fullWarn <> "." if cLegalRaw == [CGround] -- normal pickup then case destCStore of -- @CEqp@ is the implicit default; refine: CEqp | calmE && IA.goesIntoSha (aspectRecordFull itemFull) -> retRec CSha CEqp | inEqp && eqpOverfull b (oldN + k) -> do -- If this stack doesn't fit, we don't equip any part of it, -- but we may equip a smaller stack later in the same pickup. issueWarning retRec $ if calmE then CSha else CInv CEqp | inEqp -> retRec CEqp CEqp -> retRec CInv _ -> retRec destCStore else case destCStore of -- player forces store, so @inEqp@ ignored CEqp | eqpOverfull b (oldN + k) -> do -- If the chosen number from the stack doesn't fit, -- we don't equip any part of it and we exit item manipulation. issueWarning -- No recursive call here: return [] _ -> retRec destCStore if not calmE && CSha `elem` [fromCStore, destCStore] then failSer ItemNotCalm else do l4 <- ret4 l 0 return $! if null l4 then error $ "" `showFailure` l else Right $ ReqMoveItems l4 -- * Project projectHuman :: (MonadClient m, MonadClientUI m) => m (FailOrCmd RequestTimed) projectHuman = do actorSk <- leaderSkillsClientUI if Ability.getSk Ability.SkProject actorSk <= 0 then -- detailed check later failSer ProjectUnskilled else do itemSel <- getsSession sitemSel case itemSel of Just (iid, fromCStore, _) -> do leader <- getLeaderUI b <- getsState $ getActorBody leader bag <- getsState $ getBodyStoreBag b fromCStore case iid `EM.lookup` bag of Nothing -> failWith "no item to fling" Just _kit -> do itemFull <- getsState $ itemToFull iid let i = (fromCStore, (iid, itemFull)) projectItem i Nothing -> failWith "no item to fling" projectItem :: (MonadClient m, MonadClientUI m) => (CStore, (ItemId, ItemFull)) -> m (FailOrCmd RequestTimed) projectItem (fromCStore, (iid, itemFull)) = do leader <- getLeaderUI b <- getsState $ getActorBody leader actorMaxSk <- getsState $ getActorMaxSkills leader let calmE = calmEnough b actorMaxSk if not calmE && fromCStore == CSha then failSer ItemNotCalm else do mpsuitReq <- psuitReq case mpsuitReq of Left err -> failWith err Right psuitReqFun -> case psuitReqFun itemFull of Left reqFail -> failSer reqFail Right (pos, _) -> do Benefit{benFling} <- getsClient $ (EM.! iid) . sdiscoBenefit go <- if benFling > 0 then displayYesNo ColorFull "The item appears beneficial. Do you really want to fling it?" else return True if go then do -- Set personal target to enemy, so that AI, if it takes over -- the actor, is likely to continue the fight even if the foe -- flees. Similarly if the crosshair points at position, etc. sxhair <- getsSession sxhair modifyClient $ updateTarget leader (const sxhair) -- Project. eps <- getsClient seps return $ Right $ ReqProject pos eps iid fromCStore else do modifySession $ \sess -> sess {sitemSel = Nothing} failWith "never mind" -- * Apply applyHuman :: MonadClientUI m => m (FailOrCmd RequestTimed) applyHuman = do actorSk <- leaderSkillsClientUI if Ability.getSk Ability.SkApply actorSk <= 0 then -- detailed check later failSer ApplyUnskilled else do itemSel <- getsSession sitemSel case itemSel of Just (iid, fromCStore, _) -> do leader <- getLeaderUI b <- getsState $ getActorBody leader bag <- getsState $ getBodyStoreBag b fromCStore case iid `EM.lookup` bag of Nothing -> failWith "no item to apply" Just kit -> do itemFull <- getsState $ itemToFull iid applyItem (fromCStore, (iid, (itemFull, kit))) Nothing -> failWith "no item to apply" applyItem :: MonadClientUI m => (CStore, (ItemId, ItemFullKit)) -> m (FailOrCmd RequestTimed) applyItem (fromCStore, (iid, (itemFull, kit))) = do leader <- getLeaderUI b <- getsState $ getActorBody leader localTime <- getsState $ getLocalTime (blid b) actorMaxSk <- getsState $ getActorMaxSkills leader actorSk <- leaderSkillsClientUI let skill = Ability.getSk Ability.SkApply actorSk calmE = calmEnough b actorMaxSk arItem = aspectRecordFull itemFull if not calmE && fromCStore == CSha then failSer ItemNotCalm else case permittedApply localTime skill calmE itemFull kit of Left reqFail -> failSer reqFail Right _ -> do Benefit{benApply} <- getsClient $ (EM.! iid) . sdiscoBenefit go <- if | IA.checkFlag Ability.Periodic arItem && not (IA.checkFlag Ability.Durable arItem) -> -- No warning if item durable, because activation weak, -- but price low, due to no destruction. displayYesNo ColorFull "Applying this periodic item will produce only the first of its effects and moreover, because it's not durable, will destroy it. Are you sure?" | benApply < 0 -> displayYesNo ColorFull "The item appears harmful. Do you really want to apply it?" | otherwise -> return True if go then return $ Right $ ReqApply iid fromCStore else do modifySession $ \sess -> sess {sitemSel = Nothing} failWith "never mind" -- * AlterDir -- | Ask for a direction and alter a tile in the specified way, if possible. alterDirHuman :: MonadClientUI m => [TriggerTile] -> m (FailOrCmd RequestTimed) alterDirHuman ts = do UIOptions{uVi, uLaptop} <- getsSession sUIOptions let verb1 = case ts of [] -> "alter" tr : _ -> ttverb tr keys = K.escKM : K.leftButtonReleaseKM : map (K.KM K.NoModifier) (K.dirAllKey uVi uLaptop) prompt = makePhrase ["Where to", verb1 <> "? [movement key] [pointer]"] promptAdd0 prompt slides <- reportToSlideshow [K.escKM] km <- getConfirms ColorFull keys slides case K.key km of K.LeftButtonRelease -> do leader <- getLeaderUI b <- getsState $ getActorBody leader Point x y <- getsSession spointer let dir = Point x (y - mapStartY) `vectorToFrom` bpos b if isUnit dir then alterTile ts dir else failWith "never mind" _ -> case K.handleDir uVi uLaptop km of Nothing -> failWith "never mind" Just dir -> alterTile ts dir -- | Try to alter a tile using a feature in the given direction. alterTile :: MonadClientUI m => [TriggerTile] -> Vector -> m (FailOrCmd RequestTimed) alterTile ts dir = do leader <- getLeaderUI b <- getsState $ getActorBody leader let tpos = bpos b `shift` dir pText = compassText dir alterTileAtPos ts tpos pText -- | Try to alter a tile using a feature at the given position. -- -- We don't check if the tile is interesting, e.g., if any embedded -- item can be triggered, because the player explicitely requested -- the action. Consequently, even if all embedded items are recharching, -- the time will be wasted and the server will describe the failure in detail. alterTileAtPos :: MonadClientUI m => [TriggerTile] -> Point -> Text -> m (FailOrCmd RequestTimed) alterTileAtPos ts tpos pText = do cops@COps{cotile, coTileSpeedup} <- getsState scops leader <- getLeaderUI b <- getsState $ getActorBody leader actorSk <- leaderSkillsClientUI lvl <- getLevel $ blid b embeds <- getsState $ getEmbedBag (blid b) tpos let alterSkill = Ability.getSk Ability.SkAlter actorSk t = lvl `at` tpos alterMinSkill = Tile.alterMinSkill coTileSpeedup t hasFeat TriggerTile{ttfeature} = Tile.hasFeature cotile ttfeature t case filter hasFeat ts of [] | not $ null ts -> failWith $ guessAlter cops ts t _ | not (Tile.isModifiable coTileSpeedup t) && EM.null embeds -> failSer AlterNothing _ | chessDist tpos (bpos b) > 1 -> failSer AlterDistant _ | alterSkill <= 1 -> failSer AlterUnskilled _ | not (Tile.isSuspect coTileSpeedup t) && alterSkill < alterMinSkill -> failSer AlterUnwalked trs -> if EM.notMember tpos $ lfloor lvl then if not (occupiedBigLvl tpos lvl) && not (occupiedProjLvl tpos lvl) then do let v = case trs of [] -> "alter" tr : _ -> ttverb tr verAlters <- verifyAlters (blid b) tpos case verAlters of Right () -> do let msg = makeSentence ["you", v, MU.Text pText] msgAdd MsgDone msg return $ Right $ ReqAlter tpos Left err -> return $ Left err else failSer AlterBlockActor else failSer AlterBlockItem -- | Verify important effects, such as fleeing the dungeon. -- -- This is contrived for now, the embedded items are not analyzed, -- but only recognized by name. verifyAlters :: MonadClientUI m => LevelId -> Point -> m (FailOrCmd ()) verifyAlters lid p = do COps{coTileSpeedup} <- getsState scops lvl <- getLevel lid let t = lvl `at` p bag <- getsState $ getEmbedBag lid p getKind <- getsState $ flip getIidKind let ks = map getKind $ EM.keys bag if | any (any IK.isEffEscape . IK.ieffects) ks -> verifyEscape | null ks && not (Tile.isModifiable coTileSpeedup t) -> failWith "never mind" | otherwise -> return $ Right () verifyEscape :: MonadClientUI m => m (FailOrCmd ()) verifyEscape = do side <- getsClient sside fact <- getsState $ (EM.! side) . sfactionD if not (fcanEscape $ gplayer fact) then failWith "This is the way out, but where would you go in this alien world?" else do (_, total) <- getsState $ calculateTotal side dungeonTotal <- getsState sgold let prompt | dungeonTotal == 0 = "You finally reached the way out. Really leave now?" | total == 0 = "Afraid of the challenge? Leaving so soon and without any treasure? Are you sure?" | total < dungeonTotal = "You finally found the way out, but still more valuables are rumoured to hide around here. Really leave already?" | otherwise = "This is the way out and you collected all treasure there is to find. Really leave now?" -- The player can back off, but we never insist, -- because possibly the score formula doesn't reward treasure -- or he is focused on winning only. go <- displayYesNo ColorBW prompt if not go then failWith "here's your chance!" else return $ Right () -- | Guess and report why the bump command failed. guessAlter :: COps -> [TriggerTile] -> ContentId TileKind -> Text guessAlter COps{cotile} (TriggerTile{ttfeature=TK.OpenTo _} : _) t | Tile.isClosable cotile t = "already open" guessAlter _ (TriggerTile{ttfeature=TK.OpenTo _} : _) _ = "cannot be opened" guessAlter COps{cotile} (TriggerTile{ttfeature=TK.CloseTo _} : _) t | Tile.isOpenable cotile t = "already closed" guessAlter _ (TriggerTile{ttfeature=TK.CloseTo _} : _) _ = "cannot be closed" guessAlter _ _ _ = "never mind" -- * AlterWithPointer -- | Try to alter a tile using a feature under the pointer. alterWithPointerHuman :: MonadClientUI m => [TriggerTile] -> m (FailOrCmd RequestTimed) alterWithPointerHuman ts = do COps{corule=RuleContent{rXmax, rYmax}, cotile} <- getsState scops lidV <- viewedLevelUI -- Not @ScreenContent@, because not drawing here. lvl <- getLevel lidV Point{..} <- getsSession spointer let tpos = Point px (py - mapStartY) t = lvl `at` tpos if px >= 0 && py - mapStartY >= 0 && px < rXmax && py - mapStartY < rYmax then alterTileAtPos ts tpos $ "the" <+> TK.tname (okind cotile t) else failWith "never mind" -- * Help -- | Display command help. helpHuman :: MonadClientUI m => (HumanCmd -> m (Either MError ReqUI)) -> m (Either MError ReqUI) helpHuman cmdAction = do cops <- getsState scops ccui@CCUI{coinput, coscreen=ScreenContent{rwidth, rheight}} <- getsSession sccui let keyH = keyHelp cops ccui 1 splitHelp (t, okx) = splitOKX rwidth rheight (textToAL t) [K.spaceKM, K.escKM] okx sli = toSlideshow $ concat $ map splitHelp keyH -- Thus, the whole help menu corresponde to a single menu of item or lore, -- e.g., shared stash menu. This is especially clear when the shared stash -- menu contains many pages. ekm <- displayChoiceScreen "help" ColorFull True sli [K.spaceKM, K.escKM] case ekm of Left km -> case km `M.lookup` bcmdMap coinput of _ | km `elem` [K.escKM, K.spaceKM] -> return $ Left Nothing Just (_desc, _cats, cmd) -> cmdAction cmd Nothing -> weaveJust <$> failWith "never mind" Right _slot -> error $ "" `showFailure` ekm -- * Hint -- | Display hint or, if already displayed, display help. hintHuman :: MonadClientUI m => (HumanCmd -> m (Either MError ReqUI)) -> m (Either MError ReqUI) hintHuman cmdAction = do hintMode <- getsSession shintMode if hintMode == HintWiped then helpHuman cmdAction else do modifySession $ \sess -> sess {shintMode = HintShown} promptMainKeys return $ Left Nothing -- * Dashboard -- | Display the dashboard. dashboardHuman :: MonadClientUI m => (HumanCmd -> m (Either MError ReqUI)) -> m (Either MError ReqUI) dashboardHuman cmdAction = do CCUI{coinput, coscreen=ScreenContent{rwidth, rheight}} <- getsSession sccui let keyL = 2 (ov0, kxs0) = okxsN coinput 1 keyL (const False) False CmdDashboard [] [] al1 = textToAL "Dashboard" splitHelp (al, okx) = splitOKX rwidth (rheight - 2) al [K.escKM] okx sli = toSlideshow $ splitHelp (al1, (ov0, kxs0)) extraKeys = [K.escKM] ekm <- displayChoiceScreen "dashboard" ColorFull False sli extraKeys case ekm of Left km -> case km `M.lookup` bcmdMap coinput of _ | km == K.escKM -> weaveJust <$> failWith "never mind" Just (_desc, _cats, cmd) -> cmdAction cmd Nothing -> weaveJust <$> failWith "never mind" Right _slot -> error $ "" `showFailure` ekm -- * ItemMenu itemMenuHuman :: MonadClientUI m => (HumanCmd -> m (Either MError ReqUI)) -> m (Either MError ReqUI) itemMenuHuman cmdAction = do itemSel <- getsSession sitemSel case itemSel of Just (iid, fromCStore, _) -> do leader <- getLeaderUI b <- getsState $ getActorBody leader bUI <- getsSession $ getActorUI leader bag <- getsState $ getBodyStoreBag b fromCStore case iid `EM.lookup` bag of Nothing -> weaveJust <$> failWith "no item to open item menu for" Just kit -> do CCUI{coscreen=ScreenContent{rwidth, rheight}} <- getsSession sccui actorMaxSk <- getsState $ getActorMaxSkills leader itemFull <- getsState $ itemToFull iid localTime <- getsState $ getLocalTime (blid b) found <- getsState $ findIid leader (bfid b) iid factionD <- getsState sfactionD sactorUI <- getsSession sactorUI jlid <- getsSession $ (EM.! iid) . sitemUI let !_A = assert (not (null found) || fromCStore == CGround `blame` (iid, leader)) () fAlt (aid, (_, store)) = aid /= leader || store /= fromCStore foundAlt = filter fAlt found foundUI = map (\(aid, bs) -> (aid, bs, sactorUI EM.! aid)) foundAlt foundKeys = map (K.KM K.NoModifier . K.Fun) [1 .. length foundUI] -- starting from 1! ppLoc bUI2 store = let phr = makePhrase $ ppCStoreWownW False store $ partActor bUI2 in "[" ++ T.unpack phr ++ "]" foundTexts = map (\(_, (_, store), bUI2) -> ppLoc bUI2 store) foundUI foundPrefix = textToAL $ if null foundTexts then "" else "The item is also in:" markParagraphs = rheight >= 45 desc = itemDesc markParagraphs (bfid b) factionD (Ability.getSk Ability.SkHurtMelee actorMaxSk) fromCStore localTime jlid itemFull kit alPrefix = splitAttrLine rwidth $ desc <+:> foundPrefix ystart = length alPrefix - 1 xstart = length (last alPrefix) + 1 ks = zip foundKeys $ map (\(_, (_, store), bUI2) -> ppLoc bUI2 store) foundUI (ovFoundRaw, kxsFound) = wrapOKX ystart xstart rwidth ks ovFound = glueLines alPrefix ovFoundRaw report <- getReportUI CCUI{coinput} <- getsSession sccui actorSk <- leaderSkillsClientUI let calmE = calmEnough b actorMaxSk greyedOut cmd = not calmE && fromCStore == CSha || case cmd of ByAimMode AimModeCmd{..} -> greyedOut exploration || greyedOut aiming ComposeIfLocal cmd1 cmd2 -> greyedOut cmd1 || greyedOut cmd2 ComposeUnlessError cmd1 cmd2 -> greyedOut cmd1 || greyedOut cmd2 Compose2ndLocal cmd1 cmd2 -> greyedOut cmd1 || greyedOut cmd2 MoveItem stores destCStore _ _ -> fromCStore `notElem` stores || not calmE && CSha == destCStore || destCStore == CEqp && eqpOverfull b 1 Apply{} -> let skill = Ability.getSk Ability.SkApply actorSk in not $ either (const False) id $ permittedApply localTime skill calmE itemFull kit Project{} -> let skill = Ability.getSk Ability.SkProject actorSk in not $ either (const False) id $ permittedProject False skill calmE itemFull _ -> False fmt n k h = " " <> T.justifyLeft n ' ' k <+> h keyL = 11 keyCaption = fmt keyL "keys" "command" offset = 1 + length ovFound (ov0, kxs0) = okxsN coinput offset keyL greyedOut True CmdItemMenu [keyCaption] [] t0 = makeSentence [ MU.SubjectVerbSg (partActor bUI) "choose" , "an item", MU.Text $ ppCStoreIn fromCStore ] al1 = renderReport report <+:> textToAL t0 splitHelp (al, okx) = splitOKX rwidth (rheight - 2) al [K.spaceKM, K.escKM] okx sli = toSlideshow $ splitHelp (al1, (ovFound ++ ov0, kxsFound ++ kxs0)) extraKeys = [K.spaceKM, K.escKM] ++ foundKeys recordHistory -- report shown (e.g., leader switch), save to history ekm <- displayChoiceScreen "item menu" ColorFull False sli extraKeys case ekm of Left km -> case km `M.lookup` bcmdMap coinput of _ | km == K.escKM -> weaveJust <$> failWith "never mind" _ | km == K.spaceKM -> return $ Left Nothing _ | km `elem` foundKeys -> case km of K.KM{key=K.Fun n} -> do let (newAid, (bNew, newCStore)) = foundAlt !! (n - 1) fact <- getsState $ (EM.! bfid bNew) . sfactionD let (autoDun, _) = autoDungeonLevel fact if | blid bNew /= blid b && autoDun -> weaveJust <$> failSer NoChangeDunLeader | otherwise -> do void $ pickLeader True newAid modifySession $ \sess -> sess {sitemSel = Just (iid, newCStore, False)} itemMenuHuman cmdAction _ -> error $ "" `showFailure` km Just (_desc, _cats, cmd) -> do modifySession $ \sess -> sess {sitemSel = Just (iid, fromCStore, True)} res <- cmdAction cmd modifySession $ \sess -> sess {sitemSel = Just (iid, fromCStore, False)} return res Nothing -> weaveJust <$> failWith "never mind" Right _slot -> error $ "" `showFailure` ekm Nothing -> weaveJust <$> failWith "no item to open item menu for" -- * ChooseItemMenu chooseItemMenuHuman :: MonadClientUI m => (HumanCmd -> m (Either MError ReqUI)) -> ItemDialogMode -> m (Either MError ReqUI) chooseItemMenuHuman cmdAction c = do res <- chooseItemDialogMode c case res of Right c2 -> do res2 <- itemMenuHuman cmdAction case res2 of Left Nothing -> chooseItemMenuHuman cmdAction c2 _ -> return res2 Left err -> return $ Left $ Just err -- * MainMenu artAtSize :: MonadClientUI m => m [Text] artAtSize = do CCUI{coscreen=ScreenContent{rwidth, rheight, rmainMenuArt}} <- getsSession sccui let tlines = T.lines rmainMenuArt xoffset = (80 - rwidth) `div` 2 yoffset = (length tlines - rheight) `div` 2 f = T.take rwidth . T.drop xoffset return $! map f $ take rheight $ drop yoffset tlines -- We detect the place for the version string by searching for 'Version' -- in the last line of the picture. If it doesn't fit, we shift, if everything -- else fails, only then we crop. We don't assume any line length. artWithVersion :: MonadClientUI m => m [String] artWithVersion = do COps{corule} <- getsState scops let pasteVersion :: [Text] -> [String] pasteVersion art = let exeVersion = rexeVersion corule libVersion = Self.version version = " Version " ++ showVersion exeVersion ++ " (frontend: " ++ frontendName ++ ", engine: LambdaHack " ++ showVersion libVersion ++ ") " versionLen = length version f line = let (prefix, versionSuffix) = T.breakOn "Version" line in if T.null versionSuffix then T.unpack line else let suffix = drop versionLen $ T.unpack versionSuffix overfillLen = versionLen - T.length versionSuffix prefixModified = T.unpack $ T.dropEnd overfillLen prefix in prefixModified ++ version ++ suffix in map f art mainMenuArt <- artAtSize return $! pasteVersion mainMenuArt generateMenu :: MonadClientUI m => (HumanCmd -> m (Either MError ReqUI)) -> [(K.KM, (Text, HumanCmd))] -> [String] -> String -> m (Either MError ReqUI) generateMenu cmdAction kds gameInfo menuName = do art <- artWithVersion let bindingLen = 35 emptyInfo = repeat $ replicate bindingLen ' ' bindings = -- key bindings to display let fmt (k, (d, _)) = ( Just k , T.unpack $ T.justifyLeft bindingLen ' ' $ " " <> T.justifyLeft 4 ' ' (T.pack $ K.showKM k) <> " " <> d ) in map fmt kds overwrite :: [(Int, String)] -> [(String, Maybe KYX)] overwrite = -- overwrite the art with key bindings and other lines let over [] (_, line) = ([], (line, Nothing)) over bs@((mkey, binding) : bsRest) (y, line) = let (prefix, lineRest) = break (=='{') line (braces, suffix) = span (=='{') lineRest in if length braces >= bindingLen then let lenB = length binding post = drop (lenB - length braces) suffix len = length prefix yxx key = (Left [key], (y, len, len + lenB)) myxx = yxx <$> mkey in (bsRest, (prefix <> binding <> post, myxx)) else (bs, (line, Nothing)) in snd . mapAccumL over (zip (repeat Nothing) gameInfo ++ bindings ++ zip (repeat Nothing) emptyInfo) menuOverwritten = overwrite $ zip [0..] art (menuOvLines, mkyxs) = unzip menuOverwritten kyxs = catMaybes mkyxs ov = map stringToAL menuOvLines ekm <- displayChoiceScreen menuName ColorFull True (menuToSlideshow (ov, kyxs)) [K.escKM] case ekm of Left km -> case km `lookup` kds of Just (_desc, cmd) -> cmdAction cmd Nothing -> weaveJust <$> failWith "never mind" Right _slot -> error $ "" `showFailure` ekm -- | Display the main menu. mainMenuHuman :: MonadClientUI m => (HumanCmd -> m (Either MError ReqUI)) -> m (Either MError ReqUI) mainMenuHuman cmdAction = do cops <- getsState scops CCUI{coinput=InputContent{bcmdList}} <- getsSession sccui gameMode <- getGameMode snxtScenario <- getsClient snxtScenario let nxtGameName = mname $ nxtGameMode cops snxtScenario tnextScenario = "pick next:" <+> nxtGameName -- Key-description-command tuples. kds = (K.mkKM "p", (tnextScenario, GameScenarioIncr)) : [ (km, (desc, cmd)) | (km, ([CmdMainMenu], desc, cmd)) <- bcmdList ] bindingLen = 35 gameName = mname gameMode gameInfo = map T.unpack [ T.justifyLeft bindingLen ' ' "" , T.justifyLeft bindingLen ' ' $ " Now playing:" <+> gameName , T.justifyLeft bindingLen ' ' "" ] generateMenu cmdAction kds gameInfo "main" -- * MainMenuAutoOn -- | Display the main menu and set @swasAutomated@. mainMenuAutoOnHuman :: MonadClientUI m => (HumanCmd -> m (Either MError ReqUI)) -> m (Either MError ReqUI) mainMenuAutoOnHuman cmdAction = do modifySession $ \sess -> sess {swasAutomated = True} mainMenuHuman cmdAction -- * MainMenuAutoOff -- | Display the main menu and unset @swasAutomated@. mainMenuAutoOffHuman :: MonadClientUI m => (HumanCmd -> m (Either MError ReqUI)) -> m (Either MError ReqUI) mainMenuAutoOffHuman cmdAction = do modifySession $ \sess -> sess {swasAutomated = False} mainMenuHuman cmdAction -- * SettingsMenu -- | Display the settings menu. settingsMenuHuman :: MonadClientUI m => (HumanCmd -> m (Either MError ReqUI)) -> m (Either MError ReqUI) settingsMenuHuman cmdAction = do markSuspect <- getsClient smarkSuspect markVision <- getsSession smarkVision markSmell <- getsSession smarkSmell side <- getsClient sside factTactic <- getsState $ ftactic . gplayer . (EM.! side) . sfactionD let offOn b = if b then "on" else "off" offOnAll n = case n of 0 -> "none" 1 -> "untried" 2 -> "all" _ -> error $ "" `showFailure` n tsuspect = "mark suspect terrain:" <+> offOnAll markSuspect tvisible = "show visible zone:" <+> offOn markVision tsmell = "display smell clues:" <+> offOn markSmell thenchmen = "henchmen tactic:" <+> Ability.nameTactic factTactic -- Key-description-command tuples. kds = [ (K.mkKM "s", (tsuspect, MarkSuspect)) , (K.mkKM "v", (tvisible, MarkVision)) , (K.mkKM "c", (tsmell, MarkSmell)) , (K.mkKM "t", (thenchmen, Tactic)) , (K.mkKM "Escape", ("back to main menu", MainMenu)) ] bindingLen = 35 gameInfo = map T.unpack [ T.justifyLeft bindingLen ' ' "" , T.justifyLeft bindingLen ' ' " Convenience settings:" , T.justifyLeft bindingLen ' ' "" ] generateMenu cmdAction kds gameInfo "settings" -- * ChallengesMenu -- | Display the challenges menu. challengesMenuHuman :: MonadClientUI m => (HumanCmd -> m (Either MError ReqUI)) -> m (Either MError ReqUI) challengesMenuHuman cmdAction = do curChal <- getsClient scurChal nxtChal <- getsClient snxtChal let offOn b = if b then "on" else "off" tcurDiff = " * difficulty:" <+> tshow (cdiff curChal) tnextDiff = "difficulty (lower easier):" <+> tshow (cdiff nxtChal) tcurWolf = " * lone wolf:" <+> offOn (cwolf curChal) tnextWolf = "lone wolf (very hard):" <+> offOn (cwolf nxtChal) tcurFish = " * cold fish:" <+> offOn (cfish curChal) tnextFish = "cold fish (hard):" <+> offOn (cfish nxtChal) -- Key-description-command tuples. kds = [ (K.mkKM "d", (tnextDiff, GameDifficultyIncr)) , (K.mkKM "w", (tnextWolf, GameWolfToggle)) , (K.mkKM "f", (tnextFish, GameFishToggle)) , (K.mkKM "Escape", ("back to main menu", MainMenu)) ] bindingLen = 35 gameInfo = map T.unpack [ T.justifyLeft bindingLen ' ' " Current challenges:" , T.justifyLeft bindingLen ' ' "" , T.justifyLeft bindingLen ' ' tcurDiff , T.justifyLeft bindingLen ' ' tcurWolf , T.justifyLeft bindingLen ' ' tcurFish , T.justifyLeft bindingLen ' ' "" , T.justifyLeft bindingLen ' ' " Next game challenges:" , T.justifyLeft bindingLen ' ' "" ] generateMenu cmdAction kds gameInfo "challenge" -- * GameScenarioIncr gameScenarioIncr :: MonadClient m => m () gameScenarioIncr = modifyClient $ \cli -> cli {snxtScenario = snxtScenario cli + 1} -- * GameDifficultyIncr gameDifficultyIncr :: MonadClient m => m () gameDifficultyIncr = do nxtDiff <- getsClient $ cdiff . snxtChal let delta = -1 d | nxtDiff + delta > difficultyBound = 1 | nxtDiff + delta < 1 = difficultyBound | otherwise = nxtDiff + delta modifyClient $ \cli -> cli {snxtChal = (snxtChal cli) {cdiff = d} } -- * GameWolfToggle gameWolfToggle :: MonadClient m => m () gameWolfToggle = modifyClient $ \cli -> cli {snxtChal = (snxtChal cli) {cwolf = not (cwolf (snxtChal cli))} } -- * GameFishToggle gameFishToggle :: MonadClient m => m () gameFishToggle = modifyClient $ \cli -> cli {snxtChal = (snxtChal cli) {cfish = not (cfish (snxtChal cli))} } -- * GameRestart gameRestartHuman :: MonadClientUI m => m (FailOrCmd ReqUI) gameRestartHuman = do cops <- getsState scops isNoConfirms <- isNoConfirmsGame gameMode <- getGameMode snxtScenario <- getsClient snxtScenario let nxtGameName = mname $ nxtGameMode cops snxtScenario b <- if isNoConfirms then return True else displayYesNo ColorBW $ "You just requested a new" <+> nxtGameName <+> "game. The progress of the ongoing" <+> mname gameMode <+> "game will be lost! Are you sure?" if b then do snxtChal <- getsClient snxtChal -- This ignores all but the first word of game mode names picked -- via main menu and assumes the fist word of such game modes -- is present in their frequencies. let nxtGameGroup = toGroupName $ head $ T.words nxtGameName return $ Right $ ReqUIGameRestart nxtGameGroup snxtChal else do msg2 <- rndToActionForget $ oneOf [ "yea, would be a pity to leave them to die" , "yea, a shame to get your team stranded" ] failWith msg2 nxtGameMode :: COps -> Int -> ModeKind nxtGameMode COps{comode} snxtScenario = let f !acc _p _i !a = a : acc campaignModes = ofoldlGroup' comode "campaign scenario" f [] in campaignModes !! (snxtScenario `mod` length campaignModes) -- * GameQuit -- TODO: deduplicate with gameRestartHuman gameQuitHuman :: MonadClientUI m => m (FailOrCmd ReqUI) gameQuitHuman = do isNoConfirms <- isNoConfirmsGame gameMode <- getGameMode b <- if isNoConfirms then return True else displayYesNo ColorBW $ "If you quit, the progress of the ongoing" <+> mname gameMode <+> "game will be lost! Are you sure?" if b then do snxtChal <- getsClient snxtChal return $ Right $ ReqUIGameRestart "insert coin" snxtChal else do msg2 <- rndToActionForget $ oneOf [ "yea, would be a pity to leave them to die" , "yea, a shame to get your team stranded" ] failWith msg2 -- * GameDrop gameDropHuman :: MonadClientUI m => m ReqUI gameDropHuman = do modifySession $ \sess -> sess {sallNframes = -1} -- hack, but we crash anyway promptAdd0 "Interrupt! Trashing the unsaved game. The program exits now." clientPrintUI "Interrupt! Trashing the unsaved game. The program exits now." -- this is not shown by vty frontend, but at least shown by sdl2 one return ReqUIGameDropAndExit -- * GameExit gameExitHuman :: MonadClientUI m => m ReqUI gameExitHuman = do -- Announce before the saving started, since it can take a while. promptAdd0 "Saving game. The program stops now." return ReqUIGameSaveAndExit -- * GameSave gameSaveHuman :: MonadClientUI m => m ReqUI gameSaveHuman = do -- Announce before the saving started, since it can take a while. promptAdd0 "Saving game backup." return ReqUIGameSave -- * Tactic -- Note that the difference between seek-target and follow-the-leader tactic -- can influence even a faction with passive actors. E.g., if a passive actor -- has an extra active skill from equipment, he moves every turn. tacticHuman :: MonadClientUI m => m (FailOrCmd ReqUI) tacticHuman = do fid <- getsClient sside fromT <- getsState $ ftactic . gplayer . (EM.! fid) . sfactionD let toT = if fromT == maxBound then minBound else succ fromT go <- displaySpaceEsc ColorFull $ "(Beware, work in progress!)" <+> "Current henchmen tactic is" <+> Ability.nameTactic fromT <+> "(" <> Ability.describeTactic fromT <> ")." <+> "Switching tactic to" <+> Ability.nameTactic toT <+> "(" <> Ability.describeTactic toT <> ")." <+> "This clears targets of all henchmen (non-leader teammates)." <+> "New targets will be picked according to new tactic." if not go then failWith "tactic change canceled" else return $ Right $ ReqUITactic toT -- * Automate automateHuman :: MonadClientUI m => m (FailOrCmd ReqUI) automateHuman = do clearAimMode go <- displaySpaceEsc ColorBW "Ceding control to AI (press SPACE to confirm, ESC to cancel)." if not go then failWith "automation canceled" else return $ Right ReqUIAutomate -- * AutomateToggle automateToggleHuman :: MonadClientUI m => m (FailOrCmd ReqUI) automateToggleHuman = do swasAutomated <- getsSession swasAutomated if swasAutomated then failWith "automation canceled" else automateHuman -- * AutomateBack automateBackHuman :: MonadClientUI m => m (Either MError ReqUI) automateBackHuman = do swasAutomated <- getsSession swasAutomated return $! if swasAutomated then Right ReqUIAutomate else Left Nothing LambdaHack-0.9.5.0/engine-src/Game/LambdaHack/Client/UI/HandleHumanLocalM.hs0000644000000000000000000013146607346545000024253 0ustar0000000000000000-- | Semantics of "Game.LambdaHack.Client.UI.HumanCmd" -- client commands that do not return server requests,, -- but only change internal client state. -- None of such commands takes game time. module Game.LambdaHack.Client.UI.HandleHumanLocalM ( -- * Meta commands macroHuman -- * Local commands , chooseItemHuman, chooseItemDialogMode , chooseItemProjectHuman, chooseItemApplyHuman , psuitReq, triggerSymbols, pickLeaderHuman, pickLeaderWithPointerHuman , memberCycleHuman, memberBackHuman , selectActorHuman, selectNoneHuman, selectWithPointerHuman , repeatHuman, recordHuman, allHistoryHuman, lastHistoryHuman , markVisionHuman, markSmellHuman, markSuspectHuman, printScreenHuman -- * Commands specific to aiming , cancelHuman, acceptHuman, clearTargetIfItemClearHuman, itemClearHuman , moveXhairHuman, aimTgtHuman, aimFloorHuman, aimEnemyHuman, aimItemHuman , aimAscendHuman, epsIncrHuman , xhairUnknownHuman, xhairItemHuman, xhairStairHuman , xhairPointerFloorHuman, xhairPointerEnemyHuman , aimPointerFloorHuman, aimPointerEnemyHuman #ifdef EXPOSE_INTERNAL -- * Internal operations , permittedProjectClient, projectCheck, xhairLegalEps, posFromXhair , permittedApplyClient, selectAid, eitherHistory, endAiming, endAimingMsg , doLook, flashAiming #endif ) where import Prelude () import Game.LambdaHack.Core.Prelude import qualified Data.EnumMap.Strict as EM import qualified Data.EnumSet as ES import Data.Ord import qualified Data.Text as T import qualified NLP.Miniutter.English as MU import Game.LambdaHack.Client.BfsM import Game.LambdaHack.Client.ClientOptions import Game.LambdaHack.Client.CommonM import Game.LambdaHack.Client.MonadClient import Game.LambdaHack.Client.State import Game.LambdaHack.Client.UI.ActorUI import Game.LambdaHack.Client.UI.Animation import Game.LambdaHack.Client.UI.Content.Screen import Game.LambdaHack.Client.UI.ContentClientUI import Game.LambdaHack.Client.UI.DrawM import Game.LambdaHack.Client.UI.EffectDescription import Game.LambdaHack.Client.UI.FrameM import Game.LambdaHack.Client.UI.HandleHelperM import Game.LambdaHack.Client.UI.HumanCmd import Game.LambdaHack.Client.UI.InventoryM import Game.LambdaHack.Client.UI.ItemSlot import qualified Game.LambdaHack.Client.UI.Key as K import Game.LambdaHack.Client.UI.MonadClientUI import Game.LambdaHack.Client.UI.Msg import Game.LambdaHack.Client.UI.MsgM import Game.LambdaHack.Client.UI.Overlay import Game.LambdaHack.Client.UI.SessionUI import Game.LambdaHack.Client.UI.SlideshowM import Game.LambdaHack.Common.Actor import Game.LambdaHack.Common.ActorState import Game.LambdaHack.Common.Faction import Game.LambdaHack.Common.Item import qualified Game.LambdaHack.Common.ItemAspect as IA import Game.LambdaHack.Common.Kind import Game.LambdaHack.Common.Level import Game.LambdaHack.Common.Misc import Game.LambdaHack.Common.MonadStateRead import Game.LambdaHack.Common.Point import Game.LambdaHack.Common.ReqFailure import Game.LambdaHack.Common.State import qualified Game.LambdaHack.Common.Tile as Tile import Game.LambdaHack.Common.Time import Game.LambdaHack.Common.Types import Game.LambdaHack.Common.Vector import qualified Game.LambdaHack.Content.ItemKind as IK import Game.LambdaHack.Content.ModeKind (fhasGender) import qualified Game.LambdaHack.Content.PlaceKind as PK import Game.LambdaHack.Content.RuleKind import qualified Game.LambdaHack.Definition.Ability as Ability import Game.LambdaHack.Definition.Defs -- * Macro macroHuman :: MonadClientUI m => [String] -> m () macroHuman kms = do modifySession $ \sess -> sess {slastPlay = map K.mkKM kms ++ slastPlay sess} msgAdd MsgMacro $ "Macro activated:" <+> T.pack (intercalate " " kms) -- * ChooseItem -- | Display items from a given container store and possibly let the user -- chose one. chooseItemHuman :: MonadClientUI m => ItemDialogMode -> m MError chooseItemHuman c = either Just (const Nothing) <$> chooseItemDialogMode c chooseItemDialogMode :: MonadClientUI m => ItemDialogMode -> m (FailOrCmd ItemDialogMode) chooseItemDialogMode c = do CCUI{coscreen=ScreenContent{rwidth, rheight}} <- getsSession sccui COps{coitem} <- getsState scops side <- getsClient sside let prompt :: Actor -> ActorUI -> Ability.Skills -> ItemDialogMode -> State -> Text prompt body bodyUI actorMaxSk c2 s = let (tIn, t) = ppItemDialogMode c2 subject = partActor bodyUI f (k, _) acc = k + acc countItems store = EM.foldr' f 0 $ getBodyStoreBag body store s in case c2 of MStore CGround -> let n = countItems CGround nItems = MU.CarAWs n "item" in makePhrase [ MU.Capitalize $ MU.SubjectVerbSg subject "notice" , nItems, "at" , MU.WownW (MU.Text $ bpronoun bodyUI) $ MU.Text "feet" ] MStore CSha -> -- We assume "gold grain", not "grain" with label "of gold": let currencyName = IK.iname $ okind coitem $ ouniqGroup coitem "currency" dungeonTotal = sgold s (_, total) = calculateTotal side s n = countItems CSha verbSha = if | n == 0 -> "find nothing" | calmEnough body actorMaxSk -> "notice" | otherwise -> "paw distractedly" in makePhrase [ MU.Text $ spoilsBlurb currencyName total dungeonTotal , MU.Capitalize $ MU.SubjectVerbSg subject verbSha , MU.Text tIn , MU.Text t ] MStore cstore -> let n = countItems cstore nItems = MU.CarAWs n "item" in makePhrase [ MU.Capitalize $ MU.SubjectVerbSg subject "see" , nItems, MU.Text tIn , MU.WownW (MU.Text $ bpronoun bodyUI) $ MU.Text t ] MOrgans -> makePhrase [ MU.Capitalize $ MU.SubjectVerbSg subject "feel" , MU.Text tIn , MU.WownW (MU.Text $ bpronoun bodyUI) $ MU.Text t ] MOwned -> makePhrase [ MU.Capitalize $ MU.SubjectVerbSg subject "recall" , MU.Text tIn , MU.Text t ] MSkills -> makePhrase [ MU.Capitalize $ MU.SubjectVerbSg subject "estimate" , MU.WownW (MU.Text $ bpronoun bodyUI) $ MU.Text t ] MLore{} -> makePhrase [ MU.Capitalize $ MU.SubjectVerbSg subject "recall" , MU.Text t ] MPlaces -> makePhrase [ MU.Capitalize $ MU.SubjectVerbSg subject "recall" , MU.Text t ] ggi <- getStoreItem prompt c recordHistory -- item chosen, wipe out already shown msgs leader <- getLeaderUI actorMaxSk <- getsState $ getActorMaxSkills leader let meleeSkill = Ability.getSk Ability.SkHurtMelee actorMaxSk bUI <- getsSession $ getActorUI leader case ggi of (Right (iid, itemBag, lSlots), (c2, _)) -> case c2 of MStore fromCStore -> do modifySession $ \sess -> sess {sitemSel = Just (iid, fromCStore, False)} return $ Right c2 MOrgans -> do let blurb itemFull = if IA.checkFlag Ability.Condition $ aspectRecordFull itemFull then "condition" else "organ" promptFun _ itemFull _ = makeSentence [ partActor bUI, "can't remove" , MU.AW $ blurb itemFull ] ix0 = fromMaybe (error $ show iid) $ findIndex (== iid) $ EM.elems lSlots go <- displayItemLore itemBag meleeSkill promptFun ix0 lSlots if go then chooseItemDialogMode c2 else failWith "never mind" MOwned -> do found <- getsState $ findIid leader side iid let (newAid, bestStore) = case leader `lookup` found of Just (_, store) -> (leader, store) Nothing -> case found of (aid, (_, store)) : _ -> (aid, store) [] -> error $ "" `showFailure` iid modifySession $ \sess -> sess {sitemSel = Just (iid, bestStore, False)} arena <- getArenaUI b2 <- getsState $ getActorBody newAid fact <- getsState $ (EM.! side) . sfactionD let (autoDun, _) = autoDungeonLevel fact if | newAid == leader -> return $ Right c2 | blid b2 /= arena && autoDun -> failSer NoChangeDunLeader | otherwise -> do -- We switch leader only here, not in lore screens, because -- lore is only about inspecting items, no activation submenu. void $ pickLeader True newAid return $ Right c2 MSkills -> error $ "" `showFailure` ggi MLore slore -> do let ix0 = fromMaybe (error $ show iid) $ findIndex (== iid) $ EM.elems lSlots promptFun _ _ _ = makeSentence [ MU.SubjectVerbSg (partActor bUI) "remember" , MU.AW $ MU.Text (headingSLore slore) ] go <- displayItemLore itemBag meleeSkill promptFun ix0 lSlots if go then chooseItemDialogMode c2 else failWith "never mind" MPlaces -> error $ "" `showFailure` ggi (Left err, (MSkills, ekm)) -> case ekm of Right slot0 -> assert (err == "skills") $ do let slotListBound = length skillSlots - 1 displayOneSlot slotIndex = do b <- getsState $ getActorBody leader let slot = allSlots !! slotIndex skill = skillSlots !! fromMaybe (error $ show slot) (elemIndex slot allSlots) valueText = skillToDecorator skill b $ Ability.getSk skill actorMaxSk prompt2 = makeSentence [ MU.WownW (partActor bUI) (MU.Text $ skillName skill) , "is", MU.Text valueText ] ov0 = indentSplitAttrLine rwidth $ textToAL $ skillDesc skill keys = [K.spaceKM, K.escKM] ++ [K.upKM | slotIndex /= 0] ++ [K.downKM | slotIndex /= slotListBound] promptAdd0 prompt2 slides <- overlayToSlideshow (rheight - 2) keys (ov0, []) km <- getConfirms ColorFull keys slides case K.key km of K.Space -> chooseItemDialogMode MSkills K.Up -> displayOneSlot $ slotIndex - 1 K.Down -> displayOneSlot $ slotIndex + 1 K.Esc -> failWith "never mind" _ -> error $ "" `showFailure` km slotIndex0 = fromMaybe (error "displayOneSlot: illegal slot") $ elemIndex slot0 allSlots displayOneSlot slotIndex0 Left _ -> failWith "never mind" (Left err, (MPlaces, ekm)) -> case ekm of Right slot0 -> assert (err == "places") $ do COps{coplace} <- getsState scops soptions <- getsClient soptions places <- getsState $ EM.assocs . placesFromState coplace soptions let slotListBound = length places - 1 displayOneSlot slotIndex = do let slot = allSlots !! slotIndex (pk, figures@(es, _, _, _)) = places !! fromMaybe (error $ show slot) (elemIndex slot allSlots) pkind = okind coplace pk partsPhrase = makePhrase $ placeParts figures prompt2 = makeSentence [ MU.SubjectVerbSg (partActor bUI) "remember" , MU.Text $ PK.pname pkind ] freqsText = "Frequencies:" <+> T.intercalate " " (map (\(grp, n) -> "(" <> fromGroupName grp <> ", " <> tshow n <> ")") $ PK.pfreq pkind) onLevels | ES.null es = [] | otherwise = [makeSentence [ "Appears on" , MU.CarWs (ES.size es) "level" <> ":" , MU.WWandW $ map MU.Car $ sort $ map (abs . fromEnum) $ ES.elems es ]] ov0 = indentSplitAttrLine rwidth $ textToAL $ T.unlines $ (if sexposePlaces soptions then [ "", partsPhrase , "", freqsText , "" ] ++ PK.ptopLeft pkind else []) ++ [""] ++ onLevels keys = [K.spaceKM, K.escKM] ++ [K.upKM | slotIndex /= 0] ++ [K.downKM | slotIndex /= slotListBound] promptAdd0 prompt2 slides <- overlayToSlideshow (rheight - 2) keys (ov0, []) km <- getConfirms ColorFull keys slides case K.key km of K.Space -> chooseItemDialogMode MPlaces K.Up -> displayOneSlot $ slotIndex - 1 K.Down -> displayOneSlot $ slotIndex + 1 K.Esc -> failWith "never mind" _ -> error $ "" `showFailure` km slotIndex0 = fromMaybe (error "displayOneSlot: illegal slot") $ elemIndex slot0 allSlots displayOneSlot slotIndex0 Left _ -> failWith "never mind" (Left err, _) -> failWith err -- * ChooseItemProject chooseItemProjectHuman :: forall m. (MonadClient m, MonadClientUI m) => [TriggerItem] -> m MError chooseItemProjectHuman ts = do leader <- getLeaderUI b <- getsState $ getActorBody leader actorMaxSk <- getsState $ getActorMaxSkills leader let calmE = calmEnough b actorMaxSk cLegalRaw = [CGround, CInv, CSha, CEqp] cLegal | calmE = cLegalRaw | otherwise = delete CSha cLegalRaw (verb1, object1) = case ts of [] -> ("aim", "item") tr : _ -> (tiverb tr, tiobject tr) triggerSyms = triggerSymbols ts mpsuitReq <- psuitReq case mpsuitReq of -- If xhair aim invalid, no item is considered a (suitable) missile. Left err -> failMsg err Right psuitReqFun -> do itemSel <- getsSession sitemSel case itemSel of Just (_, _, True) -> return Nothing Just (iid, fromCStore, False) -> do -- We don't validate vs @ts@ here, because player has selected -- this item, so he knows what he's doing (unless really absurd). itemFull <- getsState $ itemToFull iid bag <- getsState $ getBodyStoreBag b fromCStore case iid `EM.lookup` bag of Just _ | either (const False) snd (psuitReqFun itemFull) -> return Nothing _ -> do modifySession $ \sess -> sess {sitemSel = Nothing} chooseItemProjectHuman ts Nothing -> do let psuit = return $ SuitsSomething $ \itemFull _kit -> either (const False) snd (psuitReqFun itemFull) && (null triggerSyms || IK.isymbol (itemKind itemFull) `elem` triggerSyms) prompt = makePhrase ["What", object1, "to", verb1] promptGeneric = "What to fling" ggi <- getGroupItem psuit prompt promptGeneric cLegalRaw cLegal case ggi of Right ((iid, _itemFull), (MStore fromCStore, _)) -> do modifySession $ \sess -> sess {sitemSel = Just (iid, fromCStore, False)} return Nothing Left err -> failMsg err _ -> error $ "" `showFailure` ggi permittedProjectClient :: MonadClientUI m => m (ItemFull -> Either ReqFailure Bool) permittedProjectClient = do leader <- getLeaderUI b <- getsState $ getActorBody leader actorMaxSk <- getsState $ getActorMaxSkills leader actorSk <- leaderSkillsClientUI let skill = Ability.getSk Ability.SkProject actorSk calmE = calmEnough b actorMaxSk return $ permittedProject False skill calmE projectCheck :: MonadClientUI m => Point -> m (Maybe ReqFailure) projectCheck tpos = do COps{corule=RuleContent{rXmax, rYmax}, coTileSpeedup} <- getsState scops leader <- getLeaderUI eps <- getsClient seps sb <- getsState $ getActorBody leader let lid = blid sb spos = bpos sb -- Not @ScreenContent@, because not drawing here. case bla rXmax rYmax eps spos tpos of Nothing -> return $ Just ProjectAimOnself Just [] -> error $ "project from the edge of level" `showFailure` (spos, tpos, sb) Just (pos : _) -> do lvl <- getLevel lid let t = lvl `at` pos if not $ Tile.isWalkable coTileSpeedup t then return $ Just ProjectBlockTerrain else if occupiedBigLvl pos lvl then return $ Just ProjectBlockActor else return Nothing -- | Check whether one is permitted to aim (for projecting) at a target. -- The check is stricter for actor targets, assuming the player simply wants -- to hit a single actor. In order to fine tune trick-shots, e.g., piercing -- many actors, other aiming modes should be used. -- Returns a different @seps@ if needed to reach the target. -- -- Note: Simple Perception check is not enough for the check, -- e.g., because the target actor can be obscured by a glass wall. xhairLegalEps :: MonadClientUI m => m (Either Text Int) xhairLegalEps = do leader <- getLeaderUI b <- getsState $ getActorBody leader lidV <- viewedLevelUI let !_A = assert (lidV == blid b) () findNewEps onlyFirst pos = do oldEps <- getsClient seps mnewEps <- makeLine onlyFirst b pos oldEps return $! case mnewEps of Just newEps -> Right newEps Nothing -> Left $ if onlyFirst then "aiming blocked at the first step" else "aiming line blocked somewhere" xhair <- getsSession sxhair case xhair of Nothing -> return $ Left "no aim designated" Just (TEnemy a) -> do body <- getsState $ getActorBody a let pos = bpos body if blid body == lidV then findNewEps False pos else return $ Left "can't fling at an enemy on remote level" Just (TNonEnemy a) -> do body <- getsState $ getActorBody a let pos = bpos body if blid body == lidV then findNewEps False pos else return $ Left "can't fling at a non-enemy on remote level" Just (TPoint TEnemyPos{} _ _) -> return $ Left "selected opponent not visible" Just (TPoint _ lid pos) -> if lid == lidV then findNewEps True pos -- @True@ to help pierce many foes, etc. else return $ Left "can't fling at a target on remote level" Just (TVector v) -> do -- Not @ScreenContent@, because not drawing here. COps{corule=RuleContent{rXmax, rYmax}} <- getsState scops let shifted = shiftBounded rXmax rYmax (bpos b) v if shifted == bpos b && v /= Vector 0 0 then return $ Left "selected translation is void" else findNewEps True shifted -- @True@, because the goal is vague anyway posFromXhair :: (MonadClient m, MonadClientUI m) => m (Either Text Point) posFromXhair = do canAim <- xhairLegalEps case canAim of Right newEps -> do -- Modify @seps@, permanently. modifyClient $ \cli -> cli {seps = newEps} mpos <- xhairToPos case mpos of Nothing -> error $ "" `showFailure` mpos Just pos -> do munit <- projectCheck pos case munit of Nothing -> return $ Right pos Just reqFail -> return $ Left $ showReqFailure reqFail Left cause -> return $ Left cause -- | On top of @permittedProjectClient@, it also checks legality -- of aiming at the target and projection range. It also modifies @eps@. psuitReq :: (MonadClient m, MonadClientUI m) => m (Either Text (ItemFull -> Either ReqFailure (Point, Bool))) psuitReq = do leader <- getLeaderUI b <- getsState $ getActorBody leader lidV <- viewedLevelUI if lidV /= blid b then return $ Left "can't fling on remote level" else do mpos <- posFromXhair p <- permittedProjectClient case mpos of Left err -> return $ Left err Right pos -> return $ Right $ \itemFull -> case p itemFull of Left err -> Left err Right False -> Right (pos, False) Right True -> let arItem = aspectRecordFull itemFull in Right (pos, IA.totalRange arItem (itemKind itemFull) >= chessDist (bpos b) pos) triggerSymbols :: [TriggerItem] -> [Char] triggerSymbols [] = [] triggerSymbols (TriggerItem{tisymbols} : ts) = tisymbols ++ triggerSymbols ts -- * ChooseItemApply chooseItemApplyHuman :: forall m. MonadClientUI m => [TriggerItem] -> m MError chooseItemApplyHuman ts = do leader <- getLeaderUI b <- getsState $ getActorBody leader actorMaxSk <- getsState $ getActorMaxSkills leader let calmE = calmEnough b actorMaxSk cLegalRaw = [CGround, CInv, CSha, CEqp] cLegal | calmE = cLegalRaw | otherwise = delete CSha cLegalRaw (verb1, object1) = case ts of [] -> ("apply", "item") tr : _ -> (tiverb tr, tiobject tr) triggerSyms = triggerSymbols ts prompt = makePhrase ["What", object1, "to", verb1] promptGeneric = "What to apply" itemSel <- getsSession sitemSel case itemSel of Just (_, _, True) -> return Nothing Just (iid, fromCStore, False) -> do -- We don't validate vs @ts@ here, because player has selected -- this item, so he knows what he's doing (unless really absurd). itemFull <- getsState $ itemToFull iid bag <- getsState $ getBodyStoreBag b fromCStore mp <- permittedApplyClient case iid `EM.lookup` bag of Just kit | either (const False) id (mp itemFull kit) -> return Nothing _ -> do modifySession $ \sess -> sess {sitemSel = Nothing} chooseItemApplyHuman ts Nothing -> do let psuit :: m Suitability psuit = do mp <- permittedApplyClient return $ SuitsSomething $ \itemFull kit -> either (const False) id (mp itemFull kit) && (null triggerSyms || IK.isymbol (itemKind itemFull) `elem` triggerSyms) ggi <- getGroupItem psuit prompt promptGeneric cLegalRaw cLegal case ggi of Right ((iid, _itemFull), (MStore fromCStore, _)) -> do modifySession $ \sess -> sess {sitemSel = Just (iid, fromCStore, False)} return Nothing Left err -> failMsg err _ -> error $ "" `showFailure` ggi permittedApplyClient :: MonadClientUI m => m (ItemFull -> ItemQuant -> Either ReqFailure Bool) permittedApplyClient = do leader <- getLeaderUI b <- getsState $ getActorBody leader actorMaxSk <- getsState $ getActorMaxSkills leader actorSk <- leaderSkillsClientUI let skill = Ability.getSk Ability.SkApply actorSk calmE = calmEnough b actorMaxSk localTime <- getsState $ getLocalTime (blid b) return $ permittedApply localTime skill calmE -- * PickLeader pickLeaderHuman :: MonadClientUI m => Int -> m MError pickLeaderHuman k = do side <- getsClient sside fact <- getsState $ (EM.! side) . sfactionD arena <- getArenaUI sactorUI <- getsSession sactorUI mhero <- getsState $ tryFindHeroK sactorUI side k allOurs <- getsState $ fidActorNotProjGlobalAssocs side -- not only on level let allOursUI = map (\(aid, b) -> (aid, b, sactorUI EM.! aid)) allOurs hs = sortOn keySelected allOursUI mactor = case drop k hs of [] -> Nothing (aid, b, _) : _ -> Just (aid, b) mchoice = if fhasGender (gplayer fact) then mhero else mactor (autoDun, _) = autoDungeonLevel fact case mchoice of Nothing -> failMsg "no such member of the party" Just (aid, b) | blid b /= arena && autoDun -> failMsg $ showReqFailure NoChangeDunLeader | otherwise -> do void $ pickLeader True aid return Nothing -- * PickLeaderWithPointer pickLeaderWithPointerHuman :: MonadClientUI m => m MError pickLeaderWithPointerHuman = pickLeaderWithPointer -- * MemberCycle -- | Switch current member to the next on the viewed level, if any, wrapping. memberCycleHuman :: MonadClientUI m => m MError memberCycleHuman = memberCycle True -- * MemberBack -- | Switch current member to the previous in the whole dungeon, wrapping. memberBackHuman :: MonadClientUI m => m MError memberBackHuman = memberBack True -- * SelectActor selectActorHuman :: MonadClientUI m => m () selectActorHuman = do leader <- getLeaderUI selectAid leader selectAid :: MonadClientUI m => ActorId -> m () selectAid leader = do bodyUI <- getsSession $ getActorUI leader wasMemeber <- getsSession $ ES.member leader . sselected let upd = if wasMemeber then ES.delete leader -- already selected, deselect instead else ES.insert leader modifySession $ \sess -> sess {sselected = upd $ sselected sess} let subject = partActor bodyUI promptAdd $ makeSentence [subject, if wasMemeber then "deselected" else "selected"] -- * SelectNone selectNoneHuman :: MonadClientUI m => m () selectNoneHuman = do side <- getsClient sside lidV <- viewedLevelUI oursIds <- getsState $ fidActorRegularIds side lidV let ours = ES.fromDistinctAscList oursIds oldSel <- getsSession sselected let wasNone = ES.null $ ES.intersection ours oldSel upd = if wasNone then ES.union -- already all deselected; select all instead else ES.difference modifySession $ \sess -> sess {sselected = upd (sselected sess) ours} let subject = "all party members on the level" promptAdd $ makeSentence [subject, if wasNone then "selected" else "deselected"] -- * SelectWithPointer selectWithPointerHuman :: MonadClientUI m => m MError selectWithPointerHuman = do COps{corule=RuleContent{rYmax}} <- getsState scops lidV <- viewedLevelUI -- Not @ScreenContent@, because not drawing here. side <- getsClient sside ours <- getsState $ filter (not . bproj . snd) . actorAssocs (== side) lidV sactorUI <- getsSession sactorUI let oursUI = map (\(aid, b) -> (aid, b, sactorUI EM.! aid)) ours viewed = sortOn keySelected oursUI Point{..} <- getsSession spointer -- Select even if no space in status line for the actor's symbol. if | py == rYmax + 2 && px == 0 -> selectNoneHuman >> return Nothing | py == rYmax + 2 -> case drop (px - 1) viewed of [] -> failMsg "not pointing at an actor" (aid, _, _) : _ -> selectAid aid >> return Nothing | otherwise -> case find (\(_, b) -> bpos b == Point px (py - mapStartY)) ours of Nothing -> failMsg "not pointing at an actor" Just (aid, _) -> selectAid aid >> return Nothing -- * Repeat -- Note that walk followed by repeat should not be equivalent to run, -- because the player can really use a command that does not stop -- at terrain change or when walking over items. repeatHuman :: MonadClientUI m => Int -> m () repeatHuman n = do LastRecord _ seqPrevious k <- getsSession slastRecord let macro = concat $ replicate n $ reverse seqPrevious modifySession $ \sess -> sess {slastPlay = macro ++ slastPlay sess} let slastRecord = LastRecord [] [] (if k == 0 then 0 else maxK) modifySession $ \sess -> sess {slastRecord} maxK :: Int maxK = 100 -- * Record recordHuman :: MonadClientUI m => m () recordHuman = do lastPlayOld <- getsSession slastPlay LastRecord _seqCurrent seqPrevious k <- getsSession slastRecord case k of 0 -> do let slastRecord = LastRecord [] [] maxK modifySession $ \sess -> sess {slastRecord} when (null lastPlayOld) $ -- Don't spam if recording is a part of playing back a macro. promptAdd0 $ "Macro will be recorded for up to" <+> tshow maxK <+> "actions. Stop recording with the same key." _ -> do let slastRecord = LastRecord seqPrevious [] 0 modifySession $ \sess -> sess {slastRecord} when (null lastPlayOld) $ -- Don't spam if recording is a part of playing back a macro. promptAdd0 $ "Macro recording stopped after" <+> tshow (maxK - k - 1) <+> "actions." -- * AllHistory allHistoryHuman :: MonadClientUI m => m () allHistoryHuman = eitherHistory True eitherHistory :: forall m. MonadClientUI m => Bool -> m () eitherHistory showAll = do CCUI{coscreen=ScreenContent{rwidth, rheight}} <- getsSession sccui history <- getsSession shistory arena <- getArenaUI localTime <- getsState $ getLocalTime arena global <- getsState stime let rh = renderHistory history turnsGlobal = global `timeFitUp` timeTurn turnsLocal = localTime `timeFitUp` timeTurn msg = makeSentence [ "You survived for" , MU.CarWs turnsGlobal "half-second turn" , "(this level:" , MU.Car turnsLocal <> ")" ] kxs = [ (Right sn, (slotPrefix sn, 0, rwidth)) | sn <- take (length rh) intSlots ] promptAdd0 msg okxs <- overlayToSlideshow rheight [K.escKM] (rh, kxs) let displayAllHistory = do ekm <- displayChoiceScreen "history" ColorFull True okxs [K.spaceKM, K.escKM] case ekm of Left km | km == K.escKM -> promptAdd0 "Try to survive a few seconds more, if you can." Left km | km == K.spaceKM -> -- click in any unused space promptAdd0 "Steady on." Right SlotChar{..} | slotChar == 'a' -> displayOneReport slotPrefix _ -> error $ "" `showFailure` ekm histBound = lengthHistory history - 1 displayOneReport :: Int -> m () displayOneReport histSlot = do let timeReport = case drop histSlot rh of [] -> error $ "" `showFailure` histSlot tR : _ -> tR ov0 = indentSplitAttrLine rwidth timeReport prompt = makeSentence [ "the", MU.Ordinal $ histSlot + 1 , "record of all history follows" ] keys = [K.spaceKM, K.escKM] ++ [K.upKM | histSlot /= 0] ++ [K.downKM | histSlot /= histBound] promptAdd0 prompt slides <- overlayToSlideshow (rheight - 2) keys (ov0, []) km <- getConfirms ColorFull keys slides case K.key km of K.Space -> displayAllHistory K.Up -> displayOneReport $ histSlot - 1 K.Down -> displayOneReport $ histSlot + 1 K.Esc -> promptAdd0 "Try to learn from your previous mistakes." _ -> error $ "" `showFailure` km if showAll then displayAllHistory else displayOneReport (length rh - 1) -- * LastHistory lastHistoryHuman :: MonadClientUI m => m () lastHistoryHuman = eitherHistory False -- * MarkVision markVisionHuman :: MonadClientUI m => m () markVisionHuman = modifySession toggleMarkVision -- * MarkSmell markSmellHuman :: MonadClientUI m => m () markSmellHuman = modifySession toggleMarkSmell -- * MarkSuspect markSuspectHuman :: MonadClient m => m () markSuspectHuman = do -- @condBFS@ depends on the setting we change here. invalidateBfsAll modifyClient cycleMarkSuspect -- * PrintScreen printScreenHuman :: MonadClientUI m => m () printScreenHuman = do promptAdd "Screenshot printed." printScreen -- * Cancel -- | End aiming mode, rejecting the current position. cancelHuman :: MonadClientUI m => m () cancelHuman = do saimMode <- getsSession saimMode when (isJust saimMode) clearAimMode -- * Accept -- | Accept the current x-hair position as target, ending -- aiming mode, if active. acceptHuman :: (MonadClient m, MonadClientUI m) => m () acceptHuman = do endAiming endAimingMsg clearAimMode -- | End aiming mode, accepting the current position. endAiming :: (MonadClient m, MonadClientUI m) => m () endAiming = do leader <- getLeaderUI sxhair <- getsSession sxhair modifyClient $ updateTarget leader $ const sxhair endAimingMsg :: MonadClientUI m => m () endAimingMsg = do leader <- getLeaderUI subject <- partActorLeader leader tgt <- getsClient $ getTarget leader (mtargetMsg, _) <- targetDesc tgt promptAdd $ case mtargetMsg of Nothing -> makeSentence [MU.SubjectVerbSg subject "clear target"] Just targetMsg -> makeSentence [MU.SubjectVerbSg subject "target", MU.Text targetMsg] -- * ClearTargetIfItemClear clearTargetIfItemClearHuman :: (MonadClient m, MonadClientUI m) => m () clearTargetIfItemClearHuman = do itemSel <- getsSession sitemSel when (isNothing itemSel) $ do modifySession $ \sess -> sess {sxhair = Nothing} leader <- getLeaderUI modifyClient $ updateTarget leader (const Nothing) doLook -- | Perform look around in the current position of the xhair. -- Does nothing outside aiming mode. doLook :: MonadClientUI m => m () doLook = do saimMode <- getsSession saimMode case saimMode of Nothing -> return () Just aimMode -> do leader <- getLeaderUI let lidV = aimLevelId aimMode mxhairPos <- xhairToPos b <- getsState $ getActorBody leader let xhairPos = fromMaybe (bpos b) mxhairPos blurb <- lookAtPosition lidV xhairPos promptAdd0 blurb -- * ItemClear itemClearHuman :: MonadClientUI m => m () itemClearHuman = modifySession $ \sess -> sess {sitemSel = Nothing} -- * MoveXhair -- | Move the xhair. Assumes aiming mode. moveXhairHuman :: MonadClientUI m => Vector -> Int -> m MError moveXhairHuman dir n = do COps{corule=RuleContent{rXmax, rYmax}} <- getsState scops leader <- getLeaderUI saimMode <- getsSession saimMode let lidV = maybe (error $ "" `showFailure` leader) aimLevelId saimMode -- Not @ScreenContent@, because not drawing here. lpos <- getsState $ bpos . getActorBody leader xhair <- getsSession sxhair mxhairPos <- xhairToPos let xhairPos = fromMaybe lpos mxhairPos shiftB pos = shiftBounded rXmax rYmax pos dir newPos = iterate shiftB xhairPos !! n if newPos == xhairPos then failMsg "never mind" else do let sxhair = case xhair of Just TVector{} -> Just $ TVector $ newPos `vectorToFrom` lpos _ -> Just $ TPoint TKnown lidV newPos modifySession $ \sess -> sess {sxhair} doLook return Nothing -- * AimTgt -- | Start aiming. aimTgtHuman :: MonadClientUI m => m MError aimTgtHuman = do -- (Re)start aiming at the current level. lidV <- viewedLevelUI modifySession $ \sess -> sess {saimMode = Just $ AimMode lidV} doLook failMsg "aiming started" -- * AimFloor -- | Cycle aiming mode. Do not change position of the xhair, -- switch among things at that position. aimFloorHuman :: MonadClientUI m => m () aimFloorHuman = do lidV <- viewedLevelUI leader <- getLeaderUI lpos <- getsState $ bpos . getActorBody leader mxhairPos <- xhairToPos xhair <- getsSession sxhair saimMode <- getsSession saimMode bsAll <- getsState $ actorAssocs (const True) lidV side <- getsClient sside fact <- getsState $ (EM.! side) . sfactionD let xhairPos = fromMaybe lpos mxhairPos sxhair = case xhair of _ | isNothing saimMode -> -- first key press: keep target xhair Just TEnemy{} -> Just $ TPoint TKnown lidV xhairPos Just TNonEnemy{} -> Just $ TPoint TKnown lidV xhairPos Just TPoint{} | xhairPos /= lpos -> Just $ TVector $ xhairPos `vectorToFrom` lpos Just TVector{} -> -- If many actors, we pick here the first that would be picked -- by '*', so that all other projectiles on the tile come next, -- when pressing "*", without any intervening actors from other tiles. -- This is why we use @actorAssocs@ above instead of @posToAidAssocs@. case find (\(_, b) -> Just (bpos b) == mxhairPos) bsAll of Just (aid, b) -> Just $ if isFoe side fact (bfid b) then TEnemy aid else TNonEnemy aid Nothing -> Just $ TPoint TUnknown lidV xhairPos _ -> xhair modifySession $ \sess -> sess { saimMode = Just $ AimMode lidV , sxhair } doLook -- * AimEnemy aimEnemyHuman :: MonadClientUI m => m () aimEnemyHuman = do lidV <- viewedLevelUI leader <- getLeaderUI lpos <- getsState $ bpos . getActorBody leader mxhairPos <- xhairToPos xhair <- getsSession sxhair saimMode <- getsSession saimMode side <- getsClient sside fact <- getsState $ (EM.! side) . sfactionD bsAll <- getsState $ actorAssocs (const True) lidV let -- On the same position, big actors come before projectiles. ordPos (_, b) = (chessDist lpos $ bpos b, bpos b, bproj b) dbs = sortOn ordPos bsAll pickUnderXhair = -- switch to the actor under xhair, if any fromMaybe (-1) $ findIndex ((== mxhairPos) . Just . bpos . snd) dbs (pickEnemies, i) = case xhair of Just (TEnemy a) | isJust saimMode -> -- pick next enemy (True, 1 + fromMaybe (-1) (findIndex ((== a) . fst) dbs)) Just (TEnemy a) -> -- first key press, retarget old enemy (True, fromMaybe (-1) $ findIndex ((== a) . fst) dbs) Just (TNonEnemy a) | isJust saimMode -> -- pick next non-enemy (False, 1 + fromMaybe (-1) (findIndex ((== a) . fst) dbs)) Just (TNonEnemy a) -> -- first key press, retarget old non-enemy (False, fromMaybe (-1) $ findIndex ((== a) . fst) dbs) _ -> (True, pickUnderXhair) (lt, gt) = splitAt i dbs isEnemy b = isFoe side fact (bfid b) && not (bproj b) && bhp b > 0 cond = if pickEnemies then isEnemy else not . isEnemy lf = filter (cond . snd) $ gt ++ lt sxhair = case lf of (a, _) : _ -> Just $ if pickEnemies then TEnemy a else TNonEnemy a [] -> xhair -- no seen foes in sight, stick to last target -- Register the chosen enemy, to pick another on next invocation. modifySession $ \sess -> sess { saimMode = Just $ AimMode lidV , sxhair } doLook -- * AimItem aimItemHuman :: MonadClientUI m => m () aimItemHuman = do lidV <- viewedLevelUI leader <- getLeaderUI lpos <- getsState $ bpos . getActorBody leader mxhairPos <- xhairToPos xhair <- getsSession sxhair saimMode <- getsSession saimMode bsAll <- getsState $ EM.keys . lfloor . (EM.! lidV) . sdungeon let ordPos p = (chessDist lpos p, p) dbs = sortOn ordPos bsAll pickUnderXhair = -- switch to the item under xhair, if any let i = fromMaybe (-1) $ findIndex ((== mxhairPos) . Just) dbs in splitAt i dbs (lt, gt) = case xhair of Just (TPoint _ lid pos) | isJust saimMode && lid == lidV -> -- pick next item let i = fromMaybe (-1) $ findIndex (== pos) dbs in splitAt (i + 1) dbs Just (TPoint _ lid pos) | lid == lidV -> -- first key press, retarget old item let i = fromMaybe (-1) $ findIndex (== pos) dbs in splitAt i dbs _ -> pickUnderXhair gtlt = gt ++ lt sxhair = case gtlt of p : _ -> Just $ TPoint TKnown lidV p -- don't force AI to collect it [] -> xhair -- no items remembered, stick to last target -- Register the chosen enemy, to pick another on next invocation. modifySession $ \sess -> sess { saimMode = Just $ AimMode lidV , sxhair } doLook -- * AimAscend -- | Change the displayed level in aiming mode to (at most) -- k levels shallower. Enters aiming mode, if not already in one. aimAscendHuman :: MonadClientUI m => Int -> m MError aimAscendHuman k = do dungeon <- getsState sdungeon lidV <- viewedLevelUI let up = k > 0 case ascendInBranch dungeon up lidV of [] -> failMsg "no more levels in this direction" _ : _ -> do let ascendOne lid = case ascendInBranch dungeon up lid of [] -> lid nlid : _ -> nlid lidK = iterate ascendOne lidV !! abs k leader <- getLeaderUI lpos <- getsState $ bpos . getActorBody leader mxhairPos <- xhairToPos let xhairPos = fromMaybe lpos mxhairPos sxhair = Just $ TPoint TKnown lidK xhairPos modifySession $ \sess -> sess { saimMode = Just (AimMode lidK) , sxhair } doLook return Nothing -- * EpsIncr -- | Tweak the @eps@ parameter of the aiming digital line. epsIncrHuman :: (MonadClient m, MonadClientUI m) => Bool -> m () epsIncrHuman b = do saimMode <- getsSession saimMode lidV <- viewedLevelUI modifySession $ \sess -> sess {saimMode = Just $ AimMode lidV} modifyClient $ \cli -> cli {seps = seps cli + if b then 1 else -1} invalidateBfsPathAll flashAiming modifySession $ \sess -> sess {saimMode} -- Flash the aiming line and path. flashAiming :: MonadClientUI m => m () flashAiming = do lidV <- viewedLevelUI animate lidV pushAndDelay -- * XhairUnknown xhairUnknownHuman :: (MonadClient m, MonadClientUI m) => m MError xhairUnknownHuman = do leader <- getLeaderUI b <- getsState $ getActorBody leader mpos <- closestUnknown leader case mpos of Nothing -> failMsg "no more unknown spots left" Just p -> do let sxhair = Just $ TPoint TUnknown (blid b) p modifySession $ \sess -> sess {sxhair} doLook return Nothing -- * XhairItem xhairItemHuman :: (MonadClient m, MonadClientUI m) => m MError xhairItemHuman = do leader <- getLeaderUI b <- getsState $ getActorBody leader items <- closestItems leader case items of [] -> failMsg "no more reachable items remembered or visible" _ -> do let (_, (p, bag)) = maximumBy (comparing fst) items sxhair = Just $ TPoint (TItem bag) (blid b) p modifySession $ \sess -> sess {sxhair} doLook return Nothing -- * XhairStair xhairStairHuman :: (MonadClient m, MonadClientUI m) => Bool -> m MError xhairStairHuman up = do leader <- getLeaderUI b <- getsState $ getActorBody leader stairs <- closestTriggers (if up then ViaStairsUp else ViaStairsDown) leader case stairs of [] -> failMsg $ "no reachable stairs" <+> if up then "up" else "down" _ -> do let (_, (p, (p0, bag))) = maximumBy (comparing fst) stairs sxhair = Just $ TPoint (TEmbed bag p0) (blid b) p modifySession $ \sess -> sess {sxhair} doLook return Nothing -- * XhairPointerFloor xhairPointerFloorHuman :: MonadClientUI m => m () xhairPointerFloorHuman = do saimMode <- getsSession saimMode aimPointerFloorHuman modifySession $ \sess -> sess {saimMode} -- * XhairPointerEnemy xhairPointerEnemyHuman :: MonadClientUI m => m () xhairPointerEnemyHuman = do saimMode <- getsSession saimMode aimPointerEnemyHuman modifySession $ \sess -> sess {saimMode} -- * AimPointerFloor aimPointerFloorHuman :: MonadClientUI m => m () aimPointerFloorHuman = do COps{corule=RuleContent{rXmax, rYmax}} <- getsState scops lidV <- viewedLevelUI -- Not @ScreenContent@, because not drawing here. Point{..} <- getsSession spointer if px >= 0 && py - mapStartY >= 0 && px < rXmax && py - mapStartY < rYmax then do oldXhair <- getsSession sxhair let sxhair = Just $ TPoint TUnknown lidV $ Point px (py - mapStartY) sxhairMoused = sxhair /= oldXhair modifySession $ \sess -> sess { saimMode = Just $ AimMode lidV , sxhair , sxhairMoused } doLook else stopPlayBack -- * AimPointerEnemy aimPointerEnemyHuman :: MonadClientUI m => m () aimPointerEnemyHuman = do COps{corule=RuleContent{rXmax, rYmax}} <- getsState scops lidV <- viewedLevelUI -- Not @ScreenContent@, because not drawing here. Point{..} <- getsSession spointer if px >= 0 && py - mapStartY >= 0 && px < rXmax && py - mapStartY < rYmax then do bsAll <- getsState $ actorAssocs (const True) lidV oldXhair <- getsSession sxhair side <- getsClient sside fact <- getsState $ (EM.! side) . sfactionD let newPos = Point px (py - mapStartY) sxhair = -- If many actors, we pick here the first that would be picked -- by '*', so that all other projectiles on the tile come next, -- when pressing "*", without any intervening actors from other tiles. -- This is why we use @actorAssocs@ above instead of @posToAidAssocs@. case find (\(_, b) -> bpos b == newPos) bsAll of Just (aid, b) -> Just $ if isFoe side fact (bfid b) then TEnemy aid else TNonEnemy aid Nothing -> Just $ TPoint TUnknown lidV newPos sxhairMoused = sxhair /= oldXhair modifySession $ \sess -> sess { saimMode = Just $ AimMode lidV , sxhairMoused , sxhair } doLook else stopPlayBack LambdaHack-0.9.5.0/engine-src/Game/LambdaHack/Client/UI/HandleHumanM.hs0000644000000000000000000001507507346545000023275 0ustar0000000000000000-- | Semantics of human player commands. module Game.LambdaHack.Client.UI.HandleHumanM ( cmdHumanSem #ifdef EXPOSE_INTERNAL -- * Internal operations , noRemoteHumanCmd, cmdAction, addNoError #endif ) where import Prelude () import Game.LambdaHack.Core.Prelude import Game.LambdaHack.Client.MonadClient import Game.LambdaHack.Client.Request import Game.LambdaHack.Client.UI.HandleHelperM import Game.LambdaHack.Client.UI.HandleHumanGlobalM import Game.LambdaHack.Client.UI.HandleHumanLocalM import Game.LambdaHack.Client.UI.HumanCmd import Game.LambdaHack.Client.UI.MonadClientUI -- | The semantics of human player commands in terms of the client monad. -- -- Some time cosuming commands are enabled even in aiming mode, but cannot be -- invoked in aiming mode on a remote level (level different than -- the level of the leader), which is caught here. cmdHumanSem :: (MonadClient m, MonadClientUI m) => HumanCmd -> m (Either MError ReqUI) cmdHumanSem cmd = if noRemoteHumanCmd cmd then do -- If in aiming mode, check if the current level is the same -- as player level and refuse performing the action otherwise. arena <- getArenaUI lidV <- viewedLevelUI if arena /= lidV then weaveJust <$> failWith "command disabled on a remote level, press ESC to switch back" else cmdAction cmd else cmdAction cmd -- | Commands that are forbidden on a remote level, because they -- would usually take time when invoked on one, but not necessarily do -- what the player expects. Note that some commands that normally take time -- are not included, because they don't take time in aiming mode -- or their individual sanity conditions include a remote level check. noRemoteHumanCmd :: HumanCmd -> Bool noRemoteHumanCmd cmd = case cmd of Wait -> True Wait10 -> True MoveItem{} -> True Apply{} -> True AlterDir{} -> True AlterWithPointer{} -> True MoveOnceToXhair -> True RunOnceToXhair -> True ContinueToXhair -> True _ -> False cmdAction :: (MonadClient m, MonadClientUI m) => HumanCmd -> m (Either MError ReqUI) cmdAction cmd = case cmd of Macro kms -> addNoError $ macroHuman kms ByArea l -> byAreaHuman cmdAction l ByAimMode AimModeCmd{..} -> byAimModeHuman (cmdAction exploration) (cmdAction aiming) ComposeIfLocal cmd1 cmd2 -> composeIfLocalHuman (cmdAction cmd1) (cmdAction cmd2) ComposeUnlessError cmd1 cmd2 -> composeUnlessErrorHuman (cmdAction cmd1) (cmdAction cmd2) Compose2ndLocal cmd1 cmd2 -> compose2ndLocalHuman (cmdAction cmd1) (cmdAction cmd2) LoopOnNothing cmd1 -> loopOnNothingHuman (cmdAction cmd1) ExecuteIfClear cmd1 -> executeIfClearHuman (cmdAction cmd1) Wait -> weaveJust <$> (ReqUITimed <$$> waitHuman) Wait10 -> weaveJust <$> (ReqUITimed <$$> waitHuman10) Yell -> weaveJust <$> (ReqUITimed <$$> yellHuman) MoveDir v -> weaveJust <$> (ReqUITimed <$$> moveRunHuman True True False False v) RunDir v -> weaveJust <$> (ReqUITimed <$$> moveRunHuman True True True True v) RunOnceAhead -> ReqUITimed <$$> runOnceAheadHuman MoveOnceToXhair -> weaveJust <$> (ReqUITimed <$$> moveOnceToXhairHuman) RunOnceToXhair -> weaveJust <$> (ReqUITimed <$$> runOnceToXhairHuman) ContinueToXhair -> weaveJust <$> (ReqUITimed <$$> continueToXhairHuman) MoveItem cLegalRaw toCStore mverb auto -> weaveJust <$> (ReqUITimed <$$> moveItemHuman cLegalRaw toCStore mverb auto) Project -> weaveJust <$> (ReqUITimed <$$> projectHuman) Apply -> weaveJust <$> (ReqUITimed <$$> applyHuman) AlterDir ts -> weaveJust <$> (ReqUITimed <$$> alterDirHuman ts) AlterWithPointer ts -> weaveJust <$> (ReqUITimed <$$> alterWithPointerHuman ts) Help -> helpHuman cmdAction Hint -> hintHuman cmdAction ItemMenu -> itemMenuHuman cmdAction ChooseItemMenu dialogMode -> chooseItemMenuHuman cmdAction dialogMode MainMenu -> mainMenuHuman cmdAction MainMenuAutoOn -> mainMenuAutoOnHuman cmdAction MainMenuAutoOff -> mainMenuAutoOffHuman cmdAction Dashboard -> dashboardHuman cmdAction GameDifficultyIncr -> gameDifficultyIncr >> challengesMenuHuman cmdAction GameWolfToggle -> gameWolfToggle >> challengesMenuHuman cmdAction GameFishToggle -> gameFishToggle >> challengesMenuHuman cmdAction GameScenarioIncr -> gameScenarioIncr >> mainMenuHuman cmdAction GameRestart -> weaveJust <$> gameRestartHuman GameQuit -> weaveJust <$> gameQuitHuman GameDrop -> weaveJust <$> fmap Right gameDropHuman GameExit -> weaveJust <$> fmap Right gameExitHuman GameSave -> weaveJust <$> fmap Right gameSaveHuman Tactic -> weaveJust <$> tacticHuman Automate -> weaveJust <$> automateHuman AutomateToggle -> weaveJust <$> automateToggleHuman AutomateBack -> automateBackHuman ChooseItem dialogMode -> Left <$> chooseItemHuman dialogMode ChooseItemProject ts -> Left <$> chooseItemProjectHuman ts ChooseItemApply ts -> Left <$> chooseItemApplyHuman ts PickLeader k -> Left <$> pickLeaderHuman k PickLeaderWithPointer -> Left <$> pickLeaderWithPointerHuman MemberCycle -> Left <$> memberCycleHuman MemberBack -> Left <$> memberBackHuman SelectActor -> addNoError selectActorHuman SelectNone -> addNoError selectNoneHuman SelectWithPointer -> Left <$> selectWithPointerHuman Repeat n -> addNoError $ repeatHuman n Record -> addNoError recordHuman AllHistory -> addNoError allHistoryHuman LastHistory -> addNoError lastHistoryHuman MarkVision -> markVisionHuman >> settingsMenuHuman cmdAction MarkSmell -> markSmellHuman >> settingsMenuHuman cmdAction MarkSuspect -> markSuspectHuman >> settingsMenuHuman cmdAction SettingsMenu -> settingsMenuHuman cmdAction ChallengesMenu -> challengesMenuHuman cmdAction PrintScreen -> addNoError printScreenHuman Cancel -> addNoError cancelHuman Accept -> addNoError acceptHuman ClearTargetIfItemClear -> addNoError clearTargetIfItemClearHuman ItemClear -> addNoError itemClearHuman MoveXhair v k -> Left <$> moveXhairHuman v k AimTgt -> Left <$> aimTgtHuman AimFloor -> addNoError aimFloorHuman AimEnemy -> addNoError aimEnemyHuman AimItem -> addNoError aimItemHuman AimAscend k -> Left <$> aimAscendHuman k EpsIncr b -> addNoError $ epsIncrHuman b XhairUnknown -> Left <$> xhairUnknownHuman XhairItem -> Left <$> xhairItemHuman XhairStair up -> Left <$> xhairStairHuman up XhairPointerFloor -> addNoError xhairPointerFloorHuman XhairPointerEnemy -> addNoError xhairPointerEnemyHuman AimPointerFloor -> addNoError aimPointerFloorHuman AimPointerEnemy -> addNoError aimPointerEnemyHuman addNoError :: Monad m => m () -> m (Either MError ReqUI) addNoError cmdCli = cmdCli >> return (Left Nothing) LambdaHack-0.9.5.0/engine-src/Game/LambdaHack/Client/UI/HumanCmd.hs0000644000000000000000000001336007346545000022463 0ustar0000000000000000{-# LANGUAGE DeriveGeneric #-} -- | Abstract syntax of human player commands. module Game.LambdaHack.Client.UI.HumanCmd ( CmdCategory(..), categoryDescription , CmdArea(..), areaDescription , CmdTriple, AimModeCmd(..), HumanCmd(..) , TriggerItem(..), TriggerTile(..) ) where import Prelude () import Game.LambdaHack.Core.Prelude import Control.DeepSeq import Data.Binary import GHC.Generics (Generic) import qualified NLP.Miniutter.English as MU import Game.LambdaHack.Common.Vector import qualified Game.LambdaHack.Content.TileKind as TK import Game.LambdaHack.Definition.Defs data CmdCategory = CmdMainMenu | CmdDashboard | CmdItemMenu | CmdMove | CmdItem | CmdAim | CmdMeta | CmdMouse | CmdInternal | CmdNoHelp | CmdDebug | CmdMinimal deriving (Show, Read, Eq, Generic) instance NFData CmdCategory instance Binary CmdCategory categoryDescription :: CmdCategory -> Text categoryDescription CmdMainMenu = "Main menu" categoryDescription CmdDashboard = "Dashboard" categoryDescription CmdItemMenu = "Item menu commands" categoryDescription CmdMove = "Terrain exploration and alteration" categoryDescription CmdItem = "Remaining item-related commands" categoryDescription CmdAim = "Aiming commands" categoryDescription CmdMeta = "Assorted commands" categoryDescription CmdMouse = "Mouse" categoryDescription CmdInternal = "Internal" categoryDescription CmdNoHelp = "Ignored in help" categoryDescription CmdDebug = "Debug" categoryDescription CmdMinimal = "The minimal command set" -- The constructors are sorted, roughly, wrt inclusion, then top to bottom, -- the left to right. -- | Symbolic representation of areas of the screen used to define the meaning -- of mouse button presses relative to where the mouse points to. data CmdArea = CaMessage | CaMapLeader | CaMapParty | CaMap | CaLevelNumber | CaArenaName | CaPercentSeen | CaXhairDesc | CaSelected | CaCalmGauge | CaCalmValue | CaHPGauge | CaHPValue | CaLeaderDesc deriving (Show, Read, Eq, Ord, Generic) instance NFData CmdArea instance Binary CmdArea areaDescription :: CmdArea -> Text areaDescription ca = case ca of CaMessage -> "message line" CaMapLeader -> "leader on map" CaMapParty -> "party on map" CaMap -> "the map area" CaLevelNumber -> "level number" CaArenaName -> "level caption" CaPercentSeen -> "percent seen" CaXhairDesc -> "x-hair info" CaSelected -> "party roster" CaCalmGauge -> "Calm gauge" CaCalmValue -> "Calm value" CaHPGauge -> "HP gauge" CaHPValue -> "HP Value" CaLeaderDesc -> "leader info" -- 1234567890123 -- | This triple of command categories, description and the command term itself -- defines the meaning of a human command as entered via a keypress, -- mouse click or chosen from a menu. type CmdTriple = ([CmdCategory], Text, HumanCmd) data AimModeCmd = AimModeCmd {exploration :: HumanCmd, aiming :: HumanCmd} deriving (Show, Read, Eq, Ord, Generic) instance NFData AimModeCmd instance Binary AimModeCmd -- | Abstract syntax of human player commands. data HumanCmd = -- Meta. Macro [String] | ByArea [(CmdArea, HumanCmd)] -- if outside the areas, do nothing | ByAimMode AimModeCmd | ComposeIfLocal HumanCmd HumanCmd | ComposeUnlessError HumanCmd HumanCmd | Compose2ndLocal HumanCmd HumanCmd | LoopOnNothing HumanCmd | ExecuteIfClear HumanCmd -- Global. -- These usually take time. | Wait | Wait10 | Yell | MoveDir Vector | RunDir Vector | RunOnceAhead | MoveOnceToXhair | RunOnceToXhair | ContinueToXhair | MoveItem [CStore] CStore (Maybe MU.Part) Bool | Project | Apply | AlterDir [TriggerTile] | AlterWithPointer [TriggerTile] | Help | Hint | ItemMenu | MainMenu | MainMenuAutoOn | MainMenuAutoOff | Dashboard -- Below this line, commands do not take time. | GameDifficultyIncr | GameWolfToggle | GameFishToggle | GameScenarioIncr | GameRestart | GameQuit | GameDrop | GameExit | GameSave | Tactic | Automate | AutomateToggle | AutomateBack -- Local. Below this line, commands do not notify the server. | ChooseItem ItemDialogMode | ChooseItemMenu ItemDialogMode | ChooseItemProject [TriggerItem] | ChooseItemApply [TriggerItem] | PickLeader Int | PickLeaderWithPointer | MemberCycle | MemberBack | SelectActor | SelectNone | SelectWithPointer | Repeat Int | Record | AllHistory | LastHistory | MarkVision | MarkSmell | MarkSuspect | SettingsMenu | ChallengesMenu | PrintScreen -- These are mostly related to aiming. | Cancel | Accept | ClearTargetIfItemClear | ItemClear | MoveXhair Vector Int | AimTgt | AimFloor | AimEnemy | AimItem | AimAscend Int | EpsIncr Bool | XhairUnknown | XhairItem | XhairStair Bool | XhairPointerFloor | XhairPointerEnemy | AimPointerFloor | AimPointerEnemy deriving (Show, Read, Eq, Ord, Generic) instance NFData HumanCmd instance Binary HumanCmd -- | Description of how item manipulation is triggered and communicated -- to the player. data TriggerItem = TriggerItem {tiverb :: MU.Part, tiobject :: MU.Part, tisymbols :: [Char]} deriving (Show, Eq, Ord, Generic) instance Read TriggerItem where readsPrec = error $ "parsing of TriggerItem not implemented" `showFailure` () instance NFData TriggerItem instance Binary TriggerItem -- | Description of how tile altering is triggered and communicated -- to the player. data TriggerTile = TriggerTile {ttverb :: MU.Part, ttobject :: MU.Part, ttfeature :: TK.Feature} deriving (Show, Eq, Ord, Generic) instance Read TriggerTile where readsPrec = error $ "parsing of TriggerTile not implemented" `showFailure` () instance NFData TriggerTile instance Binary TriggerTile LambdaHack-0.9.5.0/engine-src/Game/LambdaHack/Client/UI/InventoryM.hs0000644000000000000000000005656107346545000023113 0ustar0000000000000000-- | UI of inventory management. module Game.LambdaHack.Client.UI.InventoryM ( Suitability(..) , getFull, getGroupItem, getStoreItem ) where import Prelude () import Game.LambdaHack.Core.Prelude import qualified Data.Char as Char import Data.Either import qualified Data.EnumMap.Strict as EM import qualified Data.Text as T import Data.Tuple (swap) import qualified NLP.Miniutter.English as MU import Game.LambdaHack.Client.MonadClient import Game.LambdaHack.Client.State import Game.LambdaHack.Client.UI.ActorUI import Game.LambdaHack.Client.UI.Content.Screen import Game.LambdaHack.Client.UI.ContentClientUI import Game.LambdaHack.Client.UI.HandleHelperM import Game.LambdaHack.Client.UI.HumanCmd import Game.LambdaHack.Client.UI.ItemSlot import qualified Game.LambdaHack.Client.UI.Key as K import Game.LambdaHack.Client.UI.MonadClientUI import Game.LambdaHack.Client.UI.MsgM import Game.LambdaHack.Client.UI.Overlay import Game.LambdaHack.Client.UI.SessionUI import Game.LambdaHack.Client.UI.Slideshow import Game.LambdaHack.Client.UI.SlideshowM import Game.LambdaHack.Common.Actor import Game.LambdaHack.Common.ActorState import Game.LambdaHack.Common.Faction import Game.LambdaHack.Common.Item import qualified Game.LambdaHack.Common.ItemAspect as IA import Game.LambdaHack.Common.Misc import Game.LambdaHack.Common.MonadStateRead import Game.LambdaHack.Common.ReqFailure import Game.LambdaHack.Common.State import Game.LambdaHack.Common.Types import qualified Game.LambdaHack.Definition.Ability as Ability import Game.LambdaHack.Definition.Defs data ItemDialogState = ISuitable | IAll deriving (Show, Eq) accessModeBag :: ActorId -> State -> ItemDialogMode -> ItemBag accessModeBag leader s (MStore cstore) = let b = getActorBody leader s in getBodyStoreBag b cstore s accessModeBag leader s MOrgans = let b = getActorBody leader s in getBodyStoreBag b COrgan s accessModeBag leader s MOwned = let fid = bfid $ getActorBody leader s in combinedItems fid s accessModeBag _ _ MSkills = EM.empty accessModeBag _ s MLore{} = EM.map (const (1, [])) $ sitemD s accessModeBag _ _ MPlaces = EM.empty -- | Let a human player choose any item from a given group. -- Note that this does not guarantee the chosen item belongs to the group, -- as the player can override the choice. -- Used e.g., for applying and projecting. getGroupItem :: MonadClientUI m => m Suitability -- ^ which items to consider suitable -> Text -- ^ specific prompt for only suitable items -> Text -- ^ generic prompt -> [CStore] -- ^ initial legal modes -> [CStore] -- ^ legal modes after Calm taken into account -> m (Either Text ( (ItemId, ItemFull) , (ItemDialogMode, Either K.KM SlotChar) )) getGroupItem psuit prompt promptGeneric cLegalRaw cLegalAfterCalm = do soc <- getFull psuit (\_ _ _ cCur _ -> prompt <+> ppItemDialogModeFrom cCur) (\_ _ _ cCur _ -> promptGeneric <+> ppItemDialogModeFrom cCur) cLegalRaw cLegalAfterCalm True False case soc of Left err -> return $ Left err Right ([(iid, (itemFull, _))], cekm) -> return $ Right ((iid, itemFull), cekm) Right _ -> error $ "" `showFailure` soc -- | Display all items from a store and let the human player choose any -- or switch to any other store. -- Used, e.g., for viewing inventory and item descriptions. getStoreItem :: MonadClientUI m => (Actor -> ActorUI -> Ability.Skills -> ItemDialogMode -> State -> Text) -- ^ how to describe suitable items -> ItemDialogMode -- ^ initial mode -> m ( Either Text (ItemId, ItemBag, SingleItemSlots) , (ItemDialogMode, Either K.KM SlotChar) ) getStoreItem prompt cInitial = do let itemCs = map MStore [CEqp, CInv, CGround, CSha] loreCs = map MLore [minBound..maxBound] ++ [MPlaces] allCs = case cInitial of MLore{} -> loreCs MPlaces -> loreCs _ -> itemCs ++ [MOwned, MOrgans, MSkills] (pre, rest) = break (== cInitial) allCs post = dropWhile (== cInitial) rest remCs = post ++ pre soc <- getItem (return SuitsEverything) prompt prompt cInitial remCs True False (cInitial : remCs) case soc of (Left err, cekm) -> return (Left err, cekm) (Right ([iid], itemBag, lSlots), cekm) -> return (Right (iid, itemBag, lSlots), cekm) (Right{}, _) -> error $ "" `showFailure` soc -- | Let the human player choose a single, preferably suitable, -- item from a list of items. Don't display stores empty for all actors. -- Start with a non-empty store. getFull :: MonadClientUI m => m Suitability -- ^ which items to consider suitable -> (Actor -> ActorUI -> Ability.Skills -> ItemDialogMode -> State -> Text) -- ^ specific prompt for only suitable items -> (Actor -> ActorUI -> Ability.Skills -> ItemDialogMode -> State -> Text) -- ^ generic prompt -> [CStore] -- ^ initial legal modes -> [CStore] -- ^ legal modes with Calm taken into account -> Bool -- ^ whether to ask, when the only item -- in the starting mode is suitable -> Bool -- ^ whether to permit multiple items as a result -> m (Either Text ( [(ItemId, ItemFullKit)] , (ItemDialogMode, Either K.KM SlotChar) )) getFull psuit prompt promptGeneric cLegalRaw cLegalAfterCalm askWhenLone permitMulitple = do side <- getsClient sside leader <- getLeaderUI let aidNotEmpty store aid = do body <- getsState $ getActorBody aid bag <- getsState $ getBodyStoreBag body store return $! not $ EM.null bag partyNotEmpty store = do as <- getsState $ fidActorNotProjGlobalAssocs side bs <- mapM (aidNotEmpty store . fst) as return $! or bs mpsuit <- psuit let psuitFun = case mpsuit of SuitsEverything -> \_ _ -> True SuitsSomething f -> f -- Move the first store that is non-empty for suitable items for this actor -- to the front, if any. b <- getsState $ getActorBody leader getCStoreBag <- getsState $ \s cstore -> getBodyStoreBag b cstore s let hasThisActor = not . EM.null . getCStoreBag case filter hasThisActor cLegalAfterCalm of [] -> if isNothing (find hasThisActor cLegalRaw) then do let contLegalRaw = map MStore cLegalRaw tLegal = map (MU.Text . ppItemDialogModeIn) contLegalRaw ppLegal = makePhrase [MU.WWxW "nor" tLegal] return $ Left $ "no items" <+> ppLegal else return $ Left $ showReqFailure ItemNotCalm haveThis@(headThisActor : _) -> do itemToF <- getsState $ flip itemToFull let suitsThisActor store = let bag = getCStoreBag store in any (\(iid, kit) -> psuitFun (itemToF iid) kit) $ EM.assocs bag firstStore = fromMaybe headThisActor $ find suitsThisActor haveThis -- Don't display stores totally empty for all actors. cLegal <- filterM partyNotEmpty cLegalRaw let breakStores cInit = let (pre, rest) = break (== cInit) cLegal post = dropWhile (== cInit) rest in (MStore cInit, map MStore $ post ++ pre) let (modeFirst, modeRest) = breakStores firstStore res <- getItem psuit prompt promptGeneric modeFirst modeRest askWhenLone permitMulitple (map MStore cLegal) case res of (Left t, _) -> return $ Left t (Right (iids, itemBag, _lSlots), cekm) -> do let f iid = (iid, (itemToF iid, itemBag EM.! iid)) return $ Right (map f iids, cekm) -- | Let the human player choose a single, preferably suitable, -- item from a list of items. getItem :: MonadClientUI m => m Suitability -- ^ which items to consider suitable -> (Actor -> ActorUI -> Ability.Skills -> ItemDialogMode -> State -> Text) -- ^ specific prompt for only suitable items -> (Actor -> ActorUI -> Ability.Skills -> ItemDialogMode -> State -> Text) -- ^ generic prompt -> ItemDialogMode -- ^ first mode, legal or not -> [ItemDialogMode] -- ^ the (rest of) legal modes -> Bool -- ^ whether to ask, when the only item -- in the starting mode is suitable -> Bool -- ^ whether to permit multiple items as a result -> [ItemDialogMode] -- ^ all legal modes -> m ( Either Text ([ItemId], ItemBag, SingleItemSlots) , (ItemDialogMode, Either K.KM SlotChar) ) getItem psuit prompt promptGeneric cCur cRest askWhenLone permitMulitple cLegal = do leader <- getLeaderUI accessCBag <- getsState $ accessModeBag leader let storeAssocs = EM.assocs . accessCBag allAssocs = concatMap storeAssocs (cCur : cRest) case allAssocs of [(iid, k)] | null cRest && not askWhenLone -> do ItemSlots itemSlots <- getsSession sslots let lSlots = itemSlots EM.! IA.loreFromMode cCur slotChar = fromMaybe (error $ "" `showFailure` (iid, lSlots)) $ lookup iid $ map swap $ EM.assocs lSlots return ( Right ([iid], EM.singleton iid k, EM.singleton slotChar iid) , (cCur, Right slotChar) ) _ -> transition psuit prompt promptGeneric permitMulitple cLegal 0 cCur cRest ISuitable data DefItemKey m = DefItemKey { defLabel :: Either Text K.KM , defCond :: Bool , defAction :: Either K.KM SlotChar -> m ( Either Text ([ItemId], ItemBag, SingleItemSlots) , (ItemDialogMode, Either K.KM SlotChar) ) } data Suitability = SuitsEverything | SuitsSomething (ItemFull -> ItemQuant -> Bool) transition :: forall m. MonadClientUI m => m Suitability -> (Actor -> ActorUI -> Ability.Skills -> ItemDialogMode -> State -> Text) -> (Actor -> ActorUI -> Ability.Skills -> ItemDialogMode -> State -> Text) -> Bool -> [ItemDialogMode] -> Int -> ItemDialogMode -> [ItemDialogMode] -> ItemDialogState -> m ( Either Text ([ItemId], ItemBag, SingleItemSlots) , (ItemDialogMode, Either K.KM SlotChar) ) transition psuit prompt promptGeneric permitMulitple cLegal numPrefix cCur cRest itemDialogState = do let recCall = transition psuit prompt promptGeneric permitMulitple cLegal ItemSlots itemSlotsPre <- getsSession sslots leader <- getLeaderUI body <- getsState $ getActorBody leader bodyUI <- getsSession $ getActorUI leader actorMaxSk <- getsState $ getActorMaxSkills leader fact <- getsState $ (EM.! bfid body) . sfactionD hs <- partyAfterLeader leader bagAll <- getsState $ \s -> accessModeBag leader s cCur itemToF <- getsState $ flip itemToFull revCmd <- revCmdMap mpsuit <- psuit -- when throwing, this sets eps and checks xhair validity psuitFun <- case mpsuit of SuitsEverything -> return $ \_ _ -> True SuitsSomething f -> return f -- When throwing, this function takes -- missile range into accout. -- This is the only place slots are sorted. As a side-effect, -- slots in inventories always agree with slots of item lore. -- Not so for organ menu, because many lore maps point there. -- Sorting in @updateItemSlot@ would not be enough, because, e.g., -- identifying an item should change its slot position. lSlots <- case cCur of MOrgans -> do let newSlots = EM.adjust (sortSlotMap itemToF) SOrgan $ EM.adjust (sortSlotMap itemToF) STrunk $ EM.adjust (sortSlotMap itemToF) SCondition itemSlotsPre modifySession $ \sess -> sess {sslots = ItemSlots newSlots} return $! mergeItemSlots itemToF [ newSlots EM.! SOrgan , newSlots EM.! STrunk , newSlots EM.! SCondition ] MSkills -> return EM.empty MPlaces -> return EM.empty _ -> do let slore = IA.loreFromMode cCur newSlots = EM.adjust (sortSlotMap itemToF) slore itemSlotsPre modifySession $ \sess -> sess {sslots = ItemSlots newSlots} return $! newSlots EM.! slore let getResult :: Either K.KM SlotChar -> [ItemId] -> ( Either Text ([ItemId], ItemBag, SingleItemSlots) , (ItemDialogMode, Either K.KM SlotChar) ) getResult ekm iids = (Right (iids, bagAll, bagItemSlotsAll), (cCur, ekm)) filterP iid = psuitFun (itemToF iid) bagAllSuit = EM.filterWithKey filterP bagAll bagItemSlotsAll = EM.filter (`EM.member` bagAll) lSlots -- Predicate for slot matching the current prefix, unless the prefix -- is 0, in which case we display all slots, even if they require -- the user to start with number keys to get to them. -- Could be generalized to 1 if prefix 1x exists, etc., but too rare. hasPrefixOpen x _ = slotPrefix x == numPrefix || numPrefix == 0 bagItemSlotsOpen = EM.filterWithKey hasPrefixOpen bagItemSlotsAll hasPrefix x _ = slotPrefix x == numPrefix bagItemSlots = EM.filterWithKey hasPrefix bagItemSlotsOpen bag = EM.fromList $ map (\iid -> (iid, bagAll EM.! iid)) (EM.elems bagItemSlotsOpen) suitableItemSlotsAll = EM.filter (`EM.member` bagAllSuit) lSlots suitableItemSlotsOpen = EM.filterWithKey hasPrefixOpen suitableItemSlotsAll bagSuit = EM.fromList $ map (\iid -> (iid, bagAllSuit EM.! iid)) (EM.elems suitableItemSlotsOpen) (bagFiltered, promptChosen) <- getsState $ \s -> case itemDialogState of ISuitable -> (bagSuit, prompt body bodyUI actorMaxSk cCur s <> ":") IAll -> (bag, promptGeneric body bodyUI actorMaxSk cCur s <> ":") let (autoDun, _) = autoDungeonLevel fact multipleSlots = if itemDialogState == IAll then bagItemSlotsAll else suitableItemSlotsAll maySwitchLeader MOwned = False maySwitchLeader MLore{} = False maySwitchLeader MPlaces = False maySwitchLeader _ = True keyDefs :: [(K.KM, DefItemKey m)] keyDefs = filter (defCond . snd) $ [ let km = K.mkChar '/' in (km, changeContainerDef True $ Right km) , (K.mkKP '/', changeContainerDef True $ Left "") , let km = K.mkChar '?' in (km, changeContainerDef False $ Right km) , (K.mkKP '?', changeContainerDef False $ Left "") , let km = K.mkChar '+' in (km, DefItemKey { defLabel = Right km , defCond = bag /= bagSuit , defAction = \_ -> recCall numPrefix cCur cRest $ case itemDialogState of ISuitable -> IAll IAll -> ISuitable }) , let km = K.mkChar '!' in (km, useMultipleDef $ Right km) , (K.mkKP '*', useMultipleDef $ Left "") , let km = revCmd (K.KM K.NoModifier K.Tab) MemberCycle in (km, DefItemKey { defLabel = Right km , defCond = maySwitchLeader cCur && any (\(_, b, _) -> blid b == blid body) hs , defAction = \_ -> do err <- memberCycle False let !_A = assert (isNothing err `blame` err) () (cCurUpd, cRestUpd) <- legalWithUpdatedLeader cCur cRest recCall numPrefix cCurUpd cRestUpd itemDialogState }) , let km = revCmd (K.KM K.NoModifier K.BackTab) MemberBack in (km, DefItemKey { defLabel = Right km , defCond = maySwitchLeader cCur && not (autoDun || null hs) , defAction = \_ -> do err <- memberBack False let !_A = assert (isNothing err `blame` err) () (cCurUpd, cRestUpd) <- legalWithUpdatedLeader cCur cRest recCall numPrefix cCurUpd cRestUpd itemDialogState }) , (K.KM K.NoModifier K.LeftButtonRelease, DefItemKey { defLabel = Left "" , defCond = maySwitchLeader cCur && not (null hs) , defAction = \ekm -> do merror <- pickLeaderWithPointer case merror of Nothing -> do (cCurUpd, cRestUpd) <- legalWithUpdatedLeader cCur cRest recCall numPrefix cCurUpd cRestUpd itemDialogState Just{} -> return (Left "not a teammate", (cCur, ekm)) -- don't inspect the error, it's expected }) , (K.escKM, DefItemKey { defLabel = Right K.escKM , defCond = True , defAction = \ekm -> return (Left "never mind", (cCur, ekm)) }) ] ++ numberPrefixes changeContainerDef forward defLabel = DefItemKey { defLabel , defCond = True -- even if single screen, just reset it , defAction = \_ -> do let calmE = calmEnough body actorMaxSk mcCur = filter (`elem` cLegal) [cCur] (cCurAfterCalm, cRestAfterCalm) = if forward then case cRest ++ mcCur of c1@(MStore CSha) : c2 : rest | not calmE -> (c2, c1 : rest) [MStore CSha] | not calmE -> error $ "" `showFailure` cRest c1 : rest -> (c1, rest) [] -> error $ "" `showFailure` cRest else case reverse $ mcCur ++ cRest of c1@(MStore CSha) : c2 : rest | not calmE -> (c2, reverse $ c1 : rest) [MStore CSha] | not calmE -> error $ "" `showFailure` cRest c1 : rest -> (c1, reverse rest) [] -> error $ "" `showFailure` cRest recCall numPrefix cCurAfterCalm cRestAfterCalm itemDialogState } useMultipleDef defLabel = DefItemKey { defLabel , defCond = permitMulitple && not (EM.null multipleSlots) , defAction = \ekm -> let eslots = EM.elems multipleSlots in return $ getResult ekm eslots } prefixCmdDef d = (K.mkChar $ Char.intToDigit d, DefItemKey { defLabel = Left "" , defCond = True , defAction = \_ -> recCall (10 * numPrefix + d) cCur cRest itemDialogState }) numberPrefixes = map prefixCmdDef [0..9] lettersDef :: DefItemKey m lettersDef = DefItemKey { defLabel = Left "" , defCond = True , defAction = \ekm -> let slot = case ekm of Left K.KM{key=K.Char l} -> SlotChar numPrefix l Left km -> error $ "unexpected key:" `showFailure` K.showKM km Right sl -> sl in case EM.lookup slot bagItemSlotsAll of Nothing -> error $ "unexpected slot" `showFailure` (slot, bagItemSlots) Just iid -> return $! getResult (Right slot) [iid] } case cCur of MSkills -> do io <- skillsOverlay leader let slotLabels = map fst $ snd io slotKeys = mapMaybe (keyOfEKM numPrefix) slotLabels skillsDef :: DefItemKey m skillsDef = DefItemKey { defLabel = Left "" , defCond = True , defAction = \ekm -> let slot = case ekm of Left K.KM{key} -> case key of K.Char l -> SlotChar numPrefix l _ -> error $ "unexpected key:" `showFailure` K.showKey key Right sl -> sl in return (Left "skills", (MSkills, Right slot)) } runDefItemKey keyDefs skillsDef io slotKeys promptChosen cCur MPlaces -> do io <- placesOverlay let slotLabels = map fst $ snd io slotKeys = mapMaybe (keyOfEKM numPrefix) slotLabels placesDef :: DefItemKey m placesDef = DefItemKey { defLabel = Left "" , defCond = True , defAction = \ekm -> let slot = case ekm of Left K.KM{key} -> case key of K.Char l -> SlotChar numPrefix l _ -> error $ "unexpected key:" `showFailure` K.showKey key Right sl -> sl in return (Left "places", (MPlaces, Right slot)) } runDefItemKey keyDefs placesDef io slotKeys promptChosen cCur _ -> do io <- itemOverlay lSlots (blid body) bagFiltered let slotKeys = mapMaybe (keyOfEKM numPrefix . Right) $ EM.keys bagItemSlots runDefItemKey keyDefs lettersDef io slotKeys promptChosen cCur keyOfEKM :: Int -> Either [K.KM] SlotChar -> Maybe K.KM keyOfEKM _ (Left kms) = error $ "" `showFailure` kms keyOfEKM numPrefix (Right SlotChar{..}) | slotPrefix == numPrefix = Just $ K.mkChar slotChar keyOfEKM _ _ = Nothing legalWithUpdatedLeader :: MonadClientUI m => ItemDialogMode -> [ItemDialogMode] -> m (ItemDialogMode, [ItemDialogMode]) legalWithUpdatedLeader cCur cRest = do leader <- getLeaderUI let newLegal = cCur : cRest -- not updated in any way yet b <- getsState $ getActorBody leader actorMaxSk <- getsState $ getActorMaxSkills leader let calmE = calmEnough b actorMaxSk legalAfterCalm = case newLegal of c1@(MStore CSha) : c2 : rest | not calmE -> (c2, c1 : rest) [MStore CSha] | not calmE -> (MStore CGround, newLegal) c1 : rest -> (c1, rest) [] -> error $ "" `showFailure` (cCur, cRest) return legalAfterCalm -- We don't create keys from slots in @okx@, so they have to be -- exolicitly given in @slotKeys@. runDefItemKey :: MonadClientUI m => [(K.KM, DefItemKey m)] -> DefItemKey m -> OKX -> [K.KM] -> Text -> ItemDialogMode -> m ( Either Text ([ItemId], ItemBag, SingleItemSlots) , (ItemDialogMode, Either K.KM SlotChar) ) runDefItemKey keyDefs lettersDef okx slotKeys prompt cCur = do let itemKeys = slotKeys ++ map fst keyDefs wrapB s = "[" <> s <> "]" (keyLabelsRaw, keys) = partitionEithers $ map (defLabel . snd) keyDefs keyLabels = filter (not . T.null) keyLabelsRaw choice = T.intercalate " " $ map wrapB $ nub keyLabels -- switch to Data.Containers.ListUtils.nubOrd when we drop GHC 8.4.4 promptAdd0 $ prompt <+> choice CCUI{coscreen=ScreenContent{rheight}} <- getsSession sccui ekm <- do okxs <- overlayToSlideshow (rheight - 2) keys okx displayChoiceScreen (show cCur) ColorFull False okxs itemKeys case ekm of Left km -> case km `lookup` keyDefs of Just keyDef -> defAction keyDef ekm Nothing -> defAction lettersDef ekm -- pressed; with current prefix Right _slot -> defAction lettersDef ekm -- selected; with the given prefix LambdaHack-0.9.5.0/engine-src/Game/LambdaHack/Client/UI/ItemDescription.hs0000644000000000000000000004404507346545000024075 0ustar0000000000000000-- | Descriptions of items. module Game.LambdaHack.Client.UI.ItemDescription ( partItem, partItemShort, partItemShortest, partItemHigh, partItemWs , partItemWsRanged, partItemShortAW, partItemMediumAW, partItemShortWownW , viewItem, itemDesc #ifdef EXPOSE_INTERNAL -- * Internal operations , partItemN, textAllPowers, partItemWsR #endif ) where import Prelude () import Game.LambdaHack.Core.Prelude import qualified Data.EnumMap.Strict as EM import qualified Data.Text as T import qualified NLP.Miniutter.English as MU import Game.LambdaHack.Client.UI.EffectDescription import Game.LambdaHack.Client.UI.Overlay import Game.LambdaHack.Common.Faction import Game.LambdaHack.Common.Item import qualified Game.LambdaHack.Common.ItemAspect as IA import Game.LambdaHack.Common.Misc import Game.LambdaHack.Common.Time import Game.LambdaHack.Common.Types import qualified Game.LambdaHack.Content.ItemKind as IK import qualified Game.LambdaHack.Core.Dice as Dice import qualified Game.LambdaHack.Definition.Ability as Ability import qualified Game.LambdaHack.Definition.Color as Color import Game.LambdaHack.Definition.Defs import Game.LambdaHack.Definition.Flavour -- | The part of speech describing the item parameterized by the number -- of effects/aspects to show. partItemN :: FactionId -> FactionDict -> Bool -> DetailLevel -> Int -> Time -> ItemFull -> ItemQuant -> (MU.Part, MU.Part) partItemN side factionD ranged detailLevel maxWordsToShow localTime itemFull@ItemFull{itemBase, itemKind, itemSuspect} (itemK, itemTimer) = let flav = flavourToName $ jflavour itemBase arItem = aspectRecordFull itemFull timeout = IA.aTimeout arItem temporary = IA.checkFlag Ability.Fragile arItem && IA.checkFlag Ability.Periodic arItem lenCh = itemK - ncharges localTime itemFull (itemK, itemTimer) charges | lenCh == 0 || temporary = "" | itemK == 1 && lenCh == 1 = "(charging)" | itemK == lenCh = "(all charging)" | otherwise = "(" <> tshow lenCh <+> "charging)" skipRecharging = detailLevel <= DetailLow && lenCh >= itemK (powerTsRaw, rangedDamage) = textAllPowers detailLevel skipRecharging itemFull powerTs = powerTsRaw ++ if ranged then rangedDamage else [] lsource = case jfid itemBase of Just fid | IK.iname itemKind `elem` ["impressed"] -> ["by" <+> if fid == side then "us" else gname (factionD EM.! fid)] _ -> [] ts = lsource ++ take maxWordsToShow powerTs ++ ["(...)" | length powerTs > maxWordsToShow && maxWordsToShow > 0] ++ [charges | maxWordsToShow > 1] name | temporary = let adj = if timeout == 0 then "temporarily" else "impermanent" in adj <+> IK.iname itemKind | itemSuspect = flav <+> IK.iname itemKind | otherwise = IK.iname itemKind capName = if IA.checkFlag Ability.Unique arItem then MU.Capitalize $ MU.Text name else MU.Text name in (capName, MU.Phrase $ map MU.Text ts) -- TODO: simplify the code a lot textAllPowers :: DetailLevel -> Bool -> ItemFull -> ([Text], [Text]) textAllPowers detailLevel skipRecharging itemFull@ItemFull{itemKind, itemDisco} = let arItem = aspectRecordFull itemFull -- To handle both the cases of item identified and not, we represent -- aspects as a list with dice, not a record of integers as in @arItem@. -- If item fully known, the dice will be trivial and will display -- the same as integers would, so nothing is lost. -- If item not known fully and timeouts or any crucial flags -- are under @Odds@, they are ignored, so they should be avoided -- under @Odds@ in not fully-identified items. aspectsFull = case itemDisco of ItemDiscoMean IA.KindMean{..} | kmConst -> IA.aspectRecordToList kmMean -- exact and collated ItemDiscoMean{} -> IK.iaspects itemKind -- doesn't completely lose the @Odds@ case, so better than -- the above, even if does not collate multiple skill bonuses ItemDiscoFull iAspect -> IA.aspectRecordToList iAspect mtimeout = find IK.timeoutAspect aspectsFull elab = IA.aELabel arItem periodic = IA.checkFlag Ability.Periodic arItem hurtMeleeAspect :: IK.Aspect -> Bool hurtMeleeAspect (IK.AddSkill Ability.SkHurtMelee _) = True hurtMeleeAspect _ = False active = IA.goesIntoEqp arItem splitA :: DetailLevel -> [IK.Aspect] -> [Text] splitA detLev aspects = let ppA = kindAspectToSuffix ppE = effectToSuffix detLev reduce_a = maybe "?" tshow . Dice.reduceDice restEs | detLev >= DetailHigh || not (IA.checkFlag Ability.MinorEffects arItem) = IK.ieffects itemKind | otherwise = [] (smashEffs, noSmashEffs) = partition IK.onSmashEffect restEs unSmash (IK.OnSmash eff) = eff unSmash eff = eff onSmashTs = T.intercalate " " $ filter (not . T.null) $ map (ppE . unSmash) smashEffs rechargingTs = T.intercalate " " $ [damageText | IK.idamage itemKind /= 0] ++ filter (not . T.null) (map ppE noSmashEffs) fragile = IA.checkFlag Ability.Fragile arItem periodicText = if periodic && not skipRecharging && not (T.null rechargingTs) then case (mtimeout, fragile) of (Nothing, True) -> "(each turn until gone:" <+> rechargingTs <> ")" (Nothing, False) -> "(each turn:" <+> rechargingTs <> ")" -- timeout 0, so it just fires each turn and it's not -- fragile, so a copy is not destroyed each turn (Just (IK.Timeout t), True) -> "(every" <+> reduce_a t <+> "until gone:" <+> rechargingTs <> ")" (Just (IK.Timeout t), False) -> "(every" <+> reduce_a t <> ":" <+> rechargingTs <> ")" _ -> error $ "" `showFailure` mtimeout else "" ppERestEs = if periodic then [periodicText] else map ppE noSmashEffs aes = if active then map ppA aspects ++ ppERestEs else ppERestEs ++ map ppA aspects onSmash = if T.null onSmashTs then "" else "(on smash:" <+> onSmashTs <> ")" -- Either exact value or dice of @SkHurtMelee@ needed, -- never the average, so @arItem@ not consulted directly. -- If item not known fully and @SkHurtMelee@ under @Odds@, -- it's ignored. damageText = case find hurtMeleeAspect aspects of Just (IK.AddSkill Ability.SkHurtMelee hurtMelee) -> (if IK.idamage itemKind == 0 then "0d0" else tshow (IK.idamage itemKind)) <> affixDice hurtMelee <> "%" _ -> if IK.idamage itemKind == 0 then "" else tshow (IK.idamage itemKind) timeoutText = case mtimeout of Nothing -> "" Just (IK.Timeout t) -> "(cooldown" <+> reduce_a t <> ")" -- timeout is called "cooldown" in UI _ -> error $ "" `showFailure` mtimeout in [ damageText | detLev > DetailNone && (not periodic || IK.idamage itemKind == 0) ] ++ [timeoutText | detLev > DetailNone && not periodic] ++ if detLev >= DetailMedium then aes ++ [onSmash | detLev >= DetailAll] else [] hurtMult = armorHurtCalculation True (IA.aSkills arItem) Ability.zeroSkills dmg = Dice.meanDice $ IK.idamage itemKind rawDeltaHP = ceiling $ fromIntegral hurtMult * xD dmg / 100 IK.ThrowMod{IK.throwVelocity} = IA.aToThrow arItem speed = speedFromWeight (IK.iweight itemKind) throwVelocity pdeltaHP = modifyDamageBySpeed rawDeltaHP speed rangedDamageDesc = if pdeltaHP == 0 then [] else ["{avg" <+> show64With2 pdeltaHP <+> "ranged}"] -- Note that avg melee damage would be too complex to display here, -- because in case of @MOwned@ the owner is different than leader, -- so the value would be different than when viewing the item. splitTry ass = let splits = map (`splitA` ass) [minBound..maxBound] splitsToTry = drop (fromEnum detailLevel) splits splitsValid | T.null elab = filter (/= []) splitsToTry | otherwise = splitsToTry in concat $ take 1 splitsValid aspectDescs = let aMain IK.AddSkill{} = True aMain _ = False (aspectsMain, aspectsAux) = partition aMain aspectsFull in filter (/= "") $ elab : splitTry aspectsMain ++ if detailLevel >= DetailAll then map kindAspectToSuffix aspectsAux else [] in (aspectDescs, rangedDamageDesc) -- | The part of speech describing the item. partItem :: FactionId -> FactionDict -> Time -> ItemFull -> ItemQuant -> (MU.Part, MU.Part) partItem side factionD = partItemN side factionD False DetailMedium 4 partItemShort :: FactionId -> FactionDict -> Time -> ItemFull -> ItemQuant -> (MU.Part, MU.Part) partItemShort side factionD = partItemN side factionD False DetailLow 4 partItemShortest :: FactionId -> FactionDict -> Time -> ItemFull -> ItemQuant -> (MU.Part, MU.Part) partItemShortest side factionD = partItemN side factionD False DetailNone 1 partItemHigh :: FactionId -> FactionDict -> Time -> ItemFull -> ItemQuant -> (MU.Part, MU.Part) partItemHigh side factionD = partItemN side factionD False DetailAll 100 -- The @count@ can be different than @itemK@ in @ItemFull@, e.g., when picking -- a subset of items to drop. partItemWsR :: FactionId -> FactionDict -> Bool -> Int -> Time -> ItemFull -> ItemQuant -> MU.Part partItemWsR side factionD ranged count localTime itemFull kit = let (name, powers) = partItemN side factionD ranged DetailMedium 4 localTime itemFull kit arItem = aspectRecordFull itemFull periodic = IA.checkFlag Ability.Periodic arItem condition = IA.checkFlag Ability.Condition arItem maxCount = Dice.supDice $ IK.icount $ itemKind itemFull in if | condition && count == 1 -> MU.Phrase [name, powers] | condition && not periodic && maxCount > 1 -> let percent = 100 * count `divUp` maxCount amount = tshow count <> "-strong" <+> "(" <> tshow percent <> "%)" in MU.Phrase [MU.Text amount, name, powers] | condition -> MU.Phrase [MU.Text $ tshow count <> "-fold", name, powers] | IA.checkFlag Ability.Unique arItem && count == 1 -> MU.Phrase ["the", name, powers] | otherwise -> MU.Phrase [MU.CarAWs count name, powers] partItemWs :: FactionId -> FactionDict -> Int -> Time -> ItemFull -> ItemQuant -> MU.Part partItemWs side factionD = partItemWsR side factionD False partItemWsRanged :: FactionId -> FactionDict -> Int -> Time -> ItemFull -> ItemQuant -> MU.Part partItemWsRanged side factionD = partItemWsR side factionD True partItemShortAW :: FactionId -> FactionDict -> Time -> ItemFull -> ItemQuant -> MU.Part partItemShortAW side factionD localTime itemFull kit = let (name, _) = partItemShort side factionD localTime itemFull kit arItem = aspectRecordFull itemFull in if IA.checkFlag Ability.Unique arItem then MU.Phrase ["the", name] else MU.AW name partItemMediumAW :: FactionId -> FactionDict -> Time -> ItemFull -> ItemQuant -> MU.Part partItemMediumAW side factionD localTime itemFull kit = let (name, powers) = partItemN side factionD False DetailMedium 100 localTime itemFull kit arItem = aspectRecordFull itemFull in if IA.checkFlag Ability.Unique arItem then MU.Phrase ["the", name, powers] else MU.AW $ MU.Phrase [name, powers] partItemShortWownW :: FactionId -> FactionDict -> MU.Part -> Time -> ItemFull -> ItemQuant -> MU.Part partItemShortWownW side factionD partA localTime itemFull kit = let (name, _) = partItemShort side factionD localTime itemFull kit in MU.WownW partA name viewItem :: ItemFull -> Color.AttrCharW32 {-# INLINE viewItem #-} viewItem itemFull = Color.attrChar2ToW32 (flavourToColor $ jflavour $ itemBase itemFull) (IK.isymbol $ itemKind itemFull) itemDesc :: Bool -> FactionId -> FactionDict -> Int -> CStore -> Time -> LevelId -> ItemFull -> ItemQuant -> AttrLine itemDesc markParagraphs side factionD aHurtMeleeOfOwner store localTime jlid itemFull@ItemFull{itemBase, itemKind, itemDisco, itemSuspect} kit = let (name, powers) = partItemHigh side factionD localTime itemFull kit arItem = aspectRecordFull itemFull npowers = makePhrase [name, powers] IK.ThrowMod{IK.throwVelocity, IK.throwLinger} = IA.aToThrow arItem speed = speedFromWeight (IK.iweight itemKind) throwVelocity range = rangeFromSpeedAndLinger speed throwLinger tspeed | IA.checkFlag Ability.Condition arItem || IK.iweight itemKind == 0 = "" | speed < speedLimp = "When thrown, it drops at once." | speed < speedWalk = "When thrown, it drops after one meter." | otherwise = "Can be thrown at" <+> T.pack (displaySpeed $ fromSpeed speed) <> if throwLinger /= 100 then " dropping after" <+> tshow range <> "m." else "." tsuspect = ["You are unsure what it does." | itemSuspect] (desc, aspectSentences, damageAnalysis) = let aspects = case itemDisco of ItemDiscoMean IA.KindMean{..} | kmConst -> IA.aspectRecordToList kmMean -- exact and collated ItemDiscoMean{} -> IK.iaspects itemKind -- doesn't completely lose the @Odds@ case, so better than -- the above, even if does not collate multiple skill bonuses ItemDiscoFull iAspect -> IA.aspectRecordToList iAspect sentences = tsuspect ++ mapMaybe aspectToSentence aspects aHurtMeleeOfItem = IA.getSkill Ability.SkHurtMelee arItem meanDmg = ceiling $ Dice.meanDice (IK.idamage itemKind) dmgAn = if meanDmg <= 0 then "" else let multRaw = aHurtMeleeOfOwner + if store `elem` [CEqp, COrgan] then 0 else aHurtMeleeOfItem mult = 100 + min 99 (max (-99) multRaw) minDeltaHP = xM meanDmg `divUp` 100 rawDeltaHP = fromIntegral mult * minDeltaHP pmult = 100 + min 99 (max (-99) aHurtMeleeOfItem) prawDeltaHP = fromIntegral pmult * minDeltaHP pdeltaHP = modifyDamageBySpeed prawDeltaHP speed mDeltaHP = modifyDamageBySpeed minDeltaHP speed in "Against defenceless foes you'd inflict around" -- rounding and non-id items <+> tshow meanDmg <> "*" <> tshow mult <> "%" <> "=" <> show64With2 rawDeltaHP <+> "melee damage (min" <+> show64With2 minDeltaHP <> ") and" <+> tshow meanDmg <> "*" <> tshow pmult <> "%" <> "*" <> "speed^2" <> "/" <> tshow (fromSpeed speedThrust `divUp` 10) <> "^2" <> "=" <> show64With2 pdeltaHP <+> "ranged damage (min" <+> show64With2 mDeltaHP <> ") with it" <> if Dice.infDice (IK.idamage itemKind) == Dice.supDice (IK.idamage itemKind) then "." else "on average." in (IK.idesc itemKind, T.intercalate " " sentences, tspeed <+> dmgAn) weight = IK.iweight itemKind (scaledWeight, unitWeight) | weight > 1000 = (tshow $ fromIntegral weight / (1000 :: Double), "kg") | otherwise = (tshow weight, "g") onLevel = "on level" <+> tshow (abs $ fromEnum jlid) <> "." discoFirst = (if IA.checkFlag Ability.Unique arItem then "Discovered" else "First seen") <+> onLevel whose fid = gname (factionD EM.! fid) sourceDesc = case jfid itemBase of Just fid | IA.checkFlag Ability.Condition arItem -> "Caused by" <+> (if fid == side then "us" else whose fid) <> ". First observed" <+> onLevel Just fid -> "Coming from" <+> whose fid <> "." <+> discoFirst _ -> discoFirst ikitNames = map (fromGroupName . fst) $ filter ((== COrgan) . snd) $ IK.ikit itemKind ikitDesc | null ikitNames = "" | otherwise = makeSentence [ "the actor also has organs of this kind:" , MU.Text $ T.intercalate ", " ikitNames ] colorSymbol = viewItem itemFull blurb = ((" " <> npowers <> (if markParagraphs then ":\n\n" else ": ") <> desc <> (if markParagraphs && not (T.null desc) then "\n\n" else "")) <+> (if weight > 0 then makeSentence ["Weighs around", MU.Text scaledWeight <> unitWeight] else "")) <+> aspectSentences <+> sourceDesc <+> damageAnalysis <> (if markParagraphs && not (T.null ikitDesc) then "\n\n" else "\n") <> ikitDesc in colorSymbol : textToAL blurb LambdaHack-0.9.5.0/engine-src/Game/LambdaHack/Client/UI/ItemSlot.hs0000644000000000000000000001013207346545000022521 0ustar0000000000000000{-# LANGUAGE GeneralizedNewtypeDeriving #-} -- | Item slots for UI and AI item collections. module Game.LambdaHack.Client.UI.ItemSlot ( SlotChar(..), ItemSlots(..), SingleItemSlots , allSlots, intSlots, slotLabel , assignSlot, partyItemSet, sortSlotMap, mergeItemSlots ) where import Prelude () import Game.LambdaHack.Core.Prelude import Data.Binary import Data.Bits (unsafeShiftL, unsafeShiftR) import Data.Char import qualified Data.EnumMap.Strict as EM import qualified Data.EnumSet as ES import Data.Function import Data.Ord (comparing) import qualified Data.Text as T import Game.LambdaHack.Common.Actor import Game.LambdaHack.Common.ActorState import Game.LambdaHack.Common.Item import Game.LambdaHack.Common.State import Game.LambdaHack.Common.Types import qualified Game.LambdaHack.Content.ItemKind as IK import Game.LambdaHack.Definition.Defs -- | Slot label. Usually just a character. Sometimes with a numerical prefix. data SlotChar = SlotChar {slotPrefix :: Int, slotChar :: Char} deriving (Show, Eq) instance Ord SlotChar where compare = comparing fromEnum instance Binary SlotChar where put = put . fromEnum get = fmap toEnum get instance Enum SlotChar where fromEnum (SlotChar n c) = unsafeShiftL n 8 + ord c + (if isUpper c then 100 else 0) toEnum e = let n = unsafeShiftR e 8 c0 = e - unsafeShiftL n 8 c100 = c0 - if c0 > 150 then 100 else 0 in SlotChar n (chr c100) type SingleItemSlots = EM.EnumMap SlotChar ItemId -- | A collection of mappings from slot labels to item identifiers. newtype ItemSlots = ItemSlots (EM.EnumMap SLore SingleItemSlots) deriving (Show, Binary) allChars :: [Char] allChars = ['a'..'z'] ++ ['A'..'Z'] allSlots :: [SlotChar] allSlots = concatMap (\n -> map (SlotChar n) allChars) [0..] intSlots :: [SlotChar] intSlots = map (flip SlotChar 'a') [0..] slotLabel :: SlotChar -> Text slotLabel x = T.snoc (if slotPrefix x == 0 then T.empty else tshow $ slotPrefix x) (slotChar x) <> ")" -- | Assigns a slot to an item, e.g., for inclusion in the inventory of a hero. -- At first, e.g., when item is spotted on the floor, the slot is -- not user-friendly. After any player's item manipulation action, -- slots are sorted and a fully human-readable slot is then assigned. -- Only then the slot can be viewed by the player. assignSlot :: SingleItemSlots -> SlotChar assignSlot lSlots = let maxPrefix = case EM.maxViewWithKey lSlots of Just ((lm, _), _) -> slotPrefix lm Nothing -> 0 in SlotChar (maxPrefix + 1) 'x' partyItemSet :: SLore -> FactionId -> Maybe Actor -> State -> ES.EnumSet ItemId partyItemSet slore fid mbody s = let onPersons = combinedFromLore slore fid s onGround = maybe EM.empty -- consider floor only under the acting actor (\b -> getFloorBag (blid b) (bpos b) s) mbody in ES.unions $ map EM.keysSet $ onPersons : [onGround | slore == SItem] -- If appearance and aspects the same, keep the order from before sort. compareItemFull :: ItemFull -> ItemFull -> Ordering compareItemFull itemFull1 itemFull2 = let kindAndAppearance ItemFull{itemBase=Item{..}, ..} = ( not itemSuspect, itemKindId, itemDisco , IK.isymbol itemKind, IK.iname itemKind , jflavour, jfid ) in comparing kindAndAppearance itemFull1 itemFull2 sortSlotMap :: (ItemId -> ItemFull) -> SingleItemSlots -> SingleItemSlots sortSlotMap itemToF em = let f iid = (iid, itemToF iid) sortItemIds l = map fst $ sortBy (compareItemFull `on` snd) $ map f l in EM.fromDistinctAscList $ zip allSlots $ sortItemIds $ EM.elems em mergeItemSlots :: (ItemId -> ItemFull) -> [SingleItemSlots] -> SingleItemSlots mergeItemSlots itemToF ems = let renumberSlot n SlotChar{slotPrefix, slotChar} = SlotChar{slotPrefix = slotPrefix + n * 1000000, slotChar} renumberMap n = EM.mapKeys (renumberSlot n) rms = zipWith renumberMap [0..] ems em = EM.unionsWith (\_ _ -> error "mergeItemSlots: duplicate keys") rms in sortSlotMap itemToF em LambdaHack-0.9.5.0/engine-src/Game/LambdaHack/Client/UI/Key.hs0000644000000000000000000004350507346545000021523 0ustar0000000000000000{-# LANGUAGE DeriveGeneric #-} -- | Frontend-independent keyboard input operations. module Game.LambdaHack.Client.UI.Key ( Key(..), Modifier(..), KM(..), KMP(..) , showKey, showKM , escKM, controlEscKM, spaceKM, safeSpaceKM, undefinedKM, returnKM , pgupKM, pgdnKM, wheelNorthKM, wheelSouthKM , upKM, downKM, leftKM, rightKM , homeKM, endKM, backspaceKM, controlP , leftButtonReleaseKM, middleButtonReleaseKM, rightButtonReleaseKM , dirAllKey, handleDir, moveBinding, mkKM, mkChar, mkKP , keyTranslate, keyTranslateWeb #ifdef EXPOSE_INTERNAL -- * Internal operations , dirKeypadKey, dirKeypadShiftChar, dirKeypadShiftKey , dirLaptopKey, dirLaptopShiftKey , dirViChar, dirViKey, dirViShiftKey , dirMoveNoModifier, dirRunNoModifier, dirRunControl, dirRunShift #endif ) where import Prelude () import Game.LambdaHack.Core.Prelude hiding (Left, Right) import Control.DeepSeq import Data.Binary import qualified Data.Char as Char import GHC.Generics (Generic) import Game.LambdaHack.Common.Point import Game.LambdaHack.Common.Vector -- | Frontend-independent datatype to represent keys. data Key = Esc | Return | Space | Tab | BackTab | BackSpace | PgUp | PgDn | Left | Right | Up | Down | End | Begin | Insert | Delete | PrintScreen | Home | KP Char -- ^ a keypad key for a character (digits and operators) | Char Char -- ^ a single printable character | Fun Int -- ^ function key | LeftButtonPress -- ^ left mouse button pressed | MiddleButtonPress -- ^ middle mouse button pressed | RightButtonPress -- ^ right mouse button pressed | LeftButtonRelease -- ^ left mouse button released | MiddleButtonRelease -- ^ middle mouse button released | RightButtonRelease -- ^ right mouse button released | WheelNorth -- ^ mouse wheel rotated north | WheelSouth -- ^ mouse wheel rotated south | Unknown String -- ^ an unknown key, registered to warn the user | DeadKey deriving (Ord, Eq, Generic) instance Binary Key instance NFData Key -- | Our own encoding of modifiers. data Modifier = NoModifier | ControlShift | Shift | Control | Alt deriving (Show, Ord, Eq, Generic) instance Binary Modifier instance NFData Modifier -- | Key and modifier. data KM = KM { modifier :: Modifier , key :: Key } deriving (Ord, Eq, Generic) instance Binary KM instance NFData KM instance Show KM where show = showKM -- | Key, modifier and position of mouse pointer. data KMP = KMP { kmpKeyMod :: KM , kmpPointer :: Point } -- | Common and terse names for keys. showKey :: Key -> String showKey Esc = "ESC" showKey Return = "RET" showKey Space = "SPACE" showKey Tab = "TAB" showKey BackTab = "S-TAB" showKey BackSpace = "BACKSPACE" showKey Up = "UP" showKey Down = "DOWN" showKey Left = "LEFT" showKey Right = "RIGHT" showKey Home = "HOME" showKey End = "END" showKey PgUp = "PGUP" showKey PgDn = "PGDN" showKey Begin = "BEGIN" showKey Insert = "INS" showKey Delete = "DEL" showKey PrintScreen = "PRTSCR" showKey (KP c) = "KP_" ++ [c] showKey (Char c) = [c] showKey (Fun n) = "F" ++ show n showKey LeftButtonPress = "LMB-PRESS" showKey MiddleButtonPress = "MMB-PRESS" showKey RightButtonPress = "RMB-PRESS" showKey LeftButtonRelease = "LMB" showKey MiddleButtonRelease = "MMB" showKey RightButtonRelease = "RMB" showKey WheelNorth = "WHEEL-UP" showKey WheelSouth = "WHEEL-DN" showKey (Unknown s) = "'" ++ s ++ "'" showKey DeadKey = "DEADKEY" -- | Show a key with a modifier, if any. showKM :: KM -> String showKM KM{modifier=NoModifier, key} = showKey key showKM KM{modifier=ControlShift, key} = "C-S-" ++ showKey key showKM KM{modifier=Shift, key} = "S-" ++ showKey key showKM KM{modifier=Control, key} = "C-" ++ showKey key showKM KM{modifier=Alt, key} = "A-" ++ showKey key escKM :: KM escKM = KM NoModifier Esc controlEscKM :: KM controlEscKM = KM Control Esc spaceKM :: KM spaceKM = KM NoModifier Space safeSpaceKM :: KM safeSpaceKM = KM NoModifier $ Unknown "SAFE_SPACE" undefinedKM :: KM undefinedKM = KM NoModifier $ Unknown "UNDEFINED KEY" returnKM :: KM returnKM = KM NoModifier Return pgupKM :: KM pgupKM = KM NoModifier PgUp pgdnKM :: KM pgdnKM = KM NoModifier PgDn wheelNorthKM :: KM wheelNorthKM = KM NoModifier WheelNorth wheelSouthKM :: KM wheelSouthKM = KM NoModifier WheelSouth upKM :: KM upKM = KM NoModifier Up downKM :: KM downKM = KM NoModifier Down leftKM :: KM leftKM = KM NoModifier Left rightKM :: KM rightKM = KM NoModifier Right homeKM :: KM homeKM = KM NoModifier Home endKM :: KM endKM = KM NoModifier End backspaceKM :: KM backspaceKM = KM NoModifier BackSpace controlP :: KM controlP = KM Control (Char 'P') leftButtonReleaseKM :: KM leftButtonReleaseKM = KM NoModifier LeftButtonRelease middleButtonReleaseKM :: KM middleButtonReleaseKM = KM NoModifier MiddleButtonRelease rightButtonReleaseKM :: KM rightButtonReleaseKM = KM NoModifier RightButtonRelease dirKeypadKey :: [Key] dirKeypadKey = [Home, Up, PgUp, Right, PgDn, Down, End, Left] dirKeypadShiftChar :: [Char] dirKeypadShiftChar = ['7', '8', '9', '6', '3', '2', '1', '4'] dirKeypadShiftKey :: [Key] dirKeypadShiftKey = map KP dirKeypadShiftChar dirLaptopKey :: [Key] dirLaptopKey = map Char ['7', '8', '9', 'o', 'l', 'k', 'j', 'u'] dirLaptopShiftKey :: [Key] dirLaptopShiftKey = map Char ['&', '*', '(', 'O', 'L', 'K', 'J', 'U'] dirViChar :: [Char] dirViChar = ['y', 'k', 'u', 'l', 'n', 'j', 'b', 'h'] dirViKey :: [Key] dirViKey = map Char dirViChar dirViShiftKey :: [Key] dirViShiftKey = map (Char . Char.toUpper) dirViChar dirMoveNoModifier :: Bool -> Bool -> [Key] dirMoveNoModifier uVi uLaptop = dirKeypadKey ++ if | uVi -> dirViKey | uLaptop -> dirLaptopKey | otherwise -> [] dirRunNoModifier :: Bool -> Bool -> [Key] dirRunNoModifier uVi uLaptop = dirKeypadShiftKey ++ if | uVi -> dirViShiftKey | uLaptop -> dirLaptopShiftKey | otherwise -> [] dirRunControl :: [Key] dirRunControl = dirKeypadKey ++ dirKeypadShiftKey ++ map Char dirKeypadShiftChar dirRunShift :: [Key] dirRunShift = dirRunControl dirAllKey :: Bool -> Bool -> [Key] dirAllKey uVi uLaptop = dirMoveNoModifier uVi uLaptop ++ dirRunNoModifier uVi uLaptop ++ dirRunControl -- | Configurable event handler for the direction keys. -- Used for directed commands such as close door. handleDir :: Bool -> Bool -> KM -> Maybe Vector handleDir uVi uLaptop KM{modifier=NoModifier, key} = let assocs = zip (dirAllKey uVi uLaptop) $ cycle moves in lookup key assocs handleDir _ _ _ = Nothing -- | Binding of both sets of movement keys, vi and laptop. moveBinding :: Bool -> Bool -> (Vector -> a) -> (Vector -> a) -> [(KM, a)] moveBinding uVi uLaptop move run = let assign f (km, dir) = (km, f dir) mapMove modifier keys = map (assign move) (zip (map (KM modifier) keys) $ cycle moves) mapRun modifier keys = map (assign run) (zip (map (KM modifier) keys) $ cycle moves) in mapMove NoModifier (dirMoveNoModifier uVi uLaptop) ++ mapRun NoModifier (dirRunNoModifier uVi uLaptop) ++ mapRun Control dirRunControl ++ mapRun Shift dirRunShift mkKM :: String -> KM mkKM s = let mkKey sk = case keyTranslate sk of Unknown _ -> error $ "unknown key" `showFailure` s key -> key in case s of 'C':'-':'S':'-':rest -> KM ControlShift (mkKey rest) 'S':'-':'C':'-':rest -> KM ControlShift (mkKey rest) 'S':'-':rest -> KM Shift (mkKey rest) 'C':'-':rest -> KM Control (mkKey rest) 'A':'-':rest -> KM Alt (mkKey rest) _ -> KM NoModifier (mkKey s) mkChar :: Char -> KM mkChar c = KM NoModifier $ Char c mkKP :: Char -> KM mkKP c = KM NoModifier $ KP c -- | Translate key from a GTK string description to our internal key type. -- To be used, in particular, for the command bindings and macros -- in the config file. -- -- See keyTranslate :: String -> Key keyTranslate "less" = Char '<' keyTranslate "greater" = Char '>' keyTranslate "period" = Char '.' keyTranslate "colon" = Char ':' keyTranslate "semicolon" = Char ';' keyTranslate "comma" = Char ',' keyTranslate "question" = Char '?' keyTranslate "numbersign" = Char '#' keyTranslate "dollar" = Char '$' keyTranslate "parenleft" = Char '(' keyTranslate "parenright" = Char ')' keyTranslate "asterisk" = Char '*' -- for latop movement keys keyTranslate "KP_Multiply" = KP '*' -- for keypad aiming keyTranslate "slash" = Char '/' keyTranslate "KP_Divide" = KP '/' keyTranslate "bar" = Char '|' keyTranslate "backslash" = Char '\\' keyTranslate "asciicircum" = Char '^' keyTranslate "underscore" = Char '_' keyTranslate "minus" = Char '-' keyTranslate "KP_Subtract" = Char '-' -- KP and normal are merged here keyTranslate "plus" = Char '+' keyTranslate "KP_Add" = Char '+' -- KP and normal are merged here keyTranslate "equal" = Char '=' keyTranslate "bracketleft" = Char '[' keyTranslate "bracketright" = Char ']' keyTranslate "braceleft" = Char '{' keyTranslate "braceright" = Char '}' keyTranslate "caret" = Char '^' keyTranslate "ampersand" = Char '&' keyTranslate "at" = Char '@' keyTranslate "asciitilde" = Char '~' keyTranslate "grave" = Char '`' keyTranslate "exclam" = Char '!' keyTranslate "apostrophe" = Char '\'' keyTranslate "quotedbl" = Char '"' keyTranslate "Escape" = Esc keyTranslate "ESC" = Esc keyTranslate "Return" = Return keyTranslate "RET" = Return keyTranslate "space" = Space keyTranslate "SPACE" = Space keyTranslate "Tab" = Tab keyTranslate "TAB" = Tab keyTranslate "BackTab" = BackTab keyTranslate "ISO_Left_Tab" = BackTab keyTranslate "BackSpace" = BackSpace keyTranslate "BACKSPACE" = BackSpace keyTranslate "Up" = Up keyTranslate "UP" = Up keyTranslate "KP_Up" = Up keyTranslate "Down" = Down keyTranslate "DOWN" = Down keyTranslate "KP_Down" = Down keyTranslate "Left" = Left keyTranslate "LEFT" = Left keyTranslate "KP_Left" = Left keyTranslate "Right" = Right keyTranslate "RIGHT" = Right keyTranslate "KP_Right" = Right keyTranslate "Home" = Home keyTranslate "HOME" = Home keyTranslate "KP_Home" = Home keyTranslate "End" = End keyTranslate "END" = End keyTranslate "KP_End" = End keyTranslate "Page_Up" = PgUp keyTranslate "PGUP" = PgUp keyTranslate "KP_Page_Up" = PgUp keyTranslate "Prior" = PgUp keyTranslate "KP_Prior" = PgUp keyTranslate "Page_Down" = PgDn keyTranslate "PGDN" = PgDn keyTranslate "KP_Page_Down" = PgDn keyTranslate "Next" = PgDn keyTranslate "KP_Next" = PgDn keyTranslate "Begin" = Begin keyTranslate "BEGIN" = Begin keyTranslate "KP_Begin" = Begin keyTranslate "Clear" = Begin keyTranslate "KP_Clear" = Begin keyTranslate "Center" = Begin keyTranslate "KP_Center" = Begin keyTranslate "Insert" = Insert keyTranslate "INS" = Insert keyTranslate "KP_Insert" = Insert keyTranslate "Delete" = Delete keyTranslate "DEL" = Delete keyTranslate "KP_Delete" = Delete keyTranslate "KP_Enter" = Return keyTranslate "F1" = Fun 1 keyTranslate "F2" = Fun 2 keyTranslate "F3" = Fun 3 keyTranslate "F4" = Fun 4 keyTranslate "F5" = Fun 5 keyTranslate "F6" = Fun 6 keyTranslate "F7" = Fun 7 keyTranslate "F8" = Fun 8 keyTranslate "F9" = Fun 9 keyTranslate "F10" = Fun 10 keyTranslate "F11" = Fun 11 keyTranslate "F12" = Fun 12 keyTranslate "LeftButtonPress" = LeftButtonPress keyTranslate "LMB-PRESS" = LeftButtonPress keyTranslate "MiddleButtonPress" = MiddleButtonPress keyTranslate "MMB-PRESS" = MiddleButtonPress keyTranslate "RightButtonPress" = RightButtonPress keyTranslate "RMB-PRESS" = RightButtonPress keyTranslate "LeftButtonRelease" = LeftButtonRelease keyTranslate "LMB" = LeftButtonRelease keyTranslate "MiddleButtonRelease" = MiddleButtonRelease keyTranslate "MMB" = MiddleButtonRelease keyTranslate "RightButtonRelease" = RightButtonRelease keyTranslate "RMB" = RightButtonRelease keyTranslate "WheelNorth" = WheelNorth keyTranslate "WHEEL-UP" = WheelNorth keyTranslate "WheelSouth" = WheelSouth keyTranslate "WHEEL-DN" = WheelSouth -- dead keys keyTranslate "Shift_L" = DeadKey keyTranslate "Shift_R" = DeadKey keyTranslate "Control_L" = DeadKey keyTranslate "Control_R" = DeadKey keyTranslate "Super_L" = DeadKey keyTranslate "Super_R" = DeadKey keyTranslate "Menu" = DeadKey keyTranslate "Alt_L" = DeadKey keyTranslate "Alt_R" = DeadKey keyTranslate "Meta_L" = DeadKey keyTranslate "Meta_R" = DeadKey keyTranslate "ISO_Level2_Shift" = DeadKey keyTranslate "ISO_Level3_Shift" = DeadKey keyTranslate "ISO_Level2_Latch" = DeadKey keyTranslate "ISO_Level3_Latch" = DeadKey keyTranslate "Num_Lock" = DeadKey keyTranslate "NumLock" = DeadKey keyTranslate "Caps_Lock" = DeadKey keyTranslate "CapsLock" = DeadKey keyTranslate "VoidSymbol" = DeadKey -- numeric keypad keyTranslate ['K','P','_',c] = KP c -- standard characters keyTranslate [c] = Char c keyTranslate s = Unknown s -- | Translate key from a Web API string description -- () -- to our internal key type. To be used in web frontends. -- The argument says whether Shift is pressed. keyTranslateWeb :: String -> Bool -> Key keyTranslateWeb "1" True = KP '1' keyTranslateWeb "2" True = KP '2' keyTranslateWeb "3" True = KP '3' keyTranslateWeb "4" True = KP '4' keyTranslateWeb "5" True = KP '5' keyTranslateWeb "6" True = KP '6' keyTranslateWeb "7" True = KP '7' keyTranslateWeb "8" True = KP '8' keyTranslateWeb "9" True = KP '9' keyTranslateWeb "End" True = KP '1' keyTranslateWeb "ArrowDown" True = KP '2' keyTranslateWeb "PageDown" True = KP '3' keyTranslateWeb "ArrowLeft" True = KP '4' keyTranslateWeb "Begin" True = KP '5' keyTranslateWeb "Clear" True = KP '5' keyTranslateWeb "ArrowRight" True = KP '6' keyTranslateWeb "Home" True = KP '7' keyTranslateWeb "ArrowUp" True = KP '8' keyTranslateWeb "PageUp" True = KP '9' keyTranslateWeb "Backspace" _ = BackSpace keyTranslateWeb "Tab" True = BackTab keyTranslateWeb "Tab" False = Tab keyTranslateWeb "BackTab" _ = BackTab keyTranslateWeb "Begin" _ = Begin keyTranslateWeb "Clear" _ = Begin keyTranslateWeb "Enter" _ = Return keyTranslateWeb "Esc" _ = Esc keyTranslateWeb "Escape" _ = Esc keyTranslateWeb "Del" _ = Delete keyTranslateWeb "Delete" _ = Delete keyTranslateWeb "Home" _ = Home keyTranslateWeb "Up" _ = Up keyTranslateWeb "ArrowUp" _ = Up keyTranslateWeb "Down" _ = Down keyTranslateWeb "ArrowDown" _ = Down keyTranslateWeb "Left" _ = Left keyTranslateWeb "ArrowLeft" _ = Left keyTranslateWeb "Right" _ = Right keyTranslateWeb "ArrowRight" _ = Right keyTranslateWeb "PageUp" _ = PgUp keyTranslateWeb "PageDown" _ = PgDn keyTranslateWeb "End" _ = End keyTranslateWeb "Insert" _ = Insert keyTranslateWeb "space" _ = Space keyTranslateWeb "Equals" _ = Char '=' keyTranslateWeb "Multiply" True = Char '*' -- for laptop movement keys keyTranslateWeb "Multiply" False = KP '*' -- for keypad aiming keyTranslateWeb "*" False = KP '*' -- for keypad aiming keyTranslateWeb "Add" _ = Char '+' -- KP and normal are merged here keyTranslateWeb "Subtract" _ = Char '-' -- KP and normal are merged here keyTranslateWeb "Divide" True = Char '?' keyTranslateWeb "Divide" False = Char '/' -- KP and normal are merged here keyTranslateWeb "/" False = Char '/' -- KP and normal are merged here keyTranslateWeb "Decimal" _ = Char '.' -- dot and comma are merged here keyTranslateWeb "Separator" _ = Char '.' -- to sidestep national standards keyTranslateWeb "F1" _ = Fun 1 keyTranslateWeb "F2" _ = Fun 2 keyTranslateWeb "F3" _ = Fun 3 keyTranslateWeb "F4" _ = Fun 4 keyTranslateWeb "F5" _ = Fun 5 keyTranslateWeb "F6" _ = Fun 6 keyTranslateWeb "F7" _ = Fun 7 keyTranslateWeb "F8" _ = Fun 8 keyTranslateWeb "F9" _ = Fun 9 keyTranslateWeb "F10" _ = Fun 10 keyTranslateWeb "F11" _ = Fun 11 keyTranslateWeb "F12" _ = Fun 12 -- dead keys keyTranslateWeb "Dead" _ = DeadKey keyTranslateWeb "Shift" _ = DeadKey keyTranslateWeb "Control" _ = DeadKey keyTranslateWeb "Meta" _ = DeadKey keyTranslateWeb "Menu" _ = DeadKey keyTranslateWeb "ContextMenu" _ = DeadKey keyTranslateWeb "Alt" _ = DeadKey keyTranslateWeb "AltGraph" _ = DeadKey keyTranslateWeb "Num_Lock" _ = DeadKey keyTranslateWeb "NumLock" _ = DeadKey keyTranslateWeb "Caps_Lock" _ = DeadKey keyTranslateWeb "CapsLock" _ = DeadKey keyTranslateWeb "Win" _ = DeadKey -- browser quirks keyTranslateWeb "Unidentified" _ = Begin -- hack for Firefox keyTranslateWeb ['\ESC'] _ = Esc keyTranslateWeb [' '] _ = Space keyTranslateWeb ['\n'] _ = Return keyTranslateWeb ['\r'] _ = DeadKey keyTranslateWeb ['\t'] _ = Tab -- standard characters keyTranslateWeb [c] _ = Char c keyTranslateWeb s _ = Unknown s LambdaHack-0.9.5.0/engine-src/Game/LambdaHack/Client/UI/KeyBindings.hs0000644000000000000000000003072407346545000023200 0ustar0000000000000000{-# LANGUAGE RankNTypes, TupleSections #-} -- | Verifying, aggregating and displaying binding of keys to commands. module Game.LambdaHack.Client.UI.KeyBindings ( keyHelp, okxsN ) where import Prelude () import Game.LambdaHack.Core.Prelude import qualified Data.Map.Strict as M import qualified Data.Text as T import Game.LambdaHack.Client.UI.Content.Input import Game.LambdaHack.Client.UI.Content.Screen import Game.LambdaHack.Client.UI.ContentClientUI import Game.LambdaHack.Client.UI.HumanCmd import Game.LambdaHack.Client.UI.ItemSlot import qualified Game.LambdaHack.Client.UI.Key as K import Game.LambdaHack.Client.UI.Overlay import Game.LambdaHack.Client.UI.Slideshow import Game.LambdaHack.Common.Kind import Game.LambdaHack.Content.RuleKind import qualified Game.LambdaHack.Definition.Color as Color -- | Produce a set of help/menu screens from the key bindings. -- -- When the intro screen mentions KP_5, this really is KP_Begin, -- but since that is harder to understand we assume a different, non-default -- state of NumLock in the help text than in the code that handles keys. keyHelp :: COps -> CCUI -> Int -> [(Text, OKX)] keyHelp COps{corule} CCUI{ coinput=coinput@InputContent{..} , coscreen=ScreenContent{rheight, rintroScreen, rmoveKeysScreen} } offset = assert (offset > 0) $ let introBlurb = "" : map T.pack rintroScreen ++ [ "" , "Press SPACE or PGDN for help and ESC to see the map again." ] movBlurb = map T.pack rmoveKeysScreen movBlurbEnd = [ "Press SPACE or scroll the mouse wheel to see the minimal command set." ] minimalBlurb = [ "The following commands, joined with the basic set above," , "let you accomplish anything in the game, though" , "not necessarily with the fewest keystrokes. You can also" , "play the game exclusively with a mouse, or both mouse" , "and keyboard. (See the ending help screens for mouse commands.)" , "Lastly, you can select a command with arrows or mouse directly" , "from the help screen or the dashboard and execute it on the spot." , "" ] casualEnding = [ "" , "Press SPACE to see the detailed descriptions of all commands." ] categoryEnding = [ "" , "Press SPACE to see the next page of command descriptions." ] itemMenuEnding = [ "" , "Note how lower case item commands (pack an item, equip, stash)" , "let you move items into a particular item store." , "" , "Press SPACE to see the detailed descriptions of other item-related commands." ] itemRemainingEnding = [ "" , "Note how upper case item commands (manage Pack, Equipment," , "Stash, etc.) let you view and organize items within" , "a particular item store. Once a menu is opened, you can" , "switch stores at will, so each of the commands only" , "determines the starting item store. Each store" , "is accessible from the dashboard, as well." , "" , "Press SPACE to see the next page of command descriptions." ] itemAllEnding = [ "" , "Note how lower case item commands (pack an item, equip, stash)" , "let you move items into a particular item store, while" , "upper case item commands (manage Pack, Equipment, Stash, etc.)" , "let you view and organize items within an item store." , "Once a store management menu is opened, you can switch" , "stores at will, so the multiple commands only determine" , "the starting item store. Each store is accessible" , "from the dashboard as well." , "" , "Press SPACE to see the next page of command descriptions." ] mouseBasicsBlurb = [ "Screen area and UI mode (exploration/aiming) determine" , "mouse click effects. First, we give an overview" , "of effects of each button over the game map area." , "The list includes not only left and right buttons, but also" , "the optional middle mouse button (MMB) and the mouse wheel," , "which is also used over menus, to page-scroll them." , "(For mice without RMB, one can use Control key with LMB and for mice" , "without MMB, one can use C-RMB or C-S-LMB.)" , "Next we show mouse button effects per screen area," , "in exploration mode and (if different) in aiming mode." , "" ] mouseBasicsEnding = [ "" , "Press SPACE to see mouse commands in exploration and aiming modes." ] lastHelpEnding = [ "" , "For more playing instructions see file PLAYING.md. Press PGUP or scroll" , "mouse wheel for previous pages and press SPACE or ESC to see the map again." ] keyL = 12 pickLeaderDescription = [ fmt keyL "0, 1 ... 6" "pick a particular actor as the new leader" ] casualDescription = "Minimal cheat sheet for casual play" fmt n k h = " " <> T.justifyLeft n ' ' k <+> h fmts s = " " <> s introText = map fmts introBlurb movText = map fmts movBlurb movTextEnd = map fmts movBlurbEnd minimalText = map fmts minimalBlurb casualEnd = map fmts casualEnding categoryEnd = map fmts categoryEnding itemMenuEnd = map fmts itemMenuEnding itemRemainingEnd = map fmts itemRemainingEnding itemAllEnd = map fmts itemAllEnding mouseBasicsText = map fmts mouseBasicsBlurb mouseBasicsEnd = map fmts mouseBasicsEnding lastHelpEnd = map fmts lastHelpEnding keyCaptionN n = fmt n "keys" "command" keyCaption = keyCaptionN keyL okxs = okxsN coinput offset keyL (const False) True renumber y (km, (y0, x1, x2)) = (km, (y0 + y, x1, x2)) mergeOKX :: OKX -> OKX -> OKX mergeOKX (ov1, ks1) (ov2, ks2) = (ov1 ++ ov2, ks1 ++ map (renumber $ length ov1) ks2) catLength cat = length $ filter (\(_, (cats, desc, _)) -> cat `elem` cats && (desc /= "" || CmdInternal `elem` cats)) bcmdList keyM = 13 keyB = 31 truncatem b = if T.length b > keyB then T.take (keyB - 1) b <> "$" else b fmm a b c = fmt keyM a $ fmt keyB (truncatem b) (" " <> truncatem c) areaCaption t = fmm t "LMB (left mouse button)" "RMB (right mouse button)" keySel :: (forall a. (a, a) -> a) -> K.KM -> [(CmdArea, Either K.KM SlotChar, Text)] keySel sel key = let cmd = case M.lookup key bcmdMap of Just (_, _, cmd2) -> cmd2 Nothing -> error $ "" `showFailure` key caCmds = case cmd of ByAimMode AimModeCmd{exploration=ByArea lexp, aiming=ByArea laim} -> sort $ sel (lexp, laim \\ lexp) _ -> error $ "" `showFailure` cmd caMakeChoice (ca, cmd2) = let (km, desc) = case M.lookup cmd2 brevMap of Just ks -> let descOfKM km2 = case M.lookup km2 bcmdMap of Just (_, "", _) -> Nothing Just (_, desc2, _) -> Just (km2, desc2) Nothing -> error $ "" `showFailure` km2 in case mapMaybe descOfKM ks of [] -> error $ "" `showFailure` (ks, cmd2) kmdesc3 : _ -> kmdesc3 Nothing -> (key, "(not described:" <+> tshow cmd2 <> ")") in (ca, Left km, desc) in map caMakeChoice caCmds okm :: (forall a. (a, a) -> a) -> K.KM -> K.KM -> [Text] -> [Text] -> OKX okm sel key1 key2 header footer = let kst1 = keySel sel key1 kst2 = keySel sel key2 f (ca1, Left km1, _) (ca2, Left km2, _) y = assert (ca1 == ca2 `blame` (kst1, kst2)) [ (Left [km1], (y, keyM + 3, keyB + keyM + 3)) , (Left [km2], (y, keyB + keyM + 5, 2 * keyB + keyM + 5)) ] f c d e = error $ "" `showFailure` (c, d, e) kxs = concat $ zipWith3 f kst1 kst2 [offset + length header..] render (ca1, _, desc1) (_, _, desc2) = fmm (areaDescription ca1) desc1 desc2 menu = zipWith render kst1 kst2 in (map textToAL $ "" : header ++ menu ++ footer, kxs) in concat [ [ ( rtitle corule <+> "- backstory" , (map textToAL introText, []) ) ] , if catLength CmdMinimal + length movText + length minimalText + length casualEnd + 5 > rheight then [ ( casualDescription <+> "(1/2)." , (map textToAL ([""] ++ movText ++ [""] ++ movTextEnd), []) ) , ( casualDescription <+> "(2/2)." , okxs CmdMinimal (minimalText ++ [keyCaption]) casualEnd ) ] else [ ( casualDescription <> "." , okxs CmdMinimal (movText ++ [""] ++ minimalText ++ [keyCaption]) casualEnd ) ] , if catLength CmdItemMenu + catLength CmdItem + 9 > rheight then [ ( categoryDescription CmdItemMenu <> "." , okxs CmdItemMenu [keyCaption] itemMenuEnd ) , ( categoryDescription CmdItem <> "." , okxs CmdItem [keyCaption] itemRemainingEnd ) ] else [ ( categoryDescription CmdItemMenu <> "." , mergeOKX (okxs CmdItemMenu [keyCaption] [""]) (okxs CmdItem [categoryDescription CmdItem <> ".", "", keyCaption] itemAllEnd) ) ] , if catLength CmdMove + catLength CmdAim + 9 > rheight then [ ( "All terrain exploration and alteration commands." , okxs CmdMove [keyCaption] (pickLeaderDescription ++ categoryEnd) ) , ( categoryDescription CmdAim <> "." , okxs CmdAim [keyCaption] categoryEnd ) ] else [ ( "All terrain exploration and alteration commands." , mergeOKX (okxs CmdMove [keyCaption] (pickLeaderDescription ++ [""])) (okxs CmdAim [categoryDescription CmdAim <> ".", "", keyCaption] categoryEnd) ) ] , if 45 > rheight then [ ( "Mouse overview." , let (ls, _) = okxs CmdMouse (mouseBasicsText ++ [keyCaption]) mouseBasicsEnd in (ls, []) ) -- don't capture mouse wheel, etc. , ( "Mouse in exploration and aiming modes." , mergeOKX (okm fst K.leftButtonReleaseKM K.rightButtonReleaseKM [areaCaption "exploration"] []) (okm snd K.leftButtonReleaseKM K.rightButtonReleaseKM [areaCaption "aiming mode"] categoryEnd) ) ] else [ ( "Mouse commands." , let (ls, _) = okxs CmdMouse (mouseBasicsText ++ [keyCaption]) [] okx0 = (ls, []) -- don't capture mouse wheel, etc. in mergeOKX (mergeOKX okx0 (okm fst K.leftButtonReleaseKM K.rightButtonReleaseKM [areaCaption "exploration"] [])) (okm snd K.leftButtonReleaseKM K.rightButtonReleaseKM [areaCaption "aiming mode"] categoryEnd) ) ] , [ ( categoryDescription CmdMeta <> "." , okxs CmdMeta [keyCaption] lastHelpEnd ) ] ] -- | Turn the specified portion of bindings into a menu. okxsN :: InputContent -> Int -> Int -> (HumanCmd -> Bool) -> Bool -> CmdCategory -> [Text] -> [Text] -> OKX okxsN InputContent{..} offset n greyedOut showManyKeys cat header footer = let fmt k h = " " <> T.justifyLeft n ' ' k <+> h coImage :: HumanCmd -> [K.KM] coImage cmd = M.findWithDefault (error $ "" `showFailure` cmd) cmd brevMap disp = T.intercalate " or " . map (T.pack . K.showKM) keyKnown km = case K.key km of K.Unknown{} -> False _ -> True keys :: [(Either [K.KM] SlotChar, (Bool, Text))] keys = [ (Left kmsRes, (greyedOut cmd, fmt keyNames desc)) | (_, (cats, desc, cmd)) <- bcmdList , let kms = coImage cmd knownKeys = filter keyKnown kms keyNames = disp $ (if showManyKeys then id else take 1) knownKeys kmsRes = if desc == "" then knownKeys else kms , cat `elem` cats , desc /= "" || CmdInternal `elem` cats] f (ks, (_, tkey)) y = (ks, (y, 1, T.length tkey)) kxs = zipWith f keys [offset + length header..] ts = map (False,) ("" : header) ++ map snd keys ++ map (False,) footer greyToAL (b, t) = if b then textFgToAL Color.BrBlack t else textToAL t in (map greyToAL ts, kxs) LambdaHack-0.9.5.0/engine-src/Game/LambdaHack/Client/UI/MonadClientUI.hs0000644000000000000000000004074207346545000023426 0ustar0000000000000000-- | Client monad for interacting with a human through UI. module Game.LambdaHack.Client.UI.MonadClientUI ( -- * Client UI monad MonadClientUI( getsSession , modifySession , updateClientLeader , getCacheBfs , getCachePath ) -- * Assorted primitives , clientPrintUI, mapStartY, getSession, putSession, displayFrames , connFrontendFrontKey, setFrontAutoYes, frontendShutdown, printScreen , chanFrontend, anyKeyPressed, discardPressedKey, resetPressedKeys , addPressedControlEsc, revCmdMap , getReportUI, getLeaderUI, getArenaUI, viewedLevelUI , leaderTgtToPos, xhairToPos, clearAimMode, scoreToSlideshow, defaultHistory , tellAllClipPS, tellGameClipPS, elapsedSessionTimeGT , resetSessionStart, resetGameStart , partActorLeader, partActorLeaderFun, partPronounLeader , tryRestore, leaderSkillsClientUI #ifdef EXPOSE_INTERNAL -- * Internal operations , connFrontend, displayFrame, addPressedKey #endif ) where import Prelude () import Game.LambdaHack.Core.Prelude import qualified Data.EnumMap.Strict as EM import qualified Data.Map.Strict as M import qualified Data.Text as T import qualified Data.Text.IO as T import Data.Time.Clock import Data.Time.Clock.POSIX import Data.Time.LocalTime import qualified Data.Vector.Unboxed as U import qualified NLP.Miniutter.English as MU import System.FilePath import System.IO (hFlush, stdout) import Game.LambdaHack.Client.Bfs import Game.LambdaHack.Client.ClientOptions import Game.LambdaHack.Client.CommonM import Game.LambdaHack.Client.MonadClient import Game.LambdaHack.Client.State import Game.LambdaHack.Client.UI.ActorUI import Game.LambdaHack.Client.UI.Content.Input import Game.LambdaHack.Client.UI.Content.Screen import Game.LambdaHack.Client.UI.ContentClientUI import Game.LambdaHack.Client.UI.Frame import Game.LambdaHack.Client.UI.Frontend import qualified Game.LambdaHack.Client.UI.Frontend as Frontend import qualified Game.LambdaHack.Client.UI.HumanCmd as HumanCmd import qualified Game.LambdaHack.Client.UI.Key as K import Game.LambdaHack.Client.UI.Msg import Game.LambdaHack.Client.UI.SessionUI import Game.LambdaHack.Client.UI.Slideshow import Game.LambdaHack.Client.UI.UIOptions import Game.LambdaHack.Common.Actor import Game.LambdaHack.Common.ActorState import Game.LambdaHack.Common.Faction import Game.LambdaHack.Common.File import qualified Game.LambdaHack.Common.HighScore as HighScore import Game.LambdaHack.Common.Kind import Game.LambdaHack.Common.Misc import Game.LambdaHack.Common.MonadStateRead import Game.LambdaHack.Common.Point import qualified Game.LambdaHack.Common.PointArray as PointArray import qualified Game.LambdaHack.Common.Save as Save import Game.LambdaHack.Common.State import Game.LambdaHack.Common.Time import Game.LambdaHack.Common.Types import Game.LambdaHack.Content.ModeKind import Game.LambdaHack.Content.RuleKind import qualified Game.LambdaHack.Definition.Ability as Ability import Game.LambdaHack.Definition.Defs -- Assumes no interleaving with other clients, because each UI client -- in a different terminal/window/machine. clientPrintUI :: MonadClientUI m => Text -> m () clientPrintUI t = liftIO $ do T.hPutStrLn stdout t hFlush stdout -- | The row where the dungeon map starts. mapStartY :: Y mapStartY = 1 -- | The monad that gives the client access to UI operations, -- but not to modifying client state. class MonadClientRead m => MonadClientUI m where getsSession :: (SessionUI -> a) -> m a modifySession :: (SessionUI -> SessionUI) -> m () updateClientLeader :: ActorId -> m () getCacheBfs :: ActorId -> m (PointArray.Array BfsDistance) getCachePath :: ActorId -> Point -> m (Maybe AndPath) getSession :: MonadClientUI m => m SessionUI getSession = getsSession id putSession :: MonadClientUI m => SessionUI -> m () putSession s = modifySession (const s) -- | Write a UI request to the frontend and read a corresponding reply. connFrontend :: MonadClientUI m => FrontReq a -> m a connFrontend req = do ChanFrontend f <- getsSession schanF liftIO $ f req displayFrame :: MonadClientUI m => Maybe Frame -> m () displayFrame mf = do frame <- case mf of Nothing -> return $! FrontDelay 1 Just fr -> do modifySession $ \cli -> cli {snframes = snframes cli + 1} return $! FrontFrame fr connFrontend frame -- | Push frames or delays to the frame queue. The frames depict -- the @lid@ level. displayFrames :: MonadClientUI m => LevelId -> PreFrames -> m () displayFrames lid frs = do let frames = case frs of [] -> [] [Just (bfr, ffr)] -> [Just (FrameBase $ U.unsafeThaw bfr, ffr)] _ -> -- Due to the frames coming from the same base frame, -- we have to copy it to avoid picture corruption. map (fmap $ \(bfr, ffr) -> (FrameBase $ U.thaw bfr, ffr)) frs mapM_ displayFrame frames -- Can be different than @blid b@, e.g., when our actor is attacked -- on a remote level. lidV <- viewedLevelUI when (lidV == lid) $ modifySession $ \sess -> sess {sdisplayNeeded = False} -- | Write 'FrontKey' UI request to the frontend, read the reply, -- set pointer, return key. connFrontendFrontKey :: MonadClientUI m => [K.KM] -> PreFrame -> m K.KM connFrontendFrontKey frontKeyKeys (bfr, ffr) = do let frontKeyFrame = (FrameBase $ U.unsafeThaw bfr, ffr) kmp <- connFrontend $ FrontKey frontKeyKeys frontKeyFrame modifySession $ \sess -> sess {spointer = K.kmpPointer kmp} return $! K.kmpKeyMod kmp setFrontAutoYes :: MonadClientUI m => Bool -> m () setFrontAutoYes b = connFrontend $ FrontAutoYes b frontendShutdown :: MonadClientUI m => m () frontendShutdown = connFrontend FrontShutdown printScreen :: MonadClientUI m => m () printScreen = connFrontend FrontPrintScreen -- | Initialize the frontend chosen by the player via client options. chanFrontend :: MonadClientUI m => ScreenContent -> ClientOptions -> m ChanFrontend chanFrontend coscreen soptions = liftIO $ Frontend.chanFrontendIO coscreen soptions anyKeyPressed :: MonadClientUI m => m Bool anyKeyPressed = connFrontend FrontPressed discardPressedKey :: MonadClientUI m => m () discardPressedKey = connFrontend FrontDiscardKey resetPressedKeys :: MonadClientUI m => m () resetPressedKeys = connFrontend FrontResetKeys addPressedKey :: MonadClientUI m => K.KMP -> m () addPressedKey = connFrontend . FrontAdd addPressedControlEsc :: MonadClientUI m => m () addPressedControlEsc = addPressedKey K.KMP { K.kmpKeyMod = K.controlEscKM , K.kmpPointer = originPoint } revCmdMap :: MonadClientUI m => m (K.KM -> HumanCmd.HumanCmd -> K.KM) revCmdMap = do CCUI{coinput=InputContent{brevMap}} <- getsSession sccui let revCmd dflt cmd = case M.lookup cmd brevMap of Nothing -> dflt Just (k : _) -> k Just [] -> error $ "" `showFailure` brevMap return revCmd getReportUI :: MonadClientUI m => m Report getReportUI = do sUIOptions <- getsSession sUIOptions report <- getsSession $ newReport . shistory side <- getsClient sside fact <- getsState $ (EM.! side) . sfactionD let underAI = isAIFact fact mem = EM.fromList <$> uMessageColors sUIOptions promptAI = toMsg mem MsgPrompt "[press any key for main menu]" return $! if underAI then consReport promptAI report else report getLeaderUI :: MonadClientUI m => m ActorId getLeaderUI = do cli <- getClient case sleader cli of Nothing -> error $ "leader expected but not found" `showFailure` cli Just leader -> return leader getArenaUI :: MonadClientUI m => m LevelId getArenaUI = do let fallback = do side <- getsClient sside fact <- getsState $ (EM.! side) . sfactionD case gquit fact of Just Status{stDepth} -> return $! toEnum stDepth Nothing -> getEntryArena fact mleader <- getsClient sleader case mleader of Just leader -> do -- The leader may just be teleporting (e.g., due to displace -- over terrain not in FOV) so not existent momentarily. mem <- getsState $ EM.member leader . sactorD if mem then getsState $ blid . getActorBody leader else fallback Nothing -> fallback viewedLevelUI :: MonadClientUI m => m LevelId viewedLevelUI = do arena <- getArenaUI saimMode <- getsSession saimMode return $! maybe arena aimLevelId saimMode leaderTgtToPos :: MonadClientUI m => m (Maybe Point) leaderTgtToPos = do lidV <- viewedLevelUI mleader <- getsClient sleader case mleader of Nothing -> return Nothing Just aid -> do mtgt <- getsClient $ getTarget aid getsState $ aidTgtToPos aid lidV mtgt xhairToPos :: MonadClientUI m => m (Maybe Point) xhairToPos = do lidV <- viewedLevelUI mleader <- getsClient sleader sxhair <- getsSession sxhair case mleader of Nothing -> return Nothing -- e.g., when game start and no leader yet Just aid -> getsState $ aidTgtToPos aid lidV sxhair -- e.g., xhair on another level -- If aim mode is exited, usually the player had the opportunity to deal -- with xhair on a foe spotted on another level, so now move xhair -- back to the leader level. clearAimMode :: MonadClientUI m => m () clearAimMode = do lidVOld <- viewedLevelUI -- not in aiming mode at this point mxhairPos <- xhairToPos -- computed while still in aiming mode modifySession $ \sess -> sess {saimMode = Nothing} lidV <- viewedLevelUI -- not in aiming mode at this point when (lidVOld /= lidV) $ do leader <- getLeaderUI lpos <- getsState $ bpos . getActorBody leader sxhairOld <- getsSession sxhair let xhairPos = fromMaybe lpos mxhairPos sxhair = case sxhairOld of Just TPoint{} -> Just $ TPoint TUnknown lidV xhairPos -- the point is possibly unknown on this level; unimportant anyway _ -> sxhairOld modifySession $ \sess -> sess {sxhair} scoreToSlideshow :: MonadClientUI m => Int -> Status -> m Slideshow scoreToSlideshow total status = do CCUI{coscreen=ScreenContent{rwidth, rheight}} <- getsSession sccui fid <- getsClient sside scoreDict <- getsState shigh gameModeId <- getsState sgameModeId gameMode <- getGameMode time <- getsState stime dungeonTotal <- getsState sgold date <- liftIO getPOSIXTime tz <- liftIO $ getTimeZone $ posixSecondsToUTCTime date curChalSer <- getsClient scurChal factionD <- getsState sfactionD let fact = factionD EM.! fid table = HighScore.getTable gameModeId scoreDict gameModeName = mname gameMode chal | fhasUI $ gplayer fact = curChalSer | otherwise = curChalSer {cdiff = difficultyInverse (cdiff curChalSer)} theirVic (fi, fa) | isFoe fid fact fi && not (isHorrorFact fa) = Just $ gvictims fa | otherwise = Nothing theirVictims = EM.unionsWith (+) $ mapMaybe theirVic $ EM.assocs factionD ourVic (fi, fa) | isFriend fid fact fi = Just $ gvictims fa | otherwise = Nothing ourVictims = EM.unionsWith (+) $ mapMaybe ourVic $ EM.assocs factionD (worthMentioning, (ntable, pos)) = HighScore.register table total dungeonTotal time status date chal (T.unwords $ tail $ T.words $ gname fact) ourVictims theirVictims (fhiCondPoly $ gplayer fact) sli = highSlideshow rwidth (rheight - 1) ntable pos gameModeName tz return $! if worthMentioning then sli else emptySlideshow defaultHistory :: MonadClientUI m => m History defaultHistory = do sUIOptions <- getsSession sUIOptions liftIO $ do utcTime <- getCurrentTime timezone <- getTimeZone utcTime let curDate = T.pack $ take 19 $ show $ utcToLocalTime timezone utcTime emptyHist = emptyHistory $ uHistoryMax sUIOptions mem = EM.fromList <$> uMessageColors sUIOptions msg = toMsg mem MsgAdmin $ "History log started on " <> curDate <> "." return $! fst $ addToReport emptyHist msg 0 timeZero tellAllClipPS :: MonadClientUI m => m () tellAllClipPS = do bench <- getsClient $ sbenchmark . soptions when bench $ do sstartPOSIX <- getsSession sstart curPOSIX <- liftIO getPOSIXTime allTime <- getsSession sallTime gtime <- getsState stime allNframes <- getsSession sallNframes gnframes <- getsSession snframes let time = absoluteTimeAdd allTime gtime nframes = allNframes + gnframes diff = fromRational $ toRational $ curPOSIX - sstartPOSIX cps = fromIntegral (timeFit time timeClip) / diff :: Double fps = fromIntegral nframes / diff :: Double clientPrintUI $ "Session time:" <+> tshow diff <> "s; frames:" <+> tshow nframes <> "." <+> "Average clips per second:" <+> tshow cps <> "." <+> "Average FPS:" <+> tshow fps <> "." tellGameClipPS :: MonadClientUI m => m () tellGameClipPS = do bench <- getsClient $ sbenchmark . soptions when bench $ do sgstartPOSIX <- getsSession sgstart curPOSIX <- liftIO getPOSIXTime -- If loaded game, don't report anything. unless (sgstartPOSIX == 0) $ do time <- getsState stime nframes <- getsSession snframes let diff = fromRational $ toRational $ curPOSIX - sgstartPOSIX cps = fromIntegral (timeFit time timeClip) / diff :: Double fps = fromIntegral nframes / diff :: Double -- This means: "Game portion after last reload time:...". clientPrintUI $ "Game time:" <+> tshow diff <> "s; frames:" <+> tshow nframes <> "." <+> "Average clips per second:" <+> tshow cps <> "." <+> "Average FPS:" <+> tshow fps <> "." elapsedSessionTimeGT :: MonadClientUI m => Int -> m Bool elapsedSessionTimeGT stopAfter = do current <- liftIO getPOSIXTime sstartPOSIX <- getsSession sstart return $! fromIntegral stopAfter + sstartPOSIX <= current resetSessionStart :: MonadClientUI m => m () resetSessionStart = do sstart <- liftIO getPOSIXTime modifySession $ \sess -> sess {sstart} resetGameStart resetGameStart :: MonadClientUI m => m () resetGameStart = do sgstart <- liftIO getPOSIXTime time <- getsState stime nframes <- getsSession snframes modifySession $ \cli -> cli { sgstart , sallTime = absoluteTimeAdd (sallTime cli) time , snframes = 0 , sallNframes = sallNframes cli + nframes } partActorLeaderCommon :: Maybe ActorId -> ActorUI -> Actor -> ActorId -> MU.Part partActorLeaderCommon mleader bUI b aid = case mleader of Just leader | aid == leader -> "you" _ | bhp b <= 0 -> MU.Phrase ["the fallen", partActor bUI] _ -> partActor bUI -- | The part of speech describing the actor or the "you" pronoun if he is -- the leader of the observer's faction. partActorLeader :: MonadClientUI m => ActorId -> m MU.Part partActorLeader aid = do mleader <- getsClient sleader bUI <- getsSession $ getActorUI aid b <- getsState $ getActorBody aid return $! partActorLeaderCommon mleader bUI b aid partActorLeaderFun :: MonadClientUI m => m (ActorId -> MU.Part) partActorLeaderFun = do mleader <- getsClient sleader sess <- getSession s <- getState return $! \aid -> partActorLeaderCommon mleader (getActorUI aid sess) (getActorBody aid s) aid -- | The part of speech with the actor's pronoun or "you" if a leader -- of the client's faction. partPronounLeader :: MonadClientUI m => ActorId -> m MU.Part partPronounLeader aid = do mleader <- getsClient sleader bUI <- getsSession $ getActorUI aid return $! case mleader of Just leader | aid == leader -> "you" _ -> partPronoun bUI -- | Try to read saved client game state from the file system. tryRestore :: MonadClientUI m => m (Maybe (StateClient, Maybe SessionUI)) tryRestore = do cops@COps{corule} <- getsState scops bench <- getsClient $ sbenchmark . soptions if bench then return Nothing else do side <- getsClient sside prefix <- getsClient $ ssavePrefixCli . soptions let fileName = prefix <> Save.saveNameCli cops side res <- liftIO $ Save.restoreGame cops fileName let cfgUIName = rcfgUIName corule content = rcfgUIDefault corule dataDir <- liftIO appDataDir liftIO $ tryWriteFile (dataDir cfgUIName) content return res leaderSkillsClientUI :: MonadClientUI m => m Ability.Skills leaderSkillsClientUI = do leader <- getLeaderUI getsState $ getActorMaxSkills leader LambdaHack-0.9.5.0/engine-src/Game/LambdaHack/Client/UI/Msg.hs0000644000000000000000000003254007346545000021516 0ustar0000000000000000{-# LANGUAGE DeriveGeneric, GeneralizedNewtypeDeriving #-} -- | Game messages displayed on top of the screen for the player to read -- and then saved to player history. module Game.LambdaHack.Client.UI.Msg ( -- * Msg Msg, toMsg , MsgClass(..), interruptsRunning, disturbsResting -- * Report , Report, nullReport, consReport, renderReport, anyInReport -- * History , History, newReport, emptyHistory, addToReport, archiveReport, lengthHistory , renderHistory #ifdef EXPOSE_INTERNAL -- * Internal operations , isSavedToHistory, isDisplayed, bindsPronouns, msgColor , UAttrLine, RepMsgN, uToAttrLine, attrLineToU , emptyReport, snocReport, renderWholeReport, renderRepetition , scrapRepetition, renderTimeReport #endif ) where import Prelude () import Game.LambdaHack.Core.Prelude import Control.DeepSeq import Data.Binary import qualified Data.EnumMap.Strict as EM import Data.Vector.Binary () import qualified Data.Vector.Unboxed as U import Data.Word (Word32) import GHC.Generics (Generic) import Game.LambdaHack.Client.UI.Overlay import qualified Game.LambdaHack.Common.RingBuffer as RB import Game.LambdaHack.Common.Time import qualified Game.LambdaHack.Definition.Color as Color -- * UAttrLine type UAttrLine = U.Vector Word32 uToAttrLine :: UAttrLine -> AttrLine uToAttrLine v = map Color.AttrCharW32 $ U.toList v attrLineToU :: AttrLine -> UAttrLine attrLineToU l = U.fromList $ map Color.attrCharW32 l -- * Msg -- | The type of a single game message. data Msg = Msg { msgLine :: AttrLine -- ^ the colours and characters of the message; -- not just text, in case there was some colour -- unrelated to msg class , msgClass :: MsgClass -- ^ whether message should be displayed, -- recorded in history, with what color, etc. } deriving (Show, Eq, Generic) instance Binary Msg toMsg :: Maybe (EM.EnumMap MsgClass Color.Color) -> MsgClass -> Text -> Msg toMsg mem msgClass l = let findColorInConfig = EM.findWithDefault Color.White msgClass color = maybe (msgColor msgClass) findColorInConfig mem msgLine = textFgToAL color l in Msg {..} data MsgClass = MsgAdmin | MsgBecome | MsgNoLonger | MsgLongerUs | MsgLonger | MsgItemCreation | MsgItemDestruction | MsgDeathGood | MsgDeathBad | MsgDeath | MsgDeathThreat | MsgLeader | MsgDiplomacy | MsgOutcome | MsgPlot | MsgLandscape | MsgTileDisco | MsgItemDisco | MsgActorSpot | MsgFirstEnemySpot | MsgItemSpot | MsgItemMove | MsgAction | MsgActionMinor | MsgEffectMajor | MsgEffect | MsgEffectMinor | MsgMisc | MsgHeardClose | MsgHeard | MsgFocus | MsgWarning | MsgRangedPowerfulWe | MsgRangedPowerfulUs | MsgRanged -- our non-projectile actors are not hit | MsgRangedUs | MsgRare | MsgVeryRare | MsgMeleePowerfulWe | MsgMeleePowerfulUs | MsgMeleeInterestingWe | MsgMeleeInterestingUs | MsgMelee -- our non-projectile actors are not hit | MsgMeleeUs | MsgDone | MsgAtFeetMajor | MsgAtFeet | MsgNumeric | MsgSpam | MsgMacro | MsgRunStop | MsgPrompt | MsgPromptFocus | MsgAlert | MsgStopPlayback deriving (Show, Read, Eq, Enum, Generic) instance NFData MsgClass instance Binary MsgClass isSavedToHistory :: MsgClass -> Bool isSavedToHistory MsgNumeric = False isSavedToHistory MsgSpam = False isSavedToHistory MsgMacro = False isSavedToHistory MsgRunStop = False isSavedToHistory MsgPrompt = False isSavedToHistory MsgPromptFocus = False isSavedToHistory MsgAlert = False isSavedToHistory MsgStopPlayback = False isSavedToHistory _ = True isDisplayed :: MsgClass -> Bool isDisplayed MsgRunStop = False isDisplayed MsgNumeric = False isDisplayed MsgSpam = False isDisplayed MsgMacro = False isDisplayed MsgStopPlayback = False isDisplayed _ = True interruptsRunning :: MsgClass -> Bool interruptsRunning MsgHeard = False -- MsgHeardClose interrupts, even if running started while hearing close interruptsRunning MsgEffectMinor = False interruptsRunning MsgItemDisco = False interruptsRunning MsgItemMove = False interruptsRunning MsgActionMinor = False interruptsRunning MsgAtFeet = False interruptsRunning MsgNumeric = False interruptsRunning MsgSpam = False interruptsRunning MsgMacro = False interruptsRunning MsgRunStop = False interruptsRunning MsgPrompt = False interruptsRunning MsgPromptFocus = False -- MsgAlert means something went wrong, so alarm interruptsRunning _ = True disturbsResting :: MsgClass -> Bool disturbsResting MsgHeard = False disturbsResting MsgHeardClose = False -- handled separately disturbsResting MsgLeader = False -- handled separately disturbsResting MsgEffectMinor = False disturbsResting MsgItemDisco = False disturbsResting MsgItemMove = False disturbsResting MsgActionMinor = False disturbsResting MsgAtFeet = False disturbsResting MsgNumeric = False disturbsResting MsgSpam = False disturbsResting MsgMacro = False disturbsResting MsgRunStop = False disturbsResting MsgPrompt = False disturbsResting MsgPromptFocus = False -- MsgAlert means something went wrong, so alarm disturbsResting _ = True -- Only player's non-projectile actors getting hit introduce subjects, -- because only such hits are guaranteed to be perceived. -- Here we also mark friends being hit, but that's a safe approximation. -- We also mark the messages that use the introduced subjects -- by referring to them via pronouns. They can't be moved freely either. bindsPronouns :: MsgClass -> Bool bindsPronouns MsgRangedPowerfulUs = True bindsPronouns MsgRangedUs = True bindsPronouns MsgMeleePowerfulUs = True bindsPronouns MsgMeleeInterestingUs = True bindsPronouns MsgMeleeUs = True bindsPronouns MsgLongerUs = True bindsPronouns _ = False -- Only @White@ color gets replaced by this one. msgColor :: MsgClass -> Color.Color msgColor MsgAdmin = Color.White msgColor MsgBecome = Color.BrBlue -- similar color to cyan and role to Effect msgColor MsgNoLonger = Color.Blue msgColor MsgLongerUs = Color.White -- not important enough msgColor MsgLonger = Color.White -- not important enough msgColor MsgItemCreation = Color.BrBlue msgColor MsgItemDestruction = Color.Blue msgColor MsgDeathGood = Color.BrGreen msgColor MsgDeathBad = Color.BrRed msgColor MsgDeath = Color.White msgColor MsgDeathThreat = Color.BrRed msgColor MsgLeader = Color.White msgColor MsgDiplomacy = Color.BrYellow msgColor MsgOutcome = Color.BrWhite msgColor MsgPlot = Color.White msgColor MsgLandscape = Color.White msgColor MsgTileDisco = Color.Magenta msgColor MsgItemDisco = Color.BrMagenta msgColor MsgActorSpot = Color.White -- too common msgColor MsgFirstEnemySpot = Color.Red msgColor MsgItemSpot = Color.White msgColor MsgItemMove = Color.White msgColor MsgAction = Color.White msgColor MsgActionMinor = Color.White msgColor MsgEffectMajor = Color.BrCyan msgColor MsgEffect = Color.Cyan msgColor MsgEffectMinor = Color.White msgColor MsgMisc = Color.White msgColor MsgHeardClose = Color.BrYellow msgColor MsgHeard = Color.Brown msgColor MsgFocus = Color.Green msgColor MsgWarning = Color.BrYellow msgColor MsgRangedPowerfulWe = Color.Green msgColor MsgRangedPowerfulUs = Color.Red msgColor MsgRanged = Color.White msgColor MsgRangedUs = Color.White msgColor MsgRare = Color.Cyan msgColor MsgVeryRare = Color.BrCyan msgColor MsgMeleePowerfulWe = Color.Green msgColor MsgMeleePowerfulUs = Color.Red msgColor MsgMeleeInterestingWe = Color.Green msgColor MsgMeleeInterestingUs = Color.Red msgColor MsgMelee = Color.White msgColor MsgMeleeUs = Color.White msgColor MsgDone = Color.White msgColor MsgAtFeetMajor = Color.White msgColor MsgAtFeet = Color.White msgColor MsgNumeric = Color.White msgColor MsgSpam = Color.White msgColor MsgMacro = Color.White msgColor MsgRunStop = Color.White msgColor MsgPrompt = Color.White msgColor MsgPromptFocus = Color.Green msgColor MsgAlert = Color.BrYellow msgColor MsgStopPlayback = Color.BrYellow -- * Report data RepMsgN = RepMsgN {repMsg :: Msg, _repN :: Int} deriving (Show, Generic) instance Binary RepMsgN -- | The set of messages, with repetitions, to show at the screen at once. newtype Report = Report [RepMsgN] deriving (Show, Binary) -- | Empty set of messages. emptyReport :: Report emptyReport = Report [] -- | Test if the set of messages is empty. nullReport :: Report -> Bool nullReport (Report l) = null l -- | Add a message to the end of the report. snocReport :: Report -> Msg -> Int -> Report snocReport (Report !r) y n = if null $ msgLine y then Report r else Report $ RepMsgN y n : r -- | Add a message to the start of report. consReport :: Msg -> Report -> Report consReport Msg{msgLine=[]} rep = rep consReport y (Report r) = Report $ r ++ [RepMsgN y 1] -- | Render a report as a (possibly very long) 'AttrLine'. Filter out -- messages not meant for display. renderReport :: Report -> AttrLine renderReport (Report r) = let rep = Report $ filter (isDisplayed . msgClass . repMsg) r in renderWholeReport rep -- | Render a report as a (possibly very long) 'AttrLine'. renderWholeReport :: Report -> AttrLine renderWholeReport (Report []) = [] renderWholeReport (Report (x : xs)) = renderWholeReport (Report xs) <+:> renderRepetition x renderRepetition :: RepMsgN -> AttrLine renderRepetition (RepMsgN s 0) = msgLine s renderRepetition (RepMsgN s 1) = msgLine s renderRepetition (RepMsgN s n) = msgLine s ++ stringToAL ("") anyInReport :: (MsgClass -> Bool) -> Report -> Bool anyInReport f (Report xns) = any (f . msgClass . repMsg) xns -- * History -- | The history of reports. This is a ring buffer of the given length -- containing old archived history and two most recent reports stored -- separately. data History = History { newReport :: Report , newTime :: Time , oldReport :: Report , oldTime :: Time , archivedHistory :: RB.RingBuffer UAttrLine } deriving (Show, Generic) instance Binary History -- | Empty history of the given maximal length. emptyHistory :: Int -> History emptyHistory size = let ringBufferSize = size - 1 -- a report resides outside the buffer in History emptyReport timeZero emptyReport timeZero (RB.empty ringBufferSize U.empty) scrapRepetition :: History -> Maybe History scrapRepetition History{ newReport = Report newMsgs , oldReport = Report oldMsgs , .. } = case newMsgs of -- We take into account only first message of the new report, -- because others were deduplicated as they were added. -- We keep the message in the new report, because it should not -- vanish from the screen. In this way the message may be passed -- along many reports. RepMsgN s1 n1 : rest1 -> let commutative s = not $ bindsPronouns $ msgClass s f (RepMsgN s2 _) = msgLine s1 == msgLine s2 in case break f rest1 of (_, []) | commutative s1 -> case break f oldMsgs of (noDup, RepMsgN s2 n2 : rest2) -> -- We keep the occurence of the message in the new report only. let newReport = Report $ RepMsgN s2 (n1 + n2) : rest1 oldReport = Report $ noDup ++ rest2 in Just History{..} _ -> Nothing (noDup, RepMsgN s2 n2 : rest2) | commutative s1 || all (commutative . repMsg) noDup -> -- We keep the older (and so, oldest) occurence of the message, -- to avoid visual disruption by moving the message around. let newReport = Report $ noDup ++ RepMsgN s2 (n1 + n2) : rest2 oldReport = Report oldMsgs in Just History{..} _ -> Nothing _ -> Nothing -- empty new report -- | Add a message to the new report of history, eliminating a possible -- duplicate and noting its existence in the result. addToReport :: History -> Msg -> Int -> Time -> (History, Bool) addToReport History{..} msg n time = let newH = History{newReport = snocReport newReport msg n, newTime = time, ..} in case scrapRepetition newH of Just scrappedH -> (scrappedH, True) Nothing -> (newH, False) -- | Archive old report to history, filtering out messages with 0 duplicates -- and prompts. Set up new report with a new timestamp. archiveReport :: History -> History archiveReport History{newReport=Report newMsgs, ..} = let f (RepMsgN _ n) = n > 0 newReportNon0 = Report $ filter f newMsgs in if nullReport newReportNon0 then -- Drop empty new report. History emptyReport timeZero oldReport oldTime archivedHistory else let lU = map attrLineToU $ renderTimeReport oldTime oldReport in History emptyReport timeZero newReportNon0 newTime $ foldl' (\ !h !v -> RB.cons v h) archivedHistory (reverse lU) renderTimeReport :: Time -> Report -> [AttrLine] renderTimeReport !t (Report r) = let turns = t `timeFitUp` timeTurn rep = Report $ filter (isSavedToHistory . msgClass . repMsg) r in if nullReport rep then [] else [stringToAL (show turns ++ ": ") ++ renderReport rep] lengthHistory :: History -> Int lengthHistory History{oldReport, archivedHistory} = RB.length archivedHistory + length (renderTimeReport timeZero oldReport) -- matches @renderHistory@ -- | Render history as many lines of text. New report is not rendered. -- It's expected to be empty when history is shown. renderHistory :: History -> [AttrLine] renderHistory History{..} = map uToAttrLine (RB.toList archivedHistory) ++ renderTimeReport oldTime oldReport LambdaHack-0.9.5.0/engine-src/Game/LambdaHack/Client/UI/MsgM.hs0000644000000000000000000001074307346545000021634 0ustar0000000000000000-- | Monadic operations on game messages. module Game.LambdaHack.Client.UI.MsgM ( msgAddDuplicate, msgAdd, msgAdd0, promptAdd, promptAdd0 , promptMainKeys, recordHistory ) where import Prelude () import Game.LambdaHack.Core.Prelude import qualified Data.EnumMap.Strict as EM import Game.LambdaHack.Client.MonadClient import Game.LambdaHack.Client.State import qualified Game.LambdaHack.Client.UI.HumanCmd as HumanCmd import qualified Game.LambdaHack.Client.UI.Key as K import Game.LambdaHack.Client.UI.MonadClientUI import Game.LambdaHack.Client.UI.Msg import Game.LambdaHack.Client.UI.SessionUI import Game.LambdaHack.Client.UI.UIOptions import Game.LambdaHack.Common.ActorState import Game.LambdaHack.Common.MonadStateRead import Game.LambdaHack.Common.State import Game.LambdaHack.Definition.Defs -- | Add a message to the current report. msgAddDuplicate :: MonadClientUI m => Text -> MsgClass -> Int -> m Bool msgAddDuplicate msg msgClass n = do sUIOptions <- getsSession sUIOptions time <- getsState stime history <- getsSession shistory let mem = EM.fromList <$> uMessageColors sUIOptions (nhistory, duplicate) = addToReport history (toMsg mem msgClass msg) n time modifySession $ \sess -> sess {shistory = nhistory} return duplicate -- | Add a message to the current report. Do not report if it was a duplicate. msgAdd :: MonadClientUI m => MsgClass -> Text -> m () msgAdd msgClass msg = void $ msgAddDuplicate msg msgClass 1 -- | Add a message to the current report with 0 copies for the purpose -- of collating duplicates. Do not report if it was a duplicate. msgAdd0 :: MonadClientUI m => MsgClass -> Text -> m () msgAdd0 msgClass msg = void $ msgAddDuplicate msg msgClass 0 -- | Add a prompt to the current report. Do not report if it was a duplicate. promptAdd :: MonadClientUI m => Text -> m () promptAdd = msgAdd MsgAlert -- | Add a prompt to the current report with 0 copies for the purpose -- of collating duplicates. Do not report if it was a duplicate. promptAdd0 :: MonadClientUI m => Text -> m () promptAdd0 = msgAdd0 MsgPrompt -- | Add a prompt with basic keys description. promptMainKeys :: MonadClientUI m => m () promptMainKeys = do side <- getsClient sside ours <- getsState $ fidActorNotProjGlobalAssocs side revCmd <- revCmdMap let kmHelp = revCmd K.undefinedKM HumanCmd.Hint kmViewEqp = revCmd K.undefinedKM (HumanCmd.ChooseItemMenu (MStore CEqp)) kmItemEqp = revCmd K.undefinedKM (HumanCmd.MoveItem [CGround, CInv, CSha] CEqp Nothing False) kmXhairPointerFloor = revCmd K.undefinedKM HumanCmd.XhairPointerFloor saimMode <- getsSession saimMode UIOptions{uVi, uLaptop} <- getsSession sUIOptions xhair <- getsSession sxhair -- The silly "uk8o79jl" ordering of keys is chosen to match "hjklyubn", -- which the usual way of writing them. let moveKeys | uVi = "keypad or hjklyubn" | uLaptop = "keypad or uk8o79jl" | otherwise = "keypad" manyTeammates = length ours > 1 keepTab = if manyTeammates then "Keep TAB of teammates (S-TAB for other levels)." else "" describePos = if mmbIsNormal then "Describe map position with MMB." else "" viewEquip = if eqpKeysAreNormal then "View (E)quipment and (e)quip items." else "" moreHelp = "Press" <+> tshow kmHelp <+> "for help." mmbIsNormal = kmXhairPointerFloor == K.middleButtonReleaseKM eqpKeysAreNormal = kmViewEqp == K.mkChar 'E' && kmItemEqp == K.mkChar 'e' keys | isNothing saimMode = "Explore with" <+> moveKeys <+> "keys or mouse." <+> describePos <+> viewEquip <+> keepTab <+> moreHelp | otherwise = tgtKindVerb xhair <+> "with" <+> moveKeys <+> "keys or mouse." <+> keepTab <+> moreHelp void $ promptAdd0 keys tgtKindVerb :: Maybe Target -> Text tgtKindVerb mtgt = case mtgt of Just TEnemy{} -> "Aim at enemy" Just TNonEnemy{} -> "Aim at non-enemy" Just TPoint{} -> "Aim at position" Just TVector{} -> "Indicate a move vector" Nothing -> "Start aiming" -- | Store new report in the history and archive old report. recordHistory :: MonadClientUI m => m () recordHistory = modifySession $ \sess -> sess {shistory = archiveReport $ shistory sess} LambdaHack-0.9.5.0/engine-src/Game/LambdaHack/Client/UI/Overlay.hs0000644000000000000000000001113407346545000022405 0ustar0000000000000000{-# LANGUAGE RankNTypes #-} -- | Screen overlays. module Game.LambdaHack.Client.UI.Overlay ( -- * AttrLine AttrLine, emptyAttrLine, textToAL, textFgToAL, stringToAL, (<+:>) -- * Overlay , Overlay, IntOverlay , splitAttrLine, indentSplitAttrLine, glueLines, updateLines -- * Misc , ColorMode(..) #ifdef EXPOSE_INTERNAL -- * Internal operations , linesAttr, splitAttrPhrase #endif ) where import Prelude () import Game.LambdaHack.Core.Prelude import qualified Data.Text as T import qualified Game.LambdaHack.Definition.Color as Color import Game.LambdaHack.Definition.Defs -- * AttrLine -- | Line of colourful text. type AttrLine = [Color.AttrCharW32] emptyAttrLine :: Int -> AttrLine emptyAttrLine w = replicate w Color.spaceAttrW32 textToAL :: Text -> AttrLine textToAL !t = let f c l = let !ac = Color.attrChar1ToW32 c in ac : l in T.foldr f [] t textFgToAL :: Color.Color -> Text -> AttrLine textFgToAL !fg !t = let f ' ' l = Color.spaceAttrW32 : l -- for speed and simplicity we always keep the space @White@ f c l = let !ac = Color.attrChar2ToW32 fg c in ac : l in T.foldr f [] t stringToAL :: String -> AttrLine stringToAL = map Color.attrChar1ToW32 infixr 6 <+:> -- matches Monoid.<> (<+:>) :: AttrLine -> AttrLine -> AttrLine (<+:>) [] l2 = l2 (<+:>) l1 [] = l1 (<+:>) l1 l2 = l1 ++ [Color.spaceAttrW32] ++ l2 -- * Overlay -- | A series of screen lines that either fit the width of the screen -- or are intended for truncation when displayed. The length of overlay -- may exceed the length of the screen, unlike in @SingleFrame@. -- An exception is lines generated from animation, which have to fit -- in either dimension. type Overlay = [AttrLine] -- | Sparse screen overlay representation where only the indicated rows -- are overlayed and the remaining rows are kept unchanged. type IntOverlay = [(Int, AttrLine)] -- | Split a string into lines. Avoids ending the line with -- a character other than space. Space characters are removed -- from the start, but never from the end of lines. Newlines are respected. -- -- Note that we only split wrt @White@ space, nothing else. splitAttrLine :: X -> AttrLine -> Overlay splitAttrLine w l = concatMap (splitAttrPhrase w . dropWhile (== Color.spaceAttrW32)) $ linesAttr l indentSplitAttrLine :: X -> AttrLine -> [AttrLine] indentSplitAttrLine w l = -- First line could be split at @w@, not @w - 1@, but it's good enough. let ts = splitAttrLine (w - 1) l in case ts of [] -> [] hd : tl -> hd : map ([Color.spaceAttrW32] ++) tl linesAttr :: AttrLine -> Overlay linesAttr l | null l = [] | otherwise = h : if null t then [] else linesAttr (tail t) where (h, t) = span (/= Color.retAttrW32) l -- We consider only these, because they are short and form a closed category. nonbreakableRev :: [AttrLine] nonbreakableRev = map stringToAL ["eht", "a", "na", "ehT", "A", "nA"] breakAtSpace :: AttrLine -> (AttrLine, AttrLine) breakAtSpace lRev = let (pre, post) = break (== Color.spaceAttrW32) lRev in case post of c : rest | c == Color.spaceAttrW32 -> if any (`isPrefixOf` rest) nonbreakableRev then let (pre2, post2) = breakAtSpace rest in (pre ++ c : pre2, post2) else (pre, post) _ -> (pre, post) -- no space found, give up splitAttrPhrase :: X -> AttrLine -> Overlay splitAttrPhrase w xs | w >= length xs = [xs] -- no problem, everything fits | otherwise = let (pre, postRaw) = splitAt w xs preRev = reverse pre ((ppre, ppost), post) = case postRaw of c : rest | c == Color.spaceAttrW32 && not (any (`isPrefixOf` preRev) nonbreakableRev) -> (([], preRev), rest) _ -> (breakAtSpace preRev, postRaw) testPost = dropWhileEnd (== Color.spaceAttrW32) ppost in if null testPost then pre : splitAttrPhrase w post else reverse ppost : splitAttrPhrase w (reverse ppre ++ post) glueLines :: Overlay -> Overlay -> Overlay glueLines ov1 ov2 = reverse $ glue (reverse ov1) ov2 where glue [] l = l glue m [] = m glue (mh : mt) (lh : lt) = reverse lt ++ (mh <+:> lh) : mt -- @f@ should not enlarge the line beyond screen width. updateLines :: Int -> (AttrLine -> AttrLine) -> Overlay -> Overlay updateLines n f ov = let upd k (l : ls) = if k == 0 then f l : ls else l : upd (k - 1) ls upd _ [] = [] in upd n ov -- * Misc -- | Color mode for the display. data ColorMode = ColorFull -- ^ normal, with full colours | ColorBW -- ^ black and white only deriving Eq LambdaHack-0.9.5.0/engine-src/Game/LambdaHack/Client/UI/RunM.hs0000644000000000000000000003147707346545000021661 0ustar0000000000000000{-# LANGUAGE RankNTypes #-} -- | Running and disturbance. -- -- The general rule is: whatever is behind you (and so ignored previously), -- determines what you ignore moving forward. This is calcaulated -- separately for the tiles to the left, to the right and in the middle -- along the running direction. So, if you want to ignore something -- start running when you stand on it (or to the right or left, respectively) -- or by entering it (or passing to the right or left, respectively). -- -- Some things are never ignored, such as: enemies seen, imporant messages -- heard, solid tiles and actors in the way. module Game.LambdaHack.Client.UI.RunM ( continueRun #ifdef EXPOSE_INTERNAL -- * Internal operations , continueRunDir, walkableDir, tryTurning, checkAndRun #endif ) where import Prelude () import Game.LambdaHack.Core.Prelude import qualified Data.EnumMap.Strict as EM import GHC.Exts (inline) import Game.LambdaHack.Client.CommonM import Game.LambdaHack.Client.MonadClient import Game.LambdaHack.Client.Request import Game.LambdaHack.Client.State import Game.LambdaHack.Client.UI.MonadClientUI import Game.LambdaHack.Client.UI.Msg import Game.LambdaHack.Client.UI.SessionUI import Game.LambdaHack.Common.Actor import Game.LambdaHack.Common.ActorState import Game.LambdaHack.Common.Faction import Game.LambdaHack.Common.Kind import Game.LambdaHack.Common.Level import Game.LambdaHack.Common.MonadStateRead import Game.LambdaHack.Common.State import qualified Game.LambdaHack.Common.Tile as Tile import Game.LambdaHack.Common.Types import Game.LambdaHack.Common.Vector import Game.LambdaHack.Content.TileKind (TileKind) import Game.LambdaHack.Common.Point import qualified Game.LambdaHack.Definition.Ability as Ability import Game.LambdaHack.Definition.Defs -- | Continue running in the given direction. continueRun :: MonadClientUI m => LevelId -> RunParams -> m (Either Text RequestTimed) continueRun arena paramOld = case paramOld of RunParams{ runMembers = [] , runStopMsg = Just stopMsg } -> return $ Left stopMsg RunParams{ runMembers = [] , runStopMsg = Nothing } -> return $ Left "selected actors no longer there" RunParams{ runLeader , runMembers = r : rs , runInitial , runStopMsg } -> do -- If runInitial and r == runLeader, it means the leader moves -- again, after all other members, in step 0, -- so we call continueRunDir with True to change direction once -- and then unset runInitial. let runInitialNew = runInitial && r /= runLeader paramIni = paramOld {runInitial = runInitialNew} onLevel <- getsState $ memActor r arena onLevelLeader <- getsState $ memActor runLeader arena if | not onLevel -> do let paramNew = paramIni {runMembers = rs } continueRun arena paramNew | not onLevelLeader -> do let paramNew = paramIni {runLeader = r} continueRun arena paramNew | otherwise -> do mdirOrRunStopMsgCurrent <- continueRunDir paramOld let runStopMsgCurrent = either Just (const Nothing) mdirOrRunStopMsgCurrent runStopMsgNew = runStopMsg `mplus` runStopMsgCurrent -- We check @runStopMsgNew@, because even if the current actor -- runs OK, we want to stop soon if some others had to stop. runMembersNew = if isJust runStopMsgNew then rs else rs ++ [r] paramNew = paramIni { runMembers = runMembersNew , runStopMsg = runStopMsgNew } case mdirOrRunStopMsgCurrent of Left _ -> continueRun arena paramNew -- run all others undisturbed; one time Right dir -> do updateClientLeader r modifySession $ \sess -> sess {srunning = Just paramNew} return $ Right $ ReqMove dir -- The potential invisible actor is hit. War is started without asking. -- | This function implements the actual logic of running. It checks if we -- have to stop running because something interesting cropped up, -- it ajusts the direction given by the vector if we reached -- a corridor's corner (we never change direction except in corridors) -- and it increments the counter of traversed tiles. -- -- Note that while goto-xhair commands ignore items on the way, -- here we stop wnenever we touch an item. Running is more cautious -- to compensate that the player cannot specify the end-point of running. -- It's also more suited to open, already explored terrain. Goto-xhair -- works better with unknown terrain, e.g., it stops whenever an item -- is spotted, but then ignores the item, leaving it to the player -- to mark the item position as a goal of the next goto. continueRunDir :: MonadClientUI m => RunParams -> m (Either Text Vector) continueRunDir params = case params of RunParams{ runMembers = [] } -> error $ "" `showFailure` params RunParams{ runLeader , runMembers = aid : _ , runInitial } -> do report <- getsSession $ newReport . shistory let msgInterrupts = anyInReport interruptsRunning report if msgInterrupts then return $ Left "message shown" else do cops@COps{cotile} <- getsState scops rbody <- getsState $ getActorBody runLeader let rposHere = bpos rbody rposLast = fromMaybe (error $ "" `showFailure` (runLeader, rbody)) (boldpos rbody) -- Match run-leader dir, because we want runners to keep formation. dir = rposHere `vectorToFrom` rposLast body <- getsState $ getActorBody aid let lid = blid body lvl <- getLevel lid let posHere = bpos body posThere = posHere `shift` dir bigActorThere = occupiedBigLvl posThere lvl projsThere = occupiedProjLvl posThere lvl let openableLast = Tile.isOpenable cotile (lvl `at` (posHere `shift` dir)) check | bigActorThere = return $ Left "actor in the way" | projsThere = return $ Left "projectile in the way" -- don't displace actors, except with leader in step 0 | walkableDir cops lvl posHere dir = if runInitial && aid /= runLeader then return $ Right dir -- zeroth step always OK else checkAndRun aid dir | not (runInitial && aid == runLeader) = return $ Left "blocked" -- don't change direction, except in step 1 and by run-leader | openableLast = return $ Left "blocked by a closed door" -- the player may prefer to open the door | otherwise = -- Assume turning is permitted, because this is the start -- of the run, so the situation is mostly known to the player tryTurning aid check walkableDir :: COps -> Level -> Point -> Vector -> Bool walkableDir COps{coTileSpeedup} lvl spos dir = Tile.isWalkable coTileSpeedup $ lvl `at` (spos `shift` dir) tryTurning :: MonadClientRead m => ActorId -> m (Either Text Vector) tryTurning aid = do cops@COps{cotile} <- getsState scops body <- getsState $ getActorBody aid let lid = blid body lvl <- getLevel lid let posHere = bpos body posLast = fromMaybe (error $ "" `showFailure` (aid, body)) (boldpos body) dirLast = posHere `vectorToFrom` posLast let openableDir dir = Tile.isOpenable cotile (lvl `at` (posHere `shift` dir)) dirWalkable dir = walkableDir cops lvl posHere dir || openableDir dir dirNearby dir1 dir2 = euclidDistSqVector dir1 dir2 == 1 -- Distance 2 could be useful, but surprising even to apt players. dirSimilar dir = dirNearby dirLast dir && dirWalkable dir dirsSimilar = filter dirSimilar moves case dirsSimilar of [] -> return $ Left "dead end" d1 : ds | all (dirNearby d1) ds -> -- only one or two directions possible case sortOn (euclidDistSqVector dirLast) $ filter (walkableDir cops lvl posHere) $ d1 : ds of [] -> return $ Left "blocked and all similar directions are non-walkable" d : _ -> checkAndRun aid d _ -> return $ Left "blocked and many distant similar directions found" -- The direction is different than the original, if called from @tryTurning@ -- and the same if from @continueRunDir@. checkAndRun :: MonadClientRead m => ActorId -> Vector -> m (Either Text Vector) checkAndRun aid dir = do COps{coTileSpeedup} <- getsState scops actorSk <- currentSkillsClient aid actorMaxSkills <- getsState sactorMaxSkills body <- getsState $ getActorBody aid fact <- getsState $ (EM.! bfid body) . sfactionD smarkSuspect <- getsClient smarkSuspect let lid = blid body lvl <- getLevel lid actorD <- getsState sactorD let posHere = bpos body posHasItems pos = EM.member pos $ lfloor lvl posThere = posHere `shift` dir bigActorThere = occupiedBigLvl posThere lvl enemyThreatensThere = let f !p = case posToBigLvl p lvl of Nothing -> False Just aid2 -> g aid2 $ actorD EM.! aid2 g aid2 !b2 = inline isFoe (bfid body) fact (bfid b2) && actorCanMelee actorMaxSkills aid2 b2 && bhp b2 > 0 -- uncommon in any f $ vicinityUnsafe posThere projsThere = occupiedProjLvl posThere lvl let posLast = fromMaybe (error $ "" `showFailure` (aid, body)) (boldpos body) dirLast = posHere `vectorToFrom` posLast -- This is supposed to work on unit vectors --- diagonal, as well as, -- vertical and horizontal. anglePos :: Point -> Vector -> RadianAngle -> Point anglePos pos d angle = shift pos (rotate angle d) -- We assume the tiles have not changed since last running step. -- If they did, we don't care --- running should be stopped -- because of the change of nearby tiles then. -- We don't take into account the two tiles at the rear of last -- surroundings, because the actor may have come from there -- (via a diagonal move) and if so, he may be interested in such tiles. -- If he arrived directly from the right or left, he is responsible -- for starting the run further away, if he does not want to ignore -- such tiles as the ones he came from. tileLast = lvl `at` posLast tileHere = lvl `at` posHere tileThere = lvl `at` posThere leftPsLast = map (anglePos posHere dirLast) [pi/2, 3*pi/4] ++ map (anglePos posHere dir) [pi/2, 3*pi/4] rightPsLast = map (anglePos posHere dirLast) [-pi/2, -3*pi/4] ++ map (anglePos posHere dir) [-pi/2, -3*pi/4] leftForwardPosHere = anglePos posHere dir (pi/4) rightForwardPosHere = anglePos posHere dir (-pi/4) leftTilesLast = map (lvl `at`) leftPsLast rightTilesLast = map (lvl `at`) rightPsLast leftForwardTileHere = lvl `at` leftForwardPosHere rightForwardTileHere = lvl `at` rightForwardPosHere tilePropAt :: ContentId TileKind -> (Bool, Bool, Bool) tilePropAt tile = let suspect = smarkSuspect > 0 && Tile.isSuspect coTileSpeedup tile || smarkSuspect > 1 && Tile.isHideAs coTileSpeedup tile alterSkill = Ability.getSk Ability.SkAlter actorSk alterable = alterSkill >= Tile.alterMinSkill coTileSpeedup tile walkable = Tile.isWalkable coTileSpeedup tile in (suspect, alterable, walkable) terrainChangeMiddle = tilePropAt tileThere `notElem` map tilePropAt [tileLast, tileHere] terrainChangeLeft = tilePropAt leftForwardTileHere `notElem` map tilePropAt leftTilesLast terrainChangeRight = tilePropAt rightForwardTileHere `notElem` map tilePropAt rightTilesLast itemChangeLeft = posHasItems leftForwardPosHere `notElem` map posHasItems leftPsLast itemChangeRight = posHasItems rightForwardPosHere `notElem` map posHasItems rightPsLast check | bigActorThere = return $ Left "actor in the way" | enemyThreatensThere = return $ Left "enemy threatens the position" | projsThere = return $ Left "projectile in the way" -- Actor in possibly another direction tnan original. -- (e.g., called from @tryTurning@). | terrainChangeLeft = return $ Left "terrain change on the left" | terrainChangeRight = return $ Left "terrain change on the right" | itemChangeLeft = return $ Left "item change on the left" | itemChangeRight = return $ Left "item change on the right" | terrainChangeMiddle = return $ Left "terrain change in the middle" | otherwise = return $ Right dir check LambdaHack-0.9.5.0/engine-src/Game/LambdaHack/Client/UI/SessionUI.hs0000644000000000000000000002022107346545000022642 0ustar0000000000000000{-# LANGUAGE GeneralizedNewtypeDeriving #-} -- | The client UI session state. module Game.LambdaHack.Client.UI.SessionUI ( SessionUI(..), ItemDictUI, AimMode(..), RunParams(..), LastRecord(..) , HintMode(..) , emptySessionUI, toggleMarkVision, toggleMarkSmell, getActorUI ) where import Prelude () import Game.LambdaHack.Core.Prelude import Data.Binary import qualified Data.EnumMap.Strict as EM import qualified Data.EnumSet as ES import qualified Data.Map.Strict as M import Data.Time.Clock.POSIX import Game.LambdaHack.Client.State import Game.LambdaHack.Client.UI.ActorUI import Game.LambdaHack.Client.UI.ContentClientUI import Game.LambdaHack.Client.UI.Frontend import Game.LambdaHack.Client.UI.ItemSlot import qualified Game.LambdaHack.Client.UI.Key as K import Game.LambdaHack.Client.UI.Msg import Game.LambdaHack.Client.UI.UIOptions import Game.LambdaHack.Common.Point import Game.LambdaHack.Common.Time import Game.LambdaHack.Common.Types import Game.LambdaHack.Definition.Defs -- | The information that is used across a client playing session, -- including many consecutive games in a single session. -- Some of it is saved, some is reset when a new playing session starts. -- An important component is the frontend session. data SessionUI = SessionUI { sxhair :: Maybe Target -- ^ the common xhair , sactorUI :: ActorDictUI -- ^ assigned actor UI presentations , sitemUI :: ItemDictUI -- ^ assigned item first seen level , sslots :: ItemSlots -- ^ map from slots to items , slastItemMove :: Maybe (CStore, CStore) -- ^ last item move stores , schanF :: ChanFrontend -- ^ connection with the frontend , sccui :: CCUI -- ^ UI client content , sUIOptions :: UIOptions -- ^ UI options as set by the player , saimMode :: Maybe AimMode -- ^ aiming mode , sxhairMoused :: Bool -- ^ last mouse aiming not vacuus , sitemSel :: Maybe (ItemId, CStore, Bool) -- ^ selected item, if any, it's store and -- whether to override suitability check , sselected :: ES.EnumSet ActorId -- ^ the set of currently selected actors , srunning :: Maybe RunParams -- ^ parameters of the current run, if any , shistory :: History -- ^ history of messages , spointer :: Point -- ^ mouse pointer position , slastRecord :: LastRecord -- ^ state of key sequence recording , slastPlay :: [K.KM] -- ^ state of key sequence playback , slastLost :: ES.EnumSet ActorId -- ^ actors that just got out of sight , swaitTimes :: Int -- ^ player just waited this many times , swasAutomated :: Bool -- ^ the player just exited AI automation , smarkVision :: Bool -- ^ mark leader and party FOV , smarkSmell :: Bool -- ^ mark smell, if the leader can smell , smenuIxMap :: M.Map String Int -- ^ indices of last used menu items , sdisplayNeeded :: Bool -- ^ current level needs displaying , shintMode :: HintMode -- ^ how to show keys hints when no messages , sreportNull :: Bool -- ^ whether no report created last UI turn -- or the report wiped out from screen , sstart :: POSIXTime -- ^ this session start time , sgstart :: POSIXTime -- ^ this game start time , sallTime :: Time -- ^ clips from start of session -- to current game start , snframes :: Int -- ^ this game current frame count , sallNframes :: Int -- ^ frame count from start of session -- to current game start } type ItemDictUI = EM.EnumMap ItemId LevelId -- | Current aiming mode of a client. newtype AimMode = AimMode { aimLevelId :: LevelId } deriving (Show, Eq, Binary) -- | Parameters of the current run. data RunParams = RunParams { runLeader :: ActorId -- ^ the original leader from run start , runMembers :: [ActorId] -- ^ the list of actors that take part , runInitial :: Bool -- ^ initial run continuation by any -- run participant, including run leader , runStopMsg :: Maybe Text -- ^ message with the next stop reason , runWaiting :: Int -- ^ waiting for others to move out of the way } deriving (Show) -- | State of last recorded and currently being recorded key sequences. data LastRecord = LastRecord { currentKeys :: [K.KM] -- ^ accumulated keys of the current command , previousKeys :: [K.KM] -- ^ keys of the rest of the recorded command batch , freeSpace :: Int -- ^ space left for commands to record in this batch } data HintMode = HintAbsent | HintShown | HintWiped deriving (Eq, Enum, Bounded) emptySessionUI :: UIOptions -> SessionUI emptySessionUI sUIOptions = SessionUI { sxhair = Nothing , sactorUI = EM.empty , sitemUI = EM.empty , sslots = ItemSlots $ EM.fromAscList $ zip [minBound..maxBound] (repeat EM.empty) , slastItemMove = Nothing , schanF = ChanFrontend $ const $ error $ "emptySessionUI: ChanFrontend" `showFailure` () , sccui = emptyCCUI , sUIOptions , saimMode = Nothing , sxhairMoused = True , sitemSel = Nothing , sselected = ES.empty , srunning = Nothing , shistory = emptyHistory 0 , spointer = originPoint , slastRecord = LastRecord [] [] 0 , slastPlay = [] , slastLost = ES.empty , swaitTimes = 0 , swasAutomated = False , smarkVision = False , smarkSmell = True , smenuIxMap = M.singleton "main" (2 - 9) -- subtracting @initIx@ , sdisplayNeeded = False , sreportNull = True , shintMode = HintAbsent , sstart = 0 , sgstart = 0 , sallTime = timeZero , snframes = 0 , sallNframes = 0 } toggleMarkVision :: SessionUI -> SessionUI toggleMarkVision s@SessionUI{smarkVision} = s {smarkVision = not smarkVision} toggleMarkSmell :: SessionUI -> SessionUI toggleMarkSmell s@SessionUI{smarkSmell} = s {smarkSmell = not smarkSmell} getActorUI :: ActorId -> SessionUI -> ActorUI getActorUI aid sess = EM.findWithDefault (error $ "" `showFailure` (aid, sactorUI sess)) aid $ sactorUI sess instance Binary SessionUI where put SessionUI{..} = do put sxhair put sactorUI put sitemUI put sslots put sUIOptions put saimMode put sitemSel put sselected put srunning put shistory put smarkVision put smarkSmell put sdisplayNeeded get = do sxhair <- get sactorUI <- get sitemUI <- get sslots <- get sUIOptions <- get -- is overwritten ASAP, but useful for, e.g., crash debug saimMode <- get sitemSel <- get sselected <- get srunning <- get shistory <- get smarkVision <- get smarkSmell <- get sdisplayNeeded <- get let slastItemMove = Nothing schanF = ChanFrontend $ const $ error $ "Binary: ChanFrontend" `showFailure` () sccui = emptyCCUI sxhairMoused = True spointer = originPoint slastRecord = LastRecord [] [] 0 slastPlay = [] slastLost = ES.empty swaitTimes = 0 swasAutomated = False smenuIxMap = M.singleton "main" (2 - 9) -- subtracting @initIx@ sreportNull = True shintMode = HintAbsent sstart = 0 sgstart = 0 sallTime = timeZero snframes = 0 sallNframes = 0 return $! SessionUI{..} instance Binary RunParams where put RunParams{..} = do put runLeader put runMembers put runInitial put runStopMsg put runWaiting get = do runLeader <- get runMembers <- get runInitial <- get runStopMsg <- get runWaiting <- get return $! RunParams{..} LambdaHack-0.9.5.0/engine-src/Game/LambdaHack/Client/UI/Slideshow.hs0000644000000000000000000001570007346545000022730 0ustar0000000000000000-- | Slideshows. module Game.LambdaHack.Client.UI.Slideshow ( KYX, OKX, Slideshow(slideshow) , emptySlideshow, unsnoc, toSlideshow, menuToSlideshow , wrapOKX, splitOverlay, splitOKX, highSlideshow #ifdef EXPOSE_INTERNAL -- * Internal operations , moreMsg, endMsg, keysOKX, showTable, showNearbyScores #endif ) where import Prelude () import Game.LambdaHack.Core.Prelude import Data.Time.LocalTime import Game.LambdaHack.Client.UI.ItemSlot import qualified Game.LambdaHack.Client.UI.Key as K import Game.LambdaHack.Client.UI.Msg import Game.LambdaHack.Client.UI.Overlay import qualified Game.LambdaHack.Common.HighScore as HighScore import qualified Game.LambdaHack.Definition.Color as Color import Game.LambdaHack.Definition.Defs -- | A key or an item slot label at a given position on the screen. type KYX = (Either [K.KM] SlotChar, (Y, X, X)) -- | An Overlay of text with an associated list of keys or slots -- that activated when the specified screen position is pointed at. -- The list should be sorted wrt rows and then columns. type OKX = (Overlay, [KYX]) -- | A list of active screenfulls to be shown one after another. -- Each screenful has an independent numbering of rows and columns. newtype Slideshow = Slideshow {slideshow :: [OKX]} deriving (Show, Eq) emptySlideshow :: Slideshow emptySlideshow = Slideshow [] unsnoc :: Slideshow -> Maybe (Slideshow, OKX) unsnoc Slideshow{slideshow} = case reverse slideshow of [] -> Nothing okx : rest -> Just (Slideshow $ reverse rest, okx) toSlideshow :: [OKX] -> Slideshow toSlideshow okxs = Slideshow $ addFooters False okxsNotNull where okxFilter (ov, kyxs) = (ov, filter (either (not . null) (const True) . fst) kyxs) okxsNotNull = map okxFilter okxs addFooters _ [] = error $ "" `showFailure` okxsNotNull addFooters _ [(als, [])] = [( als ++ [stringToAL endMsg] , [(Left [K.safeSpaceKM], (length als, 0, 15))] )] addFooters False [(als, kxs)] = [(als, kxs)] addFooters True [(als, kxs)] = [( als ++ [stringToAL endMsg] , kxs ++ [(Left [K.safeSpaceKM], (length als, 0, 15))] )] addFooters _ ((als, kxs) : rest) = ( als ++ [stringToAL moreMsg] , kxs ++ [(Left [K.safeSpaceKM], (length als, 0, 8))] ) : addFooters True rest moreMsg :: String moreMsg = "--more-- " endMsg :: String endMsg = "--back to top-- " menuToSlideshow :: OKX -> Slideshow menuToSlideshow (als, kxs) = assert (not (null als || null kxs)) $ Slideshow [(als, kxs)] wrapOKX :: Y -> X -> X -> [(K.KM, String)] -> OKX wrapOKX ystart xstart xBound ks = let f ((y, x), (kL, kV, kX)) (key, s) = let len = length s in if x + len > xBound then f ((y + 1, 0), ([], kL : kV, kX)) (key, s) else ( (y, x + len + 1) , (s : kL, kV, (Left [key], (y, x, x + len)) : kX) ) (kL1, kV1, kX1) = snd $ foldl' f ((ystart, xstart), ([], [], [])) ks catL = stringToAL . intercalate " " . reverse in (reverse $ map catL $ kL1 : kV1, reverse kX1) keysOKX :: Y -> X -> X -> [K.KM] -> OKX keysOKX ystart xstart xBound keys = let wrapB :: String -> String wrapB s = "[" ++ s ++ "]" ks = map (\key -> (key, wrapB $ K.showKM key)) keys in wrapOKX ystart xstart xBound ks splitOverlay :: X -> Y -> Report -> [K.KM] -> OKX -> Slideshow splitOverlay width height report keys (ls0, kxs0) = toSlideshow $ splitOKX width height (renderReport report) keys (ls0, kxs0) -- Note that we only split wrt @White@ space, nothing else. splitOKX :: X -> Y -> AttrLine -> [K.KM] -> OKX -> [OKX] splitOKX width height rrep keys (ls0, kxs0) = assert (height > 2) $ -- and kxs0 is sorted let msgRaw = splitAttrLine width rrep (lX0, keysX0) = keysOKX 0 0 maxBound keys (lX, keysX) | null msgRaw = (lX0, keysX0) | otherwise = keysOKX (length msgRaw - 1) (length (last msgRaw) + 1) width keys msgOkx = (glueLines msgRaw lX, keysX) ((lsInit, kxsInit), (header, rkxs)) = -- Check whether most space taken by report and keys. if length (glueLines msgRaw lX0) * 2 > height then (msgOkx, ( [intercalate [Color.spaceAttrW32] lX0 <+:> rrep] , keysX0 )) -- will display "$" (unless has EOLs) else (([], []), msgOkx) renumber y (km, (y0, x1, x2)) = (km, (y0 + y, x1, x2)) splitO yoffset (hdr, rk) (ls, kxs) = let zipRenumber = map $ renumber $ length hdr - yoffset (pre, post) = splitAt (height - 1) $ hdr ++ ls yoffsetNew = yoffset + height - length hdr - 1 in if null post then [(pre, rk ++ zipRenumber kxs)] -- all fits on one screen else let (preX, postX) = break (\(_, (y1, _, _)) -> y1 >= yoffsetNew) kxs in (pre, rk ++ zipRenumber preX) : splitO yoffsetNew (hdr, rk) (post, postX) initSlides = if null lsInit then assert (null kxsInit) [] else splitO 0 ([], []) (lsInit, kxsInit) mainSlides = if null ls0 && not (null lsInit) then assert (null kxs0) [] else splitO 0 (header, rkxs) (ls0, kxs0) in initSlides ++ mainSlides -- | Generate a slideshow with the current and previous scores. highSlideshow :: X -- ^ width of the display area -> Y -- ^ height of the display area -> HighScore.ScoreTable -- ^ current score table -> Int -- ^ position of the current score in the table -> Text -- ^ the name of the game mode -> TimeZone -- ^ the timezone where the game is run -> Slideshow highSlideshow width height table pos gameModeName tz = let entries = (height - 3) `div` 3 msg = HighScore.showAward entries table pos gameModeName tts = showNearbyScores tz pos table entries al = textToAL msg splitScreen ts = splitOKX width height al [K.spaceKM, K.escKM] (ts, []) in toSlideshow $ concat $ map splitScreen tts -- | Show a screenful of the high scores table. -- Parameter @entries@ is the number of (3-line) scores to be shown. showTable :: TimeZone -> Int -> HighScore.ScoreTable -> Int -> Int -> [AttrLine] showTable tz pos table start entries = let zipped = zip [1..] $ HighScore.unTable table screenful = take entries . drop (start - 1) $ zipped renderScore (pos1, score1) = map (if pos1 == pos then textFgToAL Color.BrWhite else textToAL) $ HighScore.showScore tz pos1 score1 in [] : intercalate [[]] (map renderScore screenful) -- | Produce a couple of renderings of the high scores table. showNearbyScores :: TimeZone -> Int -> HighScore.ScoreTable -> Int -> [[AttrLine]] showNearbyScores tz pos h entries = if pos <= entries then [showTable tz pos h 1 entries] else [showTable tz pos h 1 entries, showTable tz pos h (max (entries + 1) (pos - entries `div` 2)) entries] LambdaHack-0.9.5.0/engine-src/Game/LambdaHack/Client/UI/SlideshowM.hs0000644000000000000000000002720407346545000023047 0ustar0000000000000000-- | Monadic operations on slideshows and related data. module Game.LambdaHack.Client.UI.SlideshowM ( overlayToSlideshow, reportToSlideshow, reportToSlideshowKeep , displaySpaceEsc, displayMore, displayMoreKeep, displayYesNo, getConfirms , displayChoiceScreen ) where import Prelude () import Game.LambdaHack.Core.Prelude import Data.Either import qualified Data.Map.Strict as M import Game.LambdaHack.Client.UI.Content.Screen import Game.LambdaHack.Client.UI.ContentClientUI import Game.LambdaHack.Client.UI.FrameM import Game.LambdaHack.Client.UI.ItemSlot import qualified Game.LambdaHack.Client.UI.Key as K import Game.LambdaHack.Client.UI.MonadClientUI import Game.LambdaHack.Client.UI.MsgM import Game.LambdaHack.Client.UI.Overlay import Game.LambdaHack.Client.UI.SessionUI import Game.LambdaHack.Client.UI.Slideshow import Game.LambdaHack.Common.Point import qualified Game.LambdaHack.Definition.Color as Color import Game.LambdaHack.Definition.Defs -- | Add current report to the overlay, split the result and produce, -- possibly, many slides. overlayToSlideshow :: MonadClientUI m => Y -> [K.KM] -> OKX -> m Slideshow overlayToSlideshow y keys okx = do CCUI{coscreen=ScreenContent{rwidth}} <- getsSession sccui report <- getReportUI recordHistory -- report will be shown soon, remove it to history return $! splitOverlay rwidth y report keys okx -- | Split current report into a slideshow. reportToSlideshow :: MonadClientUI m => [K.KM] -> m Slideshow reportToSlideshow keys = do CCUI{coscreen=ScreenContent{rheight}} <- getsSession sccui overlayToSlideshow (rheight - 2) keys ([], []) -- | Split current report into a slideshow. Keep report unchanged. reportToSlideshowKeep :: MonadClientUI m => [K.KM] -> m Slideshow reportToSlideshowKeep keys = do CCUI{coscreen=ScreenContent{rwidth, rheight}} <- getsSession sccui report <- getReportUI -- Don't do @recordHistory@; the message is important, but related -- to the messages that come after, so should be shown together. return $! splitOverlay rwidth (rheight - 2) report keys ([], []) -- | Display a message. Return value indicates if the player wants to continue. -- Feature: if many pages, only the last SPACE exits (but first ESC). displaySpaceEsc :: MonadClientUI m => ColorMode -> Text -> m Bool displaySpaceEsc dm prompt = do promptAdd0 prompt -- Two frames drawn total (unless @prompt@ very long). slides <- reportToSlideshow [K.spaceKM, K.escKM] km <- getConfirms dm [K.spaceKM, K.escKM] slides return $! km == K.spaceKM -- | Display a message. Ignore keypresses. -- Feature: if many pages, only the last SPACE exits (but first ESC). displayMore :: MonadClientUI m => ColorMode -> Text -> m () displayMore dm prompt = do promptAdd0 prompt slides <- reportToSlideshow [K.spaceKM] void $ getConfirms dm [K.spaceKM, K.escKM] slides displayMoreKeep :: MonadClientUI m => ColorMode -> Text -> m () displayMoreKeep dm prompt = do promptAdd0 prompt slides <- reportToSlideshowKeep [K.spaceKM] void $ getConfirms dm [K.spaceKM, K.escKM] slides -- | Print a yes/no question and return the player's answer. Use black -- and white colours to turn player's attention to the choice. displayYesNo :: MonadClientUI m => ColorMode -> Text -> m Bool displayYesNo dm prompt = do promptAdd0 prompt let yn = map K.mkChar ['y', 'n'] slides <- reportToSlideshow yn km <- getConfirms dm (K.escKM : yn) slides return $! km == K.mkChar 'y' getConfirms :: MonadClientUI m => ColorMode -> [K.KM] -> Slideshow -> m K.KM getConfirms dm extraKeys slides = do ekm <- displayChoiceScreen "" dm False slides extraKeys return $! either id (error $ "" `showFailure` ekm) ekm -- | Display a, potentially, multi-screen menu and return the chosen -- key or item slot label (and the index in the whole menu so that the cursor -- can again be placed at that spot next time menu is displayed). -- -- This function is the only source of menus and so, effectively, UI modes. displayChoiceScreen :: forall m . MonadClientUI m => String -> ColorMode -> Bool -> Slideshow -> [K.KM] -> m (Either K.KM SlotChar) displayChoiceScreen menuName dm sfBlank frsX extraKeys = do let frs = slideshow frsX keys = concatMap (concatMap (either id (const []) . fst) . snd) frs ++ extraKeys !_A = assert (K.escKM `elem` extraKeys) () navigationKeys = [ K.leftButtonReleaseKM, K.rightButtonReleaseKM , K.returnKM, K.spaceKM , K.upKM, K.leftKM, K.downKM, K.rightKM , K.pgupKM, K.pgdnKM, K.wheelNorthKM, K.wheelSouthKM , K.homeKM, K.endKM, K.controlP ] legalKeys = keys ++ navigationKeys -- The arguments go from first menu line and menu page to the last, -- in order. Their indexing is from 0. We select the nearest item -- with the index equal or less to the pointer. findKYX :: Int -> [OKX] -> Maybe (OKX, KYX, Int) findKYX _ [] = Nothing findKYX pointer (okx@(_, kyxs) : frs2) = case drop pointer kyxs of [] -> -- not enough menu items on this page case findKYX (pointer - length kyxs) frs2 of Nothing -> -- no more menu items in later pages case reverse kyxs of [] -> Nothing kyx : _ -> Just (okx, kyx, length kyxs - 1) res -> res kyx : _ -> Just (okx, kyx, pointer) maxIx = length (concatMap snd frs) - 1 allOKX = concatMap snd frs initIx = case findIndex (isRight . fst) allOKX of Just p -> p _ -> 0 -- can't be @length allOKX@ or a multi-page item menu -- mangles saved index of other item munus clearIx = if initIx > maxIx then 0 else initIx page :: Int -> m (Either K.KM SlotChar, Int) page pointer = assert (pointer >= 0) $ case findKYX pointer frs of Nothing -> error $ "no menu keys" `showFailure` frs Just ((ov, kyxs), (ekm, (y, x1, x2)), ixOnPage) -> do let highableAttrs = [Color.defAttr, Color.defAttr {Color.fg = Color.BrBlack}] highAttr x | Color.acAttr x `notElem` highableAttrs = x highAttr x = x {Color.acAttr = (Color.acAttr x) {Color.fg = Color.BrWhite}} cursorAttr x = x {Color.acAttr = (Color.acAttr x) {Color.bg = Color.HighlightNoneCursor}} drawHighlight xs = let (xs1, xsRest) = splitAt x1 xs (xs2, xs3) = splitAt (x2 - x1) xsRest highW32 = Color.attrCharToW32 . highAttr . Color.attrCharFromW32 cursorW32 = Color.attrCharToW32 . cursorAttr . Color.attrCharFromW32 xs2High = case map highW32 xs2 of [] -> [] xh : xhrest -> cursorW32 xh : xhrest in xs1 ++ xs2High ++ xs3 ov1 = updateLines y drawHighlight ov ignoreKey = page pointer pageLen = length kyxs xix (_, (_, x1', _)) = x1' == x1 firstRowOfNextPage = pointer + pageLen - ixOnPage restOKX = drop firstRowOfNextPage allOKX firstItemOfNextPage = case findIndex (isRight . fst) restOKX of Just p -> p + firstRowOfNextPage _ -> firstRowOfNextPage interpretKey :: K.KM -> m (Either K.KM SlotChar, Int) interpretKey ikm = case K.key ikm of _ | ikm == K.controlP -> do -- Silent, because any prompt would be shown too late. printScreen ignoreKey K.Return -> case ekm of Left (km : _) -> if K.key km == K.Return && km `elem` keys then return (Left km, pointer) else interpretKey km Left [] -> error $ "" `showFailure` ikm Right c -> return (Right c, pointer) K.LeftButtonRelease -> do Point{..} <- getsSession spointer let onChoice (_, (cy, cx1, cx2)) = cy == py && cx1 <= px && cx2 > px case find onChoice kyxs of Nothing | ikm `elem` keys -> return (Left ikm, pointer) Nothing -> if K.spaceKM `elem` keys then return (Left K.spaceKM, pointer) else ignoreKey Just (ckm, _) -> case ckm of Left (km : _) -> if K.key km == K.Return && km `elem` keys then return (Left km, pointer) else interpretKey km Left [] -> error $ "" `showFailure` ikm Right c -> return (Right c, pointer) K.RightButtonRelease -> if | ikm `elem` keys -> return (Left ikm, pointer) | K.escKM `elem` keys -> return (Left K.escKM, pointer) | otherwise -> ignoreKey K.Space | firstItemOfNextPage <= maxIx -> page firstItemOfNextPage K.Unknown "SAFE_SPACE" -> if firstItemOfNextPage <= maxIx then page firstItemOfNextPage else page clearIx _ | ikm `elem` keys -> return (Left ikm, pointer) K.Up -> case findIndex xix $ reverse $ take ixOnPage kyxs of Nothing -> interpretKey ikm{K.key=K.Left} Just ix -> page (max 0 (pointer - ix - 1)) K.Left -> if pointer == 0 then page maxIx else page (max 0 (pointer - 1)) K.Down -> case findIndex xix $ drop (ixOnPage + 1) kyxs of Nothing -> interpretKey ikm{K.key=K.Right} Just ix -> page (pointer + ix + 1) K.Right -> if pointer == maxIx then page 0 else page (min maxIx (pointer + 1)) K.Home -> page clearIx K.End -> page maxIx _ | K.key ikm `elem` [K.PgUp, K.WheelNorth] -> page (max 0 (pointer - ixOnPage - 1)) _ | K.key ikm `elem` [K.PgDn, K.WheelSouth] -> page (min maxIx firstItemOfNextPage) K.Space -> if pointer == maxIx then page clearIx else page maxIx _ -> error $ "unknown key" `showFailure` ikm pkm <- promptGetKey dm ov1 sfBlank legalKeys interpretKey pkm menuIxMap <- getsSession smenuIxMap -- Beware, values in @menuIxMap@ may be negative (meaning: a key, not slot). let menuIx | menuName == "" = clearIx | otherwise = maybe clearIx (+ initIx) (M.lookup menuName menuIxMap) -- this may be negative, from different context (km, pointer) <- if null frs then return (Left K.escKM, menuIx) else page $ max clearIx $ min maxIx menuIx -- the saved index could be from different context unless (menuName == "") $ modifySession $ \sess -> sess {smenuIxMap = M.insert menuName (pointer - initIx) menuIxMap} assert (either (`elem` keys) (const True) km) $ return km LambdaHack-0.9.5.0/engine-src/Game/LambdaHack/Client/UI/UIOptions.hs0000644000000000000000000000257607346545000022667 0ustar0000000000000000{-# LANGUAGE DeriveGeneric #-} -- | UI client options. module Game.LambdaHack.Client.UI.UIOptions ( UIOptions(..) ) where import Prelude () import Game.LambdaHack.Core.Prelude import Control.DeepSeq import Data.Binary import GHC.Generics (Generic) import Game.LambdaHack.Client.UI.HumanCmd import qualified Game.LambdaHack.Client.UI.Key as K import Game.LambdaHack.Client.UI.Msg import qualified Game.LambdaHack.Definition.Color as Color -- | Options that affect the UI of the client. data UIOptions = UIOptions { -- commands uCommands :: [(K.KM, CmdTriple)] -- hero names , uHeroNames :: [(Int, (Text, Text))] -- ui , uVi :: Bool -- ^ the option for Vi keys takes precendence , uLaptop :: Bool -- ^ because the laptop keys are the default , uGtkFontFamily :: Text , uSdlFontFile :: Text , uSdlScalableSizeAdd :: Int , uSdlBitmapSizeAdd :: Int , uScalableFontSize :: Int , uHistoryMax :: Int , uMaxFps :: Int , uNoAnim :: Bool , uhpWarningPercent :: Int -- ^ HP percent at which warning is emitted. , uMessageColors :: Maybe [(MsgClass, Color.Color)] , uCmdline :: [String] -- ^ Hardwired commandline arguments to process. } deriving (Show, Generic) instance NFData UIOptions instance Binary UIOptions LambdaHack-0.9.5.0/engine-src/Game/LambdaHack/Client/UI/UIOptionsParse.hs0000644000000000000000000001276007346545000023656 0ustar0000000000000000-- | UI client options. module Game.LambdaHack.Client.UI.UIOptionsParse ( mkUIOptions, applyUIOptions #ifdef EXPOSE_INTERNAL -- * Internal operations , configError, readError, parseConfig #endif ) where import Prelude () import Game.LambdaHack.Core.Prelude import Control.DeepSeq import qualified Data.Ini as Ini import qualified Data.Ini.Reader as Ini import qualified Data.Ini.Types as Ini import qualified Data.Map.Strict as M import System.FilePath import Text.Read import Game.LambdaHack.Client.ClientOptions import Game.LambdaHack.Client.UI.HumanCmd import qualified Game.LambdaHack.Client.UI.Key as K import Game.LambdaHack.Client.UI.UIOptions import Game.LambdaHack.Common.File import Game.LambdaHack.Common.Kind import Game.LambdaHack.Common.Misc import Game.LambdaHack.Content.RuleKind configError :: String -> a configError err = error $ "Error when parsing configuration file. Please fix config.ui.ini or remove it altogether. The details:\n" ++ err readError :: Read a => String -> a readError = either (configError . ("when reading a value" `showFailure`)) id . readEither parseConfig :: Ini.Config -> UIOptions parseConfig cfg = let uCommands = let mkCommand (ident, keydef) = case stripPrefix "Cmd_" ident of Just _ -> let (key, def) = readError keydef in (K.mkKM key, def :: CmdTriple) Nothing -> configError $ "wrong macro id" `showFailure` ident section = Ini.allItems "additional_commands" cfg in map mkCommand section uHeroNames = let toNumber (ident, nameAndPronoun) = case stripPrefix "HeroName_" ident of Just n -> (readError n, readError nameAndPronoun) Nothing -> configError $ "wrong hero name id" `showFailure` ident section = Ini.allItems "hero_names" cfg in map toNumber section lookupFail :: forall b. String -> String -> b lookupFail optionName err = configError $ "config file access failed" `showFailure` (err, optionName, cfg) getOptionMaybe :: forall a. Read a => String -> Maybe a getOptionMaybe optionName = let ms = Ini.getOption "ui" optionName cfg in either (lookupFail optionName) id . readEither <$> ms getOption :: forall a. Read a => String -> a getOption optionName = let s = fromMaybe (lookupFail optionName "") $ Ini.getOption "ui" optionName cfg in either (lookupFail optionName) id $ readEither s uVi = getOption "movementViKeys_hjklyubn" -- The option for Vi keys takes precendence, -- because the laptop keys are the default. uLaptop = not uVi && getOption "movementLaptopKeys_uk8o79jl" uGtkFontFamily = getOption "gtkFontFamily" uSdlFontFile = getOption "sdlFontFile" uSdlScalableSizeAdd = getOption "sdlScalableSizeAdd" uSdlBitmapSizeAdd = getOption "sdlBitmapSizeAdd" uScalableFontSize = getOption "scalableFontSize" #ifdef USE_JSFILE -- Local storage quota exeeded on Chrome. uHistoryMax = getOption "historyMax" `div` 10 #else uHistoryMax = getOption "historyMax" #endif uMaxFps = max 1 $ getOption "maxFps" uNoAnim = getOption "noAnim" uhpWarningPercent = getOption "hpWarningPercent" uMessageColors = getOptionMaybe "messageColors" uCmdline = words $ getOption "overrideCmdline" in UIOptions{..} -- | Read and parse UI config file. mkUIOptions :: COps -> Bool -> IO UIOptions mkUIOptions COps{corule} benchmark = do let cfgUIName = rcfgUIName corule sUIDefault = rcfgUIDefault corule cfgUIDefault = either (configError . ("Ini.parse sUIDefault" `showFailure`)) id $ Ini.parse sUIDefault dataDir <- appDataDir let userPath = dataDir cfgUIName cfgUser <- if benchmark then return Ini.emptyConfig else do cpExists <- doesFileExist userPath if not cpExists then return Ini.emptyConfig else do sUser <- readFile userPath return $! either (configError . ("Ini.parse sUser" `showFailure`)) id $ Ini.parse sUser let cfgUI = M.unionWith M.union cfgUser cfgUIDefault -- user cfg preferred conf = parseConfig cfgUI -- Catch syntax errors in complex expressions ASAP. return $! deepseq conf conf -- | Modify client options with UI options. applyUIOptions :: COps -> UIOptions -> ClientOptions -> ClientOptions applyUIOptions COps{corule} uioptions soptions = (\opts -> opts {sgtkFontFamily = sgtkFontFamily opts `mplus` Just (uGtkFontFamily uioptions)}) . (\opts -> opts {sdlFontFile = sdlFontFile opts `mplus` Just (uSdlFontFile uioptions)}) . (\opts -> opts {sdlScalableSizeAdd = sdlScalableSizeAdd opts `mplus` Just (uSdlScalableSizeAdd uioptions)}) . (\opts -> opts {sdlBitmapSizeAdd = sdlBitmapSizeAdd opts `mplus` Just (uSdlBitmapSizeAdd uioptions)}) . (\opts -> opts {sscalableFontSize = sscalableFontSize opts `mplus` Just (uScalableFontSize uioptions)}) . (\opts -> opts {smaxFps = smaxFps opts `mplus` Just (uMaxFps uioptions)}) . (\opts -> opts {snoAnim = snoAnim opts `mplus` Just (uNoAnim uioptions)}) . (\opts -> opts {stitle = stitle opts `mplus` Just (rtitle corule)}) . (\opts -> opts {sfontDir = sfontDir opts `mplus` Just (rfontDir corule)}) $ soptions LambdaHack-0.9.5.0/engine-src/Game/LambdaHack/Common/0000755000000000000000000000000007346545000020125 5ustar0000000000000000LambdaHack-0.9.5.0/engine-src/Game/LambdaHack/Common/Actor.hs0000644000000000000000000002152207346545000021533 0ustar0000000000000000{-# LANGUAGE DeriveGeneric #-} -- | Actors in the game: heroes, monsters, etc. module Game.LambdaHack.Common.Actor ( -- * The@ Acto@r type, its components and operations on them Actor(..), ResDelta(..), ActorMaxSkills, Watchfulness(..) , deltasSerious, deltasHears, deltaBenign, deltaWasBenign, actorCanMelee , gearSpeed, actorTemplate, actorWaits, actorWaitsOrSleeps, actorDying , hpTooLow, calmEnough, hpEnough, hpFull, canSleep, prefersSleep , checkAdjacent, eqpOverfull, eqpFreeN -- * Assorted , ActorDict, monsterGenChance, smellTimeout ) where import Prelude () import Game.LambdaHack.Core.Prelude import Data.Binary import qualified Data.EnumMap.Strict as EM import Data.Int (Int64) import Data.Ratio import GHC.Generics (Generic) import qualified Game.LambdaHack.Definition.Ability as Ability import qualified Game.LambdaHack.Core.Dice as Dice import Game.LambdaHack.Common.Item import Game.LambdaHack.Common.Misc import Game.LambdaHack.Common.Point import Game.LambdaHack.Core.Random import Game.LambdaHack.Common.Time import Game.LambdaHack.Common.Types import Game.LambdaHack.Common.Vector -- | Actor attributes that are changing throughout the game. -- If they appear to be dublets of aspects from actor kinds, e.g. HP, -- they may be results of casting the dice specified in their respective -- actor kind and/or may be modified temporarily, but return -- to the original value from their respective kind over time. -- -- Other properties of an actor, in particular its current aspects, -- are derived from the actor's trunk, organs and equipment. -- A class of the aspects, the boolean ones, are called flags. -- Another class are skills. Stats are a subclass that determines -- if particular actions are permitted for the actor (or faction). data Actor = Actor { -- The trunk of the actor's body (present also in @borgan@ or @beqp@) btrunk :: ItemId -- ^ the trunk organ of the actor's body -- Resources , bhp :: Int64 -- ^ current hit points * 1M , bhpDelta :: ResDelta -- ^ HP delta this turn * 1M , bcalm :: Int64 -- ^ current calm * 1M , bcalmDelta :: ResDelta -- ^ calm delta this turn * 1M -- Location , bpos :: Point -- ^ current position , boldpos :: Maybe Point -- ^ previous position, if any , blid :: LevelId -- ^ current level , bfid :: FactionId -- ^ faction the actor currently belongs to , btrajectory :: Maybe ([Vector], Speed) -- ^ trajectory the actor must -- travel and his travel speed -- Items , borgan :: ItemBag -- ^ organs , beqp :: ItemBag -- ^ personal equipment , binv :: ItemBag -- ^ personal inventory pack , bweapon :: Int -- ^ number of weapons among eqp and organs -- Assorted , bwatch :: Watchfulness -- ^ state of the actor's watchfulness , bproj :: Bool -- ^ is a projectile? affects being able -- to fly through other projectiles, etc. } deriving (Show, Eq, Generic) instance Binary Actor -- | Representation of recent changes to HP of Calm of an actor. -- This is reset every time the actor perfoms an action, so this is -- aggregated over actor turn (move), not time turn. -- The resource changes recorded in the tuple are, respectively, -- negative and positive. data ResDelta = ResDelta { resCurrentTurn :: (Int64, Int64) -- ^ resource change this move , resPreviousTurn :: (Int64, Int64) -- ^ resource change previous move } deriving (Show, Eq, Generic) instance Binary ResDelta type ActorMaxSkills = EM.EnumMap ActorId Ability.Skills -- | All actors on the level, indexed by actor identifier. type ActorDict = EM.EnumMap ActorId Actor data Watchfulness = WWatch | WWait Int | WSleep | WWake deriving (Show, Eq, Generic) instance Binary Watchfulness deltasSerious :: ResDelta -> Bool deltasSerious ResDelta{..} = fst resCurrentTurn <= minusM2 || fst resPreviousTurn <= minusM2 deltasHears :: ResDelta -> Bool deltasHears ResDelta{..} = fst resCurrentTurn == minusM1 || fst resPreviousTurn == minusM1 deltaBenign :: ResDelta -> Bool deltaBenign ResDelta{resCurrentTurn} = fst resCurrentTurn >= 0 -- only the current one deltaWasBenign :: ResDelta -> Bool deltaWasBenign ResDelta{resPreviousTurn} = fst resPreviousTurn >= 0 -- only the previous one actorCanMelee :: ActorMaxSkills -> ActorId -> Actor -> Bool actorCanMelee actorMaxSkills aid b = let actorMaxSk = actorMaxSkills EM.! aid condUsableWeapon = bweapon b > 0 canMelee = Ability.getSk Ability.SkMelee actorMaxSk > 0 in condUsableWeapon && canMelee -- | The speed from organs and gear; being pushed is ignored. gearSpeed :: Ability.Skills -> Speed gearSpeed actorMaxSk = toSpeed $ max minSpeed (Ability.getSk Ability.SkSpeed actorMaxSk) -- see @minimalSpeed@ actorTemplate :: ItemId -> Int64 -> Int64 -> Point -> LevelId -> FactionId -> Bool -> Actor actorTemplate btrunk bhp bcalm bpos blid bfid bproj = let btrajectory = Nothing boldpos = Nothing borgan = EM.empty beqp = EM.empty binv = EM.empty bweapon = 0 bwatch = WWatch -- overriden elsewhere, sometimes bhpDelta = ResDelta (0, 0) (0, 0) bcalmDelta = ResDelta (0, 0) (0, 0) in Actor{..} actorWaits :: Actor -> Bool {-# INLINE actorWaits #-} actorWaits b = case bwatch b of WWait{} -> True _ -> False actorWaitsOrSleeps :: Actor -> Bool {-# INLINE actorWaitsOrSleeps #-} actorWaitsOrSleeps b = case bwatch b of WWait{} -> True WSleep -> True _ -> False actorDying :: Actor -> Bool actorDying b = bhp b <= 0 || bproj b && maybe True (null . fst) (btrajectory b) hpTooLow :: Actor -> Ability.Skills -> Bool hpTooLow b actorMaxSk = 5 * bhp b < xM (Ability.getSk Ability.SkMaxHP actorMaxSk) && bhp b <= xM 40 || bhp b <= oneM calmEnough :: Actor -> Ability.Skills -> Bool calmEnough b actorMaxSk = let calmMax = max 1 $ Ability.getSk Ability.SkMaxCalm actorMaxSk in 2 * xM calmMax <= 3 * bcalm b && bcalm b > xM 10 hpEnough :: Actor -> Ability.Skills -> Bool hpEnough b actorMaxSk = xM (Ability.getSk Ability.SkMaxHP actorMaxSk) <= 2 * bhp b && bhp b > oneM hpFull :: Actor -> Ability.Skills -> Bool hpFull b actorMaxSk = xM (Ability.getSk Ability.SkMaxHP actorMaxSk) <= bhp b -- | Has the skill and can wake up easily, so can sleep safely. canSleep :: Ability.Skills -> Bool canSleep actorMaxSk = Ability.getSk Ability.SkWait actorMaxSk >= 3 && (Ability.getSk Ability.SkSight actorMaxSk > 0 || Ability.getSk Ability.SkHearing actorMaxSk > 0) && Ability.getSk Ability.SkAggression actorMaxSk < 2 -- | Can't loot, so sometimes prefers to sleep instead of exploring. prefersSleep :: Ability.Skills -> Bool prefersSleep actorMaxSk = Ability.getSk Ability.SkMoveItem actorMaxSk <= 0 checkAdjacent :: Actor -> Actor -> Bool checkAdjacent sb tb = blid sb == blid tb && adjacent (bpos sb) (bpos tb) eqpOverfull :: Actor -> Int -> Bool eqpOverfull b n = let size = sum $ map fst $ EM.elems $ beqp b in assert (size <= 10 `blame` (b, n, size)) $ size + n > 10 eqpFreeN :: Actor -> Int eqpFreeN b = let size = sum $ map fst $ EM.elems $ beqp b in assert (size <= 10 `blame` (b, size)) $ 10 - size -- | Chance that a new monster is generated. Depends on the number -- of monsters already present, and on the level depth and its cave kind. monsterGenChance :: Dice.AbsDepth -> Dice.AbsDepth -> Int -> Int -> Rnd Bool monsterGenChance (Dice.AbsDepth ldepth) (Dice.AbsDepth totalDepth) lvlSpawned actorCoeff = assert (totalDepth > 0 && ldepth > 0) $ -- The sustained spawn speed is now trebled compared to the comment below, -- to compensate for some monsters generated asleep: -- -- Heroes have to endure a level depth-sized wave of immediate -- spawners for each level and only then the monsters start -- to trickle more and more slowly, at the speed dictated -- by @actorCoeff@ specified in cave kind. -- On level 1/10, first 4 monsters spawn immediately, at level 5/10, -- 8 spawn immediately. In general at level n, n+3 spawn at once. let scaledDepth = ldepth * 10 `div` totalDepth -- Never spawn too rarely so that camping is never safe. maxCoeff = 100 * 30 -- safe level after 30 spawns flattens out coeff = min maxCoeff $ actorCoeff * (lvlSpawned - scaledDepth - 2) in chance $ 3%fromIntegral (coeff `max` 1) -- 3 --- trebled -- | How long until an actor's smell vanishes from a tile. smellTimeout :: Delta Time smellTimeout = timeDeltaScale (Delta timeTurn) 200 LambdaHack-0.9.5.0/engine-src/Game/LambdaHack/Common/ActorState.hs0000644000000000000000000005165507346545000022546 0ustar0000000000000000{-# LANGUAGE TupleSections #-} -- | Operations on the 'Actor' type, and related, that need the 'State' type, -- but not our custom monad types. module Game.LambdaHack.Common.ActorState ( fidActorNotProjGlobalAssocs, actorAssocs, fidActorRegularAssocs , fidActorRegularIds, foeRegularAssocs, foeRegularList , friendRegularAssocs, friendRegularList, bagAssocs, bagAssocsK , posToBig, posToBigAssoc, posToProjs, posToProjAssocs , posToAids, posToAidAssocs , calculateTotal, itemPrice, mergeItemQuant, findIid , combinedGround, combinedOrgan, combinedEqp, combinedInv , combinedItems, combinedFromLore , getActorBody, getActorMaxSkills, actorCurrentSkills, canTraverse , getCarriedAssocsAndTrunk, getCarriedIidCStore, getContainerBag , getFloorBag, getEmbedBag, getBodyStoreBag , mapActorItems_, getActorAssocs, getActorAssocsK , memActor, getLocalTime, regenCalmDelta, actorInAmbient, canDeAmbientList , dispEnemy, itemToFull, fullAssocs, kitAssocs , getItemKindId, getIidKindId, getItemKind, getIidKind , getItemKindIdServer, getIidKindIdServer, getItemKindServer, getIidKindServer , lidFromC, posFromC, anyFoeAdj, adjacentBigAssocs, adjacentProjAssocs , armorHurtBonus, inMelee ) where import Prelude () import Game.LambdaHack.Core.Prelude import qualified Data.EnumMap.Strict as EM import qualified Data.EnumSet as ES import Data.Int (Int64) import GHC.Exts (inline) import Game.LambdaHack.Common.Actor import Game.LambdaHack.Common.Faction import Game.LambdaHack.Common.Item import Game.LambdaHack.Common.Kind import Game.LambdaHack.Common.Level import Game.LambdaHack.Common.Misc import Game.LambdaHack.Common.State import qualified Game.LambdaHack.Common.Tile as Tile import Game.LambdaHack.Common.Time import Game.LambdaHack.Common.Types import Game.LambdaHack.Common.Vector import qualified Game.LambdaHack.Content.ItemKind as IK import Game.LambdaHack.Content.ModeKind import qualified Game.LambdaHack.Content.TileKind as TK import Game.LambdaHack.Common.Point import qualified Game.LambdaHack.Definition.Ability as Ability import Game.LambdaHack.Definition.Defs fidActorNotProjGlobalAssocs :: FactionId -> State -> [(ActorId, Actor)] fidActorNotProjGlobalAssocs fid s = let f (_, b) = not (bproj b) && bfid b == fid in filter f $ EM.assocs $ sactorD s actorAssocs :: (FactionId -> Bool) -> LevelId -> State -> [(ActorId, Actor)] actorAssocs p lid s = let f (_, b) = blid b == lid && p (bfid b) in filter f $ EM.assocs $ sactorD s actorRegularAssocs :: (FactionId -> Bool) -> LevelId -> State -> [(ActorId, Actor)] {-# INLINE actorRegularAssocs #-} actorRegularAssocs p lid s = let f (_, b) = not (bproj b) && blid b == lid && p (bfid b) && bhp b > 0 in filter f $ EM.assocs $ sactorD s fidActorRegularAssocs :: FactionId -> LevelId -> State -> [(ActorId, Actor)] fidActorRegularAssocs fid = actorRegularAssocs (== fid) fidActorRegularIds :: FactionId -> LevelId -> State -> [ActorId] fidActorRegularIds fid lid s = map fst $ actorRegularAssocs (== fid) lid s foeRegularAssocs :: FactionId -> LevelId -> State -> [(ActorId, Actor)] foeRegularAssocs fid lid s = let fact = (EM.! fid) . sfactionD $ s in actorRegularAssocs (inline isFoe fid fact) lid s foeRegularList :: FactionId -> LevelId -> State -> [Actor] foeRegularList fid lid s = let fact = (EM.! fid) . sfactionD $ s in map snd $ actorRegularAssocs (inline isFoe fid fact) lid s friendRegularAssocs :: FactionId -> LevelId -> State -> [(ActorId, Actor)] friendRegularAssocs fid lid s = let fact = (EM.! fid) . sfactionD $ s in actorRegularAssocs (inline isFriend fid fact) lid s friendRegularList :: FactionId -> LevelId -> State -> [Actor] friendRegularList fid lid s = let fact = (EM.! fid) . sfactionD $ s in map snd $ actorRegularAssocs (inline isFriend fid fact) lid s bagAssocs :: State -> ItemBag -> [(ItemId, Item)] bagAssocs s bag = let iidItem iid = (iid, getItemBody iid s) in map iidItem $ EM.keys bag bagAssocsK :: State -> ItemBag -> [(ItemId, (Item, ItemQuant))] bagAssocsK s bag = let iidItem (iid, kit) = (iid, (getItemBody iid s, kit)) in map iidItem $ EM.assocs bag posToBig :: Point -> LevelId -> State -> Maybe ActorId posToBig pos lid s = posToBigLvl pos $ sdungeon s EM.! lid posToBigAssoc :: Point -> LevelId -> State -> Maybe (ActorId, Actor) posToBigAssoc pos lid s = let maid = posToBigLvl pos $ sdungeon s EM.! lid in fmap (\aid -> (aid, getActorBody aid s)) maid posToProjs :: Point -> LevelId -> State -> [ActorId] posToProjs pos lid s = posToProjsLvl pos $ sdungeon s EM.! lid posToProjAssocs :: Point -> LevelId -> State -> [(ActorId, Actor)] posToProjAssocs pos lid s = let l = posToProjsLvl pos $ sdungeon s EM.! lid in map (\aid -> (aid, getActorBody aid s)) l posToAids :: Point -> LevelId -> State -> [ActorId] posToAids pos lid s = posToAidsLvl pos $ sdungeon s EM.! lid posToAidAssocs :: Point -> LevelId -> State -> [(ActorId, Actor)] posToAidAssocs pos lid s = let l = posToAidsLvl pos $ sdungeon s EM.! lid in map (\aid -> (aid, getActorBody aid s)) l -- | Calculate loot's worth for a given faction. calculateTotal :: FactionId -> State -> (ItemBag, Int) calculateTotal fid s = let bag = combinedItems fid s items = map (\(iid, (k, _)) -> (getItemBody iid s, k)) $ EM.assocs bag price (item, k) = itemPrice k $ getItemKind item s in (bag, sum $ map price items) -- | Price an item, taking count into consideration. itemPrice :: Int -> IK.ItemKind -> Int itemPrice jcount itemKind = case lookup "valuable" $ IK.ifreq itemKind of Just k -> jcount * k Nothing -> 0 mergeItemQuant :: ItemQuant -> ItemQuant -> ItemQuant mergeItemQuant (k2, it2) (k1, it1) = (k1 + k2, it1 ++ it2) findIid :: ActorId -> FactionId -> ItemId -> State -> [(ActorId, (Actor, CStore))] findIid leader fid iid s = let actors = fidActorNotProjGlobalAssocs fid s itemsOfActor (aid, b) = let itemsOfCStore store = let bag = getBodyStoreBag b store s in map (\iid2 -> (iid2, (aid, (b, store)))) (EM.keys bag) stores = [CInv, CEqp, COrgan] ++ [CSha | aid == leader] in concatMap itemsOfCStore stores items = concatMap itemsOfActor actors in map snd $ filter ((== iid) . fst) items combinedGround :: FactionId -> State -> ItemBag combinedGround fid s = let bs = inline fidActorNotProjGlobalAssocs fid s in EM.unionsWith mergeItemQuant $ map (\(_, b) -> getFloorBag (blid b) (bpos b) s) bs -- Trunk not considered (if stolen). combinedOrgan :: FactionId -> State -> ItemBag combinedOrgan fid s = let bs = inline fidActorNotProjGlobalAssocs fid s in EM.unionsWith mergeItemQuant $ map (borgan . snd) bs combinedEqp :: FactionId -> State -> ItemBag combinedEqp fid s = let bs = inline fidActorNotProjGlobalAssocs fid s in EM.unionsWith mergeItemQuant $ map (beqp . snd) bs combinedInv :: FactionId -> State -> ItemBag combinedInv fid s = let bs = inline fidActorNotProjGlobalAssocs fid s in EM.unionsWith mergeItemQuant $ map (binv . snd) bs -- Trunk not considered (if stolen). combinedItems :: FactionId -> State -> ItemBag combinedItems fid s = let shaBag = gsha $ sfactionD s EM.! fid bs = map snd $ inline fidActorNotProjGlobalAssocs fid s in EM.unionsWith mergeItemQuant $ map binv bs ++ map beqp bs ++ [shaBag] combinedFromLore :: SLore -> FactionId -> State -> ItemBag combinedFromLore slore fid s = case slore of SItem -> combinedItems fid s SOrgan -> combinedOrgan fid s STrunk -> combinedOrgan fid s SCondition -> combinedOrgan fid s SBlast -> EM.empty SEmbed -> EM.empty getActorBody :: ActorId -> State -> Actor {-# INLINE getActorBody #-} getActorBody aid s = sactorD s EM.! aid -- For now, faction and tactic skill modifiers only change -- the stats that affect permitted actions (@SkMove..SkApply@), -- so the expensive @actorCurrentSkills@ operation doesn't need to be used -- when checking the other skills, e.g., for FOV calculations, -- and the @getActorMaxSkills@ cheap operation suffices. -- (@ModeKind@ content is not currently validated in this respect.) getActorMaxSkills :: ActorId -> State -> Ability.Skills {-# INLINE getActorMaxSkills #-} getActorMaxSkills aid s = sactorMaxSkills s EM.! aid actorCurrentSkills :: Maybe ActorId -> ActorId -> State -> Ability.Skills actorCurrentSkills mleader aid s = let body = getActorBody aid s actorMaxSk = getActorMaxSkills aid s player = gplayer . (EM.! bfid body) . sfactionD $ s skillsFromTactic = Ability.tacticSkills $ ftactic player factionSkills | Just aid == mleader = Ability.zeroSkills | otherwise = fskillsOther player `Ability.addSkills` skillsFromTactic in actorMaxSk `Ability.addSkills` factionSkills -- Check that the actor can move, also between levels and through doors. -- Otherwise, it's too awkward for human player to control, e.g., -- being stuck in a room with revolving doors closing after one turn -- and the player needing to micromanage opening such doors with -- another actor all the time. Completely immovable actors -- e.g., an impregnable surveillance camera in a crowded corridor, -- are less of a problem due to micromanagment, but more due to -- the constant disturbing of other actor's running, etc. canTraverse :: ActorId -> State -> Bool canTraverse aid s = let actorMaxSk = getActorMaxSkills aid s in Ability.getSk Ability.SkMove actorMaxSk > 0 && Ability.getSk Ability.SkAlter actorMaxSk >= fromEnum TK.talterForStairs getCarriedAssocsAndTrunk :: Actor -> State -> [(ItemId, Item)] getCarriedAssocsAndTrunk b s = -- The trunk is important for a case of spotting a caught projectile -- with a stolen projecting item. This actually does happen. let trunk = EM.singleton (btrunk b) (1, []) in bagAssocs s $ EM.unionsWith const [binv b, beqp b, borgan b, trunk] getCarriedIidCStore :: Actor -> [(ItemId, CStore)] getCarriedIidCStore b = let bagCarried (cstore, bag) = map (,cstore) $ EM.keys bag in concatMap bagCarried [(CInv, binv b), (CEqp, beqp b), (COrgan, borgan b)] getContainerBag :: Container -> State -> ItemBag getContainerBag c s = case c of CFloor lid p -> getFloorBag lid p s CEmbed lid p -> getEmbedBag lid p s CActor aid cstore -> let b = getActorBody aid s in getBodyStoreBag b cstore s CTrunk{} -> EM.empty -- for dummy/test/analytics cases getFloorBag :: LevelId -> Point -> State -> ItemBag getFloorBag lid p s = EM.findWithDefault EM.empty p $ lfloor (sdungeon s EM.! lid) getEmbedBag :: LevelId -> Point -> State -> ItemBag getEmbedBag lid p s = EM.findWithDefault EM.empty p $ lembed (sdungeon s EM.! lid) getBodyStoreBag :: Actor -> CStore -> State -> ItemBag getBodyStoreBag b cstore s = case cstore of CGround -> getFloorBag (blid b) (bpos b) s COrgan -> borgan b CEqp -> beqp b CInv -> binv b CSha -> gsha $ sfactionD s EM.! bfid b mapActorItems_ :: Monad m => (CStore -> ItemId -> ItemQuant -> m a) -> Actor -> State -> m () mapActorItems_ f b s = do let notProcessed = [CGround] sts = [minBound..maxBound] \\ notProcessed g cstore = do let bag = getBodyStoreBag b cstore s mapM_ (uncurry $ f cstore) $ EM.assocs bag mapM_ g sts getActorAssocs :: ActorId -> CStore -> State -> [(ItemId, Item)] getActorAssocs aid cstore s = let b = getActorBody aid s in bagAssocs s $ getBodyStoreBag b cstore s getActorAssocsK :: ActorId -> CStore -> State -> [(ItemId, (Item, ItemQuant))] getActorAssocsK aid cstore s = let b = getActorBody aid s in bagAssocsK s $ getBodyStoreBag b cstore s -- | Checks if the actor is present on the current level. -- The order of argument here and in other functions is set to allow -- -- > b <- getsState (memActor a) memActor :: ActorId -> LevelId -> State -> Bool memActor aid lid s = maybe False ((== lid) . blid) $ EM.lookup aid $ sactorD s -- | Get current time from the dungeon data. getLocalTime :: LevelId -> State -> Time getLocalTime lid s = ltime $ sdungeon s EM.! lid regenCalmDelta :: ActorId -> Actor -> State -> Int64 regenCalmDelta aid body s = let calmIncr = oneM -- normal rate of calm regen actorMaxSk = getActorMaxSkills aid s maxDeltaCalm = xM (Ability.getSk Ability.SkMaxCalm actorMaxSk) - bcalm body fact = (EM.! bfid body) . sfactionD $ s -- Worry actor by non-projectile enemies felt (even if not seen) -- on the level within 3 steps. Even dying, but not hiding in wait. isHeardFoe (!p, aid2) = let b = getActorBody aid2 s in inline chessDist p (bpos body) <= 3 && not (actorWaitsOrSleeps b) -- uncommon && inline isFoe (bfid body) fact (bfid b) -- costly actorRelaxed = deltaBenign $ bcalmDelta body actorWasRelaxed = deltaWasBenign $ bcalmDelta body in if | not actorRelaxed -> 0 -- if no foes around, do not compensate and obscure distress, -- otherwise, don't increase delta further and suggest grave harm; -- note that in the effect, an actor that first hears distant -- action and then hears nearby enemy, won't notice the latter, -- which can be justified by distraction and is KISS and tactical | any isHeardFoe $ EM.assocs $ lbig $ sdungeon s EM.! blid body -> minusM1 -- even if all calmness spent, keep informing the client; -- from above we know delta won't get too large here | actorWasRelaxed -> min calmIncr (max 0 maxDeltaCalm) -- if Calm is over max | otherwise -> 0 -- don't regenerate if shortly after stress, to make -- waking up actors via bad stealth easier actorInAmbient :: Actor -> State -> Bool actorInAmbient b s = let lvl = (EM.! blid b) . sdungeon $ s in Tile.isLit (coTileSpeedup $ scops s) (lvl `at` bpos b) canDeAmbientList :: Actor -> State -> [Point] canDeAmbientList b s = let COps{coTileSpeedup} = scops s lvl = (EM.! blid b) . sdungeon $ s posDeAmbient p = let t = lvl `at` p in Tile.isWalkable coTileSpeedup t -- no time to waste altering && not (Tile.isLit coTileSpeedup t) in if Tile.isLit coTileSpeedup (lvl `at` bpos b) then filter posDeAmbient (vicinityUnsafe $ bpos b) else [] -- Check whether an actor can displace another. We assume they are adjacent -- and they are foes. dispEnemy :: ActorId -> ActorId -> Ability.Skills -> State -> Bool dispEnemy source target actorMaxSk s = let hasBackup b = let adjAssocs = adjacentBigAssocs b s fact = sfactionD s EM.! bfid b friend (_, b2) = isFriend (bfid b) fact (bfid b2) && bhp b2 > 0 in any friend adjAssocs sb = getActorBody source s tb = getActorBody target s dozes = bwatch tb `elem` [WSleep, WWake] in bproj tb || not (actorDying tb || actorWaits tb || Ability.getSk Ability.SkMove actorMaxSk <= 0 && not dozes -- roots weak if the tree sleeps || hasBackup sb && hasBackup tb) -- solo actors are flexible itemToFull :: ItemId -> State -> ItemFull itemToFull iid s = itemToFull6 (scops s) (sdiscoKind s) (sdiscoAspect s) iid (getItemBody iid s) fullAssocs :: ActorId -> [CStore] -> State -> [(ItemId, ItemFull)] fullAssocs aid cstores s = let allAssocs = concatMap (\cstore -> getActorAssocsK aid cstore s) cstores iToFull (iid, (item, _kit)) = (iid, itemToFull6 (scops s) (sdiscoKind s) (sdiscoAspect s) iid item) in map iToFull allAssocs kitAssocs :: ActorId -> [CStore] -> State -> [(ItemId, ItemFullKit)] kitAssocs aid cstores s = let allAssocs = concatMap (\cstore -> getActorAssocsK aid cstore s) cstores iToFull (iid, (item, kit)) = (iid, ( itemToFull6 (scops s) (sdiscoKind s) (sdiscoAspect s) iid item , kit )) in map iToFull allAssocs getItemKindId :: Item -> State -> ContentId IK.ItemKind getItemKindId item s = case jkind item of IdentityObvious ik -> ik IdentityCovered ix ik -> fromMaybe ik $ EM.lookup ix $ sdiscoKind s getIidKindId :: ItemId -> State -> ContentId IK.ItemKind getIidKindId iid s = getItemKindId (getItemBody iid s) s getItemKind :: Item -> State -> IK.ItemKind getItemKind item s = okind (coitem $ scops s) $ getItemKindId item s getIidKind :: ItemId -> State -> IK.ItemKind getIidKind iid s = getItemKind (getItemBody iid s) s getItemKindIdServer :: Item -> State -> ContentId IK.ItemKind getItemKindIdServer item s = case jkind item of IdentityObvious ik -> ik IdentityCovered ix _ik -> fromMaybe (error $ show $ jkind item) (EM.lookup ix $ sdiscoKind s) getIidKindIdServer :: ItemId -> State -> ContentId IK.ItemKind getIidKindIdServer iid s = getItemKindIdServer (getItemBody iid s) s getItemKindServer :: Item -> State -> IK.ItemKind getItemKindServer item s = okind (coitem $ scops s) $ getItemKindIdServer item s getIidKindServer :: ItemId -> State -> IK.ItemKind getIidKindServer iid s = getItemKindServer (getItemBody iid s) s -- | Determine the dungeon level of the container. If the item is in a shared -- stash, the level depends on which actor asks. lidFromC :: Container -> State -> LevelId lidFromC (CFloor lid _) _ = lid lidFromC (CEmbed lid _) _ = lid lidFromC (CActor aid _) s = blid $ getActorBody aid s lidFromC (CTrunk _ lid _) _ = lid posFromC :: Container -> State -> Point posFromC (CFloor _ pos) _ = pos posFromC (CEmbed _ pos) _ = pos posFromC (CActor aid _) s = bpos $ getActorBody aid s posFromC c@CTrunk{} _ = error $ "" `showFailure` c -- | Require that any non-dying foe is adjacent. We include even -- projectiles that explode when stricken down, because they can be caught -- and then they don't explode, so it makes sense to focus on handling them. -- If there are many projectiles in a single adjacent position, we only test -- the first one, the one that would be hit in melee (this is not optimal -- if the actor would need to flee instead of meleeing, but fleeing -- with *many* projectiles adjacent is a possible waste of a move anyway). anyFoeAdj :: ActorId -> State -> Bool anyFoeAdj aid s = let body = getActorBody aid s lvl = (EM.! blid body) . sdungeon $ s fact = (EM.! bfid body) . sfactionD $ s f !p = case posToBigLvl p lvl of Nothing -> False Just aid2 -> g $ getActorBody aid2 s g !b = inline isFoe (bfid body) fact (bfid b) && bhp b > 0 -- uncommon h !p = case posToProjsLvl p lvl of [] -> False aid2 : _ -> g $ getActorBody aid2 s in any (\ p -> f p || h p) $ vicinityUnsafe $ bpos body adjacentBigAssocs :: Actor -> State -> [(ActorId, Actor)] {-# INLINE adjacentBigAssocs #-} adjacentBigAssocs body s = let lvl = (EM.! blid body) . sdungeon $ s f !p = posToBigLvl p lvl g !aid = (aid, getActorBody aid s) in map g $ mapMaybe f $ vicinityUnsafe $ bpos body adjacentProjAssocs :: Actor -> State -> [(ActorId, Actor)] {-# INLINE adjacentProjAssocs #-} adjacentProjAssocs body s = let lvl = (EM.! blid body) . sdungeon $ s f !p = posToProjsLvl p lvl g !aid = (aid, getActorBody aid s) in map g $ concatMap f $ vicinityUnsafe $ bpos body armorHurtBonus :: ActorId -> ActorId -> State -> Int armorHurtBonus source target s = let sb = getActorBody source s sMaxSk = getActorMaxSkills source s tMaxSk = getActorMaxSkills target s in armorHurtCalculation (bproj sb) sMaxSk tMaxSk -- | Check if any non-dying foe (projectile or not) is adjacent -- to any of our normal actors (whether they can melee or just need to flee, -- in which case alert is needed so that they are not slowed down by others). -- This is needed only by AI and computed as lazily as possible. inMelee :: FactionId -> LevelId -> State -> Bool inMelee !fid !lid s = let fact = sfactionD s EM.! fid f !b = blid b == lid && inline isFoe fid fact (bfid b) -- costly && bhp b > 0 -- uncommon allFoes = filter f $ EM.elems $ sactorD s g !b = bfid b == fid && blid b == lid && not (bproj b) && bhp b > 0 allOurs = filter g $ EM.elems $ sactorD s -- We assume foes are less numerous, even though they may come -- from multiple factions and they contain projectiles, -- because we see all our actors, while many foes may be hidden. -- Consequently, we allocate the set of foe positions -- and avoid allocating ours, by iterating over our actors. -- This in O(mn) instead of O(m+n), but it allocates -- less and multiplicative constants are lower. -- We inspect adjacent locations of foe positions, not of ours, -- thus increasing allocation a bit, but not by much, because -- the set should be rather saturated. -- If there are no foes in sight, we don't iterate at all. setFoeVicinity = ES.fromList $ concatMap (vicinityUnsafe . bpos) allFoes in not (ES.null setFoeVicinity) -- shortcut && any (\b -> bpos b `ES.member` setFoeVicinity) allOurs LambdaHack-0.9.5.0/engine-src/Game/LambdaHack/Common/Analytics.hs0000644000000000000000000000512007346545000022406 0ustar0000000000000000{-# LANGUAGE DeriveGeneric, GeneralizedNewtypeDeriving #-} -- | Per-actor analytics of personal feats. module Game.LambdaHack.Common.Analytics ( FactionAnalytics, ActorAnalytics, GenerationAnalytics , KillMap, Analytics(..), KillHow(..) , emptyAnalytics, addFactionKill, addActorKill #ifdef EXPOSE_INTERNAL -- * Internal operations , addKill #endif ) where import Prelude () import Game.LambdaHack.Core.Prelude import Data.Binary import qualified Data.EnumMap.Strict as EM import GHC.Generics (Generic) import Game.LambdaHack.Common.Types import Game.LambdaHack.Definition.Defs -- | Summary analytics data for each faction. type FactionAnalytics = EM.EnumMap FactionId Analytics -- | Analytics data for each live actor. type ActorAnalytics = EM.EnumMap ActorId Analytics -- | Statistics of possible and actual generation of items for each lore kind. type GenerationAnalytics = EM.EnumMap SLore (EM.EnumMap ItemId Int) -- | Labels of individual kill count analytics. data KillHow = KillKineticMelee | KillKineticRanged | KillKineticBlast | KillKineticPush | KillOtherMelee | KillOtherRanged | KillOtherBlast | KillOtherPush | KillActorLaunch | KillTileLaunch | KillDropLaunch | KillCatch deriving (Show, Eq, Enum, Generic) instance Binary KillHow type KillMap = EM.EnumMap FactionId (EM.EnumMap ItemId Int) -- | Statistics of past events concerning an actor. newtype Analytics = Analytics { akillCounts :: EM.EnumMap KillHow KillMap } deriving (Show, Eq, Binary) emptyAnalytics :: Analytics emptyAnalytics = Analytics { akillCounts = EM.empty } addKill :: KillHow -> FactionId -> ItemId -> Maybe Analytics -> Analytics addKill killHow fid iid = let f Nothing = Analytics {akillCounts = EM.singleton killHow $ EM.singleton fid $ EM.singleton iid 1} f (Just an) = an {akillCounts = EM.alter g killHow $ akillCounts an} g Nothing = Just $ EM.singleton fid $ EM.singleton iid 1 g (Just fidMap) = Just $ EM.alter h fid fidMap h Nothing = Just $ EM.singleton iid 1 h (Just iidMap) = Just $ EM.alter i iid iidMap i Nothing = Just 1 i (Just n) = Just $ n + 1 in f addFactionKill :: FactionId -> KillHow -> FactionId -> ItemId -> FactionAnalytics -> FactionAnalytics addFactionKill fidOfKiller killHow fid iid = EM.alter (Just . addKill killHow fid iid) fidOfKiller addActorKill :: ActorId -> KillHow -> FactionId -> ItemId -> ActorAnalytics -> ActorAnalytics addActorKill aid killHow fid iid = EM.alter (Just . addKill killHow fid iid) aid LambdaHack-0.9.5.0/engine-src/Game/LambdaHack/Common/Area.hs0000644000000000000000000000536407346545000021341 0ustar0000000000000000-- | Rectangular areas of levels and their basic operations. module Game.LambdaHack.Common.Area ( Area, toArea, fromArea, spanArea, trivialArea, isTrivialArea , inside, shrink, expand, middlePoint, areaInnerBorder, sumAreas, punindex ) where import Prelude () import Game.LambdaHack.Core.Prelude import Data.Binary import Game.LambdaHack.Common.Point import Game.LambdaHack.Definition.Defs -- | The type of areas. The bottom left and the top right points. data Area = Area X Y X Y deriving (Show, Eq) -- | Checks if it's an area with at least one field. toArea :: (X, Y, X, Y) -> Maybe Area toArea (x0, y0, x1, y1) = if x0 <= x1 && y0 <= y1 then Just $ Area x0 y0 x1 y1 else Nothing fromArea :: Area -> (X, Y, X, Y) fromArea (Area x0 y0 x1 y1) = (x0, y0, x1, y1) -- Funny thing, Trivial area, a point, has span 1 in each dimension. spanArea :: Area -> (Point, X, Y) spanArea (Area x0 y0 x1 y1) = (Point x0 y0, x1 - x0 + 1, y1 - y0 + 1) trivialArea :: Point -> Area trivialArea (Point x y) = Area x y x y isTrivialArea :: Area -> Bool isTrivialArea (Area x0 y0 x1 y1) = x0 == x1 && y0 == y1 -- | Checks that a point belongs to an area. inside :: Point -> Area -> Bool {-# INLINE inside #-} inside (Point x y) (Area x0 y0 x1 y1) = x1 >= x && x >= x0 && y1 >= y && y >= y0 -- | Shrink the given area on all fours sides by the amount. shrink :: Area -> Maybe Area shrink (Area x0 y0 x1 y1) = toArea (x0 + 1, y0 + 1, x1 - 1, y1 - 1) expand :: Area -> Area expand (Area x0 y0 x1 y1) = Area (x0 - 1) (y0 - 1) (x1 + 1) (y1 + 1) middlePoint :: Area -> Point middlePoint (Area x0 y0 x1 y1) = Point (x0 + (x1 - x0) `div` 2) (y0 + (y1 - y0) `div` 2) areaInnerBorder :: Area -> [Point] areaInnerBorder (Area x0 y0 x1 y1) = [ Point x y | x <- [x0, x1], y <- [y0..y1] ] ++ [ Point x y | x <- [x0+1..x1-1], y <- [y0, y1] ] -- We assume the areas are adjacent. sumAreas :: Area -> Area -> Area sumAreas a@(Area x0 y0 x1 y1) a'@(Area x0' y0' x1' y1') = if | y1 == y0' -> assert (x0 == x0' && x1 == x1' `blame` (a, a')) $ Area x0 y0 x1 y1' | y0 == y1' -> assert (x0 == x0' && x1 == x1' `blame` (a, a')) $ Area x0' y0' x1' y1 | x1 == x0' -> assert (y0 == y0' && y1 == y1' `blame` (a, a')) $ Area x0 y0 x1' y1 | x0 == x1' -> assert (y0 == y0' && y1 == y1' `blame` (a, a')) $ Area x0' y0' x1 y1' | otherwise -> error $ "areas not adjacent" `showFailure` (a, a') punindex :: X -> Int -> Point {-# INLINE punindex #-} punindex xsize n = let (py, px) = n `quotRem` xsize in Point{..} instance Binary Area where put (Area x0 y0 x1 y1) = do put x0 put y0 put x1 put y1 get = Area <$> get <*> get <*> get <*> get LambdaHack-0.9.5.0/engine-src/Game/LambdaHack/Common/Faction.hs0000644000000000000000000001522307346545000022047 0ustar0000000000000000{-# LANGUAGE DeriveGeneric #-} -- | Factions taking part in the game, e.g., a hero faction, a monster faction -- and an animal faction. module Game.LambdaHack.Common.Faction ( FactionDict, Faction(..), Diplomacy(..) , Status(..), Challenge(..) , gleader, isHorrorFact, noRunWithMulti, isAIFact, autoDungeonLevel , automatePlayer, isFoe, isFriend , difficultyBound, difficultyDefault, difficultyCoeff, difficultyInverse , defaultChallenge, possibleActorFactions #ifdef EXPOSE_INTERNAL -- * Internal operations , Dipl #endif ) where import Prelude () import Game.LambdaHack.Core.Prelude import Data.Binary import qualified Data.EnumMap.Strict as EM import qualified Data.IntMap.Strict as IM import GHC.Generics (Generic) import Game.LambdaHack.Common.Item import Game.LambdaHack.Common.Types import Game.LambdaHack.Content.ItemKind (ItemKind) import qualified Game.LambdaHack.Content.ItemKind as IK import Game.LambdaHack.Content.ModeKind import qualified Game.LambdaHack.Definition.Ability as Ability import qualified Game.LambdaHack.Definition.Color as Color import Game.LambdaHack.Definition.Defs -- | All factions in the game, indexed by faction identifier. type FactionDict = EM.EnumMap FactionId Faction -- | The faction datatype. data Faction = Faction { gname :: Text -- ^ individual name , gcolor :: Color.Color -- ^ color of actors or their frames , gplayer :: Player -- ^ the player spec for this faction , ginitial :: [(Int, Int, GroupName ItemKind)] -- ^ initial actors , gdipl :: Dipl -- ^ diplomatic standing , gquit :: Maybe Status -- ^ cause of game end/exit , _gleader :: Maybe ActorId -- ^ the leader of the faction; don't use -- in place of sleader on clients , gsha :: ItemBag -- ^ faction's shared inventory , gvictims :: EM.EnumMap (ContentId ItemKind) Int -- ^ members killed , gvictimsD :: EM.EnumMap (ContentId ModeKind) (IM.IntMap (EM.EnumMap (ContentId ItemKind) Int)) -- ^ members killed in the past, by game mode and difficulty level } deriving (Show, Eq, Generic) instance Binary Faction -- | Diplomacy states. Higher overwrite lower in case of asymmetric content. data Diplomacy = Unknown | Neutral | Alliance | War deriving (Show, Eq, Ord, Enum, Generic) instance Binary Diplomacy type Dipl = EM.EnumMap FactionId Diplomacy -- | Current game status. data Status = Status { stOutcome :: Outcome -- ^ current game outcome , stDepth :: Int -- ^ depth of the final encounter , stNewGame :: Maybe (GroupName ModeKind) -- ^ new game group to start, if any } deriving (Show, Eq, Ord, Generic) instance Binary Status data Challenge = Challenge { cdiff :: Int -- ^ game difficulty level (HP bonus or malus) , cwolf :: Bool -- ^ lone wolf challenge (only one starting character) , cfish :: Bool -- ^ cold fish challenge (no healing from enemies) } deriving (Show, Eq, Ord, Generic) instance Binary Challenge gleader :: Faction -> Maybe ActorId gleader = _gleader -- | Tell whether the faction consists of summoned horrors only. -- -- Horror player is special, for summoned actors that don't belong to any -- of the main players of a given game. E.g., animals summoned during -- a skirmish game between two hero factions land in the horror faction. -- In every game, either all factions for which summoning items exist -- should be present or a horror player should be added to host them. isHorrorFact :: Faction -> Bool isHorrorFact fact = horrorGroup `elem` fgroups (gplayer fact) -- A faction where other actors move at once or where some of leader change -- is automatic can't run with multiple actors at once. That would be -- overpowered or too complex to keep correct. -- -- Note that this doesn't take into account individual actor skills, -- so this is overly restrictive and, OTOH, sometimes running will fail -- or behave wierdly regardless. But it's simple and easy to understand -- by the UI user. noRunWithMulti :: Faction -> Bool noRunWithMulti fact = let skillsOther = fskillsOther $ gplayer fact in Ability.getSk Ability.SkMove skillsOther >= 0 || case fleaderMode (gplayer fact) of LeaderNull -> True LeaderAI AutoLeader{} -> True LeaderUI AutoLeader{..} -> autoDungeon || autoLevel isAIFact :: Faction -> Bool isAIFact fact = case fleaderMode (gplayer fact) of LeaderNull -> True LeaderAI _ -> True LeaderUI _ -> False autoDungeonLevel :: Faction -> (Bool, Bool) autoDungeonLevel fact = case fleaderMode (gplayer fact) of LeaderNull -> (False, False) LeaderAI AutoLeader{..} -> (autoDungeon, autoLevel) LeaderUI AutoLeader{..} -> (autoDungeon, autoLevel) automatePlayer :: Bool -> Player -> Player automatePlayer st pl = let autoLeader False Player{fleaderMode=LeaderAI auto} = LeaderUI auto autoLeader True Player{fleaderMode=LeaderUI auto} = LeaderAI auto autoLeader _ Player{fleaderMode} = fleaderMode in pl {fleaderMode = autoLeader st pl} -- | Check if factions are at war. Assumes symmetry. isFoe :: FactionId -> Faction -> FactionId -> Bool isFoe fid1 fact1 fid2 = fid1 /= fid2 -- shortcut && War == EM.findWithDefault Unknown fid2 (gdipl fact1) -- | Check if factions are allied. Assumes symmetry. isAlly :: Faction -> FactionId -> Bool {-# INLINE isAlly #-} isAlly fact1 fid2 = Alliance == EM.findWithDefault Unknown fid2 (gdipl fact1) -- | Check if factions are allied or are the same faction. Assumes symmetry. isFriend :: FactionId -> Faction -> FactionId -> Bool isFriend fid1 fact1 fid2 = fid1 == fid2 || isAlly fact1 fid2 difficultyBound :: Int difficultyBound = 9 difficultyDefault :: Int difficultyDefault = (1 + difficultyBound) `div` 2 -- The function is its own inverse. difficultyCoeff :: Int -> Int difficultyCoeff n = difficultyDefault - n -- The function is its own inverse. difficultyInverse :: Int -> Int difficultyInverse n = difficultyBound + 1 - n defaultChallenge :: Challenge defaultChallenge = Challenge { cdiff = difficultyDefault , cwolf = False , cfish = False } possibleActorFactions :: ItemKind -> FactionDict -> [(FactionId, Faction)] possibleActorFactions itemKind factionD = let freqNames = map fst $ IK.ifreq itemKind f (_, fact) = any (`elem` fgroups (gplayer fact)) freqNames fidFactsRaw = filter f $ EM.assocs factionD in if null fidFactsRaw then filter (isHorrorFact . snd) $ EM.assocs factionD -- fall back else fidFactsRaw LambdaHack-0.9.5.0/engine-src/Game/LambdaHack/Common/File.hs0000644000000000000000000000051707346545000021343 0ustar0000000000000000-- | Saving/loading to files, with serialization and compression. module Game.LambdaHack.Common.File ( encodeEOF, strictDecodeEOF , tryCreateDir, doesFileExist, tryWriteFile, readFile, renameFile ) where import Prelude () #ifdef USE_JSFILE import Game.LambdaHack.Common.JSFile #else import Game.LambdaHack.Common.HSFile #endif LambdaHack-0.9.5.0/engine-src/Game/LambdaHack/Common/HSFile.hs0000644000000000000000000000553607346545000021604 0ustar0000000000000000-- | Saving/loading to files, with serialization and compression. module Game.LambdaHack.Common.HSFile ( encodeEOF, strictDecodeEOF , tryCreateDir, doesFileExist, tryWriteFile, readFile, renameFile #ifdef EXPOSE_INTERNAL -- * Internal operations , encodeData #endif ) where import Prelude () import Game.LambdaHack.Core.Prelude import qualified Codec.Compression.Zlib as Z import qualified Control.Exception as Ex import Data.Binary import qualified Data.ByteString.Lazy as LBS import Data.Version import System.Directory import System.FilePath import System.IO (IOMode (..), hClose, openBinaryFile, readFile, withBinaryFile, writeFile) -- | Serialize and save data. -- Note that LBS.writeFile opens the file in binary mode. encodeData :: Binary a => FilePath -> a -> IO () encodeData path a = do let tmpPath = path <.> "tmp" Ex.bracketOnError (openBinaryFile tmpPath WriteMode) (\h -> hClose h >> removeFile tmpPath) (\h -> do LBS.hPut h . encode $ a hClose h renameFile tmpPath path ) -- | Serialize, compress and save data with an EOF marker. -- The @OK@ is used as an EOF marker to ensure any apparent problems with -- corrupted files are reported to the user ASAP. encodeEOF :: Binary b => FilePath -> Version -> b -> IO () encodeEOF path v b = encodeData path (v, (Z.compress $ encode b, "OK" :: String)) -- | Read, decompress and deserialize data with an EOF marker. -- The @OK@ EOF marker ensures any easily detectable file corruption -- is discovered and reported before any value is decoded from -- the second component and before the file handle is closed. -- OTOH, binary encoding corruption is not discovered until a version -- check elswere ensures that binary formats are compatible. strictDecodeEOF :: Binary b => FilePath -> IO (Version, b) strictDecodeEOF path = withBinaryFile path ReadMode $ \h -> do c1 <- LBS.hGetContents h let (v1, (c2, s)) = decode c1 return $! if s == ("OK" :: String) then (v1, decode $ Z.decompress c2) else error $ "Fatal error: corrupted file " ++ path -- | Try to create a directory, if it doesn't exist. We catch exceptions -- in case many clients try to do the same thing at the same time. tryCreateDir :: FilePath -> IO () tryCreateDir dir = do dirExists <- doesDirectoryExist dir unless dirExists $ Ex.handle (\(_ :: Ex.IOException) -> return ()) (createDirectory dir) -- | Try to write a file, given content, if the file not already there. -- We catch exceptions in case many clients try to do the same thing -- at the same time. tryWriteFile :: FilePath -> String -> IO () tryWriteFile path content = do fileExists <- doesFileExist path unless fileExists $ Ex.handle (\(_ :: Ex.IOException) -> return ()) (writeFile path content) LambdaHack-0.9.5.0/engine-src/Game/LambdaHack/Common/HighScore.hs0000644000000000000000000001716707346545000022350 0ustar0000000000000000{-# LANGUAGE DeriveGeneric, GeneralizedNewtypeDeriving #-} -- | High score table operations. module Game.LambdaHack.Common.HighScore ( ScoreTable, ScoreDict , empty, register, showScore, showAward, getTable, unTable, getRecord #ifdef EXPOSE_INTERNAL -- * Internal operations , ScoreRecord, insertPos #endif ) where import Prelude () import Game.LambdaHack.Core.Prelude import Data.Binary import qualified Data.EnumMap.Strict as EM import qualified Data.Text as T import Data.Time.Clock.POSIX import Data.Time.LocalTime import GHC.Generics (Generic) import qualified NLP.Miniutter.English as MU import Game.LambdaHack.Common.Faction import Game.LambdaHack.Common.Misc import Game.LambdaHack.Common.Time import Game.LambdaHack.Content.ItemKind (ItemKind) import Game.LambdaHack.Content.ModeKind (HiCondPoly, HiIndeterminant (..), ModeKind, Outcome (..)) import Game.LambdaHack.Definition.Defs -- | A single score record. Records are ordered in the highscore table, -- from the best to the worst, in lexicographic ordering wrt the fields below. data ScoreRecord = ScoreRecord { points :: Int -- ^ the score , negTime :: Time -- ^ game time spent (negated, so less better) , date :: POSIXTime -- ^ date of the last game interruption , status :: Status -- ^ reason of the game interruption , challenge :: Challenge -- ^ challenge setup of the game , gplayerName :: Text -- ^ name of the faction's gplayer , ourVictims :: EM.EnumMap (ContentId ItemKind) Int -- ^ allies lost , theirVictims :: EM.EnumMap (ContentId ItemKind) Int -- ^ foes killed } deriving (Show, Eq, Ord, Generic) instance Binary ScoreRecord -- | The list of scores, in decreasing order. newtype ScoreTable = ScoreTable {unTable :: [ScoreRecord]} deriving (Eq, Binary) instance Show ScoreTable where show _ = "a score table" -- | A dictionary from game mode IDs to scores tables. type ScoreDict = EM.EnumMap (ContentId ModeKind) ScoreTable -- | Empty score table empty :: ScoreDict empty = EM.empty -- | Insert a new score into the table, Return new table and the ranking. -- Make sure the table doesn't grow too large. insertPos :: ScoreRecord -> ScoreTable -> (ScoreTable, Int) insertPos s (ScoreTable table) = let (prefix, suffix) = span (> s) table pos = length prefix + 1 in (ScoreTable $ prefix ++ [s] ++ take (100 - pos) suffix, pos) -- | Register a new score in a score table. register :: ScoreTable -- ^ old table -> Int -- ^ the total value of faction items -> Int -- ^ the total value of dungeon items -> Time -- ^ game time spent -> Status -- ^ reason of the game interruption -> POSIXTime -- ^ current date -> Challenge -- ^ challenge setup -> Text -- ^ name of the faction's gplayer -> EM.EnumMap (ContentId ItemKind) Int -- ^ allies lost -> EM.EnumMap (ContentId ItemKind) Int -- ^ foes killed -> HiCondPoly -> (Bool, (ScoreTable, Int)) register table total dungeonTotal time status@Status{stOutcome} date challenge gplayerName ourVictims theirVictims hiCondPoly = let turnsSpent = fromIntegral $ timeFitUp time timeTurn hiInValue (hi, c) = assert (total <= dungeonTotal) $ case hi of HiConst -> c HiLoot | dungeonTotal == 0 -> c -- a fluke; no gold generated HiLoot -> c * fromIntegral total / fromIntegral dungeonTotal HiSprint -> -- Up to -c turns matter. max 0 (-c - turnsSpent) HiBlitz -> -- Up to 1000000/-c turns matter. sqrt $ max 0 (1000000 + c * turnsSpent) HiSurvival -> -- Up to 1000000/c turns matter. sqrt $ max 0 (min 1000000 $ c * turnsSpent) HiKill -> c * fromIntegral (sum (EM.elems theirVictims)) HiLoss -> c * fromIntegral (sum (EM.elems ourVictims)) hiPolynomialValue = sum . map hiInValue hiSummandValue (hiPoly, outcomes) = if stOutcome `elem` outcomes then max 0 (hiPolynomialValue hiPoly) else 0 hiCondValue = sum . map hiSummandValue -- Other challenges than HP difficulty are not reflected in score. points = (ceiling :: Double -> Int) $ hiCondValue hiCondPoly * 1.5 ^^ (- (difficultyCoeff (cdiff challenge))) negTime = absoluteTimeNegate time score = ScoreRecord{..} in (points > 0, insertPos score table) -- | Show a single high score, from the given ranking in the high score table. showScore :: TimeZone -> Int -> ScoreRecord -> [Text] showScore tz pos score = let Status{stOutcome, stDepth} = status score died = case stOutcome of Killed -> "perished on level" <+> tshow (abs stDepth) Defeated -> "got defeated" Camping -> "set camp" Conquer -> "slew all opposition" Escape -> "emerged victorious" Restart -> "resigned prematurely" curDate = T.take 19 . tshow . utcToLocalTime tz . posixSecondsToUTCTime . date $ score turns = absoluteTimeNegate (negTime score) `timeFitUp` timeTurn tpos = T.justifyRight 3 ' ' $ tshow pos tscore = T.justifyRight 6 ' ' $ tshow $ points score victims = let nkilled = sum $ EM.elems $ theirVictims score nlost = sum $ EM.elems $ ourVictims score in "killed" <+> tshow nkilled <> ", lost" <+> tshow nlost diff = cdiff $ challenge score diffText | diff == difficultyDefault = "" | otherwise = "difficulty" <+> tshow diff <> ", " tturns = makePhrase [MU.CarWs turns "turn"] in [ tpos <> "." <+> tscore <+> gplayerName score <+> died <> "," <+> victims <> "," , " " <> diffText <> "after" <+> tturns <+> "on" <+> curDate <> "." ] getTable :: ContentId ModeKind -> ScoreDict -> ScoreTable getTable = EM.findWithDefault (ScoreTable []) getRecord :: Int -> ScoreTable -> ScoreRecord getRecord pos (ScoreTable table) = fromMaybe (error $ "" `showFailure` (pos, table)) $ listToMaybe $ drop (pred pos) table showAward :: Int -- ^ number of (3-line) scores to be shown -> ScoreTable -- ^ current score table -> Int -- ^ position of the current score in the table -> Text -- ^ the name of the game mode -> Text showAward height table pos gameModeName = let posStatus = status $ getRecord pos table (efforts, person, msgUnless) = case stOutcome posStatus of Killed | stDepth posStatus <= 1 -> ("your short-lived struggle", MU.Sg3rd, "(no bonus)") Killed -> ("your heroic deeds", MU.PlEtc, "(no bonus)") Defeated -> ("your futile efforts", MU.PlEtc, "(no bonus)") Camping -> -- This is only according to the limited player knowledge; -- the final score can be different, which is fine: ("your valiant exploits", MU.PlEtc, "") Conquer -> ("your ruthless victory", MU.Sg3rd, if pos <= height then "among the best" -- "greatest heroes" doesn't fit else "(bonus included)") Escape -> ("your dashing coup", MU.Sg3rd, if pos <= height then "among the best" else "(bonus included)") Restart -> ("your abortive attempt", MU.Sg3rd, "(no bonus)") subject = makePhrase [efforts, "in", MU.Text gameModeName] in makeSentence [ MU.SubjectVerb person MU.Yes (MU.Text subject) "award you" , MU.Ordinal pos, "place", msgUnless ] LambdaHack-0.9.5.0/engine-src/Game/LambdaHack/Common/Item.hs0000644000000000000000000003370607346545000021370 0ustar0000000000000000{-# LANGUAGE DeriveGeneric, GeneralizedNewtypeDeriving, TupleSections #-} -- | Weapons, treasure and all the other items in the game. module Game.LambdaHack.Common.Item ( Item(..), ItemIdentity(..) , ItemKindIx, ItemDisco(..), ItemFull(..), ItemFullKit , DiscoveryKind, DiscoveryAspect, ItemIxMap, Benefit(..), DiscoveryBenefit , ItemTimer, ItemQuant, ItemBag, ItemDict , itemToFull6, aspectRecordFull, strongestSlot, ncharges, hasCharge , strongestMelee, unknownMeleeBonus, unknownSpeedBonus , conditionMeleeBonus, conditionSpeedBonus, armorHurtCalculation #ifdef EXPOSE_INTERNAL -- * Internal operations , valueAtEqpSlot, unknownAspect #endif ) where import Prelude () import Game.LambdaHack.Core.Prelude import Data.Binary import qualified Data.EnumMap.Strict as EM import qualified Data.EnumSet as ES import Data.Hashable (Hashable) import qualified Data.Ix as Ix import qualified Data.Ord as Ord import GHC.Generics (Generic) import qualified Game.LambdaHack.Common.ItemAspect as IA import Game.LambdaHack.Common.Kind import Game.LambdaHack.Common.Time import Game.LambdaHack.Common.Types import qualified Game.LambdaHack.Content.ItemKind as IK import qualified Game.LambdaHack.Core.Dice as Dice import Game.LambdaHack.Definition.Ability (EqpSlot (..)) import qualified Game.LambdaHack.Definition.Ability as Ability import Game.LambdaHack.Definition.Defs import Game.LambdaHack.Definition.Flavour -- | Game items in actor possesion or strewn around the dungeon. -- The information contained in this time is available to the player -- from the moment the item is first seen and is never mutated. -- -- Some items are not created identified (@IdentityCovered@). -- Then they are presented as having a template kind that is really -- not their own, though usually close. Full kind information about -- item's kind is available through the @ItemKindIx@ index once the item -- is identified and full information about the value of item's aspect record -- is available elsewhere (both @IdentityObvious@ and @IdentityCovered@ -- items may or may not need identification of their aspect record). data Item = Item { jkind :: ItemIdentity -- ^ the kind of the item, or an indiretion , jfid :: Maybe FactionId -- ^ the faction that created the item, if any , jflavour :: Flavour -- ^ flavour, always the real one, not hidden; -- people may not recognize shape, but they -- remember colour and old vs fancy look } deriving (Show, Eq, Generic) instance Hashable Item instance Binary Item -- | Either the explicit obvious kind of the item or the kind it's hidden under, -- with the details covered under the index indirection. data ItemIdentity = IdentityObvious (ContentId IK.ItemKind) | IdentityCovered ItemKindIx (ContentId IK.ItemKind) deriving (Show, Eq, Generic) instance Hashable ItemIdentity instance Binary ItemIdentity -- | The map of item ids to item aspect reocrd. The full map is known -- by the server. type DiscoveryAspect = EM.EnumMap ItemId IA.AspectRecord -- | An index of the kind identifier of an item. Clients have partial knowledge -- how these idexes map to kind ids. They gain knowledge by identifying items. -- The indexes and kind identifiers are 1-1. newtype ItemKindIx = ItemKindIx Word16 deriving (Show, Eq, Ord, Enum, Ix.Ix, Hashable, Binary) -- | The secret part of the information about an item. If a faction -- knows the aspect record of the item, this is the complete secret information. -- Items that don't need second identification (the @kmConst@ flag is set) -- may be identified or not and both cases are OK (their display flavour -- will differ and that may be the point). data ItemDisco = ItemDiscoFull IA.AspectRecord | ItemDiscoMean IA.KindMean deriving (Show, Eq, Ord) -- No speedup from making fields non-strict. -- | Full information about an item. data ItemFull = ItemFull { itemBase :: Item , itemKindId :: ContentId IK.ItemKind , itemKind :: IK.ItemKind , itemDisco :: ItemDisco , itemSuspect :: Bool } deriving Show type ItemFullKit = (ItemFull, ItemQuant) -- | The map of item kind indexes to item kind ids. -- The full map, as known by the server, is 1-1. -- Because it's sparse and changes, we don't represent it as an (unboxed) -- vector, until it becomes a bottleneck (if ever, likely on JS, where only -- vectors are fast). type DiscoveryKind = EM.EnumMap ItemKindIx (ContentId IK.ItemKind) -- | The map of item kind indexes to identifiers of items that have that kind. -- Used to update data about items when their kinds become known, e.g., -- AI item use benefit data. type ItemIxMap = EM.EnumMap ItemKindIx (ES.EnumSet ItemId) -- | The fields are, in order: -- 1. whether the item should be kept in equipment (not in pack nor stash) -- 2. the total benefit from picking the item up (to use or to put in equipment) -- 3. the benefit of applying the item to self -- 4. the (usually negative, for him) value of hitting a foe in melee with it -- 5. the (usually negative, for him) value of flinging the item at an opponent data Benefit = Benefit { benInEqp :: Bool , benPickup :: Double , benApply :: Double , benMelee :: Double , benFling :: Double } deriving (Show, Generic) instance Binary Benefit type DiscoveryBenefit = EM.EnumMap ItemId Benefit type ItemTimer = [Time] -- | Number of items in a bag, together with recharging timer, in case of -- items that need recharging, exists only temporarily or auto-activate -- at regular intervals. type ItemQuant = (Int, ItemTimer) -- | A bag of items, e.g., one of the stores of an actor or the items -- on a particular floor position or embedded in a particular map tile. type ItemBag = EM.EnumMap ItemId ItemQuant -- | All items in the dungeon (including in actor inventories), -- indexed by item identifier. type ItemDict = EM.EnumMap ItemId Item itemToFull6 :: COps -> DiscoveryKind -> DiscoveryAspect -> ItemId -> Item -> ItemFull itemToFull6 COps{coitem, coItemSpeedup} discoKind discoAspect iid itemBase = let (itemKindId, itemSuspect) = case jkind itemBase of IdentityObvious ik -> (ik, False) IdentityCovered ix ik -> maybe (ik, True) (, False) $ ix `EM.lookup` discoKind itemKind = okind coitem itemKindId km = getKindMean itemKindId coItemSpeedup -- If the kind is not identified, we know nothing about the real -- aspect record, so we at least assume they are variable. itemAspectMean | itemSuspect = km {IA.kmConst = False} | otherwise = km itemDisco = case EM.lookup iid discoAspect of Just itemAspect -> ItemDiscoFull itemAspect Nothing -> ItemDiscoMean itemAspectMean in ItemFull {..} aspectRecordFull :: ItemFull -> IA.AspectRecord aspectRecordFull itemFull = case itemDisco itemFull of ItemDiscoFull itemAspect -> itemAspect ItemDiscoMean itemAspectMean -> IA.kmMean itemAspectMean -- This ignores items that don't go into equipment, as determined in @inEqp@. -- They are removed from equipment elsewhere via @harmful@. strongestSlot :: DiscoveryBenefit -> Ability.EqpSlot -> [(ItemId, ItemFullKit)] -> [(Int, (ItemId, ItemFullKit))] strongestSlot discoBenefit eqpSlot is = let f (iid, (itemFull, kit)) = let Benefit{benInEqp, benPickup, benMelee} = discoBenefit EM.! iid in if not benInEqp then Nothing else Just $ let ben = case eqpSlot of EqpSlotWeaponFast -> -- For equipping/unequipping the main reliable weapon, -- we take into account not only melee damage, -- but also timeout, aspects, etc. ceiling benPickup EqpSlotWeaponBig -> -- For equipping/unequipping the one-shot big hitter -- weapon, we take into account only melee damage -- and we don't even care if it's durable. -- The backup is ready in the slot above, after all. ceiling (- benMelee) _ -> valueAtEqpSlot eqpSlot $ aspectRecordFull itemFull in (ben, (iid, (itemFull, kit))) in sortBy (flip $ Ord.comparing fst) $ mapMaybe f is valueAtEqpSlot :: EqpSlot -> IA.AspectRecord -> Int valueAtEqpSlot eqpSlot arItem@IA.AspectRecord{..} = case eqpSlot of EqpSlotMove -> Ability.getSk Ability.SkMove aSkills EqpSlotMelee -> Ability.getSk Ability.SkMelee aSkills EqpSlotDisplace -> Ability.getSk Ability.SkDisplace aSkills EqpSlotAlter -> Ability.getSk Ability.SkAlter aSkills EqpSlotWait -> Ability.getSk Ability.SkWait aSkills EqpSlotMoveItem -> Ability.getSk Ability.SkMoveItem aSkills EqpSlotProject -> Ability.getSk Ability.SkProject aSkills EqpSlotApply -> Ability.getSk Ability.SkApply aSkills EqpSlotSwimming -> Ability.getSk Ability.SkSwimming aSkills EqpSlotFlying -> Ability.getSk Ability.SkFlying aSkills EqpSlotHurtMelee -> Ability.getSk Ability.SkHurtMelee aSkills EqpSlotArmorMelee -> Ability.getSk Ability.SkArmorMelee aSkills EqpSlotArmorRanged -> Ability.getSk Ability.SkArmorRanged aSkills EqpSlotMaxHP -> Ability.getSk Ability.SkMaxHP aSkills EqpSlotSpeed -> Ability.getSk Ability.SkSpeed aSkills EqpSlotSight -> Ability.getSk Ability.SkSight aSkills EqpSlotShine -> Ability.getSk Ability.SkShine aSkills EqpSlotMiscBonus -> aTimeout -- usually better items have longer timeout + Ability.getSk Ability.SkMaxCalm aSkills + Ability.getSk Ability.SkSmell aSkills + Ability.getSk Ability.SkNocto aSkills -- powerful, but hard to boost over aSight EqpSlotWeaponFast -> error $ "" `showFailure` arItem -- sum of all benefits EqpSlotWeaponBig -> error $ "" `showFailure` arItem -- sum of all benefits ncharges :: Time -> ItemFull -> ItemQuant -> Int ncharges localTime itemFull (itemK, itemTimer) = let timeout = IA.aTimeout $ aspectRecordFull itemFull timeoutTurns = timeDeltaScale (Delta timeTurn) timeout charging startT = timeShift startT timeoutTurns > localTime it1 = filter charging itemTimer in itemK - length it1 hasCharge :: Time -> ItemFull -> ItemQuant -> Bool hasCharge localTime itemFull (itemK, itemTimer) = ncharges localTime itemFull (itemK, itemTimer) > 0 strongestMelee :: Bool -> Maybe DiscoveryBenefit -> Time -> [(ItemId, ItemFullKit)] -> [(Double, (Int, (ItemId, ItemFullKit)))] strongestMelee _ _ _ [] = [] strongestMelee ignoreCharges mdiscoBenefit localTime kitAss = -- For fighting, as opposed to equipping, we value weapon only for -- its raw damage and harming effects and at this very moment only, -- not in the future. Hehce, we exclude discharged weapons. let f (iid, (itemFull, kit)) = let rawDmg = IK.damageUsefulness $ itemKind itemFull knownOrConstantAspects = case itemDisco itemFull of ItemDiscoMean IA.KindMean{kmConst} -> kmConst ItemDiscoFull{} -> True unIDedBonus | knownOrConstantAspects || isNothing mdiscoBenefit = 0 | otherwise = 1000 -- == exceptionally strong weapon totalValue = case mdiscoBenefit of Just discoBenefit -> let Benefit{benMelee} = discoBenefit EM.! iid in - benMelee + unIDedBonus Nothing -> rawDmg -- special case: not interested about ID ncha = ncharges localTime itemFull kit in ( if ignoreCharges || ncha > 0 then totalValue else -100000 , (ncha, (iid, (itemFull, kit))) ) -- We can't filter out weapons that are not harmful to victim -- (@benMelee >= 0), because actors use them if nothing else available, -- e.g., geysers, bees. This is intended and fun. in sortBy (flip $ Ord.comparing fst) $ filter ((> -100000) . fst) $ map f kitAss unknownAspect :: (IK.Aspect -> [Dice.Dice]) -> ItemFull -> Bool unknownAspect f ItemFull{itemKind=IK.ItemKind{iaspects}, ..} = case itemDisco of ItemDiscoMean IA.KindMean{kmConst} -> let unknown x = let (minD, maxD) = Dice.infsupDice x in minD /= maxD in itemSuspect || not kmConst && or (concatMap (map unknown . f) iaspects) ItemDiscoFull{} -> False -- all known -- We assume @SkHurtMelee@ never appears inside @Odds@. If it does, -- not much harm. unknownMeleeBonus :: [ItemFull] -> Bool unknownMeleeBonus = let p (IK.AddSkill Ability.SkHurtMelee k) = [k] p _ = [] f itemFull b = b || unknownAspect p itemFull in foldr f False -- We assume @SkSpeed@ never appears inside @Odds@. If it does, -- not much harm. unknownSpeedBonus :: [ItemFull] -> Bool unknownSpeedBonus = let p (IK.AddSkill Ability.SkSpeed k) = [k] p _ = [] f itemFull b = b || unknownAspect p itemFull in foldr f False conditionMeleeBonus :: [ItemFullKit] -> Int conditionMeleeBonus kitAss = let f (itemFull, (itemK, _)) k = let arItem = aspectRecordFull itemFull in if IA.checkFlag Ability.Condition arItem then k + itemK * IA.getSkill Ability.SkHurtMelee arItem else k in foldr f 0 kitAss conditionSpeedBonus :: [ItemFullKit] -> Int conditionSpeedBonus kitAss = let f (itemFull, (itemK, _)) k = let arItem = aspectRecordFull itemFull in if IA.checkFlag Ability.Condition arItem then k + itemK * IA.getSkill Ability.SkSpeed arItem else k in foldr f 0 kitAss armorHurtCalculation :: Bool -> Ability.Skills -> Ability.Skills -> Int armorHurtCalculation proj sMaxSk tMaxSk = let trim200 n = min 200 $ max (-200) n itemBonus = trim200 (Ability.getSk Ability.SkHurtMelee sMaxSk) - if proj then trim200 (Ability.getSk Ability.SkArmorRanged tMaxSk) else trim200 (Ability.getSk Ability.SkArmorMelee tMaxSk) in 100 + min 99 (max (-99) itemBonus) -- at least 1% of damage gets through LambdaHack-0.9.5.0/engine-src/Game/LambdaHack/Common/ItemAspect.hs0000644000000000000000000001777407346545000022537 0ustar0000000000000000{-# LANGUAGE DeriveGeneric #-} -- | The type of item aspects and its operations. module Game.LambdaHack.Common.ItemAspect ( AspectRecord(..), KindMean(..) , emptyAspectRecord, addMeanAspect, castAspect, aspectsRandom , aspectRecordToList, rollAspectRecord, getSkill, checkFlag, meanAspect , onlyMinorEffects, itemTrajectory, totalRange, isHumanTrinket , goesIntoEqp, goesIntoInv, goesIntoSha, loreFromMode, loreFromContainer #ifdef EXPOSE_INTERNAL -- * Internal operations , ceilingMeanDice #endif ) where import Prelude () import Game.LambdaHack.Core.Prelude import qualified Control.Monad.Trans.State.Strict as St import Data.Binary import qualified Data.EnumSet as ES import Data.Hashable (Hashable) import qualified Data.Text as T import GHC.Generics (Generic) import qualified System.Random as R import Game.LambdaHack.Common.Time import Game.LambdaHack.Common.Types import Game.LambdaHack.Common.Vector import qualified Game.LambdaHack.Content.ItemKind as IK import qualified Game.LambdaHack.Core.Dice as Dice import Game.LambdaHack.Common.Point import Game.LambdaHack.Core.Random import qualified Game.LambdaHack.Definition.Ability as Ability import Game.LambdaHack.Definition.Defs -- | Record of skills conferred by an item as well as of item flags -- and other item aspects. data AspectRecord = AspectRecord { aTimeout :: Int , aSkills :: Ability.Skills , aFlags :: Ability.Flags , aELabel :: Text , aToThrow :: IK.ThrowMod , aHideAs :: Maybe (GroupName IK.ItemKind) , aEqpSlot :: Maybe Ability.EqpSlot } deriving (Show, Eq, Ord, Generic) instance Hashable AspectRecord instance Binary AspectRecord -- | Partial information about an item, deduced from its item kind. -- These are assigned to each 'IK.ItemKind'. The @kmConst@ flag says whether -- the item's aspect record is constant rather than random or dependent -- on item creation dungeon level. data KindMean = KindMean { kmConst :: Bool -- ^ whether the item doesn't need second identification , kmMean :: AspectRecord -- ^ mean value of item's possible aspect records } deriving (Show, Eq, Ord, Generic) emptyAspectRecord :: AspectRecord emptyAspectRecord = AspectRecord { aTimeout = 0 , aSkills = Ability.zeroSkills , aFlags = Ability.Flags ES.empty , aELabel = "" , aToThrow = IK.ThrowMod 100 100 1 , aHideAs = Nothing , aEqpSlot = Nothing } castAspect :: Dice.AbsDepth -> Dice.AbsDepth -> AspectRecord -> IK.Aspect -> Rnd AspectRecord castAspect !ldepth !totalDepth !ar !asp = case asp of IK.Timeout d -> do n <- castDice ldepth totalDepth d return $! assert (aTimeout ar == 0) $ ar {aTimeout = n} IK.AddSkill sk d -> do n <- castDice ldepth totalDepth d return $! if n /= 0 then ar {aSkills = Ability.addSk sk n (aSkills ar)} else ar IK.SetFlag feat -> return $! ar {aFlags = Ability.Flags $ ES.insert feat (Ability.flags $ aFlags ar)} IK.ELabel t -> return $! ar {aELabel = t} IK.ToThrow tt -> return $! ar {aToThrow = tt} IK.HideAs ha -> return $! ar {aHideAs = Just ha} IK.EqpSlot slot -> return $! ar {aEqpSlot = Just slot} IK.Odds d aspects1 aspects2 -> do pick1 <- oddsDice ldepth totalDepth d foldlM' (castAspect ldepth totalDepth) ar $ if pick1 then aspects1 else aspects2 -- If @False@, aspects of this kind are most probably fixed, not random -- nor dependent on dungeon level where the item is created. aspectsRandom :: [IK.Aspect] -> Bool aspectsRandom ass = let rollM depth = foldlM' (castAspect (Dice.AbsDepth depth) (Dice.AbsDepth 10)) emptyAspectRecord ass gen = R.mkStdGen 0 (ar0, gen0) = St.runState (rollM 0) gen (ar1, gen1) = St.runState (rollM 10) gen0 in show gen /= show gen0 || show gen /= show gen1 || ar0 /= ar1 addMeanAspect :: AspectRecord -> IK.Aspect -> AspectRecord addMeanAspect !ar !asp = case asp of IK.Timeout d -> let n = ceilingMeanDice d in assert (aTimeout ar == 0) $ ar {aTimeout = n} IK.AddSkill sk d -> let n = ceilingMeanDice d in if n /= 0 then ar {aSkills = Ability.addSk sk n (aSkills ar)} else ar IK.SetFlag feat -> ar {aFlags = Ability.Flags $ ES.insert feat (Ability.flags $ aFlags ar)} IK.ELabel t -> ar {aELabel = t} IK.ToThrow tt -> ar {aToThrow = tt} IK.HideAs ha -> ar {aHideAs = Just ha} IK.EqpSlot slot -> ar {aEqpSlot = Just slot} IK.Odds{} -> ar -- can't tell, especially since we don't know the level ceilingMeanDice :: Dice.Dice -> Int ceilingMeanDice d = ceiling $ Dice.meanDice d aspectRecordToList :: AspectRecord -> [IK.Aspect] aspectRecordToList AspectRecord{..} = [IK.Timeout $ Dice.intToDice aTimeout | aTimeout /= 0] ++ [ IK.AddSkill sk $ Dice.intToDice n | (sk, n) <- Ability.skillsToList aSkills ] ++ [IK.SetFlag feat | feat <- ES.elems $ Ability.flags aFlags] ++ [IK.ELabel aELabel | not $ T.null aELabel] ++ [IK.ToThrow aToThrow | not $ aToThrow == IK.ThrowMod 100 100 1] ++ maybe [] (\ha -> [IK.HideAs ha]) aHideAs ++ maybe [] (\slot -> [IK.EqpSlot slot]) aEqpSlot rollAspectRecord :: [IK.Aspect] -> Dice.AbsDepth -> Dice.AbsDepth -> Rnd AspectRecord rollAspectRecord ass ldepth totalDepth = foldlM' (castAspect ldepth totalDepth) emptyAspectRecord ass getSkill :: Ability.Skill -> AspectRecord -> Int {-# INLINE getSkill #-} getSkill sk ar = Ability.getSk sk $ aSkills ar checkFlag :: Ability.Flag -> AspectRecord -> Bool {-# INLINE checkFlag #-} checkFlag flag ar = Ability.checkFl flag (aFlags ar) meanAspect :: IK.ItemKind -> AspectRecord meanAspect kind = foldl' addMeanAspect emptyAspectRecord (IK.iaspects kind) -- Kinetic damage is not considered major effect, even though it -- identifies an item, when one hits with it. However, it's tedious -- to wait for weapon identification until first hit and also -- if a weapon is periodically activated, the kinetic damage would not apply, -- so we'd need special cases that force identification or warn -- or here not consider kinetic damage a major effect if item is periodic. -- So we opt for KISS and identify effect-less weapons at pick-up, -- not at first hit. onlyMinorEffects :: AspectRecord -> IK.ItemKind -> Bool onlyMinorEffects ar kind = checkFlag Ability.MinorEffects ar -- override || not (any (not . IK.onSmashEffect) $ IK.ieffects kind) -- exhibits no major effects itemTrajectory :: AspectRecord -> IK.ItemKind -> [Point] -> ([Vector], (Speed, Int)) itemTrajectory ar itemKind path = let IK.ThrowMod{..} = aToThrow ar in computeTrajectory (IK.iweight itemKind) throwVelocity throwLinger path totalRange :: AspectRecord -> IK.ItemKind -> Int totalRange ar itemKind = snd $ snd $ itemTrajectory ar itemKind [] isHumanTrinket :: IK.ItemKind -> Bool isHumanTrinket itemKind = maybe False (> 0) $ lookup "valuable" $ IK.ifreq itemKind -- risk from treasure hunters goesIntoEqp :: AspectRecord -> Bool goesIntoEqp ar = checkFlag Ability.Equipable ar || checkFlag Ability.Meleeable ar goesIntoInv :: AspectRecord -> Bool goesIntoInv ar = not (checkFlag Ability.Precious ar) && not (goesIntoEqp ar) goesIntoSha :: AspectRecord -> Bool goesIntoSha ar = checkFlag Ability.Precious ar && not (goesIntoEqp ar) loreFromMode :: ItemDialogMode -> SLore loreFromMode c = case c of MStore COrgan -> SOrgan MStore _ -> SItem MOrgans -> undefined -- slots from many lore kinds MOwned -> SItem MSkills -> undefined -- artificial slots MLore slore -> slore MPlaces -> undefined -- artificial slots loreFromContainer :: AspectRecord -> Container -> SLore loreFromContainer arItem c = case c of CFloor{} -> SItem CEmbed{} -> SEmbed CActor _ store -> if | checkFlag Ability.Blast arItem -> SBlast | checkFlag Ability.Condition arItem -> SCondition | otherwise -> loreFromMode $ MStore store CTrunk{} -> if checkFlag Ability.Blast arItem then SBlast else STrunk LambdaHack-0.9.5.0/engine-src/Game/LambdaHack/Common/JSFile.hs0000644000000000000000000000701407346545000021577 0ustar0000000000000000-- | Saving/loading to JS storeage, mimicking operations on files. module Game.LambdaHack.Common.JSFile ( encodeEOF, strictDecodeEOF , tryCreateDir, doesFileExist, tryWriteFile, readFile, renameFile ) where import Prelude () import Game.LambdaHack.Core.Prelude import Data.Binary import qualified Data.ByteString.Lazy.Char8 as LBS import qualified Data.Text as T import Data.Text.Encoding (decodeLatin1) import Data.Version import GHCJS.DOM (currentWindow) import GHCJS.DOM.Storage (getItem, removeItem, setItem) import GHCJS.DOM.Types (runDOM) import GHCJS.DOM.Window (getLocalStorage) -- | Serialize and save data with an EOF marker. In JS we don't have access -- to the zlib library, so we don't compress here. We treat the bytestring -- as Latin1 characters and so lose half of the storage space by ignoring -- the other half of the JS UTF16 characters, but in this way we ensure -- we never run into illegal characters in the aribtrary binary data, -- unlike when treating it as UTF16 characters. This is also reasonably fast. -- The @OK@ is used as an EOF marker to ensure any apparent problems with -- corrupted files are reported to the user ASAP. encodeEOF :: Binary b => FilePath -> Version -> b -> IO () encodeEOF path v b = flip runDOM undefined $ do Just win <- currentWindow storage <- getLocalStorage win setItem storage path $ decodeLatin1 $ LBS.toStrict $ encode (v, (encode b, "OK" :: String)) -- | Read and deserialize data with an EOF marker. -- The @OK@ EOF marker ensures any easily detectable file corruption -- is discovered and reported before any value is decoded from -- the second component. -- OTOH, binary encoding corruption is not discovered until a version -- check elswere ensures that binary formats are compatible. strictDecodeEOF :: Binary b => FilePath -> IO (Version, b) strictDecodeEOF path = flip runDOM undefined $ do Just win <- currentWindow storage <- getLocalStorage win Just item <- getItem storage path let c1 = LBS.pack $ T.unpack item (v1, (c2, s)) = decode c1 return $! if s == ("OK" :: String) then (v1, decode c2) else error $ "Fatal error: corrupted file " ++ path -- | Try to create a directory; not needed with local storage in JS. tryCreateDir :: FilePath -> IO () tryCreateDir _dir = return () doesFileExist :: FilePath -> IO Bool doesFileExist path = flip runDOM undefined $ do Just win <- currentWindow storage <- getLocalStorage win mitem <- getItem storage path let fileExists = isJust (mitem :: Maybe String) return $! fileExists tryWriteFile :: FilePath -> String -> IO () tryWriteFile path content = flip runDOM undefined $ do Just win <- currentWindow storage <- getLocalStorage win mitem <- getItem storage path let fileExists = isJust (mitem :: Maybe String) unless fileExists $ setItem storage path content readFile :: FilePath -> IO String readFile path = flip runDOM undefined $ do Just win <- currentWindow storage <- getLocalStorage win mitem <- getItem storage path case mitem of Nothing -> fail $ "Fatal error: no file " ++ path Just item -> return item renameFile :: FilePath -> FilePath -> IO () renameFile path path2 = flip runDOM undefined $ do Just win <- currentWindow storage <- getLocalStorage win mitem <- getItem storage path case mitem :: Maybe String of Nothing -> fail $ "Fatal error: no file " ++ path Just item -> do setItem storage path2 item -- overwrites removeItem storage path LambdaHack-0.9.5.0/engine-src/Game/LambdaHack/Common/Kind.hs0000644000000000000000000000775407346545000021363 0ustar0000000000000000-- | General content types and operations. module Game.LambdaHack.Common.Kind ( ContentData, COps(..) , emptyCOps , ItemSpeedup , emptyItemSpeedup, getKindMean, speedupItem , TileSpeedup(..), Tab(..) , emptyTileSpeedup, emptyTab , okind, omemberGroup, oisSingletonGroup, ouniqGroup, opick , ofoldlWithKey', ofoldlGroup', omapVector, oimapVector , olength, linearInterpolation ) where import Prelude () import Game.LambdaHack.Core.Prelude import qualified Data.Vector as V import qualified Data.Vector.Unboxed as U import Data.Word (Word8) import qualified Game.LambdaHack.Common.ItemAspect as IA import Game.LambdaHack.Content.CaveKind import Game.LambdaHack.Content.ItemKind (ItemKind) import qualified Game.LambdaHack.Content.ItemKind as IK import Game.LambdaHack.Content.ModeKind import Game.LambdaHack.Content.PlaceKind import Game.LambdaHack.Content.RuleKind import Game.LambdaHack.Content.TileKind (TileKind) import Game.LambdaHack.Definition.ContentData import Game.LambdaHack.Definition.Defs -- | Operations for all content types, gathered together. data COps = COps { cocave :: ContentData CaveKind -- server only , coitem :: ContentData ItemKind , comode :: ContentData ModeKind -- server only , coplace :: ContentData PlaceKind -- server only, so far , corule :: RuleContent , cotile :: ContentData TileKind , coItemSpeedup :: ItemSpeedup , coTileSpeedup :: TileSpeedup } instance Show COps where show _ = "game content" instance Eq COps where (==) _ _ = True emptyCOps :: COps emptyCOps = COps { cocave = emptyContentData , coitem = emptyContentData , comode = emptyContentData , coplace = emptyContentData , corule = emptyRuleContent , cotile = emptyContentData , coItemSpeedup = emptyItemSpeedup , coTileSpeedup = emptyTileSpeedup } -- | Map from an item kind identifier to the mean aspect value for the kind. newtype ItemSpeedup = ItemSpeedup (V.Vector IA.KindMean) emptyItemSpeedup :: ItemSpeedup emptyItemSpeedup = ItemSpeedup V.empty getKindMean :: ContentId IK.ItemKind -> ItemSpeedup -> IA.KindMean getKindMean kindId (ItemSpeedup is) = is V.! contentIdIndex kindId speedupItem :: ContentData IK.ItemKind -> ItemSpeedup speedupItem coitem = let f !kind = let kmMean = IA.meanAspect kind kmConst = not $ IA.aspectsRandom (IK.iaspects kind) in IA.KindMean{..} in ItemSpeedup $ omapVector coitem f -- | A lot of tabulated maps from tile kind identifier to a property -- of the tile kind. data TileSpeedup = TileSpeedup { isClearTab :: Tab Bool , isLitTab :: Tab Bool , isWalkableTab :: Tab Bool , isDoorTab :: Tab Bool , isChangableTab :: Tab Bool , isSuspectTab :: Tab Bool , isHideAsTab :: Tab Bool , consideredByAITab :: Tab Bool , isVeryOftenItemTab :: Tab Bool , isCommonItemTab :: Tab Bool , isOftenActorTab :: Tab Bool , isNoItemTab :: Tab Bool , isNoActorTab :: Tab Bool , isEasyOpenTab :: Tab Bool , isEmbedTab :: Tab Bool , isAquaticTab :: Tab Bool , alterMinSkillTab :: Tab Word8 , alterMinWalkTab :: Tab Word8 } -- Vectors of booleans can be slower than arrays, because they are not packed, -- but with growing cache sizes they may as well turn out faster at some point. -- The advantage of vectors are exposed internals, in particular unsafe -- indexing. Also, in JS, bool arrays are obviously not packed. -- | A map morally indexed by @ContentId TileKind@. newtype Tab a = Tab (U.Vector a) emptyTileSpeedup :: TileSpeedup emptyTileSpeedup = TileSpeedup emptyTab emptyTab emptyTab emptyTab emptyTab emptyTab emptyTab emptyTab emptyTab emptyTab emptyTab emptyTab emptyTab emptyTab emptyTab emptyTab emptyTab emptyTab emptyTab :: U.Unbox a => Tab a emptyTab = Tab $! U.empty LambdaHack-0.9.5.0/engine-src/Game/LambdaHack/Common/Level.hs0000644000000000000000000003256307346545000021541 0ustar0000000000000000{-# LANGUAGE TypeFamilies #-} -- | Inhabited dungeon levels and the operations to query and change them -- as the game progresses. module Game.LambdaHack.Common.Level ( -- * Dungeon Dungeon, dungeonBounds, ascendInBranch, whereTo -- * The @Level@ type and its components , ItemFloor, BigActorMap, ProjectileMap, TileMap, SmellMap, Level(..) -- * Component updates , updateFloor, updateEmbed, updateBigMap, updateProjMap , updateTile, updateEntry, updateSmell -- * Level query , at , posToBigLvl, occupiedBigLvl, posToProjsLvl, occupiedProjLvl, posToAidsLvl , findPosTry, findPosTry2, nearbyFreePoints -- * Misc , sortEmbeds #ifdef EXPOSE_INTERNAL -- * Internal operations , EntryMap , nearbyPassablePoints, assertSparseItems, assertSparseProjectiles #endif ) where import Prelude () import Game.LambdaHack.Core.Prelude import Data.Binary import qualified Data.EnumMap.Strict as EM import qualified Data.EnumSet as ES import Game.LambdaHack.Common.Area import Game.LambdaHack.Common.Item import Game.LambdaHack.Common.Kind import qualified Game.LambdaHack.Common.Tile as Tile import Game.LambdaHack.Common.Time import Game.LambdaHack.Common.Types import Game.LambdaHack.Common.Vector import Game.LambdaHack.Content.CaveKind (CaveKind) import qualified Game.LambdaHack.Content.ItemKind as IK import Game.LambdaHack.Content.PlaceKind import Game.LambdaHack.Content.RuleKind import Game.LambdaHack.Content.TileKind (TileKind) import qualified Game.LambdaHack.Core.Dice as Dice import Game.LambdaHack.Common.Point import qualified Game.LambdaHack.Common.PointArray as PointArray import Game.LambdaHack.Core.Random import Game.LambdaHack.Definition.Defs -- | The complete dungeon is a map from level identifiers to levels. type Dungeon = EM.EnumMap LevelId Level dungeonBounds :: Dungeon -> (LevelId, LevelId) dungeonBounds dungeon | Just ((s, _), _) <- EM.minViewWithKey dungeon , Just ((e, _), _) <- EM.maxViewWithKey dungeon = (s, e) dungeonBounds dungeon = error $ "empty dungeon" `showFailure` dungeon -- | Levels in the current branch, one level up (or down) from the current. ascendInBranch :: Dungeon -> Bool -> LevelId -> [LevelId] ascendInBranch dungeon up lid = -- Currently there is just one branch, so the computation is simple. let (minD, maxD) = dungeonBounds dungeon ln = max minD $ min maxD $ toEnum $ fromEnum lid + if up then 1 else -1 in case EM.lookup ln dungeon of Just _ | ln /= lid -> [ln] _ | ln == lid -> [] _ -> ascendInBranch dungeon up ln -- jump over gaps -- | Compute the level identifier and stair position on the new level, -- after a level change. -- -- We assume there is never a staircase up and down at the same position. whereTo :: LevelId -- ^ level of the stairs -> Point -- ^ position of the stairs -> Bool -- ^ optional forced direction -> Dungeon -- ^ current game dungeon -> [(LevelId, Point)] -- ^ possible destinations whereTo lid pos up dungeon = let lvl = dungeon EM.! lid li = case elemIndex pos $ fst $ lstair lvl of Just ifst -> assert up [ifst] Nothing -> case elemIndex pos $ snd $ lstair lvl of Just isnd -> assert (not up) [isnd] Nothing -> let forcedPoss = (if up then fst else snd) (lstair lvl) in [0 .. length forcedPoss - 1] -- for ascending via, e.g., spells in case ascendInBranch dungeon up lid of [] -> [] -- spell fizzles ln : _ -> let lvlDest = dungeon EM.! ln stairsDest = (if up then snd else fst) (lstair lvlDest) posAtIndex i = case drop i stairsDest of [] -> error $ "not enough stairs:" `showFailure` (ln, i + 1) p : _ -> (ln, p) in map posAtIndex li -- | Items located on map tiles. type ItemFloor = EM.EnumMap Point ItemBag -- | Big actors located on map tiles. type BigActorMap = EM.EnumMap Point ActorId -- | Collections of projectiles located on map tiles. type ProjectileMap = EM.EnumMap Point [ActorId] -- | Tile kinds on the map. type TileMap = PointArray.Array (ContentId TileKind) -- | Current smell on map tiles. type SmellMap = EM.EnumMap Point Time -- | Entries of places on the map. type EntryMap = EM.EnumMap Point PlaceEntry -- | A view on single, inhabited dungeon level. "Remembered" fields -- carry a subset of the info in the client copies of levels. data Level = Level { lkind :: ContentId CaveKind -- ^ the kind of cave the level is an instance of , ldepth :: Dice.AbsDepth -- ^ absolute depth of the level , lfloor :: ItemFloor -- ^ remembered items lying on the floor , lembed :: ItemFloor -- ^ remembered items embedded in the tile , lbig :: BigActorMap -- ^ seen big (non-projectile) actors at positions -- on the level; -- could be recomputed at resume, but small enough , lproj :: ProjectileMap -- ^ seen projectiles at positions on the level; -- could be recomputed at resume , ltile :: TileMap -- ^ remembered level map , lentry :: EntryMap -- ^ room entrances on the level , larea :: Area -- ^ area of the level , lsmell :: SmellMap -- ^ remembered smells on the level , lstair :: ([Point], [Point]) -- ^ positions of (up, down) stairs , lescape :: [Point] -- ^ positions of IK.Escape tiles , lseen :: Int -- ^ currently remembered clear tiles , lexpl :: Int -- ^ total number of explorable tiles , ltime :: Time -- ^ local time on the level (possibly frozen) , lnight :: Bool -- ^ whether the level is covered in darkness } deriving (Show, Eq) assertSparseItems :: ItemFloor -> ItemFloor assertSparseItems m = assert (EM.null (EM.filter EM.null m) `blame` "null floors found" `swith` m) m assertSparseProjectiles :: ProjectileMap -> ProjectileMap assertSparseProjectiles m = assert (EM.null (EM.filter null m) `blame` "null projectile lists found" `swith` m) m updateFloor :: (ItemFloor -> ItemFloor) -> Level -> Level updateFloor f lvl = lvl {lfloor = f (lfloor lvl)} updateEmbed :: (ItemFloor -> ItemFloor) -> Level -> Level updateEmbed f lvl = lvl {lembed = f (lembed lvl)} updateBigMap :: (BigActorMap -> BigActorMap) -> Level -> Level updateBigMap f lvl = lvl {lbig = f (lbig lvl)} updateProjMap :: (ProjectileMap -> ProjectileMap) -> Level -> Level updateProjMap f lvl = lvl {lproj = f (lproj lvl)} updateTile :: (TileMap -> TileMap) -> Level -> Level updateTile f lvl = lvl {ltile = f (ltile lvl)} updateEntry :: (EntryMap -> EntryMap) -> Level -> Level updateEntry f lvl = lvl {lentry = f (lentry lvl)} updateSmell :: (SmellMap -> SmellMap) -> Level -> Level updateSmell f lvl = lvl {lsmell = f (lsmell lvl)} -- | Query for tile kinds on the map. at :: Level -> Point -> ContentId TileKind {-# INLINE at #-} at Level{ltile} p = ltile PointArray.! p posToBigLvl :: Point -> Level -> Maybe ActorId {-# INLINE posToBigLvl #-} posToBigLvl pos lvl = EM.lookup pos $ lbig lvl occupiedBigLvl :: Point -> Level -> Bool {-# INLINE occupiedBigLvl #-} occupiedBigLvl pos lvl = pos `EM.member` lbig lvl posToProjsLvl :: Point -> Level -> [ActorId] {-# INLINE posToProjsLvl #-} posToProjsLvl pos lvl = EM.findWithDefault [] pos $ lproj lvl occupiedProjLvl :: Point -> Level -> Bool {-# INLINE occupiedProjLvl #-} occupiedProjLvl pos lvl = pos `EM.member` lproj lvl posToAidsLvl :: Point -> Level -> [ActorId] {-# INLINE posToAidsLvl #-} posToAidsLvl pos lvl = maybeToList (posToBigLvl pos lvl) ++ posToProjsLvl pos lvl -- | Try to find a random position on the map satisfying -- conjunction of the mandatory and an optional predicate. -- If the permitted number of attempts is not enough, -- try again the same number of times without the next optional predicate, -- and fall back to trying with only the mandatory predicate. findPosTry :: Int -- ^ the number of tries -> Level -- ^ look up in this level -> (Point -> ContentId TileKind -> Bool) -- ^ mandatory predicate -> [Point -> ContentId TileKind -> Bool] -- ^ optional predicates -> Rnd (Maybe Point) {-# INLINE findPosTry #-} findPosTry numTries lvl m = findPosTry2 numTries lvl m [] undefined findPosTry2 :: Int -- ^ the number of tries -> Level -- ^ look up in this level -> (Point -> ContentId TileKind -> Bool) -- ^ mandatory predicate -> [Point -> ContentId TileKind -> Bool] -- ^ optional predicates -> (Point -> ContentId TileKind -> Bool) -- ^ good to have pred. -> [Point -> ContentId TileKind -> Bool] -- ^ worst case predicates -> Rnd (Maybe Point) {-# INLINE findPosTry2 #-} findPosTry2 numTries Level{ltile, larea} m0 l g r = assert (numTries > 0) $ let (Point x0 y0, xspan, yspan) = spanArea larea accomodate :: Rnd (Maybe Point) -> (Point -> ContentId TileKind -> Bool) -> [Point -> ContentId TileKind -> Bool] -> Rnd (Maybe Point) {-# INLINE accomodate #-} accomodate fallback m = go where go :: [Point -> ContentId TileKind -> Bool] -> Rnd (Maybe Point) go [] = fallback go (hd : tl) = search numTries where search 0 = go tl search !k = do pxyRelative <- randomR (0, xspan * yspan - 1) -- Here we can't use @fromEnum@ and/or work with the @Int@ -- representation, because the span is different than @rXmax@. let Point{..} = punindex xspan pxyRelative pos = Point (x0 + px) (y0 + py) tile = ltile PointArray.! pos if m pos tile && hd pos tile then return $ Just pos else search (k - 1) rAndOnceOnlym0 = r ++ [\_ _ -> True] in accomodate (accomodate (return Nothing) m0 rAndOnceOnlym0) -- @pos@ and @tile@ not always needed, so not strict; -- the function arguments determine that thanks to inlining. (\pos tile -> m0 pos tile && g pos tile) l -- | Generate a list of all passable points on (connected component of) -- the level in the order of path distance from the starting position (BFS). -- The starting position needn't be passable and is always included. nearbyPassablePoints :: COps -> Level -> Point -> [Point] nearbyPassablePoints cops@COps{corule=RuleContent{rXmax, rYmax}} lvl start = let passable p = Tile.isEasyOpen (coTileSpeedup cops) (lvl `at` p) passableVic p = filter passable $ vicinityBounded rXmax rYmax p siftSingle :: Point -> (ES.EnumSet Point, [Point]) -> (ES.EnumSet Point, [Point]) siftSingle current (seen, sameDistance) = if current `ES.member` seen then (seen, sameDistance) else (ES.insert current seen, current : sameDistance) siftVicinity :: Point -> (ES.EnumSet Point, [Point]) -> (ES.EnumSet Point, [Point]) siftVicinity current seenAndSameDistance = let vic = passableVic current in foldr siftSingle seenAndSameDistance vic siftNearby :: (ES.EnumSet Point, [Point]) -> [Point] siftNearby (seen, sameDistance) = sameDistance ++ case foldr siftVicinity (seen, []) sameDistance of (_, []) -> [] (seen2, sameDistance2) -> siftNearby (seen2, sameDistance2) in siftNearby (ES.singleton start, [start]) nearbyFreePoints :: COps -> Level -> (ContentId TileKind -> Bool) -> Point -> [Point] nearbyFreePoints cops lvl f start = let good p = f (lvl `at` p) && Tile.isWalkable (coTileSpeedup cops) (lvl `at` p) && null (posToAidsLvl p lvl) in filter good $ nearbyPassablePoints cops lvl start -- We assume there are no stray embeds, not mentioned in the tile kind. -- OTOH, some of those mentioned may be used up and so not in the bag -- and it's OK. sortEmbeds :: COps -> (ItemId -> IK.ItemKind) -> ContentId TileKind -> ItemBag -> [(ItemId, ItemQuant)] sortEmbeds COps{cotile} getKind tk embedBag = let itemKindList = map (\(iid, kit) -> (getKind iid, (iid, kit))) (EM.assocs embedBag) grpList = Tile.embeddedItems cotile tk f grp (itemKind, _) = fromMaybe 0 (lookup grp $ IK.ifreq itemKind) > 0 in map snd $ mapMaybe (\grp -> find (f grp) itemKindList) grpList instance Binary Level where put Level{..} = do put lkind put ldepth put (assertSparseItems lfloor) put (assertSparseItems lembed) put lbig put (assertSparseProjectiles lproj) put ltile put lentry put larea put lsmell put lstair put lescape put lseen put lexpl put ltime put lnight get = do lkind <- get ldepth <- get lfloor <- get lembed <- get lbig <- get lproj <- get ltile <- get lentry <- get larea <- get lsmell <- get lstair <- get lescape <- get lseen <- get lexpl <- get ltime <- get lnight <- get return $! Level{..} LambdaHack-0.9.5.0/engine-src/Game/LambdaHack/Common/Misc.hs0000644000000000000000000000607107346545000021360 0ustar0000000000000000-- | Hacks that haven't found their home yet. module Game.LambdaHack.Common.Misc ( makePhrase, makeSentence, squashedWWandW , appDataDir , xM, xD, minusM, minusM1, minusM2, oneM, tenthM , show64With2 , workaroundOnMainThreadMVar ) where import Prelude () import Game.LambdaHack.Core.Prelude import Control.Concurrent import qualified Data.Char as Char import Data.Int (Int64) import qualified Data.Map as M import qualified NLP.Miniutter.English as MU import System.Directory (getAppUserDataDirectory) import System.Environment (getProgName) import System.IO.Unsafe (unsafePerformIO) -- | Re-exported English phrase creation functions, applied to our custom -- irregular word sets. makePhrase, makeSentence :: [MU.Part] -> Text makePhrase = MU.makePhrase irregular makeSentence = MU.makeSentence irregular irregular :: MU.Irregular irregular = MU.Irregular { irrPlural = M.fromList [ ("merchandise", "merchandise") , ("Merchandise", "Merchandise") ] -- this is both countable and uncountable, but I use it here -- only as uncountable, do I overwrite the default `M.union` MU.irrPlural MU.defIrregular , irrIndefinite = MU.irrIndefinite MU.defIrregular } -- | Apply the @WWandW@ constructor, first representing repetitions -- as @CardinalWs@. -- The parts are not sorted, only grouped, to keep the order. -- The internal structure of speech parts is compared, not their string -- rendering, so some coincidental clashes are avoided (and code is simpler). squashedWWandW :: [MU.Part] -> (MU.Part, MU.Person) squashedWWandW parts = let repetitions = group parts f [] = error $ "empty group" `showFailure` parts f [part] = (part, MU.Sg3rd) -- avoid prefixing hero names with "a" f l@(part : _) = (MU.CardinalWs (length l) part, MU.PlEtc) cars = map f repetitions person = case cars of [] -> error $ "empty cars" `showFailure` parts [(_, person1)] -> person1 _ -> MU.PlEtc in (MU.WWandW $ map fst cars, person) -- | Personal data directory for the game. Depends on the OS and the game, -- e.g., for LambdaHack under Linux it's @~\/.LambdaHack\/@. appDataDir :: IO FilePath appDataDir = do progName <- getProgName let name = takeWhile Char.isAlphaNum progName getAppUserDataDirectory name xM :: Int -> Int64 xM k = fromIntegral k * 1000000 xD :: Double -> Double xD k = k * 1000000 minusM, minusM1, minusM2, oneM, tenthM :: Int64 minusM = xM (-1) minusM1 = xM (-1) - 1 minusM2 = xM (-1) - 2 oneM = xM 1 tenthM = 100000 show64With2 :: Int64 -> Text show64With2 n = let k = 100 * n `div` oneM l = k `div` 100 x = k - l * 100 y = x `div` 10 in tshow l <> if | x == 0 -> "" | x == y * 10 -> "." <> tshow y | x < 10 -> ".0" <> tshow x | otherwise -> "." <> tshow x -- Global variable for passing the action to run on main thread, if any. workaroundOnMainThreadMVar :: MVar (IO ()) {-# NOINLINE workaroundOnMainThreadMVar #-} workaroundOnMainThreadMVar = unsafePerformIO newEmptyMVar LambdaHack-0.9.5.0/engine-src/Game/LambdaHack/Common/MonadStateRead.hs0000644000000000000000000001274607346545000023326 0ustar0000000000000000-- | Game state reading monad and basic operations. module Game.LambdaHack.Common.MonadStateRead ( MonadStateRead(..) , getState, getLevel , getGameMode, isNoConfirmsGame, getEntryArena, pickWeaponM, displayTaunt ) where import Prelude () import Game.LambdaHack.Core.Prelude import qualified Data.EnumMap.Strict as EM import Data.Text (Text) import qualified Game.LambdaHack.Definition.Ability as Ability import Game.LambdaHack.Common.Actor import Game.LambdaHack.Common.ActorState import Game.LambdaHack.Common.Faction import Game.LambdaHack.Core.Frequency import Game.LambdaHack.Common.Item import Game.LambdaHack.Common.Kind import Game.LambdaHack.Common.Level import Game.LambdaHack.Common.Types import Game.LambdaHack.Core.Random import Game.LambdaHack.Common.ReqFailure import Game.LambdaHack.Common.State import Game.LambdaHack.Content.ModeKind -- | Monad for reading game state. A state monad with state modification -- disallowed (another constraint is needed to permit that). -- The basic server and client monads are like that, because server -- and clients freely modify their internal session data, but don't modify -- the main game state, except in very restricted and synchronized way. class (Monad m, Functor m, Applicative m) => MonadStateRead m where getsState :: (State -> a) -> m a getState :: MonadStateRead m => m State getState = getsState id getLevel :: MonadStateRead m => LevelId -> m Level getLevel lid = getsState $ (EM.! lid) . sdungeon getGameMode :: MonadStateRead m => m ModeKind getGameMode = do COps{comode} <- getsState scops t <- getsState sgameModeId return $! okind comode t isNoConfirmsGame :: MonadStateRead m => m Bool isNoConfirmsGame = do gameMode <- getGameMode return $! maybe False (> 0) $ lookup "no confirms" $ mfreq gameMode getEntryArena :: MonadStateRead m => Faction -> m LevelId getEntryArena fact = do dungeon <- getsState sdungeon let (minD, maxD) = dungeonBounds dungeon f [] = 0 f ((ln, _, _) : _) = ln return $! max minD $ min maxD $ toEnum $ f $ ginitial fact pickWeaponM :: MonadStateRead m => Bool -> Maybe DiscoveryBenefit -> [(ItemId, ItemFullKit)] -> Ability.Skills -> ActorId -> m [(Double, (Int, (ItemId, ItemFullKit)))] pickWeaponM ignoreCharges mdiscoBenefit kitAss actorSk source = do sb <- getsState $ getActorBody source localTime <- getsState $ getLocalTime (blid sb) actorMaxSk <- getsState $ getActorMaxSkills source let calmE = calmEnough sb actorMaxSk forced = bproj sb permitted = permittedPrecious forced calmE preferredPrecious = either (const False) id . permitted permAssocs = filter (preferredPrecious . fst . snd) kitAss strongest = strongestMelee ignoreCharges mdiscoBenefit localTime permAssocs return $! if | forced -> map (\ii -> (1, (1, ii))) kitAss | Ability.getSk Ability.SkMelee actorSk <= 0 -> [] | otherwise -> strongest displayTaunt :: MonadStateRead m => Bool -> (Rnd (Text, Text) -> m (Text, Text)) -> ActorId -> m (Text, Text) displayTaunt _voluntary rndToAction aid = do b <- getsState $ getActorBody aid actorMaxSk <- getsState $ getActorMaxSkills aid let canApply = Ability.getSk Ability.SkApply actorMaxSk > 2 && canHear -- if applies complex items, probably intelligent and can speak canHear = Ability.getSk Ability.SkHearing actorMaxSk > 0 && canBrace -- if hears, probably also emits sound vocally; -- disabled even by ushanka and rightly so canBrace = Ability.getSk Ability.SkWait actorMaxSk >= 2 -- not an insect, plant, geyser, faucet, fence, etc. -- so can emit sound by hitting something with body parts || Ability.getSk Ability.SkApply actorMaxSk > 2 -- and neither an impatient intelligent actor braceUneasy = [ (2, ("something", "flail around")) , (1, ("something", "toss blindly")) , (1, ("something", "squirm dizzily")) ] braceEasy = [ (2, ("something", "stretch")) , (1, ("something", "fidget")) , (1, ("something", "fret")) ] uneasy = deltasSerious (bcalmDelta b) || not (calmEnough b actorMaxSk) if bwatch b `elem` [WSleep, WWake] then rndToAction $ frequency $ toFreq "SfxTaunt" $ if uneasy then if | canApply -> (5, ("somebody", "yell")) : (3, ("somebody", "bellow")) : braceUneasy | canHear -> (5, ("somebody", "bellow")) : (3, ("something", "hiss")) : braceUneasy | canBrace -> braceUneasy | otherwise -> [(1, ("something", "drone enquiringly"))] else if | canApply -> (5, ("somebody", "yawn")) : (3, ("somebody", "grunt")) : braceEasy | canHear -> (5, ("somebody", "grunt")) : (3, ("something", "wheeze")) : braceEasy | canBrace -> braceEasy | otherwise -> [(1, ("something", "hum silently"))] else return $! if | canApply -> ("somebody", "holler a taunt") | canHear -> ("somebody", "growl menacingly") | canBrace -> ("something", "stomp repeatedly") | otherwise -> ("something", "buzz angrily") LambdaHack-0.9.5.0/engine-src/Game/LambdaHack/Common/Perception.hs0000644000000000000000000000623607346545000022600 0ustar0000000000000000{-# LANGUAGE DeriveGeneric, GeneralizedNewtypeDeriving #-} -- | Actors perceiving other actors and the dungeon level. -- -- Visibility works according to KISS. Everything that player sees is real. -- There are no unmarked hidden tiles and only solid tiles can be marked, -- so there are no invisible walls and to pass through an illusory wall, -- you have to use a turn bumping into it first. Only tiles marked with Suspect -- can turn out to be another tile. (So, if all tiles are marked with -- Suspect, the player knows nothing for sure, but this should be avoided, -- because searching becomes too time-consuming.) -- Each actor sees adjacent tiles, even when blind, so adjacent tiles are -- known, so the actor can decide accurately whether to pass thorugh -- or alter, etc. -- -- Items are always real and visible. Actors are real, but can be invisible. -- Invisible actors in walls can't be hit, but are hinted at when altering -- the tile, so the player can flee or block. Invisible actors in open -- space can be hit. module Game.LambdaHack.Common.Perception ( PerVisible(..) , PerSmelled(..) , Perception(..) , PerLid , PerFid , totalVisible, totalSmelled , emptyPer, nullPer, addPer, diffPer ) where import Prelude () import Game.LambdaHack.Core.Prelude import Data.Binary import qualified Data.EnumMap.Strict as EM import qualified Data.EnumSet as ES import GHC.Generics (Generic) import Game.LambdaHack.Common.Types import Game.LambdaHack.Common.Point -- | Visible positions. newtype PerVisible = PerVisible {pvisible :: ES.EnumSet Point} deriving (Show, Eq, Binary) -- | Smelled positions. newtype PerSmelled = PerSmelled {psmelled :: ES.EnumSet Point} deriving (Show, Eq, Binary) -- | The type representing the perception of a faction on a level. data Perception = Perception { psight :: PerVisible , psmell :: PerSmelled } deriving (Show, Eq, Generic) instance Binary Perception -- | Perception of a single faction, indexed by level identifier. type PerLid = EM.EnumMap LevelId Perception -- | Perception indexed by faction identifier. -- This can't be added to @FactionDict@, because clients can't see it -- for other factions. type PerFid = EM.EnumMap FactionId PerLid -- | The set of tiles visible by at least one hero. totalVisible :: Perception -> ES.EnumSet Point totalVisible = pvisible . psight -- | The set of tiles smelt by at least one hero. totalSmelled :: Perception -> ES.EnumSet Point totalSmelled = psmelled . psmell emptyPer :: Perception emptyPer = Perception { psight = PerVisible ES.empty , psmell = PerSmelled ES.empty } nullPer :: Perception -> Bool nullPer per = per == emptyPer addPer :: Perception -> Perception -> Perception addPer per1 per2 = Perception { psight = PerVisible $ totalVisible per1 `ES.union` totalVisible per2 , psmell = PerSmelled $ totalSmelled per1 `ES.union` totalSmelled per2 } diffPer :: Perception -> Perception -> Perception diffPer per1 per2 = Perception { psight = PerVisible $ totalVisible per1 ES.\\ totalVisible per2 , psmell = PerSmelled $ totalSmelled per1 ES.\\ totalSmelled per2 } LambdaHack-0.9.5.0/engine-src/Game/LambdaHack/Common/Point.hs0000644000000000000000000001315407346545000021556 0ustar0000000000000000{-# LANGUAGE DeriveGeneric #-} -- | Basic operations on 2D points represented as linear offsets. module Game.LambdaHack.Common.Point ( Point(..), PointI , chessDist, euclidDistSq, adjacent, bla, fromTo , originPoint , speedupHackXSize #ifdef EXPOSE_INTERNAL -- * Internal operations , blaXY, balancedWord #endif ) where import Prelude () import Game.LambdaHack.Core.Prelude import Data.Binary import Data.Int (Int32) import qualified Data.Primitive.PrimArray as PA import GHC.Generics (Generic) import Game.LambdaHack.Definition.Defs -- | This is a hack to pass the X size of the dungeon, defined -- in game content, to the @Enum@ instances of @Point@ and @Vector@. -- This is already slower and has higher allocation than -- hardcoding the value, so passing the value explicitly to -- a generalization of the @Enum@ conversions is out of the question. -- Perhaps this can be done cleanly and efficiently at link-time -- via Backpack, but it's probably not supported yet by GHCJS (not verified). -- For now, we need to be careful never to modify this array, -- except for setting it at program start before it's used for the first time. -- Which is easy, because @Point@ is never mentioned in content definitions. -- The @PrimArray@ has much smaller overhead than @IORef@ -- and reading from it looks cleaner, hence its use. speedupHackXSize :: PA.PrimArray X {-# NOINLINE speedupHackXSize #-} speedupHackXSize = PA.primArrayFromList [80] -- updated at program startup -- | 2D points in cartesian representation. Coordinates grow to the right -- and down, so that the (0, 0) point is in the top-left corner of the screen. -- Coordinates are never negative. data Point = Point { px :: X , py :: Y } deriving (Eq, Ord, Generic) instance Show Point where show (Point x y) = show (x, y) instance Binary Point where put = put . (fromIntegral :: Int -> Int32) . fromEnum get = fmap (toEnum . (fromIntegral :: Int32 -> Int)) get -- Note that @Ord@ on @Int@ is not monotonic wrt @Ord@ on @Point@. -- We need to keep it that way, because we want close xs to have close indexes, -- e.g., adjacent points in line to have adjacent enumerations, -- because some of the screen layout and most of processing is line-by-line. -- Consequently, one can use EM.fromAscList on @(1, 8)..(10, 8)@, but not on -- @(1, 7)..(10, 9)@. instance Enum Point where fromEnum Point{..} = let !xsize = PA.indexPrimArray speedupHackXSize 0 in #ifdef WITH_EXPENSIVE_ASSERTIONS assert (px >= 0 && py >= 0 && px < xsize `blame` "invalid point coordinates" `swith` (px, py)) #endif (px + py * xsize) toEnum n = let !xsize = PA.indexPrimArray speedupHackXSize 0 (py, px) = n `quotRem` xsize in Point{..} -- | Enumeration representation of @Point@. type PointI = Int -- | The distance between two points in the chessboard metric. chessDist :: Point -> Point -> Int chessDist (Point x0 y0) (Point x1 y1) = max (abs (x1 - x0)) (abs (y1 - y0)) -- | Squared euclidean distance between two points. euclidDistSq :: Point -> Point -> Int euclidDistSq (Point x0 y0) (Point x1 y1) = (x1 - x0) ^ (2 :: Int) + (y1 - y0) ^ (2 :: Int) -- | Checks whether two points are adjacent on the map -- (horizontally, vertically or diagonally). adjacent :: Point -> Point -> Bool {-# INLINE adjacent #-} adjacent s t = chessDist s t == 1 -- | Bresenham's line algorithm generalized to arbitrary starting @eps@ -- (@eps@ value of 0 gives the standard BLA). -- Skips the source point and goes through the second point -- to the edge of the level. Gives @Nothing@ if the points are equal. -- The target is given as @Point@ to permit aiming out of the level, -- e.g., to get uniform distributions of directions for explosions -- close to the edge of the level. bla :: X -> Y -> Int -> Point -> Point -> Maybe [Point] bla rXmax rYmax eps source target = if source == target then Nothing else Just $ let inBounds p@(Point x y) = rXmax > x && x >= 0 && rYmax > y && y >= 0 && p /= source in takeWhile inBounds $ tail $ blaXY eps source target -- | Bresenham's line algorithm generalized to arbitrary starting @eps@ -- (@eps@ value of 0 gives the standard BLA). Includes the source point -- and goes through the target point to infinity. blaXY :: Int -> Point -> Point -> [Point] blaXY eps (Point x0 y0) (Point x1 y1) = let (dx, dy) = (x1 - x0, y1 - y0) xyStep b (x, y) = (x + signum dx, y + signum dy * b) yxStep b (x, y) = (x + signum dx * b, y + signum dy) (p, q, step) | abs dx > abs dy = (abs dy, abs dx, xyStep) | otherwise = (abs dx, abs dy, yxStep) bw = balancedWord p q (eps `mod` max 1 q) walk w xy = xy : walk (tail w) (step (head w) xy) in map (uncurry Point) $ walk bw (x0, y0) -- | See . balancedWord :: Int -> Int -> Int -> [Int] balancedWord p q eps | eps + p < q = 0 : balancedWord p q (eps + p) balancedWord p q eps = 1 : balancedWord p q (eps + p - q) -- | A list of all points on a straight vertical or straight horizontal line -- between two points. Fails if no such line exists. fromTo :: Point -> Point -> [Point] fromTo (Point x0 y0) (Point x1 y1) = let fromTo1 :: Int -> Int -> [Int] fromTo1 z0 z1 | z0 <= z1 = [z0..z1] | otherwise = [z0,z0-1..z1] result | x0 == x1 = map (Point x0) (fromTo1 y0 y1) | y0 == y1 = map (`Point` y0) (fromTo1 x0 x1) | otherwise = error $ "diagonal fromTo" `showFailure` ((x0, y0), (x1, y1)) in result originPoint :: Point originPoint = Point 0 0 LambdaHack-0.9.5.0/engine-src/Game/LambdaHack/Common/PointArray.hs0000644000000000000000000002645207346545000022562 0ustar0000000000000000{-# LANGUAGE FlexibleContexts, StandaloneDeriving, TypeFamilies #-} -- | Arrays, based on Data.Vector.Unboxed, indexed by @Point@. module Game.LambdaHack.Common.PointArray ( UnboxRepClass(..), Array(..) , empty, (!), accessI, (//), unsafeUpdateA, unsafeWriteA, unsafeWriteManyA , replicateA, replicateMA, generateA, generateMA, unfoldrNA, sizeA , foldrA, foldrA', foldlA', ifoldrA, ifoldrA', ifoldlA', foldMA', ifoldMA' , mapA, imapA, imapMA_, safeSetA, unsafeSetA , minIndexA, minLastIndexA, minIndexesA, maxIndexA, maxIndexByA, maxLastIndexA , forceA, fromListA, toListA #ifdef EXPOSE_INTERNAL -- * Internal operations , toUnboxRep #endif ) where import Prelude () import Game.LambdaHack.Core.Prelude import Control.Monad.ST.Strict import Data.Binary import Data.Vector.Binary () import qualified Data.Vector.Fusion.Bundle as Bundle import qualified Data.Vector.Generic as G import qualified Data.Vector.Unboxed as U import qualified Data.Vector.Unboxed.Mutable as VM import Game.LambdaHack.Common.Point import qualified Game.LambdaHack.Definition.Color as Color import Game.LambdaHack.Definition.Defs class ( Ord c, Eq (UnboxRep c), Ord (UnboxRep c), Bounded (UnboxRep c) , Binary (UnboxRep c), U.Unbox (UnboxRep c) ) => UnboxRepClass c where type UnboxRep c type instance UnboxRep c = c toUnboxRepUnsafe :: c -> UnboxRep c -- has to be total fromUnboxRep :: UnboxRep c -> c -- has to be total instance UnboxRepClass Bool where toUnboxRepUnsafe c = c fromUnboxRep c = c instance UnboxRepClass Word8 where toUnboxRepUnsafe c = c fromUnboxRep c = c instance UnboxRepClass (ContentId k) where type UnboxRep (ContentId k) = Word16 toUnboxRepUnsafe = fromContentId fromUnboxRep = toContentId instance UnboxRepClass Color.AttrCharW32 where type UnboxRep Color.AttrCharW32 = Word32 toUnboxRepUnsafe = Color.attrCharW32 fromUnboxRep = Color.AttrCharW32 -- | Arrays indexed by @Point@. data Array c = Array { axsize :: X , aysize :: Y , avector :: U.Vector (UnboxRep c) } deriving instance UnboxRepClass c => Eq (Array c) instance Show (Array c) where show a = "PointArray.Array with size " ++ show (axsize a, aysize a) instance UnboxRepClass c => Binary (Array c) where put Array{..} = do put axsize put aysize put avector get = do axsize <- get aysize <- get avector <- get return $! Array{..} toUnboxRep :: UnboxRepClass c => c -> UnboxRep c {-# INLINE toUnboxRep #-} toUnboxRep c = #ifdef WITH_EXPENSIVE_ASSERTIONS assert (c <= fromUnboxRep maxBound) $ #endif toUnboxRepUnsafe c empty :: UnboxRepClass c => Array c empty = Array 0 0 U.empty -- Note: there's no point specializing this to @Point@ arguments, -- since the extra few additions in @fromPoint@ may be less expensive than -- memory or register allocations needed for the extra @Int@ in @Point@. -- | Array lookup. (!) :: UnboxRepClass c => Array c -> Point -> c {-# INLINE (!) #-} (!) Array{..} p = fromUnboxRep $ avector U.! fromEnum p accessI :: UnboxRepClass c => Array c -> Int -> UnboxRep c {-# INLINE accessI #-} accessI Array{..} p = avector `U.unsafeIndex` p -- | Construct an array updated with the association list. (//) :: UnboxRepClass c => Array c -> [(Point, c)] -> Array c {-# INLINE (//) #-} (//) Array{..} l = let v = avector U.// map (fromEnum *** toUnboxRep) l in Array{avector = v, ..} unsafeUpdateA :: UnboxRepClass c => Array c -> [(Point, c)] -> () {-# INLINE unsafeUpdateA #-} unsafeUpdateA Array{..} l = runST $ do vThawed <- U.unsafeThaw avector mapM_ (\(p, c) -> VM.write vThawed (fromEnum p) (toUnboxRep c)) l void $ U.unsafeFreeze vThawed unsafeWriteA :: UnboxRepClass c => Array c -> Point -> c -> () {-# INLINE unsafeWriteA #-} unsafeWriteA Array{..} p c = runST $ do vThawed <- U.unsafeThaw avector VM.write vThawed (fromEnum p) (toUnboxRep c) void $ U.unsafeFreeze vThawed unsafeWriteManyA :: UnboxRepClass c => Array c -> [Point] -> c -> () {-# INLINE unsafeWriteManyA #-} unsafeWriteManyA Array{..} l c = runST $ do vThawed <- U.unsafeThaw avector let d = toUnboxRep c mapM_ (\p -> VM.write vThawed (fromEnum p) d) l void $ U.unsafeFreeze vThawed -- | Create an array from a replicated element. replicateA :: UnboxRepClass c => X -> Y -> c -> Array c {-# INLINE replicateA #-} replicateA axsize aysize c = Array{avector = U.replicate (axsize * aysize) $ toUnboxRep c, ..} -- | Create an array from a replicated monadic action. replicateMA :: (Monad m, UnboxRepClass c) => X -> Y -> m c -> m (Array c) {-# INLINE replicateMA #-} replicateMA axsize aysize m = do v <- U.replicateM (axsize * aysize) $ liftM toUnboxRep m return $! Array{avector = v, ..} -- | Create an array from a function. generateA :: UnboxRepClass c => X -> Y -> (Point -> c) -> Array c {-# INLINE generateA #-} generateA axsize aysize f = let g n = toUnboxRep $ f $ toEnum n in Array{avector = U.generate (axsize * aysize) g, ..} -- | Create an array from a monadic function. generateMA :: (Monad m, UnboxRepClass c) => X -> Y -> (Point -> m c) -> m (Array c) {-# INLINE generateMA #-} generateMA axsize aysize fm = do let gm n = liftM toUnboxRep $ fm $ toEnum n v <- U.generateM (axsize * aysize) gm return $! Array{avector = v, ..} unfoldrNA :: UnboxRepClass c => X -> Y -> (b -> (c, b)) -> b -> Array c {-# INLINE unfoldrNA #-} unfoldrNA axsize aysize fm b = let gm = Just . first toUnboxRep . fm v = U.unfoldrN (axsize * aysize) gm b in Array {avector = v, ..} -- | Content identifiers array size. sizeA :: Array c -> (X, Y) {-# INLINE sizeA #-} sizeA Array{..} = (axsize, aysize) -- | Fold right over an array. foldrA :: UnboxRepClass c => (c -> a -> a) -> a -> Array c -> a {-# INLINE foldrA #-} foldrA f z0 Array{..} = U.foldr (\c a-> f (fromUnboxRep c) a) z0 avector -- | Fold right strictly over an array. foldrA' :: UnboxRepClass c => (c -> a -> a) -> a -> Array c -> a {-# INLINE foldrA' #-} foldrA' f z0 Array{..} = U.foldr' (\c a-> f (fromUnboxRep c) a) z0 avector -- | Fold left strictly over an array. foldlA' :: UnboxRepClass c => (a -> c -> a) -> a -> Array c -> a {-# INLINE foldlA' #-} foldlA' f z0 Array{..} = U.foldl' (\a c -> f a (fromUnboxRep c)) z0 avector -- | Fold left strictly over an array -- (function applied to each element and its index). ifoldlA' :: UnboxRepClass c => (a -> Point -> c -> a) -> a -> Array c -> a {-# INLINE ifoldlA' #-} ifoldlA' f z0 Array{..} = U.ifoldl' (\a n c -> f a (toEnum n) (fromUnboxRep c)) z0 avector -- | Fold right over an array -- (function applied to each element and its index). ifoldrA :: UnboxRepClass c => (Point -> c -> a -> a) -> a -> Array c -> a {-# INLINE ifoldrA #-} ifoldrA f z0 Array{..} = U.ifoldr (\n c a -> f (toEnum n) (fromUnboxRep c) a) z0 avector -- | Fold right strictly over an array -- (function applied to each element and its index). ifoldrA' :: UnboxRepClass c => (Point -> c -> a -> a) -> a -> Array c -> a {-# INLINE ifoldrA' #-} ifoldrA' f z0 Array{..} = U.ifoldr' (\n c a -> f (toEnum n) (fromUnboxRep c) a) z0 avector -- | Fold monadically strictly over an array. foldMA' :: (Monad m, UnboxRepClass c) => (a -> c -> m a) -> a -> Array c -> m a {-# INLINE foldMA' #-} foldMA' f z0 Array{..} = U.foldM' (\a c -> f a (fromUnboxRep c)) z0 avector -- | Fold monadically strictly over an array -- (function applied to each element and its index). ifoldMA' :: (Monad m, UnboxRepClass c) => (a -> Point -> c -> m a) -> a -> Array c -> m a {-# INLINE ifoldMA' #-} ifoldMA' f z0 Array{..} = U.ifoldM' (\a n c -> f a (toEnum n) (fromUnboxRep c)) z0 avector -- | Map over an array. mapA :: (UnboxRepClass c, UnboxRepClass d) => (c -> d) -> Array c -> Array d {-# INLINE mapA #-} mapA f Array{..} = Array{avector = U.map (toUnboxRep . f . fromUnboxRep) avector, ..} -- | Map over an array (function applied to each element and its index). imapA :: (UnboxRepClass c, UnboxRepClass d) => (Point -> c -> d) -> Array c -> Array d {-# INLINE imapA #-} imapA f Array{..} = let v = U.imap (\n c -> toUnboxRep $ f (toEnum n) (fromUnboxRep c)) avector in Array{avector = v, ..} -- | Map monadically over an array (function applied to each element -- and its index) and ignore the results. imapMA_ :: (Monad m, UnboxRepClass c) => (Point -> c -> m ()) -> Array c -> m () {-# INLINE imapMA_ #-} imapMA_ f Array{..} = U.imapM_ (\n c -> f (toEnum n) (fromUnboxRep c)) avector -- | Set all elements to the given value, in place. unsafeSetA :: UnboxRepClass c => c -> Array c -> Array c {-# INLINE unsafeSetA #-} unsafeSetA c Array{..} = runST $ do vThawed <- U.unsafeThaw avector VM.set vThawed (toUnboxRep c) vFrozen <- U.unsafeFreeze vThawed return $! Array{avector = vFrozen, ..} -- | Set all elements to the given value, in place, if possible. safeSetA :: UnboxRepClass c => c -> Array c -> Array c {-# INLINE safeSetA #-} safeSetA c Array{..} = Array{avector = U.modify (\v -> VM.set v (toUnboxRep c)) avector, ..} -- | Yield the point coordinates of a minimum element of the array. -- The array may not be empty. minIndexA :: UnboxRepClass c => Array c -> Point {-# INLINE minIndexA #-} minIndexA Array{..} = toEnum $ U.minIndex avector -- | Yield the point coordinates of the last minimum element of the array. -- The array may not be empty. minLastIndexA :: UnboxRepClass c => Array c -> Point {-# INLINE minLastIndexA #-} minLastIndexA Array{..} = toEnum $ fst . Bundle.foldl1' imin . Bundle.indexed . G.stream $ avector where imin (i, x) (j, y) = i `seq` j `seq` if x >= y then (j, y) else (i, x) -- | Yield the point coordinates of all the minimum elements of the array. -- The array may not be empty. minIndexesA :: UnboxRepClass c => Array c -> [Point] {-# INLINE minIndexesA #-} minIndexesA Array{..} = Bundle.foldr imin [] . Bundle.indexed . G.stream $ avector where imin (i, x) acc = if x == minE then let !j = toEnum i in j : acc else acc !minE = U.minimum avector -- | Yield the point coordinates of the first maximum element of the array. -- The array may not be empty. maxIndexA :: UnboxRepClass c => Array c -> Point {-# INLINE maxIndexA #-} maxIndexA Array{..} = toEnum $ U.maxIndex avector -- | Yield the point coordinates of the first maximum element of the array. -- The array may not be empty. maxIndexByA :: UnboxRepClass c => (c -> c -> Ordering) -> Array c -> Point {-# INLINE maxIndexByA #-} maxIndexByA f Array{..} = let g a b = f (fromUnboxRep a) (fromUnboxRep b) in toEnum $ U.maxIndexBy g avector -- | Yield the point coordinates of the last maximum element of the array. -- The array may not be empty. maxLastIndexA :: UnboxRepClass c => Array c -> Point {-# INLINE maxLastIndexA #-} maxLastIndexA Array{..} = toEnum $ fst . Bundle.foldl1' imax . Bundle.indexed . G.stream $ avector where imax (i, x) (j, y) = i `seq` j `seq` if x <= y then (j, y) else (i, x) -- | Force the array not to retain any extra memory. forceA :: UnboxRepClass c => Array c -> Array c {-# INLINE forceA #-} forceA Array{..} = Array{avector = U.force avector, ..} fromListA :: UnboxRepClass c => X -> Y -> [c] -> Array c {-# INLINE fromListA #-} fromListA axsize aysize l = Array{avector = U.fromListN (axsize * aysize) $ map toUnboxRep l, ..} toListA :: UnboxRepClass c => Array c -> [c] {-# INLINE toListA #-} toListA Array{..} = map fromUnboxRep $ U.toList avector LambdaHack-0.9.5.0/engine-src/Game/LambdaHack/Common/ReqFailure.hs0000644000000000000000000002221707346545000022524 0ustar0000000000000000{-# LANGUAGE DeriveGeneric #-} -- | Possible causes of failure of request. module Game.LambdaHack.Common.ReqFailure ( ReqFailure(..) , impossibleReqFailure, showReqFailure , permittedPrecious, permittedProject, permittedProjectAI, permittedApply #ifdef EXPOSE_INTERNAL -- * Internal operations #endif ) where import Prelude () import Game.LambdaHack.Core.Prelude import Data.Binary import GHC.Generics (Generic) import Game.LambdaHack.Common.Item import qualified Game.LambdaHack.Common.ItemAspect as IA import Game.LambdaHack.Common.Time import qualified Game.LambdaHack.Content.ItemKind as IK import qualified Game.LambdaHack.Definition.Ability as Ability -- | Possible causes of failure of request. data ReqFailure = MoveUnskilled | MoveNothing | MeleeUnskilled | MeleeSelf | MeleeDistant | DisplaceUnskilled | DisplaceDistant | DisplaceAccess | DisplaceMultiple | DisplaceDying | DisplaceBraced | DisplaceImmobile | DisplaceSupported | AlterUnskilled | AlterUnwalked | AlterDistant | AlterBlockActor | AlterBlockItem | AlterNothing | WaitUnskilled | YellUnskilled | MoveItemUnskilled | EqpOverfull | EqpStackFull | ApplyUnskilled | ApplyFood | ApplyRead | ApplyPeriodic | ApplyOutOfReach | ApplyCharging | ApplyNoEffects | ItemNothing | ItemNotCalm | NotCalmPrecious | ProjectUnskilled | ProjectAimOnself | ProjectBlockTerrain | ProjectBlockActor | ProjectLobable | ProjectOutOfReach | TriggerNothing | NoChangeDunLeader deriving (Show, Eq, Generic) instance Binary ReqFailure impossibleReqFailure :: ReqFailure -> Bool impossibleReqFailure reqFailure = case reqFailure of MoveUnskilled -> False -- unidentified skill items MoveNothing -> True MeleeUnskilled -> False -- unidentified skill items MeleeSelf -> True MeleeDistant -> True DisplaceUnskilled -> False -- unidentified skill items DisplaceDistant -> True DisplaceAccess -> True DisplaceMultiple -> True DisplaceDying -> True DisplaceBraced -> True DisplaceImmobile -> False -- unidentified skill items DisplaceSupported -> False AlterUnskilled -> False -- unidentified skill items AlterUnwalked -> False AlterDistant -> True AlterBlockActor -> True -- adjacent actor always visible AlterBlockItem -> True -- adjacent item always visible AlterNothing -> True WaitUnskilled -> False -- unidentified skill items YellUnskilled -> False -- unidentified skill items MoveItemUnskilled -> False -- unidentified skill items EqpOverfull -> True EqpStackFull -> True ApplyUnskilled -> False -- unidentified skill items ApplyFood -> False -- unidentified skill items ApplyRead -> False -- unidentified skill items ApplyPeriodic -> False -- unidentified skill items ApplyOutOfReach -> True ApplyCharging -> False -- if aspect record unknown, charging unknown ApplyNoEffects -> False -- if effects unknown, can't prevent it ItemNothing -> True ItemNotCalm -> False -- unidentified skill items NotCalmPrecious -> False -- unidentified skill items ProjectUnskilled -> False -- unidentified skill items ProjectAimOnself -> True ProjectBlockTerrain -> True -- adjacent terrain always visible ProjectBlockActor -> True -- adjacent actor always visible ProjectLobable -> False -- unidentified skill items ProjectOutOfReach -> True TriggerNothing -> True -- terrain underneath always visible NoChangeDunLeader -> True showReqFailure :: ReqFailure -> Text showReqFailure reqFailure = case reqFailure of MoveUnskilled -> "too low movement stat" MoveNothing -> "wasting time on moving into obstacle" MeleeUnskilled -> "too low melee combat stat" MeleeSelf -> "trying to melee oneself" MeleeDistant -> "trying to melee a distant foe" DisplaceUnskilled -> "too low actor displacing stat" DisplaceDistant -> "trying to displace a distant actor" DisplaceAccess -> "trying to switch places without access" DisplaceMultiple -> "trying to displace multiple actors" DisplaceDying -> "trying to displace a dying foe" DisplaceBraced -> "trying to displace a braced foe" DisplaceImmobile -> "trying to displace an immobile foe" DisplaceSupported -> "trying to displace a foe supported by teammates" AlterUnskilled -> "alter stat is needed to search or exploit terrain" AlterUnwalked -> "too low altering stat to enter or exploit terrain" AlterDistant -> "trying to alter distant terrain" AlterBlockActor -> "blocked by an actor" AlterBlockItem -> "jammed by an item" AlterNothing -> "wasting time on altering nothing" WaitUnskilled -> "too low wait stat" YellUnskilled -> "actors unskilled in waiting cannot yell/yawn" MoveItemUnskilled -> "too low item moving stat" EqpOverfull -> "cannot equip any more items" EqpStackFull -> "cannot equip the whole item stack" ApplyUnskilled -> "too low item applying stat" ApplyFood -> "eating food requires apply stat 2" ApplyRead -> "activating cultural artifacts requires apply stat 3" ApplyPeriodic -> "manually activating periodic items requires apply stat 4" ApplyOutOfReach -> "cannot apply an item out of reach" ApplyCharging -> "cannot apply an item that is still charging" ApplyNoEffects -> "cannot apply an item that produces no effect" ItemNothing -> "wasting time on void item manipulation" ItemNotCalm -> "you are too alarmed to use the shared stash" NotCalmPrecious -> "you are too alarmed to handle such an exquisite item" ProjectUnskilled -> "too low item flinging stat" ProjectAimOnself -> "cannot aim at oneself" ProjectBlockTerrain -> "aiming obstructed by terrain" ProjectBlockActor -> "aiming blocked by an actor" ProjectLobable -> "flinging a lobable item that stops at target position requires fling stat 3" ProjectOutOfReach -> "cannot aim an item out of reach" TriggerNothing -> "wasting time on triggering nothing" NoChangeDunLeader -> "no manual level change for your team" -- The item should not be applied nor thrown because it's too delicate -- to operate when not calm or because it's too precious to identify by use. permittedPrecious :: Bool -> Bool -> ItemFull -> Either ReqFailure Bool permittedPrecious forced calmE itemFull@ItemFull{itemDisco} = let arItem = aspectRecordFull itemFull isPrecious = IA.checkFlag Ability.Precious arItem in if not forced && not calmE && isPrecious then Left NotCalmPrecious else Right $ IA.checkFlag Ability.Durable arItem || case itemDisco of ItemDiscoFull{} -> True _ -> not isPrecious -- Simplified, faster version, for inner AI loop. permittedPreciousAI :: Bool -> ItemFull -> Bool permittedPreciousAI calmE itemFull@ItemFull{itemDisco} = let arItem = aspectRecordFull itemFull isPrecious = IA.checkFlag Ability.Precious arItem in (calmE || not isPrecious) && IA.checkFlag Ability.Durable arItem || case itemDisco of ItemDiscoFull{} -> True _ -> not isPrecious permittedProject :: Bool -> Int -> Bool -> ItemFull -> Either ReqFailure Bool permittedProject forced skill calmE itemFull = let arItem = aspectRecordFull itemFull in if | not forced && skill < 1 -> Left ProjectUnskilled | not forced && IA.checkFlag Ability.Lobable arItem && skill < 3 -> Left ProjectLobable | otherwise -> case permittedPrecious forced calmE itemFull of Left failure -> Left failure Right False -> Right False Right True -> Right $ let badSlot = case IA.aEqpSlot arItem of Just Ability.EqpSlotShine -> False Just _ -> True Nothing -> IA.goesIntoEqp arItem in not badSlot -- Simplified, faster and more permissive version, for inner AI loop. permittedProjectAI :: Int -> Bool -> ItemFull -> Bool permittedProjectAI skill calmE itemFull = let arItem = aspectRecordFull itemFull in if | skill < 1 -> False | IA.checkFlag Ability.Lobable arItem && skill < 3 -> False | otherwise -> permittedPreciousAI calmE itemFull permittedApply :: Time -> Int -> Bool-> ItemFull -> ItemQuant -> Either ReqFailure Bool permittedApply localTime skill calmE itemFull@ItemFull{itemKind, itemSuspect} kit = if | skill < 1 -> Left ApplyUnskilled | skill < 2 && IK.isymbol itemKind `notElem` [',', '"'] -> Left ApplyFood | skill < 3 && IK.isymbol itemKind == '?' -> Left ApplyRead | skill < 4 && let arItem = aspectRecordFull itemFull in IA.checkFlag Ability.Periodic arItem -> Left ApplyPeriodic -- If the item is discharged, neither the kinetic hit nor -- any effects activate, so there's no point applying. -- Note that if client doesn't know the timeout, here we may leak the fact -- that the item is still charging, but the client risks destruction -- if the item is, in fact, recharged and is not durable -- (likely in case of jewellery). So it's OK (the message may be -- somewhat alarming though). | not $ hasCharge localTime itemFull kit -> Left ApplyCharging | otherwise -> if null (IK.ieffects itemKind) && not itemSuspect then Left ApplyNoEffects else permittedPrecious False calmE itemFull LambdaHack-0.9.5.0/engine-src/Game/LambdaHack/Common/RingBuffer.hs0000644000000000000000000000306507346545000022516 0ustar0000000000000000{-# LANGUAGE DeriveGeneric #-} -- | Ring buffers. module Game.LambdaHack.Common.RingBuffer ( RingBuffer , empty, cons, uncons, toList, length ) where import Prelude () import Game.LambdaHack.Core.Prelude hiding (length, uncons) import Data.Binary import qualified Data.Foldable as Foldable import qualified Data.Sequence as Seq import GHC.Generics (Generic) -- | Ring buffers of a size determined at initialization. data RingBuffer a = RingBuffer { rbCarrier :: Seq.Seq a , rbMaxSize :: Int , rbNext :: Int , rbLength :: Int } deriving (Show, Generic) instance Binary a => Binary (RingBuffer a) -- Only takes O(log n)). empty :: Int -> a -> RingBuffer a empty size dummy = let rbMaxSize = max 1 size in RingBuffer (Seq.replicate rbMaxSize dummy) rbMaxSize 0 0 cons :: a -> RingBuffer a -> RingBuffer a cons a RingBuffer{..} = let incNext = (rbNext + 1) `mod` rbMaxSize incLength = min rbMaxSize $ rbLength + 1 in RingBuffer (Seq.update rbNext a rbCarrier) rbMaxSize incNext incLength uncons :: RingBuffer a -> Maybe (a, RingBuffer a) uncons RingBuffer{..} = let decNext = (rbNext - 1) `mod` rbMaxSize in if rbLength == 0 then Nothing else Just ( Seq.index rbCarrier decNext , RingBuffer rbCarrier rbMaxSize decNext (rbLength - 1) ) toList :: RingBuffer a -> [a] toList RingBuffer{..} = let l = Foldable.toList rbCarrier start = (rbNext + rbMaxSize - rbLength) `mod` rbMaxSize in take rbLength $ drop start $ l ++ l length :: RingBuffer a -> Int length RingBuffer{rbLength} = rbLength LambdaHack-0.9.5.0/engine-src/Game/LambdaHack/Common/Save.hs0000644000000000000000000001367707346545000021375 0ustar0000000000000000-- | Saving and restoring game state, used by both server and clients. module Game.LambdaHack.Common.Save ( ChanSave, saveToChan, wrapInSaves, restoreGame, saveNameCli, saveNameSer , compatibleVersion #ifdef EXPOSE_INTERNAL -- * Internal operations , loopSave, delayPrint #endif ) where import Prelude () import Game.LambdaHack.Core.Prelude import Control.Concurrent import Control.Concurrent.Async import qualified Control.Exception as Ex import Data.Binary import Data.Text (Text) import qualified Data.Text as T import qualified Data.Text.IO as T import Data.Version import System.FilePath import System.IO (hFlush, stdout) import qualified System.Random as R import Game.LambdaHack.Common.File import Game.LambdaHack.Common.Kind import Game.LambdaHack.Common.Misc import Game.LambdaHack.Common.Types import Game.LambdaHack.Content.RuleKind type ChanSave a = MVar (Maybe a) saveToChan :: ChanSave a -> a -> IO () saveToChan toSave s = do -- Wipe out previous candidates for saving. void $ tryTakeMVar toSave putMVar toSave $ Just s -- | Repeatedly save serialized snapshots of current state. -- -- Running with @-N2@ ca reduce @Max pause@ from 0.2s to 0.01s -- and @bytes copied during GC@ 10-fold, but framerate nor the frequency -- of not making a backup save are unaffected (at standard backup settings), -- even with null frontend, because saving takes so few resources. -- So, generally, backup save settings are relevant only due to latency -- impact on very slow computers or in JS. loopSave :: Binary a => COps -> (a -> FilePath) -> ChanSave a -> IO () loopSave cops stateToFileName toSave = loop where loop = do -- Wait until anyting to save. ms <- takeMVar toSave case ms of Just s -> do dataDir <- appDataDir tryCreateDir (dataDir "saves") let fileName = stateToFileName s yield -- minimize UI lag due to saving encodeEOF (dataDir "saves" fileName) (rexeVersion $ corule cops) s -- Wait until the save finished. During that time, the mvar -- is continually updated to newest state values. loop Nothing -> return () -- exit wrapInSaves :: Binary a => COps -> (a -> FilePath) -> (ChanSave a -> IO ()) -> IO () {-# INLINE wrapInSaves #-} wrapInSaves cops stateToFileName exe = do -- We don't merge this with the other calls to waitForChildren, -- because, e.g., for server, we don't want to wait for clients to exit, -- if the server crashes (but we wait for the save to finish). toSave <- newEmptyMVar a <- async $ loopSave cops stateToFileName toSave link a let fin = do -- Wait until the last save (if any) starts -- and tell the save thread to end. putMVar toSave Nothing -- Wait 0.5s to flush debug and then until the save thread ends. threadDelay 500000 wait a exe toSave `Ex.finally` fin -- The creation of, e.g., the initial client state, is outside the 'finally' -- clause, but this is OK, since no saves are ordered until 'runActionCli'. -- We save often, not only in the 'finally' section, in case of -- power outages, kill -9, GHC runtime crashes, etc. For internal game -- crashes, C-c, etc., the finalizer would be enough. -- If we implement incremental saves, saving often will help -- to spread the cost, to avoid a long pause at game exit. -- | Restore a saved game, if it exists. Initialize directory structure -- and copy over data files, if needed. restoreGame :: Binary a => COps -> FilePath -> IO (Maybe a) restoreGame cops fileName = do -- Create user data directory and copy files, if not already there. dataDir <- appDataDir tryCreateDir dataDir let path bkp = dataDir "saves" bkp <> fileName saveExists <- doesFileExist (path "") -- If the savefile exists but we get IO or decoding errors, -- we show them and start a new game. If the savefile was randomly -- corrupted or made read-only, that should solve the problem. -- OTOH, serious IO problems (e.g. failure to create a user data directory) -- terminate the program with an exception. res <- Ex.try $ if saveExists then do let vExe1 = rexeVersion $ corule cops (vExe2, s) <- strictDecodeEOF (path "") if compatibleVersion vExe1 vExe2 then return $ Just s else do let msg = "Savefile" <+> T.pack (path "") <+> "from an incompatible version" <+> T.pack (showVersion vExe2) <+> "detected while trying to restore" <+> T.pack (showVersion vExe1) <+> "game." fail $ T.unpack msg else return Nothing let handler :: Ex.SomeException -> IO (Maybe a) handler e = do let msg = "Restore failed. The old file moved aside. The error message is:" <+> (T.unwords . T.lines) (tshow e) delayPrint msg renameFile (path "") (path "bkp.") return Nothing either handler return res -- Minor version discrepancy permitted. compatibleVersion :: Version -> Version -> Bool compatibleVersion v1 v2 = take 3 (versionBranch v1) == take 3 (versionBranch v2) delayPrint :: Text -> IO () delayPrint t = do delay <- R.randomRIO (0, 1000000) threadDelay delay -- try not to interleave saves with other clients T.hPutStrLn stdout t hFlush stdout saveNameCli :: COps -> FactionId -> String saveNameCli COps{corule} side = let gameShortName = case T.words $ rtitle corule of w : _ -> T.unpack w _ -> "Game" n = fromEnum side -- we depend on the numbering hack to number saves in gameShortName ++ (if n > 0 then ".human_" ++ show n else ".computer_" ++ show (-n)) ++ ".sav" saveNameSer :: COps -> String saveNameSer COps{corule} = let gameShortName = case T.words $ rtitle corule of w : _ -> T.unpack w _ -> "Game" in gameShortName ++ ".server.sav" LambdaHack-0.9.5.0/engine-src/Game/LambdaHack/Common/State.hs0000644000000000000000000002427707346545000021555 0ustar0000000000000000-- | The common server and client basic game state type and its operations. module Game.LambdaHack.Common.State ( -- * Basic game state, local or global State -- * State components , sdungeon, stotalDepth, sactorD, sitemD, sitemIxMap, sfactionD, stime, scops , sgold, shigh, sgameModeId, sdiscoKind, sdiscoAspect, sactorMaxSkills -- * State construction , defStateGlobal, emptyState, localFromGlobal -- * State update , updateDungeon, updateDepth, updateActorD, updateItemD, updateItemIxMap , updateFactionD, updateTime, updateCOpsAndCachedData, updateGold , updateDiscoKind, updateDiscoAspect, updateActorMaxSkills -- * State operations , getItemBody, aspectRecordFromItem, aspectRecordFromIid , maxSkillsFromActor, maxSkillsInDungeon #ifdef EXPOSE_INTERNAL -- * Internal operations , unknownLevel, unknownTileMap #endif ) where import Prelude () import Game.LambdaHack.Core.Prelude import Data.Binary import qualified Data.EnumMap.Strict as EM import qualified Game.LambdaHack.Definition.Ability as Ability import Game.LambdaHack.Common.Actor import Game.LambdaHack.Common.Area import Game.LambdaHack.Definition.Defs import qualified Game.LambdaHack.Core.Dice as Dice import Game.LambdaHack.Common.Faction import qualified Game.LambdaHack.Common.HighScore as HighScore import Game.LambdaHack.Common.Item import qualified Game.LambdaHack.Common.ItemAspect as IA import Game.LambdaHack.Common.Kind import Game.LambdaHack.Common.Level import Game.LambdaHack.Common.Point import qualified Game.LambdaHack.Common.PointArray as PointArray import Game.LambdaHack.Common.Time import Game.LambdaHack.Common.Types import Game.LambdaHack.Content.CaveKind (CaveKind) import Game.LambdaHack.Content.ModeKind import Game.LambdaHack.Content.RuleKind import Game.LambdaHack.Content.TileKind (TileKind, unknownId) -- | View on the basic game state. -- The @remembered@ fields, in client copies of the state, carry only -- a subset of the full information that the server keeps. -- Clients never directly change their @State@, but apply -- atomic actions sent by the server to do so (and/or the server applies -- the actions to each client state in turn). data State = State { _sdungeon :: Dungeon -- ^ remembered dungeon , _stotalDepth :: Dice.AbsDepth -- ^ absolute dungeon depth for item creation , _sactorD :: ActorDict -- ^ remembered actors in the dungeon , _sitemD :: ItemDict -- ^ remembered items in the dungeon , _sitemIxMap :: ItemIxMap -- ^ spotted items with the same kind index -- could be recomputed at resume, but small , _sfactionD :: FactionDict -- ^ remembered sides still in game , _stime :: Time -- ^ global game time, for UI display only , _scops :: COps -- ^ remembered content , _sgold :: Int -- ^ total value of human trinkets in dungeon , _shigh :: HighScore.ScoreDict -- ^ high score table , _sgameModeId :: ContentId ModeKind -- ^ current game mode , _sdiscoKind :: DiscoveryKind -- ^ item kind discoveries data , _sdiscoAspect :: DiscoveryAspect -- ^ item aspect data; could be recomputed , _sactorMaxSkills :: ActorMaxSkills -- ^ actor aspect records; is recomputed } deriving (Show, Eq) instance Binary State where put State{..} = do put _sdungeon put _stotalDepth put _sactorD put _sitemD put _sitemIxMap put _sfactionD put _stime put _sgold put _shigh put _sgameModeId put _sdiscoKind put _sdiscoAspect get = do _sdungeon <- get _stotalDepth <- get _sactorD <- get _sitemD <- get _sitemIxMap <- get _sfactionD <- get _stime <- get _sgold <- get _shigh <- get _sgameModeId <- get _sdiscoKind <- get _sdiscoAspect <- get let _scops = emptyCOps _sactorMaxSkills = EM.empty return $! State{..} sdungeon :: State -> Dungeon sdungeon = _sdungeon stotalDepth :: State -> Dice.AbsDepth stotalDepth = _stotalDepth sactorD :: State -> ActorDict sactorD = _sactorD sitemD :: State -> ItemDict sitemD = _sitemD sitemIxMap :: State -> ItemIxMap sitemIxMap = _sitemIxMap sfactionD :: State -> FactionDict sfactionD = _sfactionD stime :: State -> Time stime = _stime scops :: State -> COps scops = _scops sgold :: State -> Int sgold = _sgold shigh :: State -> HighScore.ScoreDict shigh = _shigh sgameModeId :: State -> ContentId ModeKind sgameModeId = _sgameModeId sdiscoKind :: State -> DiscoveryKind sdiscoKind = _sdiscoKind sdiscoAspect :: State -> DiscoveryAspect sdiscoAspect = _sdiscoAspect sactorMaxSkills :: State -> ActorMaxSkills sactorMaxSkills = _sactorMaxSkills unknownLevel :: COps -> ContentId CaveKind -> Dice.AbsDepth -> Area -> ([Point], [Point]) -> [Point] -> Int -> Bool -> Level unknownLevel COps{corule, cotile} lkind ldepth larea lstair lescape lexpl lnight = let outerId = ouniqGroup cotile "unknown outer fence" in Level { lkind , ldepth , lfloor = EM.empty , lembed = EM.empty , lbig = EM.empty , lproj = EM.empty , ltile = unknownTileMap larea outerId (rXmax corule) (rYmax corule) , lentry = EM.empty , larea , lsmell = EM.empty , lstair , lescape , lseen = 0 , lexpl , ltime = timeZero , lnight } unknownTileMap :: Area -> ContentId TileKind -> X -> Y -> TileMap unknownTileMap larea outerId rXmax rYmax = let unknownMap = PointArray.replicateA rXmax rYmax unknownId outerUpdate = zip (areaInnerBorder larea) $ repeat outerId in unknownMap PointArray.// outerUpdate -- | Initial complete global game state. defStateGlobal :: Dungeon -> Dice.AbsDepth -> FactionDict -> COps -> HighScore.ScoreDict -> ContentId ModeKind -> DiscoveryKind -> State defStateGlobal _sdungeon _stotalDepth _sfactionD _scops _shigh _sgameModeId _sdiscoKind = State { _sactorD = EM.empty , _sitemD = EM.empty , _sitemIxMap = EM.empty , _stime = timeZero , _sgold = 0 , _sdiscoAspect = EM.empty , _sactorMaxSkills = EM.empty , .. } -- | Initial empty state. emptyState :: State emptyState = State { _sdungeon = EM.empty , _stotalDepth = Dice.AbsDepth 0 , _sactorD = EM.empty , _sitemD = EM.empty , _sitemIxMap = EM.empty , _sfactionD = EM.empty , _stime = timeZero , _scops = emptyCOps , _sgold = 0 , _shigh = HighScore.empty , _sgameModeId = toEnum 0 -- the initial value is unused , _sdiscoKind = EM.empty , _sdiscoAspect = EM.empty , _sactorMaxSkills = EM.empty } -- | Local state created by removing secret information from global -- state components. localFromGlobal :: State -> State localFromGlobal State{..} = State { _sdungeon = EM.map (\Level{..} -> unknownLevel _scops lkind ldepth larea lstair lescape lexpl lnight) _sdungeon , .. } -- | Update dungeon data within state. updateDungeon :: (Dungeon -> Dungeon) -> State -> State updateDungeon f s = s {_sdungeon = f (_sdungeon s)} -- | Update dungeon depth. updateDepth :: (Dice.AbsDepth -> Dice.AbsDepth) -> State -> State updateDepth f s = s {_stotalDepth = f (_stotalDepth s)} -- | Update the actor dictionary. updateActorD :: (ActorDict -> ActorDict) -> State -> State updateActorD f s = s {_sactorD = f (_sactorD s)} -- | Update the item dictionary. updateItemD :: (ItemDict -> ItemDict) -> State -> State updateItemD f s = s {_sitemD = f (_sitemD s)} -- | Update the item kind index map. updateItemIxMap :: (ItemIxMap -> ItemIxMap) -> State -> State updateItemIxMap f s = s {_sitemIxMap = f (_sitemIxMap s)} -- | Update faction data within state. updateFactionD :: (FactionDict -> FactionDict) -> State -> State updateFactionD f s = s {_sfactionD = f (_sfactionD s)} -- | Update global time within state. updateTime :: (Time -> Time) -> State -> State updateTime f s = s {_stime = f (_stime s)} -- | Update content data within state and recompute the cached data. updateCOpsAndCachedData :: (COps -> COps) -> State -> State updateCOpsAndCachedData f s = let s2 = s {_scops = f (_scops s)} in s2 {_sactorMaxSkills = maxSkillsInDungeon s2} -- | Update total gold value in the dungeon. updateGold :: (Int -> Int) -> State -> State updateGold f s = s {_sgold = f (_sgold s)} updateDiscoKind :: (DiscoveryKind -> DiscoveryKind) -> State -> State updateDiscoKind f s = s {_sdiscoKind = f (_sdiscoKind s)} updateDiscoAspect :: (DiscoveryAspect -> DiscoveryAspect) -> State -> State updateDiscoAspect f s = s {_sdiscoAspect = f (_sdiscoAspect s)} updateActorMaxSkills :: (ActorMaxSkills -> ActorMaxSkills) -> State -> State updateActorMaxSkills f s = s {_sactorMaxSkills = f (_sactorMaxSkills s)} getItemBody :: ItemId -> State -> Item getItemBody iid s = sitemD s EM.! iid -- This is best guess, including mean aspect record, so we can take into -- consideration even the kind the item hides under. aspectRecordFromItem :: ItemId -> Item -> State -> IA.AspectRecord aspectRecordFromItem iid item s = let kindId = case jkind item of IdentityObvious ik -> ik IdentityCovered ix ik -> fromMaybe ik $ ix `EM.lookup` sdiscoKind s COps{coItemSpeedup} = scops s mean = IA.kmMean $ getKindMean kindId coItemSpeedup in fromMaybe mean $ EM.lookup iid $ sdiscoAspect s aspectRecordFromIid :: ItemId -> State -> IA.AspectRecord aspectRecordFromIid iid s = aspectRecordFromItem iid (getItemBody iid s) s maxSkillsFromActor :: Actor -> State -> Ability.Skills maxSkillsFromActor b s = let processIid (iid, (k, _)) = (IA.aSkills $ aspectRecordFromIid iid s, k) processBag sks = Ability.sumScaledSkills $ map processIid sks in processBag $ EM.assocs (borgan b) ++ EM.assocs (beqp b) maxSkillsInDungeon :: State -> ActorMaxSkills maxSkillsInDungeon s = EM.map (`maxSkillsFromActor` s) $ sactorD s LambdaHack-0.9.5.0/engine-src/Game/LambdaHack/Common/Thread.hs0000644000000000000000000000146407346545000021675 0ustar0000000000000000-- | Keeping track of forked threads. module Game.LambdaHack.Common.Thread ( forkChild, waitForChildren ) where import Prelude () import Game.LambdaHack.Core.Prelude import Control.Concurrent.Async import Control.Concurrent.MVar -- Swiped from -- Ported to Async to link exceptions, to let travis tests fail. forkChild :: MVar [Async ()] -> IO () -> IO () forkChild children io = do a <- async io link a childs <- takeMVar children putMVar children (a : childs) waitForChildren :: MVar [Async ()] -> IO () waitForChildren children = do cs <- takeMVar children case cs of [] -> do putMVar children [] return () m : ms -> do putMVar children ms wait m waitForChildren children LambdaHack-0.9.5.0/engine-src/Game/LambdaHack/Common/Tile.hs0000644000000000000000000003321707346545000021364 0ustar0000000000000000-- | Operations concerning dungeon level tiles. -- -- Unlike for many other content types, there is no type @Tile@, -- of particular concrete tiles in the dungeon, -- corresponding to 'TileKind' (the type of kinds of terrain tiles). -- This is because the tiles are too numerous and there's not enough -- storage space for a well-rounded @Tile@ type, on one hand, -- and on the other hand, tiles are accessed -- too often in performance critical code -- to try to compress their representation and/or recompute them. -- Instead, of defining a @Tile@ type, we express various properties -- of concrete tiles by arrays or sparse EnumMaps, as appropriate. -- -- Actors at normal speed (2 m/s) take one turn to move one tile (1 m by 1 m). module Game.LambdaHack.Common.Tile ( -- * Construction of tile property lookup speedup tables speedupTile -- * Sped up property lookups , isClear, isLit, isWalkable, isDoor, isChangable , isSuspect, isHideAs, consideredByAI, isExplorable , isVeryOftenItem, isCommonItem, isOftenActor, isNoItem, isNoActor , isEasyOpen, isEmbed, isAquatic, alterMinSkill, alterMinWalk -- * Slow property lookups , kindHasFeature, hasFeature, openTo, closeTo, embeddedItems, revealAs , obscureAs, hideAs, buildAs , isEasyOpenKind, isOpenable, isClosable, isModifiable #ifdef EXPOSE_INTERNAL -- * Internal operations , createTab, createTabWithKey, accessTab, alterMinSkillKind, alterMinWalkKind #endif ) where import Prelude () import Game.LambdaHack.Core.Prelude import qualified Data.Vector.Unboxed as U import Data.Word (Word8) import Game.LambdaHack.Common.Kind import Game.LambdaHack.Content.ItemKind (ItemKind) import Game.LambdaHack.Content.TileKind (TileKind, isUknownSpace) import qualified Game.LambdaHack.Content.TileKind as TK import Game.LambdaHack.Core.Random import Game.LambdaHack.Definition.Defs createTab :: U.Unbox a => ContentData TileKind -> (TileKind -> a) -> Tab a createTab cotile prop = Tab $ U.convert $ omapVector cotile prop createTabWithKey :: U.Unbox a => ContentData TileKind -> (ContentId TileKind -> TileKind -> a) -> Tab a createTabWithKey cotile prop = Tab $ U.convert $ oimapVector cotile prop -- Unsafe indexing is pretty safe here, because we guard the vector -- with the newtype. accessTab :: U.Unbox a => Tab a -> ContentId TileKind -> a {-# INLINE accessTab #-} accessTab (Tab tab) ki = tab `U.unsafeIndex` contentIdIndex ki speedupTile :: Bool -> ContentData TileKind -> TileSpeedup speedupTile allClear cotile = -- Vectors pack bools as Word8 by default. No idea if the extra memory -- taken makes random lookups more or less efficient, so not optimizing -- further, until I have benchmarks. let isClearTab | allClear = createTab cotile $ not . (== maxBound) . TK.talter | otherwise = createTab cotile $ kindHasFeature TK.Clear isLitTab = createTab cotile $ not . kindHasFeature TK.Dark isWalkableTab = createTab cotile $ kindHasFeature TK.Walkable isDoorTab = createTab cotile $ \tk -> let getTo TK.OpenTo{} = True getTo TK.CloseTo{} = True getTo _ = False in any getTo $ TK.tfeature tk isChangableTab = createTab cotile $ \tk -> let getTo TK.ChangeTo{} = True getTo _ = False in any getTo $ TK.tfeature tk isSuspectTab = createTab cotile TK.isSuspectKind isHideAsTab = createTab cotile $ \tk -> let getTo TK.HideAs{} = True getTo _ = False in any getTo $ TK.tfeature tk consideredByAITab = createTab cotile $ kindHasFeature TK.ConsideredByAI isVeryOftenItemTab = createTab cotile $ kindHasFeature TK.VeryOftenItem isCommonItemTab = createTab cotile $ \tk -> kindHasFeature TK.OftenItem tk || kindHasFeature TK.VeryOftenItem tk isOftenActorTab = createTab cotile $ kindHasFeature TK.OftenActor isNoItemTab = createTab cotile $ kindHasFeature TK.NoItem isNoActorTab = createTab cotile $ kindHasFeature TK.NoActor isEasyOpenTab = createTab cotile isEasyOpenKind isEmbedTab = createTab cotile $ \tk -> let getTo TK.Embed{} = True getTo _ = False in any getTo $ TK.tfeature tk isAquaticTab = createTab cotile $ \tk -> maybe False (> 0) $ lookup "aquatic" $ TK.tfreq tk alterMinSkillTab = createTabWithKey cotile alterMinSkillKind alterMinWalkTab = createTabWithKey cotile alterMinWalkKind in TileSpeedup {..} -- Check that alter can be used, if not, @maxBound@. -- For now, we assume only items with @Embed@ may have embedded items, -- whether inserted at dungeon creation or later on. -- This is used by UI and server to validate (sensibility of) altering. -- See the comment for @alterMinWalkKind@ regarding @HideAs@. alterMinSkillKind :: ContentId TileKind -> TileKind -> Word8 alterMinSkillKind _k tk = let getTo TK.OpenTo{} = True getTo TK.CloseTo{} = True getTo TK.ChangeTo{} = True getTo TK.HideAs{} = True -- in case tile swapped, but server sends hidden getTo TK.RevealAs{} = True getTo TK.ObscureAs{} = True getTo TK.Embed{} = True getTo TK.ConsideredByAI = True getTo _ = False in if any getTo $ TK.tfeature tk then TK.talter tk else maxBound -- How high alter skill is needed to make it walkable. If already -- walkable, put @0@, if can't, put @maxBound@. Used only by AI and Bfs -- We don't include @HideAs@, because it's very unlikely anybody swapped -- the tile while AI was not looking so AI can assume it's still uninteresting. -- Pathfinding in UI will also not show such tile as passable, which is OK. -- If a human player has a suspicion the tile was swapped, he can check -- it manually, disregarding the displayed path hints. alterMinWalkKind :: ContentId TileKind -> TileKind -> Word8 alterMinWalkKind k tk = let getTo TK.OpenTo{} = True getTo TK.RevealAs{} = True getTo TK.ObscureAs{} = True getTo _ = False in if | kindHasFeature TK.Walkable tk -> 0 | isUknownSpace k -> TK.talter tk | any getTo $ TK.tfeature tk -> TK.talter tk | otherwise -> maxBound -- | Whether a tile does not block vision. -- Essential for efficiency of "FOV", hence tabulated. isClear :: TileSpeedup -> ContentId TileKind -> Bool {-# INLINE isClear #-} isClear TileSpeedup{isClearTab} = accessTab isClearTab -- | Whether a tile has ambient light --- is lit on its own. -- Essential for efficiency of "Perception", hence tabulated. isLit :: TileSpeedup -> ContentId TileKind -> Bool {-# INLINE isLit #-} isLit TileSpeedup{isLitTab} = accessTab isLitTab -- | Whether actors can walk into a tile. -- Essential for efficiency of pathfinding, hence tabulated. isWalkable :: TileSpeedup -> ContentId TileKind -> Bool {-# INLINE isWalkable #-} isWalkable TileSpeedup{isWalkableTab} = accessTab isWalkableTab -- | Whether a tile is a door, open or closed. -- Essential for efficiency of pathfinding, hence tabulated. isDoor :: TileSpeedup -> ContentId TileKind -> Bool {-# INLINE isDoor #-} isDoor TileSpeedup{isDoorTab} = accessTab isDoorTab -- | Whether a tile is changable. isChangable :: TileSpeedup -> ContentId TileKind -> Bool {-# INLINE isChangable #-} isChangable TileSpeedup{isChangableTab} = accessTab isChangableTab -- | Whether a tile is suspect. -- Essential for efficiency of pathfinding, hence tabulated. isSuspect :: TileSpeedup -> ContentId TileKind -> Bool {-# INLINE isSuspect #-} isSuspect TileSpeedup{isSuspectTab} = accessTab isSuspectTab isHideAs :: TileSpeedup -> ContentId TileKind -> Bool {-# INLINE isHideAs #-} isHideAs TileSpeedup{isHideAsTab} = accessTab isHideAsTab consideredByAI :: TileSpeedup -> ContentId TileKind -> Bool {-# INLINE consideredByAI #-} consideredByAI TileSpeedup{consideredByAITab} = accessTab consideredByAITab -- | Whether one can easily explore a tile, possibly finding a treasure, -- either spawned there or dropped there by a (dying from poison) foe. -- Doors can't be explorable since revealing a secret tile -- should not change it's (walkable and) explorable status. -- Door status should not depend on whether they are open or not -- so that a foe opening a door doesn't force us to backtrack to explore it. -- Still, a foe that digs through a wall will affect our exploration counter -- and if content lets walls contain threasure, such backtraking makes sense. isExplorable :: TileSpeedup -> ContentId TileKind -> Bool isExplorable coTileSpeedup t = isWalkable coTileSpeedup t && not (isDoor coTileSpeedup t) isVeryOftenItem :: TileSpeedup -> ContentId TileKind -> Bool {-# INLINE isVeryOftenItem #-} isVeryOftenItem TileSpeedup{isVeryOftenItemTab} = accessTab isVeryOftenItemTab isCommonItem :: TileSpeedup -> ContentId TileKind -> Bool {-# INLINE isCommonItem #-} isCommonItem TileSpeedup{isCommonItemTab} = accessTab isCommonItemTab isOftenActor :: TileSpeedup -> ContentId TileKind -> Bool {-# INLINE isOftenActor #-} isOftenActor TileSpeedup{isOftenActorTab} = accessTab isOftenActorTab isNoItem :: TileSpeedup -> ContentId TileKind -> Bool {-# INLINE isNoItem #-} isNoItem TileSpeedup{isNoItemTab} = accessTab isNoItemTab isNoActor :: TileSpeedup -> ContentId TileKind -> Bool {-# INLINE isNoActor #-} isNoActor TileSpeedup{isNoActorTab} = accessTab isNoActorTab -- | Whether a tile kind (specified by its id) has an @OpenTo@ feature -- or is walkable even without opening. isEasyOpen :: TileSpeedup -> ContentId TileKind -> Bool {-# INLINE isEasyOpen #-} isEasyOpen TileSpeedup{isEasyOpenTab} = accessTab isEasyOpenTab isEmbed :: TileSpeedup -> ContentId TileKind -> Bool {-# INLINE isEmbed #-} isEmbed TileSpeedup{isEmbedTab} = accessTab isEmbedTab isAquatic :: TileSpeedup -> ContentId TileKind -> Bool {-# INLINE isAquatic #-} isAquatic TileSpeedup{isAquaticTab} = accessTab isAquaticTab alterMinSkill :: TileSpeedup -> ContentId TileKind -> Int {-# INLINE alterMinSkill #-} alterMinSkill TileSpeedup{alterMinSkillTab} = fromEnum . accessTab alterMinSkillTab alterMinWalk :: TileSpeedup -> ContentId TileKind -> Int {-# INLINE alterMinWalk #-} alterMinWalk TileSpeedup{alterMinWalkTab} = fromEnum . accessTab alterMinWalkTab -- | Whether a tile kind has the given feature. kindHasFeature :: TK.Feature -> TileKind -> Bool {-# INLINE kindHasFeature #-} kindHasFeature f t = f `elem` TK.tfeature t -- | Whether a tile kind (specified by its id) has the given feature. hasFeature :: ContentData TileKind -> TK.Feature -> ContentId TileKind -> Bool {-# INLINE hasFeature #-} hasFeature cotile f t = kindHasFeature f (okind cotile t) openTo :: ContentData TileKind -> ContentId TileKind -> Rnd (ContentId TileKind) openTo cotile t = do let getTo (TK.OpenTo grp) acc = grp : acc getTo _ acc = acc case foldr getTo [] $ TK.tfeature $ okind cotile t of [grp] -> fromMaybe (error $ "" `showFailure` grp) <$> opick cotile grp (const True) _ -> return t closeTo :: ContentData TileKind -> ContentId TileKind -> Rnd (ContentId TileKind) closeTo cotile t = do let getTo (TK.CloseTo grp) acc = grp : acc getTo _ acc = acc case foldr getTo [] $ TK.tfeature $ okind cotile t of [grp] -> fromMaybe (error $ "" `showFailure` grp) <$> opick cotile grp (const True) _ -> return t embeddedItems :: ContentData TileKind -> ContentId TileKind -> [GroupName ItemKind] embeddedItems cotile t = let getTo (TK.Embed igrp) acc = igrp : acc getTo _ acc = acc in foldr getTo [] $ TK.tfeature $ okind cotile t revealAs :: ContentData TileKind -> ContentId TileKind -> Rnd (ContentId TileKind) revealAs cotile t = do let getTo (TK.RevealAs grp) acc = grp : acc getTo _ acc = acc case foldr getTo [] $ TK.tfeature $ okind cotile t of [] -> return t groups -> do grp <- oneOf groups fromMaybe (error $ "" `showFailure` grp) <$> opick cotile grp (const True) obscureAs :: ContentData TileKind -> ContentId TileKind -> Rnd (ContentId TileKind) obscureAs cotile t = do let getTo (TK.ObscureAs grp) acc = grp : acc getTo _ acc = acc case foldr getTo [] $ TK.tfeature $ okind cotile $ buildAs cotile t of [] -> return t groups -> do grp <- oneOf groups fromMaybe (error $ "" `showFailure` grp) <$> opick cotile grp (const True) hideAs :: ContentData TileKind -> ContentId TileKind -> Maybe (ContentId TileKind) hideAs cotile t = let getTo TK.HideAs{} = True getTo _ = False in case find getTo $ TK.tfeature $ okind cotile t of Just (TK.HideAs grp) -> let tHidden = ouniqGroup cotile grp in assert (tHidden /= t) $ Just tHidden _ -> Nothing buildAs :: ContentData TileKind -> ContentId TileKind -> ContentId TileKind buildAs cotile t = let getTo TK.BuildAs{} = True getTo _ = False in case find getTo $ TK.tfeature $ okind cotile t of Just (TK.BuildAs grp) -> ouniqGroup cotile grp _ -> t isEasyOpenKind :: TileKind -> Bool isEasyOpenKind tk = let getTo TK.OpenTo{} = True getTo TK.Walkable = True -- very easy open getTo _ = False in TK.talter tk < 10 && any getTo (TK.tfeature tk) -- | Whether a tile kind (specified by its id) has an OpenTo feature. isOpenable :: ContentData TileKind -> ContentId TileKind -> Bool isOpenable cotile t = TK.isOpenableKind $ okind cotile t -- | Whether a tile kind (specified by its id) has a CloseTo feature. isClosable :: ContentData TileKind -> ContentId TileKind -> Bool isClosable cotile t = TK.isClosableKind $ okind cotile t isModifiable :: TileSpeedup -> ContentId TileKind -> Bool isModifiable coTileSpeedup t = isDoor coTileSpeedup t || isChangable coTileSpeedup t || isSuspect coTileSpeedup t LambdaHack-0.9.5.0/engine-src/Game/LambdaHack/Common/Time.hs0000644000000000000000000002622607346545000021367 0ustar0000000000000000{-# LANGUAGE DeriveFunctor, GeneralizedNewtypeDeriving #-} -- | Game time and speed. module Game.LambdaHack.Common.Time ( Time, timeTicks , timeZero, timeEpsilon, timeClip, timeTurn, timeSecond, clipsInTurn , absoluteTimeAdd, absoluteTimeSubtract, absoluteTimeNegate , timeFit, timeFitUp , Delta(..), timeShift, timeDeltaToFrom, timeDeltaAdd, timeDeltaSubtract , timeDeltaReverse, timeDeltaScale, timeDeltaPercent, timeDeltaDiv , timeDeltaToDigit, timeDeltaInSecondsText , Speed, toSpeed, fromSpeed, minSpeed, displaySpeed , speedZero, speedWalk, speedLimp, speedThrust, modifyDamageBySpeed , speedScale, speedAdd , ticksPerMeter, speedFromWeight, rangeFromSpeedAndLinger #ifdef EXPOSE_INTERNAL -- * Internal operations , _timeTick, turnsInSecond, sInMs, minimalSpeed, rangeFromSpeed #endif ) where import Prelude () import Game.LambdaHack.Core.Prelude import Data.Binary import qualified Data.Char as Char import Data.Int (Int64) import Game.LambdaHack.Common.Misc -- | Game time in ticks. The time dimension. -- One tick is 1 microsecond (one millionth of a second), -- one turn is 0.5 s. newtype Time = Time {timeTicks :: Int64} deriving (Show, Eq, Ord, Binary) -- | Start of the game time, or zero lenght time interval. timeZero :: Time timeZero = Time 0 -- | The smallest unit of time. Should not be exported and used elsewhere, -- because the proportion of turn to tick is an implementation detail. -- The significance of this detail is only that it determines resolution -- of the time dimension. _timeTick :: Time _timeTick = Time 1 -- | An infinitesimal time period. timeEpsilon :: Time timeEpsilon = _timeTick -- | At least once per clip all moves are resolved -- and a frame or a frame delay is generated. -- Currently one clip is 0.05 s, but it may change, -- and the code should not depend on this fixed value. timeClip :: Time timeClip = Time 50000 -- | One turn is 0.5 s. The code may depend on that. -- Actors at normal speed (2 m/s) take one turn to move one tile (1 m by 1 m). timeTurn :: Time timeTurn = Time 500000 -- | This many ticks fits in a single second. Do not export, timeSecond :: Time timeSecond = Time $ timeTicks timeTurn * turnsInSecond -- | This many turns fit in a single second. turnsInSecond :: Int64 turnsInSecond = 2 -- | This many clips fit in one turn. Determines the resolution -- of actor move sampling and display updates. clipsInTurn :: Int clipsInTurn = let r = timeTurn `timeFit` timeClip in assert (r >= 5) r -- | Absolute time addition, e.g., for summing the total game session time -- from the times of individual games. absoluteTimeAdd :: Time -> Time -> Time {-# INLINE absoluteTimeAdd #-} absoluteTimeAdd (Time t1) (Time t2) = Time (t1 + t2) absoluteTimeSubtract :: Time -> Time -> Time {-# INLINE absoluteTimeSubtract #-} absoluteTimeSubtract (Time t1) (Time t2) = Time (t1 - t2) -- | Absolute time negation. To be used for reversing time flow, -- e.g., for comparing absolute times in the reverse order. absoluteTimeNegate :: Time -> Time {-# INLINE absoluteTimeNegate #-} absoluteTimeNegate (Time t) = Time (-t) -- | How many time intervals of the latter kind fits in an interval -- of the former kind. timeFit :: Time -> Time -> Int {-# INLINE timeFit #-} timeFit (Time t1) (Time t2) = fromEnum $ t1 `div` t2 -- | How many time intervals of the latter kind cover an interval -- of the former kind (rounded up). timeFitUp :: Time -> Time -> Int {-# INLINE timeFitUp #-} timeFitUp (Time t1) (Time t2) = fromEnum $ t1 `divUp` t2 -- | One-dimentional vectors. Introduced to tell apart the 2 uses of Time: -- as an absolute game time and as an increment. newtype Delta a = Delta a deriving (Show, Eq, Ord, Binary, Functor) -- | Shifting an absolute time by a time vector. timeShift :: Time -> Delta Time -> Time {-# INLINE timeShift #-} timeShift (Time t1) (Delta (Time t2)) = Time (t1 + t2) -- | Time time vector between the second and the first absolute times. -- The arguments are in the same order as in the underlying scalar subtraction. timeDeltaToFrom :: Time -> Time -> Delta Time {-# INLINE timeDeltaToFrom #-} timeDeltaToFrom (Time t1) (Time t2) = Delta $ Time (t1 - t2) -- | Addition of time deltas. timeDeltaAdd :: Delta Time -> Delta Time -> Delta Time {-# INLINE timeDeltaAdd #-} timeDeltaAdd (Delta (Time t1)) (Delta (Time t2)) = Delta $ Time (t1 - t2) -- | Subtraction of time deltas. -- The arguments are in the same order as in the underlying scalar subtraction. timeDeltaSubtract :: Delta Time -> Delta Time -> Delta Time {-# INLINE timeDeltaSubtract #-} timeDeltaSubtract (Delta (Time t1)) (Delta (Time t2)) = Delta $ Time (t1 - t2) -- | Reverse a time vector. timeDeltaReverse :: Delta Time -> Delta Time {-# INLINE timeDeltaReverse #-} timeDeltaReverse (Delta (Time t)) = Delta (Time (-t)) -- | Scale the time vector by an @Int@ scalar value. timeDeltaScale :: Delta Time -> Int -> Delta Time {-# INLINE timeDeltaScale #-} timeDeltaScale (Delta (Time t)) s = Delta (Time (t * fromIntegral s)) -- | Take the given percent of the time vector. timeDeltaPercent :: Delta Time -> Int -> Delta Time {-# INLINE timeDeltaPercent #-} timeDeltaPercent (Delta (Time t)) s = Delta (Time (t * fromIntegral s `div` 100)) -- | Divide a time vector. timeDeltaDiv :: Delta Time -> Int -> Delta Time {-# INLINE timeDeltaDiv #-} timeDeltaDiv (Delta (Time t)) n = Delta (Time (t `div` fromIntegral n)) -- | Represent the main 10 thresholds of a time range by digits, -- given the total length of the time range. timeDeltaToDigit :: Delta Time -> Delta Time -> Char {-# INLINE timeDeltaToDigit #-} timeDeltaToDigit (Delta (Time maxT)) (Delta (Time t)) = let n = (20 * t) `div` maxT k = (n + 1) `div` 2 digit | k > 9 = '9' | k < 1 = '1' | otherwise = Char.intToDigit $ fromEnum k in digit -- @oneM@ times the number of seconds represented by the time delta timeDeltaInSeconds :: Delta Time -> Int64 timeDeltaInSeconds (Delta (Time dt)) = oneM * dt `div` timeTicks timeSecond timeDeltaInSecondsText :: Delta Time -> Text timeDeltaInSecondsText delta = show64With2 (timeDeltaInSeconds delta) <> "s" -- | Speed in meters per 1 million seconds (m/Ms). -- Actors at normal speed (2 m/s) take one time turn (0.5 s) -- to make one step (move one tile, which is 1 m by 1 m). newtype Speed = Speed Int64 deriving (Eq, Ord, Binary) instance Show Speed where show s = show $ fromSpeed s -- | Number of seconds in a mega-second. sInMs :: Int64 sInMs = 1000000 -- | Constructor for content definitions. toSpeed :: Int -> Speed {-# INLINE toSpeed #-} toSpeed s = Speed $ fromIntegral s * sInMs `div` 10 -- | Readable representation of speed in the format used in content definitions. fromSpeed :: Speed -> Int {-# INLINE fromSpeed #-} fromSpeed (Speed s) = fromEnum $ s * 10 `div` sInMs minSpeed :: Int minSpeed = 5 -- | Pretty-print speed given in the format used in content definitions. displaySpeed :: Int -> String displaySpeed kRaw = let k = max minSpeed kRaw l = k `div` 10 x = k - l * 10 in show l <> (if x == 0 then "" else "." <> show x) <> "m/s" -- | The minimal speed is half a meter (half a step across a tile) -- per second (two standard turns, which the time span during which -- projectile moves, unless it has modified linger value). -- This is four times slower than standard human movement speed. -- -- It needen't be lower, because @rangeFromSpeed@ gives 0 steps -- with such speed, so the actor's trajectory is empty, so it drops down -- at once. Twice that speed already moves a normal projectile one step -- before it stops. It shouldn't be lower or a slow actor would incur -- such a time debt for performing a single action that he'd be paralyzed -- for many turns, e.g., leaving his dead body on the screen for very long. minimalSpeed :: Int64 minimalSpeed = let Speed msp = toSpeed minSpeed in assert (msp == sInMs `div` 2) msp -- | No movement possible at that speed. speedZero :: Speed speedZero = Speed 0 -- | Fast walk speed (2 m/s) that suffices to move one tile in one turn. speedWalk :: Speed speedWalk = Speed $ 2 * sInMs -- | Limp speed (1 m/s) that suffices to move one tile in two turns. -- This is the minimal speed for projectiles to fly just one space and drop. speedLimp :: Speed speedLimp = Speed sInMs -- | Sword thrust speed (10 m/s). Base weapon damages, both melee and ranged, -- are given assuming this speed and ranged damage is modified -- accordingly when projectile speeds differ. Differences in melee -- weapon swing speeds are captured in damage bonuses instead, -- since many other factors influence total damage. -- -- Billiard ball is 25 m/s, sword swing at the tip is 35 m/s, -- medieval bow is 70 m/s, AK47 is 700 m/s. speedThrust :: Speed speedThrust = Speed $ 10 * sInMs -- | Modify damage when projectiles is at a non-standard speed. -- Energy and so damage is proportional to the square of speed, -- hence the formula. modifyDamageBySpeed :: Int64 -> Speed -> Int64 modifyDamageBySpeed dmg (Speed s) = let Speed sThrust = speedThrust in round (fromIntegral dmg * fromIntegral s ^ (2 :: Int) -- overflows Int64 / fromIntegral sThrust ^ (2 :: Int) :: Double) -- | Scale speed by an @Int@ scalar value. speedScale :: Rational -> Speed -> Speed {-# INLINE speedScale #-} speedScale s (Speed v) = Speed (round $ fromIntegral v * s) -- | Speed addition. speedAdd :: Speed -> Speed -> Speed {-# INLINE speedAdd #-} speedAdd (Speed s1) (Speed s2) = Speed (s1 + s2) -- | The number of time ticks it takes to walk 1 meter at the given speed. ticksPerMeter :: Speed -> Delta Time {-# INLINE ticksPerMeter #-} ticksPerMeter (Speed v) = -- Prevent division by zero or infinite time taken for any action. Delta $ Time $ timeTicks timeSecond * sInMs `divUp` max minimalSpeed v -- | Calculate projectile speed from item weight in grams -- and velocity percent modifier. -- See . speedFromWeight :: Int -> Int -> Speed speedFromWeight !weight !throwVelocity = let w = fromIntegral weight mpMs | w < 250 = sInMs * 20 | w < 1500 = sInMs * 20 * 1250 `div` (w + 1000) | w < 10500 = sInMs * (11000 - w) `div` 1000 | otherwise = minimalSpeed * 2 -- move one step and drop v = mpMs * fromIntegral throwVelocity `div` 100 -- We round down to the nearest multiple of 2M (unless the speed -- is very low), to ensure both turns of flight cover the same distance -- and that the speed matches the distance traveled exactly. multiple2M = if v > 2 * sInMs then 2 * sInMs * (v `div` (2 * sInMs)) else v in Speed $ max minimalSpeed multiple2M -- | Calculate maximum range in meters of a projectile from its speed. -- See . -- With this formula, each projectile flies for at most 1 second, -- that is 2 standard turns, and then drops to the ground. rangeFromSpeed :: Speed -> Int {-# INLINE rangeFromSpeed #-} rangeFromSpeed (Speed v) = fromEnum $ v `div` sInMs -- | Calculate maximum range taking into account the linger percentage. rangeFromSpeedAndLinger :: Speed -> Int -> Int rangeFromSpeedAndLinger !speed !throwLinger = let range = rangeFromSpeed speed in throwLinger * range `divUp` 100 LambdaHack-0.9.5.0/engine-src/Game/LambdaHack/Common/Types.hs0000644000000000000000000000321407346545000021565 0ustar0000000000000000{-# LANGUAGE DeriveGeneric, GeneralizedNewtypeDeriving #-} -- | Abstract identifiers for the main types in the engine. This is imported -- by modules that don't need to know the internal structure -- of the types. As a side effect, this prevents mutual dependencies -- among modules. module Game.LambdaHack.Common.Types ( ItemId, FactionId, LevelId, ActorId , Container(..), ppContainer ) where import Prelude () import Game.LambdaHack.Core.Prelude import Data.Binary import Data.Hashable import GHC.Generics (Generic) import Game.LambdaHack.Common.Point import Game.LambdaHack.Definition.Defs -- | A unique identifier of an item in the dungeon. newtype ItemId = ItemId Int deriving (Show, Eq, Ord, Enum, Binary) -- | A unique identifier of a faction in a game. newtype FactionId = FactionId Int deriving (Show, Eq, Ord, Enum, Hashable, Binary) -- | Abstract level identifiers. newtype LevelId = LevelId Int deriving (Show, Eq, Ord, Hashable, Binary) instance Enum LevelId where fromEnum (LevelId n) = n toEnum = LevelId -- picks the main branch of the dungeon -- | A unique identifier of an actor in the dungeon. newtype ActorId = ActorId Int deriving (Show, Eq, Ord, Enum, Binary) -- | Item container type. data Container = CFloor LevelId Point | CEmbed LevelId Point | CActor ActorId CStore | CTrunk FactionId LevelId Point -- ^ for bootstrapping actor bodies deriving (Show, Eq, Ord, Generic) instance Binary Container ppContainer :: Container -> Text ppContainer CFloor{} = "nearby" ppContainer CEmbed{} = "embedded nearby" ppContainer (CActor _ cstore) = ppCStoreIn cstore ppContainer c@CTrunk{} = error $ "" `showFailure` c LambdaHack-0.9.5.0/engine-src/Game/LambdaHack/Common/Vector.hs0000644000000000000000000002364007346545000021730 0ustar0000000000000000{-# LANGUAGE DeriveGeneric #-} -- | Basic operations on bounded 2D vectors, with an efficient, but not 1-1 -- and not monotonic @Enum@ instance. module Game.LambdaHack.Common.Vector ( Vector(..), VectorI , isUnit, isDiagonal, neg, chessDistVector, euclidDistSqVector , moves, movesCardinal, movesCardinalI, movesDiagonal, movesDiagonalI , compassText, vicinityBounded, vicinityUnsafe , vicinityCardinal, vicinityCardinalUnsafe, squareUnsafeSet , shift, shiftBounded, trajectoryToPath, trajectoryToPathBounded , vectorToFrom, computeTrajectory , RadianAngle, rotate, towards #ifdef EXPOSE_INTERNAL -- * Internal operations , _moveTexts, longMoveTexts, movesSquare, pathToTrajectory , normalize, normalizeVector #endif ) where import Prelude () import Game.LambdaHack.Core.Prelude import Control.DeepSeq import Data.Binary import qualified Data.EnumMap.Strict as EM import qualified Data.EnumSet as ES import Data.Int (Int32) import qualified Data.IntSet as IS import qualified Data.Primitive.PrimArray as PA import GHC.Generics (Generic) import Game.LambdaHack.Common.Point import Game.LambdaHack.Common.Time import Game.LambdaHack.Definition.Defs -- | 2D vectors in cartesian representation. Coordinates grow to the right -- and down, so that the (1, 1) vector points to the bottom-right corner -- of the screen. data Vector = Vector { vx :: X , vy :: Y } deriving (Show, Read, Eq, Ord, Generic) instance Binary Vector where put = put . (fromIntegral :: Int -> Int32) . fromEnum get = fmap (toEnum . (fromIntegral :: Int32 -> Int)) get -- Note that the conversion is not monotonic wrt the natural @Ord@ instance, -- to keep it in sync with Point. instance Enum Vector where fromEnum Vector{..} = let !xsize = PA.indexPrimArray speedupHackXSize 0 in vx + vy * xsize toEnum n = let !xsize = PA.indexPrimArray speedupHackXSize 0 !xsizeHalf = xsize `div` 2 (!y, !x) = n `quotRem` xsize (!vx, !vy) | x >= xsizeHalf = (x - xsize, y + 1) | x <= - xsizeHalf = (x + xsize, y - 1) | otherwise = (x, y) in Vector{..} instance NFData Vector -- | Enumeration representation of @Vector@. type VectorI = Int -- | Tells if a vector has length 1 in the chessboard metric. isUnit :: Vector -> Bool {-# INLINE isUnit #-} isUnit v = chessDistVector v == 1 -- | Checks whether a unit vector is a diagonal direction, -- as opposed to cardinal. If the vector is not unit, -- it checks that the vector is not horizontal nor vertical. isDiagonal :: Vector -> Bool {-# INLINE isDiagonal #-} isDiagonal (Vector x y) = x * y /= 0 -- | Reverse an arbirary vector. neg :: Vector -> Vector {-# INLINE neg #-} neg (Vector vx vy) = Vector (-vx) (-vy) -- | The lenght of a vector in the chessboard metric, -- where diagonal moves cost 1. chessDistVector :: Vector -> Int {-# INLINE chessDistVector #-} chessDistVector (Vector x y) = max (abs x) (abs y) -- | Squared euclidean distance between two vectors. euclidDistSqVector :: Vector -> Vector -> Int euclidDistSqVector (Vector x0 y0) (Vector x1 y1) = (x1 - x0) ^ (2 :: Int) + (y1 - y0) ^ (2 :: Int) -- | Vectors of all unit moves in the chessboard metric, -- clockwise, starting north-west. moves :: [Vector] moves = map (uncurry Vector) [(-1, -1), (0, -1), (1, -1), (1, 0), (1, 1), (0, 1), (-1, 1), (-1, 0)] -- | Vectors of all cardinal direction unit moves, clockwise, starting north. movesCardinal :: [Vector] movesCardinal = map (uncurry Vector) [(0, -1), (1, 0), (0, 1), (-1, 0)] movesCardinalI :: [VectorI] movesCardinalI = map fromEnum movesCardinal -- | Vectors of all diagonal direction unit moves, clockwise, starting north. movesDiagonal :: [Vector] movesDiagonal = map (uncurry Vector) [(-1, -1), (1, -1), (1, 1), (-1, 1)] movesDiagonalI :: [VectorI] movesDiagonalI = map fromEnum movesDiagonal -- | Currently unused. _moveTexts :: [Text] _moveTexts = ["NW", "N", "NE", "E", "SE", "S", "SW", "W"] longMoveTexts :: [Text] longMoveTexts = [ "northwest", "north", "northeast", "east" , "southeast", "south", "southwest", "west" ] compassText :: Vector -> Text compassText v = let m = EM.fromList $ zip moves longMoveTexts assFail = error $ "not a unit vector" `showFailure` v in EM.findWithDefault assFail v m -- | Checks that a point belongs to an area. insideP :: Point -> (X, Y, X, Y) -> Bool {-# INLINE insideP #-} insideP (Point x y) (x0, y0, x1, y1) = x1 >= x && x >= x0 && y1 >= y && y >= y0 -- | All (8 at most) closest neighbours of a point within an area. vicinityBounded :: X -> Y -- ^ limit the search to this area -> Point -- ^ position to find neighbours of -> [Point] vicinityBounded rXmax rYmax p = if insideP p (1, 1, rXmax - 2, rYmax - 2) then vicinityUnsafe p else [ res | dxy <- moves , let res = shift p dxy , insideP res (0, 0, rXmax - 1, rYmax - 1) ] vicinityUnsafe :: Point -> [Point] {-# INLINE vicinityUnsafe #-} vicinityUnsafe p = [ shift p dxy | dxy <- moves ] -- | All (4 at most) cardinal direction neighbours of a point within an area. vicinityCardinal :: X -> Y -- ^ limit the search to this area -> Point -- ^ position to find neighbours of -> [Point] vicinityCardinal rXmax rYmax p = [ res | dxy <- movesCardinal , let res = shift p dxy , insideP res (0, 0, rXmax - 1, rYmax - 1) ] vicinityCardinalUnsafe :: Point -> [Point] vicinityCardinalUnsafe p = [ shift p dxy | dxy <- movesCardinal ] -- Ascending list; includes the origin. movesSquare :: [VectorI] movesSquare = map (fromEnum . uncurry Vector) [ (-1, -1), (0, -1), (1, -1) , (-1, 0), (0, 0), (1, 0) , (-1, 1), (0, 1), (1, 1) ] squareUnsafeSet :: Point -> ES.EnumSet Point {-# INLINE squareUnsafeSet #-} squareUnsafeSet p = ES.intSetToEnumSet $ IS.fromDistinctAscList $ map (fromEnum p +) movesSquare -- | Translate a point by a vector. shift :: Point -> Vector -> Point {-# INLINE shift #-} shift (Point x0 y0) (Vector x1 y1) = Point (x0 + x1) (y0 + y1) -- | Translate a point by a vector, but only if the result fits in an area. shiftBounded :: X -> Y -> Point -> Vector -> Point shiftBounded rXmax rYmax pos v@(Vector xv yv) = if insideP pos (-xv, -yv, rXmax - xv - 1, rYmax - yv - 1) then shift pos v else pos -- | A list of points that a list of vectors leads to. trajectoryToPath :: Point -> [Vector] -> [Point] trajectoryToPath _ [] = [] trajectoryToPath start (v : vs) = let next = shift start v in next : trajectoryToPath next vs -- | A list of points that a list of vectors leads to, bounded by level size. trajectoryToPathBounded :: X -> Y -> Point -> [Vector] -> [Point] trajectoryToPathBounded _ _ _ [] = [] trajectoryToPathBounded rXmax rYmax start (v : vs) = let next = shiftBounded rXmax rYmax start v in next : trajectoryToPathBounded rXmax rYmax next vs -- | The vector between the second point and the first. We have -- -- > shift pos1 (pos2 `vectorToFrom` pos1) == pos2 -- -- The arguments are in the same order as in the underlying scalar subtraction. vectorToFrom :: Point -> Point -> Vector {-# INLINE vectorToFrom #-} vectorToFrom (Point x0 y0) (Point x1 y1) = Vector (x0 - x1) (y0 - y1) -- | A list of vectors between a list of points. pathToTrajectory :: [Point] -> [Vector] pathToTrajectory [] = [] pathToTrajectory lp1@(_ : lp2) = zipWith vectorToFrom lp2 lp1 computeTrajectory :: Int -> Int -> Int -> [Point] -> ([Vector], (Speed, Int)) computeTrajectory weight throwVelocity throwLinger path = let speed = speedFromWeight weight throwVelocity trange = rangeFromSpeedAndLinger speed throwLinger btrajectory = pathToTrajectory $ take (trange + 1) path in (btrajectory, (speed, trange)) type RadianAngle = Double -- | Rotate a vector by the given angle (expressed in radians) -- counterclockwise and return a unit vector approximately in the resulting -- direction. rotate :: RadianAngle -> Vector -> Vector rotate angle (Vector x' y') = let x = fromIntegral x' y = fromIntegral y' -- Minus before the angle comes from our coordinates being -- mirrored along the X axis (Y coordinates grow going downwards). dx = x * cos (-angle) - y * sin (-angle) dy = x * sin (-angle) + y * cos (-angle) in normalize dx dy -- | Given a vector of arbitrary non-zero length, produce a unit vector -- that points in the same direction (in the chessboard metric). -- Of several equally good directions it picks one of those that visually -- (in the euclidean metric) maximally align with the original vector. normalize :: Double -> Double -> Vector normalize dx dy = assert (dx /= 0 || dy /= 0 `blame` "can't normalize zero" `swith` (dx, dy)) $ let angle :: Double angle = atan (dy / dx) / (pi / 2) dxy | angle <= -0.75 && angle >= -1.25 = (0, -1) | angle <= -0.25 = (1, -1) | angle <= 0.25 = (1, 0) | angle <= 0.75 = (1, 1) | angle <= 1.25 = (0, 1) | otherwise = error $ "impossible angle" `showFailure` (dx, dy, angle) in if dx >= 0 then uncurry Vector dxy else neg $ uncurry Vector dxy normalizeVector :: Vector -> Vector normalizeVector v@(Vector vx vy) = let res = normalize (fromIntegral vx) (fromIntegral vy) in assert (not (isUnit v) || v == res `blame` "unit vector gets untrivially normalized" `swith` (v, res)) res -- | Given two distinct positions, determine the direction (a unit vector) -- in which one should move from the first in order to get closer -- to the second. Ignores obstacles. Of several equally good directions -- (in the chessboard metric) it picks one of those that visually -- (in the euclidean metric) maximally align with the vector between -- the two points. towards :: Point -> Point -> Vector towards pos0 pos1 = assert (pos0 /= pos1 `blame` "towards self" `swith` (pos0, pos1)) $ normalizeVector $ pos1 `vectorToFrom` pos0 LambdaHack-0.9.5.0/engine-src/Game/LambdaHack/Server.hs0000644000000000000000000000144107346545000020477 0ustar0000000000000000-- | Semantics of requests that are sent by clients to the server, -- in terms of game state changes and responses to be sent to the clients. -- -- See -- . module Game.LambdaHack.Server ( -- * Re-exported from "Game.LambdaHack.Server.LoopM" loopSer -- * Re-exported from "Game.LambdaHack.Server.ProtocolM" , ChanServer (..) -- * Re-exported from "Game.LambdaHack.Server.Commandline" , serverOptionsPI -- * Re-exported from "Game.LambdaHack.Server.ServerOptions" , ServerOptions(..) ) where import Prelude () import Game.LambdaHack.Server.Commandline (serverOptionsPI) import Game.LambdaHack.Server.LoopM (loopSer) import Game.LambdaHack.Server.ProtocolM import Game.LambdaHack.Server.ServerOptions LambdaHack-0.9.5.0/engine-src/Game/LambdaHack/Server/0000755000000000000000000000000007346545000020143 5ustar0000000000000000LambdaHack-0.9.5.0/engine-src/Game/LambdaHack/Server/BroadcastAtomic.hs0000644000000000000000000004147707346545000023553 0ustar0000000000000000{-# LANGUAGE TupleSections #-} -- | Sending atomic commands to clients and executing them on the server. -- -- See -- . module Game.LambdaHack.Server.BroadcastAtomic ( handleAndBroadcast, sendPer, handleCmdAtomicServer #ifdef EXPOSE_INTERNAL -- * Internal operations , hearUpdAtomic, hearSfxAtomic, filterHear, atomicForget, atomicRemember #endif ) where import Prelude () import Game.LambdaHack.Core.Prelude import qualified Data.EnumMap.Strict as EM import qualified Data.EnumSet as ES import Game.LambdaHack.Atomic import Game.LambdaHack.Common.Actor import Game.LambdaHack.Common.ActorState import qualified Game.LambdaHack.Common.ItemAspect as IA import Game.LambdaHack.Common.Kind import Game.LambdaHack.Common.Level import Game.LambdaHack.Common.Misc import Game.LambdaHack.Common.MonadStateRead import Game.LambdaHack.Common.Perception import Game.LambdaHack.Common.State import qualified Game.LambdaHack.Common.Tile as Tile import Game.LambdaHack.Common.Types import qualified Game.LambdaHack.Content.ItemKind as IK import Game.LambdaHack.Content.TileKind (isUknownSpace) import qualified Game.LambdaHack.Core.Dice as Dice import Game.LambdaHack.Common.Point import qualified Game.LambdaHack.Definition.Ability as Ability import Game.LambdaHack.Definition.Defs import Game.LambdaHack.Server.MonadServer import Game.LambdaHack.Server.ProtocolM import Game.LambdaHack.Server.ServerOptions import Game.LambdaHack.Server.State --storeUndo :: MonadServer m => CmdAtomic -> m () --storeUndo _atomic = -- maybe skip (\a -> modifyServer $ \ser -> ser {sundo = a : sundo ser}) -- $ Nothing -- undoCmdAtomic atomic handleCmdAtomicServer :: MonadServerAtomic m => UpdAtomic -> m (PosAtomic, [UpdAtomic], Bool) handleCmdAtomicServer cmd = do ps <- posUpdAtomic cmd atomicBroken <- breakUpdAtomic cmd executedOnServer <- if seenAtomicSer ps then execUpdAtomicSer cmd else return False return (ps, atomicBroken, executedOnServer) -- | Send an atomic action to all clients that can see it. handleAndBroadcast :: (MonadServerAtomic m, MonadServerComm m) => PosAtomic -> [UpdAtomic] -> CmdAtomic -> m () handleAndBroadcast ps atomicBroken atomic = do -- This is calculated in the server State before action (simulating -- current client State, because action has not been applied -- on the client yet). -- E.g., actor's position in @breakUpdAtomic@ is assumed to be pre-action. -- To get rid of breakUpdAtomic we'd need to send only Spot and Lose -- commands instead of Move and Displace (plus Sfx for Displace). -- So this only makes sense when we switch to sending state diffs. knowEvents <- getsServer $ sknowEvents . soptions sperFidOld <- getsServer sperFid -- Send some actions to the clients, one faction at a time. let sendAtomic fid (UpdAtomic cmd) = sendUpdate fid cmd sendAtomic fid (SfxAtomic sfx) = sendSfx fid sfx breakSend lid fid perFidLid = do let send2 (cmd2, ps2) = when (seenAtomicCli knowEvents fid perFidLid ps2) $ sendUpdate fid cmd2 psBroken <- mapM posUpdAtomic atomicBroken case psBroken of _ : _ -> mapM_ send2 $ zip atomicBroken psBroken [] -> do -- hear only here; broken commands are never loud -- At most @minusM@ applied total over a single actor move, -- to avoid distress as if wounded (which is measured via deltas). -- So, if faction hits an enemy and it yells, hearnig yell will -- not decrease calm over the decrease from hearing strike. -- This may accumulate over time, though, to eventually wake up -- sleeping actors. let drainCalmOnce aid = do b <- getsState $ getActorBody aid when (deltaBenign $ bcalmDelta b) $ execUpdAtomic $ UpdRefillCalm aid minusM -- Projectiles never hear, for speed and simplicity, -- even though they sometimes see. There are flying cameras, -- but no microphones --- drones make too much noise themselves. as <- getsState $ fidActorRegularAssocs fid lid case atomic of UpdAtomic cmd -> do maids <- hearUpdAtomic as cmd case maids of Nothing -> return () Just aids -> do sendUpdate fid $ UpdHearFid fid $ HearUpd (not $ null aids) cmd mapM_ drainCalmOnce aids SfxAtomic cmd -> do mhear <- hearSfxAtomic as cmd case mhear of Nothing -> return () Just (hearMsg, aids) -> do sendUpdate fid $ UpdHearFid fid hearMsg mapM_ drainCalmOnce aids -- We assume players perceive perception change before the action, -- so the action is perceived in the new perception, -- even though the new perception depends on the action's outcome -- (e.g., new actor created). anySend lid fid perFidLid = if seenAtomicCli knowEvents fid perFidLid ps then sendAtomic fid atomic else breakSend lid fid perFidLid posLevel lid fid = anySend lid fid $ sperFidOld EM.! fid EM.! lid send fid = case ps of PosSight lid _ -> posLevel lid fid PosFidAndSight _ lid _ -> posLevel lid fid PosFidAndSer (Just lid) _ -> posLevel lid fid PosSmell lid _ -> posLevel lid fid PosFid fid2 -> when (fid == fid2) $ sendAtomic fid atomic PosFidAndSer Nothing fid2 -> when (fid == fid2) $ sendAtomic fid atomic PosSer -> return () PosAll -> sendAtomic fid atomic PosNone -> error $ "" `showFailure` (fid, atomic) -- Factions that are eliminated by the command are processed as well, -- because they are not deleted from @sfactionD@. factionD <- getsState sfactionD mapM_ send $ EM.keys factionD -- | Messages for some unseen atomic commands. hearUpdAtomic :: MonadStateRead m => [(ActorId, Actor)] -> UpdAtomic -> m (Maybe [ActorId]) hearUpdAtomic as cmd = do COps{coTileSpeedup} <- getsState scops case cmd of UpdDestroyActor _ body _ | not $ bproj body -> do aids <- filterHear (bpos body) as return $ Just aids -- profound UpdCreateItem iid item _ (CActor aid cstore) -> do -- Kinetic damage implies the explosion is loud enough to cause noise. itemKind <- getsState $ getItemKindServer item discoAspect <- getsState sdiscoAspect let arItem = discoAspect EM.! iid if cstore /= COrgan || IA.checkFlag Ability.Blast arItem && Dice.supDice (IK.idamage itemKind) > 0 then do body <- getsState $ getActorBody aid aids <- filterHear (bpos body) as return $ Just aids -- profound else return Nothing UpdTrajectory aid (Just (l, _)) Nothing | not (null l) -> do -- Non-blast actor hits a non-walkable tile. b <- getsState $ getActorBody aid discoAspect <- getsState sdiscoAspect let arTrunk = discoAspect EM.! btrunk b aids <- filterHear (bpos b) as return $! if bproj b && IA.checkFlag Ability.Blast arTrunk || null aids then Nothing else Just aids UpdAlterTile _ p _ toTile -> do aids <- filterHear p as return $! if Tile.isDoor coTileSpeedup toTile && null aids then Nothing else Just aids -- profound UpdAlterExplorable{} -> return $ Just [] -- profound _ -> return Nothing -- | Messages for some unseen sfx. hearSfxAtomic :: MonadServer m => [(ActorId, Actor)] -> SfxAtomic -> m (Maybe (HearMsg, [ActorId])) hearSfxAtomic as cmd = case cmd of SfxStrike aid _ iid _ -> do -- Only the attacker position considered, for simplicity. b <- getsState $ getActorBody aid discoAspect <- getsState sdiscoAspect let arItem = discoAspect EM.! iid aids <- filterHear (bpos b) as itemKindId <- getsState $ getIidKindIdServer iid -- Loud explosions cause enough noise, so ignoring particle hit spam. return $! if IA.checkFlag Ability.Blast arItem || null aids then Nothing else Just (HearStrike itemKindId, aids) SfxEffect _ aid (IK.Summon grp p) _ -> do b <- getsState $ getActorBody aid aids <- filterHear (bpos b) as return $! if null aids then Nothing else Just (HearSummon (bproj b) grp p, aids) SfxTaunt voluntary aid -> do b <- getsState $ getActorBody aid aids <- filterHear (bpos b) as (subject, verb) <- displayTaunt voluntary rndToAction aid return $ Just (HearTaunt $ subject <+> verb, aids) -- intentional _ -> return Nothing filterHear :: MonadStateRead m => Point -> [(ActorId, Actor)] -> m [ActorId] filterHear pos as = do let actorHear (aid, body) = do -- Actors hear as if they were leaders, for speed and to prevent -- micromanagement by switching leader to hear more. -- This is analogous to actors seeing as if they were leaders. actorMaxSk <- getsState $ getActorMaxSkills aid return $! Ability.getSk Ability.SkHearing actorMaxSk >= chessDist pos (bpos body) map fst <$> filterM actorHear as sendPer :: (MonadServerAtomic m, MonadServerComm m) => FactionId -> LevelId -> Perception -> Perception -> Perception -> m () {-# INLINE sendPer #-} sendPer fid lid outPer inPer perNew = do knowEvents <- getsServer $ sknowEvents . soptions unless knowEvents $ do -- inconsistencies would quickly manifest sendUpdNoState fid $ UpdPerception lid outPer inPer sClient <- getsServer $ (EM.! fid) . sclientStates let forget = atomicForget fid lid outPer sClient remember <- getsState $ atomicRemember lid inPer sClient let seenNew = seenAtomicCli False fid perNew psRem <- mapM posUpdAtomic remember -- Verify that we remember only currently seen things. let !_A = assert (allB seenNew psRem) () mapM_ (sendUpdateCheck fid) forget mapM_ (sendUpdate fid) remember -- Remembered items, map tiles and smells are not wiped out when they get -- out of FOV. Clients remember them. Only actors are forgotten. atomicForget :: FactionId -> LevelId -> Perception -> State -> [UpdAtomic] atomicForget side lid outPer sClient = -- Wipe out actors that just became invisible due to changed FOV. let outFov = totalVisible outPer fActor (aid, b) = -- We forget only currently invisible actors. Actors can be outside -- perception, but still visible, if they belong to our faction, -- e.g., if they teleport to outside of current perception -- or if they have disabled senses. UpdLoseActor aid b $ getCarriedAssocsAndTrunk b sClient -- this command always succeeds, the actor can be always removed, -- because the actor is taken from the state outPrioBig = mapMaybe (\p -> posToBigAssoc p lid sClient) $ ES.elems outFov outPrioProj = concatMap (\p -> posToProjAssocs p lid sClient) $ ES.elems outFov in map fActor $ filter ((/= side) . bfid . snd) outPrioBig ++ outPrioProj atomicRemember :: LevelId -> Perception -> State -> State -> [UpdAtomic] {-# INLINE atomicRemember #-} atomicRemember lid inPer sClient s = let COps{cotile, coTileSpeedup} = scops s inFov = ES.elems $ totalVisible inPer lvl = sdungeon s EM.! lid -- Wipe out remembered items on tiles that now came into view -- and spot items on these tiles. Optimized away, when items match. lvlClient = sdungeon sClient EM.! lid inContainer allow fc bagEM bagEMClient = let f p = case (EM.lookup p bagEM, EM.lookup p bagEMClient) of (Nothing, Nothing) -> [] -- most common, no items ever (Just bag, Nothing) -> -- common, client unaware let ais = map (\iid -> (iid, getItemBody iid s)) (EM.keys bag) in [UpdSpotItemBag (fc lid p) bag ais | allow p] (Nothing, Just bagClient) -> -- uncommon, all items vanished -- We don't check @allow@, because client sees items there, -- so we assume he's aware of the tile enough to notice. let aisClient = map (\iid -> (iid, getItemBody iid sClient)) (EM.keys bagClient) in [UpdLoseItemBag (fc lid p) bagClient aisClient] (Just bag, Just bagClient) -> -- We don't check @allow@, because client sees items there, -- so we assume he's aware of the tile enough to see new items. if bag == bagClient then [] -- common, nothing has changed, so optimized else -- uncommon, surprise; because it's rare, we send -- whole bags and don't optimize by sending only delta let aisClient = map (\iid -> (iid, getItemBody iid sClient)) (EM.keys bagClient) ais = map (\iid -> (iid, getItemBody iid s)) (EM.keys bag) in [ UpdLoseItemBag (fc lid p) bagClient aisClient , UpdSpotItemBag (fc lid p) bag ais ] in concatMap f inFov inFloor = inContainer (const True) CFloor (lfloor lvl) (lfloor lvlClient) -- Check that client may be shown embedded items, assuming he's not seeing -- any at this position so far. If he's not shown now, the items will be -- revealed via searching the tile later on. -- This check is essential to prevent embedded items from leaking -- tile identity. allowEmbed p = not (Tile.isHideAs coTileSpeedup $ lvl `at` p) || lvl `at` p == lvlClient `at` p inEmbed = inContainer allowEmbed CEmbed (lembed lvl) (lembed lvlClient) -- Spot tiles. atomicTile = -- We ignore the server resending us hidden versions of the tiles -- (or resending us the same data we already got). -- If the tiles are changed to other variants of the hidden tile, -- we can still verify by searching. let f p (loses1, spots1, entries1) = let t = lvl `at` p tHidden = fromMaybe t $ Tile.hideAs cotile t tClient = lvlClient `at` p entries2 = case EM.lookup p $ lentry lvl of Nothing -> entries1 Just entry2 -> case EM.lookup p $ lentry lvlClient of Nothing -> (p, entry2) : entries1 Just entry3 -> assert (entry3 == entry2) entries1 -- avoid resending entries if client previously saw -- another not hidden tile at that position in if tClient `elem` [t, tHidden] then (loses1, spots1, entries1) else ( if isUknownSpace tClient then loses1 else (p, tClient) : loses1 , (p, tHidden) : spots1 -- send the hidden version , if tHidden == t then entries2 else entries1) (loses, spots, entries) = foldr f ([], [], []) inFov in [UpdLoseTile lid loses | not $ null loses] ++ [UpdSpotTile lid spots | not $ null spots] ++ [UpdSpotEntry lid entries | not $ null entries] -- Wipe out remembered smell on tiles that now came into smell Fov. -- Smell radius is small, so we can just wipe and send all. -- TODO: only send smell younger than ltime (states get out of sync) -- or remove older smell elsewhere in the code each turn (expensive). -- For now clients act as if this was the case, not peeking into old. inSmellFov = ES.elems $ totalSmelled inPer inSm = mapMaybe (\p -> (p,) <$> EM.lookup p (lsmell lvlClient)) inSmellFov inSmell = if null inSm then [] else [UpdLoseSmell lid inSm] -- Spot smells. inSm2 = mapMaybe (\p -> (p,) <$> EM.lookup p (lsmell lvl)) inSmellFov atomicSmell = if null inSm2 then [] else [UpdSpotSmell lid inSm2] -- Actors come last to report the environment they land on. inAssocs = concatMap (\p -> posToAidAssocs p lid s) inFov -- Here, the actor may be already visible, e.g., when teleporting, -- so the exception is caught in @sendUpdate@ above. fActor (aid, b) = let ais = getCarriedAssocsAndTrunk b s in UpdSpotActor aid b ais inActor = map fActor inAssocs in atomicTile ++ inFloor ++ inEmbed ++ inSmell ++ atomicSmell ++ inActor LambdaHack-0.9.5.0/engine-src/Game/LambdaHack/Server/Commandline.hs0000644000000000000000000002366707346545000022743 0ustar0000000000000000{-# LANGUAGE ApplicativeDo #-} -- | Parsing of commandline arguments. module Game.LambdaHack.Server.Commandline ( serverOptionsPI #ifdef EXPOSE_INTERNAL -- * Internal operations , serverOptionsP -- other internal operations too numerous and changing, so not listed #endif ) where import Prelude () import Game.LambdaHack.Core.Prelude -- Cabal import qualified Paths_LambdaHack as Self (version) import qualified Data.Text as T import Data.Version import Options.Applicative import qualified System.Random as R -- Dependence on ClientOptions is an anomaly. Instead, probably the raw -- remaining commandline should be passed and parsed by the client to extract -- client and ui options from and singnal an error if anything was left. import Game.LambdaHack.Client (ClientOptions (..)) import Game.LambdaHack.Definition.Defs import Game.LambdaHack.Common.Faction import Game.LambdaHack.Content.ModeKind import Game.LambdaHack.Server.ServerOptions -- | Parser for server options from commandline arguments. serverOptionsPI :: ParserInfo ServerOptions serverOptionsPI = info (serverOptionsP <**> helper <**> version) $ fullDesc <> progDesc "Configure debug options here, gameplay options in configuration file." version :: Parser (a -> a) version = infoOption (showVersion Self.version) (long "version" <> help "Print engine version information") serverOptionsP :: Parser ServerOptions serverOptionsP = do ~(snewGameSer, scurChalSer) <- serToChallenge <$> newGameP knowMap <- knowMapP knowEvents <- knowEventsP knowItems <- knowItemsP showItemSamples <- showItemSamplesP sexposePlaces <- exposePlacesP sexposeItems <- exposeItemsP sexposeActors <- exposeActorsP sniff <- sniffP sallClear <- allClearP sboostRandomItem <- boostRandItemP sgameMode <- gameModeP sautomateAll <- automateAllP skeepAutomated <- keepAutomatedP sstopAfterSeconds <- stopAfterSecsP sstopAfterFrames <- stopAfterFramesP sprintEachScreen <- printEachScreenP sbenchmark <- benchmarkP sdungeonRng <- setDungeonRngP smainRng <- setMainRngP sdumpInitRngs <- dumpInitRngsP sdbgMsgSer <- dbgMsgSerP sgtkFontFamily <- gtkFontFamilyP sdlFontFile <- sdlFontFileP sdlScalableSizeAdd <- sdlScalableSizeAddP sdlBitmapSizeAdd <- sdlBitmapSizeAddP sscalableFontSize <- scalableFontSizeP sfontDir <- fontDirP slogPriority <- logPriorityP smaxFps <- maxFpsP sdisableAutoYes <- disableAutoYesP snoAnim <- noAnimP ssavePrefixSer <- savePrefixP sfrontendTeletype <- frontendTeletypeP sfrontendNull <- frontendNullP sfrontendLazy <- frontendLazyP sdbgMsgCli <- dbgMsgCliP pure ServerOptions { sclientOptions = ClientOptions { stitle = Nothing , snewGameCli = snewGameSer , ssavePrefixCli = ssavePrefixSer , .. } , sknowMap = knowMap || knowEvents || knowItems , sknowEvents = knowEvents || knowItems , sknowItems = knowItems , sshowItemSamples = not (knowEvents || knowItems) && showItemSamples , .. } where serToChallenge :: Maybe Int -> (Bool, Challenge) serToChallenge Nothing = (False, defaultChallenge) serToChallenge (Just cdiff) = (True, defaultChallenge {cdiff}) knowMapP :: Parser Bool knowMapP = switch ( long "knowMap" <> help "Reveal map for all clients in the next game" ) knowEventsP :: Parser Bool knowEventsP = switch ( long "knowEvents" <> help "Show all events in the next game (implies --knowMap)" ) knowItemsP :: Parser Bool knowItemsP = switch ( long "knowItems" <> help "Auto-identify all items in the next game (implies --knowEvents)" ) exposePlacesP :: Parser Bool exposePlacesP = switch ( long "exposePlaces" <> help "Expose all possible places in the next game" ) exposeItemsP :: Parser Bool exposeItemsP = switch ( long "exposeItems" <> help "Expose all possible items in the next game" ) exposeActorsP :: Parser Bool exposeActorsP = switch ( long "exposeActors" <> help "Expose all killable actors in the next game" ) showItemSamplesP :: Parser Bool showItemSamplesP = switch ( long "showItemSamples" <> help "At game over show samples of all items (--sknowEvents disables this)" ) sniffP :: Parser Bool sniffP = switch ( long "sniff" <> help "Monitor all trafic between server and clients" ) allClearP :: Parser Bool allClearP = switch ( long "allClear" <> help "Let all map tiles be translucent" ) boostRandItemP :: Parser Bool boostRandItemP = switch ( long "boostRandomItem" <> help "Pick a random item and make it very common" ) gameModeP :: Parser (Maybe (GroupName ModeKind)) gameModeP = optional $ toGameMode <$> strOption ( long "gameMode" <> metavar "MODE" <> help "Start next game in the scenario indicated by MODE" ) where toGameMode :: String -> GroupName ModeKind toGameMode = toGroupName . T.pack automateAllP :: Parser Bool automateAllP = switch ( long "automateAll" <> help "Give control of all UI teams to computer" ) keepAutomatedP :: Parser Bool keepAutomatedP = switch ( long "keepAutomated" <> help "Keep factions automated after game over" ) newGameP :: Parser (Maybe Int) newGameP = optional $ option auto ( long "newGame" <> help "Start a new game, overwriting the save file, with difficulty for all UI players set to N" <> metavar "N" ) stopAfterSecsP :: Parser (Maybe Int) stopAfterSecsP = optional $ option auto ( long "stopAfterSeconds" <> help "Exit game session after around N seconds" <> metavar "N" ) stopAfterFramesP :: Parser (Maybe Int) stopAfterFramesP = optional $ option auto ( long "stopAfterFrames" <> help "Exit game session after around N frames" <> metavar "N" ) printEachScreenP :: Parser Bool printEachScreenP = switch ( long "printEachScreen" <> help "Take a screenshot of each rendered distinct frame (SDL only)" ) benchmarkP :: Parser Bool benchmarkP = switch ( long "benchmark" <> help "Restrict file IO, print timing stats" ) setDungeonRngP :: Parser (Maybe R.StdGen) setDungeonRngP = optional $ option auto ( long "setDungeonRng" <> metavar "RNG_SEED" <> help "Set dungeon generation RNG seed to string RNG_SEED" ) setMainRngP :: Parser (Maybe R.StdGen) setMainRngP = optional $ option auto ( long "setMainRng" <> metavar "RNG_SEED" <> help "Set the main game RNG seed to string RNG_SEED" ) dumpInitRngsP :: Parser Bool dumpInitRngsP = switch ( long "dumpInitRngs" <> help "Dump the RNG seeds used to initialize the game" ) dbgMsgSerP :: Parser Bool dbgMsgSerP = switch ( long "dbgMsgSer" <> help "Emit extra internal server debug messages" ) gtkFontFamilyP :: Parser (Maybe Text) gtkFontFamilyP = optional $ T.pack <$> strOption ( long "gtkFontFamily" <> metavar "FONT_FAMILY" <> help "Use FONT_FAMILY for the main game window in GTK frontend" ) sdlFontFileP :: Parser (Maybe Text) sdlFontFileP = optional $ T.pack <$> strOption ( long "sdlFontFile" <> metavar "FONT_FILE" <> help "Use FONT_FILE for the main game window in SDL2 frontend" ) sdlScalableSizeAddP :: Parser (Maybe Int) sdlScalableSizeAddP = optional $ option auto ( long "sdlScalableSizeAdd" <> metavar "N" <> help "Enlarge map cells by N over scalable font max height in SDL2 frontend (N may be negative)" ) sdlBitmapSizeAddP :: Parser (Maybe Int) sdlBitmapSizeAddP = optional $ option auto ( long "sdlBitmapSizeAdd" <> metavar "N" <> help "Enlarge map cells by N on top of bitmap font max height in SDL2 frontend (N may be negative)" ) scalableFontSizeP :: Parser (Maybe Int) scalableFontSizeP = optional $ option auto ( long "scalableFontSize" <> metavar "N" <> help "Use font size of N pixels for the main game window (interpreted differently by different graphical frontends; ignored for bitmap fonts)" ) fontDirP :: Parser (Maybe FilePath) fontDirP = optional $ option auto ( long "fontDir" <> metavar "FILEPATH" <> help "Take font files for the SDL2 frontend from FILEPATH" ) maxFpsP :: Parser (Maybe Int) maxFpsP = optional $ max 1 <$> option auto ( long "maxFps" <> metavar "N" <> help "Display at most N frames per second" ) logPriorityP :: Parser (Maybe Int) logPriorityP = optional $ max 0 <$> option auto ( long "logPriority" <> metavar "N" <> help "Log only messages of priority at least N, where 1 (all) is the lowest and 5 (errors only) is the default." ) disableAutoYesP :: Parser Bool disableAutoYesP = switch ( long "disableAutoYes" <> help "Never auto-answer prompts, not even when UI faction is automated" ) noAnimP :: Parser (Maybe Bool) noAnimP = flag Nothing (Just True) ( long "noAnim" <> help "Don't show any animations" ) savePrefixP :: Parser String savePrefixP = strOption ( long "savePrefix" <> metavar "PREFIX" <> value "" <> help "Prepend PREFIX to all savefile names" ) frontendTeletypeP :: Parser Bool frontendTeletypeP = switch ( long "frontendTeletype" <> help "Use the line terminal frontend (for tests)" ) frontendNullP :: Parser Bool frontendNullP = switch ( long "frontendNull" <> help "Use frontend with no display (for benchmarks)" ) frontendLazyP :: Parser Bool frontendLazyP = switch ( long "frontendLazy" <> help "Use frontend that not even computes frames (for benchmarks)" ) dbgMsgCliP :: Parser Bool dbgMsgCliP = switch ( long "dbgMsgCli" <> help "Emit extra internal client debug messages" ) LambdaHack-0.9.5.0/engine-src/Game/LambdaHack/Server/CommonM.hs0000644000000000000000000007560607346545000022062 0ustar0000000000000000{-# LANGUAGE TupleSections #-} -- | Server operations common to many modules. module Game.LambdaHack.Server.CommonM ( revealItems, moveStores, generalMoveItem , deduceQuits, deduceKilled, electLeader, setFreshLeader , updatePer, recomputeCachePer, projectFail , addActorFromGroup, registerActor, discoverIfMinorEffects , pickWeaponServer, currentSkillsServer, allGroupItems , addCondition, removeConditionSingle, addSleep, removeSleepSingle , addKillToAnalytics #ifdef EXPOSE_INTERNAL -- * Internal operations , containerMoveItem, quitF, keepArenaFact, anyActorsAlive, projectBla , addProjectile, addActorIid, getCacheLucid, getCacheTotal #endif ) where import Prelude () import Game.LambdaHack.Core.Prelude import qualified Data.EnumMap.Strict as EM import qualified Data.Ord as Ord import Data.Ratio import Game.LambdaHack.Atomic import Game.LambdaHack.Client (ClientOptions (..)) import Game.LambdaHack.Common.Actor import Game.LambdaHack.Common.ActorState import Game.LambdaHack.Common.Analytics import Game.LambdaHack.Common.Faction import Game.LambdaHack.Common.Item import qualified Game.LambdaHack.Common.ItemAspect as IA import Game.LambdaHack.Common.Kind import Game.LambdaHack.Common.Level import Game.LambdaHack.Common.Misc import Game.LambdaHack.Common.MonadStateRead import Game.LambdaHack.Common.Perception import Game.LambdaHack.Common.ReqFailure import Game.LambdaHack.Common.State import qualified Game.LambdaHack.Common.Tile as Tile import Game.LambdaHack.Common.Time import Game.LambdaHack.Common.Types import Game.LambdaHack.Content.ItemKind (ItemKind) import qualified Game.LambdaHack.Content.ItemKind as IK import Game.LambdaHack.Content.ModeKind import Game.LambdaHack.Content.RuleKind import Game.LambdaHack.Common.Point import Game.LambdaHack.Core.Random import qualified Game.LambdaHack.Definition.Ability as Ability import Game.LambdaHack.Definition.Defs import Game.LambdaHack.Server.Fov import Game.LambdaHack.Server.ItemM import Game.LambdaHack.Server.ItemRev import Game.LambdaHack.Server.MonadServer import Game.LambdaHack.Server.ServerOptions import Game.LambdaHack.Server.State revealItems :: MonadServerAtomic m => FactionId -> m () revealItems fid = do COps{coitem} <- getsState scops ServerOptions{sclientOptions} <- getsServer soptions discoAspect <- getsState sdiscoAspect let discover aid store iid _ = do itemKindId <- getsState $ getIidKindIdServer iid let arItem = discoAspect EM.! iid c = CActor aid store itemKind = okind coitem itemKindId unless (IA.isHumanTrinket itemKind) $ -- a hack execUpdAtomic $ UpdDiscover c iid itemKindId arItem f (aid, b) = -- CSha is IDed for each actor of each faction, which is fine, -- even though it may introduce a slight lag at gameover. join $ getsState $ mapActorItems_ (discover aid) b -- Don't ID projectiles, their items are not really owned by the party. aids <- getsState $ fidActorNotProjGlobalAssocs fid mapM_ f aids dungeon <- getsState sdungeon let minLid = fst $ minimumBy (Ord.comparing (ldepth . snd)) $ EM.assocs dungeon discoverSample iid = do itemKindId <- getsState $ getIidKindIdServer iid let arItem = discoAspect EM.! iid cdummy = CTrunk fid minLid originPoint -- only @fid@ matters here itemKind = okind coitem itemKindId unless (IA.isHumanTrinket itemKind) $ -- a hack execUpdAtomic $ UpdDiscover cdummy iid itemKindId arItem generationAn <- getsServer sgenerationAn getKindId <- getsState $ flip getIidKindIdServer let kindsEqual iid iid2 = getKindId iid == getKindId iid2 && iid /= iid2 nonDupSample em iid 0 = not $ any (kindsEqual iid) $ EM.keys em nonDupSample _ _ _ = True nonDupGen = EM.map (\em -> EM.filterWithKey (nonDupSample em) em) generationAn -- Remove samples that are supplanted by real items. -- If there are mutliple UI factions, the second run will be vacuus, -- but it's important to do that before the first try to identify things -- to prevent spam from identifying samples that are not needed. modifyServer $ \ser -> ser {sgenerationAn = nonDupGen} when (sexposeActors sclientOptions) $ -- Few, if any, need ID, but we can't rule out unusual content. mapM_ discoverSample $ EM.keys $ nonDupGen EM.! STrunk when (sexposeItems sclientOptions) $ mapM_ discoverSample $ EM.keys $ nonDupGen EM.! SItem mapM_ discoverSample $ EM.keys $ nonDupGen EM.! SEmbed mapM_ discoverSample $ EM.keys $ nonDupGen EM.! SOrgan mapM_ discoverSample $ EM.keys $ nonDupGen EM.! SCondition mapM_ discoverSample $ EM.keys $ nonDupGen EM.! SBlast moveStores :: MonadServerAtomic m => Bool -> ActorId -> CStore -> CStore -> m () moveStores verbose aid fromStore toStore = do b <- getsState $ getActorBody aid let g iid (k, _) = do move <- generalMoveItem verbose iid k (CActor aid fromStore) (CActor aid toStore) mapM_ execUpdAtomic move mapActorCStore_ fromStore g b -- | Generate the atomic updates that jointly perform a given item move. generalMoveItem :: MonadStateRead m => Bool -> ItemId -> Int -> Container -> Container -> m [UpdAtomic] generalMoveItem _ iid k (CActor aid1 cstore1) (CActor aid2 cstore2) | aid1 == aid2 && cstore1 /= CSha && cstore2 /= CSha = return [UpdMoveItem iid k aid1 cstore1 cstore2] generalMoveItem verbose iid k c1 c2 = containerMoveItem verbose iid k c1 c2 containerMoveItem :: MonadStateRead m => Bool -> ItemId -> Int -> Container -> Container -> m [UpdAtomic] containerMoveItem verbose iid k c1 c2 = do bag <- getsState $ getContainerBag c1 case iid `EM.lookup` bag of Nothing -> error $ "" `showFailure` (iid, k, c1, c2) Just (_, it) -> do item <- getsState $ getItemBody iid return [ UpdLoseItem verbose iid item (k, take k it) c1 , UpdSpotItem verbose iid item (k, take k it) c2 ] quitF :: MonadServerAtomic m => Status -> FactionId -> m () quitF status fid = do fact <- getsState $ (EM.! fid) . sfactionD let oldSt = gquit fact -- Note that it's the _old_ status that we check here. case stOutcome <$> oldSt of Just Killed -> return () -- Do not overwrite in case Just Defeated -> return () -- many things happen in 1 turn. Just Conquer -> return () Just Escape -> return () _ -> do -- This runs regardless of the _new_ status. manalytics <- if fhasUI $ gplayer fact then do keepAutomated <- getsServer $ skeepAutomated . soptions -- Try to remove AI control of the UI faction, to show endgame info. when (isAIFact fact && fleaderMode (gplayer fact) /= LeaderNull && not keepAutomated) $ execUpdAtomic $ UpdAutoFaction fid False itemD <- getsState sitemD dungeon <- getsState sdungeon let ais = EM.assocs itemD minLid = fst $ minimumBy (Ord.comparing (ldepth . snd)) $ EM.assocs dungeon execUpdAtomic $ UpdSpotItemBag (CTrunk fid minLid originPoint) EM.empty ais revealItems fid -- Likely, by this time UI faction is no longer AI-controlled, -- so the score will get registered. registerScore status fid factionAn <- getsServer sfactionAn generationAn <- getsServer sgenerationAn return $ Just (factionAn, generationAn) else return Nothing execUpdAtomic $ UpdQuitFaction fid oldSt (Just status) manalytics modifyServer $ \ser -> ser {sbreakLoop = True} -- check game over -- Send any UpdQuitFaction actions that can be deduced from factions' -- current state. deduceQuits :: MonadServerAtomic m => FactionId -> Status -> m () deduceQuits fid0 status@Status{stOutcome} | stOutcome `elem` [Defeated, Camping, Restart, Conquer] = error $ "no quitting to deduce" `showFailure` (fid0, status) deduceQuits fid0 status = do fact0 <- getsState $ (EM.! fid0) . sfactionD let factHasUI = fhasUI . gplayer quitFaction (stOutcome, (fid, _)) = quitF status{stOutcome} fid mapQuitF outfids = do let (withUI, withoutUI) = partition (factHasUI . snd . snd) ((stOutcome status, (fid0, fact0)) : outfids) mapM_ quitFaction (withoutUI ++ withUI) inGameOutcome (fid, fact) = do let mout | fid == fid0 = Just $ stOutcome status | otherwise = stOutcome <$> gquit fact case mout of Just Killed -> False Just Defeated -> False Just Restart -> False -- effectively, commits suicide _ -> True factionD <- getsState sfactionD let assocsInGame = filter inGameOutcome $ EM.assocs factionD assocsKeepArena = filter (keepArenaFact . snd) assocsInGame assocsUI = filter (factHasUI . snd) assocsInGame nonHorrorAIG = filter (not . isHorrorFact . snd) assocsInGame worldPeace = all (\(fid1, _) -> all (\(fid2, fact2) -> not $ isFoe fid2 fact2 fid1) nonHorrorAIG) nonHorrorAIG othersInGame = filter ((/= fid0) . fst) assocsInGame if | null assocsUI -> -- Only non-UI players left in the game and they all win. mapQuitF $ zip (repeat Conquer) othersInGame | null assocsKeepArena -> -- Only leaderless and spawners remain (the latter may sometimes -- have no leader, just as the former), so they win, -- or we could get stuck in a state with no active arena -- and so no spawns. mapQuitF $ zip (repeat Conquer) othersInGame | worldPeace -> -- Nobody is at war any more, so all win (e.g., horrors, but never mind). mapQuitF $ zip (repeat Conquer) othersInGame | stOutcome status == Escape -> do -- Otherwise, in a game with many warring teams alive, -- only complete Victory matters, until enough of them die. let (victors, losers) = partition (\(fi, _) -> isFriend fid0 fact0 fi) othersInGame mapQuitF $ zip (repeat Escape) victors ++ zip (repeat Defeated) losers | otherwise -> quitF status fid0 -- | Tell whether a faction that we know is still in game, keeps arena. -- Keeping arena means, if the faction is still in game, -- it always has a leader in the dungeon somewhere. -- So, leaderless factions and spawner factions do not keep an arena, -- even though the latter usually has a leader for most of the game. keepArenaFact :: Faction -> Bool keepArenaFact fact = fleaderMode (gplayer fact) /= LeaderNull && fneverEmpty (gplayer fact) -- We assume the actor in the second argument has HP <= 0 or is going to be -- dominated right now. Even if the actor is to be dominated, -- @bfid@ of the actor body is still the old faction. deduceKilled :: MonadServerAtomic m => ActorId -> m () deduceKilled aid = do body <- getsState $ getActorBody aid fact <- getsState $ (EM.! bfid body) . sfactionD when (fneverEmpty $ gplayer fact) $ do actorsAlive <- anyActorsAlive (bfid body) aid when (not actorsAlive) $ deduceQuits (bfid body) $ Status Killed (fromEnum $ blid body) Nothing anyActorsAlive :: MonadServer m => FactionId -> ActorId -> m Bool anyActorsAlive fid aid = do as <- getsState $ fidActorNotProjGlobalAssocs fid -- We test HP here, in case more than one actor goes to 0 HP in the same turn. return $! any (\(aid2, b2) -> aid2 /= aid && bhp b2 > 0) as electLeader :: MonadServerAtomic m => FactionId -> LevelId -> ActorId -> m () electLeader fid lid aidToReplace = do mleader <- getsState $ gleader . (EM.! fid) . sfactionD when (mleader == Just aidToReplace) $ do allOurs <- getsState $ fidActorNotProjGlobalAssocs fid -- not only on level let -- Prefer actors on this level and with positive HP and not sleeping. -- Exclude @aidToReplace@, even if not dead (e.g., if being dominated). (positive, negative) = partition (\(_, b) -> bhp b > 0) allOurs (awake, sleeping) = partition (\(_, b) -> bwatch b /= WSleep) positive onThisLevel <- getsState $ fidActorRegularAssocs fid lid let candidates = filter (\(_, b) -> bwatch b /= WSleep) onThisLevel ++ awake ++ sleeping ++ negative mleaderNew = listToMaybe $ filter (/= aidToReplace) $ map fst $ candidates execUpdAtomic $ UpdLeadFaction fid mleader mleaderNew setFreshLeader :: MonadServerAtomic m => FactionId -> ActorId -> m () setFreshLeader fid aid = do fact <- getsState $ (EM.! fid) . sfactionD unless (fleaderMode (gplayer fact) == LeaderNull) $ do -- First update and send Perception so that the new leader -- may report his environment. b <- getsState $ getActorBody aid let !_A = assert (not $ bproj b) () valid <- getsServer $ (EM.! blid b) . (EM.! fid) . sperValidFid unless valid $ updatePer fid (blid b) execUpdAtomic $ UpdLeadFaction fid (gleader fact) (Just aid) updatePer :: MonadServerAtomic m => FactionId -> LevelId -> m () {-# INLINE updatePer #-} updatePer fid lid = do modifyServer $ \ser -> ser {sperValidFid = EM.adjust (EM.insert lid True) fid $ sperValidFid ser} sperFidOld <- getsServer sperFid let perOld = sperFidOld EM.! fid EM.! lid -- Performed in the State after action, e.g., with a new actor. perNew <- recomputeCachePer fid lid let inPer = diffPer perNew perOld outPer = diffPer perOld perNew unless (nullPer outPer && nullPer inPer) $ execSendPer fid lid outPer inPer perNew recomputeCachePer :: MonadServer m => FactionId -> LevelId -> m Perception recomputeCachePer fid lid = do total <- getCacheTotal fid lid fovLucid <- getCacheLucid lid let perNew = perceptionFromPTotal fovLucid total fper = EM.adjust (EM.insert lid perNew) fid modifyServer $ \ser -> ser {sperFid = fper $ sperFid ser} return perNew -- The missile item is removed from the store only if the projection -- went into effect (no failure occured). projectFail :: MonadServerAtomic m => ActorId -- ^ actor causing the projection -> ActorId -- ^ actor projecting the item (is on current lvl) -> Point -- ^ target position of the projectile -> Int -- ^ digital line parameter -> Bool -- ^ whether to start at the source position -> ItemId -- ^ the item to be projected -> CStore -- ^ whether the items comes from floor or inventory -> Bool -- ^ whether the item is a blast -> m (Maybe ReqFailure) projectFail propeller source tpxy eps center iid cstore blast = do COps{corule=RuleContent{rXmax, rYmax}, coTileSpeedup} <- getsState scops sb <- getsState $ getActorBody source let lid = blid sb spos = bpos sb lvl <- getLevel lid case bla rXmax rYmax eps spos tpxy of Nothing -> return $ Just ProjectAimOnself Just [] -> error $ "projecting from the edge of level" `showFailure` (spos, tpxy) Just (pos : restUnlimited) -> do bag <- getsState $ getBodyStoreBag sb cstore case EM.lookup iid bag of Nothing -> return $ Just ProjectOutOfReach Just _kit -> do itemFull <- getsState $ itemToFull iid actorSk <- currentSkillsServer source actorMaxSk <- getsState $ getActorMaxSkills source let skill = Ability.getSk Ability.SkProject actorSk forced = blast || bproj sb calmE = calmEnough sb actorMaxSk legal = permittedProject forced skill calmE itemFull arItem = aspectRecordFull itemFull case legal of Left reqFail -> return $ Just reqFail Right _ -> do let lobable = IA.checkFlag Ability.Lobable arItem rest = if lobable then take (chessDist spos tpxy - 1) restUnlimited else restUnlimited t = lvl `at` pos if | not $ Tile.isWalkable coTileSpeedup t -> return $ Just ProjectBlockTerrain | occupiedBigLvl pos lvl -> if blast && bproj sb then do -- Hit the blocking actor. projectBla propeller source spos (pos:rest) iid cstore blast return Nothing else return $ Just ProjectBlockActor | otherwise -> do -- Make the explosion less regular and weaker at edges. if blast && bproj sb && center then -- Start in the center, not around. projectBla propeller source spos (pos:rest) iid cstore blast else projectBla propeller source pos rest iid cstore blast return Nothing projectBla :: MonadServerAtomic m => ActorId -- ^ actor causing the projection -> ActorId -- ^ actor projecting the item (is on current lvl) -> Point -- ^ starting point of the projectile -> [Point] -- ^ rest of the trajectory of the projectile -> ItemId -- ^ the item to be projected -> CStore -- ^ whether the items comes from floor or inventory -> Bool -- ^ whether the item is a blast -> m () projectBla propeller source pos rest iid cstore blast = do sb <- getsState $ getActorBody source let lid = blid sb localTime <- getsState $ getLocalTime lid unless blast $ execSfxAtomic $ SfxProject source iid cstore bag <- getsState $ getBodyStoreBag sb cstore ItemFull{itemBase, itemKind} <- getsState $ itemToFull iid case iid `EM.lookup` bag of Nothing -> error $ "" `showFailure` (source, pos, rest, iid, cstore) Just kit@(_, it) -> do let delay = if IK.iweight itemKind == 0 then timeTurn -- big delay at start, e.g., to easily read hologram else timeZero -- avoid running into own projectiles btime = absoluteTimeAdd delay localTime addProjectile propeller pos rest iid kit lid (bfid sb) btime let c = CActor source cstore execUpdAtomic $ UpdLoseItem False iid itemBase (1, take 1 it) c addActorFromGroup :: MonadServerAtomic m => GroupName ItemKind -> FactionId -> Point -> LevelId -> Time -> m (Maybe ActorId) addActorFromGroup actorGroup bfid pos lid time = do -- We bootstrap the actor by first creating the trunk of the actor's body -- that contains the fixed properties of all actors of that kind. freq <- prepareItemKind 0 lid [(actorGroup, 1)] m2 <- rollItemAspect freq lid case m2 of Nothing -> return Nothing Just (itemKnown, itemFullKit) -> Just <$> registerActor False itemKnown itemFullKit bfid pos lid time registerActor :: MonadServerAtomic m => Bool -> ItemKnown -> ItemFullKit -> FactionId -> Point -> LevelId -> Time -> m ActorId registerActor summoned (ItemKnown kindIx ar _) (itemFullRaw, kit) bfid pos lid time = do let container = CTrunk bfid lid pos jfid = Just bfid itemKnown = ItemKnown kindIx ar jfid itemFull = itemFullRaw {itemBase = (itemBase itemFullRaw) {jfid}} trunkId <- registerItem (itemFull, kit) itemKnown container False aid <- addNonProjectile summoned trunkId (itemFull, kit) bfid pos lid time fact <- getsState $ (EM.! bfid) . sfactionD actorMaxSk <- getsState $ getActorMaxSkills aid condAnyFoeAdj <- getsState $ anyFoeAdj aid when (canSleep actorMaxSk && not condAnyFoeAdj && not summoned && not (fhasGender (gplayer fact))) $ do -- heroes never start asleep let sleepOdds = if prefersSleep actorMaxSk then 9%10 else 1%2 sleeps <- rndToAction $ chance sleepOdds when sleeps $ addSleep aid return aid addProjectile :: MonadServerAtomic m => ActorId -> Point -> [Point] -> ItemId -> ItemQuant -> LevelId -> FactionId -> Time -> m () addProjectile propeller pos rest iid (_, it) lid fid time = do itemFull <- getsState $ itemToFull iid let arItem = aspectRecordFull itemFull IK.ThrowMod{IK.throwHP} = IA.aToThrow arItem (trajectory, (speed, _)) = IA.itemTrajectory arItem (itemKind itemFull) (pos : rest) -- Trunk is added to equipment, not to organs, because it's the -- projected item, so it's carried, not grown. tweakBody b = b { bhp = xM throwHP , btrajectory = Just (trajectory, speed) , beqp = EM.singleton iid (1, take 1 it) } aid <- addActorIid iid itemFull True fid pos lid tweakBody bp <- getsState $ getActorBody propeller -- If propeller is a projectile, it may produce other projectiles, e.g., -- by exploding, so it's not voluntary, so others are to blame. -- However, we can't easily see whether a pushed non-projectile actor -- produced a projectile due to colliding or voluntarily, so we assign -- blame to him. originator <- if bproj bp then getsServer $ EM.findWithDefault propeller propeller . strajPushedBy else return propeller modifyServer $ \ser -> ser { strajTime = updateActorTime fid lid aid time $ strajTime ser , strajPushedBy = EM.insert aid originator $ strajPushedBy ser } addNonProjectile :: MonadServerAtomic m => Bool -> ItemId -> ItemFullKit -> FactionId -> Point -> LevelId -> Time -> m ActorId addNonProjectile summoned trunkId (itemFull, kit) fid pos lid time = do let tweakBody b = b { borgan = EM.singleton trunkId kit , bcalm = if summoned then xM 5 -- a tiny buffer before domination else bcalm b } aid <- addActorIid trunkId itemFull False fid pos lid tweakBody -- We assume actor is never born pushed. modifyServer $ \ser -> ser {sactorTime = updateActorTime fid lid aid time $ sactorTime ser} return aid addActorIid :: MonadServerAtomic m => ItemId -> ItemFull -> Bool -> FactionId -> Point -> LevelId -> (Actor -> Actor) -> m ActorId addActorIid trunkId ItemFull{itemBase, itemKind, itemDisco=ItemDiscoFull arItem} bproj fid pos lid tweakBody = do -- Initial HP and Calm is based only on trunk and ignores organs. let trunkMaxHP = max 2 $ IA.getSkill Ability.SkMaxHP arItem hp = xM trunkMaxHP `div` 2 -- Hard to auto-id items that refill Calm, but reduced sight at game -- start is more confusing and frustrating: calm = xM (max 0 $ IA.getSkill Ability.SkMaxCalm arItem) -- Create actor. factionD <- getsState sfactionD curChalSer <- getsServer $ scurChalSer . soptions -- If difficulty is below standard, HP is added to the UI factions, -- otherwise HP is added to their enemies. -- If no UI factions, their role is taken by the escapees (for testing). let diffBonusCoeff = difficultyCoeff $ cdiff curChalSer boostFact = not bproj && if diffBonusCoeff > 0 then any (fhasUI . gplayer . snd) (filter (\(fi, fa) -> isFriend fi fa fid) (EM.assocs factionD)) else any (fhasUI . gplayer . snd) (filter (\(fi, fa) -> isFoe fi fa fid) (EM.assocs factionD)) finalHP | boostFact = min (xM 899) -- no more than UI can stand (hp * 2 ^ abs diffBonusCoeff) | otherwise = hp maxHP = min (finalHP + xM 100) (2 * finalHP) -- prevent too high max HP resulting in panic when low HP/max HP ratio bonusHP = fromEnum (maxHP `div` oneM) - trunkMaxHP healthOrgans = [ (Just bonusHP, ("bonus HP", COrgan)) | bonusHP /= 0 && not bproj ] b = actorTemplate trunkId finalHP calm pos lid fid bproj withTrunk = b {bweapon = if IA.checkFlag Ability.Meleeable arItem then 1 else 0} bodyTweaked = tweakBody withTrunk aid <- getsServer sacounter modifyServer $ \ser -> ser {sacounter = succ aid} execUpdAtomic $ UpdCreateActor aid bodyTweaked [(trunkId, itemBase)] -- Create, register and insert all initial actor items, including -- the bonus health organs from difficulty setting. forM_ (healthOrgans ++ map (Nothing,) (IK.ikit itemKind)) $ \(mk, (ikText, cstore)) -> do let container = CActor aid cstore itemFreq = [(ikText, 1)] mIidEtc <- rollAndRegisterItem lid itemFreq container False mk case mIidEtc of Nothing -> error $ "" `showFailure` (lid, itemFreq, container, mk) Just (iid, (itemFull2, _)) -> when (cstore /= CGround) $ -- The items are created in inventory, so won't be picked up, -- so we have to discover them now, if eligible. discoverIfMinorEffects container iid (itemKindId itemFull2) return aid addActorIid _ _ _ _ _ _ _ = error "addActorIid: server ignorant about an item" discoverIfMinorEffects :: MonadServerAtomic m => Container -> ItemId -> ContentId ItemKind -> m () discoverIfMinorEffects c iid itemKindId = do COps{coitem} <- getsState scops discoAspect <- getsState sdiscoAspect let arItem = discoAspect EM.! iid itemKind = okind coitem itemKindId -- Otherwise, discover by use when item's effects get activated later on. when (IA.onlyMinorEffects arItem itemKind && not (IA.isHumanTrinket itemKind)) $ execUpdAtomic $ UpdDiscover c iid itemKindId arItem pickWeaponServer :: MonadServer m => ActorId -> m (Maybe (ItemId, CStore)) pickWeaponServer source = do eqpAssocs <- getsState $ kitAssocs source [CEqp] bodyAssocs <- getsState $ kitAssocs source [COrgan] actorSk <- currentSkillsServer source sb <- getsState $ getActorBody source let kitAssRaw = eqpAssocs ++ bodyAssocs forced = bproj sb kitAss | forced = kitAssRaw -- for projectiles, anything is weapon | otherwise = filter (IA.checkFlag Ability.Meleeable . aspectRecordFull . fst . snd) kitAssRaw -- Server ignores item effects or it would leak item discovery info. -- In particular, it even uses weapons that would heal opponent, -- and not only in case of projectiles. strongest <- pickWeaponM False Nothing kitAss actorSk source case strongest of [] -> return Nothing iis@((maxS, _) : _) -> do let maxIis = map snd $ takeWhile ((== maxS) . fst) iis (_, (iid, _)) <- rndToAction $ oneOf maxIis let cstore = if isJust (lookup iid bodyAssocs) then COrgan else CEqp return $ Just (iid, cstore) -- @MonadStateRead@ would be enough, but the logic is sound only on server. currentSkillsServer :: MonadServer m => ActorId -> m Ability.Skills currentSkillsServer aid = do body <- getsState $ getActorBody aid fact <- getsState $ (EM.! bfid body) . sfactionD let mleader = gleader fact getsState $ actorCurrentSkills mleader aid getCacheLucid :: MonadServer m => LevelId -> m FovLucid getCacheLucid lid = do fovClearLid <- getsServer sfovClearLid fovLitLid <- getsServer sfovLitLid fovLucidLid <- getsServer sfovLucidLid let getNewLucid = getsState $ \s -> lucidFromLevel fovClearLid fovLitLid s lid (sdungeon s EM.! lid) case EM.lookup lid fovLucidLid of Just (FovValid fovLucid) -> return fovLucid _ -> do newLucid <- getNewLucid modifyServer $ \ser -> ser {sfovLucidLid = EM.insert lid (FovValid newLucid) $ sfovLucidLid ser} return newLucid getCacheTotal :: MonadServer m => FactionId -> LevelId -> m CacheBeforeLucid getCacheTotal fid lid = do sperCacheFidOld <- getsServer sperCacheFid let perCacheOld = sperCacheFidOld EM.! fid EM.! lid case ptotal perCacheOld of FovValid total -> return total FovInvalid -> do actorMaxSkills <- getsState sactorMaxSkills fovClearLid <- getsServer sfovClearLid getActorB <- getsState $ flip getActorBody let perActorNew = perActorFromLevel (perActor perCacheOld) getActorB actorMaxSkills (fovClearLid EM.! lid) -- We don't check if any actor changed, because almost surely one is. -- Exception: when an actor is destroyed, but then union differs, too. total = totalFromPerActor perActorNew perCache = PerceptionCache { ptotal = FovValid total , perActor = perActorNew } fperCache = EM.adjust (EM.insert lid perCache) fid modifyServer $ \ser -> ser {sperCacheFid = fperCache $ sperCacheFid ser} return total allGroupItems :: MonadServerAtomic m => CStore -> GroupName ItemKind -> ActorId -> m [(ItemId, ItemQuant)] allGroupItems store grp target = do b <- getsState $ getActorBody target getKind <- getsState $ flip getIidKindServer let hasGroup (iid, _) = maybe False (> 0) $ lookup grp $ IK.ifreq $ getKind iid assocsCStore <- getsState $ EM.assocs . getBodyStoreBag b store return $! filter hasGroup assocsCStore addCondition :: MonadServerAtomic m => GroupName ItemKind -> ActorId -> m () addCondition name aid = do b <- getsState $ getActorBody aid let c = CActor aid COrgan mresult <- rollAndRegisterItem (blid b) [(name, 1)] c False Nothing assert (isJust mresult) $ return () removeConditionSingle :: MonadServerAtomic m => GroupName ItemKind -> ActorId -> m Int removeConditionSingle name aid = do let c = CActor aid COrgan is <- allGroupItems COrgan name aid case is of [(iid, (nAll, itemTimer))] -> do itemBase <- getsState $ getItemBody iid execUpdAtomic $ UpdLoseItem False iid itemBase (1, itemTimer) c return $ nAll - 1 _ -> error $ "missing or multiple item" `showFailure` (name, is) addSleep :: MonadServerAtomic m => ActorId -> m () addSleep aid = do b <- getsState $ getActorBody aid addCondition "asleep" aid execUpdAtomic $ UpdWaitActor aid (bwatch b) WSleep removeSleepSingle :: MonadServerAtomic m => ActorId -> m () removeSleepSingle aid = do nAll <- removeConditionSingle "asleep" aid when (nAll == 0) $ execUpdAtomic $ UpdWaitActor aid WWake WWatch addKillToAnalytics :: MonadServerAtomic m => ActorId -> KillHow -> FactionId -> ItemId -> m () addKillToAnalytics aid killHow fid iid = do actorD <- getsState sactorD case EM.lookup aid actorD of Just b -> modifyServer $ \ser -> ser { sfactionAn = addFactionKill (bfid b) killHow fid iid $ sfactionAn ser , sactorAn = addActorKill aid killHow fid iid $ sactorAn ser } Nothing -> return () -- killer dead, too late to assign blame LambdaHack-0.9.5.0/engine-src/Game/LambdaHack/Server/DebugM.hs0000644000000000000000000000764207346545000021653 0ustar0000000000000000-- | Debug output for requests and responses. module Game.LambdaHack.Server.DebugM ( debugResponse , debugRequestAI, debugRequestUI #ifdef EXPOSE_INTERNAL -- * Internal operations , debugShow, debugPretty, debugPlain, DebugAid(..), debugAid #endif ) where import Prelude () import Game.LambdaHack.Core.Prelude import Data.Int (Int64) import qualified Data.Text as T import qualified Text.Show.Pretty as Show.Pretty import Game.LambdaHack.Atomic import Game.LambdaHack.Client (Response (..)) import Game.LambdaHack.Common.Actor import Game.LambdaHack.Common.ActorState import Game.LambdaHack.Common.Types import Game.LambdaHack.Common.MonadStateRead import Game.LambdaHack.Common.Time import Game.LambdaHack.Server.MonadServer import Game.LambdaHack.Server.State -- We debug these on the server, not on the clients, because we want -- a single log, knowing the order in which the server received requests -- and sent responseQs. Clients interleave and block non-deterministically -- so their logs would be harder to interpret. debugShow :: Show a => a -> Text debugShow = T.pack . Show.Pretty.ppShow debugResponse :: MonadServer m => FactionId -> Response -> m () debugResponse fid resp = case resp of RespUpdAtomic _ cmd@UpdPerception{} -> debugPlain fid "RespUpdAtomic" cmd RespUpdAtomic _ cmd@UpdResume{} -> debugPlain fid "RespUpdAtomic" cmd RespUpdAtomic _ cmd@UpdRestart{} -> debugPlain fid "RespUpdAtomic" cmd RespUpdAtomic _ cmd@UpdSpotTile{} -> debugPlain fid "RespUpdAtomic" cmd RespUpdAtomic _ cmd@(UpdCreateActor aid _ _) -> do d <- debugAid aid "UpdCreateActor" serverPrint d debugPretty fid "RespUpdAtomic" cmd RespUpdAtomic _ cmd@(UpdSpotActor aid _ _) -> do d <- debugAid aid "UpdSpotActor" serverPrint d debugPretty fid "RespUpdAtomic" cmd RespUpdAtomic _ cmd -> debugPretty fid "RespUpdAtomic" cmd RespUpdAtomicNoState cmd@UpdPerception{} -> debugPlain fid "RespUpdAtomicNoState" cmd RespUpdAtomicNoState cmd@UpdResume{} -> debugPlain fid "RespUpdAtomicNoState" cmd RespUpdAtomicNoState cmd@UpdSpotTile{} -> debugPlain fid "RespUpdAtomicNoState" cmd RespUpdAtomicNoState cmd -> debugPretty fid "RespUpdAtomicNoState" cmd RespQueryAI aid -> do d <- debugAid aid "RespQueryAI" serverPrint d RespSfxAtomic sfx -> do -- not so crucial so no details ps <- posSfxAtomic sfx serverPrint $ debugShow (fid, "RespSfxAtomic" :: Text, ps) RespQueryUI -> serverPrint "RespQueryUI" debugPretty :: MonadServer m => FactionId -> Text -> UpdAtomic -> m () debugPretty fid t cmd = do ps <- posUpdAtomic cmd serverPrint $ debugShow (fid, t, ps, cmd) debugPlain :: MonadServer m => FactionId -> Text -> UpdAtomic -> m () debugPlain fid t cmd = do ps <- posUpdAtomic cmd serverPrint $ T.pack $ show (fid, t, ps, cmd) -- too large for pretty printing debugRequestAI :: MonadServer m => ActorId -> m () debugRequestAI aid = do d <- debugAid aid "AI request" serverPrint d debugRequestUI :: MonadServer m => ActorId -> m () debugRequestUI aid = do d <- debugAid aid "UI request" serverPrint d data DebugAid = DebugAid { label :: Text , aid :: ActorId , faction :: FactionId , lid :: LevelId , bHP :: Int64 , btime :: Maybe Time , btrTime :: Maybe Time , time :: Time } deriving Show debugAid :: MonadServer m => ActorId -> Text -> m Text debugAid aid label = do b <- getsState $ getActorBody aid time <- getsState $ getLocalTime (blid b) btime <- getsServer $ lookupActorTime (bfid b) (blid b) aid . sactorTime btrTime <- getsServer $ lookupActorTime (bfid b) (blid b) aid . strajTime return $! debugShow DebugAid { label , aid , faction = bfid b , lid = blid b , bHP = bhp b , btime , btrTime , time } LambdaHack-0.9.5.0/engine-src/Game/LambdaHack/Server/DungeonGen.hs0000644000000000000000000004137207346545000022537 0ustar0000000000000000{-# LANGUAGE TupleSections #-} -- | The dungeon generation routine. It creates empty dungeons, without -- actors and without items, either lying on the floor or embedded inside tiles. module Game.LambdaHack.Server.DungeonGen ( FreshDungeon(..), dungeonGen #ifdef EXPOSE_INTERNAL -- * Internal operations , convertTileMaps, buildTileMap, anchorDown, buildLevel , snapToStairList, placeDownStairs, levelFromCave #endif ) where import Prelude () import Game.LambdaHack.Core.Prelude import qualified Control.Monad.Trans.State.Strict as St import Data.Either (rights) import qualified Data.EnumMap.Strict as EM import qualified Data.IntMap.Strict as IM import qualified Data.Text as T import qualified Data.Text.IO as T import System.IO (hFlush, stdout) import System.IO.Unsafe (unsafePerformIO) import qualified System.Random as R import Game.LambdaHack.Common.Area import Game.LambdaHack.Definition.Defs import qualified Game.LambdaHack.Core.Dice as Dice import Game.LambdaHack.Common.Kind import Game.LambdaHack.Common.Level import Game.LambdaHack.Common.Point import qualified Game.LambdaHack.Common.PointArray as PointArray import Game.LambdaHack.Core.Random import qualified Game.LambdaHack.Common.Tile as Tile import Game.LambdaHack.Common.Time import Game.LambdaHack.Common.Types import Game.LambdaHack.Content.CaveKind import Game.LambdaHack.Content.ModeKind import qualified Game.LambdaHack.Content.PlaceKind as PK import Game.LambdaHack.Content.RuleKind import Game.LambdaHack.Content.TileKind (TileKind) import qualified Game.LambdaHack.Content.TileKind as TK import Game.LambdaHack.Server.DungeonGen.AreaRnd import Game.LambdaHack.Server.DungeonGen.Cave import Game.LambdaHack.Server.DungeonGen.Place import Game.LambdaHack.Server.ServerOptions convertTileMaps :: COps -> Bool -> Rnd (ContentId TileKind) -> Maybe (Rnd (ContentId TileKind)) -> Area -> TileMapEM -> Rnd TileMap convertTileMaps COps{corule=RuleContent{rXmax, rYmax}, cotile, coTileSpeedup} areAllWalkable cdefTile mpickPassable darea ltile = do let outerId = ouniqGroup cotile "unknown outer fence" runCdefTile :: (R.StdGen, (Int, [(Int, ContentId TileKind)])) -> ( ContentId TileKind , (R.StdGen, (Int, [(Int, ContentId TileKind)])) ) runCdefTile (gen1, (pI, assocs)) = let p = toEnum pI in if p `inside` darea then case assocs of (p2, t2) : rest | p2 == pI -> (t2, (gen1, (pI + 1, rest))) _ -> let (tile, gen2) = St.runState cdefTile gen1 in (tile, (gen2, (pI + 1, assocs))) else (outerId, (gen1, (pI + 1, assocs))) runUnfold gen = let (gen1, gen2) = R.split gen in (PointArray.unfoldrNA rXmax rYmax runCdefTile (gen1, (0, IM.assocs $ EM.enumMapToIntMap ltile)), gen2) converted1 <- St.state runUnfold case mpickPassable of _ | areAllWalkable -> return converted1 -- all walkable; passes OK Nothing -> return converted1 -- no walkable tiles for filling the map Just pickPassable -> do -- some tiles walkable, so ensure connectivity let passes p@Point{..} array = Tile.isWalkable coTileSpeedup (array PointArray.! p) -- If no point blocks on both ends, then I can eventually go -- from bottom to top of the map and from left to right -- unless there are disconnected areas inside rooms). blocksHorizontal (Point x y) array = not (passes (Point (x + 1) y) array || passes (Point (x - 1) y) array) blocksVertical (Point x y) array = not (passes (Point x (y + 1)) array || passes (Point x (y - 1)) array) xeven Point{..} = px `mod` 2 == 0 yeven Point{..} = py `mod` 2 == 0 activeArea = fromMaybe (error $ "" `showFailure` darea) $ shrink darea connect included blocks walkableTile array = let g p c = if p `inside` activeArea && included p && not (Tile.isEasyOpen coTileSpeedup c) && p `EM.notMember` ltile && blocks p array then walkableTile else c in PointArray.imapA g array walkable2 <- pickPassable let converted2 = connect xeven blocksHorizontal walkable2 converted1 walkable3 <- pickPassable let converted3 = connect yeven blocksVertical walkable3 converted2 walkable4 <- pickPassable let converted4 = connect (not . xeven) blocksHorizontal walkable4 converted3 walkable5 <- pickPassable let converted5 = connect (not . yeven) blocksVertical walkable5 converted4 return converted5 buildTileMap :: COps -> Cave -> Rnd TileMap buildTileMap cops@COps{cotile, cocave} Cave{dkind, darea, dmap} = do let CaveKind{cpassable, cdefTile} = okind cocave dkind pickDefTile = fromMaybe (error $ "" `showFailure` cdefTile) <$> opick cotile cdefTile (const True) wcond = Tile.isEasyOpenKind mpickPassable = if cpassable then Just $ fromMaybe (error $ "" `showFailure` cdefTile) <$> opick cotile cdefTile wcond else Nothing nwcond = not . Tile.kindHasFeature TK.Walkable areAllWalkable <- isNothing <$> opick cotile cdefTile nwcond convertTileMaps cops areAllWalkable pickDefTile mpickPassable darea dmap anchorDown :: Y anchorDown = 5 -- not 4, asymmetric vs up, for staircase variety; -- symmetry kept for @cfenceApart@ caves, to save real estate -- Create a level from a cave. buildLevel :: COps -> ServerOptions -> Int -> GroupName CaveKind -> Int -> Dice.AbsDepth -> [(Point, Text)] -> Rnd (Level, [(Point, Text)]) buildLevel cops@COps{cocave, coplace, corule=RuleContent{..}} serverOptions ln genName minD totalDepth lstairPrev = do dkind <- fromMaybe (error $ "" `showFailure` genName) <$> opick cocave genName (const True) let kc = okind cocave dkind d = if cfenceApart kc then 1 else 0 -- Simple rule for now: level @ln@ has depth (difficulty) @abs ln@. ldepth = Dice.AbsDepth $ abs ln darea = let (lxPrev, lyPrev) = unzip $ map (px . fst &&& py . fst) lstairPrev -- Stairs take some space, hence the additions. lxMin = max 0 $ -4 - d + minimum (rXmax - 1 : lxPrev) lxMax = min (rXmax - 1) $ 4 + d + maximum (0 : lxPrev) lyMin = max 0 $ -3 - d + minimum (rYmax - 1 : lyPrev) lyMax = min (rYmax - 1) $ 3 + d + maximum (0 : lyPrev) -- Pick minimal cave size that fits all previous stairs. xspan = max (lxMax - lxMin + 1) $ cXminSize kc yspan = max (lyMax - lyMin + 1) $ cYminSize kc x0 = min lxMin $ max (lxMax - xspan + 1) $ (rXmax - xspan) `div` 2 y0 = min lyMin $ max (lyMax - yspan + 1) $ (rYmax - yspan) `div` 2 in fromMaybe (error $ "" `showFailure` kc) $ toArea (x0, y0, x0 + xspan - 1, y0 + yspan - 1) -- Any stairs coming from above are considered extra stairs -- and if they don't exceed @extraStairs@, -- the amount is filled up with single downstairs. -- If they do exceed @extraStairs@, some of them end here. extraStairs <- castDice ldepth totalDepth $ cextraStairs kc let (abandonedStairs, remainingStairsDown) = if ln == minD then (length lstairPrev, 0) else let double = min (length lstairPrev) extraStairs single = max 0 $ extraStairs - double in (length lstairPrev - double, single) (lstairsSingleUp, lstairsDouble) = splitAt abandonedStairs lstairPrev pstairsSingleUp = map fst lstairsSingleUp pstairsDouble = map fst lstairsDouble pallUpStairs = pstairsDouble ++ pstairsSingleUp boot = let (x0, y0, x1, y1) = fromArea darea in rights $ map (snapToStairList 0 pallUpStairs) [ Point (x0 + 4 + d) (y0 + 3 + d) , Point (x1 - 4 - d) (y1 - anchorDown + 1) ] fixedEscape <- case cescapeFreq kc of [] -> return [] escapeFreq -> do -- Escapes don't extend to other levels, so corners not harmful -- (actually neither are the other restrictions inherited from stairs -- placement, but we respect them to keep a uniform visual layout). -- Allowing corners and generating before stars, because they are more -- important that stairs (except the first stairs, but they are guaranteed -- unless the level has no incoming stairs, but if so, plenty of space). mepos <- placeDownStairs "escape" True serverOptions ln kc darea pallUpStairs boot case mepos of Just epos -> return [(epos, escapeFreq)] Nothing -> return [] -- with some luck, there is an escape elsewhere let pescape = map fst fixedEscape pallUpAndEscape = pescape ++ pallUpStairs addSingleDown :: [Point] -> Int -> Rnd [Point] addSingleDown acc 0 = return acc addSingleDown acc k = do mpos <- placeDownStairs "stairs" False serverOptions ln kc darea (pallUpAndEscape ++ acc) boot case mpos of Just pos -> addSingleDown (pos : acc) (k - 1) Nothing -> return acc -- calling again won't change anything pstairsSingleDown <- addSingleDown [] remainingStairsDown let freqDouble carried = filter (\(gn, _) -> carried `elem` T.words (fromGroupName gn)) $ cstairFreq kc ++ cstairAllowed kc fixedStairsDouble = map (second freqDouble) lstairsDouble freqUp carried = map (first (\gn -> toGroupName $ fromGroupName gn <+> "up")) $ freqDouble carried fixedStairsUp = map (second freqUp) lstairsSingleUp freqDown = map (first (\gn -> toGroupName $ fromGroupName gn <+> "down")) $ cstairFreq kc fixedStairsDown = map (, freqDown) pstairsSingleDown pallExits = pallUpAndEscape ++ pstairsSingleDown fixedCenters = EM.fromList $ fixedEscape ++ fixedStairsDouble ++ fixedStairsUp ++ fixedStairsDown -- Avoid completely uniform levels (e.g., uniformly merged places). bootExtra <- if EM.null fixedCenters then do mpointExtra <- placeDownStairs "extra boot" False serverOptions ln kc darea pallExits boot -- With sane content, @Nothing@ should never appear. return $! maybeToList mpointExtra else return [] let posUp Point{..} = Point (px - 1) py posDn Point{..} = Point (px + 1) py lstair = ( map posUp $ pstairsSingleUp ++ pstairsDouble , map posDn $ pstairsDouble ++ pstairsSingleDown ) cellSize <- castDiceXY ldepth totalDepth $ ccellSize kc let subArea = fromMaybe (error $ "" `showFailure` kc) $ shrink darea area = if cfenceApart kc then subArea else darea (lgr, gs) = grid fixedCenters (boot ++ bootExtra) area cellSize dsecret <- randomR (1, maxBound) cave <- buildCave cops ldepth totalDepth darea dsecret dkind lgr gs bootExtra cmap <- buildTileMap cops cave let lvl = levelFromCave cops cave ldepth cmap lstair pescape stairCarried p0 = let Place{qkind} = dstairs cave EM.! p0 freq = map (first $ T.words . tshow) (PK.pfreq $ okind coplace qkind) carriedAll = filter (\t -> any (\(ws, _) -> t `elem` ws) freq) rstairWordCarried in case carriedAll of [t] -> (p0, t) _ -> error $ "wrong carried stair word" `showFailure` (freq, carriedAll, kc) return (lvl, lstairsDouble ++ map stairCarried pstairsSingleDown) snapToStairList :: Int -> [Point] -> Point -> Either Point Point snapToStairList _ [] p = Right p snapToStairList a (pos : rest) p = let nx = if px pos > px p + 5 + a || px pos < px p - 5 - a then px p else px pos ny = if py pos > py p + 3 + a || py pos < py p - 3 - a then py p else py pos np = Point nx ny in if np == pos then Left np else snapToStairList a rest np -- Places yet another staircase (or escape), taking into account only -- the already existing stairs. placeDownStairs :: Text -> Bool -> ServerOptions -> Int -> CaveKind -> Area -> [Point] -> [Point] -> Rnd (Maybe Point) placeDownStairs object cornerPermitted serverOptions ln CaveKind{cminStairDist, cfenceApart} darea ps boot = do let dist cmin p = all (\pos -> chessDist p pos > cmin) ps (x0, y0, x1, y1) = fromArea darea -- Stairs in corners often enlarge next caves, so refrain from -- generating stairs, if only corner available (escapes special-cased). notInCorner Point{..} = cornerPermitted || x1 - x0 + 1 < 40 || y1 - y0 + 1 < 20 -- everything is a corner || px > x0 + 9 && px < x1 - 9 -- enough to fit smallest stairs || py > y0 + 6 && py < y1 - 6 -- enough to fit smallest stairs f p = case snapToStairList 0 ps p of Left{} -> Nothing Right np -> let nnp = either id id $ snapToStairList 0 boot np in if notInCorner nnp then Just nnp else Nothing g p = case snapToStairList 2 ps p of Left{} -> Nothing Right np -> let nnp = either id id $ snapToStairList 2 boot np in if notInCorner nnp && dist cminStairDist nnp then Just nnp else Nothing focusArea = let d = if cfenceApart then 1 else 0 in fromMaybe (error $ "" `showFailure` darea) $ toArea ( x0 + 4 + d, y0 + 3 + d , x1 - 4 - d, y1 - anchorDown + 1 ) mpos <- findPointInArea focusArea g 300 f -- The message fits this debugging level: let !_ = if isNothing mpos && sdumpInitRngs serverOptions then unsafePerformIO $ do T.hPutStrLn stdout $ "Failed to place" <+> object <+> "on level" <+> tshow ln <> ", in" <+> tshow darea hFlush stdout -- Not really expensive, but shouldn't disrupt normal testing nor play. #ifdef WITH_EXPENSIVE_ASSERTIONS error "possible, but unexpected; alarm!" #endif else () return mpos -- Build rudimentary level from a cave kind. levelFromCave :: COps -> Cave -> Dice.AbsDepth -> TileMap -> ([Point], [Point]) -> [Point] -> Level levelFromCave COps{coTileSpeedup} Cave{..} ldepth ltile lstair lescape = let f n t | Tile.isExplorable coTileSpeedup t = n + 1 | otherwise = n lexpl = PointArray.foldlA' f 0 ltile in Level { lkind = dkind , ldepth , lfloor = EM.empty , lembed = EM.empty , lbig = EM.empty , lproj = EM.empty , ltile , lentry = dentry , larea = darea , lsmell = EM.empty , lstair , lescape , lseen = 0 , lexpl , ltime = timeZero , lnight = dnight } -- | Freshly generated and not yet populated dungeon. data FreshDungeon = FreshDungeon { freshDungeon :: Dungeon -- ^ maps for all levels , freshTotalDepth :: Dice.AbsDepth -- ^ absolute dungeon depth } -- | Generate the dungeon for a new game. dungeonGen :: COps -> ServerOptions -> Caves -> Rnd FreshDungeon dungeonGen cops serverOptions caves = do let keys = concatMap fst caves minD = minimum keys maxD = maximum keys freshTotalDepth = assert (signum minD == signum maxD) $ Dice.AbsDepth $ max 10 $ max (abs minD) (abs maxD) placeCaveGroup :: ([(LevelId, Level)], [(Point, Text)]) -> (Int, GroupName CaveKind) -> Rnd ([(LevelId, Level)], [(Point, Text)]) placeCaveGroup (lvls, ldown) (n, genName) = do (newLevel, ldown2) <- -- lstairUp for the next level is lstairDown for the current level buildLevel cops serverOptions n genName minD freshTotalDepth ldown return ((toEnum n, newLevel) : lvls, ldown2) buildLvls :: ([(LevelId, Level)], [(Point, Text)]) -> ([Int], [GroupName CaveKind]) -> Rnd ([(LevelId, Level)], [(Point, Text)]) buildLvls (lvls, ldown) (ns, l) = assert (length ns == length l) $ do lShuffled <- shuffle l let nsl = zip ns lShuffled foldlM' placeCaveGroup (lvls, ldown) nsl (levels, _) <- foldlM' buildLvls ([], []) caves let freshDungeon = EM.fromList levels return $! FreshDungeon{..} LambdaHack-0.9.5.0/engine-src/Game/LambdaHack/Server/DungeonGen/0000755000000000000000000000000007346545000022174 5ustar0000000000000000LambdaHack-0.9.5.0/engine-src/Game/LambdaHack/Server/DungeonGen/AreaRnd.hs0000644000000000000000000003613607346545000024055 0ustar0000000000000000-- | Operations on the 'Area' type that involve random numbers. module Game.LambdaHack.Server.DungeonGen.AreaRnd ( -- * Picking points inside areas mkFixed, pointInArea, findPointInArea, mkVoidRoom, mkRoom -- * Choosing connections , connectGrid, randomConnection -- * Plotting corridors , HV(..), Corridor, connectPlaces , SpecialArea(..), grid #ifdef EXPOSE_INTERNAL -- * Internal operations , connectGrid', sortPoint, mkCorridor, borderPlace #endif ) where import Prelude () import Game.LambdaHack.Core.Prelude import qualified Data.EnumMap.Strict as EM import qualified Data.EnumSet as ES import Data.Functor.Identity (runIdentity) import qualified Data.IntSet as IS import Game.LambdaHack.Common.Area import Game.LambdaHack.Definition.Defs import Game.LambdaHack.Common.Point import Game.LambdaHack.Core.Random import Game.LambdaHack.Common.Vector import Game.LambdaHack.Content.PlaceKind -- Doesn't respect minimum sizes, because staircases are specified verbatim, -- so can't be arbitrarily scaled up. -- The size may be one more than what maximal size hint requests, -- but this is safe (limited by area size) and makes up for the rigidity -- of the fixed room sizes (e.g., that the size is always odd). mkFixed :: (X, Y) -- ^ maximum size -> Area -- ^ the containing area, not the room itself -> Point -- ^ the center point -> Area mkFixed (xMax, yMax) area p@Point{..} = let (x0, y0, x1, y1) = fromArea area xradius = min ((xMax + 1) `div` 2) $ min (px - x0) (x1 - px) yradius = min ((yMax + 1) `div` 2) $ min (py - y0) (y1 - py) a = (px - xradius, py - yradius, px + xradius, py + yradius) in fromMaybe (error $ "" `showFailure` (a, xMax, yMax, area, p)) $ toArea a -- | Pick a random point within an area. pointInArea :: Area -> Rnd Point pointInArea area = do let (Point x0 y0, xspan, yspan) = spanArea area pxy <- randomR (0, xspan * yspan - 1) let Point{..} = punindex xspan pxy return $! Point (x0 + px) (y0 + py) -- | Find a suitable position in the area, based on random points -- and a predicate. findPointInArea :: Area -> (Point -> Maybe Point) -> Int -> (Point -> Maybe Point) -> Rnd (Maybe Point) findPointInArea area g gnumTries f = let (Point x0 y0, xspan, yspan) = spanArea area checkPoint :: Applicative m => (Point -> Maybe Point) -> m (Maybe Point) -> Int -> m (Maybe Point) {-# INLINE checkPoint #-} checkPoint check fallback pxyRelative = let Point{..} = punindex xspan pxyRelative pos = Point (x0 + px) (y0 + py) in case check pos of Just p -> pure $ Just p Nothing -> fallback gsearch 0 = fsearch (xspan * yspan * 10) gsearch count = do pxy <- randomR (0, xspan * yspan - 1) checkPoint g (gsearch (count - 1)) pxy fsearch 0 = return $! runIdentity $ searchAll (xspan * yspan - 1) fsearch count = do pxy <- randomR (0, xspan * yspan - 1) checkPoint f (fsearch (count - 1)) pxy searchAll (-1) = pure Nothing searchAll pxyRelative = checkPoint f (searchAll (pxyRelative - 1)) pxyRelative in gsearch gnumTries -- | Create a void room, i.e., a single point area within the designated area. mkVoidRoom :: Area -> Rnd Area mkVoidRoom area = do -- Pass corridors closer to the middle of the grid area, if possible. let core = fromMaybe area $ shrink area pxy <- pointInArea core return $! trivialArea pxy -- | Create a random room according to given parameters. mkRoom :: (X, Y) -- ^ minimum size -> (X, Y) -- ^ maximum size -> Area -- ^ the containing area, not the room itself -> Rnd Area mkRoom (xm, ym) (xM, yM) area = do let (x0, y0, x1, y1) = fromArea area xspan = x1 - x0 + 1 yspan = y1 - y0 + 1 aW = (min xm xspan, min ym yspan, min xM xspan, min yM yspan) areaW = fromMaybe (error $ "" `showFailure` aW) $ toArea aW Point xW yW <- pointInArea areaW -- roll size let a1 = (x0, y0, max x0 (x1 - xW + 1), max y0 (y1 - yW + 1)) area1 = fromMaybe (error $ "" `showFailure` a1) $ toArea a1 Point rx1 ry1 <- pointInArea area1 -- roll top-left corner let a3 = (rx1, ry1, rx1 + xW - 1, ry1 + yW - 1) area3 = fromMaybe (error $ "" `showFailure` a3) $ toArea a3 return $! area3 -- Choosing connections between areas in a grid -- | Pick a subset of connections between adjacent areas within a grid until -- there is only one connected component in the graph of all areas. connectGrid :: ES.EnumSet Point -> (X, Y) -> Rnd [(Point, Point)] connectGrid voidPlaces (nx, ny) = do let unconnected = ES.fromDistinctAscList [ Point x y | y <- [0..ny-1], x <- [0..nx-1] ] -- Candidates are neighbours that are still unconnected. We start with -- a random choice. p <- oneOf $ ES.toList $ unconnected ES.\\ voidPlaces let candidates = ES.singleton p connectGrid' voidPlaces (nx, ny) unconnected candidates [] connectGrid' :: ES.EnumSet Point -> (X, Y) -> ES.EnumSet Point -> ES.EnumSet Point -> [(Point, Point)] -> Rnd [(Point, Point)] connectGrid' voidPlaces (nx, ny) unconnected candidates !acc | unconnected `ES.isSubsetOf` voidPlaces = return acc | otherwise = do let candidatesBest = candidates ES.\\ voidPlaces c <- oneOf $ ES.toList $ if ES.null candidatesBest then candidates else candidatesBest -- potential new candidates: let ns = ES.fromList $ vicinityCardinal nx ny c nu = ES.delete c unconnected -- new unconnected -- (new candidates, potential connections): (nc, ds) = ES.partition (`ES.member` nu) ns new <- if ES.null ds then return id else do d <- oneOf (ES.toList ds) return (sortPoint (c, d) :) connectGrid' voidPlaces (nx, ny) nu (ES.delete c (candidates `ES.union` nc)) (new acc) -- | Sort the sequence of two points, in the derived lexicographic order. sortPoint :: (Point, Point) -> (Point, Point) sortPoint (a, b) | a <= b = (a, b) | otherwise = (b, a) -- | Pick a single random connection between adjacent areas within a grid. randomConnection :: (X, Y) -> Rnd (Point, Point) randomConnection (nx, ny) = assert (nx > 1 && ny > 0 || nx > 0 && ny > 1 `blame` (nx, ny)) $ do rb <- oneOf [False, True] if rb && nx > 1 then do rx <- randomR (0, nx-2) ry <- randomR (0, ny-1) return (Point rx ry, Point (rx+1) ry) else do rx <- randomR (0, nx-1) ry <- randomR (0, ny-2) return (Point rx ry, Point rx (ry+1)) -- Plotting individual corridors between two areas -- | The choice of horizontal and vertical orientation. data HV = Horiz | Vert deriving Eq -- | The coordinates of consecutive fields of a corridor. type Corridor = (Point, Point, Point, Point) -- | Create a corridor, either horizontal or vertical, with -- a possible intermediate part that is in the opposite direction. -- There might not always exist a good intermediate point -- if the places are allowed to be close together -- and then we let the intermediate part degenerate. mkCorridor :: HV -- ^ orientation of the starting section -> Point -- ^ starting point -> Bool -- ^ starting is inside @FGround@ or @FFloor@ -> Point -- ^ ending point -> Bool -- ^ ending is inside @FGround@ or @FFloor@ -> Area -- ^ the area containing the intermediate point -> Rnd Corridor -- ^ straight sections of the corridor mkCorridor hv (Point x0 y0) p0floor (Point x1 y1) p1floor area = do Point rxRaw ryRaw <- pointInArea area let (sx0, sy0, sx1, sy1) = fromArea area -- Avoid corridors that run along @FGround@ or @FFloor@ fence, -- unless not possible. rx = if | rxRaw == sx0 + 1 && p0floor -> sx0 | rxRaw == sx1 - 1 && p1floor -> sx1 | otherwise -> rxRaw ry = if | ryRaw == sy0 + 1 && p0floor -> sy0 | ryRaw == sy1 - 1 && p1floor -> sy1 | otherwise -> ryRaw return $! case hv of Horiz -> (Point x0 y0, Point rx y0, Point rx y1, Point x1 y1) Vert -> (Point x0 y0, Point x0 ry, Point x1 ry, Point x1 y1) -- | Try to connect two interiors of places with a corridor. -- Choose entrances some steps away from the edges, if the place -- is big enough. Note that with @pfence == FNone@, the inner area considered -- is the strict interior of the place, without the outermost tiles. -- -- The corridor connects (touches) the inner areas and the turning point -- of the corridor (if any) is outside of the outer areas -- and inside the grid areas. connectPlaces :: (Area, Fence, Area) -> (Area, Fence, Area) -> Rnd (Maybe Corridor) connectPlaces (_, _, sg) (_, _, tg) | sg == tg = return Nothing connectPlaces s3@(sqarea, spfence, sg) t3@(tqarea, tpfence, tg) = do let (sa, so, stiny) = borderPlace sqarea spfence (ta, to, ttiny) = borderPlace tqarea tpfence trim area = let (x0, y0, x1, y1) = fromArea area dx = case (x1 - x0) `div` 2 of 0 -> 0 1 -> 1 2 -> 1 3 -> 1 _ -> 3 dy = case (y1 - y0) `div` 2 of 0 -> 0 1 -> 1 2 -> 1 3 -> 1 _ -> 3 in fromMaybe (error $ "" `showFailure` (area, s3, t3)) $ toArea (x0 + dx, y0 + dy, x1 - dx, y1 - dy) Point sx sy <- pointInArea $ trim sa Point tx ty <- pointInArea $ trim ta -- If the place (e.g., void place) is slim (at most 2-tile wide, no fence), -- overwrite it with corridor. The place may not even be built (e.g., void) -- and the overwrite ensures connections through it are not broken. let (_, _, sax1Raw, say1Raw) = fromArea sa -- inner area sslim = stiny && spfence == FNone (sax1, say1) = if sslim then (sax1Raw - 1, say1Raw - 1) else (sax1Raw, say1Raw) (tax0Raw, tay0Raw, _, _) = fromArea ta tslim = ttiny && tpfence == FNone (tax0, tay0) = if tslim then (tax0Raw + 1, tay0Raw + 1) else (tax0Raw, tay0Raw) (_, _, sox1, soy1) = fromArea so -- outer area (tox0, toy0, _, _) = fromArea to (sgx0, sgy0, sgx1, sgy1) = fromArea sg -- grid area (tgx0, tgy0, tgx1, tgy1) = fromArea tg (hv, area, p0, p1) | sgx1 == tgx0 = let x0 = if sgy0 <= ty && ty <= sgy1 then sox1 + 1 else sgx1 x1 = if tgy0 <= sy && sy <= tgy1 then tox0 - 1 else sgx1 in case toArea (x0, min sy ty, x1, max sy ty) of Just a -> (Horiz, a, Point (sax1 + 1) sy, Point (tax0 - 1) ty) Nothing -> error $ "" `showFailure` (sx, sy, tx, ty, s3, t3) | otherwise = assert (sgy1 == tgy0) $ let y0 = if sgx0 <= tx && tx <= sgx1 then soy1 + 1 else sgy1 y1 = if tgx0 <= sx && sx <= tgx1 then toy0 - 1 else sgy1 in case toArea (min sx tx, y0, max sx tx, y1) of Just a -> (Vert, a, Point sx (say1 + 1), Point tx (tay0 - 1)) Nothing -> error $ "" `showFailure` (sx, sy, tx, ty, s3, t3) nin p = not $ p `inside` sa || p `inside` ta !_A = assert (sslim || tslim || allB nin [p0, p1] `blame` (sx, sy, tx, ty, s3, t3)) () cor@(c1, c2, c3, c4) <- mkCorridor hv p0 (sa == so) p1 (ta == to) area let !_A2 = assert (sslim || tslim || allB nin [c1, c2, c3, c4] `blame` (cor, sx, sy, tx, ty, s3, t3)) () return $ Just cor borderPlace :: Area -> Fence -> (Area, Area, Bool) borderPlace qarea pfence = case pfence of FWall -> (qarea, expand qarea, False) FFloor -> (qarea, qarea, False) FGround -> (qarea, qarea, False) FNone -> case shrink qarea of Nothing -> (qarea, qarea, True) Just sr -> (sr, qarea, False) data SpecialArea = SpecialArea Area | SpecialFixed Point (Freqs PlaceKind) Area | SpecialMerged SpecialArea Point deriving Show -- | Divide uniformly a larger area into the given number of smaller areas -- overlapping at the edges. -- -- The list of fixed centers (some important points inside) -- of (non-overlapping) areas is given. Incorporate those, -- with as little disruption, as possible. -- Assume each of four boundaries of the cave are covered by a fixed centre. grid :: EM.EnumMap Point (Freqs PlaceKind) -> [Point] -> Area -> (X, Y) -> ((X, Y), EM.EnumMap Point SpecialArea) grid fixedCenters boot area cellSize = let (x0, y0, x1, y1) = fromArea area f zsize z1 n prev (c1 : c2 : rest) = let len = c2 - c1 cn = len * n `div` zsize in -- traceShow ( zsize, z1, n, prev, len, cn -- , len `div` max 1 (2 * cn) ) $ if cn < 2 then let mid1 = (c1 + c2) `div` 2 mid2 = (c1 + c2) `divUp` 2 mid = if mid1 - prev > 4 then mid1 else mid2 in (prev, mid, Just c1) : f zsize z1 n mid (c2 : rest) else (prev, c1 + len `div` (2 * cn), Just c1) : [ ( c1 + len * (2 * z - 1) `div` (2 * cn) , c1 + len * (2 * z + 1) `div` (2 * cn) , Nothing ) | z <- [1 .. cn - 1] ] ++ f zsize z1 n (c1 + len * (2 * cn - 1) `div` (2 * cn)) (c2 : rest) f _ z1 _ prev [c1] = [(prev, z1, Just c1)] f _ _ _ _ [] = error $ "empty list of centers" `showFailure` fixedCenters (xCenters, yCenters) = unzip $ map (px &&& py) $ EM.keys fixedCenters xset = IS.fromList $ xCenters ++ map px boot yset = IS.fromList $ yCenters ++ map py boot xsize = IS.findMax xset - IS.findMin xset ysize = IS.findMax yset - IS.findMin yset -- This is precisely how the cave will be divided among places, -- if there are no fixed centres except at boot coordinates. -- In any case, places, except for at boot points and fixed centres, -- are guaranteed at least the rolled minimal size of their -- enclosing cell (with one shared fence). Fixed centres are guaranteed -- a size between the cave cell size and the one implied by their -- placement wrt to cave fence and other fixed centers. lgrid = ( xsize `div` fst cellSize , ysize `div` snd cellSize ) xallSegments = zip [0..] $ f xsize x1 (fst lgrid) x0 $ IS.toList xset yallSegments = zip [0..] $ f ysize y1 (snd lgrid) y0 $ IS.toList yset in -- traceShow (xallSegments, yallSegments) $ ( (length xallSegments, length yallSegments) , EM.fromDistinctAscList [ ( Point x y , case (mcx, mcy) of (Just cx, Just cy) -> case EM.lookup (Point cx cy) fixedCenters of Nothing -> SpecialArea sarea Just placeFreq -> SpecialFixed (Point cx cy) placeFreq sarea _ -> SpecialArea sarea ) | (y, (cy0, cy1, mcy)) <- yallSegments , (x, (cx0, cx1, mcx)) <- xallSegments , let sarea = fromMaybe (error $ "" `showFailure` (x, y)) $ toArea (cx0, cy0, cx1, cy1) ] ) LambdaHack-0.9.5.0/engine-src/Game/LambdaHack/Server/DungeonGen/Cave.hs0000644000000000000000000004377107346545000023422 0ustar0000000000000000-- | Generation of caves (not yet inhabited dungeon levels) from cave kinds. module Game.LambdaHack.Server.DungeonGen.Cave ( Cave(..), buildCave #ifdef EXPOSE_INTERNAL -- * Internal operations , pickOpening #endif ) where import Prelude () import Game.LambdaHack.Core.Prelude import qualified Data.EnumMap.Strict as EM import qualified Data.EnumSet as ES import Data.Key (mapWithKeyM) import Game.LambdaHack.Common.Area import Game.LambdaHack.Common.Kind import qualified Game.LambdaHack.Common.Tile as Tile import Game.LambdaHack.Common.Vector import Game.LambdaHack.Content.CaveKind import Game.LambdaHack.Content.PlaceKind import Game.LambdaHack.Content.TileKind (TileKind) import qualified Game.LambdaHack.Core.Dice as Dice import Game.LambdaHack.Common.Point import Game.LambdaHack.Core.Random import Game.LambdaHack.Definition.Defs import Game.LambdaHack.Server.DungeonGen.AreaRnd import Game.LambdaHack.Server.DungeonGen.Place -- | The type of caves (not yet inhabited dungeon levels). data Cave = Cave { dkind :: ContentId CaveKind -- ^ the kind of the cave , darea :: Area -- ^ map area of the cave , dmap :: TileMapEM -- ^ tile kinds in the cave , dstairs :: EM.EnumMap Point Place -- ^ stair places indexed by their center , dentry :: EM.EnumMap Point PlaceEntry -- ^ room entrances in the cave , dnight :: Bool -- ^ whether the cave is dark } deriving Show {- | Generate a cave using an algorithm inspired by the original Rogue, as follows (in gross simplification): * The available area is divided into a grid, e.g, 3 by 3, where each of the 9 grid cells has approximately the same size. * In some of the 9 grid cells a room is placed at a random position and with a random size, but larger than the minimum size, e.g, 2 by 2 floor tiles. * Rooms that are on horizontally or vertically adjacent grid cells may be connected by a corridor. Corridors consist of 3 segments of straight lines (either "horizontal, vertical, horizontal" or "vertical, horizontal, vertical"). They end in openings in the walls of the room they connect. It is possible that one or two of the 3 segments have length 0, such that the resulting corridor is L-shaped or even a single straight line. * Corridors are generated randomly in such a way that at least every room on the grid is connected, and a few more might be. It is not sufficient to always connect all adjacent rooms, because not each cell holds a room. -} buildCave :: COps -- ^ content definitions -> Dice.AbsDepth -- ^ depth of the level to generate -> Dice.AbsDepth -- ^ absolute depth -> Area -- ^ map area of the cave -> Int -- ^ secret tile seed -> ContentId CaveKind -- ^ cave kind to use for generation -> (X, Y) -- ^ the dimensions of the grid of places -> EM.EnumMap Point SpecialArea -- ^ pos of stairs, etc. -> [Point] -- ^ boot positions to be treated as fixed -> Rnd Cave buildCave cops@COps{cocave, coplace, cotile, coTileSpeedup} ldepth totalDepth darea dsecret dkind lgr@(gx, gy) gs bootExtra = do let kc@CaveKind{..} = okind cocave dkind darkCorTile <- fromMaybe (error $ "" `showFailure` cdarkCorTile) <$> opick cotile cdarkCorTile (const True) litCorTile <- fromMaybe (error $ "" `showFailure` clitCorTile) <$> opick cotile clitCorTile (const True) dnight <- oddsDice ldepth totalDepth cnightOdds let createPlaces = do minPlaceSize <- castDiceXY ldepth totalDepth cminPlaceSize maxPlaceSize <- castDiceXY ldepth totalDepth cmaxPlaceSize let mergeFixed :: EM.EnumMap Point SpecialArea -> (Point, SpecialArea) -> EM.EnumMap Point SpecialArea mergeFixed !gs0 (!i, !special) = let mergeSpecial ar p2 f = case EM.lookup p2 gs0 of Just (SpecialArea ar2) -> let aSum = sumAreas ar ar2 sp = SpecialMerged (f aSum) p2 in EM.insert i sp $ EM.delete p2 gs0 _ -> gs0 mergable :: X -> Y -> Maybe HV mergable x y = case EM.lookup (Point x y) gs0 of Just (SpecialArea ar) -> let (_, xspan, yspan) = spanArea ar isFixed p = p `elem` bootExtra || case gs EM.! p of SpecialFixed{} -> True _ -> False in if -- Limit (the aggresive) merging of normal places -- and leave extra place for merging stairs. | any isFixed $ vicinityCardinal gx gy (Point x y) -> Nothing -- Bias: prefer extending vertically. -- Not @-2@, but @-4@, to merge aggressively. | yspan - 4 < snd minPlaceSize -> Just Vert | xspan - 4 < fst minPlaceSize -> Just Horiz | otherwise -> Nothing _ -> Nothing in case special of SpecialArea ar -> case mergable (px i) (py i) of Nothing -> gs0 Just hv -> case hv of -- Bias; vertical minimal sizes are smaller. -- -- The commented out cases never happen, because @mergable@ -- is symmetric and we proceed top-left to bottom-right. -- -- Vert | py i - 1 >= 0 -- && mergable (px i) (py i - 1) == Just Vert -> -- mergeSpecial ar i{py = py i - 1} SpecialArea Vert | py i + 1 < gy && mergable (px i) (py i + 1) == Just Vert -> mergeSpecial ar i{py = py i + 1} SpecialArea -- Horiz | px i - 1 >= 0 -- && mergable (px i - 1) (py i) == Just Horiz -> -- mergeSpecial ar i{px = px i - 1} SpecialArea Horiz | px i + 1 < gx && mergable (px i + 1) (py i) == Just Horiz -> mergeSpecial ar i{px = px i + 1} SpecialArea _ -> gs0 SpecialFixed p placeGroup ar -> -- If single merge is sufficient to extend the fixed place -- to full size, and the merge is possible, we perform it. -- An empty inner list signifies some merge is needed, -- but not possible, and then we abort and don't waste space. let (x0, y0, x1, y1) = fromArea ar dy = 3 -- arbitrary, matches common content dx = 5 -- arbitrary, matches common content vics :: [[Point]] vics = [ [i {py = py i - 1} | py i - 1 >= 0] -- possible | py p - y0 < dy ] -- needed ++ [ [i {py = py i + 1} | py i + 1 < gy] | y1 - py p < dy ] ++ [ [i {px = px i - 1} | px i - 1 >= 0] | px p - x0 < dx ] ++ [ [i {px = px i + 1} | px i + 1 < gx] | x1 - px p < dx ] in case vics of [[p2]] -> mergeSpecial ar p2 (SpecialFixed p placeGroup) _ -> gs0 SpecialMerged{} -> error $ "" `showFailure` (gs, gs0, i) gs2 = foldl' mergeFixed gs $ EM.assocs gs voidPlaces <- do let gridArea = fromMaybe (error $ "" `showFailure` lgr) $ toArea (0, 0, gx - 1, gy - 1) voidNum = round $ cmaxVoid * fromIntegral (EM.size gs2) isOrdinaryArea p = case p `EM.lookup` gs2 of Just SpecialArea{} -> True _ -> False reps <- replicateM voidNum (pointInArea gridArea) -- repetitions are OK; variance is low anyway return $! ES.fromList $ filter isOrdinaryArea reps let decidePlace :: Bool -> ( TileMapEM , EM.EnumMap Point (Place, Area) , EM.EnumMap Point Place ) -> (Point, SpecialArea) -> Rnd ( TileMapEM , EM.EnumMap Point (Place, Area) , EM.EnumMap Point Place ) decidePlace noVoid (!m, !qls, !qstairs) (!i, !special) = case special of SpecialArea ar -> do -- Reserved for corridors and the global fence. let innerArea = fromMaybe (error $ "" `showFailure` (i, ar)) $ shrink ar !_A0 = shrink innerArea !_A1 = assert (isJust _A0 `blame` (innerArea, gs, kc)) () if not noVoid && i `ES.member` voidPlaces then do qarea <- mkVoidRoom innerArea let qkind = deadEndId qmap = EM.empty qfence = EM.empty return (m, EM.insert i (Place{..}, ar) qls, qstairs) else do r <- mkRoom minPlaceSize maxPlaceSize innerArea place <- buildPlace cops kc dnight darkCorTile litCorTile ldepth totalDepth dsecret r (Just innerArea) [] return ( EM.unions [qmap place, qfence place, m] , EM.insert i (place, ar) qls , qstairs ) SpecialFixed p@Point{..} placeFreq ar -> do -- Reserved for corridors and the global fence. let innerArea = fromMaybe (error $ "" `showFailure` (i, ar)) $ shrink ar !_A0 = shrink innerArea !_A1 = assert (isJust _A0 `blame` (innerArea, gs2, kc)) () !_A2 = assert (p `inside` fromJust _A0 `blame` (p, innerArea, gs)) () r = mkFixed maxPlaceSize innerArea p !_A3 = assert (isJust (shrink r) `blame` ( r, ar, p, innerArea, gs , gs2, qls, kc )) () place <- buildPlace cops kc dnight darkCorTile litCorTile ldepth totalDepth dsecret r Nothing placeFreq return ( EM.unions [qmap place, qfence place, m] , EM.insert i (place, ar) qls , EM.insert p place qstairs ) SpecialMerged sp p2 -> do (lplaces, dplaces, dstairs) <- decidePlace True (m, qls, qstairs) (i, sp) return ( lplaces , EM.insert p2 (dplaces EM.! i) dplaces , dstairs ) places <- foldlM' (decidePlace False) (EM.empty, EM.empty, EM.empty) $ EM.assocs gs2 return (voidPlaces, lgr, places) (voidPlaces, lgrid, (lplaces, dplaces, dstairs)) <- createPlaces let lcorridorsFun :: Rnd ( EM.EnumMap Point ( ContentId TileKind , ContentId PlaceKind ) , TileMapEM ) lcorridorsFun = do connects <- connectGrid voidPlaces lgrid addedConnects <- do let cauxNum = round $ cauxConnects * fromIntegral (fst lgrid * snd lgrid) cns <- map head . group . sort <$> replicateM cauxNum (randomConnection lgrid) -- This allows connections through a single void room, -- if a non-void room on both ends. let notDeadEnd (p, q) = if | p `ES.member` voidPlaces -> q `ES.notMember` voidPlaces && sndInCns p | q `ES.member` voidPlaces -> fstInCns q | otherwise -> True sndInCns p = any (\(p0, q0) -> q0 == p && p0 `ES.notMember` voidPlaces) cns fstInCns q = any (\(p0, q0) -> p0 == q && q0 `ES.notMember` voidPlaces) cns return $! filter notDeadEnd cns let allConnects = connects `union` addedConnects connectPos :: (Point, Point) -> Rnd (Maybe ( ContentId PlaceKind , Corridor , ContentId PlaceKind )) connectPos (p0, p1) = do let (place0, area0) = dplaces EM.! p0 (place1, area1) = dplaces EM.! p1 savePlaces cor = (qkind place0, cor, qkind place1) connected <- connectPlaces (qarea place0, pfence $ okind coplace (qkind place0), area0) (qarea place1, pfence $ okind coplace (qkind place1), area1) return $! savePlaces <$> connected cs <- catMaybes <$> mapM connectPos allConnects let pickedCorTile = if dnight then darkCorTile else litCorTile digCorridorSection :: a -> Point -> Point -> EM.EnumMap Point a digCorridorSection a p1 p2 = EM.fromList $ zip (fromTo p1 p2) (repeat a) digCorridor (sqkind, (p1, p2, p3, p4), tqkind) = ( EM.union (digCorridorSection (pickedCorTile, sqkind) p1 p2) (digCorridorSection (pickedCorTile, tqkind) p3 p4) , digCorridorSection pickedCorTile p2 p3 ) (lplOuter, lInner) = unzip $ map digCorridor cs return (EM.unions lplOuter, EM.unions lInner) (lplcorOuter, lcorInner) <- lcorridorsFun -- The hacks below are instead of unionWithKeyM, which is costly. let mergeCor _ pl (cor, pk) = if Tile.isWalkable coTileSpeedup pl then Nothing -- tile already open else Just (pl, cor, pk) {-# INLINE intersectionWithKeyMaybe #-} intersectionWithKeyMaybe combine = EM.mergeWithKey combine (const EM.empty) (const EM.empty) interCor = intersectionWithKeyMaybe mergeCor lplaces lplcorOuter -- fast doorMap <- mapWithKeyM (pickOpening cops kc lplaces litCorTile dsecret) interCor -- very small let subArea = fromMaybe (error $ "" `showFailure` kc) $ shrink darea fence <- buildFenceRnd cops cfenceTileN cfenceTileE cfenceTileS cfenceTileW subArea -- The obscured tile, e.g., scratched wall, stays on the server forever, -- only the suspect variant on client gets replaced by this upon searching. let sub2Area = fromMaybe (error $ "" `showFailure` kc) $ shrink subArea sub3Area = fromMaybe (error $ "" `showFailure` kc) $ shrink sub2Area likelySecret = (`inside` sub3Area) obscure p t = if isChancePos 1 chidden dsecret p && likelySecret p then Tile.obscureAs cotile t else return t lplacesObscured <- mapWithKeyM obscure lplaces let lcorOuter = EM.map fst lplcorOuter aroundFence Place{..} = if pfence (okind coplace qkind) `elem` [FFloor, FGround] then EM.map (const $ PAround qkind) qfence else EM.empty dentry = EM.unions $ EM.map (\(_, _, pk) -> PEntry pk) interCor : map (\(place, _) -> aroundFence place) (EM.elems dplaces) ++ -- for @FNone@ fences with walkable tiles on the edges [EM.map (\(_, _, pk) -> PEnd pk) $ let mergeCorAlways pl (cor, pk) = (pl, cor, pk) in EM.intersectionWith mergeCorAlways lplaces lplcorOuter] dmap = EM.unions [doorMap, lplacesObscured, lcorOuter, lcorInner, fence] -- order matters return $! Cave {..} pickOpening :: COps -> CaveKind -> TileMapEM -> ContentId TileKind -> Int -> Point -> (ContentId TileKind, ContentId TileKind, ContentId PlaceKind) -> Rnd (ContentId TileKind) pickOpening COps{cotile, coTileSpeedup} CaveKind{cdoorChance, copenChance, chidden} lplaces litCorTile dsecret pos (pl, cor, _) = do let nicerCorridor = if Tile.isLit coTileSpeedup cor then cor else -- If any cardinally adjacent walkable room tile is lit, -- make the opening lit, as well. let roomTileLit p = case EM.lookup p lplaces of Nothing -> False Just tile -> Tile.isWalkable coTileSpeedup tile && Tile.isLit coTileSpeedup tile vic = vicinityCardinalUnsafe pos in if any roomTileLit vic then litCorTile else cor -- Openings have a certain chance to be doors and doors have a certain -- chance to be open. rd <- chance cdoorChance if rd then do let hidden = Tile.buildAs cotile pl doorTrappedId <- Tile.revealAs cotile hidden let !_A = assert (Tile.buildAs cotile doorTrappedId == doorTrappedId) () -- Not all solid tiles can hide a door, so @doorTrappedId@ may in fact -- not be a door at all, hence the check. if Tile.isDoor coTileSpeedup doorTrappedId then do -- door created ro <- chance copenChance if ro then Tile.openTo cotile doorTrappedId else if isChancePos 1 chidden dsecret pos then return $! doorTrappedId -- server will hide it else do doorOpenId <- Tile.openTo cotile doorTrappedId Tile.closeTo cotile doorOpenId else return $! doorTrappedId -- assume this is what content enforces else return $! nicerCorridor LambdaHack-0.9.5.0/engine-src/Game/LambdaHack/Server/DungeonGen/Place.hs0000644000000000000000000003700607346545000023562 0ustar0000000000000000{-# LANGUAGE RankNTypes #-} -- | Generation of places from place kinds. module Game.LambdaHack.Server.DungeonGen.Place ( Place(..), TileMapEM, buildPlace, isChancePos, buildFenceRnd #ifdef EXPOSE_INTERNAL -- * Internal operations , placeCheck, interiorArea, olegend, pover, buildFence, buildFenceMap , tilePlace #endif ) where import Prelude () import Game.LambdaHack.Core.Prelude import qualified Data.Bits as Bits import qualified Data.EnumMap.Strict as EM import qualified Data.EnumSet as ES import qualified Data.Text as T import Game.LambdaHack.Common.Area import Game.LambdaHack.Common.Kind import Game.LambdaHack.Common.Point import qualified Game.LambdaHack.Common.Tile as Tile import Game.LambdaHack.Content.CaveKind import Game.LambdaHack.Content.PlaceKind import Game.LambdaHack.Content.TileKind (TileKind) import qualified Game.LambdaHack.Content.TileKind as TK import qualified Game.LambdaHack.Core.Dice as Dice import Game.LambdaHack.Core.Frequency import Game.LambdaHack.Core.Random import Game.LambdaHack.Definition.Defs import Game.LambdaHack.Server.DungeonGen.AreaRnd -- | The map of tile kinds in a place (and generally anywhere in a cave). -- The map is sparse. The default tile that eventually fills the empty spaces -- is specified in the cave kind specification with @cdefTile@. type TileMapEM = EM.EnumMap Point (ContentId TileKind) -- | The parameters of a place. All are immutable and rolled and fixed -- at the time when a place is generated. data Place = Place { qkind :: ContentId PlaceKind , qarea :: Area , qmap :: TileMapEM , qfence :: TileMapEM } deriving Show -- | For @CAlternate@ tiling, require the place be comprised -- of an even number of whole corners, with exactly one square -- overlap between consecutive coners and no trimming. -- For other tiling methods, check that the area is large enough for tiling -- the corner twice in each direction, with a possible one row/column overlap. placeCheck :: Area -- ^ the area to fill -> PlaceKind -- ^ the kind of place to construct -> Bool placeCheck r pk@PlaceKind{..} = case interiorArea pk r of Nothing -> False Just area -> let (_, xspan, yspan) = spanArea area dxcorner = case ptopLeft of [] -> 0 ; l : _ -> T.length l dycorner = length ptopLeft wholeOverlapped d dcorner = d > 1 && dcorner > 1 && (d - 1) `mod` (2 * (dcorner - 1)) == 0 largeEnough = xspan >= 2 * dxcorner - 1 && yspan >= 2 * dycorner - 1 in case pcover of CAlternate -> wholeOverlapped xspan dxcorner && wholeOverlapped yspan dycorner CStretch -> largeEnough CReflect -> largeEnough CVerbatim -> True CMirror -> True -- | Calculate interior room area according to fence type, based on the -- total area for the room and it's fence. This is used for checking -- if the room fits in the area, for digging up the place and the fence -- and for deciding if the room is dark or lit later in the dungeon -- generation process. interiorArea :: PlaceKind -> Area -> Maybe Area interiorArea kr r = let requiredForFence = case pfence kr of FWall -> 1 FFloor -> 1 FGround -> 1 FNone -> 0 in if pcover kr `elem` [CVerbatim, CMirror] then let (Point x0 y0, xspan, yspan) = spanArea r dx = case ptopLeft kr of [] -> error $ "" `showFailure` kr l : _ -> T.length l dy = length $ ptopLeft kr mx = (xspan - dx) `div` 2 my = (yspan - dy) `div` 2 in if mx < requiredForFence || my < requiredForFence then Nothing else toArea (x0 + mx, y0 + my, x0 + mx + dx - 1, y0 + my + dy - 1) else case requiredForFence of 0 -> Just r 1 -> shrink r _ -> error $ "" `showFailure` kr -- | Given a few parameters, roll and construct a 'Place' datastructure -- and fill a cave section acccording to it. buildPlace :: COps -- ^ the game content -> CaveKind -- ^ current cave kind -> Bool -- ^ whether the cave is dark -> ContentId TileKind -- ^ dark fence tile, if fence hollow -> ContentId TileKind -- ^ lit fence tile, if fence hollow -> Dice.AbsDepth -- ^ current level depth -> Dice.AbsDepth -- ^ absolute depth -> Int -- ^ secret tile seed -> Area -- ^ whole area of the place, fence included -> Maybe Area -- ^ whole inner area of the grid cell -> Freqs PlaceKind -- ^ optional fixed place freq -> Rnd Place buildPlace cops@COps{coplace, coTileSpeedup} kc@CaveKind{..} dnight darkCorTile litCorTile levelDepth@(Dice.AbsDepth ldepth) totalDepth@(Dice.AbsDepth tdepth) dsecret r minnerArea mplaceGroup = do let f !q !acc !p !pk !kind = let rarity = linearInterpolation ldepth tdepth (prarity kind) !fr = q * p * rarity in (fr, (pk, kind)) : acc g (placeGroup, q) = ofoldlGroup' coplace placeGroup (f q) [] pfreq = case mplaceGroup of [] -> cplaceFreq _ -> mplaceGroup placeFreq = concatMap g pfreq checkedFreq = filter (\(_, (_, kind)) -> placeCheck r kind) placeFreq freq = toFreq "buildPlace" checkedFreq let !_A = assert (not (nullFreq freq) `blame` (placeFreq, checkedFreq, r)) () (qkind, kr) <- frequency freq let smallPattern = pcover kr `elem` [CVerbatim, CMirror] && (length (ptopLeft kr) < 10 || T.length (head (ptopLeft kr)) < 10) -- Below we apply a heuristics to estimate if there are floor tiles -- in the place that are adjacent to floor tiles of the cave and so both -- should have the same lit condition. -- A false positive is walled staircases in LambdaHack, but it's OK. dark <- if cpassable && not (dnight && Tile.isLit coTileSpeedup darkCorTile) -- the colonnade can be illuminated just as the trail is && (pfence kr `elem` [FFloor, FGround] || pfence kr == FNone && smallPattern) then return dnight else oddsDice levelDepth totalDepth cdarkOdds let qlegend = if dark then clegendDarkTile else clegendLitTile rBetter <- case minnerArea of Just innerArea | pcover kr `elem` [CVerbatim, CMirror] -> do -- A hack: if a verbatim place was rolled, redo computing the area -- taking into account that often much smaller portion is taken by place. let requiredForFence = case pfence kr of FWall -> 1 FFloor -> 1 FGround -> 1 FNone -> 0 sizeBetter = ( 2 * requiredForFence + T.length (head (ptopLeft kr)) , 2 * requiredForFence + length (ptopLeft kr) ) mkRoom sizeBetter sizeBetter innerArea _ -> return r let qarea = fromMaybe (error $ "" `showFailure` (kr, r)) $ interiorArea kr rBetter override = if dark then poverrideDark kr else poverrideLit kr (overrideOneIn, overDefault) <- pover cops override (legendOneIn, legend) <- olegend cops qlegend cmap <- tilePlace qarea kr let mOneIn :: EM.EnumMap Char (Int, Int, ContentId TileKind) mOneIn = EM.union overrideOneIn legendOneIn m :: EM.EnumMap Char (ContentId TileKind) m = EM.union overDefault legend lookupOneIn :: Point -> Char -> ContentId TileKind lookupOneIn xy c = case EM.lookup c mOneIn of Just (k, n, tk) | isChancePos k n dsecret xy -> tk _ -> EM.findWithDefault (error $ "" `showFailure` (c, mOneIn, m)) c m qmap = EM.mapWithKey lookupOneIn cmap qfence <- buildFence cops kc dnight darkCorTile litCorTile dark (pfence kr) qarea return $! Place {..} isChancePos :: Int -> Int -> Int -> Point -> Bool isChancePos k n dsecret (Point x y) = k > 0 && n > 0 && let z = dsecret `Bits.rotateR` x `Bits.xor` y + x in if k < n then z `mod` ((n + k) `divUp` k) == 0 else z `mod` ((k + n) `divUp` n) /= 0 -- | Roll a legend of a place plan: a map from plan symbols to tile kinds. olegend :: COps -> GroupName TileKind -> Rnd ( EM.EnumMap Char (Int, Int, ContentId TileKind) , EM.EnumMap Char (ContentId TileKind) ) olegend COps{cotile} cgroup = let getSymbols !acc _ _ !tk = ES.insert (TK.tsymbol tk) acc symbols = ofoldlGroup' cotile cgroup getSymbols ES.empty getLegend s !acc = do (mOneIn, m) <- acc let p f t = TK.tsymbol t == s && f (Tile.kindHasFeature TK.Spice t) tk <- fmap (fromMaybe $ error $ "" `showFailure` (cgroup, s)) $ opick cotile cgroup (p not) mtkSpice <- opick cotile cgroup (p id) return $! case mtkSpice of Nothing -> (mOneIn, EM.insert s tk m) Just tkSpice -> -- Unlikely, but possible that ordinary legend has spice. let n = fromMaybe (error $ show cgroup) (lookup cgroup (TK.tfreq (okind cotile tk))) k = fromMaybe (error $ show cgroup) (lookup cgroup (TK.tfreq (okind cotile tkSpice))) in (EM.insert s (k, n, tkSpice) mOneIn, EM.insert s tk m) legend = ES.foldr' getLegend (return (EM.empty, EM.empty)) symbols in legend pover :: COps -> [(Char, GroupName TileKind)] -> Rnd ( EM.EnumMap Char (Int, Int, ContentId TileKind) , EM.EnumMap Char (ContentId TileKind) ) pover COps{cotile} poverride = let getLegend (s, cgroup) acc = do (mOneIn, m) <- acc mtkSpice <- opick cotile cgroup (Tile.kindHasFeature TK.Spice) tk <- fromMaybe (error $ "" `showFailure` (s, cgroup, poverride)) <$> opick cotile cgroup (not . Tile.kindHasFeature TK.Spice) return $! case mtkSpice of Nothing -> (mOneIn, EM.insert s tk m) Just tkSpice -> -- Very likely that overrides have spice. let n = fromMaybe (error $ show cgroup) (lookup cgroup (TK.tfreq (okind cotile tk))) k = fromMaybe (error $ show cgroup) (lookup cgroup (TK.tfreq (okind cotile tkSpice))) in (EM.insert s (k, n, tkSpice) mOneIn, EM.insert s tk m) in foldr getLegend (return (EM.empty, EM.empty)) poverride -- | Construct a fence around a place. buildFence :: COps -> CaveKind -> Bool -> ContentId TileKind -> ContentId TileKind -> Bool -> Fence -> Area -> Rnd TileMapEM buildFence COps{cotile} CaveKind{ccornerTile, cwallTile} dnight darkCorTile litCorTile dark fence qarea = do qFWall <- fromMaybe (error $ "" `showFailure` cwallTile) <$> opick cotile cwallTile (const True) qFCorner <- fromMaybe (error $ "" `showFailure` ccornerTile) <$> opick cotile ccornerTile (const True) let qFFloor = if dark then darkCorTile else litCorTile qFGround = if dnight then darkCorTile else litCorTile return $! case fence of FWall -> buildFenceMap qFWall qFCorner qarea FFloor -> buildFenceMap qFFloor qFFloor qarea FGround -> buildFenceMap qFGround qFGround qarea FNone -> EM.empty -- | Construct a fence around an area, with the given tile kind. -- Corners have a different kind, e.g., to avoid putting doors there. buildFenceMap :: ContentId TileKind -> ContentId TileKind -> Area -> TileMapEM buildFenceMap wallId cornerId area = let (x0, y0, x1, y1) = fromArea area in EM.fromList $ [ (Point x y, wallId) | x <- [x0-1, x1+1], y <- [y0..y1] ] ++ [ (Point x y, wallId) | x <- [x0..x1], y <- [y0-1, y1+1] ] ++ [ (Point x y, cornerId) | x <- [x0-1, x1+1], y <- [y0-1, y1+1] ] -- | Construct a fence around an area, with the given tile group. buildFenceRnd :: COps -> GroupName TileKind -> GroupName TileKind -> GroupName TileKind -> GroupName TileKind -> Area -> Rnd TileMapEM buildFenceRnd COps{cotile} cfenceTileN cfenceTileE cfenceTileS cfenceTileW area = do let (x0, y0, x1, y1) = fromArea area allTheSame = all (== cfenceTileN) [cfenceTileE, cfenceTileS, cfenceTileW] fenceIdRnd couterFenceTile (xf, yf) = do let isCorner x y = x `elem` [x0-1, x1+1] && y `elem` [y0-1, y1+1] tileGroup | isCorner xf yf && not allTheSame = "basic outer fence" | otherwise = couterFenceTile fenceId <- fromMaybe (error $ "" `showFailure` tileGroup) <$> opick cotile tileGroup (const True) return (Point xf yf, fenceId) pointListN = [(x, y0-1) | x <- [x0-1..x1+1]] pointListE = [(x1+1, y) | y <- [y0..y1]] pointListS = [(x, y1+1) | x <- [x0-1..x1+1]] pointListW = [(x0-1, y) | y <- [y0..y1]] fenceListN <- mapM (fenceIdRnd cfenceTileN) pointListN fenceListE <- mapM (fenceIdRnd cfenceTileE) pointListE fenceListS <- mapM (fenceIdRnd cfenceTileS) pointListS fenceListW <- mapM (fenceIdRnd cfenceTileW) pointListW return $! EM.fromList $ fenceListN ++ fenceListE ++ fenceListS ++ fenceListW -- | Create a place by tiling patterns. tilePlace :: Area -- ^ the area to fill -> PlaceKind -- ^ the place kind to construct -> Rnd (EM.EnumMap Point Char) tilePlace area pl@PlaceKind{..} = do let (Point x0 y0, xspan, yspan) = spanArea area dxcorner = case ptopLeft of [] -> error $ "" `showFailure` (area, pl) l : _ -> T.length l (dx, dy) = assert (xspan >= dxcorner && yspan >= length ptopLeft `blame` (area, pl)) (xspan, yspan) fromX (x2, y2) = map (`Point` y2) [x2..] fillInterior :: (Int -> String -> String) -> (Int -> [String] -> [String]) -> [(Point, Char)] fillInterior f g = let tileInterior (y, row) = let fx = f dx row xStart = x0 + ((xspan - length fx) `div` 2) in filter ((/= 'X') . snd) $ zip (fromX (xStart, y)) fx reflected = let gy = g dy $ map T.unpack ptopLeft yStart = y0 + ((yspan - length gy) `div` 2) in zip [yStart..] gy in concatMap tileInterior reflected tileReflect :: Int -> [a] -> [a] tileReflect d pat = let lstart = take (d `divUp` 2) pat lend = take (d `div` 2) pat in lstart ++ reverse lend interior <- case pcover of CAlternate -> do let tile :: Int -> [a] -> [a] tile _ [] = error $ "nothing to tile" `showFailure` pl tile d pat = take d (cycle $ init pat ++ init (reverse pat)) return $! fillInterior tile tile CStretch -> do let stretch :: Int -> [a] -> [a] stretch _ [] = error $ "nothing to stretch" `showFailure` pl stretch d pat = tileReflect d (pat ++ repeat (last pat)) return $! fillInterior stretch stretch CReflect -> do let reflect :: Int -> [a] -> [a] reflect d pat = tileReflect d (cycle pat) return $! fillInterior reflect reflect CVerbatim -> return $! fillInterior (flip const) (flip const) CMirror -> do mirror1 <- oneOf [id, reverse] mirror2 <- oneOf [id, reverse] return $! fillInterior (\_ l -> mirror1 l) (\_ l -> mirror2 l) return $! EM.fromList interior LambdaHack-0.9.5.0/engine-src/Game/LambdaHack/Server/EndM.hs0000644000000000000000000001457307346545000021334 0ustar0000000000000000-- | Server operations used when ending game and deciding whether to end. module Game.LambdaHack.Server.EndM ( endOrLoop, dieSer, writeSaveAll #ifdef EXPOSE_INTERNAL -- * Internal operations , gameExit #endif ) where import Prelude () import Game.LambdaHack.Core.Prelude import qualified Data.EnumMap.Strict as EM import Game.LambdaHack.Atomic import Game.LambdaHack.Client (sbenchmark) import Game.LambdaHack.Common.Actor import Game.LambdaHack.Common.ActorState import Game.LambdaHack.Common.Faction import Game.LambdaHack.Common.MonadStateRead import Game.LambdaHack.Common.State import Game.LambdaHack.Common.Types import Game.LambdaHack.Content.ModeKind import Game.LambdaHack.Definition.Defs import Game.LambdaHack.Server.CommonM import Game.LambdaHack.Server.Fov import Game.LambdaHack.Server.HandleEffectM import Game.LambdaHack.Server.MonadServer import Game.LambdaHack.Server.ProtocolM import Game.LambdaHack.Server.ServerOptions import Game.LambdaHack.Server.State -- | Continue or exit or restart the game. endOrLoop :: (MonadServerAtomic m, MonadServerComm m) => m () -> (Maybe (GroupName ModeKind) -> m ()) -> m () endOrLoop loop restart = do factionD <- getsState sfactionD let inGame fact = case gquit fact of Nothing -> True Just Status{stOutcome=Camping} -> True _ -> False gameOver = not $ any inGame $ EM.elems factionD let getQuitter fact = case gquit fact of Just Status{stOutcome=Restart, stNewGame} -> stNewGame _ -> Nothing quitters = mapMaybe getQuitter $ EM.elems factionD restartNeeded = gameOver || not (null quitters) let isCamper fact = case gquit fact of Just Status{stOutcome=Camping} -> True _ -> False campers = filter (isCamper . snd) $ EM.assocs factionD -- Wipe out the quit flag for the savegame files. mapM_ (\(fid, fact) -> execUpdAtomic $ UpdQuitFaction fid (gquit fact) Nothing Nothing) campers swriteSave <- getsServer swriteSave when swriteSave $ do modifyServer $ \ser -> ser {swriteSave = False} writeSaveAll True if | restartNeeded -> do execSfxAtomic SfxRestart restart (listToMaybe quitters) | not $ null campers -> gameExit -- and @loop@ is not called | otherwise -> loop -- continue current game gameExit :: (MonadServerAtomic m, MonadServerComm m) => m () gameExit = do -- debugPossiblyPrint "Server: Verifying all perceptions." -- Verify that the possibly not saved caches are equal to future -- reconstructed. Otherwise, save/restore would change game state. -- This is done even in released binaries, because it only prolongs -- game shutdown a bit. The same checks at each periodic game save -- would icrease the game saving lag, so they are normally avoided. verifyCaches -- Kill all clients, including those that did not take part -- in the current game. -- Clients exit not now, but after they print all ending screens. -- debugPossiblyPrint "Server: Killing all clients." killAllClients -- debugPossiblyPrint "Server: All clients killed." return () verifyCaches :: MonadServer m => m () verifyCaches = do sperCacheFid <- getsServer sperCacheFid sperValidFid <- getsServer sperValidFid sactorMaxSkills2 <- getsState sactorMaxSkills sfovLucidLid <- getsServer sfovLucidLid sfovClearLid <- getsServer sfovClearLid sfovLitLid <- getsServer sfovLitLid sperFid <- getsServer sperFid actorMaxSkills <- getsState maxSkillsInDungeon ( fovLitLid, fovClearLid, fovLucidLid ,perValidFid, perCacheFid, perFid ) <- getsState perFidInDungeon let !_A7 = assert (sfovLitLid == fovLitLid `blame` "wrong accumulated sfovLitLid" `swith` (sfovLitLid, fovLitLid)) () !_A6 = assert (sfovClearLid == fovClearLid `blame` "wrong accumulated sfovClearLid" `swith` (sfovClearLid, fovClearLid)) () !_A5 = assert (sactorMaxSkills2 == actorMaxSkills `blame` "wrong accumulated sactorMaxSkills" `swith` (sactorMaxSkills2, actorMaxSkills)) () !_A4 = assert (sfovLucidLid == fovLucidLid `blame` "wrong accumulated sfovLucidLid" `swith` (sfovLucidLid, fovLucidLid)) () !_A3 = assert (sperValidFid == perValidFid `blame` "wrong accumulated sperValidFid" `swith` (sperValidFid, perValidFid)) () !_A2 = assert (sperCacheFid == perCacheFid `blame` "wrong accumulated sperCacheFid" `swith` (sperCacheFid, perCacheFid)) () !_A1 = assert (sperFid == perFid `blame` "wrong accumulated perception" `swith` (sperFid, perFid)) () return () dieSer :: MonadServerAtomic m => ActorId -> Actor -> m () dieSer aid b = do b2 <- if bproj b then return b else do kindId <- getsState $ getIidKindIdServer $ btrunk b execUpdAtomic $ UpdRecordKill aid kindId 1 -- At this point the actor's body exists and his items are not dropped. deduceKilled aid -- Most probabaly already done, but just in case (e.g., when actor -- created with 0 HP): electLeader (bfid b) (blid b) aid fact <- getsState $ (EM.! bfid b) . sfactionD -- Prevent faction's stash from being lost in case they are not spawners. -- Projectiles can't drop stash, because they are blind and so the faction -- would not see the actor that drops the stash, leading to a crash. -- But this is OK; projectiles can't be leaders, so stash dropped earlier. when (isNothing $ gleader fact) $ moveStores False aid CSha CInv getsState $ getActorBody aid -- If the actor was a projectile and no effect was triggered by hitting -- an enemy, the item still exists and @OnSmash@ effects will be triggered: dropAllItems aid b2 b3 <- getsState $ getActorBody aid execUpdAtomic $ UpdDestroyActor aid b3 [] -- | Save game on server and all clients. writeSaveAll :: MonadServerAtomic m => Bool -> m () writeSaveAll uiRequested = do bench <- getsServer $ sbenchmark . sclientOptions . soptions noConfirmsGame <- isNoConfirmsGame when (uiRequested || not bench && not noConfirmsGame) $ do execUpdAtomic UpdWriteSave saveServer #ifdef WITH_EXPENSIVE_ASSERTIONS -- This check is sometimes repeated in @gameExit@, but we don't care about -- speed of shutdown and even more so in WITH_EXPENSIVE_ASSERTIONS mode. verifyCaches #endif LambdaHack-0.9.5.0/engine-src/Game/LambdaHack/Server/Fov.hs0000644000000000000000000003461107346545000021236 0ustar0000000000000000-- | Field Of View scanning. -- -- See -- for discussion. module Game.LambdaHack.Server.Fov ( -- * Perception cache FovValid(..), PerValidFid , PerReachable(..), CacheBeforeLucid(..), PerActor , PerceptionCache(..), PerCacheLid, PerCacheFid -- * Data used in FOV computation and cached to speed it up , FovShine(..), FovLucid(..), FovLucidLid , FovClear(..), FovClearLid, FovLit (..), FovLitLid -- * Operations , perceptionFromPTotal, perActorFromLevel, boundSightByCalm , totalFromPerActor, lucidFromLevel, perFidInDungeon #ifdef EXPOSE_INTERNAL -- * Internal operations , cacheBeforeLucidFromActor, shineFromLevel, floorLightSources, lucidFromItems , litFromLevel, litInDungeon, clearFromLevel, clearInDungeon, lucidInDungeon , perLidFromFaction, perceptionCacheFromLevel , Matrix, fullscan #endif ) where import Prelude () import Game.LambdaHack.Core.Prelude import qualified Data.EnumMap.Strict as EM import qualified Data.EnumSet as ES import Data.Int (Int64) import qualified Data.IntSet as IS import GHC.Exts (inline) import Game.LambdaHack.Common.Actor import Game.LambdaHack.Common.ActorState import Game.LambdaHack.Common.Item import qualified Game.LambdaHack.Common.ItemAspect as IA import Game.LambdaHack.Common.Kind import Game.LambdaHack.Common.Level import Game.LambdaHack.Common.Misc import Game.LambdaHack.Common.Perception import Game.LambdaHack.Common.Point import qualified Game.LambdaHack.Common.PointArray as PointArray import Game.LambdaHack.Common.State import qualified Game.LambdaHack.Common.Tile as Tile import Game.LambdaHack.Common.Types import Game.LambdaHack.Common.Vector import qualified Game.LambdaHack.Definition.Ability as Ability import Game.LambdaHack.Server.FovDigital -- * Perception cache types data FovValid a = FovValid a | FovInvalid deriving (Show, Eq) -- | Main perception validity map, for all factions. type PerValidFid = EM.EnumMap FactionId (EM.EnumMap LevelId Bool) -- | Visually reachable positions (light passes through them to the actor). -- They need to be intersected with lucid positions to obtain visible positions. newtype PerReachable = PerReachable {preachable :: ES.EnumSet Point} deriving (Show, Eq) data CacheBeforeLucid = CacheBeforeLucid { creachable :: PerReachable , cnocto :: PerVisible , csmell :: PerSmelled } deriving (Show, Eq) type PerActor = EM.EnumMap ActorId (FovValid CacheBeforeLucid) -- We might cache even more effectively in terms of Enum{Set,Map} unions -- if we recorded for each field how many actors see it (and how many -- lights lit it). But this is complex and unions of EnumSets are cheaper -- than the EnumMaps that would be required. data PerceptionCache = PerceptionCache { ptotal :: FovValid CacheBeforeLucid , perActor :: PerActor } deriving (Show, Eq) -- | Server cache of perceptions of a single faction, -- indexed by level identifier. type PerCacheLid = EM.EnumMap LevelId PerceptionCache -- | Server cache of perceptions, indexed by faction identifier. type PerCacheFid = EM.EnumMap FactionId PerCacheLid -- * Data used in FOV computation -- | Map from level positions that currently hold item or actor(s) with shine -- to the maximum of radiuses of the shining lights. -- -- Note that floor and (many projectile) actors light on a single tile -- should be additive for @FovShine@ to be incrementally updated. -- -- @FovShine@ should not even be kept in @StateServer@, because it's cheap -- to compute, compared to @FovLucid@ and invalidated almost as often -- (not invalidated only by @UpdAlterTile@). newtype FovShine = FovShine {fovShine :: EM.EnumMap Point Int} deriving (Show, Eq) -- | Level positions with either ambient light or shining items or actors. newtype FovLucid = FovLucid {fovLucid :: ES.EnumSet Point} deriving (Show, Eq) type FovLucidLid = EM.EnumMap LevelId (FovValid FovLucid) -- | Level positions that pass through light and vision. newtype FovClear = FovClear {fovClear :: PointArray.Array Bool} deriving (Show, Eq) type FovClearLid = EM.EnumMap LevelId FovClear -- | Level positions with tiles that have ambient light. newtype FovLit = FovLit {fovLit :: ES.EnumSet Point} deriving (Show, Eq) type FovLitLid = EM.EnumMap LevelId FovLit -- * Update of invalidated Fov data -- | Compute positions visible (reachable and seen) by the party. -- A position is lucid, if it's lit by an ambient light or by a weak, portable -- light source, e.g,, carried by an actor. A reachable and lucid position -- is visible. Additionally, positions directly adjacent to an actor are -- assumed to be visible to him (through sound, touch, noctovision, whatever). perceptionFromPTotal :: FovLucid -> CacheBeforeLucid -> Perception perceptionFromPTotal FovLucid{fovLucid} ptotal = let nocto = pvisible $ cnocto ptotal reach = preachable $ creachable ptotal psight = PerVisible $ nocto `ES.union` (reach `ES.intersection` fovLucid) psmell = csmell ptotal in Perception{..} perActorFromLevel :: PerActor -> (ActorId -> Actor) -> ActorMaxSkills -> FovClear -> PerActor perActorFromLevel perActorOld getActorB actorMaxSkills fovClear = -- Dying actors included, to let them see their own demise. let f _ fv@FovValid{} = fv f aid FovInvalid = let actorMaxSk = actorMaxSkills EM.! aid b = getActorB aid in FovValid $ cacheBeforeLucidFromActor fovClear b actorMaxSk in EM.mapWithKey f perActorOld boundSightByCalm :: Int -> Int64 -> Int boundSightByCalm sight calm = min (fromEnum $ calm `div` xM 5) sight -- | Compute positions reachable by the actor. Reachable are all fields -- on a visually unblocked path from the actor position. -- Also compute positions seen by noctovision and perceived by smell. cacheBeforeLucidFromActor :: FovClear -> Actor -> Ability.Skills -> CacheBeforeLucid cacheBeforeLucidFromActor clearPs body actorMaxSk = let radius = boundSightByCalm (Ability.getSk Ability.SkSight actorMaxSk) (bcalm body) spectatorPos = bpos body creachable = PerReachable $ fullscan radius spectatorPos clearPs cnocto = PerVisible $ fullscan (Ability.getSk Ability.SkNocto actorMaxSk) spectatorPos clearPs smellRadius = if Ability.getSk Ability.SkSmell actorMaxSk >= 2 then 2 else 0 csmell = PerSmelled $ fullscan smellRadius spectatorPos clearPs in CacheBeforeLucid{..} totalFromPerActor :: PerActor -> CacheBeforeLucid totalFromPerActor perActor = let as = map (\case FovValid x -> x FovInvalid -> error $ "" `showFailure` perActor) $ EM.elems perActor in CacheBeforeLucid { creachable = PerReachable $ ES.unions $ map (preachable . creachable) as , cnocto = PerVisible $ ES.unions $ map (pvisible . cnocto) as , csmell = PerSmelled $ ES.unions $ map (psmelled . csmell) as } -- | Update lights on the level. This is needed every (even enemy) -- actor move to show thrown torches. -- We need to update lights even if cmd doesn't change any perception, -- so that for next cmd that does, but doesn't change lights, -- and operates on the same level, the lights are up to date. -- We could make lights lazy to ensure no computation is wasted, -- but it's rare that cmd changed them, but not the perception -- (e.g., earthquake in an uninhabited corner of the active arena, -- but the we'd probably want some feedback, at least sound). lucidFromLevel :: FovClearLid -> FovLitLid -> State -> LevelId -> Level -> FovLucid lucidFromLevel fovClearLid fovLitLid s lid lvl = let shine = shineFromLevel s lid lvl lucids = lucidFromItems (fovClearLid EM.! lid) $ EM.assocs $ fovShine shine litTiles = fovLitLid EM.! lid in FovLucid $ ES.unions $ fovLit litTiles : map fovLucid lucids shineFromLevel :: State -> LevelId -> Level -> FovShine shineFromLevel s lid lvl = -- Actors shine as if they were leaders, for speed and to prevent -- micromanagement by switching leader to see more. let actorLights = [ (bpos b, radius) | (aid, b) <- inline actorAssocs (const True) lid s , let radius = Ability.getSk Ability.SkShine $ getActorMaxSkills aid s , radius > 0 ] floorLights = floorLightSources (sdiscoAspect s) lvl allLights = floorLights ++ actorLights -- If there is light both on the floor and carried by actor -- (or several projectile actors), its radius is the maximum. in FovShine $ EM.fromListWith max allLights floorLightSources :: DiscoveryAspect -> Level -> [(Point, Int)] floorLightSources discoAspect lvl = -- Not enough oxygen to have more than one light lit on a given tile. -- Items obscuring or dousing off fire are not cumulative as well. let processIid (accLight, accDouse) (iid, _) = let shine = IA.getSkill Ability.SkShine $ discoAspect EM.! iid in case compare shine 0 of EQ -> (accLight, accDouse) GT -> (max shine accLight, accDouse) LT -> (accLight, min shine accDouse) processBag bag acc = foldl' processIid acc $ EM.assocs bag in [ (p, radius) | (p, bag) <- EM.assocs $ lfloor lvl -- lembed are hidden , let (maxLight, maxDouse) = processBag bag (0, 0) radius = maxLight + maxDouse , radius > 0 ] -- | Compute all dynamically lit positions on a level, whether lit by actors -- or shining floor items. Note that an actor can be blind, -- in which case he doesn't see his own light (but others, -- from his or other factions, possibly do). lucidFromItems :: FovClear -> [(Point, Int)] -> [FovLucid] lucidFromItems clearPs allItems = let lucidPos (!p, !shine) = FovLucid $ fullscan shine p clearPs in map lucidPos allItems -- * Computation of initial perception and caches -- | Calculate the perception and its caches for the whole dungeon. perFidInDungeon :: State -> ( FovLitLid, FovClearLid, FovLucidLid , PerValidFid, PerCacheFid, PerFid) perFidInDungeon s = let fovLitLid = litInDungeon s fovClearLid = clearInDungeon s fovLucidLid = lucidInDungeon fovClearLid fovLitLid s perValidLid = EM.map (const True) (sdungeon s) perValidFid = EM.map (const perValidLid) (sfactionD s) f fid _ = perLidFromFaction fovLucidLid fovClearLid fid s em = EM.mapWithKey f $ sfactionD s in ( fovLitLid, fovClearLid, fovLucidLid , perValidFid, EM.map snd em, EM.map fst em) litFromLevel :: COps -> Level -> FovLit litFromLevel COps{coTileSpeedup} Level{ltile} = let litSet p t set = if Tile.isLit coTileSpeedup t then p : set else set in FovLit $ ES.fromDistinctAscList $ PointArray.ifoldrA' litSet [] ltile litInDungeon :: State -> FovLitLid litInDungeon s = EM.map (litFromLevel (scops s)) $ sdungeon s clearFromLevel :: COps -> Level -> FovClear clearFromLevel COps{coTileSpeedup} Level{ltile} = FovClear $ PointArray.mapA (Tile.isClear coTileSpeedup) ltile clearInDungeon :: State -> FovClearLid clearInDungeon s = EM.map (clearFromLevel (scops s)) $ sdungeon s lucidInDungeon :: FovClearLid -> FovLitLid -> State -> FovLucidLid lucidInDungeon fovClearLid fovLitLid s = EM.mapWithKey (\lid lvl -> FovValid $ lucidFromLevel fovClearLid fovLitLid s lid lvl) $ sdungeon s -- | Calculate perception of a faction. perLidFromFaction :: FovLucidLid -> FovClearLid -> FactionId -> State -> (PerLid, PerCacheLid) perLidFromFaction fovLucidLid fovClearLid fid s = let em = EM.mapWithKey (\lid _ -> perceptionCacheFromLevel fovClearLid fid lid s) (sdungeon s) fovLucid lid = case EM.lookup lid fovLucidLid of Just (FovValid fl) -> fl _ -> error $ "" `showFailure` (lid, fovLucidLid) getValid (FovValid pc) = pc getValid FovInvalid = error $ "" `showFailure` fid in ( EM.mapWithKey (\lid pc -> perceptionFromPTotal (fovLucid lid) (getValid (ptotal pc))) em , em ) perceptionCacheFromLevel :: FovClearLid -> FactionId -> LevelId -> State -> PerceptionCache perceptionCacheFromLevel fovClearLid fid lid s = let fovClear = fovClearLid EM.! lid lvlBodies = inline actorAssocs (== fid) lid s f (aid, b) = -- Actors see and smell as if they were leaders, for speed -- and to prevent micromanagement by switching leader to see more. let actorMaxSk = getActorMaxSkills aid s in if Ability.getSk Ability.SkSight actorMaxSk <= 0 && Ability.getSk Ability.SkNocto actorMaxSk <= 0 && Ability.getSk Ability.SkSmell actorMaxSk <= 0 then Nothing -- dumb missile else Just (aid, FovValid $ cacheBeforeLucidFromActor fovClear b actorMaxSk) lvlCaches = mapMaybe f lvlBodies perActor = EM.fromDistinctAscList lvlCaches total = totalFromPerActor perActor in PerceptionCache{ptotal = FovValid total, perActor} -- * The actual Fov algorithm type Matrix = (Int, Int, Int, Int) -- | Perform a full scan for a given position. Returns the positions -- that are currently in the field of view. -- The actor's own position is considred in his field of view. fullscan :: Int -- ^ scanning radius -> Point -- ^ position of the spectator -> FovClear -- ^ the array with clear positions -> ES.EnumSet Point fullscan !radius spectatorPos fc = case radius of 2 -> squareUnsafeSet spectatorPos 1 -> ES.singleton spectatorPos 0 -> ES.empty -- e.g., smell for non-smelling _ | radius <= 0 -> ES.empty _ -> let !FovClear{fovClear} = fc !spectatorI = fromEnum spectatorPos mapTr :: Matrix -> [PointI] mapTr m@(!_, !_, !_, !_) = scan (radius - 1) isClear (trV m) trV :: Matrix -> Bump -> PointI {-# INLINE trV #-} trV (x1, y1, x2, y2) B{..} = spectatorI + fromEnum (Vector (x1 * bx + y1 * by) (x2 * bx + y2 * by)) isClear :: PointI -> Bool {-# INLINE isClear #-} isClear = PointArray.accessI fovClear in ES.intSetToEnumSet $ IS.fromList $ [spectatorI] ++ mapTr (1, 0, 0, -1) -- quadrant I ++ mapTr (0, 1, 1, 0) -- II (counter-clockwise) ++ mapTr (-1, 0, 0, 1) -- III ++ mapTr (0, -1, -1, 0) -- IV LambdaHack-0.9.5.0/engine-src/Game/LambdaHack/Server/FovDigital.hs0000644000000000000000000002777407346545000022550 0ustar0000000000000000-- | DFOV (Digital Field of View) implemented according to specification at . -- This fast version of the algorithm, based on PFOV, has AFAIK -- never been described nor implemented before. -- -- The map is processed in depth-first-search manner, that is, as soon -- as we detect on obstacle we move away from the viewer up to the -- FOV radius and then restart on the other side of the obstacle. -- This has better cache behaviour than breadth-firsts-search, -- where we would process all tiles equally distant from the viewer -- in the same round, because then we'd need to keep the many convex hulls -- and edges, not just a single set, and we'd potentially traverse all -- of them each round. module Game.LambdaHack.Server.FovDigital ( scan -- * Scanning coordinate system , Bump(..) -- * Assorted minor operations #ifdef EXPOSE_INTERNAL -- * Current scan parameters , Distance, Progress -- * Geometry in system @Bump@ , LineOrdering, Line(..), ConvexHull(..), CHull(..), Edge, EdgeInterval -- * Internal operations , steepestInHull, foldlCHull', addToHull, addToHullGo , createLine, steepness, intersect , _debugSteeper, _debugLine #endif ) where import Prelude () import Game.LambdaHack.Core.Prelude hiding (intersect) import Game.LambdaHack.Common.Point (PointI) -- | Distance from the (0, 0) point where FOV originates. type Distance = Int -- | Progress along an arc with a constant distance from (0, 0). type Progress = Int -- | Rotated and translated coordinates of 2D points, so that the points fit -- in a single quadrant area (e, g., quadrant I for Permissive FOV, hence both -- coordinates positive; adjacent diagonal halves of quadrant I and II -- for Digital FOV, hence y positive). -- The special coordinates are written using the standard mathematical -- coordinate setup, where quadrant I, with x and y positive, -- is on the upper right. data Bump = B { bx :: Int , by :: Int } deriving Show -- | Two strict orderings of lines with a common point. data LineOrdering = Steeper | Shallower -- | Straight line between points. data Line = Line Bump Bump deriving Show -- | Convex hull represented as a non-empty list of points. data ConvexHull = ConvexHull Bump CHull deriving Show data CHull = CHNil | CHCons Bump CHull deriving Show -- | An edge (comprising of a line and a convex hull) of the area to be scanned. type Edge = (Line, ConvexHull) -- | The contiguous area left to be scanned, delimited by edges. type EdgeInterval = (Edge, Edge) -- | Calculates the list of tiles visible from (0, 0) within the given -- sight range. scan :: Distance -- ^ visiblity distance -> (PointI -> Bool) -- ^ visually clear position predicate -> (Bump -> PointI) -- ^ coordinate transformation -> [PointI] {-# INLINE scan #-} scan !r isClear tr = #ifdef WITH_EXPENSIVE_ASSERTIONS assert (r > 0 `blame` r) $ -- not really expensive, but obfuscates Core #endif -- The scanned area is a square, which is a sphere in the chessboard metric. dscan 1 ( (Line (B 1 0) (B (-r) r), ConvexHull (B 0 0) CHNil) , (Line (B 0 0) (B (r+1) r), ConvexHull (B 1 0) CHNil) ) where dscan :: Distance -> EdgeInterval -> [PointI] {-# INLINE dscan #-} dscan !d ( (sl{-shallow line-}, sHull), (el{-steep line-}, eHull) ) = dgo d sl sHull el eHull -- Speed (mosty JS) and generally convincing GHC to unbox stuff. dgo :: Distance -> Line -> ConvexHull -> Line -> ConvexHull -> [PointI] dgo !d !sl sHull !el eHull = -- @sHull@ and @eHull@ may be unused let !ps0 = let (n, k) = intersect sl d -- minimal progress to consider in n `div` k !pe = let (n, k) = intersect el d -- maximal progress to consider -- Corners obstruct view, so the steep line, constructed -- from corners, is itself not a part of the view, -- so if its intersection with the horizonstal line at distance -- @d@ is only at a corner, we choose the position leading -- to a smaller view. in -1 + n `divUp` k outside = if d < r then let !trBump = bump ps0 in if isClear trBump then trBump : mscanVisible sl sHull (ps0+1) -- start visible else trBump : mscanShadowed (ps0+1) -- start in shadow else map bump [ps0..pe] bump :: Progress -> PointI bump !px = tr $ B px d -- We're in a visible interval. mscanVisible :: Line -> ConvexHull -> Progress -> [PointI] mscanVisible line hull = goVisible where goVisible :: Progress -> [PointI] goVisible !ps = if ps <= pe then let !trBump = bump ps in if isClear trBump -- not entering shadow then trBump : goVisible (ps+1) else let steepBump = B ps d nep = steepestInHull Shallower steepBump hull neLine = createLine nep steepBump neHull = addToHull Shallower steepBump eHull in trBump : dgo (d+1) line hull neLine neHull ++ mscanShadowed (ps+1) -- note how we recursively scan more and more -- distant tiles, up to the FOV radius, -- before starting to process the shadow else dgo (d+1) line hull el eHull -- reached end, scan next row -- We're in a shadowed interval. mscanShadowed :: Progress -> [PointI] mscanShadowed !ps = if ps <= pe then let !trBump = bump ps in if not $ isClear trBump -- not moving out of shadow then trBump : mscanShadowed (ps+1) else let shallowBump = B ps d nsp = steepestInHull Steeper shallowBump eHull nsLine = createLine nsp shallowBump nsHull = addToHull Steeper shallowBump sHull in trBump : mscanVisible nsLine nsHull (ps+1) else [] -- reached end while in shadow in #ifdef WITH_EXPENSIVE_ASSERTIONS assert (r >= d && d >= 0 && pe >= ps0 `blame` (r,d,sl,sHull,el,eHull,ps0,pe)) #endif outside -- | Specialized implementation for speed in the inner loop. Not partial. steepestInHull :: LineOrdering -> Bump -> ConvexHull -> Bump {-# NOINLINE steepestInHull #-} steepestInHull !lineOrdering !new (ConvexHull !b !ch) = foldlCHull' max' b ch where max' !x !y = if steepness lineOrdering new x y then x else y -- | Standard @foldl'@ over @CHull@. foldlCHull' :: (a -> Bump -> a) -> a -> CHull -> a {-# INLINE foldlCHull' #-} foldlCHull' f = fgo where fgo !z CHNil = z fgo z (CHCons b ch) = fgo (f z b) ch -- | Extends a convex hull of bumps with a new bump. The new bump makes -- some old bumps unnecessary, e.g. those that are joined with the new steep -- bump with lines that are not shallower than any newer lines in the hull. -- Removing such unnecessary bumps slightly speeds up computation -- of 'steepestInHull'. -- -- Recursion in @addToHullGo@ seems spurious, but it's called each time with -- potentially different comparison predicate, so it's necessary. addToHull :: LineOrdering -- ^ the line ordering to use -> Bump -- ^ a new bump to consider -> ConvexHull -- ^ a convex hull of bumps represented as a list -> ConvexHull {-# INLINE addToHull #-} addToHull lineOrdering new (ConvexHull old ch) = ConvexHull new $ addToHullGo lineOrdering new $ CHCons old ch -- This worker is needed to avoid Core returning a pair (new, result) -- and also Bump-packing new (steepBump/shallowBump) twice, losing sharing. addToHullGo :: LineOrdering -> Bump -> CHull -> CHull {-# NOINLINE addToHullGo #-} addToHullGo !lineOrdering !new = hgo where hgo :: CHull -> CHull hgo (CHCons a ch@(CHCons b _)) | not (steepness lineOrdering new b a) = hgo ch hgo ch = ch -- | Create a line from two points. -- -- Debug: check if well-defined. createLine :: Bump -> Bump -> Line {-# INLINE createLine #-} createLine p1 p2 = let line = Line p1 p2 in #ifdef WITH_EXPENSIVE_ASSERTIONS assert (uncurry blame $ _debugLine line) #endif line -- | Strictly compare steepness of lines @(b1, bf)@ and @(b2, bf)@, -- according to the @LineOrdering@ given. This is related to comparing -- the slope (gradient, angle) of two lines, but simplified wrt signs -- to work fast in this particular setup. -- -- Debug: Verify that the results of 2 independent checks are equal. steepness :: LineOrdering -> Bump -> Bump -> Bump -> Bool {-# INLINE steepness #-} steepness lineOrdering (B xf yf) (B x1 y1) (B x2 y2) = let y2x1 = (yf - y2) * (xf - x1) y1x2 = (yf - y1) * (xf - x2) res = case lineOrdering of Steeper -> y2x1 > y1x2 Shallower -> y2x1 < y1x2 in #ifdef WITH_EXPENSIVE_ASSERTIONS assert (res == _debugSteeper lineOrdering (B xf yf) (B x1 y1) (B x2 y2)) #endif res {- | A pair @(a, b)@ such that @a@ divided by @b@ is the X coordinate of the intersection of a given line and the horizontal line at distance @d@ above the X axis. Derivation of the formula: The intersection point @(xt, yt)@ satisfies the following equalities: > yt = d > (yt - y) (xf - x) = (xt - x) (yf - y) hence > (yt - y) (xf - x) = (xt - x) (yf - y) > (d - y) (xf - x) = (xt - x) (yf - y) > (d - y) (xf - x) + x (yf - y) = xt (yf - y) > xt = ((d - y) (xf - x) + x (yf - y)) / (yf - y) General remarks: The FOV agrees with physical properties of tiles as diamonds and visibility from any point to any point. A diamond is denoted by the left corner of it's encompassing tile. Hero is at (0, 0). Order of processing in the first quadrant rotated by 45 degrees is > 45678 > 123 > @ so the first processed diamond is at (-1, 1). The order is similar as for the restrictive shadow casting algorithm and reversed wrt PFOV. The fast moving line when scanning is called the shallow line, and it's the one that delimits the view from the left, while the steep line is on the right, opposite to PFOV. We start scanning from the left. The 'PointI' ('Enum' representation of @Point@) coordinates are cartesian. The 'Bump' coordinates are cartesian, translated so that the hero is at (0, 0) and rotated so that he always looks at the first (rotated 45 degrees) quadrant. The ('Progress', 'Distance') cordinates coincide with the @Bump@ coordinates, unlike in PFOV. Debug: check that the line fits in the upper half-plane. -} intersect :: Line -> Distance -> (Int, Int) {-# INLINE intersect #-} intersect (Line (B x y) (B xf yf)) d = #ifdef WITH_EXPENSIVE_ASSERTIONS assert (allB (>= 0) [y, yf]) #endif ((d - y)*(xf - x) + x*(yf - y), yf - y) -- | Debug functions for DFOV: -- | Debug: calculate steepness for DFOV in another way and compare results. _debugSteeper :: LineOrdering -> Bump -> Bump -> Bump -> Bool {-# INLINE _debugSteeper #-} _debugSteeper lineOrdering f@(B _xf yf) p1@(B _x1 y1) p2@(B _x2 y2) = assert (allB (>= 0) [yf, y1, y2]) $ let (n1, k1) = intersect (Line p1 f) 0 (n2, k2) = intersect (Line p2 f) 0 sign = case lineOrdering of Steeper -> GT Shallower -> LT in compare (k1 * n2) (n1 * k2) == sign -- | Debug: check if a view border line for DFOV is legal. _debugLine :: Line -> (Bool, String) {-# INLINE _debugLine #-} _debugLine line@(Line (B x1 y1) (B x2 y2)) | not (allB (>= 0) [y1, y2]) = (False, "negative Y coordinates: " ++ show line) | y1 == y2 && x1 == x2 = (False, "ill-defined line: " ++ show line) | y1 == y2 = (False, "horizontal line: " ++ show line) | crossL0 = (False, "crosses the X axis below 0: " ++ show line) | crossG1 = (False, "crosses the X axis above 1: " ++ show line) | otherwise = (True, "") where (n, k) = line `intersect` 0 (q, r) = if k == 0 then (0, 0) else n `divMod` k crossL0 = q < 0 -- q truncated toward negative infinity crossG1 = q >= 1 && (q > 1 || r /= 0) LambdaHack-0.9.5.0/engine-src/Game/LambdaHack/Server/HandleAtomicM.hs0000644000000000000000000003411307346545000023146 0ustar0000000000000000-- | Handle atomic commands on the server, after they are executed -- to change server 'State' and before they are sent to clients. module Game.LambdaHack.Server.HandleAtomicM ( cmdAtomicSemSer #ifdef EXPOSE_INTERNAL -- * Internal operations , invalidateArenas, updateSclear, updateSlit , invalidateLucidLid, invalidateLucidAid , actorHasShine, itemAffectsShineRadius, itemAffectsPerRadius , addPerActor, addPerActorAny, deletePerActor, deletePerActorAny , invalidatePerActor, reconsiderPerActor, invalidatePerLid #endif ) where import Prelude () import Game.LambdaHack.Core.Prelude import qualified Data.EnumMap.Strict as EM import qualified Data.EnumSet as ES import Game.LambdaHack.Atomic import Game.LambdaHack.Common.Actor import Game.LambdaHack.Common.ActorState import Game.LambdaHack.Common.Item import qualified Game.LambdaHack.Common.ItemAspect as IA import Game.LambdaHack.Common.Kind import Game.LambdaHack.Common.MonadStateRead import Game.LambdaHack.Common.State import qualified Game.LambdaHack.Common.Tile as Tile import Game.LambdaHack.Common.Types import Game.LambdaHack.Content.TileKind (TileKind) import Game.LambdaHack.Common.Point import qualified Game.LambdaHack.Common.PointArray as PointArray import qualified Game.LambdaHack.Definition.Ability as Ability import Game.LambdaHack.Definition.Defs import Game.LambdaHack.Server.Fov import Game.LambdaHack.Server.MonadServer import Game.LambdaHack.Server.State -- | Effect of atomic actions on server state is calculated -- with the global state from after the command is executed -- (except where the supplied @oldState@ is used). cmdAtomicSemSer :: MonadServer m => State -> UpdAtomic -> m () cmdAtomicSemSer oldState cmd = case cmd of UpdCreateActor aid b _ -> do actorMaxSkills <- getsState sactorMaxSkills when (actorHasShine actorMaxSkills aid) $ invalidateLucidLid $ blid b addPerActor aid b UpdDestroyActor aid b _ -> do let actorMaxSkillsOld = sactorMaxSkills oldState when (actorHasShine actorMaxSkillsOld aid) $ invalidateLucidLid $ blid b deletePerActor actorMaxSkillsOld aid b modifyServer $ \ser -> ser { sactorTime = EM.adjust (EM.adjust (EM.delete aid) (blid b)) (bfid b) (sactorTime ser) , strajTime = EM.adjust (EM.adjust (EM.delete aid) (blid b)) (bfid b) (strajTime ser) , strajPushedBy = EM.delete aid (strajPushedBy ser) , sactorAn = EM.delete aid (sactorAn ser) , sactorStasis = ES.delete aid (sactorStasis ser) } UpdCreateItem iid _ _ (CFloor lid _) -> do discoAspect <- getsState sdiscoAspect when (itemAffectsShineRadius discoAspect iid []) $ invalidateLucidLid lid UpdCreateItem iid _ _ (CActor aid store) -> do discoAspect <- getsState sdiscoAspect when (itemAffectsShineRadius discoAspect iid [store]) $ invalidateLucidAid aid when (store `elem` [CEqp, COrgan]) $ when (itemAffectsPerRadius discoAspect iid) $ reconsiderPerActor aid UpdDestroyItem iid _ _ (CFloor lid _) -> do discoAspect <- getsState sdiscoAspect when (itemAffectsShineRadius discoAspect iid []) $ invalidateLucidLid lid UpdDestroyItem iid _ _ (CActor aid store) -> do discoAspect <- getsState sdiscoAspect when (itemAffectsShineRadius discoAspect iid [store]) $ invalidateLucidAid aid when (store `elem` [CEqp, COrgan]) $ when (itemAffectsPerRadius discoAspect iid) $ reconsiderPerActor aid UpdSpotActor aid b _ -> do -- On server, it does't affect aspects, but does affect lucid (Ascend). actorMaxSkills <- getsState sactorMaxSkills when (actorHasShine actorMaxSkills aid) $ invalidateLucidLid $ blid b addPerActor aid b UpdLoseActor aid b _ -> do -- On server, it does't affect aspects, but does affect lucid (Ascend). let actorMaxSkillsOld = sactorMaxSkills oldState when (actorHasShine actorMaxSkillsOld aid) $ invalidateLucidLid $ blid b deletePerActor actorMaxSkillsOld aid b modifyServer $ \ser -> ser { sactorTime = EM.adjust (EM.adjust (EM.delete aid) (blid b)) (bfid b) (sactorTime ser) , strajTime = EM.adjust (EM.adjust (EM.delete aid) (blid b)) (bfid b) (strajTime ser) , strajPushedBy = EM.delete aid (strajPushedBy ser) , sactorAn = EM.delete aid (sactorAn ser) , sactorStasis = ES.delete aid (sactorStasis ser) } UpdSpotItem _ iid _ _ (CFloor lid _) -> do discoAspect <- getsState sdiscoAspect when (itemAffectsShineRadius discoAspect iid []) $ invalidateLucidLid lid UpdSpotItem _ iid _ _ (CActor aid store) -> do discoAspect <- getsState sdiscoAspect when (itemAffectsShineRadius discoAspect iid [store]) $ invalidateLucidAid aid when (store `elem` [CEqp, COrgan]) $ when (itemAffectsPerRadius discoAspect iid) $ reconsiderPerActor aid UpdLoseItem _ iid _ _ (CFloor lid _) -> do discoAspect <- getsState sdiscoAspect when (itemAffectsShineRadius discoAspect iid []) $ invalidateLucidLid lid UpdLoseItem _ iid _ _ (CActor aid store) -> do discoAspect <- getsState sdiscoAspect when (itemAffectsShineRadius discoAspect iid [store]) $ invalidateLucidAid aid when (store `elem` [CEqp, COrgan]) $ when (itemAffectsPerRadius discoAspect iid) $ reconsiderPerActor aid UpdSpotItemBag (CFloor lid _) bag _ais -> do discoAspect <- getsState sdiscoAspect let iids = EM.keys bag when (any (\iid -> itemAffectsShineRadius discoAspect iid []) iids) $ invalidateLucidLid lid UpdSpotItemBag (CActor aid store) bag _ais -> do discoAspect <- getsState sdiscoAspect let iids = EM.keys bag when (any (\iid -> itemAffectsShineRadius discoAspect iid [store]) iids) $ invalidateLucidAid aid when (store `elem` [CEqp, COrgan]) $ when (any (itemAffectsPerRadius discoAspect) iids) $ reconsiderPerActor aid UpdLoseItemBag (CFloor lid _) bag _ais -> do discoAspect <- getsState sdiscoAspect let iids = EM.keys bag when (any (\iid -> itemAffectsShineRadius discoAspect iid []) iids) $ invalidateLucidLid lid UpdLoseItemBag (CActor aid store) bag _ais -> do discoAspect <- getsState sdiscoAspect let iids = EM.keys bag when (any (\iid -> itemAffectsShineRadius discoAspect iid [store]) iids) $ invalidateLucidAid aid when (store `elem` [CEqp, COrgan]) $ when (any (itemAffectsPerRadius discoAspect) iids) $ reconsiderPerActor aid UpdMoveActor aid _ _ -> do actorMaxSkills <- getsState sactorMaxSkills when (actorHasShine actorMaxSkills aid) $ invalidateLucidAid aid invalidatePerActor aid UpdDisplaceActor aid1 aid2 -> do actorMaxSkills <- getsState sactorMaxSkills when (actorHasShine actorMaxSkills aid1 || actorHasShine actorMaxSkills aid2) $ invalidateLucidAid aid1 -- the same lid as aid2 invalidatePerActor aid1 invalidatePerActor aid2 UpdMoveItem iid _k aid s1 s2 -> do discoAspect <- getsState sdiscoAspect let itemAffectsPer = itemAffectsPerRadius discoAspect iid invalidatePer = when itemAffectsPer $ reconsiderPerActor aid itemAffectsShine = itemAffectsShineRadius discoAspect iid [s1, s2] invalidateLucid = when itemAffectsShine $ invalidateLucidAid aid case s1 of CEqp -> case s2 of COrgan -> return () _ -> do invalidateLucid invalidatePer COrgan -> case s2 of CEqp -> return () _ -> do invalidateLucid invalidatePer _ -> do invalidateLucid -- from itemAffects, s2 provides light or s1 is CGround when (s2 `elem` [CEqp, COrgan]) invalidatePer UpdRefillCalm aid _ -> do actorMaxSk <- getsState $ getActorMaxSkills aid body <- getsState $ getActorBody aid let sight = Ability.getSk Ability.SkSight actorMaxSk oldBody = getActorBody aid oldState radiusOld = boundSightByCalm sight (bcalm oldBody) radiusNew = boundSightByCalm sight (bcalm body) when (radiusOld /= radiusNew) $ invalidatePerActor aid UpdLeadFaction{} -> invalidateArenas UpdRecordKill{} -> invalidateArenas UpdAlterTile lid pos fromTile toTile -> do clearChanged <- updateSclear lid pos fromTile toTile litChanged <- updateSlit lid pos fromTile toTile when (clearChanged || litChanged) $ invalidateLucidLid lid when clearChanged $ invalidatePerLid lid _ -> return () invalidateArenas :: MonadServer m => m () invalidateArenas = modifyServer $ \ser -> ser {svalidArenas = False} updateSclear :: MonadServer m => LevelId -> Point -> ContentId TileKind -> ContentId TileKind -> m Bool updateSclear lid pos fromTile toTile = do COps{coTileSpeedup} <- getsState scops let fromClear = Tile.isClear coTileSpeedup fromTile toClear = Tile.isClear coTileSpeedup toTile if fromClear == toClear then return False else do let f FovClear{fovClear} = FovClear $ fovClear PointArray.// [(pos, toClear)] modifyServer $ \ser -> ser {sfovClearLid = EM.adjust f lid $ sfovClearLid ser} return True updateSlit :: MonadServer m => LevelId -> Point -> ContentId TileKind -> ContentId TileKind -> m Bool updateSlit lid pos fromTile toTile = do COps{coTileSpeedup} <- getsState scops let fromLit = Tile.isLit coTileSpeedup fromTile toLit = Tile.isLit coTileSpeedup toTile if fromLit == toLit then return False else do let f (FovLit set) = FovLit $ if toLit then ES.insert pos set else ES.delete pos set modifyServer $ \ser -> ser {sfovLitLid = EM.adjust f lid $ sfovLitLid ser} return True invalidateLucidLid :: MonadServer m => LevelId -> m () invalidateLucidLid lid = modifyServer $ \ser -> ser { sfovLucidLid = EM.insert lid FovInvalid $ sfovLucidLid ser , sperValidFid = EM.map (EM.insert lid False) $ sperValidFid ser } invalidateLucidAid :: MonadServer m => ActorId -> m () invalidateLucidAid aid = do lid <- getsState $ blid . getActorBody aid invalidateLucidLid lid actorHasShine :: ActorMaxSkills -> ActorId -> Bool actorHasShine actorMaxSkills aid = case EM.lookup aid actorMaxSkills of Just actorMaxSk -> Ability.getSk Ability.SkShine actorMaxSk > 0 Nothing -> error $ "" `showFailure` aid itemAffectsShineRadius :: DiscoveryAspect -> ItemId -> [CStore] -> Bool itemAffectsShineRadius discoAspect iid stores = (null stores || not (null $ intersect stores [CEqp, COrgan, CGround])) && case EM.lookup iid discoAspect of Just arItem -> IA.getSkill Ability.SkShine arItem /= 0 Nothing -> error $ "" `showFailure` iid itemAffectsPerRadius :: DiscoveryAspect -> ItemId -> Bool itemAffectsPerRadius discoAspect iid = case EM.lookup iid discoAspect of Just arItem -> IA.getSkill Ability.SkSight arItem /= 0 || IA.getSkill Ability.SkSmell arItem /= 0 || IA.getSkill Ability.SkNocto arItem /= 0 Nothing -> error $ "" `showFailure` iid addPerActor :: MonadServer m => ActorId -> Actor -> m () addPerActor aid b = do actorMaxSk <- getsState $ getActorMaxSkills aid unless (Ability.getSk Ability.SkSight actorMaxSk <= 0 && Ability.getSk Ability.SkNocto actorMaxSk <= 0 && Ability.getSk Ability.SkSmell actorMaxSk <= 0) $ addPerActorAny aid b addPerActorAny :: MonadServer m => ActorId -> Actor -> m () addPerActorAny aid b = do let fid = bfid b lid = blid b f PerceptionCache{perActor} = PerceptionCache { ptotal = FovInvalid , perActor = EM.insert aid FovInvalid perActor } modifyServer $ \ser -> ser { sperCacheFid = EM.adjust (EM.adjust f lid) fid $ sperCacheFid ser , sperValidFid = EM.adjust (EM.insert lid False) fid $ sperValidFid ser } deletePerActor :: MonadServer m => ActorMaxSkills -> ActorId -> Actor -> m () deletePerActor actorMaxSkillsOld aid b = do let actorMaxSk = actorMaxSkillsOld EM.! aid unless (Ability.getSk Ability.SkSight actorMaxSk <= 0 && Ability.getSk Ability.SkNocto actorMaxSk <= 0 && Ability.getSk Ability.SkSmell actorMaxSk <= 0) $ deletePerActorAny aid b deletePerActorAny :: MonadServer m => ActorId -> Actor -> m () deletePerActorAny aid b = do let fid = bfid b lid = blid b f PerceptionCache{perActor} = PerceptionCache { ptotal = FovInvalid , perActor = EM.delete aid perActor } modifyServer $ \ser -> ser { sperCacheFid = EM.adjust (EM.adjust f lid) fid $ sperCacheFid ser , sperValidFid = EM.adjust (EM.insert lid False) fid $ sperValidFid ser } invalidatePerActor :: MonadServer m => ActorId -> m () invalidatePerActor aid = do actorMaxSk <- getsState $ getActorMaxSkills aid unless (Ability.getSk Ability.SkSight actorMaxSk <= 0 && Ability.getSk Ability.SkNocto actorMaxSk <= 0 && Ability.getSk Ability.SkSmell actorMaxSk <= 0) $ do b <- getsState $ getActorBody aid addPerActorAny aid b reconsiderPerActor :: MonadServer m => ActorId -> m () reconsiderPerActor aid = do b <- getsState $ getActorBody aid actorMaxSk <- getsState $ getActorMaxSkills aid if Ability.getSk Ability.SkSight actorMaxSk <= 0 && Ability.getSk Ability.SkNocto actorMaxSk <= 0 && Ability.getSk Ability.SkSmell actorMaxSk <= 0 then do perCacheFid <- getsServer sperCacheFid when (EM.member aid $ perActor ((perCacheFid EM.! bfid b) EM.! blid b)) $ deletePerActorAny aid b else addPerActorAny aid b invalidatePerLid :: MonadServer m => LevelId -> m () invalidatePerLid lid = do let f pc@PerceptionCache{perActor} | EM.null perActor = pc | otherwise = PerceptionCache { ptotal = FovInvalid , perActor = EM.map (const FovInvalid) perActor } modifyServer $ \ser -> let perCacheFidNew = EM.map (EM.adjust f lid) $ sperCacheFid ser g fid valid | ptotal ((perCacheFidNew EM.! fid) EM.! lid) == FovInvalid = EM.insert lid False valid g _ valid = valid in ser { sperCacheFid = perCacheFidNew , sperValidFid = EM.mapWithKey g $ sperValidFid ser } LambdaHack-0.9.5.0/engine-src/Game/LambdaHack/Server/HandleEffectM.hs0000644000000000000000000025547707346545000023150 0ustar0000000000000000{-# LANGUAGE TupleSections #-} -- | Handle effects. They are most often caused by requests sent by clients -- but sometimes also caused by projectiles or periodically activated items. module Game.LambdaHack.Server.HandleEffectM ( applyItem, kineticEffectAndDestroy, effectAndDestroyAndAddKill , itemEffectEmbedded, highestImpression, dominateFidSfx , dropAllItems, pickDroppable #ifdef EXPOSE_INTERNAL -- * Internal operations , UseResult(..) , applyKineticDamage, refillHP, cutCalm, effectAndDestroy, imperishableKit , itemEffectDisco, effectSem , effectBurn, effectExplode, effectRefillHP, effectRefillCalm, effectDominate , dominateFid, effectImpress, effectPutToSleep, effectYell, effectSummon , effectAscend, findStairExit, switchLevels1, switchLevels2, effectEscape , effectParalyze, paralyze, effectParalyzeInWater, effectInsertMove , effectTeleport, effectCreateItem, effectDropItem, dropCStoreItem , effectPolyItem, effectRerollItem, effectDupItem, effectIdentify , identifyIid, effectDetect, effectDetectX, effectSendFlying , sendFlyingVector, effectDropBestWeapon, effectActivateInv , effectTransformContainer, effectApplyPerfume, effectOneOf , effectVerbNoLonger, effectVerbMsg, effectComposite #endif ) where import Prelude () import Game.LambdaHack.Core.Prelude import Data.Bits (xor) import qualified Data.EnumMap.Strict as EM import qualified Data.EnumSet as ES import qualified Data.HashMap.Strict as HM import Data.Int (Int64) import Data.Key (mapWithKeyM_) import qualified Data.Ord as Ord import qualified Data.Text as T import Game.LambdaHack.Atomic import Game.LambdaHack.Common.Actor import Game.LambdaHack.Common.ActorState import Game.LambdaHack.Common.Analytics import Game.LambdaHack.Common.Faction import Game.LambdaHack.Common.Item import qualified Game.LambdaHack.Common.ItemAspect as IA import Game.LambdaHack.Common.Kind import Game.LambdaHack.Common.Level import Game.LambdaHack.Common.Misc import Game.LambdaHack.Common.MonadStateRead import Game.LambdaHack.Common.Perception import Game.LambdaHack.Common.Point import Game.LambdaHack.Common.ReqFailure import Game.LambdaHack.Common.State import qualified Game.LambdaHack.Common.Tile as Tile import Game.LambdaHack.Common.Time import Game.LambdaHack.Common.Types import Game.LambdaHack.Common.Vector import Game.LambdaHack.Content.ItemKind (ItemKind) import qualified Game.LambdaHack.Content.ItemKind as IK import Game.LambdaHack.Content.ModeKind import Game.LambdaHack.Content.RuleKind import qualified Game.LambdaHack.Core.Dice as Dice import Game.LambdaHack.Core.Random import qualified Game.LambdaHack.Definition.Ability as Ability import Game.LambdaHack.Definition.Defs import Game.LambdaHack.Server.CommonM import Game.LambdaHack.Server.ItemM import Game.LambdaHack.Server.ItemRev import Game.LambdaHack.Server.MonadServer import Game.LambdaHack.Server.PeriodicM import Game.LambdaHack.Server.ServerOptions import Game.LambdaHack.Server.State -- * Semantics of effects data UseResult = UseDud | UseId | UseUp deriving (Eq, Ord) applyItem :: MonadServerAtomic m => ActorId -> ItemId -> CStore -> m () applyItem aid iid cstore = do execSfxAtomic $ SfxApply aid iid cstore let c = CActor aid cstore -- Treated as if the actor hit himself with the item as a weapon, -- incurring both the kinetic damage and effect, hence the same call -- as in @reqMelee@. kineticEffectAndDestroy True aid aid aid iid c True applyKineticDamage :: MonadServerAtomic m => ActorId -> ActorId -> ItemId -> m Bool applyKineticDamage source target iid = do itemKind <- getsState $ getIidKindServer iid if IK.idamage itemKind == 0 then return False else do -- speedup sb <- getsState $ getActorBody source hurtMult <- getsState $ armorHurtBonus source target totalDepth <- getsState stotalDepth Level{ldepth} <- getLevel (blid sb) dmg <- rndToAction $ castDice ldepth totalDepth $ IK.idamage itemKind let rawDeltaHP = fromIntegral hurtMult * xM dmg `divUp` 100 speedDeltaHP = case btrajectory sb of Just (_, speed) | bproj sb -> - modifyDamageBySpeed rawDeltaHP speed _ -> - rawDeltaHP if speedDeltaHP < 0 then do -- damage the target, never heal refillHP source target speedDeltaHP return True else return False refillHP :: MonadServerAtomic m => ActorId -> ActorId -> Int64 -> m () refillHP source target speedDeltaHP = assert (speedDeltaHP /= 0) $ do tbOld <- getsState $ getActorBody target actorMaxSk <- getsState $ getActorMaxSkills target -- We don't ignore even tiny HP drains, because they can be very weak -- enemy projectiles and so will recur and in total can be deadly -- and also AI should rather be stupidly aggressive than stupidly lethargic. let serious = source /= target && not (bproj tbOld) hpMax = Ability.getSk Ability.SkMaxHP actorMaxSk deltaHP0 | serious && speedDeltaHP < minusM = -- If overfull, at least cut back to max, unless minor drain. min speedDeltaHP (xM hpMax - bhp tbOld) | otherwise = speedDeltaHP deltaHP = if | deltaHP0 > 0 && bhp tbOld > xM 999 -> -- UI limit tenthM -- avoid nop, to avoid loops | deltaHP0 < 0 && bhp tbOld < - xM 999 -> -tenthM | otherwise -> deltaHP0 execUpdAtomic $ UpdRefillHP target deltaHP when serious $ cutCalm target tb <- getsState $ getActorBody target fact <- getsState $ (EM.! bfid tb) . sfactionD unless (bproj tb || fleaderMode (gplayer fact) == LeaderNull) $ -- If leader just lost all HP, change the leader early (not when destroying -- the actor), to let players rescue him, especially if he's slowed -- by the attackers. when (bhp tb <= 0 && bhp tbOld > 0) $ do -- If all other party members dying, leadership will switch -- to one of them, which seems questionable, but it's rare -- and the disruption servers to underline the dire circumstance. electLeader (bfid tb) (blid tb) target mleader <- getsState $ gleader . (EM.! bfid tb) . sfactionD -- If really nobody else in the party, make him the leader back again -- on the oft chance that he gets revived by a projectile, etc. when (isNothing mleader) $ execUpdAtomic $ UpdLeadFaction (bfid tb) Nothing $ Just target cutCalm :: MonadServerAtomic m => ActorId -> m () cutCalm target = do tb <- getsState $ getActorBody target actorMaxSk <- getsState $ getActorMaxSkills target let upperBound = if hpTooLow tb actorMaxSk then 2 -- to trigger domination on next attack, etc. else xM $ Ability.getSk Ability.SkMaxCalm actorMaxSk deltaCalm = min minusM2 (upperBound - bcalm tb) -- HP loss decreases Calm by at least @minusM2@ to avoid "hears something", -- which is emitted when decreasing Calm by @minusM1@. updateCalm target deltaCalm -- Here kinetic damage is applied. This is necessary so that the same -- AI benefit calculation may be used for flinging and for applying items. kineticEffectAndDestroy :: MonadServerAtomic m => Bool -> ActorId -> ActorId -> ActorId -> ItemId -> Container -> Bool -> m () kineticEffectAndDestroy voluntary killer source target iid c mayDestroy = do bag <- getsState $ getContainerBag c case iid `EM.lookup` bag of Nothing -> error $ "" `showFailure` (source, target, iid, c) Just kit -> do itemFull <- getsState $ itemToFull iid tbOld <- getsState $ getActorBody target localTime <- getsState $ getLocalTime (blid tbOld) let recharged = hasCharge localTime itemFull kit -- If neither kinetic hit nor any effect is activated, there's no chance -- the items can be destroyed or even timeout changes, so we abort early. when recharged $ do kineticPerformed <- applyKineticDamage source target iid tb <- getsState $ getActorBody target -- Sometimes victim heals just after we registered it as killed, -- but that's OK, an actor killed two times is similar enough -- to two killed. when (kineticPerformed -- speedup && bhp tb <= 0 && bhp tbOld > 0) $ do sb <- getsState $ getActorBody source arWeapon <- getsState $ (EM.! iid) . sdiscoAspect let killHow | not (bproj sb) = if voluntary then KillKineticMelee else KillKineticPush | IA.checkFlag Ability.Blast arWeapon = KillKineticBlast | otherwise = KillKineticRanged addKillToAnalytics killer killHow (bfid tbOld) (btrunk tbOld) effectAndDestroyAndAddKill voluntary killer False (fst kit <= 1) kineticPerformed source target iid c False itemFull mayDestroy effectAndDestroyAndAddKill :: MonadServerAtomic m => Bool -> ActorId -> Bool -> Bool -> Bool -> ActorId -> ActorId -> ItemId -> Container -> Bool -> ItemFull -> Bool -> m () effectAndDestroyAndAddKill voluntary killer onSmashOnly useAllCopies kineticPerformed source target iid container periodic itemFull mayDestroy = do tbOld <- getsState $ getActorBody target effectAndDestroy onSmashOnly useAllCopies kineticPerformed source target iid container periodic itemFull mayDestroy tb <- getsState $ getActorBody target -- Sometimes victim heals just after we registered it as killed, -- but that's OK, an actor killed two times is similar enough to two killed. when (bhp tb <= 0 && bhp tbOld > 0) $ do sb <- getsState $ getActorBody source arWeapon <- getsState $ (EM.! iid) . sdiscoAspect let killHow | not (bproj sb) = if voluntary then KillOtherMelee else KillOtherPush | IA.checkFlag Ability.Blast arWeapon = KillOtherBlast | otherwise = KillOtherRanged addKillToAnalytics killer killHow (bfid tbOld) (btrunk tbOld) effectAndDestroy :: MonadServerAtomic m => Bool -> Bool -> Bool -> ActorId -> ActorId -> ItemId -> Container -> Bool -> ItemFull -> Bool -> m () effectAndDestroy onSmashOnly useAllCopies kineticPerformed source target iid container periodic itemFull@ItemFull{itemBase, itemDisco, itemKindId, itemKind} mayDestroy = do bag <- getsState $ getContainerBag container let (itemK, itemTimer) = bag EM.! iid effs = if onSmashOnly then IK.strengthOnSmash itemKind else IK.ieffects itemKind arItem = case itemDisco of ItemDiscoFull itemAspect -> itemAspect _ -> error "effectAndDestroy: server ignorant about an item" timeout = IA.aTimeout arItem lid <- getsState $ lidFromC container localTime <- getsState $ getLocalTime lid let it1 = let timeoutTurns = timeDeltaScale (Delta timeTurn) timeout charging startT = timeShift startT timeoutTurns > localTime in filter charging itemTimer len = length it1 recharged = len < itemK || onSmashOnly -- If the item has no charges and the effects are not @OnSmash@ -- we speed up by shortcutting early, because we don't need to activate -- effects and we know kinetic hit was not performed (no charges to do so -- and in case of @OnSmash@, only effects are triggered). when recharged $ do let it2 = if timeout /= 0 && recharged then if periodic && IA.checkFlag Ability.Fragile arItem then replicate (itemK - length it1) localTime ++ it1 -- copies are spares only; one fires, all discharge else localTime : it1 -- copies all fire, turn by turn; one discharges else itemTimer kit2 = (1, take 1 it2) !_A = assert (len <= itemK `blame` (source, target, iid, container)) () -- We use up the charge even if eventualy every effect fizzles. Tough luck. -- At least we don't destroy the item in such case. -- Also, we ID it regardless. unless (itemTimer == it2) $ execUpdAtomic $ UpdTimeItem iid container itemTimer it2 -- We have to destroy the item before the effect affects the item -- or affects the actor holding it or standing on it (later on we could -- lose track of the item and wouldn't be able to destroy it) . -- This is OK, because we don't remove the item type from various -- item dictionaries, just an individual copy from the container, -- so, e.g., the item can be identified after it's removed. let imperishable = not mayDestroy || imperishableKit periodic itemFull unless imperishable $ execUpdAtomic $ UpdLoseItem False iid itemBase kit2 container -- At this point, the item is potentially no longer in container -- @container@, therefore beware of assuming so in the code below. -- If the item activation is not periodic, but the item itself is, -- only the first effect gets activated (and the item may be destroyed, -- unlike with periodic activations). let effsManual = if not periodic && IA.checkFlag Ability.Periodic arItem && not (IA.checkFlag Ability.Condition arItem) then take 1 effs -- may be empty else effs triggeredEffect <- itemEffectDisco useAllCopies kineticPerformed source target iid itemKindId itemKind container periodic effsManual let triggered = if kineticPerformed then UseUp else triggeredEffect sb <- getsState $ getActorBody source -- Announce no effect, which is rare and wastes time, so noteworthy. unless (triggered == UseUp -- effects triggered; feedback comes from them || periodic -- don't spam via fizzled periodic effects || bproj sb -- don't spam, projectiles can be very numerous ) $ execSfxAtomic $ SfxMsgFid (bfid sb) $ if any IK.forApplyEffect effsManual then SfxFizzles -- something didn't work, despite promising effects else SfxNothingHappens -- fully expected -- If none of item's effects nor a kinetic hit were performed, -- we recreate the item (assuming we deleted the item above). -- Regardless, we don't rewind the time, because some info is gained -- (that the item does not exhibit any effects in the given context). unless (imperishable || triggered == UseUp) $ execUpdAtomic $ UpdSpotItem False iid itemBase kit2 container imperishableKit :: Bool -> ItemFull -> Bool imperishableKit periodic itemFull = let arItem = aspectRecordFull itemFull in IA.checkFlag Ability.Durable arItem || periodic && not (IA.checkFlag Ability.Fragile arItem) -- The item is triggered exactly once. If there are more copies, -- they are left to be triggered next time. itemEffectEmbedded :: MonadServerAtomic m => Bool -> ActorId -> LevelId -> Point -> ItemId -> m () itemEffectEmbedded voluntary aid lid tpos iid = do -- First embedded item may move actor to another level, so @lid@ -- may be unequal to @blid sb@. let c = CEmbed lid tpos -- Treated as if the actor hit himself with the embedded item as a weapon, -- incurring both the kinetic damage and effect, hence the same call -- as in @reqMelee@. Information whether this happened due to being pushed -- is preserved, but how did the pushing is lost, so we blame the victim. kineticEffectAndDestroy voluntary aid aid aid iid c True -- | The source actor affects the target actor, with a given item. -- If any of the effects fires up, the item gets identified. -- Even using raw damage (beating the enemy with the magic wand, -- for example) identifies the item. This means a costly @UpdDiscover@ -- is processed for each random timeout weapon hit and for most projectiles, -- but at least not for most explosion particles nor plain organs. -- And if not needed, the @UpdDiscover@ are eventually not sent to clients. -- So, enemy missiles that hit us are no longer mysterious until picked up, -- which is for the better, because the client knows their charging status -- and so can generate accurate messages in the case when not recharged. -- This also means that thrown consumables in flasks sturdy enough to cause -- damage are always identified at hit, even if no effect activated. -- So throwing them at foes is a better identification method than applying. -- -- Note that if we activate a durable non-passive item, e.g., a spiked shield, -- from the ground, it will get identified, which is perfectly fine, -- until we want to add sticky armor that can't be easily taken off -- (and, e.g., has some maluses). itemEffectDisco :: MonadServerAtomic m => Bool -> Bool-> ActorId -> ActorId -> ItemId -> ContentId ItemKind -> ItemKind -> Container -> Bool -> [IK.Effect] -> m UseResult itemEffectDisco useAllCopies kineticPerformed source target iid itemKindId itemKind c periodic effs = do urs <- mapM (effectSem useAllCopies source target iid c periodic) effs let ur = case urs of [] -> UseDud -- there was no effects _ -> maximum urs -- Note: @UseId@ suffices for identification, @UseUp@ is not necessary. when (ur >= UseId || kineticPerformed) $ identifyIid iid c itemKindId itemKind return ur -- | Source actor affects target actor, with a given effect and it strength. -- Both actors are on the current level and can be the same actor. -- The item may or may not still be in the container. effectSem :: MonadServerAtomic m => Bool -> ActorId -> ActorId -> ItemId -> Container -> Bool -> IK.Effect -> m UseResult effectSem useAllCopies source target iid c periodic effect = do let recursiveCall = effectSem useAllCopies source target iid c periodic sb <- getsState $ getActorBody source pos <- getsState $ posFromC c -- @execSfx@ usually comes last in effect semantics, but not always -- and we are likely to introduce more variety. let execSfx = execSfxAtomic $ SfxEffect (bfid sb) target effect 0 execSfxSource = execSfxAtomic $ SfxEffect (bfid sb) source effect 0 case effect of IK.Burn nDm -> effectBurn nDm source target IK.Explode t -> effectExplode execSfx t source target IK.RefillHP p -> effectRefillHP p source target IK.RefillCalm p -> effectRefillCalm execSfx p source target IK.Dominate -> effectDominate source target IK.Impress -> effectImpress recursiveCall execSfx source target IK.PutToSleep -> effectPutToSleep execSfx target IK.Yell -> effectYell execSfx target IK.Summon grp nDm -> effectSummon grp nDm iid source target periodic IK.Ascend p -> effectAscend recursiveCall execSfx p source target pos IK.Escape{} -> effectEscape execSfx source target IK.Paralyze nDm -> effectParalyze execSfx nDm source target IK.ParalyzeInWater nDm -> effectParalyzeInWater execSfx nDm source target IK.InsertMove nDm -> effectInsertMove execSfx nDm source target IK.Teleport nDm -> effectTeleport execSfx nDm source target IK.CreateItem store grp tim -> effectCreateItem (Just $ bfid sb) Nothing source target store grp tim IK.DropItem n k store grp -> effectDropItem execSfx iid n k store grp target IK.PolyItem -> effectPolyItem execSfx iid target IK.RerollItem -> effectRerollItem execSfx iid target IK.DupItem -> effectDupItem execSfx iid target IK.Identify -> effectIdentify execSfx iid target IK.Detect d radius -> effectDetect execSfx d radius target pos IK.SendFlying tmod -> effectSendFlying execSfx tmod source target c Nothing IK.PushActor tmod -> effectSendFlying execSfx tmod source target c (Just True) IK.PullActor tmod -> effectSendFlying execSfx tmod source target c (Just False) IK.DropBestWeapon -> effectDropBestWeapon execSfx iid target IK.ActivateInv symbol -> effectActivateInv execSfx iid source target symbol IK.ApplyPerfume -> effectApplyPerfume execSfx target IK.OneOf l -> effectOneOf recursiveCall l IK.OnSmash _ -> return UseDud -- ignored under normal circumstances IK.VerbNoLonger _ -> effectVerbNoLonger useAllCopies execSfxSource source IK.VerbMsg _ -> effectVerbMsg execSfxSource source IK.Composite l -> effectComposite recursiveCall l -- * Individual semantic functions for effects -- ** Burn -- Damage from fire. Not affected by armor. effectBurn :: MonadServerAtomic m => Dice.Dice -> ActorId -> ActorId -> m UseResult effectBurn nDm source target = do tb <- getsState $ getActorBody target totalDepth <- getsState stotalDepth Level{ldepth} <- getLevel (blid tb) n0 <- rndToAction $ castDice ldepth totalDepth nDm let n = max 1 n0 -- avoid 0 and negative burn deltaHP = - xM n sb <- getsState $ getActorBody source -- Display the effect more accurately. let reportedEffect = IK.Burn $ Dice.intToDice n execSfxAtomic $ SfxEffect (bfid sb) target reportedEffect deltaHP refillHP source target deltaHP return UseUp -- ** Explode effectExplode :: MonadServerAtomic m => m () -> GroupName ItemKind -> ActorId -> ActorId -> m UseResult effectExplode execSfx cgroup source target = do execSfx tb <- getsState $ getActorBody target let itemFreq = [(cgroup, 1)] -- Explosion particles are placed among organs of the victim: container = CActor target COrgan m2 <- rollAndRegisterItem (blid tb) itemFreq container False Nothing let (iid, (ItemFull{itemBase, itemKind}, (itemK, _))) = fromMaybe (error $ "" `showFailure` cgroup) m2 Point x y = bpos tb semirandom = T.length (IK.idesc itemKind) projectN k100 n = do -- We pick a point at the border, not inside, to have a uniform -- distribution for the points the line goes through at each distance -- from the source. Otherwise, e.g., the points on cardinal -- and diagonal lines from the source would be more common. let veryrandom = (k100 `xor` (semirandom + n)) `mod` 5 fuzz = 5 + veryrandom k | n < 16 && n >= 12 = 12 | n < 12 && n >= 8 = 8 | n < 8 && n >= 4 = 4 | otherwise = min n 16 -- fire in groups of 16 including old duds psDir4 = [ Point (x - 12) (y + 12) , Point (x + 12) (y + 12) , Point (x - 12) (y - 12) , Point (x + 12) (y - 12) ] psDir8 = [ Point (x - 12) y , Point (x + 12) y , Point x (y + 12) , Point x (y - 12) ] psFuzz = [ Point (x - 12) $ y + fuzz , Point (x + 12) $ y + fuzz , Point (x - 12) $ y - fuzz , Point (x + 12) $ y - fuzz , flip Point (y - 12) $ x + fuzz , flip Point (y + 12) $ x + fuzz , flip Point (y - 12) $ x - fuzz , flip Point (y + 12) $ x - fuzz ] randomReverse = if veryrandom `mod` 2 == 0 then id else reverse ps = take k $ concat $ randomReverse [ zip (repeat True) -- diagonal particles don't reach that far $ take 4 (drop ((k100 + itemK + fuzz) `mod` 4) $ cycle psDir4) , zip (repeat False) -- only some cardinal reach far $ take 4 (drop ((k100 + n) `mod` 4) $ cycle psDir8) ] ++ [zip (repeat True) $ take 8 (drop ((k100 + fuzz) `mod` 8) $ cycle psFuzz)] forM_ ps $ \(centerRaw, tpxy) -> do let center = centerRaw && itemK >= 8 -- if few, keep them regular mfail <- projectFail source target tpxy veryrandom center iid COrgan True case mfail of Nothing -> return () Just ProjectBlockTerrain -> return () Just ProjectBlockActor | not $ bproj tb -> return () Just failMsg -> execSfxAtomic $ SfxMsgFid (bfid tb) $ SfxUnexpected failMsg tryFlying 0 = return () tryFlying k100 = do -- Explosion particles were placed among organs of the victim: bag2 <- getsState $ borgan . getActorBody target -- We stop bouncing old particles when less than half remains, -- to prevent hoarding explosives to use only in cramped spaces. case EM.lookup iid bag2 of Just (n2, _) | n2 >= itemK `div` 2 -> do projectN k100 n2 tryFlying $ k100 - 1 _ -> return () -- Some of the particles that fail to take off, bounce off obstacles -- up to 100 times in total, trying to fly in different directions. tryFlying 100 bag3 <- getsState $ borgan . getActorBody target let mn3 = EM.lookup iid bag3 -- Give up and destroy the remaining particles, if any. maybe (return ()) (\kit -> execUpdAtomic $ UpdLoseItem False iid itemBase kit container) mn3 return UseUp -- we neglect verifying that at least one projectile got off -- ** RefillHP -- Unaffected by armor. effectRefillHP :: MonadServerAtomic m => Int -> ActorId -> ActorId -> m UseResult effectRefillHP power0 source target = do sb <- getsState $ getActorBody source tb <- getsState $ getActorBody target curChalSer <- getsServer $ scurChalSer . soptions fact <- getsState $ (EM.! bfid tb) . sfactionD let power = if power0 <= -1 then power0 else max 1 power0 -- avoid 0 deltaHP = xM power if | cfish curChalSer && deltaHP > 0 && fhasUI (gplayer fact) && bfid sb /= bfid tb -> do execSfxAtomic $ SfxMsgFid (bfid tb) SfxColdFish return UseId | otherwise -> do let reportedEffect = IK.RefillHP power execSfxAtomic $ SfxEffect (bfid sb) target reportedEffect deltaHP refillHP source target deltaHP return UseUp -- ** RefillCalm effectRefillCalm :: MonadServerAtomic m => m () -> Int -> ActorId -> ActorId -> m UseResult effectRefillCalm execSfx power0 source target = do tb <- getsState $ getActorBody target actorMaxSk <- getsState $ getActorMaxSkills target let power = if power0 <= -1 then power0 else max 1 power0 -- avoid 0 rawDeltaCalm = xM power calmMax = Ability.getSk Ability.SkMaxCalm actorMaxSk serious = rawDeltaCalm <= minusM2 && source /= target && not (bproj tb) deltaCalm0 | serious = -- if overfull, at least cut back to max min rawDeltaCalm (xM calmMax - bcalm tb) | otherwise = rawDeltaCalm deltaCalm = if | deltaCalm0 > 0 && bcalm tb > xM 999 -> -- UI limit tenthM -- avoid nop, to avoid loops | deltaCalm0 < 0 && bcalm tb < - xM 999 -> -tenthM | otherwise -> deltaCalm0 execSfx updateCalm target deltaCalm return UseUp -- ** Dominate -- The is another way to trigger domination (the normal way is by zeroed Calm). -- Calm is here irrelevant. The other conditions are the same. effectDominate :: MonadServerAtomic m => ActorId -> ActorId -> m UseResult effectDominate source target = do sb <- getsState $ getActorBody source tb <- getsState $ getActorBody target if | bproj tb -> return UseDud | bfid tb == bfid sb -> return UseDud -- accidental hit; ignore | otherwise -> do fact <- getsState $ (EM.! bfid tb) . sfactionD hiImpression <- highestImpression tb let permitted = case hiImpression of Nothing -> False -- no impression, no domination Just (hiImpressionFid, hiImpressionK) -> hiImpressionFid == bfid sb -- highest impression needs to be by us && (fleaderMode (gplayer fact) /= LeaderNull || hiImpressionK >= 10) -- to tame/hack animal/robot, impress them a lot first if permitted then do b <- dominateFidSfx source target (bfid sb) return $! if b then UseUp else UseDud else do execSfxAtomic $ SfxMsgFid (bfid sb) $ SfxUnimpressed target when (source /= target) $ execSfxAtomic $ SfxMsgFid (bfid tb) $ SfxUnimpressed target return UseDud highestImpression :: MonadServerAtomic m => Actor -> m (Maybe (FactionId, Int)) highestImpression tb = do getKind <- getsState $ flip getIidKindServer getItem <- getsState $ flip getItemBody let isImpression iid = maybe False (> 0) $ lookup "impressed" $ IK.ifreq $ getKind iid impressions = EM.filterWithKey (\iid _ -> isImpression iid) $ borgan tb f (_, (k, _)) = k maxImpression = maximumBy (Ord.comparing f) $ EM.assocs impressions if EM.null impressions then return Nothing else case jfid $ getItem $ fst maxImpression of Nothing -> return Nothing Just fid -> assert (fid /= bfid tb) $ return $ Just (fid, fst $ snd maxImpression) dominateFidSfx :: MonadServerAtomic m => ActorId -> ActorId -> FactionId -> m Bool dominateFidSfx source target fid = do tb <- getsState $ getActorBody target let !_A = assert (not $ bproj tb) () -- Actors that don't move freely can't be dominated, for otherwise, -- when they are the last survivors, they could get stuck and the game -- wouldn't end. Also, they are a hassle to guide through the dungeon. canTra <- getsState $ canTraverse target -- Being pushed protects from domination, for simplicity. -- A possible interesting exploit, but much help from content would be needed -- to make it practical. if isNothing (btrajectory tb) && canTra && bhp tb > 0 then do let execSfx = execSfxAtomic $ SfxEffect fid target IK.Dominate 0 execSfx -- if actor ours, possibly the last occasion to see him dominateFid fid source target -- If domination resulted in game over, the message won't be seen -- before the end game screens, but at least it will be seen afterwards -- and browsable in history while inside subsequent game, revealing -- the cause of the previous game over. Better than no message at all. execSfx -- see the actor as theirs, unless position not visible return True else return False dominateFid :: MonadServerAtomic m => FactionId -> ActorId -> ActorId -> m () dominateFid fid source target = do tb0 <- getsState $ getActorBody target -- Game over deduced very early, so no further animation nor message -- will appear before game end screens. This is good in that our last actor -- that yielded will still be on screen when end game messages roll. -- This is bad in that last enemy actor that got dominated by us -- may not be on screen and we have no clue how we won until -- we see history in the next game. Even worse if our ally dominated -- the enemy actor. Then we may never learn. Oh well, that's realism. deduceKilled target electLeader (bfid tb0) (blid tb0) target fact <- getsState $ (EM.! bfid tb0) . sfactionD -- Drop all items so that domiation is not too nasty, especially -- if the dominated hero runs off or teleports away with gold -- or starts hitting with the most potent artifact weapon in the game. -- Prevent the faction's stash from being lost in case they are -- not spawners. Drop items while still of the original faction -- to mark them on the map for other party members to collect. when (isNothing $ gleader fact) $ moveStores False target CSha CInv dropAllItems target tb0 tb <- getsState $ getActorBody target ais <- getsState $ getCarriedAssocsAndTrunk tb actorMaxSk <- getsState $ getActorMaxSkills target getKind <- getsState $ flip getIidKindServer let isImpression iid = maybe False (> 0) $ lookup "impressed" $ IK.ifreq $ getKind iid dropAllImpressions = EM.filterWithKey (\iid _ -> not $ isImpression iid) borganNoImpression = dropAllImpressions $ borgan tb -- Actor is not pushed nor projectile, so @sactorTime@ suffices. btime <- getsServer $ (EM.! target) . (EM.! blid tb) . (EM.! bfid tb) . sactorTime execUpdAtomic $ UpdLoseActor target tb ais let maxCalm = Ability.getSk Ability.SkMaxCalm actorMaxSk maxHp = Ability.getSk Ability.SkMaxHP actorMaxSk bNew = tb { bfid = fid , bcalm = max (xM 10) $ xM maxCalm `div` 2 , bhp = min (xM maxHp) $ bhp tb + xM 10 , borgan = borganNoImpression} aisNew <- getsState $ getCarriedAssocsAndTrunk bNew modifyServer $ \ser -> ser {sactorTime = updateActorTime fid (blid tb) target btime $ sactorTime ser} execUpdAtomic $ UpdSpotActor target bNew aisNew -- Focus on the dominated actor, by making him a leader. setFreshLeader fid target factionD <- getsState sfactionD let inGame fact2 = case gquit fact2 of Nothing -> True Just Status{stOutcome=Camping} -> True _ -> False gameOver = not $ any inGame $ EM.elems factionD -- Avoid the spam of identifying items, if game over. unless gameOver $ do -- Add some nostalgia for the old faction. void $ effectCreateItem (Just $ bfid tb) (Just 10) source target COrgan "impressed" IK.timerNone -- Identify organs that won't get identified by use. getKindId <- getsState $ flip getIidKindIdServer let discoverIf (iid, cstore) = do let itemKindId = getKindId iid c = CActor target cstore assert (cstore /= CGround) $ discoverIfMinorEffects c iid itemKindId aic = (btrunk tb, COrgan) : filter ((/= btrunk tb) . fst) (getCarriedIidCStore tb) mapM_ discoverIf aic -- | Drop all actor's items. dropAllItems :: MonadServerAtomic m => ActorId -> Actor -> m () dropAllItems aid b = do mapActorCStore_ CInv (dropCStoreItem False CInv aid b maxBound) b mapActorCStore_ CEqp (dropCStoreItem False CEqp aid b maxBound) b -- ** Impress effectImpress :: MonadServerAtomic m => (IK.Effect -> m UseResult) -> m () -> ActorId -> ActorId -> m UseResult effectImpress recursiveCall execSfx source target = do sb <- getsState $ getActorBody source tb <- getsState $ getActorBody target if | bproj tb -> return UseDud | bfid tb == bfid sb -> -- Unimpress wrt others, but only once. The recursive Sfx suffices. recursiveCall $ IK.DropItem 1 1 COrgan "impressed" | otherwise -> do -- Actors that don't move freely and so are stupid, can't be impressed. canTra <- getsState $ canTraverse target if canTra then do unless (bhp tb <= 0) execSfx -- avoid spam just before death effectCreateItem (Just $ bfid sb) (Just 1) source target COrgan "impressed" IK.timerNone else return UseDud -- no message, because common and not crucial -- ** PutToSleep effectPutToSleep :: MonadServerAtomic m => m () -> ActorId -> m UseResult effectPutToSleep execSfx target = do tb <- getsState $ getActorBody target if | bproj tb -> return UseDud | bwatch tb `elem` [WSleep, WWake] -> return UseId -- can't increase sleep | otherwise -> do actorMaxSk <- getsState $ getActorMaxSkills target let maxCalm = xM $ Ability.getSk Ability.SkMaxCalm actorMaxSk deltaCalm = maxCalm - bcalm tb when (deltaCalm > 0) $ updateCalm target deltaCalm -- max Calm, but asleep vulnerability execSfx case bwatch tb of WWait n | n > 0 -> do nAll <- removeConditionSingle "braced" target let !_A = assert (nAll == 0) () return () _ -> return () -- Forced sleep. No check if the actor can sleep naturally. addSleep target return UseUp -- ** Yell -- This is similar to 'reqYell', but also mentions that the actor is startled, -- because, presumably, he yells involuntarily. It doesn't wake him up -- via Calm instantly, just like yelling in a dream not always does. effectYell :: MonadServerAtomic m => m () -> ActorId -> m UseResult effectYell execSfx target = do tb <- getsState $ getActorBody target if bproj tb || bhp tb <= 0 then -- avoid yelling projectiles or corpses return UseDud -- the yell never manifested else do execSfx execSfxAtomic $ SfxTaunt False target when (deltaBenign $ bcalmDelta tb) $ execUpdAtomic $ UpdRefillCalm target minusM return UseUp -- ** Summon -- Note that the Calm expended doesn't depend on the number of actors summoned. effectSummon :: MonadServerAtomic m => GroupName ItemKind -> Dice.Dice -> ItemId -> ActorId -> ActorId -> Bool -> m UseResult effectSummon grp nDm iid source target periodic = do -- Obvious effect, nothing announced. cops@COps{coTileSpeedup} <- getsState scops sb <- getsState $ getActorBody source tb <- getsState $ getActorBody target sMaxSk <- getsState $ getActorMaxSkills source tMaxSk <- getsState $ getActorMaxSkills target totalDepth <- getsState stotalDepth lvl@Level{ldepth, lbig} <- getLevel (blid tb) nFriends <- getsState $ length . friendRegularAssocs (bfid sb) (blid sb) discoAspect <- getsState sdiscoAspect power0 <- rndToAction $ castDice ldepth totalDepth nDm let arItem = discoAspect EM.! iid power = max power0 1 -- KISS, always at least one summon -- We put @source@ instead of @target@ and @power@ instead of dice -- to make the message more accurate. effect = IK.Summon grp $ Dice.intToDice power durable = IA.checkFlag Ability.Durable arItem warnBothActors warning = unless (bproj sb) $ do execSfxAtomic $ SfxMsgFid (bfid sb) warning when (source /= target) $ execSfxAtomic $ SfxMsgFid (bfid tb) warning deltaCalm = - xM 30 -- Verify Calm only at periodic activations or if the item is durable. -- Otherwise summon uses up the item, which prevents summoning getting -- out of hand. I don't verify Calm otherwise, to prevent an exploit -- via draining one's calm on purpose when an item with good activation -- has a nasty summoning side-effect (the exploit still works on durables). if | (periodic || durable) && not (bproj sb) && (bcalm sb < - deltaCalm || not (calmEnough sb sMaxSk)) -> do warnBothActors $ SfxSummonLackCalm source return UseId | nFriends >= 20 -> do -- We assume the actor tries to summon his teammates or allies. -- As he repeats such summoning, he is going to bump into this limit. -- If he summons others, see the next condition. warnBothActors $ SfxSummonTooManyOwn source return UseId | EM.size lbig >= 200 -> do -- lower than the 300 limit for spawning -- Even if the actor summons foes, he is prevented from exploiting it -- too many times and stopping natural monster spawning on the level -- (e.g., by filling the level with harmless foes). warnBothActors $ SfxSummonTooManyAll source return UseId | otherwise -> do unless (bproj sb) $ updateCalm source deltaCalm let validTile t = not $ Tile.isNoActor coTileSpeedup t ps = nearbyFreePoints cops lvl validTile (bpos tb) localTime <- getsState $ getLocalTime (blid tb) -- Make sure summoned actors start acting after the victim. let actorTurn = ticksPerMeter $ gearSpeed tMaxSk targetTime = timeShift localTime actorTurn afterTime = timeShift targetTime $ Delta timeClip when (length (take power ps) < power) $ debugPossiblyPrint "Server: effectSummon: failed to find enough free positions" bs <- forM (take power ps) $ \p -> do -- Mark as summoned to prevent immediate chain summoning. -- Summon from current depth, not deeper due to many spawns already. maid <- addAnyActor True 0 [(grp, 1)] (blid tb) afterTime (Just p) case maid of Nothing -> return False -- suspect content; server debug elsewhere Just aid -> do b <- getsState $ getActorBody aid mleader <- getsState $ gleader . (EM.! bfid b) . sfactionD when (isNothing mleader) $ setFreshLeader (bfid b) aid return True if or bs then do execSfxAtomic $ SfxEffect (bfid sb) source effect 0 return UseUp else do -- We don't display detailed warnings when @addAnyActor@ fails, -- e.g., because the actor groups can't be generated on a given level. -- However, we at least don't claim any summoning happened -- and we offer a general summoning failure messages. warnBothActors $ SfxSummonFailure source return UseId -- ** Ascend -- Note that projectiles can be teleported, too, for extra fun. effectAscend :: MonadServerAtomic m => (IK.Effect -> m UseResult) -> m () -> Bool -> ActorId -> ActorId -> Point -> m UseResult effectAscend recursiveCall execSfx up source target pos = do b1 <- getsState $ getActorBody target let lid1 = blid b1 destinations <- getsState $ whereTo lid1 pos up . sdungeon sb <- getsState $ getActorBody source if | actorWaits b1 && source /= target -> do execSfxAtomic $ SfxMsgFid (bfid sb) $ SfxBracedImmune target when (source /= target) $ execSfxAtomic $ SfxMsgFid (bfid b1) $ SfxBracedImmune target return UseId | null destinations -> do execSfxAtomic $ SfxMsgFid (bfid sb) SfxLevelNoMore when (source /= target) $ execSfxAtomic $ SfxMsgFid (bfid b1) SfxLevelNoMore -- We keep it useful even in shallow dungeons. recursiveCall $ IK.Teleport 30 -- powerful teleport | otherwise -> do (lid2, pos2) <- rndToAction $ oneOf destinations execSfx mbtime_bOld <- getsServer $ lookupActorTime (bfid b1) lid1 target . sactorTime mbtimeTraj_bOld <- getsServer $ lookupActorTime (bfid b1) lid1 target . strajTime pos3 <- findStairExit (bfid sb) up lid2 pos2 let switch1 = void $ switchLevels1 (target, b1) switch2 = do -- Make the initiator of the stair move the leader, -- to let him clear the stairs for others to follow. let mlead = if bproj b1 then Nothing else Just target -- Move the actor to where the inhabitants were, if any. switchLevels2 lid2 pos3 (target, b1) mbtime_bOld mbtimeTraj_bOld mlead -- The actor will be added to the new level, -- but there can be other actors at his new position. inhabitants <- getsState $ posToAidAssocs pos3 lid2 case inhabitants of [] -> do switch1 switch2 (_, b2) : _ -> do -- Alert about the switch. execSfxAtomic $ SfxMsgFid (bfid sb) SfxLevelPushed -- Only tell one pushed player, even if many actors, because then -- they are projectiles, so not too important. when (source /= target) $ execSfxAtomic $ SfxMsgFid (bfid b2) SfxLevelPushed -- Move the actor out of the way. switch1 -- Move the inhabitants out of the way and to where the actor was. let moveInh inh = do -- Preserve the old leader, since the actor is pushed, -- so possibly has nothing worhwhile to do on the new level -- (and could try to switch back, if made a leader, -- leading to a loop). mbtime_inh <- getsServer $ lookupActorTime (bfid (snd inh)) lid2 (fst inh) . sactorTime mbtimeTraj_inh <- getsServer $ lookupActorTime (bfid (snd inh)) lid2 (fst inh) . strajTime inhMLead <- switchLevels1 inh switchLevels2 lid1 (bpos b1) inh mbtime_inh mbtimeTraj_inh inhMLead mapM_ moveInh inhabitants -- Move the actor to his destination. switch2 return UseUp findStairExit :: MonadStateRead m => FactionId -> Bool -> LevelId -> Point -> m Point findStairExit side moveUp lid pos = do COps{coTileSpeedup} <- getsState scops fact <- getsState $ (EM.! side) . sfactionD lvl <- getLevel lid let defLanding = uncurry Vector $ if moveUp then (1, 0) else (-1, 0) center = uncurry Vector $ if moveUp then (-1, 0) else (1, 0) (mvs2, mvs1) = break (== defLanding) moves mvs = center : filter (/= center) (mvs1 ++ mvs2) ps = filter (Tile.isWalkable coTileSpeedup . (lvl `at`)) $ map (shift pos) mvs posOcc :: State -> Int -> Point -> Bool posOcc s k p = case posToAidAssocs p lid s of [] -> k == 0 (_, b) : _ | bproj b -> k == 3 (_, b) : _ | isFoe side fact (bfid b) -> k == 1 -- non-proj foe _ -> k == 2 -- moving a non-projectile friend unocc <- getsState posOcc case concatMap (\k -> filter (unocc k) ps) [0..3] of [] -> error $ "" `showFailure` ps posRes : _ -> return posRes switchLevels1 :: MonadServerAtomic m => (ActorId, Actor) -> m (Maybe ActorId) switchLevels1 (aid, bOld) = do let side = bfid bOld mleader <- getsState $ gleader . (EM.! side) . sfactionD -- Prevent leader pointing to a non-existing actor. mlead <- if not (bproj bOld) && isJust mleader then do execUpdAtomic $ UpdLeadFaction side mleader Nothing return mleader -- outside of a client we don't know the real tgt of aid, hence fst else return Nothing -- Remove the actor from the old level. -- Onlookers see somebody disappear suddenly. -- @UpdDestroyActor@ is too loud, so use @UpdLoseActor@ instead. ais <- getsState $ getCarriedAssocsAndTrunk bOld execUpdAtomic $ UpdLoseActor aid bOld ais return mlead switchLevels2 ::MonadServerAtomic m => LevelId -> Point -> (ActorId, Actor) -> Maybe Time -> Maybe Time -> Maybe ActorId -> m () switchLevels2 lidNew posNew (aid, bOld) mbtime_bOld mbtimeTraj_bOld mlead = do let lidOld = blid bOld side = bfid bOld let !_A = assert (lidNew /= lidOld `blame` "stairs looped" `swith` lidNew) () -- Sync actor's items' timeouts with the new local time of the level. -- We need to sync organs and equipment due to periodic activations, -- but also inventory pack (as well as some organs and equipment), -- due to timeouts after use, e.g., for some weapons (they recharge also -- in the pack; however, this doesn't encourage micromanagement for periodic -- items, because the timeout is randomised upon move to equipment). -- -- We don't rebase timeouts for items in stash, because they are -- used by many actors on levels with different local times, -- so there is no single rebase that would match all. -- This is not a big problem: after a single use by an actor the timeout is -- set to his current local time, so further uses by that actor have -- not anomalously short or long recharge times. If the recharge time -- is very long, the player has an option of moving the item from stash -- to pack and back, to reset the timeout. An abuse is possible when recently -- used item is put from inventory to stash and at once used on another level -- taking advantage of local time difference, but this only works once -- and using the item back again at the original level makes the recharge -- time longer, in turn. timeOld <- getsState $ getLocalTime lidOld timeLastActive <- getsState $ getLocalTime lidNew let delta = timeLastActive `timeDeltaToFrom` timeOld shiftByDelta = (`timeShift` delta) computeNewTimeout :: ItemQuant -> ItemQuant computeNewTimeout (k, it) = (k, map shiftByDelta it) rebaseTimeout :: ItemBag -> ItemBag rebaseTimeout = EM.map computeNewTimeout bNew = bOld { blid = lidNew , bpos = posNew , boldpos = Just posNew -- new level, new direction , borgan = rebaseTimeout $ borgan bOld , beqp = rebaseTimeout $ beqp bOld , binv = rebaseTimeout $ binv bOld } ais <- getsState $ getCarriedAssocsAndTrunk bOld -- Sync the actor time with the level time. -- This time shift may cause a double move of a foe of the same speed, -- but this is OK --- the foe didn't have a chance to move -- before, because the arena went inactive, so he moves now one more time. maybe (return ()) (\btime_bOld -> modifyServer $ \ser -> ser {sactorTime = updateActorTime (bfid bNew) lidNew aid (shiftByDelta btime_bOld) $ sactorTime ser}) mbtime_bOld maybe (return ()) (\btime_bOld -> modifyServer $ \ser -> ser {strajTime = updateActorTime (bfid bNew) lidNew aid (shiftByDelta btime_bOld) $ strajTime ser}) mbtimeTraj_bOld -- Materialize the actor at the new location. -- Onlookers see somebody appear suddenly. The actor himself -- sees new surroundings and has to reset his perception. execUpdAtomic $ UpdCreateActor aid bNew ais case mlead of Nothing -> return () Just leader -> -- The leader is fresh in the sense that he's on a new level -- and so doesn't have up to date Perception. setFreshLeader side leader -- ** Escape -- | The faction leaves the dungeon. effectEscape :: MonadServerAtomic m => m () -> ActorId -> ActorId -> m UseResult effectEscape execSfx source target = do -- Obvious effect, nothing announced. sb <- getsState $ getActorBody source tb <- getsState $ getActorBody target let fid = bfid tb fact <- getsState $ (EM.! fid) . sfactionD if | bproj tb -> return UseDud -- basically a misfire | not (fcanEscape $ gplayer fact) -> do execSfxAtomic $ SfxMsgFid (bfid sb) SfxEscapeImpossible when (source /= target) $ execSfxAtomic $ SfxMsgFid (bfid tb) SfxEscapeImpossible return UseId | otherwise -> do execSfx deduceQuits (bfid tb) $ Status Escape (fromEnum $ blid tb) Nothing return UseUp -- ** Paralyze -- | Advance target actor time by this many time clips. Not by actor moves, -- to hurt fast actors more. effectParalyze :: MonadServerAtomic m => m () -> Dice.Dice -> ActorId -> ActorId -> m UseResult effectParalyze execSfx nDm source target = do tb <- getsState $ getActorBody target if bproj tb then return UseDud else -- shortcut for speed paralyze execSfx nDm source target paralyze :: MonadServerAtomic m => m () -> Dice.Dice -> ActorId -> ActorId -> m UseResult paralyze execSfx nDm source target = do tb <- getsState $ getActorBody target totalDepth <- getsState stotalDepth Level{ldepth} <- getLevel (blid tb) power0 <- rndToAction $ castDice ldepth totalDepth nDm let power = max power0 1 -- KISS, avoid special case actorStasis <- getsServer sactorStasis if | ES.member target actorStasis -> do sb <- getsState $ getActorBody source execSfxAtomic $ SfxMsgFid (bfid sb) SfxStasisProtects when (source /= target) $ execSfxAtomic $ SfxMsgFid (bfid tb) SfxStasisProtects return UseId | otherwise -> do execSfx let t = timeDeltaScale (Delta timeClip) power -- Only the normal time, not the trajectory time, is affected. modifyServer $ \ser -> ser { sactorTime = ageActor (bfid tb) (blid tb) target t $ sactorTime ser , sactorStasis = ES.insert target (sactorStasis ser) } -- actor's time warped, so he is in stasis, -- immune to further warps return UseUp -- ** ParalyzeInWater -- | Advance target actor time by this many time clips. Not by actor moves, -- to hurt fast actors more. Due to water, so resistable. effectParalyzeInWater :: MonadServerAtomic m => m () -> Dice.Dice -> ActorId -> ActorId -> m UseResult effectParalyzeInWater execSfx nDm source target = do tb <- getsState $ getActorBody target if bproj tb then return UseDud else do -- shortcut for speed actorMaxSk <- getsState $ getActorMaxSkills target let swimmingOrFlying = max (Ability.getSk Ability.SkSwimming actorMaxSk) (Ability.getSk Ability.SkFlying actorMaxSk) if Dice.supDice nDm > swimmingOrFlying then paralyze execSfx nDm source target -- no help at all else -- fully resisted -- Don't spam: -- sb <- getsState $ getActorBody source -- execSfxAtomic $ SfxMsgFid (bfid sb) SfxWaterParalysisResisted return UseId -- ** InsertMove -- | Give target actor the given number of tenths of extra move. Don't give -- an absolute amount of time units, to benefit slow actors more. effectInsertMove :: MonadServerAtomic m => m () -> Dice.Dice -> ActorId -> ActorId -> m UseResult effectInsertMove execSfx nDm source target = do tb <- getsState $ getActorBody target actorMaxSk <- getsState $ getActorMaxSkills target totalDepth <- getsState stotalDepth Level{ldepth} <- getLevel (blid tb) actorStasis <- getsServer sactorStasis power0 <- rndToAction $ castDice ldepth totalDepth nDm let power = max power0 1 -- KISS, avoid special case actorTurn = ticksPerMeter $ gearSpeed actorMaxSk t = timeDeltaScale (timeDeltaPercent actorTurn 10) (-power) if | bproj tb -> return UseDud -- shortcut for speed | ES.member target actorStasis -> do sb <- getsState $ getActorBody source execSfxAtomic $ SfxMsgFid (bfid sb) SfxStasisProtects when (source /= target) $ execSfxAtomic $ SfxMsgFid (bfid tb) SfxStasisProtects return UseId | otherwise -> do execSfx -- Only the normal time, not the trajectory time, is affected. modifyServer $ \ser -> ser { sactorTime = ageActor (bfid tb) (blid tb) target t $ sactorTime ser , sactorStasis = ES.insert target (sactorStasis ser) } -- actor's time warped, so he is in stasis, -- immune to further warps return UseUp -- ** Teleport -- | Teleport the target actor. -- Note that projectiles can be teleported, too, for extra fun. effectTeleport :: MonadServerAtomic m => m () -> Dice.Dice -> ActorId -> ActorId -> m UseResult effectTeleport execSfx nDm source target = do sb <- getsState $ getActorBody source tb <- getsState $ getActorBody target if actorWaits tb && source /= target -- immune only against not own effects, to enable teleport as beneficial -- necklace drawback; also consistent with sleep not protecting then do execSfxAtomic $ SfxMsgFid (bfid sb) $ SfxBracedImmune target when (source /= target) $ execSfxAtomic $ SfxMsgFid (bfid tb) $ SfxBracedImmune target return UseId else do COps{coTileSpeedup} <- getsState scops totalDepth <- getsState stotalDepth lvl@Level{ldepth} <- getLevel (blid tb) range <- rndToAction $ castDice ldepth totalDepth nDm let spos = bpos tb dMinMax !delta !pos = let d = chessDist spos pos in d >= range - delta && d <= range + delta dist !delta !pos _ = dMinMax delta pos mtpos <- rndToAction $ findPosTry 200 lvl (\p !t -> Tile.isWalkable coTileSpeedup t && not (Tile.isNoActor coTileSpeedup t) && not (occupiedBigLvl p lvl) && not (occupiedProjLvl p lvl)) [ dist 1 , dist $ 1 + range `div` 9 , dist $ 1 + range `div` 7 , dist $ 1 + range `div` 5 , dist 5 , dist 7 , dist 9 ] case mtpos of Nothing -> do -- really very rare, so debug debugPossiblyPrint "Server: effectTeleport: failed to find any free position" execSfxAtomic $ SfxMsgFid (bfid sb) SfxTransImpossible when (source /= target) $ execSfxAtomic $ SfxMsgFid (bfid tb) SfxTransImpossible return UseId Just tpos -> do execSfx execUpdAtomic $ UpdMoveActor target spos tpos return UseUp -- ** CreateItem effectCreateItem :: MonadServerAtomic m => Maybe FactionId -> Maybe Int -> ActorId -> ActorId -> CStore -> GroupName ItemKind -> IK.TimerDice -> m UseResult effectCreateItem jfidRaw mcount source target store grp tim = do sb <- getsState $ getActorBody source tb <- getsState $ getActorBody target totalDepth <- getsState stotalDepth Level{ldepth} <- getLevel (blid tb) let fscale unit nDm = do k0 <- rndToAction $ castDice ldepth totalDepth nDm let k = max 1 k0 -- KISS, don't freak out if dice permit 0 return $! timeDeltaScale unit k fgame = fscale (Delta timeTurn) factor nDm = do actorMaxSk <- getsState $ getActorMaxSkills target -- A tiny bit added to make sure length 1 effect doesn't end before -- the end of first turn, which would make, e.g., speed, useless. let actorTurn = timeDeltaPercent (ticksPerMeter $ gearSpeed actorMaxSk) 101 fscale actorTurn nDm delta <- IK.foldTimer (return $ Delta timeZero) fgame factor tim let c = CActor target store bagBefore <- getsState $ getBodyStoreBag tb store -- Power depth of new items unaffected by number of spawned actors. freq <- prepareItemKind 0 (blid tb) [(grp, 1)] m2 <- rollItemAspect freq (blid tb) let (itemKnownRaw, (itemFullRaw, kitRaw)) = fromMaybe (error $ "" `showFailure` (blid tb, freq, c)) m2 -- Avoid too many different item identifiers (one for each faction) -- for blasts or common item generating tiles. Conditions are -- allowed to be duplicated, because they provide really useful info -- (perpetrator). However, if timer is none, they are not duplicated -- to make sure that, e.g., poisons stack with each other regardless -- of perpetrator and we don't get "no longer poisoned" message -- while still poisoned due to another faction. With timed aspects, -- e.g., slowness, the message is less misleading, and it's interesting -- that I'm twice slower due to aspects from two factions and not -- as deadly as being poisoned at twice the rate from two factions. jfid = if store == COrgan && not (IK.isTimerNone tim) || grp == "impressed" then jfidRaw else Nothing (itemKnown, itemFull) = let ItemKnown kindIx ar _ = itemKnownRaw in ( ItemKnown kindIx ar jfid , itemFullRaw {itemBase = (itemBase itemFullRaw) {jfid}} ) kitNew = case mcount of Just itemK -> (itemK, []) Nothing -> kitRaw itemRev <- getsServer sitemRev let mquant = case HM.lookup itemKnown itemRev of Nothing -> Nothing Just iid -> (iid,) <$> iid `EM.lookup` bagBefore case mquant of Just (iid, (_, afterIt@(timer : rest))) | not $ IK.isTimerNone tim -> do -- Already has such items and timer change requested, so only increase -- the timer of the first item by the delta, but don't create items. let newIt = timer `timeShift` delta : rest if afterIt /= newIt then do execUpdAtomic $ UpdTimeItem iid c afterIt newIt -- It's hard for the client to tell this timer change from charge use, -- timer reset on pickup, etc., so we create the msg manually. -- Sending to both involved factions lets the player notice -- both the extensions he caused and suffered. Other faction causing -- that on themselves or on others won't be noticed. TMI. execSfxAtomic $ SfxMsgFid (bfid sb) $ SfxTimerExtended (blid tb) target iid store delta when (bfid sb /= bfid tb) $ execSfxAtomic $ SfxMsgFid (bfid tb) $ SfxTimerExtended (blid tb) target iid store delta return UseUp else return UseDud -- probably incorrect content, but let it be _ -> do -- No such items or some items, but void delta, so create items. -- If it's, e.g., a periodic poison, the new items will stack with any -- already existing items. iid <- registerItem (itemFull, kitNew) itemKnown c True -- If created not on the ground, ID it, because it won't be on pickup. when (store /= CGround) $ discoverIfMinorEffects c iid (itemKindId itemFull) -- Now, if timer change requested, change the timer, but in the new items, -- possibly increased in number wrt old items. when (not $ IK.isTimerNone tim) $ do tb2 <- getsState $ getActorBody target bagAfter <- getsState $ getBodyStoreBag tb2 store localTime <- getsState $ getLocalTime (blid tb) let newTimer = localTime `timeShift` delta (afterK, afterIt) = fromMaybe (error $ "" `showFailure` (iid, bagAfter, c)) (iid `EM.lookup` bagAfter) newIt = replicate afterK newTimer when (afterIt /= newIt) $ execUpdAtomic $ UpdTimeItem iid c afterIt newIt return UseUp -- ** DropItem -- | Make the target actor drop items in a store from the given group. -- The item itself is immune (any copies). effectDropItem :: MonadServerAtomic m => m () -> ItemId -> Int -> Int -> CStore -> GroupName ItemKind -> ActorId -> m UseResult effectDropItem execSfx iidId ngroup kcopy store grp target = do tb <- getsState $ getActorBody target fact <- getsState $ (EM.! bfid tb) . sfactionD isRaw <- allGroupItems store grp target curChalSer <- getsServer $ scurChalSer . soptions factionD <- getsState sfactionD let is = filter ((/= iidId) . fst) isRaw if | bproj tb || null is -> return UseDud | ngroup == maxBound && kcopy == maxBound && store `elem` [CEqp, CInv, CSha] && fhasGender (gplayer fact) -- hero in Allure's decontamination chamber && (cdiff curChalSer == 1 -- at lowest difficulty for its faction && any (fhasUI . gplayer . snd) (filter (\(fi, fa) -> isFriend fi fa (bfid tb)) (EM.assocs factionD)) || cdiff curChalSer == difficultyBound && any (fhasUI . gplayer . snd) (filter (\(fi, fa) -> isFoe fi fa (bfid tb)) (EM.assocs factionD))) -> {- A hardwired hack, because AI heroes don't cope with Allure's decontamination chamber; beginners may struggle too, so this is trigered by difficulty. - AI heroes don't switch leader to the hero past laboratory to equip weapons from stash between the in-lab hero picks up the loot pile and himself enters the decontamination chamber - all consumables always end up in a pack and the whole pack is always left behind, because consumables are not shared among actors via shared stash (yet); we could pack consumables to stash by default, but it's too confusing and risky for beginner players and doesn't work for heroes that have not enough Calm ATM and AI would still need to learn to spread consumables from stash to packs afterwards - the items of the last actor would be lost anyway, unless AI is taught the foolproof solution of this puzzle, which is yet a bit more specific than the two general abilities described as desirable above -} return UseUp | otherwise -> do unless (store == COrgan) execSfx mapM_ (uncurry (dropCStoreItem True store target tb kcopy)) (take ngroup is) return UseUp -- | Drop a single actor's item (though possibly multiple copies). -- Note that if there are multiple copies, at most one explodes -- to avoid excessive carnage and UI clutter (let's say, -- the multiple explosions interfere with each other or perhaps -- larger quantities of explosives tend to be packaged more safely). -- Note also that @OnSmash@ effects are activated even if item discharged. dropCStoreItem :: MonadServerAtomic m => Bool -> CStore -> ActorId -> Actor -> Int -> ItemId -> ItemQuant -> m () dropCStoreItem verbose store aid b kMax iid (k, _) = do itemFull@ItemFull{itemBase} <- getsState $ itemToFull iid let arItem = aspectRecordFull itemFull c = CActor aid store fragile = IA.checkFlag Ability.Fragile arItem durable = IA.checkFlag Ability.Durable arItem isDestroyed = bproj b && (bhp b <= 0 && not durable || fragile) || IA.checkFlag Ability.Condition arItem if isDestroyed then do let -- We don't know if it's voluntary, so we conservatively assume -- it is and we blame @aid@. voluntary = True onSmashOnly = True useAllCopies = kMax >= k effectAndDestroyAndAddKill voluntary aid onSmashOnly useAllCopies False aid aid iid c False itemFull True -- One copy was destroyed (or none if the item was discharged), -- so let's mop up. bag <- getsState $ getContainerBag c maybe (return ()) (\(k1, it) -> let destroyedSoFar = k - k1 k2 = min (kMax - destroyedSoFar) k1 kit2 = (k2, take k2 it) in when (k2 > 0) $ execUpdAtomic $ UpdLoseItem False iid itemBase kit2 c) (EM.lookup iid bag) else do cDrop <- pickDroppable False aid b -- drop over fog, etc. mvCmd <- generalMoveItem verbose iid (min kMax k) (CActor aid store) cDrop mapM_ execUpdAtomic mvCmd pickDroppable :: MonadStateRead m => Bool -> ActorId -> Actor -> m Container pickDroppable respectNoItem aid b = do cops@COps{coTileSpeedup} <- getsState scops lvl <- getLevel (blid b) let validTile t = not (respectNoItem && Tile.isNoItem coTileSpeedup t) if validTile $ lvl `at` bpos b then return $! CActor aid CGround else do let ps = nearbyFreePoints cops lvl validTile (bpos b) return $! case filter (adjacent $ bpos b) $ take 8 ps of [] -> CActor aid CGround -- fallback; still correct, though not ideal pos : _ -> CFloor (blid b) pos -- ** PolyItem -- Can't apply to the item itself (any copies). effectPolyItem :: MonadServerAtomic m => m () -> ItemId -> ActorId -> m UseResult effectPolyItem execSfx iidId target = do tb <- getsState $ getActorBody target let cstore = CGround kitAss <- getsState $ kitAssocs target [cstore] case filter ((/= iidId) . fst) kitAss of [] -> do execSfxAtomic $ SfxMsgFid (bfid tb) SfxPurposeNothing -- Do not spam the source actor player about the failures. return UseId (iid, ( itemFull@ItemFull{itemBase, itemKindId, itemKind} , (itemK, itemTimer) )) : _ -> do let arItem = aspectRecordFull itemFull maxCount = Dice.supDice $ IK.icount itemKind if | IA.checkFlag Ability.Unique arItem -> do execSfxAtomic $ SfxMsgFid (bfid tb) SfxPurposeUnique return UseId | maybe True (<= 0) $ lookup "common item" $ IK.ifreq itemKind -> do execSfxAtomic $ SfxMsgFid (bfid tb) SfxPurposeNotCommon return UseId | itemK < maxCount -> do execSfxAtomic $ SfxMsgFid (bfid tb) $ SfxPurposeTooFew maxCount itemK return UseId | otherwise -> do -- Only the required number of items is used up, not all of them. let c = CActor target cstore kit = (maxCount, take maxCount itemTimer) execSfx identifyIid iid c itemKindId itemKind execUpdAtomic $ UpdDestroyItem iid itemBase kit c effectCreateItem (Just $ bfid tb) Nothing target target cstore "common item" IK.timerNone -- ** RerollItem -- Can't apply to the item itself (any copies). effectRerollItem :: forall m . MonadServerAtomic m => m () -> ItemId -> ActorId -> m UseResult effectRerollItem execSfx iidId target = do COps{coItemSpeedup} <- getsState scops tb <- getsState $ getActorBody target let cstore = CGround -- if ever changed, call @discoverIfMinorEffects@ kitAss <- getsState $ kitAssocs target [cstore] case filter ((/= iidId) . fst) kitAss of [] -> do execSfxAtomic $ SfxMsgFid (bfid tb) SfxRerollNothing -- Do not spam the source actor player about the failures. return UseId (iid, ( ItemFull{ itemBase, itemKindId, itemKind , itemDisco=ItemDiscoFull itemAspect } , (_, itemTimer) )) : _ -> if | IA.kmConst $ getKindMean itemKindId coItemSpeedup -> do execSfxAtomic $ SfxMsgFid (bfid tb) SfxRerollNotRandom return UseId | otherwise -> do let c = CActor target cstore kit = (1, take 1 itemTimer) -- prevent micromanagement freq = pure (itemKindId, itemKind) execSfx identifyIid iid c itemKindId itemKind execUpdAtomic $ UpdDestroyItem iid itemBase kit c dungeon <- getsState sdungeon let maxLid = fst $ maximumBy (Ord.comparing (ldepth . snd)) $ EM.assocs dungeon roll100 :: Int -> m (ItemKnown, ItemFullKit) roll100 n = do m2 <- rollItemAspect freq maxLid case m2 of Nothing -> error "effectRerollItem: can't create rerolled item" Just i2@(ItemKnown _ ar2 _, _) -> if ar2 == itemAspect && n > 0 then roll100 (n - 1) else return i2 (itemKnown, (itemFull, _)) <- roll100 100 void $ registerItem (itemFull, kit) itemKnown c True return UseUp _ -> error "effectRerollItem: server ignorant about an item" -- ** DupItem -- Can't apply to the item itself (any copies). effectDupItem :: MonadServerAtomic m => m () -> ItemId -> ActorId -> m UseResult effectDupItem execSfx iidId target = do tb <- getsState $ getActorBody target let cstore = CGround -- beware of other options, e.g., creating in eqp -- and not setting timeout to a random value kitAss <- getsState $ kitAssocs target [cstore] case filter ((/= iidId) . fst) kitAss of [] -> do execSfxAtomic $ SfxMsgFid (bfid tb) SfxDupNothing -- Do not spam the source actor player about the failures. return UseId (iid, ( itemFull@ItemFull{itemBase, itemKindId, itemKind} , _ )) : _ -> do let arItem = aspectRecordFull itemFull if | IA.checkFlag Ability.Unique arItem -> do execSfxAtomic $ SfxMsgFid (bfid tb) SfxDupUnique return UseId | maybe False (> 0) $ lookup "valuable" $ IK.ifreq itemKind -> do execSfxAtomic $ SfxMsgFid (bfid tb) SfxDupValuable return UseId | otherwise -> do let c = CActor target cstore execSfx identifyIid iid c itemKindId itemKind execUpdAtomic $ UpdCreateItem iid itemBase (1, []) c return UseUp -- ** Identify effectIdentify :: MonadServerAtomic m => m () -> ItemId -> ActorId -> m UseResult effectIdentify execSfx iidId target = do COps{coItemSpeedup} <- getsState scops discoAspect <- getsState sdiscoAspect -- The actor that causes the application does not determine what item -- is identifiable, becuase it's the target actor that identifies -- his possesions. tb <- getsState $ getActorBody target sClient <- getsServer $ (EM.! bfid tb) . sclientStates let tryFull store as = case as of [] -> return False (iid, _) : rest | iid == iidId -> tryFull store rest -- don't id itself (iid, ItemFull{itemBase, itemKindId, itemKind}) : rest -> do let arItem = discoAspect EM.! iid kindIsKnown = case jkind itemBase of IdentityObvious _ -> True IdentityCovered ix _ -> ix `EM.member` sdiscoKind sClient if iid `EM.member` sdiscoAspect sClient -- already fully identified || IA.isHumanTrinket itemKind -- hack; keep them non-identified || store == CGround && IA.onlyMinorEffects arItem itemKind -- will be identified when picked up, so don't bother || IA.kmConst (getKindMean itemKindId coItemSpeedup) && kindIsKnown -- constant aspects and known kind; no need to identify further; -- this should normally not be needed, since clients should -- identify such items for free then tryFull store rest else do let c = CActor target store execSfx identifyIid iid c itemKindId itemKind return True tryStore stores = case stores of [] -> do execSfxAtomic $ SfxMsgFid (bfid tb) SfxIdentifyNothing return UseId -- the message tells it's ID effect store : rest -> do allAssocs <- getsState $ fullAssocs target [store] go <- tryFull store allAssocs if go then return UseUp else tryStore rest tryStore [CGround, CEqp, CInv, CSha] identifyIid :: MonadServerAtomic m => ItemId -> Container -> ContentId ItemKind -> ItemKind -> m () identifyIid iid c itemKindId itemKind = unless (IA.isHumanTrinket itemKind) $ do discoAspect <- getsState sdiscoAspect execUpdAtomic $ UpdDiscover c iid itemKindId $ discoAspect EM.! iid -- ** Detect effectDetect :: MonadServerAtomic m => m () -> IK.DetectKind -> Int -> ActorId -> Point -> m UseResult effectDetect execSfx d radius target pos = do COps{coitem, coTileSpeedup} <- getsState scops b <- getsState $ getActorBody target lvl <- getLevel $ blid b s <- getState getKind <- getsState $ flip getIidKindServer let lootPredicate p = p `EM.member` lfloor lvl || (case posToBigAssoc p (blid b) s of Nothing -> False Just (_, body) -> let belongings = EM.keys (beqp body) ++ EM.keys (binv body) -- shared stash ignored, because hard to get in any belongingIsLoot belongings) || any embedHasLoot (EM.keys $ getEmbedBag (blid b) p s) itemKindIsLoot = isNothing . lookup "unreported inventory" . IK.ifreq belongingIsLoot iid = itemKindIsLoot $ getKind iid embedHasLoot iid = any effectHasLoot $ IK.ieffects $ getKind iid reported acc _ _ itemKind = acc && itemKindIsLoot itemKind effectHasLoot (IK.CreateItem cstore grp _) = cstore `elem` [CGround, CEqp, CInv, CSha] && ofoldlGroup' coitem grp reported True effectHasLoot IK.PolyItem = True effectHasLoot IK.RerollItem = True effectHasLoot IK.DupItem = True effectHasLoot (IK.OneOf l) = any effectHasLoot l effectHasLoot (IK.OnSmash eff) = effectHasLoot eff effectHasLoot (IK.Composite l) = any effectHasLoot l effectHasLoot _ = False (predicate, action) = case d of IK.DetectAll -> (const True, const $ return False) IK.DetectActor -> ((`EM.member` lbig lvl), const $ return False) IK.DetectLoot -> (lootPredicate, const $ return False) IK.DetectExit -> let (ls1, ls2) = lstair lvl in ((`elem` ls1 ++ ls2 ++ lescape lvl), const $ return False) IK.DetectHidden -> let predicateH p = Tile.isHideAs coTileSpeedup $ lvl `at` p revealEmbed p = do embeds <- getsState $ getEmbedBag (blid b) p unless (EM.null embeds) $ do let ais = map (\iid -> (iid, getItemBody iid s)) (EM.keys embeds) execUpdAtomic $ UpdSpotItemBag (CEmbed (blid b) p) embeds ais actionH l = do let f p = when (p /= pos) $ do let t = lvl `at` p execUpdAtomic $ UpdSearchTile target p t -- This is safe searching; embedded items -- are not triggered, but they are revealed. revealEmbed p case EM.lookup p $ lentry lvl of Nothing -> return () Just entry -> execUpdAtomic $ UpdSpotEntry (blid b) [(p, entry)] mapM_ f l return $! not $ null l -- KISS, even if client knows all in (predicateH, actionH) IK.DetectEmbed -> ((`EM.member` lembed lvl), const $ return False) effectDetectX d predicate action execSfx radius target effectDetectX :: MonadServerAtomic m => IK.DetectKind -> (Point -> Bool) -> ([Point] -> m Bool) -> m () -> Int -> ActorId -> m UseResult effectDetectX d predicate action execSfx radius target = do COps{corule=RuleContent{rXmax, rYmax}} <- getsState scops b <- getsState $ getActorBody target sperFidOld <- getsServer sperFid let perOld = sperFidOld EM.! bfid b EM.! blid b Point x0 y0 = bpos b perList = filter predicate [ Point x y | y <- [max 0 (y0 - radius) .. min (rYmax - 1) (y0 + radius)] , x <- [max 0 (x0 - radius) .. min (rXmax - 1) (x0 + radius)] ] extraPer = emptyPer {psight = PerVisible $ ES.fromDistinctAscList perList} inPer = diffPer extraPer perOld unless (nullPer inPer) $ do -- Perception is modified on the server and sent to the client -- together with all the revealed info. let perNew = addPer inPer perOld fper = EM.adjust (EM.insert (blid b) perNew) (bfid b) modifyServer $ \ser -> ser {sperFid = fper $ sperFid ser} execSendPer (bfid b) (blid b) emptyPer inPer perNew pointsModified <- action perList if not (nullPer inPer) || pointsModified then do execSfx -- Perception is reverted. This is necessary to ensure save and restore -- doesn't change game state. unless (nullPer inPer) $ do modifyServer $ \ser -> ser {sperFid = sperFidOld} execSendPer (bfid b) (blid b) inPer emptyPer perOld else execSfxAtomic $ SfxMsgFid (bfid b) $ SfxVoidDetection d return UseUp -- even if nothing spotted, in itself it's still useful data -- ** SendFlying -- | Send the target actor flying like a projectile. If the actors are adjacent, -- the vector is directed outwards, if no, inwards, if it's the same actor, -- boldpos is used, if it can't, a random outward vector of length 10 -- is picked. effectSendFlying :: MonadServerAtomic m => m () -> IK.ThrowMod -> ActorId -> ActorId -> Container -> Maybe Bool -> m UseResult effectSendFlying execSfx IK.ThrowMod{..} source target c modePush = do v <- sendFlyingVector source target modePush sb <- getsState $ getActorBody source tb <- getsState $ getActorBody target let eps = 0 fpos = bpos tb `shift` v isEmbed = case c of CEmbed{} -> True _ -> False if bhp tb <= 0 -- avoid dragging around corpses || bproj tb && isEmbed then -- fyling projectiles can't slip on the floor return UseDud -- the impact never manifested else if actorWaits tb && source /= target && isNothing (btrajectory tb) then do execSfxAtomic $ SfxMsgFid (bfid sb) $ SfxBracedImmune target when (source /= target) $ execSfxAtomic $ SfxMsgFid (bfid tb) $ SfxBracedImmune target return UseUp -- waste it to prevent repeated throwing at immobile actors else do COps{corule=RuleContent{rXmax, rYmax}} <- getsState scops case bla rXmax rYmax eps (bpos tb) fpos of Nothing -> error $ "" `showFailure` (fpos, tb) Just [] -> error $ "projecting from the edge of level" `showFailure` (fpos, tb) Just (pos : rest) -> do weightAssocs <- getsState $ fullAssocs target [CInv, CEqp, COrgan] let weight = sum $ map (IK.iweight . itemKind . snd) weightAssocs path = bpos tb : pos : rest (trajectory, (speed, _)) = -- Note that the @ThrowMod@ aspect of the actor's trunk is ignored. computeTrajectory weight throwVelocity throwLinger path ts = Just (trajectory, speed) if null trajectory then return UseId -- e.g., actor is too heavy; but a jerk is noticeable else do execSfx -- Old and new trajectories are not added; the old one is replaced. unless (btrajectory tb == ts) $ execUpdAtomic $ UpdTrajectory target (btrajectory tb) ts -- If propeller is a projectile, it pushes involuntarily, -- so its originator is to blame. -- However, we can't easily see whether a pushed non-projectile actor -- pushed another due to colliding or voluntarily, so we assign -- blame to him. originator <- if bproj sb then getsServer $ EM.findWithDefault source source . strajPushedBy else return source modifyServer $ \ser -> ser {strajPushedBy = EM.insert target originator $ strajPushedBy ser} -- In case of pre-existing pushing, don't touch the time -- so that the pending @advanceTimeTraj@ can do its job -- (it will, because non-empty trajectory is here set, unless, e.g., -- subsequent effects from the same item change the trajectory). when (isNothing $ btrajectory tb) $ do -- Set flying time to almost now, so that the push happens ASAP, -- because it's the first one, so almost no delay is needed. localTime <- getsState $ getLocalTime (blid tb) -- But add a slight overhead to avoid displace-slide loops -- of 3 actors in a line. let overheadTime = timeShift localTime (Delta timeClip) modifyServer $ \ser -> ser {strajTime = updateActorTime (bfid tb) (blid tb) target overheadTime $ strajTime ser} return UseUp sendFlyingVector :: MonadServerAtomic m => ActorId -> ActorId -> Maybe Bool -> m Vector sendFlyingVector source target modePush = do sb <- getsState $ getActorBody source let boldpos_sb = fromMaybe (bpos sb) (boldpos sb) if source == target then if boldpos_sb == bpos sb then rndToAction $ do z <- randomR (-10, 10) oneOf [Vector 10 z, Vector (-10) z, Vector z 10, Vector z (-10)] else return $! vectorToFrom (bpos sb) boldpos_sb else do tb <- getsState $ getActorBody target let pushV = vectorToFrom (bpos tb) (bpos sb) pullV = vectorToFrom (bpos sb) (bpos tb) return $! case modePush of Just True -> pushV Just False -> pullV Nothing | adjacent (bpos sb) (bpos tb) -> pushV Nothing -> pullV -- ** DropBestWeapon -- | Make the target actor drop his best weapon. -- The item itself is immune (any copies). effectDropBestWeapon :: MonadServerAtomic m => m () -> ItemId -> ActorId -> m UseResult effectDropBestWeapon execSfx iidId target = do tb <- getsState $ getActorBody target if bproj tb then return UseDud else do localTime <- getsState $ getLocalTime (blid tb) kitAssRaw <- getsState $ kitAssocs target [CEqp] let kitAss = filter (\(iid, (i, _)) -> IA.checkFlag Ability.Meleeable (aspectRecordFull i) && iid /= iidId) kitAssRaw ignoreCharges = True case strongestMelee ignoreCharges Nothing localTime kitAss of (_, (_, (iid, _))) : _ -> do execSfx let kit = beqp tb EM.! iid dropCStoreItem True CEqp target tb 1 iid kit -- not the whole stack return UseUp [] -> return UseDud -- ** ActivateInv -- | Activate all items with the given symbol -- in the target actor's equipment (there's no variant that activates -- a random one, to avoid the incentive for carrying garbage). -- Only one item of each stack is activated (and possibly consumed). -- Won't activate the item itself (any copies). effectActivateInv :: MonadServerAtomic m => m () -> ItemId -> ActorId -> ActorId -> Char -> m UseResult effectActivateInv execSfx iidId source target symbol = do let c = CActor target CInv effectTransformContainer execSfx iidId symbol c $ \iid _ -> -- We don't know if it's voluntary, so we conservatively assume it is -- and we blame @source@. kineticEffectAndDestroy True source target target iid c True effectTransformContainer :: forall m. MonadServerAtomic m => m () -> ItemId -> Char -> Container -> (ItemId -> ItemQuant -> m ()) -> m UseResult effectTransformContainer execSfx iidId symbol c m = do getKind <- getsState $ flip getIidKindServer let hasSymbol (iid, _kit) = do let jsymbol = IK.isymbol $ getKind iid return $! jsymbol == symbol assocsCStore <- getsState $ EM.assocs . getContainerBag c is <- filter ((/= iidId) . fst) <$> if symbol == ' ' then return assocsCStore else filterM hasSymbol assocsCStore if null is then return UseDud else do execSfx mapM_ (uncurry m) is -- Even if no item produced any visible effect, rummaging through -- the inventory uses up the effect and produced discernible vibrations. return UseUp -- ** ApplyPerfume effectApplyPerfume :: MonadServerAtomic m => m () -> ActorId -> m UseResult effectApplyPerfume execSfx target = do tb <- getsState $ getActorBody target Level{lsmell} <- getLevel $ blid tb unless (EM.null lsmell) $ do execSfx let f p fromSm = execUpdAtomic $ UpdAlterSmell (blid tb) p fromSm timeZero mapWithKeyM_ f lsmell return UseUp -- even if no smell before, the perfume is noticeable -- ** OneOf effectOneOf :: MonadServerAtomic m => (IK.Effect -> m UseResult) -> [IK.Effect] -> m UseResult effectOneOf recursiveCall l = do let call1 = do ef <- rndToAction $ oneOf l recursiveCall ef call99 = replicate 99 call1 f call result = do ur <- call -- We avoid 99 calls to a fizzling effect that only prints -- a failure message and IDs the item. if ur == UseDud then result else return ur foldr f (return UseDud) call99 -- no @execSfx@, because individual effects sent them -- ** VerbNoLonger effectVerbNoLonger :: MonadServerAtomic m => Bool -> m () -> ActorId -> m UseResult effectVerbNoLonger useAllCopies execSfx source = do b <- getsState $ getActorBody source when (useAllCopies -- @UseUp@ below ensures that if all used, all destroyed && not (bproj b)) $ -- no spam when projectiles activate execSfx -- announce that all copies have run out (or whatever message) return UseUp -- help to destroy the copy, even if not all used up -- ** VerbMsg effectVerbMsg :: MonadServerAtomic m => m () -> ActorId -> m UseResult effectVerbMsg execSfx source = do b <- getsState $ getActorBody source unless (bproj b) execSfx -- don't spam when projectiles activate return UseUp -- announcing always successful and this helps -- to destroy the item -- ** Composite effectComposite :: forall m. MonadServerAtomic m => (IK.Effect -> m UseResult) -> [IK.Effect] -> m UseResult effectComposite recursiveCall l = do let f :: IK.Effect -> m UseResult -> m UseResult f eff result = do ur <- recursiveCall eff when (ur == UseUp) $ void result -- UseResult comes from the first return ur foldr f (return UseDud) l -- no @execSfx@, because individual effects sent them LambdaHack-0.9.5.0/engine-src/Game/LambdaHack/Server/HandleRequestM.hs0000644000000000000000000013551507346545000023372 0ustar0000000000000000-- | Semantics of requests -- . -- A couple of them do not take time, the rest does. -- Note that since the results are atomic commands, which are executed -- only later (on the server and some of the clients), all condition -- are checkd by the semantic functions in the context of the state -- before the server command. Even if one or more atomic actions -- are already issued by the point an expression is evaluated, they do not -- influence the outcome of the evaluation. module Game.LambdaHack.Server.HandleRequestM ( handleRequestAI, handleRequestUI, handleRequestTimed, switchLeader , reqMoveGeneric, reqDisplaceGeneric, reqAlterFail , reqGameDropAndExit, reqGameSaveAndExit #ifdef EXPOSE_INTERNAL -- * Internal operations , execFailure, checkWaiting, processWatchfulness, managePerRequest , handleRequestTimedCases, affectSmell, reqMove, reqMelee, reqMeleeChecked , reqDisplace, reqAlter, reqWait, reqWait10, reqYell, reqMoveItems , reqMoveItem, reqProject, reqApply , reqGameRestart, reqGameSave, reqTactic, reqAutomate #endif ) where import Prelude () import Game.LambdaHack.Core.Prelude import qualified Data.EnumMap.Strict as EM import qualified Data.Ord as Ord import qualified Data.Text as T import qualified Text.Show.Pretty as Show.Pretty import Game.LambdaHack.Atomic import Game.LambdaHack.Client (ReqAI (..), ReqUI (..), RequestTimed (..)) import Game.LambdaHack.Client.UI.ItemDescription import Game.LambdaHack.Common.Actor import Game.LambdaHack.Common.ActorState import Game.LambdaHack.Common.Analytics import Game.LambdaHack.Common.Faction import Game.LambdaHack.Common.Item import qualified Game.LambdaHack.Common.ItemAspect as IA import Game.LambdaHack.Common.Kind import Game.LambdaHack.Common.Level import Game.LambdaHack.Common.Misc import Game.LambdaHack.Common.MonadStateRead import Game.LambdaHack.Common.Point import Game.LambdaHack.Common.ReqFailure import Game.LambdaHack.Common.State import qualified Game.LambdaHack.Common.Tile as Tile import Game.LambdaHack.Common.Time import Game.LambdaHack.Common.Types import Game.LambdaHack.Common.Vector import qualified Game.LambdaHack.Content.ItemKind as IK import Game.LambdaHack.Content.ModeKind import qualified Game.LambdaHack.Content.TileKind as TK import qualified Game.LambdaHack.Definition.Ability as Ability import Game.LambdaHack.Definition.Defs import Game.LambdaHack.Server.CommonM import Game.LambdaHack.Server.HandleEffectM import Game.LambdaHack.Server.ItemM import Game.LambdaHack.Server.MonadServer import Game.LambdaHack.Server.PeriodicM import Game.LambdaHack.Server.ServerOptions import Game.LambdaHack.Server.State execFailure :: MonadServerAtomic m => ActorId -> RequestTimed -> ReqFailure -> m () execFailure aid req failureSer = do -- Clients should rarely do that (only in case of invisible actors) -- so we report it to the client, but do not crash -- (server should work OK with stupid clients, too). body <- getsState $ getActorBody aid let fid = bfid body msg = showReqFailure failureSer impossible = impossibleReqFailure failureSer debugShow :: Show a => a -> Text debugShow = T.pack . Show.Pretty.ppShow possiblyAlarm = if impossible then debugPossiblyPrintAndExit else debugPossiblyPrint possiblyAlarm $ "Server: execFailure:" <+> msg <> "\n" <> debugShow body <> "\n" <> debugShow req <> "\n" <> debugShow failureSer execSfxAtomic $ SfxMsgFid fid $ SfxUnexpected failureSer -- | The semantics of server commands. -- AI always takes time and so doesn't loop. handleRequestAI :: MonadServerAtomic m => ReqAI -> m (Maybe RequestTimed) handleRequestAI cmd = case cmd of ReqAITimed cmdT -> return $ Just cmdT ReqAINop -> return Nothing -- | The semantics of server commands. Only the first two cases affect time. handleRequestUI :: MonadServerAtomic m => FactionId -> ActorId -> ReqUI -> m (Maybe RequestTimed) handleRequestUI fid aid cmd = case cmd of ReqUITimed cmdT -> return $ Just cmdT ReqUIGameRestart t d -> reqGameRestart aid t d >> return Nothing ReqUIGameDropAndExit -> reqGameDropAndExit aid >> return Nothing ReqUIGameSaveAndExit -> reqGameSaveAndExit aid >> return Nothing ReqUIGameSave -> reqGameSave >> return Nothing ReqUITactic toT -> reqTactic fid toT >> return Nothing ReqUIAutomate -> reqAutomate fid >> return Nothing ReqUINop -> return Nothing checkWaiting :: RequestTimed -> Maybe Bool checkWaiting cmd = case cmd of ReqWait -> Just True -- true wait, with bracing, no overhead, etc. ReqWait10 -> Just False -- false wait, only one clip at a time _ -> Nothing -- | This is a shorthand. Instead of setting @bwatch@ in @ReqWait@ -- and unsetting in all other requests, we call this once after -- executing a request. -- In game state, we collect the number of server requests pertaining -- to the actor (the number of actor's "moves"), through which -- the actor was waiting. processWatchfulness :: MonadServerAtomic m => Maybe Bool -> ActorId -> m () processWatchfulness mwait aid = do b <- getsState $ getActorBody aid actorMaxSk <- getsState $ getActorMaxSkills aid let uneasy = deltasSerious (bcalmDelta b) || not (calmEnough b actorMaxSk) case bwatch b of WSleep -> if mwait /= Just False -- lurk can't wake up regardless; too short && (not (isJust mwait) -- not a wait || uneasy -- spooked || not (deltaBenign $ bhpDelta b)) -- any HP lost then execUpdAtomic $ UpdWaitActor aid WSleep WWake else execUpdAtomic $ UpdRefillHP aid 10000 -- no @xM@, so slow, but each turn HP gauge green; -- this is 1HP per 100 turns, so it's 10 slower than a necklace -- that gives 1HP per 10 turns; -- so if an actor sleeps for the duration of a 1000 turns, -- which may be the time it takes to fully explore a level, -- 10HP would be gained, so weak actors would wake up WWake -> unless (mwait == Just False) $ -- lurk can't wake up; too fast removeSleepSingle aid WWait 0 -> case mwait of -- actor couldn't brace last time Just True -> return () -- if he still waits, keep him stuck unbraced _ -> execUpdAtomic $ UpdWaitActor aid (WWait 0) WWatch WWait n -> case mwait of Just True -> -- only proper wait prevents switching to watchfulness if n >= 500 then -- enough dozing to fall asleep if not uneasy -- won't wake up at once && canSleep actorMaxSk -- enough skills then do nAll <- removeConditionSingle "braced" aid let !_A = assert (nAll == 0) () addSleep aid else -- Start dozing from scratch to prevent hopeless skill checks. execUpdAtomic $ UpdWaitActor aid (WWait n) (WWait 1) else -- Doze some more before checking sleep eligibility. execUpdAtomic $ UpdWaitActor aid (WWait n) (WWait $ n + 1) _ -> do nAll <- removeConditionSingle "braced" aid let !_A = assert (nAll == 0) () execUpdAtomic $ UpdWaitActor aid (WWait n) WWatch WWatch -> when (mwait == Just True) $ -- only long wait switches to wait state if Ability.getSk Ability.SkWait actorMaxSk >= 2 then do addCondition "braced" aid execUpdAtomic $ UpdWaitActor aid WWatch (WWait 1) else execUpdAtomic $ UpdWaitActor aid WWatch (WWait 0) handleRequestTimed :: MonadServerAtomic m => FactionId -> ActorId -> RequestTimed -> m Bool handleRequestTimed fid aid cmd = do let mwait = checkWaiting cmd b <- getsState $ getActorBody aid -- Note that only the ordinary 1-turn wait eliminates overhead. -- The more fine-graned waits don't make actors braced and induce -- overhead, so that they have some drawbacks in addition to the -- benefit of seeing approaching danger up to almost a turn faster. -- It may be too late to block then, but not too late to sidestep or attack. unless (mwait == Just True) $ overheadActorTime fid (blid b) advanceTime aid (if mwait == Just False then 10 else 100) True handleRequestTimedCases aid cmd managePerRequest aid -- Note that due to the order, actor was still braced or sleeping -- throughout request processing, etc. So, if he hits himself kinetically, -- his armor from bracing previous turn is still in effect. processWatchfulness mwait aid return $! isNothing mwait -- for speed, we report if @cmd@ harmless -- | Clear deltas for Calm and HP for proper UI display and AI hints. managePerRequest :: MonadServerAtomic m => ActorId -> m () managePerRequest aid = do b <- getsState $ getActorBody aid let clearMark = 0 unless (bcalmDelta b == ResDelta (0, 0) (0, 0)) $ -- Clear delta for the next actor move. execUpdAtomic $ UpdRefillCalm aid clearMark unless (bhpDelta b == ResDelta (0, 0) (0, 0)) $ -- Clear delta for the next actor move. execUpdAtomic $ UpdRefillHP aid clearMark handleRequestTimedCases :: MonadServerAtomic m => ActorId -> RequestTimed -> m () handleRequestTimedCases aid cmd = case cmd of ReqMove target -> reqMove aid target ReqMelee target iid cstore -> reqMelee aid target iid cstore ReqDisplace target -> reqDisplace aid target ReqAlter tpos -> reqAlter aid tpos ReqWait -> reqWait aid ReqWait10 -> reqWait10 aid ReqYell -> reqYell aid ReqMoveItems l -> reqMoveItems aid l ReqProject p eps iid cstore -> reqProject aid p eps iid cstore ReqApply iid cstore -> reqApply aid iid cstore switchLeader :: MonadServerAtomic m => FactionId -> ActorId -> m () {-# INLINE switchLeader #-} switchLeader fid aidNew = do fact <- getsState $ (EM.! fid) . sfactionD bPre <- getsState $ getActorBody aidNew let mleader = gleader fact !_A1 = assert (Just aidNew /= mleader && not (bproj bPre) `blame` (aidNew, bPre, fid, fact)) () !_A2 = assert (bfid bPre == fid `blame` "client tries to move other faction actors" `swith` (aidNew, bPre, fid, fact)) () let (autoDun, _) = autoDungeonLevel fact arena <- case mleader of Nothing -> return $! blid bPre Just leader -> do b <- getsState $ getActorBody leader return $! blid b if | blid bPre /= arena && autoDun -> execFailure aidNew ReqWait{-hack-} NoChangeDunLeader | otherwise -> do execUpdAtomic $ UpdLeadFaction fid mleader (Just aidNew) -- We exchange times of the old and new leader. -- This permits an abuse, because a slow tank can be moved fast -- by alternating between it and many fast actors (until all of them -- get slowed down by this and none remain). But at least the sum -- of all times of a faction is conserved. And we avoid double moves -- against the UI player caused by his leader changes. There may still -- happen double moves caused by AI leader changes, but that's rare. -- The flip side is the possibility of multi-moves of the UI player -- as in the case of the tank. -- Warning: when the action is performed on the server, -- the time of the actor is different than when client prepared that -- action, so any client checks involving time should discount this. case mleader of Just aidOld | aidOld /= aidNew -> swapTime aidOld aidNew _ -> return () -- * ReqMove -- | Add a smell trace for the actor to the level. If smell already there -- and the actor can smell, remove smell. Projectiles are ignored. -- As long as an actor can smell, he doesn't leave any smell ever. -- Smell trace is never left in water tiles. affectSmell :: MonadServerAtomic m => ActorId -> m () affectSmell aid = do COps{coTileSpeedup} <- getsState scops b <- getsState $ getActorBody aid lvl <- getLevel $ blid b let aquatic = Tile.isAquatic coTileSpeedup $ lvl `at` bpos b unless (bproj b || aquatic) $ do actorMaxSk <- getsState $ getActorMaxSkills aid let smellRadius = Ability.getSk Ability.SkSmell actorMaxSk hasOdor = Ability.getSk Ability.SkOdor actorMaxSk > 0 when (hasOdor || smellRadius > 0) $ do localTime <- getsState $ getLocalTime $ blid b let oldS = fromMaybe timeZero $ EM.lookup (bpos b) . lsmell $ lvl newTime = timeShift localTime smellTimeout newS = if smellRadius > 0 then timeZero else newTime when (oldS /= newS) $ execUpdAtomic $ UpdAlterSmell (blid b) (bpos b) oldS newS -- | Actor moves or attacks. -- Note that client may not be able to see an invisible monster -- so it's the server that determines if melee took place, etc. -- Also, only the server is authorized to check if a move is legal -- and it needs full context for that, e.g., the initial actor position -- to check if melee attack does not try to reach to a distant tile. reqMove :: MonadServerAtomic m => ActorId -> Vector -> m () reqMove = reqMoveGeneric True True reqMoveGeneric :: MonadServerAtomic m => Bool -> Bool -> ActorId -> Vector -> m () reqMoveGeneric voluntary mayAttack source dir = do COps{coTileSpeedup} <- getsState scops actorSk <- currentSkillsServer source sb <- getsState $ getActorBody source let abInSkill sk = isJust (btrajectory sb) || Ability.getSk sk actorSk > 0 lid = blid sb lvl <- getLevel lid let spos = bpos sb tpos = spos `shift` dir -- This predicate is symmetric wrt source and target, though the effect -- of collision may not be (the source projectiles applies its effect -- on the target particles, but loses 1 HP due to the collision). -- The condition implies that it's impossible to shoot down a bullet -- with a bullet, but a bullet can shoot down a burstable target, -- as well as be swept away by it, and two burstable projectiles -- burst when meeting mid-air. Projectiles that are not bursting -- nor damaging never collide with any projectile. collides <- getsState $ \s tb -> let sitemKind = getIidKindServer (btrunk sb) s titemKind = getIidKindServer (btrunk tb) s sar = sdiscoAspect s EM.! btrunk sb tar = sdiscoAspect s EM.! btrunk tb -- Such projectiles are prone to bursting or are themselves -- particles of an explosion shockwave. bursting arItem = IA.checkFlag Ability.Fragile arItem && IA.checkFlag Ability.Lobable arItem sbursting = bursting sar tbursting = bursting tar -- Such projectiles, even if not bursting themselves, can cause -- another projectile to burst. damaging itemKind = IK.idamage itemKind /= 0 sdamaging = damaging sitemKind tdamaging = damaging titemKind -- Avoid explosion extinguishing itself via its own particles colliding. sameBlast = IA.checkFlag Ability.Blast sar && getIidKindIdServer (btrunk sb) s == getIidKindIdServer (btrunk tb) s in not sameBlast && (sbursting && (tdamaging || tbursting) || (tbursting && (sdamaging || sbursting))) -- We start by checking actors at the target position. tgt <- getsState $ posToAidAssocs tpos lid case tgt of (target, tb) : _ | mayAttack && (not (bproj sb) || not (bproj tb) || collides tb) -> do -- A projectile is too small and insubstantial to hit another projectile, -- unless it's large enough or tends to explode (fragile and lobable). -- The actor in the way is visible or not; server sees him always. -- Below the only weapon (the only item) of projectiles is picked. mweapon <- pickWeaponServer source case mweapon of Just (wp, cstore) | abInSkill Ability.SkMelee -> reqMeleeChecked voluntary source target wp cstore _ -> return () -- waiting, even if no @SkWait@ skill -- Movement of projectiles only happens after melee and a check -- if they survive, so that if they don't, they explode in front -- of enemy, not under him, so that already first explosion blasts -- reach him, not only potential secondary explosions. when (bproj sb) $ do b2 <- getsState $ getActorBody source unless (actorDying b2) $ reqMoveGeneric voluntary False source dir _ -> -- Either the position is empty, or all involved actors are proj. -- Movement requires full access and skill. if Tile.isWalkable coTileSpeedup $ lvl `at` tpos then if abInSkill Ability.SkMove then do execUpdAtomic $ UpdMoveActor source spos tpos affectSmell source void $ reqAlterFail voluntary source tpos -- possibly alter or activate else execFailure source (ReqMove dir) MoveUnskilled else -- Client foolishly tries to move into unwalkable tile. execFailure source (ReqMove dir) MoveNothing -- * ReqMelee -- | Resolves the result of an actor moving into another. -- Actors on unwalkable positions can be attacked without any restrictions. -- For instance, an actor embedded in a wall can be attacked from -- an adjacent position. This function is analogous to projectGroupItem, -- but for melee and not using up the weapon. -- No problem if there are many projectiles at the spot. We just -- attack the one specified. reqMelee :: MonadServerAtomic m => ActorId -> ActorId -> ItemId -> CStore -> m () reqMelee source target iid cstore = do actorSk <- currentSkillsServer source if Ability.getSk Ability.SkMelee actorSk > 0 then reqMeleeChecked True source target iid cstore else execFailure source (ReqMelee target iid cstore) MeleeUnskilled reqMeleeChecked :: forall m. MonadServerAtomic m => Bool -> ActorId -> ActorId -> ItemId -> CStore -> m () reqMeleeChecked voluntary source target iid cstore = do sb <- getsState $ getActorBody source tb <- getsState $ getActorBody target let req = ReqMelee target iid cstore if source == target then execFailure source req MeleeSelf else if not (checkAdjacent sb tb) then execFailure source req MeleeDistant else do -- If @voluntary@ is set, blame is exact, otherwise, an approximation. killer <- if | voluntary -> assert (not (bproj sb)) $ return source | bproj sb -> getsServer $ EM.findWithDefault source source . strajPushedBy | otherwise -> return source discoAspect <- getsState sdiscoAspect let arTrunk = discoAspect EM.! btrunk tb arWeapon = discoAspect EM.! iid sfid = bfid sb tfid = bfid tb -- Let the missile drop down, but don't remove its trajectory -- so that it doesn't pretend to have hit a wall. haltTrajectory :: KillHow -> ActorId -> Actor -> m () haltTrajectory killHow aid b = case btrajectory b of btra@(Just (l, speed)) | not $ null l -> do execUpdAtomic $ UpdTrajectory aid btra $ Just ([], speed) let arTrunkAid = discoAspect EM.! btrunk b when (bproj b && not (IA.checkFlag Ability.Blast arTrunkAid)) $ addKillToAnalytics killer killHow (bfid b) (btrunk b) _ -> return () -- Only catch if braced. Never steal trunk from an already caught -- projectile or one with many items inside. if bproj tb && EM.size (beqp tb) == 1 && not (IA.checkFlag Ability.Blast arTrunk) && actorWaits sb -- still valid while request being processed then do -- Catching the projectile, that is, stealing the item from its eqp. -- No effect from our weapon (organ) is applied to the projectile -- and the weapon (organ) is never destroyed, even if not durable. -- Pushed actor doesn't stop flight by catching the projectile -- nor does he lose 1HP. -- This is not overpowered, because usually at least one partial wait -- is needed to sync (if not, attacker should switch missiles) -- and so only every other missile can be caught. Normal sidestepping -- or sync and displace, if in a corridor, is as effective -- and blocking can be even more so, depending on powers of the missile. -- Missiles are really easy to defend against, but sight (and so, Calm) -- is the key, as well as light, ambush around a corner, etc. execSfxAtomic $ SfxSteal source target iid cstore case EM.assocs $ beqp tb of [(iid2, (k, _))] -> do upds <- generalMoveItem True iid2 k (CActor target CEqp) (CActor source CInv) mapM_ execUpdAtomic upds itemFull <- getsState $ itemToFull iid2 discoverIfMinorEffects (CActor source CInv) iid2 (itemKindId itemFull) err -> error $ "" `showFailure` err haltTrajectory KillCatch target tb else do if bproj sb && bproj tb then do -- Special case for collision of projectiles, because they just -- symmetrically ram into each other, so picking one to hit another, -- based on random timing, would be wrong. -- Instead of suffering melee attack, let the target projectile -- get smashed and burst (if fragile and if not piercing). -- The source projectile terminates flight (unless pierces) later on. when (bhp tb > oneM) $ execUpdAtomic $ UpdRefillHP target minusM when (bhp tb <= oneM) $ do -- If projectile has too low HP to pierce, terminate its flight. let killHow | IA.checkFlag Ability.Blast arWeapon = KillKineticBlast | otherwise = KillKineticRanged haltTrajectory killHow target tb -- Avoid spam when two explosions collide. unless (IA.checkFlag Ability.Blast arWeapon && IA.checkFlag Ability.Blast arTrunk) $ execSfxAtomic $ SfxStrike source target iid cstore else do -- Normal hit, with effects. Msgs inside @SfxStrike@ describe -- the source part of the strike. execSfxAtomic $ SfxStrike source target iid cstore let c = CActor source cstore mayDestroy = not (bproj sb) || bhp sb <= oneM -- piercing projectiles may not have their weapon destroyed -- Msgs inside @itemEffect@ describe the target part of the strike. -- If any effects and aspects, this is also where they are identified. -- Here also the kinetic damage is applied, before any effects are. -- -- Note: that "hornet swarm detect items" via a scrolls is intentional, -- even though unrealistic and funny. Otherwise actors could protect -- themselves from some projectiles by lowering their apply stat. -- Also, the animal faction won't have too much benefit from that info, -- so the problem is not balance, but the goofy message. kineticEffectAndDestroy voluntary killer source target iid c mayDestroy sb2 <- getsState $ getActorBody source case btrajectory sb2 of Just{} -> do -- Deduct a hitpoint for a pierce of a projectile -- or due to a hurled actor colliding with another. -- Don't deduct if no pierce, to prevent spam. -- Never kill in this way. when (bhp sb2 > oneM) $ do execUpdAtomic $ UpdRefillHP source minusM unless (bproj sb2) $ do execSfxAtomic $ SfxMsgFid (bfid sb2) $ SfxCollideActor (blid tb) source target unless (bproj tb) $ execSfxAtomic $ SfxMsgFid (bfid tb) $ SfxCollideActor (blid tb) source target when (not (bproj sb2) || bhp sb2 <= oneM) $ -- Non-projectiles can't pierce, so terminate their flight. -- If projectile has too low HP to pierce, ditto. haltTrajectory KillActorLaunch source sb2 _ -> return () -- The only way to start a war is to slap an enemy voluntarily.. -- Being hit by and hitting projectiles, as well as via pushing, -- count as unintentional friendly fire. sfact <- getsState $ (EM.! sfid) . sfactionD let friendlyFire = bproj sb2 || bproj tb || not voluntary fromDipl = EM.findWithDefault Unknown tfid (gdipl sfact) unless (friendlyFire || isFoe sfid sfact tfid -- already at war || isFriend sfid sfact tfid) $ -- allies never at war execUpdAtomic $ UpdDiplFaction sfid tfid fromDipl War -- * ReqDisplace -- | Actor tries to swap positions with another. reqDisplace :: MonadServerAtomic m => ActorId -> ActorId -> m () reqDisplace = reqDisplaceGeneric True reqDisplaceGeneric :: MonadServerAtomic m => Bool -> ActorId -> ActorId -> m () reqDisplaceGeneric voluntary source target = do COps{coTileSpeedup} <- getsState scops actorSk <- currentSkillsServer source sb <- getsState $ getActorBody source let abInSkill sk = isJust (btrajectory sb) || Ability.getSk sk actorSk > 0 tb <- getsState $ getActorBody target tfact <- getsState $ (EM.! bfid tb) . sfactionD let spos = bpos sb tpos = bpos tb atWar = isFoe (bfid tb) tfact (bfid sb) req = ReqDisplace target actorMaxSk <- getsState $ getActorMaxSkills target dEnemy <- getsState $ dispEnemy source target actorMaxSk if | not (abInSkill Ability.SkDisplace) -> execFailure source req DisplaceUnskilled | not (checkAdjacent sb tb) -> execFailure source req DisplaceDistant | atWar && not dEnemy -> do -- if not at war, can displace always -- We don't fail with DisplaceImmobile and DisplaceSupported. -- because it's quite common they can't be determined by the attacker, -- and so the failure would be too alarming to the player. -- If the character melees instead, the player can tell displace failed. -- As for the other failures, they are impossible and we don't -- verify here that they don't occur, for simplicity. mweapon <- pickWeaponServer source case mweapon of Just (wp, cstore) | abInSkill Ability.SkMelee -> reqMeleeChecked voluntary source target wp cstore _ -> return () -- waiting, even if no @SkWait@ skill | otherwise -> do let lid = blid sb lvl <- getLevel lid -- Displacing requires full access. if Tile.isWalkable coTileSpeedup $ lvl `at` tpos then case posToAidsLvl tpos lvl of [] -> error $ "" `showFailure` (source, sb, target, tb) [_] -> do execUpdAtomic $ UpdDisplaceActor source target -- We leave or wipe out smell, for consistency, but it's not -- absolute consistency, e.g., blinking doesn't touch smell, -- so sometimes smellers will backtrack once to wipe smell. OK. affectSmell source affectSmell target void $ reqAlterFail voluntary source tpos -- possibly alter or activate void $ reqAlterFail voluntary target spos _ -> execFailure source req DisplaceMultiple else -- Client foolishly tries to displace an actor without access. execFailure source req DisplaceAccess -- * ReqAlter -- | Search and/or alter the tile. reqAlter :: MonadServerAtomic m => ActorId -> Point -> m () reqAlter source tpos = do mfail <- reqAlterFail True source tpos let req = ReqAlter tpos maybe (return ()) (execFailure source req) mfail reqAlterFail :: MonadServerAtomic m => Bool -> ActorId -> Point -> m (Maybe ReqFailure) reqAlterFail voluntary source tpos = do cops@COps{cotile, coTileSpeedup} <- getsState scops sb <- getsState $ getActorBody source actorMaxSk <- getsState $ getActorMaxSkills source factionD <- getsState sfactionD let calmE = calmEnough sb actorMaxSk lid = blid sb sClient <- getsServer $ (EM.! bfid sb) . sclientStates itemToF <- getsState $ flip itemToFull actorSk <- currentSkillsServer source localTime <- getsState $ getLocalTime lid let alterSkill = Ability.getSk Ability.SkAlter actorSk embeds <- getsState $ getEmbedBag lid tpos lvl <- getLevel lid getKind <- getsState $ flip getIidKindServer let serverTile = lvl `at` tpos lvlClient = (EM.! lid) . sdungeon $ sClient clientTile = lvlClient `at` tpos hiddenTile = Tile.hideAs cotile serverTile revealEmbeds = unless (EM.null embeds) $ do s <- getState let ais = map (\iid -> (iid, getItemBody iid s)) (EM.keys embeds) execUpdAtomic $ UpdSpotItemBag (CEmbed lid tpos) embeds ais tryApplyEmbeds = mapM_ tryApplyEmbed (sortEmbeds cops getKind serverTile embeds) tryApplyEmbed (iid, kit) = do let itemFull = itemToF iid -- Let even completely apply-unskilled actors trigger basic embeds. -- See the note about no skill check when melee triggers effects. legal = permittedApply localTime maxBound calmE itemFull kit (object1, object2) = partItemShortest (bfid sb) factionD localTime itemFull (1, []) name = makePhrase [object1, object2] case legal of Left ApplyNoEffects -> return () -- pure flavour embed Left reqFail -> -- The failure is fully expected, because client may choose -- to trigger some embeds, knowing that others won't fire. execSfxAtomic $ SfxMsgFid (bfid sb) $ SfxExpected ("embedded" <+> name) reqFail _ -> itemEffectEmbedded voluntary source lid tpos iid underFeet = tpos == bpos sb -- if enter and alter, be more permissive if chessDist tpos (bpos sb) > 1 then return $ Just AlterDistant else if Just clientTile == hiddenTile then -- searches -- Only actors with SkAlter > 1 can search for hidden doors, etc. if not underFeet && alterSkill <= 1 then return $ Just AlterUnskilled -- don't leak about searching else do -- Blocking by items nor actors does not prevent searching. -- Searching broadcasted, in case actors from other factions are present -- so that they can learn the tile and learn our action. -- If they already know the tile, they will just consider our action -- a waste of time and ignore the command. execUpdAtomic $ UpdSearchTile source tpos serverTile -- Searching also reveals the embedded items of the tile. -- If the items are already seen by the client -- (e.g., due to item detection, despite tile being still hidden), -- the command is ignored on the client. revealEmbeds -- If the entries are already seen by the client -- the command is ignored on the client. case EM.lookup tpos $ lentry lvl of Nothing -> return () Just entry -> execUpdAtomic $ UpdSpotEntry lid [(tpos, entry)] -- Seaching triggers the embeds as well, after they are revealed. -- The rationale is that the items were all the time present -- (just invisible to the client), so they need to be triggered. -- The exception is changable tiles, because they are not so easy -- to trigger; they need subsequent altering. unless (Tile.isDoor coTileSpeedup serverTile || Tile.isChangable coTileSpeedup serverTile || EM.null embeds) $ do -- Can't send @SfxTrigger@ afterwards, because actor may be moved -- by the embeds to another level, where @tpos@ is meaningless. execSfxAtomic $ SfxTrigger source tpos tryApplyEmbeds return Nothing -- success else if clientTile == serverTile then -- alters if not underFeet && alterSkill < Tile.alterMinSkill coTileSpeedup serverTile then return $ Just AlterUnskilled -- don't leak about altering else do let changeTo tgroup = do lvl2 <- getLevel lid -- No @SfxAlter@, because the effect is obvious (e.g., opened door). let nightCond kt = not (Tile.kindHasFeature TK.Walkable kt && Tile.kindHasFeature TK.Clear kt) || (if lnight lvl2 then id else not) (Tile.kindHasFeature TK.Dark kt) -- Sometimes the tile is determined precisely by the ambient light -- of the source tiles. If not, default to cave day/night condition. mtoTile <- rndToAction $ opick cotile tgroup nightCond toTile <- maybe (rndToAction $ fromMaybe (error $ "" `showFailure` tgroup) <$> opick cotile tgroup (const True)) return mtoTile unless (toTile == serverTile) $ do -- don't regenerate same tile -- At most one of these two will be accepted on any given client. execUpdAtomic $ UpdAlterTile lid tpos serverTile toTile -- This case happens when a client does not see a searching -- action by another faction, but sees the subsequent altering. case hiddenTile of Just tHidden -> execUpdAtomic $ UpdAlterTile lid tpos tHidden toTile Nothing -> return () case (Tile.isExplorable coTileSpeedup serverTile, Tile.isExplorable coTileSpeedup toTile) of (False, True) -> execUpdAtomic $ UpdAlterExplorable lid 1 (True, False) -> execUpdAtomic $ UpdAlterExplorable lid (-1) _ -> return () -- At the end we replace old embeds (even if partially used up) -- with new ones. -- If the source tile was hidden, the items could not be visible -- on a client, in which case the command would be ignored -- on the client, without causing any problems. Otherwise, -- if the position is in view, client has accurate info. case EM.lookup tpos (lembed lvl2) of Just bag -> do s <- getState let ais = map (\iid -> (iid, getItemBody iid s)) (EM.keys bag) execUpdAtomic $ UpdLoseItemBag (CEmbed lid tpos) bag ais Nothing -> return () -- Altering always reveals the outcome tile, so it's not hidden -- and so its embedded items are always visible. embedItem lid tpos toTile feats = TK.tfeature $ okind cotile serverTile toAlter feat = case feat of TK.OpenTo tgroup -> Just tgroup TK.CloseTo tgroup -> Just tgroup TK.ChangeTo tgroup -> Just tgroup _ -> Nothing groupsToAlterTo | underFeet = [] -- don't autoclose doors under actor | otherwise = mapMaybe toAlter feats if null groupsToAlterTo && EM.null embeds then return $ Just AlterNothing -- no altering possible; silly client else if underFeet || EM.notMember tpos (lfloor lvl) then if underFeet || not (occupiedBigLvl tpos lvl) && not (occupiedProjLvl tpos lvl) then do -- If the only thing that happens is the change of the tile, -- don't display a message, because the change -- is visible on the map (unless it changes into itself) -- and there's nothing more to speak about. unless (EM.null embeds) $ do -- Can't send @SfxTrigger@ afterwards, because actor may be moved -- by the embeds to another level, where @tpos@ is meaningless. -- However, don't spam with projectiles on ice. unless (bproj sb || underFeet) $ execSfxAtomic $ SfxTrigger source tpos -- The embeds of the initial tile are activated before the tile -- is altered. This prevents, e.g., trying to activate items -- where none are present any more, or very different to what -- the client expected. Surprise only comes through searching -- as implemented above. -- The items are first revealed for the sake of clients that -- may see the tile as hidden. Note that the tile is not revealed -- (unless it's altered later on, in which case the new one is). revealEmbeds tryApplyEmbeds case groupsToAlterTo of [] -> return () [groupToAlterTo] -> changeTo groupToAlterTo l -> error $ "tile changeable in many ways" `showFailure` l return Nothing -- success else return $ Just AlterBlockActor else return $ Just AlterBlockItem else -- client is misguided re tile at that position, so bail out return $ Just AlterNothing -- * ReqWait -- | Do nothing. Wait skill 1 required. Bracing requires 2, sleep 3, lurking 4. -- -- Something is sometimes done in 'processWatchfulness'. reqWait :: MonadServerAtomic m => ActorId -> m () {-# INLINE reqWait #-} reqWait source = do actorSk <- currentSkillsServer source unless (Ability.getSk Ability.SkWait actorSk > 0) $ execFailure source ReqWait WaitUnskilled -- * ReqWait10 -- | Do nothing. -- -- Something is sometimes done in 'processWatchfulness'. reqWait10 :: MonadServerAtomic m => ActorId -> m () {-# INLINE reqWait10 #-} reqWait10 source = do actorSk <- currentSkillsServer source unless (Ability.getSk Ability.SkWait actorSk >= 4) $ execFailure source ReqWait10 WaitUnskilled -- * ReqYell -- | Yell/yawn/stretch/taunt. -- Wakes up (gradually) from sleep. Causes noise heard by enemies on the level -- even if out of their hearing range. -- -- Governed by the waiting skill (because everyone is supposed to have it). -- unlike @ReqWait@, induces overhead. -- -- This is similar to the effect @Yell@, but always voluntary. reqYell :: MonadServerAtomic m => ActorId -> m () reqYell source = do actorSk <- currentSkillsServer source if | Ability.getSk Ability.SkWait actorSk > 0 -> -- Last yawn before waking up is displayed as a yell, but that's fine. -- To fix that, we'd need to move the @SfxTaunt@ -- to @processWatchfulness@. execSfxAtomic $ SfxTaunt True source | Ability.getSk Ability.SkMove actorSk <= 0 || Ability.getSk Ability.SkDisplace actorSk <= 0 || Ability.getSk Ability.SkMelee actorSk <= 0 -> -- Potentially, only waiting is possible, so given that it's drained, -- don't let the actor be stuck nor alarm about server failure. execSfxAtomic $ SfxTaunt False source | otherwise -> -- In most situation one of the 3 actions above -- can be performed and waiting skill is not needed for that, -- so given the 3 skills are available, waste turn -- but don't alarm, because it does happen sometimes in crowds. -- execFailure source ReqYell YellUnskilled return () -- * ReqMoveItems reqMoveItems :: MonadServerAtomic m => ActorId -> [(ItemId, Int, CStore, CStore)] -> m () reqMoveItems source l = do actorSk <- currentSkillsServer source if Ability.getSk Ability.SkMoveItem actorSk > 0 then do b <- getsState $ getActorBody source actorMaxSk <- getsState $ getActorMaxSkills source -- Server accepts item movement based on calm at the start, not end -- or in the middle, to avoid interrupted or partially ignored commands. let calmE = calmEnough b actorMaxSk mapM_ (reqMoveItem source calmE) l else execFailure source (ReqMoveItems l) MoveItemUnskilled reqMoveItem :: MonadServerAtomic m => ActorId -> Bool -> (ItemId, Int, CStore, CStore) -> m () reqMoveItem aid calmE (iid, k, fromCStore, toCStore) = do b <- getsState $ getActorBody aid let fromC = CActor aid fromCStore req = ReqMoveItems [(iid, k, fromCStore, toCStore)] toC <- case toCStore of CGround -> pickDroppable False aid b -- drop over fog, etc. _ -> return $! CActor aid toCStore bagBefore <- getsState $ getContainerBag toC if | k < 1 || fromCStore == toCStore -> execFailure aid req ItemNothing | toCStore == CEqp && eqpOverfull b k -> execFailure aid req EqpOverfull | (fromCStore == CSha || toCStore == CSha) && not calmE -> execFailure aid req ItemNotCalm | otherwise -> do upds <- generalMoveItem True iid k fromC toC mapM_ execUpdAtomic upds itemFull <- getsState $ itemToFull iid when (fromCStore == CGround) $ -- pick up discoverIfMinorEffects toC iid (itemKindId itemFull) -- The first recharging period after equipping is random, -- between 1 and 2 standard timeouts of the item. -- We reset timeout for equipped periodic items and also for items -- moved out of the shared stash, in which timeouts are not consistent -- wrt some local time, because actors from many levels put items there -- all the time (and don't rebase it to any common clock). -- If wrong local time in shared stash causes an item to recharge -- for a very long time, the player can reset it by moving it to pack -- and back to stash (as a flip side, a charging item in stash may sometimes -- be used at once on another level, with different local time, but only -- once, because after first use, the timeout is set to local time). -- This is not terribly consistent, but not recharging in stash is -- not better, because either we block activation of any items with timeout, -- or encourage moving items out of stash, recharging and moving in. -- Which is not fun at all, but one more thing to remember doing regularly. when (toCStore `elem` [CEqp, COrgan] && fromCStore `notElem` [CEqp, COrgan] || fromCStore == CSha) $ do let beforeIt = case iid `EM.lookup` bagBefore of Nothing -> [] -- no such items before move Just (_, it2) -> it2 randomResetTimeout k iid itemFull beforeIt toC -- * ReqProject reqProject :: MonadServerAtomic m => ActorId -- ^ actor projecting the item (is on current lvl) -> Point -- ^ target position of the projectile -> Int -- ^ digital line parameter -> ItemId -- ^ the item to be projected -> CStore -- ^ whether the items comes from floor or inventory -> m () reqProject source tpxy eps iid cstore = do let req = ReqProject tpxy eps iid cstore b <- getsState $ getActorBody source actorMaxSk <- getsState $ getActorMaxSkills source let calmE = calmEnough b actorMaxSk if cstore == CSha && not calmE then execFailure source req ItemNotCalm else do mfail <- projectFail source source tpxy eps False iid cstore False maybe (return ()) (execFailure source req) mfail -- * ReqApply reqApply :: MonadServerAtomic m => ActorId -- ^ actor applying the item (is on current level) -> ItemId -- ^ the item to be applied -> CStore -- ^ the location of the item -> m () reqApply aid iid cstore = do let req = ReqApply iid cstore b <- getsState $ getActorBody aid actorMaxSk <- getsState $ getActorMaxSkills aid let calmE = calmEnough b actorMaxSk if cstore == CSha && not calmE then execFailure aid req ItemNotCalm else do bag <- getsState $ getBodyStoreBag b cstore case EM.lookup iid bag of Nothing -> execFailure aid req ApplyOutOfReach Just kit -> do itemFull <- getsState $ itemToFull iid actorSk <- currentSkillsServer aid localTime <- getsState $ getLocalTime (blid b) let skill = Ability.getSk Ability.SkApply actorSk legal = permittedApply localTime skill calmE itemFull kit case legal of Left reqFail -> execFailure aid req reqFail Right _ -> applyItem aid iid cstore -- * ReqGameRestart reqGameRestart :: MonadServerAtomic m => ActorId -> GroupName ModeKind -> Challenge -> m () reqGameRestart aid groupName scurChalSer = do -- This call to `revealItems` is really needed, because the other -- happens only at natural game conclusion, not at forced quitting. isNoConfirms <- isNoConfirmsGame factionD <- getsState sfactionD let fidsUI = map fst $ filter (\(_, fact) -> fhasUI (gplayer fact)) (EM.assocs factionD) itemD <- getsState sitemD dungeon <- getsState sdungeon let ais = EM.assocs itemD minLid = fst $ minimumBy (Ord.comparing (ldepth . snd)) $ EM.assocs dungeon unless isNoConfirms $ mapM_ (\fid -> do execUpdAtomic $ UpdSpotItemBag (CTrunk fid minLid originPoint) EM.empty ais revealItems fid) fidsUI -- Announcing end of game, we send lore, because game is over. b <- getsState $ getActorBody aid oldSt <- getsState $ gquit . (EM.! bfid b) . sfactionD factionAn <- getsServer sfactionAn generationAn <- getsServer sgenerationAn execUpdAtomic $ UpdQuitFaction (bfid b) oldSt (Just $ Status Restart (fromEnum $ blid b) (Just groupName)) (Just (factionAn, generationAn)) -- We don't save game and don't wait for clips end. ASAP. modifyServer $ \ser -> ser { sbreakASAP = True , soptionsNxt = (soptionsNxt ser) {scurChalSer} } -- * ReqGameDropAndExit -- After we break out of the game loop, we will notice from @Camping@ -- we shouldn exit the game. reqGameDropAndExit :: MonadServerAtomic m => ActorId -> m () reqGameDropAndExit aid = do b <- getsState $ getActorBody aid oldSt <- getsState $ gquit . (EM.! bfid b) . sfactionD execUpdAtomic $ UpdQuitFaction (bfid b) oldSt (Just $ Status Camping (fromEnum $ blid b) Nothing) Nothing modifyServer $ \ser -> ser { sbreakASAP = True , sbreakLoop = True } -- * ReqGameSaveAndExit -- After we break out of the game loop, we will notice from @Camping@ -- we shouldn exit the game. reqGameSaveAndExit :: MonadServerAtomic m => ActorId -> m () reqGameSaveAndExit aid = do b <- getsState $ getActorBody aid oldSt <- getsState $ gquit . (EM.! bfid b) . sfactionD execUpdAtomic $ UpdQuitFaction (bfid b) oldSt (Just $ Status Camping (fromEnum $ blid b) Nothing) Nothing modifyServer $ \ser -> ser { sbreakASAP = True , swriteSave = True } -- * ReqGameSave -- After we break out of the game loop, we will notice we shouldn't quit -- the game and we will enter the game loop again. reqGameSave :: MonadServer m => m () reqGameSave = modifyServer $ \ser -> ser { sbreakASAP = True , swriteSave = True } -- * ReqTactic reqTactic :: MonadServerAtomic m => FactionId -> Ability.Tactic -> m () reqTactic fid toT = do fromT <- getsState $ ftactic . gplayer . (EM.! fid) . sfactionD execUpdAtomic $ UpdTacticFaction fid toT fromT -- * ReqAutomate reqAutomate :: MonadServerAtomic m => FactionId -> m () reqAutomate fid = execUpdAtomic $ UpdAutoFaction fid True LambdaHack-0.9.5.0/engine-src/Game/LambdaHack/Server/ItemM.hs0000644000000000000000000002415307346545000021517 0ustar0000000000000000-- | Server operations for items. module Game.LambdaHack.Server.ItemM ( registerItem, randomResetTimeout, embedItem, prepareItemKind, rollItemAspect , rollAndRegisterItem , placeItemsInDungeon, embedItemsInDungeon, mapActorCStore_ #ifdef EXPOSE_INTERNAL -- * Internal operations , onlyRegisterItem, computeRndTimeout, createLevelItem #endif ) where import Prelude () import Game.LambdaHack.Core.Prelude import qualified Data.EnumMap.Strict as EM import qualified Data.EnumSet as ES import Data.Function import qualified Data.HashMap.Strict as HM import Data.Ord import Game.LambdaHack.Atomic import Game.LambdaHack.Common.Actor import Game.LambdaHack.Common.ActorState import Game.LambdaHack.Common.Item import qualified Game.LambdaHack.Common.ItemAspect as IA import Game.LambdaHack.Common.Kind import Game.LambdaHack.Common.Level import Game.LambdaHack.Common.MonadStateRead import Game.LambdaHack.Common.State import qualified Game.LambdaHack.Common.Tile as Tile import Game.LambdaHack.Common.Time import Game.LambdaHack.Common.Types import Game.LambdaHack.Content.CaveKind (citemFreq, citemNum) import Game.LambdaHack.Content.ItemKind (ItemKind) import qualified Game.LambdaHack.Content.ItemKind as IK import Game.LambdaHack.Content.TileKind (TileKind) import Game.LambdaHack.Core.Frequency import Game.LambdaHack.Common.Point import qualified Game.LambdaHack.Common.PointArray as PointArray import Game.LambdaHack.Core.Random import qualified Game.LambdaHack.Definition.Ability as Ability import Game.LambdaHack.Definition.Defs import Game.LambdaHack.Server.ItemRev import Game.LambdaHack.Server.MonadServer import Game.LambdaHack.Server.ServerOptions import Game.LambdaHack.Server.State onlyRegisterItem :: MonadServerAtomic m => ItemKnown -> m ItemId onlyRegisterItem itemKnown@(ItemKnown _ arItem _) = do itemRev <- getsServer sitemRev case HM.lookup itemKnown itemRev of Just iid -> return iid Nothing -> do icounter <- getsServer sicounter executedOnServer <- execUpdAtomicSer $ UpdDiscoverServer icounter arItem let !_A = assert executedOnServer () modifyServer $ \ser -> ser { sitemRev = HM.insert itemKnown icounter (sitemRev ser) , sicounter = succ icounter } return $! icounter registerItem :: MonadServerAtomic m => ItemFullKit -> ItemKnown -> Container -> Bool -> m ItemId registerItem (itemFull@ItemFull{itemBase, itemKindId, itemKind}, kit) itemKnown@(ItemKnown _ arItem _) container verbose = do iid <- onlyRegisterItem itemKnown let slore = IA.loreFromContainer arItem container modifyServer $ \ser -> ser {sgenerationAn = EM.adjust (EM.insertWith (+) iid (fst kit)) slore (sgenerationAn ser)} let cmd = if verbose then UpdCreateItem else UpdSpotItem False execUpdAtomic $ cmd iid itemBase kit container let worth = itemPrice (fst kit) itemKind unless (worth == 0) $ execUpdAtomic $ UpdAlterGold worth knowItems <- getsServer $ sknowItems . soptions when knowItems $ case container of CTrunk{} -> return () _ -> execUpdAtomic $ UpdDiscover container iid itemKindId arItem -- The first recharging period after creation is random, -- between 1 and 2 standard timeouts of the item. -- In this way we avoid many rattlesnakes rattling in unison. case container of CActor _ cstore | cstore `elem` [CEqp, COrgan] -> randomResetTimeout (fst kit) iid itemFull [] container _ -> return () return iid randomResetTimeout :: MonadServerAtomic m => Int -> ItemId -> ItemFull -> [Time] -> Container -> m () randomResetTimeout k iid itemFull beforeIt toC = do lid <- getsState $ lidFromC toC localTime <- getsState $ getLocalTime lid mrndTimeout <- rndToAction $ computeRndTimeout localTime itemFull -- The created or moved item set (not the items previously at destination) -- has its timeouts reset to a random value between timeout and twice timeout. -- This prevents micromanagement via swapping items in and out of eqp -- and via exact prediction of first timeout after equip. case mrndTimeout of Just rndT -> do bagAfter <- getsState $ getContainerBag toC let afterIt = case iid `EM.lookup` bagAfter of Nothing -> error $ "" `showFailure` (iid, bagAfter, toC) Just (_, it2) -> it2 resetIt = beforeIt ++ replicate k rndT when (afterIt /= resetIt) $ execUpdAtomic $ UpdTimeItem iid toC afterIt resetIt Nothing -> return () -- no @Timeout@ aspect; don't touch computeRndTimeout :: Time -> ItemFull -> Rnd (Maybe Time) computeRndTimeout localTime ItemFull{itemDisco=ItemDiscoFull itemAspect} = do let t = IA.aTimeout itemAspect if t /= 0 then do rndT <- randomR (0, t) let rndTurns = timeDeltaScale (Delta timeTurn) (t + rndT) return $ Just $ timeShift localTime rndTurns else return Nothing computeRndTimeout _ _ = error "computeRndTimeout: server ignorant about an item" createLevelItem :: MonadServerAtomic m => Point -> LevelId -> m () createLevelItem pos lid = do COps{cocave} <- getsState scops Level{lkind} <- getLevel lid let container = CFloor lid pos litemFreq = citemFreq $ okind cocave lkind void $ rollAndRegisterItem lid litemFreq container True Nothing embedItem :: MonadServerAtomic m => LevelId -> Point -> ContentId TileKind -> m () embedItem lid pos tk = do COps{cotile} <- getsState scops let embeds = Tile.embeddedItems cotile tk container = CEmbed lid pos f grp = rollAndRegisterItem lid [(grp, 1)] container False Nothing mapM_ f embeds prepareItemKind :: MonadServerAtomic m => Int -> LevelId -> Freqs ItemKind -> m (Frequency (ContentId IK.ItemKind, ItemKind)) prepareItemKind lvlSpawned lid itemFreq = do cops <- getsState scops uniqueSet <- getsServer suniqueSet totalDepth <- getsState stotalDepth Level{ldepth} <- getLevel lid return $! newItemKind cops uniqueSet itemFreq ldepth totalDepth lvlSpawned rollItemAspect :: MonadServerAtomic m => Frequency (ContentId IK.ItemKind, ItemKind) -> LevelId -> m (Maybe (ItemKnown, ItemFullKit)) rollItemAspect freq lid = do cops <- getsState scops flavour <- getsServer sflavour discoRev <- getsServer sdiscoKindRev totalDepth <- getsState stotalDepth Level{ldepth} <- getLevel lid m2 <- rndToAction $ newItem cops freq flavour discoRev ldepth totalDepth case m2 of Just (itemKnown, ifk@(itemFull@ItemFull{itemKindId}, _)) -> do let arItem = aspectRecordFull itemFull when (IA.checkFlag Ability.Unique arItem) $ modifyServer $ \ser -> ser {suniqueSet = ES.insert itemKindId (suniqueSet ser)} return $ Just (itemKnown, ifk) Nothing -> return Nothing rollAndRegisterItem :: MonadServerAtomic m => LevelId -> Freqs ItemKind -> Container -> Bool -> Maybe Int -> m (Maybe (ItemId, ItemFullKit)) rollAndRegisterItem lid itemFreq container verbose mk = do -- Power depth of new items unaffected by number of spawned actors. freq <- prepareItemKind 0 lid itemFreq m2 <- rollItemAspect freq lid case m2 of Nothing -> return Nothing Just (itemKnown, (itemFull, kit)) -> do let kit2 = (fromMaybe (fst kit) mk, snd kit) iid <- registerItem (itemFull, kit2) itemKnown container verbose return $ Just (iid, (itemFull, kit2)) placeItemsInDungeon :: forall m. MonadServerAtomic m => EM.EnumMap LevelId [Point] -> m () placeItemsInDungeon alliancePositions = do COps{cocave, coTileSpeedup} <- getsState scops totalDepth <- getsState stotalDepth let initialItems (lid, lvl@Level{lkind, ldepth}) = do litemNum <- rndToAction $ castDice ldepth totalDepth (citemNum $ okind cocave lkind) let alPos = EM.findWithDefault [] lid alliancePositions placeItems :: Int -> m () placeItems n | n == litemNum = return () placeItems !n = do Level{lfloor} <- getLevel lid -- Don't generate items around initial actors or in bunches. let distAllianceAndNotFloor !p _ = let f !k b = chessDist p k > 4 && b in p `EM.notMember` lfloor && foldr f True alPos mpos <- rndToAction $ findPosTry2 20 lvl (\_ !t -> Tile.isWalkable coTileSpeedup t && not (Tile.isNoItem coTileSpeedup t)) [ \_ !t -> Tile.isVeryOftenItem coTileSpeedup t , \_ !t -> Tile.isCommonItem coTileSpeedup t ] distAllianceAndNotFloor [ distAllianceAndNotFloor , distAllianceAndNotFloor ] case mpos of Just pos -> do createLevelItem pos lid placeItems (n + 1) Nothing -> debugPossiblyPrint "Server: placeItemsInDungeon: failed to find positions" placeItems 0 dungeon <- getsState sdungeon -- Make sure items on easy levels are generated first, to avoid all -- artifacts on deep levels. let absLid = abs . fromEnum fromEasyToHard = sortBy (comparing absLid `on` fst) $ EM.assocs dungeon mapM_ initialItems fromEasyToHard embedItemsInDungeon :: MonadServerAtomic m => m () embedItemsInDungeon = do let embedItems (lid, Level{ltile}) = PointArray.imapMA_ (embedItem lid) ltile dungeon <- getsState sdungeon -- Make sure items on easy levels are generated first, to avoid all -- artifacts on deep levels. let absLid = abs . fromEnum fromEasyToHard = sortBy (comparing absLid `on` fst) $ EM.assocs dungeon mapM_ embedItems fromEasyToHard -- | Mapping over actor's items from a give store. mapActorCStore_ :: MonadServer m => CStore -> (ItemId -> ItemQuant -> m a) -> Actor -> m () mapActorCStore_ cstore f b = do bag <- getsState $ getBodyStoreBag b cstore mapM_ (uncurry f) $ EM.assocs bag LambdaHack-0.9.5.0/engine-src/Game/LambdaHack/Server/ItemRev.hs0000644000000000000000000002114707346545000022057 0ustar0000000000000000{-# LANGUAGE DeriveGeneric, GeneralizedNewtypeDeriving #-} -- | Creation of items on the server. Types and operations that don't involve -- server state nor our custom monads. module Game.LambdaHack.Server.ItemRev ( ItemKnown(..), ItemRev, UniqueSet, buildItem, newItemKind, newItem -- * Item discovery types , DiscoveryKindRev, emptyDiscoveryKindRev, serverDiscos -- * The @FlavourMap@ type , FlavourMap, emptyFlavourMap, dungeonFlavourMap ) where import Prelude () import Game.LambdaHack.Core.Prelude import Data.Binary import qualified Data.EnumMap.Strict as EM import qualified Data.EnumSet as ES import Data.Hashable (Hashable) import qualified Data.HashMap.Strict as HM import Data.Vector.Binary () import qualified Data.Vector.Unboxed as U import GHC.Generics (Generic) import Game.LambdaHack.Common.Item import qualified Game.LambdaHack.Common.ItemAspect as IA import Game.LambdaHack.Common.Kind import Game.LambdaHack.Common.Time import Game.LambdaHack.Common.Types import Game.LambdaHack.Content.ItemKind (ItemKind) import qualified Game.LambdaHack.Content.ItemKind as IK import qualified Game.LambdaHack.Core.Dice as Dice import Game.LambdaHack.Core.Frequency import Game.LambdaHack.Core.Random import qualified Game.LambdaHack.Definition.Ability as Ability import qualified Game.LambdaHack.Definition.Color as Color import Game.LambdaHack.Definition.Defs import Game.LambdaHack.Definition.Flavour -- | The essential item properties, used for the @ItemRev@ hash table -- from items to their ids, needed to assign ids to newly generated items. -- All the other meaningul properties can be derived from them. -- Note: item seed instead of @AspectRecord@ is not enough, -- becaused different seeds may result in the same @AspectRecord@ -- and we don't want such items to be distinct in UI and elsewhere. data ItemKnown = ItemKnown ItemIdentity IA.AspectRecord (Maybe FactionId) deriving (Show, Eq, Generic) instance Binary ItemKnown instance Hashable ItemKnown -- | Reverse item map, for item creation, to keep items and item identifiers -- in bijection. type ItemRev = HM.HashMap ItemKnown ItemId type UniqueSet = ES.EnumSet (ContentId ItemKind) -- | Build an item with the given kind and aspects. buildItem :: COps -> IA.AspectRecord -> FlavourMap -> DiscoveryKindRev -> ContentId ItemKind -> Item buildItem COps{coitem} arItem (FlavourMap flavourMap) (DiscoveryKindRev discoRev) ikChosen = let jkind = case IA.aHideAs arItem of Just grp -> let kindHidden = ouniqGroup coitem grp in IdentityCovered (toEnum $ fromEnum $ discoRev U.! contentIdIndex ikChosen) kindHidden Nothing -> IdentityObvious ikChosen jfid = Nothing -- the default jflavour = toEnum $ fromEnum $ flavourMap U.! contentIdIndex ikChosen in Item{..} -- | Roll an item kind based on given @Freqs@ and kind rarities newItemKind :: COps -> UniqueSet -> Freqs ItemKind -> Dice.AbsDepth -> Dice.AbsDepth -> Int -> Frequency (ContentId IK.ItemKind, ItemKind) newItemKind COps{coitem, coItemSpeedup} uniqueSet itemFreq (Dice.AbsDepth ldepth) (Dice.AbsDepth totalDepth) lvlSpawned = -- Effective generation depth of actors (not items) increases with spawns. -- Up to 10 spawns, no effect. With 20 spawns, depth + 5, and then -- each 10 spawns adds 5 depth. Capped by @totalDepth@, to ensure variety. let numSpawnedCoeff = max 0 $ lvlSpawned `div` 2 - 5 -- The first 10 spawns are of the nominal level. ldSpawned = min totalDepth $ ldepth + numSpawnedCoeff f _ acc _ ik _ | ik `ES.member` uniqueSet = acc f !q !acc !p !ik !kind = -- Don't consider lvlSpawned for uniques, except those that have -- @Unique@ under @Odds@. let ld = if IA.checkFlag Ability.Unique $ IA.kmMean $ getKindMean ik coItemSpeedup then ldepth else ldSpawned rarity = linearInterpolation ld totalDepth (IK.irarity kind) !fr = q * p * rarity in (fr, (ik, kind)) : acc g (!itemGroup, !q) = ofoldlGroup' coitem itemGroup (f q) [] freqDepth = concatMap g itemFreq in toFreq "newItemKind" freqDepth -- | Given item kind frequency, roll item kind, generate item aspects -- based on level and put together the full item data set. newItem :: COps -> Frequency (ContentId IK.ItemKind, ItemKind) -> FlavourMap -> DiscoveryKindRev -> Dice.AbsDepth -> Dice.AbsDepth -> Rnd (Maybe (ItemKnown, ItemFullKit)) newItem cops freq flavourMap discoRev levelDepth totalDepth = if nullFreq freq then return Nothing else do (itemKindId, itemKind) <- frequency freq -- Number of new items/actors unaffected by number of spawned actors. itemN <- castDice levelDepth totalDepth (IK.icount itemKind) arItem <- IA.rollAspectRecord (IK.iaspects itemKind) levelDepth totalDepth let itemBase = buildItem cops arItem flavourMap discoRev itemKindId itemIdentity = jkind itemBase itemK = max 1 itemN itemTimer = [timeZero | IA.checkFlag Ability.Periodic arItem] -- delay first discharge of single organs itemSuspect = False -- Bonuses on items/actors unaffected by number of spawned actors. let itemDisco = ItemDiscoFull arItem itemFull = ItemFull {..} return $ Just ( ItemKnown itemIdentity arItem (jfid itemBase) , (itemFull, (itemK, itemTimer)) ) -- | The reverse map to @DiscoveryKind@, needed for item creation. -- This is total and never changes, hence implemented as vector. -- Morally, it's indexed by @ContentId ItemKind@ and elements are @ItemKindIx@. newtype DiscoveryKindRev = DiscoveryKindRev (U.Vector Word16) deriving (Show, Binary) emptyDiscoveryKindRev :: DiscoveryKindRev emptyDiscoveryKindRev = DiscoveryKindRev U.empty serverDiscos :: COps -> Rnd (DiscoveryKind, DiscoveryKindRev) serverDiscos COps{coitem} = do let ixs = [toEnum 0..toEnum (olength coitem - 1)] shuffled <- shuffle ixs let f (!ikMap, !ikRev, (!ix) : rest) !kmKind _ = (EM.insert ix kmKind ikMap, EM.insert kmKind ix ikRev, rest) f (ikMap, _, []) ik _ = error $ "too short ixs" `showFailure` (ik, ikMap) (discoS, discoRev, _) = ofoldlWithKey' coitem f (EM.empty, EM.empty, shuffled) udiscoRev = U.fromListN (olength coitem) $ map (toEnum . fromEnum) $ EM.elems discoRev return (discoS, DiscoveryKindRev udiscoRev) -- | Flavours assigned by the server to item kinds, in this particular game. -- This is total and never changes, hence implemented as vector. -- Morally, it's indexed by @ContentId ItemKind@ and elements are @Flavour@. newtype FlavourMap = FlavourMap (U.Vector Word16) deriving (Show, Binary) emptyFlavourMap :: FlavourMap emptyFlavourMap = FlavourMap U.empty stdFlav :: ES.EnumSet Flavour stdFlav = ES.fromList [ Flavour fn bc | fn <- [minBound..maxBound], bc <- Color.stdCol ] -- | Assigns flavours to item kinds. Assures no flavor is repeated for the same -- symbol, except for items with only one permitted flavour. rollFlavourMap :: Rnd ( EM.EnumMap (ContentId ItemKind) Flavour , EM.EnumMap Char (ES.EnumSet Flavour) ) -> ContentId ItemKind -> ItemKind -> Rnd ( EM.EnumMap (ContentId ItemKind) Flavour , EM.EnumMap Char (ES.EnumSet Flavour) ) rollFlavourMap !rnd !key !ik = case IK.iflavour ik of [] -> error "empty iflavour" [flavour] -> do (!assocs, !availableMap) <- rnd return ( EM.insert key flavour assocs , availableMap) flvs -> do (!assocs, !availableMap) <- rnd let available = EM.findWithDefault stdFlav (IK.isymbol ik) availableMap proper = ES.fromList flvs `ES.intersection` available assert (not (ES.null proper) `blame` "not enough flavours for items" `swith` (flvs, available, ik, availableMap)) $ do flavour <- oneOf $ ES.toList proper let availableReduced = ES.delete flavour available return ( EM.insert key flavour assocs , EM.insert (IK.isymbol ik) availableReduced availableMap) -- | Randomly chooses flavour for all item kinds for this game. dungeonFlavourMap :: COps -> Rnd FlavourMap dungeonFlavourMap COps{coitem} = do (assocsFlav, _) <- ofoldlWithKey' coitem rollFlavourMap (return (EM.empty, EM.empty)) let uFlav = U.fromListN (olength coitem) $ map (toEnum . fromEnum) $ EM.elems assocsFlav return $! FlavourMap uFlav LambdaHack-0.9.5.0/engine-src/Game/LambdaHack/Server/LoopM.hs0000644000000000000000000007453507346545000021543 0ustar0000000000000000-- | The main loop of the server, processing human and computer player -- moves turn by turn. module Game.LambdaHack.Server.LoopM ( loopSer #ifdef EXPOSE_INTERNAL -- * Internal operations , factionArena, arenasForLoop, handleFidUpd, loopUpd, endClip , manageCalmAndDomination, applyPeriodicLevel , handleTrajectories, hTrajectories, advanceTrajectory , handleActors, hActors, restartGame #endif ) where import Prelude () import Game.LambdaHack.Core.Prelude import qualified Data.EnumMap.Strict as EM import qualified Data.EnumSet as ES import Game.LambdaHack.Atomic import Game.LambdaHack.Client (ReqUI (..)) import Game.LambdaHack.Common.Actor import Game.LambdaHack.Common.ActorState import Game.LambdaHack.Common.Analytics import Game.LambdaHack.Common.Faction import Game.LambdaHack.Common.Item import qualified Game.LambdaHack.Common.ItemAspect as IA import Game.LambdaHack.Common.Kind import Game.LambdaHack.Common.Level import Game.LambdaHack.Common.Misc import Game.LambdaHack.Common.MonadStateRead import Game.LambdaHack.Common.Perception import Game.LambdaHack.Common.State import qualified Game.LambdaHack.Common.Tile as Tile import Game.LambdaHack.Common.Time import Game.LambdaHack.Common.Types import Game.LambdaHack.Common.Vector import qualified Game.LambdaHack.Content.ItemKind as IK import Game.LambdaHack.Content.ModeKind import Game.LambdaHack.Content.RuleKind import qualified Game.LambdaHack.Definition.Ability as Ability import Game.LambdaHack.Definition.Defs import Game.LambdaHack.Server.CommonM import Game.LambdaHack.Server.EndM import Game.LambdaHack.Server.HandleEffectM import Game.LambdaHack.Server.HandleRequestM import Game.LambdaHack.Server.MonadServer import Game.LambdaHack.Server.PeriodicM import Game.LambdaHack.Server.ProtocolM import Game.LambdaHack.Server.ServerOptions import Game.LambdaHack.Server.StartM import Game.LambdaHack.Server.State -- | Start a game session, including the clients, and then loop, -- communicating with the clients. -- -- The loop is started in server state that is empty, see 'emptyStateServer'. loopSer :: (MonadServerAtomic m, MonadServerComm m) => ServerOptions -- ^ player-supplied server options -> (Bool -> FactionId -> ChanServer -> IO ()) -- ^ function that initializes a client and runs its main loop -> m () loopSer serverOptions executorClient = do -- Recover states and launch clients. modifyServer $ \ser -> ser { soptionsNxt = serverOptions , soptions = serverOptions } cops <- getsState scops let updConn = updateConn executorClient restored <- tryRestore case restored of Just (sRaw, ser) | not $ snewGameSer serverOptions -> do -- a restored game execUpdAtomic $ UpdResumeServer $ updateCOpsAndCachedData (const cops) sRaw putServer ser {soptionsNxt = serverOptions} applyDebug factionD <- getsState sfactionD let f fid = let cmd = UpdResumeServer $ updateCOpsAndCachedData (const cops) $ sclientStates ser EM.! fid in execUpdAtomicFidCatch fid cmd mapM_ f $ EM.keys factionD updConn initPer pers <- getsServer sperFid let clear = const emptyPer persFid fid | sknowEvents serverOptions = EM.map clear (pers EM.! fid) | otherwise = pers EM.! fid mapM_ (\fid -> sendUpdate fid $ UpdResume fid (persFid fid)) (EM.keys factionD) arenasNew <- arenasForLoop modifyServer $ \ser2 -> ser2 {sarenas = arenasNew, svalidArenas = True} -- We dump RNG seeds here, based on @soptionsNxt@, in case the game -- wasn't run with @--dumpInitRngs@ previously, but we need the seeds, -- e.g., to diagnose a crash. rngs <- getsServer srngs when (sdumpInitRngs serverOptions) $ dumpRngs rngs _ -> do -- starting new game for this savefile (--newGame or fresh save) s <- gameReset serverOptions Nothing Nothing -- get RNG from item boost -- Set up commandline options. let optionsBarRngs = serverOptions {sdungeonRng = Nothing, smainRng = Nothing} modifyServer $ \ser -> ser { soptionsNxt = optionsBarRngs , soptions = optionsBarRngs } execUpdAtomic $ UpdRestartServer s updConn initPer reinitGame writeSaveAll False loopUpd updConn factionArena :: MonadStateRead m => Faction -> m (Maybe LevelId) factionArena fact = case gleader fact of -- Even spawners need an active arena for their leader, -- or they start clogging stairs. Just leader -> do b <- getsState $ getActorBody leader return $ Just $ blid b Nothing -> return Nothing -- This means Allure heroes can kill all aliens on lvl 4, retreat, -- hide and sleep on lvl 3 and they are guaranteed aliens don't spawn. -- However, animals still spawn, if slowly, and aliens resume -- spawning when heroes move on again. arenasForLoop :: MonadStateRead m => m [LevelId] {-# INLINE arenasForLoop #-} arenasForLoop = do factionD <- getsState sfactionD marenas <- mapM factionArena $ EM.elems factionD let arenas = ES.toList $ ES.fromList $ catMaybes marenas !_A = assert (not (null arenas) `blame` "game over not caught earlier" `swith` factionD) () return $! arenas handleFidUpd :: forall m. (MonadServerAtomic m, MonadServerComm m) => (FactionId -> m ()) -> FactionId -> Faction -> m () {-# INLINE handleFidUpd #-} handleFidUpd updatePerFid fid fact = do -- Update perception on all levels at once, -- in case a leader is changed to actor on another -- (possibly not even currently active) level. -- This runs for all factions even if save is requested by UI. -- Let players ponder new game state while the engine is busy saving. -- Also, this ensures perception before game save is exactly the same -- as at game resume, which is an invariant we check elsewhere. -- However, if perception is not updated after the action, the actor -- may not see his vicinity, so may not see enemy that displaces (or hits) him -- resulting in breaking the displace action and temporary leader loss, -- which is fine, though a bit alarming. So, we update it at the end. updatePerFid fid -- Move a single actor only. Note that the skipped actors are not marked -- as waiting. Normally they will act in the next clip or the next few, -- so that's natural. But if there are dozens of them, this is wierd. -- E.g., they don't move, but still make nearby foes lose Calm. -- However, for KISS, we leave it be. -- -- Bail out if immediate loop break- requested by UI. No check -- for @sbreakLoop@ needed, for the same reasons as in @handleActors@. let handle :: [LevelId] -> m Bool handle [] = return False handle (lid : rest) = do breakASAP <- getsServer sbreakASAP if breakASAP then return False else do nonWaitMove <- handleActors lid fid if nonWaitMove then return True else handle rest killDying :: [LevelId] -> m () killDying = mapM_ killDyingLid killDyingLid :: LevelId -> m () killDyingLid lid = do localTime <- getsState $ getLocalTime lid levelTime <- getsServer $ (EM.! lid) . (EM.! fid) . sactorTime let l = filter (\(_, atime) -> atime <= localTime) $ EM.assocs levelTime killAid (aid, _) = do b1 <- getsState $ getActorBody aid when (bhp b1 <= 0) $ dieSer aid b1 mapM_ killAid l -- Start on arena with leader, if available. This is crucial to ensure -- that no actor (even ours) moves before UI declares save(&exit). fa <- factionArena fact arenas <- getsServer sarenas let myArenas = case fa of Just myArena -> myArena : delete myArena arenas Nothing -> arenas nonWaitMove <- handle myArenas breakASAP <- getsServer sbreakASAP unless breakASAP $ killDying myArenas -- We update perception at the end, see comment above. This is usually -- cheap, and when not, if it's AI faction, it's a waste, but if it's UI, -- that's exactly where it prevents lost attack messages, etc. -- If the move was a wait, perception unchanged, so no need to update, -- unless the actor starts sleeping, in which case his perception -- is reduced a bit later, so no harm done. when nonWaitMove $ updatePerFid fid -- | Handle a clip (the smallest fraction of a game turn for which a frame may -- potentially be generated). Run the leader and other actors moves. -- Eventually advance the time and repeat. loopUpd :: forall m. (MonadServerAtomic m, MonadServerComm m) => m () -> m () loopUpd updConn = do let updatePerFid :: FactionId -> m () {-# NOINLINE updatePerFid #-} updatePerFid fid = do -- {-# SCC updatePerFid #-} do perValid <- getsServer $ (EM.! fid) . sperValidFid mapM_ (\(lid, valid) -> unless valid $ updatePer fid lid) (EM.assocs perValid) handleFid :: (FactionId, Faction) -> m () {-# NOINLINE handleFid #-} handleFid (fid, fact) = do breakASAP <- getsServer sbreakASAP -- Don't process other factions, even their perceptions, -- if UI saves and/or exits. unless breakASAP $ handleFidUpd updatePerFid fid fact loopConditionally = do factionD <- getsState sfactionD -- Update perception one last time to satisfy save/resume assertions, -- because we may get here at arbitrary moment due to game over -- and so have outdated perception. mapM_ updatePerFid (EM.keys factionD) modifyServer $ \ser -> ser { sbreakLoop = False , sbreakASAP = False } endOrLoop loopUpdConn (restartGame updConn loopUpdConn) loopUpdConn = do factionD <- getsState sfactionD -- Start handling actors with the single UI faction (positive ID), -- to safely save/exit. Note that this hack fails if there are many UI -- factions (when we reenable multiplayer). Then players will request -- save&exit and others will vote on it and it will happen -- after the clip has ended, not at the start. -- Note that at most a single actor with a time-consuming action -- is processed per faction, so it's fair, but many loops are needed. mapM_ handleFid $ EM.toDescList factionD breakASAP <- getsServer sbreakASAP breakLoop <- getsServer sbreakLoop if breakASAP || breakLoop then loopConditionally else do -- Projectiles are processed last and not at all if the UI leader -- decides to save or exit or restart or if there is game over. -- This and UI leader acting before any other ordinary actors -- ensures state is not changed and so the clip doesn't need -- to be carried through before save. arenas <- getsServer sarenas mapM_ (\fid -> mapM_ (`handleTrajectories` fid) arenas) (EM.keys factionD) endClip updatePerFid -- must be last, in case performs a bkp save -- The condition can be changed in @handleTrajectories@ by pushing -- onto an escape and in @endClip@. breakLoop2 <- getsServer sbreakLoop if breakLoop2 then loopConditionally else loopUpdConn -- process next iteration unconditionally loopUpdConn -- | Handle the end of every clip. Do whatever has to be done -- every fixed number of clips, e.g., monster generation. -- Advance time. Perform periodic saves, if applicable. -- -- This is never run if UI requested save or exit or restart and it's correct, -- because we know nobody moved and no time was or needs to be advanced -- and arenas are not changed. After game was saved and exited, -- on game resume the first clip is performed with empty arenas, -- so arena time is not updated and nobody moves, nor anything happens, -- but arenas are here correctly updated. endClip :: forall m. MonadServerAtomic m => (FactionId -> m ()) -> m () {-# INLINE endClip #-} endClip updatePerFid = do COps{corule} <- getsState scops time <- getsState stime let clipN = time `timeFit` timeClip -- No check if @sbreakASAP@ is set, because then the function is not called. breakLoop <- getsServer sbreakLoop -- We don't send a lot of useless info to the client if the game has already -- ended. At best wasteful, at worst the player sees strange messages. unless breakLoop $ do -- I need to send time updates, because I can't add time to each command, -- because I'd need to send also all arenas, which should be updated, -- and this is too expensive data for each, e.g., projectile move. -- I send even if nothing changes so that UI time display can progress. -- Possibly @arenas@ are invalid here, but all moves were performed -- according to this value, so time should be replenished according -- to this value as well. -- This is crucial, because tiny time discrepancies can accumulate -- magnified by hunders of actors that share the clip slots due to the -- restriction that at most one faction member acts each clip. arenas <- getsServer sarenas execUpdAtomic $ UpdAgeGame arenas -- Perform periodic dungeon maintenance. when (clipN `mod` rleadLevelClips corule == 0) leadLevelSwitch case clipN `mod` clipsInTurn of 2 -> -- Periodic activation only once per turn, for speed, -- but on all active arenas. Calm updates and domination -- happen there as well. applyPeriodicLevel 4 -> -- Add monsters each turn, not each clip. unless (null arenas) spawnMonster _ -> return () -- @applyPeriodicLevel@ might have, e.g., dominated actors, ending the game. -- It could not have unended the game, though. breakLoop2 <- getsServer sbreakLoop unless breakLoop2 $ do -- Possibly a leader change due to @leadLevelSwitch@, so update arenas here -- for 100% accuracy at least at the start of actor moves, before they -- change leaders as part of their moves. -- -- After game resume, this is the first non-vacuus computation. -- Next call to @loopUpdConn@ really moves actors and updates arena times -- so we start in exactly the same place that UI save ended in. validArenas <- getsServer svalidArenas unless validArenas $ do arenasNew <- arenasForLoop modifyServer $ \ser -> ser {sarenas = arenasNew, svalidArenas = True} -- Update all perception for visual feedback and to make sure saving -- and resuming game doesn't affect gameplay (by updating perception). -- Perception updates in @handleFidUpd@ are not enough, because -- periodic actions could have invalidated them. factionD <- getsState sfactionD mapM_ updatePerFid (EM.keys factionD) -- Saving on the browser causes a huge lag, hence autosave disabled. #ifndef USE_JSFILE unless breakLoop2 $ -- if by chance requested and periodic saves coincide -- Periodic save needs to be at the end, so that restore can start -- at the beginning. when (clipN `mod` rwriteSaveClips corule == 0) $ writeSaveAll False #endif -- | Check if the given actor is dominated and update his calm. manageCalmAndDomination :: MonadServerAtomic m => ActorId -> Actor -> m () manageCalmAndDomination aid b = do performedDomination <- if bcalm b > 0 then return False else do -- triggered by zeroed Calm hiImpression <- highestImpression b case hiImpression of Nothing -> return False Just (hiImpressionFid, hiImpressionK) -> do fact <- getsState $ (EM.! bfid b) . sfactionD if fleaderMode (gplayer fact) /= LeaderNull -- animals/robots/human drones never Calm-dominated || hiImpressionK >= 10 -- unless very high impression, e.g., in a dominated hero then dominateFidSfx aid aid hiImpressionFid else return False unless performedDomination $ do newCalmDelta <- getsState $ regenCalmDelta aid b unless (newCalmDelta == 0) $ -- Update delta for the current player turn. updateCalm aid newCalmDelta -- | Trigger periodic items for all actors on the given level. applyPeriodicLevel :: MonadServerAtomic m => m () applyPeriodicLevel = do arenas <- getsServer sarenas let arenasSet = ES.fromDistinctAscList arenas applyPeriodicItem _ _ (_, (_, [])) = return () -- periodic items always have at least one timer applyPeriodicItem aid cstore (iid, _) = do itemFull <- getsState $ itemToFull iid let arItem = aspectRecordFull itemFull when (IA.checkFlag Ability.Periodic arItem) $ do -- Check if the item is still in the bag (previous items act!). b2 <- getsState $ getActorBody aid bag <- getsState $ getBodyStoreBag b2 cstore case iid `EM.lookup` bag of Nothing -> return () -- item dropped Just (k, _) -> -- Activate even if effects null or vacuous, to possibly -- destroy the item. effectAndDestroyAndAddKill True aid False (k <= 1) False aid aid iid (CActor aid cstore) True itemFull True applyPeriodicActor (aid, b) = -- While it's fun when projectiles flash or speed up mid-air, -- it's very exotic and quite time-intensive whenever hundreds -- of projectiles exist due to ongoing explosions. -- Nothing activates when actor dying to prevent a regenerating -- actor from resurrecting each turn, resulting in silly end-game stats. when (not (bproj b) && bhp b > 0 && blid b `ES.member` arenasSet) $ do -- Equipment goes first, to refresh organs before they expire, -- to avoid the message that organ expired. mapM_ (applyPeriodicItem aid CEqp) $ EM.assocs $ beqp b mapM_ (applyPeriodicItem aid COrgan) $ EM.assocs $ borgan b -- While we are at it, also update his Calm. manageCalmAndDomination aid b allActors <- getsState sactorD mapM_ applyPeriodicActor $ EM.assocs allActors handleTrajectories :: MonadServerAtomic m => LevelId -> FactionId -> m () handleTrajectories lid fid = do localTime <- getsState $ getLocalTime lid levelTime <- getsServer $ (EM.! lid) . (EM.! fid) . strajTime let l = sort $ map fst $ filter (\(_, atime) -> atime <= localTime) $ EM.assocs levelTime -- The @strajTime@ map may be outdated before @hTrajectories@ -- call (due to other actors following their trajectories), -- so it's only used to decide which actors are processed in this -- @handleTrajectories@ call. If an actor is added to the map, -- the recursive call to @handleTrajectories@ will detect that -- and process him later on. -- If the actor is no longer on the level or no longer belongs -- to the faction, it is nevertheless processed without a problem. -- We are guaranteed the actor still exists. mapM_ hTrajectories l -- Avoid frames between fadeout and fadein. breakLoop <- getsServer sbreakLoop unless (null l || breakLoop) $ handleTrajectories lid fid -- for speeds > tile/clip hTrajectories :: MonadServerAtomic m => ActorId -> m () {-# INLINE hTrajectories #-} hTrajectories aid = do b1 <- getsState $ getActorBody aid let removePushed b = -- No longer fulfills criteria and was not removed by dying; remove him. modifyServer $ \ser -> ser { strajTime = EM.adjust (EM.adjust (EM.delete aid) (blid b)) (bfid b) (strajTime ser) , strajPushedBy = EM.delete aid (strajPushedBy ser) } removeTrajectory b = -- Non-projectile actor stops flying (a projectile with empty trajectory -- would be intercepted earlier on as dead). -- Will be removed from @strajTime@ in recursive call -- to @handleTrajectories@. assert (not $ bproj b) $ execUpdAtomic $ UpdTrajectory aid (btrajectory b) Nothing breakLoop <- getsServer sbreakLoop if breakLoop then return () -- don't move if game over via pushing else if actorDying b1 then dieSer aid b1 else case btrajectory b1 of Nothing -> removePushed b1 Just ([], _) -> removeTrajectory b1 >> removePushed b1 Just{} -> do advanceTrajectory aid b1 -- Here, @advanceTrajectory@ might have affected @actorDying@, -- so we check again ASAP to make sure the body of the projectile -- (or pushed actor) doesn't block movement of other actors, -- but vanishes promptly. -- Bodies of actors that die not flying remain on the battlefied until -- their natural next turn, to give them a chance of rescue. -- Note that domination of pushed actors is not checked -- nor is their calm updated. They are helpless wrt movement, -- but also invulnerable in this respect. b2 <- getsState $ getActorBody aid if actorDying b2 then dieSer aid b2 else case btrajectory b2 of Nothing -> removePushed b2 Just ([], _) -> removeTrajectory b2 >> removePushed b2 Just{} -> -- delay next iteration only if still flying advanceTimeTraj aid -- if @actorDying@ due to @bhp b <= 0@: -- If @b@ is a projectile, it means hits an actor or is hit by actor. -- Then the carried item is destroyed and that's all. -- If @b@ is not projectile, it dies, his items drop to the ground -- and possibly a new leader is elected. -- -- if @actorDying@ due to @btrajectory@ null: -- A projectile drops to the ground due to obstacles or range. -- The carried item is not destroyed, unless it's fragile, -- but drops to the ground. -- | Manage trajectory of a projectile. -- -- Colliding with a wall or actor doesn't take time, because -- the projectile does not move (the move is blocked). -- Not advancing time forces dead projectiles to be destroyed ASAP. -- Otherwise, with some timings, it can stay on the game map dead, -- blocking path of human-controlled actors and alarming the hapless human. advanceTrajectory :: MonadServerAtomic m => ActorId -> Actor -> m () {-# INLINE advanceTrajectory #-} advanceTrajectory aid b = do COps{coTileSpeedup} <- getsState scops lvl <- getLevel $ blid b arTrunk <- getsState $ (EM.! btrunk b) . sdiscoAspect case btrajectory b of Just (d : lv, speed) -> do let tpos = bpos b `shift` d -- target position if | Tile.isWalkable coTileSpeedup $ lvl `at` tpos -> do -- Hit will clear trajectories in @reqMelee@, -- so no need to do that here. execUpdAtomic $ UpdTrajectory aid (btrajectory b) (Just (lv, speed)) when (null lv && bproj b && not (IA.checkFlag Ability.Blast arTrunk)) $ do killer <- getsServer $ EM.findWithDefault aid aid . strajPushedBy addKillToAnalytics killer KillDropLaunch (bfid b) (btrunk b) let occupied = occupiedBigLvl tpos lvl || occupiedProjLvl tpos lvl reqMoveHit = reqMoveGeneric False True aid d reqDisp = reqDisplaceGeneric False aid if | bproj b -> -- Projectiles always hit; then can't tell friend from foe. reqMoveHit | occupied -> -- Non-projectiles displace, unless they can hit big enemy. -- Hitting projectiles would stop a possibly important flight. case (posToBigLvl tpos lvl, posToProjsLvl tpos lvl) of (Nothing, []) -> error "advanceTrajectory: not occupied" (Nothing, [target]) -> reqDisp target (Nothing, _) -> reqMoveHit -- can't displace multiple (Just target, []) -> do b2 <- getsState $ getActorBody target fact <- getsState $ (EM.! bfid b) . sfactionD if isFoe (bfid b) fact (bfid b2) then reqMoveHit else reqDisp target (Just _, _) -> reqMoveHit -- can't displace multiple | otherwise -> reqMoveHit -- if not occupied, just move | bproj b -> do -- @Nothing@ trajectory of a projectile signals an obstacle hit. -- Second call of @actorDying@ above will catch the dead projectile. execUpdAtomic $ UpdTrajectory aid (btrajectory b) Nothing -- Kill counts for each blast particle is TMI. when (not (IA.checkFlag Ability.Blast arTrunk)) $ do killer <- getsServer $ EM.findWithDefault aid aid . strajPushedBy addKillToAnalytics killer KillTileLaunch (bfid b) (btrunk b) -- Losing HP due to hitting an obstacle not needed, because -- trajectory is halted, so projectile will die soon anyway. | otherwise -> do -- Will be removed from @strajTime@ in recursive call -- to @handleTrajectories@. execSfxAtomic $ SfxCollideTile aid tpos mfail <- reqAlterFail False aid tpos lvl2 <- getLevel $ blid b case mfail of Nothing | Tile.isWalkable coTileSpeedup $ lvl2 `at` tpos -> -- Too late to announce anything, but given that the way -- is opened, continue flight. Don't even lose any HP. return () _ -> do -- Altering failed, probably just a wall, so lose HP -- due to being pushed into an obstacle. Never kill in this way. -- Note that sometimes this may come already after one faction -- wins the game and end game screens are show. This is OK-ish. execUpdAtomic $ UpdTrajectory aid (btrajectory b) Nothing when (bhp b > oneM) $ do execUpdAtomic $ UpdRefillHP aid minusM let effect = IK.RefillHP (-2) -- -2 is a lie to ensure display execSfxAtomic $ SfxEffect (bfid b) aid effect (-1) _ -> error $ "Nothing or empty trajectory" `showFailure` (aid, b) handleActors :: (MonadServerAtomic m, MonadServerComm m) => LevelId -> FactionId -> m Bool handleActors lid fid = do localTime <- getsState $ getLocalTime lid levelTime <- getsServer $ (EM.! lid) . (EM.! fid) . sactorTime let l = sort $ map fst $ filter (\(_, atime) -> atime <= localTime) $ EM.assocs levelTime -- The @sactorTime@ map may be outdated before @hActors@ -- call (due to other actors on the list acting), -- so it's only used to decide which actors are processed in this call. -- If the actor is no longer on the level or no longer belongs -- to the faction, it is nevertheless processed without a problem -- (the client may act wrt slightly outdated Perception and that's all). -- We are guaranteed the actor still exists. mleader <- getsState $ gleader . (EM.! fid) . sfactionD -- Leader acts first, so that UI leader can save&exit before state changes. hActors $ case mleader of Just aid | aid `elem` l -> aid : delete aid l _ -> l hActors :: forall m. (MonadServerAtomic m, MonadServerComm m) => [ActorId] -> m Bool hActors [] = return False hActors as@(aid : rest) = do b1 <- getsState $ getActorBody aid let !_A = assert (not $ bproj b1) () if bhp b1 <= 0 then -- Will be killed in a later pass, making it possible to revive him now. hActors rest else do let side = bfid b1 fact <- getsState $ (EM.! side) . sfactionD breakLoop <- getsServer sbreakLoop let mleader = gleader fact aidIsLeader = mleader == Just aid mainUIactor = fhasUI (gplayer fact) && (aidIsLeader || fleaderMode (gplayer fact) == LeaderNull) -- Checking @breakLoop@, to avoid doubly setting faction status to Camping -- in case AI-controlled UI client asks to exit game at exactly -- the same moment as natural game over was detected. mainUIunderAI = mainUIactor && isAIFact fact && not breakLoop when mainUIunderAI $ do cmdS <- sendQueryUI side aid case fst cmdS of ReqUINop -> return () ReqUIAutomate -> execUpdAtomic $ UpdAutoFaction side False ReqUIGameDropAndExit -> reqGameDropAndExit aid ReqUIGameSaveAndExit -> reqGameSaveAndExit aid _ -> error $ "" `showFailure` cmdS factNew <- getsState $ (EM.! side) . sfactionD let doQueryAI = not mainUIactor || isAIFact factNew breakASAP <- getsServer sbreakASAP -- If breaking out of the game loop, pretend there was a non-wait move. -- we don't need additionally to check @sbreakLoop@, because it occurs alone -- only via action of an actor and at most one action is performed here. if breakASAP then return True else do let mswitchLeader :: Maybe ActorId -> m ActorId {-# NOINLINE mswitchLeader #-} mswitchLeader (Just aidNew) = switchLeader side aidNew >> return aidNew mswitchLeader Nothing = return aid (aidNew, mtimed) <- if doQueryAI then do (cmd, maid) <- sendQueryAI side aid aidNew <- mswitchLeader maid mtimed <- handleRequestAI cmd return (aidNew, mtimed) else do (cmd, maid) <- sendQueryUI side aid aidNew <- mswitchLeader maid mtimed <- handleRequestUI side aidNew cmd return (aidNew, mtimed) case mtimed of Just timed -> do nonWaitMove <- handleRequestTimed side aidNew timed -- Even if the actor got a free turn of time via a scroll, -- he will not act again this clip, only next clip. -- Clip is small, so not a big deal and it's faster and avoids -- complete game time freezes, e.g., due to an exploit. if nonWaitMove then return True else hActors rest Nothing -> do breakASAP2 <- getsServer sbreakASAP -- If breaking out of the game lopp, pretend there was a non-wait move. if breakASAP2 then return True else hActors as restartGame :: MonadServerAtomic m => m () -> m () -> Maybe (GroupName ModeKind) -> m () restartGame updConn loop mgameMode = do soptionsNxt <- getsServer soptionsNxt srandom <- getsServer srandom s <- gameReset soptionsNxt mgameMode (Just srandom) let optionsBarRngs = soptionsNxt {sdungeonRng = Nothing, smainRng = Nothing} modifyServer $ \ser -> ser { soptionsNxt = optionsBarRngs , soptions = optionsBarRngs } execUpdAtomic $ UpdRestartServer s updConn initPer reinitGame writeSaveAll False loop LambdaHack-0.9.5.0/engine-src/Game/LambdaHack/Server/MonadServer.hs0000644000000000000000000002037007346545000022726 0ustar0000000000000000-- | Basic server monads and related operations. module Game.LambdaHack.Server.MonadServer ( -- * The server monad MonadServer( getsServer , modifyServer , chanSaveServer -- exposed only to be implemented, not used , liftIO -- exposed only to be implemented, not used ) , MonadServerAtomic(..) -- * Assorted primitives , getServer, putServer, debugPossiblyPrint, debugPossiblyPrintAndExit , serverPrint, saveServer, dumpRngs, restoreScore, registerScore , rndToAction, getSetGen ) where import Prelude () import Game.LambdaHack.Core.Prelude -- Cabal import qualified Paths_LambdaHack as Self (version) import qualified Control.Exception as Ex import qualified Control.Monad.Trans.State.Strict as St import qualified Data.EnumMap.Strict as EM import qualified Data.Text as T import qualified Data.Text.IO as T import Data.Time.Clock.POSIX import Data.Time.LocalTime import System.Exit (exitFailure) import System.FilePath import System.IO (hFlush, stdout) import qualified System.Random as R import Game.LambdaHack.Atomic import Game.LambdaHack.Client (sbenchmark) import Game.LambdaHack.Common.ActorState import Game.LambdaHack.Common.Faction import Game.LambdaHack.Common.File import qualified Game.LambdaHack.Common.HighScore as HighScore import Game.LambdaHack.Common.Kind import Game.LambdaHack.Common.Misc import Game.LambdaHack.Common.MonadStateRead import Game.LambdaHack.Common.Perception import qualified Game.LambdaHack.Common.Save as Save import Game.LambdaHack.Common.State import Game.LambdaHack.Common.Types import Game.LambdaHack.Content.ModeKind import Game.LambdaHack.Content.RuleKind import Game.LambdaHack.Core.Random import Game.LambdaHack.Server.ServerOptions import Game.LambdaHack.Server.State class MonadStateRead m => MonadServer m where getsServer :: (StateServer -> a) -> m a modifyServer :: (StateServer -> StateServer) -> m () chanSaveServer :: m (Save.ChanSave (State, StateServer)) -- We do not provide a MonadIO instance, so that outside -- nobody can subvert the action monads by invoking arbitrary IO. liftIO :: IO a -> m a -- | The monad for executing atomic game state transformations. class MonadServer m => MonadServerAtomic m where -- | Execute an atomic command that changes the state -- on the server and on all clients that can notice it. execUpdAtomic :: UpdAtomic -> m () -- | Execute an atomic command that changes the state -- on the server only. execUpdAtomicSer :: UpdAtomic -> m Bool -- | Execute an atomic command that changes the state -- on the given single client only. execUpdAtomicFid :: FactionId -> UpdAtomic -> m () -- | Execute an atomic command that changes the state -- on the given single client only. -- Catch 'AtomicFail' and indicate if it was in fact raised. execUpdAtomicFidCatch :: FactionId -> UpdAtomic -> m Bool -- | Execute an atomic command that only displays special effects. execSfxAtomic :: SfxAtomic -> m () execSendPer :: FactionId -> LevelId -> Perception -> Perception -> Perception -> m () getServer :: MonadServer m => m StateServer getServer = getsServer id putServer :: MonadServer m => StateServer -> m () putServer s = modifyServer (const s) debugPossiblyPrint :: MonadServer m => Text -> m () debugPossiblyPrint t = do debug <- getsServer $ sdbgMsgSer . soptions when debug $ liftIO $ do T.hPutStrLn stdout t hFlush stdout debugPossiblyPrintAndExit :: MonadServer m => Text -> m () debugPossiblyPrintAndExit t = do debug <- getsServer $ sdbgMsgSer . soptions when debug $ liftIO $ do T.hPutStrLn stdout t hFlush stdout exitFailure serverPrint :: MonadServer m => Text -> m () serverPrint t = liftIO $ do T.hPutStrLn stdout t hFlush stdout saveServer :: MonadServer m => m () saveServer = do s <- getState ser <- getServer toSave <- chanSaveServer liftIO $ Save.saveToChan toSave (s, ser) -- | Dumps to stdout the RNG states from the start of the game. dumpRngs :: MonadServer m => RNGs -> m () dumpRngs rngs = liftIO $ do T.hPutStrLn stdout $ tshow rngs hFlush stdout -- | Read the high scores dictionary. Return the empty table if no file. restoreScore :: forall m. MonadServer m => COps -> m HighScore.ScoreDict restoreScore COps{corule} = do bench <- getsServer $ sbenchmark . sclientOptions . soptions mscore <- if bench then return Nothing else do let scoresFile = rscoresFile corule dataDir <- liftIO appDataDir let path bkp = dataDir bkp <> scoresFile configExists <- liftIO $ doesFileExist (path "") res <- liftIO $ Ex.try $ if configExists then do (vlib2, s) <- strictDecodeEOF (path "") if Save.compatibleVersion vlib2 Self.version then return $ Just s else do let msg = "High score file from old version of game detected." fail msg else return Nothing let handler :: Ex.SomeException -> m (Maybe a) handler e = do let msg = "High score restore failed. The old file moved aside. The error message is:" <+> (T.unwords . T.lines) (tshow e) serverPrint msg liftIO $ renameFile (path "") (path "bkp.") return Nothing either handler return res maybe (return HighScore.empty) return mscore -- | Generate a new score, register it and save. registerScore :: MonadServer m => Status -> FactionId -> m () registerScore status fid = do cops@COps{corule} <- getsState scops total <- getsState $ snd . calculateTotal fid let scoresFile = rscoresFile corule dataDir <- liftIO appDataDir -- Re-read the table in case it's changed by a concurrent game. scoreDict <- restoreScore cops gameModeId <- getsState sgameModeId time <- getsState stime dungeonTotal <- getsState sgold date <- liftIO getPOSIXTime tz <- liftIO $ getTimeZone $ posixSecondsToUTCTime date curChalSer <- getsServer $ scurChalSer . soptions factionD <- getsState sfactionD bench <- getsServer $ sbenchmark . sclientOptions . soptions noConfirmsGame <- isNoConfirmsGame let fact = factionD EM.! fid path = dataDir scoresFile outputScore (worthMentioning, (ntable, pos)) = -- If testing or fooling around, dump instead of registering. -- In particular don't register score for the auto-* scenarios. if bench || noConfirmsGame || isAIFact fact then debugPossiblyPrint $ T.intercalate "\n" $ HighScore.showScore tz pos (HighScore.getRecord pos ntable) else let nScoreDict = EM.insert gameModeId ntable scoreDict in when worthMentioning $ liftIO $ encodeEOF path Self.version (nScoreDict :: HighScore.ScoreDict) chal | fhasUI $ gplayer fact = curChalSer | otherwise = curChalSer {cdiff = difficultyInverse (cdiff curChalSer)} theirVic (fi, fa) | isFoe fid fact fi && not (isHorrorFact fa) = Just $ gvictims fa | otherwise = Nothing theirVictims = EM.unionsWith (+) $ mapMaybe theirVic $ EM.assocs factionD ourVic (fi, fa) | isFriend fid fact fi = Just $ gvictims fa | otherwise = Nothing ourVictims = EM.unionsWith (+) $ mapMaybe ourVic $ EM.assocs factionD table = HighScore.getTable gameModeId scoreDict registeredScore = HighScore.register table total dungeonTotal time status date chal (T.unwords $ tail $ T.words $ gname fact) ourVictims theirVictims (fhiCondPoly $ gplayer fact) outputScore registeredScore -- | Invoke pseudo-random computation with the generator kept in the state. rndToAction :: MonadServer m => Rnd a -> m a rndToAction r = do gen1 <- getsServer srandom let (a, gen2) = St.runState r gen1 modifyServer $ \ser -> ser {srandom = gen2} return a -- | Gets a random generator from the user-submitted options or, if not present, -- generates one. getSetGen :: MonadServer m => Maybe R.StdGen -> m R.StdGen getSetGen mrng = case mrng of Just rnd -> return rnd Nothing -> liftIO R.newStdGen LambdaHack-0.9.5.0/engine-src/Game/LambdaHack/Server/PeriodicM.hs0000644000000000000000000004005107346545000022352 0ustar0000000000000000-- | Server operations performed periodically in the game loop -- and related operations. module Game.LambdaHack.Server.PeriodicM ( spawnMonster, addAnyActor , advanceTime, advanceTimeTraj, overheadActorTime, swapTime , updateCalm, leadLevelSwitch #ifdef EXPOSE_INTERNAL -- * Internal operations , rollSpawnPos #endif ) where import Prelude () import Game.LambdaHack.Core.Prelude import qualified Data.EnumMap.Strict as EM import qualified Data.EnumSet as ES import Data.Int (Int64) import Data.Ord import Game.LambdaHack.Atomic import Game.LambdaHack.Common.Actor import Game.LambdaHack.Common.ActorState import Game.LambdaHack.Common.Area import Game.LambdaHack.Common.Faction import Game.LambdaHack.Common.Item import Game.LambdaHack.Common.Kind import Game.LambdaHack.Common.Level import Game.LambdaHack.Common.Misc import Game.LambdaHack.Common.MonadStateRead import Game.LambdaHack.Common.Perception import Game.LambdaHack.Common.Point import Game.LambdaHack.Common.State import qualified Game.LambdaHack.Common.Tile as Tile import Game.LambdaHack.Common.Time import Game.LambdaHack.Common.Types import qualified Game.LambdaHack.Content.CaveKind as CK import Game.LambdaHack.Content.ItemKind (ItemKind) import qualified Game.LambdaHack.Content.ItemKind as IK import Game.LambdaHack.Content.ModeKind import Game.LambdaHack.Core.Frequency import Game.LambdaHack.Core.Random import qualified Game.LambdaHack.Definition.Ability as Ability import Game.LambdaHack.Definition.Defs import Game.LambdaHack.Server.CommonM import Game.LambdaHack.Server.ItemM import Game.LambdaHack.Server.MonadServer import Game.LambdaHack.Server.State -- | Spawn, possibly, a monster according to the level's actor groups. -- We assume heroes are never spawned. spawnMonster :: MonadServerAtomic m => m () spawnMonster = do COps{cocave} <- getsState scops arenas <- getsServer sarenas -- Do this on only one of the arenas to prevent micromanagement, -- e.g., spreading leaders across levels to bump monster generation. arena <- rndToAction $ oneOf arenas Level{lkind, ldepth, lbig} <- getLevel arena let ck = okind cocave lkind if | CK.cactorCoeff ck == 0 || null (CK.cactorFreq ck) -> return () | EM.size lbig >= 300 -> -- probably not so rare, but debug anyway -- Gameplay consideration: not fun to slog through so many actors. -- Caves rarely start with more than 100. debugPossiblyPrint "Server: spawnMonster: too many big actors on level" | otherwise -> do totalDepth <- getsState stotalDepth lvlSpawned <- getsServer $ fromMaybe 0 . EM.lookup arena . snumSpawned rc <- rndToAction $ monsterGenChance ldepth totalDepth lvlSpawned (CK.cactorCoeff ck) when rc $ do modifyServer $ \ser -> ser {snumSpawned = EM.insert arena (lvlSpawned + 1) $ snumSpawned ser} localTime <- getsState $ getLocalTime arena maid <- addAnyActor False lvlSpawned (CK.cactorFreq ck) arena localTime Nothing case maid of Nothing -> return () -- suspect content; server debug elsewhere Just aid -> do b <- getsState $ getActorBody aid mleader <- getsState $ gleader . (EM.! bfid b) . sfactionD when (isNothing mleader) $ setFreshLeader (bfid b) aid addAnyActor :: MonadServerAtomic m => Bool -> Int -> Freqs ItemKind -> LevelId -> Time -> Maybe Point -> m (Maybe ActorId) addAnyActor summoned lvlSpawned actorFreq lid time mpos = do -- We bootstrap the actor by first creating the trunk of the actor's body -- that contains the fixed properties of all actors of that kind. cops <- getsState scops lvl <- getLevel lid factionD <- getsState sfactionD freq <- prepareItemKind lvlSpawned lid actorFreq m2 <- rollItemAspect freq lid case m2 of Nothing -> do debugPossiblyPrint "Server: addAnyActor: trunk failed to roll" return Nothing Just (itemKnownRaw, (itemFullRaw, kit)) -> do (fid, _) <- rndToAction $ oneOf $ possibleActorFactions (itemKind itemFullRaw) factionD pers <- getsServer sperFid let allPers = ES.unions $ map (totalVisible . (EM.! lid)) $ EM.elems $ EM.delete fid pers -- expensive :( -- Checking skill would be more accurate, but skills can be -- inside organs, equipment, condition organs, created organs, etc. freqNames = map fst $ IK.ifreq $ itemKind itemFullRaw mobile = "mobile" `elem` freqNames aquatic = "aquatic" `elem` freqNames mrolledPos <- case mpos of Just{} -> return mpos Nothing -> do rollPos <- getsState $ rollSpawnPos cops allPers mobile aquatic lid lvl fid rndToAction rollPos case mrolledPos of Just pos -> Just <$> registerActor summoned itemKnownRaw (itemFullRaw, kit) fid pos lid time Nothing -> do debugPossiblyPrint "Server: addAnyActor: failed to find any free position" return Nothing rollSpawnPos :: COps -> ES.EnumSet Point -> Bool -> Bool -> LevelId -> Level -> FactionId -> State -> Rnd (Maybe Point) rollSpawnPos COps{coTileSpeedup} visible mobile aquatic lid lvl@Level{larea} fid s = do let inhabitants = foeRegularList fid lid s nearInh !df !p = all (\ !b -> df $ chessDist (bpos b) p) inhabitants distantMiddle !d !p = chessDist p (middlePoint larea) < d condList | mobile = [ nearInh (<= 50) -- don't spawn very far from foes , nearInh (<= 100) ] | otherwise = [ distantMiddle 8 , distantMiddle 16 , distantMiddle 24 , distantMiddle 26 , distantMiddle 28 , distantMiddle 30 ] -- Not considering TK.OftenActor, because monsters emerge from hidden ducts, -- which are easier to hide in crampy corridors that lit halls. findPosTry2 (if mobile then 500 else 50) lvl ( \p !t -> Tile.isWalkable coTileSpeedup t && not (Tile.isNoActor coTileSpeedup t) && not (occupiedBigLvl p lvl) && not (occupiedProjLvl p lvl) ) (map (\f p _ -> f p) condList) (\ !p t -> nearInh (> 4) p -- otherwise actors in dark rooms swarmed && not (p `ES.member` visible) -- visibility and plausibility && (not aquatic || Tile.isAquatic coTileSpeedup t)) [ \ !p _ -> nearInh (> 3) p && not (p `ES.member` visible) , \ !p _ -> nearInh (> 2) p -- otherwise actors hit on entering level && not (p `ES.member` visible) , \ !p _ -> not (p `ES.member` visible) ] -- | Advance the move time for the given actor. advanceTime :: MonadServerAtomic m => ActorId -> Int -> Bool -> m () advanceTime aid percent breakStasis = do b <- getsState $ getActorBody aid actorMaxSk <- getsState $ getActorMaxSkills aid let t = timeDeltaPercent (ticksPerMeter $ gearSpeed actorMaxSk) percent -- @t@ may be negative; that's OK. modifyServer $ \ser -> ser {sactorTime = ageActor (bfid b) (blid b) aid t $ sactorTime ser} when breakStasis $ modifyServer $ \ser -> ser {sactorStasis = ES.delete aid (sactorStasis ser)} -- actor moved, so he broke the time stasis, he can be -- paralyzed as well as propelled again -- | Advance the trajectory following time for the given actor. advanceTimeTraj :: MonadServerAtomic m => ActorId -> m () advanceTimeTraj aid = do b <- getsState $ getActorBody aid let speedTraj = case btrajectory b of Nothing -> error $ "" `showFailure` b Just (_, speed) -> speed t = ticksPerMeter speedTraj -- @t@ may be negative; that's OK. modifyServer $ \ser -> ser {strajTime = ageActor (bfid b) (blid b) aid t $ strajTime ser} -- | Add communication overhead time delta to all non-projectile, non-dying -- faction's actors, except the leader. Effectively, this limits moves -- of a faction on a level to 10, regardless of the number of actors -- and their speeds. To avoid animals suddenly acting extremely sluggish -- whenever monster's leader visits a distant arena that has a crowd -- of animals, overhead applies only to actors on the same level. -- Since the number of active levels is limited, this bounds the total moves -- per turn of each faction as well. -- -- Leader is immune from overhead and so he is faster than other faction -- members and of equal speed to leaders of other factions (of equal -- base speed) regardless how numerous the faction is. -- Thanks to this, there is no problem with leader of a numerous faction -- having very long UI turns, introducing UI lag. overheadActorTime :: MonadServerAtomic m => FactionId -> LevelId -> m () overheadActorTime fid lid = do -- Only non-projectiles processed, because @strajTime@ ignored. actorTimeFid <- getsServer $ (EM.! fid) . sactorTime let actorTimeLid = actorTimeFid EM.! lid getActorB <- getsState $ flip getActorBody mleader <- getsState $ gleader . (EM.! fid) . sfactionD let f !aid !time = let body = getActorB aid in if bhp body > 0 -- speed up all-move-at-once carcass removal && Just aid /= mleader -- leader fast, for UI to be fast then timeShift time (Delta timeClip) else time actorTimeLid2 = EM.mapWithKey f actorTimeLid actorTimeFid2 = EM.insert lid actorTimeLid2 actorTimeFid modifyServer $ \ser -> ser {sactorTime = EM.insert fid actorTimeFid2 $ sactorTime ser} -- | Swap the relative move times of two actors (e.g., when switching -- a UI leader). Notice that their trajectory move times are not swapped. swapTime :: MonadServerAtomic m => ActorId -> ActorId -> m () swapTime source target = do sb <- getsState $ getActorBody source tb <- getsState $ getActorBody target slvl <- getsState $ getLocalTime (blid sb) tlvl <- getsState $ getLocalTime (blid tb) btime_sb <- getsServer $ (EM.! source) . (EM.! blid sb) . (EM.! bfid sb) . sactorTime btime_tb <- getsServer $ (EM.! target) . (EM.! blid tb) . (EM.! bfid tb) . sactorTime let lvlDelta = slvl `timeDeltaToFrom` tlvl bDelta = btime_sb `timeDeltaToFrom` btime_tb sdelta = timeDeltaSubtract lvlDelta bDelta tdelta = timeDeltaReverse sdelta -- Equivalent, for the assert: let !_A = let sbodyDelta = btime_sb `timeDeltaToFrom` slvl tbodyDelta = btime_tb `timeDeltaToFrom` tlvl sgoal = slvl `timeShift` tbodyDelta tgoal = tlvl `timeShift` sbodyDelta sdelta' = sgoal `timeDeltaToFrom` btime_sb tdelta' = tgoal `timeDeltaToFrom` btime_tb in assert (sdelta == sdelta' && tdelta == tdelta' `blame` ( slvl, tlvl, btime_sb, btime_tb , sdelta, sdelta', tdelta, tdelta' )) () when (sdelta /= Delta timeZero) $ modifyServer $ \ser -> ser {sactorTime = ageActor (bfid sb) (blid sb) source sdelta $ sactorTime ser} when (tdelta /= Delta timeZero) $ modifyServer $ \ser -> ser {sactorTime = ageActor (bfid tb) (blid tb) target tdelta $ sactorTime ser} updateCalm :: MonadServerAtomic m => ActorId -> Int64 -> m () updateCalm target deltaCalm = do tb <- getsState $ getActorBody target actorMaxSk <- getsState $ getActorMaxSkills target let calmMax64 = xM $ Ability.getSk Ability.SkMaxCalm actorMaxSk execUpdAtomic $ UpdRefillCalm target deltaCalm when (bcalm tb < calmMax64 && bcalm tb + deltaCalm >= calmMax64) $ return () -- We don't dominate the actor here, because if so, players would -- disengage after one of their actors is dominated and wait for him -- to regenerate Calm. This is unnatural and boring. Better fight -- and hope he gets his Calm again to 0 and then defects back. -- We could instead tell here that Calm is fully regenerated, -- but that would be too verbose. leadLevelSwitch :: MonadServerAtomic m => m () leadLevelSwitch = do COps{cocave} <- getsState scops let canSwitch fact = fst (autoDungeonLevel fact) -- a hack to help AI, until AI client can switch levels || case fleaderMode (gplayer fact) of LeaderNull -> False LeaderAI _ -> True LeaderUI _ -> False flipFaction (_, fact) | not $ canSwitch fact = return () flipFaction (fid, fact) = case gleader fact of Nothing -> return () Just leader -> do body <- getsState $ getActorBody leader let !_A = assert (fid == bfid body) () s <- getsServer $ (EM.! fid) . sclientStates let leaderStuck = actorWaits body oursRaw = [ ((lid, lvl), (allSeen, as)) | (lid, lvl) <- EM.assocs $ sdungeon s , lid /= blid body || not leaderStuck , let asRaw = -- Drama levels ignored, hence @Regular@. fidActorRegularAssocs fid lid s isAlert (_, b) = case bwatch b of WWatch -> True WWait n -> n == 0 WSleep -> False WWake -> True -- probably in danger (alert, relaxed) = partition isAlert asRaw as = alert ++ relaxed -- best switch leader to alert , not (null as) , let allSeen = lexpl lvl <= lseen lvl || CK.cactorCoeff (okind cocave $ lkind lvl) > 150 && not (fhasGender $ gplayer fact) ] (oursSeen, oursNotSeen) = partition (fst . snd) oursRaw -- Monster AI changes leadership mostly to move from level -- to level and, in particular, to quickly bring troops -- to the frontline level and so prevent human from killing -- monsters at numerical advantage. -- However, an AI boss that can't move between levels -- disrupts this by hogging leadership. To prevent that, -- assuming the boss resides below the frontline level, -- only the two shallowest levels that are not yet fully -- explored are considered to choose the new leader from. -- This frontier moves as the levels are explored or emptied -- and sometimes the level with the boss is counted among -- them, but it never happens in the crucial periods when -- AI armies are transferred from level to level. f ((lid, _), _) = abs $ fromEnum lid ours = oursSeen ++ take 2 (sortBy (comparing f) oursNotSeen) -- Actors on desolate levels (not many own or enemy non-projectiles) -- tend to become (or stay) leaders so that they can join the main -- force where it matters ASAP. Unfortunately, this keeps hero -- scouts as leader, but foes spawn very fast early on , -- so they give back leadership rather quickly to let others follow. -- We count non-mobile and sleeping actors, because they may -- be dangerous, especially if adjacent to stairs. let freqList = [ (k, (lid, aid)) | ((lid, lvl), (_, (aid, _) : _)) <- ours , let len = min 20 (EM.size $ lbig lvl) k = 1000000 `div` (1 + len) ] unless (null freqList) $ do (lid, a) <- rndToAction $ frequency $ toFreq "leadLevel" freqList unless (lid == blid body) $ -- flip levels rather than actors setFreshLeader fid a factionD <- getsState sfactionD mapM_ flipFaction $ EM.assocs factionD LambdaHack-0.9.5.0/engine-src/Game/LambdaHack/Server/ProtocolM.hs0000644000000000000000000002036507346545000022423 0ustar0000000000000000-- | The server definitions for the server-client communication protocol. module Game.LambdaHack.Server.ProtocolM ( -- * The communication channels CliSerQueue, ConnServerDict, ChanServer(..) -- * The server-client communication monad , MonadServerComm ( getsDict -- exposed only to be implemented, not used , modifyDict -- exposed only to be implemented, not used , liftIO -- exposed only to be implemented, not used ) -- * Protocol , putDict, sendUpdate, sendUpdateCheck, sendUpdNoState , sendSfx, sendQueryAI, sendQueryUI -- * Assorted , killAllClients, childrenServer, updateConn, tryRestore #ifdef EXPOSE_INTERNAL -- * Internal operations , writeQueue, readQueueAI, readQueueUI, newQueue #endif ) where import Prelude () import Game.LambdaHack.Core.Prelude import Control.Concurrent import Control.Concurrent.Async import qualified Data.EnumMap.Strict as EM import Data.Key (mapWithKeyM, mapWithKeyM_) import System.FilePath import System.IO.Unsafe (unsafePerformIO) import Game.LambdaHack.Atomic import Game.LambdaHack.Client (RequestAI, RequestUI, Response (..), sbenchmark) import Game.LambdaHack.Common.Faction import Game.LambdaHack.Common.File import Game.LambdaHack.Common.Kind import Game.LambdaHack.Common.Misc import Game.LambdaHack.Common.MonadStateRead import qualified Game.LambdaHack.Common.Save as Save import Game.LambdaHack.Common.State import Game.LambdaHack.Common.Thread import Game.LambdaHack.Common.Types import Game.LambdaHack.Content.ModeKind import Game.LambdaHack.Content.RuleKind import Game.LambdaHack.Server.DebugM import Game.LambdaHack.Server.MonadServer hiding (liftIO) import Game.LambdaHack.Server.ServerOptions import Game.LambdaHack.Server.State writeQueue :: MonadServerComm m => Response -> CliSerQueue Response -> m () {-# INLINE writeQueue #-} writeQueue cmd responseS = liftIO $ putMVar responseS cmd readQueueAI :: MonadServerComm m => CliSerQueue RequestAI -> m RequestAI {-# INLINE readQueueAI #-} readQueueAI requestS = liftIO $ takeMVar requestS readQueueUI :: MonadServerComm m => CliSerQueue RequestUI -> m RequestUI {-# INLINE readQueueUI #-} readQueueUI requestS = liftIO $ takeMVar requestS newQueue :: IO (CliSerQueue a) newQueue = newEmptyMVar type CliSerQueue = MVar -- | Connection information for all factions, indexed by faction identifier. type ConnServerDict = EM.EnumMap FactionId ChanServer -- | Connection channel between the server and a single client. data ChanServer = ChanServer { responseS :: CliSerQueue Response , requestAIS :: CliSerQueue RequestAI , requestUIS :: Maybe (CliSerQueue RequestUI) } -- | The server monad with the ability to communicate with clients. class MonadServer m => MonadServerComm m where getsDict :: (ConnServerDict -> a) -> m a modifyDict :: (ConnServerDict -> ConnServerDict) -> m () liftIO :: IO a -> m a getDict :: MonadServerComm m => m ConnServerDict getDict = getsDict id putDict :: MonadServerComm m => ConnServerDict -> m () putDict s = modifyDict (const s) -- | If the @AtomicFail@ conditions hold, send a command to client, -- otherwise do nothing. sendUpdate :: (MonadServerAtomic m, MonadServerComm m) => FactionId -> UpdAtomic -> m () sendUpdate !fid !cmd = do succeeded <- execUpdAtomicFidCatch fid cmd when succeeded $ sendUpd fid cmd -- | Send a command to client, crashing if the @AtomicFail@ conditions -- don't hold when executed on the client's state. sendUpdateCheck :: (MonadServerAtomic m, MonadServerComm m) => FactionId -> UpdAtomic -> m () sendUpdateCheck !fid !cmd = do execUpdAtomicFid fid cmd sendUpd fid cmd sendUpd :: MonadServerComm m => FactionId -> UpdAtomic -> m () sendUpd !fid !cmd = do chan <- getsDict (EM.! fid) s <- getsServer $ (EM.! fid) . sclientStates let resp = RespUpdAtomic s cmd debug <- getsServer $ sniff . soptions when debug $ debugResponse fid resp writeQueue resp $ responseS chan sendUpdNoState :: MonadServerComm m => FactionId -> UpdAtomic -> m () sendUpdNoState !fid !cmd = do chan <- getsDict (EM.! fid) let resp = RespUpdAtomicNoState cmd debug <- getsServer $ sniff . soptions when debug $ debugResponse fid resp writeQueue resp $ responseS chan sendSfx :: MonadServerComm m => FactionId -> SfxAtomic -> m () sendSfx !fid !sfx = do let resp = RespSfxAtomic sfx debug <- getsServer $ sniff . soptions when debug $ debugResponse fid resp chan <- getsDict (EM.! fid) case chan of ChanServer{requestUIS=Just{}} -> writeQueue resp $ responseS chan _ -> return () sendQueryAI :: MonadServerComm m => FactionId -> ActorId -> m RequestAI sendQueryAI fid aid = do let respAI = RespQueryAI aid debug <- getsServer $ sniff . soptions when debug $ debugResponse fid respAI chan <- getsDict (EM.! fid) req <- do writeQueue respAI $ responseS chan readQueueAI $ requestAIS chan when debug $ debugRequestAI aid return req sendQueryUI :: (MonadServerAtomic m, MonadServerComm m) => FactionId -> ActorId -> m RequestUI sendQueryUI fid _aid = do let respUI = RespQueryUI debug <- getsServer $ sniff . soptions when debug $ debugResponse fid respUI chan <- getsDict (EM.! fid) req <- do writeQueue respUI $ responseS chan readQueueUI $ fromJust $ requestUIS chan when debug $ debugRequestUI _aid return req killAllClients :: (MonadServerAtomic m, MonadServerComm m) => m () killAllClients = do d <- getDict let sendKill fid _ = sendUpdNoState fid $ UpdKillExit fid -- We can't interate over sfactionD, because client can be from an old game. -- For the same reason we can't look up and send client's state. mapWithKeyM_ sendKill d -- Global variable for all children threads of the server. childrenServer :: MVar [Async ()] {-# NOINLINE childrenServer #-} childrenServer = unsafePerformIO (newMVar []) -- | Update connections to the new definition of factions. -- Connect to clients in old or newly spawned threads -- that read and write directly to the channels. updateConn :: (MonadServerAtomic m, MonadServerComm m) => (Bool -> FactionId -> ChanServer -> IO ()) -> m () updateConn executorClient = do -- Prepare connections based on factions. oldD <- getDict let mkChanServer :: Faction -> IO ChanServer mkChanServer fact = do responseS <- newQueue requestAIS <- newQueue requestUIS <- if fhasUI $ gplayer fact then Just <$> newQueue else return Nothing return $! ChanServer{..} addConn :: FactionId -> Faction -> IO ChanServer addConn fid fact = case EM.lookup fid oldD of Just conns -> return conns -- share old conns and threads Nothing -> mkChanServer fact factionD <- getsState sfactionD d <- liftIO $ mapWithKeyM addConn factionD let newD = d `EM.union` oldD -- never kill old clients putDict newD -- Spawn client threads. let toSpawn = newD EM.\\ oldD forkUI fid connS = forkChild childrenServer $ executorClient True fid connS forkAI fid connS = forkChild childrenServer $ executorClient False fid connS forkClient fid conn@ChanServer{requestUIS=Nothing} = -- When a connection is reused, clients are not respawned, -- even if UI usage changes, but it works OK thanks to UI faction -- clients distinguished by positive FactionId numbers. forkAI fid conn forkClient fid conn = forkUI fid conn liftIO $ mapWithKeyM_ forkClient toSpawn tryRestore :: MonadServerComm m => m (Maybe (State, StateServer)) tryRestore = do cops@COps{corule} <- getsState scops soptions <- getsServer soptions let bench = sbenchmark $ sclientOptions soptions if bench then return Nothing else do let prefix = ssavePrefixSer soptions fileName = prefix <> Save.saveNameSer cops res <- liftIO $ Save.restoreGame cops fileName let cfgUIName = rcfgUIName corule content = rcfgUIDefault corule dataDir <- liftIO appDataDir liftIO $ tryWriteFile (dataDir cfgUIName) content return $! res LambdaHack-0.9.5.0/engine-src/Game/LambdaHack/Server/ServerOptions.hs0000644000000000000000000000654307346545000023331 0ustar0000000000000000-- | Server and client game state types and operations. module Game.LambdaHack.Server.ServerOptions ( ServerOptions(..), RNGs(..), defServerOptions ) where import Prelude () import Game.LambdaHack.Core.Prelude import Data.Binary import qualified System.Random as R import Game.LambdaHack.Client (ClientOptions (..), defClientOptions) import Game.LambdaHack.Definition.Defs import Game.LambdaHack.Common.Faction import Game.LambdaHack.Content.ModeKind -- | Options that affect the behaviour of the server (including game rules). data ServerOptions = ServerOptions { sknowMap :: Bool , sknowEvents :: Bool , sknowItems :: Bool , sniff :: Bool , sallClear :: Bool , sboostRandomItem :: Bool , sgameMode :: Maybe (GroupName ModeKind) , sautomateAll :: Bool , skeepAutomated :: Bool , sdungeonRng :: Maybe R.StdGen , smainRng :: Maybe R.StdGen , snewGameSer :: Bool , scurChalSer :: Challenge , sdumpInitRngs :: Bool , ssavePrefixSer :: String , sdbgMsgSer :: Bool , sshowItemSamples :: Bool , sclientOptions :: ClientOptions -- The client debug inside server debug only holds the client commandline -- options and is never updated with config options, etc. } deriving Show data RNGs = RNGs { dungeonRandomGenerator :: Maybe R.StdGen , startingRandomGenerator :: Maybe R.StdGen } instance Show RNGs where show RNGs{..} = let args = [ maybe "" (\gen -> "--setDungeonRng \"" ++ show gen ++ "\"") dungeonRandomGenerator , maybe "" (\gen -> "--setMainRng \"" ++ show gen ++ "\"") startingRandomGenerator ] in unwords args instance Binary ServerOptions where put ServerOptions{..} = do put sknowMap put sknowEvents put sknowItems put sniff put sallClear put sboostRandomItem put sgameMode put sautomateAll put skeepAutomated put scurChalSer put ssavePrefixSer put sdbgMsgSer put sshowItemSamples put sclientOptions get = do sknowMap <- get sknowEvents <- get sknowItems <- get sniff <- get sallClear <- get sboostRandomItem <- get sgameMode <- get sautomateAll <- get skeepAutomated <- get scurChalSer <- get ssavePrefixSer <- get sdbgMsgSer <- get sshowItemSamples <- get sclientOptions <- get let sdungeonRng = Nothing smainRng = Nothing snewGameSer = False sdumpInitRngs = False return $! ServerOptions{..} instance Binary RNGs where put RNGs{..} = do put (show dungeonRandomGenerator) put (show startingRandomGenerator) get = do dg <- get sg <- get let dungeonRandomGenerator = read dg startingRandomGenerator = read sg return $! RNGs{..} -- | Default value of server options. defServerOptions :: ServerOptions defServerOptions = ServerOptions { sknowMap = False , sknowEvents = False , sknowItems = False , sniff = False , sallClear = False , sboostRandomItem = False , sgameMode = Nothing , sautomateAll = False , skeepAutomated = False , sdungeonRng = Nothing , smainRng = Nothing , snewGameSer = False , scurChalSer = defaultChallenge , sdumpInitRngs = False , ssavePrefixSer = "" , sdbgMsgSer = False , sshowItemSamples = False , sclientOptions = defClientOptions } LambdaHack-0.9.5.0/engine-src/Game/LambdaHack/Server/StartM.hs0000644000000000000000000005004707346545000021717 0ustar0000000000000000-- | Operations for starting and restarting the game. module Game.LambdaHack.Server.StartM ( initPer, reinitGame, gameReset, applyDebug #ifdef EXPOSE_INTERNAL -- * Internal operations , sampleTrunks, sampleItems , mapFromFuns, resetFactions, populateDungeon, findEntryPoss #endif ) where import Prelude () import Game.LambdaHack.Core.Prelude import qualified Control.Monad.Trans.State.Strict as St import qualified Data.EnumMap.Strict as EM import qualified Data.EnumSet as ES import qualified Data.IntMap.Strict as IM import Data.Key (mapWithKeyM_) import qualified Data.Map.Strict as M import Data.Ord import qualified Data.Set as S import qualified Data.Text as T import Data.Tuple (swap) import qualified NLP.Miniutter.English as MU import qualified System.Random as R import Game.LambdaHack.Atomic import Game.LambdaHack.Common.ActorState import Game.LambdaHack.Common.Analytics import Game.LambdaHack.Common.Area import Game.LambdaHack.Common.Faction import Game.LambdaHack.Common.Item import Game.LambdaHack.Common.Kind import Game.LambdaHack.Common.Level import Game.LambdaHack.Common.Misc import Game.LambdaHack.Common.MonadStateRead import Game.LambdaHack.Common.Point import Game.LambdaHack.Common.State import qualified Game.LambdaHack.Common.Tile as Tile import Game.LambdaHack.Common.Time import Game.LambdaHack.Common.Types import qualified Game.LambdaHack.Content.CaveKind as CK import qualified Game.LambdaHack.Content.ItemKind as IK import Game.LambdaHack.Content.ModeKind import qualified Game.LambdaHack.Core.Dice as Dice import Game.LambdaHack.Core.Random import qualified Game.LambdaHack.Definition.Color as Color import Game.LambdaHack.Definition.Defs import Game.LambdaHack.Definition.Flavour import Game.LambdaHack.Server.CommonM import qualified Game.LambdaHack.Server.DungeonGen as DungeonGen import Game.LambdaHack.Server.Fov import Game.LambdaHack.Server.ItemM import Game.LambdaHack.Server.ItemRev import Game.LambdaHack.Server.MonadServer import Game.LambdaHack.Server.ServerOptions import Game.LambdaHack.Server.State initPer :: MonadServer m => m () initPer = do ( sfovLitLid, sfovClearLid, sfovLucidLid ,sperValidFid, sperCacheFid, sperFid ) <- getsState perFidInDungeon modifyServer $ \ser -> ser { sfovLitLid, sfovClearLid, sfovLucidLid , sperValidFid, sperCacheFid, sperFid } reinitGame :: MonadServerAtomic m => m () reinitGame = do COps{coitem} <- getsState scops pers <- getsServer sperFid ServerOptions{scurChalSer, sknowMap, sshowItemSamples, sclientOptions} <- getsServer soptions -- This state is quite small, fit for transmition to the client. -- The biggest part is content, which needs to be updated in clients -- at this point to keep them in sync with changes on the server. s <- getState discoS <- getsState sdiscoKind -- Thanks to the following, for any item with not hidden identity, -- the client has its kind from the start. let discoKindFiltered = let f kindId = isNothing $ IK.getMandatoryHideAsFromKind $ okind coitem kindId in EM.filter f discoS defL | sknowMap = s | otherwise = localFromGlobal s defLocal = updateDiscoKind (const discoKindFiltered) defL factionD <- getsState sfactionD modifyServer $ \ser -> ser {sclientStates = EM.map (const defLocal) factionD} let updRestart fid = UpdRestart fid (pers EM.! fid) defLocal scurChalSer sclientOptions mapWithKeyM_ (\fid _ -> do -- Different seed for each client, to make sure behaviour is varied. gen1 <- getsServer srandom let (clientRandomSeed, gen2) = R.split gen1 modifyServer $ \ser -> ser {srandom = gen2} execUpdAtomic $ updRestart fid clientRandomSeed) factionD dungeon <- getsState sdungeon let sactorTime = EM.map (const (EM.map (const EM.empty) dungeon)) factionD strajTime = EM.map (const (EM.map (const EM.empty) dungeon)) factionD modifyServer $ \ser -> ser {sactorTime, strajTime} when sshowItemSamples $ do genOrig <- getsServer srandom uniqueSetOrig <- getsServer suniqueSet genOld <- getsServer sgenerationAn genSampleTrunks <- sampleTrunks dungeon genSampleItems <- sampleItems dungeon let sgenerationAn = EM.unions [genSampleTrunks, genSampleItems, genOld] modifyServer $ \ser -> ser {sgenerationAn} -- Make sure the debug generations don't affect future RNG behaviour. -- However, in the long run, AI behaviour is affected anyway, -- because the items randomly chosen for AI actions are ordered by their -- @ItemId@, which is affected by the sample item generation. modifyServer $ \ser -> ser {srandom = genOrig, suniqueSet = uniqueSetOrig} populateDungeon mapM_ (\fid -> mapM_ (updatePer fid) (EM.keys dungeon)) (EM.keys factionD) -- For simplicity only spawnable actors are taken into account, not starting -- actors of any faction nor summonable actors. sampleTrunks :: MonadServerAtomic m => Dungeon -> m GenerationAnalytics sampleTrunks dungeon = do COps{cocave, coitem} <- getsState scops factionD <- getsState sfactionD let getGroups Level{lkind} = map fst $ CK.cactorFreq $ okind cocave lkind groups = S.elems $ S.fromList $ concatMap getGroups $ EM.elems dungeon addGroupToSet !s0 !grp = ofoldlGroup' coitem grp (\s _ ik _ -> ES.insert ik s) s0 trunkKindIds = ES.elems $ foldl' addGroupToSet ES.empty groups minLid = fst $ minimumBy (comparing (ldepth . snd)) $ EM.assocs dungeon regItem itemKindId = do let itemKind = okind coitem itemKindId freq = pure (itemKindId, itemKind) case possibleActorFactions itemKind factionD of [] -> return Nothing (fid, _) : _ -> do let c = CTrunk fid minLid originPoint jfid = Just fid m2 <- rollItemAspect freq minLid case m2 of Nothing -> error "sampleTrunks: can't create actor trunk" Just (ItemKnown kindIx ar _, (itemFullRaw, kit)) -> do let itemKnown = ItemKnown kindIx ar jfid itemFull = itemFullRaw {itemBase = (itemBase itemFullRaw) {jfid}} Just <$> registerItem (itemFull, kit) itemKnown c False miids <- mapM regItem trunkKindIds return $! EM.singleton STrunk $ EM.fromAscList $ zip (catMaybes miids) $ repeat 0 -- For simplicity, only actors generated on the ground are taken into account. -- not starting items of any actors nor items that can be create by effects -- occuring in the game. sampleItems :: MonadServerAtomic m => Dungeon -> m GenerationAnalytics sampleItems dungeon = do COps{cocave, coitem} <- getsState scops let getGroups Level{lkind} = map fst $ CK.citemFreq $ okind cocave lkind groups = S.elems $ S.fromList $ concatMap getGroups $ EM.elems dungeon addGroupToSet !s0 !grp = ofoldlGroup' coitem grp (\s _ ik _ -> ES.insert ik s) s0 itemKindIds = ES.elems $ foldl' addGroupToSet ES.empty groups minLid = fst $ minimumBy (comparing (ldepth . snd)) $ EM.assocs dungeon regItem itemKindId = do let itemKind = okind coitem itemKindId freq = pure (itemKindId, itemKind) c = CFloor minLid originPoint m2 <- rollItemAspect freq minLid case m2 of Nothing -> error "sampleItems: can't create sample item" Just (itemKnown, (itemFull, _kit)) -> Just <$> registerItem (itemFull, (0, [])) itemKnown c False miids <- mapM regItem itemKindIds return $! EM.singleton SItem $ EM.fromAscList $ zip (catMaybes miids) $ repeat 0 mapFromFuns :: Ord b => [a] -> [a -> b] -> M.Map b a mapFromFuns domain = let fromFun f m1 = let invAssocs = map (\c -> (f c, c)) domain m2 = M.fromList invAssocs in m2 `M.union` m1 in foldr fromFun M.empty resetFactions :: FactionDict -> ContentId ModeKind -> Int -> Dice.AbsDepth -> Roster -> Rnd FactionDict resetFactions factionDold gameModeIdOld curDiffSerOld totalDepth players = do let rawCreate (gplayer@Player{..}, initialActors) = do let castInitialActors (ln, d, actorGroup) = do n <- castDice (Dice.AbsDepth $ abs ln) totalDepth d return (ln, n, actorGroup) ginitial <- mapM castInitialActors initialActors let cmap = mapFromFuns Color.legalFgCol [colorToTeamName, colorToPlainName, colorToFancyName] colorName = T.toLower $ head $ T.words fname prefix = case fleaderMode of LeaderNull -> "Loose" LeaderAI _ -> "Autonomous" LeaderUI _ -> "Controlled" gnameNew = prefix <+> if fhasGender then makePhrase [MU.Ws $ MU.Text fname] else fname gcolor = M.findWithDefault Color.BrWhite colorName cmap gvictimsDnew = case find (\fact -> gname fact == gnameNew) $ EM.elems factionDold of Nothing -> EM.empty Just fact -> let sing = IM.singleton curDiffSerOld (gvictims fact) f = IM.unionWith (EM.unionWith (+)) in EM.insertWith f gameModeIdOld sing $ gvictimsD fact let gname = gnameNew gdipl = EM.empty -- fixed below gquit = Nothing _gleader = Nothing gvictims = EM.empty gvictimsD = gvictimsDnew gsha = EM.empty return $! Faction{..} lUI <- mapM rawCreate $ filter (fhasUI . fst) $ rosterList players let !_A = assert (length lUI <= 1 `blame` "currently, at most one faction may have a UI" `swith` lUI) () lnoUI <- mapM rawCreate $ filter (not . fhasUI . fst) $ rosterList players let lFs = reverse (zip [toEnum (-1), toEnum (-2)..] lnoUI) -- sorted ++ zip [toEnum 1..] lUI swapIx l = let findPlayerName name = find ((name ==) . fname . gplayer . snd) f (name1, name2) = case (findPlayerName name1 lFs, findPlayerName name2 lFs) of (Just (ix1, _), Just (ix2, _)) -> (ix1, ix2) _ -> error $ "unknown faction" `showFailure` ((name1, name2), lFs) ixs = map f l -- Only symmetry is ensured, everything else is permitted, e.g., -- a faction in alliance with two others that are at war. in ixs ++ map swap ixs mkDipl diplMode = let f (ix1, ix2) = let adj fact = fact {gdipl = EM.insert ix2 diplMode (gdipl fact)} in EM.adjust adj ix1 in foldr f rawFs = EM.fromDistinctAscList lFs -- War overrides alliance, so 'warFs' second. allianceFs = mkDipl Alliance rawFs (swapIx (rosterAlly players)) warFs = mkDipl War allianceFs (swapIx (rosterEnemy players)) return $! warFs gameReset :: MonadServer m => ServerOptions -> Maybe (GroupName ModeKind) -> Maybe R.StdGen -> m State gameReset serverOptions mGameMode mrandom = do -- Dungeon seed generation has to come first, to ensure item boosting -- is determined by the dungeon RNG. cops@COps{comode} <- getsState scops dungeonSeed <- getSetGen $ sdungeonRng serverOptions `mplus` mrandom srandom <- getSetGen $ smainRng serverOptions `mplus` mrandom let srngs = RNGs (Just dungeonSeed) (Just srandom) when (sdumpInitRngs serverOptions) $ dumpRngs srngs scoreTable <- restoreScore cops factionDold <- getsState sfactionD gameModeIdOld <- getsState sgameModeId curChalSer <- getsServer $ scurChalSer . soptions let startingModeGroup = "insert coin" gameMode = fromMaybe startingModeGroup $ mGameMode `mplus` sgameMode serverOptions rnd :: Rnd (FactionDict, FlavourMap, DiscoveryKind, DiscoveryKindRev, DungeonGen.FreshDungeon, ContentId ModeKind) rnd = do modeKindId <- fromMaybe (error $ "Unknown game mode:" `showFailure` gameMode) <$> opick comode gameMode (const True) let mode = okind comode modeKindId automatePS ps = ps {rosterList = map (first $ automatePlayer True) $ rosterList ps} players = if sautomateAll serverOptions then automatePS $ mroster mode else mroster mode sflavour <- dungeonFlavourMap cops (discoKind, sdiscoKindRev) <- serverDiscos cops freshDng <- DungeonGen.dungeonGen cops serverOptions $ mcaves mode factionD <- resetFactions factionDold gameModeIdOld (cdiff curChalSer) (DungeonGen.freshTotalDepth freshDng) players return ( factionD, sflavour, discoKind , sdiscoKindRev, freshDng, modeKindId ) let ( factionD, sflavour, discoKind ,sdiscoKindRev, DungeonGen.FreshDungeon{..}, modeKindId ) = St.evalState rnd dungeonSeed defState = defStateGlobal freshDungeon freshTotalDepth factionD cops scoreTable modeKindId discoKind defSer = emptyStateServer { srandom , srngs } putServer defSer modifyServer $ \ser -> ser {sdiscoKindRev, sflavour} return $! defState -- Spawn initial actors. Clients should notice this, to set their leaders. populateDungeon :: MonadServerAtomic m => m () populateDungeon = do cops@COps{coTileSpeedup} <- getsState scops dungeon <- getsState sdungeon factionD <- getsState sfactionD curChalSer <- getsServer $ scurChalSer . soptions let ginitialWolf fact1 = if cwolf curChalSer && fhasUI (gplayer fact1) then case ginitial fact1 of [] -> [] (ln, _, grp) : _ -> [(ln, 1, grp)] else ginitial fact1 (minD, maxD) = dungeonBounds dungeon -- Players that escape go first to be started over stairs, if possible. valuePlayer pl = (not $ fcanEscape pl, fname pl) -- Sorting, to keep games from similar game modes mutually reproducible. needInitialCrew = sortOn (valuePlayer . gplayer . snd) $ filter (not . null . ginitialWolf . snd) $ EM.assocs factionD boundLid (ln, _, _) = max minD . min maxD . toEnum $ ln getEntryLevels (_, fact) = map boundLid $ ginitialWolf fact arenas = ES.toList $ ES.fromList $ concatMap getEntryLevels needInitialCrew hasActorsOnArena lid (_, fact) = any ((== lid) . boundLid) $ ginitialWolf fact initialActorPositions lid = do lvl <- getLevel lid let arenaFactions = filter (hasActorsOnArena lid) needInitialCrew indexff (fid, _) = findIndex ((== fid) . fst) arenaFactions representsAlliance ff2@(fid2, fact2) = not $ any (\ff3@(fid3, _) -> indexff ff3 < indexff ff2 && isFriend fid2 fact2 fid3) arenaFactions arenaAlliances = filter representsAlliance arenaFactions entryPoss <- rndToAction $ findEntryPoss cops lid lvl (length arenaAlliances) when (length entryPoss < length arenaAlliances) $ debugPossiblyPrint "Server: populateDungeon: failed to find enough alliance positions" let usedPoss = zip arenaAlliances entryPoss return $! (lid, usedPoss) initialActors (lid, usedPoss) = do let arenaFactions = filter (hasActorsOnArena lid) needInitialCrew placeAlliance ((fid3, _), ppos) = mapM_ (\(fid4, fact4) -> when (isFriend fid4 fact4 fid3) $ placeActors lid ((fid4, fact4), ppos)) arenaFactions mapM_ placeAlliance usedPoss placeActors lid ((fid3, fact3), ppos) = do lvl <- getLevel lid let validTile t = not $ Tile.isNoActor coTileSpeedup t initActors = ginitialWolf fact3 initGroups = concat [ replicate n actorGroup | ln3@(_, n, actorGroup) <- initActors , boundLid ln3 == lid ] psFree = nearbyFreePoints cops lvl validTile ppos when (length psFree < length initGroups) $ debugPossiblyPrint "Server: populateDungeon: failed to find enough actor positions" let ps = zip initGroups psFree localTime <- getsState $ getLocalTime lid forM_ ps $ \ (actorGroup, p) -> do rndDelay <- rndToAction $ randomR (0, clipsInTurn - 1) let delta = timeDeltaScale (Delta timeClip) rndDelay rndTime = timeShift localTime delta maid <- addActorFromGroup actorGroup fid3 p lid rndTime case maid of Nothing -> error $ "can't spawn initial actors" `showFailure` (lid, (fid3, fact3)) Just aid -> do mleader <- getsState $ gleader . (EM.! fid3) . sfactionD -- Sleeping actor may become a leader, but it's quickly corrected. when (isNothing mleader) $ setFreshLeader fid3 aid return True lposs <- mapM initialActorPositions arenas let alliancePositions = EM.fromList $ map (second $ map snd) lposs placeItemsInDungeon alliancePositions embedItemsInDungeon mapM_ initialActors lposs -- | Find starting postions for all factions. Try to make them distant -- from each other. Place as many of the factions, as possible, -- over stairs, starting from the end of the list, including placing the last -- factions over escapes (we assume they are guardians of the escapes). -- This implies the inital factions (if any) start far from escapes. findEntryPoss :: COps -> LevelId -> Level -> Int -> Rnd [Point] findEntryPoss COps{coTileSpeedup} lid lvl@Level{larea, lstair, lescape} k = do let (_, xspan, yspan) = spanArea larea factionDist = max xspan yspan - 10 dist !poss !cmin !l _ = all (\ !pos -> chessDist l pos > cmin) poss tryFind _ 0 = return [] tryFind !ps !n = do let ds = [ dist ps factionDist , dist ps $ 2 * factionDist `div` 3 , dist ps $ factionDist `div` 2 , dist ps $ factionDist `div` 3 , dist ps $ factionDist `div` 4 , dist ps $ factionDist `div` 5 ] mp <- findPosTry2 500 lvl -- try really hard, for skirmish fairness (\_ !t -> Tile.isWalkable coTileSpeedup t && not (Tile.isNoActor coTileSpeedup t)) (take 2 ds) -- don't pick too close @isOftenActor@ locations (\_ !t -> Tile.isOftenActor coTileSpeedup t) ds case mp of Just np -> do nps <- tryFind (np : ps) (n - 1) return $! np : nps Nothing -> return [] -- Only consider deeper stairs to avoid leaderless spawners that stay near -- their starting stairs ambushing explorers that enter the level, -- unless the staircase has both sets of stairs. deeperStairs = (if fromEnum lid > 0 then fst else snd) lstair let !_A = assert (k > 0 && factionDist > 0) () onStairs = reverse $ take k $ lescape ++ deeperStairs nk = k - length onStairs -- Starting in the middle is too easy. found <- tryFind (middlePoint larea : onStairs) nk return $! found ++ onStairs -- | Apply options that don't need a new game. applyDebug :: MonadServer m => m () applyDebug = do ServerOptions{..} <- getsServer soptionsNxt modifyServer $ \ser -> ser {soptions = (soptions ser) { sniff , sallClear , sdbgMsgSer , snewGameSer , sdumpInitRngs , sclientOptions }} LambdaHack-0.9.5.0/engine-src/Game/LambdaHack/Server/State.hs0000644000000000000000000001515407346545000021565 0ustar0000000000000000-- | Server and client game state types and operations. module Game.LambdaHack.Server.State ( StateServer(..), ActorTime, ActorPushedBy , emptyStateServer, updateActorTime, lookupActorTime, ageActor ) where import Prelude () import Game.LambdaHack.Core.Prelude import Data.Binary import qualified Data.EnumMap.Strict as EM import qualified Data.EnumSet as ES import qualified Data.HashMap.Strict as HM import qualified System.Random as R import Game.LambdaHack.Common.Analytics import Game.LambdaHack.Common.Perception import Game.LambdaHack.Common.State import Game.LambdaHack.Common.Time import Game.LambdaHack.Common.Types import Game.LambdaHack.Server.Fov import Game.LambdaHack.Server.ItemRev import Game.LambdaHack.Server.ServerOptions -- | State with server-specific data, including a copy of each client's -- basic game state, but not the server's basic state. data StateServer = StateServer { sactorTime :: ActorTime -- ^ absolute times of actors next actions , strajTime :: ActorTime -- ^ and same for actors with trajectories , strajPushedBy :: ActorPushedBy -- ^ culprits for actors with trajectories , sfactionAn :: FactionAnalytics -- ^ various past events data for factions , sactorAn :: ActorAnalytics -- ^ various past events data for actors , sgenerationAn :: GenerationAnalytics -- ^ item creation statistics, by item lore , sactorStasis :: ES.EnumSet ActorId -- ^ actors currently in time stasis, -- invulnerable to time warps until move , sdiscoKindRev :: DiscoveryKindRev -- ^ reverse map, used for item creation , suniqueSet :: UniqueSet -- ^ already generated unique items , sitemRev :: ItemRev -- ^ reverse id map, used for item creation , sflavour :: FlavourMap -- ^ association of flavour to item kinds , sacounter :: ActorId -- ^ stores next actor index , sicounter :: ItemId -- ^ stores next item index , snumSpawned :: EM.EnumMap LevelId Int , sundo :: () -- [CmdAtomic] -- ^ atomic commands performed to date , sclientStates :: EM.EnumMap FactionId State -- ^ each faction state, as seen by clients , sperFid :: PerFid -- ^ perception of all factions , sperValidFid :: PerValidFid -- ^ perception validity for all factions , sperCacheFid :: PerCacheFid -- ^ perception cache of all factions , sfovLucidLid :: FovLucidLid -- ^ ambient or shining light positions , sfovClearLid :: FovClearLid -- ^ clear tiles positions , sfovLitLid :: FovLitLid -- ^ ambient light positions , sarenas :: [LevelId] -- ^ active arenas , svalidArenas :: Bool -- ^ whether active arenas valid , srandom :: R.StdGen -- ^ current random generator , srngs :: RNGs -- ^ initial random generators , sbreakLoop :: Bool -- ^ exit game loop after clip's end; -- usually no game save follows , sbreakASAP :: Bool -- ^ exit game loop ASAP; usually with save , swriteSave :: Bool -- ^ write savegame to file after loop exit , soptions :: ServerOptions -- ^ current commandline options , soptionsNxt :: ServerOptions -- ^ options for the next game } deriving Show -- | Position in time for each actor, grouped by level and by faction. type ActorTime = EM.EnumMap FactionId (EM.EnumMap LevelId (EM.EnumMap ActorId Time)) -- | Record who last propelled a given actor with trajectory. type ActorPushedBy = EM.EnumMap ActorId ActorId -- | Initial, empty game server state. emptyStateServer :: StateServer emptyStateServer = StateServer { sactorTime = EM.empty , strajTime = EM.empty , strajPushedBy = EM.empty , sfactionAn = EM.empty , sactorAn = EM.empty , sgenerationAn = EM.fromAscList $ zip [minBound..maxBound] (repeat EM.empty) , sactorStasis = ES.empty , sdiscoKindRev = emptyDiscoveryKindRev , suniqueSet = ES.empty , sitemRev = HM.empty , sflavour = emptyFlavourMap , sacounter = toEnum 0 , sicounter = toEnum 0 , snumSpawned = EM.empty , sundo = () , sclientStates = EM.empty , sperFid = EM.empty , sperValidFid = EM.empty , sperCacheFid = EM.empty , sfovLucidLid = EM.empty , sfovClearLid = EM.empty , sfovLitLid = EM.empty , sarenas = [] , svalidArenas = False , srandom = R.mkStdGen 42 , srngs = RNGs { dungeonRandomGenerator = Nothing , startingRandomGenerator = Nothing } , sbreakLoop = False , sbreakASAP = False , swriteSave = False , soptions = defServerOptions , soptionsNxt = defServerOptions } updateActorTime :: FactionId -> LevelId -> ActorId -> Time -> ActorTime -> ActorTime updateActorTime !fid !lid !aid !time = EM.adjust (EM.adjust (EM.insert aid time) lid) fid lookupActorTime :: FactionId -> LevelId -> ActorId -> ActorTime -> Maybe Time lookupActorTime !fid !lid !aid !atime = do m1 <- EM.lookup fid atime m2 <- EM.lookup lid m1 EM.lookup aid m2 ageActor :: FactionId -> LevelId -> ActorId -> Delta Time -> ActorTime -> ActorTime ageActor !fid !lid !aid !delta = EM.adjust (EM.adjust (EM.adjust (`timeShift` delta) aid) lid) fid instance Binary StateServer where put StateServer{..} = do put sactorTime put strajTime put strajPushedBy put sfactionAn put sactorAn put sgenerationAn put sactorStasis put sdiscoKindRev put suniqueSet put sitemRev put sflavour put sacounter put sicounter put snumSpawned put sclientStates put (show srandom) put srngs put soptions get = do sactorTime <- get strajTime <- get strajPushedBy <- get sfactionAn <- get sactorAn <- get sgenerationAn <- get sactorStasis <- get sdiscoKindRev <- get suniqueSet <- get sitemRev <- get sflavour <- get sacounter <- get sicounter <- get snumSpawned <- get sclientStates <- get g <- get srngs <- get soptions <- get let srandom = read g sundo = () sperFid = EM.empty sperValidFid = EM.empty sperCacheFid = EM.empty sfovLucidLid = EM.empty sfovClearLid = EM.empty sfovLitLid = EM.empty sarenas = [] svalidArenas = False sbreakLoop = False sbreakASAP = False swriteSave = False soptionsNxt = defServerOptions return $! StateServer{..} LambdaHack-0.9.5.0/test/0000755000000000000000000000000007346545000013002 5ustar0000000000000000LambdaHack-0.9.5.0/test/test.hs0000644000000000000000000000175607346545000014326 0ustar0000000000000000import Prelude () import Options.Applicative import Game.LambdaHack.Client.UI.Frontend.Chosen import Game.LambdaHack.Core.Prelude import Game.LambdaHack.Server import TieKnot main :: IO () main = do let args = words "--dbgMsgSer --logPriority 4 --newGame 1 --noAnim --maxFps 100000 --frontendNull --benchmark --stopAfterFrames 50 --automateAll --keepAutomated --gameMode crawl --setDungeonRng 0 --setMainRng 0" serverOptions <- handleParseResult $ execParserPure defaultPrefs serverOptionsPI args tieKnot serverOptions when (frontendName == "sdl") $ do -- The hacky log priority 0 tells SDL frontend to init and quit at once, -- for testing on CIs without graphics access. let args2 = words "--dbgMsgSer --logPriority 0 --newGame 3 --maxFps 100000 --benchmark --stopAfterFrames 50 --automateAll --keepAutomated --gameMode battle --setDungeonRng 7 --setMainRng 7" serverOptions2 <- handleParseResult $ execParserPure defaultPrefs serverOptionsPI args2 tieKnot serverOptions2