edge (empty) → 0.8
raw patch · 82 files changed
+6420/−0 lines, 82 filesdep +ALUTdep +basedep +containerssetup-changedbinary-added
Dependencies added: ALUT, base, containers, gloss, random, wraparound
Files
- AfterEffect.hs +31/−0
- AfterEffect.hs-boot +3/−0
- AfterEffect/MineExplosion.hs +86/−0
- AfterEffect/SimpleExplosion.hs +107/−0
- Animation.hs +30/−0
- Asteroid.hs +82/−0
- BigAsteroid.hs +80/−0
- COPYING +674/−0
- Combat.hs +97/−0
- DONATE +5/−0
- Display.hs +247/−0
- Input.hs +188/−0
- Item.hs +58/−0
- Lance.hs +416/−0
- Moving.hs +97/−0
- Projectile/Blade.hs +114/−0
- Projectile/BulletMI.hs +111/−0
- Projectile/BulletMII.hs +111/−0
- Projectile/BulletMkI.hs +111/−0
- Projectile/BulletSI.hs +111/−0
- Projectile/BulletSII.hs +114/−0
- Projectile/Cannon.hs +117/−0
- Projectile/Mine.hs +116/−0
- Projectile/Nuke.hs +132/−0
- Projectile/Pellet.hs +99/−0
- ResourceTracker.hs +39/−0
- Resources.hs +469/−0
- Setup.hs +2/−0
- SpaceJunk.hs +40/−0
- Star.hs +19/−0
- Step.hs +456/−0
- Trigonometry.hs +57/−0
- Unit.hs +104/−0
- Unit/Simple/Turret.hs +184/−0
- Unit/Smart/ATank.hs +223/−0
- Unit/Smart/Death.hs +279/−0
- Unit/Smart/Ninja.hs +252/−0
- Unit/Smart/Saucer.hs +257/−0
- Unit/Smart/Sniper.hs +232/−0
- Unit/Smart/Tank.hs +223/−0
- Universe.hs +49/−0
- Universe.hs-boot +3/−0
- Updating.hs +28/−0
- edge.cabal +115/−0
- edge.hs +52/−0
- image/asteroid.bmp binary
- image/asteroidbig.bmp binary
- image/atank.bmp binary
- image/blade.bmp binary
- image/death.bmp binary
- image/explosion-00.bmp binary
- image/explosion-01.bmp binary
- image/explosion-02.bmp binary
- image/explosion-03.bmp binary
- image/explosion-04.bmp binary
- image/explosion-05.bmp binary
- image/explosion-06.bmp binary
- image/item-cannon.bmp binary
- image/item-default.bmp binary
- image/item-fourway.bmp binary
- image/item-health.bmp binary
- image/item-nuke.bmp binary
- image/item-rapidfire.bmp binary
- image/item-spread.bmp binary
- image/lance-thrusting.bmp binary
- image/lance.bmp binary
- image/mine-explosion.bmp binary
- image/mine-lit.bmp binary
- image/mine.bmp binary
- image/ninja.bmp binary
- image/nuke-0.bmp binary
- image/nuke-1.bmp binary
- image/nuke-2.bmp binary
- image/nuke-3.bmp binary
- image/saucer.bmp binary
- image/sniper.bmp binary
- image/tank.bmp binary
- image/turret.bmp binary
- sound/energy-shot-02.wav binary
- sound/explosion.wav binary
- sound/simple-energy-shot.wav binary
- sound/test.wav binary
+ AfterEffect.hs view
@@ -0,0 +1,31 @@+{-# LANGUAGE ExistentialQuantification #-}++module AfterEffect ( AfterEffect (..) ) where++import Animation+import Updating+import Moving++data AfterEffect =+ forall a. ( Animation a+ , Locatable a+ , Transient a+ , Audible a+ ) => AfterEffect a+ -- to be expanded algebraically++instance InternallyUpdating AfterEffect where+ preUpdate (AfterEffect a) et = AfterEffect (preUpdate a et)+ postUpdate (AfterEffect a) et = AfterEffect (postUpdate a et)++instance Transient AfterEffect where++ expired' (AfterEffect a) = expired' a++instance Audible AfterEffect where+ processAudio (AfterEffect a) wp = do a' <- processAudio a wp+ return (AfterEffect a')++ terminateAudio (AfterEffect a) = do a' <- terminateAudio a+ return (AfterEffect a')+
+ AfterEffect.hs-boot view
@@ -0,0 +1,3 @@+module AfterEffect where++data AfterEffect
+ AfterEffect/MineExplosion.hs view
@@ -0,0 +1,86 @@+module AfterEffect.MineExplosion where++import Data.WrapAround+import Animation+import Updating+import qualified Moving as M+import Graphics.Gloss.Data.Picture+import Graphics.Gloss.Data.Color+import Sound.ALUT+import Data.Maybe+import ResourceTracker+import GHC.Float++data MineExplosion =+ MineExplosion { center :: WrapPoint+ , timeRemaining :: Double+ , soundSource :: Maybe Source+ , wrapMap :: WrapMap+ , resourceTracker :: ResourceTracker+ , animClock :: Double+ }++new :: ResourceTracker -> WrapMap -> WrapPoint -> MineExplosion+new rt wmap center' =+ MineExplosion { center = center'+ , timeRemaining = 3.0+ , soundSource = Nothing+ , wrapMap = wmap+ , resourceTracker = rt+ , animClock = 0.0+ }++instance Animation MineExplosion where+ image self t =+ let dFrame = Color white (Scale 0.10 0.10 (Text "boom!")) in+ let rt = resourceTracker self in+ let at = animClock self in+ if at < 0.1 then fromMaybe dFrame $ getImage rt "mine-explosion.bmp"+ else Blank++instance M.Locatable MineExplosion where+ center = center++instance Transient MineExplosion where++ expired' self = if timeRemaining self <= 0.0+ then Just []+ else Nothing++instance InternallyUpdating MineExplosion where++ preUpdate self t = self { timeRemaining = timeRemaining self - t }++ postUpdate self t = self { animClock = animClock self + t }++instance Audible MineExplosion where++ processAudio self lcenter =+ if isNothing (soundSource self)+ then do self' <- initializeSoundSource self+ let (x, y) = vectorRelation+ (wrapMap self')+ (lcenter)+ (center self')+ let s = fromJust $ soundSource self'+ sourcePosition s $= (Vertex3 (double2Float x)+ (double2Float (-y))+ 0)+ play [s]+ return self'+ else return self++ terminateAudio self =+ if isNothing (soundSource self)+ then return self+ else do stop [fromJust (soundSource self)]+ return self++initializeSoundSource self =+ do [source] <- genObjectNames 1+ buffer source $= getSound (resourceTracker self) "explosion.wav"+ sourceRelative source $= Listener+ referenceDistance source $= audioReferenceDistance+ rolloffFactor source $= audioRolloffFactor+ sourceGain source $= 0.5+ return self { soundSource = Just source }
+ AfterEffect/SimpleExplosion.hs view
@@ -0,0 +1,107 @@+module AfterEffect.SimpleExplosion where++import Data.WrapAround+import Animation+import Updating+import qualified Moving as M+import Graphics.Gloss.Data.Picture+import Graphics.Gloss.Data.Color+import Sound.ALUT+import Data.Maybe+import ResourceTracker+import GHC.Float++data SimpleExplosion =+ SimpleExplosion { center :: WrapPoint+ , timeRemaining :: Double+ , soundSource :: Maybe Source+ , wrapMap :: WrapMap+ , resourceTracker :: ResourceTracker+ , animClock :: Double+ , velocity :: (Double, Double)+ }++new :: ResourceTracker -> WrapMap -> WrapPoint -> (Double, Double) -> SimpleExplosion+new rt wmap center' velocity' =+ SimpleExplosion { center = center'+ , timeRemaining = 3.0+ , soundSource = Nothing+ , wrapMap = wmap+ , resourceTracker = rt+ , animClock = 0.0+ , velocity = velocity'+ }++instance Animation SimpleExplosion where+ image self t =+ let dFrame = Color white (Scale 0.10 0.10 (Text "boom!")) in+ let rt = resourceTracker self in+ let f00 = fromMaybe dFrame $ getImage rt "explosion-00.bmp" in + let f01 = fromMaybe dFrame $ getImage rt "explosion-01.bmp" in + let f02 = fromMaybe dFrame $ getImage rt "explosion-02.bmp" in + let f03 = fromMaybe dFrame $ getImage rt "explosion-03.bmp" in + let f04 = fromMaybe dFrame $ getImage rt "explosion-04.bmp" in + let f05 = fromMaybe dFrame $ getImage rt "explosion-05.bmp" in + let f06 = fromMaybe dFrame $ getImage rt "explosion-06.bmp" in+ let at = animClock self in+ let fspace = 0.07 in+ if at < fspace * 1 then f00+ else if at < fspace * 2 then f01+ else if at < fspace * 3 then f02+ else if at < fspace * 4 then f03+ else if at < fspace * 5 then f04+ else if at < fspace * 6 then f05+ else if at < fspace * 7 then f06+ else Blank++instance M.Locatable SimpleExplosion where+ center = center++instance Transient SimpleExplosion where++ expired' self = if timeRemaining self <= 0.0+ then Just []+ else Nothing++instance InternallyUpdating SimpleExplosion where++ preUpdate self t = self { timeRemaining = timeRemaining self - t+ , center = M.idealNewLocation (wrapMap self)+ (center self)+ (velocity self)+ t+ }++ postUpdate self t = self { animClock = animClock self + t }++instance Audible SimpleExplosion where++ processAudio self lcenter =+ if isNothing (soundSource self)+ then do self' <- initializeSoundSource self+ let (x, y) = vectorRelation+ (wrapMap self')+ (lcenter)+ (center self')+ let s = fromJust $ soundSource self'+ sourcePosition s $= (Vertex3 (double2Float x)+ (double2Float (-y))+ 0)+ play [s]+ return self'+ else return self++ terminateAudio self =+ if isNothing (soundSource self)+ then return self+ else do stop [fromJust (soundSource self)]+ return self++initializeSoundSource self =+ do [source] <- genObjectNames 1+ buffer source $= getSound (resourceTracker self) "explosion.wav"+ sourceRelative source $= Listener+ referenceDistance source $= audioReferenceDistance+ rolloffFactor source $= audioRolloffFactor+ sourceGain source $= 0.5+ return self { soundSource = Just source }
+ Animation.hs view
@@ -0,0 +1,30 @@+module Animation where++import Graphics.Gloss.Data.Picture+import Moving+import Data.WrapAround+import Sound.ALUT++class Animation a where+ image :: a -> Double -> Picture++class Audible a where+ processAudio :: a -> WrapPoint -> IO a+ terminateAudio :: a -> IO a++{-+ Note to self: I need to terminateAudio for the purpose of stopping sound+ from Audible objects before they vanish (e.g., before a level change).+ However, I am also concerned about the fact that the Sound.OpenAL API+ doesn't seem to have any call for destroying a Source. I wonder if this is+ handled automatically somehow, if I this will lead to a memory leak, with+ Source objects accumulating in whatever system stores them.+-}++audioReferenceDistance = 300.0 :: Float++-- audioMaxDistance = 800.0 :: Float++audioRolloffFactor = 3.0 :: Float++audioDistanceModel = InverseDistanceClamped
+ Asteroid.hs view
@@ -0,0 +1,82 @@+module Asteroid where++import Animation+import Updating+import Graphics.Gloss.Data.Picture+import Graphics.Gloss.Data.Color+import qualified Moving as M+import Data.WrapAround+import ResourceTracker+import GHC.Float+import Combat+import Data.Maybe+import SpaceJunk++asteroidRadius = 15.0++damageEnergy' = 100.0++data Asteroid =+ Asteroid { location :: WrapPoint+ , idealTargetLocation :: Maybe WrapPoint+ , velocity :: (Double, Double)+ , wrapMap :: WrapMap+ , animDefault0 :: Picture+ }++new :: ResourceTracker -> WrapMap -> WrapPoint -> (Double, Double) -> Asteroid+new rt wmap location velocity =+ let pic = fromMaybe+ (Scale 0.20 0.20+ (Color white+ (Text "Error! Missing image!")))+ (getImage rt "asteroid.bmp") in+ Asteroid { location = location+ , velocity = velocity+ , wrapMap = wmap+ , idealTargetLocation = Nothing+ , animDefault0 = pic+ }+++instance Animation Asteroid where+ image self _ = animDefault0 self++instance M.Locatable Asteroid where+ center = location++instance M.Moving Asteroid where+ velocity = velocity++instance M.Colliding Asteroid where+ collisionRadius _ = asteroidRadius++instance InternallyUpdating Asteroid where++ preUpdate asteroid t = updateIdealTargetLocation t asteroid++ postUpdate asteroid t =+ let location' = fromMaybe+ (location asteroid)+ (idealTargetLocation asteroid) in+ asteroid { location = location'+ , idealTargetLocation = Nothing+ }+++updateIdealTargetLocation t asteroid =+ asteroid { idealTargetLocation = Just (M.idealNewLocation (wrapMap asteroid)+ (location asteroid)+ (velocity asteroid)+ t)+ }++instance Damageable Asteroid where++ inflictDamage = const+++instance Damaging Asteroid where++ damageEnergy _ = damageEnergy'+
+ BigAsteroid.hs view
@@ -0,0 +1,80 @@+module BigAsteroid where++import Animation+import Updating+import Graphics.Gloss.Data.Picture+import Graphics.Gloss.Data.Color+import qualified Moving as M+import Data.WrapAround+import ResourceTracker+import GHC.Float+import Combat+import Data.Maybe++asteroidRadius = 30.0++punch = 100.0++data BigAsteroid =+ BigAsteroid { location :: WrapPoint+ , idealTargetLocation :: Maybe WrapPoint+ , velocity :: (Double, Double)+ , wrapMap :: WrapMap+ , animDefault0 :: Picture+ }++new :: ResourceTracker -> WrapMap -> WrapPoint -> (Double, Double) -> BigAsteroid+new rt wmap location velocity =+ let pic = fromMaybe+ (Scale 0.20 0.20+ (Color white+ (Text "Error! Missing image!")))+ (getImage rt "asteroidbig.bmp") in+ BigAsteroid { location = location+ , velocity = velocity+ , wrapMap = wmap+ , idealTargetLocation = Nothing+ , animDefault0 = pic+ }+++instance Animation BigAsteroid where+ image self _ = animDefault0 self++instance M.Locatable BigAsteroid where+ center = location++instance M.Moving BigAsteroid where+ velocity = velocity++instance M.Colliding BigAsteroid where+ collisionRadius _ = asteroidRadius++instance InternallyUpdating BigAsteroid where++ preUpdate asteroid t = updateIdealTargetLocation t asteroid++ postUpdate asteroid t =+ let location' = fromMaybe+ (location asteroid)+ (idealTargetLocation asteroid) in+ asteroid { location = location'+ , idealTargetLocation = Nothing+ }+++updateIdealTargetLocation t asteroid =+ asteroid { idealTargetLocation = Just (M.idealNewLocation (wrapMap asteroid)+ (location asteroid)+ (velocity asteroid)+ t)+ }++instance Damageable BigAsteroid where++ inflictDamage = const+++instance Damaging BigAsteroid where++ damageEnergy _ = punch
+ COPYING view
@@ -0,0 +1,674 @@+ GNU GENERAL PUBLIC LICENSE+ Version 3, 29 June 2007++ Copyright (C) 2007 Free Software Foundation, Inc. <http://fsf.org/>+ Everyone is permitted to copy and distribute verbatim copies+ of this license document, but changing it is not allowed.++ Preamble++ The GNU General Public License is a free, copyleft license for+software and other kinds of works.++ The licenses for most software and other practical works are designed+to take away your freedom to share and change the works. By contrast,+the GNU General Public License is intended to guarantee your freedom to+share and change all versions of a program--to make sure it remains free+software for all its users. We, the Free Software Foundation, use the+GNU General Public License for most of our software; it applies also to+any other work released this way by its authors. You can apply it to+your programs, too.++ When we speak of free software, we are referring to freedom, not+price. Our General Public Licenses are designed to make sure that you+have the freedom to distribute copies of free software (and charge for+them if you wish), that you receive source code or can get it if you+want it, that you can change the software or use pieces of it in new+free programs, and that you know you can do these things.++ To protect your rights, we need to prevent others from denying you+these rights or asking you to surrender the rights. Therefore, you have+certain responsibilities if you distribute copies of the software, or if+you modify it: responsibilities to respect the freedom of others.++ For example, if you distribute copies of such a program, whether+gratis or for a fee, you must pass on to the recipients the same+freedoms that you received. You must make sure that they, too, receive+or can get the source code. And you must show them these terms so they+know their rights.++ Developers that use the GNU GPL protect your rights with two steps:+(1) assert copyright on the software, and (2) offer you this License+giving you legal permission to copy, distribute and/or modify it.++ For the developers' and authors' protection, the GPL clearly explains+that there is no warranty for this free software. For both users' and+authors' sake, the GPL requires that modified versions be marked as+changed, so that their problems will not be attributed erroneously to+authors of previous versions.++ Some devices are designed to deny users access to install or run+modified versions of the software inside them, although the manufacturer+can do so. This is fundamentally incompatible with the aim of+protecting users' freedom to change the software. The systematic+pattern of such abuse occurs in the area of products for individuals to+use, which is precisely where it is most unacceptable. Therefore, we+have designed this version of the GPL to prohibit the practice for those+products. If such problems arise substantially in other domains, we+stand ready to extend this provision to those domains in future versions+of the GPL, as needed to protect the freedom of users.++ Finally, every program is threatened constantly by software patents.+States should not allow patents to restrict development and use of+software on general-purpose computers, but in those that do, we wish to+avoid the special danger that patents applied to a free program could+make it effectively proprietary. To prevent this, the GPL assures that+patents cannot be used to render the program non-free.++ The precise terms and conditions for copying, distribution and+modification follow.++ TERMS AND CONDITIONS++ 0. Definitions.++ "This License" refers to version 3 of the GNU General Public License.++ "Copyright" also means copyright-like laws that apply to other kinds of+works, such as semiconductor masks.++ "The Program" refers to any copyrightable work licensed under this+License. Each licensee is addressed as "you". "Licensees" and+"recipients" may be individuals or organizations.++ To "modify" a work means to copy from or adapt all or part of the work+in a fashion requiring copyright permission, other than the making of an+exact copy. The resulting work is called a "modified version" of the+earlier work or a work "based on" the earlier work.++ A "covered work" means either the unmodified Program or a work based+on the Program.++ To "propagate" a work means to do anything with it that, without+permission, would make you directly or secondarily liable for+infringement under applicable copyright law, except executing it on a+computer or modifying a private copy. Propagation includes copying,+distribution (with or without modification), making available to the+public, and in some countries other activities as well.++ To "convey" a work means any kind of propagation that enables other+parties to make or receive copies. Mere interaction with a user through+a computer network, with no transfer of a copy, is not conveying.++ An interactive user interface displays "Appropriate Legal Notices"+to the extent that it includes a convenient and prominently visible+feature that (1) displays an appropriate copyright notice, and (2)+tells the user that there is no warranty for the work (except to the+extent that warranties are provided), that licensees may convey the+work under this License, and how to view a copy of this License. If+the interface presents a list of user commands or options, such as a+menu, a prominent item in the list meets this criterion.++ 1. Source Code.++ The "source code" for a work means the preferred form of the work+for making modifications to it. "Object code" means any non-source+form of a work.++ A "Standard Interface" means an interface that either is an official+standard defined by a recognized standards body, or, in the case of+interfaces specified for a particular programming language, one that+is widely used among developers working in that language.++ The "System Libraries" of an executable work include anything, other+than the work as a whole, that (a) is included in the normal form of+packaging a Major Component, but which is not part of that Major+Component, and (b) serves only to enable use of the work with that+Major Component, or to implement a Standard Interface for which an+implementation is available to the public in source code form. A+"Major Component", in this context, means a major essential component+(kernel, window system, and so on) of the specific operating system+(if any) on which the executable work runs, or a compiler used to+produce the work, or an object code interpreter used to run it.++ The "Corresponding Source" for a work in object code form means all+the source code needed to generate, install, and (for an executable+work) run the object code and to modify the work, including scripts to+control those activities. However, it does not include the work's+System Libraries, or general-purpose tools or generally available free+programs which are used unmodified in performing those activities but+which are not part of the work. For example, Corresponding Source+includes interface definition files associated with source files for+the work, and the source code for shared libraries and dynamically+linked subprograms that the work is specifically designed to require,+such as by intimate data communication or control flow between those+subprograms and other parts of the work.++ The Corresponding Source need not include anything that users+can regenerate automatically from other parts of the Corresponding+Source.++ The Corresponding Source for a work in source code form is that+same work.++ 2. Basic Permissions.++ All rights granted under this License are granted for the term of+copyright on the Program, and are irrevocable provided the stated+conditions are met. This License explicitly affirms your unlimited+permission to run the unmodified Program. The output from running a+covered work is covered by this License only if the output, given its+content, constitutes a covered work. This License acknowledges your+rights of fair use or other equivalent, as provided by copyright law.++ You may make, run and propagate covered works that you do not+convey, without conditions so long as your license otherwise remains+in force. You may convey covered works to others for the sole purpose+of having them make modifications exclusively for you, or provide you+with facilities for running those works, provided that you comply with+the terms of this License in conveying all material for which you do+not control copyright. Those thus making or running the covered works+for you must do so exclusively on your behalf, under your direction+and control, on terms that prohibit them from making any copies of+your copyrighted material outside their relationship with you.++ Conveying under any other circumstances is permitted solely under+the conditions stated below. Sublicensing is not allowed; section 10+makes it unnecessary.++ 3. Protecting Users' Legal Rights From Anti-Circumvention Law.++ No covered work shall be deemed part of an effective technological+measure under any applicable law fulfilling obligations under article+11 of the WIPO copyright treaty adopted on 20 December 1996, or+similar laws prohibiting or restricting circumvention of such+measures.++ When you convey a covered work, you waive any legal power to forbid+circumvention of technological measures to the extent such circumvention+is effected by exercising rights under this License with respect to+the covered work, and you disclaim any intention to limit operation or+modification of the work as a means of enforcing, against the work's+users, your or third parties' legal rights to forbid circumvention of+technological measures.++ 4. Conveying Verbatim Copies.++ You may convey verbatim copies of the Program's source code as you+receive it, in any medium, provided that you conspicuously and+appropriately publish on each copy an appropriate copyright notice;+keep intact all notices stating that this License and any+non-permissive terms added in accord with section 7 apply to the code;+keep intact all notices of the absence of any warranty; and give all+recipients a copy of this License along with the Program.++ You may charge any price or no price for each copy that you convey,+and you may offer support or warranty protection for a fee.++ 5. Conveying Modified Source Versions.++ You may convey a work based on the Program, or the modifications to+produce it from the Program, in the form of source code under the+terms of section 4, provided that you also meet all of these conditions:++ a) The work must carry prominent notices stating that you modified+ it, and giving a relevant date.++ b) The work must carry prominent notices stating that it is+ released under this License and any conditions added under section+ 7. This requirement modifies the requirement in section 4 to+ "keep intact all notices".++ c) You must license the entire work, as a whole, under this+ License to anyone who comes into possession of a copy. This+ License will therefore apply, along with any applicable section 7+ additional terms, to the whole of the work, and all its parts,+ regardless of how they are packaged. This License gives no+ permission to license the work in any other way, but it does not+ invalidate such permission if you have separately received it.++ d) If the work has interactive user interfaces, each must display+ Appropriate Legal Notices; however, if the Program has interactive+ interfaces that do not display Appropriate Legal Notices, your+ work need not make them do so.++ A compilation of a covered work with other separate and independent+works, which are not by their nature extensions of the covered work,+and which are not combined with it such as to form a larger program,+in or on a volume of a storage or distribution medium, is called an+"aggregate" if the compilation and its resulting copyright are not+used to limit the access or legal rights of the compilation's users+beyond what the individual works permit. Inclusion of a covered work+in an aggregate does not cause this License to apply to the other+parts of the aggregate.++ 6. Conveying Non-Source Forms.++ You may convey a covered work in object code form under the terms+of sections 4 and 5, provided that you also convey the+machine-readable Corresponding Source under the terms of this License,+in one of these ways:++ a) Convey the object code in, or embodied in, a physical product+ (including a physical distribution medium), accompanied by the+ Corresponding Source fixed on a durable physical medium+ customarily used for software interchange.++ b) Convey the object code in, or embodied in, a physical product+ (including a physical distribution medium), accompanied by a+ written offer, valid for at least three years and valid for as+ long as you offer spare parts or customer support for that product+ model, to give anyone who possesses the object code either (1) a+ copy of the Corresponding Source for all the software in the+ product that is covered by this License, on a durable physical+ medium customarily used for software interchange, for a price no+ more than your reasonable cost of physically performing this+ conveying of source, or (2) access to copy the+ Corresponding Source from a network server at no charge.++ c) Convey individual copies of the object code with a copy of the+ written offer to provide the Corresponding Source. This+ alternative is allowed only occasionally and noncommercially, and+ only if you received the object code with such an offer, in accord+ with subsection 6b.++ d) Convey the object code by offering access from a designated+ place (gratis or for a charge), and offer equivalent access to the+ Corresponding Source in the same way through the same place at no+ further charge. You need not require recipients to copy the+ Corresponding Source along with the object code. If the place to+ copy the object code is a network server, the Corresponding Source+ may be on a different server (operated by you or a third party)+ that supports equivalent copying facilities, provided you maintain+ clear directions next to the object code saying where to find the+ Corresponding Source. Regardless of what server hosts the+ Corresponding Source, you remain obligated to ensure that it is+ available for as long as needed to satisfy these requirements.++ e) Convey the object code using peer-to-peer transmission, provided+ you inform other peers where the object code and Corresponding+ Source of the work are being offered to the general public at no+ charge under subsection 6d.++ A separable portion of the object code, whose source code is excluded+from the Corresponding Source as a System Library, need not be+included in conveying the object code work.++ A "User Product" is either (1) a "consumer product", which means any+tangible personal property which is normally used for personal, family,+or household purposes, or (2) anything designed or sold for incorporation+into a dwelling. In determining whether a product is a consumer product,+doubtful cases shall be resolved in favor of coverage. For a particular+product received by a particular user, "normally used" refers to a+typical or common use of that class of product, regardless of the status+of the particular user or of the way in which the particular user+actually uses, or expects or is expected to use, the product. A product+is a consumer product regardless of whether the product has substantial+commercial, industrial or non-consumer uses, unless such uses represent+the only significant mode of use of the product.++ "Installation Information" for a User Product means any methods,+procedures, authorization keys, or other information required to install+and execute modified versions of a covered work in that User Product from+a modified version of its Corresponding Source. The information must+suffice to ensure that the continued functioning of the modified object+code is in no case prevented or interfered with solely because+modification has been made.++ If you convey an object code work under this section in, or with, or+specifically for use in, a User Product, and the conveying occurs as+part of a transaction in which the right of possession and use of the+User Product is transferred to the recipient in perpetuity or for a+fixed term (regardless of how the transaction is characterized), the+Corresponding Source conveyed under this section must be accompanied+by the Installation Information. But this requirement does not apply+if neither you nor any third party retains the ability to install+modified object code on the User Product (for example, the work has+been installed in ROM).++ The requirement to provide Installation Information does not include a+requirement to continue to provide support service, warranty, or updates+for a work that has been modified or installed by the recipient, or for+the User Product in which it has been modified or installed. Access to a+network may be denied when the modification itself materially and+adversely affects the operation of the network or violates the rules and+protocols for communication across the network.++ Corresponding Source conveyed, and Installation Information provided,+in accord with this section must be in a format that is publicly+documented (and with an implementation available to the public in+source code form), and must require no special password or key for+unpacking, reading or copying.++ 7. Additional Terms.++ "Additional permissions" are terms that supplement the terms of this+License by making exceptions from one or more of its conditions.+Additional permissions that are applicable to the entire Program shall+be treated as though they were included in this License, to the extent+that they are valid under applicable law. If additional permissions+apply only to part of the Program, that part may be used separately+under those permissions, but the entire Program remains governed by+this License without regard to the additional permissions.++ When you convey a copy of a covered work, you may at your option+remove any additional permissions from that copy, or from any part of+it. (Additional permissions may be written to require their own+removal in certain cases when you modify the work.) You may place+additional permissions on material, added by you to a covered work,+for which you have or can give appropriate copyright permission.++ Notwithstanding any other provision of this License, for material you+add to a covered work, you may (if authorized by the copyright holders of+that material) supplement the terms of this License with terms:++ a) Disclaiming warranty or limiting liability differently from the+ terms of sections 15 and 16 of this License; or++ b) Requiring preservation of specified reasonable legal notices or+ author attributions in that material or in the Appropriate Legal+ Notices displayed by works containing it; or++ c) Prohibiting misrepresentation of the origin of that material, or+ requiring that modified versions of such material be marked in+ reasonable ways as different from the original version; or++ d) Limiting the use for publicity purposes of names of licensors or+ authors of the material; or++ e) Declining to grant rights under trademark law for use of some+ trade names, trademarks, or service marks; or++ f) Requiring indemnification of licensors and authors of that+ material by anyone who conveys the material (or modified versions of+ it) with contractual assumptions of liability to the recipient, for+ any liability that these contractual assumptions directly impose on+ those licensors and authors.++ All other non-permissive additional terms are considered "further+restrictions" within the meaning of section 10. If the Program as you+received it, or any part of it, contains a notice stating that it is+governed by this License along with a term that is a further+restriction, you may remove that term. If a license document contains+a further restriction but permits relicensing or conveying under this+License, you may add to a covered work material governed by the terms+of that license document, provided that the further restriction does+not survive such relicensing or conveying.++ If you add terms to a covered work in accord with this section, you+must place, in the relevant source files, a statement of the+additional terms that apply to those files, or a notice indicating+where to find the applicable terms.++ Additional terms, permissive or non-permissive, may be stated in the+form of a separately written license, or stated as exceptions;+the above requirements apply either way.++ 8. Termination.++ You may not propagate or modify a covered work except as expressly+provided under this License. Any attempt otherwise to propagate or+modify it is void, and will automatically terminate your rights under+this License (including any patent licenses granted under the third+paragraph of section 11).++ However, if you cease all violation of this License, then your+license from a particular copyright holder is reinstated (a)+provisionally, unless and until the copyright holder explicitly and+finally terminates your license, and (b) permanently, if the copyright+holder fails to notify you of the violation by some reasonable means+prior to 60 days after the cessation.++ Moreover, your license from a particular copyright holder is+reinstated permanently if the copyright holder notifies you of the+violation by some reasonable means, this is the first time you have+received notice of violation of this License (for any work) from that+copyright holder, and you cure the violation prior to 30 days after+your receipt of the notice.++ Termination of your rights under this section does not terminate the+licenses of parties who have received copies or rights from you under+this License. If your rights have been terminated and not permanently+reinstated, you do not qualify to receive new licenses for the same+material under section 10.++ 9. Acceptance Not Required for Having Copies.++ You are not required to accept this License in order to receive or+run a copy of the Program. Ancillary propagation of a covered work+occurring solely as a consequence of using peer-to-peer transmission+to receive a copy likewise does not require acceptance. However,+nothing other than this License grants you permission to propagate or+modify any covered work. These actions infringe copyright if you do+not accept this License. Therefore, by modifying or propagating a+covered work, you indicate your acceptance of this License to do so.++ 10. Automatic Licensing of Downstream Recipients.++ Each time you convey a covered work, the recipient automatically+receives a license from the original licensors, to run, modify and+propagate that work, subject to this License. You are not responsible+for enforcing compliance by third parties with this License.++ An "entity transaction" is a transaction transferring control of an+organization, or substantially all assets of one, or subdividing an+organization, or merging organizations. If propagation of a covered+work results from an entity transaction, each party to that+transaction who receives a copy of the work also receives whatever+licenses to the work the party's predecessor in interest had or could+give under the previous paragraph, plus a right to possession of the+Corresponding Source of the work from the predecessor in interest, if+the predecessor has it or can get it with reasonable efforts.++ You may not impose any further restrictions on the exercise of the+rights granted or affirmed under this License. For example, you may+not impose a license fee, royalty, or other charge for exercise of+rights granted under this License, and you may not initiate litigation+(including a cross-claim or counterclaim in a lawsuit) alleging that+any patent claim is infringed by making, using, selling, offering for+sale, or importing the Program or any portion of it.++ 11. Patents.++ A "contributor" is a copyright holder who authorizes use under this+License of the Program or a work on which the Program is based. The+work thus licensed is called the contributor's "contributor version".++ A contributor's "essential patent claims" are all patent claims+owned or controlled by the contributor, whether already acquired or+hereafter acquired, that would be infringed by some manner, permitted+by this License, of making, using, or selling its contributor version,+but do not include claims that would be infringed only as a+consequence of further modification of the contributor version. For+purposes of this definition, "control" includes the right to grant+patent sublicenses in a manner consistent with the requirements of+this License.++ Each contributor grants you a non-exclusive, worldwide, royalty-free+patent license under the contributor's essential patent claims, to+make, use, sell, offer for sale, import and otherwise run, modify and+propagate the contents of its contributor version.++ In the following three paragraphs, a "patent license" is any express+agreement or commitment, however denominated, not to enforce a patent+(such as an express permission to practice a patent or covenant not to+sue for patent infringement). To "grant" such a patent license to a+party means to make such an agreement or commitment not to enforce a+patent against the party.++ If you convey a covered work, knowingly relying on a patent license,+and the Corresponding Source of the work is not available for anyone+to copy, free of charge and under the terms of this License, through a+publicly available network server or other readily accessible means,+then you must either (1) cause the Corresponding Source to be so+available, or (2) arrange to deprive yourself of the benefit of the+patent license for this particular work, or (3) arrange, in a manner+consistent with the requirements of this License, to extend the patent+license to downstream recipients. "Knowingly relying" means you have+actual knowledge that, but for the patent license, your conveying the+covered work in a country, or your recipient's use of the covered work+in a country, would infringe one or more identifiable patents in that+country that you have reason to believe are valid.++ If, pursuant to or in connection with a single transaction or+arrangement, you convey, or propagate by procuring conveyance of, a+covered work, and grant a patent license to some of the parties+receiving the covered work authorizing them to use, propagate, modify+or convey a specific copy of the covered work, then the patent license+you grant is automatically extended to all recipients of the covered+work and works based on it.++ A patent license is "discriminatory" if it does not include within+the scope of its coverage, prohibits the exercise of, or is+conditioned on the non-exercise of one or more of the rights that are+specifically granted under this License. You may not convey a covered+work if you are a party to an arrangement with a third party that is+in the business of distributing software, under which you make payment+to the third party based on the extent of your activity of conveying+the work, and under which the third party grants, to any of the+parties who would receive the covered work from you, a discriminatory+patent license (a) in connection with copies of the covered work+conveyed by you (or copies made from those copies), or (b) primarily+for and in connection with specific products or compilations that+contain the covered work, unless you entered into that arrangement,+or that patent license was granted, prior to 28 March 2007.++ Nothing in this License shall be construed as excluding or limiting+any implied license or other defenses to infringement that may+otherwise be available to you under applicable patent law.++ 12. No Surrender of Others' Freedom.++ If conditions are imposed on you (whether by court order, agreement or+otherwise) that contradict the conditions of this License, they do not+excuse you from the conditions of this License. If you cannot convey a+covered work so as to satisfy simultaneously your obligations under this+License and any other pertinent obligations, then as a consequence you may+not convey it at all. For example, if you agree to terms that obligate you+to collect a royalty for further conveying from those to whom you convey+the Program, the only way you could satisfy both those terms and this+License would be to refrain entirely from conveying the Program.++ 13. Use with the GNU Affero General Public License.++ Notwithstanding any other provision of this License, you have+permission to link or combine any covered work with a work licensed+under version 3 of the GNU Affero General Public License into a single+combined work, and to convey the resulting work. The terms of this+License will continue to apply to the part which is the covered work,+but the special requirements of the GNU Affero General Public License,+section 13, concerning interaction through a network will apply to the+combination as such.++ 14. Revised Versions of this License.++ The Free Software Foundation may publish revised and/or new versions of+the GNU General Public License from time to time. Such new versions will+be similar in spirit to the present version, but may differ in detail to+address new problems or concerns.++ Each version is given a distinguishing version number. If the+Program specifies that a certain numbered version of the GNU General+Public License "or any later version" applies to it, you have the+option of following the terms and conditions either of that numbered+version or of any later version published by the Free Software+Foundation. If the Program does not specify a version number of the+GNU General Public License, you may choose any version ever published+by the Free Software Foundation.++ If the Program specifies that a proxy can decide which future+versions of the GNU General Public License can be used, that proxy's+public statement of acceptance of a version permanently authorizes you+to choose that version for the Program.++ Later license versions may give you additional or different+permissions. However, no additional obligations are imposed on any+author or copyright holder as a result of your choosing to follow a+later version.++ 15. Disclaimer of Warranty.++ THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY+APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT+HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY+OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO,+THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR+PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM+IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF+ALL NECESSARY SERVICING, REPAIR OR CORRECTION.++ 16. Limitation of Liability.++ IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING+WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES AND/OR CONVEYS+THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY+GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE+USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF+DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD+PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS),+EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF+SUCH DAMAGES.++ 17. Interpretation of Sections 15 and 16.++ If the disclaimer of warranty and limitation of liability provided+above cannot be given local legal effect according to their terms,+reviewing courts shall apply local law that most closely approximates+an absolute waiver of all civil liability in connection with the+Program, unless a warranty or assumption of liability accompanies a+copy of the Program in return for a fee.++ END OF TERMS AND CONDITIONS++ How to Apply These Terms to Your New Programs++ If you develop a new program, and you want it to be of the greatest+possible use to the public, the best way to achieve this is to make it+free software which everyone can redistribute and change under these terms.++ To do so, attach the following notices to the program. It is safest+to attach them to the start of each source file to most effectively+state the exclusion of warranty; and each file should have at least+the "copyright" line and a pointer to where the full notice is found.++ <one line to give the program's name and a brief idea of what it does.>+ Copyright (C) <year> <name of author>++ 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 3 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, see <http://www.gnu.org/licenses/>.++Also add information on how to contact you by electronic and paper mail.++ If the program does terminal interaction, make it output a short+notice like this when it starts in an interactive mode:++ <program> Copyright (C) <year> <name of author>+ This program 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, your program's commands+might be different; for a GUI interface, you would use an "about box".++ You should also get your employer (if you work as a programmer) or school,+if any, to sign a "copyright disclaimer" for the program, if necessary.+For more information on this, and how to apply and follow the GNU GPL, see+<http://www.gnu.org/licenses/>.++ The GNU 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. But first, please read+<http://www.gnu.org/philosophy/why-not-lgpl.html>.
+ Combat.hs view
@@ -0,0 +1,97 @@+{-# LANGUAGE ExistentialQuantification #-}++module Combat where++import Updating+import Animation+import Moving+import Data.WrapAround++data Projectile = forall a. ( Animation a+ , Colliding a+ , Transient a+ , Damaging a+ , Damageable a+ ) => Projectile a++instance Colliding Projectile where++ collisionRadius (Projectile a) = collisionRadius a++instance Moving Projectile where++ velocity (Projectile a) = velocity a++instance Locatable Projectile where+ center (Projectile a) = center a++instance Damaging Projectile where+ damageEnergy (Projectile a) = damageEnergy a++instance Damageable Projectile where+ inflictDamage (Projectile a) et = Projectile (inflictDamage a et)++instance Transient Projectile where+ expired' (Projectile a) = expired' a++instance InternallyUpdating Projectile where+ preUpdate (Projectile a) et = Projectile (preUpdate a et)+ postUpdate (Projectile a) et = Projectile (postUpdate a et)++class Damaging a where++ damageEnergy :: a -> Double++class Damageable a where++ inflictDamage :: a -> Double -> a++inflictDamage' :: (Damaging a, Damageable b) => a -> b -> b+inflictDamage' a b = inflictDamage b (damageEnergy a)++class Launcher a where++ deployProjectiles :: a -> ([Projectile], a)++handleCollisionDamage :: ( Damaging a+ , Damageable a+ , Colliding a+ , Damaging b+ , Damageable b+ , Colliding b+ ) => WrapMap -> Double -> a -> [b] -> (a, [b])++handleCollisionDamage wmap tw x ys = handleCollisionDamage' x ys []++ where handleCollisionDamage' x [] nys = (x, nys)+ handleCollisionDamage' x (y:ys) nys =+ if not $ collisionWindow wmap (max+ (maxExpectedVelocity * tw)+ (collisionRadius x + collisionRadius y)) x y+ then handleCollisionDamage' x ys (nys ++ [y])+ else+ case collision wmap tw x y of+ Nothing -> handleCollisionDamage' x ys (nys ++ [y])+ Just _ -> let (nx, ny) = ( inflictDamage' y x+ , inflictDamage' x y+ ) in+ handleCollisionDamage' nx ys (nys ++ [ny])++handleCollisionDamage' :: ( Damaging a+ , Damageable a+ , Colliding a+ , Damaging b+ , Damageable b+ , Colliding b+ ) => WrapMap -> Double -> [a] -> [b] -> ([a], [b])++handleCollisionDamage' wmap tw xs ys = handleCollisionDamage'' xs ys []++ where handleCollisionDamage'' [] ys nxs = (nxs, ys)+ handleCollisionDamage'' (x:xs) ys nxs =+ let (rx, rys) = handleCollisionDamage wmap tw x ys in+ handleCollisionDamage'' xs rys (nxs ++ [rx])++data Impacting = forall a. (Damaging a, Damageable a, Colliding a) => Impacting a++
+ DONATE view
@@ -0,0 +1,5 @@+Care to support this free software project with a small donation? Visit:++https://frigidcode.com/donate++ -- Christopher Howard <christopher.howard@frigidcode.com>
+ Display.hs view
@@ -0,0 +1,247 @@+{-# LANGUAGE ExistentialQuantification #-}++module Display (displayUniverse) where++import Animation+import Universe+import Lance+import Data.Maybe+import Moving+import Star+import Data.WrapAround+import Graphics.Gloss.Interface.IO.Game+import GHC.Float+import Combat+import AfterEffect ( AfterEffect ( AfterEffect ) )+import Unit+import Item+import ResourceTracker++data Displayable = forall a. (Locatable a, Animation a) => Displayable a++displayUniverse u+ = let arena' = arena u in+ let wmap = Universe.wrapMap arena' in+ let pship = do lance' <- lance arena'+ Just (image lance' undefined) in+ let pship' = fromMaybe Blank pship in+ let viewCenterWp = case lance arena' of+ Just x -> Moving.center x+ Nothing -> lastFocus arena' in+ let displayables =+ do (Displayable displayable)+ <- map Displayable (stars arena')+ ++ map Displayable (asteroids arena')+ ++ [ Displayable a+ | Projectile a <- lanceProjectiles arena'+ ++ unitProjectiles arena'+ ]+ ++ [ case effect of+ AfterEffect a -> Displayable a+ | effect <- afterFX arena' ]+ ++ [ Displayable a | SimpleUnit a <- simpleUnits arena' ]+ ++ [ Displayable a | SmartUnit a <- smartUnits arena' ]+ ++ [ Displayable a | a <- items arena' ]+ let wp = Moving.center displayable in+ let (x, y) = vectorRelation wmap wp viewCenterWp in+ let pic = image displayable undefined in+ [ Translate (double2Float x) (double2Float y) pic ] in+ let deflectorBar' = Translate 65.0 370.0+ (case lance arena' of+ Just x -> deflectorBar (deflectorCharge x)+ Nothing -> deflectorBar 0.8+ ) in+ let deflectorText' = Translate (-65.0) 365.0 deflectorText in+ let levelText = Translate 140.0 365.0+ (Color white+ (Scale 0.14 0.14+ (Text ("level " ++ show (level u + 1))))) in+ let livesText = Translate (-140.0) 365.0+ (Color white+ (Scale 0.14 0.14+ (Text (show (lives u) ++ " lives")))) in+ let godText = case lance arena' of+ Nothing -> Blank+ Just l -> if not (godMode l)+ then Blank+ else Translate (-20.0) 335.0+ (Color yellow+ (Scale 0.14 0.14+ (Text "god mode"))) in+ let integrityText = Translate (-500.0) 365.0+ (Color white+ (Scale 0.14 0.14+ (Text "structural integrity"))) in+ let integrityAssessment =+ case lance arena' of+ Nothing -> Blank+ Just l -> if integrity l >= 3.0+ then Color green (Text "optimal")+ else if integrity l >= 2.0+ then Color yellow (Text "light damage")+ else Color red (Text "heavy damage") in+ let integrityTextL2 = Translate (-330.0) 365.0+ (Scale 0.14 0.14+ integrityAssessment) in+ let sP = Translate 450.0 330.0+ (sensorPanel arena' (100.0, 100.0)) in+ return $ Pictures $ displayables+ ++ [ pship'+ , deflectorText'+ , deflectorBar'+ , levelText+ , livesText+ , sP+ , godText+ , integrityText+ , integrityTextL2+ , Translate (-400.0) 340.0 (inventoryDisplay+ (lance arena')+ (resourceTracker u))+ ]++inventoryDisplay :: Maybe Lance -> ResourceTracker -> Picture+inventoryDisplay mLance rt =+ let spacing = 40.0 in+ case mLance of+ Nothing -> Blank+ Just l -> let i = inventory l in+ let pFourWay =+ if not (i !! 0)+ then Blank+ else let p = fromMaybe Blank+ (getImage rt "item-fourway.bmp") in+ Translate ((-2.0) * spacing) 0.0 p in+ let pCannon =+ if not (i !! 1)+ then Blank+ else let p = fromMaybe Blank+ (getImage rt "item-cannon.bmp") in+ Translate ((-1.0) * spacing) 0.0 p in+ let pSpread =+ if not (i !! 2)+ then Blank+ else let p = fromMaybe Blank+ (getImage rt "item-spread.bmp") in+ p in+ let pRapidFire =+ if not (i !! 3)+ then Blank+ else let p = fromMaybe Blank+ (getImage rt "item-rapidfire.bmp") in+ Translate spacing 0.0 p in+ let pNuke =+ if not (i !! 4)+ then Blank+ else let p = fromMaybe Blank+ (getImage rt "item-nuke.bmp") in+ Translate (2.0 * spacing) 0.0 p in+ let c = currentWeapon l in+ let pSelected =+ if c == 0+ then Blank+ else Translate+ ((fromIntegral c - 3.0) * spacing) 0.0+ (Line [ (12.0, 13.0)+ , (12.0, -12.0)+ , (-13.0, -12.0)+ , (-13.0, 13.0)+ , (12.0, 13.0)+ ]) in+ Pictures [ pFourWay+ , pCannon, pSpread, pRapidFire, pNuke, pSelected]++sensorPanel :: Arena -> (Double, Double) -> Picture+sensorPanel arena (w, h) =+ let wmap = wrapmap w h in+ let (w', h') = (double2Float w, double2Float h) in+ let (w'', h'') = (w' * 0.5, h' * 0.5) in+ -- let outline = Color white (Line [ (w' * 0.5, h' * 0.5)+ -- , (w' * 0.5, (-h') * 0.5)+ -- , ((-w') * 0.5,(-h') * 0.5)+ -- , ((-w') * 0.5, h' * 0.5)+ -- , (w' * 0.5, h' * 0.5)+ -- ]) in+ let outline = Color white+ (Pictures+ [ (Line [ (w'' - 4.0, h'')+ , (w'', h'')+ , (w'', h'' - 4.0)+ ])+ , (Line [ (w'', (-h'') + 4.0)+ , (w'', (-h''))+ , (w'' - 4.0, (-h''))+ ])+ , (Line [ ((-w''), (-h'') + 4.0)+ , ((-w''), (-h''))+ , ((-w'') + 4.0, (-h''))+ ])+ , (Line [ ((-w''), h'' - 4.0)+ , ((-w''), h'')+ , ((-w'') + 4.0, h'')+ ])+ ]) in++ let focalPoint = Color white (Line [ (2.0, 0.0)+ , (0.0, 2.0)+ , (-2.0, 0.0)+ , (0.0, -2.0)+ , (2.0, 0.0)+ ]) in+ let unitDots =+ [ let cp = case lance arena of+ Nothing -> lastFocus arena+ Just l -> Moving.center l in+ let (x, y) = vectorRelation wmap cp c in+ Translate+ (double2Float (-x))+ (double2Float (-y))+ (Color white (Polygon [ (2.0, 0.0)+ , (0.0, 2.0)+ , (-2.0, 0.0)+ , (0.0, -2.0)+ ]))+ | c <- map Moving.center (simpleUnits arena)+ ++ map Moving.center (smartUnits arena)+ ] in+ let itemDots =+ [ let cp = case lance arena of+ Nothing -> lastFocus arena+ Just l -> Moving.center l in+ let (x, y) = vectorRelation wmap cp c in+ Translate+ (double2Float (-x))+ (double2Float (-y))+ (Color cyan (Polygon [ (2.0, 0.0)+ , (0.0, 2.0)+ , (-2.0, 0.0)+ , (0.0, -2.0)+ ]))+ | c <- map Moving.center (items arena)+ ] in+ Pictures $ [ outline+ , focalPoint+ ] ++ unitDots ++ itemDots++deflectorText = Color white (Scale 0.14 0.14 (Text "deflector"))++deflectorBar charge =+ let width = 100.0 in+ let height = 20.0 in+ let outline = Line [ ((-width) / 2.0, height / 2.0)+ , (width / 2.0, height / 2.0)+ , (width / 2.0, (-height) / 2.0)+ , ((-width) / 2.0, (-height) / 2.0)+ , ((-width) / 2.0, height / 2.0)+ ] in+ let portion = (double2Float charge - 0.8) / (2.0 - 0.8) in+ let barColor = if charge < 1.0 then red+ else white in+ let bar = Polygon [ ((-width) / 2.0, height / 2.0)+ , ((-width) / 2.0 + portion * width, height / 2.0)+ , ((-width) / 2.0 + portion * width, (-height) / 2.0)+ , ((-width) / 2.0, (-height) / 2.0)+ ] in+ Pictures [Color barColor bar+ , Color white outline+ ]
+ Input.hs view
@@ -0,0 +1,188 @@+module Input where++import Universe+import Graphics.Gloss.Interface.IO.Game+import Lance++handleInput :: Event -> Universe -> IO Universe++handleInput (EventKey (Char ':') Down Modifiers { shift = Down+ , ctrl = Down+ , alt = Down+ } _) u+ = let a = arena u in+ let mL = lance a in+ case mL of+ Nothing -> return u+ Just l -> return u { arena = a+ { lance = Just l+ { godMode = True } } }++handleInput (EventKey (Char '"') Down Modifiers { shift = Down+ , ctrl = Down+ , alt = Down+ } _) u+ = return u { skipLevel = True }++--- two-hand keys ---++handleInput (EventKey (SpecialKey KeyLeft) Down _ _) u+ = ccwThrusters u++handleInput (EventKey (SpecialKey KeyLeft) Up _ _) u+ = stabilizeThrusters u++handleInput (EventKey (SpecialKey KeyRight) Down _ _) u+ = cwThrusters u++handleInput (EventKey (SpecialKey KeyRight) Up _ _) u+ = stabilizeThrusters u++handleInput (EventKey (SpecialKey KeyUp) Down _ _) u+ = activateForwardThrusters u++handleInput (EventKey (SpecialKey KeyUp) Up _ _) u+ = deactivateForwardThrusters u++handleInput (EventKey (SpecialKey KeySpace) Down _ _) u+ = activateDeflector u++handleInput (EventKey (SpecialKey KeySpace) Up _ _) u+ = deactivateDeflector u++handleInput (EventKey (Char 'a') Down _ _) u+ = setFireTrigger u+ +handleInput (EventKey (Char 'a') Up _ _) u+ = releaseFireTrigger u++handleInput (EventKey (SpecialKey KeyTab) Down _ _) u+ = switchWeapon u++--------------------- keypad keys++handleInput (EventKey (Char '4') Down _ _) u+ = ccwThrusters u++handleInput (EventKey (Char '4') Up _ _) u+ = stabilizeThrusters u++handleInput (EventKey (Char '6') Down _ _) u+ = cwThrusters u++handleInput (EventKey (Char '6') Up _ _) u+ = stabilizeThrusters u++handleInput (EventKey (Char '8') Down _ _) u+ = activateForwardThrusters u++handleInput (EventKey (Char '8') Up _ _) u+ = deactivateForwardThrusters u++handleInput (EventKey (Char '0') Down _ _) u+ = setFireTrigger u++handleInput (EventKey (Char '0') Up _ _) u+ = releaseFireTrigger u++handleInput (EventKey (SpecialKey KeyEnter) Down _ _) u+ = activateDeflector u++handleInput (EventKey (SpecialKey KeyEnter) Up _ _) u+ = deactivateDeflector u++handleInput (EventKey (Char '5') Down _ _) u+ = switchWeapon u++handleInput _ u = return u++setFireTrigger u+ = let a = arena u in+ let mL = lance a in+ case mL of+ Nothing -> return u+ Just l -> return u { arena = a+ { lance = Just l+ { fireTrigger = True } } }++releaseFireTrigger u+ = let a = arena u in+ let mL = lance a in+ case mL of+ Nothing -> return u+ Just l -> return u { arena = a+ { lance = Just l+ { fireTrigger = False } } }++activateDeflector u+ = let a = arena u in+ let mL = lance a in+ case mL of+ Nothing -> return u+ Just l -> return u { arena = a+ { lance = Just l+ { deflector = True } } }++deactivateDeflector u+ = let a = arena u in+ let mL = lance a in+ case mL of+ Nothing -> return u+ Just l -> return u { arena = a+ { lance = Just l+ { deflector = False } } }++ccwThrusters u+ = let a = arena u in+ let mL = lance a in+ case mL of+ Nothing -> return u+ Just l -> return u { arena = a+ { lance = Just l+ { rotationalThrusters = CCW } } }++stabilizeThrusters u+ = let a = arena u in+ let mL = lance a in+ case mL of+ Nothing -> return u+ Just l -> return u { arena = a+ { lance = Just l+ { rotationalThrusters = Stable } } }++cwThrusters u+ = let a = arena u in+ let mL = lance a in+ case mL of+ Nothing -> return u+ Just l -> return u { arena = a+ { lance = Just l+ { rotationalThrusters = CW } } }++activateForwardThrusters u+ = let a = arena u in+ let mL = lance a in+ case mL of+ Nothing -> return u+ Just l -> return u { arena = a+ { lance = Just l+ { linearThrusters = True } } }++deactivateForwardThrusters u+ = let a = arena u in+ let mL = lance a in+ case mL of+ Nothing -> return u+ Just l -> return u { arena = a+ { lance = Just l+ { linearThrusters = False } } }++switchWeapon u+ = let a = arena u in+ let mL = lance a in+ case mL of+ Nothing -> return u+ Just l -> return u { arena = a+ { lance = Just (changeCurrentWeapon l) }+ }+
+ Item.hs view
@@ -0,0 +1,58 @@+module Item where++import Data.WrapAround+import Moving+import Animation+import Data.Maybe+import Graphics.Gloss.Data.Picture+import Graphics.Gloss.Data.Color+import ResourceTracker+import System.Random++data ItemType = Health+ | FourWay+ | Cannon+ | Spread+ | RapidFire+ | Nuke+ deriving (Show)++data Item = Item ItemType ResourceTracker WrapPoint+ deriving (Show)++instance Colliding Item where+ collisionRadius _ = 11.0++instance Locatable Item where+ center (Item _ _ a) = a++instance Moving Item where++ velocity _ = (0.0, 0.0)++instance Animation Item where+ image (Item ty rt _) _ = fromMaybe+ (Scale 0.20 0.20+ (Color white+ (Text "Error! Missing image!")))+ (getImage rt pic)+ where pic = case ty of+ Health -> "item-health.bmp"+ FourWay -> "item-fourway.bmp"+ Cannon -> "item-cannon.bmp"+ Spread -> "item-spread.bmp"+ RapidFire -> "item-rapidfire.bmp"+ Nuke -> "item-nuke.bmp"++randomItemType :: IO (ItemType)+randomItemType = do let min = (0 :: Int)+ let max = (5 :: Int)+ r <- randomRIO (min, max)+ return $+ case r of+ 0 -> Health+ 1 -> FourWay+ 2 -> Cannon+ 3 -> Spread+ 4 -> RapidFire+ otherwise -> Nuke
+ Lance.hs view
@@ -0,0 +1,416 @@+module Lance ( Lance ( rotationalThrusters+ , linearThrusters+ , deflector+ , fireTrigger+ , deflectorCharge+ , center+ , angle+ , velocity+ , godMode+ , integrity+ , inventory+ , currentWeapon+ )+ , new+ , RotationDirection (..)+ , shielded+ , processItem+ , changeCurrentWeapon+ ) where++import Data.WrapAround+import Animation+import Graphics.Gloss.Data.Picture+import Graphics.Gloss.Data.Color+import GHC.Float+import Trigonometry+import ResourceTracker+import Data.Maybe+import Updating+import qualified Moving as M+import Combat+import qualified Projectile.BulletMkI as P.BulletMkI+import qualified Projectile.Cannon as P.Cannon+import qualified Projectile.Nuke as P.Nuke+import AfterEffect+import qualified AfterEffect.SimpleExplosion as SimpleExplosion+import Sound.ALUT+import Item++radialVelocity = pi -- radians per second++accelerationRate = 200 -- points per second++maxVelocity = 500 -- points per second++kamikazeDamage = 8.0++deflectorChargeLossFactor = 0.8++data RotationDirection = Stable | CW | CCW+ deriving (Eq)++type LanceInventory = [Bool]++data Lance = Lance { angle :: Double -- radians+ , center :: WrapPoint+ , rotationalThrusters :: RotationDirection+ , idealTargetCenter :: Maybe WrapPoint+ , velocity :: (Double, Double)+ , linearThrusters :: Bool+ , wrapMap :: WrapMap+ , resourceTracker :: ResourceTracker++ -- deflector + , deflectorCharge :: Double+ , deflector :: Bool++ -- firing+ , launchTube :: [Projectile]+ , sinceLastShot :: Double+ , fireTrigger :: Bool+ , currentWeapon :: Int+ , inventory :: LanceInventory++ -- death+ , integrity :: Double++ -- Sound+ , queueShotSound :: Bool+ , shotSoundSource :: Maybe Source++ , godMode :: Bool+ }++new :: ResourceTracker -> WrapMap -> WrapPoint -> Lance+new rt wmap center =+ Lance { center = center+ , angle = 0.0+ , rotationalThrusters = Stable+ , idealTargetCenter = Nothing+ , velocity = (0.0, 0.0)+ , linearThrusters = False+ , wrapMap = wmap+ , resourceTracker = rt+ , deflector = False+ , deflectorCharge = 2.0+ , launchTube = []+ , sinceLastShot = 0.0+ , fireTrigger = False+ , currentWeapon = 0+ , inventory = [False, False, False, False, False]+ , queueShotSound = False+ , shotSoundSource = Nothing+ , godMode = False+ , integrity = 3.0+ }++changeCurrentWeapon self =+ let i = inventory self in+ let c = currentWeapon self in+ let c' = if c + 1 > 5+ then if i !! 0+ then 1+ else 0+ else c + 1 in+ if c' /= 0 && not (i !! (c' - 1))+ then changeCurrentWeapon self { currentWeapon = c' }+ else self { currentWeapon = c' }++replaceAt :: Int -> a -> [a] -> [a]+replaceAt i a as+ | i < 0 = as+ | i >= length as = as+ | otherwise = let x = take i as in+ let y = drop (i + 1) as in+ x ++ [a] ++ y++processItem :: Lance -> Item -> Lance+processItem self (Item typ _ _) =+ case typ of+ Health -> self { integrity = 3.0 }+ FourWay -> self { inventory = replaceAt 0 True (inventory self)+ , currentWeapon = 1+ }+ Cannon -> self { inventory = replaceAt 1 True (inventory self) + , currentWeapon = 2+ }+ Spread -> self { inventory = replaceAt 2 True (inventory self) + , currentWeapon = 3+ }+ RapidFire -> self { inventory = replaceAt 3 True (inventory self) + , currentWeapon = 4+ }+ Nuke -> self { inventory = replaceAt 4 True (inventory self) + , currentWeapon = 5+ }++instance Audible Lance where++ processAudio self lcenter =+ do self' <- if isNothing (shotSoundSource self)+ then initializeShotSoundSource self+ else return self+ if not (queueShotSound self)+ then return self'+ else do play [fromJust $ shotSoundSource self]+ return self' { queueShotSound = False }++ terminateAudio self =+ if isNothing (shotSoundSource self)+ then return self+ else do stop [fromJust (shotSoundSource self)]+ return self++initializeShotSoundSource self =+ do [source] <- genObjectNames 1+ buffer source $= getSound (resourceTracker self) "simple-energy-shot.wav"+ -- ...+ return self { shotSoundSource = Just source }++shielded :: Lance -> Bool+shielded lance = deflectorCharge lance >= 1.0 && deflector lance++updateAngle :: Double -> Lance -> Lance+updateAngle t lance+ | rotationalThrusters lance == CW+ = lance { angle = angle lance - radialVelocity * t}+ | rotationalThrusters lance == CCW+ = lance { angle = angle lance + radialVelocity * t}+ | otherwise = lance++instance Animation Lance where+ image lance _ = let rt = resourceTracker lance in+ let lancePic = fromMaybe+ (Scale 0.20 0.20+ (Color white+ (Text "Error! Missing image!")))+ (getImage rt "lance.bmp") in+ let lanceThrustingPic =+ fromMaybe+ (Scale 0.20 0.20+ (Color white+ (Text "Error! Missing image!")))+ (getImage rt "lance-thrusting.bmp") in+ let pic = if linearThrusters lance then lanceThrustingPic+ else lancePic in+ let deflector' = if deflector lance+ && deflectorCharge lance >= 1.0+ then Color white (Circle 40.0)+ else Blank in+ Pictures [ deflector'+ , Rotate (radToDeg+ (double2Float+ (angle lance)) * (-1) - 90) pic+ ]++instance M.Locatable Lance where+ center = Lance.center++instance M.Moving Lance where+ velocity = velocity++instance M.Colliding Lance where+ collisionRadius _ = 20.0++instance InternallyUpdating Lance where++ preUpdate lance t = (updateFiringInformation t .+ updateIdealTargetCenter t .+ updateVelocity t .+ updateAngle t) lance++ postUpdate lance t =+ let center' = fromMaybe (center lance) (idealTargetCenter lance) in+ updateDeflectorCharge t+ lance { center = center'+ , idealTargetCenter = Nothing+ }++updateFiringInformation t lance =+ let sinceLastShot' = sinceLastShot lance + t in+ case currentWeapon lance of+ 1 -> handleFourWayWeapon lance sinceLastShot'+ 2 -> handleCannonWeapon lance sinceLastShot'+ 3 -> handleSpreadWeapon lance sinceLastShot'+ 4 -> handleRapidFireWeapon lance sinceLastShot'+ 5 -> handleNukeWeapon lance sinceLastShot'+ otherwise -> handleDefaultWeapon lance sinceLastShot'+ +handleDefaultWeapon self ls =+ if ls >= 0.4 && fireTrigger self+ then self { sinceLastShot = 0.0+ , launchTube =+ Projectile ( P.BulletMkI.new+ (wrapMap self)+ (angle self)+ (center self)+ (velocity self) ) : launchTube self+ , queueShotSound = True+ }+ else self { sinceLastShot = ls }++handleFourWayWeapon self ls =+ if ls >= 0.4 && fireTrigger self+ then self { sinceLastShot = 0.0+ , launchTube =+ [ Projectile ( P.BulletMkI.new+ (wrapMap self)+ (angle self)+ (center self)+ (velocity self) ) ]+ ++ [ Projectile ( P.BulletMkI.new+ (wrapMap self)+ (angle self + pi / 2)+ (center self)+ (velocity self) ) ]+ ++ [ Projectile ( P.BulletMkI.new+ (wrapMap self)+ (angle self + pi)+ (center self)+ (velocity self) ) ]+ ++ [ Projectile ( P.BulletMkI.new+ (wrapMap self)+ (angle self + 3 * pi / 2)+ (center self)+ (velocity self) ) ]+ ++ launchTube self+ , queueShotSound = True+ }+ else self { sinceLastShot = ls }++handleCannonWeapon self ls =+ if ls >= 0.7 && fireTrigger self+ then self { sinceLastShot = 0.0+ , launchTube =+ Projectile ( P.Cannon.new+ (wrapMap self)+ (angle self)+ (center self)+ (velocity self) ) : launchTube self+ , queueShotSound = True+ }+ else self { sinceLastShot = ls }++handleSpreadWeapon self ls =+ let spreadAngle = pi / 10 in+ if ls >= 0.4 && fireTrigger self+ then self { sinceLastShot = 0.0+ , launchTube =+ [ Projectile ( P.BulletMkI.new+ (wrapMap self)+ (angle self)+ (center self)+ (velocity self) ) ]+ ++ [ Projectile ( P.BulletMkI.new+ (wrapMap self)+ (angle self + spreadAngle)+ (center self)+ (velocity self) ) ]+ ++ [ Projectile ( P.BulletMkI.new+ (wrapMap self)+ (angle self + spreadAngle * 2)+ (center self)+ (velocity self) ) ]+ ++ [ Projectile ( P.BulletMkI.new+ (wrapMap self)+ (angle self - spreadAngle)+ (center self)+ (velocity self) ) ]+ ++ [ Projectile ( P.BulletMkI.new+ (wrapMap self)+ (angle self - spreadAngle * 2)+ (center self)+ (velocity self) ) ]+ ++ launchTube self+ , queueShotSound = True+ }+ else self { sinceLastShot = ls }++handleRapidFireWeapon self ls =+ if ls >= 0.2 && fireTrigger self+ then self { sinceLastShot = 0.0+ , launchTube =+ Projectile ( P.BulletMkI.new+ (wrapMap self)+ (angle self)+ (center self)+ (velocity self) ) : launchTube self+ , queueShotSound = True+ }+ else self { sinceLastShot = ls }++handleNukeWeapon self ls =+ if ls >= 3.0 && fireTrigger self+ then self { sinceLastShot = 0.0+ , launchTube =+ Projectile ( P.Nuke.new+ (wrapMap self)+ (resourceTracker self)+ (angle self)+ (center self)+ (velocity self) ) : launchTube self+ , queueShotSound = True+ }+ else self { sinceLastShot = ls }++updateDeflectorCharge t lance =+ let charge = deflectorCharge lance in+ let charge' = if deflector lance then max 0.8 (charge - t+ * deflectorChargeLossFactor)+ else min 2.0 (charge + t * 0.05) in+ lance { deflectorCharge = charge' }++updateIdealTargetCenter :: Double -> Lance -> Lance+updateIdealTargetCenter t lance =+ lance { idealTargetCenter = Just (M.idealNewLocation (wrapMap lance)+ (center lance)+ (velocity lance)+ t)+ }++updateVelocity :: Double -> Lance -> Lance+updateVelocity t lance+ | linearThrusters lance =+ lance { velocity = M.calcNewVelocity+ (velocity lance)+ accelerationRate+ (angle lance)+ maxVelocity+ t + }+ | otherwise = lance++instance Launcher Lance where++ deployProjectiles self = (launchTube self, self { launchTube = []+ -- , sinceLastShot = 0.0+ })++instance Damaging Lance where++ damageEnergy self =+ if not (deflector self) || deflectorCharge self < 1.0+ then kamikazeDamage+ else 0.0++instance Damageable Lance where++ inflictDamage self d =+ let d' = if godMode self then 0 else d in+ if d' > 0 && (not (deflector self) || deflectorCharge self < 1.0)+ then self { integrity = integrity self - d }+ else self++instance Transient Lance where++ expired' self = if not (integrity self <= 0.0)+ then Nothing+ else Just [ef]+ where ef = AfterEffect (SimpleExplosion.new (resourceTracker self)+ (wrapMap self)+ (Lance.center self)+ (Lance.velocity self))++-- instance Audible Lance where+-- processAudio self = queueShotFX
+ Moving.hs view
@@ -0,0 +1,97 @@+module Moving where++import Data.WrapAround+import qualified Data.WrapAround as W+import Trigonometry+import Data.List (find)+import Control.Monad (join)++maxExpectedVelocity = 1000 -- should equal max velocity of fastest object in arena++calcNewVelocity+ :: (Double, Double) -> Double -> Double -> Double -> Double -> (Double, Double)+calcNewVelocity oVelocity accelerationRate thrustAngle maxVelocity t =+ let (vXo, vYo) = oVelocity in+ let acceleration = t * accelerationRate in+ let dX = cos thrustAngle * acceleration in+ let dY = sin thrustAngle * acceleration in+ let vXn = vXo + dX in+ let vYn = vYo + dY in+ let magVN' = sqrt (vXn ** 2 + vYn ** 2) in+ let magVN = if magVN' == 0 then 0.1 -- erm... necessary?+ else magVN' in+ let aVN = if vXn >= 0 then asin (vYn / magVN)+ else pi - asin (vYn / magVN) in+ let finalMag = min magVN maxVelocity in+ let finalX = cos aVN * finalMag in+ let finalY = sin aVN * finalMag in+ (finalX, finalY)++idealNewLocation :: WrapMap -> WrapPoint -> (Double, Double) -> Double -> WrapPoint+idealNewLocation wmap oLocation (velX, velY) t =+ addPoints' wmap oLocation velocity'+ where velocity' = (velX * t, velY * t)++class Locatable a where+ center :: a -> WrapPoint++class (Locatable a) => Moving a where++ velocity :: a -> (Double, Double)++class (Moving a) => Colliding a where++ collisionRadius :: a -> Double++data Collision = Collision { time :: Double -- since start of collision detection+ -- window frame+ , center1 :: WrapPoint -- at point of collision+ , center2 :: WrapPoint -- likewise+ }++-- Double refers to time window for checking for collision+collision :: (Colliding a, Colliding b)+ => WrapMap+ -> Double+ -> a+ -> b+ -> Maybe Collision+collision wmap tw obj1 obj2 =+ let r1 = collisionRadius obj1 in+ let r2 = collisionRadius obj2 in+ let v1 = velocity obj1 in+ let v2 = velocity obj2 in+ let dD = Trigonometry.distance v1 v2 in+ let ts = fromIntegral $ ceiling (dD / (r1 + r2)) in+ let ti = tw / ts in+ let tpoints = [ x * ti | x <- [0..ts] ] in+ let o1 = center obj1 in+ let o2 = center obj2 in+ let points = [ ( addPoints' wmap o1 (mulSV t v1)+ , addPoints' wmap o2 (mulSV t v2)+ ) | t <- tpoints ] in+ let distances = [ W.distance wmap p1 p2 | (p1, p2) <- points ] in+ let zipped = zip3 tpoints points distances in+ do (t, (p1, p2), _) <- find (\(_, _, d) -> d <= r1 + r2) zipped+ Just Collision { time = t+ , center1 = p1+ , center2 = p2+ }++collisionWindow :: (Colliding a, Colliding b) => WrapMap -> Double -> a -> b -> Bool+collisionWindow wmap range obj1 obj2 =+ W.distance wmap (center obj1) (center obj2) <= range++collisionScan :: (Colliding a, Colliding b) => WrapMap -> a -> [b] -> Double -> Maybe Collision+collisionScan wmap c cs t =+ let relAsteroids =+ [ a | a <- cs+ , let range = max (maxExpectedVelocity * 2 * t)+ (collisionRadius c + collisionRadius a) in+ collisionWindow wmap range c a+ ] in+ let collisions = map (collision wmap t c) relAsteroids in+ join (find (\a -> case a of+ Nothing -> False+ otherwise -> True) collisions)+
+ Projectile/Blade.hs view
@@ -0,0 +1,114 @@+module Projectile.Blade ( Blade(..)+ , new+ , range+ , speed+ ) where++import Combat+import Animation+import Updating+import Graphics.Gloss.Data.Picture+import Graphics.Gloss.Data.Color+import Data.WrapAround+import qualified Moving as M+import Trigonometry+import Data.Maybe+import ResourceTracker+import GHC.Float++velocityC = 250.0+rangeC = 1500.0+punch = 4.0++range = rangeC+speed = velocityC++data Blade =+ Blade { velocity :: (Double, Double)+ , center :: WrapPoint+ , rangeLeft :: Double+ , wrapMap :: WrapMap+ , idealNewCenter :: Maybe WrapPoint+ , clock :: Double+ , resourceTracker :: ResourceTracker+ }++-- angle is radians+new :: WrapMap -> ResourceTracker -> Double -> WrapPoint -> (Double, Double) -> Blade+new wmap rt angle center' (vpx, vpy) =+ let x = cos angle * velocityC in+ let y = sin angle * velocityC in+ Blade { velocity = (x + vpx, y + vpy)+ , center = center'+ , rangeLeft = rangeC+ , wrapMap = wmap+ , idealNewCenter = Nothing+ , clock = 0.0+ , resourceTracker = rt+ }++instance Animation Blade where++ image self t = Rotate (double2Float deg) p+ where deg = radToDeg ((clock self * 4 * pi) `doubleRem` (2 * pi))+ p = fromMaybe+ (Color white+ (Line [(-40, 0), (40, 0)]))+ (getImage rt "blade.bmp")+ rt = resourceTracker self+ +instance M.Colliding Blade where++ collisionRadius self = 20.0++instance M.Moving Blade where++ velocity self = Projectile.Blade.velocity self++instance M.Locatable Blade where++ center self = Projectile.Blade.center self++instance SimpleTransient Blade where++ expired self = rangeLeft self <= 0.0++instance InternallyUpdating Blade where++ preUpdate self t = updateIdealTargetCenter t self++ postUpdate self t =+ let center' = case idealNewCenter self of+ Nothing -> center self+ Just x -> x in+ self { center = center'+ , idealNewCenter = Nothing+ , clock = clock self + t+ }++updateIdealTargetCenter :: Double -> Blade -> Blade+updateIdealTargetCenter t self =+ let newLoc = M.idealNewLocation (wrapMap self)+ (center self)+ (velocity self)+ t in+ self { idealNewCenter = Just (newLoc)+ , rangeLeft = max 0.0 $ rangeLeft self+ - Data.WrapAround.distance (wrapMap self)+ (center self)+ (newLoc)+ }++instance Damaging Blade where++ damageEnergy b = punch++instance Transient Blade where++ expired' self = if rangeLeft self <= 0.0+ then Just []+ else Nothing++instance Damageable Blade where++ inflictDamage self d = self
+ Projectile/BulletMI.hs view
@@ -0,0 +1,111 @@+module Projectile.BulletMI ( BulletMI(..)+ , new+ ) where++import Combat+import Animation+import Updating+import Graphics.Gloss.Data.Picture+import Graphics.Gloss.Data.Color+import Data.WrapAround+import qualified Moving as M++velocityC = 400.0+rangeC = 500.0++data BulletMI =+ BulletMI { velocity :: (Double, Double)+ , center :: WrapPoint+ , rangeLeft :: Double+ , wrapMap :: WrapMap+ , idealNewCenter :: Maybe WrapPoint+ , impacted :: Bool+ , clock :: Double+ }++-- angle is radians+new :: WrapMap -> Double -> WrapPoint -> (Double, Double) -> BulletMI+new wmap angle center' (vpx, vpy) =+ let x = cos angle * velocityC in+ let y = sin angle * velocityC in+ BulletMI { velocity = (x + vpx, y + vpy)+ , center = center'+ , rangeLeft = rangeC+ , wrapMap = wmap+ , idealNewCenter = Nothing+ , impacted = False+ , clock = 0.0+ }++instance Animation BulletMI where++ image self t = let r = fromInteger (ceiling (clock self)) - clock self in+ Color (c r)+ (Rotate 45.0+ (Circle 4.0))+ where c x | x < 0.10 = red+ | x < 0.20 = yellow+ | x < 0.30 = red+ | x < 0.40 = yellow+ | x < 0.50 = red+ | x < 0.60 = yellow+ | x < 0.70 = red+ | x < 0.80 = yellow+ | x < 0.90 = red+ | otherwise = yellow++instance M.Colliding BulletMI where++ collisionRadius b = 2.0++instance M.Moving BulletMI where++ velocity b = Projectile.BulletMI.velocity b++instance M.Locatable BulletMI where++ center b = Projectile.BulletMI.center b++instance SimpleTransient BulletMI where++ expired b = rangeLeft b <= 0.0++instance InternallyUpdating BulletMI where++ preUpdate self t = let s' = updateIdealTargetCenter t self in+ s' { clock = clock self + t }++ postUpdate self t =+ let center' = case idealNewCenter self of+ Nothing -> center self+ Just x -> x in+ self { center = center'+ , idealNewCenter = Nothing+ }++updateIdealTargetCenter :: Double -> BulletMI -> BulletMI+updateIdealTargetCenter t self =+ let newLoc = M.idealNewLocation (wrapMap self)+ (center self)+ (velocity self)+ t in+ self { idealNewCenter = Just (newLoc)+ , rangeLeft = max 0.0 $ rangeLeft self - distance (wrapMap self)+ (center self)+ (newLoc)+ }++instance Damaging BulletMI where++ damageEnergy b = 2.0++instance Transient BulletMI where++ expired' self = if impacted self || rangeLeft self <= 0.0+ then Just []+ else Nothing++instance Damageable BulletMI where++ inflictDamage self d = if d > 0 then self { impacted = True }+ else self
+ Projectile/BulletMII.hs view
@@ -0,0 +1,111 @@+module Projectile.BulletMII ( BulletMII(..)+ , new+ ) where++import Combat+import Animation+import Updating+import Graphics.Gloss.Data.Picture+import Graphics.Gloss.Data.Color+import Data.WrapAround+import qualified Moving as M++velocityC = 400.0+rangeC = 700.0++data BulletMII =+ BulletMII { velocity :: (Double, Double)+ , center :: WrapPoint+ , rangeLeft :: Double+ , wrapMap :: WrapMap+ , idealNewCenter :: Maybe WrapPoint+ , impacted :: Bool+ , clock :: Double+ }++-- angle is radians+new :: WrapMap -> Double -> WrapPoint -> (Double, Double) -> BulletMII+new wmap angle center' (vpx, vpy) =+ let x = cos angle * velocityC in+ let y = sin angle * velocityC in+ BulletMII { velocity = (x + vpx, y + vpy)+ , center = center'+ , rangeLeft = rangeC+ , wrapMap = wmap+ , idealNewCenter = Nothing+ , impacted = False+ , clock = 0.0+ }++instance Animation BulletMII where++ image self t = let r = fromInteger (ceiling (clock self)) - clock self in+ Color (c r)+ (Rotate 45.0+ (Circle 4.0))+ where c x | x < 0.10 = red+ | x < 0.20 = yellow+ | x < 0.30 = red+ | x < 0.40 = yellow+ | x < 0.50 = red+ | x < 0.60 = yellow+ | x < 0.70 = red+ | x < 0.80 = yellow+ | x < 0.90 = red+ | otherwise = yellow++instance M.Colliding BulletMII where++ collisionRadius b = 2.0++instance M.Moving BulletMII where++ velocity b = Projectile.BulletMII.velocity b++instance M.Locatable BulletMII where++ center b = Projectile.BulletMII.center b++instance SimpleTransient BulletMII where++ expired b = rangeLeft b <= 0.0++instance InternallyUpdating BulletMII where++ preUpdate self t = let s' = updateIdealTargetCenter t self in+ s' { clock = clock self + t }++ postUpdate self t =+ let center' = case idealNewCenter self of+ Nothing -> center self+ Just x -> x in+ self { center = center'+ , idealNewCenter = Nothing+ }++updateIdealTargetCenter :: Double -> BulletMII -> BulletMII+updateIdealTargetCenter t self =+ let newLoc = M.idealNewLocation (wrapMap self)+ (center self)+ (velocity self)+ t in+ self { idealNewCenter = Just (newLoc)+ , rangeLeft = max 0.0 $ rangeLeft self - distance (wrapMap self)+ (center self)+ (newLoc)+ }++instance Damaging BulletMII where++ damageEnergy b = 2.0++instance Transient BulletMII where++ expired' self = if impacted self || rangeLeft self <= 0.0+ then Just []+ else Nothing++instance Damageable BulletMII where++ inflictDamage self d = if d > 0 then self { impacted = True }+ else self
+ Projectile/BulletMkI.hs view
@@ -0,0 +1,111 @@+module Projectile.BulletMkI ( BulletMkI(..)+ , new+ ) where++import Combat+import Animation+import Updating+import Graphics.Gloss.Data.Picture+import Graphics.Gloss.Data.Color+import Data.WrapAround+import qualified Moving as M++velocityC = 700.0+rangeC = 1000.0++data BulletMkI =+ BulletMkI { velocity :: (Double, Double)+ , center :: WrapPoint+ , rangeLeft :: Double+ , wrapMap :: WrapMap+ , idealNewCenter :: Maybe WrapPoint+ , impacted :: Bool+ , clock :: Double+ }++-- angle is radians+new :: WrapMap -> Double -> WrapPoint -> (Double, Double) -> BulletMkI+new wmap angle center' (vpx, vpy) =+ let x = cos angle * velocityC in+ let y = sin angle * velocityC in+ BulletMkI { velocity = (x + vpx, y + vpy)+ , center = center'+ , rangeLeft = rangeC+ , wrapMap = wmap+ , idealNewCenter = Nothing+ , impacted = False+ , clock = 0.0+ }++instance Animation BulletMkI where++ image self t = let r = fromInteger (ceiling (clock self)) - clock self in+ Color (c r)+ (Rotate 45.0+ (Circle 2.0))+ where c x | x < 0.10 = blue+ | x < 0.20 = cyan+ | x < 0.30 = blue+ | x < 0.40 = cyan+ | x < 0.50 = blue+ | x < 0.60 = cyan+ | x < 0.70 = blue+ | x < 0.80 = cyan+ | x < 0.90 = blue+ | otherwise = cyan++instance M.Colliding BulletMkI where++ collisionRadius b = 1.0++instance M.Moving BulletMkI where++ velocity b = Projectile.BulletMkI.velocity b++instance M.Locatable BulletMkI where++ center b = Projectile.BulletMkI.center b++instance SimpleTransient BulletMkI where++ expired b = rangeLeft b <= 0.0++instance InternallyUpdating BulletMkI where++ preUpdate self t = let s' = updateIdealTargetCenter t self in+ s' { clock = clock self + t }++ postUpdate self t =+ let center' = case idealNewCenter self of+ Nothing -> center self+ Just x -> x in+ self { center = center'+ , idealNewCenter = Nothing+ }++updateIdealTargetCenter :: Double -> BulletMkI -> BulletMkI+updateIdealTargetCenter t self =+ let newLoc = M.idealNewLocation (wrapMap self)+ (center self)+ (velocity self)+ t in+ self { idealNewCenter = Just (newLoc)+ , rangeLeft = max 0.0 $ rangeLeft self - distance (wrapMap self)+ (center self)+ (newLoc)+ }++instance Damaging BulletMkI where++ damageEnergy b = 1.0++instance Transient BulletMkI where++ expired' self = if impacted self || rangeLeft self <= 0.0+ then Just []+ else Nothing++instance Damageable BulletMkI where++ inflictDamage self d = if d > 0 then self { impacted = True }+ else self
+ Projectile/BulletSI.hs view
@@ -0,0 +1,111 @@+module Projectile.BulletSI ( BulletSI(..)+ , new+ ) where++import Combat+import Animation+import Updating+import Graphics.Gloss.Data.Picture+import Graphics.Gloss.Data.Color+import Data.WrapAround+import qualified Moving as M++velocityC = 400.0+rangeC = 500.0++data BulletSI =+ BulletSI { velocity :: (Double, Double)+ , center :: WrapPoint+ , rangeLeft :: Double+ , wrapMap :: WrapMap+ , idealNewCenter :: Maybe WrapPoint+ , impacted :: Bool+ , clock :: Double+ }++-- angle is radians+new :: WrapMap -> Double -> WrapPoint -> (Double, Double) -> BulletSI+new wmap angle center' (vpx, vpy) =+ let x = cos angle * velocityC in+ let y = sin angle * velocityC in+ BulletSI { velocity = (x + vpx, y + vpy)+ , center = center'+ , rangeLeft = rangeC+ , wrapMap = wmap+ , idealNewCenter = Nothing+ , impacted = False+ , clock = 0.0+ }++instance Animation BulletSI where++ image self t = let r = fromInteger (ceiling (clock self)) - clock self in+ Color (c r)+ (Rotate 45.0+ (Circle 2.0))+ where c x | x < 0.10 = red+ | x < 0.20 = yellow+ | x < 0.30 = red+ | x < 0.40 = yellow+ | x < 0.50 = red+ | x < 0.60 = yellow+ | x < 0.70 = red+ | x < 0.80 = yellow+ | x < 0.90 = red+ | otherwise = yellow++instance M.Colliding BulletSI where++ collisionRadius b = 1.0++instance M.Moving BulletSI where++ velocity b = Projectile.BulletSI.velocity b++instance M.Locatable BulletSI where++ center b = Projectile.BulletSI.center b++instance SimpleTransient BulletSI where++ expired b = rangeLeft b <= 0.0++instance InternallyUpdating BulletSI where++ preUpdate self t = let s' = updateIdealTargetCenter t self in+ s' { clock = clock self + t }++ postUpdate self t =+ let center' = case idealNewCenter self of+ Nothing -> center self+ Just x -> x in+ self { center = center'+ , idealNewCenter = Nothing+ }++updateIdealTargetCenter :: Double -> BulletSI -> BulletSI+updateIdealTargetCenter t self =+ let newLoc = M.idealNewLocation (wrapMap self)+ (center self)+ (velocity self)+ t in+ self { idealNewCenter = Just (newLoc)+ , rangeLeft = max 0.0 $ rangeLeft self - distance (wrapMap self)+ (center self)+ (newLoc)+ }++instance Damaging BulletSI where++ damageEnergy b = 1.0++instance Transient BulletSI where++ expired' self = if impacted self || rangeLeft self <= 0.0+ then Just []+ else Nothing++instance Damageable BulletSI where++ inflictDamage self d = if d > 0 then self { impacted = True }+ else self
+ Projectile/BulletSII.hs view
@@ -0,0 +1,114 @@+module Projectile.BulletSII ( BulletSII(..)+ , new+ , speed+ ) where++import Combat+import Animation+import Updating+import Graphics.Gloss.Data.Picture+import Graphics.Gloss.Data.Color+import Data.WrapAround+import qualified Moving as M++velocityC = 600.0+rangeC = 1000.0++speed = velocityC++data BulletSII =+ BulletSII { velocity :: (Double, Double)+ , center :: WrapPoint+ , rangeLeft :: Double+ , wrapMap :: WrapMap+ , idealNewCenter :: Maybe WrapPoint+ , impacted :: Bool+ , clock :: Double+ }++-- angle is radians+new :: WrapMap -> Double -> WrapPoint -> (Double, Double) -> BulletSII+new wmap angle center' (vpx, vpy) =+ let x = cos angle * velocityC in+ let y = sin angle * velocityC in+ BulletSII { velocity = (x + vpx, y + vpy)+ , center = center'+ , rangeLeft = rangeC+ , wrapMap = wmap+ , idealNewCenter = Nothing+ , impacted = False+ , clock = 0.0+ }++instance Animation BulletSII where++ image self t = let r = fromInteger (ceiling (clock self)) - clock self in+ Color (c r)+ (Rotate 45.0+ (Circle 2.0))+ where c x | x < 0.10 = green+ | x < 0.20 = yellow+ | x < 0.30 = green+ | x < 0.40 = yellow+ | x < 0.50 = green+ | x < 0.60 = yellow+ | x < 0.70 = green+ | x < 0.80 = yellow+ | x < 0.90 = green+ | otherwise = yellow++instance M.Colliding BulletSII where++ collisionRadius b = 1.0++instance M.Moving BulletSII where++ velocity b = Projectile.BulletSII.velocity b++instance M.Locatable BulletSII where++ center b = Projectile.BulletSII.center b++instance SimpleTransient BulletSII where++ expired b = rangeLeft b <= 0.0++instance InternallyUpdating BulletSII where++ preUpdate self t = let s' = updateIdealTargetCenter t self in+ s' { clock = clock self + t }++ postUpdate self t =+ let center' = case idealNewCenter self of+ Nothing -> center self+ Just x -> x in+ self { center = center'+ , idealNewCenter = Nothing+ }++updateIdealTargetCenter :: Double -> BulletSII -> BulletSII+updateIdealTargetCenter t self =+ let newLoc = M.idealNewLocation (wrapMap self)+ (center self)+ (velocity self)+ t in+ self { idealNewCenter = Just (newLoc)+ , rangeLeft = max 0.0 $ rangeLeft self - distance (wrapMap self)+ (center self)+ (newLoc)+ }++instance Damaging BulletSII where++ damageEnergy b = 1.0++instance Transient BulletSII where++ expired' self = if impacted self || rangeLeft self <= 0.0+ then Just []+ else Nothing++instance Damageable BulletSII where++ inflictDamage self d = if d > 0 then self { impacted = True }+ else self
+ Projectile/Cannon.hs view
@@ -0,0 +1,117 @@+module Projectile.Cannon ( Cannon(..)+ , new+ ) where++import Combat+import Animation+import Updating+import Graphics.Gloss.Data.Picture+import Graphics.Gloss.Data.Color+import Data.WrapAround+import qualified Moving as M+import GHC.Float++velocityC = 500.0+rangeC = 800.0++integrityMax = 60.0++punch = 4.0++radiusC = 12.0++data Cannon =+ Cannon { velocity :: (Double, Double)+ , center :: WrapPoint+ , rangeLeft :: Double+ , wrapMap :: WrapMap+ , idealNewCenter :: Maybe WrapPoint+ , integrity :: Double+ , clock :: Double+ }++-- angle is radians+new :: WrapMap -> Double -> WrapPoint -> (Double, Double) -> Cannon+new wmap angle center' (vpx, vpy) =+ let x = cos angle * velocityC in+ let y = sin angle * velocityC in+ Cannon { velocity = (x + vpx, y + vpy)+ , center = center'+ , rangeLeft = rangeC+ , wrapMap = wmap+ , idealNewCenter = Nothing+ , clock = 0.0+ , integrity = integrityMax+ }++instance Animation Cannon where++ image self t = let r = fromInteger (ceiling (clock self)) - clock self in+ Color (c r)+ (Rotate 45.0+ (Circle (double2Float radiusC)))+ where c x | x < 0.10 = blue+ | x < 0.20 = cyan+ | x < 0.30 = blue+ | x < 0.40 = cyan+ | x < 0.50 = blue+ | x < 0.60 = cyan+ | x < 0.70 = blue+ | x < 0.80 = cyan+ | x < 0.90 = blue+ | otherwise = cyan++instance M.Colliding Cannon where++ collisionRadius self = radiusC++instance M.Moving Cannon where++ velocity self = Projectile.Cannon.velocity self++instance M.Locatable Cannon where++ center self = Projectile.Cannon.center self++instance SimpleTransient Cannon where++ expired self = rangeLeft self <= 0.0 || integrity self <= 0.0++instance InternallyUpdating Cannon where++ preUpdate self t = let s' = updateIdealTargetCenter t self in+ s' { clock = clock self + t }++ postUpdate self t =+ let center' = case idealNewCenter self of+ Nothing -> center self+ Just x -> x in+ self { center = center'+ , idealNewCenter = Nothing+ }++updateIdealTargetCenter :: Double -> Cannon -> Cannon+updateIdealTargetCenter t self =+ let newLoc = M.idealNewLocation (wrapMap self)+ (center self)+ (velocity self)+ t in+ self { idealNewCenter = Just (newLoc)+ , rangeLeft = max 0.0 $ rangeLeft self - distance (wrapMap self)+ (center self)+ (newLoc)+ }++instance Damaging Cannon where++ damageEnergy self = punch++instance Transient Cannon where++ expired' self = if rangeLeft self <= 0.0 || integrity self <= 0.0+ then Just []+ else Nothing++instance Damageable Cannon where++ inflictDamage self d = self { integrity = integrity self - d }
+ Projectile/Mine.hs view
@@ -0,0 +1,116 @@+module Projectile.Mine ( Mine(..)+ , new+ ) where++import Combat+import Animation+import Updating+import Graphics.Gloss.Data.Picture+import Graphics.Gloss.Data.Color+import Data.WrapAround+import qualified Moving as M+import ResourceTracker+import Data.Maybe+import qualified AfterEffect.MineExplosion as MineExplosion+import AfterEffect++detRadius = 100.0+punch = 1.0++data Mine =+ Mine { center :: WrapPoint+ , impacted :: Bool+ , clock :: Double+ , resourceTracker :: ResourceTracker+ , wrapMap :: WrapMap+ }++-- angle is radians+new :: ResourceTracker -> WrapMap -> WrapPoint -> Mine+new rt wmap center' =+ Mine { center = center'+ , impacted = False+ , clock = 0.0+ , resourceTracker = rt+ , wrapMap = wmap+ }++instance Animation Mine where++ image self _ =+ -- assumes t >= 0+ let t = clock self in+ let adjt = let a = t * 0.1 in+ let b = fromIntegral (truncate a) in+ let c = a - b in+ c * 10.0 in+ c adjt+ where c x | x <= 0.1 = plit+ | x > 5 && x <= 5.1 = plit+ | otherwise = p+ p = fromMaybe+ (Scale 0.20 0.20+ (Color white+ (Text "Error! Missing image!")))+ (getImage rt "mine.bmp")+ plit = fromMaybe+ (Scale 0.20 0.20+ (Color white+ (Text "Error! Missing image!")))+ (getImage rt "mine-lit.bmp")+ rt = resourceTracker self++ -- image self t = let r = fromInteger (ceiling (clock self)) - clock self in+ -- Color (c r)+ -- (Rotate 45.0+ -- (Circle 2.0))+ -- where c x | x < 0.10 = red+ -- | x < 0.20 = yellow+ -- | x < 0.30 = red+ -- | x < 0.40 = yellow+ -- | x < 0.50 = red+ -- | x < 0.60 = yellow+ -- | x < 0.70 = red+ -- | x < 0.80 = yellow+ -- | x < 0.90 = red+ -- | otherwise = yellow++instance M.Colliding Mine where++ collisionRadius _ = detRadius++instance M.Moving Mine where++ velocity _ = (0.0, 0.0)++instance M.Locatable Mine where++ center self = Projectile.Mine.center self++instance SimpleTransient Mine where++ expired self = impacted self++instance InternallyUpdating Mine where++ preUpdate self t = self { clock = clock self + t }++ postUpdate self _ = self++instance Damaging Mine where++ damageEnergy _ = punch++instance Transient Mine where++ expired' self = if impacted self+ then Just [mE]+ else Nothing+ where mE = AfterEffect $ MineExplosion.new rt wmap center'+ rt = resourceTracker self+ wmap = wrapMap self+ center' = center self++instance Damageable Mine where++ inflictDamage self d = self { impacted = d > 0 }
+ Projectile/Nuke.hs view
@@ -0,0 +1,132 @@+module Projectile.Nuke ( Nuke(..)+ , new+ ) where++import Combat+import Animation+import Updating+import Graphics.Gloss.Data.Picture+import Graphics.Gloss.Data.Color+import Data.WrapAround+import qualified Moving as M+import ResourceTracker+import Data.Maybe++velocityC = 200.0++punch = 8.0+residualPunch = 0.1++detTime = 1.5++data Nuke =+ Nuke { velocity :: (Double, Double)+ , center :: WrapPoint+ , wrapMap :: WrapMap+ , idealNewCenter :: Maybe WrapPoint+ , clock :: Double+ , initialBlastCompleted :: Bool+ , resourceTracker :: ResourceTracker+ }++-- angle is radians+new :: WrapMap -> ResourceTracker -> Double -> WrapPoint -> (Double, Double) -> Nuke+new wmap rt angle center' (vpx, vpy) =+ let x = cos angle * velocityC in+ let y = sin angle * velocityC in+ Nuke { velocity = (x + vpx, y + vpy)+ , center = center'+ , wrapMap = wmap+ , idealNewCenter = Nothing+ , clock = 0.0+ , initialBlastCompleted = False+ , resourceTracker = rt+ }++instance Animation Nuke where+ image self t =+ let c = clock self in+ if c < detTime+ then Color green (Circle 2.0)+ else if c < detTime + 0.05+ then p0+ else if c < detTime + 0.1+ then p1+ else if c < detTime + 0.15+ then p2+ else if c < detTime + 0.2+ then p3+ else Blank+ where p0 = failImg (getImage rt "nuke-0.bmp")+ p1 = failImg (getImage rt "nuke-1.bmp")+ p2 = failImg (getImage rt "nuke-2.bmp")+ p3 = failImg (getImage rt "nuke-3.bmp")+ rt = resourceTracker self+ failImg = \x -> Scale 2.0 2.0 (fromMaybe (Color white (Circle 125.0)) x)+++instance M.Colliding Nuke where++ collisionRadius self =+ if clock self < detTime+ then 2.0+ else 200++instance M.Moving Nuke where++ velocity b = Projectile.Nuke.velocity b++instance M.Locatable Nuke where++ center b = Projectile.Nuke.center b++instance SimpleTransient Nuke where++ expired self = clock self >= detTime + 0.5++instance InternallyUpdating Nuke where++ preUpdate self t = let s' = updateIdealTargetCenter t self in+ s' { clock = clock self + t+ , velocity = if clock self >= detTime+ then (0.0, 0.0)+ else velocity self+ }++ postUpdate self t =+ let center' = case idealNewCenter self of+ Nothing -> center self+ Just x -> x in+ self { center = center'+ , idealNewCenter = Nothing+ , initialBlastCompleted = clock self >= detTime+ }++updateIdealTargetCenter :: Double -> Nuke -> Nuke+updateIdealTargetCenter t self =+ let newLoc = M.idealNewLocation (wrapMap self)+ (center self)+ (velocity self)+ t in+ self { idealNewCenter = Just (newLoc)+ }++instance Damaging Nuke where++ damageEnergy self =+ let c = clock self in+ if c < detTime+ then 0.0+ else if initialBlastCompleted self+ then residualPunch+ else punch++instance Transient Nuke where++ expired' self = if clock self >= detTime + 0.5+ then Just []+ else Nothing++instance Damageable Nuke where++ inflictDamage self _ = self
+ Projectile/Pellet.hs view
@@ -0,0 +1,99 @@+module Projectile.Pellet ( Pellet(..)+ , new+ , range+ ) where++import Combat+import Animation+import Updating+import Graphics.Gloss.Data.Picture+import Graphics.Gloss.Data.Color+import Data.WrapAround+import qualified Moving as M++velocityC = 600.0+rangeC = 300.0+punch = 0.3++range = rangeC++data Pellet =+ Pellet { velocity :: (Double, Double)+ , center :: WrapPoint+ , rangeLeft :: Double+ , wrapMap :: WrapMap+ , idealNewCenter :: Maybe WrapPoint+ , impacted :: Bool+ }++-- angle is radians+new :: WrapMap -> Double -> WrapPoint -> (Double, Double) -> Pellet+new wmap angle center' (vpx, vpy) =+ let x = cos angle * velocityC in+ let y = sin angle * velocityC in+ Pellet { velocity = (x + vpx, y + vpy)+ , center = center'+ , rangeLeft = rangeC+ , wrapMap = wmap+ , idealNewCenter = Nothing+ , impacted = False+ }++instance Animation Pellet where++ image self t = Color (makeColor8 172 172 172 255) (Circle 1.0)++instance M.Colliding Pellet where++ collisionRadius b = 1.0++instance M.Moving Pellet where++ velocity b = Projectile.Pellet.velocity b++instance M.Locatable Pellet where++ center b = Projectile.Pellet.center b++instance SimpleTransient Pellet where++ expired b = rangeLeft b <= 0.0++instance InternallyUpdating Pellet where++ preUpdate self t = updateIdealTargetCenter t self++ postUpdate self t =+ let center' = case idealNewCenter self of+ Nothing -> center self+ Just x -> x in+ self { center = center'+ , idealNewCenter = Nothing+ }++updateIdealTargetCenter :: Double -> Pellet -> Pellet+updateIdealTargetCenter t self =+ let newLoc = M.idealNewLocation (wrapMap self)+ (center self)+ (velocity self)+ t in+ self { idealNewCenter = Just (newLoc)+ , rangeLeft = max 0.0 $ rangeLeft self - distance (wrapMap self)+ (center self)+ (newLoc)+ }++instance Damaging Pellet where++ damageEnergy b = punch++instance Transient Pellet where++ expired' self = if impacted self || rangeLeft self <= 0.0+ then Just []+ else Nothing++instance Damageable Pellet where++ inflictDamage self d = if d > 0 then self { impacted = True }+ else self
+ ResourceTracker.hs view
@@ -0,0 +1,39 @@+module ResourceTracker ( ResourceTracker()+ , emptyResourceTracker+ , getImage+ , storeImage+ , getSound+ , storeSound+ ) where++import Graphics.Gloss.Data.Picture (Picture)+import qualified Graphics.Gloss.Data.Picture as GP+import Data.Map (Map)+import qualified Data.Map as M+-- import Control.Monad.State+import Sound.ALUT++data ResourceTracker = ResourceTracker { images :: Map String Picture+ , sounds :: Map String Buffer+-- , defaultSound :: Buffer+ }+ deriving (Show)++emptyResourceTracker = ResourceTracker { images = M.empty+ , sounds = M.empty+ }++getImage :: ResourceTracker -> String -> Maybe Picture+getImage rt filename = M.lookup filename (images rt)++storeImage :: ResourceTracker -> String -> Picture -> ResourceTracker+storeImage rt filename pic = let nimages = M.insert filename pic (images rt) in+ rt { images = nimages }++getSound :: ResourceTracker -> String -> Maybe Buffer+getSound rt filename = M.lookup filename (sounds rt)++storeSound :: ResourceTracker -> String -> Buffer -> ResourceTracker+storeSound rt filename buffer = let buffers' = M.insert filename buffer (sounds rt) in+ rt { sounds = buffers' }+
+ Resources.hs view
@@ -0,0 +1,469 @@+module Resources where++import Paths_edge+import Graphics.Gloss.Data.Picture+import Graphics.Gloss.Data.Color+import ResourceTracker+import SpaceJunk+import qualified Asteroid as Asteroid+import qualified BigAsteroid as BigAsteroid+import Data.WrapAround+import Star+import Sound.ALUT+import Universe+import Unit+import qualified Unit.Simple.Turret as Turret+import qualified Unit.Smart.Tank as Tank+import qualified Unit.Smart.ATank as ATank+import qualified Unit.Smart.Death as Death+import qualified Unit.Smart.Ninja as Ninja+import qualified Unit.Smart.Saucer as Saucer+import qualified Unit.Smart.Sniper as Sniper+import Combat+import qualified Projectile.Mine as Mine+import Item+import System.Random++initResources = let imageFiles = [ "asteroid.bmp"+ , "asteroidbig.bmp"+ , "atank.bmp"+ , "blade.bmp"+ , "death.bmp"+ , "item-default.bmp"+ , "item-health.bmp"+ , "item-fourway.bmp"+ , "item-cannon.bmp"+ , "item-spread.bmp"+ , "item-rapidfire.bmp"+ , "item-nuke.bmp"+ , "lance.bmp"+ , "lance-thrusting.bmp"+ , "mine.bmp"+ , "mine-explosion.bmp"+ , "mine-lit.bmp"+ , "ninja.bmp"+ , "nuke-0.bmp"+ , "nuke-1.bmp"+ , "nuke-2.bmp"+ , "nuke-3.bmp"+ , "turret.bmp"+ , "tank.bmp"+ , "explosion-00.bmp"+ , "explosion-01.bmp"+ , "explosion-02.bmp"+ , "explosion-03.bmp"+ , "explosion-04.bmp"+ , "explosion-05.bmp"+ , "explosion-06.bmp"+ , "saucer.bmp"+ , "sniper.bmp"+ ] in+ let imageFiles' = map ("image/" ++) imageFiles in+ let soundFiles = [ "test.wav"+ , "energy-shot-02.wav"+ , "explosion.wav"+ , "simple-energy-shot.wav"+ ] in+ let soundFiles' = map ("sound/" ++) soundFiles in+ do imagePaths <- mapM getDataFileName imageFiles'+ pics <- mapM loadBMP imagePaths+ soundPaths <- mapM getDataFileName soundFiles'+ sounds <- mapM (createBuffer . File) soundPaths+ let rt = foldr go emptyResourceTracker+ (zip imageFiles pics)+ return $ foldr go' rt (zip soundFiles sounds)+ where go (file, pic) rt = storeImage rt file pic+ go' (file, sound) rt = storeSound rt file sound++-- loadBuffer path = do buf <- createBuffer (File path)+-- [source] <- genObjectNames 1+-- buffer source $= Just buf+-- return source++startingAsteroids rt wmap =+ let positionsVelocities = [ ((1900, 500), (200, -120))+ , (( 100, 2900), ( 90, 10))+ , ((2500, 1100), (-100, 100))+ , (( 700, 300), (80, 60))+ , ((1300, 1400), (-30, 240))+ , ((1000, 2400), (110, 100))+ ] in+ map (\(p, v) -> Asteroid.new rt wmap (wrappoint wmap p) v) positionsVelocities++defaultStars =+ [ Star { Star.location = wrappoint wmap (40.0, 93.0), Star.color = rose }+ , Star { Star.location = wrappoint wmap (54.0, 74.0), Star.color = white }+ , Star { Star.location = wrappoint wmap (86.0, 38.0), Star.color = white }+ , Star { Star.location = wrappoint wmap (30.0, 52.0), Star.color = white }+ , Star { Star.location = wrappoint wmap ( 2.0, 24.0), Star.color = orange }+ , Star { Star.location = wrappoint wmap (85.0, 76.0), Star.color = white }+ , Star { Star.location = wrappoint wmap (27.0, 32.0), Star.color = white }+ , Star { Star.location = wrappoint wmap (53.0, 94.0), Star.color = white }+ , Star { Star.location = wrappoint wmap (66.0, 37.0), Star.color = green }+ , Star { Star.location = wrappoint wmap (39.0, 73.0), Star.color = white }+ , Star { Star.location = wrappoint wmap (88.0, 67.0), Star.color = chartreuse }+ , Star { Star.location = wrappoint wmap (50.0, 50.0), Star.color = white }+ , Star { Star.location = wrappoint wmap (93.0, 33.0), Star.color = white }+ , Star { Star.location = wrappoint wmap (25.0, 57.0), Star.color = white }+ , Star { Star.location = wrappoint wmap (36.0, 6.0), Star.color = white }+ , Star { Star.location = wrappoint wmap (65.0, 61.0), Star.color = white }+ , Star { Star.location = wrappoint wmap (43.0, 24.0), Star.color = blue }+ , Star { Star.location = wrappoint wmap (54.0, 52.0), Star.color = white }+ , Star { Star.location = wrappoint wmap (66.0, 45.0), Star.color = white }+ , Star { Star.location = wrappoint wmap (41.0, 67.0), Star.color = white }+ , Star { Star.location = wrappoint wmap (37.0, 25.0), Star.color = white }+ , Star { Star.location = wrappoint wmap (62.0, 48.0), Star.color = green }+ , Star { Star.location = wrappoint wmap (88.0, 73.0), Star.color = white }+ , Star { Star.location = wrappoint wmap ( 4.0, 54.0), Star.color = white }+ , Star { Star.location = wrappoint wmap (59.0, 77.0), Star.color = white }+ , Star { Star.location = wrappoint wmap (73.0, 83.0), Star.color = yellow }+ , Star { Star.location = wrappoint wmap (34.0, 24.0), Star.color = white }+ , Star { Star.location = wrappoint wmap (58.0, 48.0), Star.color = white }+ , Star { Star.location = wrappoint wmap (03.0, 99.0), Star.color = white }+ , Star { Star.location = wrappoint wmap (57.0, 46.0), Star.color = aquamarine }+ , Star { Star.location = wrappoint wmap (66.0, 67.0), Star.color = white }+ , Star { Star.location = wrappoint wmap (31.0, 2.0), Star.color = white }+ , Star { Star.location = wrappoint wmap (85.0, 53.0), Star.color = white }+ , Star { Star.location = wrappoint wmap (23.0, 77.0), Star.color = white }+ , Star { Star.location = wrappoint wmap (97.0, 16.0), Star.color = white }+ , Star { Star.location = wrappoint wmap (16.0, 83.0), Star.color = white }+ , Star { Star.location = wrappoint wmap (42.0, 45.0), Star.color = magenta }+ , Star { Star.location = wrappoint wmap ( 9.0, 67.0), Star.color = white }+ , Star { Star.location = wrappoint wmap (33.0, 33.0), Star.color = azure }+ , Star { Star.location = wrappoint wmap (27.0, 75.0), Star.color = violet }+ , Star { Star.location = wrappoint wmap (36.0, 64.0), Star.color = white }+ , Star { Star.location = wrappoint wmap (74.0, 2.0), Star.color = white }+ , Star { Star.location = wrappoint wmap (48.0, 46.0), Star.color = cyan }+ , Star { Star.location = wrappoint wmap (20.0, 98.0), Star.color = rose }+ , Star { Star.location = wrappoint wmap (52.0, 44.0), Star.color = white }+ , Star { Star.location = wrappoint wmap (16.0, 38.0), Star.color = white }+ , Star { Star.location = wrappoint wmap (32.0, 72.0), Star.color = white }+ , Star { Star.location = wrappoint wmap (21.0, 23.0), Star.color = orange }+ , Star { Star.location = wrappoint wmap (75.0, 86.0), Star.color = white }+ , Star { Star.location = wrappoint wmap (67.0, 34.0), Star.color = white }+ , Star { Star.location = wrappoint wmap (55.0, 64.0), Star.color = white }+ , Star { Star.location = wrappoint wmap (46.0, 38.0), Star.color = green }+ , Star { Star.location = wrappoint wmap (37.0, 73.0), Star.color = white }+ , Star { Star.location = wrappoint wmap (38.0, 69.0), Star.color = chartreuse }+ , Star { Star.location = wrappoint wmap (52.0, 90.0), Star.color = white }+ , Star { Star.location = wrappoint wmap (43.0, 31.0), Star.color = white }+ , Star { Star.location = wrappoint wmap (26.0, 27.0), Star.color = white }+ , Star { Star.location = wrappoint wmap (86.0, 8.0), Star.color = white }+ , Star { Star.location = wrappoint wmap (69.0, 91.0), Star.color = white }+ , Star { Star.location = wrappoint wmap (13.0, 22.0), Star.color = blue }+ , Star { Star.location = wrappoint wmap (58.0, 72.0), Star.color = white }+ , Star { Star.location = wrappoint wmap (96.0, 48.0), Star.color = white }+ , Star { Star.location = wrappoint wmap (42.0, 97.0), Star.color = white }+ , Star { Star.location = wrappoint wmap (77.0, 28.0), Star.color = white }+ , Star { Star.location = wrappoint wmap (63.0, 78.0), Star.color = green }+ , Star { Star.location = wrappoint wmap (68.0, 71.0), Star.color = white }+ , Star { Star.location = wrappoint wmap ( 2.0, 84.0), Star.color = white }+ , Star { Star.location = wrappoint wmap (49.0, 73.0), Star.color = white }+ , Star { Star.location = wrappoint wmap (72.0, 83.0), Star.color = yellow }+ , Star { Star.location = wrappoint wmap (94.0, 29.0), Star.color = white }+ , Star { Star.location = wrappoint wmap (52.0, 98.0), Star.color = white }+ , Star { Star.location = wrappoint wmap (73.0, 92.0), Star.color = white }+ , Star { Star.location = wrappoint wmap (52.0, 36.0), Star.color = aquamarine }+ , Star { Star.location = wrappoint wmap (46.0, 64.0), Star.color = white }+ , Star { Star.location = wrappoint wmap (32.0, 82.0), Star.color = white }+ , Star { Star.location = wrappoint wmap (35.0, 53.0), Star.color = white }+ , Star { Star.location = wrappoint wmap (24.0, 87.0), Star.color = white }+ , Star { Star.location = wrappoint wmap (87.0, 17.0), Star.color = white }+ , Star { Star.location = wrappoint wmap (16.0, 93.0), Star.color = white }+ , Star { Star.location = wrappoint wmap (72.0, 42.0), Star.color = magenta }+ , Star { Star.location = wrappoint wmap ( 4.0, 97.0), Star.color = white }+ , Star { Star.location = wrappoint wmap (93.0, 33.0), Star.color = azure }+ , Star { Star.location = wrappoint wmap (22.0, 5.0), Star.color = violet }+ , Star { Star.location = wrappoint wmap (46.0, 68.0), Star.color = white }+ , Star { Star.location = wrappoint wmap (76.0, 92.0), Star.color = white }+ , Star { Star.location = wrappoint wmap (78.0, 41.0), Star.color = cyan }+ ]+ where wmap = wrapmap 100.0 100.0++initLevels rt =+ do let b = blankArena 3000.0 3000.0+ let a = b { stars = defaultStars+ }+ let wmap = Universe.wrapMap a+ let pL = [+ -- 0+ a { asteroids = asteroidGen rt wmap+ [ ((1900, 500), (200, -120))+ , (( 100, 2900), ( 90, 10))+ -- , ((2500, 1100), ((-100), 100))+ -- , (( 700, 300), (80, 60))+ -- , ((1300, 1400), ((-30), 240))+ -- , ((1000, 2400), (110, 100))+ ]+ , simpleUnits = turretGen rt wmap+ [ ((-700.0, 300.0), 0.0, 7 * pi / 4)+ , ((500.0, 800.0), pi / 3, 7 * pi / 4)+ ]+ }+ ,+ -- 1+ a { asteroids = asteroidGen rt wmap+ [ ((1900, 500), (200, -120))+ , (( 100, 2900), ( 90, 10))+ , ((2500, 1100), (-100, 100))+ ]+ , simpleUnits = turretGen rt wmap+ [ ((1000.0, 200.0), 0.0, pi / 3)+ ]+ + , smartUnits = tankGen rt wmap+ [ ((-1000.0, 800.0), 0.0)+ , ((-1200.0, 500.0), pi)+ ]+ }+ ,+ -- 2+ a { asteroids = asteroidGen rt wmap+ [ ((900, 340), (230, -120))+ , ((1200, 1400), (110, 30))+ , ((200, 500), (-180, 110))+ ]+ , simpleUnits = turretGen rt wmap+ [ ((-500.0, 200.0), 0.0, 3 * pi / 2 )+ ]+ + , smartUnits = tankGen rt wmap+ [ ((-1000.0, 800.0), 0.0)+ , ((900.0, 600.0), pi)+ , ((700.0, -500.0), pi / 2)+ ] +++ aTankGen rt wmap+ [ ((-1100.0, -900.0), pi + pi / 3)+ ]+ }+ ,+ -- 3+ a { asteroids = asteroidGen rt wmap+ [ ((800, -340), (130, 120))+ , ((700, 200), (10, -130))+ , ((-300, 900), (70, 110))+ ]+ , smartUnits = tankGen rt wmap+ [ ((-700.0, 600.0), 0.0)+ , ((500.0, -1100.0), pi / 2)+ ] +++ aTankGen rt wmap+ [ ((-1000.0, 900.0), pi + pi / 3)+ ] +++ saucerGen rt wmap+ [ ((400.0, 1400.0), 0.0) ]+ + }+ ,+ -- 4+ a { asteroids = asteroidGen rt wmap+ [ ((800, -340), (130, 120))+ , ((700, 200), (10, -130))+ , ((-300, 900), (70, 110))+ ]+ , smartUnits = tankGen rt wmap+ [ ((-400.0, 900.0), 0.0)+ ] +++ aTankGen rt wmap+ [ ((1400.0, -800.0), pi)+ ] +++ saucerGen rt wmap+ [ ((400.0, 1400.0), 0.0)+ , ((-1200.0, -1000.0), pi)+ , ((100.0, -500.0), pi)+ , ((-600.0, 800.0), 0.0)+ ]+ + }+ ,+ -- 5+ a { asteroids = asteroidGen rt wmap+ [ ((800, -340), (-130, 120))+ , ((700, 200), (-130, 120))+ , ((-300, 900), (-130, 120))+ , ((1340, -1230), (-130, 120))+ , ((-420, 990), (-130, 120))+ , ((370, -130), (-130, 120))+ , ((-1220, 1090), (-130, 120))+ , ((400, 1300), (-130, 120))+ , ((-700, -500), (-130, 120))+ , ((-1320, 1290), (-130, 120))+ , ((100, 400), (-130, 120))+ , ((-800, -400), (-130, 120))+ , ((1440, -1330), (-130, 120))+ , ((-520, 120), (-130, 120))+ , ((1100, 40), (-130, 120))+ , ((500, 100), (-130, 120))+ , ((-1100, -20), (-130, 120))+ , ((-520, -70), (-130, 120))+ , ((40, 1100), (-130, 120))+ , ((100, 500), (-130, 120))+ , ((-20,-1100), (-130, 120))+ , ((-70, -520), (-130, 120))+ , ((-600, 1500), (-130, 120))+ , ((-1000, 500), (-130, 120))+ , ((-400, -600), (-130, 120))+ , ((1200, -600), (-130, 120))+ , ((500, -1400), (-130, 120))+ ] +++ bigAsteroidGen rt wmap+ [ ((500, -840), (-130, 120))+ , ((900, 300), (-130, 120))+ , ((-200, 1100), (-130, 120))+ , ((600, -200), (-130, 120))+ , ((-600, 700), (-130, 120))+ , ((-900, -1100), (-130, 120))+ , ((-100, -900), (-130, 120))+ , ((-200, -200), (-130, 120))+ , ((600, 600), (-130, 120))+ , ((900, -900), (-130, 120))+ , ((-1400, -1400), (-130, 120))+ , ((1100, 1300), (-130, 120))+ , ((-1000, -800), (-130, 120))+ , ((400, -600), (-130, 120))+ , ((-500, -1300), (-130, 120))+ ] + , simpleUnits = turretGen rt wmap+ [ ((700.0, 650.0), 0.0, pi )+ , ((-550.0, -300.0), 0.0, 0.0 )+ ]+ , smartUnits = tankGen rt wmap+ [ ((-450.0, 821.0), 0.0)+ ] +++ aTankGen rt wmap+ [ ((40.0, -1400.0), pi)+ ] +++ saucerGen rt wmap+ [ ((540.0, 1320.0), 0.0)+ , ((-1000.0, -1200.0), pi)+ , ((40.0, 1200.0), pi)+ , ((-200.0, -1000.0), 0)+ ]+ }+ ,+ -- 6+ a { asteroids = asteroidGen rt wmap+ [ ((800, -340), (-30, 20))+ , ((-1320, 1290), (200, 100))+ , ((-400, -600), (-80, -40))+ , ((500, -1400), (30, 80))+ ] +++ bigAsteroidGen rt wmap+ [ ((-100, -900), (40, 120))+ , ((-1000, -800), (50, -60))+ ] + , simpleUnits = turretGen rt wmap+ [ ((900.0, -650.0), 0.0, pi )+ ]+ , smartUnits = tankGen rt wmap+ [ ((-450.0, 821.0), 0.0)+ , ((40.0, -1400.0), pi)+ ] +++ sniperGen rt wmap+ [ ((-1200.0, 0.0), 0.0)+ , ((1200.0, 0.0), 0.0)+ ]+ , unitProjectiles = mineGen rt wmap+ [ (300.0, 400.0)+ , (-700.0, 200.0)+ , (1300.0, -500.0)+ ]+ }+ ,+ -- 7+ a { asteroids = asteroidGen rt wmap+ [ ((840, -440), (-30, 20))+ , ((-1320, 1290), (120, -100))+ , ((600, 1400), (30, 80))+ ] +++ bigAsteroidGen rt wmap+ [ ((-100, -900), (40, 30))+ , ((-900, 800), (80, -60))+ , ((-1000, 400), (-50, -80))+ ] + , smartUnits = ninjaGen rt wmap+ [ ((100.0, 600.0), 0.0)+ , ((-200.0, -700.0), pi)+ , ((700.0, 800.0), 0.0)+ , ((600.0, -900.0), pi)+ , ((-800.0, 1300.0), 0.0)+ , ((-1400.0, -1400.0), pi)+ ]+ + , unitProjectiles = mineGen rt wmap+ [ (200.0, 800.0)+ , (-500.0, -200.0)+ , (-1300.0, 1000.0)+ ]+ }+ ,+ -- 8+ a { asteroids = asteroidGen rt wmap+ [ ((640, -440), (-20, 30))+ , ((-1320, 1190), (110, -90))+ , ((700, 1200), (40, 70))+ ] +++ bigAsteroidGen rt wmap+ [ ((-100, -900), (30, 40))+ , ((-500, 1000), (70, -70))+ ] + , smartUnits = deathGen rt wmap+ [ ((0.0, -1000.0), 0.0)+ ]+ }+ ]+ let addItems a = do it1 <- randomItemType+ it2 <- randomItemType+ x1 <- randomRIO (0, 2999)+ x2 <- randomRIO (0, 2999)+ y1 <- randomRIO (0, 2999)+ y2 <- randomRIO (0, 2999)+ let wp1 = wrappoint wmap (x1, y1)+ let wp2 = wrappoint wmap (x2, y2)+ let i1 = Item it1 rt wp1+ let i2 = Item it2 rt wp2+ return a { items = [i1, i2] }+ mapM addItems pL++asteroidGen rt wmap p =+ let positionsVelocities = p in+ map (\(p, v) -> (SpaceJunk (Asteroid.new+ rt+ wmap+ (wrappoint wmap p)+ v)))+ positionsVelocities++bigAsteroidGen rt wmap p =+ let positionsVelocities = p in+ map (\(p, v) -> (SpaceJunk (BigAsteroid.new+ rt+ wmap+ (wrappoint wmap p)+ v)))+ positionsVelocities++turretGen rt wmap =+ map (\(x, y, z) -> SimpleUnit (Turret.new rt wmap (wrappoint wmap x) y z))++tankGen rt wmap =+ map (\(x, y) -> SmartUnit (Tank.new rt wmap (wrappoint wmap x) y))++aTankGen rt wmap =+ map (\(x, y) -> SmartUnit (ATank.new rt wmap (wrappoint wmap x) y))++mineGen rt wmap =+ map (\x -> Projectile (Mine.new rt wmap (wrappoint wmap x)))++sniperGen rt wmap =+ map (\(x, y) -> SmartUnit (Sniper.new rt wmap (wrappoint wmap x) y))++deathGen rt wmap =+ map (\(x, y) -> SmartUnit (Death.new rt wmap (wrappoint wmap x) y))++saucerGen rt wmap =+ map (\(x, y) -> SmartUnit (Saucer.new rt wmap (wrappoint wmap x) y))++ninjaGen rt wmap =+ map (\(x, y) -> SmartUnit (Ninja.new rt wmap (wrappoint wmap x) y))+
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ SpaceJunk.hs view
@@ -0,0 +1,40 @@+{-# LANGUAGE ExistentialQuantification #-}++module SpaceJunk where++import Animation+import Updating+import qualified Moving as M+import Combat++data SpaceJunk = forall a. ( InternallyUpdating a+ , M.Colliding a+ , Damaging a+ , Damageable a+ , Animation a+ ) => SpaceJunk a++instance Damaging SpaceJunk where+ damageEnergy (SpaceJunk a) = damageEnergy a++instance Damageable SpaceJunk where+ inflictDamage (SpaceJunk a) et = SpaceJunk (inflictDamage a et)++instance InternallyUpdating SpaceJunk where+ preUpdate (SpaceJunk a) et = SpaceJunk (preUpdate a et)+ postUpdate (SpaceJunk a) et = SpaceJunk (postUpdate a et)++instance M.Colliding SpaceJunk where++ collisionRadius (SpaceJunk a) = M.collisionRadius a++instance M.Moving SpaceJunk where++ velocity (SpaceJunk a) = M.velocity a++instance M.Locatable SpaceJunk where+ center (SpaceJunk a) = M.center a++instance Animation SpaceJunk where+ image (SpaceJunk a) = image a+
+ Star.hs view
@@ -0,0 +1,19 @@+module Star where++import Data.WrapAround+import Animation+import Graphics.Gloss.Data.Picture+import Graphics.Gloss.Data.Color+import GHC.Float+import Moving++data Star = Star { location :: WrapPoint+ , color :: Color+ }++instance Animation Star where+ image star _ = Color (Star.color star) (rectangleSolid 1.0 1.0)++instance Locatable Star where+ center = location+
+ Step.hs view
@@ -0,0 +1,456 @@+{-# LANGUAGE ExistentialQuantification, Rank2Types #-}++module Step (stepUniverse) where++import Universe+import SpaceJunk+import Moving+import Data.WrapAround+import Updating+import GHC.Float+import Lance+import Data.List (find)+import Combat+import Data.Maybe ( fromMaybe+ , isNothing+ , fromJust+ , isJust+ )+import AfterEffect+import qualified AfterEffect.SimpleExplosion as SimpleExplosion+import Unit+import Animation+import Control.Monad+import System.IO+import System.Exit+import Resources+import Sound.ALUT++stepUniverse :: Float -> Universe -> IO Universe+stepUniverse t u =+ let t' = float2Double t in+ do (_, u') <- (handleNewLevel+ >=> handleLives+ >=> handlePureUpdates+ >=> handleSound) (t', u)+ return u'+++handleLives :: (Double, Universe) -> IO (Double, Universe)+handleLives (t, u) =+ do let a = arena u+ let wmap = Universe.wrapMap a+ let rt = resourceTracker u+ if isJust (lance (arena u))+ then return (t, u)+ else if delayRemaining u > 0+ then return ( t+ , u { delayRemaining = delayRemaining u - t }+ )+ else if lives u > 0+ then return+ ( t+ , u { arena =+ a { lance = Just (Lance.new rt wmap+ (wrappoint wmap (0, 0)))+ }+ , delayRemaining = 2.0+ }+ )+ else return+ ( t+ , u { arena = + (head (levels u))+ { lance = Just (Lance.new rt wmap+ (wrappoint wmap (0, 0)))+ }+ , level = 0+ , lives = 3+ , delayRemaining = 2.0+ }+ ) ++handleNewLevel :: (Double, Universe) -> IO (Double, Universe)+handleNewLevel (t, u)+ | not (null (simpleUnits (arena u)) && null (smartUnits (arena u)))+ && not (skipLevel u)+ = return (t, u)+ | level u + 1 >= length (Universe.levels u) =+ do hPutStrLn stderr "Out of levels! Game over."+ exitSuccess+ | otherwise =+ do silenceMost (arena u)+ let a = Universe.levels u !! (level u + 1)+ let l = lance (arena u)+ let wmap = Universe.wrapMap a+ let u'+ = u { arena =+ a { lance =+ fmap+ (\ l ->+ l { Lance.center = wrappoint wmap+ (0.0, 0.0)+ , angle = 0.0+ , Lance.velocity = (0.0, 0.0)})+ l+ }+ , level = level u + 1+ , skipLevel = False+ }+ return (t, u')++{-+ Here we'll terminateAudio everything in the arena that can receive it, not+ including the Lance, which is carried across level changes.+-}+silenceMost a = return ()++-- newLevel u = -- let mProcessAudio = mapM processAudio in+-- let a = arena in+-- if level u >= length (levels u)+-- then++handlePureUpdates :: (Double, Universe) -> IO (Double, Universe)+handlePureUpdates (t, u) = return $ ( handleExpiration+ . handlePostUpdates+ . handleCollisions+ . handleUnitLaunches+ . handleLanceLaunches+ . handlePreUpdates+ . handleVisionUpdates+ . fixFocus+ ) (t, u)+++handleSound :: (Double, Universe) -> IO (Double, Universe)+handleSound (t, u) =+ let arena' = arena u in+ do let listenerCoords = case lance arena' of+ Nothing -> lastFocus arena'+ Just l -> Moving.center l+ lance' <- case lance arena' of+ Nothing -> return Nothing+ Just l -> do l' <- processAudio l listenerCoords+ return (Just l')+ simpleUnits' <- mapM (\x -> processAudio x listenerCoords) (simpleUnits arena')+ smartUnits' <- mapM (\x -> processAudio x listenerCoords) (smartUnits arena')+ afterFX' <- mapM (\x -> processAudio x listenerCoords) (afterFX arena')+ let u' = u { arena = arena' { lance = lance'+ , simpleUnits = simpleUnits'+ , smartUnits = smartUnits'+ , afterFX = afterFX'+ }+ } + -- case lance' of+ -- Nothing -> return ()+ -- Just l -> do let (x, y) = toCoords+ -- (Universe.wrapMap arena')+ -- (Moving.center l)+ -- listenerPosition $= (Vertex3+ -- (double2Float x)+ -- (double2Float y)+ -- 0)+ return (t, u')+ ++handleExpiration :: (Double, Universe) -> (Double, Universe)+handleExpiration (t, u) =+ let arena' = arena u in++ let (lance', aFX_lance) = case lance arena' of+ Nothing -> (Nothing, [])+ Just l -> case expired' l of+ Nothing -> (Just l, [])+ Just a -> (Nothing, a) in++ let lives' = if isJust (lance arena') && isNothing lance'+ then lives u - 1+ else lives u in++ let (lanceProjectiles', aFX_lanceProjectiles) =+ expirationFold (lanceProjectiles arena') in++ let (unitProjectiles', aFX_unitProjectiles) =+ expirationFold (unitProjectiles arena') in++ let (afterFX', aFX_afterFX) =+ expirationFold (afterFX arena') in++ let (simpleUnits', aFX_simpleUnits) =+ expirationFold (simpleUnits arena') in++ let (smartUnits', aFX_smartUnits) =+ expirationFold (smartUnits arena') in++ let u' = u { arena = arena' { lance = lance'+ , lanceProjectiles = lanceProjectiles'+ , unitProjectiles = unitProjectiles'+ , simpleUnits = simpleUnits'+ , smartUnits = smartUnits'+ , afterFX = afterFX'+ ++ aFX_afterFX+ ++ aFX_lance+ ++ aFX_lanceProjectiles+ ++ aFX_unitProjectiles+ ++ aFX_simpleUnits+ ++ aFX_smartUnits+ }+ , lives = lives'+ } in+ (t, u')++ where expirationFold xs = foldr foldF ([], []) xs++ foldF x (nxs, nAFX) = case expired' x of+ Nothing -> (nxs ++ [x], nAFX)+ Just a -> (nxs, nAFX ++ a)+ ++handleLanceLaunches :: (Double, Universe) -> (Double, Universe)+handleLanceLaunches (t, u) =+ let arena' = arena u in+ case lance arena' of+ Nothing -> (t, u)+ Just llance -> let (nProj, nLance) = deployProjectiles llance in+ let u' = u { arena = arena' { lanceProjectiles =+ lanceProjectiles arena'+ ++ nProj+ , lance = Just nLance+ }+ } in+ (t, u')++handleUnitLaunches :: (Double, Universe) -> (Double, Universe)+handleUnitLaunches (t, u) =+ let arena' = arena u in+ let (simpleUnits', unitProjectiles') =+ foldr foldDepl ([], []) (simpleUnits arena') in+ let (smartUnits', unitProjectiles'') =+ foldr foldDepl ([], []) (smartUnits arena') in+ let u' = u { arena = arena' { unitProjectiles = unitProjectiles arena'+ ++ unitProjectiles'+ ++ unitProjectiles''+ , simpleUnits = simpleUnits'+ , smartUnits = smartUnits'+ }+ } in+ (t, u')++ where foldDepl s (units, projectiles) =+ let (nProjectiles, updatedUnit) = deployProjectiles s in+ (units ++ [updatedUnit], projectiles ++ nProjectiles)++fixFocus (t, u) =+ let arena' = arena u in+ let oldFocus = lastFocus arena' in+ let mFocus = do llance <- lance arena'+ Just (Moving.center llance) in+ let newFocus = fromMaybe oldFocus mFocus in+ let u' = u { arena = arena' { lastFocus = newFocus } } in+ (t, u')++handleUpdatesCore :: (forall a. (InternallyUpdating a+ => (a -> Double -> a)))+ -> (Double, Universe)+ -> (Double, Universe)+handleUpdatesCore f (t, u) =+ let arena' = arena u in+ let lance' = do llance <- lance arena'+ Just (f llance t) in+ let asteroids' = [ f a t | a <- asteroids arena' ] in+ let lanceProjectiles' = [ Projectile (f a t)+ | Projectile a <- lanceProjectiles arena' ] in+ let unitProjectiles' = [ Projectile (f a t)+ | Projectile a <- unitProjectiles arena' ] in+ let afterFX' = [ case effect of+ AfterEffect a -> AfterEffect (f a t)+ | effect <- afterFX arena' ] in+ let simpleUnits' = [ f s t | s <- simpleUnits arena' ] in+ let smartUnits' = [ f s t | s <- smartUnits arena' ] in+ let u' = u { arena = arena' { lance = lance'+ , asteroids = asteroids'+ , lanceProjectiles = lanceProjectiles'+ , afterFX = afterFX'+ , simpleUnits = simpleUnits'+ , smartUnits = smartUnits'+ , unitProjectiles = unitProjectiles'+ }+ } in+ (t, u')++handlePreUpdates :: (Double, Universe) -> (Double, Universe)+handlePreUpdates (t, u) = handleUpdatesCore Updating.preUpdate (t, u)++handlePostUpdates :: (Double, Universe) -> (Double, Universe)+handlePostUpdates (t, u) = handleUpdatesCore Updating.postUpdate (t, u)++handleVisionUpdates :: (Double, Universe) -> (Double, Universe)+handleVisionUpdates (t, u) =+ let a = arena u in+ let u' = u { arena =+ a { smartUnits = [ updateVision s a | s <- smartUnits a ] }+ } in+ (t, u')++handleCollisionsLanceAsteroids (t, u) =+ let lance' = case lance a of+ Nothing -> Nothing+ Just l -> let (x, _) = handleCollisionDamage+ wmap t l (asteroids a) in+ Just x in+ let u' = u { arena = a { lance = lance' } } in+ (t, u')+ where+ a = arena u+ wmap = Universe.wrapMap a++handleCollisionsLanceUnitProjectiles (t, u) =+ let (lance', unitProjectiles') =+ case lance a of+ Nothing -> (Nothing, unitProjectiles a)+ Just l -> let (x, ys) = handleCollisionDamage+ wmap t l (unitProjectiles a) in+ (Just x, ys) in+ let u' = u { arena = a { lance = lance'+ , unitProjectiles = unitProjectiles'+ }+ } in+ (t, u')+ where+ a = arena u+ wmap = Universe.wrapMap a++handleCollisionsLanceProjectilesAsteroids (t, u) =+ let (lanceProjectiles', _) = handleCollisionDamage'+ wmap t+ (lanceProjectiles a)+ (asteroids a) in+ let u' = u { arena = a { lanceProjectiles = lanceProjectiles'+ }+ } in+ (t, u')+ where+ a = arena u+ wmap = Universe.wrapMap a++handleCollisionsLanceProjectilesSimpleUnits (t, u) =+ let (lanceProjectiles', simpleUnits') = handleCollisionDamage'+ wmap t+ (lanceProjectiles a)+ (simpleUnits a) in++ let u' = u { arena = a { lanceProjectiles = lanceProjectiles'+ , simpleUnits = simpleUnits'+ }+ } in+ (t, u')+ where+ a = arena u+ wmap = Universe.wrapMap a++handleCollisionsUnitProjectilesAsteroids (t, u) =+ let (unitProjectiles', _) = handleCollisionDamage'+ wmap t+ (unitProjectiles a)+ (asteroids a) in++ let u' = u { arena = a { unitProjectiles = unitProjectiles'+ }+ } in+ (t, u')+ where+ a = arena u+ wmap = Universe.wrapMap a++handleCollisionsLanceSimpleUnits (t, u) =+ let (lance', simpleUnits') =+ case (lance a) of+ Nothing -> (Nothing, (simpleUnits a))+ Just l -> let (x, ys) = handleCollisionDamage+ wmap t l (simpleUnits a) in+ (Just x, ys) in++ let u' = u { arena = a { lance = lance'+ , simpleUnits = simpleUnits'+ }+ } in+ (t, u')+ where+ a = arena u+ wmap = Universe.wrapMap a++handleCollisionsLanceProjectilesSmartUnits (t, u) =+ let (lanceProjectiles', smartUnits') = handleCollisionDamage'+ wmap t+ (lanceProjectiles a)+ (smartUnits a) in++ let u' = u { arena = a { lanceProjectiles = lanceProjectiles'+ , smartUnits = smartUnits'+ }+ } in+ (t, u')+ where+ a = arena u+ wmap = Universe.wrapMap a++handleCollisionsLanceSmartUnits (t, u) =+ let (lance', smartUnits') =+ case (lance a) of+ Nothing -> (Nothing, (smartUnits a))+ Just l -> let (x, ys) = handleCollisionDamage+ wmap t l (smartUnits a) in+ (Just x, ys) in++ let u' = u { arena = a { lance = lance'+ , smartUnits = smartUnits'+ }+ } in+ (t, u')+ where+ a = arena u+ wmap = Universe.wrapMap a++handleCollisionsLanceItems (t, u) =+ let (lance', items') =+ case (lance a) of+ Nothing -> (Nothing, (items a))+ Just l -> let (x, ys) = collisionHandler l (items a) [] in+ (Just x, ys) in++ let u' = u { arena = a { lance = lance'+ , items = items'+ }+ } in+ (t, u')+ where+ a = arena u+ wmap = Universe.wrapMap a+ collisionHandler x [] nys = (x, nys)+ collisionHandler x (y:ys) nys =+ if not (collisionWindow wmap (max+ (maxExpectedVelocity * t)+ (collisionRadius x + collisionRadius y)) x y)+ then collisionHandler x ys (nys ++ [y])+ else+ case collision wmap t x y of+ Nothing -> collisionHandler x ys (nys ++ [y])+ Just _ -> let nx = processItem x y in+ collisionHandler nx ys nys++handleCollisions :: (Double, Universe) -> (Double, Universe)+handleCollisions (t, u) =++ ( handleCollisionsLanceItems+ . handleCollisionsLanceSmartUnits+ . handleCollisionsLanceProjectilesSmartUnits+ . handleCollisionsLanceSimpleUnits+ . handleCollisionsUnitProjectilesAsteroids+ . handleCollisionsLanceProjectilesSimpleUnits+ . handleCollisionsLanceProjectilesAsteroids+ . handleCollisionsLanceUnitProjectiles+ . handleCollisionsLanceAsteroids+ ) (t, u)+++
+ Trigonometry.hs view
@@ -0,0 +1,57 @@+module Trigonometry where++import Data.Maybe++radToDeg :: Floating a => a -> a+radToDeg x = x * 180 / pi++mulSV :: Double -> (Double, Double) -> (Double, Double)+mulSV s (x, y) = (s * x, s * y)++distance :: (Double, Double) -> (Double, Double) -> Double+distance (x1, y1) (x2, y2) = sqrt ((x2 - x1)**2 + (y2 - y1)**2)++normAngle :: Double -> Double -- radians+normAngle x = if x >= 0 then asin (sin x)+ else 2 * pi + asin (sin x)++vectorDirection :: (Double, Double) -- vector+ -> Double -- angle in radians+vectorDirection (0, 0) = 0.0 / 0.0 -- NaN+vectorDirection (x, y)+ | x >= 0 && y >= 0 = a+ | x < 0 && y >= 0 = pi - a+ | x < 0 && y < 0 = pi + a+ | otherwise = 2 * pi - a+ where a = atan (abs y / abs x)++-- let x = 2 * pi + pi / 2 in asin (sin x)+-- let x = (- (2*pi)) + (- (pi / 2)) in 2*pi + asin (sin x)++{-+ Assumes source (origin of projectile) is at origin of grid (0, 0) and so+ target center is relative to this. Assumes source is stationary and so+ velocity of target is relative to source.+-}+targetingA :: Double -> (Double, Double) -> (Double, Double) -> Double+targetingA pSpeed tCenter tVelocity = targetingA'+ pSpeed tCenter tVelocity Nothing 3++ where targetingA' pSpeed oCenter tVelocity nCenter iter =+ let eCenter = fromMaybe oCenter nCenter in+ let d = distance (0, 0) eCenter in+ let t = d / pSpeed in+ let aCenter = addV oCenter (mulSV t tVelocity) in+ if iter > 0+ then targetingA' pSpeed oCenter tVelocity (Just aCenter) (iter - 1)+ else vectorDirection aCenter++addV :: (Double, Double) -> (Double, Double) -> (Double, Double)+addV (x1, y1) (x2, y2) = (x1 + x2, y1 + y2)++subV :: (Double, Double) -> (Double, Double) -> (Double, Double)+subV (x1, y1) (x2, y2) = (x1 - x2, y1 - y2)++doubleRem :: Double -> Double -> Double+doubleRem x y = let a = x / y in+ (a - (fromIntegral (truncate a))) * y
+ Unit.hs view
@@ -0,0 +1,104 @@+{-# LANGUAGE ExistentialQuantification #-}++module Unit ( SimpleUnit (..)+ , SmartUnit (..)+ ) where++import Animation+import Moving+import Combat+import Updating++-- Simple, i.e., no sensory awareness and related A.I.+data SimpleUnit = forall a. ( Animation a+ , Colliding a+ , Transient a+ , Damageable a+ , Damaging a+ , Launcher a+ , Audible a+ ) => SimpleUnit a++instance Colliding SimpleUnit where++ collisionRadius (SimpleUnit a) = collisionRadius a++instance Moving SimpleUnit where++ velocity (SimpleUnit a) = velocity a++instance Locatable SimpleUnit where+ center (SimpleUnit a) = center a++instance Damaging SimpleUnit where+ damageEnergy (SimpleUnit a) = damageEnergy a++instance Damageable SimpleUnit where+ inflictDamage (SimpleUnit a) et = SimpleUnit (inflictDamage a et)++instance Transient SimpleUnit where+ expired' (SimpleUnit a) = expired' a++instance InternallyUpdating SimpleUnit where+ preUpdate (SimpleUnit a) et = SimpleUnit (preUpdate a et)+ postUpdate (SimpleUnit a) et = SimpleUnit (postUpdate a et)++data SmartUnit = forall a. ( Animation a+ , Colliding a+ , Transient a+ , Damageable a+ , Damaging a+ , Launcher a+ , Audible a+ , Observant a+ ) => SmartUnit a++instance Colliding SmartUnit where++ collisionRadius (SmartUnit a) = collisionRadius a++instance Moving SmartUnit where++ velocity (SmartUnit a) = velocity a++instance Locatable SmartUnit where+ center (SmartUnit a) = center a++instance Damaging SmartUnit where+ damageEnergy (SmartUnit a) = damageEnergy a++instance Damageable SmartUnit where+ inflictDamage (SmartUnit a) et = SmartUnit (inflictDamage a et)++instance Transient SmartUnit where+ expired' (SmartUnit a) = expired' a++instance InternallyUpdating SmartUnit where+ preUpdate (SmartUnit a) et = SmartUnit (preUpdate a et)+ postUpdate (SmartUnit a) et = SmartUnit (postUpdate a et)++instance Observant SmartUnit where+ updateVision (SmartUnit a) arena = SmartUnit (updateVision a arena)++instance Launcher SimpleUnit where+ deployProjectiles (SimpleUnit a) = let (ps, a') = deployProjectiles a in+ (ps, SimpleUnit a')++instance Launcher SmartUnit where+ deployProjectiles (SmartUnit a) = let (ps, a') = deployProjectiles a in+ (ps, SmartUnit a')++instance Audible SimpleUnit where+ processAudio (SimpleUnit a) wp = do a' <- processAudio a wp+ return (SimpleUnit a')++ terminateAudio (SimpleUnit a) = do a' <- terminateAudio a+ return (SimpleUnit a')++instance Audible SmartUnit where+ processAudio (SmartUnit a) wp = do a' <- processAudio a wp+ return (SmartUnit a')++ terminateAudio (SmartUnit a) = do a' <- terminateAudio a+ return (SmartUnit a')+
+ Unit/Simple/Turret.hs view
@@ -0,0 +1,184 @@+module Unit.Simple.Turret ( Turret(..)+ , new+ ) where++import Data.WrapAround+import Animation+import Graphics.Gloss.Data.Picture+import Graphics.Gloss.Data.Color+import GHC.Float+import Trigonometry+import ResourceTracker+import Updating+import qualified Moving as M+import Combat+import qualified Projectile.BulletSI as P.BulletSI+import AfterEffect+import qualified AfterEffect.SimpleExplosion as SimpleExplosion+import Data.Maybe+import Sound.ALUT++radialVelocity = pi/6 -- radians per second++velocityMagnitude = 40++kamikazeDamage = 6.0++maxIntegrity = 2.0++data Turret = Turret { turretAngle :: Double -- radians+ , velocity :: (Double, Double)+ , center :: WrapPoint+ , idealTargetLocation :: Maybe WrapPoint+ , wrapMap :: WrapMap+ , launchTube :: [Projectile]+ , sinceLastShot :: Double+ , integrity :: Double+ , animDefault0 :: Picture+ , resourceTracker :: ResourceTracker++ -- Sound+ , queueShotSound :: Bool+ , shotSoundSource :: Maybe Source+ }++instance Audible Turret where++ processAudio self lcenter =+ do self' <- if isNothing (shotSoundSource self)+ then initializeShotSoundSource self+ else return self+ if not (queueShotSound self)+ then return self'+ else do let (x, y) = vectorRelation+ (wrapMap self)+ (lcenter)+ (center self)+ let s = fromJust $ shotSoundSource self+ sourcePosition s $= (Vertex3 (double2Float x)+ (double2Float (-y))+ 0)+ play [s]+ return self' { queueShotSound = False }++ terminateAudio self =+ if isNothing (shotSoundSource self)+ then return self+ else do stop [fromJust (shotSoundSource self)]+ return self++initializeShotSoundSource self =+ do [source] <- genObjectNames 1+ buffer source $= getSound (resourceTracker self) "energy-shot-02.wav"+ -- ...+ sourceRelative source $= Listener+ referenceDistance source $= audioReferenceDistance+-- maxDistance source $= audioMaxDistance+ rolloffFactor source $= audioRolloffFactor+ return self { shotSoundSource = Just source }++new :: ResourceTracker+ -> WrapMap+ -> WrapPoint+ -> Double+ -> Double+ -> Turret+new rt wmap center' tAngle mAngle =+ let pic = fromMaybe+ (Scale 0.20 0.20+ (Color white+ (Text "Error! Missing image!")))+ (getImage rt "turret.bmp") in+ Turret { center = center'+ , turretAngle = tAngle+ , idealTargetLocation = Nothing+ , velocity = velocity'+ , wrapMap = wmap+ , launchTube = []+ , sinceLastShot = 0.0+ , integrity = maxIntegrity+ , animDefault0 = pic+ , resourceTracker = rt++ , queueShotSound = False+ , shotSoundSource = Nothing+ }+ where velocity' =( sin mAngle * velocityMagnitude+ , cos mAngle * velocityMagnitude+ ) ++updateAngle t self+ = self { turretAngle = turretAngle self - radialVelocity * t}++instance Animation Turret where+ image self _ = Rotate (radToDeg+ (double2Float+ (turretAngle self)) * (-1) - 90)+ (animDefault0 self)++instance M.Locatable Turret where+ center = center++instance M.Moving Turret where+ velocity = velocity++instance M.Colliding Turret where+ collisionRadius _ = 16.0++instance InternallyUpdating Turret where++ preUpdate self t = (updateFiringInformation t+ . updateIdealTargetLocation t+ . updateAngle t) self++ postUpdate self t =+ let center' = fromMaybe (center self) (idealTargetLocation self) in+ self { center = center'+ , idealTargetLocation = Nothing+ }++updateFiringInformation t self =+ let sinceLastShot' = sinceLastShot self + t in+ if sinceLastShot' >= 1.5+ then self { sinceLastShot = 0.0+ , launchTube = launchTube self ++ projectiles+ , queueShotSound = True+ }+ else self { sinceLastShot = sinceLastShot' }+ where projectiles = map projectile [ 0.0, pi / 2, pi, 3 * pi / 2 ]+ projectile x = Projectile ( P.BulletSI.new+ (wrapMap self)+ (turretAngle self + x)+ (center self)+ (velocity self) )+++updateIdealTargetLocation :: Double -> Turret -> Turret+updateIdealTargetLocation t self =+ self { idealTargetLocation = Just (M.idealNewLocation (wrapMap self)+ (center self)+ (velocity self)+ t)+ }++instance Launcher Turret where++ deployProjectiles self = (launchTube self, self { launchTube = [] })++instance Transient Turret where++ expired' self = if integrity self > 0.0+ then Nothing+ else Just [aeffect]+ where aeffect = AfterEffect (SimpleExplosion.new (resourceTracker self)+ (wrapMap self)+ (center self)+ (velocity self))++instance Damageable Turret where++ inflictDamage self d = self { integrity = max 0.0 (integrity self - d) }++instance Damaging Turret where++ damageEnergy self = kamikazeDamage
+ Unit/Smart/ATank.hs view
@@ -0,0 +1,223 @@+module Unit.Smart.ATank ( ATank(..)+ , new+ ) where++import Data.WrapAround+import Animation+import Graphics.Gloss.Data.Picture+import Graphics.Gloss.Data.Color+import GHC.Float+import Trigonometry+import ResourceTracker+import Updating+import qualified Moving as M+import Combat+import qualified Projectile.BulletMI as P.BulletMI+import AfterEffect+import qualified AfterEffect.SimpleExplosion as SimpleExplosion+import Data.Maybe+import Universe hiding (wrapMap, resourceTracker)+import qualified Universe as U+import Sound.ALUT++radialVelocity = pi/4 -- radians per second++maxVelocityMag = 60++kamikazeDamage = 14.0++maxIntegrity = 4++accelerationRate = 40++data ATank = ATank { angle :: Double -- radians+ , velocity :: (Double, Double)+ , center :: WrapPoint+ , idealTargetLocation :: Maybe WrapPoint+ , wrapMap :: WrapMap+ , launchTube :: [Projectile]+ , sinceLastShot :: Double+ , integrity :: Double+ , vision :: Maybe Arena+ , resourceTracker :: ResourceTracker++ -- Sound+ , queueShotSound :: Bool+ , shotSoundSource :: Maybe Source+ }++instance Audible ATank where++ processAudio self lcenter =+ do self' <- if isNothing (shotSoundSource self)+ then initializeShotSoundSource self+ else return self+ if not (queueShotSound self)+ then return self'+ else do let (x, y) = vectorRelation+ (wrapMap self)+ (lcenter)+ (center self)+ let s = fromJust $ shotSoundSource self+ sourcePosition s $= (Vertex3 (double2Float x)+ (double2Float (-y))+ 0)+ play [s]+ return self' { queueShotSound = False }++ terminateAudio self =+ if isNothing (shotSoundSource self)+ then return self+ else do stop [fromJust (shotSoundSource self)]+ return self++initializeShotSoundSource self =+ do [source] <- genObjectNames 1+ buffer source $= getSound (resourceTracker self) "energy-shot-02.wav"+ -- ...+ sourceRelative source $= Listener+ referenceDistance source $= audioReferenceDistance+-- maxDistance source $= audioMaxDistance+ rolloffFactor source $= audioRolloffFactor+ return self { shotSoundSource = Just source }++new :: ResourceTracker+ -> WrapMap+ -> WrapPoint+ -> Double+ -> ATank+new rt wmap center' angle' =+ ATank { center = center'+ , angle = angle'+ , idealTargetLocation = Nothing+ , velocity = (0.0, 0.0)+ , wrapMap = wmap+ , launchTube = []+ , sinceLastShot = 0.0+ , integrity = maxIntegrity+ , vision = Nothing+ , resourceTracker = rt++ , queueShotSound = False+ , shotSoundSource = Nothing+ }++instance Observant ATank where++ updateVision self arena = self { vision = Just arena }++updateAngle t self+ = case vision self of+ Nothing -> self+ Just arena -> if isNothing (lance arena)+ then self+ else let sDir = vectorDirection (velocity self) in+ let tDir = vectorDirection+ (vectorRelation+ (U.wrapMap arena)+ (center self)+ (M.center (fromJust (lance arena)))) in+ let adj+ | tDir - sDir > pi / 6 = radialVelocity * t+ | tDir -sDir < (-pi) / 6 = (-radialVelocity) * t+ | otherwise = 0.0 in+ self { angle = angle self + adj }++updateVelocity :: Double -> ATank -> ATank+updateVelocity t self =+ self { velocity = M.calcNewVelocity+ (velocity self)+ accelerationRate+ (angle self)+ maxVelocityMag+ t + }++instance Animation ATank where+ image self _ = Rotate (radToDeg+ (double2Float+ (angle self)) * (-1) - 90)+ pic+ where pic = fromMaybe+ (Scale 0.20 0.20+ (Color white+ (Text "Error! Missing image!")))+ (getImage rt "atank.bmp")+ rt = resourceTracker self++instance M.Locatable ATank where+ center = center++instance M.Moving ATank where+ velocity = velocity++instance M.Colliding ATank where+ collisionRadius _ = 20.0++instance InternallyUpdating ATank where++ preUpdate self t = (updateFiringInformation t+ . updateIdealTargetLocation t+ . updateVelocity t+ . updateAngle t) self++ postUpdate self t =+ let center' = fromMaybe (center self) (idealTargetLocation self) in+ self { center = center'+ , idealTargetLocation = Nothing+ }++updateFiringInformation t self =+ let sinceLastShot' = sinceLastShot self + t in+ if sinceLastShot' >= 2.5+ then self { sinceLastShot = 0.0+ , launchTube = projectile : launchTube self+ , queueShotSound = True+ }+ else self { sinceLastShot = sinceLastShot' }+ where projectile = Projectile+ (P.BulletMI.new+ (wrapMap self)+ pAngle+ (center self)+ (velocity self))+ pAngle = case vision self of+ Nothing -> angle self+ Just arena ->+ case lance arena of+ Nothing -> angle self+ Just l -> vectorDirection+ (vectorRelation+ (U.wrapMap arena)+ (center self)+ (M.center l))++updateIdealTargetLocation :: Double -> ATank -> ATank+updateIdealTargetLocation t self =+ self { idealTargetLocation = Just (M.idealNewLocation (wrapMap self)+ (center self)+ (velocity self)+ t)+ }++instance Launcher ATank where++ deployProjectiles self = (launchTube self, self { launchTube = [] })++instance Transient ATank where++ expired' self = if integrity self > 0.0+ then Nothing+ else Just [aeffect]+ where aeffect = AfterEffect (SimpleExplosion.new (resourceTracker self)+ (wrapMap self)+ (center self)+ (velocity self))++instance Damageable ATank where++ inflictDamage self d = self { integrity = max 0.0 (integrity self - d) }++instance Damaging ATank where++ damageEnergy self = kamikazeDamage
+ Unit/Smart/Death.hs view
@@ -0,0 +1,279 @@+module Unit.Smart.Death ( Death(..)+ , new+ ) where++import Data.WrapAround+import Animation+import Graphics.Gloss.Data.Picture+import Graphics.Gloss.Data.Color+import GHC.Float+import Trigonometry+import ResourceTracker+import Updating+import qualified Moving as M+import Combat+import qualified Projectile.BulletSII as P.BulletSII+import qualified Projectile.BulletMII as P.BulletMII+import AfterEffect+import qualified AfterEffect.SimpleExplosion as SimpleExplosion+import Data.Maybe+import Universe hiding (wrapMap, resourceTracker)+import qualified Universe as U+import Sound.ALUT++radialVelocity = pi -- radians per second++maxVelocityMag = 200.0++kamikazeDamage = 100.0++maxIntegrity = 12++accelerationRate = 200.0++adjAngle = pi / 8++shotDelay_sniper = 3.0++shotDelay_spread = 2.0++data Death = Death { angle :: Double -- radians+ , velocity :: (Double, Double)+ , center :: WrapPoint+ , idealTargetLocation :: Maybe WrapPoint+ , wrapMap :: WrapMap+ , launchTube :: [Projectile]+ , sinceLastShot_sniper :: Double+ , sinceLastShot_spread :: Double+ , integrity :: Double+ , vision :: Maybe Arena+ , resourceTracker :: ResourceTracker+ + -- Sound+ , queueShotSound :: Bool+ , shotSoundSource :: Maybe Source+ }++instance Audible Death where++ processAudio self lcenter =+ do self' <- if isNothing (shotSoundSource self)+ then initializeShotSoundSource self+ else return self+ if not (queueShotSound self)+ then return self'+ else do let (x, y) = vectorRelation+ (wrapMap self)+ (lcenter)+ (center self)+ let s = fromJust $ shotSoundSource self+ sourcePosition s $= (Vertex3 (double2Float x)+ (double2Float (-y))+ 0)+ play [s]+ return self' { queueShotSound = False }++ terminateAudio self =+ if isNothing (shotSoundSource self)+ then return self+ else do stop [fromJust (shotSoundSource self)]+ return self++initializeShotSoundSource self =+ do [source] <- genObjectNames 1+ buffer source $= getSound (resourceTracker self) "energy-shot-02.wav"+ sourceRelative source $= Listener+ referenceDistance source $= audioReferenceDistance+ rolloffFactor source $= audioRolloffFactor+ return self { shotSoundSource = Just source }++new :: ResourceTracker+ -> WrapMap+ -> WrapPoint+ -> Double+ -> Death+new rt wmap center' angle' =+ Death { center = center'+ , angle = angle'+ , idealTargetLocation = Nothing+ , velocity = (0.0, 0.0)+ , wrapMap = wmap+ , launchTube = []+ , sinceLastShot_sniper = 0.0+ , sinceLastShot_spread = 0.0+ , integrity = maxIntegrity+ , vision = Nothing+ , resourceTracker = rt++ , queueShotSound = False+ , shotSoundSource = Nothing+ }++instance Observant Death where++ updateVision self arena = self { vision = Just arena }++updateAngle t self+ = case vision self of+ Nothing -> self+ Just a -> case lance a of+ Nothing -> self+ Just l -> let sDir = angle self in+ let sDir' = if sDir == 0.0 / 0.0+ then 0.1+ else sDir in+ let tDir = vectorDirection+ (vectorRelation+ (wrapMap self)+ (center self)+ (M.center l)) in+ let adj+ | tDir - sDir' > adjAngle = radialVelocity * t+ | tDir - sDir' < (-1) * adjAngle = (-radialVelocity) * t+ | otherwise = 0.0 in+ self { angle = angle self + adj }++updateVelocity t self =+ let thrustingVelocity = M.calcNewVelocity+ (velocity self)+ accelerationRate+ (angle self)+ maxVelocityMag+ t in+ let velocity' = case vision self of+ Nothing -> velocity self+ Just a ->+ case lance a of+ Nothing -> velocity self+ Just l -> let sDir = angle self in+ let sDir' = if sDir == 0.0 / 0.0+ then 0.1+ else sDir in+ let tDir = vectorDirection+ (vectorRelation+ (wrapMap self)+ (center self)+ (M.center l)) in+ if abs (tDir - sDir') <= adjAngle+ then thrustingVelocity+ else velocity self in+ self { velocity = velocity' }++instance Animation Death where+ image self _ = fromMaybe+ (Scale 0.20 0.20+ (Color white+ (Text "Error! Missing image!")))+ (getImage rt "death.bmp")+ where rt = resourceTracker self++instance M.Locatable Death where+ center = center++instance M.Moving Death where+ velocity = velocity++instance M.Colliding Death where+ collisionRadius _ = 60.0++instance InternallyUpdating Death where++ preUpdate self t = (updateFiringInformation t+ . updateIdealTargetLocation t+ . updateVelocity t+ . updateAngle t) self++ postUpdate self t =+ let center' = fromMaybe (center self) (idealTargetLocation self) in+ self { center = center'+ , idealTargetLocation = Nothing+ }++updateFiringInformation t self =+ fst $ (handleSpreadFiring . handleSniperFiring) (self, t)++handleSniperFiring (self, t) =+ let sinceLastShot_sniper' = sinceLastShot_sniper self + t in+ if sinceLastShot_sniper' >= shotDelay_sniper+ then (self { sinceLastShot_sniper = 0.0+ , launchTube = projectile : launchTube self+ , queueShotSound = True+ }, t)+ else (self { sinceLastShot_sniper = sinceLastShot_sniper' }, t)+ where projectile = Projectile+ (P.BulletSII.new+ (wrapMap self)+ pAngle+ (center self)+ (velocity self))+ pSpeed = P.BulletSII.speed+ pAngle = case vision self of+ Nothing -> angle self+ Just arena ->+ case lance arena of+ Nothing -> angle self+ Just l -> targetingA+ pSpeed+ (vectorRelation+ (U.wrapMap arena)+ (center self)+ (M.center l))+ (subV+ (M.velocity l)+ (M.velocity self))++handleSpreadFiring (self, t) =+ let sinceLastShot_spread' = sinceLastShot_spread self + t in+ if sinceLastShot_spread' >= shotDelay_spread+ then (self { sinceLastShot_spread = 0.0+ , launchTube = projectiles ++ launchTube self+ , queueShotSound = True+ }, t)+ else (self { sinceLastShot_spread = sinceLastShot_spread' }, t)+ where projectiles = map projectile [ x * pi / 8.0 - pi / 4.0 | x <- [0..7] ]+ projectile x = Projectile+ (P.BulletMII.new+ (wrapMap self)+ (pAngle + x)+ (center self)+ (velocity self))+ pAngle = case vision self of+ Nothing -> angle self+ Just arena ->+ case lance arena of+ Nothing -> angle self+ Just l -> vectorDirection+ (vectorRelation+ (U.wrapMap arena)+ (center self)+ (M.center l))++updateIdealTargetLocation :: Double -> Death -> Death+updateIdealTargetLocation t self =+ self { idealTargetLocation = Just (M.idealNewLocation (wrapMap self)+ (center self)+ (velocity self)+ t)+ }++instance Launcher Death where++ deployProjectiles self = (launchTube self, self { launchTube = [] })++instance Transient Death where++ expired' self = if integrity self > 0.0+ then Nothing+ else Just [aeffect]+ where aeffect = AfterEffect (SimpleExplosion.new (resourceTracker self)+ (wrapMap self)+ (center self)+ (velocity self))++instance Damageable Death where++ inflictDamage self d = self { integrity = max 0.0 (integrity self - d) }++instance Damaging Death where++ damageEnergy self = kamikazeDamage
+ Unit/Smart/Ninja.hs view
@@ -0,0 +1,252 @@+module Unit.Smart.Ninja ( Ninja(..)+ , new+ ) where++import Data.WrapAround+import Animation+import Graphics.Gloss.Data.Picture+import Graphics.Gloss.Data.Color+import GHC.Float+import Trigonometry+import ResourceTracker+import Updating+import qualified Moving as M+import Combat+import qualified Projectile.Blade as P.Blade+import AfterEffect+import qualified AfterEffect.SimpleExplosion as SimpleExplosion+import Data.Maybe+import Universe hiding (wrapMap, resourceTracker)+import qualified Universe as U+import Sound.ALUT++radialVelocity = pi/2 -- radians per second++maxVelocityMag = 200.0++kamikazeDamage = 8.0++maxIntegrity = 2++accelerationRate = 200.0++adjAngle = pi / 8++shotDelay = 5.0++data Ninja = Ninja { angle :: Double -- radians+ , velocity :: (Double, Double)+ , center :: WrapPoint+ , idealTargetLocation :: Maybe WrapPoint+ , wrapMap :: WrapMap+ , launchTube :: [Projectile]+ , sinceLastShot :: Double+ , integrity :: Double+ , vision :: Maybe Arena+ , resourceTracker :: ResourceTracker+ + -- Sound+ , queueShotSound :: Bool+ , shotSoundSource :: Maybe Source+ }++instance Audible Ninja where++ processAudio self lcenter =+ do self' <- if isNothing (shotSoundSource self)+ then initializeShotSoundSource self+ else return self+ if not (queueShotSound self)+ then return self'+ else do let (x, y) = vectorRelation+ (wrapMap self)+ (lcenter)+ (center self)+ let s = fromJust $ shotSoundSource self+ sourcePosition s $= (Vertex3 (double2Float x)+ (double2Float (-y))+ 0)+ play [s]+ return self' { queueShotSound = False }++ terminateAudio self =+ if isNothing (shotSoundSource self)+ then return self+ else do stop [fromJust (shotSoundSource self)]+ return self++initializeShotSoundSource self =+ do [source] <- genObjectNames 1+ buffer source $= getSound (resourceTracker self) "energy-shot-02.wav"+ -- ...+ sourceRelative source $= Listener+ referenceDistance source $= audioReferenceDistance+ rolloffFactor source $= audioRolloffFactor+ return self { shotSoundSource = Just source }++new :: ResourceTracker+ -> WrapMap+ -> WrapPoint+ -> Double+ -> Ninja+new rt wmap center' angle' =+ Ninja { center = center'+ , angle = angle'+ , idealTargetLocation = Nothing+ , velocity = (0.0, 0.0)+ , wrapMap = wmap+ , launchTube = []+ , sinceLastShot = 0.0+ , integrity = maxIntegrity+ , vision = Nothing+ , resourceTracker = rt+ , queueShotSound = False+ , shotSoundSource = Nothing+ }++instance Observant Ninja where++ updateVision self arena = self { vision = Just arena }+++updateAngle t self+ = case vision self of+ Nothing -> self+ Just a -> case lance a of+ Nothing -> self+ Just l -> let sDir = angle self in+ let sDir' = if sDir == 0.0 / 0.0+ then 0.1+ else sDir in+ let tDir = vectorDirection+ (vectorRelation+ (wrapMap self)+ (center self)+ (M.center l)) in+ let adj+ | tDir - sDir' > adjAngle = radialVelocity * t+ | tDir - sDir' < (-1) * adjAngle = (-radialVelocity) * t+ | otherwise = 0.0 in+ self { angle = angle self + adj }++updateVelocity :: Double -> Ninja -> Ninja+updateVelocity t self =+ let thrustingVelocity = M.calcNewVelocity+ (velocity self)+ accelerationRate+ (angle self)+ maxVelocityMag+ t in+ let velocity' = case vision self of+ Nothing -> velocity self+ Just a ->+ case lance a of+ Nothing -> velocity self+ Just l -> let sDir = angle self in+ let sDir' = if sDir == 0.0 / 0.0+ then 0.1+ else sDir in+ let tDir = vectorDirection+ (vectorRelation+ (wrapMap self)+ (center self)+ (M.center l)) in+ if abs (tDir - sDir') <= adjAngle+ then thrustingVelocity+ else velocity self in+ self { velocity = velocity' }++instance Animation Ninja where+ image self _ = Rotate (radToDeg+ (double2Float+ (angle self)) * (-1) - 90)+ pic+ where pic = fromMaybe+ (Scale 0.20 0.20+ (Color white+ (Text "Error! Missing image!")))+ (getImage rt "ninja.bmp")+ rt = resourceTracker self++instance M.Locatable Ninja where+ center = center++instance M.Moving Ninja where+ velocity = velocity++instance M.Colliding Ninja where+ collisionRadius _ = 40.0++instance InternallyUpdating Ninja where++ preUpdate self t = (updateFiringInformation t+ . updateIdealTargetLocation t+ . updateVelocity t+ . updateAngle t) self++ postUpdate self t =+ let center' = fromMaybe (center self) (idealTargetLocation self) in+ self { center = center'+ , idealTargetLocation = Nothing+ }++updateFiringInformation t self =+ let sinceLastShot' = sinceLastShot self + t in+ if sinceLastShot' >= shotDelay+ then self { sinceLastShot = 0.0+ , launchTube = projectile : launchTube self+ , queueShotSound = True+ }+ else self { sinceLastShot = sinceLastShot' }+ where projectile = Projectile+ (P.Blade.new+ (wrapMap self)+ (resourceTracker self)+ pAngle+ (center self)+ (velocity self))+ pSpeed = P.Blade.speed+ pAngle = case vision self of+ Nothing -> angle self+ Just arena ->+ case lance arena of+ Nothing -> angle self+ Just l -> targetingA+ pSpeed+ (vectorRelation+ (U.wrapMap arena)+ (center self)+ (M.center l))+ (subV+ (M.velocity l)+ (M.velocity self))++updateIdealTargetLocation :: Double -> Ninja -> Ninja+updateIdealTargetLocation t self =+ self { idealTargetLocation = Just (M.idealNewLocation (wrapMap self)+ (center self)+ (velocity self)+ t)+ }++instance Launcher Ninja where++ deployProjectiles self = (launchTube self, self { launchTube = [] })++instance Transient Ninja where++ expired' self = if integrity self > 0.0+ then Nothing+ else Just [aeffect]+ where aeffect = AfterEffect (SimpleExplosion.new (resourceTracker self)+ (wrapMap self)+ (center self)+ (velocity self))++instance Damageable Ninja where++ inflictDamage self d = self { integrity = max 0.0 (integrity self - d) }++instance Damaging Ninja where++ damageEnergy self = kamikazeDamage
+ Unit/Smart/Saucer.hs view
@@ -0,0 +1,257 @@+module Unit.Smart.Saucer ( Saucer(..)+ , new+ ) where++import Data.WrapAround+import Animation+import Graphics.Gloss.Data.Picture+import Graphics.Gloss.Data.Color+import GHC.Float+import Trigonometry+import ResourceTracker+import Updating+import qualified Moving as M+import Combat+import qualified Projectile.Pellet as P.Pellet+import AfterEffect+import qualified AfterEffect.SimpleExplosion as SimpleExplosion+import Data.Maybe+import Universe hiding (wrapMap, resourceTracker)+import qualified Universe as U+import Sound.ALUT++radialVelocity = pi -- radians per second++maxVelocityMag = 300++kamikazeDamage = 6.0++maxIntegrity = 1++accelerationRate = 300++adjAngle = pi / 8++shotDelay = 0.10++data Saucer = Saucer { angle :: Double -- radians+ , velocity :: (Double, Double)+ , center :: WrapPoint+ , idealTargetLocation :: Maybe WrapPoint+ , wrapMap :: WrapMap+ , launchTube :: [Projectile]+ , sinceLastShot :: Double+ , integrity :: Double+ , vision :: Maybe Arena+ , resourceTracker :: ResourceTracker+ , firingAnglesIndex :: Int+ + -- Sound+ , queueShotSound :: Bool+ , shotSoundSource :: Maybe Source+ }++instance Audible Saucer where++ processAudio self lcenter =+ do self' <- if isNothing (shotSoundSource self)+ then initializeShotSoundSource self+ else return self+ if not (queueShotSound self)+ then return self'+ else do let (x, y) = vectorRelation+ (wrapMap self)+ (lcenter)+ (center self)+ let s = fromJust $ shotSoundSource self+ sourcePosition s $= (Vertex3 (double2Float x)+ (double2Float (-y))+ 0)+ play [s]+ return self' { queueShotSound = False }++ terminateAudio self =+ if isNothing (shotSoundSource self)+ then return self+ else do stop [fromJust (shotSoundSource self)]+ return self++initializeShotSoundSource self =+ do [source] <- genObjectNames 1+ buffer source $= getSound (resourceTracker self) "energy-shot-02.wav"+ -- ...+ sourceRelative source $= Listener+ referenceDistance source $= audioReferenceDistance+-- maxDistance source $= audioMaxDistance+ rolloffFactor source $= audioRolloffFactor+ return self { shotSoundSource = Just source }++new :: ResourceTracker+ -> WrapMap+ -> WrapPoint+ -> Double+ -> Saucer+new rt wmap center' angle' =+ Saucer { center = center'+ , angle = angle'+ , idealTargetLocation = Nothing+ , velocity = (0.0, 0.0)+ , wrapMap = wmap+ , launchTube = []+ , sinceLastShot = 0.0+ , integrity = maxIntegrity+ , vision = Nothing+ , resourceTracker = rt+ , firingAnglesIndex = 0++ , queueShotSound = False+ , shotSoundSource = Nothing+ }++instance Observant Saucer where++ updateVision self arena = self { vision = Just arena }++updateAngle t self+ = case vision self of+ Nothing -> self+ Just a -> case lance a of+ Nothing -> self+ Just l -> let sDir = angle self in+ let sDir' = if sDir == 0.0 / 0.0+ then 0.1+ else sDir in+ let tDir = vectorDirection+ (vectorRelation+ (wrapMap self)+ (center self)+ (M.center l)) in+ let adj+ | tDir - sDir' > adjAngle = radialVelocity * t+ | tDir - sDir' < (-1) * adjAngle = (-radialVelocity) * t+ | otherwise = 0.0 in+ self { angle = angle self + adj }++updateVelocity :: Double -> Saucer -> Saucer+updateVelocity t self =+ let thrustingVelocity = M.calcNewVelocity+ (velocity self)+ accelerationRate+ (angle self)+ maxVelocityMag+ t in+ let velocity' = case vision self of+ Nothing -> velocity self+ Just a ->+ case lance a of+ Nothing -> velocity self+ Just l -> let sDir = angle self in+ let sDir' = if sDir == 0.0 / 0.0+ then 0.1+ else sDir in+ let tDir = vectorDirection+ (vectorRelation+ (wrapMap self)+ (center self)+ (M.center l)) in+ if abs (tDir - sDir') <= adjAngle+ then thrustingVelocity+ else velocity self in+ self { velocity = velocity' }++instance Animation Saucer where+ image self _ = fromMaybe+ (Scale 0.20 0.20+ (Color white+ (Text "Error! Missing image!")))+ (getImage rt "saucer.bmp")+ where rt = resourceTracker self++instance M.Locatable Saucer where+ center = center++instance M.Moving Saucer where+ velocity = velocity++instance M.Colliding Saucer where+ collisionRadius _ = 20.0++instance InternallyUpdating Saucer where++ preUpdate self t = (updateFiringInformation t+ . updateIdealTargetLocation t+ . updateVelocity t+ . updateAngle t) self++ postUpdate self t =+ let center' = fromMaybe (center self) (idealTargetLocation self) in+ self { center = center'+ , idealTargetLocation = Nothing+ }++updateFiringInformation t self =+ let inRange = case vision self of+ Nothing -> False+ Just a -> case lance a of+ Nothing -> False+ Just l -> Data.WrapAround.distance+ (wrapMap self)+ (center self)+ (M.center l) <= P.Pellet.range in+ let sinceLastShot' = sinceLastShot self + t in+ if sinceLastShot' >= shotDelay && inRange+ then self { sinceLastShot = 0.0+ , launchTube = projectile : launchTube self+ , queueShotSound = True+ , firingAnglesIndex =+ if firingAnglesIndex self >= length firingAngles - 1+ then 0+ else firingAnglesIndex self + 1+ }+ else self { sinceLastShot = sinceLastShot' }+ where projectile = Projectile+ (P.Pellet.new+ (wrapMap self)+ pAngle+ (center self)+ (velocity self))+ pAngle = firingAngles !! firingAnglesIndex self+ firingAngles = [ 0.0+ , 3.142+ , 0.785+ , 3.927+ , 1.571+ , 4.712+ , 2.356+ , 5.498+ ]++updateIdealTargetLocation :: Double -> Saucer -> Saucer+updateIdealTargetLocation t self =+ self { idealTargetLocation = Just (M.idealNewLocation (wrapMap self)+ (center self)+ (velocity self)+ t)+ }++instance Launcher Saucer where++ deployProjectiles self = (launchTube self, self { launchTube = [] })++instance Transient Saucer where++ expired' self = if integrity self > 0.0+ then Nothing+ else Just [aeffect]+ where aeffect = AfterEffect (SimpleExplosion.new (resourceTracker self)+ (wrapMap self)+ (center self)+ (velocity self))++instance Damageable Saucer where++ inflictDamage self d = self { integrity = max 0.0 (integrity self - d) }++instance Damaging Saucer where++ damageEnergy self = kamikazeDamage
+ Unit/Smart/Sniper.hs view
@@ -0,0 +1,232 @@+module Unit.Smart.Sniper ( Sniper(..)+ , new+ ) where++import Data.WrapAround+import Animation+import Graphics.Gloss.Data.Picture+import Graphics.Gloss.Data.Color+import GHC.Float+import Trigonometry+import ResourceTracker+import Updating+import qualified Moving as M+import Combat+import qualified Projectile.BulletSII as P.BulletSII+import AfterEffect+import qualified AfterEffect.SimpleExplosion as SimpleExplosion+import Data.Maybe+import Universe hiding (wrapMap, resourceTracker)+import qualified Universe as U+import Sound.ALUT++radialVelocity = pi/6 -- radians per second++maxVelocityMag = 20++kamikazeDamage = 2.0++maxIntegrity = 1++accelerationRate = 30++adjAngle = pi / 8++shotDelay = 4.0++data Sniper = Sniper { angle :: Double -- radians+ , velocity :: (Double, Double)+ , center :: WrapPoint+ , idealTargetLocation :: Maybe WrapPoint+ , wrapMap :: WrapMap+ , launchTube :: [Projectile]+ , sinceLastShot :: Double+ , integrity :: Double+ , vision :: Maybe Arena+ , resourceTracker :: ResourceTracker+ + -- Sound+ , queueShotSound :: Bool+ , shotSoundSource :: Maybe Source+ }++instance Audible Sniper where++ processAudio self lcenter =+ do self' <- if isNothing (shotSoundSource self)+ then initializeShotSoundSource self+ else return self+ if not (queueShotSound self)+ then return self'+ else do let (x, y) = vectorRelation+ (wrapMap self)+ (lcenter)+ (center self)+ let s = fromJust $ shotSoundSource self+ sourcePosition s $= (Vertex3 (double2Float x)+ (double2Float (-y))+ 0)+ play [s]+ return self' { queueShotSound = False }++ terminateAudio self =+ if isNothing (shotSoundSource self)+ then return self+ else do stop [fromJust (shotSoundSource self)]+ return self++initializeShotSoundSource self =+ do [source] <- genObjectNames 1+ buffer source $= getSound (resourceTracker self) "energy-shot-02.wav"+ -- ...+ sourceRelative source $= Listener+ referenceDistance source $= audioReferenceDistance+-- maxDistance source $= audioMaxDistance+ rolloffFactor source $= audioRolloffFactor+ return self { shotSoundSource = Just source }++new :: ResourceTracker+ -> WrapMap+ -> WrapPoint+ -> Double+ -> Sniper+new rt wmap center' angle' =+ Sniper { center = center'+ , angle = angle'+ , idealTargetLocation = Nothing+ , velocity = (0.0, 0.0)+ , wrapMap = wmap+ , launchTube = []+ , sinceLastShot = 0.0+ , integrity = maxIntegrity+ , vision = Nothing+ , resourceTracker = rt++ , queueShotSound = False+ , shotSoundSource = Nothing+ }++instance Observant Sniper where++ updateVision self arena = self { vision = Just arena }++updateAngle t self+ = case vision self of+ Nothing -> self+ Just arena -> if isNothing (lance arena)+ then self+ else let sDir = vectorDirection (velocity self) in+ let tDir = vectorDirection+ (vectorRelation+ (U.wrapMap arena)+ (center self)+ (M.center (fromJust (lance arena)))) in+ let adj+ | tDir - sDir > adjAngle = radialVelocity * t+ | tDir -sDir < (-1) * adjAngle = (-radialVelocity) * t+ | otherwise = 0.0 in+ self { angle = angle self + adj }++updateVelocity :: Double -> Sniper -> Sniper+updateVelocity t self =+ self { velocity = M.calcNewVelocity+ (velocity self)+ accelerationRate+ (angle self)+ maxVelocityMag+ t + }++instance Animation Sniper where+ image self _ = Rotate (radToDeg+ (double2Float+ (angle self)) * (-1) - 90)+ pic+ where pic = fromMaybe+ (Scale 0.20 0.20+ (Color white+ (Text "Error! Missing image!")))+ (getImage rt "sniper.bmp")+ rt = resourceTracker self++instance M.Locatable Sniper where+ center = center++instance M.Moving Sniper where+ velocity = velocity++instance M.Colliding Sniper where+ collisionRadius _ = 20.0++instance InternallyUpdating Sniper where++ preUpdate self t = (updateFiringInformation t+ . updateIdealTargetLocation t+ . updateVelocity t+ . updateAngle t) self++ postUpdate self t =+ let center' = fromMaybe (center self) (idealTargetLocation self) in+ self { center = center'+ , idealTargetLocation = Nothing+ }++updateFiringInformation t self =+ let sinceLastShot' = sinceLastShot self + t in+ if sinceLastShot' >= shotDelay+ then self { sinceLastShot = 0.0+ , launchTube = projectile : launchTube self+ , queueShotSound = True+ }+ else self { sinceLastShot = sinceLastShot' }+ where projectile = Projectile+ (P.BulletSII.new+ (wrapMap self)+ pAngle+ (center self)+ (velocity self))+ pSpeed = P.BulletSII.speed+ pAngle = case vision self of+ Nothing -> angle self+ Just arena ->+ case lance arena of+ Nothing -> angle self+ Just l -> targetingA+ pSpeed+ (vectorRelation+ (U.wrapMap arena)+ (center self)+ (M.center l))+ (subV+ (M.velocity l)+ (M.velocity self))++updateIdealTargetLocation :: Double -> Sniper -> Sniper+updateIdealTargetLocation t self =+ self { idealTargetLocation = Just (M.idealNewLocation (wrapMap self)+ (center self)+ (velocity self)+ t)+ }++instance Launcher Sniper where++ deployProjectiles self = (launchTube self, self { launchTube = [] })++instance Transient Sniper where++ expired' self = if integrity self > 0.0+ then Nothing+ else Just [aeffect]+ where aeffect = AfterEffect (SimpleExplosion.new (resourceTracker self)+ (wrapMap self)+ (center self)+ (velocity self))++instance Damageable Sniper where++ inflictDamage self d = self { integrity = max 0.0 (integrity self - d) }++instance Damaging Sniper where++ damageEnergy self = kamikazeDamage
+ Unit/Smart/Tank.hs view
@@ -0,0 +1,223 @@+module Unit.Smart.Tank ( Tank(..)+ , new+ ) where++import Data.WrapAround+import Animation+import Graphics.Gloss.Data.Picture+import Graphics.Gloss.Data.Color+import GHC.Float+import Trigonometry+import ResourceTracker+import Updating+import qualified Moving as M+import Combat+import qualified Projectile.BulletSI as P.BulletSI+import AfterEffect+import qualified AfterEffect.SimpleExplosion as SimpleExplosion+import Data.Maybe+import Universe hiding (wrapMap, resourceTracker)+import qualified Universe as U+import Sound.ALUT++radialVelocity = pi/6 -- radians per second++maxVelocityMag = 40++kamikazeDamage = 10.0++maxIntegrity = 3++accelerationRate = 30++data Tank = Tank { angle :: Double -- radians+ , velocity :: (Double, Double)+ , center :: WrapPoint+ , idealTargetLocation :: Maybe WrapPoint+ , wrapMap :: WrapMap+ , launchTube :: [Projectile]+ , sinceLastShot :: Double+ , integrity :: Double+ , vision :: Maybe Arena+ , resourceTracker :: ResourceTracker++ -- Sound+ , queueShotSound :: Bool+ , shotSoundSource :: Maybe Source+ }++instance Audible Tank where++ processAudio self lcenter =+ do self' <- if isNothing (shotSoundSource self)+ then initializeShotSoundSource self+ else return self+ if not (queueShotSound self)+ then return self'+ else do let (x, y) = vectorRelation+ (wrapMap self)+ (lcenter)+ (center self)+ let s = fromJust $ shotSoundSource self+ sourcePosition s $= (Vertex3 (double2Float x)+ (double2Float (-y))+ 0)+ play [s]+ return self' { queueShotSound = False }++ terminateAudio self =+ if isNothing (shotSoundSource self)+ then return self+ else do stop [fromJust (shotSoundSource self)]+ return self++initializeShotSoundSource self =+ do [source] <- genObjectNames 1+ buffer source $= getSound (resourceTracker self) "energy-shot-02.wav"+ -- ...+ sourceRelative source $= Listener+ referenceDistance source $= audioReferenceDistance+-- maxDistance source $= audioMaxDistance+ rolloffFactor source $= audioRolloffFactor+ return self { shotSoundSource = Just source }++new :: ResourceTracker+ -> WrapMap+ -> WrapPoint+ -> Double+ -> Tank+new rt wmap center' angle' =+ Tank { center = center'+ , angle = angle'+ , idealTargetLocation = Nothing+ , velocity = (0.0, 0.0)+ , wrapMap = wmap+ , launchTube = []+ , sinceLastShot = 0.0+ , integrity = maxIntegrity+ , vision = Nothing+ , resourceTracker = rt++ , queueShotSound = False+ , shotSoundSource = Nothing+ }++instance Observant Tank where++ updateVision self arena = self { vision = Just arena }++updateAngle t self+ = case vision self of+ Nothing -> self+ Just arena -> if isNothing (lance arena)+ then self+ else let sDir = vectorDirection (velocity self) in+ let tDir = vectorDirection+ (vectorRelation+ (U.wrapMap arena)+ (center self)+ (M.center (fromJust (lance arena)))) in+ let adj+ | tDir - sDir > pi / 6 = radialVelocity * t+ | tDir -sDir < (-pi) / 6 = (-radialVelocity) * t+ | otherwise = 0.0 in+ self { angle = angle self + adj }++updateVelocity :: Double -> Tank -> Tank+updateVelocity t self =+ self { velocity = M.calcNewVelocity+ (velocity self)+ accelerationRate+ (angle self)+ maxVelocityMag+ t + }++instance Animation Tank where+ image self _ = Rotate (radToDeg+ (double2Float+ (angle self)) * (-1) - 90)+ pic+ where pic = fromMaybe+ (Scale 0.20 0.20+ (Color white+ (Text "Error! Missing image!")))+ (getImage rt "tank.bmp")+ rt = resourceTracker self++instance M.Locatable Tank where+ center = center++instance M.Moving Tank where+ velocity = velocity++instance M.Colliding Tank where+ collisionRadius _ = 20.0++instance InternallyUpdating Tank where++ preUpdate self t = (updateFiringInformation t+ . updateIdealTargetLocation t+ . updateVelocity t+ . updateAngle t) self++ postUpdate self t =+ let center' = fromMaybe (center self) (idealTargetLocation self) in+ self { center = center'+ , idealTargetLocation = Nothing+ }++updateFiringInformation t self =+ let sinceLastShot' = sinceLastShot self + t in+ if sinceLastShot' >= 3+ then self { sinceLastShot = 0.0+ , launchTube = projectile : launchTube self+ , queueShotSound = True+ }+ else self { sinceLastShot = sinceLastShot' }+ where projectile = Projectile+ (P.BulletSI.new+ (wrapMap self)+ pAngle+ (center self)+ (velocity self))+ pAngle = case vision self of+ Nothing -> angle self+ Just arena ->+ case lance arena of+ Nothing -> angle self+ Just l -> vectorDirection+ (vectorRelation+ (U.wrapMap arena)+ (center self)+ (M.center l))++updateIdealTargetLocation :: Double -> Tank -> Tank+updateIdealTargetLocation t self =+ self { idealTargetLocation = Just (M.idealNewLocation (wrapMap self)+ (center self)+ (velocity self)+ t)+ }++instance Launcher Tank where++ deployProjectiles self = (launchTube self, self { launchTube = [] })++instance Transient Tank where++ expired' self = if integrity self > 0.0+ then Nothing+ else Just [aeffect]+ where aeffect = AfterEffect (SimpleExplosion.new (resourceTracker self)+ (wrapMap self)+ (center self)+ (velocity self))++instance Damageable Tank where++ inflictDamage self d = self { integrity = max 0.0 (integrity self - d) }++instance Damaging Tank where++ damageEnergy self = kamikazeDamage
+ Universe.hs view
@@ -0,0 +1,49 @@+module Universe where+import Lance+import Star+import Data.WrapAround+import SpaceJunk+import Combat+import AfterEffect+import Unit ( SimpleUnit+ , SmartUnit+ )+import ResourceTracker+import Item++data Arena = Arena { lance :: Maybe Lance+ , lastFocus :: WrapPoint+ , stars :: [Star]+ , wrapMap :: WrapMap+ , asteroids :: [SpaceJunk]+ , lanceProjectiles :: [Projectile]+ , afterFX :: [AfterEffect]+ , simpleUnits :: [SimpleUnit]+ , smartUnits :: [SmartUnit]+ , unitProjectiles :: [Projectile]+ , items :: [Item]+ }++data Universe = Universe { arena :: Arena+ , level :: Int+ , levels :: [Arena]+ , lives :: Integer+ , delayRemaining :: Double+ , resourceTracker :: ResourceTracker+ , skipLevel :: Bool+ }++blankArena width height =+ let wmap = wrapmap width height in+ Arena { lance = Nothing+ , lastFocus = wrappoint wmap (0, 0)+ , stars = []+ , Universe.wrapMap = wmap+ , asteroids = []+ , lanceProjectiles = []+ , afterFX = []+ , simpleUnits = []+ , smartUnits = []+ , unitProjectiles = []+ , items = []+ }
+ Universe.hs-boot view
@@ -0,0 +1,3 @@+module Universe where++data Arena
+ Updating.hs view
@@ -0,0 +1,28 @@+module Updating where++import {-# SOURCE #-} AfterEffect ( AfterEffect )+import {-# SOURCE #-} Universe ( Arena )++-- Double is elapsed time in seconds+class InternallyUpdating a where+ preUpdate :: a -> Double -> a+ postUpdate :: a -> Double -> a++{- + Objects that exist temporarily or that may die after being wounded a certain+ amount. Should be used for objects whose continued existence depends on some+ internal variable, e.g., a lifeforce or countdown that may reach zero.+-}+class (InternallyUpdating a) => Transient a where++ {- Whether or not the object should be removed from existence -}+ expired' :: a -> Maybe [AfterEffect]++class (InternallyUpdating a) => SimpleTransient a where++ expired :: a -> Bool++class Observant a where++ updateVision :: a -> Arena -> a+
+ edge.cabal view
@@ -0,0 +1,115 @@+-- edge.cabal auto-generated by cabal init. For additional options,+-- see+-- http://www.haskell.org/cabal/release/cabal-latest/doc/users-guide/authors.html#pkg-descr.+-- The name of the package.+Name: edge++-- The package version. See the Haskell package versioning policy+-- (http://www.haskell.org/haskellwiki/Package_versioning_policy) for+-- standards guiding when and how versions should be incremented.+Version: 0.8++-- A short (one-line) description of the package.+Synopsis: Top view space combat arcade game++-- A longer description of the package.+Description: The Edge has always been a rough patch of interstellar+ space filled with innumerable bad guys of every nefarious+ sort, and dangerous debris flying in every direction at+ high speeds. But now it has grown out of control and is+ threatening to overflow into colonial space. Central+ command has decided to send in their newest super weapon,+ the Mark II Lance fighter, piloted by their top ace pilot.+ Good luck commander!++-- URL for the project homepage or repository.+Homepage: http://frigidcode.com++-- The license under which the package is released.+License: GPL-3++-- The file containing the license text.+License-file: COPYING++-- The package author(s).+Author: Christopher Howard++-- An email address to which users can send suggestions, bug reports,+-- and patches.+Maintainer: christopher.howard@frigidcode.com++-- A copyright notice.+-- Copyright: ++Category: Game++Build-type: Simple++-- Extra files to be distributed with the package, such as examples or+-- a README.+Extra-source-files: DONATE++-- Constraint on the version of Cabal needed to build this package.+Cabal-version: >=1.10++data-files: image/*.bmp+ sound/*.wav++Executable edge+ -- .hs or .lhs file containing the Main module.+ Main-is: edge.hs+ + Default-language: Haskell2010+ -- Packages needed in order to build this package.+ Build-depends: gloss >= 1.7.4.1 && < 1.8+ , wraparound >= 0.0.1.1 && < 0.1+ , base >= 4 && < 5+ , containers >= 0.4.2.1 && < 0.5+ , ALUT >= 2.2 && < 2.3+ , random >= 1.0.1.1 && < 1.1+ + -- Modules not exported by this package.+ Other-modules: Lance+ , Asteroid+ , BigAsteroid+ , Trigonometry+ , Animation+ , Star+ , Paths_edge+ , ResourceTracker+ , Resources+ , Input+ , Item+ , Universe+ , Updating+ , Moving+ , SpaceJunk+ , Display+ , Step+ , AfterEffect+ , AfterEffect.SimpleExplosion+ , AfterEffect.MineExplosion+ , Projectile.Blade+ , Projectile.BulletMkI+ , Projectile.BulletSI+ , Projectile.BulletSII+ , Projectile.BulletMI+ , Projectile.BulletMII+ , Projectile.Cannon+ , Projectile.Mine+ , Projectile.Nuke+ , Projectile.Pellet+ , Combat+ , Unit+ , Unit.Simple.Turret+ , Unit.Smart.Tank+ , Unit.Smart.ATank+ , Unit.Smart.Death+ , Unit.Smart.Ninja+ , Unit.Smart.Saucer+ , Unit.Smart.Sniper+ + -- Extra tools (e.g. alex, hsc2hs, ...) needed to build the source.+ -- Build-tools: ++ ghc-options: -O2 -threaded
+ edge.hs view
@@ -0,0 +1,52 @@+import Data.WrapAround+import Graphics.Gloss.Interface.IO.Game+import Lance+import Resources+import Input+import Universe+import Display+import Step+import Unit+import Unit.Simple.Turret (Turret)+import qualified Unit.Simple.Turret as Turret+import ResourceTracker+import Sound.ALUT+import Data.Maybe+import System.IO+import Data.List ( intersperse )+import Animation++displayMode = InWindow "The Edge" (1024, 768) (0, 0)++main = withProgNameAndArgs runALUT $ \progName args -> do+ universe <- initUniverse+ distanceModel $= audioDistanceModel+-- listenerPosition $= (Vertex3 0 0 0)+ errs <- get alErrors+ if not (null errs)+ then hPutStrLn+ stderr+ (concat+ (intersperse "," [ d | ALError _ d <- errs ]))+ else return ()+ playIO displayMode black 20 universe displayUniverse handleInput stepUniverse++initUniverse =+ do rt <- initResources+ rLevels <- initLevels rt+ let sArena = head rLevels+ let wmap = Universe.wrapMap sArena+ return Universe { arena = sArena++ { lance = Just (Lance.new rt wmap+ (wrappoint wmap (0, 0)))+ }++ , level = 0+ , Universe.levels = rLevels+ , lives = 3+ , delayRemaining = 2.0+ , resourceTracker = rt+ , skipLevel = False+ }+
+ image/asteroid.bmp view
binary file changed (absent → 4218 bytes)
+ image/asteroidbig.bmp view
binary file changed (absent → 16506 bytes)
+ image/atank.bmp view
binary file changed (absent → 6522 bytes)
+ image/blade.bmp view
binary file changed (absent → 11158 bytes)
+ image/death.bmp view
binary file changed (absent → 65658 bytes)
+ image/explosion-00.bmp view
binary file changed (absent → 40122 bytes)
+ image/explosion-01.bmp view
binary file changed (absent → 40122 bytes)
+ image/explosion-02.bmp view
binary file changed (absent → 40122 bytes)
+ image/explosion-03.bmp view
binary file changed (absent → 40122 bytes)
+ image/explosion-04.bmp view
binary file changed (absent → 40122 bytes)
+ image/explosion-05.bmp view
binary file changed (absent → 40122 bytes)
+ image/explosion-06.bmp view
binary file changed (absent → 40122 bytes)
+ image/item-cannon.bmp view
binary file changed (absent → 2058 bytes)
+ image/item-default.bmp view
binary file changed (absent → 2058 bytes)
+ image/item-fourway.bmp view
binary file changed (absent → 2058 bytes)
+ image/item-health.bmp view
binary file changed (absent → 2058 bytes)
+ image/item-nuke.bmp view
binary file changed (absent → 2058 bytes)
+ image/item-rapidfire.bmp view
binary file changed (absent → 2058 bytes)
+ image/item-spread.bmp view
binary file changed (absent → 2058 bytes)
+ image/lance-thrusting.bmp view
binary file changed (absent → 12566 bytes)
+ image/lance.bmp view
binary file changed (absent → 12566 bytes)
+ image/mine-explosion.bmp view
binary file changed (absent → 40122 bytes)
+ image/mine-lit.bmp view
binary file changed (absent → 1146 bytes)
+ image/mine.bmp view
binary file changed (absent → 1146 bytes)
+ image/ninja.bmp view
binary file changed (absent → 10186 bytes)
+ image/nuke-0.bmp view
binary file changed (absent → 262266 bytes)
+ image/nuke-1.bmp view
binary file changed (absent → 262266 bytes)
+ image/nuke-2.bmp view
binary file changed (absent → 262266 bytes)
+ image/nuke-3.bmp view
binary file changed (absent → 262266 bytes)
+ image/saucer.bmp view
binary file changed (absent → 6846 bytes)
+ image/sniper.bmp view
binary file changed (absent → 4218 bytes)
+ image/tank.bmp view
binary file changed (absent → 6522 bytes)
+ image/turret.bmp view
binary file changed (absent → 4746 bytes)
+ sound/energy-shot-02.wav view
binary file changed (absent → 13440 bytes)
+ sound/explosion.wav view
binary file changed (absent → 19340 bytes)
+ sound/simple-energy-shot.wav view
binary file changed (absent → 13440 bytes)
+ sound/test.wav view
binary file changed (absent → 108972 bytes)