diff options
| author | Yale AI Dept <ai@nebula.cs.yale.edu> | 1993-07-14 13:08:00 -0500 |
|---|---|---|
| committer | Duncan McGreggor <duncan.mcgreggor@rackspace.com> | 1993-07-14 13:08:00 -0500 |
| commit | 4e987026148fe65c323afbc93cd560c07bf06b3f (patch) | |
| tree | 26ae54177389edcbe453d25a00c38c2774e8b7d4 /progs/demo/X11/animation | |
Import to github.
Diffstat (limited to 'progs/demo/X11/animation')
36 files changed, 2139 insertions, 0 deletions
diff --git a/progs/demo/X11/animation/README b/progs/demo/X11/animation/README new file mode 100644 index 0000000..c14b867 --- /dev/null +++ b/progs/demo/X11/animation/README @@ -0,0 +1,22 @@ +In his paper "A Functional Animation Starter Kit" [ARYA88], Kevi Arya +proposes an approach to animation that uses functional languages. As +Arya describes, the cost of computing power is falling. This is making +the use of computer animation much more prevalent. However, languages +such as C make it difficult to program animations. What is needed is +a simpler, faster and more accessible way to program graphics. Functional +languages are a very effective means for this, due to their higher order +functions. + + Kevi Arya goes on to provide such a functional animation package in +the language Miranda. Haskell in particular is good functional language for +two reasons. It is a completely functional language, doing even I/O in a +functional manner. Variables are evaluated in a lazy manner allowing infinite +lists to be manipulated easily, which suits the infinite frames format +of animation. + +The following animations are provided here: + + seaside.hs - a seaside scene + planets.hs - planets in orbit + palm.hs - another seaside scene + birds.hs - flying birds diff --git a/progs/demo/X11/animation/animation.hs b/progs/demo/X11/animation/animation.hs new file mode 100644 index 0000000..3c0750c --- /dev/null +++ b/progs/demo/X11/animation/animation.hs @@ -0,0 +1,16 @@ +-- This bundles all the animation stuff into a single module. + +module Animation(R_Ptypes..,R_Constants..,R_Utility..,R_Picture..,R_Behaviour.., + R_Movie..,R_Shapes..,R_Defaults..,R_Inbetween.., + R_Display..) where +import R_Ptypes +import R_Constants +import R_Utility +import R_Picture +import R_Behaviour +import R_Movie +import R_Shapes +import R_Defaults +import R_Inbetween +import R_Display + diff --git a/progs/demo/X11/animation/animation.hu b/progs/demo/X11/animation/animation.hu new file mode 100644 index 0000000..0dd71ee --- /dev/null +++ b/progs/demo/X11/animation/animation.hu @@ -0,0 +1,6 @@ +animation.hs +r_movie.hu +r_defaults.hu +r_shapes.hu +r_inbetween.hu +r_display.hu diff --git a/progs/demo/X11/animation/birds.hs b/progs/demo/X11/animation/birds.hs new file mode 100644 index 0000000..daba730 --- /dev/null +++ b/progs/demo/X11/animation/birds.hs @@ -0,0 +1,28 @@ +module Birds where + +import Animation + +bird :: Movie +--bird = osc [bird1,bird2] +bird = rOVERLAY + [apply (bPar [right,right,right,right]) bm1, + apply (bPar [up,right,right,right]) bm2] + where bm1 = osc [bird1] + bm2 = osc [bird2] + +bird1 = [(black,b1)] + where b1 = [(0,90),(20,100),(30,110),(40,110),(50,100),(110,120), + (130,100),(120,90),(80,90),(0,90), + (80,90),(90,70),(140,50),(120,90),(80,90), + (80,90),(70,70),(80,60),(90,70)] + +bird2 = [(red,b2)] + where b2 = [(0,60),(20,70),(30,80),(40,80),(50,70),(110,70), + (140,30),(110,35),(100,35),(70,50),(50,60),(0,60), + (70,50),(100,90),(150,100),(120,60),(110,35), + (70,50),(65,100),(85,115),(97,86)] + +main = getEnv "DISPLAY" exit + (\ host -> displaym host 30 bird) + + diff --git a/progs/demo/X11/animation/birds.hu b/progs/demo/X11/animation/birds.hu new file mode 100644 index 0000000..cd94b30 --- /dev/null +++ b/progs/demo/X11/animation/birds.hu @@ -0,0 +1,3 @@ +:o= all +birds.hs +animation.hu diff --git a/progs/demo/X11/animation/doc.tex b/progs/demo/X11/animation/doc.tex new file mode 100644 index 0000000..1b66751 --- /dev/null +++ b/progs/demo/X11/animation/doc.tex @@ -0,0 +1,578 @@ + +% This is obsolete regarding the X system -- jcp + +% -*-latex-*- +% Creator: John Tinmouth +% Creation Date: Thu May 9 1991 +\documentstyle[11pt]{article} +\newcommand{\X}[1]{{#1}\index{{#1}}} +\begin{document} + +\title{A Functional Animation Package in Haskell} +\author{ + John Tinmouth\\ + Computer Science Senior Project\\ + Yale University\\ + Professor Paul Hudak } +\date{9 May 1991} +\maketitle + + + +\section{Introduction} + + In his paper "A Functional Animation Starter Kit" [ARYA88], Kevi Arya +proposes an approach to animation that uses functional languages. As +Arya describes, the cost of computing power is falling. This is making +the use of computer animation much more prevalent. However, languages +such as C make it difficult to program animations. What is needed is +a simpler, faster and more accessible way to program graphics. Functional +languages are a very effective means for this, due to their higher order +functions. + + Kevi Arya goes on to provide such a functional animation package in +the language Miranda. Haskell in particular is good functional language for +two reasons. It is a completely functional language, doing even I/O in a +functional manner. Variables are evaluated in a lazy manner allowing infinite +lists to be manipulated easily, which suits the infinite frames format +of animation. As it is now possible to complete the implementation of +this package is Haskell, my work has been converting these Miranda programs +to Haskell version 1.0-0, Yale Haskell Group. + + + +\section{How to Use the Graphics: Overview} + + By using higher order functions, it becomes very easy to do rapid +prototyping of animations. You can quickly throw out an animation of +simple images manipulated in simple ways. For example, if there was +an image of a car, and you wanted it to move left, you could almost +just describe it in english, and that would be the animation. +\begin{verbatim} + movie = apply left car +\end{verbatim} + + After the simple model is done, converting it to a more complex model +is simple. Simply make the image, "car" in this case, more complex, and +then modify the "left" function, and you are done. + + There are three stages in making a movie. First of all, you must +define your basic images. These will tend to be Pics put into lists, either +finite or infinite, to be basic Movies. Second, you decide precisely +what kind of motion you want in animation. These are behaviours. A behaviour +modifies a movie over time, changing each successive frame. This includes +motion, changing size, changing from one image to another and so forth. These +are applied to your basic Movies. Third, you must combine your basic Movies +into your final Movie. If you want a scene of clouds and a man walking, you +must overlay your basic Movie of clouds with your Movie of a walking man. + +\section {Original Images or Pics} + + A Movie is a list of frames called Pics. Each of these Pics is a list +of colored polygons. The Pic is a Color followed by a list of Vectors, +representing the vertices of the Polygon. The original Pic usually must +be entered by hand, although simple generation routines for boxes, +triangles and circles are available. You need to produce some of these +basic images in one way or another, so that you have something to +manipulate. + + To make a Movie, you need a list of these Pics. With a single Pic, you +can generate a sequence of that Pic. With several Pics, you can oscillate +through the Pics in an inifinite list. To generate an infinite list of +Pics of p1, define a Movie, m1 = i p1. + The following datatypes are used in this package: + +\begin{verbatim} +type Vec = (Int,Int) +type Color = Int +type Poly = (Color,[Vec]) +type Pic = [Poly] +type Movie = [Pic] +type Behaviour = [Pic -> Pic] +\end{verbatim} + + +\subsection {Modifying Pics} + + Starting with a single Pic, it is possible to create a short list of +Pics to oscillate on. You can flip it, scale it, or otherwise modify the +original Pic (p1) in some way to create another Pic (p2). You can either +keep doing this and produce N images for a Movie of [p1,p2,...,pN], or use +the interpolation functions available to shift from p1 to p2 in N frames, +resulting in a Movie [p1,interp1,interp2,...,interpN-2,p2]. + The list of specific Pic-to-Pic functions is included in the next section, +along with short explanations of what they do. + +\subsection {Pic-to-Pic Functions Available} + +\begin{verbatim} +overlay_Pic Args: Pic Pic + This takes 2 Pics and just puts them together into one Pic. + module: R_Picture + +put_Pic Args: Vec Pic Pic + This overlays the two Pics, putting Pic-1's center the Vec + distance away from Pic-2's center. + module: R_Picture + +over_Pic Args: Pic Pic + This puts two images on top of one another, explicitly + centering the first on top of the second and forms one Pic. + module: R_Picture + +above_Pic Args: Pic Pic + This puts the first Pic above the second Pic, at a distance + of half the combined heights of the Pics and overlays them + to form one Pic. + module: R_Picture + +beside_Pic Args: Pic Pic + This puts the first Pic to the right of the second Pic, at + a distance of half the combined widths of the Pics and + overlays them to form one Pic. + module: R_Picture + +beside2_Pic Args: Pic Pic + Withouth analysing the widths of the Pics, it puts the + first Pic the width of the second Pic to the right and + overlays them to form one Pic. + module: R_Picture + +scale_Pic Args: Int Pic + This scales the picture in elevenths around its own origin + and returns that Pic. So if the Int is 22, the Pic will + scaled by a factor of 2 (22/11). + module: R_Picture + +scale_rel_Pic Args: Vev Int Pic + This is another scaling function, but it scales the image + from the Vec, treating it as the origin. + module: R_Picture + +mov_Pic Args: Vec Pic + This moves the Pic by the amount of the vector. + module: R_Picture + +movto_Pic Args: Vec Pic + This moves the Pic's center to the Vec. + module: R_Picture + +to_orig Args: Pic + This moves the Pic's center to the lower,left side of + the Pic. + module: R_Picture + +rot_Pic Args: Vec Float Pic + This rotates the Pic by the Float in radians, using the Vec + as the origin of rotation. + module: R_Picture + +twist_Pic Args: Float Pic + This rotates the Pic by the Float amount of radians around + its own center. + module: R_Picture + +rot_Pic' Args: Vec Pic + This rotates the Pic by a certain amount (set in R_Constants) + using the Vec as the center of rotation. The set amount of + rotation makes it faster than rot_Pic. + module: R_Picture + +twist_Pic' Args: Pic + This rotates the Pic by a certain amoutn (set in R_Constants) + around the Pic's origin. The set amount of rotation makes + it faster than twist_Pic. + module: R_Picture + +flipx_Pic Args: Int Pic + This flips the Pic around the line x=Int, essentially giving + a mirror image of the Pic, reversing right and left. + module: R_Picture + + +flipy_Pic Args: Int Pic + This flips the Pic around the line y=Int, mirror-imaging the + Pic, reversing up and down. + module: R_Picture + +flip_Pic Args: Pic + This flips the Pic around its own x-origin, reversing + left and right. + module: R_Picture + +flock_Pic Args: Int Pic + This takes the image Pic and copies it out Int*Int times in + a Int by Int grid pattern, and returns that as an Pic. + module: R_Picture + +set_Color Args: Int Pic + This takes an Int standing for a color, and changes the + color of the Pic to that. + module: R_Picture +\end{verbatim} + +\subsection{Other Functions for Manipulating Pics} + +\begin{verbatim} +i Args: Any + This will take anything and return an infinite stream of them. + module: R_Utility + +osc Args: [Any] + This will take a Movie, which is a list of Pics and + oscillate them. + [p1] will give [p1,p1,p1,p1....] + [p1,p2,p3,p4] will give [p1,p2,p3,p4,p3,p2,p1,p2...] + module: R_Utility +\end{verbatim} + +\section{Behaviours and their Application to Movies} + + A Behaviour is a list of functions that will convert one Pic to +another Pic. This list then can be applied to any Movie with one +of the application functions (most often apply). The beauty of the Behaviour +is that once you have a behaviour for moving left, you can move any +Movie left without rewriting the routine every time. + + There are specific functions that take a Behaviour and a Movie and +return a new Movie. These are apply and while. If you had a Movie of a +man walking in place, and a Behaviour called left that moves Pics ever +increasing distances left, then you could create a man walking left by: +\begin{verbatim} + apply left man +\end{verbatim} + + If you want to apply more than one Behaviour to a Movie, you must first +decide whether to do that in sequence or in parallel, and use bSeq and bPar +to reduce the list of Behaviours to a single Behaviour, and then apply +that to a movie. For example: +\begin{verbatim} + apply (bPar left up) gull +\end{verbatim} +will take a Movie of a gull and move the Pics up and left. + + Most of the basic Behaviours are defined in R\_Behaviour. + + +\subsection{Defining Customized Packages of Behaviours} + + Often you will have more specialized, or just simpler Behaviours you +want to use. Using the Behaviours and Pic-to-Pic functions, it is very +easy to create your own small library of Behaviours. R\_Defaults is a +module of such Behaviours. For example, to create a Behaviour to move +a Movie right, you would create a list of mov\_Pic's, each taking a +everincreasingly large x-coordinate. +\begin{verbatim} + right = [ mov_Pic (x,y) | (x,y) <- zip [0,10,..] [0,..] ] +\end{verbatim} + + Or if you wanted a behavour to place a Movie at (100,100) twice as +large as before, you could create a new Behaviour from old ones as: + scaleat= bPar [movto (i (100,100)), scale (i 22)] + +\subsection{Behaviours Available} +\begin{verbatim} +flip Args: none + This will flip every Pic around its x-origin, resulting in + mirror images reversing left and right. + module: R_Behaviour + +twist' Args: none + This will rotate each Pic by the amount rotunit (see + R_Constants) around its origin. + module: R_Behaviour + +mov Args: [Vec] + This will move each Pic by its corresponding vector. + module: R_Behaviour + +movto Args: [Vec] + This will move each Pic's origin to its corresponding vector. + module: R_Behaviour + +circ_mov Args: Float Float + This will move each Pic in a circle, of radius of the first + Float and by an increment of the second Float, using (0,0) + as the origin of rotation. + module: R_Behaviour + +scale Args: [Int] + Scales every Pic on its origin by the the corresponding Int + in the list. These Ints represents elevenths, so that a + [2,2,...] will scale every Pic by 2/11 . + module: R_Behaviour + +scale_rel Args: Vec [Int] + Same as scale, except that the Pics are all scaled using the + Vec as the point of origin. + module: R_Behaviour + +twist Args: [Float] + This will rotate every Pic by its corresponding Float from + the list in radians. + module: R_Behaviour + +set_color Args: [Int] + This sets each Pic to the color indicated by its + corresponding int in the list. + module: R_Behaviour + +rot Args: [Vec] [Float] + This will rotate each Pic around its corresponding Vec by + its corresponding Float in radians. + module: R_Behaviour + +big Args: none + Scales every Pic up by scaleunit + module: R_Defaults + +huge Args: none + This scales every Pic up by 2*scaleunit + module: R_Defaults + +small Args: none + This scales every Pic down by 10/11 + module: R_Defaults + +tiny Args: none + This scale every Pic down by 5/11 + module: R_Defaults + +bigger Args: none + This scales every Pic in the list by scaleunit more + than the previous Pic, so that the n-th element is + scaled up by (n-1)*scaleunit + module: R_Defaults + +smaller Args: none + This scales every Pic down, so that the n-th element + is scaled down by (n-1)*(10/11) + module: R_Defaults + +ccw Args: none + This rotates every Pic by one rotunit more than the + previous Pic, in a counterclockwise fashion. + module: R_Defaults + +cw Args: none + This rotates every Pic by one rotunit more than the + previous Pic, in a clockwise fashion. + module: R_Defaults + +up Args: none + This moves every Pic up by one unit more than the + Previous Pic, so that the n-th element is moved up + (n-1) units. + module: R_Defaults + +down Args: none + This is same as up, but the Pics move down. + module: R_Defaults + +right Args: none + This is same as up, but the Pics move right. + module: R_Defaults + +left Args: none + This is same as up, but the Pics move left. + module: R_Defaults +\end{verbatim} + +\subsection{Functions For Behaviours} + +\begin{verbatim} +do Args: Int Behaviour + This takes the first Int elements of the Behaviour and + return that. + module: R_Behaviour + +rpt Args: Int Behaviour + This takes an Int and returns a Behaviour of length Int. + However, the n-th Pic-to-Pic in the Behaviour returned + is made up of the first through (n-1)the Pic-to-Pics of + the input list. + module: R_Behaviour + +forever Args: Behaviour + This makes a finite Behaviour list an infinite one by + appending the list to itself endlessly. + module: R_Behaviour + +apply Args: Behaviour Movie + This takes a Behaviour and applies it to a Movie + module: R_Behaviour + +while Args: (Boolean function) Behaviour Movie + As long as the Boolean function evaluates true, this + takes a Behaviour and applies it to a Movie. When it + evaluates to false, no more Pics are produced and + the Movie is cut short there. + module: R_Behaviour + +bseq Args: Behaviour Behaviour + This takes two Behaviour and creates one Behaviour made + up of the two inputs applies in sequence. + module: R_Behaviour + +bSeq Args: [Behaviour] Behaviour + This takes two Behaviour and creates one Behaviour made + up of the two inputs applies in sequence. + module: R_Behaviour + +bpar Args: Behaviour Behaviour + This takes two Behaviour and creates one Behaviour made + up of the two inputs applies in parallel. + module: R_Behaviour + +bPar Args: [Behaviour] Behaviour + This takes two Behaviour and creates one Behaviour made + up of the two inputs applies in parallel. + module: R_Behaviour +\end{verbatim} + +\section{Creating the Final Movie} + + Finally, you have your basic Movies made up of Pictures and Behaviours. +Now you need to combine them into one Movie. The functions that do this +are found in the module R\_Movie. These functions will take a list of +Movies and return a single Movie combining all the Movies in the list. +How they are combined can be controlled to some extent. Usually they are +just overlayed, but they can be put beside one another, or on top of +one another, or put a Vec distance apart. + + It is also possible to use a combination of these forms. If you wanted +to overaly M1 and M2, and then put that beside M3, you would do: +\begin{verbatim} + rBESIDE [M3, rOVERLAY [M1,M2] ] +\end{verbatim} +This is acceptable as rOVERLAY will return a single Movie. + +\subsection{Movie Combining Functions} + +\begin{verbatim} +rABOVE Args: [Movie] + Puts all the Movies into one movie, all above one another. + module: R_Movie + +rBESIDE Args: [Movie] + Puts all the Movies into one movie, all beside one another. + module: R_Movie + +rBESIDE2 Args: [Movie] + Using their absolute coordinates, puts all the Movies + beside one another. + module: R_Movie + +rOVER Args: [Movie] + This lays the Movies on top of one another, centering + each Pic so that they share the same origin. + module: R_Movie + +rOVERLAY Args: [Movie] + This lays the Movies on top of one another, centering + each Pic so that they share the smae origin. + module: R_Movie + +pUT Args: [Vec] Movie Movie + This takes a list of Vec, and puts each Pic of the + first Movie in the location of the corresponding + Vec on top of the Pic of the second Movie and + returns that list as the new Movie. + module: R_Movie + +\end{verbatim} + +\section{Displaying Your Movie} + + Once you have your function for the Movie defined, you need to output +it in some way. Currently, this is done by outputting characters to a file and +running a C Program in X-Windows that displays the contents of the file +as a graphic in the X system. First of all, you must convert the +Movie variable to a stream of characters. This is done by running +"showm" on the Movie. Be carefull you don't try to convert an infinite list +into characters as the compiler will take awhile to do this. Instead, take +a certain number of frames and convert them with "showm". +\begin{verbatim} + man\_vm = rOVERLAY [man,vm] + man\_vmstring = showm (take 20 man&vm) +\end{verbatim} + Now that you have this string, you need to write it to disk. The +"writetofile" function does this. It takes a characater string(ie [Char] ) +as an argument, and then prompts you for a filename. It then writes the +string to the filename. So to put man\_vm string into a file: +\begin{verbatim} + main = writetofile man_vmstring +\end{verbatim} +and run the program, where you will prompted for the filename. Or you could: +\begin{verbatim} + main = writetofile (showm (take 20 man_vm)) +\end{verbatim} +to make it more compact. + + +\subsection{Miscellaneous Usefull Functions} + +\begin{verbatim} +inbetween Args: Int Pic Pic + This takes an Int and two Pics and returns a Movie + with Int Pics interpolating between the two Pics. + module: R_Inbetween + +tween Args: Int Movie Movie + This takes an Int and two Movies and returns one + Movie made up of the first Movie, Int number of + frames of Pics interpolating between the last + Pic of the first Movie and the first Pic of the + second Movie, followed by the second Movie + module: R_Inbetween + +box Args: Int Int Int + This takes 3 Ints, the color, width and height of + the box and returns a Pic of a box + module: R_Shapes + +tri Args: Int Vec Vec Vec + This takes a color and three vectors and returns a + Pic of a triangle of that colour with those vertices. + module: R_Shapes + +circ Args: Int Int Int + This takes a color, the radius and the number of points + around the circle, and returns a circle with origin at + (0,0). + module: R_Shapes +\end{verbatim} + +\pagebreak +\large {\bf Appendix: C Programs to Display on X-Windows} +\\ +\\ + The program currently used to run these graphics is called "xcshow". +This takes one argument, the name of the file to be run. When run +in X-Windows, it will produce a window with the first Pic. To run it, click +on the left mouse button inside the window. Clicking again will freeze it. +This will keep cycling through the file, replaying again when it hits the +end of the file, until the window is killed. + + There is also "xshow" which is used to run the monochrome Movies, as +"xcshow" is used to run the color Movies. As this animation package +only produces color Movies, it isn't too usefull. + + +\pagebreak +\large {\bf References} +\\ +\\ +\begin{verbatim} +[ARYA88] "The Formal Analysis of a Functiona Animation System", Kevi Arya, + DPhil,Thesis,Oxford University, Programming Research Group, + April 1988 + +[ARYA89] "Processes In A Functional Animation System", Kevi Arya,IBM + T.J. Research Center, 1989 + +[HASK90] "Report On The Programming Language Haskell, Version 1.0", + YALEU/DCS/RR-777,Yale University,1990 +\end{verbatim} + +\end{document} diff --git a/progs/demo/X11/animation/palm.hs b/progs/demo/X11/animation/palm.hs new file mode 100644 index 0000000..9deef12 --- /dev/null +++ b/progs/demo/X11/animation/palm.hs @@ -0,0 +1,47 @@ +module Palm (main) where + +import Animation +import SeaFigs + +main = getEnv "DISPLAY" exit + (\ host -> displaym host 30 trans) + +trans :: Movie +trans = manright++change++gull2 + +manright::Movie +manright = mirrorx (take 10 (apply left man)) + +gull2::Movie +gull2 = apply (bPar [right,up,huge,huge,huge,(mov (i (275,0)))]) gull + +change::Movie +change = inbetween 5 manf1 gull1 + where gull1 = head gull2 + manf1 = last manright + + + +mirrorx :: Movie -> Movie +mirrorx m = map (flipx_Pic x) m + where (x,_)=orig_Movie m + + +orig_Movie :: Movie -> Vec +orig_Movie m = ((x2-x1) `div` 2,(y2-y1) `div` 2) + where x2 = reduce max (map maxx m) + x1 = reduce min (map minx m) + y2 = reduce max (map maxy m) + y1 = reduce min (map miny m) + +maxx :: Pic -> Int +maxx p = reduce max [x | (c,q) <- p, (x,y) <- q] + +minx :: Pic -> Int +minx p = reduce min [x | (c,q) <- p, (x,y) <- q] + +maxy :: Pic -> Int +maxy p = reduce max [y | (c,q) <- p, (x,y) <- q] + +miny :: Pic -> Int +miny p = reduce min [y | (c,q) <- p, (x,y) <- q] diff --git a/progs/demo/X11/animation/palm.hu b/progs/demo/X11/animation/palm.hu new file mode 100644 index 0000000..a86fcb9 --- /dev/null +++ b/progs/demo/X11/animation/palm.hu @@ -0,0 +1,3 @@ +:o= all +palm.hs +seafigs.hu diff --git a/progs/demo/X11/animation/planets.hs b/progs/demo/X11/animation/planets.hs new file mode 100644 index 0000000..38f278a --- /dev/null +++ b/progs/demo/X11/animation/planets.hs @@ -0,0 +1,30 @@ +module Planets (main) where + +import Animation + +planets:: Float -> Float -> Int -> Int -> Int -> Int -> Movie +planets i1 i2 r1 r2 c1 c2 + = rOVERLAY + [ apply f1 earth, + apply (bpar f1 f2) moon + ] + where f1 = circ_mov (fromIntegral r1) i1 + f2 = circ_mov (fromIntegral r2) i2 + earth = osc [mov_Pic (vplus center (r1,0)) (box c1 30 30)] + moon = osc [mov_Pic (vplus center (r1+r2,0)) (box c2 15 15)] + +gen a b c d = c :(gen a b (c+b) d) + + +planet_scene:: Movie +planet_scene = rOVERLAY + [apply (bpar (set_color (i yellow)) (movto (i center))) orb, + planets (pi/40.0) (pi/10.0) 450 80 darkblue lightblue, + planets (pi/20.0) (pi/8.0) 300 50 brown black, + planets (pi/10.0) (pi/4.0) 150 40 green red + ] + +orb = osc [circ red 50 10] + +main = getEnv "DISPLAY" exit + (\ host -> displaym host 60 planet_scene) diff --git a/progs/demo/X11/animation/planets.hu b/progs/demo/X11/animation/planets.hu new file mode 100644 index 0000000..3473372 --- /dev/null +++ b/progs/demo/X11/animation/planets.hu @@ -0,0 +1,3 @@ +:o= all +planets.hs +animation.hu diff --git a/progs/demo/X11/animation/r_behaviour.hs b/progs/demo/X11/animation/r_behaviour.hs new file mode 100644 index 0000000..6f58e3b --- /dev/null +++ b/progs/demo/X11/animation/r_behaviour.hs @@ -0,0 +1,158 @@ +{-********************************************************************** + MODULE R_BEHAVIOUR + + This module defines the basic Behaviours available to manipulate + Movies. These functions can either be used directly, or used to + easily create personnalized Behaviours (see R_Defaults). + There are the Behaviours that affect one Movie, which are mov,movto + circ_mov,scale,scale_rel,rot,flip and set_color. These change some + aspect of the movie over time. + There are functions that combine several movies into one, namely + bseq,bSeq,bpar and bPar. + Some functions modify the Behaviours. These are do, rpt and forever. + They put limits on how long the Behaviour is. + Finally, there are the functions that apply the Behaviours to a Movie. + These are apply and while. Apply applies a Behaviour to a Movie until + it runs out of Movie or Behaviour. While takes a conditional and + applies the Behaviour to it until that condition is fullfilled. + +***********************************************************************-} + +module R_Behaviour (mov,movto,circ_mov,scale,scale_rel,rot,flipb, + set_color, + bseq,bSeq,bpar,bPar, + do,rpt,forever, + apply,while ) where + +import R_Ptypes +import R_Utility +import R_Picture + + -- takes a Pic to Pic and makes an infinite list Behaviour out of it +makeb1 :: (Pic->Pic) -> Behaviour +makeb1 f = f : makeb1 f + + -- takes a movie and flips it around the x-origin using flip_Pic +flipb :: Behaviour +flipb = makeb1 flip_Pic + + -- twist makes twist_Pic into a Behaviour, rotating the image by rotunit +twist' :: Behaviour +twist' = makeb1 twist_Pic' + + -- makeb2 makes a Behaviour out of a function that takes a list and a + -- function and outputs a Behaviour. +makeb2 :: (a->Pic->Pic) -> [a] -> Behaviour +makeb2 f [] = [] +makeb2 f (v:vs) = f v : makeb2 f vs + + -- mov takes a list of Vec's and applies each Pic-to-Pic in the Behaviour + -- list to its corresponding Vec, and gives back a new Behaviour +mov :: [Vec] ->Behaviour +mov = makeb2 mov_Pic + + -- movto creates a list of Pic-to-Pic Behaviours that move each Pic to its + -- corresponding Vec +movto :: [Vec] -> Behaviour +movto = makeb2 movto_Pic + + -- produces a Behaviour that produces movement in a circle, taking + -- the radius and the increment as arguments. +circ_mov :: Float -> Float -> Behaviour +circ_mov r inc = mov (map (vmin' (head vs')) vs') + where vs = [ (r*(cos theta),r*(sin theta)) | + theta <- gen inc 0.0 ] + vmin' x y = vmin y x + vs' = map vftov vs + +gen :: Float -> Float -> [Float] +gen b c = c : (gen b (c+b) ) + + + -- scale outputs a list of Pic-to-Pic's that scale according to its + -- corresponding Int in the input list +scale :: [Int] -> Behaviour +scale = makeb2 scale_Pic + + -- scale_rel does the same thing, but centers on the lower-left corner of + -- the image +scale_rel :: Vec -> [Int] -> Behaviour +scale_rel v = makeb2 (scale_rel_Pic v) + + -- twist outputs a list of Behaviours that rotate each pick by its + -- corresponding Float in the list +twist :: [Float] -> Behaviour +twist = makeb2 twist_Pic + + -- set_color takes a list of Colors, and returns a list of Pic-to-Pic's + -- that change to the corresponding color in the list +set_color :: [Color] -> Behaviour +set_color = makeb2 set_Color_Pic + + -- makeb3 takes a function with two inputs, and two input lists and + -- returns a behaviour made up of functions with inputs fromt the lists +makeb3 :: (a->b->Pic->Pic) -> [a] -> [b] -> Behaviour +makeb3 f [] (p:ps) = [] +makeb3 f (v:vs) [] = [] +makeb3 f (v:vs) (p:ps) = f v p : makeb3 f vs ps + + -- rot produces behaviours rotating by the Float, around the point + -- of the Vec, both provided by lists. +rot :: [Vec] -> [Float] -> Behaviour +rot = makeb3 rot_Pic + + -- bseq takes two Behaviours and combines them into one, in sequence. + -- It first applies all of the first Behaviour, then all of the second +bseq :: Behaviour -> Behaviour -> Behaviour +bseq ps [] = [] +bseq [] qs = [] +bseq ps qs = ps ++ (mapc (last ps) qs) + + -- bSeq takes a list of Behaviour and makes them into one Behaviour, in + -- sequence. +bSeq :: [Behaviour] -> Behaviour +bSeq = reduce bseq + + -- bpar takes two behaviours and applies them both simultaneously, + -- producing a list of Pic-to-Pic's, each one made up of a function + -- from the first list combined with a function from the second list +bpar :: Behaviour -> Behaviour -> Behaviour +bpar [] (q:qs) = [] +bpar (p:ps) [] = [] +bpar (p:ps) (q:qs) = (p.q):(bpar ps qs) + + -- bPar takes a list of Behaviours and makes them all into one Behaviour, + -- in paralell +bPar :: [Behaviour] -> Behaviour +bPar = reduce bpar + + -- takes the first n POic-to-Pics in a Behaviour and returns that Behaviour +do :: Int -> Behaviour -> Behaviour +do n f = take n f + + -- applies bseq to the list of behaviours, so that the nth element of + -- the returned list has n-1 behaviours in it, applied in sequence +rpt :: Int -> Behaviour -> Behaviour +rpt n f = replicate n bseq [] f + + -- takes the behaviour and applies all the behaviours up the nth element + -- to the nth element, in an infinite list +forever :: Behaviour -> Behaviour +forever f = bseq f (forever f) + + -- takes a behaviour, applies each from to a Pic in a Movie and returns + -- the new Movie +apply :: Behaviour -> Movie -> Movie +apply [] ms = [] +apply fs [] = [] +apply (f:fs) (m:ms) = (f m):(apply fs ms) + + -- applies the Behaviour to the Movie until the condition is fullfilled, + -- then returns the movie to that point +while :: (Pic -> Bool) -> Behaviour -> Movie -> Movie +while c [] ms = [] +while c fs [] = [] +while c (f:fs) (m:ms) = if (c m) then ( (f m):(while c fs ms)) + else [] + + diff --git a/progs/demo/X11/animation/r_behaviour.hu b/progs/demo/X11/animation/r_behaviour.hu new file mode 100644 index 0000000..afa52bb --- /dev/null +++ b/progs/demo/X11/animation/r_behaviour.hu @@ -0,0 +1,3 @@ +:o= all +r_behaviour.hs +r_picture.hu diff --git a/progs/demo/X11/animation/r_constants.hs b/progs/demo/X11/animation/r_constants.hs new file mode 100644 index 0000000..f36e3f2 --- /dev/null +++ b/progs/demo/X11/animation/r_constants.hs @@ -0,0 +1,129 @@ +{-**************************************************************** + MODULE R_CONSTANTS + + This module sets up all the constants used in this functional + animation package. + Defined here are the basic units of movement, scale and rotation. + The screen height and width are set, and the various parts of + the screen such as the top-middle, lower-left and center are + all set. Finally the color values used by xcshow, the c-program + that displays the movies in X, are set. + +******************************************************************-} + +module R_Constants (fps, unit, hf, qt, scaleunit, rotunit, + nullpic, nullseq, + sinunit,cosunit, + screenwid, screenht, botl, leftm, topl, topm, topr, + rightm, botr, botm, center, + white,black,red,green,darkblue,lightblue,brown,yellow, + colorName, allColors + ) where + +import R_Ptypes + + -- units are set. The scaleunit is in 11th, so that the 12 is + -- actually 12/11'ths +fps :: Int +unit :: Int +hf :: Int +qt :: Int +scaleunit :: Int +fps = 25 +unit = 15 +hf = unit `div` 2 +qt = unit `div`4 +scaleunit = 12 + --scaleunit is div'ed by 12 later + +rotunit :: Float +rotunit = pi/18 +sinunit = sin rotunit +cosunit = cos rotunit + + +nullpic :: Pic +nullpic = [] +nullseq :: Movie +nullseq= nullpic : [ nullseq2 | nullseq2 <- nullseq] + + -- Screen Parameters +screenwid :: Int +screenwid = 800 +screenht :: Int +screenht = 800 + +botl :: Vec +leftm :: Vec +topl :: Vec +topm :: Vec +topr :: Vec +rightm :: Vec +botr :: Vec +botm :: Vec +center :: Vec + +leftmb :: Vec +leftmt :: Vec +topml :: Vec +topmr :: Vec +rightmt :: Vec +rightmb :: Vec +botml :: Vec +botmr :: Vec + +botl = ( 0, 0 ) +leftm = ( 0, screenht `div` 2) +topl = ( 0, screenht ) +topm = ( screenwid `div` 2, screenht ) +topr = ( screenwid, screenht ) +rightm = ( screenwid, screenht `div` 2 ) +botr = ( screenwid, 0 ) +botm = ( screenwid `div` 2, 0 ) +center = ( screenwid `div` 2, screenht `div` 2 ) + +leftmb = ( 0, screenht `div` 4 ) +leftmt = ( 0, (screenht*3) `div` 4 ) +topml = ( screenwid `div` 4, screenht ) +topmr = ( (screenwid*3) `div` 4, screenht ) +rightmt = ( screenwid, (screenht*3) `div` 4 ) +rightmb = ( screenwid, screenht `div` 4 ) +botml = ( screenwid `div` 4, 0 ) +botmr = ( (screenwid*3) `div` 4, 0 ) + + -- Colors values set to names + +white :: Color +white = 1 +black :: Color +black = 2 +red :: Color +red = 4 +green :: Color +green = 6 +darkblue :: Color +darkblue = 8 +lightblue :: Color +lightblue = 10 +yellow :: Color +yellow = 12 +brown :: Color +brown = 14 + +colorName :: Color -> String +colorName 1 = "white" +colorName 2 = "black" +colorName 4 = "red" +colorName 6 = "green" +colorName 8 = "blue" +colorName 10 = "lightblue" +colorName 12 = "yellow" +colorName 14 = "brown" + +allColors :: [Color] +allColors = [1,2,4,6,8,10,12,14] + + + + + diff --git a/progs/demo/X11/animation/r_constants.hu b/progs/demo/X11/animation/r_constants.hu new file mode 100644 index 0000000..d61580f --- /dev/null +++ b/progs/demo/X11/animation/r_constants.hu @@ -0,0 +1,3 @@ +:o= all +r_constants.hs +r_ptypes.hu diff --git a/progs/demo/X11/animation/r_curve.hs b/progs/demo/X11/animation/r_curve.hs new file mode 100644 index 0000000..14d288c --- /dev/null +++ b/progs/demo/X11/animation/r_curve.hs @@ -0,0 +1,60 @@ +{-************************************************************** + MODULE R_CURVE + + This module produces sequences of numbers to be used by + Behaviours. The sequences used for moving or scaling can + be produced here, in either linear sequences or accelerating + and decelerating sequences. + The acceleration functions produce floats, so the vftov function + would have to be used to convert floating point vectors to integer + vectors. + +***************************************************************-} + +module R_Curve(lnr,hold, acc, dec, accdec, decacc) where + +import R_Ptypes +import R_Constants +import R_Utility +import R_Picture +import R_Behaviour + + -- lnr takes the start, finish and the number of intervals and + -- produces a linear list of ints going from the start to finish. +lnr :: Int -> Int -> Int ->[Int] +lnr start fin n = take n [start,(start+step)..] + where step = ((fin-start)`div`(n-1)) + + -- hold produces an infinite number of ints starting at v, modified + -- by step every time. +hold :: Int -> Int -> [Int] +hold v step = [v,v+step..] + + -- acc accelerates from 0 to the max in n steps. +acc :: Int -> Int -> Int -> [Int] +acc min max n = min:acc' min (max-min) n 1 + +acc' :: Int -> Int -> Int -> Int -> [Int] +acc' min max n c | (c>n) = [] +acc' min max n c = (min + (((max*c*c) `div` (n*n)))) + : (acc' min max n (c+1)) + + + -- dec decelerates from the max to 0 in n steps. +dec :: Int -> Int -> Int -> [Int] +dec min max n = reverse (acc min max n) + + -- accdec accelerates from start up to max and back to fin, in an steps + -- accelerating and dn steps decelerating +accdec :: Int -> Int -> Int -> Int -> Int -> [Int] +accdec start max fin an dn = (acc start max an)++(tail (dec fin max dn)) + + -- decacc decelerates from start to min in dn steps and then accelerates + -- back up to fin in an more steps +decacc :: Int -> Int -> Int -> Int -> Int -> [Int] +decacc start min fin dn an = (dec min start dn)++(tail (acc min fin an)) + + + + + diff --git a/progs/demo/X11/animation/r_curve.hu b/progs/demo/X11/animation/r_curve.hu new file mode 100644 index 0000000..9aa9629 --- /dev/null +++ b/progs/demo/X11/animation/r_curve.hu @@ -0,0 +1,3 @@ +:o= all +r_curve.hs +r_behaviour.hu diff --git a/progs/demo/X11/animation/r_defaults.hs b/progs/demo/X11/animation/r_defaults.hs new file mode 100644 index 0000000..1b7070a --- /dev/null +++ b/progs/demo/X11/animation/r_defaults.hs @@ -0,0 +1,76 @@ +{-**************************************************************** + MODULE R_DEFAULTS + + This module uses the R_Behaviour module to define convient and + easy to use behaviours. These aren't very sophistated, but they + can be used to quickly animate a movie. For more sophistated + animation, a similiar library of sophistocated personnalized + functions can be created. + +******************************************************************-} + +module R_Defaults (big, huge, bigger, smaller, ccw, cw, + up, down, left, right,small,tiny) +where + +import R_Ptypes +import R_Constants +import R_Utility +import R_Picture +import R_Behaviour + + + -- big scales everything up by the scaleunit (now 12/11ths) +big :: Behaviour +big = [scale_Pic x | x <- [scaleunit,scaleunit..]] + + -- huge scales everything up by twice the scaleunit (24/11ths) +huge :: Behaviour +huge= [scale_Pic x | x <- [scaleunit*2,(scaleunit*2)..]] + + -- small scales everything down by 10/11ths +small :: Behaviour +small = [scale_Pic x | x <- [s,s..]] + where s = 10 + + -- tiny scales everything down by 5/11ths +tiny :: Behaviour +tiny = [scale_Pic x | x <- [s,s..]] + where s = 5 + + -- bigger causes the Pics to be scaled up by 12/11ths,24/11ths,36/11ths + -- and so on, everincreasing. +bigger :: Behaviour +bigger = [scale_Pic x | x <- (rept (\x -> div (x*scaleunit) 11) 1)] + + -- smaller causes the Pics to be scaled downwards in ever decreasing + -- amounts. +smaller :: Behaviour +smaller = [scale_Pic x | x <- (rept (\x -> div (x*10) 11) 1)] + + -- a hardwired version of ccw that rotates the Pics by one rotunit + -- more every Pic, counterclockwise. +ccw :: Behaviour +ccw = [twist_Pic x | x <- [0.0,rotunit..]] + + -- same as ccw, but rotates the Pics clockwise +cw :: Behaviour +cw = [twist_Pic x | x <- [0.0,-rotunit..]] + + -- moves the Pic up by one more unit every Pic. +up :: Behaviour +up = [mov_Pic (x,y) | (x,y)<- zip2 [0,0..] [0,unit..]] + + -- moves the Pic down by one more unit every Pic. +down :: Behaviour +down = [mov_Pic (x,y) | (x,y)<-zip2 [0,0..] [0,-unit]] + + -- moves the Pic left by one more unit every Pic. +left :: Behaviour +left = [mov_Pic (x,y) | (x,y)<- zip2 [0,-unit..] [0,0..]] + + -- moves the Pic right by one more unit every Pic. +right :: Behaviour +right = [mov_Pic (x,y) | (x,y)<- zip2 [0,unit..] [0,0..]] + + diff --git a/progs/demo/X11/animation/r_defaults.hu b/progs/demo/X11/animation/r_defaults.hu new file mode 100644 index 0000000..f945bbc --- /dev/null +++ b/progs/demo/X11/animation/r_defaults.hu @@ -0,0 +1,3 @@ +:o= all +r_defaults.hs +r_behaviour.hu diff --git a/progs/demo/X11/animation/r_display.hs b/progs/demo/X11/animation/r_display.hs new file mode 100644 index 0000000..19f1d4a --- /dev/null +++ b/progs/demo/X11/animation/r_display.hs @@ -0,0 +1,114 @@ +module R_Display (displaym) where + +import R_Ptypes +import R_Utility +import Xlib +import R_Constants + +displaym :: String -> Int -> Movie -> IO () + +displaym host n movie = + let + movie' = cycle (take n (map (map translatePoly) movie)) + in + xOpenDisplay host + `thenIO` \ display -> + let (screen:_) = xDisplayRoots display + fg_color = xScreenBlackPixel screen + bg_color = xScreenWhitePixel screen + color_map = xScreenDefaultColormap screen + getPixels [] = returnIO [] + getPixels (c:cs) = + xLookupColor color_map c `thenIO` \ (xc, _) -> + xAllocColor color_map xc `thenIO` \ (p,_,_) -> + getPixels cs `thenIO` \ ps -> + returnIO (p:ps) + in + getPixels (map colorName allColors) + `thenIO` \ pixels -> + let + lookupPixel c = lookupPixel1 c allColors pixels + + lookupPixel1 x [] _ = head pixels + lookupPixel1 x (c:cs) (p:ps) = + if x == c then p + else lookupPixel1 x cs ps + parent = xScreenRoot screen + in + xMArrayCreate [lookupPixel i | i <- [0..15]] + `thenIO` \ pixelArray -> + xCreateGcontext (XDrawWindow parent) + [XGCBackground bg_color, + XGCForeground fg_color] + `thenIO` \ gcontext -> + xCreateGcontext (XDrawWindow parent) + [XGCBackground bg_color, + XGCForeground bg_color] + `thenIO` \ blank_gcontext -> + xCreateWindow parent + (XRect 100 100 500 500) + [XWinBackground bg_color, + XWinEventMask (XEventMask [XButtonPress])] + `thenIO` \window -> + let depth = xDrawableDepth (XDrawWindow window) + in + xCreatePixmap (XSize 500 500) depth (XDrawWindow parent) + `thenIO` \ pixmap -> + xMapWindow window + `thenIO` \() -> + let + dispFrame m = + xDrawRectangle (XDrawPixmap pixmap) + blank_gcontext + (XRect 0 0 500 500) + True + `thenIO_` + dispPic m + `thenIO_` + xCopyArea (XDrawPixmap pixmap) gcontext (XRect 0 0 500 500) + (XDrawWindow window) (XPoint 0 0) + `thenIO_` + xDisplayForceOutput display + + dispPic [] = returnIO () + dispPic (p:ps) = dispPoly p `thenIO_` dispPic ps + + dispPoly (c, vec) = +-- xLookupColor color_map (colorName c) `thenIO` \ ec -> +-- xAllocColor color_map ec `thenIO` \ p -> + xMArrayLookup pixelArray c `thenIO` \p -> + xUpdateGcontext gcontext [XGCForeground p] `thenIO` \ () -> +-- xSetGcontextForeground gcontext (lookupPixel c) `thenIO` \ () -> + xDrawLines (XDrawPixmap pixmap) gcontext vec True + + untilButton3 (frame:frames) = + let + action = dispFrame frame `thenIO_` untilButton3 frames + in + xEventListen display `thenIO` \count -> + if count == 0 then action else + xGetEvent display `thenIO` \event -> + case (xEventType event) of + XButtonPressEvent -> + case (xEventCode event) of + 3 -> returnIO () + _ -> action + _ -> action + in + printString ("Click right button to end.\n") `thenIO_` + untilButton3 movie' `thenIO_` + xFreePixmap pixmap `thenIO_` + xCloseDisplay display + +type Movie' = [Pic'] +type Pic' = [Poly'] +type Poly' = (Int, [XPoint]) + +translatePoly :: Poly -> Poly' +translatePoly (c, vs) = (c, flatten_2 vs) + +flatten_2 [] = [] +flatten_2 ((a,b):r) = (XPoint (a `div` 2) (b `div` 2)):(flatten_2 r) + +printString :: String -> IO () +printString s = appendChan "stdout" s abort (returnIO ()) diff --git a/progs/demo/X11/animation/r_display.hu b/progs/demo/X11/animation/r_display.hu new file mode 100644 index 0000000..23f2c77 --- /dev/null +++ b/progs/demo/X11/animation/r_display.hu @@ -0,0 +1,6 @@ +:o= foldr inline constant +r_constants.hu +r_utility.hu +r_ptypes.hu +r_display.hs +$HASKELL_LIBRARY/X11/xlib.hu diff --git a/progs/demo/X11/animation/r_inbetween.hs b/progs/demo/X11/animation/r_inbetween.hs new file mode 100644 index 0000000..a7fb7d3 --- /dev/null +++ b/progs/demo/X11/animation/r_inbetween.hs @@ -0,0 +1,82 @@ +{-****************************************************************** + MODULE R_INBETWEEN + + This module takes care of interpolation functions. Basically, + given two Pics, inbetween will give you a movie gradually + converting from one Pic to the other Pic, using linear interpolation. + Tween will take two Movies, and append them, interpolating n + frames between the last Pic of the first Movie and the first Pic of + the last Movie. + +******************************************************************-} + +module R_Inbetween (inbetween,tween) where + +import R_Ptypes +import R_Utility +import R_Picture +import R_Behaviour + + -- inbetween takes an int and two Pics, and interpolates n Pics + -- of interpolated Pics. +inbetween :: Int -> Pic -> Pic -> Movie +inbetween n p1 p2 | (length p1 == length p2) = + ((zip1.(map (inbetweenp n))).zip1) [p1,p2] +inbetween n p1 p2 = inbetween n [(col,p1')] [(col,p2')] + where p1' = concat [ vs | (c,vs) <- p1] + p2' = concat [ vs | (c,vs) <- p2] + col = head [ c | (c,vs) <- p1 ] + + -- inbetweenp takes a list of 2 Polygons ([[Vec]]) and returns a + -- sequence of interpolated Polygons. Should the Number of vertices + -- of one Polygon be less than those in the other, it splits it so + -- as to have two Polygons of the same length. +inbetweenp :: Int -> Pic -> Pic +inbetweenp n [(c1,vs),(c2,ws)] = + if ((length vs) < (length ws)) then + inbetween1 (split (length ws) (c1,vs)) (c2,ws) 0 n + else if ((length vs) > (length ws)) then + inbetween1 (c1,vs) (split (length vs) (c2,ws)) 0 n + else inbetween1 (c1,vs) (c2,ws) 0 n + + + -- inbetween1 returns a sequence of interpolated Polygons. +inbetween1 :: Poly -> Poly -> Int -> Int -> Pic +inbetween1 p1 p2 m n | m>n || n<=0 = [] +inbetween1 p1 p2 m n = inbetween2 p1 p2 m n + :inbetween1 p1 p2 (m+1) n + + -- inbetween2 returns ONE of the required sequence of + -- interpolated Polygons. +inbetween2 :: Poly -> Poly -> Int -> Int -> Poly +inbetween2 (c1,vs) (c2,ws) p q = (c1, map (partway p q) (zip1 [vs,ws])) + + -- split splits up a Polygon so as to have the given #vertices. +split :: Int -> Poly -> Poly +split n (c,vs) = (c, split' n vs) + +split' :: Int -> [Vec] -> [Vec] +split' n vs | n<= (length vs) = vs +split' n vs = if (n>double) then + split' n (split' double vs) + else + v1:(mid v1 v2):(split' (n-2) (v2:vss)) + where double = 2*((length vs)) - 1 + (v1:v2:vss) = vs + + + -- tween will interpolate n Pics transforming the last Pic of + -- the first Movie into the first Pic of the second Movie, and + -- then run the second Movie +tween :: Int -> Movie -> Movie -> Movie +tween n m1 [] = m1 +tween n m1 m2 = m1 ++ (inbetween n (last m1) (head m2')) ++ (tail m2') + where m2' = apply (mov (repeat v)) m2 + v = vmin (orig_Pic (last m1)) (orig_Pic (head m2)) + + -- tweens will take a list of Movies and append them all, interpolating + -- n frames between every Movie. +tweens :: Int -> [Movie] -> Movie +tweens n = foldr (tween n) [] + + diff --git a/progs/demo/X11/animation/r_inbetween.hu b/progs/demo/X11/animation/r_inbetween.hu new file mode 100644 index 0000000..52771d0 --- /dev/null +++ b/progs/demo/X11/animation/r_inbetween.hu @@ -0,0 +1,3 @@ +:o= all +r_inbetween.hs +r_behaviour.hu diff --git a/progs/demo/X11/animation/r_movie.hs b/progs/demo/X11/animation/r_movie.hs new file mode 100644 index 0000000..a97a452 --- /dev/null +++ b/progs/demo/X11/animation/r_movie.hs @@ -0,0 +1,114 @@ +{-********************************************************************* + MODULE R_MOVIE + + This module contains necessary functions for editing Movies. There + are several that give information on a Movie, such as the heights or + wirdths of its Pics. The others all deal with the various ways of + combining various Movies into one Movie, a vital set of functions. + +*********************************************************************-} + +module R_Movie (ht, wid, orig, + above, rABOVE, beside, rBESIDE,rBESIDE2, over, rOVER, + overlay, rOVERLAY, pUT, + uncurry, curry + ) where + +import R_Ptypes +import R_Constants +import R_Utility +import R_Picture + + -- takes a function and a list and returns a new list of element operated + -- on by the function. +promote:: (a->b)->[a]->[b] +promote f [] = [] +promote f [p] = f p:promote f [p] +promote f (p:ps) = f p:promote f ps + + -- promote1 takes a function that analyzes a Pic, and then applies it + -- to analyse a movie, returning a list. +promote1:: (Pic->a) -> Movie -> [a] +promote1 f ps = [f p | p <- ps] + + -- ht takes a Movie and returns a list of the heights of the Pics +ht :: Movie -> [Int] +ht = promote1 ht_Pic + + -- wid takes a Movie and returns a list of the widths of the Pics +wid :: Movie -> [Int] +wid = promote1 wid_Pic + + -- orig takes a Movie and returns a list of vectors that are the + -- origins of the Pics +orig:: Movie -> [Vec] +orig = promote1 orig_Pic + + -- promote2 takes a function accepting an element and a Pic, and + -- applies the function to the Movie and list, producing a new Movie +promote2:: (a->Pic->Pic) -> [a] -> Movie -> Movie +promote2 f ps qs = [f p q | (p,q) <- zip2 ps qs] + + -- takes two Movies and puts them above one another +above:: Movie -> Movie -> Movie +above = promote2 above_Pic + + -- takes a list of Movies and puts them all above one another +rABOVE:: [Movie] -> Movie +rABOVE = reduce above + + -- takes two Movies and puts them beside one another +beside:: Movie -> Movie -> Movie +beside = promote2 beside_Pic + + -- takes a list of Movies and puts them all beside one another +rBESIDE:: [Movie] -> Movie +rBESIDE = reduce beside + + -- same as beside, but with absolute coordinates. +beside2:: Movie -> Movie -> Movie +beside2 = promote2 beside2_Pic + + -- same as rBESIDE, but with absolute coordinates. +rBESIDE2:: [Movie] -> Movie +rBESIDE2 = reduce beside2 + + -- puts one Movie on top of the other Movie +over:: Movie -> Movie -> Movie +over = promote2 over_Pic + + -- takes a list of Movies, and puts the n-th on top of the first + -- through 9n-1)th. +rOVER:: [Movie] -> Movie +rOVER = reduce over + + -- just overlays the two Movies by appending the Pics. +overlay:: Movie -> Movie -> Movie +overlay = promote2 overlay_Pic + + -- overlays a list of Movies by appending the Pics +rOVERLAY:: [Movie] -> Movie +rOVERLAY = reduce overlay + + -- promote3 takes a function that takes two items and a Pic and + -- returns a Pic, and then applies it to two input lists and a Movie, + -- producing a new Movie. +promote3:: (a->b->Pic->Pic) -> [a] -> [b] -> Movie -> Movie +promote3 f ps qs rs = [f p q r | (p,q,r) <- zip3 ps qs rs] + + -- pUT takes a list of Vectors, and puts each Pic of the first Movie + -- in the location of the corresponding vector, on top of the Pic of + -- the second Movie, and returns that list as a new Movie. +pUT:: [Vec] -> Movie -> Movie -> Movie +pUT = promote3 put_Pic + + -- uncurry takes a function that takes two elements and a list of + -- two elements and applies the function to them. +uncurry:: (a->a->b) -> [a] -> b +uncurry f [a,b] = f a b + + -- curry takes a function that takes a list, and two elements, and + -- then applies the function to the elements in a list. +curry:: ([a]->b) -> a -> a -> b +curry f a b = f [a,b] + diff --git a/progs/demo/X11/animation/r_movie.hu b/progs/demo/X11/animation/r_movie.hu new file mode 100644 index 0000000..0023a04 --- /dev/null +++ b/progs/demo/X11/animation/r_movie.hu @@ -0,0 +1,3 @@ +:o= all +r_movie.hs +r_picture.hu diff --git a/progs/demo/X11/animation/r_picture.hs b/progs/demo/X11/animation/r_picture.hs new file mode 100644 index 0000000..ed3a50f --- /dev/null +++ b/progs/demo/X11/animation/r_picture.hs @@ -0,0 +1,188 @@ +{-************************************************************ + MODULE R_PICTURE + + This module contains all the functions that can be used to manipulate + Pic's. The user will probably never use any of these functions. They + are used by Behaviours and such higher-order functions, which apply + these routines to all the Pic's in the list. + +*************************************************************-} + +module R_Picture (close_Pic, ht_Pic, wid_Pic, orig_Pic, + overlay_Pic, put_Pic, over_Pic, above_Pic, beside_Pic, + map_Pic,beside2_Pic, + scale_Pic, scale_rel_Pic, mov_Pic, rot_Pic, twist_Pic, + twist_Pic', flipx_Pic, flipy_Pic, flip_Pic, {- flock_Pic, -} + set_Color_Pic, + to_orig_Pic, + movto_Pic + ) where + +import R_Ptypes +import R_Constants +import R_Utility + + -- close_Pic makes sure that the polygon is closed +close_Pic:: Pic -> Pic +close_Pic p = map close_Poly p + where + close_Poly (c,ply) | (head ply) == (last ply) = (c,ply) + close_Poly (c,ply) = (c,ply++(tail (reverse ply))) + + --these functions find the max and min x and y coordinates of a Pic +maxx :: Pic -> Int +maxx p = reduce max [x | (c,q) <- p, (x,y) <- q] + +minx :: Pic -> Int +minx p = reduce min [x | (c,q) <- p, (x,y) <- q] + +maxy :: Pic -> Int +maxy p = reduce max [y | (c,q) <- p, (x,y) <- q] + +miny :: Pic -> Int +miny p = reduce min [y | (c,q) <- p, (x,y) <- q] + + -- these functions find the height, width and origin of a Pic +ht_Pic :: Pic -> Int +ht_Pic p = (maxy p) - (miny p) + +wid_Pic :: Pic -> Int +wid_Pic p = (maxx p) - (minx p) + +orig_Pic:: Pic -> Vec +orig_Pic p = ( (maxx p + minx p) `div` 2, (maxy p + miny p) `div` 2 ) + +-- PICTURE COMBINING OPERATIONS: + + -- overlay_Pic just takes 2 Pics and puts them together into one +overlay_Pic:: Pic -> Pic -> Pic +overlay_Pic p q = p ++ q + + -- put_Pic overlays the Pics, offsetting the first Pic by a vector + -- amount from the origin of the second +put_Pic:: Vec -> Pic -> Pic -> Pic +put_Pic v p q = overlay_Pic + (movto_Pic (vplus (orig_Pic q) v) p ) + q + + -- over_Pic puts one Pic directly on top of the other +over_Pic:: Pic -> Pic -> Pic +over_Pic p q = put_Pic (0,0) p q + + -- above_Pic puts the first Pic on top of the second +above_Pic:: Pic -> Pic -> Pic +above_Pic p q = put_Pic (0,(((ht_Pic q) + (ht_Pic p)) `div` 2)) p q + + -- beside_Pic puts the first Pic beside the second. The width of + -- the Pic is defined as the max x minus the min x, so a moving + -- figure will stand still in this implementation +beside_Pic:: Pic -> Pic -> Pic +beside_Pic p q = put_Pic (((wid_Pic q)+(wid_Pic p)) `div` 2, 0) p q + + -- beside2_Pic puts the first Pic beside the second, without + -- shifting to the width of the Pic. It uses the absolute coordinates. +beside2_Pic:: Pic -> Pic -> Pic +beside2_Pic p q = put ((wid_Pic q), 0) p q + where put v p q = overlay_Pic (mov_Pic v p) q + + + -- The following maps a given function over the Vector-list of each Polygon: +map_Pic:: (Vec -> Vec) -> Pic -> Pic +map_Pic f p = map f' p + where f' (c,vs) = (c, map f vs) + +-- THE GEOMETRIC TRANSFORMATIONS: + + -- scales the Pic by r, where r is in units of 11th. ie r=1, the Pic is + -- scaled by 1/11 to its origin. +scale_Pic :: Int -> Pic -> Pic +scale_Pic r p + = map_Pic (scalep r) p + where scalep r (v1,v2) = (div ((r*(v1-dx))+dx) 11,div ((r*(v2-dy))+dy) 11) + dx = fst (orig_Pic p) + dy = snd (orig_Pic p) + + -- this is another scaling function, but it centers the image at the Vec +scale_rel_Pic :: Vec -> Int -> Pic -> Pic +scale_rel_Pic v r + = map_Pic (scalep r) + where scalep r (v1,v2) = (div ((r*(v1-dx))+dx) 11,div ((r*(v2-dy))+dy) 11) + dx = fst v + dy = snd v + + -- moves a Pic by the vector amount +mov_Pic:: Vec -> Pic -> Pic +mov_Pic v = map_Pic (vplus v) + + -- moves a Pic to the vector +movto_Pic:: Vec -> Pic -> Pic +movto_Pic v p = mov_Pic (vmin v (orig_Pic p)) p + + -- moves the origin of the Pic to the lower left side of the Pic +to_orig_Pic:: Pic -> Pic +to_orig_Pic p = mov_Pic (-mx,-my) p + where mx = minx p + my = miny p + + -- rotates the Pic about the Vector by theta +rot_Pic :: Vec -> Float -> Pic -> Pic +rot_Pic (a,b) theta + = map_Pic (rotp (a,b) theta) + where rotp (a,b) t (v1,v2) + = vftov (a2+ (u * cos theta - v * sin theta), + b2+ (u * sin theta + v * cos theta)) + where u = u1 -a2 + v = u2 -b2 + (u1,u2) = vtovf (v1,v2) + (a2,b2) = vtovf (a,b) + + -- rotates a Pic about its origin by theta +twist_Pic :: Float -> Pic -> Pic +twist_Pic theta p = rot_Pic (orig_Pic p) theta p + + + -- hardwired version of rot_Pic that runs faster by rotating a set + -- unit, the rotunit, every time +rot_Pic':: Vec -> Pic -> Pic +rot_Pic' (a,b) = map_Pic (rotp (a,b)) + where rotp (a,b) (v1,v2) + = vftov (a2+ (u * cosunit - v * sinunit), + b2+ (u * sinunit + v * cosunit)) + where u = u1-a2 + v = u2-b2 + (u1,u2) = vtovf (v1,v2) + (a2,b2) = vtovf (a,b) + + -- hardwired version of twist_Pic that runs faster using rot_Pic' +twist_Pic':: Pic -> Pic +twist_Pic' p = rot_Pic' (orig_Pic p) p + + -- flips the Pic about the line x=n (x-coordinates change) +flipx_Pic :: Int -> Pic -> Pic +flipx_Pic n = map_Pic (flipvx n) + where + flipvx n (a,b) = (2*(n-a)+a,b) + + -- flips the Pic about the line y=n (y-coordinates change) +flipy_Pic :: Int -> Pic -> Pic +flipy_Pic n = map_Pic (flipvy n) + where + flipvy n (a,b) = (a, 2*(n-b)+b) + + -- flips the Pic about its own x origin. +flip_Pic:: Pic -> Pic +flip_Pic p = map_Pic (flipvx x) p + where (x,y) = orig_Pic p + flipvx n (a,b) = (2*(n-a)+a,b) + + -- copies the Pic into another Pic n*n times in an n by n array pattern +flock_Pic :: Int -> Pic -> Pic +flock_Pic 1 p = p +flock_Pic (n+2) p = beside_Pic (flock_Pic (n-1) p) (row n p) + where row n p = replicate n above_Pic nullpic p + + -- changes the color of the Pic +set_Color_Pic:: Color -> Pic -> Pic +set_Color_Pic c p = map f p + where f (c',vs) = (c,vs) + diff --git a/progs/demo/X11/animation/r_picture.hu b/progs/demo/X11/animation/r_picture.hu new file mode 100644 index 0000000..932d87c --- /dev/null +++ b/progs/demo/X11/animation/r_picture.hu @@ -0,0 +1,4 @@ +:o= all +r_picture.hs +r_constants.hu +r_utility.hu diff --git a/progs/demo/X11/animation/r_ptypes.hs b/progs/demo/X11/animation/r_ptypes.hs new file mode 100644 index 0000000..c020f82 --- /dev/null +++ b/progs/demo/X11/animation/r_ptypes.hs @@ -0,0 +1,67 @@ +{-*********************************************************************** + MODULE PTYPES + + This module contains the definitions for all the basic datatypes used to + create functional movies. + The basis of all the images is the Poly, which is a tuple of a color + and a list of points. This is displayed as a polygon of that color. The + form is a line drawn to each of the points, in order. + A list of these Poly's is a Pic, or picture. Each picture is a single + frame of the movie. A list of Pic's makes up a Movie, which is a series + of Pic's displayed in order. + Behaviours affect the movies, such as moving them left, or right. + PictoPic's affect a single picture. + The other functions simply convert regular values such as integers + and floats to the datatypes used by the functional programming. + +************************************************************************-} + + +module R_Ptypes (Vec(..), Color(..), Pic(..), Poly(..), Movie(..), Behaviour(..), PictoPic(..), Process(..), + Vecfloat(..), + Msg(..), Chan(..), + Val (..), + ntov, vtov, nstov, vstov, pstov, bstov + ) where + + + --These are the basic data types for storing and manipulating the movies. + +type Vec = (Int,Int) +type Color = Int +type Pic = [Poly] +type Poly = (Color,[Vec]) +type Movie = [Pic] +type Behaviour = [Pic -> Pic] +type PictoPic = Pic -> Pic + +type Process = [Msg] -> [Msg] +type Msg = [(Chan,Val)] +type Chan = [Char] + +data Val = N Int | V (Int,Int) | P Pic | B PictoPic + +type Vecfloat = (Float,Float) + + + +--Those convert from the various regular values to Val's. + +ntov n = N n + +vtov:: Vec -> Val +vtov v = V v + +ptov:: Pic -> Val +ptov p = P p + +nstov ns = [N n|n<-ns] + +vstov:: [Vec] -> [Val] +vstov vs = [V v|v<-vs] + +pstov:: [Pic] -> [Val] +pstov ps = [P p|p<-ps] + +bstov:: [PictoPic] -> [Val] +bstov bs = [B b|b<-bs] diff --git a/progs/demo/X11/animation/r_ptypes.hu b/progs/demo/X11/animation/r_ptypes.hu new file mode 100644 index 0000000..8a99f8f --- /dev/null +++ b/progs/demo/X11/animation/r_ptypes.hu @@ -0,0 +1,2 @@ +:o= all +r_ptypes.hs diff --git a/progs/demo/X11/animation/r_shapes.hs b/progs/demo/X11/animation/r_shapes.hs new file mode 100644 index 0000000..aef3362 --- /dev/null +++ b/progs/demo/X11/animation/r_shapes.hs @@ -0,0 +1,38 @@ +{-***************************************************************** + MODULE R_SHAPES + + This modules produces Pic's of boxes and triangles to help build + Pic's to animate. + +******************************************************************-} + +module R_Shapes (box, tri, circ_mov, circ) where + +import R_Ptypes +import R_Utility +import R_Picture +import R_Behaviour + + -- box takes four three ints, the color, width and height of the box and + -- returns a Pic of a box +box :: Int -> Int -> Int -> Pic +box c width height= [(c,[(0,0),(width,0),(width,height),(0,height),(0,0)])] + + -- tri takes a color and three vectors, and returns a Pic of a triangle + -- with the vectors as vertices +tri:: Color -> Vec -> Vec -> Vec -> Pic +tri c (x1,y1) (x2,y2) (x3,y3) = [(c,[(x1,y1),(x2,y2),(x3,y3),(x1,y1)])] + + + -- circ takes a color, the radius +circ :: Color -> Int -> Int -> Pic +circ c r inc = [(c,(r+r,r):(circ' r' inc' 1.0))] + where r' = (fromIntegral r) + inc' = (fromIntegral inc) + +circ' :: Float -> Float -> Float -> [Vec] +circ' r inc c | c>inc = [] +circ' r inc c = vftov (x+r,y+r) : (circ' r inc (c+1.0)) + where x = r*(cos((2*c*pi)/inc)) + y = r*(sin((2*c*pi)/inc)) + diff --git a/progs/demo/X11/animation/r_shapes.hu b/progs/demo/X11/animation/r_shapes.hu new file mode 100644 index 0000000..ad0bf40 --- /dev/null +++ b/progs/demo/X11/animation/r_shapes.hu @@ -0,0 +1,3 @@ +:o= all +r_shapes.hs +r_behaviour.hu diff --git a/progs/demo/X11/animation/r_utility.hs b/progs/demo/X11/animation/r_utility.hs new file mode 100644 index 0000000..9dfcc65 --- /dev/null +++ b/progs/demo/X11/animation/r_utility.hs @@ -0,0 +1,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) + + + + diff --git a/progs/demo/X11/animation/r_utility.hu b/progs/demo/X11/animation/r_utility.hu new file mode 100644 index 0000000..6fac189 --- /dev/null +++ b/progs/demo/X11/animation/r_utility.hu @@ -0,0 +1,3 @@ +:o= all +r_utility.hs +r_ptypes.hu diff --git a/progs/demo/X11/animation/seafigs.hs b/progs/demo/X11/animation/seafigs.hs new file mode 100644 index 0000000..c216a63 --- /dev/null +++ b/progs/demo/X11/animation/seafigs.hs @@ -0,0 +1,158 @@ +module Seafigs (sky,blue_sky,clouds,clouds2,gull,man,sun,vm,windmill,palm) where + +import Animation + +blue_sky:: Movie +blue_sky = osc [box lightblue 1000 1000] + +sky:: Color -> Movie +sky c = osc [box c 1000 1000] + +clouds2:: Movie +clouds2 = apply (mov (i (cld_wid,0))) (rBESIDE[cld,cld]) + where cld_wid = -(wid_Pic (cld!!0)) + cld= apply (bPar [right,mov (repeat (250,-50))]) cldm1 + cldm1=osc[cloud1] + +clouds:: Movie +clouds + = rOVERLAY + [apply (bPar [right,mov (repeat (250,-50))]) cloudm1, + apply (bPar [right,mov (repeat (0,-50))]) cloudm2, + apply (bPar [right,mov (repeat (250,-75))]) cloudm2, + apply (bPar [right,flipb,smaller,mov(repeat (200,-100))]) cloudm2, + apply (bPar [right,flipb,smaller,mov(repeat (300,-125))]) cloudm1, + apply (bPar [right,right,mov (repeat (-50,50))]) cloudm1] + where cloudm1 = osc [cloud1] + cloudm2 = osc [cloud2] + + +cloud1 = [(white,ply)] + where ply = [(142,301),(169,309),(180,315),(192,312), + (196,308),(202,302),(216,300),(224,308), + (238,312),(258,311),(274,301),(278,283), + (265,279),(246,279),(230,281),(197,286), + (185,288),(167,287),(148,287),(136,292), + (136,292),(142,301)] + + +cloud2 = [(white,ply)] + where ply = [(51,262), (56,266), + (66,265), (90,264), (92,266), (98,270), + (111,268),(137,268),(155,266),(174,266), + (183,262),(183,253),(162,251),(136,254), + (132,250),(126,248),(115,252),(109,253), + (98,252), (90,253), (88,254), (67,254), + (56,252), (49,254), (47,259), (51,262)] + +gull :: Movie +gull = osc [gull1,gull2] + +gull1 = [(black,[(2,4),(6,4),(9,2),(10,0),(11,2), + (16,4),(20,4)])] + +gull2 = [(black,[(0,0),(2,2),(6,3),(9,2),(12,3), + (16,2),(18,0)])] + +man :: Movie +man = osc [man1,man2,man3] + + +man1 = [(black,[(0,0),(10,0),(20,40),(30,60),(40,20), + (60,0),(50,0)]), + (black,[(0,40),(20,60),(30,80),(50,70),(60,60)]), + (black,[(30,60),(30,100)]), + (black,[(30,100),(25,100),(20,105),(23,112), + (20,115),(30,120),(35,120),(40,115), + (40,110),(35,105),(30,100)]) + ] + +man2 = [(black,[(20,0),(30,0),(20,40),(30,60),(45,30), + (60,20),(50,0)]), + (black,[(0,60),(20,60),(20,80),(40,80),(50,60)]), + (black,[(30,60),(20,100)]), + (black,[(20,100),(15,100),(10,105),(13,112), + (10,115),(20,120),(30,120),(30,115), + (30,110),(25,105),(20,100)]) + ] + +man3 = [(black,[(0,15),(5,10),(15,45),(30,60),(35,25), + (44,10),(35,0)]), + (black,[(10,40),(22,60),(20,80),(40,75),(45,44)]), + (black,[(30,60),(20,100)]), + (black,[(20,100),(19,100),(14,105),(17,112), + (14,115),(24,120),(34,120),(34,115), + (34,110),(29,105),(200,100)]) + ] + +sun :: Movie +sun = osc [sun'] + where + sun' = reduce overlay_Pic [sun1, + twist_Pic (pi/24.0) sun1, + twist_Pic (pi/12.0) sun1] + +sun1 = [(yellow,[(43,16),(18,27),(9,51),(20,71),(42,81), + (66,73),(76,47),(69,25),(43,15),(43,16)])] + +vm :: Movie +vm = osc[vm1,vm2] + +vm1 = beside_Pic (box brown 10 15) + (above_Pic light1 (box brown 40 80)) + where light1 = box yellow 10 10 + +vm2 = beside_Pic (box brown 10 15) + (reduce above_Pic [light,light2,box brown 40 80]) + where light2 = over_Pic (box red 10 10) (box white 5 5) + light = [ (red,[(5,5), (10,2), (0,30),(5,5)]), + (red,[(20,2),(25,5),(30,30),(20,2)]), + (red,[(15,15),(20,15),(15,50),(10,25)])] + +windmill :: Movie +windmill + = apply + (bpar (mov (repeat (unit*3,0))) (scale_rel (0,0) (repeat 3))) + (overlay body (apply (movto (repeat (100,400))) prop)) + +blade = osc [tri red (0,0) (100,0) (50,300)] +prop = apply cw fan + +fan = rOVERLAY [fan1,fan2,fan3,fan4] +fan1 = blade +fan2 = apply (rot (osc[(50,300)]) (osc[pi/2.0])) fan1 +fan3 = apply (rot (osc[(50,300)]) (osc[pi/2.0])) fan2 +fan4 = apply (rot (osc[(50,300)]) (osc[pi/2.0])) fan3 + +body = osc [ [(brown,[(0,0),(200,0),(170,300), + (100,400),(30,300),(0,0)]) ] ] + + +palm :: Movie +palm + = osc palms + where palms = inbetween 3 palm1 (flipx_Pic 100 palm1) + palm1 = reduce overlay_Pic [trunk,frond1,frond2,frond3,frond4] + where frond1 = [ (green,[(50,60),(60,70),(80,60)]), + (green,[(50,70),(60,80),(80,70)]), + (green,[(50,80),(55,90),(70,80)]), + (green,[(60,70),(55,90),(50,100)]) ] + + frond2 = flipx_Pic 50 frond1 + + frond3 = [ (green,[(10,70),(5,80)]), + (green,[(10,80),(10,90)]), + (green,[(20,90),(20,100)]), + (green,[(30,95),(40,104)]), + (green,[(5,80),(20,100),(40,104), + (50,100)])] + + frond4 = [(green,[(0,100),(5,110)]), + (green,[(15,105),(15,115)]), + (green,[(25,105),(30,115)]), + (green,[(35,105),(40,115)]), + (green,[(5,110),(30,115),(50,110), + (50,100)])] + + trunk = [(brown,[(100,0),(95,40),(80,80), + (70,90),(60,97),(50,100)])] diff --git a/progs/demo/X11/animation/seafigs.hu b/progs/demo/X11/animation/seafigs.hu new file mode 100644 index 0000000..83fcfcf --- /dev/null +++ b/progs/demo/X11/animation/seafigs.hu @@ -0,0 +1,3 @@ +:o= all +animation.hu +seafigs.hs diff --git a/progs/demo/X11/animation/seaside.hs b/progs/demo/X11/animation/seaside.hs new file mode 100644 index 0000000..fe11e12 --- /dev/null +++ b/progs/demo/X11/animation/seaside.hs @@ -0,0 +1,25 @@ +module Seaside (main) where + +import Animation +import Seafigs + +seaside :: Movie +seaside = rOVERLAY [blue_sky, + apply (bPar [up,cw,movto (repeat botm)]) sun, + apply right clouds, + apply (bPar [right,bigger]) gull, + apply (bPar [right,right,bigger]) gull, + apply (bPar [up,up,right,bigger]) gull, + apply (bPar [up,right,right,right]) gull, + windm, + apply (mov (repeat botm)) palm, + man_and_vm + ] + where man_and_vm = rBESIDE2 [manfig, vm] + manfig = apply left (apply (mov (i (700,0))) + man) + windm = apply (mov (i (500,0))) windmill + + +main = getEnv "DISPLAY" exit + (\ host -> displaym host 30 (map (flipy_Pic 500) seaside)) diff --git a/progs/demo/X11/animation/seaside.hu b/progs/demo/X11/animation/seaside.hu new file mode 100644 index 0000000..df2c4b9 --- /dev/null +++ b/progs/demo/X11/animation/seaside.hu @@ -0,0 +1,5 @@ +:o= all +seaside.hs +seafigs.hu + + |