Hi,
last few days I spent making remake of glxgears. Nothing
fancy, I just wanted easily configurable gears. The current
performance is only about 70% of glxgears.
But I have a problem with shading. Whatever I have been trying,
I still don't understand how the shading can be activated. I have
light, I have color, but not even Flat shading.
Please can you give me a hand?
Thanks,
Martin
PS: I didn't find any attachment size policy for this list, so I hope
that the attachment is small enough.
-
--
-- Copyright (c) 2008 Martin 'Trin' Kudlvasr
-- All rights reserved.
--
-- Redistribution and use in sourse and binary forms are permitted
-- provided that the above copyright notice and this paragraph are
-- duplicated in all such forms and that any documentation,
-- advertising materials, and other materials related to such
-- distribution and use acknowledge that the software was developed
-- by Martin Kudlvasr. The name of Martin Kudlvasr
-- may not be used to endorse or promote products derived from this
-- software without specific prior written permission.
-- THIS SOFTWARE IS PROVIDED 'AS IS' AND WITHOUT ANY EXPRESS OR
-- IMPLIED WARRANTIES, INCLUDING LIMITATION, THE IMPLIED
-- WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
--
---
-
--
-- Author -
-- Martin 'Trin' Kudlvasr
-- www.trinpad.eu
-- November, 2008
module Gear where
import Graphics.Rendering.OpenGL
import Data.List
data ToothDim = ToothDim { top :: GLfloat, -- width at the top of a tooth
bottom :: GLfloat, -- width at the base of a tooth
height :: GLfloat } -- height of the tooth
data Gear = Gear { bottomRadius, -- from center to tooth bottom corner
topRadius, -- from center to tooth top corner
bottomAngle, -- angle that tooth bottom line takes
topAngle, -- angle that tooth top line takes
betweenAngle, -- angle between top and bottom tooth line
innerRadius, -- inner circle of gear
thickness :: GLfloat, -- z axis thickness
gColor :: Color4 GLfloat
}
-- angles of gear contour points
angles gear = 0 : takeWhile (2*pi) [ sum $ take i as | i - [1..] ] ++ [0]
where
as = cycle $ map (\f - f gear) [ bottomAngle, betweenAngle, topAngle, betweenAngle ]
-- angle of 1 phase
toothAngle gear = sum $ map (\f - f gear) [bottomAngle, betweenAngle, topAngle, betweenAngle]
-- radius depends on teeth amount and dimensions. This is error with which radius is calculated
_MAX_ERROR = 0.001
calculateGearRadius toothDim teethCount =
calculateGearRadius' toothDim teethCount 1000 0.5
calculateGearRadius' toothDim targetTeeth tmpRadius factor =
case countTeeth top bottom newRadius of
tmpTeeth
| tmpTeeth targetTeeth + _MAX_ERROR - calculateGearRadius' toothDim targetTeeth newRadius factor
| tmpTeeth targetTeeth - calculateGearRadius' toothDim targetTeeth tmpRadius (factor/2)
| otherwise - newRadius
where
ToothDim top bottom height = toothDim
newRadius = tmpRadius*(1-factor)
countTeeth top bottom radius =
pi / ( asin (top / (2*radius)) + asin(bottom / (2*radius) ) )
newTeethCountGear toothDim teethCount innerR thickness c =
Gear bottomR topR bottomA topA betweenA innerR thickness c
where
bottomR = calculateGearRadius toothDim teethCount
topR= sqrt ( (bottomR*bottomR) - (bottom*bottom/4) ) + height
ToothDim top bottom height = toothDim
bottomA = 2 * asin (top / (2*bottomR))
topA= 2 * asin (top / (2*(bottomR+height)))
totalA = 2 * pi / teethCount
betweenA= (totalA - topA - bottomA) / 2
newGear = newTeethCountGear
newMinimumRadiusGear toothDim minRadius innerR thickness c =
newGear toothDim (fromIntegral teethCount + 1) innerR thickness c
where
ToothDim top bottom height = toothDim
toothA = 2 * ( asin (top / (2*minRadius)) + asin (bottom / (2*minRadius)) )
(teethCount, _) = properFraction ( 2 * pi / toothA )
gearContourPoints gear =
zipWith3 zipF [0,1..] inCircle outCircle
where
zipF i inP outP | i `mod` 4 == 0 = inP
| i `mod` 4 == 1 = inP
| otherwise = outP
inCircle = angleCirclePoints as $ bottomRadius gear
outCircle = angleCirclePoints as $ topRadiusgear
as = angles gear
gearFacePoints gear =
concat $ zipWith (\x y - [x,y]) contourPs innerPs
where
contourPs = gearContourPoints gear
innerPs = angleCirclePoints (angles gear) (innerRadius gear)
setZ ps newZ
