learn-physics 0.4.2 → 0.4.3

raw patch · 6 files changed

+81/−178 lines, 6 filesdep +glossPVP ok

version bump matches the API change (PVP)

Dependencies added: gloss

API changes (from Hackage documentation)

Files

• learn-physics.cabal +3/−1
• src/Physics/Learn/Visual/GlossTools.hs +63/−0
• src/Physics/Learn/Visual/PlotTools.hs +15/−0
• src/examples/BCircularLoop.hs +0/−27
• src/examples/LorentzForceSimulation.hs +0/−64
• src/examples/sunEarthRK4.hs +0/−86

@@ -1,5 +1,5 @@ Name:                learn-physics-Version:             0.4.2+Version:             0.4.3 Synopsis:            Haskell code for learning physics Description:         A library of functions for vector calculus,                      calculation of electric field, electric flux,@@ -33,10 +33,12 @@                        Physics.Learn                        Physics.Learn.Visual.PlotTools                        Physics.Learn.Visual.VisTools+                       Physics.Learn.Visual.GlossTools   Build-depends:       base >= 4.2 && < 4.8,                        vector-space >= 0.8.4 && < 0.9,                        not-gloss >= 0.5.0.4 && < 0.6,                        spatial-math >= 0.1.7 && < 0.2,+                       gloss >= 1.8 && < 1.9,                        gnuplot >= 0.5 && < 0.6   Hs-source-dirs:      src 

@@ -0,0 +1,63 @@+{-# OPTIONS_GHC -Wall #-}++-- | Some tools related to the gloss 2D graphics and animation library.++module Physics.Learn.Visual.GlossTools+    ( polarToCart+    , cartToPolar+    , arrow+    , thickArrow+    )+    where++import Graphics.Gloss+import Graphics.Gloss.Geometry.Angle++-- positive x is to the right in Translate+-- positive y is up           in Translate (this is good)++basicArrow100 :: Picture+basicArrow100 = Pictures [Line [(0,0),(100,0)],Polygon [(75,5),(100,0),(75,-5)]]++-- | assumes radians coming in+polarToCart :: (Float,Float) -> (Float,Float)+polarToCart (r,theta) = (r * cos theta,r * sin theta)++-- | theta=0 is positive x axis,+--   output angle in radians+cartToPolar :: (Float,Float) -> (Float,Float)+cartToPolar (x,y) = (sqrt (x**2+y**2),atan2 y x)++-- | An arrow+arrow :: Point -- ^ location of base of arrow+      -> Point -- ^ displacement vector+      -> Picture+arrow (x,y) val = Translate x y $ originArrow val++-- | Rotate takes its angle in degrees, and rotates clockwise.+originArrow :: Point  -- ^ displacement vector+            -> Picture+originArrow (x,y)+    = Rotate (-radToDeg theta) $ Scale (r/100) (r/100) basicArrow100+      where+        (r,theta) = cartToPolar (x,y)++basicThickArrow :: Float -> Float -> Float -> Float -> Picture+basicThickArrow l w headLength headWidth+    = Pictures [Polygon [(0,w/2),(l-hl,w/2),(l-hl,-w/2),(0,-w/2)]+               ,Polygon [(l-hl,hw/2),(l,0),(l-hl,-hw/2)]+               ]+    where+      hl = min l headLength+      hw = max w headWidth++-- | A think arrow+thickArrow :: Float -- ^ arrow thickness+           -> Point -- ^ location of base of arrow+           -> Point -- ^ displacement vector+           -> Picture+thickArrow t (x,y) disp+    = Translate x y $ Rotate (-radToDeg theta) $ basicThickArrow r t (r/4) (2*t)+      where+        (r,theta) = cartToPolar disp+

@@ -16,13 +16,21 @@     , psFile     , examplePlot1     , examplePlot2+    , plotXYCurve     )     where  import Graphics.Gnuplot.Simple     ( Attribute(..)     , plotFunc+    , plotPath     )+import Physics.Learn.Curve+    ( Curve(..)+    )+import Physics.Learn.Position+    ( cartesianCoordinates+    )  -- | An 'Attribute' with a given label at a given position. label :: String -> (Double,Double) -> Attribute@@ -55,3 +63,10 @@                         ,psFile "post1.ps"                         ] [0,0.01..10::Double] cos +-- | Plot a Curve in the xy plane using Gnuplot+plotXYCurve :: Curve -> IO ()+plotXYCurve (Curve f a b)+    = plotPath [] [(x,y) | t <- [a,a+dt..b]+                  , let (x,y,_) = cartesianCoordinates (f t)]+      where+        dt = (b-a)/1000

