Skip to content

GitLab

Commit ba7c9391 authored by Marc Coiffier's avatar Marc Coiffier
Browse files

Fun with Logos

parent 1d045b9d
Hide whitespace changes
Inline Side-by-side
capricon/capricon.cabal
View file @ ba7c9391
......@@ -2,7 +2,7 @@
-- see http://haskell.org/cabal/users-guide/
name: capricon
version: 0.8.2
version: 0.9
-- synopsis:
-- description:
license: GPL-3
......@@ -35,7 +35,7 @@ executable capricon
default-extensions: RebindableSyntax, ViewPatterns, TupleSections, FlexibleInstances, FlexibleContexts, MultiParamTypeClasses, FunctionalDependencies, LambdaCase, TypeOperators, RankNTypes, GeneralizedNewtypeDeriving, TypeFamilies
-- other-modules:
-- other-extensions:
build-depends: base >=4.8 && <4.10,capricon >=0.8 && <0.9,definitive-base >=2.6 && <2.7,definitive-parser >=3.1 && <3.2
build-depends: base >=4.8 && <4.10,capricon >=0.9 && <0.10,definitive-base >=2.6 && <2.7,definitive-parser >=3.1 && <3.2
ghc-options: -Wincomplete-patterns -Wname-shadowing -W -Werror
hs-source-dirs: exe
default-language: Haskell2010
......@@ -47,7 +47,7 @@ executable WiQEE.js
-- other-modules:
-- other-extensions:
haste-options: --opt-all
build-depends: base >=4.8 && <4.10,capricon >=0.8 && <0.9,definitive-base >=2.6 && <2.7,definitive-parser >=3.0 && <3.1,filepath >=1.4 && <1.5,haste-lib,array
build-depends: array >=0.5 && <0.6,base >=4.8 && <4.10,capricon >=0.9 && <0.10,definitive-base >=2.6 && <2.7,definitive-parser >=3.1 && <3.2,filepath >=1.4 && <1.5,haste-lib
hs-source-dirs: exe
default-language: Haskell2010
-- executable coinche
......@@ -55,7 +55,7 @@ executable WiQEE.js
-- default-extensions: RebindableSyntax
-- -- other-modules:
-- -- other-extensions:
-- build-depends: base >=4.9 && <4.10,definitive-base >=2.6 && <2.7,definitive-parser >=3.0 && <3.1,misc >=. && <.1,random >=1.1 && <1.2,random-shuffle >=. && <.1
-- build-depends: base >=4.8 && <4.10,definitive-base >=2.6 && <2.7,definitive-parser >=3.1 && <3.2,random >=1.1 && <1.2,random-shuffle
-- ghc-options: -Wincomplete-patterns -Wname-shadowing -Werror
-- hs-source-dirs: exe
-- default-language: Haskell2010
capricon/src/Algebra/Monad/Concatenative.hs
View file @ ba7c9391
......@@ -124,7 +124,7 @@ execSymbolImpl execBuiltin' onComment atom = do
(OpenBrace,_) -> progStack =~ (StackClosure [] []:)
(OpenSplice,StackClosure cs p:ps) ->
progStack =- StackClosure [] []:StackClosure ((p,StackClosure [] []):cs) []:ps
progStack =- StackClosure [] []:StackClosure ((reverse p,StackClosure [] []):cs) []:ps
(CloseSplice,StackClosure cs p:StackClosure cs' p':ps) ->
progStack =- StackClosure (set (t'1.l'2) (StackClosure (reverse cs) (reverse p)) cs') p':ps
......
grow/grow.cabal
View file @ ba7c9391
......@@ -24,4 +24,4 @@ executable grow
main-is: Grow.hs
hs-source-dirs: exe
default-extensions: RebindableSyntax, TypeOperators, GeneralizedNewtypeDeriving, TupleSections, FlexibleContexts, DefaultSignatures
build-depends: base >=4.9 && <4.10,definitive-base >=2.6 && <2.7,definitive-parser >=3.0 && <3.1,directory >=1.3 && <1.4,time >=1.6 && <1.7,unix >=2.7 && <2.8
build-depends: base >=4.9 && <4.10,definitive-base >=2.6 && <2.7,definitive-parser >=3.1 && <3.2,directory >=1.3 && <1.4,time >=1.6 && <1.7,unix >=2.7 && <2.8
logos/doc/examples/demo
View file @ ba7c9391
......@@ -20,14 +20,11 @@
'normal { 0 vcons 'vertexNormal swap def } def
'red { 1 0 0 0.5 rgba } def
'green { 0 1 0 0.5 rgba } def
'blue { 0 0 1 0.5 rgba } def
'white { 1 1 1 rgb } def
'white2 { 1 1 1 0.5 rgba } def
'tile "textures/Gravel-2450.jpg" image def
"tileTexture" uniform tile defuniform
'red { 1 0 0 0.1 rgba } def
'green { 0 1 0 0.1 rgba } def
'blue { 0 0 1 0.1 rgba } def
'white { 1 1 1 0.1 rgba } def
'nocolor { 0 0 0 0 rgba } def
'rgb-triangle
[ blue 1 0 texpoint 1 0 0 point
......@@ -35,12 +32,12 @@
, green 0 0 texpoint 0 0 0 point ]
components 'TRIANGLES mesh def
'rgb-square
[ 0 0 1 normal blue 1 0 texpoint 1 0 0 point
, green 0 1 texpoint 0 1 0 point
, red 0 0 texpoint 0 0 0 point
, green 0 1 texpoint 0 1 0 point
, blue 1 0 texpoint 1 0 0 point
, white 1 1 texpoint 1 1 0 point ]
[ 0 0 1 normal nocolor 1 0 texpoint 1 0 0 point
, 0 1 texpoint 0 1 0 point
, 0 0 texpoint 0 0 0 point
, 0 1 texpoint 0 1 0 point
, 1 0 texpoint 1 0 0 point
, 1 1 texpoint 1 1 0 point ]
components 'TRIANGLES mesh def
'cue
[ blue 0 0 0 point 1 0 0 point
......@@ -48,17 +45,33 @@
, green 0 0 0 point 0 0 1 point ]
components 'LINES mesh def
'modelMat dup uniform def
modelMat identity defuniform
'=> { modelMat swap [ 2 shaft ] } def
'Uniform { dup "set-%s" format swap { {@ dup uniform @} 1 dupn defuniform , {@ @} swap def } def } def
'modelMat Uniform
'viewMat Uniform
'projMat Uniform
'tile "textures/Pebbles_006_COLOR.jpg" image def
'tileNormals "textures/Pebbles_006_NRM.jpg" image def
'tileTexture Uniform , tile set-tileTexture
'tileTextureNormal Uniform , tileNormals set-tileTextureNormal
'lightVect Uniform , 0 0 1 0 vcons set-lightVect
'lightColor Uniform , 1 1 1 1 vcons set-lightColor
'ambiantLuminosity Uniform , 0.6 set-ambiantLuminosity
identity set-modelMat
'=> { {@ 'modelMat uniform @} swap [ 2 shaft ] } def
'scene [
10 range {
'i swap def
10 range {
'j swap def
0.125 0.125 0 0 vcons translation , 0.8 scale ,
i j 0 0 vcons translate , 0.2 scale => rgb-square
-0.5 -0.5 0 0 vcons translation , 0.8 scale ,
vz vz vx i 4.5 -- 0.2 ** ** vy j 4.5 -- 0.2 ** ** ++ ++ normalize rotate ,
i 0.5 ++ j 0.5 ++ 0 0 vcons translate , 0.2 scale => rgb-square
} each
} each
] def
......@@ -73,14 +86,15 @@ modelMat identity defuniform
'view-xy-angle vx def
'view-zy-angle vz def
'view-trans -1 -1 0 0 vcons translation def
'viewMat dup uniform def , viewMat view-trans defuniform
'view-scale 1 def
view-trans set-viewMat
'projMat dup uniform def
'resize {
identity swap scale , vz negate translate , vx vy vz vz negate mcons **
projMat swap defuniform } def
identity swap scale , vz negate translate , vx vy vz negate vz negate mcons **
set-projMat } def
'set-camera { viewMat view-trans , vx view-xy-angle rotate , vz view-zy-angle rotate defuniform } def
'set-camera { view-trans , view-scale scale , vx view-xy-angle rotate , vz view-zy-angle rotate set-viewMat } def
'ctrl false def
......@@ -88,6 +102,8 @@ modelMat identity defuniform
"press RIGHT" { 'view-xy-angle { dyx ** } modify set-camera refresh } bind-key
"press UP" { 'view-zy-angle { dyz ** } modify set-camera refresh } bind-key
"press DOWN" { 'view-zy-angle { dzy ** } modify set-camera refresh } bind-key
"press KP_ADD" { 'view-scale { 1.1 ** } modify set-camera refresh } bind-key
"press KP_SUBTRACT" { 'view-scale { {@ {@ 1.1 recip @} @} ** } modify set-camera refresh } bind-key
"press ESC" { quit } bind-key
"press Q" { ctrl { quit } { } if } bind-key
......@@ -97,8 +113,12 @@ modelMat identity defuniform
1 resize refresh
'keep-looping false def
'auto-loop { keep-looping { 'LEFT 'press key 'auto-loop $ 20000 delay } { } if } def
'auto-loop { keep-looping { loop-body 'auto-loop $ 40000 delay } { } if } def
'auto-toggle { 'keep-looping { 1 swap - } modify } def
'loop-body { 'LEFT 'press key } def
"press L" { auto-toggle auto-loop } bind-key
'loop-body { lightVect east-west { dyz } { dzy } if ** set-lightVect refresh } def
'east-west true def
"press E" { 'east-west { 1 swap - } modify } bind-key
logos/doc/examples/fragment.shader
View file @ ba7c9391
......@@ -2,11 +2,30 @@
in vec4 fragmentColor;
in vec2 fragmentUV;
in vec3 fragmentNormal;
uniform sampler2D tileTexture;
uniform sampler2D tileTextureNormal;
uniform vec4 lightVect;
uniform vec4 lightColor;
uniform float ambiantLuminosity;
vec3 reflect(vec3 u,vec3 v) {
float duv = dot(u,v);
if(duv!=0)
return (2*dot(u,u)/duv)*v - u;
else
return -u;
}
void main() {
vec4 texCol = texture(tileTexture,vec2(1) - fragmentUV);
gl_FragColor = vec4((fragmentColor.rgb * fragmentColor.a + texCol.rgb) / (1+fragmentColor.a),texCol.a);
// gl_FragColor = fragmentColor;
vec4 texCol = texture(tileTexture,fragmentUV);
vec3 texNorm_raw = texture(tileTextureNormal,fragmentUV).xyz;
vec3 texNorm = reflect(reflect(texNorm_raw,vec3(0,0,1)),vec3(0,0,1)+fragmentNormal);
float luminosity = clamp(dot(normalize(texNorm),lightVect.xyz),0,1);
gl_FragDepth = gl_FragCoord.z / gl_FragCoord.w;
gl_FragColor = vec4((fragmentColor.rgb * fragmentColor.a + lightColor.rgb * (ambiantLuminosity + luminosity)) * texCol.rgb / (1+ambiantLuminosity+fragmentColor.a),1);
}
logos/doc/examples/vertex.shader
View file @ ba7c9391
......@@ -6,6 +6,7 @@ in vec4 vertexColor;
in vec2 vertexUV;
out vec4 fragmentColor;
out vec2 fragmentUV;
out vec3 fragmentNormal;
uniform mat4 viewMat;
uniform mat4 modelMat;
......@@ -15,4 +16,5 @@ void main() {
gl_Position = projMat * viewMat * modelMat * vec4(vertexPosition,1);
fragmentUV = vertexUV;
fragmentColor = vertexColor;
fragmentNormal = (modelMat * vec4(vertexNormal,0)).xyz;
}
logos/exe/Logos.hs
View file @ ba7c9391
......@@ -259,7 +259,7 @@ runLogos OpenWindow = do
GLFW.openWindowHint GLFW.OpenGLVersionMinor 3
GLFW.openWindowHint GLFW.OpenGLProfile GLFW.OpenGLCoreProfile
success <- GLFW.openWindow (GL.Size (fromIntegral w) (fromIntegral h)) [GLFW.DisplayRGBBits 8 8 8, GLFW.DisplayAlphaBits 8, GLFW.DisplayDepthBits 8] GLFW.Window
success <- GLFW.openWindow (GL.Size (fromIntegral w) (fromIntegral h)) [GLFW.DisplayRGBBits 8 8 8, GLFW.DisplayDepthBits 24] GLFW.Window
if not success then throw $ SomeException GLFWWindowOpenException else do
initGL >> initShaders
forkIO $ forever $ GLFW.pollEvents >> threadDelay 50000
......@@ -291,6 +291,7 @@ runLogos DefUniform = do
x:StackExtra (Opaque (Uni u)):st' -> do
runStackState $ put st'
case x of
StackFloat f -> liftIO $ GL.uniform u $= f
StackVect (V4 x y z w) -> liftIO $ GL.uniform u $= GL.Vector4 x y z w
StackMat m -> liftIO $ setUniformMat u m
StackExtra (Opaque (TI (GL.TextureObject tex))) -> liftIO $ GL.uniform u $= GL.TextureUnit tex
......@@ -393,12 +394,11 @@ initShaders = GL.createProgram <*= \prog -> do
initGL = do
vao <- GL.genObjectName
GL.bindVertexArrayObject $= Just vao
GL.depthFunc $= Just GL.Lequal
GL.blend $= GL.Enabled
GL.blendFunc $= (GL.SrcAlpha, GL.OneMinusSrcAlpha)
GL.texture GL.Texture2D $= GL.Enabled
GL.textureFunction $= GL.Blend
-- GL.blend $= GL.Disabled
-- GL.blendFunc $= (GL.SrcAlpha, GL.OneMinusSrcAlpha)
-- GL.texture GL.Texture2D $= GL.Enabled
-- GL.textureFunction $= GL.Blend
main = between (void GLFW.initialize) GLFW.terminate $ do
isTerm <- hIsTerminalDevice stdin
......
logos/logos.cabal
View file @ ba7c9391
......@@ -13,15 +13,16 @@ cabal-version: >=1.10
library
exposed-modules: Data.Matricial
build-depends: base >=4.8 && <4.10, definitive-base >=2.6 && <2.7
build-depends: base >=4.9 && <4.10,definitive-base >=2.6 && <2.7
default-extensions: TypeSynonymInstances, NoMonomorphismRestriction, StandaloneDeriving, GeneralizedNewtypeDeriving, TypeOperators, RebindableSyntax, FlexibleInstances, FlexibleContexts, FunctionalDependencies, TupleSections, MultiParamTypeClasses, Rank2Types, AllowAmbiguousTypes, RoleAnnotations, ViewPatterns, LambdaCase
hs-source-dirs: src
default-language: Haskell2010
executable logos
build-depends: base >=4.8 && <4.10, definitive-base >=2.6 && <2.7, capricon, OpenGL, GLFW, StateVar, JuicyPixels, vector, logos, definitive-parser, hreadline
build-depends: base >=4.9 && <4.10,capricon >=0.9 && <0.10,definitive-base >=2.6 && <2.7,definitive-parser >=3.1 && <3.2,GLFW >=0.5 && <0.6,hreadline >=0.2 && <0.3,JuicyPixels >=3.2 && <3.3,logos >=0.1 && <0.2,OpenGL >=3.0 && <3.1,StateVar >=1.1 && <1.2,vector >=0.12 && <0.13
default-extensions: TypeSynonymInstances, NoMonomorphismRestriction, StandaloneDeriving, GeneralizedNewtypeDeriving, TypeOperators, RebindableSyntax, FlexibleInstances, FlexibleContexts, FunctionalDependencies, TupleSections, MultiParamTypeClasses, Rank2Types, AllowAmbiguousTypes, RoleAnnotations, ViewPatterns, LambdaCase
hs-source-dirs: exe
ghc-options: -threaded
main-is: Logos.hs
default-language: Haskell2010
......
scripts/update-deps
View file @ ba7c9391
......@@ -3,11 +3,12 @@ IFSBAK="$IFS"
declare -A PKGS
while read pkg ver; do
PKGS[$pkg]="$ver"
done < <(stack list-dependencies)
done < <(stack ls dependencies)
for file in */*.cabal; do
while IFS= read line; do
case "$line" in
*build-depends:*)
prefix="${line%%build-depends:*}"
IFS="$IFS,&" deps=( ${line#*build-depends:} ) IFS="$IFSBAK"
full_deps=( )
for dep in "${deps[@]}"; do
......@@ -16,7 +17,7 @@ for file in */*.cabal; do
*)
ver="${PKGS[$dep]}"
IFS=. vern=( $ver ) IFS="$IFSBAK"
if [ "$RAW_DEPS" != '' ]; then
if [ "$RAW_DEPS" != '' ] || [ "${vern[0]}" == "" ]; then
full_deps+=( "$dep" )
else
full_deps+=( "$dep >=${vern[0]}.${vern[1]} && <${vern[0]}.$((vern[1]+1))" )
......@@ -25,7 +26,7 @@ for file in */*.cabal; do
esac
done
IFS=$'\n' full_deps=( $(printf "%s\n" "${full_deps[@]}" | sort) ) IFS="$IFSBAK"
IFS=,; printf " build-depends: %s\n" "${full_deps[*]}"; IFS="$IFSBAK"
IFS=,; printf "%sbuild-depends: %s\n" "$prefix" "${full_deps[*]}"; IFS="$IFSBAK"
;;
*) printf "%s\n" "$line";;
esac
......
stack.yaml
View file @ ba7c9391
......@@ -37,11 +37,12 @@ resolver: lts-9.10
# will not be run. This is useful for tweaking upstream packages.
packages:
- ./curly
- ./capricon
- ./curly-gateway
- ./logos
# Dependency packages to be pulled from upstream that are not in the resolver
# (e.g., acme-missiles-0.3)
extra-deps:
- ./capricon
- ./curly-gateway
- AES-0.2.9
- kademlia-1.1.0.0
- GLFW-0.5.2.5
......@@ -49,7 +50,6 @@ extra-deps:
- ./definitive-parser
- ./definitive-network
- ./definitive-filesystem
- ./logos
- ./hreadline
- ./curly-kademlia
- ./curly-core
......
woosh/woosh.cabal
View file @ ba7c9391
......@@ -28,6 +28,6 @@ executable woosh
AllowAmbiguousTypes,
RoleAnnotations
other-extensions: ImplicitParams, StandaloneDeriving, MultiParamTypeClasses, RankNTypes, DefaultSignatures, TupleSections, Rank2Types, FunctionalDependencies, ViewPatterns, LiberalTypeSynonyms, NoRebindableSyntax, EmptyDataDecls, CPP, ScopedTypeVariables, UndecidableInstances, DeriveGeneric, ExistentialQuantification, RecursiveDo, DeriveDataTypeable
build-depends: base >=4.9 && <4.10,definitive-base >=2.6 && <2.7,definitive-parser >=3.0 && <3.1,utf8-string >=1.0 && <1.1
build-depends: base >=4.9 && <4.10,definitive-base >=2.6 && <2.7,definitive-parser >=3.1 && <3.2,utf8-string >=1.0 && <1.1
hs-source-dirs: exe
default-language: Haskell2010
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment