module HFoil.Drawing
( drawSolution
, drawFoil
, drawNormals
, drawForces
, drawKuttas
, drawOnce
) where
import Numeric.LinearAlgebra hiding( Element, scale, i )
import Foreign.Storable ( Storable )
import qualified Numeric.LinearAlgebra as LA
import Text.Printf ( printf )
import Linear ( V3(..) )
import Vis
import HFoil.Flow
import HFoil.Foil
cpScale :: Fractional a => a
cpScale = 0.25
normalLengths :: Fractional a => a
normalLengths = 0.01
drawLine :: Num a => Color -> [(a,a)] -> VisObject a
drawLine col coords = Line (map (\(x,y) -> V3 x y 0) coords) col
drawCircle :: Num a => Color -> (a, a) -> a -> VisObject a
drawCircle col (x,y) size = Trans (V3 x y 0) $ Sphere size Solid col
drawLineV :: (Num a, Storable a) => Color -> (Vector a, Vector a) -> VisObject a
drawLineV col (vx, vy) = Line (zipWith (\x y -> V3 x y 0) (toList vx) (toList vy)) col
drawFoil :: (Num a, Storable a) => Foil a -> VisObject a
drawFoil (Foil elements _) = VisObjects $ map drawElement elements
drawElement :: (Num a, Storable a) => Element a -> VisObject a
drawElement element = drawLineV white (fNodes element)
drawNormals :: Foil Double -> VisObject Double
drawNormals (Foil elements _) = VisObjects $ map (\(xy0, xy1) -> drawLine green [xy0, xy1]) (zip xy0s xy1s)
where
xy0s = zip (toList xm) (toList ym)
xy1s = zip (toList (xm + (LA.scale normalLengths xUnitNormal))) (toList (ym + (LA.scale normalLengths yUnitNormal)))
(xUnitNormal, yUnitNormal) = (\(x,y) -> (vjoin x, vjoin y)) $ unzip $ map fUnitNormals elements
(xm, ym) = (\(x,y) -> (vjoin x, vjoin y)) $ unzip $ map fMidpoints elements
colorFun :: (Fractional a, Real a) => a -> a -> a -> Color
colorFun min' max' x' = makeColor (1x) (1x) x 1
where
x = realToFrac $ (x' min') / (max'min')
drawKuttas :: (Real a, Fractional a, Storable a) => FlowSol a -> VisObject a
drawKuttas flow = VisObjects $ concatMap (\(k0,k1) -> [circ k0, circ k1]) kis
where
kis = solKuttaIndices flow
(xs',ys') = unzip $ map fMidpoints $ (\(Foil els _) -> els) (solFoil flow)
xs = vjoin xs'
ys = vjoin ys'
circ k = drawCircle yellow (xs @> k, ys @> k) 0.006
drawForces :: FlowSol Double -> VisObject Double
drawForces flow = VisObjects $ map (\(xy0, xy1, cp) -> drawLine (colorFun minCp maxCp cp) [xy0, xy1])
$ zip3 xy0s xy1s (toList (solCps flow))
where
xy0s = zip (toList xm) (toList ym)
xy1s = zip (toList (xm + xPressures)) (toList (ym + yPressures))
(xPressures, yPressures) = (\(x,y) -> (LA.scale c x/lengths, LA.scale c y/lengths)) (solForces flow)
lengths = vjoin $ map fLengths $ (\(Foil x _) -> x) $ solFoil flow
(xm, ym) = (\(x,y) -> (vjoin x, vjoin y)) $ unzip $ map fMidpoints $ (\(Foil x _) -> x) $ solFoil flow
c = 0.1
maxCp = maxElement (solCps flow)
minCp = minElement (solCps flow)
drawColoredFoil :: (Num a, Storable a) => [Color] -> Foil a -> VisObject a
drawColoredFoil colors foil@(Foil elements _) = VisObjects $ zipWith drawColoredElement colors' elements
where
colors' = groupSomethingByFoil foil colors
drawColoredElement :: (Num a, Storable a) => [Color] -> Element a -> VisObject a
drawColoredElement colors element = VisObjects $ map (\(xy0, xy1, col) -> drawLine col [xy0, xy1]) (zip3 xy0s xy1s colors)
where
xys = (\(x,y) -> zip (toList x) (toList y)) $ fNodes element
xy0s = tail xys
xy1s = init xys
groupSomethingByFoil :: Storable a => Foil a -> [b] -> [[b]]
groupSomethingByFoil (Foil elements _) somethings = f somethings (map (LA.dim . fAngles) elements)
where
f xs (n:ns) = (take n xs):(f (drop n xs) ns)
f [] []= []
f _ _ = error "uh oh (groupSomethingByFoil)"
drawSolution :: FlowSol Double -> VisObject Double
drawSolution flow = VisObjects $ onscreenText ++
[ drawColoredFoil colors foil
, drawCircle white (fst $ solCenterPressure flow, snd $ solCenterPressure flow) 0.006
, drawCircle white (fst $ solCenterPressure flow, 0) 0.006
, drawCircle green (0.25,0) 0.006
] ++ zipWith (\x y -> drawLineV red (x, y)) xs
(takesV (map LA.dim xs) (LA.scale cpScale cps))
where
foil@(Foil elements name) = solFoil flow
cps = solCps flow
xs = map (fst . fMidpoints) elements
onscreenText =
zipWith (\s k -> Text2d s (30,fromIntegral $ 30*k) Fixed9By15 (makeColor 1 1 1 1))
msgs (reverse [1..length msgs])
msgs = [ name
, printf ("alpha: %.6f deg") ((solAlpha flow)*180/pi)
, printf ("Cl: %.6f") (solCl flow)
, printf ("Cd: %.6f") (solCd flow)
, printf ("Cm: %.6f (c/4, 0)") (solCm flow)
]
colors = map (colorFun (minElement cps) (maxElement cps)) (toList cps)
drawOnce :: Real a => [VisObject a] -> IO ()
drawOnce pics = display (defaultOpts {optWindowName = "hfoil"}) (VisObjects pics)