@@ -1,27 +0,0 @@-{-# OPTIONS_GHC -Wall #-}--module Main where--import Physics.Learn-import Vis--loopCurve :: Curve-loopCurve = Curve (\phi -> cyl 1 phi 0) 0 (2*pi)--loop :: CurrentDistribution-loop = LineCurrent 20 loopCurve--samplePoints :: [Position]-samplePoints = [cyl s phi z |-                 s   <- [0.25,0.75..1.75]-               , phi <- [pi/6,pi/2..2*pi]-               , z   <- [-1.5,-1..1.5]]--arrows :: VisObject Double-arrows = displayVectorField blue 5e-5 samplePoints (bField loop)--drawFun :: VisObject Double-drawFun = VisObjects [curveObject red loopCurve, arrows]--main :: IO ()-main = display Nothing "Magnetic Field from a Current Loop" drawFun

@@ -1,64 +0,0 @@-{-# OPTIONS_GHC -Wall #-}--module Main where--import Physics.Learn-import Vis-import SpatialMath-    ( Euler(..)-    )--drawFunction :: SimpleState -> VisObject Double-drawFunction (_t,r,_v)-    = RotEulerDeg (Euler 270 0 0) $ RotEulerDeg (Euler 0 180 0) $-      VisObjects [ Axes (0.5, 15)-                 , Trans (xyzFromPos r) (Sphere 0.1 Solid red)-                 ]--statePropagationFunction :: Float -> SimpleState -> SimpleState-statePropagationFunction t' (t,r,v) = rungeKutta4 newton2 (realToFrac t' - t) (t,r,v)---- Newton's Second Law-newton2 :: SimpleState -> Diff SimpleState-newton2 (t,r,v) = (1,v,force (t,r,v) ^/ m)---- Lorentz Force Law-force :: SimpleState -> Vec-force (_t,r,v) = q *^ (electricField r ^+^ v >< magneticField r)--main :: IO ()-main = simulate-       Nothing-       "Particle Experiencing Electromagnetic Force"-       0.01-       (0,initialPosition,initialVelocity)-       drawFunction-       statePropagationFunction---- particle mass-m :: Double-m = 1---- particle charge-q :: Double-q = 1---- Electric Field-electricField :: VectorField-electricField r = vec 0 2 0-    where-      (x,y,z) = cartesianCoordinates r---- Magnetic Field-magneticField :: VectorField-magneticField r = vec 0 0 4-    where-      (x,y,z) = cartesianCoordinates r---- Initial displacement-initialPosition :: Position-initialPosition = cart 0 0 0---- Initial velocity-initialVelocity :: Vec-initialVelocity = vec 0 0 0

@@ -1,86 +0,0 @@-{-# OPTIONS_GHC -Wall #-}---- Animation of Earth orbiting around a fixed Sun--- Using SI units--module Main where--import Physics.Learn-import Graphics.Gloss-import Graphics.Gloss.Data.ViewPort--type Acceleration = Vec--gGrav :: Double-gGrav = 6.67e-11--massSun :: Double-massSun = 1.99e30---- This is enlarged so we can see it.-radiusSun :: Double-radiusSun = 0.1 * earthSunDistance---- This is enlarged so we can see it.-radiusEarth :: Double-radiusEarth = 0.05 * earthSunDistance--earthSunDistance :: Double-earthSunDistance = 1.496e11--year :: Double-year = 365.25*24*60*60---- Derived constants--initialEarthSpeed :: Double-initialEarthSpeed = 2*pi*earthSunDistance/year--initialState :: SimpleState-initialState = (0-               ,cart (2 * earthSunDistance) 0 0-               ,vec 0 (initialEarthSpeed / 2) 0)--rS :: Position-rS = cart 0 0 0--earthGravity :: SimpleAccelerationFunction-earthGravity (_,rE,_)-    = ((-gGrav) * massSun) *^ disp ^/ magnitude disp ** 3-      where-        disp = displacement rS rE--diskPic :: Double -> Picture-diskPic r = ThickCircle (radius/2) radius-    where radius = realToFrac r---- A yellow disk will represent the Sun-yellowDisk :: Picture-yellowDisk = Color yellow (diskPic radiusSun)---- A blue disk will represent the Earth-blueDisk :: Picture-blueDisk = Color blue (diskPic radiusEarth)--worldToPicture :: SimpleState -> Picture-worldToPicture (_,rE,_)-    = scale scl scl $ pictures [yellowDisk-                               ,translate xE yE blueDisk-                               ]-    where-      xE = realToFrac x-      yE = realToFrac y-      scl = 200 / realToFrac (earthSunDistance)-      (x,y,_) = cartesianCoordinates rE--timeScale :: Double-timeScale = 0.25 * year--simStep :: ViewPort -> Float -> SimpleState -> SimpleState-simStep _ dt = simpleRungeKuttaStep earthGravity dtScaled-    where-      dtScaled = timeScale * realToFrac dt--main :: IO ()-main = simulate (InWindow "Sun-Earth Animation" (600, 600) (10, 10))-       black 50 initialState worldToPicture simStep