Compare commits
No commits in common. "master" and "gh-pages" have entirely different histories.
11
.gitignore
vendored
11
.gitignore
vendored
@ -1,11 +0,0 @@
|
|||||||
/.dist-buildwrapper
|
|
||||||
/.project
|
|
||||||
/.settings
|
|
||||||
.cabal-sandbox
|
|
||||||
*.trace
|
|
||||||
cabal.sandbox.config
|
|
||||||
deps/hsSDL2*
|
|
||||||
deps/*.deb
|
|
||||||
dist/*
|
|
||||||
*.swp
|
|
||||||
|
|
||||||
@ -1,4 +0,0 @@
|
|||||||
#!/bin/bash
|
|
||||||
cd deps
|
|
||||||
./getDeps.sh ni #non-interactively..
|
|
||||||
cd ..
|
|
||||||
@ -1,2 +0,0 @@
|
|||||||
language: haskell
|
|
||||||
before_install: sh .travis.prepare.sh
|
|
||||||
30
COMPILING
30
COMPILING
@ -1,30 +0,0 @@
|
|||||||
# on ubuntu14.04 (trusty) and later
|
|
||||||
|
|
||||||
just run
|
|
||||||
> ./build.sh
|
|
||||||
|
|
||||||
# manual installation
|
|
||||||
|
|
||||||
set up external dependencies:
|
|
||||||
|
|
||||||
> sudo apt-get install libsdl2-dev libsdl2-ttf-dev libsdl2-image-dev libsdl2-mixer-dev
|
|
||||||
> cd deps && ./getDeps.sh && cd ..
|
|
||||||
|
|
||||||
NOTE: ubuntu saucy currently only has libsdl2-dev.2.0.0 in the repositories, but we need libsdl2-dev.2.0.1
|
|
||||||
Therefore the update-script gets the updated packages for trusty (which have the same dependencies)
|
|
||||||
and installs them.
|
|
||||||
PIONEERS WONT RUN WITH VERSION 2.0.0 OF LIBSDL2!
|
|
||||||
|
|
||||||
make sure the compiled files are in your PATH (e.g. include $HOME/.cabal/bin in your $PATH)
|
|
||||||
|
|
||||||
install dependencies & configure app
|
|
||||||
> cabal sandbox init
|
|
||||||
> cabal sandbox add-source deps/hsSDL2
|
|
||||||
> cabal sandbox add-source deps/hsSDL2-ttf
|
|
||||||
> cabal install --only-dependencies
|
|
||||||
> cabal configure
|
|
||||||
|
|
||||||
build
|
|
||||||
> cabal build
|
|
||||||
|
|
||||||
run ./Pioneers (symlinked to dist/build/Pioneers/Pioneers)
|
|
||||||
@ -1,81 +0,0 @@
|
|||||||
name: Pioneers
|
|
||||||
version: 0.1
|
|
||||||
cabal-version: >= 1.16
|
|
||||||
build-type: Simple
|
|
||||||
author: sdressel
|
|
||||||
|
|
||||||
executable Pioneers
|
|
||||||
hs-source-dirs: src
|
|
||||||
if os(windows) {
|
|
||||||
ghc-options: -Wall -Odph -rtsopts -threaded -fno-liberate-case -funfolding-use-threshold1000 -funfolding-keeness-factor1000 -optlo-O3
|
|
||||||
} else {
|
|
||||||
ghc-options: -Wall -Odph -rtsopts -threaded -fno-liberate-case -funfolding-use-threshold1000 -funfolding-keeness-factor1000 -optlo-O3 -fllvm
|
|
||||||
}
|
|
||||||
other-modules:
|
|
||||||
Map.Map,
|
|
||||||
Map.Types,
|
|
||||||
Map.Graphics,
|
|
||||||
Map.Creation,
|
|
||||||
Importer.IQM.Types,
|
|
||||||
Importer.IQM.Parser,
|
|
||||||
Render.Misc,
|
|
||||||
Render.Render,
|
|
||||||
Render.RenderObject,
|
|
||||||
Render.Types,
|
|
||||||
UI.Callbacks,
|
|
||||||
Types
|
|
||||||
main-is: Main.hs
|
|
||||||
build-depends:
|
|
||||||
base >=4.6,
|
|
||||||
OpenGL >=2.9,
|
|
||||||
bytestring >=0.10,
|
|
||||||
OpenGLRaw >=1.4,
|
|
||||||
text >=0.11,
|
|
||||||
array >=0.4,
|
|
||||||
random >=1.0.1,
|
|
||||||
transformers >=0.3.0,
|
|
||||||
unordered-containers >= 0.2.1,
|
|
||||||
hashable >= 1.0.1.1,
|
|
||||||
mtl >=2.1.2,
|
|
||||||
stm >=2.4.2,
|
|
||||||
vector >=0.10.9 && <0.11,
|
|
||||||
distributive >=0.3.2,
|
|
||||||
linear >=1.3.1,
|
|
||||||
lens >=4.0,
|
|
||||||
SDL2 >= 0.1.0,
|
|
||||||
time >=1.4.0,
|
|
||||||
GLUtil >= 0.7,
|
|
||||||
attoparsec >= 0.11.2,
|
|
||||||
attoparsec-binary >= 0.1
|
|
||||||
Default-Language: Haskell2010
|
|
||||||
|
|
||||||
test-suite MapTests
|
|
||||||
type: exitcode-stdio-1.0
|
|
||||||
hs-source-dirs: tests/Map, src
|
|
||||||
main-is: MapTestSuite.hs
|
|
||||||
build-depends: base,
|
|
||||||
OpenGL >=2.9,
|
|
||||||
bytestring >=0.10,
|
|
||||||
OpenGLRaw >=1.4,
|
|
||||||
text >=0.11,
|
|
||||||
array >=0.4,
|
|
||||||
random >=1.0.1,
|
|
||||||
transformers >=0.3.0,
|
|
||||||
unordered-containers >= 0.2.1,
|
|
||||||
hashable >= 1.0.1.1,
|
|
||||||
mtl >=2.1.2,
|
|
||||||
stm >=2.4.2,
|
|
||||||
vector >=0.10.9 && <0.11,
|
|
||||||
distributive >=0.3.2,
|
|
||||||
linear >=1.3.1,
|
|
||||||
lens >=4.0,
|
|
||||||
SDL2 >= 0.1.0,
|
|
||||||
time >=1.4.0,
|
|
||||||
GLUtil >= 0.7,
|
|
||||||
attoparsec >= 0.11.2,
|
|
||||||
attoparsec-binary >= 0.1,
|
|
||||||
QuickCheck,
|
|
||||||
test-framework,
|
|
||||||
test-framework-th,
|
|
||||||
test-framework-quickcheck2
|
|
||||||
Default-Language: Haskell2010
|
|
||||||
30
README.md
30
README.md
@ -1,30 +0,0 @@
|
|||||||
# Pioneers
|
|
||||||
|
|
||||||
A Settlers II inspired game written in Haskell
|
|
||||||
|
|
||||||
## Development-Status
|
|
||||||
|
|
||||||
Bugtracker/Wiki: http://redmine.pwning.de/projects/pioneers
|
|
||||||
|
|
||||||
## Compiling
|
|
||||||
|
|
||||||
1. Clone this repository
|
|
||||||
2. install libraries `sudo apt-get install libsdl2 libsdl2-dev libghc-llvm-dev` - make sure libsdl2 is in version 2.0.1+ (shipped with Ubuntu since 14.04)
|
|
||||||
3. run `./build.sh`
|
|
||||||
4. run `./Pioneers`
|
|
||||||
|
|
||||||
The script sets up a cabal sandbox, downloads some libraries and compiles them. Only tested under Ubuntu 14.04. Won't work with Ubuntu < 14.04 due to lacking libraries (libsdl2)
|
|
||||||
|
|
||||||
## Features
|
|
||||||
|
|
||||||
Note, that most of it is just planned and due to change.
|
|
||||||
|
|
||||||
- modern OpenGL3.x-Engine
|
|
||||||
- themeable with different Cultures
|
|
||||||
- rock-solid Multiplayer (no desync, just slightly more lag in case of resync)
|
|
||||||
|
|
||||||
## Why Haskell?
|
|
||||||
|
|
||||||
- There are not enough good games written in functional languages.
|
|
||||||
- More robust and easier to reason about lateron
|
|
||||||
|
|
||||||
12
build.sh
12
build.sh
@ -1,12 +0,0 @@
|
|||||||
#!/bin/bash
|
|
||||||
cabal sandbox init
|
|
||||||
|
|
||||||
cd deps
|
|
||||||
./getDeps.sh
|
|
||||||
cd ..
|
|
||||||
|
|
||||||
cabal sandbox add-source deps/hsSDL2
|
|
||||||
cabal sandbox add-source deps/hsSDL2-ttf
|
|
||||||
cabal install --only-dependencies
|
|
||||||
cabal configure
|
|
||||||
cabal build
|
|
||||||
84
deps/getDeps.sh
vendored
84
deps/getDeps.sh
vendored
@ -1,84 +0,0 @@
|
|||||||
#!/bin/bash
|
|
||||||
|
|
||||||
if [ "$1" != "ni" ]
|
|
||||||
then
|
|
||||||
if [ ! -f /usr/bin/dialog ]
|
|
||||||
then
|
|
||||||
sudo apt-get install dialog
|
|
||||||
fi
|
|
||||||
dialog --yesno "Install libSDL2 from ubuntu trusty repositories?\n\nSAUCY IS NOT SUPPORTED! You NEED Ubuntu 14.04+\n\nThe script will try to install the trusty-packages." 20 75
|
|
||||||
install=${?}
|
|
||||||
else
|
|
||||||
install=0
|
|
||||||
fi
|
|
||||||
|
|
||||||
if [[ $install -eq 0 ]]
|
|
||||||
then
|
|
||||||
sudo apt-get install libsdl2-dev libsdl2-ttf-dev libsdl2-image-dev libsdl2-mixer-dev
|
|
||||||
fi
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
echo "cloning repositories"
|
|
||||||
if [ ! -d "hsSDL2" ]
|
|
||||||
then
|
|
||||||
git clone https://github.com/Lemmih/hsSDL2 hsSDL2
|
|
||||||
else
|
|
||||||
cd hsSDL2
|
|
||||||
git pull
|
|
||||||
cd ..
|
|
||||||
fi
|
|
||||||
|
|
||||||
if [ ! -d "hsSDL2-ttf" ]
|
|
||||||
then
|
|
||||||
git clone https://github.com/osa1/hsSDL2-ttf hsSDL2-ttf
|
|
||||||
else
|
|
||||||
cd hsSDL2-ttf
|
|
||||||
git pull
|
|
||||||
cd ..
|
|
||||||
fi
|
|
||||||
|
|
||||||
if [ ! -d "hsSDL2-mixer" ]
|
|
||||||
then
|
|
||||||
git clone https://github.com/jdeseno/hs-sdl2-mixer hsSDL2-mixer
|
|
||||||
else
|
|
||||||
cd hsSDL2-mixer
|
|
||||||
git pull
|
|
||||||
cd ..
|
|
||||||
fi
|
|
||||||
|
|
||||||
if [ ! -d "hsSDL2-image" ]
|
|
||||||
then
|
|
||||||
git clone https://github.com/jdeseno/hs-sdl2-image hsSDL2-image
|
|
||||||
else
|
|
||||||
cd hsSDL2-image
|
|
||||||
git pull
|
|
||||||
cd ..
|
|
||||||
fi
|
|
||||||
|
|
||||||
|
|
||||||
echo "trying to build"
|
|
||||||
|
|
||||||
cabal install haddock
|
|
||||||
|
|
||||||
echo "building hsSDL2.."
|
|
||||||
|
|
||||||
cd hsSDL2
|
|
||||||
cabal sandbox delete
|
|
||||||
cabal sandbox init
|
|
||||||
cabal install --only-dependencies
|
|
||||||
cabal build
|
|
||||||
cd ..
|
|
||||||
|
|
||||||
for t in "hsSDL2-ttf" "hsSDL2-mixer" "hsSDL2-image"
|
|
||||||
do
|
|
||||||
echo "building ${t}.."
|
|
||||||
cd "${t}"
|
|
||||||
cabal sandbox delete
|
|
||||||
cabal sandbox init
|
|
||||||
cabal sandbox add-source ../hsSDL2
|
|
||||||
cabal install --only-dependencies
|
|
||||||
cabal build
|
|
||||||
cd ..
|
|
||||||
done
|
|
||||||
|
|
||||||
Binary file not shown.
Binary file not shown.
|
Before Width: | Height: | Size: 56 KiB |
Binary file not shown.
|
Before Width: | Height: | Size: 25 KiB |
@ -1 +0,0 @@
|
|||||||
sudo cp * /usr/share/fonts/truetype/
|
|
||||||
Binary file not shown.
Binary file not shown.
|
Before Width: | Height: | Size: 2.7 KiB |
BIN
images/body-bg.jpg
Normal file
BIN
images/body-bg.jpg
Normal file
Binary file not shown.
|
After Width: | Height: | Size: 3.1 KiB |
BIN
images/download-button.png
Normal file
BIN
images/download-button.png
Normal file
Binary file not shown.
|
After Width: | Height: | Size: 31 KiB |
BIN
images/github-button.png
Normal file
BIN
images/github-button.png
Normal file
Binary file not shown.
|
After Width: | Height: | Size: 3.1 KiB |
BIN
images/header-bg.jpg
Normal file
BIN
images/header-bg.jpg
Normal file
Binary file not shown.
|
After Width: | Height: | Size: 10 KiB |
BIN
images/highlight-bg.jpg
Normal file
BIN
images/highlight-bg.jpg
Normal file
Binary file not shown.
|
After Width: | Height: | Size: 33 KiB |
BIN
images/sidebar-bg.jpg
Normal file
BIN
images/sidebar-bg.jpg
Normal file
Binary file not shown.
|
After Width: | Height: | Size: 3.1 KiB |
83
index.html
Normal file
83
index.html
Normal file
@ -0,0 +1,83 @@
|
|||||||
|
<!DOCTYPE html>
|
||||||
|
<html>
|
||||||
|
<head>
|
||||||
|
<meta charset='utf-8'>
|
||||||
|
<meta http-equiv="X-UA-Compatible" content="chrome=1">
|
||||||
|
<meta name="viewport" content="width=device-width, initial-scale=1, maximum-scale=1">
|
||||||
|
<link href='https://fonts.googleapis.com/css?family=Architects+Daughter' rel='stylesheet' type='text/css'>
|
||||||
|
<link rel="stylesheet" type="text/css" href="stylesheets/stylesheet.css" media="screen" />
|
||||||
|
<link rel="stylesheet" type="text/css" href="stylesheets/pygment_trac.css" media="screen" />
|
||||||
|
<link rel="stylesheet" type="text/css" href="stylesheets/print.css" media="print" />
|
||||||
|
|
||||||
|
<!--[if lt IE 9]>
|
||||||
|
<script src="//html5shiv.googlecode.com/svn/trunk/html5.js"></script>
|
||||||
|
<![endif]-->
|
||||||
|
|
||||||
|
<title>Pioneers by Drezil</title>
|
||||||
|
</head>
|
||||||
|
|
||||||
|
<body>
|
||||||
|
<header>
|
||||||
|
<div class="inner">
|
||||||
|
<h1>Pioneers</h1>
|
||||||
|
<h2>Strategy-Game in Haskell similar to "Settlers II"</h2>
|
||||||
|
<a href="https://github.com/Drezil/pioneers" class="button"><small>View project on</small>GitHub</a>
|
||||||
|
</div>
|
||||||
|
</header>
|
||||||
|
|
||||||
|
<div id="content-wrapper">
|
||||||
|
<div class="inner clearfix">
|
||||||
|
<section id="main-content">
|
||||||
|
<h3>
|
||||||
|
<a name="welcome-to-github-pages" class="anchor" href="#welcome-to-github-pages"><span class="octicon octicon-link"></span></a>Welcome to GitHub Pages.</h3>
|
||||||
|
|
||||||
|
<p>This automatic page generator is the easiest way to create beautiful pages for all of your projects. Author your page content here using GitHub Flavored Markdown, select a template crafted by a designer, and publish. After your page is generated, you can check out the new branch:</p>
|
||||||
|
|
||||||
|
<pre><code>$ cd your_repo_root/repo_name
|
||||||
|
$ git fetch origin
|
||||||
|
$ git checkout gh-pages
|
||||||
|
</code></pre>
|
||||||
|
|
||||||
|
<p>If you're using the GitHub for Mac, simply sync your repository and you'll see the new branch.</p>
|
||||||
|
|
||||||
|
<h3>
|
||||||
|
<a name="designer-templates" class="anchor" href="#designer-templates"><span class="octicon octicon-link"></span></a>Designer Templates</h3>
|
||||||
|
|
||||||
|
<p>We've crafted some handsome templates for you to use. Go ahead and continue to layouts to browse through them. You can easily go back to edit your page before publishing. After publishing your page, you can revisit the page generator and switch to another theme. Your Page content will be preserved if it remained markdown format.</p>
|
||||||
|
|
||||||
|
<h3>
|
||||||
|
<a name="rather-drive-stick" class="anchor" href="#rather-drive-stick"><span class="octicon octicon-link"></span></a>Rather Drive Stick?</h3>
|
||||||
|
|
||||||
|
<p>If you prefer to not use the automatic generator, push a branch named <code>gh-pages</code> to your repository to create a page manually. In addition to supporting regular HTML content, GitHub Pages support Jekyll, a simple, blog aware static site generator written by our own Tom Preston-Werner. Jekyll makes it easy to create site-wide headers and footers without having to copy them across every page. It also offers intelligent blog support and other advanced templating features.</p>
|
||||||
|
|
||||||
|
<h3>
|
||||||
|
<a name="authors-and-contributors" class="anchor" href="#authors-and-contributors"><span class="octicon octicon-link"></span></a>Authors and Contributors</h3>
|
||||||
|
|
||||||
|
<p>You can <a href="https://github.com/blog/821" class="user-mention">@mention</a> a GitHub username to generate a link to their profile. The resulting <code><a></code> element will link to the contributor's GitHub Profile. For example: In 2007, Chris Wanstrath (<a href="https://github.com/defunkt" class="user-mention">@defunkt</a>), PJ Hyett (<a href="https://github.com/pjhyett" class="user-mention">@pjhyett</a>), and Tom Preston-Werner (<a href="https://github.com/mojombo" class="user-mention">@mojombo</a>) founded GitHub.</p>
|
||||||
|
|
||||||
|
<h3>
|
||||||
|
<a name="support-or-contact" class="anchor" href="#support-or-contact"><span class="octicon octicon-link"></span></a>Support or Contact</h3>
|
||||||
|
|
||||||
|
<p>Having trouble with Pages? Check out the documentation at <a href="http://help.github.com/pages">http://help.github.com/pages</a> or contact <a href="mailto:support@github.com">support@github.com</a> and we’ll help you sort it out.</p>
|
||||||
|
</section>
|
||||||
|
|
||||||
|
<aside id="sidebar">
|
||||||
|
<a href="https://github.com/Drezil/pioneers/zipball/master" class="button">
|
||||||
|
<small>Download</small>
|
||||||
|
.zip file
|
||||||
|
</a>
|
||||||
|
<a href="https://github.com/Drezil/pioneers/tarball/master" class="button">
|
||||||
|
<small>Download</small>
|
||||||
|
.tar.gz file
|
||||||
|
</a>
|
||||||
|
|
||||||
|
<p class="repo-owner"><a href="https://github.com/Drezil/pioneers"></a> is maintained by <a href="https://github.com/Drezil">Drezil</a>.</p>
|
||||||
|
|
||||||
|
<p>This page was generated by <a href="https://pages.github.com">GitHub Pages</a> using the Architect theme by <a href="https://twitter.com/jasonlong">Jason Long</a>.</p>
|
||||||
|
</aside>
|
||||||
|
</div>
|
||||||
|
</div>
|
||||||
|
|
||||||
|
|
||||||
|
</body>
|
||||||
|
</html>
|
||||||
1
javascripts/main.js
Normal file
1
javascripts/main.js
Normal file
@ -0,0 +1 @@
|
|||||||
|
console.log('This would be the main JS file.');
|
||||||
BIN
models/box.blend
BIN
models/box.blend
Binary file not shown.
118
models/box.iqe
118
models/box.iqe
@ -1,118 +0,0 @@
|
|||||||
# Inter-Quake Export
|
|
||||||
|
|
||||||
joint "Bone" -1
|
|
||||||
pq 0.00000000 0.00000000 0.00000000 -0.70710683 -0.00000000 -0.00000000 -0.70710683
|
|
||||||
|
|
||||||
mesh "Cube"
|
|
||||||
material "Material"
|
|
||||||
|
|
||||||
vp 0.50000000 0.49999997 0.00000000
|
|
||||||
vt 0.00000000 0.00000000
|
|
||||||
vn 0.00000000 0.00000000 -1.00000000
|
|
||||||
vb 0 0.99999976
|
|
||||||
vp -0.50000006 -0.49999991 0.00000000
|
|
||||||
vt 0.00000000 0.00000000
|
|
||||||
vn 0.00000000 0.00000000 -1.00000000
|
|
||||||
vb 0 0.99999994
|
|
||||||
vp 0.50000000 -0.50000000 0.00000000
|
|
||||||
vt 0.00000000 0.00000000
|
|
||||||
vn 0.00000000 0.00000000 -1.00000000
|
|
||||||
vb 0 0.99999988
|
|
||||||
vp -0.49999982 0.50000018 0.00000000
|
|
||||||
vt 0.00000000 0.00000000
|
|
||||||
vn 0.00000000 0.00000000 -1.00000000
|
|
||||||
vb 0 0.99999994
|
|
||||||
vp 0.50000024 0.49999973 1.00000000
|
|
||||||
vt 0.00000000 0.00000000
|
|
||||||
vn 0.00000000 0.00000000 1.00000000
|
|
||||||
vb 0 0.99999976
|
|
||||||
vp -0.50000018 -0.49999982 1.00000000
|
|
||||||
vt 0.00000000 0.00000000
|
|
||||||
vn 0.00000000 0.00000000 1.00000000
|
|
||||||
vb 0 0.99999994
|
|
||||||
vp -0.49999997 0.50000000 1.00000000
|
|
||||||
vt 0.00000000 0.00000000
|
|
||||||
vn 0.00000000 0.00000000 1.00000000
|
|
||||||
vb 0 1.00000000
|
|
||||||
vp 0.49999967 -0.50000030 1.00000000
|
|
||||||
vt 0.00000000 0.00000000
|
|
||||||
vn 0.00000000 0.00000000 1.00000000
|
|
||||||
vb 0 0.99999988
|
|
||||||
vp 0.50000000 0.49999997 0.00000000
|
|
||||||
vt 0.00000000 0.00000000
|
|
||||||
vn 1.00000000 -0.00000028 0.00000004
|
|
||||||
vb 0 0.99999976
|
|
||||||
vp 0.49999967 -0.50000030 1.00000000
|
|
||||||
vt 0.00000000 0.00000000
|
|
||||||
vn 1.00000000 -0.00000028 0.00000004
|
|
||||||
vb 0 0.99999988
|
|
||||||
vp 0.50000024 0.49999973 1.00000000
|
|
||||||
vt 0.00000000 0.00000000
|
|
||||||
vn 1.00000000 -0.00000028 0.00000004
|
|
||||||
vb 0 0.99999976
|
|
||||||
vp 0.50000000 -0.50000000 0.00000000
|
|
||||||
vt 0.00000000 0.00000000
|
|
||||||
vn 1.00000000 -0.00000028 0.00000004
|
|
||||||
vb 0 0.99999988
|
|
||||||
vp 0.50000000 -0.50000000 0.00000000
|
|
||||||
vt 0.00000000 0.00000000
|
|
||||||
vn -0.00000028 -1.00000000 -0.00000010
|
|
||||||
vb 0 0.99999988
|
|
||||||
vp -0.50000018 -0.49999982 1.00000000
|
|
||||||
vt 0.00000000 0.00000000
|
|
||||||
vn -0.00000028 -1.00000000 -0.00000010
|
|
||||||
vb 0 0.99999994
|
|
||||||
vp 0.49999967 -0.50000030 1.00000000
|
|
||||||
vt 0.00000000 0.00000000
|
|
||||||
vn -0.00000028 -1.00000000 -0.00000010
|
|
||||||
vb 0 0.99999988
|
|
||||||
vp -0.50000006 -0.49999991 0.00000000
|
|
||||||
vt 0.00000000 0.00000000
|
|
||||||
vn -0.00000028 -1.00000000 -0.00000010
|
|
||||||
vb 0 0.99999994
|
|
||||||
vp -0.50000006 -0.49999991 0.00000000
|
|
||||||
vt 0.00000000 0.00000000
|
|
||||||
vn -1.00000000 0.00000022 -0.00000013
|
|
||||||
vb 0 0.99999994
|
|
||||||
vp -0.49999997 0.50000000 1.00000000
|
|
||||||
vt 0.00000000 0.00000000
|
|
||||||
vn -1.00000000 0.00000022 -0.00000013
|
|
||||||
vb 0 1.00000000
|
|
||||||
vp -0.50000018 -0.49999982 1.00000000
|
|
||||||
vt 0.00000000 0.00000000
|
|
||||||
vn -1.00000000 0.00000022 -0.00000013
|
|
||||||
vb 0 0.99999994
|
|
||||||
vp -0.49999982 0.50000018 0.00000000
|
|
||||||
vt 0.00000000 0.00000000
|
|
||||||
vn -1.00000000 0.00000022 -0.00000013
|
|
||||||
vb 0 0.99999994
|
|
||||||
vp 0.50000024 0.49999973 1.00000000
|
|
||||||
vt 0.00000000 0.00000000
|
|
||||||
vn 0.00000024 1.00000000 0.00000021
|
|
||||||
vb 0 0.99999976
|
|
||||||
vp -0.49999982 0.50000018 0.00000000
|
|
||||||
vt 0.00000000 0.00000000
|
|
||||||
vn 0.00000024 1.00000000 0.00000021
|
|
||||||
vb 0 0.99999994
|
|
||||||
vp 0.50000000 0.49999997 0.00000000
|
|
||||||
vt 0.00000000 0.00000000
|
|
||||||
vn 0.00000024 1.00000000 0.00000021
|
|
||||||
vb 0 0.99999976
|
|
||||||
vp -0.49999997 0.50000000 1.00000000
|
|
||||||
vt 0.00000000 0.00000000
|
|
||||||
vn 0.00000024 1.00000000 0.00000021
|
|
||||||
vb 0 1.00000000
|
|
||||||
|
|
||||||
fm 0 1 2
|
|
||||||
fm 0 3 1
|
|
||||||
fm 4 5 6
|
|
||||||
fm 4 7 5
|
|
||||||
fm 8 9 10
|
|
||||||
fm 8 11 9
|
|
||||||
fm 12 13 14
|
|
||||||
fm 12 15 13
|
|
||||||
fm 16 17 18
|
|
||||||
fm 16 19 17
|
|
||||||
fm 20 21 22
|
|
||||||
fm 20 23 21
|
|
||||||
|
|
||||||
BIN
models/box.iqm
BIN
models/box.iqm
Binary file not shown.
Binary file not shown.
1
params.json
Normal file
1
params.json
Normal file
@ -0,0 +1 @@
|
|||||||
|
{"name":"Pioneers","tagline":"Strategy-Game in Haskell similar to \"Settlers II\"","body":"### Welcome to GitHub Pages.\r\nThis automatic page generator is the easiest way to create beautiful pages for all of your projects. Author your page content here using GitHub Flavored Markdown, select a template crafted by a designer, and publish. After your page is generated, you can check out the new branch:\r\n\r\n```\r\n$ cd your_repo_root/repo_name\r\n$ git fetch origin\r\n$ git checkout gh-pages\r\n```\r\n\r\nIf you're using the GitHub for Mac, simply sync your repository and you'll see the new branch.\r\n\r\n### Designer Templates\r\nWe've crafted some handsome templates for you to use. Go ahead and continue to layouts to browse through them. You can easily go back to edit your page before publishing. After publishing your page, you can revisit the page generator and switch to another theme. Your Page content will be preserved if it remained markdown format.\r\n\r\n### Rather Drive Stick?\r\nIf you prefer to not use the automatic generator, push a branch named `gh-pages` to your repository to create a page manually. In addition to supporting regular HTML content, GitHub Pages support Jekyll, a simple, blog aware static site generator written by our own Tom Preston-Werner. Jekyll makes it easy to create site-wide headers and footers without having to copy them across every page. It also offers intelligent blog support and other advanced templating features.\r\n\r\n### Authors and Contributors\r\nYou can @mention a GitHub username to generate a link to their profile. The resulting `<a>` element will link to the contributor's GitHub Profile. For example: In 2007, Chris Wanstrath (@defunkt), PJ Hyett (@pjhyett), and Tom Preston-Werner (@mojombo) founded GitHub.\r\n\r\n### Support or Contact\r\nHaving trouble with Pages? Check out the documentation at http://help.github.com/pages or contact support@github.com and we’ll help you sort it out.\r\n","google":"","note":"Don't delete this file! It's used internally to help with page regeneration."}
|
||||||
70
shaders/3rdParty/noise2D.glsl
vendored
70
shaders/3rdParty/noise2D.glsl
vendored
@ -1,70 +0,0 @@
|
|||||||
//
|
|
||||||
// Description : Array and textureless GLSL 2D simplex noise function.
|
|
||||||
// Author : Ian McEwan, Ashima Arts.
|
|
||||||
// Maintainer : ijm
|
|
||||||
// Lastmod : 20110822 (ijm)
|
|
||||||
// License : Copyright (C) 2011 Ashima Arts. All rights reserved.
|
|
||||||
// Distributed under the MIT License. See LICENSE file.
|
|
||||||
// https://github.com/ashima/webgl-noise
|
|
||||||
//
|
|
||||||
|
|
||||||
vec3 mod289(vec3 x) {
|
|
||||||
return x - floor(x * (1.0 / 289.0)) * 289.0;
|
|
||||||
}
|
|
||||||
|
|
||||||
vec2 mod289(vec2 x) {
|
|
||||||
return x - floor(x * (1.0 / 289.0)) * 289.0;
|
|
||||||
}
|
|
||||||
|
|
||||||
vec3 permute(vec3 x) {
|
|
||||||
return mod289(((x*34.0)+1.0)*x);
|
|
||||||
}
|
|
||||||
|
|
||||||
float snoise(vec2 v)
|
|
||||||
{
|
|
||||||
const vec4 C = vec4(0.211324865405187, // (3.0-sqrt(3.0))/6.0
|
|
||||||
0.366025403784439, // 0.5*(sqrt(3.0)-1.0)
|
|
||||||
-0.577350269189626, // -1.0 + 2.0 * C.x
|
|
||||||
0.024390243902439); // 1.0 / 41.0
|
|
||||||
// First corner
|
|
||||||
vec2 i = floor(v + dot(v, C.yy) );
|
|
||||||
vec2 x0 = v - i + dot(i, C.xx);
|
|
||||||
|
|
||||||
// Other corners
|
|
||||||
vec2 i1;
|
|
||||||
//i1.x = step( x0.y, x0.x ); // x0.x > x0.y ? 1.0 : 0.0
|
|
||||||
//i1.y = 1.0 - i1.x;
|
|
||||||
i1 = (x0.x > x0.y) ? vec2(1.0, 0.0) : vec2(0.0, 1.0);
|
|
||||||
// x0 = x0 - 0.0 + 0.0 * C.xx ;
|
|
||||||
// x1 = x0 - i1 + 1.0 * C.xx ;
|
|
||||||
// x2 = x0 - 1.0 + 2.0 * C.xx ;
|
|
||||||
vec4 x12 = x0.xyxy + C.xxzz;
|
|
||||||
x12.xy -= i1;
|
|
||||||
|
|
||||||
// Permutations
|
|
||||||
i = mod289(i); // Avoid truncation effects in permutation
|
|
||||||
vec3 p = permute( permute( i.y + vec3(0.0, i1.y, 1.0 ))
|
|
||||||
+ i.x + vec3(0.0, i1.x, 1.0 ));
|
|
||||||
|
|
||||||
vec3 m = max(0.5 - vec3(dot(x0,x0), dot(x12.xy,x12.xy), dot(x12.zw,x12.zw)), 0.0);
|
|
||||||
m = m*m ;
|
|
||||||
m = m*m ;
|
|
||||||
|
|
||||||
// Gradients: 41 points uniformly over a line, mapped onto a diamond.
|
|
||||||
// The ring size 17*17 = 289 is close to a multiple of 41 (41*7 = 287)
|
|
||||||
|
|
||||||
vec3 x = 2.0 * fract(p * C.www) - 1.0;
|
|
||||||
vec3 h = abs(x) - 0.5;
|
|
||||||
vec3 ox = floor(x + 0.5);
|
|
||||||
vec3 a0 = x - ox;
|
|
||||||
|
|
||||||
// Normalise gradients implicitly by scaling m
|
|
||||||
// Approximation of: m *= inversesqrt( a0*a0 + h*h );
|
|
||||||
m *= 1.79284291400159 - 0.85373472095314 * ( a0*a0 + h*h );
|
|
||||||
|
|
||||||
// Compute final noise value at P
|
|
||||||
vec3 g;
|
|
||||||
g.x = a0.x * x0.x + h.x * x0.y;
|
|
||||||
g.yz = a0.yz * x12.xz + h.yz * x12.yw;
|
|
||||||
return 130.0 * dot(m, g);
|
|
||||||
}
|
|
||||||
102
shaders/3rdParty/noise3D.glsl
vendored
102
shaders/3rdParty/noise3D.glsl
vendored
@ -1,102 +0,0 @@
|
|||||||
//
|
|
||||||
// Description : Array and textureless GLSL 2D/3D/4D simplex
|
|
||||||
// noise functions.
|
|
||||||
// Author : Ian McEwan, Ashima Arts.
|
|
||||||
// Maintainer : ijm
|
|
||||||
// Lastmod : 20110822 (ijm)
|
|
||||||
// License : Copyright (C) 2011 Ashima Arts. All rights reserved.
|
|
||||||
// Distributed under the MIT License. See LICENSE file.
|
|
||||||
// https://github.com/ashima/webgl-noise
|
|
||||||
//
|
|
||||||
|
|
||||||
vec3 mod289(vec3 x) {
|
|
||||||
return x - floor(x * (1.0 / 289.0)) * 289.0;
|
|
||||||
}
|
|
||||||
|
|
||||||
vec4 mod289(vec4 x) {
|
|
||||||
return x - floor(x * (1.0 / 289.0)) * 289.0;
|
|
||||||
}
|
|
||||||
|
|
||||||
vec4 permute(vec4 x) {
|
|
||||||
return mod289(((x*34.0)+1.0)*x);
|
|
||||||
}
|
|
||||||
|
|
||||||
vec4 taylorInvSqrt(vec4 r)
|
|
||||||
{
|
|
||||||
return 1.79284291400159 - 0.85373472095314 * r;
|
|
||||||
}
|
|
||||||
|
|
||||||
float snoise(vec3 v)
|
|
||||||
{
|
|
||||||
const vec2 C = vec2(1.0/6.0, 1.0/3.0) ;
|
|
||||||
const vec4 D = vec4(0.0, 0.5, 1.0, 2.0);
|
|
||||||
|
|
||||||
// First corner
|
|
||||||
vec3 i = floor(v + dot(v, C.yyy) );
|
|
||||||
vec3 x0 = v - i + dot(i, C.xxx) ;
|
|
||||||
|
|
||||||
// Other corners
|
|
||||||
vec3 g = step(x0.yzx, x0.xyz);
|
|
||||||
vec3 l = 1.0 - g;
|
|
||||||
vec3 i1 = min( g.xyz, l.zxy );
|
|
||||||
vec3 i2 = max( g.xyz, l.zxy );
|
|
||||||
|
|
||||||
// x0 = x0 - 0.0 + 0.0 * C.xxx;
|
|
||||||
// x1 = x0 - i1 + 1.0 * C.xxx;
|
|
||||||
// x2 = x0 - i2 + 2.0 * C.xxx;
|
|
||||||
// x3 = x0 - 1.0 + 3.0 * C.xxx;
|
|
||||||
vec3 x1 = x0 - i1 + C.xxx;
|
|
||||||
vec3 x2 = x0 - i2 + C.yyy; // 2.0*C.x = 1/3 = C.y
|
|
||||||
vec3 x3 = x0 - D.yyy; // -1.0+3.0*C.x = -0.5 = -D.y
|
|
||||||
|
|
||||||
// Permutations
|
|
||||||
i = mod289(i);
|
|
||||||
vec4 p = permute( permute( permute(
|
|
||||||
i.z + vec4(0.0, i1.z, i2.z, 1.0 ))
|
|
||||||
+ i.y + vec4(0.0, i1.y, i2.y, 1.0 ))
|
|
||||||
+ i.x + vec4(0.0, i1.x, i2.x, 1.0 ));
|
|
||||||
|
|
||||||
// Gradients: 7x7 points over a square, mapped onto an octahedron.
|
|
||||||
// The ring size 17*17 = 289 is close to a multiple of 49 (49*6 = 294)
|
|
||||||
float n_ = 0.142857142857; // 1.0/7.0
|
|
||||||
vec3 ns = n_ * D.wyz - D.xzx;
|
|
||||||
|
|
||||||
vec4 j = p - 49.0 * floor(p * ns.z * ns.z); // mod(p,7*7)
|
|
||||||
|
|
||||||
vec4 x_ = floor(j * ns.z);
|
|
||||||
vec4 y_ = floor(j - 7.0 * x_ ); // mod(j,N)
|
|
||||||
|
|
||||||
vec4 x = x_ *ns.x + ns.yyyy;
|
|
||||||
vec4 y = y_ *ns.x + ns.yyyy;
|
|
||||||
vec4 h = 1.0 - abs(x) - abs(y);
|
|
||||||
|
|
||||||
vec4 b0 = vec4( x.xy, y.xy );
|
|
||||||
vec4 b1 = vec4( x.zw, y.zw );
|
|
||||||
|
|
||||||
//vec4 s0 = vec4(lessThan(b0,0.0))*2.0 - 1.0;
|
|
||||||
//vec4 s1 = vec4(lessThan(b1,0.0))*2.0 - 1.0;
|
|
||||||
vec4 s0 = floor(b0)*2.0 + 1.0;
|
|
||||||
vec4 s1 = floor(b1)*2.0 + 1.0;
|
|
||||||
vec4 sh = -step(h, vec4(0.0));
|
|
||||||
|
|
||||||
vec4 a0 = b0.xzyw + s0.xzyw*sh.xxyy ;
|
|
||||||
vec4 a1 = b1.xzyw + s1.xzyw*sh.zzww ;
|
|
||||||
|
|
||||||
vec3 p0 = vec3(a0.xy,h.x);
|
|
||||||
vec3 p1 = vec3(a0.zw,h.y);
|
|
||||||
vec3 p2 = vec3(a1.xy,h.z);
|
|
||||||
vec3 p3 = vec3(a1.zw,h.w);
|
|
||||||
|
|
||||||
//Normalise gradients
|
|
||||||
vec4 norm = taylorInvSqrt(vec4(dot(p0,p0), dot(p1,p1), dot(p2, p2), dot(p3,p3)));
|
|
||||||
p0 *= norm.x;
|
|
||||||
p1 *= norm.y;
|
|
||||||
p2 *= norm.z;
|
|
||||||
p3 *= norm.w;
|
|
||||||
|
|
||||||
// Mix final noise value
|
|
||||||
vec4 m = max(0.6 - vec4(dot(x0,x0), dot(x1,x1), dot(x2,x2), dot(x3,x3)), 0.0);
|
|
||||||
m = m * m;
|
|
||||||
return 42.0 * dot( m*m, vec4( dot(p0,x0), dot(p1,x1),
|
|
||||||
dot(p2,x2), dot(p3,x3) ) );
|
|
||||||
}
|
|
||||||
128
shaders/3rdParty/noise4D.glsl
vendored
128
shaders/3rdParty/noise4D.glsl
vendored
@ -1,128 +0,0 @@
|
|||||||
//
|
|
||||||
// Description : Array and textureless GLSL 2D/3D/4D simplex
|
|
||||||
// noise functions.
|
|
||||||
// Author : Ian McEwan, Ashima Arts.
|
|
||||||
// Maintainer : ijm
|
|
||||||
// Lastmod : 20110822 (ijm)
|
|
||||||
// License : Copyright (C) 2011 Ashima Arts. All rights reserved.
|
|
||||||
// Distributed under the MIT License. See LICENSE file.
|
|
||||||
// https://github.com/ashima/webgl-noise
|
|
||||||
//
|
|
||||||
|
|
||||||
vec4 mod289(vec4 x) {
|
|
||||||
return x - floor(x * (1.0 / 289.0)) * 289.0; }
|
|
||||||
|
|
||||||
float mod289(float x) {
|
|
||||||
return x - floor(x * (1.0 / 289.0)) * 289.0; }
|
|
||||||
|
|
||||||
vec4 permute(vec4 x) {
|
|
||||||
return mod289(((x*34.0)+1.0)*x);
|
|
||||||
}
|
|
||||||
|
|
||||||
float permute(float x) {
|
|
||||||
return mod289(((x*34.0)+1.0)*x);
|
|
||||||
}
|
|
||||||
|
|
||||||
vec4 taylorInvSqrt(vec4 r)
|
|
||||||
{
|
|
||||||
return 1.79284291400159 - 0.85373472095314 * r;
|
|
||||||
}
|
|
||||||
|
|
||||||
float taylorInvSqrt(float r)
|
|
||||||
{
|
|
||||||
return 1.79284291400159 - 0.85373472095314 * r;
|
|
||||||
}
|
|
||||||
|
|
||||||
vec4 grad4(float j, vec4 ip)
|
|
||||||
{
|
|
||||||
const vec4 ones = vec4(1.0, 1.0, 1.0, -1.0);
|
|
||||||
vec4 p,s;
|
|
||||||
|
|
||||||
p.xyz = floor( fract (vec3(j) * ip.xyz) * 7.0) * ip.z - 1.0;
|
|
||||||
p.w = 1.5 - dot(abs(p.xyz), ones.xyz);
|
|
||||||
s = vec4(lessThan(p, vec4(0.0)));
|
|
||||||
p.xyz = p.xyz + (s.xyz*2.0 - 1.0) * s.www;
|
|
||||||
|
|
||||||
return p;
|
|
||||||
}
|
|
||||||
|
|
||||||
// (sqrt(5) - 1)/4 = F4, used once below
|
|
||||||
#define F4 0.309016994374947451
|
|
||||||
|
|
||||||
float snoise(vec4 v)
|
|
||||||
{
|
|
||||||
const vec4 C = vec4( 0.138196601125011, // (5 - sqrt(5))/20 G4
|
|
||||||
0.276393202250021, // 2 * G4
|
|
||||||
0.414589803375032, // 3 * G4
|
|
||||||
-0.447213595499958); // -1 + 4 * G4
|
|
||||||
|
|
||||||
// First corner
|
|
||||||
vec4 i = floor(v + dot(v, vec4(F4)) );
|
|
||||||
vec4 x0 = v - i + dot(i, C.xxxx);
|
|
||||||
|
|
||||||
// Other corners
|
|
||||||
|
|
||||||
// Rank sorting originally contributed by Bill Licea-Kane, AMD (formerly ATI)
|
|
||||||
vec4 i0;
|
|
||||||
vec3 isX = step( x0.yzw, x0.xxx );
|
|
||||||
vec3 isYZ = step( x0.zww, x0.yyz );
|
|
||||||
// i0.x = dot( isX, vec3( 1.0 ) );
|
|
||||||
i0.x = isX.x + isX.y + isX.z;
|
|
||||||
i0.yzw = 1.0 - isX;
|
|
||||||
// i0.y += dot( isYZ.xy, vec2( 1.0 ) );
|
|
||||||
i0.y += isYZ.x + isYZ.y;
|
|
||||||
i0.zw += 1.0 - isYZ.xy;
|
|
||||||
i0.z += isYZ.z;
|
|
||||||
i0.w += 1.0 - isYZ.z;
|
|
||||||
|
|
||||||
// i0 now contains the unique values 0,1,2,3 in each channel
|
|
||||||
vec4 i3 = clamp( i0, 0.0, 1.0 );
|
|
||||||
vec4 i2 = clamp( i0-1.0, 0.0, 1.0 );
|
|
||||||
vec4 i1 = clamp( i0-2.0, 0.0, 1.0 );
|
|
||||||
|
|
||||||
// x0 = x0 - 0.0 + 0.0 * C.xxxx
|
|
||||||
// x1 = x0 - i1 + 1.0 * C.xxxx
|
|
||||||
// x2 = x0 - i2 + 2.0 * C.xxxx
|
|
||||||
// x3 = x0 - i3 + 3.0 * C.xxxx
|
|
||||||
// x4 = x0 - 1.0 + 4.0 * C.xxxx
|
|
||||||
vec4 x1 = x0 - i1 + C.xxxx;
|
|
||||||
vec4 x2 = x0 - i2 + C.yyyy;
|
|
||||||
vec4 x3 = x0 - i3 + C.zzzz;
|
|
||||||
vec4 x4 = x0 + C.wwww;
|
|
||||||
|
|
||||||
// Permutations
|
|
||||||
i = mod289(i);
|
|
||||||
float j0 = permute( permute( permute( permute(i.w) + i.z) + i.y) + i.x);
|
|
||||||
vec4 j1 = permute( permute( permute( permute (
|
|
||||||
i.w + vec4(i1.w, i2.w, i3.w, 1.0 ))
|
|
||||||
+ i.z + vec4(i1.z, i2.z, i3.z, 1.0 ))
|
|
||||||
+ i.y + vec4(i1.y, i2.y, i3.y, 1.0 ))
|
|
||||||
+ i.x + vec4(i1.x, i2.x, i3.x, 1.0 ));
|
|
||||||
|
|
||||||
// Gradients: 7x7x6 points over a cube, mapped onto a 4-cross polytope
|
|
||||||
// 7*7*6 = 294, which is close to the ring size 17*17 = 289.
|
|
||||||
vec4 ip = vec4(1.0/294.0, 1.0/49.0, 1.0/7.0, 0.0) ;
|
|
||||||
|
|
||||||
vec4 p0 = grad4(j0, ip);
|
|
||||||
vec4 p1 = grad4(j1.x, ip);
|
|
||||||
vec4 p2 = grad4(j1.y, ip);
|
|
||||||
vec4 p3 = grad4(j1.z, ip);
|
|
||||||
vec4 p4 = grad4(j1.w, ip);
|
|
||||||
|
|
||||||
// Normalise gradients
|
|
||||||
vec4 norm = taylorInvSqrt(vec4(dot(p0,p0), dot(p1,p1), dot(p2, p2), dot(p3,p3)));
|
|
||||||
p0 *= norm.x;
|
|
||||||
p1 *= norm.y;
|
|
||||||
p2 *= norm.z;
|
|
||||||
p3 *= norm.w;
|
|
||||||
p4 *= taylorInvSqrt(dot(p4,p4));
|
|
||||||
|
|
||||||
// Mix contributions from the five corners
|
|
||||||
vec3 m0 = max(0.6 - vec3(dot(x0,x0), dot(x1,x1), dot(x2,x2)), 0.0);
|
|
||||||
vec2 m1 = max(0.6 - vec2(dot(x3,x3), dot(x4,x4) ), 0.0);
|
|
||||||
m0 = m0 * m0;
|
|
||||||
m1 = m1 * m1;
|
|
||||||
return 49.0 * ( dot(m0*m0, vec3( dot( p0, x0 ), dot( p1, x1 ), dot( p2, x2 )))
|
|
||||||
+ dot(m1*m1, vec2( dot( p3, x3 ), dot( p4, x4 ) ) ) ) ;
|
|
||||||
|
|
||||||
}
|
|
||||||
@ -1,169 +0,0 @@
|
|||||||
#version 330
|
|
||||||
|
|
||||||
//#include "3rdParty/noise.glsl"
|
|
||||||
|
|
||||||
vec3 mod289(vec3 x) {
|
|
||||||
return x - floor(x * (1.0 / 289.0)) * 289.0;
|
|
||||||
}
|
|
||||||
|
|
||||||
vec4 mod289(vec4 x) {
|
|
||||||
return x - floor(x * (1.0 / 289.0)) * 289.0;
|
|
||||||
}
|
|
||||||
|
|
||||||
vec4 permute(vec4 x) {
|
|
||||||
return mod289(((x*34.0)+1.0)*x);
|
|
||||||
}
|
|
||||||
|
|
||||||
vec4 taylorInvSqrt(vec4 r)
|
|
||||||
{
|
|
||||||
return 1.79284291400159 - 0.85373472095314 * r;
|
|
||||||
}
|
|
||||||
|
|
||||||
float snoise(vec3 v)
|
|
||||||
{
|
|
||||||
const vec2 C = vec2(1.0/6.0, 1.0/3.0) ;
|
|
||||||
const vec4 D = vec4(0.0, 0.5, 1.0, 2.0);
|
|
||||||
|
|
||||||
// First corner
|
|
||||||
vec3 i = floor(v + dot(v, C.yyy) );
|
|
||||||
vec3 x0 = v - i + dot(i, C.xxx) ;
|
|
||||||
|
|
||||||
// Other corners
|
|
||||||
vec3 g = step(x0.yzx, x0.xyz);
|
|
||||||
vec3 l = 1.0 - g;
|
|
||||||
vec3 i1 = min( g.xyz, l.zxy );
|
|
||||||
vec3 i2 = max( g.xyz, l.zxy );
|
|
||||||
|
|
||||||
// x0 = x0 - 0.0 + 0.0 * C.xxx;
|
|
||||||
// x1 = x0 - i1 + 1.0 * C.xxx;
|
|
||||||
// x2 = x0 - i2 + 2.0 * C.xxx;
|
|
||||||
// x3 = x0 - 1.0 + 3.0 * C.xxx;
|
|
||||||
vec3 x1 = x0 - i1 + C.xxx;
|
|
||||||
vec3 x2 = x0 - i2 + C.yyy; // 2.0*C.x = 1/3 = C.y
|
|
||||||
vec3 x3 = x0 - D.yyy; // -1.0+3.0*C.x = -0.5 = -D.y
|
|
||||||
|
|
||||||
// Permutations
|
|
||||||
i = mod289(i);
|
|
||||||
vec4 p = permute( permute( permute(
|
|
||||||
i.z + vec4(0.0, i1.z, i2.z, 1.0 ))
|
|
||||||
+ i.y + vec4(0.0, i1.y, i2.y, 1.0 ))
|
|
||||||
+ i.x + vec4(0.0, i1.x, i2.x, 1.0 ));
|
|
||||||
|
|
||||||
// Gradients: 7x7 points over a square, mapped onto an octahedron.
|
|
||||||
// The ring size 17*17 = 289 is close to a multiple of 49 (49*6 = 294)
|
|
||||||
float n_ = 0.142857142857; // 1.0/7.0
|
|
||||||
vec3 ns = n_ * D.wyz - D.xzx;
|
|
||||||
|
|
||||||
vec4 j = p - 49.0 * floor(p * ns.z * ns.z); // mod(p,7*7)
|
|
||||||
|
|
||||||
vec4 x_ = floor(j * ns.z);
|
|
||||||
vec4 y_ = floor(j - 7.0 * x_ ); // mod(j,N)
|
|
||||||
|
|
||||||
vec4 x = x_ *ns.x + ns.yyyy;
|
|
||||||
vec4 y = y_ *ns.x + ns.yyyy;
|
|
||||||
vec4 h = 1.0 - abs(x) - abs(y);
|
|
||||||
|
|
||||||
vec4 b0 = vec4( x.xy, y.xy );
|
|
||||||
vec4 b1 = vec4( x.zw, y.zw );
|
|
||||||
|
|
||||||
//vec4 s0 = vec4(lessThan(b0,0.0))*2.0 - 1.0;
|
|
||||||
//vec4 s1 = vec4(lessThan(b1,0.0))*2.0 - 1.0;
|
|
||||||
vec4 s0 = floor(b0)*2.0 + 1.0;
|
|
||||||
vec4 s1 = floor(b1)*2.0 + 1.0;
|
|
||||||
vec4 sh = -step(h, vec4(0.0));
|
|
||||||
|
|
||||||
vec4 a0 = b0.xzyw + s0.xzyw*sh.xxyy ;
|
|
||||||
vec4 a1 = b1.xzyw + s1.xzyw*sh.zzww ;
|
|
||||||
|
|
||||||
vec3 p0 = vec3(a0.xy,h.x);
|
|
||||||
vec3 p1 = vec3(a0.zw,h.y);
|
|
||||||
vec3 p2 = vec3(a1.xy,h.z);
|
|
||||||
vec3 p3 = vec3(a1.zw,h.w);
|
|
||||||
|
|
||||||
//Normalise gradients
|
|
||||||
vec4 norm = taylorInvSqrt(vec4(dot(p0,p0), dot(p1,p1), dot(p2, p2), dot(p3,p3)));
|
|
||||||
p0 *= norm.x;
|
|
||||||
p1 *= norm.y;
|
|
||||||
p2 *= norm.z;
|
|
||||||
p3 *= norm.w;
|
|
||||||
|
|
||||||
// Mix final noise value
|
|
||||||
vec4 m = max(0.6 - vec4(dot(x0,x0), dot(x1,x1), dot(x2,x2), dot(x3,x3)), 0.0);
|
|
||||||
m = m * m;
|
|
||||||
return 42.0 * dot( m*m, vec4( dot(p0,x0), dot(p1,x1),
|
|
||||||
dot(p2,x2), dot(p3,x3) ) );
|
|
||||||
}
|
|
||||||
|
|
||||||
float fog(float dist) {
|
|
||||||
dist = max(0,dist - 50);
|
|
||||||
dist = dist * 0.05;
|
|
||||||
// dist = dist*dist;
|
|
||||||
return 1-exp(-dist);
|
|
||||||
}
|
|
||||||
|
|
||||||
smooth in vec3 teNormal;
|
|
||||||
smooth in vec3 tePosition;
|
|
||||||
smooth in float fogDist;
|
|
||||||
smooth in float gmix;
|
|
||||||
in vec4 teColor;
|
|
||||||
in vec3 tePatchDistance;
|
|
||||||
|
|
||||||
out vec4 fgColor;
|
|
||||||
|
|
||||||
uniform mat4 ViewMatrix;
|
|
||||||
uniform mat4 ProjectionMatrix;
|
|
||||||
|
|
||||||
void main(void)
|
|
||||||
{
|
|
||||||
//fog color
|
|
||||||
vec4 fogColor = vec4(0.6,0.7,0.8,1.0);
|
|
||||||
//grid color
|
|
||||||
vec4 grid = vec4(0.0,0.0,0.0,1.0);
|
|
||||||
//point color
|
|
||||||
vec4 point = vec4(1.0,0.9,0.1,1.0);
|
|
||||||
|
|
||||||
//heliospheric lighting
|
|
||||||
vec4 light = vec4(1.0,1.0,1.0,1.0);
|
|
||||||
vec4 dark = vec4(0.0,0.0,0.0,1.0);
|
|
||||||
//direction to sun from origin
|
|
||||||
vec3 lightDir = normalize(ViewMatrix * vec4(5.0,5.0,1.0,0.0)).xyz;
|
|
||||||
|
|
||||||
float costheta = dot(teNormal, lightDir);
|
|
||||||
float a = costheta * 0.5 + 0.5;
|
|
||||||
|
|
||||||
//create gravel-texel
|
|
||||||
vec3 uvw = tePosition;
|
|
||||||
// Six components of noise in a fractal sum
|
|
||||||
//float n = snoise(uvw * 10);
|
|
||||||
float n = 0;
|
|
||||||
n += 0.5 * snoise(uvw * 20.0);
|
|
||||||
//n += 0.25 * snoise(uvw * 40.0);
|
|
||||||
//n += 0.125 * snoise(uvw * 80.0);
|
|
||||||
//n += 0.0625 * snoise(uvw * 160.0);
|
|
||||||
//n += 0.03125 * snoise(uvw * 320.0);
|
|
||||||
n = abs(n*2);//[0,1]
|
|
||||||
|
|
||||||
//dirt
|
|
||||||
float d = snoise(uvw);
|
|
||||||
d += 0.5 * snoise(uvw * 2);
|
|
||||||
d += 0.25 * snoise(uvw * 4);
|
|
||||||
d = d/3*2 +0.5;
|
|
||||||
|
|
||||||
// base, dirt, noise-level*(above 0?)*(linear blend by y)
|
|
||||||
vec4 texBase = mix(teColor, vec4(0.45,0.27,0.1,1),d*d*step(0.01,tePosition.y)*clamp(tePosition.y/2,0,2));
|
|
||||||
// stone highlights
|
|
||||||
vec4 texHighlights = mix(texBase, vec4(0.9*n,0.9*n,0.9*n,1),n*n*n);
|
|
||||||
//mix highlights into Color with inclination, if inclination^2 > 0.35
|
|
||||||
vec4 texColor = mix(texBase,texHighlights, (gmix*(1-gmix))*4*(gmix*(1-gmix))*4);
|
|
||||||
vec4 Color = texColor;
|
|
||||||
|
|
||||||
fgColor = Color * mix(dark, light, a);
|
|
||||||
fgColor = mix(fgColor,fogColor,fog(fogDist));
|
|
||||||
|
|
||||||
//mix onto tri-borders
|
|
||||||
float mixer = clamp(exp(1.0-50.0*min(tePatchDistance.x,min(tePatchDistance.y,tePatchDistance.z))),0,1);
|
|
||||||
fgColor = mix(fgColor, grid, mixer);
|
|
||||||
|
|
||||||
mixer = clamp(exp(1.0-50.0*min(tePatchDistance.x+tePatchDistance.y,min(tePatchDistance.x+tePatchDistance.z,tePatchDistance.y+tePatchDistance.z))),0,1);
|
|
||||||
fgColor = mix(fgColor, point, mixer);
|
|
||||||
}
|
|
||||||
@ -1,15 +0,0 @@
|
|||||||
#version 330
|
|
||||||
|
|
||||||
smooth in vec3 teNormal;
|
|
||||||
smooth in vec3 tePosition;
|
|
||||||
smooth in float fogDist;
|
|
||||||
smooth in float gmix;
|
|
||||||
in vec4 teColor;
|
|
||||||
in vec3 tePatchDistance;
|
|
||||||
|
|
||||||
uniform mat4 ViewMatrix;
|
|
||||||
uniform mat4 ProjectionMatrix;
|
|
||||||
|
|
||||||
void main(void)
|
|
||||||
{
|
|
||||||
}
|
|
||||||
@ -1,48 +0,0 @@
|
|||||||
#version 330
|
|
||||||
#extension GL_ARB_tessellation_shader : require
|
|
||||||
|
|
||||||
layout(vertices = 3) out;
|
|
||||||
in vec3 vPosition[];
|
|
||||||
in vec4 vColor[];
|
|
||||||
in vec3 vNormal[];
|
|
||||||
out vec3 tcPosition[];
|
|
||||||
out vec4 tcColor[];
|
|
||||||
out vec3 tcNormal[];
|
|
||||||
uniform float TessLevelInner = 1.0; // controlled by keyboard buttons
|
|
||||||
uniform float TessLevelOuter = 1.0; // controlled by keyboard buttons
|
|
||||||
uniform mat4 ProjectionMatrix;
|
|
||||||
uniform mat4 ViewMatrix;
|
|
||||||
uniform mat3 NormalMatrix;
|
|
||||||
|
|
||||||
#define ID gl_InvocationID
|
|
||||||
|
|
||||||
void main()
|
|
||||||
{
|
|
||||||
tcPosition[ID] = vPosition[ID];
|
|
||||||
tcColor[ID] = vColor[ID];
|
|
||||||
tcNormal[ID] = vNormal[ID];
|
|
||||||
float dist = (ProjectionMatrix * ViewMatrix * vec4(vPosition[ID], 1)).z;
|
|
||||||
if (ID == 0) {
|
|
||||||
if (dist < 30) {
|
|
||||||
gl_TessLevelInner[0] = TessLevelInner;
|
|
||||||
gl_TessLevelOuter[0] = TessLevelOuter;
|
|
||||||
gl_TessLevelOuter[1] = TessLevelOuter;
|
|
||||||
gl_TessLevelOuter[2] = TessLevelOuter;
|
|
||||||
} else if (dist < 50) {
|
|
||||||
gl_TessLevelInner[0] = max(TessLevelInner-1.0,1.0);
|
|
||||||
gl_TessLevelOuter[0] = max(TessLevelOuter-1.0,1.0);
|
|
||||||
gl_TessLevelOuter[1] = max(TessLevelOuter-1.0,1.0);
|
|
||||||
gl_TessLevelOuter[2] = max(TessLevelOuter-1.0,1.0);
|
|
||||||
} else if (dist < 100) {
|
|
||||||
gl_TessLevelInner[0] = max(TessLevelInner-2.0,1.0);
|
|
||||||
gl_TessLevelOuter[0] = max(TessLevelOuter-2.0,1.0);
|
|
||||||
gl_TessLevelOuter[1] = max(TessLevelOuter-2.0,1.0);
|
|
||||||
gl_TessLevelOuter[2] = max(TessLevelOuter-2.0,1.0);
|
|
||||||
} else {
|
|
||||||
gl_TessLevelInner[0] = 1.0;
|
|
||||||
gl_TessLevelOuter[0] = 1.0;
|
|
||||||
gl_TessLevelOuter[1] = 1.0;
|
|
||||||
gl_TessLevelOuter[2] = 1.0;
|
|
||||||
}
|
|
||||||
}
|
|
||||||
}
|
|
||||||
@ -1,152 +0,0 @@
|
|||||||
#version 330
|
|
||||||
|
|
||||||
#extension GL_ARB_tessellation_shader : require
|
|
||||||
|
|
||||||
//#include "shaders/3rdParty/noise.glsl"
|
|
||||||
|
|
||||||
vec3 mod289(vec3 x) {
|
|
||||||
return x - floor(x * (1.0 / 289.0)) * 289.0;
|
|
||||||
}
|
|
||||||
|
|
||||||
vec4 mod289(vec4 x) {
|
|
||||||
return x - floor(x * (1.0 / 289.0)) * 289.0;
|
|
||||||
}
|
|
||||||
|
|
||||||
vec4 permute(vec4 x) {
|
|
||||||
return mod289(((x*34.0)+1.0)*x);
|
|
||||||
}
|
|
||||||
|
|
||||||
vec4 taylorInvSqrt(vec4 r)
|
|
||||||
{
|
|
||||||
return 1.79284291400159 - 0.85373472095314 * r;
|
|
||||||
}
|
|
||||||
|
|
||||||
float snoise(vec3 v)
|
|
||||||
{
|
|
||||||
const vec2 C = vec2(1.0/6.0, 1.0/3.0) ;
|
|
||||||
const vec4 D = vec4(0.0, 0.5, 1.0, 2.0);
|
|
||||||
|
|
||||||
// First corner
|
|
||||||
vec3 i = floor(v + dot(v, C.yyy) );
|
|
||||||
vec3 x0 = v - i + dot(i, C.xxx) ;
|
|
||||||
|
|
||||||
// Other corners
|
|
||||||
vec3 g = step(x0.yzx, x0.xyz);
|
|
||||||
vec3 l = 1.0 - g;
|
|
||||||
vec3 i1 = min( g.xyz, l.zxy );
|
|
||||||
vec3 i2 = max( g.xyz, l.zxy );
|
|
||||||
|
|
||||||
// x0 = x0 - 0.0 + 0.0 * C.xxx;
|
|
||||||
// x1 = x0 - i1 + 1.0 * C.xxx;
|
|
||||||
// x2 = x0 - i2 + 2.0 * C.xxx;
|
|
||||||
// x3 = x0 - 1.0 + 3.0 * C.xxx;
|
|
||||||
vec3 x1 = x0 - i1 + C.xxx;
|
|
||||||
vec3 x2 = x0 - i2 + C.yyy; // 2.0*C.x = 1/3 = C.y
|
|
||||||
vec3 x3 = x0 - D.yyy; // -1.0+3.0*C.x = -0.5 = -D.y
|
|
||||||
|
|
||||||
// Permutations
|
|
||||||
i = mod289(i);
|
|
||||||
vec4 p = permute( permute( permute(
|
|
||||||
i.z + vec4(0.0, i1.z, i2.z, 1.0 ))
|
|
||||||
+ i.y + vec4(0.0, i1.y, i2.y, 1.0 ))
|
|
||||||
+ i.x + vec4(0.0, i1.x, i2.x, 1.0 ));
|
|
||||||
|
|
||||||
// Gradients: 7x7 points over a square, mapped onto an octahedron.
|
|
||||||
// The ring size 17*17 = 289 is close to a multiple of 49 (49*6 = 294)
|
|
||||||
float n_ = 0.142857142857; // 1.0/7.0
|
|
||||||
vec3 ns = n_ * D.wyz - D.xzx;
|
|
||||||
|
|
||||||
vec4 j = p - 49.0 * floor(p * ns.z * ns.z); // mod(p,7*7)
|
|
||||||
|
|
||||||
vec4 x_ = floor(j * ns.z);
|
|
||||||
vec4 y_ = floor(j - 7.0 * x_ ); // mod(j,N)
|
|
||||||
|
|
||||||
vec4 x = x_ *ns.x + ns.yyyy;
|
|
||||||
vec4 y = y_ *ns.x + ns.yyyy;
|
|
||||||
vec4 h = 1.0 - abs(x) - abs(y);
|
|
||||||
|
|
||||||
vec4 b0 = vec4( x.xy, y.xy );
|
|
||||||
vec4 b1 = vec4( x.zw, y.zw );
|
|
||||||
|
|
||||||
//vec4 s0 = vec4(lessThan(b0,0.0))*2.0 - 1.0;
|
|
||||||
//vec4 s1 = vec4(lessThan(b1,0.0))*2.0 - 1.0;
|
|
||||||
vec4 s0 = floor(b0)*2.0 + 1.0;
|
|
||||||
vec4 s1 = floor(b1)*2.0 + 1.0;
|
|
||||||
vec4 sh = -step(h, vec4(0.0));
|
|
||||||
|
|
||||||
vec4 a0 = b0.xzyw + s0.xzyw*sh.xxyy ;
|
|
||||||
vec4 a1 = b1.xzyw + s1.xzyw*sh.zzww ;
|
|
||||||
|
|
||||||
vec3 p0 = vec3(a0.xy,h.x);
|
|
||||||
vec3 p1 = vec3(a0.zw,h.y);
|
|
||||||
vec3 p2 = vec3(a1.xy,h.z);
|
|
||||||
vec3 p3 = vec3(a1.zw,h.w);
|
|
||||||
|
|
||||||
//Normalise gradients
|
|
||||||
vec4 norm = taylorInvSqrt(vec4(dot(p0,p0), dot(p1,p1), dot(p2, p2), dot(p3,p3)));
|
|
||||||
p0 *= norm.x;
|
|
||||||
p1 *= norm.y;
|
|
||||||
p2 *= norm.z;
|
|
||||||
p3 *= norm.w;
|
|
||||||
|
|
||||||
// Mix final noise value
|
|
||||||
vec4 m = max(0.6 - vec4(dot(x0,x0), dot(x1,x1), dot(x2,x2), dot(x3,x3)), 0.0);
|
|
||||||
m = m * m;
|
|
||||||
return 42.0 * dot( m*m, vec4( dot(p0,x0), dot(p1,x1),
|
|
||||||
dot(p2,x2), dot(p3,x3) ) );
|
|
||||||
}
|
|
||||||
|
|
||||||
|
|
||||||
layout(triangles, equal_spacing, cw) in;
|
|
||||||
in vec3 tcPosition[];
|
|
||||||
in vec4 tcColor[];
|
|
||||||
in vec3 tcNormal[];
|
|
||||||
out vec4 teColor;
|
|
||||||
smooth out vec3 tePosition;
|
|
||||||
smooth out vec3 teNormal;
|
|
||||||
smooth out float fogDist;
|
|
||||||
smooth out float gmix; //mixture of gravel
|
|
||||||
out vec3 tePatchDistance;
|
|
||||||
//out vec3 tePatchDistance;
|
|
||||||
//constant projection matrix
|
|
||||||
uniform mat4 ProjectionMatrix;
|
|
||||||
uniform mat4 ViewMatrix;
|
|
||||||
uniform mat3 NormalMatrix;
|
|
||||||
|
|
||||||
void main()
|
|
||||||
{
|
|
||||||
//NORMAL
|
|
||||||
vec3 n0 = gl_TessCoord.x * tcNormal[0];
|
|
||||||
vec3 n1 = gl_TessCoord.y * tcNormal[1];
|
|
||||||
vec3 n2 = gl_TessCoord.z * tcNormal[2];
|
|
||||||
vec3 tessNormal = normalize(n0 + n1 + n2);
|
|
||||||
teNormal = NormalMatrix * tessNormal;
|
|
||||||
|
|
||||||
//POSITION
|
|
||||||
vec3 p0 = gl_TessCoord.x * tcPosition[0];
|
|
||||||
vec3 p1 = gl_TessCoord.y * tcPosition[1];
|
|
||||||
vec3 p2 = gl_TessCoord.z * tcPosition[2];
|
|
||||||
tePosition = p0 + p1 + p2;
|
|
||||||
tePatchDistance = gl_TessCoord;
|
|
||||||
|
|
||||||
//sin(a,b) = length(cross(a,b))
|
|
||||||
float i0 = (1-gl_TessCoord.x)*gl_TessCoord.x * length(cross(tcNormal[0],tessNormal));
|
|
||||||
float i1 = (1-gl_TessCoord.y)*gl_TessCoord.y * length(cross(tcNormal[1],tessNormal));
|
|
||||||
float i2 = (1-gl_TessCoord.z)*gl_TessCoord.z * length(cross(tcNormal[2],tessNormal));
|
|
||||||
float standout = i0+i1+i2;
|
|
||||||
tePosition = tePosition+tessNormal*standout;
|
|
||||||
vec3 tmp = tePosition;//+clamp(tePosition,0,0.05)*snoise(tePosition/2);
|
|
||||||
tePosition = vec3(tePosition.x, tmp.y, tePosition.z);
|
|
||||||
gl_Position = ProjectionMatrix * ViewMatrix * vec4(tePosition, 1);
|
|
||||||
fogDist = gl_Position.z;
|
|
||||||
|
|
||||||
//COLOR-BLENDING
|
|
||||||
vec4 c0 = (1-exp(gl_TessCoord.x)) * tcColor[0];
|
|
||||||
vec4 c1 = (1-exp(gl_TessCoord.y)) * tcColor[1];
|
|
||||||
vec4 c2 = (1-exp(gl_TessCoord.z)) * tcColor[2];
|
|
||||||
teColor = (c0 + c1 + c2)/((1-exp(gl_TessCoord.x))+(1-exp(gl_TessCoord.y))+(1-exp(gl_TessCoord.z)));
|
|
||||||
|
|
||||||
//mix gravel based on incline (sin (normal,up))
|
|
||||||
gmix = length(cross(tessNormal, vec3(0,1,0)));
|
|
||||||
|
|
||||||
}
|
|
||||||
@ -1,18 +0,0 @@
|
|||||||
#version 330
|
|
||||||
|
|
||||||
//vertex-data
|
|
||||||
in vec4 Color;
|
|
||||||
in vec3 Position;
|
|
||||||
in vec3 Normal;
|
|
||||||
|
|
||||||
//output-data for later stages
|
|
||||||
out vec4 vColor;
|
|
||||||
out vec3 vPosition;
|
|
||||||
out vec3 vNormal;
|
|
||||||
|
|
||||||
void main()
|
|
||||||
{
|
|
||||||
vPosition = Position;
|
|
||||||
vNormal = Normal;
|
|
||||||
vColor = Color;
|
|
||||||
}
|
|
||||||
@ -1,119 +0,0 @@
|
|||||||
#version 330
|
|
||||||
|
|
||||||
//#include "3rdParty/noise.glsl"
|
|
||||||
|
|
||||||
vec3 mod289(vec3 x) {
|
|
||||||
return x - floor(x * (1.0 / 289.0)) * 289.0;
|
|
||||||
}
|
|
||||||
|
|
||||||
vec4 mod289(vec4 x) {
|
|
||||||
return x - floor(x * (1.0 / 289.0)) * 289.0;
|
|
||||||
}
|
|
||||||
|
|
||||||
vec4 permute(vec4 x) {
|
|
||||||
return mod289(((x*34.0)+1.0)*x);
|
|
||||||
}
|
|
||||||
|
|
||||||
vec4 taylorInvSqrt(vec4 r)
|
|
||||||
{
|
|
||||||
return 1.79284291400159 - 0.85373472095314 * r;
|
|
||||||
}
|
|
||||||
|
|
||||||
float snoise(vec3 v)
|
|
||||||
{
|
|
||||||
const vec2 C = vec2(1.0/6.0, 1.0/3.0) ;
|
|
||||||
const vec4 D = vec4(0.0, 0.5, 1.0, 2.0);
|
|
||||||
|
|
||||||
// First corner
|
|
||||||
vec3 i = floor(v + dot(v, C.yyy) );
|
|
||||||
vec3 x0 = v - i + dot(i, C.xxx) ;
|
|
||||||
|
|
||||||
// Other corners
|
|
||||||
vec3 g = step(x0.yzx, x0.xyz);
|
|
||||||
vec3 l = 1.0 - g;
|
|
||||||
vec3 i1 = min( g.xyz, l.zxy );
|
|
||||||
vec3 i2 = max( g.xyz, l.zxy );
|
|
||||||
|
|
||||||
// x0 = x0 - 0.0 + 0.0 * C.xxx;
|
|
||||||
// x1 = x0 - i1 + 1.0 * C.xxx;
|
|
||||||
// x2 = x0 - i2 + 2.0 * C.xxx;
|
|
||||||
// x3 = x0 - 1.0 + 3.0 * C.xxx;
|
|
||||||
vec3 x1 = x0 - i1 + C.xxx;
|
|
||||||
vec3 x2 = x0 - i2 + C.yyy; // 2.0*C.x = 1/3 = C.y
|
|
||||||
vec3 x3 = x0 - D.yyy; // -1.0+3.0*C.x = -0.5 = -D.y
|
|
||||||
|
|
||||||
// Permutations
|
|
||||||
i = mod289(i);
|
|
||||||
vec4 p = permute( permute( permute(
|
|
||||||
i.z + vec4(0.0, i1.z, i2.z, 1.0 ))
|
|
||||||
+ i.y + vec4(0.0, i1.y, i2.y, 1.0 ))
|
|
||||||
+ i.x + vec4(0.0, i1.x, i2.x, 1.0 ));
|
|
||||||
|
|
||||||
// Gradients: 7x7 points over a square, mapped onto an octahedron.
|
|
||||||
// The ring size 17*17 = 289 is close to a multiple of 49 (49*6 = 294)
|
|
||||||
float n_ = 0.142857142857; // 1.0/7.0
|
|
||||||
vec3 ns = n_ * D.wyz - D.xzx;
|
|
||||||
|
|
||||||
vec4 j = p - 49.0 * floor(p * ns.z * ns.z); // mod(p,7*7)
|
|
||||||
|
|
||||||
vec4 x_ = floor(j * ns.z);
|
|
||||||
vec4 y_ = floor(j - 7.0 * x_ ); // mod(j,N)
|
|
||||||
|
|
||||||
vec4 x = x_ *ns.x + ns.yyyy;
|
|
||||||
vec4 y = y_ *ns.x + ns.yyyy;
|
|
||||||
vec4 h = 1.0 - abs(x) - abs(y);
|
|
||||||
|
|
||||||
vec4 b0 = vec4( x.xy, y.xy );
|
|
||||||
vec4 b1 = vec4( x.zw, y.zw );
|
|
||||||
|
|
||||||
//vec4 s0 = vec4(lessThan(b0,0.0))*2.0 - 1.0;
|
|
||||||
//vec4 s1 = vec4(lessThan(b1,0.0))*2.0 - 1.0;
|
|
||||||
vec4 s0 = floor(b0)*2.0 + 1.0;
|
|
||||||
vec4 s1 = floor(b1)*2.0 + 1.0;
|
|
||||||
vec4 sh = -step(h, vec4(0.0));
|
|
||||||
|
|
||||||
vec4 a0 = b0.xzyw + s0.xzyw*sh.xxyy ;
|
|
||||||
vec4 a1 = b1.xzyw + s1.xzyw*sh.zzww ;
|
|
||||||
|
|
||||||
vec3 p0 = vec3(a0.xy,h.x);
|
|
||||||
vec3 p1 = vec3(a0.zw,h.y);
|
|
||||||
vec3 p2 = vec3(a1.xy,h.z);
|
|
||||||
vec3 p3 = vec3(a1.zw,h.w);
|
|
||||||
|
|
||||||
//Normalise gradients
|
|
||||||
vec4 norm = taylorInvSqrt(vec4(dot(p0,p0), dot(p1,p1), dot(p2, p2), dot(p3,p3)));
|
|
||||||
p0 *= norm.x;
|
|
||||||
p1 *= norm.y;
|
|
||||||
p2 *= norm.z;
|
|
||||||
p3 *= norm.w;
|
|
||||||
|
|
||||||
// Mix final noise value
|
|
||||||
vec4 m = max(0.6 - vec4(dot(x0,x0), dot(x1,x1), dot(x2,x2), dot(x3,x3)), 0.0);
|
|
||||||
m = m * m;
|
|
||||||
return 42.0 * dot( m*m, vec4( dot(p0,x0), dot(p1,x1),
|
|
||||||
dot(p2,x2), dot(p3,x3) ) );
|
|
||||||
}
|
|
||||||
|
|
||||||
float fog(float dist) {
|
|
||||||
dist = max(0,dist - 50);
|
|
||||||
dist = dist * 0.05;
|
|
||||||
// dist = dist*dist;
|
|
||||||
return 1-exp(-dist);
|
|
||||||
}
|
|
||||||
|
|
||||||
smooth in vec2 teTexCoord;
|
|
||||||
smooth in vec3 teNormal;
|
|
||||||
smooth in vec3 tePosition;
|
|
||||||
smooth in float fogDist;
|
|
||||||
smooth in float gmix;
|
|
||||||
|
|
||||||
out vec4 fgColor;
|
|
||||||
|
|
||||||
uniform mat4 ViewMatrix;
|
|
||||||
uniform mat4 ProjectionMatrix;
|
|
||||||
|
|
||||||
void main(void)
|
|
||||||
{
|
|
||||||
fgColor = vec4(1.0,0.0,1.0,1.0);
|
|
||||||
}
|
|
||||||
|
|
||||||
@ -1,27 +0,0 @@
|
|||||||
#version 330
|
|
||||||
#extension GL_ARB_tessellation_shader : require
|
|
||||||
|
|
||||||
layout(vertices = 3) out;
|
|
||||||
in vec3 vPosition[];
|
|
||||||
in vec2 vTexCoord[];
|
|
||||||
in vec3 vNormal[];
|
|
||||||
out vec3 tcPosition[];
|
|
||||||
out vec2 tcTexCoord[];
|
|
||||||
out vec3 tcNormal[];
|
|
||||||
uniform float TessLevelInner = 1.0; // controlled by keyboard buttons
|
|
||||||
uniform float TessLevelOuter = 1.0; // controlled by keyboard buttons
|
|
||||||
|
|
||||||
#define ID gl_InvocationID
|
|
||||||
|
|
||||||
void main()
|
|
||||||
{
|
|
||||||
tcPosition[ID] = vPosition[ID];
|
|
||||||
tcTexCoord[ID] = vTexCoord[ID];
|
|
||||||
tcNormal[ID] = vNormal[ID];
|
|
||||||
if (ID == 0) {
|
|
||||||
gl_TessLevelInner[0] = TessLevelInner;
|
|
||||||
gl_TessLevelOuter[0] = TessLevelOuter;
|
|
||||||
gl_TessLevelOuter[1] = TessLevelOuter;
|
|
||||||
gl_TessLevelOuter[2] = TessLevelOuter;
|
|
||||||
}
|
|
||||||
}
|
|
||||||
@ -1,151 +0,0 @@
|
|||||||
#version 330
|
|
||||||
|
|
||||||
#extension GL_ARB_tessellation_shader : require
|
|
||||||
|
|
||||||
//#include "shaders/3rdParty/noise.glsl"
|
|
||||||
|
|
||||||
vec3 mod289(vec3 x) {
|
|
||||||
return x - floor(x * (1.0 / 289.0)) * 289.0;
|
|
||||||
}
|
|
||||||
|
|
||||||
vec4 mod289(vec4 x) {
|
|
||||||
return x - floor(x * (1.0 / 289.0)) * 289.0;
|
|
||||||
}
|
|
||||||
|
|
||||||
vec4 permute(vec4 x) {
|
|
||||||
return mod289(((x*34.0)+1.0)*x);
|
|
||||||
}
|
|
||||||
|
|
||||||
vec4 taylorInvSqrt(vec4 r)
|
|
||||||
{
|
|
||||||
return 1.79284291400159 - 0.85373472095314 * r;
|
|
||||||
}
|
|
||||||
|
|
||||||
float snoise(vec3 v)
|
|
||||||
{
|
|
||||||
const vec2 C = vec2(1.0/6.0, 1.0/3.0) ;
|
|
||||||
const vec4 D = vec4(0.0, 0.5, 1.0, 2.0);
|
|
||||||
|
|
||||||
// First corner
|
|
||||||
vec3 i = floor(v + dot(v, C.yyy) );
|
|
||||||
vec3 x0 = v - i + dot(i, C.xxx) ;
|
|
||||||
|
|
||||||
// Other corners
|
|
||||||
vec3 g = step(x0.yzx, x0.xyz);
|
|
||||||
vec3 l = 1.0 - g;
|
|
||||||
vec3 i1 = min( g.xyz, l.zxy );
|
|
||||||
vec3 i2 = max( g.xyz, l.zxy );
|
|
||||||
|
|
||||||
// x0 = x0 - 0.0 + 0.0 * C.xxx;
|
|
||||||
// x1 = x0 - i1 + 1.0 * C.xxx;
|
|
||||||
// x2 = x0 - i2 + 2.0 * C.xxx;
|
|
||||||
// x3 = x0 - 1.0 + 3.0 * C.xxx;
|
|
||||||
vec3 x1 = x0 - i1 + C.xxx;
|
|
||||||
vec3 x2 = x0 - i2 + C.yyy; // 2.0*C.x = 1/3 = C.y
|
|
||||||
vec3 x3 = x0 - D.yyy; // -1.0+3.0*C.x = -0.5 = -D.y
|
|
||||||
|
|
||||||
// Permutations
|
|
||||||
i = mod289(i);
|
|
||||||
vec4 p = permute( permute( permute(
|
|
||||||
i.z + vec4(0.0, i1.z, i2.z, 1.0 ))
|
|
||||||
+ i.y + vec4(0.0, i1.y, i2.y, 1.0 ))
|
|
||||||
+ i.x + vec4(0.0, i1.x, i2.x, 1.0 ));
|
|
||||||
|
|
||||||
// Gradients: 7x7 points over a square, mapped onto an octahedron.
|
|
||||||
// The ring size 17*17 = 289 is close to a multiple of 49 (49*6 = 294)
|
|
||||||
float n_ = 0.142857142857; // 1.0/7.0
|
|
||||||
vec3 ns = n_ * D.wyz - D.xzx;
|
|
||||||
|
|
||||||
vec4 j = p - 49.0 * floor(p * ns.z * ns.z); // mod(p,7*7)
|
|
||||||
|
|
||||||
vec4 x_ = floor(j * ns.z);
|
|
||||||
vec4 y_ = floor(j - 7.0 * x_ ); // mod(j,N)
|
|
||||||
|
|
||||||
vec4 x = x_ *ns.x + ns.yyyy;
|
|
||||||
vec4 y = y_ *ns.x + ns.yyyy;
|
|
||||||
vec4 h = 1.0 - abs(x) - abs(y);
|
|
||||||
|
|
||||||
vec4 b0 = vec4( x.xy, y.xy );
|
|
||||||
vec4 b1 = vec4( x.zw, y.zw );
|
|
||||||
|
|
||||||
//vec4 s0 = vec4(lessThan(b0,0.0))*2.0 - 1.0;
|
|
||||||
//vec4 s1 = vec4(lessThan(b1,0.0))*2.0 - 1.0;
|
|
||||||
vec4 s0 = floor(b0)*2.0 + 1.0;
|
|
||||||
vec4 s1 = floor(b1)*2.0 + 1.0;
|
|
||||||
vec4 sh = -step(h, vec4(0.0));
|
|
||||||
|
|
||||||
vec4 a0 = b0.xzyw + s0.xzyw*sh.xxyy ;
|
|
||||||
vec4 a1 = b1.xzyw + s1.xzyw*sh.zzww ;
|
|
||||||
|
|
||||||
vec3 p0 = vec3(a0.xy,h.x);
|
|
||||||
vec3 p1 = vec3(a0.zw,h.y);
|
|
||||||
vec3 p2 = vec3(a1.xy,h.z);
|
|
||||||
vec3 p3 = vec3(a1.zw,h.w);
|
|
||||||
|
|
||||||
//Normalise gradients
|
|
||||||
vec4 norm = taylorInvSqrt(vec4(dot(p0,p0), dot(p1,p1), dot(p2, p2), dot(p3,p3)));
|
|
||||||
p0 *= norm.x;
|
|
||||||
p1 *= norm.y;
|
|
||||||
p2 *= norm.z;
|
|
||||||
p3 *= norm.w;
|
|
||||||
|
|
||||||
// Mix final noise value
|
|
||||||
vec4 m = max(0.6 - vec4(dot(x0,x0), dot(x1,x1), dot(x2,x2), dot(x3,x3)), 0.0);
|
|
||||||
m = m * m;
|
|
||||||
return 42.0 * dot( m*m, vec4( dot(p0,x0), dot(p1,x1),
|
|
||||||
dot(p2,x2), dot(p3,x3) ) );
|
|
||||||
}
|
|
||||||
|
|
||||||
|
|
||||||
layout(triangles, equal_spacing, cw) in;
|
|
||||||
in vec3 tcPosition[];
|
|
||||||
in vec2 tcTexCoord[];
|
|
||||||
in vec3 tcNormal[];
|
|
||||||
smooth out vec2 teTexCoord
|
|
||||||
smooth out vec3 tePosition;
|
|
||||||
smooth out vec3 teNormal;
|
|
||||||
smooth out float fogDist;
|
|
||||||
smooth out float gmix; //mixture of gravel
|
|
||||||
//out vec3 tePatchDistance;
|
|
||||||
//constant projection matrix
|
|
||||||
uniform mat4 ProjectionMatrix;
|
|
||||||
uniform mat4 ViewMatrix;
|
|
||||||
uniform mat3 NormalMatrix;
|
|
||||||
|
|
||||||
void main()
|
|
||||||
{
|
|
||||||
//base color
|
|
||||||
color = vec4(1.0,0.0,1.0,1.0);
|
|
||||||
//NORMAL
|
|
||||||
vec3 n0 = gl_TessCoord.x * tcNormal[0];
|
|
||||||
vec3 n1 = gl_TessCoord.y * tcNormal[1];
|
|
||||||
vec3 n2 = gl_TessCoord.z * tcNormal[2];
|
|
||||||
vec3 tessNormal = normalize(n0 + n1 + n2);
|
|
||||||
teNormal = NormalMatrix * tessNormal;
|
|
||||||
|
|
||||||
//POSITION
|
|
||||||
vec3 p0 = gl_TessCoord.x * tcPosition[0];
|
|
||||||
vec3 p1 = gl_TessCoord.y * tcPosition[1];
|
|
||||||
vec3 p2 = gl_TessCoord.z * tcPosition[2];
|
|
||||||
tePosition = p0 + p1 + p2;
|
|
||||||
|
|
||||||
//sin(a,b) = length(cross(a,b))
|
|
||||||
float i0 = (1-gl_TessCoord.x)*gl_TessCoord.x * length(cross(tcNormal[0],tessNormal));
|
|
||||||
float i1 = (1-gl_TessCoord.y)*gl_TessCoord.y * length(cross(tcNormal[1],tessNormal));
|
|
||||||
float i2 = (1-gl_TessCoord.z)*gl_TessCoord.z * length(cross(tcNormal[2],tessNormal));
|
|
||||||
float standout = i0+i1+i2;
|
|
||||||
tePosition = tePosition+tessNormal*standout;
|
|
||||||
tePosition = tePosition+0.05*snoise(tePosition);
|
|
||||||
gl_Position = ProjectionMatrix * ViewMatrix * vec4(tePosition, 1);
|
|
||||||
fogDist = gl_Position.z;
|
|
||||||
|
|
||||||
//COLOR-BLENDING
|
|
||||||
vec2 t0 = gl_TessCoord.x * tcTexCoord[0];
|
|
||||||
vec2 t1 = gl_TessCoord.y * tcTexCoord[1];
|
|
||||||
vec2 t2 = gl_TessCoord.z * tcTexCoord[2];
|
|
||||||
teColor = t0 + t1 + t2;
|
|
||||||
|
|
||||||
//mix gravel based on incline (sin (normal,up))
|
|
||||||
gmix = length(cross(tessNormal, vec3(0,1,0)));
|
|
||||||
|
|
||||||
}
|
|
||||||
@ -1,18 +0,0 @@
|
|||||||
#version 330
|
|
||||||
|
|
||||||
//vertex-data
|
|
||||||
in vec3 Position;
|
|
||||||
in vec3 Normal;
|
|
||||||
in vec2 TexCoord;
|
|
||||||
|
|
||||||
//output-data for later stages
|
|
||||||
out vec2 vTexCoord;
|
|
||||||
out vec3 vPosition;
|
|
||||||
out vec3 vNormal;
|
|
||||||
|
|
||||||
void main()
|
|
||||||
{
|
|
||||||
vPosition = Position;
|
|
||||||
vNormal = Normal;
|
|
||||||
vTexCoord = TexCoord;
|
|
||||||
}
|
|
||||||
@ -1,21 +0,0 @@
|
|||||||
#version 330
|
|
||||||
|
|
||||||
in vec3 vPosition;
|
|
||||||
in vec3 vNormal;
|
|
||||||
|
|
||||||
out vec4 fgColor;
|
|
||||||
|
|
||||||
uniform mat4 ViewMatrix;
|
|
||||||
|
|
||||||
void main () {
|
|
||||||
//heliospheric lighting
|
|
||||||
vec4 light = vec4(1.0,1.0,1.0,1.0);
|
|
||||||
vec4 dark = vec4(0.0,0.0,0.0,1.0);
|
|
||||||
//direction to sun from origin
|
|
||||||
vec3 lightDir = normalize(ViewMatrix * vec4(5.0,5.0,1.0,0.0)).xyz;
|
|
||||||
|
|
||||||
float costheta = dot(vNormal, lightDir);
|
|
||||||
float a = costheta * 0.5 + 0.5;
|
|
||||||
|
|
||||||
fgColor = vec4(0.5,0.5,0.5,1)*mix(dark,light,a);
|
|
||||||
}
|
|
||||||
@ -1,21 +0,0 @@
|
|||||||
#version 330
|
|
||||||
|
|
||||||
layout(location=0) in vec3 Position;
|
|
||||||
layout(location=1) in vec3 Normal;
|
|
||||||
layout(location=2) in vec2 TexCoord;
|
|
||||||
uniform mat4 ProjectionMatrix;
|
|
||||||
uniform mat4 ViewMatrix;
|
|
||||||
uniform mat3 NormalMatrix;
|
|
||||||
uniform vec3 PositionOffset = vec3(5,2,5);
|
|
||||||
uniform float TessLevelInner = 1.0; // controlled by keyboard buttons
|
|
||||||
uniform float TessLevelOuter = 1.0; // controlled by keyboard buttons
|
|
||||||
|
|
||||||
out vec3 vPosition;
|
|
||||||
out vec3 vNormal;
|
|
||||||
|
|
||||||
void main () {
|
|
||||||
vPosition = Position;
|
|
||||||
//gl_Position = vec4(Position,1);
|
|
||||||
gl_Position = ProjectionMatrix * ViewMatrix * vec4(PositionOffset + Position, 1);
|
|
||||||
vNormal = Normal;
|
|
||||||
}
|
|
||||||
@ -1,11 +0,0 @@
|
|||||||
#version 110
|
|
||||||
|
|
||||||
uniform sampler2D tex[2];
|
|
||||||
varying vec2 texcoord;
|
|
||||||
|
|
||||||
void main()
|
|
||||||
{
|
|
||||||
vec4 map = texture2D(tex[0], texcoord);
|
|
||||||
vec4 hud = texture2D(tex[1], vec2(texcoord.x,-texcoord.y));
|
|
||||||
gl_FragColor = vec4(mix(map.rgb,hud.rgb,hud.a),1.0);
|
|
||||||
}
|
|
||||||
@ -1,10 +0,0 @@
|
|||||||
#version 110
|
|
||||||
|
|
||||||
attribute vec2 position;
|
|
||||||
varying vec2 texcoord;
|
|
||||||
|
|
||||||
void main()
|
|
||||||
{
|
|
||||||
gl_Position = vec4(position, 0.0, 1.0);
|
|
||||||
texcoord = position * vec2(0.5) + vec2(0.5);
|
|
||||||
}
|
|
||||||
@ -1,366 +0,0 @@
|
|||||||
{-# LANGUAGE RankNTypes #-}
|
|
||||||
|
|
||||||
-- | Parser for IQM-Files
|
|
||||||
--
|
|
||||||
-- Assumes that the file is stored with 32-Bit-BigEndian-Ints
|
|
||||||
module Importer.IQM.Parser (parseIQM) where
|
|
||||||
|
|
||||||
import Importer.IQM.Types
|
|
||||||
import Data.Attoparsec.ByteString.Char8
|
|
||||||
import Data.Attoparsec.ByteString
|
|
||||||
import Data.Attoparsec.Binary
|
|
||||||
import Data.ByteString.Char8 (pack)
|
|
||||||
import Data.ByteString (split, null, ByteString)
|
|
||||||
import Data.ByteString.Unsafe (unsafeUseAsCString)
|
|
||||||
import qualified Data.ByteString as B
|
|
||||||
import Graphics.GLUtil
|
|
||||||
import Graphics.Rendering.OpenGL.GL.StateVar (($=))
|
|
||||||
import Graphics.Rendering.OpenGL.GL.BufferObjects
|
|
||||||
import Graphics.Rendering.OpenGL.GL.VertexArrays
|
|
||||||
import Graphics.Rendering.OpenGL.GL.VertexArrayObjects
|
|
||||||
import Graphics.Rendering.OpenGL.GL.VertexSpec
|
|
||||||
import Graphics.Rendering.OpenGL.GL.ObjectName
|
|
||||||
import Data.Word
|
|
||||||
import Data.Int
|
|
||||||
import Unsafe.Coerce
|
|
||||||
import Control.Monad.Trans.State
|
|
||||||
import Control.Monad.Trans.Class
|
|
||||||
import Control.Monad
|
|
||||||
import Foreign.Ptr
|
|
||||||
import Foreign.Marshal.Alloc
|
|
||||||
import Foreign.Marshal.Utils
|
|
||||||
import Foreign.Storable (sizeOf)
|
|
||||||
|
|
||||||
import Prelude as P hiding (take, null)
|
|
||||||
|
|
||||||
import Render.Misc (printPtrAsFloatArray, printPtrAsUByteArray, printPtrAsWord32Array, withVBO, checkError)
|
|
||||||
|
|
||||||
-- | helper-function for creating an integral out of [8-Bit Ints]
|
|
||||||
_w8ToInt :: Integral a => a -> a -> a
|
|
||||||
_w8ToInt i add = 256*i + add
|
|
||||||
|
|
||||||
-- | shorthand-function for parsing Word8 into Integrals
|
|
||||||
_parseNum :: (Integral a, Integral b) => [a] -> b
|
|
||||||
_parseNum = foldl1 _w8ToInt . map fromIntegral
|
|
||||||
|
|
||||||
-- | read a 16-Bit Int from Parsing-Input and log 2 bytes in our Parsing-Monad
|
|
||||||
--
|
|
||||||
-- begins with _ to defeat ghc-warnings. Rename if used!
|
|
||||||
_int16 :: CParser Word16
|
|
||||||
_int16 = do
|
|
||||||
ret <- lift $ do
|
|
||||||
a <- anyWord8 :: Parser Word8
|
|
||||||
b <- anyWord8 :: Parser Word8
|
|
||||||
return $ _parseNum [b,a]
|
|
||||||
modify (+2)
|
|
||||||
return ret
|
|
||||||
|
|
||||||
-- | read a 32-Bit Int from Parsing-Input and log 4 bytes in our Parsing-Monad
|
|
||||||
_int32 :: CParser Int32
|
|
||||||
_int32 = do
|
|
||||||
ret <- lift $ do
|
|
||||||
a <- anyWord8 :: Parser Word8
|
|
||||||
b <- anyWord8 :: Parser Word8
|
|
||||||
c <- anyWord8 :: Parser Word8
|
|
||||||
d <- anyWord8 :: Parser Word8
|
|
||||||
return $ _parseNum [d,c,b,a]
|
|
||||||
modify (+4)
|
|
||||||
return ret
|
|
||||||
|
|
||||||
w32leCParser :: CParser Word32
|
|
||||||
w32leCParser = do
|
|
||||||
ret <- lift anyWord32le
|
|
||||||
modify (+4)
|
|
||||||
return ret
|
|
||||||
|
|
||||||
-- | Parser for the header
|
|
||||||
readHeader :: CParser IQMHeader
|
|
||||||
readHeader = do
|
|
||||||
_ <- lift $ string (pack "INTERQUAKEMODEL\0")
|
|
||||||
modify (+16)
|
|
||||||
v <- w32leCParser
|
|
||||||
lift $ when (v /= 2) $ fail "Version /= 2.\nThis Parser only supports Version 2 of the InterQuake-Model IQM"
|
|
||||||
-- when v /= 2 then fail parsing.
|
|
||||||
size' <- w32leCParser
|
|
||||||
flags' <- w32leCParser
|
|
||||||
num_text' <- w32leCParser
|
|
||||||
ofs_text' <- w32leCParser
|
|
||||||
num_meshes' <- w32leCParser
|
|
||||||
ofs_meshes' <- w32leCParser
|
|
||||||
num_vertexarrays' <- w32leCParser
|
|
||||||
num_vertexes' <- w32leCParser
|
|
||||||
ofs_vertexarrays' <- w32leCParser
|
|
||||||
num_triangles' <- w32leCParser
|
|
||||||
ofs_triangles' <- w32leCParser
|
|
||||||
ofs_adjacency' <- w32leCParser
|
|
||||||
num_joints' <- w32leCParser
|
|
||||||
ofs_joints' <- w32leCParser
|
|
||||||
num_poses' <- w32leCParser
|
|
||||||
ofs_poses' <- w32leCParser
|
|
||||||
num_anims' <- w32leCParser
|
|
||||||
ofs_anims' <- w32leCParser
|
|
||||||
num_frames' <- w32leCParser
|
|
||||||
num_framechannels' <- w32leCParser
|
|
||||||
ofs_frames' <- w32leCParser
|
|
||||||
ofs_bounds' <- w32leCParser
|
|
||||||
num_comment' <- w32leCParser
|
|
||||||
ofs_comment' <- w32leCParser
|
|
||||||
num_extensions' <- w32leCParser
|
|
||||||
ofs_extensions' <- w32leCParser
|
|
||||||
return IQMHeader { version = v
|
|
||||||
, filesize = size'
|
|
||||||
, flags = fromIntegral flags'
|
|
||||||
, num_text = num_text'
|
|
||||||
, ofs_text = ofs_text'
|
|
||||||
, num_meshes = num_meshes'
|
|
||||||
, ofs_meshes = ofs_meshes'
|
|
||||||
, num_vertexarrays = num_vertexarrays'
|
|
||||||
, num_vertexes = num_vertexes'
|
|
||||||
, ofs_vertexarrays = ofs_vertexarrays'
|
|
||||||
, num_triangles = num_triangles'
|
|
||||||
, ofs_triangles = ofs_triangles'
|
|
||||||
, ofs_adjacency = ofs_adjacency'
|
|
||||||
, num_joints = num_joints'
|
|
||||||
, ofs_joints = ofs_joints'
|
|
||||||
, num_poses = num_poses'
|
|
||||||
, ofs_poses = ofs_poses'
|
|
||||||
, num_anims = num_anims'
|
|
||||||
, ofs_anims = ofs_anims'
|
|
||||||
, num_frames = num_frames'
|
|
||||||
, num_framechannels = num_framechannels'
|
|
||||||
, ofs_frames = ofs_frames'
|
|
||||||
, ofs_bounds = ofs_bounds'
|
|
||||||
, num_comment = num_comment'
|
|
||||||
, ofs_comment = ofs_comment'
|
|
||||||
, num_extensions = num_extensions'
|
|
||||||
, ofs_extensions = ofs_extensions'
|
|
||||||
}
|
|
||||||
|
|
||||||
-- | Parser for Mesh-Structure
|
|
||||||
readMesh :: CParser IQMMesh
|
|
||||||
readMesh = do
|
|
||||||
name <- w32leCParser
|
|
||||||
mat <- w32leCParser
|
|
||||||
fv <- w32leCParser
|
|
||||||
nv <- w32leCParser
|
|
||||||
ft <- w32leCParser
|
|
||||||
nt <- w32leCParser
|
|
||||||
return IQMMesh
|
|
||||||
{ meshName = if name == 0 then Nothing else Just (Mesh name)
|
|
||||||
, meshMaterial = mat
|
|
||||||
, meshFirstVertex = fv
|
|
||||||
, meshNumVertexes = nv
|
|
||||||
, meshFirstTriangle = ft
|
|
||||||
, meshNumTriangles = nt
|
|
||||||
}
|
|
||||||
|
|
||||||
-- | helper to read n consecutive Meshes tail-recursive
|
|
||||||
readMeshes :: Int -> CParser [IQMMesh]
|
|
||||||
readMeshes 1 = do
|
|
||||||
m <- readMesh
|
|
||||||
return [m]
|
|
||||||
readMeshes n = do
|
|
||||||
m <- readMesh
|
|
||||||
ms <- readMeshes (n-1)
|
|
||||||
return $ m:ms
|
|
||||||
|
|
||||||
-- | Parser for Mesh-Structure
|
|
||||||
readVAF :: CParser IQMVertexArray
|
|
||||||
readVAF = do
|
|
||||||
vat <- rawEnumToVAT =<< w32leCParser
|
|
||||||
flags' <- w32leCParser
|
|
||||||
format <- rawEnumToVAF =<< w32leCParser
|
|
||||||
size <- w32leCParser
|
|
||||||
offset <- w32leCParser
|
|
||||||
return $ IQMVertexArray vat (fromIntegral flags') format (fromIntegral size) offset nullPtr
|
|
||||||
|
|
||||||
-- | helper to read n consecutive Meshes tail-recursive
|
|
||||||
readVAFs :: Int -> CParser [IQMVertexArray]
|
|
||||||
readVAFs 1 = do
|
|
||||||
f <- readVAF
|
|
||||||
return [f]
|
|
||||||
readVAFs n = do
|
|
||||||
f <- readVAF
|
|
||||||
fs <- readVAFs (n-1)
|
|
||||||
return $ f:fs
|
|
||||||
|
|
||||||
-- | helper-Notation for subtracting 2 integral values of different kind in the precision
|
|
||||||
-- of the target-kind
|
|
||||||
(.-) :: forall a a1 a2.
|
|
||||||
(Num a, Integral a2, Integral a1) =>
|
|
||||||
a1 -> a2 -> a
|
|
||||||
(.-) a b = fromIntegral a - fromIntegral b
|
|
||||||
|
|
||||||
infix 5 .-
|
|
||||||
|
|
||||||
-- | skips (=drops) all input until the internal counter is at a given bytecount
|
|
||||||
--
|
|
||||||
-- Fails the parser if given bytecount is lower than the internal counter as we
|
|
||||||
-- read sequentially and do not do backtracking
|
|
||||||
skipToCounter :: Integral a => a -> CParser ()
|
|
||||||
skipToCounter a = do
|
|
||||||
let d = fromIntegral a
|
|
||||||
c <- get
|
|
||||||
when (d < c) $ fail "wanting to skip to counter already passed"
|
|
||||||
_ <- lift $ take $ d .- c
|
|
||||||
put d
|
|
||||||
|
|
||||||
-- | Parses an IQM-File and handles back the Haskell-Structure
|
|
||||||
--
|
|
||||||
-- Does a 2-Pass-Parsing. Reads in Structure on first pass (O(n))and
|
|
||||||
-- fills the Structure in a 2nd Pass from Offsets (O(memcpy'd bytes)).
|
|
||||||
parseIQM :: String -> IO IQM
|
|
||||||
parseIQM a =
|
|
||||||
do
|
|
||||||
f <- B.readFile a
|
|
||||||
-- Parse Headers/Offsets to BareIQM
|
|
||||||
let result = parse doIQMparse f
|
|
||||||
bare <- case result of
|
|
||||||
Done _ x -> return x
|
|
||||||
y -> error $ show y
|
|
||||||
-- Fill Vertex-Array with buffer objects and data of Offsets
|
|
||||||
va' <- mapM (readInVAO f (num_vertexes.bareheader $ bare)) (barevertexArrays bare)
|
|
||||||
|
|
||||||
-- create VAO with attached vbos
|
|
||||||
vao <- makeVAO $ do
|
|
||||||
-- generate array buffers
|
|
||||||
--
|
|
||||||
--for pos,normal,tex:
|
|
||||||
let initBuffer :: AttribLocation -> IQMVertexArrayType -> [IQMVertexArray] -> Int -> IO ()
|
|
||||||
initBuffer l t vas len' =
|
|
||||||
do
|
|
||||||
-- find array with type t, otherwise abort hard.
|
|
||||||
let (IQMVertexArray _ _ format num _ dat) = case filter (\(IQMVertexArray ty _ _ _ _ _) -> ty == t) vas of
|
|
||||||
[b] -> b
|
|
||||||
_ -> error $ "Current object does not support " ++ (show t)
|
|
||||||
buf <- genObjectName
|
|
||||||
-- create buffer and write data
|
|
||||||
withVBO buf (toBufferTargetfromVAType t) $ do
|
|
||||||
-- copy data
|
|
||||||
bufferData (toBufferTargetfromVAType t) $= (fromIntegral len' * fromIntegral num * (fromIntegral.vaSize) format,dat,StaticDraw)
|
|
||||||
checkError "bufferData vao"
|
|
||||||
-- tell layout
|
|
||||||
vertexAttribPointer l $= (ToFloat, VertexArrayDescriptor num Float 0 nullPtr)
|
|
||||||
let len = (fromIntegral.num_vertexes.bareheader) bare
|
|
||||||
initBuffer (AttribLocation 0) IQMPosition va' len
|
|
||||||
initBuffer (AttribLocation 1) IQMNormal va' len
|
|
||||||
initBuffer (AttribLocation 2) IQMTexCoord va' len
|
|
||||||
|
|
||||||
-- for indices
|
|
||||||
tbo <- genObjectName
|
|
||||||
tris <- withVBO tbo ArrayBuffer $ do
|
|
||||||
let
|
|
||||||
len = (fromIntegral.num_triangles.bareheader) bare
|
|
||||||
byteLen = len * 3 * sizeOf (undefined :: Word32)
|
|
||||||
data' = skipDrop ((fromIntegral.ofs_triangles.bareheader) bare) byteLen f
|
|
||||||
p <- mallocBytes byteLen
|
|
||||||
unsafeUseAsCString data' (\s -> copyBytes p s byteLen)
|
|
||||||
withVBO tbo ElementArrayBuffer $ do
|
|
||||||
bufferData ElementArrayBuffer $= (fromIntegral byteLen, p, StaticDraw)
|
|
||||||
checkError "bufferData tris"
|
|
||||||
return $ castPtr p
|
|
||||||
--putStrLn "Triangles:"
|
|
||||||
--printPtrAsWord32Array tris ((*3).fromIntegral.num_triangles.bareheader $ bare) 3
|
|
||||||
--print bare
|
|
||||||
return $ IQM
|
|
||||||
{ header = bareheader bare
|
|
||||||
, texts = baretexts bare
|
|
||||||
, meshes = baremeshes bare
|
|
||||||
, vertexArrays = va'
|
|
||||||
, vertexBufferObjects = []
|
|
||||||
, vertexArrayObject = vao
|
|
||||||
, triangles = tris
|
|
||||||
, triangleBufferObject = tbo
|
|
||||||
}
|
|
||||||
|
|
||||||
createVAO :: [(IQMVertexArray, BufferObject)] -> IO ()
|
|
||||||
createVAO bo = do
|
|
||||||
--print bo
|
|
||||||
initVAO (AttribLocation 0) IQMPosition bo
|
|
||||||
initVAO (AttribLocation 1) IQMNormal bo
|
|
||||||
initVAO (AttribLocation 2) IQMTexCoord bo
|
|
||||||
|
|
||||||
initVAO :: AttribLocation -> IQMVertexArrayType -> [(IQMVertexArray, BufferObject)] -> IO ()
|
|
||||||
initVAO l t bo = do
|
|
||||||
--print $ concat ["adding ", show t, " to vertexBufferObject"]
|
|
||||||
let (IQMVertexArray _ _ _ num _ _,buf) = case filter (\(IQMVertexArray ty _ _ _ _ _, _) -> ty == t) bo of
|
|
||||||
[(a,b)] -> (a,b)
|
|
||||||
_ -> error "IQM-Object not render-able with current shader-mechanics"
|
|
||||||
bindBuffer (toBufferTargetfromVAType t) $= Just buf
|
|
||||||
vertexAttribArray l $= Enabled
|
|
||||||
vertexAttribPointer l $= (ToFloat, VertexArrayDescriptor num Float 0 nullPtr)
|
|
||||||
|
|
||||||
-- | Creates a BufferObject on the Graphicscard for each BufferObject
|
|
||||||
|
|
||||||
toVBOfromVAO :: IQMVertexArray -> IO BufferObject
|
|
||||||
toVBOfromVAO (IQMVertexArray type' _ _ num _ ptr) =
|
|
||||||
fromPtr (toBufferTargetfromVAType type') (fromIntegral num) ptr
|
|
||||||
|
|
||||||
-- | translates from VA-type to BufferTarget
|
|
||||||
|
|
||||||
toBufferTargetfromVAType :: IQMVertexArrayType -> BufferTarget
|
|
||||||
toBufferTargetfromVAType IQMPosition = ArrayBuffer
|
|
||||||
toBufferTargetfromVAType IQMTexCoord = ArrayBuffer
|
|
||||||
toBufferTargetfromVAType IQMNormal = ArrayBuffer
|
|
||||||
toBufferTargetfromVAType IQMBlendIndexes = ElementArrayBuffer
|
|
||||||
toBufferTargetfromVAType IQMBlendWeights = ArrayBuffer
|
|
||||||
toBufferTargetfromVAType IQMColor = ArrayBuffer
|
|
||||||
toBufferTargetfromVAType _ = ArrayBuffer
|
|
||||||
|
|
||||||
-- | Allocates memory for the Vertex-data and copies it over there
|
|
||||||
-- from the given input-String
|
|
||||||
--
|
|
||||||
-- Note: The String-Operations are O(1), so only O(numberOfCopiedBytes)
|
|
||||||
-- is needed in term of computation.
|
|
||||||
readInVAO :: ByteString -> Word32 -> IQMVertexArray -> IO IQMVertexArray
|
|
||||||
readInVAO d vcount (IQMVertexArray type' a format num offset ptr) =
|
|
||||||
do
|
|
||||||
let
|
|
||||||
numElems = fromIntegral vcount * fromIntegral num
|
|
||||||
byteLen = numElems * vaSize format
|
|
||||||
data' = skipDrop (fromIntegral offset) byteLen d
|
|
||||||
|
|
||||||
unless (ptr == nullPtr) $ error $ "Error reading Vertex-Array: Double Read of " ++ show type'
|
|
||||||
p <- mallocBytes byteLen
|
|
||||||
putStrLn $ concat ["Allocating ", show vcount ,"x", show num,"x",show (vaSize format)," = ", show byteLen, " Bytes at ", show p, " for ", show type']
|
|
||||||
putStrLn $ concat ["Filling starting at ", show offset, " with: "]
|
|
||||||
unsafeUseAsCString data' (\s -> copyBytes p s byteLen)
|
|
||||||
{-case type' of
|
|
||||||
IQMBlendIndexes -> printPtrAsUByteArray p numElems 4
|
|
||||||
IQMBlendWeights -> printPtrAsUByteArray p numElems 4
|
|
||||||
IQMTexCoord -> printPtrAsFloatArray p numElems 2
|
|
||||||
_ -> printPtrAsFloatArray p numElems 3-}
|
|
||||||
return $ IQMVertexArray type' a format num offset $ castPtr p
|
|
||||||
|
|
||||||
-- | Real internal Parser.
|
|
||||||
--
|
|
||||||
-- Consumes the String only once, thus in O(n). But all Data-Structures are
|
|
||||||
-- not allocated and copied. readInVAO has to be called on each one.
|
|
||||||
doIQMparse :: Parser BareIQM
|
|
||||||
doIQMparse =
|
|
||||||
flip evalStateT 0 $ --evaluate parser with state starting at 0
|
|
||||||
do
|
|
||||||
h <- readHeader --read header
|
|
||||||
skipToCounter $ ofs_text h --skip 0-n bytes to get to text
|
|
||||||
text <- lift . take . fromIntegral $ num_text h --read texts
|
|
||||||
modify . (+) . fromIntegral $ num_text h --put offset forward
|
|
||||||
skipToCounter $ ofs_meshes h --skip 0-n bytes to get to meshes
|
|
||||||
meshes' <- readMeshes $ fromIntegral $ num_meshes h --read meshes
|
|
||||||
skipToCounter $ ofs_vertexarrays h --skip 0-n bytes to get to Vertex-Arrays
|
|
||||||
vaf <- readVAFs $ fromIntegral $ num_vertexarrays h --read Vertex-Arrays
|
|
||||||
return BareIQM
|
|
||||||
{ bareheader = h
|
|
||||||
, baretexts = filter (not.null) (split (unsafeCoerce '\0') text)
|
|
||||||
, baremeshes = meshes'
|
|
||||||
, barevertexArrays = vaf
|
|
||||||
}
|
|
||||||
|
|
||||||
-- | Helper-Function for Extracting a random substring out of a Bytestring
|
|
||||||
-- by the Offsets provided.
|
|
||||||
--
|
|
||||||
-- O(1).
|
|
||||||
skipDrop :: Int -- ^ Bytes to drop
|
|
||||||
-> Int -- ^ Bytes to take
|
|
||||||
-> ByteString
|
|
||||||
-> ByteString
|
|
||||||
skipDrop a b= B.take b . B.drop a
|
|
||||||
@ -1,221 +0,0 @@
|
|||||||
-- {-# LANGUAGE ExistentialQuantification, RankNTypes, CPP, BangPatterns #-}
|
|
||||||
-- | Word32 or Word64 - depending on implementation. Format just specifies "uint".
|
|
||||||
-- 4-Byte in the documentation indicates Word32 - but not specified!
|
|
||||||
module Importer.IQM.Types where
|
|
||||||
|
|
||||||
import Control.Monad.Trans.State.Lazy (StateT)
|
|
||||||
import Data.Int
|
|
||||||
import Data.Word
|
|
||||||
import Data.ByteString
|
|
||||||
import Data.Attoparsec.ByteString.Char8
|
|
||||||
import Foreign.Ptr
|
|
||||||
import Graphics.Rendering.OpenGL.Raw.Types
|
|
||||||
import Prelude as P
|
|
||||||
import Foreign.Storable
|
|
||||||
import Foreign.C.Types
|
|
||||||
import Graphics.Rendering.OpenGL.GL.BufferObjects hiding (Offset)
|
|
||||||
import Graphics.Rendering.OpenGL.GL.VertexArrayObjects
|
|
||||||
|
|
||||||
-- | Mesh-Indices to distinguish the meshes referenced
|
|
||||||
newtype Mesh = Mesh Word32 deriving (Show, Eq)
|
|
||||||
-- | State-Wrapped Parser-Monad which is capable of counting the
|
|
||||||
-- Bytes read for offset-gap reasons
|
|
||||||
type CParser a = StateT Int64 Parser a
|
|
||||||
|
|
||||||
-- | Alias
|
|
||||||
type Flags = GLbitfield -- ^ Alias for UInt32
|
|
||||||
|
|
||||||
-- | Alias
|
|
||||||
type Offset = Word32 -- ^ Alias for UInt32
|
|
||||||
|
|
||||||
-- | Alias
|
|
||||||
type Index = GLuint -- ^ Alias for UInt32
|
|
||||||
|
|
||||||
-- | Alias
|
|
||||||
type NumComponents = GLsizei -- ^ Alias for UInt32
|
|
||||||
|
|
||||||
-- | Data-BLOB inside IQM
|
|
||||||
type IQMData = Ptr IQMVertexArrayFormat -- ^ Pointer for Data
|
|
||||||
|
|
||||||
-- | Header of IQM-Format.
|
|
||||||
--
|
|
||||||
-- ofs_* fields are relative to the beginning of the iqmheader struct
|
|
||||||
--
|
|
||||||
-- ofs_* fields are set to 0 when data is empty
|
|
||||||
--
|
|
||||||
-- ofs_* fields are aligned at 4-byte-boundaries
|
|
||||||
data IQMHeader = IQMHeader
|
|
||||||
{ version :: !Word32 -- ^ Must be 2
|
|
||||||
, filesize :: !Word32
|
|
||||||
, flags :: !Flags
|
|
||||||
, num_text :: !Word32
|
|
||||||
, ofs_text :: !Offset
|
|
||||||
, num_meshes :: !Word32
|
|
||||||
, ofs_meshes :: !Offset
|
|
||||||
, num_vertexarrays :: !Word32
|
|
||||||
, num_vertexes :: !Word32
|
|
||||||
, ofs_vertexarrays :: !Offset
|
|
||||||
, num_triangles :: !Word32
|
|
||||||
, ofs_triangles :: !Offset
|
|
||||||
, ofs_adjacency :: !Offset
|
|
||||||
, num_joints :: !Word32
|
|
||||||
, ofs_joints :: !Offset
|
|
||||||
, num_poses :: !Word32
|
|
||||||
, ofs_poses :: !Offset
|
|
||||||
, num_anims :: !Word32
|
|
||||||
, ofs_anims :: !Offset
|
|
||||||
, num_frames :: !Word32
|
|
||||||
, num_framechannels :: !Word32
|
|
||||||
, ofs_frames :: !Offset
|
|
||||||
, ofs_bounds :: !Offset
|
|
||||||
, num_comment :: !Word32
|
|
||||||
, ofs_comment :: !Offset
|
|
||||||
, num_extensions :: !Word32 -- ^ stored as linked list, not as array.
|
|
||||||
, ofs_extensions :: !Offset
|
|
||||||
} deriving (Show, Eq)
|
|
||||||
|
|
||||||
-- | Format of an IQM-Mesh Structure.
|
|
||||||
--
|
|
||||||
-- Read it like a Header of the Meshes lateron in the Format
|
|
||||||
data IQMMesh = IQMMesh
|
|
||||||
{ meshName :: Maybe Mesh
|
|
||||||
, meshMaterial :: Word32
|
|
||||||
, meshFirstVertex :: Word32
|
|
||||||
, meshNumVertexes :: Word32
|
|
||||||
, meshFirstTriangle :: Word32
|
|
||||||
, meshNumTriangles :: Word32
|
|
||||||
} deriving (Show, Eq)
|
|
||||||
|
|
||||||
-- | Format of IQM-Triangle Structure
|
|
||||||
data IQMTriangle = IQMTriangle VertexIndex VertexIndex VertexIndex
|
|
||||||
|
|
||||||
-- | Type-Alias for Word32 indicating an index on vertices in IQMMesh
|
|
||||||
type VertexIndex = Word32
|
|
||||||
|
|
||||||
-- | Type-Alias for Word32 indicating an index on IQMTriangle
|
|
||||||
type TriangleIndex = Word32
|
|
||||||
|
|
||||||
-- | From the IQM-Format-Description:
|
|
||||||
--
|
|
||||||
-- each value is the index of the adjacent triangle for edge 0, 1, and 2, where ~0 (= -1)
|
|
||||||
-- indicates no adjacent triangle indexes are relative to the iqmheader.ofs_triangles array
|
|
||||||
-- and span all meshes, where 0 is the first triangle, 1 is the second, 2 is the third, etc.
|
|
||||||
data IQMAdjacency = IQMAdjacency TriangleIndex TriangleIndex TriangleIndex
|
|
||||||
|
|
||||||
-- | Format of a whole IQM-File
|
|
||||||
--
|
|
||||||
-- still unfinished!
|
|
||||||
data IQM = IQM
|
|
||||||
{ header :: IQMHeader
|
|
||||||
, texts :: [ByteString]
|
|
||||||
, meshes :: [IQMMesh]
|
|
||||||
, vertexArrays :: [IQMVertexArray]
|
|
||||||
, vertexBufferObjects :: [BufferObject]
|
|
||||||
, vertexArrayObject :: VertexArrayObject
|
|
||||||
, triangles :: Ptr Word32
|
|
||||||
, triangleBufferObject :: BufferObject
|
|
||||||
} deriving (Show, Eq)
|
|
||||||
|
|
||||||
-- | Internal format of an unprocessed IQM
|
|
||||||
--
|
|
||||||
-- for internal and temporary use only
|
|
||||||
|
|
||||||
data BareIQM = BareIQM
|
|
||||||
{ bareheader :: IQMHeader
|
|
||||||
, baretexts :: [ByteString]
|
|
||||||
, baremeshes :: [IQMMesh]
|
|
||||||
, barevertexArrays :: [IQMVertexArray]
|
|
||||||
} deriving (Show, Eq)
|
|
||||||
|
|
||||||
|
|
||||||
-- | Different Vertex-Array-Types in IQM
|
|
||||||
--
|
|
||||||
-- Custom Types have to be > 0x10 as of specification
|
|
||||||
data IQMVertexArrayType = IQMPosition
|
|
||||||
| IQMTexCoord
|
|
||||||
| IQMNormal
|
|
||||||
| IQMTangent
|
|
||||||
| IQMBlendIndexes
|
|
||||||
| IQMBlendWeights
|
|
||||||
| IQMColor
|
|
||||||
| IQMCustomVAT Word32
|
|
||||||
deriving (Show, Eq)
|
|
||||||
|
|
||||||
-- | Lookup-Function for internal enum to VertexArrayFormat
|
|
||||||
rawEnumToVAT :: Word32 -> CParser IQMVertexArrayType
|
|
||||||
rawEnumToVAT 0 = return IQMPosition
|
|
||||||
rawEnumToVAT 1 = return IQMTexCoord
|
|
||||||
rawEnumToVAT 2 = return IQMNormal
|
|
||||||
rawEnumToVAT 3 = return IQMTangent
|
|
||||||
rawEnumToVAT 4 = return IQMBlendIndexes
|
|
||||||
rawEnumToVAT 5 = return IQMBlendWeights
|
|
||||||
rawEnumToVAT 6 = return IQMColor
|
|
||||||
rawEnumToVAT a = return $ IQMCustomVAT a
|
|
||||||
|
|
||||||
-- | Vetrex-Array-Format of the data found at offset
|
|
||||||
data IQMVertexArrayFormat = IQMbyte
|
|
||||||
| IQMubyte
|
|
||||||
| IQMshort
|
|
||||||
| IQMushort
|
|
||||||
| IQMint
|
|
||||||
| IQMuint
|
|
||||||
| IQMhalf
|
|
||||||
| IQMfloat
|
|
||||||
| IQMdouble
|
|
||||||
-- | Unknown Word32
|
|
||||||
deriving (Show, Eq)
|
|
||||||
|
|
||||||
-- | Get the Size (in Bytes) of the given IQMVertexArrayFormat-Struct
|
|
||||||
vaSize :: IQMVertexArrayFormat -> Int
|
|
||||||
vaSize IQMbyte = sizeOf (undefined :: CSChar)
|
|
||||||
vaSize IQMubyte = sizeOf (undefined :: CUChar)
|
|
||||||
vaSize IQMshort = sizeOf (undefined :: CShort)
|
|
||||||
vaSize IQMushort = sizeOf (undefined :: CUShort)
|
|
||||||
vaSize IQMint = sizeOf (undefined :: CInt)
|
|
||||||
vaSize IQMuint = sizeOf (undefined :: CUInt)
|
|
||||||
vaSize IQMhalf = sizeOf (undefined :: Word16) --TODO: Find 16-Bit-Float-Datatype FIXME!
|
|
||||||
vaSize IQMfloat = sizeOf (undefined :: CFloat)
|
|
||||||
vaSize IQMdouble = sizeOf (undefined :: CDouble)
|
|
||||||
|
|
||||||
--mallocVArray :: Storable a => IQMVertexArrayFormat -> Int -> IO (Ptr a)
|
|
||||||
--mallocVArray IQMbyte n = mallocArray n :: IO (Ptr CSChar)
|
|
||||||
--mallocVArray IQMubyte n = mallocArray n :: IO (Ptr CUChar)
|
|
||||||
|
|
||||||
-- | Lookup-Function for internal enum to VertexArrayFormat
|
|
||||||
rawEnumToVAF :: Word32 -> CParser IQMVertexArrayFormat
|
|
||||||
rawEnumToVAF 0 = return IQMbyte
|
|
||||||
rawEnumToVAF 1 = return IQMubyte
|
|
||||||
rawEnumToVAF 2 = return IQMshort
|
|
||||||
rawEnumToVAF 3 = return IQMushort
|
|
||||||
rawEnumToVAF 4 = return IQMint
|
|
||||||
rawEnumToVAF 5 = return IQMuint
|
|
||||||
rawEnumToVAF 6 = return IQMhalf
|
|
||||||
rawEnumToVAF 7 = return IQMfloat
|
|
||||||
rawEnumToVAF 8 = return IQMdouble
|
|
||||||
--rawEnumToVAF a = return $ Unknown a
|
|
||||||
rawEnumToVAF a = fail $ P.concat ["unrecognized enum(",show a,") in VertexArrayFormat"]
|
|
||||||
|
|
||||||
|
|
||||||
-- | A Vertex-Array-Definiton.
|
|
||||||
--
|
|
||||||
-- The Vertex starts at Offset and has num_vertexes * NumComponents entries.
|
|
||||||
--
|
|
||||||
-- All Vertex-Arrays seem to have the same number of components, just differ in Type, Format
|
|
||||||
-- and Flags
|
|
||||||
data IQMVertexArray = IQMVertexArray
|
|
||||||
IQMVertexArrayType
|
|
||||||
Flags
|
|
||||||
IQMVertexArrayFormat
|
|
||||||
NumComponents
|
|
||||||
Offset
|
|
||||||
IQMData
|
|
||||||
deriving (Eq)
|
|
||||||
instance Show IQMVertexArray where
|
|
||||||
show (IQMVertexArray t fl fo nc off dat) = "IQMVertexArray (Type: " ++ show t ++
|
|
||||||
", Flags: " ++ show fl ++
|
|
||||||
", Format: " ++ show fo ++
|
|
||||||
", NumComponents: " ++ show nc ++
|
|
||||||
", Offset: " ++ show off ++
|
|
||||||
", Data at: " ++ show dat ++
|
|
||||||
")"
|
|
||||||
|
|
||||||
370
src/Main.hs
370
src/Main.hs
@ -1,370 +0,0 @@
|
|||||||
{-# LANGUAGE BangPatterns, DoAndIfThenElse #-}
|
|
||||||
module Main where
|
|
||||||
|
|
||||||
import Graphics.Rendering.OpenGL.GL.Texturing.Specification (texImage2D,TextureTarget2D(Texture2D))
|
|
||||||
import Graphics.Rendering.OpenGL.GL.PixelRectangles.ColorTable (PixelInternalFormat(..))
|
|
||||||
import Graphics.Rendering.OpenGL.GL.Texturing.Objects (textureBinding)
|
|
||||||
import Graphics.Rendering.OpenGL.GL.Texturing.Parameters (TextureFilter(..),textureFilter)
|
|
||||||
|
|
||||||
-- Monad-foo and higher functional stuff
|
|
||||||
import Control.Monad (unless, when, join)
|
|
||||||
import Control.Arrow ((***))
|
|
||||||
import Control.Lens ((^.), (.~), (%~))
|
|
||||||
|
|
||||||
-- data consistency/conversion
|
|
||||||
import Control.Concurrent (threadDelay)
|
|
||||||
import Control.Concurrent.STM (TQueue, newTQueueIO, atomically)
|
|
||||||
import Control.Concurrent.STM.TVar (newTVarIO, writeTVar, readTVar, readTVarIO)
|
|
||||||
|
|
||||||
import Control.Monad.RWS.Strict (ask, evalRWST, get, liftIO, modify)
|
|
||||||
import Data.Functor ((<$>))
|
|
||||||
import Data.Monoid (mappend)
|
|
||||||
import qualified Data.HashMap.Strict as Map
|
|
||||||
|
|
||||||
-- FFI
|
|
||||||
import Foreign.Marshal.Array (pokeArray)
|
|
||||||
import Foreign.Marshal.Alloc (allocaBytes)
|
|
||||||
|
|
||||||
-- GUI
|
|
||||||
import qualified Graphics.UI.SDL as SDL
|
|
||||||
|
|
||||||
-- Render
|
|
||||||
import qualified Graphics.Rendering.OpenGL.GL as GL
|
|
||||||
import Graphics.Rendering.OpenGL.Raw.Core31
|
|
||||||
import Data.Time (getCurrentTime, diffUTCTime)
|
|
||||||
|
|
||||||
-- Our modules
|
|
||||||
import Render.Misc (checkError, createFrustum, curb,
|
|
||||||
genColorData)
|
|
||||||
import Render.Render (initRendering,
|
|
||||||
initMapShader,
|
|
||||||
initHud, render)
|
|
||||||
import Render.Types
|
|
||||||
import UI.Callbacks
|
|
||||||
import Map.Graphics
|
|
||||||
import Map.Creation (exportedMap)
|
|
||||||
import Types
|
|
||||||
import Importer.IQM.Parser
|
|
||||||
--import Data.Attoparsec.Char8 (parseTest)
|
|
||||||
--import qualified Data.ByteString as B
|
|
||||||
|
|
||||||
-- import qualified Debug.Trace as D (trace)
|
|
||||||
|
|
||||||
--------------------------------------------------------------------------------
|
|
||||||
|
|
||||||
testParser :: String -> IO ()
|
|
||||||
testParser a = print =<< parseIQM a
|
|
||||||
{-do
|
|
||||||
f <- B.readFile a
|
|
||||||
putStrLn "reading in:"
|
|
||||||
putStrLn $ show f
|
|
||||||
putStrLn "parsed:"
|
|
||||||
parseTest parseIQM f-}
|
|
||||||
|
|
||||||
--------------------------------------------------------------------------------
|
|
||||||
|
|
||||||
main :: IO ()
|
|
||||||
main = do
|
|
||||||
let initialWidth = 1024
|
|
||||||
initialHeight = 600
|
|
||||||
SDL.withInit [SDL.InitVideo, SDL.InitAudio, SDL.InitEvents, SDL.InitTimer] $ --also: InitNoParachute -> faster, without parachute!
|
|
||||||
SDL.withWindow "Pioneers" (SDL.Position 100 100) (SDL.Size initialWidth initialHeight)
|
|
||||||
[SDL.WindowOpengl -- we want openGL
|
|
||||||
,SDL.WindowShown -- window should be visible
|
|
||||||
,SDL.WindowResizable -- and resizable
|
|
||||||
,SDL.WindowInputFocus -- focused (=> active)
|
|
||||||
,SDL.WindowMouseFocus -- Mouse into it
|
|
||||||
--,WindowInputGrabbed-- never let go of input (KB/Mouse)
|
|
||||||
] $ \window' -> do
|
|
||||||
SDL.withOpenGL window' $ do
|
|
||||||
|
|
||||||
SDL.glSwapWindow window' -- swap to get the glew-stuff out of the way
|
|
||||||
--Create Renderbuffer & Framebuffer
|
|
||||||
-- We will render to this buffer to copy the result into textures
|
|
||||||
renderBuffer <- GL.genObjectName
|
|
||||||
frameBuffer <- GL.genObjectName
|
|
||||||
GL.bindFramebuffer GL.Framebuffer GL.$= frameBuffer
|
|
||||||
GL.bindRenderbuffer GL.Renderbuffer GL.$= renderBuffer
|
|
||||||
|
|
||||||
(SDL.Size fbWidth fbHeight) <- SDL.glGetDrawableSize window'
|
|
||||||
initRendering
|
|
||||||
--generate map vertices
|
|
||||||
curMap <- exportedMap
|
|
||||||
(glMap', tex, dtex) <- initMapShader 4 =<< getMapBufferObject curMap
|
|
||||||
tex' <- newTVarIO tex
|
|
||||||
dtex' <- newTVarIO dtex
|
|
||||||
eventQueue <- newTQueueIO :: IO (TQueue SDL.Event)
|
|
||||||
now <- getCurrentTime
|
|
||||||
--font <- TTF.openFont "fonts/ttf-04B_03B_/04B_03B_.TTF" 10
|
|
||||||
--TTF.setFontStyle font TTFNormal
|
|
||||||
--TTF.setFontHinting font TTFHNormal
|
|
||||||
let
|
|
||||||
fov = 90 --field of view
|
|
||||||
near = 1 --near plane
|
|
||||||
far = 500 --far plane
|
|
||||||
ratio = fromIntegral fbWidth / fromIntegral fbHeight
|
|
||||||
frust = createFrustum fov near far ratio
|
|
||||||
cam' <- newTVarIO CameraState
|
|
||||||
{ _xAngle = pi/6
|
|
||||||
, _yAngle = pi/2
|
|
||||||
, _zDist = 10
|
|
||||||
, _frustum = frust
|
|
||||||
, _camObject = createFlatCam 25 25 curMap
|
|
||||||
}
|
|
||||||
game' <- newTVarIO GameState
|
|
||||||
{ _currentMap = curMap
|
|
||||||
}
|
|
||||||
let camStack' = Map.empty
|
|
||||||
glHud' <- initHud
|
|
||||||
let zDistClosest' = 2
|
|
||||||
zDistFarthest' = zDistClosest' + 10
|
|
||||||
--TODO: Move near/far/fov to state for runtime-changability & central storage
|
|
||||||
aks = ArrowKeyState {
|
|
||||||
_up = False
|
|
||||||
, _down = False
|
|
||||||
, _left = False
|
|
||||||
, _right = False
|
|
||||||
}
|
|
||||||
env = Env
|
|
||||||
{ _eventsChan = eventQueue
|
|
||||||
, _windowObject = window'
|
|
||||||
, _zDistClosest = zDistClosest'
|
|
||||||
, _zDistFarthest = zDistFarthest'
|
|
||||||
}
|
|
||||||
state = State
|
|
||||||
{ _window = WindowState
|
|
||||||
{ _width = fbWidth
|
|
||||||
, _height = fbHeight
|
|
||||||
, _shouldClose = False
|
|
||||||
}
|
|
||||||
, _io = IOState
|
|
||||||
{ _clock = now
|
|
||||||
, _tessClockFactor = 0
|
|
||||||
, _tessClockTime = now
|
|
||||||
}
|
|
||||||
, _camera = cam'
|
|
||||||
, _mapTexture = tex'
|
|
||||||
, _mapDepthTexture = dtex'
|
|
||||||
, _camStack = camStack'
|
|
||||||
, _keyboard = KeyboardState
|
|
||||||
{ _arrowsPressed = aks
|
|
||||||
}
|
|
||||||
, _gl = GLState
|
|
||||||
{ _glMap = glMap'
|
|
||||||
, _glHud = glHud'
|
|
||||||
, _glRenderbuffer = renderBuffer
|
|
||||||
, _glFramebuffer = frameBuffer
|
|
||||||
}
|
|
||||||
, _game = game'
|
|
||||||
, _ui = createGUI initialWidth initialHeight
|
|
||||||
}
|
|
||||||
|
|
||||||
putStrLn "init done."
|
|
||||||
uncurry mappend <$> evalRWST (adjustWindow >> run) env state
|
|
||||||
putStrLn "shutdown complete."
|
|
||||||
|
|
||||||
--SDL.glDeleteContext mainGlContext
|
|
||||||
--SDL.destroyRenderer renderer
|
|
||||||
--destroyWindow window
|
|
||||||
|
|
||||||
-- Main game loop
|
|
||||||
|
|
||||||
run :: Pioneers ()
|
|
||||||
run = do
|
|
||||||
env <- ask
|
|
||||||
|
|
||||||
-- draw Scene
|
|
||||||
draw
|
|
||||||
liftIO $ SDL.glSwapWindow (env ^. windowObject)
|
|
||||||
-- getEvents & process
|
|
||||||
processEvents
|
|
||||||
|
|
||||||
-- update State
|
|
||||||
|
|
||||||
state <- get
|
|
||||||
|
|
||||||
-- get cursor-keys - if pressed
|
|
||||||
--TODO: Add sin/cos from stateYAngle
|
|
||||||
(kxrot, kyrot) <- fmap (join (***) fromIntegral) getArrowMovement
|
|
||||||
liftIO $ atomically $ do
|
|
||||||
cam <- readTVar (state ^. camera)
|
|
||||||
game' <- readTVar (state ^. game)
|
|
||||||
let
|
|
||||||
multc = cos $ cam ^. yAngle
|
|
||||||
mults = sin $ cam ^. yAngle
|
|
||||||
modx x' = x' - 0.2 * kxrot * multc
|
|
||||||
- 0.2 * kyrot * mults
|
|
||||||
mody y' = y' + 0.2 * kxrot * mults
|
|
||||||
- 0.2 * kyrot * multc
|
|
||||||
cam' <- return $ camObject %~ (\c -> moveBy c (\(x,y) -> (modx x,mody y)) (game' ^. currentMap)) $ cam
|
|
||||||
writeTVar (state ^. camera) cam'
|
|
||||||
|
|
||||||
{-
|
|
||||||
--modify the state with all that happened in mt time.
|
|
||||||
mt <- liftIO GLFW.getTime
|
|
||||||
modify $ \s -> s
|
|
||||||
{
|
|
||||||
}
|
|
||||||
-}
|
|
||||||
|
|
||||||
(mt,tc,sleepAmount,frameTime,hC) <- liftIO $ do
|
|
||||||
let double = fromRational.toRational :: (Real a) => a -> Double
|
|
||||||
targetFramerate = 60.0
|
|
||||||
targetFrametime = 1.0/targetFramerate
|
|
||||||
--targetFrametimeμs = targetFrametime * 1000000.0
|
|
||||||
now <- getCurrentTime
|
|
||||||
let diff = max 0.001 $ diffUTCTime now (state ^. io.clock) -- get time-diffs
|
|
||||||
updatediff = diffUTCTime now (state ^. io.tessClockTime) -- get diff to last update
|
|
||||||
title = unwords ["Pioneers @ ",show ((round . double $ 1.0/diff)::Int),"fps"]
|
|
||||||
ddiff = double diff
|
|
||||||
SDL.setWindowTitle (env ^. windowObject) title
|
|
||||||
let sleepAmount = floor ((targetFrametime - double diff)*1000000) :: Int -- get time until next frame in microseconds
|
|
||||||
clockFactor = (state ^. io.tessClockFactor)
|
|
||||||
noChange = ((+)0 :: Int -> Int)
|
|
||||||
(tessChange, hasChanged)
|
|
||||||
| updatediff < 5 = (noChange,False) -- at least 5 sec since last update
|
|
||||||
| (clockFactor < (75*targetFrametime)) && (state ^. gl.glMap.stateTessellationFactor < 5) = (((+)1 :: Int -> Int),True)
|
|
||||||
-- > last 100 frames had > 25% leftover (on avg.)
|
|
||||||
| (clockFactor > (110*targetFrametime)) && (state ^. gl.glMap.stateTessellationFactor > 1) = ((flip (-) 1 :: Int -> Int),True)
|
|
||||||
-- > last 100 frames had < 90% of target-fps
|
|
||||||
| otherwise = (noChange,False) -- 0ms > x > 10% -> keep settings
|
|
||||||
when (sleepAmount > 0) $ threadDelay sleepAmount
|
|
||||||
now' <- getCurrentTime
|
|
||||||
return (now',tessChange,sleepAmount,ddiff,hasChanged)
|
|
||||||
-- set state with new clock-time
|
|
||||||
--liftIO $ putStrLn $ unwords ["clockFactor:",show (state ^. io.tessClockFactor),"\ttc:", show (tc (state ^. gl.glMap.stateTessellationFactor)),"\tsleep ",show frameTime,"ms"]
|
|
||||||
if hC then
|
|
||||||
do
|
|
||||||
liftIO $ putStrLn $ unwords ["modifying TessFactor to",show $ tc $ state ^. gl.glMap.stateTessellationFactor]
|
|
||||||
modify $ (io.clock .~ mt)
|
|
||||||
. (gl.glMap.stateTessellationFactor %~ tc)
|
|
||||||
. (io.tessClockFactor %~ (((+) frameTime).((*) 0.99)))
|
|
||||||
. (io.tessClockTime .~ mt)
|
|
||||||
else
|
|
||||||
modify $ (io.clock .~ mt)
|
|
||||||
. (io.tessClockFactor %~ (((+) frameTime).((*) 0.99)))
|
|
||||||
-- liftIO $ putStrLn $ concat $ ["TessFactor at: ",show (state ^. gl.glMap.stateTessellationFactor), " - slept for ",show sleepAmount, "μs."]
|
|
||||||
shouldClose' <- return $ state ^. window.shouldClose
|
|
||||||
unless shouldClose' run
|
|
||||||
|
|
||||||
draw :: Pioneers ()
|
|
||||||
draw = do
|
|
||||||
state <- get
|
|
||||||
when (state ^. ui . uiHasChanged) prepareGUI
|
|
||||||
render
|
|
||||||
|
|
||||||
getArrowMovement :: Pioneers (Int, Int)
|
|
||||||
getArrowMovement = do
|
|
||||||
state <- get
|
|
||||||
aks <- return $ state ^. (keyboard.arrowsPressed)
|
|
||||||
let
|
|
||||||
horz = left' + right'
|
|
||||||
vert = up'+down'
|
|
||||||
left' = if aks ^. left then -1 else 0
|
|
||||||
right' = if aks ^. right then 1 else 0
|
|
||||||
up' = if aks ^. up then -1 else 0
|
|
||||||
down' = if aks ^. down then 1 else 0
|
|
||||||
return (horz,vert)
|
|
||||||
|
|
||||||
adjustWindow :: Pioneers ()
|
|
||||||
adjustWindow = do
|
|
||||||
state <- get
|
|
||||||
let fbWidth = state ^. window.width
|
|
||||||
fbHeight = state ^. window.height
|
|
||||||
fov = 90 --field of view
|
|
||||||
near = 1 --near plane
|
|
||||||
far = 100 --far plane
|
|
||||||
ratio = fromIntegral fbWidth / fromIntegral fbHeight
|
|
||||||
frust = createFrustum fov near far ratio
|
|
||||||
liftIO $ glViewport 0 0 (fromIntegral fbWidth) (fromIntegral fbHeight)
|
|
||||||
liftIO $ atomically $ do
|
|
||||||
cam <- readTVar (state ^. camera)
|
|
||||||
cam' <- return $ frustum .~ frust $ cam
|
|
||||||
writeTVar (state ^. camera) cam'
|
|
||||||
rb <- liftIO $ do
|
|
||||||
-- bind ints to CInt for lateron.
|
|
||||||
let fbCWidth = (fromInteger.toInteger) fbWidth
|
|
||||||
fbCHeight = (fromInteger.toInteger) fbHeight
|
|
||||||
-- free old renderbuffer & create new (reuse is NOT advised!)
|
|
||||||
GL.deleteObjectName (state ^. gl.glRenderbuffer)
|
|
||||||
renderBuffer <- GL.genObjectName
|
|
||||||
GL.bindRenderbuffer GL.Renderbuffer GL.$= renderBuffer
|
|
||||||
GL.renderbufferStorage
|
|
||||||
GL.Renderbuffer -- use the only available renderbuffer
|
|
||||||
-- - must be this constant.
|
|
||||||
GL.DepthComponent' -- 32-bit float-rgba-color
|
|
||||||
(GL.RenderbufferSize fbCWidth fbCHeight) -- size of buffer
|
|
||||||
|
|
||||||
|
|
||||||
let hudtexid = state ^. gl.glHud.hudTexture
|
|
||||||
smaptexid = state ^. gl.glMap.shadowMapTexture
|
|
||||||
maptexid <- readTVarIO (state ^. mapTexture)
|
|
||||||
mapdepthtexid <- readTVarIO (state ^. mapDepthTexture)
|
|
||||||
-- create & clear textures for hud & background (map)
|
|
||||||
allocaBytes (fbWidth*fbHeight*4) $ \ptr -> do
|
|
||||||
--default to ugly pink to see if
|
|
||||||
--somethings go wrong.
|
|
||||||
let imData = genColorData (fbWidth*fbHeight) [255,0,255,0]
|
|
||||||
--putStrLn $ show imData
|
|
||||||
pokeArray ptr imData
|
|
||||||
-- HUD
|
|
||||||
textureBinding Texture2D GL.$= Just hudtexid
|
|
||||||
textureFilter Texture2D GL.$= ((Linear', Nothing), Linear')
|
|
||||||
texImage2D Texture2D GL.NoProxy 0 RGBA8 (GL.TextureSize2D fbCWidth fbCHeight) 0
|
|
||||||
(GL.PixelData GL.RGBA GL.UnsignedByte ptr)
|
|
||||||
textureBinding Texture2D GL.$= Nothing
|
|
||||||
-- MAP
|
|
||||||
textureBinding Texture2D GL.$= Just maptexid
|
|
||||||
textureFilter Texture2D GL.$= ((Linear', Nothing), Linear')
|
|
||||||
texImage2D Texture2D GL.NoProxy 0 RGBA8 (GL.TextureSize2D fbCWidth fbCHeight) 0
|
|
||||||
(GL.PixelData GL.RGBA GL.UnsignedByte ptr)
|
|
||||||
textureBinding Texture2D GL.$= Nothing
|
|
||||||
-- create & clear map depth texture
|
|
||||||
allocaBytes (fbWidth*fbHeight) $ \ptr -> do
|
|
||||||
let smapdata = genColorData (fbWidth*fbHeight) [0]
|
|
||||||
pokeArray ptr smapdata
|
|
||||||
textureBinding Texture2D GL.$= Just mapdepthtexid
|
|
||||||
textureFilter Texture2D GL.$= ((Linear', Nothing), Linear')
|
|
||||||
texImage2D Texture2D GL.NoProxy 0 GL.DepthComponent16 (GL.TextureSize2D fbCWidth fbCHeight) 0
|
|
||||||
(GL.PixelData GL.DepthComponent GL.UnsignedByte ptr)
|
|
||||||
textureBinding Texture2D GL.$= Nothing
|
|
||||||
-- create & clear depth texture for shadows
|
|
||||||
allocaBytes (2048*2048) $ \ptr -> do
|
|
||||||
let smapdata = genColorData (2048*2048) [0]
|
|
||||||
pokeArray ptr smapdata
|
|
||||||
textureBinding Texture2D GL.$= Just smaptexid
|
|
||||||
textureFilter Texture2D GL.$= ((Nearest,Nothing), Nearest)
|
|
||||||
texImage2D Texture2D GL.NoProxy 0 GL.DepthComponent16 (GL.TextureSize2D 2048 2048) 0
|
|
||||||
(GL.PixelData GL.DepthComponent GL.UnsignedByte ptr)
|
|
||||||
textureBinding Texture2D GL.$= Nothing
|
|
||||||
checkError "setting up HUD-Tex"
|
|
||||||
return renderBuffer
|
|
||||||
modify $ gl.glRenderbuffer .~ rb
|
|
||||||
modify $ ui.uiHasChanged .~ True
|
|
||||||
|
|
||||||
processEvents :: Pioneers ()
|
|
||||||
processEvents = do
|
|
||||||
me <- liftIO SDL.pollEvent
|
|
||||||
case me of
|
|
||||||
Just e -> do
|
|
||||||
processEvent e
|
|
||||||
processEvents
|
|
||||||
Nothing -> return ()
|
|
||||||
|
|
||||||
processEvent :: SDL.Event -> Pioneers ()
|
|
||||||
processEvent e = do
|
|
||||||
eventCallback e
|
|
||||||
-- env <- ask
|
|
||||||
case SDL.eventData e of
|
|
||||||
SDL.Window _ winEvent -> -- windowID event
|
|
||||||
case winEvent of
|
|
||||||
SDL.Closing ->
|
|
||||||
modify $ window.shouldClose .~ True
|
|
||||||
SDL.Resized {SDL.windowResizedTo=size} -> do
|
|
||||||
modify $ (window . width .~ SDL.sizeWidth size)
|
|
||||||
. (window . height .~ SDL.sizeHeight size)
|
|
||||||
adjustWindow
|
|
||||||
SDL.SizeChanged ->
|
|
||||||
adjustWindow
|
|
||||||
_ -> return ()
|
|
||||||
_ -> return ()
|
|
||||||
@ -1,87 +0,0 @@
|
|||||||
module Map.Creation
|
|
||||||
where
|
|
||||||
|
|
||||||
import Map.Types
|
|
||||||
|
|
||||||
import Data.Array
|
|
||||||
import System.Random
|
|
||||||
|
|
||||||
-- entirely empty map, only uses the minimal constructor
|
|
||||||
mapEmpty :: PlayMap
|
|
||||||
mapEmpty = array ((0,0), (199,199)) [((a,b), Node (a,b) (fromIntegral a, (if even b then (fromIntegral b) else(fromIntegral b) - 0.5), 1) Grass BNothing NoPlayer NoPath Plain []) | a <- [0..199], b <- [0..199]]
|
|
||||||
|
|
||||||
exportedMap :: IO PlayMap
|
|
||||||
exportedMap = do mounts <- mnt
|
|
||||||
return $ aplAll mounts mapEmpty
|
|
||||||
|
|
||||||
-- | Generate a new Map of given Type and Size
|
|
||||||
--
|
|
||||||
-- TODO:
|
|
||||||
-- 1. Should take Size -> Type -> Playmap
|
|
||||||
-- 2. plug together helper-functions for that terraintype
|
|
||||||
newMap :: MapType -> (Int, Int) -> PlayMap
|
|
||||||
newMap = undefined
|
|
||||||
|
|
||||||
aplByPlace :: (Node -> Node) -> ((Int,Int) -> Bool) -> PlayMap -> PlayMap
|
|
||||||
aplByPlace f g mp = array (bounds mp) (map (\(ab,c) -> if g ab then (ab, f c) else (ab,c)) (assocs mp))
|
|
||||||
|
|
||||||
aplByNode :: (Node -> Node) -> (Node -> Bool) -> PlayMap -> PlayMap
|
|
||||||
aplByNode f g mp = array (bounds mp) (map (\(ab,c) -> (if g c then (ab, f c) else (ab,c))) (assocs mp))
|
|
||||||
|
|
||||||
aplAll :: [a -> a] -> a -> a
|
|
||||||
aplAll fs m = foldl (\ n f -> f n) m fs
|
|
||||||
|
|
||||||
aplAllM :: Monad m => [m a -> m a] -> m a -> m a
|
|
||||||
aplAllM fs x = foldl (\ n f -> f n) x fs
|
|
||||||
|
|
||||||
-- general 3D-Gaussian
|
|
||||||
gauss3Dgeneral :: Floating q =>
|
|
||||||
q -- ^ Amplitude
|
|
||||||
-> q -- ^ Origin on X-Achsis
|
|
||||||
-> q -- ^ Origin on Z-Achsis
|
|
||||||
-> q -- ^ Sigma on X
|
|
||||||
-> q -- ^ Sigma on Z
|
|
||||||
-> q -- ^ Coordinate in question on X
|
|
||||||
-> q -- ^ Coordinate in question on Z
|
|
||||||
-> q -- ^ elevation on coordinate in question
|
|
||||||
gauss3Dgeneral amp x0 z0 sX sZ x z = amp * exp(-(((x-x0)^(2 :: Int)/(2 * sX^(2 :: Int)))+((z-z0)^(2 :: Int)/(2 * sZ^(2 :: Int)))))
|
|
||||||
|
|
||||||
-- | Basic Terrain-Generator. Will not implement "abnormal" Stuff for given Biome
|
|
||||||
-- (like Deserts on Grass-Islands or Grass on Deserts)
|
|
||||||
--
|
|
||||||
-- TODO: Implement Desert-Generator
|
|
||||||
heightToTerrain :: MapType -> YCoord -> TileType
|
|
||||||
heightToTerrain GrassIslandMap y
|
|
||||||
| y < 0.1 = Ocean
|
|
||||||
| y < 0.2 = Beach
|
|
||||||
| y < 1.5 = Grass
|
|
||||||
| y < 3 = Hill
|
|
||||||
| otherwise = Mountain
|
|
||||||
heightToTerrain _ _ = undefined
|
|
||||||
|
|
||||||
|
|
||||||
lake :: Int -> PlayMap -> PlayMap
|
|
||||||
lake = undefined
|
|
||||||
|
|
||||||
river :: Int -> PlayMap -> PlayMap
|
|
||||||
river = undefined
|
|
||||||
|
|
||||||
mnt :: IO [PlayMap -> PlayMap]
|
|
||||||
mnt = do g <- newStdGen
|
|
||||||
let seeds = take 50 $ randoms g
|
|
||||||
return $ map gaussMountain seeds
|
|
||||||
|
|
||||||
gaussMountain :: Int -> PlayMap -> PlayMap
|
|
||||||
gaussMountain seed mp = aplByPlace (liftUp c) (\(_,_) -> True) mp
|
|
||||||
where
|
|
||||||
gs = map mkStdGen (map (*seed) [1..])
|
|
||||||
c = let ((a,b), (x,y)) = bounds mp in (head (randomRs (a,x) (gs !! 0)), (head (randomRs (b,y) (gs !! 1))))
|
|
||||||
amp = head $ randomRs ((2.0, 5.0) :: (Double, Double)) (gs !! 2)
|
|
||||||
sig = head $ randomRs ((2.0, 8.0) :: (Double, Double)) (gs !! 3)
|
|
||||||
htt = heightToTerrain
|
|
||||||
|
|
||||||
-- TODO: Fix Lambda to True with sensible function, maybe rework giveNeighbourhood in Map.Map
|
|
||||||
liftUp :: (Int, Int) -> Node -> Node
|
|
||||||
liftUp (gx,gz) (Node (x,z) (rx,rz,y) _ b pl pa r s) = let y_neu = max y e
|
|
||||||
in Node (x,z) (rx, rz, y_neu) (htt GrassIslandMap y_neu) b pl pa r s
|
|
||||||
where e = gauss3Dgeneral amp (fromIntegral gx) (fromIntegral gz) sig sig rx rz
|
|
||||||
@ -1,210 +0,0 @@
|
|||||||
{-# LANGUAGE OverloadedStrings, BangPatterns #-}
|
|
||||||
module Map.Graphics
|
|
||||||
|
|
||||||
(
|
|
||||||
mapVertexArrayDescriptor,
|
|
||||||
fgColorIndex,
|
|
||||||
fgNormalIndex,
|
|
||||||
fgVertexIndex,
|
|
||||||
mapStride,
|
|
||||||
getMapBufferObject
|
|
||||||
)
|
|
||||||
where
|
|
||||||
|
|
||||||
import Data.Array.IArray
|
|
||||||
import Prelude as P
|
|
||||||
|
|
||||||
--import Graphics.Rendering.OpenGL.GL
|
|
||||||
import Graphics.Rendering.OpenGL.GL.BufferObjects
|
|
||||||
import Graphics.Rendering.OpenGL.GL.ObjectName
|
|
||||||
import Graphics.Rendering.OpenGL.GL.StateVar
|
|
||||||
import Graphics.Rendering.OpenGL.GL.VertexArrays
|
|
||||||
import Graphics.Rendering.OpenGL.GL.VertexSpec
|
|
||||||
import Graphics.Rendering.OpenGL.Raw.Core31
|
|
||||||
|
|
||||||
import Foreign.Marshal.Array (withArray)
|
|
||||||
import Foreign.Storable (sizeOf)
|
|
||||||
import Foreign.Ptr (Ptr, nullPtr, plusPtr)
|
|
||||||
import Render.Misc (checkError)
|
|
||||||
import Linear
|
|
||||||
import Control.Arrow ((***))
|
|
||||||
|
|
||||||
import Map.Types
|
|
||||||
|
|
||||||
type Height = Double
|
|
||||||
|
|
||||||
type MapEntry = (
|
|
||||||
Height,
|
|
||||||
TileType
|
|
||||||
)
|
|
||||||
type GraphicsMap = Array (Int, Int) MapEntry
|
|
||||||
|
|
||||||
-- converts from classical x/z to striped version of a map
|
|
||||||
convertToStripeMap :: PlayMap -> PlayMap
|
|
||||||
convertToStripeMap mp = array (stripify l, stripify u) (map (stripify *** strp) (assocs mp))
|
|
||||||
where
|
|
||||||
(l,u) = bounds mp
|
|
||||||
|
|
||||||
stripify :: (Int,Int) -> (Int,Int)
|
|
||||||
stripify (x,z) = (if even z then 2*x else 2*x+1, z `div` 2)
|
|
||||||
|
|
||||||
strp :: Node -> Node
|
|
||||||
strp (Node i (x,z,y) tt bi pli p ri si) = Node (stripify i) (x,z,y) tt bi pli p ri si
|
|
||||||
|
|
||||||
-- extract graphics information from Playmap
|
|
||||||
convertToGraphicsMap :: PlayMap -> GraphicsMap
|
|
||||||
convertToGraphicsMap mp = array (bounds mp) [(i, graphicsyfy (mp ! i))| i <- indices mp]
|
|
||||||
where
|
|
||||||
graphicsyfy :: Node -> MapEntry
|
|
||||||
graphicsyfy (Node _ (_,_,y) t _ _ _ _ _ ) = (y, t)
|
|
||||||
|
|
||||||
lineHeight :: GLfloat
|
|
||||||
lineHeight = 0.8660254
|
|
||||||
|
|
||||||
-- Number of GLfloats per Stride
|
|
||||||
numComponents :: Int
|
|
||||||
numComponents = 10
|
|
||||||
|
|
||||||
mapStride :: Stride
|
|
||||||
mapStride = fromIntegral (sizeOf (0.0 :: GLfloat) * numComponents)
|
|
||||||
|
|
||||||
bufferObjectPtr :: Integral a => a -> Ptr GLfloat
|
|
||||||
bufferObjectPtr = plusPtr (nullPtr :: Ptr GLfloat) . fromIntegral
|
|
||||||
|
|
||||||
mapVertexArrayDescriptor :: NumComponents -> NumComponents -> VertexArrayDescriptor GLfloat
|
|
||||||
mapVertexArrayDescriptor count' offset =
|
|
||||||
VertexArrayDescriptor count' Float mapStride (bufferObjectPtr (fromIntegral offset * sizeOf (0 :: GLfloat)) ) --(fromIntegral numComponents * offset))
|
|
||||||
|
|
||||||
fgColorIndex :: (IntegerHandling, VertexArrayDescriptor GLfloat)
|
|
||||||
fgColorIndex = (ToFloat, mapVertexArrayDescriptor 4 0) --color first
|
|
||||||
|
|
||||||
fgNormalIndex :: (IntegerHandling, VertexArrayDescriptor GLfloat)
|
|
||||||
fgNormalIndex = (ToFloat, mapVertexArrayDescriptor 3 4) --normal after color
|
|
||||||
|
|
||||||
fgVertexIndex :: (IntegerHandling, VertexArrayDescriptor GLfloat)
|
|
||||||
fgVertexIndex = (ToFloat, mapVertexArrayDescriptor 3 7) --vertex after normal
|
|
||||||
|
|
||||||
getMapBufferObject :: PlayMap -> IO (BufferObject, NumArrayIndices)
|
|
||||||
getMapBufferObject eMap = do
|
|
||||||
myMap' <- return $ convertToGraphicsMap $ convertToStripeMap eMap
|
|
||||||
! myMap <- return $ generateTriangles myMap'
|
|
||||||
len <- return $ fromIntegral $ P.length myMap `div` numComponents
|
|
||||||
putStrLn $ P.unwords ["num verts in map:",show len]
|
|
||||||
bo <- genObjectName -- create a new buffer
|
|
||||||
bindBuffer ArrayBuffer $= Just bo -- bind buffer
|
|
||||||
withArray myMap $ \buffer ->
|
|
||||||
bufferData ArrayBuffer $= (fromIntegral $ sizeOf (0 :: GLfloat) * P.length myMap,
|
|
||||||
buffer,
|
|
||||||
StaticDraw)
|
|
||||||
checkError "initBuffer"
|
|
||||||
return (bo,len)
|
|
||||||
|
|
||||||
--generateTriangles :: PlayMap -> [GLfloat]
|
|
||||||
generateTriangles :: GraphicsMap -> [GLfloat]
|
|
||||||
generateTriangles map' =
|
|
||||||
let ((xl,yl),(xh,yh)) = bounds map' in
|
|
||||||
P.concat [P.concat $ P.map (generateFirstTriLine map' y) [xl .. xh - 2]
|
|
||||||
++ P.map (generateSecondTriLine map' (y == yh) y) [xl .. xh - 2]
|
|
||||||
| y <- [yl..yh]]
|
|
||||||
|
|
||||||
generateFirstTriLine :: GraphicsMap -> Int -> Int -> [GLfloat]
|
|
||||||
generateFirstTriLine map' y x =
|
|
||||||
P.concat $
|
|
||||||
if even x then
|
|
||||||
[ lookupVertex map' x y,
|
|
||||||
lookupVertex map' (x + 1) y,
|
|
||||||
lookupVertex map' (x + 2) y
|
|
||||||
]
|
|
||||||
else
|
|
||||||
[ lookupVertex map' x y,
|
|
||||||
lookupVertex map' (x + 2) y,
|
|
||||||
lookupVertex map' (x + 1) y
|
|
||||||
]
|
|
||||||
|
|
||||||
generateSecondTriLine :: GraphicsMap -> Bool -> Int -> Int -> [GLfloat]
|
|
||||||
generateSecondTriLine map' False y x =
|
|
||||||
P.concat $
|
|
||||||
if even x then
|
|
||||||
[ lookupVertex map' x (y + 1),
|
|
||||||
lookupVertex map' (x + 2) (y + 1),
|
|
||||||
lookupVertex map' (x + 1) y
|
|
||||||
]
|
|
||||||
else
|
|
||||||
[ lookupVertex map' x y,
|
|
||||||
lookupVertex map' (x + 1) (y + 1),
|
|
||||||
lookupVertex map' (x + 2) y
|
|
||||||
]
|
|
||||||
generateSecondTriLine _ True _ _ = []
|
|
||||||
|
|
||||||
|
|
||||||
lookupVertex :: GraphicsMap -> Int -> Int -> [GLfloat]
|
|
||||||
lookupVertex map' x y =
|
|
||||||
let
|
|
||||||
(cr, cg, cb) = colorLookup map' (x,y)
|
|
||||||
(V3 vx vy vz) = coordLookup (x,y) $ heightLookup map' (x,y)
|
|
||||||
(V3 nx ny nz) = normalLookup map' x y
|
|
||||||
--TODO: calculate normals correctly!
|
|
||||||
in
|
|
||||||
[
|
|
||||||
cr, cg, cb, 1.0, -- RGBA Color
|
|
||||||
nx, ny, nz, -- 3 Normal
|
|
||||||
vx, vy, vz -- 3 Vertex
|
|
||||||
]
|
|
||||||
|
|
||||||
normalLookup :: GraphicsMap -> Int -> Int -> V3 GLfloat
|
|
||||||
normalLookup map' x y = normalize $ normN + normNE + normSE + normS + normSW + normNW
|
|
||||||
where
|
|
||||||
--Face Normals
|
|
||||||
normN = cross (vNE-vC) (vNW-vC)
|
|
||||||
normNE = cross (vE -vC) (vNE-vC)
|
|
||||||
normSE = cross (vSE-vC) (vE -vC)
|
|
||||||
normS = cross (vSW-vC) (vSE-vC)
|
|
||||||
normSW = cross (vW -vC) (vSW-vC)
|
|
||||||
normNW = cross (vNW-vC) (vW -vC)
|
|
||||||
--Vertex Normals
|
|
||||||
vC = coordLookup (x,y) $ heightLookup map' (x,y)
|
|
||||||
--TODO: kill guards with eo
|
|
||||||
vNW
|
|
||||||
| even x = coordLookup (x-1,y-1) $ heightLookup map' (x-1,y-1)
|
|
||||||
| otherwise = coordLookup (x-1,y ) $ heightLookup map' (x-1,y )
|
|
||||||
vNE
|
|
||||||
| even x = coordLookup (x+1,y-1) $ heightLookup map' (x+1,y-1)
|
|
||||||
| otherwise = coordLookup (x+1,y ) $ heightLookup map' (x+1,y )
|
|
||||||
vE
|
|
||||||
| even x = coordLookup (x+2,y ) $ heightLookup map' (x+2,y )
|
|
||||||
| otherwise = coordLookup (x+2,y ) $ heightLookup map' (x+2,y )
|
|
||||||
vSE
|
|
||||||
| even x = coordLookup (x+1,y ) $ heightLookup map' (x+1,y )
|
|
||||||
| otherwise = coordLookup (x+1,y+1) $ heightLookup map' (x+1,y+1)
|
|
||||||
vSW
|
|
||||||
| even x = coordLookup (x-1,y ) $ heightLookup map' (x-1,y )
|
|
||||||
| otherwise = coordLookup (x-1,y+1) $ heightLookup map' (x-1,y+1)
|
|
||||||
vW
|
|
||||||
| even x = coordLookup (x-2,y ) $ heightLookup map' (x-2,y )
|
|
||||||
| otherwise = coordLookup (x-2,y ) $ heightLookup map' (x-2,y )
|
|
||||||
-- eo = if even x then 1 else -1
|
|
||||||
|
|
||||||
heightLookup :: GraphicsMap -> (Int,Int) -> GLfloat
|
|
||||||
heightLookup hs t = if inRange (bounds hs) t then fromRational $ toRational h else 0.0
|
|
||||||
where
|
|
||||||
(h,_) = hs ! t
|
|
||||||
|
|
||||||
colorLookup :: GraphicsMap -> (Int,Int) -> (GLfloat, GLfloat, GLfloat)
|
|
||||||
colorLookup hs t = if inRange (bounds hs) t then c else (0.0, 0.0, 0.0)
|
|
||||||
where
|
|
||||||
(_,tp) = hs ! t
|
|
||||||
c = case tp of
|
|
||||||
Ocean -> (0.50, 0.50, 1.00)
|
|
||||||
Lake -> (0.40, 0.87 ,1.00)
|
|
||||||
Beach -> (0.90, 0.85, 0.70)
|
|
||||||
Desert -> (1.00, 0.87, 0.39)
|
|
||||||
Grass -> (0.30, 0.90, 0.10)
|
|
||||||
Mountain -> (0.80, 0.80, 0.80)
|
|
||||||
Hill -> (0.50, 0.50, 0.50)
|
|
||||||
|
|
||||||
coordLookup :: (Int,Int) -> GLfloat -> V3 GLfloat
|
|
||||||
coordLookup (x,z) y =
|
|
||||||
if even x then
|
|
||||||
V3 (fromIntegral $ x `div` 2) y (fromIntegral (2 * z) * lineHeight)
|
|
||||||
else
|
|
||||||
V3 (fromIntegral (x `div` 2) + 0.5) y (fromIntegral (2 * z + 1) * lineHeight)
|
|
||||||
107
src/Map/Map.hs
107
src/Map/Map.hs
@ -1,107 +0,0 @@
|
|||||||
module Map.Map where
|
|
||||||
|
|
||||||
import Map.Types
|
|
||||||
|
|
||||||
import Data.Array (bounds, (!))
|
|
||||||
import Data.List (sort, group)
|
|
||||||
|
|
||||||
import Debug.Trace
|
|
||||||
|
|
||||||
-- WARNING: Does NOT Check for neighbours exceeding maximum map coordinates yet.
|
|
||||||
unsafeGiveNeighbours :: (Int, Int) -- ^ original coordinates
|
|
||||||
-> [(Int,Int)] -- ^ list of neighbours
|
|
||||||
unsafeGiveNeighbours (x,z) = filter (not . negative) allNs
|
|
||||||
where
|
|
||||||
allNs = if even z then [(x+1,z), (x-1,z), (x,z+1), (x,z-1), (x+1,z+1), (x+1,z-1)]
|
|
||||||
else [(x+1,z), (x-1,z), (x,z+1), (x,z-1), (x-1,z+1), (x-1,z-1)]
|
|
||||||
|
|
||||||
negative :: (Int, Int) -> Bool
|
|
||||||
negative (a,b) = a < 0 || b < 0
|
|
||||||
|
|
||||||
giveNeighbours :: PlayMap -- ^ Map on which to find neighbours
|
|
||||||
-> (Int, Int) -- ^ original coordinates
|
|
||||||
-> [(Int, Int)] -- ^ list of neighbours
|
|
||||||
giveNeighbours mp (x,z) = filter (not . outOfBounds mp) allNs
|
|
||||||
where
|
|
||||||
allNs = if even z then [(x+1,z), (x-1,z), (x,z+1), (x,z-1), (x+1,z+1), (x+1,z-1)]
|
|
||||||
else [(x+1,z), (x-1,z), (x,z+1), (x,z-1), (x-1,z+1), (x-1,z-1)]
|
|
||||||
|
|
||||||
outOfBounds :: PlayMap -> (Int, Int) -> Bool
|
|
||||||
outOfBounds mp' (a,b) = let (lo,hi) = bounds mp' in
|
|
||||||
a < fst lo || b < snd lo || a > fst hi || b > snd hi
|
|
||||||
|
|
||||||
giveNeighbourhood :: PlayMap -- ^ map on which to find neighbourhood
|
|
||||||
-> Int -- ^ iterative
|
|
||||||
-> (Int, Int) -- ^ original coordinates
|
|
||||||
-> [(Int, Int)] -- ^ neighbourhood
|
|
||||||
giveNeighbourhood _ 0 (a,b) = [(a,b)]
|
|
||||||
giveNeighbourhood mp n (a,b) = let ns = giveNeighbours mp (a,b) in
|
|
||||||
remdups . concat $ ns : map (giveNeighbourhood mp (n-1)) ns
|
|
||||||
|
|
||||||
-- | Calculates the height of any given point on the map.
|
|
||||||
-- Does not add camera distance to ground to that.
|
|
||||||
giveMapHeight :: PlayMap
|
|
||||||
-> (Double, Double)
|
|
||||||
-> Double
|
|
||||||
giveMapHeight mop (x, z)
|
|
||||||
| outsideMap (x,z') = 0.0
|
|
||||||
| otherwise = height --sum $ map (\(p,d) -> hlu p * (d / totald)) tups
|
|
||||||
where
|
|
||||||
z' = z * 2/ sqrt 3
|
|
||||||
rx = x - (fromIntegral $ floor (x +0.5))
|
|
||||||
rz = z' - (fromIntegral $ floor (z'+0.5))
|
|
||||||
|
|
||||||
hoi = map (hlu . clmp . tadd (floor x, floor z')) mods
|
|
||||||
where
|
|
||||||
mods = [(0,0),(0,1),(1,0),(1,1)]
|
|
||||||
tadd (a,b) (c,d) = (a+c,b+d)
|
|
||||||
|
|
||||||
height = --trace (show [rx,rz] ++ show hoi)
|
|
||||||
rz * (rx * (hoi !! 0) + (1-rx) * (hoi !! 2))
|
|
||||||
+ (1-rz) * (rx * (hoi !! 1) + (1-rx) * (hoi !! 3))
|
|
||||||
|
|
||||||
outsideMap :: (Double, Double) -> Bool
|
|
||||||
outsideMap (mx, mz) = let ((a,b),(c,d)) = bounds mop
|
|
||||||
fr = fromIntegral
|
|
||||||
in mx < fr a || mx > fr c || mz < fr b || mz > fr d
|
|
||||||
|
|
||||||
-- Height LookUp on PlayMap
|
|
||||||
hlu :: (Int, Int) -> Double
|
|
||||||
hlu (k,j) = let (Node _ (_,_,y) _ _ _ _ _ _) = mop ! (k,j) in y
|
|
||||||
|
|
||||||
-- reference Points
|
|
||||||
refs :: [(Int, Int)]
|
|
||||||
refs = remdups $ map (clmp . tadd (floor x, floor z')) mods
|
|
||||||
where
|
|
||||||
mods = [(-1,-1),(-1,2),(0,0),(0,1),(1,0),(1,1),(2,-1),(2,2)]
|
|
||||||
tadd (a,b) (c,d) = (a+c,b+d)
|
|
||||||
|
|
||||||
-- tupels with reference point and distance
|
|
||||||
tups = zip refs weights --map (\t -> (t, dist (x,z') t)) refs
|
|
||||||
where
|
|
||||||
weights = [1,2,1,2,4,2,1,2,1]
|
|
||||||
|
|
||||||
-- total distance of all for reference point from the point in question
|
|
||||||
totald = sum $ map snd tups
|
|
||||||
|
|
||||||
-- clamp, as she is programmed
|
|
||||||
clamp :: (Ord a) => a -> a -> a -> a
|
|
||||||
clamp mn mx = max mn . min mx
|
|
||||||
|
|
||||||
-- clamp for tupels
|
|
||||||
clmp :: (Int, Int) -> (Int, Int)
|
|
||||||
clmp (a,b) = let ((xmin,zmin),(xmax,zmax)) = bounds mop
|
|
||||||
in (clamp (xmin+2) (xmax-2) a,clamp (zmin+2) (zmax-2) b)
|
|
||||||
|
|
||||||
-- Real distance on PlayMap
|
|
||||||
dist :: (Double, Double) -> (Int, Int) -> Double
|
|
||||||
dist (x1,z1) pmp = let xf = x1 - realx
|
|
||||||
zf = z1 - realz
|
|
||||||
in sqrt $ xf*xf + zf*zf
|
|
||||||
where
|
|
||||||
realx = (\(Node _ (nx,_,_) _ _ _ _ _ _) -> nx) (mop ! pmp)
|
|
||||||
realz = (\(Node _ (_,nz,_) _ _ _ _ _ _) -> nz) (mop ! pmp)
|
|
||||||
|
|
||||||
-- removing duplicates in O(n log n), losing order and adding Ord requirement
|
|
||||||
remdups :: Ord a => [a] -> [a]
|
|
||||||
remdups = map head . group . sort
|
|
||||||
138
src/Map/Types.hs
138
src/Map/Types.hs
@ -1,138 +0,0 @@
|
|||||||
module Map.Types
|
|
||||||
where
|
|
||||||
|
|
||||||
import Data.Array
|
|
||||||
|
|
||||||
type PlayMap = Array (Xindex, Zindex) Node
|
|
||||||
|
|
||||||
type Xindex = Int
|
|
||||||
type Zindex = Int
|
|
||||||
type XCoord = Double
|
|
||||||
type ZCoord = Double
|
|
||||||
type YCoord = Double
|
|
||||||
|
|
||||||
data Node = Node { mapCoordinates :: (Xindex, Zindex)
|
|
||||||
, actualCoordinates :: (XCoord, ZCoord, YCoord)
|
|
||||||
, tiletype :: TileType
|
|
||||||
, buildinfo :: BuildInfo
|
|
||||||
, playerinfo :: PlayerInfo
|
|
||||||
, pathinfo :: PathInfo
|
|
||||||
, resinfo :: ResInfo
|
|
||||||
, storinfo :: StorInfo
|
|
||||||
} deriving (Show)
|
|
||||||
|
|
||||||
data MapType = GrassIslandMap
|
|
||||||
| DesertMap
|
|
||||||
|
|
||||||
-- | Ownership information, Parameter to occupied is player number
|
|
||||||
data PlayerInfo = NoPlayer
|
|
||||||
| Occupied Int
|
|
||||||
|
|
||||||
instance Show PlayerInfo where
|
|
||||||
show (NoPlayer) = "not occupied"
|
|
||||||
show (Occupied i) = "occupied by player " ++ show i
|
|
||||||
|
|
||||||
-- | Path info, is this node part of a path and if so, where does it lead?
|
|
||||||
data PathInfo = NoPath
|
|
||||||
| Border
|
|
||||||
| Paths [(XCoord, YCoord)]
|
|
||||||
deriving (Show, Eq)
|
|
||||||
|
|
||||||
-- | What resources can be harvested here?
|
|
||||||
data ResInfo = Plain
|
|
||||||
| ResInfo Resource Amount
|
|
||||||
|
|
||||||
instance Show ResInfo where
|
|
||||||
show (Plain) = "no resources"
|
|
||||||
show (ResInfo res amt) = "Resource: " ++ show res ++ "," ++ show amt
|
|
||||||
|
|
||||||
-- | What commodities are currently stored here?
|
|
||||||
type StorInfo = [(Commodity,Amount)]
|
|
||||||
|
|
||||||
-- | What kind of structures may be erected here?
|
|
||||||
data BuildInfo = BStruc Structure
|
|
||||||
| BNothing
|
|
||||||
| BFlag
|
|
||||||
| BMine
|
|
||||||
| BSmall
|
|
||||||
| BMedium
|
|
||||||
| BLarge
|
|
||||||
|
|
||||||
instance Show BuildInfo where
|
|
||||||
show (BStruc s) = "Structure: " ++ show s
|
|
||||||
show (BNothing) = "no Structure possible"
|
|
||||||
show (BFlag) = "only flags possible"
|
|
||||||
show (BMine) = "mines possible"
|
|
||||||
show (BSmall) = "small buildings possible"
|
|
||||||
show (BMedium) = "medium buildings possible"
|
|
||||||
show (BLarge) = "large buildings possible"
|
|
||||||
|
|
||||||
data TileType = Ocean
|
|
||||||
| Beach
|
|
||||||
| Grass
|
|
||||||
| Desert
|
|
||||||
| Lake
|
|
||||||
| Hill -- ^ Accessible
|
|
||||||
| Mountain -- ^ Not accessible
|
|
||||||
deriving (Show, Eq)
|
|
||||||
|
|
||||||
data Structure = Flag -- Flag
|
|
||||||
| Woodcutter -- Huts
|
|
||||||
| Forester
|
|
||||||
| Stonemason
|
|
||||||
| Fisher
|
|
||||||
| Hunter
|
|
||||||
| Barracks
|
|
||||||
| Guardhouse
|
|
||||||
| LookoutTower
|
|
||||||
| Well
|
|
||||||
| Sawmill -- Houses
|
|
||||||
| Slaughterhouse
|
|
||||||
| Mill
|
|
||||||
| Bakery
|
|
||||||
| IronSmelter
|
|
||||||
| Metalworks
|
|
||||||
| Armory
|
|
||||||
| Mint
|
|
||||||
| Shipyard
|
|
||||||
| Brewery
|
|
||||||
| Storehouse
|
|
||||||
| Watchtower
|
|
||||||
| Catapult
|
|
||||||
| GoldMine -- Mines
|
|
||||||
| IronMine
|
|
||||||
| GraniteMine
|
|
||||||
| CoalMine
|
|
||||||
| Farm -- Castles
|
|
||||||
| PigFarm
|
|
||||||
| DonkeyBreeder
|
|
||||||
| Harbor
|
|
||||||
| Fortress
|
|
||||||
deriving (Show, Eq)
|
|
||||||
|
|
||||||
data Amount = Infinite -- Neverending supply
|
|
||||||
| Finite Int -- Finite supply
|
|
||||||
|
|
||||||
-- Extremely preliminary, expand when needed
|
|
||||||
data Commodity = WoodPlank
|
|
||||||
| Sword
|
|
||||||
| Fish
|
|
||||||
deriving Eq
|
|
||||||
|
|
||||||
data Resource = Coal
|
|
||||||
| Iron
|
|
||||||
| Gold
|
|
||||||
| Granite
|
|
||||||
| Water
|
|
||||||
| Fishes
|
|
||||||
deriving (Show, Eq)
|
|
||||||
|
|
||||||
instance Show Amount where
|
|
||||||
show (Infinite) = "inexhaustable supply"
|
|
||||||
show (Finite n) = show n ++ " left"
|
|
||||||
|
|
||||||
instance Show Commodity where
|
|
||||||
show WoodPlank = "wooden plank"
|
|
||||||
show Sword = "sword"
|
|
||||||
show Fish = "fish"
|
|
||||||
|
|
||||||
@ -1,191 +0,0 @@
|
|||||||
module Render.Misc where
|
|
||||||
|
|
||||||
import Control.Monad
|
|
||||||
import qualified Data.ByteString as B (ByteString)
|
|
||||||
import Data.Int (Int8)
|
|
||||||
import Data.Word (Word32,Word8)
|
|
||||||
import Graphics.Rendering.OpenGL.GL.Shaders
|
|
||||||
import Graphics.Rendering.OpenGL.GL.StateVar
|
|
||||||
import Graphics.Rendering.OpenGL.GL.StringQueries
|
|
||||||
import Graphics.Rendering.OpenGL.GLU.Errors
|
|
||||||
import Graphics.Rendering.OpenGL.GL.VertexArrayObjects
|
|
||||||
import Graphics.Rendering.OpenGL.GL.VertexArrays
|
|
||||||
import Graphics.Rendering.OpenGL.GL.VertexSpec
|
|
||||||
import Graphics.Rendering.OpenGL.GL.BufferObjects
|
|
||||||
import Graphics.UI.SDL.Types (Texture)
|
|
||||||
import System.IO (hPutStrLn, stderr)
|
|
||||||
import Linear
|
|
||||||
import Foreign.C (CFloat, CUChar)
|
|
||||||
import Foreign.Marshal.Array (peekArray)
|
|
||||||
import Foreign.Ptr (Ptr, castPtr)
|
|
||||||
|
|
||||||
up :: V3 CFloat
|
|
||||||
up = V3 0 1 0
|
|
||||||
|
|
||||||
checkError :: String -> IO ()
|
|
||||||
checkError functionName = get errors >>= mapM_ reportError
|
|
||||||
where reportError e =
|
|
||||||
hPutStrLn stderr (showError e ++ " detected in " ++ functionName)
|
|
||||||
showError (Error category message) =
|
|
||||||
"GL error " ++ show category ++ " (" ++ message ++ ")"
|
|
||||||
|
|
||||||
dumpInfo :: IO ()
|
|
||||||
dumpInfo = do
|
|
||||||
let dump message var = putStrLn . ((message ++ ": ") ++) =<< get var
|
|
||||||
dump "Vendor" vendor
|
|
||||||
dump "Renderer" renderer
|
|
||||||
dump "Version" glVersion
|
|
||||||
dump "GLSL" shadingLanguageVersion
|
|
||||||
checkError "dumpInfo"
|
|
||||||
|
|
||||||
checked :: (t -> IO ()) -> (t -> GettableStateVar Bool) -> (t -> GettableStateVar String) -> String -> t -> IO ()
|
|
||||||
checked action getStatus getInfoLog message object = do
|
|
||||||
action object
|
|
||||||
status <- get (getStatus object)
|
|
||||||
unless status $
|
|
||||||
hPutStrLn stderr . ((message ++ " log: ") ++) =<< get (getInfoLog object)
|
|
||||||
|
|
||||||
compileAndCheck :: Shader -> IO ()
|
|
||||||
compileAndCheck = checked compileShader compileStatus shaderInfoLog "compile"
|
|
||||||
|
|
||||||
compileShaderSource :: ShaderType -> B.ByteString -> IO Shader
|
|
||||||
compileShaderSource st source = do
|
|
||||||
shader <- createShader st
|
|
||||||
shaderSourceBS shader $= source
|
|
||||||
compileAndCheck shader
|
|
||||||
return shader
|
|
||||||
|
|
||||||
linkAndCheck :: Program -> IO ()
|
|
||||||
linkAndCheck = checked linkProgram linkStatus programInfoLog "link"
|
|
||||||
|
|
||||||
createProgramUsing :: [Shader] -> IO Program
|
|
||||||
createProgramUsing shaders = do
|
|
||||||
program <- createProgram
|
|
||||||
attachedShaders program $= shaders
|
|
||||||
linkAndCheck program
|
|
||||||
return program
|
|
||||||
|
|
||||||
createFrustum :: Float -> Float -> Float -> Float -> M44 CFloat
|
|
||||||
createFrustum fov n' f' rat =
|
|
||||||
let
|
|
||||||
f = realToFrac f'
|
|
||||||
n = realToFrac n'
|
|
||||||
s = realToFrac $ recip (tan $ fov*0.5 * pi / 180)
|
|
||||||
(ratw,rath) = if rat > 1 then
|
|
||||||
(1,1/realToFrac rat)
|
|
||||||
else
|
|
||||||
(realToFrac rat,1)
|
|
||||||
in
|
|
||||||
V4 (V4 (s/ratw) 0 0 0)
|
|
||||||
(V4 0 (s/rath) 0 0)
|
|
||||||
(V4 0 0 (-((f+n)/(f-n))) (-((2*f*n)/(f-n))))
|
|
||||||
(V4 0 0 (-1) 0)
|
|
||||||
|
|
||||||
-- | Creates an orthogonal frustum with given width, height, near and far-plane
|
|
||||||
createFrustumOrtho :: Float -> Float -> Float -> Float -> M44 CFloat
|
|
||||||
createFrustumOrtho w' h' n' f' =
|
|
||||||
let [w,h,n,f] = map realToFrac [w',h',n',f']
|
|
||||||
in
|
|
||||||
V4 (V4 (0.5/w) 0 0 0)
|
|
||||||
(V4 0 (0.5/h) 0 0)
|
|
||||||
(V4 0 0 (-2/(f-n)) ((-f+n)/(f-n)))
|
|
||||||
(V4 0 0 0 1)
|
|
||||||
|
|
||||||
-- from vmath.h
|
|
||||||
lookAt :: V3 CFloat -> V3 CFloat -> V3 CFloat -> M44 CFloat
|
|
||||||
lookAt eye center up' =
|
|
||||||
V4
|
|
||||||
(V4 xx xy xz (-dot x eye))
|
|
||||||
(V4 yx yy yz (-dot y eye))
|
|
||||||
(V4 zx zy zz (-dot z eye))
|
|
||||||
(V4 0 0 0 1)
|
|
||||||
where
|
|
||||||
z@(V3 zx zy zz) = normalize (eye ^-^ center)
|
|
||||||
x@(V3 xx xy xz) = normalize (cross up' z)
|
|
||||||
y@(V3 yx yy yz) = normalize (cross z x)
|
|
||||||
|
|
||||||
|
|
||||||
{-getCam :: (Double, Double) -- ^ Target in x/z-Plane
|
|
||||||
-> Double -- ^ Distance from Target
|
|
||||||
-> Double -- ^ Angle around X-Axis (angle down/up)
|
|
||||||
-> Double -- ^ Angle around Y-Axis (angle left/right)
|
|
||||||
-> M44 CFloat
|
|
||||||
|
|
||||||
getCam (x',z') dist' xa' ya' = lookAt (cpos ^+^ at') at' up
|
|
||||||
where
|
|
||||||
at' = V3 x 0 z
|
|
||||||
cpos = crot !* (V3 0 0 (-dist))
|
|
||||||
crot = (
|
|
||||||
(fromQuaternion $ axisAngle upmap (xa::CFloat))
|
|
||||||
!*!
|
|
||||||
(fromQuaternion $ axisAngle (V3 0 1 0) (ya::CFloat))
|
|
||||||
) ::M33 CFloat
|
|
||||||
upmap = ((fromQuaternion $ axisAngle (V3 0 1 0) (ya::CFloat)) :: M33 CFloat)
|
|
||||||
!* (V3 1 0 0)
|
|
||||||
x = realToFrac x'
|
|
||||||
z = realToFrac z'
|
|
||||||
dist = realToFrac dist'
|
|
||||||
xa = realToFrac xa'
|
|
||||||
ya = realToFrac ya'-}
|
|
||||||
|
|
||||||
-- | Prints any Pointer as Float-Array with given number of elements and chunks.
|
|
||||||
printPtrAsFloatArray :: Ptr a -> Int -> Int -> IO ()
|
|
||||||
printPtrAsFloatArray pointer num co = do
|
|
||||||
a <- peekArray num (castPtr pointer :: Ptr CFloat)
|
|
||||||
print $ chunksOf co a
|
|
||||||
|
|
||||||
-- | Prints any Pointer as UByte-Array with given number of elements and chunks.
|
|
||||||
printPtrAsUByteArray :: Ptr a -> Int -> Int -> IO ()
|
|
||||||
printPtrAsUByteArray pointer num co = do
|
|
||||||
a <- peekArray num (castPtr pointer :: Ptr CUChar)
|
|
||||||
print $ chunksOf co a
|
|
||||||
|
|
||||||
-- | Prints any Pointer as Word32-Array with given number of elements and chunks.
|
|
||||||
printPtrAsWord32Array :: Ptr a -> Int -> Int -> IO ()
|
|
||||||
printPtrAsWord32Array pointer num co = do
|
|
||||||
a <- peekArray num (castPtr pointer :: Ptr Word32)
|
|
||||||
print $ chunksOf co a
|
|
||||||
|
|
||||||
curb :: Ord a => a -> a -> a -> a
|
|
||||||
curb l h x
|
|
||||||
| x < l = l
|
|
||||||
| x > h = h
|
|
||||||
| otherwise = x
|
|
||||||
|
|
||||||
|
|
||||||
tryWithTexture :: Maybe Texture -> (Texture -> a) -> a -> a
|
|
||||||
tryWithTexture t f fail' =
|
|
||||||
case t of
|
|
||||||
Just tex -> f tex
|
|
||||||
_ -> fail'
|
|
||||||
|
|
||||||
genColorData :: Int -- ^ Amount
|
|
||||||
-> [Word8] -- ^ [r,g,b,a], [r,g,b] - whatever should be repeatet.
|
|
||||||
-> [Word8]
|
|
||||||
genColorData n c = take (length c*n) (cycle c)
|
|
||||||
|
|
||||||
chunksOf :: Int -> [a] -> [[a]]
|
|
||||||
chunksOf _ [] = []
|
|
||||||
chunksOf a xs = take a xs : chunksOf a (drop a xs)
|
|
||||||
|
|
||||||
|
|
||||||
withVAO :: VertexArrayObject -> IO a -> IO a
|
|
||||||
withVAO v a = do
|
|
||||||
bindVertexArrayObject $= Just v
|
|
||||||
ret <- a
|
|
||||||
bindVertexArrayObject $= Nothing
|
|
||||||
return ret
|
|
||||||
|
|
||||||
withVBO :: BufferObject -> BufferTarget -> IO a -> IO a
|
|
||||||
withVBO b t a = do
|
|
||||||
bindBuffer t $= Just b
|
|
||||||
ret <- a
|
|
||||||
bindBuffer t $= Nothing
|
|
||||||
return ret
|
|
||||||
|
|
||||||
withVAA :: [AttribLocation] -> IO a -> IO a
|
|
||||||
withVAA atts action = do
|
|
||||||
mapM_ (\a -> vertexAttribArray a $= Enabled) atts
|
|
||||||
ret <- action
|
|
||||||
mapM_ (\a -> vertexAttribArray a $= Disabled) atts
|
|
||||||
return ret
|
|
||||||
@ -1,538 +0,0 @@
|
|||||||
{-# LANGUAGE BangPatterns, InstanceSigs, ExistentialQuantification #-}
|
|
||||||
module Render.Render (initBuffer, initMapShader, initHud, initRendering, render) where
|
|
||||||
|
|
||||||
import qualified Data.ByteString as B
|
|
||||||
import Foreign.Marshal.Array (withArray)
|
|
||||||
import Foreign.Storable
|
|
||||||
import Graphics.Rendering.OpenGL.GL
|
|
||||||
import Graphics.Rendering.OpenGL.Raw.Core31
|
|
||||||
import Graphics.Rendering.OpenGL.Raw.ARB.TessellationShader
|
|
||||||
import Graphics.GLUtil.BufferObjects
|
|
||||||
import qualified Linear as L
|
|
||||||
import Control.Lens ((^.))
|
|
||||||
import Control.Monad.RWS.Strict (liftIO)
|
|
||||||
import qualified Control.Monad.RWS.Strict as RWS (get)
|
|
||||||
import Control.Concurrent.STM (readTVarIO)
|
|
||||||
import Data.Distributive (distribute, collect)
|
|
||||||
-- FFI
|
|
||||||
import Foreign (Ptr, castPtr, with, nullPtr)
|
|
||||||
import Foreign.C (CFloat)
|
|
||||||
|
|
||||||
import Map.Graphics
|
|
||||||
import Types
|
|
||||||
import Render.Misc
|
|
||||||
import Render.Types
|
|
||||||
import Importer.IQM.Parser
|
|
||||||
import Importer.IQM.Types
|
|
||||||
|
|
||||||
mapVertexShaderFile :: String
|
|
||||||
mapVertexShaderFile = "shaders/map/vertex.shader"
|
|
||||||
mapTessControlShaderFile :: String
|
|
||||||
mapTessControlShaderFile = "shaders/map/tessControl.shader"
|
|
||||||
mapTessEvalShaderFile :: String
|
|
||||||
mapTessEvalShaderFile = "shaders/map/tessEval.shader"
|
|
||||||
mapFragmentShaderFile :: String
|
|
||||||
mapFragmentShaderFile = "shaders/map/fragment.shader"
|
|
||||||
mapFragmentShaderShadowMapFile :: String
|
|
||||||
mapFragmentShaderShadowMapFile = "shaders/map/fragmentShadow.shader"
|
|
||||||
|
|
||||||
objectVertexShaderFile :: String
|
|
||||||
objectVertexShaderFile = "shaders/mapobjects/vertex.shader"
|
|
||||||
objectFragmentShaderFile :: String
|
|
||||||
objectFragmentShaderFile = "shaders/mapobjects/fragment.shader"
|
|
||||||
|
|
||||||
uiVertexShaderFile :: String
|
|
||||||
uiVertexShaderFile = "shaders/ui/vertex.shader"
|
|
||||||
uiFragmentShaderFile :: String
|
|
||||||
uiFragmentShaderFile = "shaders/ui/fragment.shader"
|
|
||||||
|
|
||||||
initBuffer :: [GLfloat] -> IO BufferObject
|
|
||||||
initBuffer varray =
|
|
||||||
let
|
|
||||||
sizeOfVarray = length varray * sizeOfComponent
|
|
||||||
sizeOfComponent = sizeOf (head varray)
|
|
||||||
in do
|
|
||||||
bufferObject <- genObjectName
|
|
||||||
bindBuffer ArrayBuffer $= Just bufferObject
|
|
||||||
withArray varray $ \buffer ->
|
|
||||||
bufferData ArrayBuffer $= (fromIntegral sizeOfVarray, buffer, StaticDraw)
|
|
||||||
checkError "initBuffer"
|
|
||||||
return bufferObject
|
|
||||||
|
|
||||||
initMapShader ::
|
|
||||||
Int -- ^ initial Tessallation-Factor
|
|
||||||
-> (BufferObject,NumArrayIndices) -- ^ Buffer with Data and DataDescriptor
|
|
||||||
-> IO (GLMapState, TextureObject, TextureObject)
|
|
||||||
initMapShader tessFac (buf, vertDes) = do
|
|
||||||
! vertexSource <- B.readFile mapVertexShaderFile
|
|
||||||
! tessControlSource <- B.readFile mapTessControlShaderFile
|
|
||||||
! tessEvalSource <- B.readFile mapTessEvalShaderFile
|
|
||||||
! fragmentSource <- B.readFile mapFragmentShaderFile
|
|
||||||
! fragmentShadowSource <- B.readFile mapFragmentShaderShadowMapFile
|
|
||||||
vertexShader <- compileShaderSource VertexShader vertexSource
|
|
||||||
checkError "compile Vertex"
|
|
||||||
tessControlShader <- compileShaderSource TessControlShader tessControlSource
|
|
||||||
checkError "compile TessControl"
|
|
||||||
tessEvalShader <- compileShaderSource TessEvaluationShader tessEvalSource
|
|
||||||
checkError "compile TessEval"
|
|
||||||
fragmentShader <- compileShaderSource FragmentShader fragmentSource
|
|
||||||
checkError "compile Frag"
|
|
||||||
fragmentShadowShader <- compileShaderSource FragmentShader fragmentShadowSource
|
|
||||||
checkError "compile Frag"
|
|
||||||
program <- createProgramUsing [vertexShader, tessControlShader, tessEvalShader, fragmentShader]
|
|
||||||
shadowProgram <- createProgramUsing [vertexShader, tessControlShader, tessEvalShader, fragmentShadowShader]
|
|
||||||
checkError "compile Program"
|
|
||||||
|
|
||||||
currentProgram $= Just program
|
|
||||||
|
|
||||||
projectionMatrixIndex <- get (uniformLocation program "ProjectionMatrix")
|
|
||||||
checkError "projMat"
|
|
||||||
|
|
||||||
viewMatrixIndex <- get (uniformLocation program "ViewMatrix")
|
|
||||||
checkError "viewMat"
|
|
||||||
|
|
||||||
modelMatrixIndex <- get (uniformLocation program "ModelMatrix")
|
|
||||||
checkError "modelMat"
|
|
||||||
|
|
||||||
normalMatrixIndex <- get (uniformLocation program "NormalMatrix")
|
|
||||||
checkError "normalMat"
|
|
||||||
|
|
||||||
tessLevelInner <- get (uniformLocation program "TessLevelInner")
|
|
||||||
checkError "TessLevelInner"
|
|
||||||
|
|
||||||
tessLevelOuter <- get (uniformLocation program "TessLevelOuter")
|
|
||||||
checkError "TessLevelOuter"
|
|
||||||
|
|
||||||
|
|
||||||
vertexIndex <- get (attribLocation program "Position")
|
|
||||||
vertexAttribArray vertexIndex $= Enabled
|
|
||||||
checkError "vertexInd"
|
|
||||||
|
|
||||||
normalIndex <- get (attribLocation program "Normal")
|
|
||||||
vertexAttribArray normalIndex $= Enabled
|
|
||||||
checkError "normalInd"
|
|
||||||
|
|
||||||
colorIndex <- get (attribLocation program "Color")
|
|
||||||
vertexAttribArray colorIndex $= Enabled
|
|
||||||
checkError "colorInd"
|
|
||||||
|
|
||||||
att <- get (activeAttribs program)
|
|
||||||
|
|
||||||
putStrLn $ unlines $ "Map-Attributes: ":map show att
|
|
||||||
putStrLn $ unlines ["Map-Indices: ", show (colorIndex, normalIndex, vertexIndex)]
|
|
||||||
|
|
||||||
tex <- genObjectName
|
|
||||||
dtex <- genObjectName
|
|
||||||
overTex <- genObjectName
|
|
||||||
|
|
||||||
textures <- genObjectNames 6
|
|
||||||
|
|
||||||
smap <- genObjectName
|
|
||||||
|
|
||||||
currentProgram $= Nothing
|
|
||||||
|
|
||||||
! vertexSource' <- B.readFile objectVertexShaderFile
|
|
||||||
! fragmentSource' <- B.readFile objectFragmentShaderFile
|
|
||||||
vertexShader' <- compileShaderSource VertexShader vertexSource'
|
|
||||||
checkError "compile Object-Vertex"
|
|
||||||
fragmentShader' <- compileShaderSource FragmentShader fragmentSource'
|
|
||||||
checkError "compile Object-Fragment"
|
|
||||||
objProgram <- createProgramUsing [vertexShader', fragmentShader']
|
|
||||||
checkError "compile Object-Program"
|
|
||||||
|
|
||||||
currentProgram $= Just objProgram
|
|
||||||
|
|
||||||
vertexIndex' <- get (attribLocation objProgram "Position")
|
|
||||||
vertexAttribArray vertexIndex $= Enabled
|
|
||||||
checkError "Object-vertexInd"
|
|
||||||
|
|
||||||
normalIndex' <- get (attribLocation objProgram "Normal")
|
|
||||||
vertexAttribArray normalIndex $= Enabled
|
|
||||||
checkError "Object-normalInd"
|
|
||||||
|
|
||||||
texIndex' <- get (attribLocation objProgram "TexCoord")
|
|
||||||
vertexAttribArray colorIndex $= Enabled
|
|
||||||
checkError "Object-texInd"
|
|
||||||
|
|
||||||
projectionMatrixIndex' <- get (uniformLocation objProgram "ProjectionMatrix")
|
|
||||||
checkError "projMat"
|
|
||||||
|
|
||||||
viewMatrixIndex' <- get (uniformLocation objProgram "ViewMatrix")
|
|
||||||
checkError "viewMat"
|
|
||||||
|
|
||||||
modelMatrixIndex' <- get (uniformLocation objProgram "ModelMatrix")
|
|
||||||
checkError "modelMat"
|
|
||||||
|
|
||||||
normalMatrixIndex' <- get (uniformLocation objProgram "NormalMatrix")
|
|
||||||
checkError "normalMat"
|
|
||||||
|
|
||||||
--tessLevelInner' <- get (uniformLocation objProgram "TessLevelInner")
|
|
||||||
--checkError "TessLevelInner"
|
|
||||||
|
|
||||||
--tessLevelOuter' <- get (uniformLocation objProgram "TessLevelOuter")
|
|
||||||
--checkError "TessLevelOuter"
|
|
||||||
|
|
||||||
vertexOffsetIndex' <- get (uniformLocation objProgram "PositionOffset")
|
|
||||||
checkError "PositionOffset"
|
|
||||||
|
|
||||||
att' <- get (activeAttribs objProgram)
|
|
||||||
putStrLn $ unlines $ "Model-Attributes: ":map show att'
|
|
||||||
uni' <- get (activeUniforms objProgram)
|
|
||||||
putStrLn $ unlines $ "Model-Uniforms: ":map show uni'
|
|
||||||
putStrLn $ unlines $ ["Model-Indices: ", show (texIndex', normalIndex', vertexIndex')]
|
|
||||||
|
|
||||||
testobj <- parseIQM "models/holzfaellerHaus1.iqm"
|
|
||||||
let objs = [MapObject testobj (L.V3 0 10 0) (MapObjectState ())]
|
|
||||||
|
|
||||||
currentProgram $= Nothing
|
|
||||||
|
|
||||||
checkError "initShader"
|
|
||||||
let sdata = MapShaderData
|
|
||||||
{ shdrVertexIndex = vertexIndex
|
|
||||||
, shdrColorIndex = colorIndex
|
|
||||||
, shdrNormalIndex = normalIndex
|
|
||||||
, shdrProjMatIndex = projectionMatrixIndex
|
|
||||||
, shdrViewMatIndex = viewMatrixIndex
|
|
||||||
, shdrModelMatIndex = modelMatrixIndex
|
|
||||||
, shdrNormalMatIndex = normalMatrixIndex
|
|
||||||
, shdrTessInnerIndex = tessLevelInner
|
|
||||||
, shdrTessOuterIndex = tessLevelOuter
|
|
||||||
}
|
|
||||||
|
|
||||||
let smodata = MapObjectShaderData
|
|
||||||
{ shdrMOVertexIndex = vertexIndex'
|
|
||||||
, shdrMOVertexOffsetIndex = vertexOffsetIndex'
|
|
||||||
, shdrMONormalIndex = normalIndex'
|
|
||||||
, shdrMOTexIndex = texIndex'
|
|
||||||
, shdrMOProjMatIndex = projectionMatrixIndex'
|
|
||||||
, shdrMOViewMatIndex = viewMatrixIndex'
|
|
||||||
, shdrMOModelMatIndex = modelMatrixIndex'
|
|
||||||
, shdrMONormalMatIndex = normalMatrixIndex'
|
|
||||||
, shdrMOTessInnerIndex = UniformLocation 0 --tessLevelInner'
|
|
||||||
, shdrMOTessOuterIndex = UniformLocation 0 --tessLevelOuter'
|
|
||||||
}
|
|
||||||
|
|
||||||
return (GLMapState
|
|
||||||
{ _mapProgram = program
|
|
||||||
, _mapShaderData = sdata
|
|
||||||
, _mapObjectShaderData = smodata
|
|
||||||
, _stateTessellationFactor = tessFac
|
|
||||||
, _stateMap = buf
|
|
||||||
, _mapVert = vertDes
|
|
||||||
, _overviewTexture = overTex
|
|
||||||
, _mapTextures = textures
|
|
||||||
, _shadowMapTexture = smap
|
|
||||||
, _mapObjects = objs
|
|
||||||
, _objectProgram = objProgram
|
|
||||||
, _shadowMapProgram = shadowProgram
|
|
||||||
}, tex, dtex)
|
|
||||||
|
|
||||||
initHud :: IO GLHud
|
|
||||||
initHud = do
|
|
||||||
! vertexSource <- B.readFile "shaders/ui/vertex.shader"
|
|
||||||
! fragmentSource <- B.readFile "shaders/ui/fragment.shader"
|
|
||||||
vertexShader <- compileShaderSource VertexShader vertexSource
|
|
||||||
checkError "compile UI-Vertex"
|
|
||||||
fragmentShader <- compileShaderSource FragmentShader fragmentSource
|
|
||||||
checkError "compile UI-Fragment"
|
|
||||||
program <- createProgramUsing [vertexShader, fragmentShader]
|
|
||||||
checkError "compile Program"
|
|
||||||
|
|
||||||
tex <- genObjectName
|
|
||||||
|
|
||||||
currentProgram $= Just program
|
|
||||||
|
|
||||||
backIndex <- get (uniformLocation program "tex[0]")
|
|
||||||
texIndex <- get (uniformLocation program "tex[1]")
|
|
||||||
checkError "ui-tex"
|
|
||||||
|
|
||||||
-- simple triangle over the whole screen.
|
|
||||||
let vertexBufferData = reverse [-1, -1, 1, -1, -1, 1, 1, 1] :: [GLfloat]
|
|
||||||
|
|
||||||
vertexIndex <- get (attribLocation program "position")
|
|
||||||
vertexAttribArray vertexIndex $= Enabled
|
|
||||||
checkError "vertexInd"
|
|
||||||
|
|
||||||
ebo <- makeBuffer ElementArrayBuffer ([0..3] :: [GLuint])
|
|
||||||
vbo <- makeBuffer ArrayBuffer vertexBufferData
|
|
||||||
|
|
||||||
att <- get (activeAttribs program)
|
|
||||||
|
|
||||||
putStrLn $ unlines $ "Attributes: ":map show att
|
|
||||||
putStrLn $ unlines $ ["Indices: ", show texIndex]
|
|
||||||
|
|
||||||
checkError "initHud"
|
|
||||||
return GLHud
|
|
||||||
{ _hudTexture = tex
|
|
||||||
, _hudTexIndex = texIndex
|
|
||||||
, _hudBackIndex = backIndex
|
|
||||||
, _hudVertexIndex = vertexIndex
|
|
||||||
, _hudVert = 4
|
|
||||||
, _hudVBO = vbo
|
|
||||||
, _hudEBO = ebo
|
|
||||||
, _hudProgram = program
|
|
||||||
}
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
initRendering :: IO ()
|
|
||||||
initRendering = do
|
|
||||||
clearColor $= Color4 0.6 0.7 0.8 1
|
|
||||||
depthFunc $= Just Less
|
|
||||||
glCullFace gl_BACK
|
|
||||||
checkError "initRendering"
|
|
||||||
|
|
||||||
|
|
||||||
-- | renders an IQM-Model at Position with scaling
|
|
||||||
renderIQM :: IQM -> L.V3 CFloat -> L.V3 CFloat -> IO ()
|
|
||||||
renderIQM m p@(L.V3 x y z) s@(L.V3 sx sy sz) = do
|
|
||||||
withVAO (vertexArrayObject m) $ do
|
|
||||||
withVAA [(AttribLocation 0),(AttribLocation 1)] $ do
|
|
||||||
checkError "setting array to enabled"
|
|
||||||
bindBuffer ElementArrayBuffer $= Just (triangleBufferObject m)
|
|
||||||
checkError "bindBuffer"
|
|
||||||
let n = fromIntegral.(*3).num_triangles.header $ m
|
|
||||||
--print $ concat ["drawing ", show n," triangles"]
|
|
||||||
drawElements Triangles n UnsignedInt nullPtr
|
|
||||||
checkError "drawing model"
|
|
||||||
bindBuffer ElementArrayBuffer $= Nothing
|
|
||||||
checkError "unbind buffer"
|
|
||||||
return ()
|
|
||||||
|
|
||||||
renderObject :: MapObject -> IO ()
|
|
||||||
renderObject (MapObject model pos@(L.V3 x y z) _{-state-}) =
|
|
||||||
renderIQM model pos (L.V3 1 1 1)
|
|
||||||
|
|
||||||
drawMap :: Pioneers ()
|
|
||||||
drawMap = do
|
|
||||||
state <- RWS.get
|
|
||||||
let
|
|
||||||
d = state ^. gl.glMap.mapShaderData
|
|
||||||
vi = shdrVertexIndex d
|
|
||||||
ni = shdrNormalIndex d
|
|
||||||
ci = shdrColorIndex d
|
|
||||||
numVert = state ^. gl.glMap.mapVert
|
|
||||||
map' = state ^. gl.glMap.stateMap
|
|
||||||
tessFac = state ^. gl.glMap.stateTessellationFactor
|
|
||||||
(UniformLocation tli) = shdrTessInnerIndex d
|
|
||||||
(UniformLocation tlo) = shdrTessOuterIndex d
|
|
||||||
liftIO $ do
|
|
||||||
glUniform1f tli (fromIntegral tessFac)
|
|
||||||
glUniform1f tlo (fromIntegral tessFac)
|
|
||||||
|
|
||||||
withVBO map' ArrayBuffer $ do
|
|
||||||
vertexAttribPointer ci $= fgColorIndex
|
|
||||||
vertexAttribPointer ni $= fgNormalIndex
|
|
||||||
vertexAttribPointer vi $= fgVertexIndex
|
|
||||||
withVAA [ci,ni,vi] $ do
|
|
||||||
checkError "beforeDraw"
|
|
||||||
|
|
||||||
glPatchParameteri gl_PATCH_VERTICES 3
|
|
||||||
|
|
||||||
cullFace $= Just Front
|
|
||||||
polygonMode $= (Fill,Fill)
|
|
||||||
|
|
||||||
glDrawArrays gl_PATCHES 0 (fromIntegral numVert)
|
|
||||||
|
|
||||||
checkError "draw map"
|
|
||||||
|
|
||||||
-- set sample 1 as target in renderbuffer
|
|
||||||
{-framebufferRenderbuffer
|
|
||||||
DrawFramebuffer --write-only
|
|
||||||
(ColorAttachment 1) --sample 1
|
|
||||||
Renderbuffer --const
|
|
||||||
rb --buffer-}
|
|
||||||
mat44ToGPU :: L.M44 CFloat -> UniformLocation -> String -> IO ()
|
|
||||||
mat44ToGPU mat (UniformLocation dest) name = do
|
|
||||||
with (distribute mat) $ \ptr ->
|
|
||||||
glUniformMatrix4fv dest 1 0 (castPtr (ptr :: Ptr (L.M44 CFloat)))
|
|
||||||
checkError $ "copy Matrix (" ++ name ++ ")"
|
|
||||||
|
|
||||||
mat33ToGPU :: L.M33 CFloat -> UniformLocation -> String -> IO ()
|
|
||||||
mat33ToGPU mat (UniformLocation dest) name = do
|
|
||||||
with (distribute mat) $ \ptr ->
|
|
||||||
glUniformMatrix3fv dest 1 0 (castPtr (ptr :: Ptr (L.M33 CFloat)))
|
|
||||||
checkError $ "copy Matrix (" ++ name ++ ")"
|
|
||||||
|
|
||||||
|
|
||||||
render :: Pioneers ()
|
|
||||||
render = do
|
|
||||||
-- -- FOO <<<<<<<<< denotes a stage (Shadowmap, Map, UI)
|
|
||||||
-- -- BAR --------- denotes a substage (which parts etc.)
|
|
||||||
-- -- BAZ denotes a sub-substage
|
|
||||||
state <- RWS.get
|
|
||||||
cam <- liftIO $ readTVarIO (state ^. camera)
|
|
||||||
let xa = cam ^. xAngle
|
|
||||||
ya = cam ^. yAngle
|
|
||||||
frust = cam ^. Types.frustum
|
|
||||||
camPos = cam ^. camObject
|
|
||||||
zDist' = cam ^. zDist
|
|
||||||
d = state ^. gl.glMap.mapShaderData
|
|
||||||
proj = shdrProjMatIndex d
|
|
||||||
nmat = shdrNormalMatIndex d
|
|
||||||
vmat = shdrViewMatIndex d
|
|
||||||
dmo = state ^. gl.glMap.mapObjectShaderData
|
|
||||||
projmo = shdrMOProjMatIndex dmo
|
|
||||||
nmatmo = shdrMONormalMatIndex dmo
|
|
||||||
vmatmo = shdrMOViewMatIndex dmo
|
|
||||||
suncam = getCam camPos 1 0.7 0 --TODO: Fix position of sun
|
|
||||||
sunnormal' = (case L.inv33 (fmap (^. L._xyz) suncam ^. L._xyz) of
|
|
||||||
(Just a) -> a
|
|
||||||
Nothing -> L.eye3) :: L.M33 CFloat
|
|
||||||
sunnmap = collect id sunnormal' :: L.M33 CFloat --transpose...
|
|
||||||
cam' = getCam camPos zDist' xa ya
|
|
||||||
normal' = (case L.inv33 (fmap (^. L._xyz) cam' ^. L._xyz) of
|
|
||||||
(Just a) -> a
|
|
||||||
Nothing -> L.eye3) :: L.M33 CFloat
|
|
||||||
nmap = collect id normal' :: L.M33 CFloat --transpose...
|
|
||||||
|
|
||||||
liftIO $ do
|
|
||||||
|
|
||||||
bindFramebuffer Framebuffer $= (state ^. gl.glFramebuffer)
|
|
||||||
{-bindRenderbuffer Renderbuffer $= (state ^. gl.glRenderbuffer)
|
|
||||||
framebufferRenderbuffer
|
|
||||||
Framebuffer
|
|
||||||
DepthAttachment
|
|
||||||
Renderbuffer
|
|
||||||
(state ^. gl.glRenderbuffer)-}
|
|
||||||
|
|
||||||
---- RENDER SHADOWMAP <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
|
|
||||||
{- liftIO $ do
|
|
||||||
textureBinding Texture2D $= Just (state ^. gl.glMap.shadowMapTexture)
|
|
||||||
framebufferTexture2D
|
|
||||||
Framebuffer
|
|
||||||
DepthAttachment
|
|
||||||
Texture2D
|
|
||||||
(state ^. gl.glMap.shadowMapTexture)
|
|
||||||
0
|
|
||||||
|
|
||||||
drawBuffer $= NoBuffers --color-buffer is not needed but must(?) be set up
|
|
||||||
checkError "setup Render-Target"
|
|
||||||
|
|
||||||
clear [DepthBuffer]
|
|
||||||
checkError "clearing shadowmap-buffer"
|
|
||||||
|
|
||||||
currentProgram $= Just (state ^. gl.glMap.mapProgram)
|
|
||||||
checkError "setting up shadowmap-program"
|
|
||||||
|
|
||||||
--set up projection (= copy from state)
|
|
||||||
--TODO: Fix width/depth
|
|
||||||
mat44ToGPU (createFrustumOrtho 20 20 0 100) proj "shadowmap-projection"
|
|
||||||
--set up camera
|
|
||||||
mat44ToGPU suncam vmat "shadowmap-cam"
|
|
||||||
--set up normal--Mat transpose((model*camera)^-1)
|
|
||||||
--TODO: needed?
|
|
||||||
mat33ToGPU sunnmap nmat "nmat"
|
|
||||||
|
|
||||||
-- drawMap
|
|
||||||
|
|
||||||
liftIO $ do
|
|
||||||
---- RENDER MAPOBJECTS --------------------------------------------
|
|
||||||
currentProgram $= Just (state ^. gl.glMap.objectProgram)
|
|
||||||
checkError "setting up shadowmap-program"
|
|
||||||
|
|
||||||
--set up projection (= copy from state)
|
|
||||||
--TODO: Fix width/depth
|
|
||||||
mat44ToGPU (createFrustumOrtho 20 20 0 100) projmo "shadowmap-projection"
|
|
||||||
|
|
||||||
--set up camera
|
|
||||||
--TODO: Fix magic constants... and camPos
|
|
||||||
mat44ToGPU suncam vmatmo "shadowmap-camera"
|
|
||||||
|
|
||||||
--set up normal--Mat transpose((model*camera)^-1)
|
|
||||||
--needed?
|
|
||||||
mat33ToGPU sunnmap nmatmo "nmat"
|
|
||||||
|
|
||||||
mapM_ renderObject (state ^. gl.glMap.mapObjects)
|
|
||||||
checkError "draw mapobjects"
|
|
||||||
|
|
||||||
checkError "draw ShadowMap"--}
|
|
||||||
|
|
||||||
---- RENDER MAP IN TEXTURE <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
|
|
||||||
-- COLORMAP
|
|
||||||
liftIO $ do
|
|
||||||
{-bindFramebuffer Framebuffer $= defaultFramebufferObject
|
|
||||||
drawBuffer $= BackBuffers-}
|
|
||||||
tex <- readTVarIO (state ^. mapTexture)
|
|
||||||
dtex <- readTVarIO (state ^. mapDepthTexture)
|
|
||||||
-- add color to texture target
|
|
||||||
framebufferTexture2D
|
|
||||||
Framebuffer
|
|
||||||
(ColorAttachment 0)
|
|
||||||
Texture2D
|
|
||||||
tex
|
|
||||||
0
|
|
||||||
-- add depth to texture target
|
|
||||||
framebufferTexture2D
|
|
||||||
Framebuffer
|
|
||||||
DepthAttachment
|
|
||||||
Texture2D
|
|
||||||
dtex
|
|
||||||
0
|
|
||||||
|
|
||||||
-- Render to FrameBufferObject
|
|
||||||
drawBuffers $= [FBOColorAttachment 0]
|
|
||||||
checkError "setup Render-Target"
|
|
||||||
|
|
||||||
clear [ColorBuffer, DepthBuffer]
|
|
||||||
checkError "clear buffer"
|
|
||||||
|
|
||||||
currentProgram $= Just (state ^. gl.glMap.mapProgram)
|
|
||||||
checkError "setting up buffer"
|
|
||||||
--set up projection (= copy from state)
|
|
||||||
mat44ToGPU frust proj "projection"
|
|
||||||
--set up camera
|
|
||||||
mat44ToGPU cam' vmat "camera"
|
|
||||||
--set up normal--Mat transpose((model*camera)^-1)
|
|
||||||
mat33ToGPU nmap nmat "nmat"
|
|
||||||
|
|
||||||
drawMap
|
|
||||||
liftIO $ do
|
|
||||||
---- RENDER MAPOBJECTS --------------------------------------------
|
|
||||||
currentProgram $= Just (state ^. gl.glMap.objectProgram)
|
|
||||||
checkError "setting up shadowmap-program"
|
|
||||||
--set up projection (= copy from state)
|
|
||||||
mat44ToGPU frust projmo "mapObjects-projection"
|
|
||||||
--set up camera
|
|
||||||
mat44ToGPU cam' vmatmo "mapObjects-cam"
|
|
||||||
--set up normal
|
|
||||||
mat33ToGPU nmap nmatmo "mapObjects-nmat"
|
|
||||||
|
|
||||||
mapM_ renderObject (state ^. gl.glMap.mapObjects)
|
|
||||||
checkError "draw mapobjects"
|
|
||||||
|
|
||||||
---- COMPOSE RENDERING --------------------------------------------
|
|
||||||
-- Render to BackBuffer (=Screen)
|
|
||||||
bindFramebuffer Framebuffer $= defaultFramebufferObject
|
|
||||||
drawBuffer $= BackBuffers
|
|
||||||
-- Drawing HUD
|
|
||||||
clear [ColorBuffer, DepthBuffer]
|
|
||||||
checkError "clear buffer"
|
|
||||||
polygonMode $= (Fill,Fill)
|
|
||||||
|
|
||||||
let hud = state ^. gl.glHud
|
|
||||||
stride = fromIntegral $ sizeOf (undefined::GLfloat) * 2
|
|
||||||
vad = VertexArrayDescriptor 2 Float stride offset0
|
|
||||||
currentProgram $= Just (hud ^. hudProgram)
|
|
||||||
|
|
||||||
activeTexture $= TextureUnit 0
|
|
||||||
textureBinding Texture2D $= Just (hud ^. hudTexture)
|
|
||||||
uniform (hud ^. hudTexIndex) $= Index1 (0::GLint)
|
|
||||||
|
|
||||||
activeTexture $= TextureUnit 1
|
|
||||||
tex <- readTVarIO (state ^. mapTexture)
|
|
||||||
textureBinding Texture2D $= Just tex
|
|
||||||
uniform (hud ^. hudBackIndex) $= Index1 (1::GLint)
|
|
||||||
|
|
||||||
bindBuffer ArrayBuffer $= Just (hud ^. hudVBO)
|
|
||||||
vertexAttribPointer (hud ^. hudVertexIndex) $= (ToFloat, vad)
|
|
||||||
vertexAttribArray (hud ^. hudVertexIndex) $= Enabled
|
|
||||||
|
|
||||||
bindBuffer ElementArrayBuffer $= Just (hud ^. hudEBO)
|
|
||||||
drawElements TriangleStrip 4 UnsignedInt offset0
|
|
||||||
|
|
||||||
bindBuffer ArrayBuffer $= Nothing
|
|
||||||
bindBuffer ElementArrayBuffer $= Nothing
|
|
||||||
|
|
||||||
|
|
||||||
@ -1,2 +0,0 @@
|
|||||||
module Render.RenderObject where
|
|
||||||
|
|
||||||
@ -1,97 +0,0 @@
|
|||||||
{-# LANGUAGE RankNTypes #-}
|
|
||||||
-- | Types specific to Rendering-Issues
|
|
||||||
module Render.Types (createFlatCam, createSphereCam, Camera, GLCamera(..)) where
|
|
||||||
|
|
||||||
import Linear
|
|
||||||
import Foreign.C (CFloat)
|
|
||||||
import Render.Misc (lookAt)
|
|
||||||
import Map.Map (giveMapHeight)
|
|
||||||
import Map.Types (PlayMap)
|
|
||||||
import GHC.Float
|
|
||||||
import qualified Debug.Trace as D
|
|
||||||
|
|
||||||
type Distance = Double
|
|
||||||
type Pitch = Double
|
|
||||||
type Yaw = Double
|
|
||||||
type Radius = Double
|
|
||||||
type Height = Double
|
|
||||||
|
|
||||||
-- | a Typclass for different Cameras
|
|
||||||
class GLCamera a where
|
|
||||||
-- | Gets the current Camera-Matrix for a given Cam, Distance Pitch and Yaw
|
|
||||||
getCam :: a -> Distance -> Pitch -> Yaw -> M44 CFloat
|
|
||||||
-- | Moves the Camera-Target on a projected 2D-plane
|
|
||||||
moveBy :: a -> (Position -> Position) -> PlayMap -> a
|
|
||||||
-- | Moves the Camera-Target to an absoloute position
|
|
||||||
move :: a -> Position -> PlayMap -> a
|
|
||||||
|
|
||||||
-- | Alias for a camera-position onto the 2d-plane it moves on
|
|
||||||
type Position = (Double, Double)
|
|
||||||
|
|
||||||
-- | Camera-Type. Either a Camera onto a 2D-flat-map or a spherical map
|
|
||||||
data Camera = Flat Position Height
|
|
||||||
| Sphere Position Radius
|
|
||||||
|
|
||||||
-- | create a Flatcam-Camera starting at given x/z-Coordinates
|
|
||||||
createFlatCam :: Double -> Double -> PlayMap -> Camera
|
|
||||||
createFlatCam x z map' = Flat (x,z) (giveMapHeight map' (x, z))
|
|
||||||
|
|
||||||
-- | create a Flatcam-Camera starting at given pitch/azimuth/radius
|
|
||||||
createSphereCam :: Double -> Double -> Double -> Camera
|
|
||||||
createSphereCam p a = Sphere (p,a)
|
|
||||||
|
|
||||||
-- | our Camera is indeed a GLCamera that we can use
|
|
||||||
--
|
|
||||||
-- TODO: Sphere-Cam still undefined
|
|
||||||
instance GLCamera Camera where
|
|
||||||
getCam (Flat (x',z') y') dist' xa' ya' =
|
|
||||||
lookAt (cpos ^+^ at') at' up
|
|
||||||
where
|
|
||||||
at' = V3 x (y+2) z
|
|
||||||
cpos = crot !* (V3 0 0 (-dist))
|
|
||||||
crot = (
|
|
||||||
(fromQuaternion $ axisAngle upmap (xa::CFloat))
|
|
||||||
!*!
|
|
||||||
(fromQuaternion $ axisAngle (V3 0 1 0) (ya::CFloat))
|
|
||||||
) ::M33 CFloat
|
|
||||||
upmap = ((fromQuaternion $ axisAngle (V3 0 1 0) (ya::CFloat)) :: M33 CFloat)
|
|
||||||
!* (V3 1 0 0)
|
|
||||||
x = realToFrac x'
|
|
||||||
y = realToFrac y'
|
|
||||||
z = realToFrac z'
|
|
||||||
dist = realToFrac dist'
|
|
||||||
xa = realToFrac xa'
|
|
||||||
ya = realToFrac ya'
|
|
||||||
up = V3 0 1 0
|
|
||||||
getCam (Sphere (inc',az') r') dist' xa' ya' = --inclination (pitch), azimuth (yaw)
|
|
||||||
lookAt (cpos ^+^ at') at' up
|
|
||||||
where
|
|
||||||
at' = sphereToCart (r+1) inc az
|
|
||||||
cpos = crot !* (V3 0 0 (-dist))
|
|
||||||
crot = (
|
|
||||||
(fromQuaternion $ axisAngle upmap (xa::CFloat))
|
|
||||||
!*!
|
|
||||||
(fromQuaternion $ axisAngle (V3 0 1 0) (ya::CFloat))
|
|
||||||
) ::M33 CFloat
|
|
||||||
upmap = ((fromQuaternion $ axisAngle (V3 0 1 0) (ya::CFloat)) :: M33 CFloat)
|
|
||||||
!* (V3 1 0 0)
|
|
||||||
up = (sphereToCart (r+1) inc az) ^-^ at'
|
|
||||||
r = realToFrac r'
|
|
||||||
inc = realToFrac inc'
|
|
||||||
az = realToFrac az'
|
|
||||||
dist = realToFrac dist'
|
|
||||||
xa = realToFrac xa'
|
|
||||||
ya = realToFrac ya'
|
|
||||||
moveBy (Sphere (inc, az) r) f map = undefined
|
|
||||||
moveBy (Flat (x', z') y) f map = Flat (x,z) y
|
|
||||||
where
|
|
||||||
(x,z) = f (x', z')
|
|
||||||
y = giveMapHeight map (x,z)
|
|
||||||
move c (x', z') map = moveBy c (\(x,z) -> (x+x',z+z')) map
|
|
||||||
|
|
||||||
-- | converting spherical to cartesian coordinates
|
|
||||||
sphereToCart :: (Floating a) => a -> a -> a -> V3 a
|
|
||||||
sphereToCart r inc az = V3
|
|
||||||
(r * (sin inc) * (cos az))
|
|
||||||
(r * (sin inc) * (sin az))
|
|
||||||
(r * (cos inc))
|
|
||||||
229
src/Types.hs
229
src/Types.hs
@ -1,229 +0,0 @@
|
|||||||
{-# LANGUAGE TemplateHaskell #-}
|
|
||||||
module Types where
|
|
||||||
|
|
||||||
import Control.Concurrent.STM (TQueue, TVar, readTVar, writeTVar, atomically)
|
|
||||||
import qualified Graphics.Rendering.OpenGL.GL as GL
|
|
||||||
import Graphics.UI.SDL as SDL (Event, Window)
|
|
||||||
import Foreign.C (CFloat)
|
|
||||||
import qualified Data.HashMap.Strict as Map
|
|
||||||
import Data.Time (UTCTime)
|
|
||||||
import Linear.Matrix (M44)
|
|
||||||
import Linear (V3)
|
|
||||||
import Control.Monad.RWS.Strict (RWST, liftIO, get)
|
|
||||||
import Control.Monad.Writer.Strict
|
|
||||||
--import Control.Monad (when)
|
|
||||||
import Control.Lens
|
|
||||||
import Graphics.Rendering.OpenGL.GL.Texturing.Objects (TextureObject)
|
|
||||||
import Render.Types
|
|
||||||
import System.IO
|
|
||||||
import Importer.IQM.Types
|
|
||||||
import UI.UIBase
|
|
||||||
import Map.Types (PlayMap)
|
|
||||||
|
|
||||||
data Coord3D a = Coord3D a a a
|
|
||||||
|
|
||||||
--Static Read-Only-State
|
|
||||||
data Env = Env
|
|
||||||
{ _eventsChan :: TQueue Event
|
|
||||||
, _windowObject :: !Window
|
|
||||||
, _zDistClosest :: !Double
|
|
||||||
, _zDistFarthest :: !Double
|
|
||||||
--, envGLContext :: !GLContext
|
|
||||||
--, envFont :: TTF.TTFFont
|
|
||||||
-- , _renderer :: !Renderer
|
|
||||||
}
|
|
||||||
|
|
||||||
--Mutable State
|
|
||||||
|
|
||||||
data Position = Position
|
|
||||||
{ __x :: !Double
|
|
||||||
, __y :: !Double
|
|
||||||
}
|
|
||||||
|
|
||||||
data WindowState = WindowState
|
|
||||||
{ _width :: !Int
|
|
||||||
, _height :: !Int
|
|
||||||
, _shouldClose :: !Bool
|
|
||||||
}
|
|
||||||
|
|
||||||
data CameraState = CameraState
|
|
||||||
{ _xAngle :: !Double
|
|
||||||
, _yAngle :: !Double
|
|
||||||
, _zDist :: !Double
|
|
||||||
, _frustum :: !(M44 CFloat)
|
|
||||||
, _camObject :: !Camera
|
|
||||||
}
|
|
||||||
|
|
||||||
data IOState = IOState
|
|
||||||
{ _clock :: !UTCTime
|
|
||||||
, _tessClockFactor :: !Double
|
|
||||||
, _tessClockTime :: !UTCTime
|
|
||||||
}
|
|
||||||
|
|
||||||
data GameState = GameState
|
|
||||||
{ _currentMap :: !PlayMap
|
|
||||||
}
|
|
||||||
|
|
||||||
data ArrowKeyState = ArrowKeyState {
|
|
||||||
_up :: !Bool
|
|
||||||
,_down :: !Bool
|
|
||||||
,_left :: !Bool
|
|
||||||
,_right :: !Bool
|
|
||||||
}
|
|
||||||
|
|
||||||
data KeyboardState = KeyboardState
|
|
||||||
{ _arrowsPressed :: !ArrowKeyState
|
|
||||||
}
|
|
||||||
|
|
||||||
-- | State in which all map-related Data is stored
|
|
||||||
--
|
|
||||||
-- The map itself is rendered with mapProgram and the shaders given here directly
|
|
||||||
-- This does not include any objects on the map - only the map itself
|
|
||||||
--
|
|
||||||
-- _mapTextures must contain the following Textures (in this ordering) after initialisation:
|
|
||||||
--
|
|
||||||
-- 1. Grass
|
|
||||||
--
|
|
||||||
-- 2. Sand
|
|
||||||
--
|
|
||||||
-- 3. Water
|
|
||||||
--
|
|
||||||
-- 4. Stone
|
|
||||||
--
|
|
||||||
-- 5. Snow
|
|
||||||
--
|
|
||||||
-- 6. Dirt (blended on grass)
|
|
||||||
|
|
||||||
|
|
||||||
data GLMapState = GLMapState
|
|
||||||
{ _mapShaderData :: !MapShaderData
|
|
||||||
, _mapObjectShaderData :: !MapObjectShaderData
|
|
||||||
, _stateTessellationFactor :: !Int
|
|
||||||
, _stateMap :: !GL.BufferObject
|
|
||||||
, _mapVert :: !GL.NumArrayIndices
|
|
||||||
, _mapProgram :: !GL.Program
|
|
||||||
, _overviewTexture :: !TextureObject
|
|
||||||
, _shadowMapTexture :: !TextureObject
|
|
||||||
, _mapTextures :: ![TextureObject] --TODO: Fix size on list?
|
|
||||||
, _objectProgram :: !GL.Program
|
|
||||||
, _mapObjects :: ![MapObject]
|
|
||||||
, _shadowMapProgram :: !GL.Program
|
|
||||||
}
|
|
||||||
|
|
||||||
data MapShaderData = MapShaderData
|
|
||||||
{ shdrVertexIndex :: !GL.AttribLocation
|
|
||||||
, shdrColorIndex :: !GL.AttribLocation
|
|
||||||
, shdrNormalIndex :: !GL.AttribLocation
|
|
||||||
, shdrProjMatIndex :: !GL.UniformLocation
|
|
||||||
, shdrViewMatIndex :: !GL.UniformLocation
|
|
||||||
, shdrModelMatIndex :: !GL.UniformLocation
|
|
||||||
, shdrNormalMatIndex :: !GL.UniformLocation
|
|
||||||
, shdrTessInnerIndex :: !GL.UniformLocation
|
|
||||||
, shdrTessOuterIndex :: !GL.UniformLocation
|
|
||||||
}
|
|
||||||
|
|
||||||
data MapObjectShaderData = MapObjectShaderData
|
|
||||||
{ shdrMOVertexIndex :: !GL.AttribLocation
|
|
||||||
, shdrMOVertexOffsetIndex :: !GL.UniformLocation
|
|
||||||
, shdrMONormalIndex :: !GL.AttribLocation
|
|
||||||
, shdrMOTexIndex :: !GL.AttribLocation
|
|
||||||
, shdrMOProjMatIndex :: !GL.UniformLocation
|
|
||||||
, shdrMOViewMatIndex :: !GL.UniformLocation
|
|
||||||
, shdrMOModelMatIndex :: !GL.UniformLocation
|
|
||||||
, shdrMONormalMatIndex :: !GL.UniformLocation
|
|
||||||
, shdrMOTessInnerIndex :: !GL.UniformLocation
|
|
||||||
, shdrMOTessOuterIndex :: !GL.UniformLocation
|
|
||||||
}
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
data MapObject = MapObject !IQM !MapCoordinates !MapObjectState
|
|
||||||
|
|
||||||
data MapObjectState = MapObjectState ()
|
|
||||||
|
|
||||||
type MapCoordinates = V3 CFloat
|
|
||||||
|
|
||||||
data GLHud = GLHud
|
|
||||||
{ _hudTexture :: !TextureObject -- ^ HUD-Texture itself
|
|
||||||
, _hudTexIndex :: !GL.UniformLocation -- ^ Position of Overlay-Texture in Shader
|
|
||||||
, _hudBackIndex :: !GL.UniformLocation -- ^ Position of Background-Texture in Shader
|
|
||||||
, _hudVertexIndex :: !GL.AttribLocation -- ^ Position of Vertices in Shader
|
|
||||||
, _hudVert :: !GL.NumArrayIndices -- ^ Number of Vertices to draw
|
|
||||||
, _hudVBO :: !GL.BufferObject -- ^ Vertex-Buffer-Object
|
|
||||||
, _hudEBO :: !GL.BufferObject -- ^ Element-Buffer-Object
|
|
||||||
, _hudProgram :: !GL.Program -- ^ Program for rendering HUD
|
|
||||||
}
|
|
||||||
|
|
||||||
data GLState = GLState
|
|
||||||
{ _glMap :: !GLMapState
|
|
||||||
, _glHud :: !GLHud
|
|
||||||
, _glRenderbuffer :: !GL.RenderbufferObject
|
|
||||||
, _glFramebuffer :: !GL.FramebufferObject
|
|
||||||
}
|
|
||||||
|
|
||||||
data UIState = UIState
|
|
||||||
{ _uiHasChanged :: !Bool
|
|
||||||
, _uiMap :: Map.HashMap UIId (GUIWidget Pioneers)
|
|
||||||
, _uiObserverEvents :: Map.HashMap EventKey [EventHandler Pioneers]
|
|
||||||
, _uiRoots :: !([UIId])
|
|
||||||
, _uiButtonState :: !UIButtonState
|
|
||||||
}
|
|
||||||
|
|
||||||
data State = State
|
|
||||||
{ _window :: !WindowState
|
|
||||||
, _camera :: TVar CameraState
|
|
||||||
, _mapTexture :: TVar TextureObject
|
|
||||||
, _mapDepthTexture :: TVar TextureObject
|
|
||||||
, _camStack :: (Map.HashMap UIId (TVar CameraState, TVar TextureObject))
|
|
||||||
, _io :: !IOState
|
|
||||||
, _keyboard :: !KeyboardState
|
|
||||||
, _gl :: !GLState
|
|
||||||
, _game :: TVar GameState
|
|
||||||
, _ui :: !UIState
|
|
||||||
}
|
|
||||||
|
|
||||||
data Entry = Log {msg::String} deriving Eq
|
|
||||||
|
|
||||||
instance Show Entry where
|
|
||||||
show (Log s) = s
|
|
||||||
|
|
||||||
type Logger = WriterT [Entry] IO Handle
|
|
||||||
|
|
||||||
type Pioneers = RWST Env () State IO
|
|
||||||
|
|
||||||
-- when using TemplateHaskell order of declaration matters
|
|
||||||
$(makeLenses ''State)
|
|
||||||
$(makeLenses ''GLState)
|
|
||||||
$(makeLenses ''GLMapState)
|
|
||||||
$(makeLenses ''GLHud)
|
|
||||||
$(makeLenses ''KeyboardState)
|
|
||||||
$(makeLenses ''ArrowKeyState)
|
|
||||||
$(makeLenses ''GameState)
|
|
||||||
$(makeLenses ''IOState)
|
|
||||||
$(makeLenses ''CameraState)
|
|
||||||
$(makeLenses ''WindowState)
|
|
||||||
$(makeLenses ''Position)
|
|
||||||
$(makeLenses ''Env)
|
|
||||||
$(makeLenses ''UIState)
|
|
||||||
|
|
||||||
-- helper-functions for types
|
|
||||||
|
|
||||||
-- | atomically change gamestate on condition
|
|
||||||
changeIfGamestate :: (GameState -> Bool) -> (GameState -> GameState) -> Pioneers Bool
|
|
||||||
changeIfGamestate cond f = do
|
|
||||||
state <- get
|
|
||||||
liftIO $ atomically $ do
|
|
||||||
game' <- readTVar (state ^. game)
|
|
||||||
let cond' = cond game'
|
|
||||||
when cond' (writeTVar (state ^. game) (f game'))
|
|
||||||
return cond'
|
|
||||||
|
|
||||||
|
|
||||||
-- | atomically change gamestate
|
|
||||||
changeGamestate :: (GameState -> GameState) -> Pioneers ()
|
|
||||||
changeGamestate s = do
|
|
||||||
--forget implied result - is True anyway
|
|
||||||
_ <- changeIfGamestate (const True) s
|
|
||||||
return ()
|
|
||||||
|
|
||||||
@ -1,323 +0,0 @@
|
|||||||
{-# LANGUAGE DoAndIfThenElse #-}
|
|
||||||
module UI.Callbacks where
|
|
||||||
|
|
||||||
|
|
||||||
import qualified Graphics.Rendering.OpenGL.GL as GL
|
|
||||||
import Control.Lens ((^.), (.~), (%~), (^?), at, ix)
|
|
||||||
import Control.Monad (liftM, when, unless)
|
|
||||||
import Control.Monad.RWS.Strict (ask, get, modify)
|
|
||||||
import Control.Monad.Trans (liftIO)
|
|
||||||
import qualified Data.HashMap.Strict as Map
|
|
||||||
--import Data.List (foldl')
|
|
||||||
import Data.Maybe
|
|
||||||
import Foreign.Marshal.Array (pokeArray)
|
|
||||||
import Foreign.Marshal.Alloc (allocaBytes)
|
|
||||||
import qualified Graphics.UI.SDL as SDL
|
|
||||||
import Control.Concurrent.STM.TVar (readTVar, writeTVar)
|
|
||||||
import Control.Concurrent.STM (atomically)
|
|
||||||
|
|
||||||
|
|
||||||
import Render.Misc (curb,genColorData)
|
|
||||||
import Types
|
|
||||||
import UI.UIWidgets
|
|
||||||
import UI.UIOperations
|
|
||||||
|
|
||||||
-- TODO: define GUI positions in a file
|
|
||||||
createGUI :: ScreenUnit -> ScreenUnit -> UIState
|
|
||||||
createGUI w h = UIState
|
|
||||||
{ _uiHasChanged = True
|
|
||||||
, _uiMap = Map.fromList [ (UIId 0, createViewport (camera) LeftButton (0, 0, w, h) [UIId 1, UIId 2, UIId 5] 0) -- TODO: automatic resize
|
|
||||||
, (UIId 1, createContainer (30, 415, 100, 80) [] 1)
|
|
||||||
, (UIId 2, createPanel (50, 240, 0, 0) [UIId 3, UIId 4] 3)
|
|
||||||
, (UIId 3, createContainer (80, 15, 130, 90) [] 4 )
|
|
||||||
, (UIId 4, createButton (10, 40, 60, 130) 2 testMessage)
|
|
||||||
, (UIId 5, createViewport (camera) LeftButton (10, 10, 300, 200) [] 5) -- TODO: wrong camera
|
|
||||||
]
|
|
||||||
, _uiObserverEvents = Map.fromList [(WindowEvent, [resizeToScreenHandler (UIId 0)])]
|
|
||||||
, _uiRoots = [UIId 0]
|
|
||||||
, _uiButtonState = UIButtonState 0 Nothing False
|
|
||||||
}
|
|
||||||
|
|
||||||
getGUI :: Map.HashMap UIId (GUIWidget Pioneers) -> [GUIWidget Pioneers]
|
|
||||||
getGUI = Map.elems
|
|
||||||
{-# INLINE getGUI #-}
|
|
||||||
|
|
||||||
getRootIds :: Pioneers [UIId]
|
|
||||||
getRootIds = do
|
|
||||||
state <- get
|
|
||||||
return $ state ^. ui.uiRoots
|
|
||||||
|
|
||||||
getRoots :: Pioneers [GUIWidget Pioneers]
|
|
||||||
getRoots = do
|
|
||||||
state <- get
|
|
||||||
rootIds <- getRootIds
|
|
||||||
let hMap = state ^. ui.uiMap
|
|
||||||
return $ toGUIAnys hMap rootIds
|
|
||||||
|
|
||||||
testMessage :: MouseButton -> w -> Pixel -> Pioneers w
|
|
||||||
testMessage btn w (x, y) = do
|
|
||||||
case btn of
|
|
||||||
LeftButton -> liftIO $ putStrLn ("\tleft click on " ++ show x ++ "," ++ show y)
|
|
||||||
RightButton -> liftIO $ putStrLn ("\tright click on " ++ show x ++ "," ++ show y)
|
|
||||||
MiddleButton -> liftIO $ putStrLn ("\tmiddle click on " ++ show x ++ "," ++ show y)
|
|
||||||
MouseX1 -> liftIO $ putStrLn ("\tX1 click on " ++ show x ++ "," ++ show y)
|
|
||||||
MouseX2 -> liftIO $ putStrLn ("\tX2 click on " ++ show x ++ "," ++ show y)
|
|
||||||
return w
|
|
||||||
|
|
||||||
transformButton :: SDL.MouseButton -> Maybe MouseButton
|
|
||||||
transformButton SDL.LeftButton = Just LeftButton
|
|
||||||
transformButton SDL.RightButton = Just RightButton
|
|
||||||
transformButton SDL.MiddleButton = Just MiddleButton
|
|
||||||
transformButton SDL.MouseX1 = Just MouseX1
|
|
||||||
transformButton SDL.MouseX2 = Just MouseX2
|
|
||||||
transformButton _ = Nothing
|
|
||||||
|
|
||||||
eventCallback :: SDL.Event -> Pioneers ()
|
|
||||||
eventCallback e = do
|
|
||||||
env <- ask
|
|
||||||
case SDL.eventData e of
|
|
||||||
SDL.Window _ ev -> -- windowID event
|
|
||||||
case ev of
|
|
||||||
SDL.Resized (SDL.Size x y) -> windowResizeHandler x y
|
|
||||||
_ -> return ()
|
|
||||||
SDL.Keyboard movement _ _ key -> -- keyMovement windowID keyRepeat keySym
|
|
||||||
-- need modifiers? use "keyModifiers key" to get them
|
|
||||||
let aks = keyboard.arrowsPressed in
|
|
||||||
case SDL.keyScancode key of
|
|
||||||
SDL.R ->
|
|
||||||
liftIO $ do
|
|
||||||
r <- SDL.getRenderer $ env ^. windowObject
|
|
||||||
putStrLn $ unwords ["Renderer: ",show r]
|
|
||||||
SDL.Escape ->
|
|
||||||
modify $ window.shouldClose .~ True
|
|
||||||
SDL.Left ->
|
|
||||||
modify $ aks.left .~ (movement == SDL.KeyDown)
|
|
||||||
SDL.Right ->
|
|
||||||
modify $ aks.right .~ (movement == SDL.KeyDown)
|
|
||||||
SDL.Up ->
|
|
||||||
modify $ aks.up .~ (movement == SDL.KeyDown)
|
|
||||||
SDL.Down ->
|
|
||||||
modify $ aks.down .~ (movement == SDL.KeyDown)
|
|
||||||
SDL.KeypadPlus ->
|
|
||||||
when (movement == SDL.KeyDown) $ do
|
|
||||||
modify $ gl.glMap.stateTessellationFactor %~ (min 5) . (+1)
|
|
||||||
state <- get
|
|
||||||
liftIO $ putStrLn $ unwords ["Tessellation at: ", show $ state ^. gl.glMap.stateTessellationFactor]
|
|
||||||
SDL.KeypadMinus ->
|
|
||||||
when (movement == SDL.KeyDown) $ do
|
|
||||||
modify $ gl.glMap.stateTessellationFactor %~ (max 1) . (+(-1))
|
|
||||||
state <- get
|
|
||||||
liftIO $ putStrLn $ unwords ["Tessellation at: ", show $ state ^. gl.glMap.stateTessellationFactor]
|
|
||||||
_ ->
|
|
||||||
return ()
|
|
||||||
SDL.MouseMotion _ _ _ (SDL.Position x y) _ _ -> -- windowID mouseID motionState motionPosition xrel yrel
|
|
||||||
mouseMoveHandler (x, y)
|
|
||||||
|
|
||||||
SDL.MouseButton _ _ button state (SDL.Position x y) -> -- windowID mouseID button buttonState buttonAt
|
|
||||||
case state of
|
|
||||||
SDL.Pressed -> maybe (return ()) (`mousePressHandler` (x, y)) $ transformButton button
|
|
||||||
SDL.Released -> maybe (return ()) (`mouseReleaseHandler` (x, y)) $ transformButton button
|
|
||||||
--_ -> return () -- causes "pattern match overlapped"
|
|
||||||
SDL.MouseWheel _ _ _ vscroll -> -- windowID mouseID hScroll vScroll
|
|
||||||
do -- TODO: MouseWheelHandler
|
|
||||||
state <- get
|
|
||||||
liftIO $ atomically $ do
|
|
||||||
cam <- readTVar (state ^. camera)
|
|
||||||
let zDist' = (cam ^. zDist) + realToFrac (negate vscroll)
|
|
||||||
zDist'' = curb (env ^. zDistClosest) (env ^. zDistFarthest) zDist'
|
|
||||||
cam' <- return $ zDist .~ zDist'' $ cam
|
|
||||||
writeTVar (state ^. camera) cam'
|
|
||||||
|
|
||||||
-- there is more (joystic, touchInterface, ...), but currently ignored
|
|
||||||
SDL.Quit -> modify $ window.shouldClose .~ True
|
|
||||||
_ -> liftIO $ putStrLn $ unwords ["Not processing Event:", show e]
|
|
||||||
|
|
||||||
|
|
||||||
windowResizeHandler :: ScreenUnit -> ScreenUnit -> Pioneers ()
|
|
||||||
windowResizeHandler x y = do
|
|
||||||
state <- get
|
|
||||||
case state ^. ui.uiObserverEvents.(at WindowEvent) of
|
|
||||||
Just evs -> let handle :: EventHandler Pioneers -> Pioneers (EventHandler Pioneers)
|
|
||||||
handle (WindowHandler h _) = h x y
|
|
||||||
handle h = return h -- TODO: may log invalid event mapping
|
|
||||||
in do newEvs <- mapM handle evs
|
|
||||||
modify $ ui.uiObserverEvents.(ix WindowEvent) .~ newEvs
|
|
||||||
Nothing -> return ()
|
|
||||||
|
|
||||||
mouseButtonHandler :: (WidgetEventHandler Pioneers -> MouseButton -> Pixel -> Bool -> GUIWidget Pioneers -> Pioneers (GUIWidget Pioneers))
|
|
||||||
-> MouseButton -> Pixel -> Pioneers ()
|
|
||||||
mouseButtonHandler transFunc btn px = do
|
|
||||||
state <- get
|
|
||||||
let hMap = state ^. ui.uiMap
|
|
||||||
currentWidget = state ^. ui.uiButtonState.mouseCurrentWidget
|
|
||||||
case currentWidget of
|
|
||||||
Just (wid, px') -> do
|
|
||||||
let target = toGUIAny hMap wid
|
|
||||||
target' <- case target ^. eventHandlers.(at MouseEvent) of
|
|
||||||
Just ma -> transFunc ma btn (px -: px') (state ^. ui.uiButtonState.mouseInside) target
|
|
||||||
Nothing -> return target
|
|
||||||
modify $ ui.uiMap %~ Map.insert wid target'
|
|
||||||
return ()
|
|
||||||
Nothing -> return ()
|
|
||||||
|
|
||||||
mousePressHandler :: MouseButton -> Pixel -> Pioneers ()
|
|
||||||
mousePressHandler btn px = do
|
|
||||||
modify $ ui.uiButtonState %~ (mousePressed %~ (+1)) -- TODO: what happens if released outside window? not reset properly?
|
|
||||||
mouseButtonHandler (\ma -> fromJust (ma ^? onMousePress)) btn px
|
|
||||||
|
|
||||||
mouseReleaseHandler :: MouseButton -> Pixel -> Pioneers ()
|
|
||||||
mouseReleaseHandler btn px = do
|
|
||||||
modify $ ui.uiButtonState %~ (mousePressed %~ flip (-) 1) -- TODO: what happens if pressed outside window? not set properly?
|
|
||||||
mouseButtonHandler (\ma -> fromJust (ma ^? onMouseRelease)) btn px
|
|
||||||
state <- get
|
|
||||||
unless (state ^. ui.uiButtonState.mousePressed > 0) $ do
|
|
||||||
case state ^. ui.uiButtonState.mouseCurrentWidget of
|
|
||||||
Just (wid, px') -> do
|
|
||||||
let target = toGUIAny (state ^. ui.uiMap) wid
|
|
||||||
-- debug
|
|
||||||
let short = target ^. baseProperties.shorthand
|
|
||||||
bound <- target ^. baseProperties.boundary
|
|
||||||
prio <- target ^. baseProperties.priority
|
|
||||||
liftIO $ putStrLn $ "releasing(" ++ show btn ++ ") " ++ short ++ ": " ++ show bound ++ " "
|
|
||||||
++ show prio ++ " at [" ++ show (fst px) ++ "," ++ show (snd px) ++ "]"
|
|
||||||
-- /debug
|
|
||||||
target' <- case target ^. eventHandlers.(at MouseMotionEvent) of --existing handler?
|
|
||||||
Just ma -> do
|
|
||||||
target_ <- fromJust (ma ^? onMouseEnter) px' target -- TODO unsafe fromJust
|
|
||||||
fromJust (ma ^? onMouseMove) px' target_ -- TODO unsafe fromJust
|
|
||||||
Nothing -> return target
|
|
||||||
modify $ ui.uiMap %~ Map.insert wid target'
|
|
||||||
Nothing -> return ()
|
|
||||||
mouseSetMouseActive px -- TODO leave current
|
|
||||||
|
|
||||||
mouseSetMouseActiveTargeted :: (UIId, Pixel) -- ^ (target widget, local coorinates)
|
|
||||||
-> Pixel -- ^ global coordinates
|
|
||||||
-> Pioneers ()
|
|
||||||
mouseSetMouseActiveTargeted (wid, px') px = do
|
|
||||||
state <- get
|
|
||||||
--liftIO $ putStrLn $ "new target: " ++ show wid
|
|
||||||
let hMap = state ^. ui.uiMap
|
|
||||||
target = toGUIAny hMap wid
|
|
||||||
modify $ ui.uiButtonState %~ (mouseCurrentWidget .~ Just (wid, px -: px')) . (mouseInside .~ True)
|
|
||||||
target' <- case target ^. eventHandlers.(at MouseMotionEvent) of --existing handler?
|
|
||||||
Just ma -> do
|
|
||||||
target_ <- fromJust (ma ^? onMouseEnter) px' target -- TODO unsafe fromJust
|
|
||||||
fromJust (ma ^? onMouseMove) px' target_ -- TODO unsafe fromJust
|
|
||||||
Nothing -> return target
|
|
||||||
modify $ ui.uiMap %~ Map.insert wid target'
|
|
||||||
|
|
||||||
mouseSetMouseActive :: Pixel -- ^global coordinates
|
|
||||||
-> Pioneers ()
|
|
||||||
mouseSetMouseActive px = do
|
|
||||||
roots <- getRootIds
|
|
||||||
hits <- liftM concat $ mapM (getInsideId px) roots
|
|
||||||
leading <- getLeadingWidget hits
|
|
||||||
case leading of
|
|
||||||
Just hit -> mouseSetMouseActiveTargeted hit px
|
|
||||||
Nothing -> modify $ ui.uiButtonState %~ (mouseCurrentWidget .~ Nothing) . (mouseInside .~ False)
|
|
||||||
|
|
||||||
mouseSetLeaving :: UIId -> Pixel -> Pioneers ()
|
|
||||||
mouseSetLeaving wid px = do
|
|
||||||
state <- get
|
|
||||||
let target = toGUIAny (state ^. ui.uiMap) wid
|
|
||||||
modify $ ui.uiButtonState.mouseInside .~ False
|
|
||||||
case target ^. eventHandlers.(at MouseMotionEvent) of --existing handler?
|
|
||||||
Just ma -> do
|
|
||||||
target_ <- fromJust (ma ^? onMouseLeave) px target --TODO unsafe fromJust
|
|
||||||
target' <- if state ^. ui.uiButtonState.mousePressed <= 0 then return target_
|
|
||||||
else fromJust (ma ^? onMouseMove) px target_ --TODO unsafe fromJust
|
|
||||||
modify $ ui.uiMap %~ Map.insert wid target'
|
|
||||||
Nothing -> return ()
|
|
||||||
|
|
||||||
mouseMoveHandler :: Pixel -> Pioneers ()
|
|
||||||
mouseMoveHandler px = do
|
|
||||||
state <- get
|
|
||||||
--liftIO $ print $ state ^. ui.uiButtonState
|
|
||||||
case state ^. ui.uiButtonState.mouseCurrentWidget of -- existing mouse-active widget?
|
|
||||||
Just (wid, px') -> do
|
|
||||||
let target = toGUIAny (state ^. ui.uiMap) wid
|
|
||||||
inTest <- isHittingChild (px -: px') target
|
|
||||||
case inTest of
|
|
||||||
Left b -> -- no child hit
|
|
||||||
if b == state ^. ui.uiButtonState.mouseInside then -- > moving inside or outside
|
|
||||||
case target ^. eventHandlers.(at MouseMotionEvent) of --existing handler?
|
|
||||||
Just ma -> do target' <- fromJust (ma ^? onMouseMove) (px -: px') target
|
|
||||||
modify $ ui.uiMap %~ Map.insert wid target'
|
|
||||||
Nothing -> return ()
|
|
||||||
else if b then -- && not mouseInside --> entering
|
|
||||||
do modify $ ui.uiButtonState.mouseInside .~ True
|
|
||||||
case target ^. eventHandlers.(at MouseMotionEvent) of --existing handler?
|
|
||||||
Just ma -> do
|
|
||||||
target_ <- fromJust (ma ^? onMouseEnter) (px -: px') target --TODO unsafe fromJust
|
|
||||||
target' <- fromJust (ma ^? onMouseMove) (px -: px') target_ --TODO unsafe fromJust
|
|
||||||
modify $ ui.uiMap %~ Map.insert wid target'
|
|
||||||
Nothing -> return ()
|
|
||||||
else -- not b && mouseInside --> leaving
|
|
||||||
do mouseSetLeaving wid (px -: px')
|
|
||||||
when (state ^. ui.uiButtonState.mousePressed <= 0) -- change mouse-active widget?
|
|
||||||
$ mouseSetMouseActive px
|
|
||||||
|
|
||||||
Right childHit -> do
|
|
||||||
mouseSetLeaving wid (px -: px')
|
|
||||||
when (state ^. ui.uiButtonState.mousePressed <= 0) -- change mouse-active widget?
|
|
||||||
$ mouseSetMouseActiveTargeted childHit px
|
|
||||||
Nothing -> do
|
|
||||||
mouseSetMouseActive px
|
|
||||||
|
|
||||||
|
|
||||||
-- | informs the GUI to prepare a blitting of state ^. gl.glHud.hudTexture
|
|
||||||
--
|
|
||||||
--TODO: should be done asynchronously at one point.
|
|
||||||
-- -> can't. if 2 Threads bind Textures its not sure
|
|
||||||
-- on which one the GPU will work.
|
|
||||||
-- "GL.textureBinding GL.Texture2D" is a State set
|
|
||||||
-- to the texture all following works on.
|
|
||||||
--
|
|
||||||
-- https://www.opengl.org/wiki/GLAPI/glTexSubImage2D for copy
|
|
||||||
prepareGUI :: Pioneers ()
|
|
||||||
prepareGUI = do
|
|
||||||
state <- get
|
|
||||||
roots <- getRoots
|
|
||||||
let tex = state ^. gl.glHud.hudTexture
|
|
||||||
liftIO $ do
|
|
||||||
-- bind texture - all later calls work on this one.
|
|
||||||
GL.textureBinding GL.Texture2D GL.$= Just tex
|
|
||||||
mapM_ (copyGUI tex (0, 0)) roots
|
|
||||||
modify $ ui.uiHasChanged .~ False
|
|
||||||
|
|
||||||
--TODO: Perform border-checking ... is xoff + width and yoff+height inside the screen-coordinates..
|
|
||||||
copyGUI :: GL.TextureObject -> Pixel -- ^current view’s offset
|
|
||||||
-> GUIWidget Pioneers -- ^the widget to draw
|
|
||||||
-> Pioneers ()
|
|
||||||
copyGUI tex (vX, vY) widget = do
|
|
||||||
(xoff, yoff, wWidth, wHeight) <- widget ^. baseProperties.boundary
|
|
||||||
state <- get
|
|
||||||
let
|
|
||||||
hMap = state ^. ui.uiMap
|
|
||||||
int = fromInteger.toInteger --conversion between Int8, GLInt, Int, ...
|
|
||||||
--temporary color here. lateron better some getData-function to
|
|
||||||
--get a list of pixel-data or a texture.
|
|
||||||
color = case widget ^. baseProperties.shorthand of
|
|
||||||
"VWP" -> [0,128,128,0]
|
|
||||||
"CNT" -> [255,0,0,128]
|
|
||||||
"BTN" -> [255,255,0,255]
|
|
||||||
"PNL" -> [128,128,128,128]
|
|
||||||
_ -> [255,0,255,255]
|
|
||||||
liftIO $ allocaBytes (wWidth*wHeight*4) $ \ptr -> do
|
|
||||||
--copy data into C-Array
|
|
||||||
pokeArray ptr (genColorData (wWidth*wHeight) color)
|
|
||||||
GL.texSubImage2D
|
|
||||||
GL.Texture2D
|
|
||||||
0
|
|
||||||
(GL.TexturePosition2D (int (vX + xoff)) (int (vY + yoff)))
|
|
||||||
(GL.TextureSize2D (int wWidth) (int wHeight))
|
|
||||||
(GL.PixelData GL.RGBA GL.UnsignedByte ptr)
|
|
||||||
prio <- widget ^. baseProperties.priority
|
|
||||||
when (widget ^. baseProperties.shorthand == "VWP" && prio == 5) $ do
|
|
||||||
-- copy camera texture on screen
|
|
||||||
return ()
|
|
||||||
nextChildrenIds <- widget ^. baseProperties.children
|
|
||||||
mapM_ (copyGUI tex (vX+xoff, vY+yoff)) $ toGUIAnys hMap nextChildrenIds
|
|
||||||
|
|
||||||
--TODO: Add scroll-Handler, return (Pioneers Bool) to indicate event-bubbling etc.
|
|
||||||
--TODO: Maybe queues are better?
|
|
||||||
@ -1,22 +0,0 @@
|
|||||||
module UI.GUIOverlay where
|
|
||||||
|
|
||||||
import Data.Int
|
|
||||||
import Graphics.UI.SDL.Surface
|
|
||||||
import Graphics.UI.SDL.Color
|
|
||||||
import Graphics.UI.SDL.Rect
|
|
||||||
import Graphics.UI.SDL.Types
|
|
||||||
import UI.UITypes
|
|
||||||
|
|
||||||
--createRGBSurface :: Int32 -> Int32 -> Int32 -> Word32 -> Word32 -> Word32 -> Word32 -> IO Surface
|
|
||||||
-- width height depth rFilter gFilter bFilter aFilter
|
|
||||||
-- createRGBSurface width height 32 0xFF000000 0x00FF0000 0x0000FF00 0x000000FF
|
|
||||||
|
|
||||||
updateGUI :: Int32 -> Int32 -> IO Surface
|
|
||||||
updateGUI width height = do
|
|
||||||
overlay <- createRGBSurface width height 32 0xFF000000 0x00FF0000 0x0000FF00 0x000000FF
|
|
||||||
fillRect overlay (Rect 10 10 400 300) (Color 255 0 128 255)
|
|
||||||
return overlay
|
|
||||||
|
|
||||||
|
|
||||||
--createTextureFromSurface :: Renderer -> Surface -> IO Texture
|
|
||||||
--createSoftwareRenderer :: Surface -> IO Renderer
|
|
||||||
417
src/UI/UIBase.hs
417
src/UI/UIBase.hs
@ -1,417 +0,0 @@
|
|||||||
{-# LANGUAGE GeneralizedNewtypeDeriving, TemplateHaskell, DeriveGeneric, KindSignatures #-}
|
|
||||||
-- widget data is separated into several modules to avoid cyclic dependencies with the Type module
|
|
||||||
-- TODO: exclude UIMouseState constructor from export?
|
|
||||||
module UI.UIBase where
|
|
||||||
|
|
||||||
import Control.Lens ((^.), (.~), (%~), (&), ix, mapped, makeLenses)
|
|
||||||
import Control.Monad (join,liftM)
|
|
||||||
import Data.Array
|
|
||||||
import Data.Bits (xor)
|
|
||||||
import Data.Hashable
|
|
||||||
import qualified Data.HashMap.Strict as Map
|
|
||||||
import Data.Ix ()
|
|
||||||
-- import Data.Maybe
|
|
||||||
import GHC.Generics (Generic)
|
|
||||||
|
|
||||||
-- |Unit of screen/window
|
|
||||||
type ScreenUnit = Int
|
|
||||||
|
|
||||||
-- | @x@ and @y@ position on screen.
|
|
||||||
type Pixel = (ScreenUnit, ScreenUnit)
|
|
||||||
|
|
||||||
-- |Combines two tuples element-wise. Designed for use with 'Pixel'.
|
|
||||||
merge :: (a -> b -> c) -> (a, a) -> (b, b) -> (c, c)
|
|
||||||
merge f (x, y) (x', y') = (f x x', f y y')
|
|
||||||
{-# INLINABLE merge #-}
|
|
||||||
|
|
||||||
-- |Maps over the elements of a tuple. Designed for use with 'Pixel'.
|
|
||||||
(>:) :: (a -> b) -> (a, a) -> (b, b)
|
|
||||||
f >: (x, y) = (f x, f y)
|
|
||||||
{-# INLINABLE (>:) #-}
|
|
||||||
|
|
||||||
-- |Adds two numeric tuples component-wise.
|
|
||||||
(+:) :: (Num a) => (a, a) -> (a, a) -> (a, a)
|
|
||||||
(+:) = merge (+)
|
|
||||||
{-# INLINABLE (+:) #-}
|
|
||||||
|
|
||||||
-- |Calculates the component-wise difference between two tuples.
|
|
||||||
(-:) :: (Num a) => (a, a) -> (a, a) -> (a, a)
|
|
||||||
(-:) = merge (-)
|
|
||||||
{-# INLINABLE (-:) #-}
|
|
||||||
|
|
||||||
-- |Multiplies two numeric tuples component-wise.
|
|
||||||
(*:) :: (Num a) => (a, a) -> (a, a) -> (a, a)
|
|
||||||
(*:) = merge (*)
|
|
||||||
{-# INLINABLE (*:) #-}
|
|
||||||
|
|
||||||
infixl 7 *:
|
|
||||||
infixl 6 +:, -:
|
|
||||||
infixl 5 >:
|
|
||||||
|
|
||||||
-- |Id to reference a specific widget, must be unique.
|
|
||||||
newtype UIId = UIId Int deriving (Eq, Ord, Bounded, Ix, Hashable, Show, Read)
|
|
||||||
|
|
||||||
-- |Mouse buttons processed by the program.
|
|
||||||
data MouseButton = LeftButton | RightButton | MiddleButton | MouseX1 | MouseX2
|
|
||||||
deriving (Eq, Ord, Enum, Ix, Bounded, Generic, Show, Read)
|
|
||||||
|
|
||||||
instance Hashable MouseButton where -- TODO: generic deriving creates functions that run forever
|
|
||||||
hash = fromEnum
|
|
||||||
hashWithSalt salt x = (salt * 16777619) `xor` hash x
|
|
||||||
|
|
||||||
---------------------------
|
|
||||||
--- widget state
|
|
||||||
---------------------------
|
|
||||||
-- |A key to reference a specific type of 'WidgetState'.
|
|
||||||
data WidgetStateKey = MouseStateKey | ViewportStateKey
|
|
||||||
deriving (Eq, Ord, Enum, Ix, Bounded, Generic, Show, Read)
|
|
||||||
|
|
||||||
instance Hashable WidgetStateKey where -- TODO: generic deriving creates functions that run forever
|
|
||||||
hash = fromEnum
|
|
||||||
hashWithSalt salt x = (salt * 16777619) `xor` hash x
|
|
||||||
|
|
||||||
-- |Global tracking of mouse actions to determine event handling.
|
|
||||||
data UIButtonState = UIButtonState
|
|
||||||
{ _mousePressed :: Int -- ^amount of currently pressed buttons
|
|
||||||
, _mouseCurrentWidget :: Maybe (UIId, Pixel)
|
|
||||||
-- ^the current mouse-active widget and its global coordinates.
|
|
||||||
-- If @_mousePressed == 0@: widget the mouse is hovering over,
|
|
||||||
-- otherwise: widget the first button has been pressed on.
|
|
||||||
, _mouseInside :: Bool -- ^@True@ if the mouse is currently within the mouse-active widget
|
|
||||||
} deriving (Show, Eq)
|
|
||||||
|
|
||||||
-- |The button dependant state of a 'MouseState'.
|
|
||||||
data MouseButtonState = MouseButtonState
|
|
||||||
{ _mouseIsDragging :: Bool -- ^firing if pressed but not confirmed
|
|
||||||
, _mouseIsDeferred :: Bool
|
|
||||||
-- ^deferred if e. g. dragging but outside component
|
|
||||||
, _dragStart :: (ScreenUnit, ScreenUnit)
|
|
||||||
} deriving (Eq, Show)
|
|
||||||
|
|
||||||
-- |An applied state a widget may take, depending on its usage and event handlers. Corresponding Key: 'WidgetStateKey'.
|
|
||||||
data WidgetState =
|
|
||||||
-- |The state of a mouse reactive ui widget. Referenced by 'MouseStateKey'.
|
|
||||||
MouseState
|
|
||||||
{ _mouseStates :: Array MouseButton MouseButtonState
|
|
||||||
, _mouseIsReady :: Bool -- ^ready if mouse is above component
|
|
||||||
, _mousePixel :: Pixel -- ^current local position of the mouse, only updated if widget is the mouse-active component
|
|
||||||
}
|
|
||||||
|
|
|
||||||
-- |A position to store screen units. Referenced by 'ViewportStateKey'.
|
|
||||||
ViewportState
|
|
||||||
{ _isDragging :: Bool
|
|
||||||
, _dragStartX :: Double
|
|
||||||
, _dragStartY :: Double
|
|
||||||
, _dragAngleX :: Double
|
|
||||||
, _dragAngleY :: Double
|
|
||||||
}
|
|
||||||
deriving (Eq, Show)
|
|
||||||
|
|
||||||
---------------------------
|
|
||||||
--- events
|
|
||||||
---------------------------
|
|
||||||
|
|
||||||
-- |A key to reference a specific 'WidgetEventHandler'.
|
|
||||||
data WidgetEventKey = MouseEvent | MouseMotionEvent
|
|
||||||
deriving (Eq, Ord, Enum, Ix, Bounded, Generic, Show, Read)
|
|
||||||
|
|
||||||
instance Hashable WidgetEventKey where -- TODO: generic deriving creates functions that run forever
|
|
||||||
hash = fromEnum
|
|
||||||
hashWithSalt salt x = (salt * 16777619) `xor` hash x
|
|
||||||
|
|
||||||
--- event handlers
|
|
||||||
|
|
||||||
-- |A handler to react on certain events. Corresponding key: 'WidgetEventKey'.
|
|
||||||
data WidgetEventHandler m =
|
|
||||||
-- |Handler to control the functionality of a 'GUIWidget' on mouse button events.
|
|
||||||
--
|
|
||||||
-- All screen coordinates are widget-local coordinates.
|
|
||||||
MouseHandler
|
|
||||||
{
|
|
||||||
-- |The function 'onMousePressed' is called when a button is pressed
|
|
||||||
-- while the button is mouse-active.
|
|
||||||
--
|
|
||||||
-- The boolean value indicates if the button press happened within the widget
|
|
||||||
-- ('_isInside').
|
|
||||||
--
|
|
||||||
-- The function returns the altered widget resulting from the button press.
|
|
||||||
_onMousePress :: MouseButton -> Pixel -> Bool -> GUIWidget m -> m (GUIWidget m)
|
|
||||||
,
|
|
||||||
-- |The function 'onMouseReleased' is called when a button is released
|
|
||||||
-- while the widget is mouse-active.
|
|
||||||
--
|
|
||||||
-- Thus, the mouse is either within the widget or outside while still dragging.
|
|
||||||
--
|
|
||||||
--
|
|
||||||
-- The boolean value indicates if the button release happened within the widget
|
|
||||||
-- ('_isInside').
|
|
||||||
--
|
|
||||||
-- The function returns the altered widget resulting from the button press.
|
|
||||||
_onMouseRelease :: MouseButton -> Pixel -> Bool -> GUIWidget m -> m (GUIWidget m)
|
|
||||||
}
|
|
||||||
|
|
|
||||||
-- |Handler to control the functionality of a 'GUIWidget' on mouse movement.
|
|
||||||
--
|
|
||||||
-- All screen coordinates are widget-local coordinates.
|
|
||||||
MouseMotionHandler
|
|
||||||
{
|
|
||||||
-- |The function 'onMouseMove' is invoked when the mouse is moved inside the
|
|
||||||
-- widget’s extent ('isInside') while no button is pressed or when the mouse is inside the
|
|
||||||
-- widget’s extent while another button loses its mouse-active state. Triggered after
|
|
||||||
-- '_onMouseEnter' or '_onMouseLeave' (only if still mouse-active on leaving) if applicable.
|
|
||||||
--
|
|
||||||
-- The function returns the altered widget resulting from the button press.
|
|
||||||
_onMouseMove :: Pixel -> GUIWidget m -> m (GUIWidget m)
|
|
||||||
,
|
|
||||||
-- |The function 'onMouseMove' is invoked when the mouse enters the
|
|
||||||
-- widget’s extent ('isInside') or when the mouse is inside the
|
|
||||||
-- widget’s extent while another button loses its mouse-active state.
|
|
||||||
--
|
|
||||||
-- The function returns the altered widget resulting from the button press.
|
|
||||||
_onMouseEnter :: Pixel -> GUIWidget m -> m (GUIWidget m)
|
|
||||||
,
|
|
||||||
-- |The function 'onMouseLeave' is invoked when the mouse leaves the
|
|
||||||
-- widget’s extent ('isInside') while no other widget is mouse-active.
|
|
||||||
--
|
|
||||||
-- The function returns the altered widget resulting from the button press.
|
|
||||||
_onMouseLeave :: Pixel -> GUIWidget m -> m (GUIWidget m)
|
|
||||||
}
|
|
||||||
deriving ()
|
|
||||||
|
|
||||||
-- |A key to reference a specific 'EventHandler'.
|
|
||||||
data EventKey = WindowEvent | WidgetPositionEvent
|
|
||||||
deriving (Eq, Ord, Enum, Ix, Bounded, Generic, Show, Read)
|
|
||||||
|
|
||||||
instance Hashable EventKey where -- TODO: generic deriving creates functions that run forever
|
|
||||||
hash = fromEnum
|
|
||||||
hashWithSalt salt x = (salt * 16777619) `xor` hash x
|
|
||||||
|
|
||||||
-- |A handler to react on certain events. Corresponding key: 'EventKey'.
|
|
||||||
data EventHandler (m :: * -> *) =
|
|
||||||
WindowHandler
|
|
||||||
{
|
|
||||||
-- |The function '_onWindowResize' is invoked when the global application window changes size.
|
|
||||||
--
|
|
||||||
-- The input is the window’s new width and height in that order.
|
|
||||||
--
|
|
||||||
-- The returned handler is resulting handler that may change by the event. Its type must
|
|
||||||
-- remain @WindowHandler@.
|
|
||||||
_onWindowResize :: ScreenUnit -> ScreenUnit -> m (EventHandler m)
|
|
||||||
,
|
|
||||||
-- |Unique id to identify an event instance.
|
|
||||||
_eventId :: UIId
|
|
||||||
}
|
|
||||||
|
|
||||||
instance Eq (EventHandler m) where
|
|
||||||
WindowHandler _ id' == WindowHandler _ id'' = id' == id''
|
|
||||||
_ == _ = False
|
|
||||||
|
|
||||||
|
|
||||||
---------------------------
|
|
||||||
--- widgets
|
|
||||||
---------------------------
|
|
||||||
|
|
||||||
-- |A @GUIWidget@ is a visual object the HUD is composed of.
|
|
||||||
data GUIWidget m = Widget
|
|
||||||
{_baseProperties :: GUIBaseProperties m
|
|
||||||
,_graphics :: GUIGraphics m
|
|
||||||
,_widgetStates :: Map.HashMap WidgetStateKey WidgetState -- TODO? unsave mapping
|
|
||||||
,_eventHandlers :: Map.HashMap WidgetEventKey (WidgetEventHandler m) -- no guarantee that data match key
|
|
||||||
}
|
|
||||||
|
|
||||||
-- |Base properties are fundamental settings of any 'GUIWidget'.
|
|
||||||
-- They mostly control positioning and widget hierarchy.
|
|
||||||
data GUIBaseProperties m = BaseProperties
|
|
||||||
{
|
|
||||||
-- |The @_getBoundary@ function gives the outer extents of the @GUIWidget@.
|
|
||||||
-- The bounding box wholly contains all children components.
|
|
||||||
_boundary :: m (ScreenUnit, ScreenUnit, ScreenUnit, ScreenUnit) -- ^@(x, y, width, height)@ in pixels (screen coordinates)
|
|
||||||
,
|
|
||||||
-- |The @_getChildren@ function returns all children associated with this widget.
|
|
||||||
--
|
|
||||||
-- All children must be wholly inside the parent’s bounding box specified by '_boundary'.
|
|
||||||
_children :: m [UIId]
|
|
||||||
,
|
|
||||||
-- |The function @_isInside@ tests whether a point is inside the widget itself.
|
|
||||||
-- A screen position may be inside the bounding box of a widget but not considered part of the
|
|
||||||
-- component.
|
|
||||||
--
|
|
||||||
-- The default implementations tests if the point is within the rectangle specified by the
|
|
||||||
-- 'getBoundary' function.
|
|
||||||
--
|
|
||||||
-- The passed coordinates are widget-local coordinates.
|
|
||||||
_isInside :: GUIWidget m -> Pixel -> m Bool
|
|
||||||
,
|
|
||||||
-- |The @_getPriority@ function returns the priority score of a @GUIWidget@.
|
|
||||||
-- A widget with a high score is more in the front than a low scored widget.
|
|
||||||
_priority :: m Int
|
|
||||||
,
|
|
||||||
-- |The @_getShorthand@ function returns a descriptive 'String' mainly for debuggin prupose.
|
|
||||||
-- The shorthand should be unique for each instance.
|
|
||||||
_shorthand :: String
|
|
||||||
}
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
-- |@GUIGraphics@ functions define the look of a 'GUIWidget'.
|
|
||||||
|
|
||||||
data GUIGraphics (m :: * -> *) = Graphics
|
|
||||||
|
|
||||||
$(makeLenses ''UIButtonState)
|
|
||||||
$(makeLenses ''WidgetState)
|
|
||||||
$(makeLenses ''MouseButtonState)
|
|
||||||
$(makeLenses ''WidgetEventHandler)
|
|
||||||
$(makeLenses ''GUIWidget)
|
|
||||||
$(makeLenses ''GUIBaseProperties)
|
|
||||||
$(makeLenses ''GUIGraphics)
|
|
||||||
|
|
||||||
initialViewportState :: WidgetState
|
|
||||||
initialViewportState = ViewportState False 0 0 0 0
|
|
||||||
|
|
||||||
-- |Creates a default @MouseButtonState@.
|
|
||||||
initialButtonState :: MouseButtonState
|
|
||||||
initialButtonState = MouseButtonState False False (0, 0)
|
|
||||||
{-# INLINE initialButtonState #-}
|
|
||||||
|
|
||||||
-- |Creates a 'MouseState' its @_mouseStates@ are valid 'MouseButtonState's for any 'MouseButton'.
|
|
||||||
initialMouseState :: WidgetState
|
|
||||||
initialMouseState = MouseState (array (minBound, maxBound) [(i, initialButtonState) | i <- range (minBound, maxBound)])
|
|
||||||
False (0, 0)
|
|
||||||
{-# INLINE initialMouseState #-}
|
|
||||||
|
|
||||||
-- |The function 'combinedMouseHandler' creates a 'MouseHandler' by composing the action functions
|
|
||||||
-- of two handlers. Thereby, the resulting widget of the first handler is the input widget of the
|
|
||||||
-- second handler and all other parameters are the same for both function calls.
|
|
||||||
--
|
|
||||||
-- If not both input handlers are of type @MouseHandler@ an error is raised.
|
|
||||||
combinedMouseHandler :: (Monad m) => WidgetEventHandler m -> WidgetEventHandler m -> WidgetEventHandler m
|
|
||||||
combinedMouseHandler (MouseHandler p1 r1) (MouseHandler p2 r2) =
|
|
||||||
MouseHandler (comb p1 p2) (comb r1 r2)
|
|
||||||
where comb h1 h2 btn px inside = join . liftM (h2 btn px inside) . h1 btn px inside
|
|
||||||
combinedMouseHandler _ _ = error $ "combineMouseHandler can only combine two WidgetEventHandler" ++
|
|
||||||
" with constructor MouseHandler"
|
|
||||||
|
|
||||||
-- |The function 'combinedMouseMotionHandler' creates a 'MouseHandler' by composing the action
|
|
||||||
-- functions of two handlers. Thereby, the resulting widget of the second handler is the input
|
|
||||||
-- widget of the second handler and all other parameters are the same for both function calls.
|
|
||||||
--
|
|
||||||
-- If not both input handlers are of type @MouseMotionHandler@ an error is raised.
|
|
||||||
combinedMouseMotionHandler :: (Monad m) => WidgetEventHandler m -> WidgetEventHandler m -> WidgetEventHandler m
|
|
||||||
combinedMouseMotionHandler (MouseMotionHandler m1 e1 l1) (MouseMotionHandler m2 e2 l2) =
|
|
||||||
MouseMotionHandler (comb m1 m2) (comb e1 e2) (comb l1 l2)
|
|
||||||
where comb h1 h2 px = join . liftM (h2 px) . h1 px
|
|
||||||
combinedMouseMotionHandler _ _ = error $ "combineMouseMotionHandler can only combine two WidgetEventHandler" ++
|
|
||||||
" with constructor MouseMotionHandler"
|
|
||||||
|
|
||||||
-- |The function 'emptyMouseHandler' creates a 'MouseHandler' that does nothing.
|
|
||||||
-- It may be useful as construction kit.
|
|
||||||
--
|
|
||||||
-- >>> emptyMouseHandler & _onMousePress .~ myPressFunction
|
|
||||||
-- >>> emptyMouseHandler { _onMousePress = myPressFunction }
|
|
||||||
emptyMouseHandler :: (Monad m) => WidgetEventHandler m
|
|
||||||
emptyMouseHandler = MouseHandler (\_ _ _ -> return) (\_ _ _ -> return)
|
|
||||||
|
|
||||||
-- |The function 'emptyMouseMotionHandler' creates a 'MouseMotionHandler' that does nothing.
|
|
||||||
-- It may be useful as construction kit.
|
|
||||||
--
|
|
||||||
-- >>> emptyMouseMotionHandler & _onMouseMove .~ myMoveFunction
|
|
||||||
-- >>> emptyMouseHandler { _onMouseMove = myMoveFunction }
|
|
||||||
emptyMouseMotionHandler :: (Monad m) => WidgetEventHandler m
|
|
||||||
emptyMouseMotionHandler = MouseMotionHandler (const return) (const return) (const return)
|
|
||||||
|
|
||||||
-- TODO? breaks if button array not of sufficient size -- will be avoided by excluding constructor export
|
|
||||||
-- |Creates a 'MouseHandler' that sets a widget’s 'MouseButtonState' properties if present,
|
|
||||||
-- only fully functional in conjunction with 'setMouseMotionStateActions'.
|
|
||||||
setMouseStateActions :: (Monad m) => WidgetEventHandler m
|
|
||||||
setMouseStateActions = MouseHandler press' release'
|
|
||||||
where
|
|
||||||
-- |Change 'MouseButtonState'’s '_mouseIsDragging' to @True@.
|
|
||||||
press' b _ _ w =
|
|
||||||
return $ w & widgetStates.(ix MouseStateKey).mouseStates.(ix b).mouseIsDragging .~ True
|
|
||||||
|
|
||||||
-- |Change 'MouseButtonState'’s '_mouseIsDragging' and '_mouseIsDeferred' to @False@.
|
|
||||||
release' b _ _ w =
|
|
||||||
return $ w & widgetStates.(ix MouseStateKey).mouseStates.(ix b) %~
|
|
||||||
(mouseIsDragging .~ False) . (mouseIsDeferred .~ False)
|
|
||||||
|
|
||||||
-- |Creates a 'MouseHandler' that sets a widget’s 'MouseState' properties if present,
|
|
||||||
-- only fully functional in conjunction with 'setMouseStateActions'.
|
|
||||||
setMouseMotionStateActions :: (Monad m) => WidgetEventHandler m
|
|
||||||
setMouseMotionStateActions = MouseMotionHandler move' enter' leave'
|
|
||||||
where
|
|
||||||
-- |Updates mouse position.
|
|
||||||
move' p w = return $ w & widgetStates.(ix MouseStateKey).mousePixel .~ p
|
|
||||||
|
|
||||||
-- |Sets '_mouseIsReady' to @True@, changes '_mouseIsDeferred' to '_mouseIsDragging'’s current
|
|
||||||
-- value and sets '_mouseIsDragging' to @False@.
|
|
||||||
enter' p w = return $ w & widgetStates.(ix MouseStateKey)
|
|
||||||
%~ (mouseIsReady .~ True) . (mousePixel .~ p)
|
|
||||||
. (mouseStates.mapped %~ (mouseIsDeferred .~ False)
|
|
||||||
-- following line executed BEFORE above line
|
|
||||||
. (\sState -> sState & mouseIsDragging .~ not (sState ^. mouseIsDeferred)))
|
|
||||||
|
|
||||||
|
|
||||||
-- |Sets '_mouseIsReady' to @False@, changes '_mouseIsDragging' to '_mouseIsDeferred'’s current
|
|
||||||
-- value and sets '_mouseIsDeferred' to @False@.
|
|
||||||
leave' p w = return $ w & widgetStates.(ix MouseStateKey)
|
|
||||||
%~ (mouseIsReady .~ False) . (mousePixel .~ p)
|
|
||||||
. (mouseStates.mapped %~ (mouseIsDragging .~ False)
|
|
||||||
-- following line executed BEFORE above line
|
|
||||||
. (\sState -> sState & mouseIsDeferred .~ not (sState ^. mouseIsDragging)))
|
|
||||||
|
|
||||||
-- TODO: make only fire if press started within widget
|
|
||||||
-- |Creates a 'MouseHandler' that reacts on mouse clicks.
|
|
||||||
--
|
|
||||||
-- Does /not/ update the widget’s 'MouseState'!
|
|
||||||
buttonMouseActions :: (Monad m) => (MouseButton -> GUIWidget m -> Pixel -> m (GUIWidget m)) -- ^action on button press
|
|
||||||
-> WidgetEventHandler m
|
|
||||||
buttonMouseActions a = MouseHandler press' release'
|
|
||||||
where
|
|
||||||
press' _ _ _ = return
|
|
||||||
|
|
||||||
release' b p inside w = if inside then a b w p else return w
|
|
||||||
|
|
||||||
-- TODO: make only fire if press started within widget
|
|
||||||
-- |Creates a 'MouseHandler' that reacts on mouse clicks.
|
|
||||||
--
|
|
||||||
-- Does /not/ update the widget’s 'MouseState'!
|
|
||||||
buttonSingleMouseActions :: (Monad m) => (GUIWidget m -> Pixel -> m (GUIWidget m)) -- ^action on button press
|
|
||||||
-> MouseButton -> WidgetEventHandler m
|
|
||||||
buttonSingleMouseActions a btn = MouseHandler press' release'
|
|
||||||
where
|
|
||||||
press' _ _ _ = return
|
|
||||||
|
|
||||||
release' b p inside w = if inside && b == btn then a w p else return w
|
|
||||||
|
|
||||||
emptyGraphics :: (Monad m) => GUIGraphics m
|
|
||||||
emptyGraphics = Graphics
|
|
||||||
|
|
||||||
-- |Extracts width and height from a '_boundary' property of a 'GUIBaseProperties'.
|
|
||||||
extractExtent :: (ScreenUnit, ScreenUnit, ScreenUnit, ScreenUnit) -> (ScreenUnit, ScreenUnit)
|
|
||||||
extractExtent (_,_,w,h) = (w,h)
|
|
||||||
{-# INLINABLE extractExtent #-}
|
|
||||||
|
|
||||||
-- |Calculates whether a point’s value exceed the given width and height.
|
|
||||||
isInsideExtent :: (ScreenUnit, ScreenUnit) -> Pixel -> Bool
|
|
||||||
isInsideExtent (w,h) (x',y') = (x' <= w) && (x' >= 0) && (y' <= h) && (y' >= 0)
|
|
||||||
|
|
||||||
-- |Calculates whether a point is within a given rectangle.
|
|
||||||
isInsideRect :: (ScreenUnit, ScreenUnit, ScreenUnit, ScreenUnit) -> Pixel -> Bool
|
|
||||||
isInsideRect (x,y,w,h) px = isInsideExtent (w, h) $ px -: (x, y)
|
|
||||||
|
|
||||||
|
|
||||||
-- |@GUIBaseProperties@ with a rectangular base that fills the bounds.
|
|
||||||
rectangularBase :: (Monad m) => (ScreenUnit, ScreenUnit, ScreenUnit, ScreenUnit) -> [UIId] -> Int -> String -> GUIBaseProperties m
|
|
||||||
rectangularBase bnd chld prio short =
|
|
||||||
BaseProperties (return bnd) (return chld)
|
|
||||||
(\w p -> liftM (flip isInsideExtent p . extractExtent) (w ^. baseProperties.boundary)) -- isInside
|
|
||||||
(return prio) short
|
|
||||||
|
|
||||||
debugShowWidget' :: (Monad m) => GUIWidget m -> m String
|
|
||||||
debugShowWidget' (Widget base _ _ handler) = do
|
|
||||||
bnd <- base ^. boundary
|
|
||||||
chld <- base ^. children
|
|
||||||
prio <- base ^. priority
|
|
||||||
let short = base ^. shorthand
|
|
||||||
return $ concat [short,"| boundary:", show bnd, ", children:", show chld,
|
|
||||||
",priority:",show prio, maybe "" (const ", with mouse handler") (Map.lookup MouseEvent handler)]
|
|
||||||
@ -1,122 +0,0 @@
|
|||||||
module UI.UIOperations where
|
|
||||||
|
|
||||||
import Control.Lens ((^.), (%~))
|
|
||||||
import Control.Monad (liftM)
|
|
||||||
--import Control.Monad.IO.Class (liftIO)
|
|
||||||
import Control.Monad.RWS.Strict (get, modify)
|
|
||||||
import qualified Data.HashMap.Strict as Map
|
|
||||||
import Data.Hashable
|
|
||||||
--import qualified Data.List as L
|
|
||||||
import Data.Maybe
|
|
||||||
|
|
||||||
import Types
|
|
||||||
import UI.UIBase
|
|
||||||
|
|
||||||
-- TODO: test GUI function to scan for overlapping widgets
|
|
||||||
|
|
||||||
toGUIAny :: Map.HashMap UIId (GUIWidget m) -> UIId -> GUIWidget m -- TODO: what to do if widget not inside map -> inconsistent state
|
|
||||||
toGUIAny m uid = fromMaybe (error "map does not contain requested key") (Map.lookup uid m)
|
|
||||||
{-# INLINABLE toGUIAny #-}
|
|
||||||
|
|
||||||
toGUIAnys :: Map.HashMap UIId (GUIWidget m) -> [UIId] -> [GUIWidget m]
|
|
||||||
toGUIAnys m = mapMaybe (`Map.lookup` m)
|
|
||||||
{-# INLINABLE toGUIAnys #-}
|
|
||||||
-- TODO: check for missing components?
|
|
||||||
|
|
||||||
-- | Tests whether a point is inside a widget by testing its bounding box first.
|
|
||||||
isInsideFast :: Monad m => GUIWidget m
|
|
||||||
-> Pixel -- ^ local coordinates
|
|
||||||
-> m Bool
|
|
||||||
isInsideFast wg px = do
|
|
||||||
(_, _, w, h) <- wg ^. baseProperties.boundary
|
|
||||||
liftM (isInsideExtent (w, h) px &&) $ (wg ^. baseProperties.isInside) wg px
|
|
||||||
|
|
||||||
-- |Adds an event to the given map. The new event is concatenated to present events. Does not test
|
|
||||||
-- if the map already contains the given element.
|
|
||||||
addEvent :: (Eq k, Hashable k) => k -> v -> Map.HashMap k [v] -> Map.HashMap k [v]
|
|
||||||
addEvent k v eventMap = Map.insertWith (++) k [v] eventMap
|
|
||||||
|
|
||||||
-- |Adds an event to the global event map such that the event handler will be notified on occurrance.
|
|
||||||
registerEvent :: EventKey -> EventHandler Pioneers -> Pioneers ()
|
|
||||||
registerEvent k v = modify $ ui.uiObserverEvents %~ addEvent k v
|
|
||||||
|
|
||||||
-- |The 'deleteQualitative' function behaves like 'Data.List.deleteBy' but reports @True@ if the
|
|
||||||
-- list contained the relevant object.
|
|
||||||
deleteQualitative :: (a -> a -> Bool) -> a -> [a] -> ([a], Bool)
|
|
||||||
deleteQualitative _ _ [] = ([], False)
|
|
||||||
deleteQualitative eq x (y:ys) = if x `eq` y then (ys, True) else
|
|
||||||
let (zs, b) = deleteQualitative eq x ys
|
|
||||||
in (y:zs, b)
|
|
||||||
|
|
||||||
-- |Removes the first occurrence of an event from the given map if it is within the event list of
|
|
||||||
-- the key.
|
|
||||||
removeEvent :: (Eq k, Hashable k, Eq v) => k -> v -> Map.HashMap k [v] -> Map.HashMap k [v]
|
|
||||||
removeEvent k v eventMap =
|
|
||||||
case Map.lookup k eventMap of
|
|
||||||
Just list -> case deleteQualitative (==) v list of
|
|
||||||
(_, False) -> eventMap
|
|
||||||
(ys, _) -> case ys of
|
|
||||||
[] -> Map.delete k eventMap
|
|
||||||
_ -> Map.insert k ys eventMap
|
|
||||||
Nothing -> Map.insert k [v] eventMap
|
|
||||||
|
|
||||||
|
|
||||||
-- |Adds an event to the global event map such that the event handler will be notified on occurrance.
|
|
||||||
deregisterEvent :: EventKey -> EventHandler Pioneers -> Pioneers ()
|
|
||||||
deregisterEvent k v = modify $ ui.uiObserverEvents %~ removeEvent k v
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
-- |The function 'getInsideId' returns child widgets that overlap with a
|
|
||||||
-- specific screen position and the pixel’s local coordinates.
|
|
||||||
--
|
|
||||||
-- A screen position may be inside the bounding box of a widget but not
|
|
||||||
-- considered part of the component. The function returns all hit widgets that
|
|
||||||
-- have no hit children, which may be the input widget itself,
|
|
||||||
-- or @[]@ if the point does not hit the widget.
|
|
||||||
getInsideId :: Pixel -- ^parent’s local coordinates
|
|
||||||
-> UIId -- ^the parent widget
|
|
||||||
-> Pioneers [(UIId, Pixel)]
|
|
||||||
getInsideId px uid = do
|
|
||||||
state <- get
|
|
||||||
let wg = toGUIAny (state ^. ui.uiMap) uid
|
|
||||||
(bX, bY, _, _) <- wg ^. baseProperties.boundary
|
|
||||||
let px' = px -: (bX, bY)
|
|
||||||
inside <- isInsideFast wg px'
|
|
||||||
if inside -- test inside parent’s bounding box
|
|
||||||
then do
|
|
||||||
childrenIds <- wg ^. baseProperties.children
|
|
||||||
hitChildren <- liftM concat $ mapM (getInsideId px') childrenIds
|
|
||||||
case hitChildren of
|
|
||||||
[] -> return [(uid, px')]
|
|
||||||
_ -> return hitChildren
|
|
||||||
else return []
|
|
||||||
--TODO: Priority queue?
|
|
||||||
--TODO: only needs to return single target if non-overlapping-child convention applies
|
|
||||||
|
|
||||||
-- TODO not needed if non-overlapping-child convention applies
|
|
||||||
getLeadingWidget :: [(UIId, Pixel)] -- ^widgets and their screen positions
|
|
||||||
-> Pioneers (Maybe (UIId, Pixel)) -- ^the leading widget
|
|
||||||
getLeadingWidget [] = return Nothing
|
|
||||||
getLeadingWidget (x:_) = return $ Just x
|
|
||||||
|
|
||||||
-- |The function 'isHittingChild' tests if a pixel is hitting a child of the given widget.
|
|
||||||
--
|
|
||||||
-- @'Left' 'False'@ is returned if the point is outside the widget,
|
|
||||||
-- @'Left' 'True'@ is returned if the point is inside the widget and hits no child and
|
|
||||||
-- 'Right' in combination with both the innermost hit child and the position’s local coordinates
|
|
||||||
-- is returned otherwise.
|
|
||||||
isHittingChild :: Pixel -- ^parent’s local coordinates
|
|
||||||
-> GUIWidget Pioneers -- ^parent widget
|
|
||||||
-> Pioneers (Either Bool (UIId, Pixel))
|
|
||||||
isHittingChild px wg = do
|
|
||||||
isIn <- isInsideFast wg px
|
|
||||||
if isIn
|
|
||||||
then do
|
|
||||||
chld <- wg ^. baseProperties.children
|
|
||||||
hitChld <- liftM concat $ mapM (getInsideId px) chld
|
|
||||||
hitLead <- getLeadingWidget hitChld
|
|
||||||
case hitLead of
|
|
||||||
Nothing -> return $ Left True
|
|
||||||
Just h -> return $ Right h
|
|
||||||
else return $ Left False
|
|
||||||
@ -1,129 +0,0 @@
|
|||||||
{-# LANGUAGE InstanceSigs, MultiParamTypeClasses, FlexibleInstances #-}
|
|
||||||
|
|
||||||
module UI.UIWidgets (module UI.UIWidgets, module UI.UIBase) where
|
|
||||||
|
|
||||||
import Control.Concurrent.STM (atomically)
|
|
||||||
import Control.Concurrent.STM.TVar (readTVarIO, writeTVar, TVar())
|
|
||||||
import Control.Lens ((^.), (.~), (%~), (&), (^?), at, Getting())
|
|
||||||
import Control.Monad
|
|
||||||
import Control.Monad.IO.Class (liftIO)
|
|
||||||
import Control.Monad.RWS.Strict (get, modify)
|
|
||||||
import Data.List
|
|
||||||
import Data.Maybe
|
|
||||||
import qualified Data.HashMap.Strict as Map
|
|
||||||
|
|
||||||
import Types
|
|
||||||
import Render.Misc (curb)
|
|
||||||
import UI.UIBase
|
|
||||||
import UI.UIOperations
|
|
||||||
|
|
||||||
|
|
||||||
createContainer :: (Monad m) => (ScreenUnit, ScreenUnit, ScreenUnit, ScreenUnit) -> [UIId] -> Int -> GUIWidget m
|
|
||||||
createContainer bnd chld prio = Widget (rectangularBase bnd chld prio "CNT")
|
|
||||||
emptyGraphics
|
|
||||||
Map.empty -- widget states
|
|
||||||
Map.empty -- event handlers
|
|
||||||
|
|
||||||
|
|
||||||
createPanel :: (ScreenUnit, ScreenUnit, ScreenUnit, ScreenUnit) -> [UIId] -> Int -> GUIWidget Pioneers
|
|
||||||
createPanel bnd chld prio = Widget (rectangularBase bnd chld prio "PNL" & boundary .~ autosize')
|
|
||||||
emptyGraphics
|
|
||||||
Map.empty -- widget states
|
|
||||||
Map.empty -- event handlers
|
|
||||||
where
|
|
||||||
autosize' :: Pioneers (ScreenUnit, ScreenUnit, ScreenUnit, ScreenUnit)
|
|
||||||
autosize' = do
|
|
||||||
state <- get
|
|
||||||
let hmap = state ^. ui . uiMap
|
|
||||||
determineSize' :: (ScreenUnit, ScreenUnit, ScreenUnit ,ScreenUnit) -> (ScreenUnit, ScreenUnit, ScreenUnit ,ScreenUnit) -> (ScreenUnit, ScreenUnit, ScreenUnit ,ScreenUnit)
|
|
||||||
determineSize' (x, y, w, h) (x', y', w', h') = (x, y, max w (x' + w'), max h (y' + h'))
|
|
||||||
case chld of
|
|
||||||
[] -> return bnd
|
|
||||||
cs -> do let widgets = mapMaybe (`Map.lookup` hmap) cs
|
|
||||||
foldl' (liftM2 determineSize') (return bnd) $ map (\w -> w ^. baseProperties.boundary) widgets
|
|
||||||
|
|
||||||
createButton :: (Monad m) => (ScreenUnit, ScreenUnit, ScreenUnit, ScreenUnit) -> Int -> (MouseButton -> GUIWidget m -> Pixel -> m (GUIWidget m)) -> GUIWidget m
|
|
||||||
createButton bnd prio action = Widget (rectangularBase bnd [] prio "BTN")
|
|
||||||
emptyGraphics
|
|
||||||
(Map.fromList [(MouseStateKey, initialMouseState)]) -- widget states
|
|
||||||
(Map.fromList [(MouseEvent, buttonMouseActions action)]) -- event handlers
|
|
||||||
|
|
||||||
createViewport :: Getting (TVar CameraState) State (TVar CameraState)
|
|
||||||
--Setting (->) State State (TVar CameraState) (TVar CameraState) -- ^ lens to connected @TVar CameraState@
|
|
||||||
-> MouseButton -- ^ button to drag with
|
|
||||||
-> (ScreenUnit, ScreenUnit, ScreenUnit, ScreenUnit) -> [UIId] -> Int -> GUIWidget Pioneers
|
|
||||||
createViewport thelens btn bnd chld prio = Widget (rectangularBase bnd chld prio "VWP")
|
|
||||||
emptyGraphics
|
|
||||||
(Map.fromList [(ViewportStateKey, initialViewportState)]) -- widget states
|
|
||||||
(Map.fromList [(MouseEvent, viewportMouseAction)
|
|
||||||
,(MouseMotionEvent, viewportMouseMotionAction)]) -- event handlers
|
|
||||||
where
|
|
||||||
updateCamera :: Double -> Double -> Double -> Double -> Double -> Double -> CameraState -> CameraState
|
|
||||||
updateCamera xStart' yStart' x y sodxa sodya cam =
|
|
||||||
let myrot = (x - xStart') / 2
|
|
||||||
mxrot = (y - yStart') / 2
|
|
||||||
newXAngle' = sodxa + mxrot/100
|
|
||||||
newXAngle = curb (pi/12) (0.45*pi) newXAngle'
|
|
||||||
newYAngle' = sodya + myrot/100
|
|
||||||
newYAngle
|
|
||||||
| newYAngle' > pi = newYAngle' - 2 * pi
|
|
||||||
| newYAngle' < (-pi) = newYAngle' + 2 * pi
|
|
||||||
| otherwise = newYAngle'
|
|
||||||
in cam & (xAngle .~ newXAngle) . (yAngle .~ newYAngle)
|
|
||||||
|
|
||||||
viewportMouseAction :: WidgetEventHandler Pioneers
|
|
||||||
viewportMouseAction =
|
|
||||||
let press btn' (x, y) _ w =
|
|
||||||
do if (btn == btn')
|
|
||||||
then do state <- get
|
|
||||||
let camT = state ^. thelens
|
|
||||||
cam <- liftIO $ readTVarIO camT
|
|
||||||
let sodxa = cam ^. xAngle
|
|
||||||
sodya = cam ^. yAngle
|
|
||||||
liftIO $ atomically $ writeTVar camT $
|
|
||||||
updateCamera (fromIntegral x) (fromIntegral y) (fromIntegral x) (fromIntegral y) sodxa sodya cam
|
|
||||||
return $ w & widgetStates . at ViewportStateKey .~
|
|
||||||
Just (ViewportState True (fromIntegral x) (fromIntegral y) sodxa sodya)
|
|
||||||
else return w
|
|
||||||
release btn' _ _ w = if (btn' == btn)
|
|
||||||
then
|
|
||||||
-- modify ViewportState to "not dragging" or recreate ViewportState state if not present
|
|
||||||
return $ w & widgetStates . at ViewportStateKey %~
|
|
||||||
maybe (Just $ initialViewportState) (\s -> Just (s & isDragging .~ False))
|
|
||||||
else return w
|
|
||||||
in MouseHandler press release
|
|
||||||
|
|
||||||
viewportMouseMotionAction :: WidgetEventHandler Pioneers
|
|
||||||
viewportMouseMotionAction =
|
|
||||||
let move (x, y) w =
|
|
||||||
do let mbPosState = w ^. widgetStates.(at ViewportStateKey)
|
|
||||||
case mbPosState of
|
|
||||||
Just posState ->
|
|
||||||
when (maybe False id (posState ^? isDragging)) $ do
|
|
||||||
state <- get
|
|
||||||
let camT = state ^. thelens
|
|
||||||
cam <- liftIO $ readTVarIO camT
|
|
||||||
let xS = fromJust $ posState ^? dragStartX -- fromJust is safe
|
|
||||||
yS = fromJust $ posState ^? dragStartY -- fromJust is safe
|
|
||||||
sodxa = fromJust $ posState ^? dragAngleX -- fromJust is safe
|
|
||||||
sodya = fromJust $ posState ^? dragAngleY -- fromJust is safe
|
|
||||||
liftIO $ atomically $ writeTVar camT $
|
|
||||||
updateCamera xS yS (fromIntegral x) (fromIntegral y) sodxa sodya cam
|
|
||||||
Nothing -> return ()
|
|
||||||
return w
|
|
||||||
in emptyMouseMotionHandler & onMouseMove .~ move
|
|
||||||
|
|
||||||
resizeToScreenHandler :: UIId -- ^id of a widget
|
|
||||||
-> EventHandler Pioneers
|
|
||||||
resizeToScreenHandler id' = WindowHandler resize (UIId 0) -- TODO: unique id
|
|
||||||
where resize :: ScreenUnit -> ScreenUnit -> Pioneers (EventHandler Pioneers)
|
|
||||||
resize w h = do
|
|
||||||
state <- get
|
|
||||||
let wg = toGUIAny (state ^. ui.uiMap) id'
|
|
||||||
(x, y, _, _) <- wg ^. baseProperties.boundary
|
|
||||||
let wg' = wg & baseProperties.boundary .~ return (x, y, w-x, h-y)
|
|
||||||
modify $ ui.uiMap %~ Map.insert id' wg'
|
|
||||||
return $ WindowHandler resize (UIId 0)
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
226
stylesheets/print.css
Normal file
226
stylesheets/print.css
Normal file
@ -0,0 +1,226 @@
|
|||||||
|
html, body, div, span, applet, object, iframe,
|
||||||
|
h1, h2, h3, h4, h5, h6, p, blockquote, pre,
|
||||||
|
a, abbr, acronym, address, big, cite, code,
|
||||||
|
del, dfn, em, img, ins, kbd, q, s, samp,
|
||||||
|
small, strike, strong, sub, sup, tt, var,
|
||||||
|
b, u, i, center,
|
||||||
|
dl, dt, dd, ol, ul, li,
|
||||||
|
fieldset, form, label, legend,
|
||||||
|
table, caption, tbody, tfoot, thead, tr, th, td,
|
||||||
|
article, aside, canvas, details, embed,
|
||||||
|
figure, figcaption, footer, header, hgroup,
|
||||||
|
menu, nav, output, ruby, section, summary,
|
||||||
|
time, mark, audio, video {
|
||||||
|
margin: 0;
|
||||||
|
padding: 0;
|
||||||
|
border: 0;
|
||||||
|
font-size: 100%;
|
||||||
|
font: inherit;
|
||||||
|
vertical-align: baseline;
|
||||||
|
}
|
||||||
|
/* HTML5 display-role reset for older browsers */
|
||||||
|
article, aside, details, figcaption, figure,
|
||||||
|
footer, header, hgroup, menu, nav, section {
|
||||||
|
display: block;
|
||||||
|
}
|
||||||
|
body {
|
||||||
|
line-height: 1;
|
||||||
|
}
|
||||||
|
ol, ul {
|
||||||
|
list-style: none;
|
||||||
|
}
|
||||||
|
blockquote, q {
|
||||||
|
quotes: none;
|
||||||
|
}
|
||||||
|
blockquote:before, blockquote:after,
|
||||||
|
q:before, q:after {
|
||||||
|
content: '';
|
||||||
|
content: none;
|
||||||
|
}
|
||||||
|
table {
|
||||||
|
border-collapse: collapse;
|
||||||
|
border-spacing: 0;
|
||||||
|
}
|
||||||
|
body {
|
||||||
|
font-size: 13px;
|
||||||
|
line-height: 1.5;
|
||||||
|
font-family: 'Helvetica Neue', Helvetica, Arial, serif;
|
||||||
|
color: #000;
|
||||||
|
}
|
||||||
|
|
||||||
|
a {
|
||||||
|
color: #d5000d;
|
||||||
|
font-weight: bold;
|
||||||
|
}
|
||||||
|
|
||||||
|
header {
|
||||||
|
padding-top: 35px;
|
||||||
|
padding-bottom: 10px;
|
||||||
|
}
|
||||||
|
|
||||||
|
header h1 {
|
||||||
|
font-weight: bold;
|
||||||
|
letter-spacing: -1px;
|
||||||
|
font-size: 48px;
|
||||||
|
color: #303030;
|
||||||
|
line-height: 1.2;
|
||||||
|
}
|
||||||
|
|
||||||
|
header h2 {
|
||||||
|
letter-spacing: -1px;
|
||||||
|
font-size: 24px;
|
||||||
|
color: #aaa;
|
||||||
|
font-weight: normal;
|
||||||
|
line-height: 1.3;
|
||||||
|
}
|
||||||
|
#downloads {
|
||||||
|
display: none;
|
||||||
|
}
|
||||||
|
#main_content {
|
||||||
|
padding-top: 20px;
|
||||||
|
}
|
||||||
|
|
||||||
|
code, pre {
|
||||||
|
font-family: Monaco, "Bitstream Vera Sans Mono", "Lucida Console", Terminal;
|
||||||
|
color: #222;
|
||||||
|
margin-bottom: 30px;
|
||||||
|
font-size: 12px;
|
||||||
|
}
|
||||||
|
|
||||||
|
code {
|
||||||
|
padding: 0 3px;
|
||||||
|
}
|
||||||
|
|
||||||
|
pre {
|
||||||
|
border: solid 1px #ddd;
|
||||||
|
padding: 20px;
|
||||||
|
overflow: auto;
|
||||||
|
}
|
||||||
|
pre code {
|
||||||
|
padding: 0;
|
||||||
|
}
|
||||||
|
|
||||||
|
ul, ol, dl {
|
||||||
|
margin-bottom: 20px;
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
/* COMMON STYLES */
|
||||||
|
|
||||||
|
table {
|
||||||
|
width: 100%;
|
||||||
|
border: 1px solid #ebebeb;
|
||||||
|
}
|
||||||
|
|
||||||
|
th {
|
||||||
|
font-weight: 500;
|
||||||
|
}
|
||||||
|
|
||||||
|
td {
|
||||||
|
border: 1px solid #ebebeb;
|
||||||
|
text-align: center;
|
||||||
|
font-weight: 300;
|
||||||
|
}
|
||||||
|
|
||||||
|
form {
|
||||||
|
background: #f2f2f2;
|
||||||
|
padding: 20px;
|
||||||
|
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
/* GENERAL ELEMENT TYPE STYLES */
|
||||||
|
|
||||||
|
h1 {
|
||||||
|
font-size: 2.8em;
|
||||||
|
}
|
||||||
|
|
||||||
|
h2 {
|
||||||
|
font-size: 22px;
|
||||||
|
font-weight: bold;
|
||||||
|
color: #303030;
|
||||||
|
margin-bottom: 8px;
|
||||||
|
}
|
||||||
|
|
||||||
|
h3 {
|
||||||
|
color: #d5000d;
|
||||||
|
font-size: 18px;
|
||||||
|
font-weight: bold;
|
||||||
|
margin-bottom: 8px;
|
||||||
|
}
|
||||||
|
|
||||||
|
h4 {
|
||||||
|
font-size: 16px;
|
||||||
|
color: #303030;
|
||||||
|
font-weight: bold;
|
||||||
|
}
|
||||||
|
|
||||||
|
h5 {
|
||||||
|
font-size: 1em;
|
||||||
|
color: #303030;
|
||||||
|
}
|
||||||
|
|
||||||
|
h6 {
|
||||||
|
font-size: .8em;
|
||||||
|
color: #303030;
|
||||||
|
}
|
||||||
|
|
||||||
|
p {
|
||||||
|
font-weight: 300;
|
||||||
|
margin-bottom: 20px;
|
||||||
|
}
|
||||||
|
|
||||||
|
a {
|
||||||
|
text-decoration: none;
|
||||||
|
}
|
||||||
|
|
||||||
|
p a {
|
||||||
|
font-weight: 400;
|
||||||
|
}
|
||||||
|
|
||||||
|
blockquote {
|
||||||
|
font-size: 1.6em;
|
||||||
|
border-left: 10px solid #e9e9e9;
|
||||||
|
margin-bottom: 20px;
|
||||||
|
padding: 0 0 0 30px;
|
||||||
|
}
|
||||||
|
|
||||||
|
ul li {
|
||||||
|
list-style: disc inside;
|
||||||
|
padding-left: 20px;
|
||||||
|
}
|
||||||
|
|
||||||
|
ol li {
|
||||||
|
list-style: decimal inside;
|
||||||
|
padding-left: 3px;
|
||||||
|
}
|
||||||
|
|
||||||
|
dl dd {
|
||||||
|
font-style: italic;
|
||||||
|
font-weight: 100;
|
||||||
|
}
|
||||||
|
|
||||||
|
footer {
|
||||||
|
margin-top: 40px;
|
||||||
|
padding-top: 20px;
|
||||||
|
padding-bottom: 30px;
|
||||||
|
font-size: 13px;
|
||||||
|
color: #aaa;
|
||||||
|
}
|
||||||
|
|
||||||
|
footer a {
|
||||||
|
color: #666;
|
||||||
|
}
|
||||||
|
|
||||||
|
/* MISC */
|
||||||
|
.clearfix:after {
|
||||||
|
clear: both;
|
||||||
|
content: '.';
|
||||||
|
display: block;
|
||||||
|
visibility: hidden;
|
||||||
|
height: 0;
|
||||||
|
}
|
||||||
|
|
||||||
|
.clearfix {display: inline-block;}
|
||||||
|
* html .clearfix {height: 1%;}
|
||||||
|
.clearfix {display: block;}
|
||||||
69
stylesheets/pygment_trac.css
Normal file
69
stylesheets/pygment_trac.css
Normal file
@ -0,0 +1,69 @@
|
|||||||
|
.highlight { background: #ffffff; }
|
||||||
|
.highlight .c { color: #999988; font-style: italic } /* Comment */
|
||||||
|
.highlight .err { color: #a61717; background-color: #e3d2d2 } /* Error */
|
||||||
|
.highlight .k { font-weight: bold } /* Keyword */
|
||||||
|
.highlight .o { font-weight: bold } /* Operator */
|
||||||
|
.highlight .cm { color: #999988; font-style: italic } /* Comment.Multiline */
|
||||||
|
.highlight .cp { color: #999999; font-weight: bold } /* Comment.Preproc */
|
||||||
|
.highlight .c1 { color: #999988; font-style: italic } /* Comment.Single */
|
||||||
|
.highlight .cs { color: #999999; font-weight: bold; font-style: italic } /* Comment.Special */
|
||||||
|
.highlight .gd { color: #000000; background-color: #ffdddd } /* Generic.Deleted */
|
||||||
|
.highlight .gd .x { color: #000000; background-color: #ffaaaa } /* Generic.Deleted.Specific */
|
||||||
|
.highlight .ge { font-style: italic } /* Generic.Emph */
|
||||||
|
.highlight .gr { color: #aa0000 } /* Generic.Error */
|
||||||
|
.highlight .gh { color: #999999 } /* Generic.Heading */
|
||||||
|
.highlight .gi { color: #000000; background-color: #ddffdd } /* Generic.Inserted */
|
||||||
|
.highlight .gi .x { color: #000000; background-color: #aaffaa } /* Generic.Inserted.Specific */
|
||||||
|
.highlight .go { color: #888888 } /* Generic.Output */
|
||||||
|
.highlight .gp { color: #555555 } /* Generic.Prompt */
|
||||||
|
.highlight .gs { font-weight: bold } /* Generic.Strong */
|
||||||
|
.highlight .gu { color: #800080; font-weight: bold; } /* Generic.Subheading */
|
||||||
|
.highlight .gt { color: #aa0000 } /* Generic.Traceback */
|
||||||
|
.highlight .kc { font-weight: bold } /* Keyword.Constant */
|
||||||
|
.highlight .kd { font-weight: bold } /* Keyword.Declaration */
|
||||||
|
.highlight .kn { font-weight: bold } /* Keyword.Namespace */
|
||||||
|
.highlight .kp { font-weight: bold } /* Keyword.Pseudo */
|
||||||
|
.highlight .kr { font-weight: bold } /* Keyword.Reserved */
|
||||||
|
.highlight .kt { color: #445588; font-weight: bold } /* Keyword.Type */
|
||||||
|
.highlight .m { color: #009999 } /* Literal.Number */
|
||||||
|
.highlight .s { color: #d14 } /* Literal.String */
|
||||||
|
.highlight .na { color: #008080 } /* Name.Attribute */
|
||||||
|
.highlight .nb { color: #0086B3 } /* Name.Builtin */
|
||||||
|
.highlight .nc { color: #445588; font-weight: bold } /* Name.Class */
|
||||||
|
.highlight .no { color: #008080 } /* Name.Constant */
|
||||||
|
.highlight .ni { color: #800080 } /* Name.Entity */
|
||||||
|
.highlight .ne { color: #990000; font-weight: bold } /* Name.Exception */
|
||||||
|
.highlight .nf { color: #990000; font-weight: bold } /* Name.Function */
|
||||||
|
.highlight .nn { color: #555555 } /* Name.Namespace */
|
||||||
|
.highlight .nt { color: #000080 } /* Name.Tag */
|
||||||
|
.highlight .nv { color: #008080 } /* Name.Variable */
|
||||||
|
.highlight .ow { font-weight: bold } /* Operator.Word */
|
||||||
|
.highlight .w { color: #bbbbbb } /* Text.Whitespace */
|
||||||
|
.highlight .mf { color: #009999 } /* Literal.Number.Float */
|
||||||
|
.highlight .mh { color: #009999 } /* Literal.Number.Hex */
|
||||||
|
.highlight .mi { color: #009999 } /* Literal.Number.Integer */
|
||||||
|
.highlight .mo { color: #009999 } /* Literal.Number.Oct */
|
||||||
|
.highlight .sb { color: #d14 } /* Literal.String.Backtick */
|
||||||
|
.highlight .sc { color: #d14 } /* Literal.String.Char */
|
||||||
|
.highlight .sd { color: #d14 } /* Literal.String.Doc */
|
||||||
|
.highlight .s2 { color: #d14 } /* Literal.String.Double */
|
||||||
|
.highlight .se { color: #d14 } /* Literal.String.Escape */
|
||||||
|
.highlight .sh { color: #d14 } /* Literal.String.Heredoc */
|
||||||
|
.highlight .si { color: #d14 } /* Literal.String.Interpol */
|
||||||
|
.highlight .sx { color: #d14 } /* Literal.String.Other */
|
||||||
|
.highlight .sr { color: #009926 } /* Literal.String.Regex */
|
||||||
|
.highlight .s1 { color: #d14 } /* Literal.String.Single */
|
||||||
|
.highlight .ss { color: #990073 } /* Literal.String.Symbol */
|
||||||
|
.highlight .bp { color: #999999 } /* Name.Builtin.Pseudo */
|
||||||
|
.highlight .vc { color: #008080 } /* Name.Variable.Class */
|
||||||
|
.highlight .vg { color: #008080 } /* Name.Variable.Global */
|
||||||
|
.highlight .vi { color: #008080 } /* Name.Variable.Instance */
|
||||||
|
.highlight .il { color: #009999 } /* Literal.Number.Integer.Long */
|
||||||
|
|
||||||
|
.type-csharp .highlight .k { color: #0000FF }
|
||||||
|
.type-csharp .highlight .kt { color: #0000FF }
|
||||||
|
.type-csharp .highlight .nf { color: #000000; font-weight: normal }
|
||||||
|
.type-csharp .highlight .nc { color: #2B91AF }
|
||||||
|
.type-csharp .highlight .nn { color: #000000 }
|
||||||
|
.type-csharp .highlight .s { color: #A31515 }
|
||||||
|
.type-csharp .highlight .sc { color: #A31515 }
|
||||||
479
stylesheets/stylesheet.css
Normal file
479
stylesheets/stylesheet.css
Normal file
@ -0,0 +1,479 @@
|
|||||||
|
/* http://meyerweb.com/eric/tools/css/reset/
|
||||||
|
v2.0 | 20110126
|
||||||
|
License: none (public domain)
|
||||||
|
*/
|
||||||
|
html, body, div, span, applet, object, iframe,
|
||||||
|
h1, h2, h3, h4, h5, h6, p, blockquote, pre,
|
||||||
|
a, abbr, acronym, address, big, cite, code,
|
||||||
|
del, dfn, em, img, ins, kbd, q, s, samp,
|
||||||
|
small, strike, strong, sub, sup, tt, var,
|
||||||
|
b, u, i, center,
|
||||||
|
dl, dt, dd, ol, ul, li,
|
||||||
|
fieldset, form, label, legend,
|
||||||
|
table, caption, tbody, tfoot, thead, tr, th, td,
|
||||||
|
article, aside, canvas, details, embed,
|
||||||
|
figure, figcaption, footer, header, hgroup,
|
||||||
|
menu, nav, output, ruby, section, summary,
|
||||||
|
time, mark, audio, video {
|
||||||
|
margin: 0;
|
||||||
|
padding: 0;
|
||||||
|
border: 0;
|
||||||
|
font-size: 100%;
|
||||||
|
font: inherit;
|
||||||
|
vertical-align: baseline;
|
||||||
|
}
|
||||||
|
/* HTML5 display-role reset for older browsers */
|
||||||
|
article, aside, details, figcaption, figure,
|
||||||
|
footer, header, hgroup, menu, nav, section {
|
||||||
|
display: block;
|
||||||
|
}
|
||||||
|
body {
|
||||||
|
line-height: 1;
|
||||||
|
}
|
||||||
|
ol, ul {
|
||||||
|
list-style: none;
|
||||||
|
}
|
||||||
|
blockquote, q {
|
||||||
|
quotes: none;
|
||||||
|
}
|
||||||
|
blockquote:before, blockquote:after,
|
||||||
|
q:before, q:after {
|
||||||
|
content: '';
|
||||||
|
content: none;
|
||||||
|
}
|
||||||
|
table {
|
||||||
|
border-collapse: collapse;
|
||||||
|
border-spacing: 0;
|
||||||
|
}
|
||||||
|
|
||||||
|
/* LAYOUT STYLES */
|
||||||
|
body {
|
||||||
|
font-size: 15px;
|
||||||
|
line-height: 1.5;
|
||||||
|
background: #fafafa url(../images/body-bg.jpg) 0 0 repeat;
|
||||||
|
font-family: 'Helvetica Neue', Helvetica, Arial, serif;
|
||||||
|
font-weight: 400;
|
||||||
|
color: #666;
|
||||||
|
}
|
||||||
|
|
||||||
|
a {
|
||||||
|
color: #2879d0;
|
||||||
|
}
|
||||||
|
a:hover {
|
||||||
|
color: #2268b2;
|
||||||
|
}
|
||||||
|
|
||||||
|
header {
|
||||||
|
padding-top: 40px;
|
||||||
|
padding-bottom: 40px;
|
||||||
|
font-family: 'Architects Daughter', 'Helvetica Neue', Helvetica, Arial, serif;
|
||||||
|
background: #2e7bcf url(../images/header-bg.jpg) 0 0 repeat-x;
|
||||||
|
border-bottom: solid 1px #275da1;
|
||||||
|
}
|
||||||
|
|
||||||
|
header h1 {
|
||||||
|
letter-spacing: -1px;
|
||||||
|
font-size: 72px;
|
||||||
|
color: #fff;
|
||||||
|
line-height: 1;
|
||||||
|
margin-bottom: 0.2em;
|
||||||
|
width: 540px;
|
||||||
|
}
|
||||||
|
|
||||||
|
header h2 {
|
||||||
|
font-size: 26px;
|
||||||
|
color: #9ddcff;
|
||||||
|
font-weight: normal;
|
||||||
|
line-height: 1.3;
|
||||||
|
width: 540px;
|
||||||
|
letter-spacing: 0;
|
||||||
|
}
|
||||||
|
|
||||||
|
.inner {
|
||||||
|
position: relative;
|
||||||
|
width: 940px;
|
||||||
|
margin: 0 auto;
|
||||||
|
}
|
||||||
|
|
||||||
|
#content-wrapper {
|
||||||
|
border-top: solid 1px #fff;
|
||||||
|
padding-top: 30px;
|
||||||
|
}
|
||||||
|
|
||||||
|
#main-content {
|
||||||
|
width: 690px;
|
||||||
|
float: left;
|
||||||
|
}
|
||||||
|
|
||||||
|
#main-content img {
|
||||||
|
max-width: 100%;
|
||||||
|
}
|
||||||
|
|
||||||
|
aside#sidebar {
|
||||||
|
width: 200px;
|
||||||
|
padding-left: 20px;
|
||||||
|
min-height: 504px;
|
||||||
|
float: right;
|
||||||
|
background: transparent url(../images/sidebar-bg.jpg) 0 0 no-repeat;
|
||||||
|
font-size: 12px;
|
||||||
|
line-height: 1.3;
|
||||||
|
}
|
||||||
|
|
||||||
|
aside#sidebar p.repo-owner,
|
||||||
|
aside#sidebar p.repo-owner a {
|
||||||
|
font-weight: bold;
|
||||||
|
}
|
||||||
|
|
||||||
|
#downloads {
|
||||||
|
margin-bottom: 40px;
|
||||||
|
}
|
||||||
|
|
||||||
|
a.button {
|
||||||
|
width: 134px;
|
||||||
|
height: 58px;
|
||||||
|
line-height: 1.2;
|
||||||
|
font-size: 23px;
|
||||||
|
color: #fff;
|
||||||
|
padding-left: 68px;
|
||||||
|
padding-top: 22px;
|
||||||
|
font-family: 'Architects Daughter', 'Helvetica Neue', Helvetica, Arial, serif;
|
||||||
|
}
|
||||||
|
a.button small {
|
||||||
|
display: block;
|
||||||
|
font-size: 11px;
|
||||||
|
}
|
||||||
|
header a.button {
|
||||||
|
position: absolute;
|
||||||
|
right: 0;
|
||||||
|
top: 0;
|
||||||
|
background: transparent url(../images/github-button.png) 0 0 no-repeat;
|
||||||
|
}
|
||||||
|
aside a.button {
|
||||||
|
width: 138px;
|
||||||
|
padding-left: 64px;
|
||||||
|
display: block;
|
||||||
|
background: transparent url(../images/download-button.png) 0 0 no-repeat;
|
||||||
|
margin-bottom: 20px;
|
||||||
|
font-size: 21px;
|
||||||
|
}
|
||||||
|
|
||||||
|
code, pre {
|
||||||
|
font-family: Monaco, "Bitstream Vera Sans Mono", "Lucida Console", Terminal, monospace;
|
||||||
|
color: #222;
|
||||||
|
margin-bottom: 30px;
|
||||||
|
font-size: 13px;
|
||||||
|
}
|
||||||
|
|
||||||
|
code {
|
||||||
|
background-color: #f2f8fc;
|
||||||
|
border: solid 1px #dbe7f3;
|
||||||
|
padding: 0 3px;
|
||||||
|
}
|
||||||
|
|
||||||
|
pre {
|
||||||
|
padding: 20px;
|
||||||
|
background: #fff;
|
||||||
|
text-shadow: none;
|
||||||
|
overflow: auto;
|
||||||
|
border: solid 1px #f2f2f2;
|
||||||
|
}
|
||||||
|
pre code {
|
||||||
|
color: #2879d0;
|
||||||
|
background-color: #fff;
|
||||||
|
border: none;
|
||||||
|
padding: 0;
|
||||||
|
}
|
||||||
|
|
||||||
|
ul, ol, dl {
|
||||||
|
margin-bottom: 20px;
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
/* COMMON STYLES */
|
||||||
|
|
||||||
|
hr {
|
||||||
|
height: 1px;
|
||||||
|
line-height: 1px;
|
||||||
|
margin-top: 1em;
|
||||||
|
padding-bottom: 1em;
|
||||||
|
border: none;
|
||||||
|
background: transparent url('../images/hr.png') 0 0 no-repeat;
|
||||||
|
}
|
||||||
|
|
||||||
|
table {
|
||||||
|
width: 100%;
|
||||||
|
border: 1px solid #ebebeb;
|
||||||
|
}
|
||||||
|
|
||||||
|
th {
|
||||||
|
font-weight: 500;
|
||||||
|
}
|
||||||
|
|
||||||
|
td {
|
||||||
|
border: 1px solid #ebebeb;
|
||||||
|
text-align: center;
|
||||||
|
font-weight: 300;
|
||||||
|
}
|
||||||
|
|
||||||
|
form {
|
||||||
|
background: #f2f2f2;
|
||||||
|
padding: 20px;
|
||||||
|
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
/* GENERAL ELEMENT TYPE STYLES */
|
||||||
|
|
||||||
|
#main-content h1 {
|
||||||
|
font-family: 'Architects Daughter', 'Helvetica Neue', Helvetica, Arial, serif;
|
||||||
|
font-size: 2.8em;
|
||||||
|
letter-spacing: -1px;
|
||||||
|
color: #474747;
|
||||||
|
}
|
||||||
|
|
||||||
|
#main-content h1:before {
|
||||||
|
content: "/";
|
||||||
|
color: #9ddcff;
|
||||||
|
padding-right: 0.3em;
|
||||||
|
margin-left: -0.9em;
|
||||||
|
}
|
||||||
|
|
||||||
|
#main-content h2 {
|
||||||
|
font-family: 'Architects Daughter', 'Helvetica Neue', Helvetica, Arial, serif;
|
||||||
|
font-size: 22px;
|
||||||
|
font-weight: bold;
|
||||||
|
margin-bottom: 8px;
|
||||||
|
color: #474747;
|
||||||
|
}
|
||||||
|
#main-content h2:before {
|
||||||
|
content: "//";
|
||||||
|
color: #9ddcff;
|
||||||
|
padding-right: 0.3em;
|
||||||
|
margin-left: -1.5em;
|
||||||
|
}
|
||||||
|
|
||||||
|
#main-content h3 {
|
||||||
|
font-family: 'Architects Daughter', 'Helvetica Neue', Helvetica, Arial, serif;
|
||||||
|
font-size: 18px;
|
||||||
|
font-weight: bold;
|
||||||
|
margin-top: 24px;
|
||||||
|
margin-bottom: 8px;
|
||||||
|
color: #474747;
|
||||||
|
}
|
||||||
|
|
||||||
|
#main-content h3:before {
|
||||||
|
content: "///";
|
||||||
|
color: #9ddcff;
|
||||||
|
padding-right: 0.3em;
|
||||||
|
margin-left: -2em;
|
||||||
|
}
|
||||||
|
|
||||||
|
#main-content h4 {
|
||||||
|
font-family: 'Architects Daughter', 'Helvetica Neue', Helvetica, Arial, serif;
|
||||||
|
font-size: 15px;
|
||||||
|
font-weight: bold;
|
||||||
|
color: #474747;
|
||||||
|
}
|
||||||
|
|
||||||
|
h4:before {
|
||||||
|
content: "////";
|
||||||
|
color: #9ddcff;
|
||||||
|
padding-right: 0.3em;
|
||||||
|
margin-left: -2.8em;
|
||||||
|
}
|
||||||
|
|
||||||
|
#main-content h5 {
|
||||||
|
font-family: 'Architects Daughter', 'Helvetica Neue', Helvetica, Arial, serif;
|
||||||
|
font-size: 14px;
|
||||||
|
color: #474747;
|
||||||
|
}
|
||||||
|
h5:before {
|
||||||
|
content: "/////";
|
||||||
|
color: #9ddcff;
|
||||||
|
padding-right: 0.3em;
|
||||||
|
margin-left: -3.2em;
|
||||||
|
}
|
||||||
|
|
||||||
|
#main-content h6 {
|
||||||
|
font-family: 'Architects Daughter', 'Helvetica Neue', Helvetica, Arial, serif;
|
||||||
|
font-size: .8em;
|
||||||
|
color: #474747;
|
||||||
|
}
|
||||||
|
h6:before {
|
||||||
|
content: "//////";
|
||||||
|
color: #9ddcff;
|
||||||
|
padding-right: 0.3em;
|
||||||
|
margin-left: -3.7em;
|
||||||
|
}
|
||||||
|
|
||||||
|
p {
|
||||||
|
margin-bottom: 20px;
|
||||||
|
}
|
||||||
|
|
||||||
|
a {
|
||||||
|
text-decoration: none;
|
||||||
|
}
|
||||||
|
|
||||||
|
p a {
|
||||||
|
font-weight: 400;
|
||||||
|
}
|
||||||
|
|
||||||
|
blockquote {
|
||||||
|
font-size: 1.6em;
|
||||||
|
border-left: 10px solid #e9e9e9;
|
||||||
|
margin-bottom: 20px;
|
||||||
|
padding: 0 0 0 30px;
|
||||||
|
}
|
||||||
|
|
||||||
|
ul {
|
||||||
|
list-style: disc inside;
|
||||||
|
padding-left: 20px;
|
||||||
|
}
|
||||||
|
|
||||||
|
ol {
|
||||||
|
list-style: decimal inside;
|
||||||
|
padding-left: 3px;
|
||||||
|
}
|
||||||
|
|
||||||
|
dl dd {
|
||||||
|
font-style: italic;
|
||||||
|
font-weight: 100;
|
||||||
|
}
|
||||||
|
|
||||||
|
footer {
|
||||||
|
background: transparent url('../images/hr.png') 0 0 no-repeat;
|
||||||
|
margin-top: 40px;
|
||||||
|
padding-top: 20px;
|
||||||
|
padding-bottom: 30px;
|
||||||
|
font-size: 13px;
|
||||||
|
color: #aaa;
|
||||||
|
}
|
||||||
|
|
||||||
|
footer a {
|
||||||
|
color: #666;
|
||||||
|
}
|
||||||
|
footer a:hover {
|
||||||
|
color: #444;
|
||||||
|
}
|
||||||
|
|
||||||
|
/* MISC */
|
||||||
|
.clearfix:after {
|
||||||
|
clear: both;
|
||||||
|
content: '.';
|
||||||
|
display: block;
|
||||||
|
visibility: hidden;
|
||||||
|
height: 0;
|
||||||
|
}
|
||||||
|
|
||||||
|
.clearfix {display: inline-block;}
|
||||||
|
* html .clearfix {height: 1%;}
|
||||||
|
.clearfix {display: block;}
|
||||||
|
|
||||||
|
/* #Media Queries
|
||||||
|
================================================== */
|
||||||
|
|
||||||
|
/* Smaller than standard 960 (devices and browsers) */
|
||||||
|
@media only screen and (max-width: 959px) {}
|
||||||
|
|
||||||
|
/* Tablet Portrait size to standard 960 (devices and browsers) */
|
||||||
|
@media only screen and (min-width: 768px) and (max-width: 959px) {
|
||||||
|
.inner {
|
||||||
|
width: 740px;
|
||||||
|
}
|
||||||
|
header h1, header h2 {
|
||||||
|
width: 340px;
|
||||||
|
}
|
||||||
|
header h1 {
|
||||||
|
font-size: 60px;
|
||||||
|
}
|
||||||
|
header h2 {
|
||||||
|
font-size: 30px;
|
||||||
|
}
|
||||||
|
#main-content {
|
||||||
|
width: 490px;
|
||||||
|
}
|
||||||
|
#main-content h1:before,
|
||||||
|
#main-content h2:before,
|
||||||
|
#main-content h3:before,
|
||||||
|
#main-content h4:before,
|
||||||
|
#main-content h5:before,
|
||||||
|
#main-content h6:before {
|
||||||
|
content: none;
|
||||||
|
padding-right: 0;
|
||||||
|
margin-left: 0;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
/* All Mobile Sizes (devices and browser) */
|
||||||
|
@media only screen and (max-width: 767px) {
|
||||||
|
.inner {
|
||||||
|
width: 93%;
|
||||||
|
}
|
||||||
|
header {
|
||||||
|
padding: 20px 0;
|
||||||
|
}
|
||||||
|
header .inner {
|
||||||
|
position: relative;
|
||||||
|
}
|
||||||
|
header h1, header h2 {
|
||||||
|
width: 100%;
|
||||||
|
}
|
||||||
|
header h1 {
|
||||||
|
font-size: 48px;
|
||||||
|
}
|
||||||
|
header h2 {
|
||||||
|
font-size: 24px;
|
||||||
|
}
|
||||||
|
header a.button {
|
||||||
|
background-image: none;
|
||||||
|
width: auto;
|
||||||
|
height: auto;
|
||||||
|
display: inline-block;
|
||||||
|
margin-top: 15px;
|
||||||
|
padding: 5px 10px;
|
||||||
|
position: relative;
|
||||||
|
text-align: center;
|
||||||
|
font-size: 13px;
|
||||||
|
line-height: 1;
|
||||||
|
background-color: #9ddcff;
|
||||||
|
color: #2879d0;
|
||||||
|
-moz-border-radius: 5px;
|
||||||
|
-webkit-border-radius: 5px;
|
||||||
|
border-radius: 5px;
|
||||||
|
}
|
||||||
|
header a.button small {
|
||||||
|
font-size: 13px;
|
||||||
|
display: inline;
|
||||||
|
}
|
||||||
|
#main-content,
|
||||||
|
aside#sidebar {
|
||||||
|
float: none;
|
||||||
|
width: 100% ! important;
|
||||||
|
}
|
||||||
|
aside#sidebar {
|
||||||
|
background-image: none;
|
||||||
|
margin-top: 20px;
|
||||||
|
border-top: solid 1px #ddd;
|
||||||
|
padding: 20px 0;
|
||||||
|
min-height: 0;
|
||||||
|
}
|
||||||
|
aside#sidebar a.button {
|
||||||
|
display: none;
|
||||||
|
}
|
||||||
|
#main-content h1:before,
|
||||||
|
#main-content h2:before,
|
||||||
|
#main-content h3:before,
|
||||||
|
#main-content h4:before,
|
||||||
|
#main-content h5:before,
|
||||||
|
#main-content h6:before {
|
||||||
|
content: none;
|
||||||
|
padding-right: 0;
|
||||||
|
margin-left: 0;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
/* Mobile Landscape Size to Tablet Portrait (devices and browsers) */
|
||||||
|
@media only screen and (min-width: 480px) and (max-width: 767px) {}
|
||||||
|
|
||||||
|
/* Mobile Portrait Size to Mobile Landscape Size (devices and browsers) */
|
||||||
|
@media only screen and (max-width: 479px) {}
|
||||||
@ -1,23 +0,0 @@
|
|||||||
{-# LANGUAGE TemplateHaskell #-}
|
|
||||||
|
|
||||||
module Main where
|
|
||||||
|
|
||||||
import Test.QuickCheck
|
|
||||||
|
|
||||||
import Test.Framework
|
|
||||||
import Test.Framework.TH
|
|
||||||
import Test.Framework.Providers.QuickCheck2
|
|
||||||
|
|
||||||
import Map.Map
|
|
||||||
|
|
||||||
main :: IO ()
|
|
||||||
main = $(defaultMainGenerator)
|
|
||||||
|
|
||||||
prop_rd_idempot :: [Int] -> Bool
|
|
||||||
prop_rd_idempot xs = remdups xs == (remdups . remdups) xs
|
|
||||||
|
|
||||||
prop_rd_length :: [Int] -> Bool
|
|
||||||
prop_rd_length xs = length (remdups xs) <= length xs
|
|
||||||
|
|
||||||
prop_rd_sorted :: [Int] -> Property
|
|
||||||
prop_rd_sorted xs = (not . null) xs ==> head (remdups xs) == minimum xs
|
|
||||||
Loading…
Reference in New Issue
Block a user