dow (empty) → 0.1.0
raw patch · 18 files changed
+3004/−0 lines, 18 filesdep +GLFWdep +OpenGLdep +arraysetup-changed
Dependencies added: GLFW, OpenGL, array, base, directory, elerea, mtl
Files
- LICENSE +28/−0
- README +12/−0
- Setup.hs +3/−0
- data/charset.txt +443/−0
- data/levels.txt +329/−0
- data/sprites.txt +1065/−0
- dow.cabal +47/−0
- src/Actor.hs +117/−0
- src/Game.hs +288/−0
- src/GraphUtils.hs +31/−0
- src/HighScore.hs +36/−0
- src/Level.hs +86/−0
- src/Main.hs +94/−0
- src/Render.hs +251/−0
- src/Sprites.hs +64/−0
- src/Text.hs +57/−0
- src/Utils.hs +42/−0
- src/Vector.hs +11/−0
+ LICENSE view
@@ -0,0 +1,28 @@+Copyright (c) 2010, Patai Gergely+All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++1. Redistributions of source code must retain the above copyright notice,+ this list of conditions and the following disclaimer.++2. Redistributions in binary form must reproduce the above copyright+ notice, this list of conditions and the following disclaimer in the+ documentation and/or other materials provided with the distribution.++3. Neither the name of the author nor the names of its contributors may be+ used to endorse or promote products derived from this software without+ specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"+AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE+IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE+ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE+LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR+CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF+SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS+INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN+CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)+ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE+POSSIBILITY OF SUCH DAMAGE.
+ README view
@@ -0,0 +1,12 @@+Dungeons of Wor+===============++Dungeons of Wor is a homage to the classic arcade game, Wizard of Wor.+It uses the artwork and levels from the Astrocade version, but the+gameplay mechanics differ from the original in several ways.++Controls:++ player one and menu - arrows + right control+ player two - WASD + left control+ quit at any time - escape
+ Setup.hs view
@@ -0,0 +1,3 @@+import Distribution.Simple++main = defaultMain
+ data/charset.txt view
@@ -0,0 +1,443 @@+ +........+........+........+........+........+........+........+........+........+........++A+...##...+..####..+.######.+.##..##.+.##..##.+.##..##.+.######.+.######.+.##..##.+.##..##.++B+.#####..+.######.+.##..##.+.##..##.+.#####..+.######.+.##..##.+.##..##.+.######.+.#####..++C+..####..+.######.+.##..##.+.##.....+.##.....+.##.....+.##.....+.##..##.+.######.+..####..++D+.#####..+.######.+.##..##.+.##..##.+.##..##.+.##..##.+.##..##.+.##..##.+.######.+.#####..++E+.######.+.######.+.##.....+.##.....+.#####..+.#####..+.##.....+.##.....+.######.+.######.++F+.######.+.######.+.##.....+.##.....+.#####..+.#####..+.##.....+.##.....+.##.....+.##.....++G+..####..+.######.+.##.....+.##.....+.##.....+.##.###.+.##.###.+.##..##.+.######.+..####..++H+.##..##.+.##..##.+.##..##.+.##..##.+.######.+.######.+.##..##.+.##..##.+.##..##.+.##..##.++I+..####..+..####..+...##...+...##...+...##...+...##...+...##...+...##...+..####..+..####..++J+.....##.+.....##.+.....##.+.....##.+.....##.+.....##.+.##..##.+.##..##.+.######.+..####..++K+.##..##.+.##..##.+.##.###.+.#####..+.####...+.####...+.##.##..+.##.###.+.##..##.+.##..##.++L+.##.....+.##.....+.##.....+.##.....+.##.....+.##.....+.##.....+.##.....+.######.+.######.++M+##....##+###..###+###..###+##.##.##+##.##.##+##....##+##....##+##....##+##....##+##....##++N+.##..##.+.##..##.+.###.##.+.######.+.######.+.##.###.+.##..##.+.##..##.+.##..##.+.##..##.++O+..####..+.######.+.##..##.+.##..##.+.##..##.+.##..##.+.##..##.+.##..##.+.######.+..####..++P+.#####..+.######.+.##..##.+.##..##.+.######.+.#####..+.##.....+.##.....+.##.....+.##.....++Q+..####..+.######.+.##..##.+.##..##.+.##..##.+.##..##.+.##..##.+.##.###.+.##..#..+..###.#.++R+.#####..+.######.+.##..##.+.##..##.+.######.+.#####..+.##.###.+.##..##.+.##..##.+.##..##.++S+..####..+.######.+.##..##.+.##.....+.#####..+..#####.+.....##.+.##..##.+.######.+..####..++T+.######.+.######.+...##...+...##...+...##...+...##...+...##...+...##...+...##...+...##...++U+.##..##.+.##..##.+.##..##.+.##..##.+.##..##.+.##..##.+.##..##.+.##..##.+.######.+..####..++V+.##..##.+.##..##.+.##..##.+.##..##.+.##..##.+.######.+..####..+..####..+...##...+...##...++W+##....##+##....##+##....##+##.##.##+##.##.##+##.##.##+########+###..###+##....##+##....##++X+.##..##.+.##..##.+.##..##.+.##..##.+..####..+.######.+.##..##.+.##..##.+.##..##.+.##..##.++Y+.##..##.+.##..##.+.######.+..####..+...##...+...##...+...##...+...##...+...##...+...##...++Z+.######.+.######.+.....##.+....###.+...###..+..###...+.###....+.##.....+.######.+.######.++0+..####..+.######.+.##..##.+.##..##.+.##..##.+.##..##.+.##..##.+.##..##.+.######.+..####..++1+...##...+..###...+...##...+...##...+...##...+...##...+...##...+...##...+..####..+..####..++2+..####..+.######.+.##..##.+.....##.+..#####.+.#####..+.##.....+.##.....+.######.+.######.++3+..####..+.######.+.##..##.+.....##.+...###..+...####.+.....##.+.##..##.+.######.+..####..++4+.##..##.+.##..##.+.##..##.+.##..##.+.######.+.######.+.....##.+.....##.+.....##.+.....##.++5+.#####..+.#####..+.##.....+.##.....+.#####..+.######.+.....##.+.##..##.+.######.+..####..++6+..####..+.#####..+.##.....+.##.....+.#####..+.######.+.##..##.+.##..##.+.######.+..####..++7+.######.+.######.+.....##.+....###.+....##..+...###..+...##...+..###...+..##....+..##....++8+..####..+.######.+.##..##.+.##..##.+..####..+.######.+.##..##.+.##..##.+.######.+..####..++9+..####..+.######.+.##..##.+.##..##.+.######.+..#####.+.....##.+.....##.+..#####.+..####..
+ data/levels.txt view
@@ -0,0 +1,329 @@+"arena"++---------------------++| |+| +-+ +---+ +---+ +-+ |+| | | |++ +---+ +---+ ++< >++ +-+ +-+ ++| | | |+| + +-+ +-----+ +-+ + |+| | | |+| + + + +-+ + + + |+| | | | | |++*+-+---+-----+---+-+*+++"pit"++---------------------++| |+| |+| |++ ++< >++ ++| |+| |+| |+| |+| |++*+-----------------+*+++"b1"++-----+---------+-----++| | | |+| +-+ + +-+ +-+ + +-+ |+| | | |++ + + +---+ +---+ + + ++< | | | | >++ | +-+ + + +-+ | ++| | | | | |+| +-+ + +-+ +-+ + +-+ |+| | | | | |+| + +-+ + + + + +-+ + |+| | | |++*+-----+-----+-----+*+++"b2"++---------------------++| |+| + + + + + + + + + + |+| | | | | | | | | | | |++ + + | + | | + | + + ++< | | | | >++-+ + +-+ + + +-+ + +-++| | | |+| + +-+ + + +-+ + |+| | | | | | | |+| + + + +-+ +-+ + + + |+| | | |++*+-+-------------+-+*+++"b3"++---+-------------+---++| | | |+| + + +-+ +-+ +-+ + + |+| | | | | |++ + + | +-+ +-+ | + + ++< | | | | | | >++---+ +-+ | | +-+ +---++| | | |+| + +---+ + + +---+ + |+| | | |+| + + + +-+ + + + |+| | | | | |++*+-+---+-----+---+-+*+++"b4"++-------+-----+-------++| | | |+| +---+ + + + + +---+ |+| | | | | |++ + +---+ + + +---+ + ++< | | >++-+ | + +-+ +-+ + | +-++| | | | | |+| + + + +-----+ + + + |+| | | |+| + + +-+ +-+ + + |+| | | |++*+---+---------+---+*+++"b5"++-----+---------+-----++| | | |+| +-+ + +-+ +-+ + +-+ |+| | | |++ +---+ + + + + +---+ ++< | | >++-+ +-+ + + + + +-+ +-++| | | | | |+| +-+ | +-+ +-+ | +-+ |+| | | |+| +-+ + + +-+ + + +-+ |+| | | |++*+-----+-----+-----+*+++"b6"++---+-------------+---++| | | |+| + + +-+ +-+ +-+ + + |+| | | |++ + + +-+ +-+ +-+ + + ++< | | | | >++-+ | +-+ +-+ | +-++| | | | | |+| + +-+ + +-+ + +-+ + |+| | | |+| + + +-+ +-+ + + |+| | | |++*+---+---------+---+*+++"b7"++-----+---------+-----++| | | |+| +-+ + +-+ +-+ + +-+ |+| | | |++ + +-+ +-+ +-+ +-+ + ++< | | | | >++-+ + + + | | + + + +-++| | | | | | | |+| +-+ + | + + | + +-+ |+| | | |+| +-+ +-+ + + +-+ +-+ |+| | | |++*+-------+-+-------+*+++"b8"++---------------------++| |+| +-+ +-+ +-+ +-+ |+| | | | | |++ + +-+ + +-+ + +-+ + ++< | | >++-+ + + + +-+ + + + +-++| | | | | |+| +-+ | +-+ +-+ | +-+ |+| | | |+| +-+ + + +-+ + + +-+ |+| | | |++*+-----+-----+-----+*+++"b9"++---------------------++| |+| +---+ + +-+ + +---+ |+| | | |++ +-+ +-+ +-+ +-+ +-+ ++< | | >++-+ + + +-+ +-+ + + +-++| | | | | |+| +-+ + + + + + + +-+ |+| | | | | | | |+| + +-+ + + + + +-+ + |+| | | |++*+-----+-----+-----+*+++"b10"++-----+---------+-----++| | | |+| +-+ + +-+ +-+ + +-+ |+| | | |++ +---+ + +-+ + +---+ ++< >++-+ + + + + + + + + +-++| | | | | | | | | |+| +-+ + | + + | + +-+ |+| | | |+| +-+ + +-+ +-+ + +-+ |+| | | |++*+---+---------+---+*+++"b11"++-----+---------+-----++| | | |+| +-+ | + +-+ + | +-+ |+| | | | | |++ +-+ + +-+ +-+ + +-+ ++< | | >++-+ + + + +-+ + + + +-++| | | | | |+| +---+ + +-+ + +---+ |+| |+| +-+ + +-+ + +-+ |+| | | |++*+-----+-----+-----+*+++"b12"++---+-------------+---++| | | |+| + + +-+ +-+ +-+ + + |+| | | | | |++ + +-+ + +-+ + +-+ + ++< | | >++-+ + + | +-+ | + + +-++| | | | | | | |+| + | + + + + + + | + |+| | | | | | | |+| + + + +-+ +-+ + + + |+| | | |++*+---+---------+---+*+++"w1"++---------------------++| |+| + + + + |+| | | | | |++ +-+ +-+ + + +-+ +-+ ++< | | | | >++ + + | | + + ++| | | | | |+| +-+ +-+ + + +-+ +-+ |+| | | | | |+| + + + + |+| |++*+-----------------+*+++"w2"++---------------------++| |+| +-+ +-+ |+| | | |++ +-+ +-+ ++< | | >++ +-+ + + +-+ ++| | | | | |+| +-+ +-+ +-+ +-+ |+| | | |+| +-+ +-+ |+| |++*+-----------------+*+++"w3"++---------------------++| |+| + +-+ +-+ + |+| | | | | |++ +-+-+ + + + + +-+-+ ++< | | | | >++ + + +-+-+ +-+-+ + + ++| | | | | |+| +-+ + + +-+ |+| | | |+| +---+ +---+ |+| |++*+-----------------+*+++"w4"++---------------------++| |+| + + + + + + |+| | | | | | | |++ | + + | + + | + + | ++< | | | | | | | | >++ + | + + | | + + | + ++| | | | | | | |+| + | + + + + | + |+| | | | | |+| + + + + |+| |++*+-----------------+*+++"w5"++---------------------++| |+| +-+ + + +-+ |+| | | | | |++ | +---+ +---+ | ++< | | | | >++ +-+ + + + + +-+ ++| | | |+| +---+ +---+ |+| | | |+| + + |+| |++*+-----------------+*+++"w6"++---------------------++| |+| +-+ + +-+ + +-+ |+| | | |++ + +-+ + +-+ + +-+ + ++< | | >++ | +-+ +-+ | ++| | | |+| + +-+ + +-+ + +-+ + |+| | | |+| +-+ + +-+ + +-+ |+| |++*+-----------------+*+++"w7"++---------------------++| |+| +-+ + + +-+ |+| | | | | |++ +-+ +-+ +-+ +-+ ++< | | | | >++ | | | | ++| | | | | |+| +-+ +-+ +-+ +-+ |+| | | | | |+| +-+ + + +-+ |+| |++*+-----------------+*+++"w8"++---------------------++| |+| +-+ +-+ +-+ +-+ |+| | | |++ +-+ +-+ +-+ ++< | | >++ +-+ +-+ ++| | | |+| + +-+ +-+ + |+| | | | | |+| + + + + |+| |++*+-----------------+*+
+ data/sprites.txt view
@@ -0,0 +1,1065 @@+r 255 0 0 255+b 65 161 255 255+y 237 202 0 255++[blue-worrior-walk]++" bbb "+" r bbb "+" bbb b "+" bbbbb "+" bbb bb "+" bbbbbbb "+" bbrrbrbb "+" b b bbbrrbrb "+" rbrbrrrrrrrrrrbrb "+" b b rrrrrrbbbb "+" bbbbb bb "+" bbbb "+" bbbbb "+" bbbbbb "+" bbb bb "+" bbb bbb "+" bb bb "+" bbbb bbbb "++" bbb "+" r bbb "+" bbb b "+" bbbbb "+" bbb bb "+" bbbbbbb "+" bbrrbrbb "+" b b bbbrrbrb "+" rbrbrrrrrrrrrrbrb "+" b b rrrrrrbbbb "+" bbbbb bb "+" bbbb "+" bb "+" bb "+" bb "+" bb "+" bb "+" bbbb "++" bbb "+" r bbb "+" bbb b "+" bbbbb "+" bbb bb "+" bbbbbbb "+" bbrrbrbb "+" b b bbbrrbrb "+" rbrbrrrrrrrrrrbrb "+" b b rrrrrrbbbb "+" bbbbb bb "+" bbbb "+" bbbb "+" bbbbb "+" bb bbb "+" bb bbb "+" bb b "+" bbbb bbb "++[blue-worrior-shoot]++" bbb "+" r bbb r "+" bbb "+" bbbbb "+" y bbb bb "+" rr brrbbb "+" yy b b bbbrrbb "+" yyyyrbrbrrrrrrrrbb "+" ryy b b rrrrrbbb "+" bbbbbbb "+" bbbbbbb "+" bbbbbb "+" bbbbbbb "+" b bbb bbb "+" b bbb bbb "+" bbbb bbb "+" bb bb "+" bbbb "++" r r bbb "+" ryy r bbbr "+" ryyyy bbb "+" yyyy bbbbb "+" r rb bbbb "+" brb bbbb "+" y brr bbrbb "+" rrr bbrrrb "+" r rrrrrrrbb "+" rrrrbbb "+" bbbbbbb "+" b bbbbbbbbb "+" b bbbbbbbbbb "+" bbbbb bbb "+" bb bbb "+" bbb "+" bbb "+" bbbbb "++" r y bbb "+" r bbbr "+" y r bbb "+" yy r bbbbb "+" yyyy bbb b "+" r yyy bbbbb "+" r rbr bbbrbb "+" brrrrr bbrrrb "+" rrrrrrrrrbb "+" rrrrrbbb "+" bbbbbbb "+" bbbbbbb "+" b bbbbbbbb "+" b bbb bbb "+" bbbb bbb "+" bb bb "+" bb "+" bbbbb "++" bbb "+" y r bbb r "+" r bbb "+" bbbbb "+" y bbb bb "+" rr brrbbb "+" yy b b bbbrrbb "+" yyyyrbrbrrrrrrrrbb "+" ryy b b rrrrrbbb "+" bbbbbbb "+" bbbbbbb "+" bbbbbbb "+" bbbbbbb "+" bbb bbb "+" bb bb bbb "+" bbb bb "+" bb bb "+" bbbb "++[yellow-worrior-walk]++" yyy "+" r yyy "+" yyy y "+" yyyyy "+" yyy yy "+" yyyyyyy "+" yyrryryy "+" y y yyyrryry "+" ryryrrrrrrrrrryry "+" y y rrrrrryyyy "+" yyyyy yy "+" yyyy "+" yyyyy "+" yyyyyy "+" yyy yy "+" yyy yyy "+" yy yy "+" yyyy yyyy "++" yyy "+" r yyy "+" yyy y "+" yyyyy "+" yyy yy "+" yyyyyyy "+" yyrryryy "+" y y yyyrryry "+" ryryrrrrrrrrrryry "+" y y rrrrrryyyy "+" yyyyy yy "+" yyyy "+" yy "+" yy "+" yy "+" yy "+" yy "+" yyyy "++" yyy "+" r yyy "+" yyy y "+" yyyyy "+" yyy yy "+" yyyyyyy "+" yyrryryy "+" y y yyyrryry "+" ryryrrrrrrrrrryry "+" y y rrrrrryyyy "+" yyyyy yy "+" yyyy "+" yyyy "+" yyyyy "+" yy yyy "+" yy yyy "+" yy y "+" yyyy yyy "++[yellow-worrior-shoot]++" yyy "+" r yyy r "+" yyy "+" yyyyy "+" y yyy yy "+" rr yrryyy "+" yy y y yyyrryy "+" yyyyryryrrrrrrrryy "+" ryy y y rrrrryyy "+" yyyyyyy "+" yyyyyyy "+" yyyyyy "+" yyyyyyy "+" y yyy yyy "+" y yyy yyy "+" yyyy yyy "+" yy yy "+" yyyy "++" r r b yyy "+" ryy r yyyr "+" ryyyy yyy "+" yyyy yyyyy "+" r ry yyyy "+" yry yyyy "+" b yrr yyryy "+" rrr yyrrry "+" r rrrrrrryy "+" rrrryyy "+" yyyyyyy "+" y yyyyyyyyy "+" y yyyyyyyyyy "+" yyyyy yyy "+" yy yyy "+" yyy "+" yyy "+" yyyyy "++" b y yyy "+" r yyyr "+" y r yyy "+" yy r yyyyy "+" yyyy yyy y "+" r yyy yyyyy "+" b ryr yyyryy "+" yrrrrr yyrrry "+" rrrrrrrrryy "+" rrrrryyy "+" yyyyyyy "+" yyyyyyy "+" y yyyyyyyy "+" y yyy yyy "+" yyyy yyy "+" yy yy "+" yy "+" yyyyy "++" yyy "+" y r yyy r "+" r yyy "+" yyyyy "+" y yyy yy "+" rr yrryyy "+" yy y y yyyrryy "+" yyyyryryrrrrrrrryy "+" ryy y y rrrrryyy "+" yyyyyyy "+" b yyyyyyy "+" yyyyyyy "+" yyyyyyy "+" yyy yyy "+" yy yy yyy "+" yyy yy "+" yy yy "+" yyyy "++[burwor-walk]++" b "+" bbb "+" bbb "+" b bbbb "+" bbbbbb bbbb "+" bbrrbbb b bbb "+" bbbbrrrbbbb bbb "+" bbbbbbbbbbbb bb "+" bbbbbbbbbb b "+" bbbb bbb b "+" bbb b "+" bbb bbbb bb "+" bbbb bbbbb bbbb "+" bbbbbbbbbbbbbb "+" bbb bbbbbb bbb "+" bb bbbbb bb "+" bb b "+" bbbbbb bbbbb "++" bb "+" bbbbbbb bb "+" bbrrbbb bbbb "+" bbbbrrrbbbbb bbbb "+" bbbbbbbbbbb bbb "+" b b bbbbbbb bbb "+" bbbbbbbbbb bb "+" bbbb bbbb bb "+" bbb b "+" bbbb b "+" bbbbbbbbbbbb "+" bbbbbbbbbbbbbb "+" bbb bbbbbbbbb "+" bb bbbb "+" bb bb "+" bbbbbb b "+" bbb "+" bb "++" bbbbbbb bbb "+" bbrrbbb bbbbb "+" bbbbrrrbbbbb bbb "+" bbbbbbbbbbb bb "+" b b bbbbbbb bb "+" bbbbb bb "+" bbbb bbbb bb "+" bbb b "+" bbbbb b "+" bbbbbbbbbb "+" bbbbbbbbbbbbbb "+" bbbb bbbb "+" bb bb "+" bb bb "+" bbbb bbbb "+" b b "+" b b "+" "++[burwor-shoot]++" b "+" bbb "+" b bbb "+" bbbbbb bbbb "+" bbrrbbb b bbbb "+" bbbbrrrbbbb bbbb "+" bbbbbbbbbbb bbb "+" rbrbrbbbbbbb bbb "+" rbbbbbbbbbb bb "+" bbbb bbb b "+" r bbbb b "+" bbb bbbbb bb "+" bbbb bbbbb bbbb "+" bbbbbbbbbbbbbb "+" bbb bbbbbb bbb "+" bb bbbbb bb "+" bb b "+" bbbbbb bbbbb "++" b "+" bb "+" b bbb "+" bbbbbb bbbb "+" bbrrbbb b bbbb "+" bbbbrrrbbbb bbbb "+" bbbbbbbbbbb bbb "+" rbrbbbbbbbbb bbb "+" rrrrrrbbbbb bb "+" bbbb bbb b "+" r bbbb b "+" bbb bbbbb bb "+" bbbb bbbbb bbbb "+" bbbbbbbbbbbbbb "+" r bbb bbbbbb bbb "+" bb bbbbb bb "+" bb b "+" r bbbbbb bbbbb "++" bbbbbb b "+" bbrrbb bbb "+" bbbbrrrbbbb bbbb "+" bbbbbbbbbb bbbb "+" r brbrbbbbbb bbbb "+" rrrrrrrbbb bbbb "+" rryrrrrbbbbb bbb "+" y bbbb bbb bb "+" bbbb bb "+" r bbbbbbbb "+" bbbbbbbbbbbb "+" bbbbbbbbbbbbbb "+" bbb bbbbbbbbb "+" y bb bbbb "+" bb bb "+" bbbbbb b "+" r bbb "+" r bb "++" bbbbbb b "+" bbrrbb bb "+" bbbbrrrbbbb bbb "+" bbbbbbbbbb bbb "+" y brbrbbbbbb bbb "+" rrrrrrrrbbb bbb "+" rrryrrrrbbbbb bb "+" y bbbb bbb bb "+" bbbbbb "+" bbbbbbbbb "+" bbbbbbbbbbbbb "+" bbbbb bbbb "+" bb bb "+" bb bb "+" bbbb bbbb "+" b r b "+" b y b "+" r "++[garwor-walk]++" rr "+" yyyyy rrr "+" yyyyyyy rr "+" yyyy yyyy y "+" yyyyyyb yyyyy y "+" yyyyyyyyyyyyyy y "+" yryryyyyyyyy y "+" rrrrrryyyyyyyyy y "+" r yryryy yyyyyyy y "+" yyyy yyyyyyyy y "+" yyyyyyyyyy "+" yyyyyyyyyyy "+" yyyyyyyyyyyy "+" y yyyyyyyy "+" yyyyy "+" yyy y "+" yy y "+" yyy yy "++" yyyyy rr "+" yyyyyy rrr "+" yyyy yyy rr "+" yyyyyyb yyyy y "+" yyyyyyyyyyyy y "+" yryryryyyyy yyyy "+" rrrrrryyyyy y "+" yryryryyyyyyy y "+" yyyyyyyyyyyyy yy "+" yyyyyyyyy y "+" yyyyyyyyyyy "+" yyyyyyyyyyy "+" y yyyyyyyyy "+" y yyyyyyyy "+" yyyyy "+" yy yyy "+" y y "+" yyy "++" yyyyy rrr "+" yyyyyy rrr "+" yyyy yyy rrr "+" yyyyyyb yyyy y "+" yyyyyyyyyyyy yyy "+" yryryryyyyy y "+" rrrrrrrryyyyy y "+" r yryryryyyyyyy y "+" yyyyyyyyyyyy y "+" yyyyyyyyy y "+" yyyyyyyyyyy "+" yyyyyyyyyyyy "+" yyyyyyyyy "+" yyyyyyy "+" yyyyyy "+" yy yy "+" yy y "+" y yy "++[garwor-shoot]++" rr "+" yyyyy rrr "+" yyyyyyy rr "+" yyyy yyyy y "+" yyyyyyb yyyyy y "+" b yyyyyyyyyyyyyy y "+" ryryryyyyyyyy y "+" rrrrrrryyyyyyyyy "+" y rryryy yyyyyyy "+" yyyyy yyyyyyyyy "+" r yyyyyyyyy "+" yyyyyyyyyy "+" yyyyyyyyyyy "+" y yyyyyyyy "+" yyyyy "+" yyy y "+" yy y "+" yyy yy "++" yyyyy r "+" yyyyyy rrr "+" yyyy yyy rrr "+" yyyyyyb yyyy rr "+" r yyyyyyyyyyyy y "+" yryryryyyyy y "+" by rrrrrryyyyy y "+" yyrrrrrrryyyyyyy y "+" ryb rrryyyyyyyyy y "+" yy yyyyyyyyyyyyyy "+" b yyyyyyyyyy "+" yyyyyyyyyy "+" y yyyyyyyyy "+" y yyyyyyyy "+" yyyyy "+" yy yyy "+" y y "+" yyy "++" yyyyy rrr "+" yyyyyy rrr "+" r yyyy yyy rrr "+" yyyyyyb yyyyrr "+" y yyyyyyyyyyyy y "+" b yryryryyyyy y "+" bb rrrrrrryyyyy y "+" yrrrrrrrryyyyyyy y "+" yb rrryyyyyyyyy y "+" yr yyyyyyyyyyyyyy "+" rr yyyyyyyyyy "+" ryy yyyyyyyyyy "+" yb y yyyyyyyyy "+" y yyyyyyyy "+" yyyyy "+" yy yyy "+" y y "+" yyy "++" yyyyy rr "+" r yyyyyy rrr "+" yyyy yyy rr "+" yyyyyyb yyyy y "+" b yyyyyyyyyyyy y "+" yryryryyyyy y "+" rrrrrrrrryyyyy y "+" rrrrrrryyyyyyy y "+" y rrryyyyyyyyy y "+" b yyyyyyyyyyyy y "+" r yyyyyyyyyy "+" yyyyyyyyyyyy "+" b yyyyyyyyy "+" yyyyyyy "+" yyyyyy "+" yy yy "+" yy y "+" y yy "++[thorwor-walk]++" rr "+" yy rr "+" y r rrr "+" y rrr r "+" rrrrr rr "+" rr rrrr r "+" rr rrrr rrr "+" rr brrrrr r "+" rrrrrrrrrrrr rr "+" rrrrrrrrrrrrrrrrrr "+" rrrrrrrrrrrrrr "+" rr rrrrrrrrrrr "+" rrrrrrrrrrrrrrrr "+" rrrr r r r "+" r r r "+" rr rr rr "+" r r r "+" bb bb bb "++" rr "+" yy r "+" y r r "+" y rrr rr "+" rrrrr r "+" rr rrrr r "+" rr rrrr r "+" rrr brrrrr rr "+" rrrrrrrrrrrrr rr "+" rr rrrrrrrrrrrrrr "+" b rrrrrrrrrrrr "+" rrrrrrrrrrr "+" r b rrrrrrrrrrrr "+" rrrrrrrr r r r "+" rrrr r r r "+" r r r "+" r r r "+" bb bb bb "++" y y rrrr "+" y rrr "+" r r "+" rrr r "+" rrrrrrr r "+" rr rrrr rr "+" rr rrrr r "+" rrrr brrrrr rr "+" rr rrrrrrrrr rr "+" r b rrrrrrrrrrrrr "+" b rrrrrrrrrrr "+" rrrrrrrrrrr "+" rrrrrrrrrrr "+" r b rrr r r r "+" rr rrr r r r "+" rrrrr rr rr rr "+" r r r "+" bb bb bb "++[thorwor-shoot]++" yyy r "+" rr yy r "+" rrrr yyr "+" rr rrr rr "+" rrrrr rrrr rr "+" r r brrrr r "+" r b rrrrrrr r "+" rrrrrrr r "+" yyyyyrrrrrrr rr "+" yyyrrrrrrrrrrr "+" r b rrrrrrrrrrr "+" r rrrrrrrrrrrr "+" rr rrr rrrrrrrr "+" rrr r r r "+" r r r "+" rr rr rr "+" r r r "+" bb bb bb "++" yy r "+" rrrr y r "+" rrrrrr rr yr "+" rr rrr rr y "+" b rr brrr ry "+" y b rrrrrrr r y "+" yy rrrrrr r "+" yyyyyyrrrrrrr r "+" yyyyrrrrrrr r "+" r b yrrrrrrrrr rr "+" r rrrrrrrrrrrrr "+" rr rrrrrrrrrrrrrr "+" rrr rrrrrrrrr "+" r rr rr "+" rr r r "+" rr rr rr "+" r r r "+" bb bb bb "++" yy r "+" rrrr y rrr "+" rrrrrr rr y r r "+" rr rrr rr y r "+" b rr brrr y r "+" yy rrrrrrr y r "+" yy rrrrrr yr "+" yyyyrrrrrrr r "+" yyyrrrrrrr r "+" r b rrrrrrrrr rr "+" r rrrrrrrrrrrrr "+" rr rrrrrrrrrrrrrr "+" rrr rrrrrrrrr "+" r r r "+" r r r "+" rr rr rr "+" r r r "+" bb bb bb "++" y rrr "+" rrrr y rr r "+" rrrrrr rr yr r "+" rr rrr rr y rr "+" y b rr brrr yr "+" yy rrrrrrr y r "+" yyyy rrrrrr r "+" yyy rrrrrrr r "+" yyyrrrrrrr r "+" r b yrrrrrrrrr rr "+" r rrrrrrrrrrrrr "+" rr rrrrrrrrrrrrrr "+" rrr rrrrrrrrr "+" r rr rr "+" rr r r "+" rr rr rr "+" r r r "+" bb bb bb "++[worluk-walk]++" bb bb yy "+" yy b b yyy "+" yyy yryyyry yyy "+" yyyy yrrryrrryyyyy "+" yyyyyrrrryrrrryyyy "+" bbyyy yryyyryyyyyb "+" bbyyy yyy yyybb "+" bybbyy byb yybb b "+" b ybybbbbbyby b "+" b bbbbbbby b "+" b bbbbb b "+" bbbbb "+" bbbbb "+" bbbbbbbbb "+" b bbbbb b "+" b bbb b "+" b b b "+" bbb bbb "++" b b "+" b b "+" yryyyry "+" y yrrryrrry "+" bby rrrryrrrr yyy "+" ybyy yryyyry yyyy "+" ybbyy yyy yyyybb "+" ybybyy byb yybbbby "+" ybyybybbbbbybyybby "+" yybyybbbbbbbyyybyy "+" yybyybbbbbyyybyy "+" yyy bbbbb yyyy "+" bbbbb "+" bbbbbbbbb "+" b bbbbb b "+" b bbb b "+" b b b "+" bbb bbb "++" "+" b b "+" b b "+" yryyyry "+" yrrryrrry "+" rrrryrrrr "+" yryyyry "+" yyy yyy yyy "+" bbbbbby byb ybbbbb "+" byyyybbbbbbbyybb "+" ybyyyybbbbbyybyyy "+" yybyy bbbbb byyyy "+" yyyyy bbbbb yyyy "+" yyyybbbbbbbbbbbyyy "+" yyy b bbbbb byyy "+" yy b bbb b yy "+" b b b "+" bbbb bbbb "++[wizard-walk]++" bbbb "+" bbbbb "+" b b "+" by y bbb "+" bb bbbbb "+" bbbb bbbbbbb "+" bb bbbbb bb "+" b bbbb bb "+" bb bbbbb r "+" rr bbbbb r "+" bbbbbb "+" bbbbbbb "+" bbbbbbbbbb "+" bbbbbbbbbb "+" bbbbbbbbbb "+" bbbbbbbbbbb "+" bbbbbbbbbbb "+" bbbbbbbbbbbb "++" bbbb "+" b bbb "+" by ybb "+" bb bbbb "+" bb bbbbb "+" bbbbbbb bb "+" b bbbb bb "+" b bbbb bb "+" bb bbbbb r "+" rr bbbbbb r "+" bbbbbbb "+" bbbbbbb "+" bbbbbbbbb "+" bbbbbbbbb "+" bbbbbbbbb "+" bbbbbbbbb "+" bbbbbbbb "+" bbbbb "++" bbb "+" bbbbb "+" b bbbb "+" by bbb "+" bb bbbb "+" bb bbbbb "+" bbbbbb bb "+" bbbbb bb "+" b bbbbbbb "+" bb bbbbbr "+" rr bbbbbrr "+" bbbbbbbb "+" bbbbbbbb "+" bbbbbbbb "+" bbbbbb "+" bbbbbb "+" bbbbbbbb "+" bbbbbbbb "++" bbbb "+" b bbb "+" by ybb "+" bb bbb "+" bb bbbbb "+" bbbbbbbbb "+" bbbbbb bb "+" bb bbbb b "+" bb bbbb bb "+" rr bbbbbb r "+" bbbbbbbb r "+" bbbbbbbbb "+" bbbbbbbb "+" bbbbbbb "+" bbbbbbb "+" bbbbbbb "+" bbbbbbbbb "+" bbbbb "++[wizard-shoot]++" bbbb "+" b bb "+" r by ybb "+" rrrr bb b "+" rb b b rrrr "+" bb bbbb bbb rrb "+" bbbbbbbbbbbbrbb "+" bbbbbbbb bbbb "+" bbbb bb "+" bbbb "+" bbbbb "+" bbbbbbb "+" bbbbbbbb "+" bbbbbbbbb "+" bbbbbbbbbb "+" bbbbbbbbbb "+" bbbbbbbbbbb "+" bbbbbbbbbbbbb "++" bbb "+" bb bbb "+" by ybbb "+" b bb "+" rrrr bbbbb b "+" rr bbbbb bbbb "+" rr bbrrrrrb "+" rr bbbbb rrr "+" bbbb rr "+" bbb "+" bbbbb "+" bbbbbb "+" bbbbbbb "+" bbbbbb "+" bbbbbb "+" bbbbbbbb "+" bbbbbbbbb "+" bbbbbbbbbbbb "++" bbbb "+" bbbbbb "+" rrrbb ybbbbb "+" yy rbbbb bbb "+" rr bbbbbbbb "+" yyy rrbbbbbbbbbbb "+" rbb bbbbb "+" b bbbb "+" bbbb "+" bbbb "+" bbbbbb "+" bbbbbbb "+" bbbbbbb "+" bbbbbbb "+" bbbbbbb "+" bbbbbbbbb "+" bbbbbbbbbb "+" bbbbbbbbbbbbb "++[worrior-flash]++" rrbbbrr "+" ryrbbbr "+" rrrrbbbr "+" rbbbbbrrrr "+" rrrbbbrbbr "+" rbbbbbbb "+" r r rbbyybybb "+"rbrbrrrrrbbbyybybr "+"ybybyyyyyyyyyybbbr "+"rbrbrrryyyyyybbbbr "+" r r rrrbbbbbrbbr "+" rbbbbrrrr "+" rbbbbbr "+" rbbbbbbr "+" rbbbrrbbr "+" rbbbr rbbbr "+" rrrbbr rrbbr "+" rbbbbr rbbbbr "++" rryyyrr "+" rbryyyr "+" rrrryyyr "+" ryyyyyrrrr "+" rrryyyryyr "+" ryyyyyyy "+" r r ryybbybyy "+"ryryrrrrryyybbybyr "+"bybybbbbbbbbbbyyyr "+"ryryrrrbbbbbbyyyyr "+" r r rrryyyyyryyr "+" ryyyyrrrr "+" ryyyyyr "+" ryyyyyyr "+" ryyyrryyr "+" ryyyr ryyyr "+" rrryyr rryyr "+" ryyyyr ryyyyr "++[blue-worrior-death]++" "+" b "+"b b bb "+"bybyyyyyy bb y "+"b b yyy bbbbb "+" b bb "+" y y r "+" rbb y b "+" r y "+" b b b b "+" b ry y "+" bb y yb r "+" bbb b "+" bbb bbb "+" bb bbbb "+" bbbb bb b "+" b "+" "++[yellow-worrior-death]++" y "+"y y yy "+"ybybbbbbb yy b "+"y y bbb yyyyy "+" y yyyy "+" y yy "+" b b r "+" ryy b y "+" r b "+" y y y y "+" y rb b "+" yy b by r "+" yyy y "+" yyy yyy "+" yy yyyy "+" yyyy yy y "+" y "+" "++[common-death]++" y b "+" b r y y b "+" y b r r "+" r b b "+" y r "+" b by "+"r ry r b r "+" r b y "+" y b b y "+"b b b b "+" y y "+" r y r r "+" b b y r b "+" y r y r b "+" b y r r b "+" r y b b "+" b y "+" "++" r y "+" y b "+" y r b y "+" b y b "+" b y "+" r b r "+" y y b "+"b b r r "+" r y "+" y "+" r y r b "+" b y r b "+" b y b y "+"b r r "+" y b b r "+" r y "+" b b "+" r "++[explosion]++" "+" "+" "+" r b "+"r rr r "+" rrrrrrr r "+" rrrrrrrrr "+" rrrbrrbrrr "+"rrrrbbbbbrr "+"rrrbbbbbbrr "+" rrrrrbbbrr "+" rr rrrrr "+"b r rrr b "+" rrr "+" r "+" "+" "+" "++" b "+" b "+" bbb "+" bb b "+" bbbbbb r "+" brbbbb bb "+" bbrrrbbbbbbb "+" bbrrrrrrrrbb "+"r bbrrrrrrrrrb "+" bbbbrrrrrrrrbb "+" bbbrrrrrrrrrbb "+" bbrrrrrrrrrrbb "+" bbrrbbrrrbrrb "+" bbbbbbbbbbb "+" bb bb bb b bbb "+" b b b "+"bb b "+" "++" y "+"y y y "+" y y y "+" y y y "+" yy yyy yy y "+" yyrrrryyy y "+" yyrrrrrryyy "+" yyrrrrrrryy y "+" yyrrrrrrrryy "+" yyrrrrrrrryy "+" yyrrrrrrrryy "+" yyyrrrrrrrryy "+" y yryyyrrrry "+"y yy yyrryyy "+" yyyy yyy "+" y y "+" y "+" y "
+ dow.cabal view
@@ -0,0 +1,47 @@+Name: dow+Version: 0.1.0+Cabal-Version: >= 1.2+Synopsis: Dungeons of Wor+Category: game, reactivity, FRP+Description:++ Dungeons of Wor is a homage to the classic arcade game, Wizard of+ Wor. It uses the artwork and levels from the Astrocade version, but+ the gameplay mechanics differ from the original in several ways.+ .+ This game is also an experiment in functional reactive programming,+ so it might be a useful resource to anyone interested in this topic.+ It was coded using the simple version of Elerea, which provides+ discrete streams as first-class values.++Author: Patai Gergely+Maintainer: Patai Gergely (patai@iit.bme.hu)+Copyright: (c) 2009, Patai Gergely+License: BSD3+License-File: LICENSE+Stability: experimental+Build-Type: Simple+Extra-Source-Files:+ src/Actor.hs+ src/Game.hs+ src/GraphUtils.hs+ src/HighScore.hs+ src/Level.hs+ src/Render.hs+ src/Sprites.hs+ src/Text.hs+ src/Utils.hs+ src/Vector.hs++Data-Files:+ README+ data/charset.txt+ data/levels.txt+ data/sprites.txt++Executable dow+ Executable: dow+ HS-Source-Dirs: src+ Main-IS: Main.hs+ Build-Depends: base >= 4 && < 5, elerea >= 1.2.3, OpenGL >= 2.4, GLFW >= 0.4, array, mtl, directory+ GHC-Options: -O2
+ src/Actor.hs view
@@ -0,0 +1,117 @@+module Actor where++import Data.Array+import Data.List+import Data.Maybe+import Graphics.Rendering.OpenGL hiding (position)++import Level+import Sprites+import Vector++data Skin = Skin+ { walkAnimation :: [TextureObject]+ , shootAnimation :: [TextureObject]+ , deathAnimation :: [TextureObject]+ }++data ActorType = BlueWorrior | YellowWorrior | Burwor | Garwor | Thorwor | Worluk | Wizard+ deriving (Eq, Ord, Enum, Ix, Show)++data Action = Entering Direction Bool | Walking | Shooting | KilledBy ActorType deriving Eq++data Actor = Actor+ { actorType :: ActorType+ , position :: Vec+ , facing :: Direction+ , action :: Action+ , animation :: [TextureObject]+ , skin :: Skin+ , speed :: Int+ , animSpeed :: Int+ , tick :: Int+ }++mkActor :: Array ActorType Skin -> ActorType -> Vec -> Actor+mkActor skins atype pos =+ Actor { actorType = atype+ , position = pos+ , facing = East+ , action = Walking+ , animation = walkAnimation (skins ! atype)+ , skin = skins ! atype+ , speed = 1+ , animSpeed = 2+ , tick = 0+ }++createSkins :: SpriteStore -> Array ActorType Skin+createSkins sprites = array (BlueWorrior,Wizard)+ [(BlueWorrior,+ Skin { walkAnimation = cycle (anim "blue-worrior-walk")+ , shootAnimation = anim "blue-worrior-shoot"+ , deathAnimation = concat (replicate 5 (anim "worrior-flash")) +++ anim "blue-worrior-death" ++ anim "common-death"+ }+ )+ ,(YellowWorrior,+ Skin { walkAnimation = cycle (anim "yellow-worrior-walk")+ , shootAnimation = anim "yellow-worrior-shoot"+ , deathAnimation = concat (replicate 5 (anim "worrior-flash")) +++ anim "yellow-worrior-death" ++ anim "common-death"+ }+ )+ ,(Burwor,+ Skin { walkAnimation = cycle (anim "burwor-walk")+ , shootAnimation = anim "burwor-shoot"+ , deathAnimation = anim "explosion" ++ anim "common-death"+ }+ )+ ,(Garwor,+ Skin { walkAnimation = cycle (anim "garwor-walk")+ , shootAnimation = anim "garwor-shoot"+ , deathAnimation = anim "explosion" ++ anim "common-death"+ }+ )+ ,(Thorwor,+ Skin { walkAnimation = cycle (anim "thorwor-walk")+ , shootAnimation = anim "thorwor-shoot"+ , deathAnimation = anim "explosion" ++ anim "common-death"+ }+ )+ ,(Worluk,+ Skin { walkAnimation = cycle (anim "worluk-walk")+ , shootAnimation = []+ , deathAnimation = anim "explosion" ++ anim "common-death"+ }+ )+ ,(Wizard,+ Skin { walkAnimation = cycle (anim "wizard-walk")+ , shootAnimation = anim "wizard-shoot"+ , deathAnimation = []+ }+ )]+ where anim name = maybe (error ("Cannot find animation " ++ name)) snd+ (find ((==name).fst) sprites)++isDead :: Actor -> Bool+isDead a = case action a of+ KilledBy _ -> True+ _ -> False++isAlive :: Actor -> Bool+isAlive = not . isDead++justDied :: Actor -> Bool+justDied Actor { action = KilledBy _, animation = [_], tick = 0 } = True+justDied _ = False++actorValue :: Actor -> Int+actorValue a = case actorType a of+ Burwor -> 100+ Garwor -> 200+ Thorwor -> 500+ Worluk -> 1000+ Wizard -> 2500+ BlueWorrior -> 1000+ YellowWorrior -> 1000
+ src/Game.hs view
@@ -0,0 +1,288 @@+{-# LANGUAGE RecursiveDo #-}++module Game where++import Control.Applicative+import Control.Monad+import Control.Monad.Fix+import Data.Array+import Data.List+import Data.Maybe+import FRP.Elerea.Experimental.Simple++import Actor+import HighScore+import Level+import Sprites+import Utils+import Vector++numberOfLives = 5++data LevelState = LevelState+ { level :: Level+ , actors :: [Actor]+ , bullets :: [(ActorType,Vec)]+ , shooters :: [ActorType]+ }++keySet1 = fst+keySet2 = snd++keyDir (True,_,_,_,_) = Just North+keyDir (_,True,_,_,_) = Just South+keyDir (_,_,True,_,_) = Just West+keyDir (_,_,_,True,_) = Just East+keyDir _ = Nothing++keyShoot (_,_,_,_,s) = s++keyAny k = keyShoot k || isJust (keyDir k)++game highScore storeScore (renderGame,renderMenu) closeAction newActor levels keyPress = do+ let firstTrue s = do+ mask <- delay False =<< transfer False (||) s+ return (liftA2 (&&) (not <$> mask) s)++ mkGame 0 = playGame storeScore renderGame newActor levels keyPress 1+ mkGame 1 = playGame storeScore renderGame newActor levels keyPress 2+ mkGame _ = return (pure closeAction,pure True)++ keys <- memo (keySet1 <$> keyPress)+ (output,_) <- switcher . flip fmap highScore $ \score -> do+ (menu,pick) <- displayMenu (renderMenu score) ["ONE PLAYER GAME","TWO PLAYER GAME","QUIT"] keys+ picked <- firstTrue (keyShoot <$> keys)+ gameSource <- generator (toMaybe <$> picked <*> (mkGame <$> pick))+ fullOutput <- menu --> gameSource+ return (fst =<< fullOutput,snd =<< fullOutput)++ return output++displayMenu renderMenu items keys = do+ let val False = 0+ val True = 1++ up <- edge ((==Just North) . keyDir <$> keys)+ down <- edge ((==Just South) . keyDir <$> keys)+ item <- transfer2 0 (\u d i -> (i + val d - val u) `mod` length items) up down++ return ((renderMenu items <$> item,pure False),item)++playGame storeScore renderFun newActor levels keyPress numPlayers = mdo+ let startLevel level enemyCount = playLevel newActor keyPress level numPlayers lives' enemyCount+ players = take numPlayers [YellowWorrior,BlueWorrior]++ pickLevel cnt rnd = case () of+ _ | cnt == 4 -> findLevel (=="arena")+ _ | cnt < 8 -> findLevel ((=='b').head)+ _ | cnt `mod` 6 == 1 -> findLevel (=="pit")+ otherwise -> findLevel ((=='w').head)+ where findLevel p = pickOne (filter (p.levelName) levels)+ pickOne xs = xs !! (rnd `mod` length xs)++ accumScore player state prev = max 0 $ prev ++ (sum . map killScore . actors) state -+ 10 * (length . filter (==player) . shooters) state+ where killScore a = if justDied a && action a == KilledBy player then actorValue a else 0++ accumLives player state prev = max 0 $ prev + (sum . map lifeLost . actors) state+ where lifeLost a = if justDied a && actorType a == player then -1 else 0++ levelNoise <- noise+ (state,trigLevel) <- switcher (startLevel <$> (pickLevel <$> levelCount <*> levelNoise) <*> levelCount)+ trigLevel' <- delay False trigLevel+ levelCount <- transfer 1 (\win cnt -> if win then cnt+1 else cnt) trigLevel'+ scores <- memo =<< (sequence <$> forM players (\t -> transfer 0 (accumScore t) state))+ lives <- memo =<< (sequence <$> forM players (\t -> transfer numberOfLives (accumLives t) state))+ lives' <- delay (replicate numPlayers numberOfLives) lives++ gameOver <- memo (all (==0) <$> lives)++ return (liftA2 (>>)+ ((\c s -> when c (storeScore s)) <$> gameOver <*> scores)+ (renderFun <$> state <*> levelCount <*> scores <*> lives)+ ,gameOver+ )++playLevel newActor keyPress level numPlayers lives enemyCount = mdo+ let mkEnemy etype = enemy (newActor etype) (if etype == Worluk then 2 else 1) level bullets++ mkShot c plr = if c && canShoot+ then (:[]) <$> bullet (actorType plr) (position plr) (facing plr)+ else return []+ where canShoot = case action plr of+ Walking -> True+ Shooting -> True+ _ -> False++ spawnEnemies oldEnemies = concatMap (spawnEnemy (length oldEnemies == 1)) oldEnemies+ spawnEnemy isLast enemy = if justDied enemy then+ case actorType enemy of+ Burwor -> [mkEnemy Garwor <$> (position <$> head players)]+ Garwor -> [mkEnemy Thorwor <$> (position <$> head players)]+ Thorwor -> if isLast then [mkEnemy Worluk <$> (position <$> head players)] else []+ _ -> []+ else []++ (lw,lh) = levelSize level+ playerInit = take numPlayers [(YellowWorrior,keySet1,1),(BlueWorrior,keySet2,0)]++ (players,bulletSources) <- fmap unzip $ forM (zip playerInit [0..]) $ \((worType,keySet,pix),lix) -> do+ shoot <- edge (keyShoot . keySet <$> keyPress)++ (player,_respawn) <- switcher . flip fmap lives $ \ls -> do+ let (pedir,py,px) = entrances level !! pix+ playerInit = (newActor worType (V (px*fieldSize) ((lh-py-1)*fieldSize)))+ { action = Entering pedir False+ , facing = [East,West] !! pix+ }+ respawn plr = ls !! lix > 1 && null (animation plr)++ if ls !! lix == 0+ then return (pure (playerInit { animation = [] }),pure False)+ else do plr <- transfer3 playerInit (movePlayer level) (keyDir . keySet <$> keyPress) shoot enemies'+ return (plr, respawn <$> plr)++ bulletSource <- generator (mkShot <$> shoot <*> player)+ return (player,bulletSource)++ newBullets <- memo (concat <$> sequence bulletSources)+ bullets <- collection newBullets (notHitAnything level <$> enemies')+ let shooters = fmap (map fst) . sequence =<< newBullets++ initialEnemies <- replicateM enemyCount (mkEnemy Burwor (V (-3*fieldSize) (-3*fieldSize)))+ spawnedEnemies <- generator (sequence <$> (sequence . spawnEnemies =<< enemies'))+ enemySource <- delay initialEnemies spawnedEnemies+ enemies <- collection enemySource (pure (not . null . animation))+ enemies' <- delay [] enemies++ return (LevelState level <$> (liftA2 (++) (sequence players) enemies) <*> bullets <*> shooters+ ,null <$> enemies+ )++bullet src pos dir = fmap ((,) src) <$> stateful pos (+3*dirVec dir)++enemy newActor moveSpeed level bullets (V playerX playerY) = mdo+ let actorInit = (newActor (fromIntegral fieldSize*startPos)) { speed = moveSpeed, animSpeed = 4 }+ startPos = if abs (startX-playerX `div` fieldSize) < 3 && abs (startY-playerY `div` fieldSize) < 3+ then V ((startX + lw `div` 2) `mod` lw) ((startY + lh `div` 2) `mod` lh)+ else V startX startY+ (lw,lh) = levelSize level++ startX <- (`mod` lw) <$> getRandom+ startY <- (`mod` lh) <$> getRandom+ startDir <- toEnum . (`mod` 4) <$> getRandom+ dirNoise <- noise++ actorInput <- startDir --> newDir level <$> dirNoise <*> actor'+ actor <- transfer2 actorInit (moveEnemy level) actorInput bullets+ actor' <- delay actorInit actor+ return actor++notHitAnything lev es (_,pos@(V px py)) =+ (sy < fieldMid-bs || North `elem` legals) &&+ (sx < fieldMid-bs || East `elem` legals) &&+ (sy > -fieldMid+bs || South `elem` legals) &&+ (sx > -fieldMid+bs || West `elem` legals) &&+ not hitExplosion+ where legals = legalMovesAt lev (fieldPos pos)+ (sx,sy) = fieldSub pos+ bs = 3++ hitExplosion = any hitBy es+ hitBy e = isDead e && abs (ex-px) < fieldMid && abs (ey-py) < fieldMid+ where V ex ey = position e++newDir lev rnd act = if not (canMove lev act) then Just pickedLegalDir+ else if rnd `mod` 1000 < 992 then Nothing+ else Just (toEnum (rnd `mod` 4))+ where legal = legalMovesAt lev (fieldPos (position act))+ pickedLegalDir = legal !! (rnd `mod` length legal)++movePlayer level mov shoot enemies plr = case action plr of+ Entering dir False -> let startMoving = isJust mov+ in plr { action = Entering dir startMoving+ , position = position plr + if startMoving then dirVec dir else 0+ }+ Entering dir True -> if fieldSub (position plr) == (0,0)+ then plr { action = Walking }+ else plr { position = position plr + dirVec dir }+ _ -> case mov of+ Nothing -> if action plr' /= Walking then animate plr' else plr'+ Just dir -> animate (if isAlive plr then move level dir plr' else plr')+ where plr' = case killed of+ _ | isDead plr -> plr+ Just enemy -> plr { animation = deathAnimation (skin plr)+ , action = KilledBy (actorType enemy)+ , animSpeed = 6+ }+ _ | shoot -> plr { animation = shootAnimation (skin plr)+ , action = Shooting+ }+ otherwise -> plr+ killed = find ((==getXY plr).getXY) [enemy | enemy <- enemies, isAlive enemy]+ getXY = fieldPos.position++moveEnemy level dir bs act = animate (mv act')+ where act' = case hit of+ Just (killer,_) -> act { animation = deathAnimation (skin act)+ , action = KilledBy killer+ }+ Nothing -> act+ mv = if isAlive act' then move level dir else id+ hit = find hitBy bs+ V px py = position act+ hitBy (_,(V bx by)) = abs (bx-px) < fieldMid && abs (by-py) < fieldMid++move :: Level -> Direction -> Actor -> Actor+move lev dir ent = mv ent $ fmap snd . find fst $+ [(halfway dir || atFieldMid && dirIsLegal, dir)+ ,(not atFieldMid && dirIsLegal, dir')+ ,(halfway entDir || legalMove entDir, entDir)+ ]+ where mv e Nothing = e+ mv e (Just d) = e { position = position e + fromIntegral (speed e) * dirVec d+ , facing = d+ }++ dirIsLegal = legalMove dir+ legalMove d = d `elem` legalMovesAt lev (fieldPos (position ent))++ (sx,sy) = fieldSub (position ent)+ atFieldMid = 0 == if isVertical dir then sx else sy+ halfway d = 0 /= if isVertical d then sy else sx++ entDir = facing ent+ dir' = case entDir of+ North | sy > 0 -> South+ East | sx > 0 -> West+ South | sy < 0 -> North+ West | sx < 0 -> East+ otherwise -> entDir++canMove :: Level -> Actor -> Bool+canMove lev ent = halfway || facing ent `elem` legalMovesAt lev (fieldPos (position ent))+ where (sx,sy) = fieldSub (position ent)+ halfway = sx /= 0 || sy /= 0++legalMovesAt lev pos = legalMoves lev ! ix pos+ where ix (x,y) = (snd (levelSize lev)-1-y,x)++animate :: Actor -> Actor+animate ent = let ent' = ent { tick = (tick ent+1) `mod` animSpeed ent }+ adv = if tick ent' == 0 then 1 else 0+ animation' = drop adv (animation ent') in+ case action ent' of+ Entering _ _ -> ent'+ Walking -> ent' { animation = animation' }+ Shooting -> if null animation'+ then ent' { animation = walkAnimation (skin ent')+ , action = Walking+ }+ else ent' { animation = animation' }+ KilledBy _ -> ent' { animation = animation' }++dirVec North = V 0 1+dirVec East = V 1 0+dirVec South = V 0 (-1)+dirVec West = V (-1) 0
+ src/GraphUtils.hs view
@@ -0,0 +1,31 @@+module GraphUtils where++import Data.Word+import Foreign.Marshal+import Foreign.Ptr+import Graphics.Rendering.OpenGL++createTexture :: Int -> Int -> Bool -> (Ptr Word8 -> IO ()) -> IO TextureObject+createTexture width height looped fill = allocaArray (width*height*4) $ \tex -> do+ fill tex+ [tid] <- genObjectNames 1+ textureBinding Texture2D $= Just tid+ if looped+ then do textureWrapMode Texture2D S $= (Repeated,Repeat)+ textureWrapMode Texture2D T $= (Repeated,Repeat)+ else do textureWrapMode Texture2D S $= (Mirrored,Clamp)+ textureWrapMode Texture2D T $= (Mirrored,Clamp)+ build2DMipmaps Texture2D RGBA' (fromIntegral width) (fromIntegral height) (PixelData RGBA UnsignedByte tex)+ return tid++vertex3 :: GLfloat -> GLfloat -> GLfloat -> IO ()+vertex3 x y z = vertex $ Vertex3 x y z++texCoord2 :: GLfloat -> GLfloat -> IO ()+texCoord2 x y = texCoord $ TexCoord2 x y++explodeList :: Int -> [a] -> [a]+explodeList = concatMap . replicate++explodeMatrix :: Int -> [[a]] -> [[a]]+explodeMatrix n = map (explodeList n) . explodeList n
+ src/HighScore.hs view
@@ -0,0 +1,36 @@+module HighScore where++import Control.Monad+import System.Directory+import System.IO++loadScore :: IO Int+loadScore = do+ dir <- getAppDir++ let fileName = dir ++ "/highscore"+ fileChk <- doesFileExist fileName+ unless fileChk $ do+ hdl <- openFile fileName WriteMode+ hPutStr hdl "0"+ hClose hdl++ hdl <- openFile fileName ReadMode+ score <- hGetLine hdl+ hClose hdl++ return (read score)++saveScore :: Int -> IO ()+saveScore score = do+ dir <- getAppDir+ hdl <- openFile (dir ++ "/highscore") WriteMode+ hPutStr hdl (show score)+ hClose hdl++getAppDir :: IO FilePath+getAppDir = do+ dir <- getAppUserDataDirectory "dow"+ dirChk <- doesDirectoryExist dir+ unless dirChk $ createDirectory dir+ return dir
+ src/Level.hs view
@@ -0,0 +1,86 @@+module Level where++import Control.Monad.Error+import Data.Array+import Data.List++import Vector++data Level = Level+ { levelName :: String+ , levelSize :: (Int,Int)+ , legalMoves :: Array (Int,Int) [Direction]+ , doors :: [(Direction,Int)]+ , entrances :: [(Direction,Int,Int)]+ } deriving Show++data Direction = North | East | South | West+ deriving (Eq, Enum, Show)++fieldSize :: Int+fieldSize = 16++fieldMid :: Int+fieldMid = fieldSize `div` 2++fieldPos :: Vec -> (Int,Int)+fieldPos (V x y) = ((x+fieldMid) `div` fieldSize, (y+fieldMid) `div` fieldSize)++fieldSub :: Vec -> (Int,Int)+fieldSub (V x y) = (mkSub x, mkSub y)+ where mkSub c = let s = c `mod` fieldSize in if s >= fieldMid then s-fieldSize else s++dirFromInt :: Int -> Direction+dirFromInt = toEnum . (`mod` 4)++turnRight :: Direction -> Direction+turnRight = dirFromInt . (+1) . fromEnum++turnBack :: Direction -> Direction+turnBack = dirFromInt . (+2) . fromEnum++turnLeft :: Direction -> Direction+turnLeft = dirFromInt . (+3) . fromEnum++isVertical :: Direction -> Bool+isVertical North = True+isVertical South = True+isVertical _ = False++parseLevel :: [String] -> Either String (Level,[String])+parseLevel lines = do+ let lines' = dropWhile null lines+ nameLine = head lines'+ (mazeLines,rest) = span (not . null) (tail lines')+ width = length (head mazeLines) `div` 2+ height = length mazeLines `div` 2++ mkEntrance (North,x) = (South,-1,x)+ mkEntrance (South,x) = (North,height,x)+ mkEntrance (East,y) = (West,y,width)+ mkEntrance (West,y) = (East,y,-1)++ makeMoves lines = concat . odds $ zipWith3 f lines (tail lines) (tail (tail lines))+ where f n c s = odds $ zipWith4 f' (tail n) (tail s) c (tail (tail c))+ f' n s w e = (if n == ' ' then [North] else []) +++ (if s == ' ' then [South] else []) +++ (if w == ' ' then [West] else []) +++ (if e == ' ' then [East] else [])++ odds (x:_:xs) = x : odds xs+ odds xs = xs++ chars `onEdgeOf` lines =+ [(d,i `div` 2) |+ (d,f) <- [(North,head),(South,last),(West,map head),(East,map last)],+ i <- findIndices (`elem` chars) (f lines)]++ when (null lines' || length mazeLines < 3) $ fail "Nothing to parse"+ when (head nameLine /= '"') $ fail "Missing level name"++ return (Level { levelName = takeWhile (/= '"') (tail nameLine)+ , levelSize = (width,height)+ , legalMoves = listArray ((0,0),(height-1,width-1)) (makeMoves mazeLines)+ , doors = "<>^v" `onEdgeOf` mazeLines+ , entrances = map mkEntrance ("*" `onEdgeOf` mazeLines)+ }, rest)
+ src/Main.hs view
@@ -0,0 +1,94 @@+module Main where++import Control.Applicative+import Control.Monad+import Control.Monad.Fix+import Data.IORef+import FRP.Elerea.Experimental.Simple+import Graphics.UI.GLFW+import Graphics.Rendering.OpenGL++import Actor+import Game+import HighScore+import Level+import Render+import Sprites+import Text++import Paths_dow (getDataFileName)++main = do+ initialize+ openWindow (Size 640 480) [DisplayRGBBits 8 8 8, DisplayAlphaBits 8, DisplayDepthBits 24] Window+ windowTitle $= "Dungeons of Wor"++ aspectRatio <- newIORef 1+ levels <- loadLevels =<< getDataFileName "data/levels.txt"+ sprites <- loadSprites =<< getDataFileName "data/sprites.txt"+ charset <- loadCharset =<< getDataFileName "data/charset.txt"+ render <- getRenderFunctions aspectRatio charset++ let skins = createSkins sprites+ newActor = mkActor skins++ windowSizeCallback $= setViewport aspectRatio++ closed <- newIORef False+ let closeAction = writeIORef closed True+ windowCloseCallback $= closeAction++ clearColor $= Color4 0 0 0 1+ blend $= Enabled+ blendFunc $= (SrcAlpha,OneMinusSrcAlpha)+ textureFilter Texture2D $= ((Linear',Just Nearest),Linear')+ textureFunction $= Combine4++ let noKeys = (False,False,False,False,False)+ (keyPress,keySink) <- external (noKeys,noKeys)+ (highScore,highScoreSink) <- external =<< loadScore+ let storeScore scores = do+ oldScore <- loadScore+ let newScore = maximum (oldScore:scores)+ saveScore newScore+ highScoreSink newScore++ renderAction <- start $ game highScore storeScore render closeAction newActor levels keyPress++ fix $ \loop -> do+ readKeys keySink+ join renderAction+ sleep 0.02+ stop <- readIORef closed+ esc <- getKey ESC+ when (not stop && esc /= Press) loop++ closeWindow++loadLevels file = do+ dat <- lines <$> readFile file+ let levels = parseLevels dat+ parseLevels dat = case parseLevel dat of+ Left _ -> []+ Right (l,dat') -> l : parseLevels dat'++ return levels++loadSprites file = do+ dat <- lines <$> readFile file+ parseSprites dat++readKeys sink = do+ let pr = (==Press)+ kn1 <- getKey UP+ ks1 <- getKey DOWN+ kw1 <- getKey LEFT+ ke1 <- getKey RIGHT+ kt1 <- getKey RCTRL+ kn2 <- getKey 'W'+ ks2 <- getKey 'S'+ kw2 <- getKey 'A'+ ke2 <- getKey 'D'+ kt2 <- getKey LCTRL+ sink ((pr kn1, pr ks1, pr kw1, pr ke1, pr kt1),+ (pr kn2, pr ks2, pr kw2, pr ke2, pr kt2))
+ src/Render.hs view
@@ -0,0 +1,251 @@+module Render+ ( getAspectRatio+ , getRenderFunctions+ , setViewport+ ) where++import Control.Monad+import Data.Array+import Data.Char+import Data.IORef+import Foreign.Marshal+import Graphics.UI.GLFW+import Graphics.Rendering.OpenGL hiding (position)++import Actor as A+import Game+import GraphUtils+import Level+import Text+import Vector++hudHeight = 0.2++solid :: GLfloat+solid = 1++fullLevelSize = addBorder . levelSize+ where addBorder (w,h) = (w+2,h+2)++getAspectRatio level = fromIntegral lh / fromIntegral lw + hudHeight+ where (lw,lh) = fullLevelSize level++setViewport ref size@(Size w h) = do+ lr <- readIORef ref++ let r = (fromIntegral h/fromIntegral w)+ r' = recip r+ lr' = recip lr+ s = 2*min (max 1 (min lr' r')) (max (r/lr) lr')++ viewport $= (Position 0 0,size)++ matrixMode $= Projection+ loadIdentity+ scale (s*min 1 r) (s*min 1 r') (1 :: GLfloat)+ translate $ Vector3 (-0.5) (-0.5*lr) (0 :: GLfloat)++ matrixMode $= Modelview 0++setAspectRatio ref val = do+ writeIORef ref val+ setViewport ref =<< get windowSize++getRenderFunctions aspectRatio charset = do+ let displayText = uncurry displayString charset++ rgbOverlay <- createTexture 24 24 True $ flip pokeArray $+ concat [if b then [95,95,95,255] else c | y <- [0..23], x <- [0..23],+ let c = case x `div` 4 `mod` 3 of+ 0 -> [255,191,191,255]+ 1 -> [191,255,191,255]+ 2 -> [191,191,255,255]+ b = x `mod` 4 == 0 || x < 12 && y `mod` 12 == 0 || x >= 12 && y `mod` 12 == 6+ ]++ return (renderGame aspectRatio displayText rgbOverlay+ ,renderMenu aspectRatio displayText rgbOverlay+ )++renderMenu aspectRatio displayText rgbOverlay score items item = do+ let charSize = 0.006+ textCol = Color4 1 0 0 solid+ activeCol = Color4 0.93 0.79 0 solid+ menu = "DUNGEONS OF WOR":"":"":items++["","","HIGH SCORE "++show score]++ setAspectRatio aspectRatio 1++ clear [ColorBuffer]+ loadIdentity++ texture Texture2D $= Enabled+ forM_ (zip menu [-3..]) $ \(text,i) -> do+ color $ if i == item then activeCol else textCol+ displayText (0.5-(fromIntegral (length text)*4*charSize))+ (0.5+charSize*(7*fromIntegral (length items-1-2*i)))+ charSize text++ renderOverlay rgbOverlay++ flush+ swapBuffers++renderGame aspectRatio displayText rgbOverlay levelState levelCount scores lives = do+ let curLevel = level levelState+ (lw,lh) = fullLevelSize curLevel+ height = fromIntegral lh / fromIntegral lw+ magn = 1 / fromIntegral lw++ setAspectRatio aspectRatio (getAspectRatio curLevel)++ clear [ColorBuffer]+ loadIdentity++ renderHud displayText height scores lives (actors levelState) levelCount curLevel+ preservingMatrix $ do+ translate $ Vector3 0 hudHeight (0 :: GLfloat)+ scale magn magn (1 :: GLfloat)++ renderLevel curLevel+ renderBullets (bullets levelState)+ renderActors (actors levelState)++ renderOverlay rgbOverlay++ flush+ swapBuffers++renderOverlay rgbOverlay = do+ texture Texture2D $= Enabled+ textureBinding Texture2D $= Just rgbOverlay+ blendFunc $= (Zero,SrcColor)+ color $ Color4 1 1 1 solid+ let pscale = 100+ renderPrimitive Quads $ do+ texCoord2 0 0+ vertex3 0 0 0+ texCoord2 pscale 0+ vertex3 1 0 0+ texCoord2 pscale pscale+ vertex3 1 1 0+ texCoord2 0 pscale+ vertex3 0 1 0+ blendFunc $= (SrcAlpha,OneMinusSrcAlpha)++renderLevel level = do+ let (lw,lh) = fullLevelSize level+ height = fromIntegral lh / fromIntegral lw+ entries = [((y,x),[]) | (_,y,x) <- entrances level]++ texture Texture2D $= Disabled+ color $ Color4 0.2 0.5 1 solid+ forM_ (entries ++ assocs (legalMoves level)) $ \((y,x),ms) -> do+ let xc = fromIntegral (x+1)+ yc = fromIntegral (lh-y-2)+ unless (North `elem` ms) $ drawRectangle xc (yc+0.95) 1 0.05+ unless (South `elem` ms) $ drawRectangle xc yc 1 0.05+ unless (East `elem` ms) $ drawRectangle (xc+0.95) yc 0.05 1+ unless (West `elem` ms) $ drawRectangle xc yc 0.05 1++renderActors as = do+ let players = filter ((`elem` [BlueWorrior,YellowWorrior]) . actorType) as+ texture Texture2D $= Enabled+ color $ Color4 1 1 1 solid+ forM_ as $ \a -> do+ let V x y = A.position a+ x' = fromIntegral x / fromIntegral fieldSize+ y' = fromIntegral y / fromIntegral fieldSize+ dist = case actorType a of+ Garwor -> 2*fieldSize+ Thorwor -> fieldSize+ _ -> maxBound+ visible = any ((\(V px py) -> abs (x-px) < dist || abs (y-py) < dist) . A.position) players++ when (visible && (not . null . animation) a) $+ drawSprite (head (animation a)) (1.1+x') (1.1+y') 0.8 0.8 (facing a)++renderBullets bs = do+ texture Texture2D $= Disabled+ color $ Color4 1 0.3 0.1 solid+ forM_ bs $ \(_,V x y) -> do+ let x' = fromIntegral x / fromIntegral fieldSize+ y' = fromIntegral y / fromIntegral fieldSize+ drawRectangle (1.45+x') (1.45+y') 0.1 0.1++renderHud displayText height scores lives actors levelCount level = do+ let r = Color4 1 0 0 solid+ b = Color4 0.25 0.63 1 solid+ y = Color4 0.93 0.79 0 solid+ d = Color4 0 0 0 solid+ charSize = 0.0028+ radarTitle = if levelCount == 1 then "RADAR" else+ case levelName level of+ "pit" -> "THE PIT"+ "arena" -> "THE ARENA"+ _ -> "DUNGEON " ++ show levelCount+ (levelW,levelH) = levelSize level+ scoreB = hudHeight / 4+ scoreW = 0.3+ scoreH = scoreB*3+ radarB = charSize+ radarW = radarF*fromIntegral levelW+ radarH = hudHeight-radarB*4-charSize*10+ radarF = radarH/fromIntegral levelH+ snum1 = show (scores !! 0)+ snum2 = show (scores !! 1)+ lnum1 = show (lives !! 0)+ lnum2 = show (lives !! 1)+ numPlayers = length lives++ texture Texture2D $= Disabled+ color b+ drawRectangle 0 0 scoreW scoreH+ drawRectangle (0.5-radarW/2-radarB) 0 (radarW+radarB*2) (radarH+radarB*2)+ color y+ drawRectangle (1-scoreW) 0 scoreW scoreH+ color d+ drawRectangle scoreB scoreB (scoreW-2*scoreB) (scoreH-2*scoreB)+ drawRectangle (1-scoreW+scoreB) scoreB (scoreW-2*scoreB) (scoreH-2*scoreB)+ drawRectangle (0.5-radarW/2) radarB radarW radarH+ forM_ actors $ \actor -> do+ let (fx,fy) = fieldPos (position actor)+ rx = 0.5-radarW/2+radarF*fromIntegral fx+ ry = radarB+radarF*fromIntegral fy+ case actorType actor of+ Burwor -> color b >> drawRectangle rx ry radarF radarF+ Garwor -> color y >> drawRectangle rx ry radarF radarF+ Thorwor -> color r >> drawRectangle rx ry radarF radarF+ _ -> return ()++ texture Texture2D $= Enabled+ color y+ displayText (1-scoreB-(fromIntegral (length snum1)*8*charSize)) (scoreB+scoreH/2-scoreB-5*charSize) charSize snum1+ displayText (1-scoreW-3*radarB-(fromIntegral (length lnum1)*8*charSize)) (scoreB+scoreH/2-scoreB-5*charSize) charSize lnum1+ when (numPlayers > 1) $ do+ color b+ displayText (scoreW-scoreB-(fromIntegral (length snum2)*8*charSize)) (scoreB+scoreH/2-scoreB-5*charSize) charSize snum2+ displayText (scoreW+3*radarB) (scoreB+scoreH/2-scoreB-5*charSize) charSize lnum2+ color r+ displayText (0.5-(fromIntegral (length radarTitle)*4*charSize)) (radarH+radarB*3) charSize radarTitle++drawRectangle :: GLfloat -> GLfloat -> GLfloat -> GLfloat -> IO ()+drawRectangle x y sx sy = renderPrimitive Quads $ mapM_ vertex+ [Vertex3 x y 0, Vertex3 (x+sx) y 0, Vertex3 (x+sx) (y+sy) 0, Vertex3 x (y+sy) 0]++drawSprite :: TextureObject -> GLfloat -> GLfloat -> GLfloat -> GLfloat -> Direction -> IO ()+drawSprite tid x y sx sy dir = do+ let (u1,v1,u2,v2,u3,v3,u4,v4) = case dir of+ North -> (1,1,1,0,0,0,0,1)+ East -> (1,1,0,1,0,0,1,0)+ South -> (0,1,0,0,1,0,1,1)+ West -> (0,1,1,1,1,0,0,0)+ textureBinding Texture2D $= Just tid+ renderPrimitive Quads $ do+ texCoord2 u1 v1+ vertex3 x y 0+ texCoord2 u2 v2+ vertex3 (x+sx) y 0+ texCoord2 u3 v3+ vertex3 (x+sx) (y+sy) 0+ texCoord2 u4 v4+ vertex3 x (y+sy) 0
+ src/Sprites.hs view
@@ -0,0 +1,64 @@+module Sprites+ ( SpriteStore+ , parseSprites+ , explodeMatrix+ ) where++import Control.Applicative+import Control.Monad.Fix+import Control.Monad+import Data.Array+import Data.Word+import Foreign.Marshal+import Foreign.Ptr+import Graphics.Rendering.OpenGL++import GraphUtils++type SpriteStore = [(String, [TextureObject])]++parseSprites :: [String] -> IO SpriteStore+parseSprites dat = do+ let (coldat,sprdat) = span (\l -> not (null l) && (head l /= '[')) dat+ colmap :: Array Char [Word8]+ colmap = listArray (' ','~') (repeat [0,0,0,0]) // map mkcol coldat+ mkcol (c:dat) = (c,[r,g,b,a])+ where [(r,dat')] = reads dat+ [(g,dat'')] = reads dat'+ [(b,dat''')] = reads dat''+ [(a,dat'''')] = reads dat'''++ flip fix sprdat $ \addGroup dat ->+ createSpriteGroup colmap dat >>= \res -> case res of+ Just (name,g,dat') -> do+ gs <- addGroup dat'+ return ((name,g):gs)+ Nothing -> return []++createSpriteGroup colmap dat = do+ let dat' = dropWhile null dat+ gname = takeWhile (/=']') (tail (head dat'))++ if null dat'+ then return Nothing+ else do+ (sps,dat'') <- flip fix (tail dat',[]) $ \addSprites (dat,tids) ->+ createSprite colmap dat >>= \res -> case res of+ Just (tid,dat') -> do+ addSprites (dat',tid:tids)+ Nothing -> return (tids,dat)+ return (Just (gname,reverse sps,dat''))++createSprite colmap dat = do+ let dat' = dropWhile null dat++ if null dat' || head (head dat') /= '"'+ then return Nothing+ else do+ let (spdat,dat'') = span (\l -> not (null l) && (head l == '"')) dat'+ spdat' = explodeMatrix 3 (map (takeWhile (/='"') . tail) spdat)+ spw = length (head spdat')+ sph = length spdat'++ tid <- createTexture spw sph False $ flip pokeArray [comp | lin <- spdat', pix <- lin, comp <- colmap ! pix]+ return (Just (tid,dat''))
+ src/Text.hs view
@@ -0,0 +1,57 @@+module Text+ ( loadCharset+ , displayString+ ) where++import Control.Applicative+import Control.Monad+import Data.Array+import Data.List+import Data.Word+import Foreign.Marshal+import Foreign.Ptr+import Graphics.Rendering.OpenGL++import GraphUtils++loadCharset file = do+ dat <- lines <$> readFile file+ let cs = unfoldr parseChar dat+ cpos = map (\n -> (n `mod` 8,n `div` 8)) [0..]+ cdat = array (' ','Z') (zip (map fst cs) cpos)++ mkpix '#' = [255,255,255,255]+ mkpix _ = [255,255,255,0]++ tid <- createTexture 256 256 False $ \tex -> do+ pokeArray tex $ concat (replicate (256*256) [255,255,255,0])+ forM_ (zip cs cpos) $ \((_,cimg),(x,y)) -> do+ forM_ (zip cimg [0..]) $ \(crow,ry) -> pokeArray (advancePtr tex ((x*32+1)*4+(y*32+1+ry)*256*4)) (concatMap mkpix crow)++ return (tid,cdat)++parseChar dat = if null dat' then Nothing else Just ((c,explodeMatrix 3 img),dat'')+ where dat' = dropWhile null dat+ c = head (head dat')+ (img,dat'') = span (not . null) (tail dat')++displayString tid cdat x y m s = do+ textureBinding Texture2D $= Just tid++ let displayChar c x = do+ let (cx,cy) = cdat ! c+ u = fromIntegral (cx*32+1)/256+ v = fromIntegral (cy*32+1)/256+ texCoord2 u (v+ch)+ vertex3 x y 0+ texCoord2 (u+cw) (v+ch)+ vertex3 (x+8*m) y 0+ texCoord2 (u+cw) v+ vertex3 (x+8*m) (y+10*m) 0+ texCoord2 u v+ vertex3 x (y+10*m) 0+ cw = 24/256+ ch = 30/256++ renderPrimitive Quads $ forM_ (zip s [0..]) $ \(c,i) ->+ displayChar c (x+i*8*m)
+ src/Utils.hs view
@@ -0,0 +1,42 @@+{-# LANGUAGE RecursiveDo #-}++module Utils where++import Control.Applicative+import Control.Monad+import Control.Monad.Fix+import Data.Maybe+import Data.Traversable hiding (sequence)+import FRP.Elerea.Experimental.Simple++infix 2 -->++transfer2 x0 f s1 s2 = mfix $ \sig -> liftA3 f s1 s2 <$> delay x0 sig++transfer3 x0 f s1 s2 s3 = mfix $ \sig -> liftM4 f s1 s2 s3 <$> delay x0 sig++transfer4 x0 f s1 s2 s3 s4 = mfix $ \sig -> liftM5 f s1 s2 s3 s4 <$> delay x0 sig++edge s = do+ s' <- delay False s+ return $ s' >>= \x -> if x then return False else s++x0 --> s = transfer x0 store s+ where store Nothing x = x+ store (Just x) _ = x++collection source isAlive = mdo+ sig <- delay [] (map snd <$> collWithVals')+ coll <- memo (liftA2 (++) source sig)+ let collWithVals = zip <$> (sequence =<< coll) <*> coll+ collWithVals' <- memo (filter <$> ((.fst) <$> isAlive) <*> collWithVals)+ return $ map fst <$> collWithVals'++switcher gen = mdo+ trig <- memo (snd =<< pw)+ trig' <- delay True trig+ ss <- generator (toMaybe <$> trig' <*> gen)+ pw <- undefined --> ss+ return (fst =<< pw,trig)++toMaybe b s = if b then Just <$> s else pure Nothing
+ src/Vector.hs view
@@ -0,0 +1,11 @@+module Vector where++data Vec = V !Int !Int deriving (Show, Eq)++instance Num Vec where+ V x1 y1 + V x2 y2 = V (x1+x2) (y1+y2)+ V x1 y1 - V x2 y2 = V (x1-x2) (y1-y2)+ V x1 y1 * V x2 y2 = V (x1*x2) (y1*y2)+ abs (V x y) = V (abs x) (abs y)+ signum (V x y) = V (signum x) (signum y)+ fromInteger x = V (fromInteger x) (fromInteger x)