fizika/Vector.hs at master · madasigon/fizika · GitHub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
{-# LANGUAGE DeriveDataTypeable, RecordWildCards  #-}
import Graphics.Gloss
import Graphics.Gloss.Data.Vector
import Debug.Trace

leftV (x, y) = (-y, x)
addV (x1, y1) (x2, y2) = (x1+x2, y1+y2)

data Object = Object {
    position :: Point,
    velocity :: Vector,
    charge :: Float,
    mass :: Float
}

type MagneticField = Point -> Float -- egyelőre mindig szembe néz
type FieldDefinition = Model -> MagneticField

data Model = Model {
    field :: FieldDefinition,
    object :: Object,
    path :: [Point],
    currentTime :: Float
}

size = 500

lorentzForce :: MagneticField -> Object -> Vector
lorentzForce aktField aktObj = mulSV (fieldHere * charge aktObj) (leftV $ velocity aktObj)
    where
        fieldHere = aktField (position aktObj)


progress _ time original@Model{..} = if False then original
    else
        original{
            object = object{
                position = newPosition,
                velocity = mulSV (magV (velocity object)) (normalizeV (addV (velocity object) deltaVelocity))
            },
            path = take 8000 $ newPosition : path,
            currentTime = currentTime + time
        }
    where
        aktField = field original
        force = lorentzForce aktField object
        deltaMomentum = mulSV time force
        deltaVelocity = mulSV (1 / mass object) deltaMomentum
        deltaPosition = mulSV time (velocity object)
        newPosition = addV (position object) deltaPosition

adapt = Scale sizeFloat sizeFloat
        where sizeFloat = fromIntegral size

circleAt radius pos = uncurry Translate pos $ Pictures [(Color yellow $ Circle radius)]
toRad :: Float -> Float
toRad angle = angle * (pi/180)
origo :: Point
origo = (0,0)

drawVector :: Vector -> Picture
drawVector vec = Scale 0.4 0.4 $ Line [origo, vec, rotScale sc ang vec, vec, rotScale sc (-ang) vec]
    where
        rotScale newScale angle = rotateV angle . mulSV newScale
        ang = toRad 5
        sc = 0.9

drawVectorFrom :: Point -> Vector -> Picture
drawVectorFrom pos = uncurry Translate pos . drawVector


view :: Model -> Picture
view original@Model{..} =
    adapt $ Pictures [prevPath, aktObject, aktVel, aktForce]
    where
        prevPath = Pictures (map (circleAt 0.001) path)
        aktObject = circleAt 0.003 (position object)
        aktVel = Color red $ drawVectorFrom (position object) (velocity object)
        aktForce = Color green $ drawVectorFrom (position object) force
        force = lorentzForce (field original) object


interesting :: [FieldDefinition]
interesting = [allando, belulTartos, idoFuggo]


belulTartos :: FieldDefinition
belulTartos Model{..} pos@(x, y) = if x > 0 || magV pos > 0.9 then 1 else -1

idoFuggo :: FieldDefinition
idoFuggo Model{..} pos@(x, y) = sin (currentTime)

allando :: FieldDefinition
allando _ _ = 1

initial = Model{
    field = idoFuggo,
    object = Object{
        position = (0,0),
        velocity = (0.5, 0),
        charge = 1,
        mass = 0.2
    },
    path = [],
    currentTime = 0
}
main = simulate
    (InWindow "Szimuláció" (size*2,size*2) (100, 100))
    black
    600
    initial
    view
    progress