Skip to content
GitLab
Menu
Projects
Groups
Snippets
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
Menu
Open sidebar
Marc Coiffier
BHR
Commits
ba7c9391
Commit
ba7c9391
authored
Nov 25, 2018
by
Marc Coiffier
Browse files
Fun with Logos
parent
1d045b9d
Changes
11
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 { view
Mat 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 ke
y 'auto-loop $
2
0000 delay } { } if } def
'auto-loop { keep-looping {
loop-bod
y 'auto-loop $
4
0000 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
.
En
abled
GL
.
blendFunc
$=
(
GL
.
SrcAlpha
,
GL
.
OneMinusSrcAlpha
)
GL
.
texture
GL
.
Texture2D
$=
GL
.
Enabled
GL
.
textureFunction
$=
GL
.
Blend
--
GL.blend $= GL.
Dis
abled
--
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 l
ist-
dependencies
)
done
< <
(
stack
l
s
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
"
%s
build-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
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment