Correct text scaling

This commit is contained in:
jgk
2021-03-07 23:34:37 +01:00
parent 80a38eca58
commit f92075263f
7 changed files with 36 additions and 63 deletions
+7 -6
View File
@@ -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();
+2 -2
View File
@@ -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()
{
+3 -3
View File
@@ -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
+1 -1
View File
@@ -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 #-}
+2 -2
View File
@@ -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
+7 -3
View File
@@ -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
+14 -46
View File
@@ -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