home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 2 / Apprentice-Release2.iso / Tools / Languages / MacHaskell 2.2 / progs / demo / X11 / animation / r_utility.hs < prev    next >
Encoding:
Text File  |  1994-09-27  |  4.5 KB  |  151 lines  |  [TEXT/YHS2]
  1. {-*********************************************************************
  2.     MODULE R_UTILITY
  3.   
  4.       This module contains all the basic utility functions that the other
  5.     modules need to have to write their code. These are made generally
  6.     low level functions, manipulating vectors or defining very 
  7.     general functions  
  8.  
  9. **********************************************************************-}
  10.  
  11.  
  12. module R_Utility (vtovf,vftov,
  13.           vplus, vmin, mid, partway,
  14.                   mag,
  15.                   reduce, power, i,
  16.                   member, repeat, zip1, zip2, zip3, rept, replicate,
  17.                   mapc, 
  18.                   append, flatten, rptseq, osc
  19.                   ) where
  20.  
  21. import R_Ptypes
  22.  
  23.  
  24. -- CONVERSION
  25.  
  26.   -- vtovf takes a vector of integers, and converts it to a vector of floats
  27. vtovf :: Vec -> Vecfloat
  28. vtovf (x,y) = (fromIntegral x,fromIntegral y)
  29.  
  30.   -- vftov takes a vector of floats and converts it to a vector of integers.
  31.   -- It rounds the floats off to do this.
  32. vftov :: Vecfloat -> Vec
  33. vftov (x,y) = (round x,round y)
  34.  
  35.  
  36. -- VECTOR OPERATIONS:
  37.  
  38.   -- vector addition
  39. vplus:: Vec -> Vec -> Vec
  40. vplus (a,b) (c,d) = (a+c,b+d)
  41.  
  42.   -- vector substraction
  43. vmin:: Vec -> Vec -> Vec
  44. vmin (a,b) (c,d) = (a-c,b-d)
  45.  
  46.   -- finds the midpoint between two vectors
  47. mid:: Vec -> Vec -> Vec
  48. mid (x1,y1) (x2,y2) = (div (x1+x2) 2,div (y1+y2) 2 )
  49.  
  50.   -- finds a point p/q along the way between two vectors
  51. partway :: Int -> Int -> [Vec] -> Vec
  52. partway p q [(x1,y1),(x2,y2)]
  53.         = vplus (x1,y1) ( div (p*(x2-x1)) q, div (p*(y2-y1)) q )
  54.  
  55.   -- finds the magnitude of two vectors
  56. mag :: Vec -> Int
  57. mag p = round (magfloat (vtovf p))
  58.  
  59. magfloat :: Vecfloat -> Float
  60. magfloat (x,y) = sqrt (x*x + y*y)
  61.  
  62.   -- returns a vector at right angles to the input vector
  63. normal:: Vec -> Vec
  64. normal (x,y) = (-y,x)
  65.  
  66.   -- returns the first vector projected onto the second
  67. project:: Vec -> Vec -> Vec
  68. project (vx,vy) (wx,wy) = partway (vx*wx+vy*wy) (mw*mw) [(0,0),(wx,wy)]
  69.                  where mw = mag (wx,wy)
  70.  
  71.  
  72. -- HIGHER-ORDER FUNCTIONS:
  73.  
  74.   -- just foldr1. It applies a function of two inputs to an entire list 
  75.   -- recursively, and displays the single element result
  76. reduce :: (a->a->a) -> [a] -> a
  77. reduce = foldr1
  78.  
  79.   -- power applies a single function n times to a seed
  80. power :: Int -> (a->a) -> a -> a
  81. power 0 f seed = seed
  82. power (n+1) f seed = f (power n f seed)
  83.  
  84.   -- i takes an element and returns an infinite list of them
  85. i :: a -> [a]
  86. i x = x: (i x)
  87.  
  88.   -- checks to see if x is in the list of xs
  89. member :: (Eq a) => [a] -> a -> Bool
  90. member [] x = False
  91. member (y:ys) x = x == y || member ys x
  92.  
  93.   -- zip1 takes lists of lists, and rearranges them so that all the first
  94.   -- elements are in the first list, all the second in the second and so on.
  95. zip1 :: (Eq a) => [[a]] -> [[a]]
  96. zip1 xs | member xs [] = []
  97. zip1 xs = (map head xs):(zip1 (map tail xs))
  98.  
  99.   -- takes two lists and makes a list of tuples.
  100. zip2 :: [a] -> [b] -> [(a,b)]
  101. zip2=zip
  102.  
  103.   -- rept takes a function and a list of elements, and applies the function
  104.   -- n-1 times to the n-th element
  105. rept :: (a->a) -> a -> [a]
  106. rept f x =  x:(rept f (f x))
  107.  
  108.   -- replicate creates an list n elements long of a, with the function
  109.   -- applies to the n-th element n-1 times.
  110. replicate :: Int -> (a->a->a) -> a -> a -> a
  111. replicate 0 f zero a = zero
  112. replicate 1 f zero a = a
  113. replicate (n+2) f zero a = f a (replicate (n+1) f zero a)
  114.  
  115.   -- mapc is a map function for lists of functions (behaviours)
  116. mapc :: (a->b) -> [c->a] -> [c->b]
  117. mapc f as = [f.a | a <- as]
  118.  
  119.  
  120. -- FUNCTIONS OVER SEQUENCES:
  121.  
  122.   -- append takes a list of lists, and makes them into one giant happy list.
  123. append :: [[a]] -> [a]
  124. append = foldr (++) []
  125.  
  126.   -- flatten takes a list of lists of tuples and gives one giant happy list
  127.   -- of single elements back.
  128. flatten:: [[(a,a)]] -> [a]
  129. flatten s = foldr f []  (append s)
  130.             where f (x,y) [] = [x,y]
  131.                   f (x,y) (z:zs) = x:y:(z:zs)
  132.  
  133.   -- rptseq takes a list of elements and applies a function to them,
  134.   -- n-1 times for the n-th element, but using map 
  135. rptseq :: (a->a) -> [a] -> [a]
  136. rptseq f [] = []
  137. rptseq f (x:xs) = x:rptseq f (map f xs)
  138.  
  139.   -- osc takes a list, and makes sure it oscillates. If the head is 
  140.   -- equal to the tail, it simply repeats the sequence infinitely. If
  141.   -- the head is not equal to the tail, it adds the sequence then adds
  142.   -- the reversed sequence minus the first and last elements, and then repeats
  143. osc :: [a] -> [a]
  144. osc s  | (length s) == 0 = []
  145. osc s  | (length s) == 1 = head s: osc s
  146. osc s           = (s ++ (((tail.reverse).tail) s)) ++ (osc s)
  147.  
  148.  
  149.  
  150.  
  151.