summaryrefslogtreecommitdiff
path: root/progs/demo/X11/animation/r_utility.hs
blob: 9dfcc653be68127eee2cfe0241310c3e494aadc1 (about) (plain)
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
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
{-*********************************************************************
    MODULE R_UTILITY
  
      This module contains all the basic utility functions that the other
    modules need to have to write their code. These are made generally
    low level functions, manipulating vectors or defining very 
    general functions  

**********************************************************************-}


module R_Utility (vtovf,vftov,
		  vplus, vmin, mid, partway,
                  mag,
                  reduce, power, i,
                  member, repeat, zip1, zip2, zip3, rept, replicate,
                  mapc, 
                  append, flatten, rptseq, osc
                  ) where

import R_Ptypes


-- CONVERSION

  -- vtovf takes a vector of integers, and converts it to a vector of floats
vtovf :: Vec -> Vecfloat
vtovf (x,y) = (fromIntegral x,fromIntegral y)

  -- vftov takes a vector of floats and converts it to a vector of integers.
  -- It rounds the floats off to do this.
vftov :: Vecfloat -> Vec
vftov (x,y) = (round x,round y)


-- VECTOR OPERATIONS:

  -- vector addition
vplus:: Vec -> Vec -> Vec
vplus (a,b) (c,d) = (a+c,b+d)

  -- vector substraction
vmin:: Vec -> Vec -> Vec
vmin (a,b) (c,d) = (a-c,b-d)

  -- finds the midpoint between two vectors
mid:: Vec -> Vec -> Vec
mid (x1,y1) (x2,y2) = (div (x1+x2) 2,div (y1+y2) 2 )

  -- finds a point p/q along the way between two vectors
partway :: Int -> Int -> [Vec] -> Vec
partway p q [(x1,y1),(x2,y2)]
        = vplus (x1,y1) ( div (p*(x2-x1)) q, div (p*(y2-y1)) q )

  -- finds the magnitude of two vectors
mag :: Vec -> Int
mag p = round (magfloat (vtovf p))

magfloat :: Vecfloat -> Float
magfloat (x,y) = sqrt (x*x + y*y)

  -- returns a vector at right angles to the input vector
normal:: Vec -> Vec
normal (x,y) = (-y,x)

  -- returns the first vector projected onto the second
project:: Vec -> Vec -> Vec
project (vx,vy) (wx,wy) = partway (vx*wx+vy*wy) (mw*mw) [(0,0),(wx,wy)]
			     where mw = mag (wx,wy)


-- HIGHER-ORDER FUNCTIONS:

  -- just foldr1. It applies a function of two inputs to an entire list 
  -- recursively, and displays the single element result
reduce :: (a->a->a) -> [a] -> a
reduce = foldr1

  -- power applies a single function n times to a seed
power :: Int -> (a->a) -> a -> a
power 0 f seed = seed
power (n+1) f seed = f (power n f seed)

  -- i takes an element and returns an infinite list of them
i :: a -> [a]
i x = x: (i x)

  -- checks to see if x is in the list of xs
member :: (Eq a) => [a] -> a -> Bool
member [] x = False
member (y:ys) x = x == y || member ys x

  -- zip1 takes lists of lists, and rearranges them so that all the first
  -- elements are in the first list, all the second in the second and so on.
zip1 :: (Eq a) => [[a]] -> [[a]]
zip1 xs | member xs [] = []
zip1 xs = (map head xs):(zip1 (map tail xs))

  -- takes two lists and makes a list of tuples.
zip2 :: [a] -> [b] -> [(a,b)]
zip2=zip

  -- rept takes a function and a list of elements, and applies the function
  -- n-1 times to the n-th element
rept :: (a->a) -> a -> [a]
rept f x =  x:(rept f (f x))

  -- replicate creates an list n elements long of a, with the function
  -- applies to the n-th element n-1 times.
replicate :: Int -> (a->a->a) -> a -> a -> a
replicate 0 f zero a = zero
replicate 1 f zero a = a
replicate (n+2) f zero a = f a (replicate (n+1) f zero a)

  -- mapc is a map function for lists of functions (behaviours)
mapc :: (a->b) -> [c->a] -> [c->b]
mapc f as = [f.a | a <- as]


-- FUNCTIONS OVER SEQUENCES:

  -- append takes a list of lists, and makes them into one giant happy list.
append :: [[a]] -> [a]
append = foldr (++) []

  -- flatten takes a list of lists of tuples and gives one giant happy list
  -- of single elements back.
flatten:: [[(a,a)]] -> [a]
flatten s = foldr f []  (append s)
            where f (x,y) [] = [x,y]
                  f (x,y) (z:zs) = x:y:(z:zs)

  -- rptseq takes a list of elements and applies a function to them,
  -- n-1 times for the n-th element, but using map 
rptseq :: (a->a) -> [a] -> [a]
rptseq f [] = []
rptseq f (x:xs) = x:rptseq f (map f xs)

  -- osc takes a list, and makes sure it oscillates. If the head is 
  -- equal to the tail, it simply repeats the sequence infinitely. If
  -- the head is not equal to the tail, it adds the sequence then adds
  -- the reversed sequence minus the first and last elements, and then repeats
osc :: [a] -> [a]
osc s  | (length s) == 0 = []
osc s  | (length s) == 1 = head s: osc s
osc s           = (s ++ (((tail.reverse).tail) s)) ++ (osc s)