diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,27 @@ +Copyright (c) 2016, Commonwealth Scientific and Industrial Research Organisation +(CSIRO) ABN 41 687 119 230. + +Redistribution and use in source and binary forms, with or without modification, +are permitted provided that the following conditions are met: + +1. Redistributions of source code must retain the above copyright notice, this +list of conditions, the following disclaimer and the following SHA-512 checksum. + +2. Redistributions in binary form must reproduce the above copyright notice, +this list of conditions, the following disclaimer and the following SHA-512 +checksum in the documentation and/or other materials provided with the +distribution. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND +ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED +WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE +DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR +ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES +(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; +LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON +ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS +SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + +THIS SOFTWARE IS PROVIDED WITH A SHA-512 CHECKSUM. +5b4a5a17d1f3cde6efd7a4e2b2a461a1204877b460b0e047f269de455eec649a81bcf81b23a491ec91926228efbfbfcc0fe340fca7e969fc622b653d7122dafd diff --git a/Setup.lhs b/Setup.lhs new file mode 100644 --- /dev/null +++ b/Setup.lhs @@ -0,0 +1,44 @@ +#!/usr/bin/env runhaskell +\begin{code} +{-# OPTIONS_GHC -Wall #-} +module Main (main) where + +import Data.List ( nub ) +import Data.Version ( showVersion ) +import Distribution.Package ( PackageName(PackageName), PackageId, InstalledPackageId, packageVersion, packageName ) +import Distribution.PackageDescription ( PackageDescription(), TestSuite(..) ) +import Distribution.Simple ( defaultMainWithHooks, UserHooks(..), simpleUserHooks ) +import Distribution.Simple.Utils ( rewriteFile, createDirectoryIfMissingVerbose ) +import Distribution.Simple.BuildPaths ( autogenModulesDir ) +import Distribution.Simple.Setup ( BuildFlags(buildVerbosity), fromFlag ) +import Distribution.Simple.LocalBuildInfo ( withLibLBI, withTestLBI, LocalBuildInfo(), ComponentLocalBuildInfo(componentPackageDeps) ) +import Distribution.Verbosity ( Verbosity ) +import System.FilePath ( () ) + +main :: IO () +main = defaultMainWithHooks simpleUserHooks + { buildHook = \pkg lbi hooks flags -> do + generateBuildModule (fromFlag (buildVerbosity flags)) pkg lbi + buildHook simpleUserHooks pkg lbi hooks flags + } + +generateBuildModule :: Verbosity -> PackageDescription -> LocalBuildInfo -> IO () +generateBuildModule verbosity pkg lbi = do + let dir = autogenModulesDir lbi + createDirectoryIfMissingVerbose verbosity True dir + withLibLBI pkg lbi $ \_ libcfg -> do + withTestLBI pkg lbi $ \suite suitecfg -> do + rewriteFile (dir "Build_" ++ testName suite ++ ".hs") $ unlines + [ "module Build_" ++ testName suite ++ " where" + , "deps :: [String]" + , "deps = " ++ (show $ formatdeps (testDeps libcfg suitecfg)) + ] + where + formatdeps = map (formatone . snd) + formatone p = case packageName p of + PackageName n -> n ++ "-" ++ showVersion (packageVersion p) + +testDeps :: ComponentLocalBuildInfo -> ComponentLocalBuildInfo -> [(InstalledPackageId, PackageId)] +testDeps xs ys = nub $ componentPackageDeps xs ++ componentPackageDeps ys + +\end{code} diff --git a/aviation-cessna172-diagrams.cabal b/aviation-cessna172-diagrams.cabal new file mode 100644 --- /dev/null +++ b/aviation-cessna172-diagrams.cabal @@ -0,0 +1,84 @@ +name: aviation-cessna172-diagrams +version: 0.0.1 +license: OtherLicense +license-file: LICENSE +author: Tony Morris <ʇǝu˙sıɹɹoɯʇ@ןןǝʞsɐɥ>, Joshua Morris <ɯoɔ˙lᴉɐɯƃ@llǝʞsɐɥ+sᴉɹɹoɯuɥoɾɐnɥsoɾ> +maintainer: Tony Morris, Joshua Morris +copyright: Copyright (c) 2016, Commonwealth Scientific and Industrial Research Organisation (CSIRO) ABN 41 687 119 230. +synopsis: Diagrams for the Cessna 172 aircraft in aviation. +category: Aviation +description: + <> + . + Diagrams for the Cessna 172 aircraft in aviation. + +homepage: https://github.com/data61/aviation-cessna172-diagrams +bug-reports: https://github.com/data61/aviation-cessna172-diagrams/issues +cabal-version: >= 1.10 +build-type: Custom +extra-source-files: changelog + +source-repository head + type: git + location: git@github.com:data61/aviation-cessna172-diagrams.git + +flag small_base + description: Choose the new, split-up base package. + +library + default-language: + Haskell2010 + + build-depends: + base >= 4.8 && < 5 + , lens >= 4.15 && < 5 + , aviation-units >= 0.0.1 && < 1 + , aviation-weight-balance >= 0.0.1 && < 1 + , aviation-cessna172-weight-balance >= 0.0.1 && < 1 + , diagrams-cairo >= 1.4 && < 2 + , diagrams-core >= 1.4 && < 2 + , diagrams-lib >= 1.4 && < 2 + , mtl >= 2.2 && < 3 + , plots >= 0.1 && < 1 + , hgeometry >= 0.5.1.0 && < 0.6 + , colour >= 2.3 && < 3 + + ghc-options: + -Wall + + default-extensions: + + NoImplicitPrelude + + hs-source-dirs: + src + + exposed-modules: + Data.Aviation.C172.Diagrams + +test-suite doctests + type: + exitcode-stdio-1.0 + + main-is: + doctests.hs + + default-language: + Haskell2010 + + build-depends: + base < 5 && >= 3 + , doctest >= 0.9.7 + , filepath >= 1.3 + , directory >= 1.1 + , QuickCheck >= 2.0 + , template-haskell >= 2.8 + , parsec >= 3.1 + , quickcheck-text + + ghc-options: + -Wall + -threaded + + hs-source-dirs: + test diff --git a/changelog b/changelog new file mode 100644 --- /dev/null +++ b/changelog @@ -0,0 +1,4 @@ +0.0.1 + +* Initial release + diff --git a/src/Data/Aviation/C172/Diagrams.hs b/src/Data/Aviation/C172/Diagrams.hs new file mode 100644 --- /dev/null +++ b/src/Data/Aviation/C172/Diagrams.hs @@ -0,0 +1,372 @@ +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleContexts #-} + +module Data.Aviation.C172.Diagrams( + dejavuSansMono +, polygonPoint +, plotgrid +, plotlines +, plotenvelope +, crosshair +, textreportDiagram +, plotMomentDiagram +, titleDiagram +, momentDiagram +, zfwMomentPoint +, ffwMomentPoint +, ufwMomentPoint +, makepoly +, c172sNormalCategoryPoly +, c172sUtilityCategoryPoly +, totalMomentPoundInchesPoint +, baggageaPoundsLimit +, baggagebPoundsLimit +, baggagetotalPoundsLimit +, totalWeightsPounds +, mtowLimit +, mrwLimit +, renderMomentDiagram +, renderMomentDiagrams +) where + +import Control.Applicative((<*>)) +import Control.Category((.)) +import Control.Lens(view, preview, review, over, both, _head, snoc, re, (&~), (.=), (*=), (%=), (.~), (&), (%~)) +import Control.Monad.State(State) +import Data.Aviation.C172.WB.C172Arms +import Data.Aviation.C172.WB.C172AircraftArms +import Data.Aviation.C172.WB.C172MomentEnvelope +import Data.Aviation.Units +import Data.Aviation.WB.Moment +import Data.Aviation.WB.Weight +import Data.Bool(Bool(True, False)) +import Data.CircularSeq(CSeq) +import Data.Colour(Colour) +import Data.Ext(ext, _core) +import Data.Foldable(Foldable, toList, mapM_) +import Data.Function(($)) +import Data.Functor(fmap) +import Data.Geometry.Boundary(PointLocationResult(Inside, Outside, OnBoundary)) +import Data.Geometry.Point(Point, point2, _point2, xCoord, yCoord) +import Data.Geometry.Polygon(SimplePolygon, Polygon, inPolygon, fromPoints, outerBoundary) +import Data.Maybe(Maybe(Just), maybe) +import Data.Monoid(Any) +import Data.Semigroup((<>)) +import Data.String(String) +import Data.Tuple(fst, uncurry) +import Diagrams.Attributes(lwO, _lw) +import Diagrams.Backend.Cairo(Cairo(Cairo), OutputType(PNG, PDF, PS, SVG)) +import Diagrams.Backend.Cairo.Internal(Options(CairoOptions)) +import Diagrams.Prelude(V2, black, red, green, blue, lightgrey, darkgrey, darkmagenta, local, _fontSize, rotateBy, (#), fc) +import Diagrams.Combinators(sep) +import Diagrams.Core.Compile(renderDia) +import Diagrams.Core.Measure(Measure) +import Diagrams.Core.Style(HasStyle) +import Diagrams.Core.Types(QDiagram, Renderable) +import Diagrams.Path(Path) +import Diagrams.Size(SizeSpec) +import Diagrams.TwoD.Align(centerX) +import Diagrams.TwoD.Attributes(lc) +import Diagrams.TwoD.Combinators(vcat') +import Diagrams.TwoD.Text(Text, alignedText, fontSizeL, font) +import Diagrams.Util(with) +import Diagrams.TwoD.Text(TextAlignment(BoxAlignedText)) +import Plots(Axis, r2Axis, linePlot, plotColor, xLabel, yLabel, xMin, yMin, xMax, yMax, xAxis, yAxis, + axisLabelPosition, (&=), AxisLabelPosition(MiddleAxisLabel), axisLabelStyle, tickLabelStyle, scaleAspectRatio, + minorGridLines, visible, axisLabelGap, axisLabelTextFunction, minorTicksHelper, minorTicksFunction, majorTicksStyle, + majorGridLinesStyle, minorGridLinesStyle, lineStyle, majorTicksFunction, atMajorTicks, tickLabelFunction) +import Plots.Axis.Render(renderAxis) +import Prelude(Rational, Double, Int, Fractional((/)), fromRational, (*), (+), (-), show, round, subtract) +import System.IO(IO) +import Text.Printf(printf) + +dejavuSansMono :: + HasStyle a => + a + -> a +dejavuSansMono = + font "DejaVu Sans Mono" + +polygonPoint :: + Fractional b => + Polygon t extra Rational -> + CSeq (b, b) +polygonPoint = + fmap (over both fromRational . _point2 . _core) . view outerBoundary + +plotgrid :: + State (Axis b V2 Double) () +plotgrid = + do xLabel .= "Loaded Airplane Moment/1000 (Pounds - Inches)" + yLabel .= "Loaded Airplane Weight (Pounds)" + + xMin .= Just 50 + yMin .= Just 1460 + + xMax .= Just 130 + yMax .= Just 2600 + + xAxis &= do + scaleAspectRatio .= Just 11 + majorTicksFunction .= \_ -> [50, 60..130] + + yAxis &= do + axisLabelTextFunction %= \f _ s -> f (BoxAlignedText 0.5 0.5) s # rotateBy (1/4) + axisLabelGap *= 2 + majorTicksFunction .= \_ -> [1500, 1600..2600] + + axisLabelStyle . _fontSize .= local 8.5 + tickLabelStyle . _fontSize .= local 8.5 + axisLabelPosition .= MiddleAxisLabel + minorTicksFunction .= minorTicksHelper 10 + majorTicksStyle %= lwO 1.6 + minorGridLinesStyle %= lwO 0.3 + minorGridLinesStyle %= lc lightgrey + majorGridLinesStyle %= lwO 0.8 + majorGridLinesStyle %= lc darkgrey + tickLabelFunction .= atMajorTicks (show . (round :: Double -> Int)) + minorGridLines . visible .= True + +plotlines :: + Renderable (Path V2 Double) b => + Colour Double + -> Measure Double + -> [(Point 2 Rational, Point 2 Rational)] + -> State (Axis b V2 Double) () +plotlines c w = + mapM_ (\(a, b) -> + fmap (over both fromRational) [_point2 a, _point2 b] `linePlot` + do plotColor .= c + lineStyle . _lw .= w) + +plotenvelope :: + (Renderable (Path V2 Double) b) => + [SimplePolygon () Rational] + -> State (Axis b V2 Double) () +plotenvelope = + let snochead = + maybe <*> snoc <*> preview _head + linePlotPolygon x c l = (linePlot . snochead . toList . polygonPoint $ x) $ + do plotColor .= c + lineStyle . _lw .= l + in mapM_ (\g -> linePlotPolygon g black 0.7) + +crosshair :: + Rational + -> Rational + -> Point 2 Rational + -> [(Point 2 Rational, Point 2 Rational)] +crosshair a b pq = + [ + (pq & yCoord %~ (subtract a), pq & yCoord %~ (+ a)) + , (pq & xCoord %~ (subtract b), pq & xCoord %~ (+ b)) + ] + +textreportDiagram :: + Renderable (Text Double) b => + C172AircraftArms Moment + -> QDiagram b V2 Double Any +textreportDiagram m = + let pq = + totalMomentPoundInchesPoint m + (p, q) = + _point2 pq + (zfwp, zfwq) = + _point2 (zfwMomentPoint m) + (ufwp, ufwq) = + _point2 (ufwMomentPoint m) + (ffwp, ffwq) = + _point2 (ffwMomentPoint m) + textRational r = + printf "%.2f" (fromRational r :: Double) + utility = + pq `inPolygon` c172sUtilityCategoryPoly + normal = + pq `inPolygon` c172sNormalCategoryPoly + textPointLocationResult Inside = + "YES" + textPointLocationResult Outside = + "NO" + textPointLocationResult OnBoundary = + "NO" + baggageaL = + textRational (baggageaPoundsLimit m) + baggagebL = + textRational (baggagebPoundsLimit m) + baggagetotalL = + textRational (baggagetotalPoundsLimit m) + mtowL = + textRational (mtowLimit m) + mrwL = + textRational (mrwLimit m) + reporttext a b x c = + alignedText a b x # fontSizeL 5 # dejavuSansMono # fc c + in vcat' (with & sep .~ 15) + [ + reporttext (0.650) (-02.80) ("All Up Moment " <> textRational (p * 1000) <> " lb/in") red + , reporttext (0.725) (-03.80) ("All Up Weight " <> textRational q <> " lb") red + , reporttext (0.890) (-04.80) ("Utility Category " <> textPointLocationResult utility) red + , reporttext (0.865) (-05.80) ("Normal Category " <> textPointLocationResult normal) red + , reporttext (0.663) (-06.80) ("Zero Fuel Moment " <> textRational (zfwp * 1000) <> " lb/in") green + , reporttext (0.725) (-07.80) ("Zero Fuel Weight " <> textRational zfwq <> " lb") green + , reporttext (0.663) (-08.80) ("Usable Fuel Moment " <> textRational (ufwp * 1000) <> " lb/in") blue + , reporttext (0.724) (-09.80) ("Usable Fuel Weight " <> textRational ufwq <> " lb") blue + , reporttext (0.650) (-10.80) ("Fuel at Capacity Moment " <> textRational (ffwp * 1000) <> " lb/in") green + , reporttext (0.726) (-11.80) ("Fuel at Capacity Weight " <> textRational ffwq <> " lb") green + , reporttext (0.742) (-12.80) ("Baggage A limit " <> baggageaL <> " lb") darkmagenta + , reporttext (0.742) (-13.80) ("Baggage B limit " <> baggagebL <> " lb") darkmagenta + , reporttext (0.742) (-14.80) ("Baggage total limit " <> baggagetotalL <> " lb") darkmagenta + , reporttext (0.724) (-15.80) ("MTOW limit " <> mtowL <> " lb") darkmagenta + , reporttext (0.724) (-16.80) ("MRW limit " <> mrwL <> " lb") darkmagenta + ] + +plotMomentDiagram :: + (Renderable (Text Double) b, Renderable (Path V2 Double) b) => + C172AircraftArms Moment + -> QDiagram b V2 Double Any +plotMomentDiagram m = + let auwMomentPlot = crosshair 40 4 (totalMomentPoundInchesPoint m) + ufwMomentPlot = crosshair 20 2 (ufwMomentPoint m) + fl = (zfwMomentPoint m, ffwMomentPoint m) + r = r2Axis &~ + do plotgrid + plotenvelope [c172sUtilityCategoryPoly, c172sNormalCategoryPoly] + plotlines red 1.5 auwMomentPlot + plotlines blue 1.0 ufwMomentPlot + plotlines green 1.5 [fl] + in renderAxis r # centerX # dejavuSansMono + +titleDiagram :: + Renderable (Text Double) b => + String + -> QDiagram b V2 Double Any +titleDiagram s = + alignedText 0.5 (-15) s # fontSizeL 5 # dejavuSansMono # fc black + +momentDiagram :: + (Renderable (Text Double) b, Renderable (Path V2 Double) b) => + String + -> C172AircraftArms Moment + -> QDiagram b V2 Double Any +momentDiagram s m = + vcat' (with & sep .~ 10) + [ + plotMomentDiagram m + , textreportDiagram m + , titleDiagram s + ] + +zfwMomentPoint :: + C172AircraftArms Moment + -> Point 2 Rational +zfwMomentPoint = + totalMomentPoundInchesPoint . zfwMoment + +ffwMomentPoint :: + C172AircraftArms Moment + -> Point 2 Rational +ffwMomentPoint = + totalMomentPoundInchesPoint . ffwMoment + +ufwMomentPoint :: + C172AircraftArms Moment + -> Point 2 Rational +ufwMomentPoint = + totalMomentPoundInchesPoint . ufwMoment + +makepoly :: + [(r, r)] + -> SimplePolygon () r +makepoly = + fromPoints . fmap (ext . uncurry point2) + +c172sNormalCategoryPoly :: + SimplePolygon () Rational +c172sNormalCategoryPoly = + makepoly c172sNormalCategory + +c172sUtilityCategoryPoly :: + SimplePolygon () Rational +c172sUtilityCategoryPoly = + makepoly c172UtilityCategory + +totalMomentPoundInchesPoint :: + (HasMoment moment, Foldable f) => + f moment + -> Point 2 Rational +totalMomentPoundInchesPoint x = + let mm = totalMoments pounds inches x + ww = totalWeights x + in point2 (mm / 1000) (review pounds ww) + +baggageaPounds :: + C172AircraftArms Moment + -> Rational +baggageaPounds m = + view (baggagea . weight . re pounds) m + +baggagebPounds :: + C172AircraftArms Moment + -> Rational +baggagebPounds m = + view (baggageb . weight . re pounds) m + +baggageaPoundsLimit :: + C172AircraftArms Moment + -> Rational +baggageaPoundsLimit m = + baggageaPounds m - 120 + +baggagebPoundsLimit :: + C172AircraftArms Moment + -> Rational +baggagebPoundsLimit m = + baggagebPounds m - 50 + +baggagetotalPoundsLimit :: + C172AircraftArms Moment + -> Rational +baggagetotalPoundsLimit m = + (baggageaPounds m + baggagebPounds m) - 120 + +totalWeightsPounds :: + C172AircraftArms Moment + -> Rational +totalWeightsPounds = + view (re pounds) . totalWeights + +mtowLimit :: + C172AircraftArms Moment + -> Rational +mtowLimit m = + totalWeightsPounds m - 2550 + +mrwLimit :: + C172AircraftArms Moment + -> Rational +mrwLimit m = + totalWeightsPounds m - 2558 + +renderMomentDiagram :: + String -- ^ diagram title + -> C172AircraftArms Moment + -> SizeSpec V2 Double -- ^ diagram size + -> OutputType -- ^ diagram output type + -> String -- ^ diagram output file + -> IO () +renderMomentDiagram l m z t f = + let momd = momentDiagram l m + in fst (renderDia Cairo (CairoOptions f z t False) momd) + +renderMomentDiagrams :: + String -- ^ diagram title + -> C172AircraftArms Moment + -> SizeSpec V2 Double -- ^ diagram size + -> String -- ^ diagram output file, without file extension + -> IO () +renderMomentDiagrams l m z f = + mapM_ + (\(e, t) -> renderMomentDiagram l m z t (f <> ('.' : e))) + [("png", PNG), ("ps", PS), ("pdf", PDF), ("svg", SVG)] diff --git a/test/doctests.hs b/test/doctests.hs new file mode 100644 --- /dev/null +++ b/test/doctests.hs @@ -0,0 +1,32 @@ +module Main where + +import Build_doctests (deps) +import Control.Applicative +import Control.Monad +import Data.List +import System.Directory +import System.FilePath +import Test.DocTest + +main :: + IO () +main = + getSources >>= \sources -> doctest $ + "-isrc" + : "-idist/build/autogen" + : "-optP-include" + : "-optPdist/build/autogen/cabal_macros.h" + : "-hide-all-packages" + : map ("-package="++) deps ++ sources + +getSources :: IO [FilePath] +getSources = filter (isSuffixOf ".hs") <$> go "src" + where + go dir = do + (dirs, files) <- getFilesAndDirectories dir + (files ++) . concat <$> mapM go dirs + +getFilesAndDirectories :: FilePath -> IO ([FilePath], [FilePath]) +getFilesAndDirectories dir = do + c <- map (dir ) . filter (`notElem` ["..", "."]) <$> getDirectoryContents dir + (,) <$> filterM doesDirectoryExist c <*> filterM doesFileExist c