diff --git a/shader/character.geom b/shader/character.geom index a3e1851e4..38343deb1 100644 --- a/shader/character.geom +++ b/shader/character.geom @@ -2,30 +2,31 @@ layout (points) in; layout (triangle_strip, max_vertices = 4) out; in vec4 vColor []; -in vec2 vTexCoord []; +in vec3 vTexCoord []; out vec4 gColor; out vec2 gTex; void main() { vec3 cenPos = gl_in[0].gl_Position.xyz; - float size = vTexCoord[0].y; + float sizex = vTexCoord[0].y; + float sizey = vTexCoord[0].z; //float size = 0.05; gColor = vColor[0]; float texPos = vTexCoord[0].x; - gl_Position = vec4 (cenPos.x - size*0.5, cenPos.y - size, cenPos.z , 1); + gl_Position = vec4 (cenPos.x - sizex*0.5, cenPos.y - sizey*0.5, cenPos.z , 1); //gl_Position = vec4 (0, 0 , 5 , 1); gTex = vec2 (texPos*0.0078125, 1); EmitVertex(); - gl_Position = vec4 (cenPos.x - size*0.5, cenPos.y + size, cenPos.z , 1); + gl_Position = vec4 (cenPos.x - sizex*0.5, cenPos.y + sizey*0.5, cenPos.z , 1); //gl_Position = vec4 (0, 0.5 , 5 , 1); gTex = vec2 (texPos*0.0078125, 0); EmitVertex(); - gl_Position = vec4 (cenPos.x + size*0.5, cenPos.y - size, cenPos.z , 1); + gl_Position = vec4 (cenPos.x + sizex*0.5, cenPos.y - sizey*0.5, cenPos.z , 1); //gl_Position = vec4 (0.5, 0.5 , -5 , 1); gTex = vec2 ((texPos+1)*0.0078125, 1); EmitVertex(); - gl_Position = vec4 (cenPos.x + size*0.5, cenPos.y + size, cenPos.z , 1); + gl_Position = vec4 (cenPos.x + sizex*0.5, cenPos.y + sizey*0.5, cenPos.z , 1); gTex = vec2 ((texPos+1)*0.0078125, 0); //gl_Position = vec4 (0.5, 0 , -5 , 1); EmitVertex(); diff --git a/shader/character.vert b/shader/character.vert index c9d3000e9..ca4366904 100644 --- a/shader/character.vert +++ b/shader/character.vert @@ -1,7 +1,7 @@ #version 430 core layout (location = 0) in vec3 aPos; layout (location = 1) in vec4 aColor; -layout (location = 2) in vec2 aTexCoord; +layout (location = 2) in vec3 aTexCoord; uniform vec2 winSize; uniform float zoom; @@ -10,7 +10,7 @@ uniform float rotation; uniform mat4 worldMat; out vec4 vColor; -out vec2 vTexCoord; +out vec3 vTexCoord; void main() { diff --git a/src/Dodge/Rendering.hs b/src/Dodge/Rendering.hs index 9b5e3b654..b0ac412f2 100644 --- a/src/Dodge/Rendering.hs +++ b/src/Dodge/Rendering.hs @@ -229,7 +229,7 @@ drawCursor w = setLayer 1 $ translate (105-halfWidth w) (halfHeight w - (25* (fromIntegral iPos)) - 20 ) - $ line [(200,12.5),(-100,12.5),(-100,-12.5),(200,-12.5)] + $ line [(100,12.5),(-100,12.5),(-100,-12.5),(100,-12.5)] where iPos = _crInvSel $ _creatures w IM.! _yourID w @@ -436,8 +436,8 @@ displayInv n w = pictures $ zipWith (translate (10-halfWidth w)) (map (\x-> halfHeight w-(25*(fromIntegral x+1))) ns) $ map dItem' is where (ns,is) = unzip $ IM.toList $ _crInv $ _creatures w IM.! n -dItem' NoItem = scale 0.15 0.15 $ dShadCol (greyN 0.5) $ text "----" -dItem' i = scale 0.15 0.15 $ pictures [dropShadow t, color (_itInvColor i) t] +dItem' NoItem = scale 0.1 0.1 $ dShadCol (greyN 0.5) $ text "----" +dItem' i = scale 0.1 0.1 $ pictures [dropShadow t, color (_itInvColor i) t] where t = text $ _itInvDisplay i i displayAmount :: Int -> String diff --git a/src/Picture.hs b/src/Picture.hs index 035387d04..2c1e4f2aa 100644 --- a/src/Picture.hs +++ b/src/Picture.hs @@ -112,7 +112,7 @@ scale3 a b (x,y,z) = (x*a,y*b,z) scale :: Float -> Float -> Picture -> Picture {-# INLINE scale #-} -scale x y pic = OverPic (scale3 x y) ((*) x) 0 id pic +scale x y pic = OverPic (scale3 x y) (\(a,b) ->(a*x,b*y)) 0 id pic rotate3 :: Float -> Point3 -> Point3 {-# INLINE rotate3 #-} diff --git a/src/Picture/Data.hs b/src/Picture/Data.hs index 028e5214a..bb115e66e 100644 --- a/src/Picture/Data.hs +++ b/src/Picture/Data.hs @@ -57,7 +57,7 @@ flat4 (x,y,z,w) = [x,y,z,w] data RenderType = RenderPoly [(Point3,Point4)] - | RenderText [(Point3,Point4,Point2)] + | RenderText [(Point3,Point4,Point3)] | RenderCirc (Point3,Point4,Float) | RenderArc (Point3,Point4,Point4) | RenderLine [(Point3,Point4)] @@ -71,7 +71,7 @@ data Picture | ThickArc Int Float Float Float Float | Line Int [Point2] | Pictures [Picture] - | OverPic (Point3 -> Point3) (Float -> Float) Float (Point4 -> Point4) Picture + | OverPic (Point3 -> Point3) (Point2 -> Point2) Float (Point4 -> Point4) Picture | OnLayer Int Picture diff --git a/src/Picture/Preload.hs b/src/Picture/Preload.hs index 21353d681..d7d4a7c21 100644 --- a/src/Picture/Preload.hs +++ b/src/Picture/Preload.hs @@ -143,14 +143,18 @@ preloadRender = do --textureBinding Texture2D $= Just chartex +-- input a list of (attribute location, attrib length) pairs +-- these will have buffers and pointers created trivao <- setupVAO [(0,3),(1,4)] linevao <- setupVAO [(0,3),(1,4)] - textvao <- setupVAO [(0,3),(1,4),(2,2)] + textvao <- setupVAO [(0,3),(1,4),(2,3)] circvao <- setupVAO [(0,3),(1,4),(2,1)] arcvao <- setupVAO [(0,3),(1,4),(2,4)] - backgroundvao <- setupVAO [(0,4),(1,2)] + backgroundvao + <- setupVAO [(0,4),(1,2)] wallvao <- setupVAO [(0,4),(1,4)] - fadecircvao <- setupVAO [(0,4)] + fadecircvao + <- setupVAO [(0,4)] return $ RenderData { -- _charMap = convertRGBA8 cmap diff --git a/src/Picture/Render.hs b/src/Picture/Render.hs index e7d1e8823..d68d4f1d5 100644 --- a/src/Picture/Render.hs +++ b/src/Picture/Render.hs @@ -6,9 +6,7 @@ import Control.Lens import Control.Monad import qualified Control.Applicative as Ap ---import Control.Monad.Trans.State --- --- + import Linear.Matrix import Linear.V4 @@ -20,7 +18,6 @@ import Picture.Data import Geometry import Picture.Preload ---import Control.Lens import Foreign hiding (rotate) @@ -57,9 +54,9 @@ tripSecond :: (b -> b') -> (a,b,c) -> (a,b',c) {-# INLINE tripSecond #-} tripSecond f (x,y,z) = (x,f y,z) -scaleT :: Float -> (Point3,Point4,Point2) -> (Point3,Point4,Point2) +scaleT :: (Float,Float) -> (Point3,Point4,Point3) -> (Point3,Point4,Point3) {-# INLINE scaleT #-} -scaleT x (a,b,(o,s)) = (a,b,(o,s*x)) +scaleT (x,y) (a,b,(o,s,t)) = (a,b,(o,s*x,t*y)) overPos :: (Point3 -> Point3) -> RenderType -> RenderType {-# INLINE overPos #-} @@ -82,14 +79,14 @@ overCol f (RenderText vs) = RenderText $ map (\(a,b,c) -> (a,f b,c)) vs overCol f (RenderCirc (a,b,c)) = RenderCirc (a,f b,c) overCol f (RenderArc (a,b,c)) = RenderArc (a,f b,c) -overSca :: (Float -> Float) -> RenderType -> RenderType +overSca :: (Point2 -> Point2) -> RenderType -> RenderType {-# INLINE overSca #-} -overSca f (RenderText vs) = RenderText $ map (scaleT (f 1)) vs +overSca f (RenderText vs) = RenderText $ map (scaleT (f (1,1))) vs overSca f p = p scaleRen,translateRen :: Float -> Float -> RenderType -> RenderType {-# INLINE scaleRen #-} -scaleRen x y (RenderText vs) = overPos (scale3 x y) $ RenderText $ map (scaleT x) vs +scaleRen x y (RenderText vs) = overPos (scale3 x y) $ RenderText $ map (scaleT (x,y)) vs scaleRen x y rt = overPos (scale3 x y) rt {-# INLINE translateRen #-} translateRen x y = overPos $ translate3 x y @@ -105,16 +102,18 @@ setDepthRen d = overPos $ \(x,y,_) -> (x,y,-d) colorRen :: RGBA -> RenderType -> RenderType colorRen c = overCol $ const c -stringToList :: String -> [(Point3,Point4,Point2)] +stringToList :: String -> [(Point3,Point4,Point3)] {-# INLINE stringToList #-} stringToList s = zipWith (\x (a,b,c) -> (translate3 x 0 a,b,c)) [0,0.9*dimText..] $ map charToTuple s - where dimText = 100 + --where dimText = 100 +dimText :: Float +dimText = 100 -charToTuple :: Char -> (Point3,Point4,Point2) +charToTuple :: Char -> (Point3,Point4,Point3) {-# INLINE charToTuple #-} -charToTuple c = ((0,0,0),white,(offset,100)) +charToTuple c = ((0,0,0),white,(offset,dimText,2*dimText)) where offset = fromIntegral (fromEnum c) - 32 picToAlt :: (Ap.Alternative f, Monoid (f RenderType)) => Int -> Picture -> f RenderType @@ -167,36 +166,6 @@ picToList x (Text i s) picToList j Blank = [] picToList j (Pictures pics) = concatMap (picToList j) pics --- picToFTree :: Int -> Picture -> FTree RenderType --- {-# INLINE picToFTree #-} --- picToFTree x (Polygon i ps) --- | i == x = FLeaf $ RenderPoly $ zip (map zeroZ $ polyToTris ps) $ repeat black --- | otherwise = FLeaf RenderBlank --- picToFTree x (PolygonCol i vs) --- | i /= x = FLeaf RenderBlank --- | otherwise = --- let (ps,cs) = unzip vs --- in FLeaf $ RenderPoly $ zip (map zeroZ $ polyToTris ps) $ polyToTris cs --- picToFTree x (Circle i r) --- | i == x = FLeaf $ RenderCirc $ ((0,0,0),black,r) --- | otherwise = FLeaf RenderBlank --- picToFTree x (ThickArc i startA endA rad wdth) --- | i == x = FLeaf $ RenderArc $ ((0,0,0),black,(startA,endA,rad,wdth)) --- | otherwise = FLeaf RenderBlank --- picToFTree x (Line i ps) --- | i == x = FLeaf $ RenderLine $ zip (map zeroZ $ doubleLine ps) $ repeat white --- | otherwise = FLeaf RenderBlank --- picToFTree x (Text i s) --- | i == x = FLeaf $ RenderText $ stringToList s --- | otherwise = FLeaf RenderBlank --- picToFTree j Blank = FLeaf RenderBlank --- picToFTree j (Scale x y pic) = collapseBranch (scaleRen x y) $ picToFTree j pic --- picToFTree j (Translate x y pic) = collapseBranch (translateRen x y) $ picToFTree j pic --- picToFTree j (Rotate a pic) = collapseBranch (rotateRen a) $ picToFTree j pic --- picToFTree j (SetDepth a pic) = collapseBranch (setDepthRen a) $ picToFTree j pic --- picToFTree j (Color c pic) = collapseBranch (colorRen c) $ picToFTree j pic --- picToFTree j (Pictures pics) = FBranches $ map (picToFTree j) pics - collapseBranch :: (RenderType -> RenderType) -> FTree RenderType -> FTree RenderType collapseBranch f (FBranch g t) = FBranch (f . g) t collapseBranch f (FBranches ts) = FBranches $ map (collapseBranch f) ts @@ -246,7 +215,6 @@ theFold :: TwoPtrs -> ThreePtrs -> F.FoldM IO RenderType (Int,Int,Int,Int,Int) theFold pas pbs pcs pds pes - -- = (,,,,) <$> pokeFold pas <*> pokeTextFold pbs <*> pokeCircFold pcs = (,,,,) <$> pokeTwoPtrsWith pokePoly pas <*> pokeThreePtrsWith pokeText pbs <*> pokeThreePtrsWith pokeCirc pcs @@ -327,14 +295,14 @@ pokeText :: (Ptr Float, Ptr Float, Ptr Float) -> Int -> RenderType -> IO Int pokeText (pa,pb,pc) n (RenderText vs) = foldM (pokeTextVert pa pb pc) n vs pokeText _ n _ = return n -pokeTextVert :: Ptr Float -> Ptr Float -> Ptr Float -> Int -> (Point3, Point4, Point2) -> IO Int +pokeTextVert :: Ptr Float -> Ptr Float -> Ptr Float -> Int -> (Point3, Point4, Point3) -> IO Int {-# INLINE pokeTextVert #-} pokeTextVert pa pb pc n (p,c,t) | n > 20000 * 2 = return n | otherwise = do pokeThreeOff pa n p pokeFourOff pb n c - pokeTwoOff pc n t + pokeThreeOff pc n t return (n+1) pokePoly :: TwoPtrs -> Int -> RenderType -> IO Int