10. An Animation Program

We are now in a position to write a LIFE animation program, lifeanimate, using character-based rather than GUI facilities. The structure of the program is similar to that of the file conversion program in section 7. It will use the abstract data type Lifestate defined in section 9.

MODULE lifeanimate;
IMPORT lifestate,lifeio;

The algebraic data type Command defines the possible interactive commands: move the viewing window to the centre of gravity of the picture (GoToCentre), erase the picture (Erase), print a help message (Help), quit the program (Quit), run the animation for a number of steps (Run), centre the viewing window on a specified point (GoTo), invert the state of a specified cell (ChgPnt), load a pattern from a file (Load), store a pattern to a file (Store) or write an Encapsulated PostScript picture of a pattern (PostScript). The dummy command Illegal is used to represent illegal user responses, and contains a string which represents an error message.

TYPE
:: FILENAME -> STRING;
:: Command -> GoToCentre | Erase | Help | Quit | Illegal !STRING | 
              Run !TRACKMODE !INT | GoTo !Pnt | ChgPnt !Pnt | 
              Load !FILENAME | Store !FILENAME | Pscript !FILENAME;

The following macros define the size of the viewing window (38 x 17), and the strings used to print live and dead cells on a character-based terminal. Figure 4 shows an example interaction with the program, including the printout of viewing windows.

MACRO
W -> 38;
H -> 17;
Star -> "* ";
Blank -> "  ";

CLEAN allows the user to provide rewrite rules on the constructors of an algebraic data type. We use this facility to rewrite terms of the Command type to Illegal in the case of errors. This is a useful general technique: it simplifies the interactive input/output by distributing some of the error-checking.

RULE
:: Run !TRACKMODE !INT -> Command;
   Run track i -> Illegal "Must have i>0", IF <= i 0;

:: Load !FILENAME -> Command;
   Load "" -> Illegal "Empty file name";

:: Store !FILENAME -> Command;
   Store "" -> Illegal "Empty file name";

:: Pscript !FILENAME -> Command;
   Pscript "" -> Illegal "Empty file name";

Two useful functions for input handling are SkipLine, which skips to the end of the input line, and SkipToSpace, which skips to the next white space, returning a boolean flag if end-of-line was reached:

:: SkipLine !UNQ FILE -> UNQ FILE;
   SkipLine f -> f',
                 (s, f'): FReadLine f;

:: SkipToSpace !UNQ FILE -> (!BOOL, !UNQ FILE);
   SkipToSpace f -> (TRUE, f'), IF =C ch '\n'
                 -> (FALSE, f'), IF =C ch ' ' || =C ch '\t'
                 -> SkipToSpace f',
                    (ok, ch, f'): FReadC f;

The next two functions print out in short and long form the possible user commands:

:: ShortCommands !UNQ FILE -> UNQ FILE;
   ShortCommands f 
     -> FWriteS s f,
        s: "H(elp  Q(uit  R i  T i  G x y  C  E  + x y  L f  S f  P f\n";

:: ShowCommands !UNQ FILE -> UNQ FILE;
   ShowCommands f 
    -> FWriteL msg f,
       msg: ["Legal Commands Are:\n",
             "\tH(elp        - display this Help message\n",
             "\tQ(uit        - quit the program\n",
             "\tR(un  i      - run for i steps\n",
             "\tT(rack  i    - run for i steps in tracking mode\n",
             "\tG(oto  x  y  - move window so (x,y) is centred\n",
             "\tC(entre      - move window to centre of picture\n",
             "\tE(rase       - erase all cells\n",
             "\t+  x  y      - toggle state of (x,y) cell\n",
             "\tL(oad  f     - load picture from file f\n",
             "\tS(tore  f    - store picture to file f\n",
             "\tP(ostscr  f  - store PostScript picture to file f\n",
             "\n"];

The Readcommand function reads a command from an input file. Care must be taken to ensure single-threading. For example, access in a guard to a variable such as ok which is the result of a read operation forces that read operation to occur, in which case the value of the file before the read operation becomes inaccessible. The unique type mechanism ensures single-threading, but it is inadvisable to rely on this mechanism too heavily. Distributing some of the error-checking, as discussed above, assists in producing single-threaded code.

:: Readcommand !UNQ FILE -> (!Command, !UNQ FILE);
   Readcommand f 
     -> (Illegal "Blank Line", f'),    IF =C ch '\n'
     -> (GoToCentre, SkipLine f'),     IF =C ch 'C' || =C ch 'c'
     -> (Erase, SkipLine f'),          IF =C ch 'E' || =C ch 'e'
     -> (Help, SkipLine f'),           IF =C ch 'H' || =C ch 'h'
     -> (Quit, SkipLine f'),           IF =C ch 'Q' || =C ch 'q'

Up to this point, the first input character ch has been read, which makes f' the current file value. Examining the variable eol forces a SkipToSpace operation, making f'' the current file variable. From this, the file variable h is obtained by reading a filename s':

     -> (Illegal "No Arguments", f''), IF eol
     -> (Load s', h),                  IF =C ch 'L' || =C ch 'l'
     -> (Store s', h),                 IF =C ch 'S' || =C ch 's'
     -> (Pscript s', h),               IF =C ch 'P' || =C ch 'p'

Examining ok in a guard forces a number to be read. To ensure single-threading it is necessary to order the rules so that all subsequent rules permit a number to be read:

     -> (Run TRUE x, SkipLine g),      IF (=C ch 'T' || =C ch 't') && ok
     -> (Run FALSE x, SkipLine g),     IF (=C ch 'R' || =C ch 'r') && ok
     -> (GoTo (x,y), SkipLine g'),     IF (=C ch 'G' || =C ch 'g') 
                                                        && ok && ok'
     -> (ChgPnt (x,y), SkipLine g'),   IF =C ch '+' && ok && ok'
     -> (Illegal "Illegal Input", SkipLine g'), 

For the default rule, the current file value must be taken as g' since one or two numbers may already have been read as a result of examining ok or ok' in failed guards. The local definitions for Readcommand are:

        (dummy, ch, f'): FReadC (FWriteS "> " f),
        (eol, f''): SkipToSpace f',
        (s, h): FReadLine f'',
        s': GetFileName 0 s,
        (ok, x, g): FReadI f'',
        (ok', y, g'): FReadI g;

The GetFileName function strips away white space from around a filename in an input string. The function GetFileNameAux is called when the beginning of the filename is found: it searches for the end of the filename and extracts it from the string:

:: GetFileName !INT !STRING -> STRING;
   GetFileName i s 
     -> "", IF =C ch '\n'
     -> GetFileName (++ i) s, IF =C ch ' ' || =C ch '\t'
     -> GetFileNameAux i (++ i) s,
        ch: INDEX s i;

:: GetFileNameAux !INT !INT !STRING -> STRING;
   GetFileNameAux start j s
     -> SLICE s start (-- j), IF =C ch ' ' || =C ch '\t' || =C ch '\n'
     -> GetFileNameAux start (++ j) s,
        ch: INDEX s j;

Corresponding to the Help command, the following function prints a help message, and then calls ShowCommands:

:: DoHelp !UNQ FILE -> UNQ FILE;
   DoHelp f 
     -> ShowCommands f',
        f': FWriteL msg f,
        msg: ["Display shows step no, number of cells, picture size\n",
              "and centre, and window size.\n",
              "\n",
              "Initial state is DEAD (no cells) - to create a pattern\n",
              "use '+ x y' repeatedly, or 'L filename'\n",
              "\n"];

Corresponding to illegal commands, the following function prints an error message, and then calls ShowCommands:

:: DoIllegal !STRING !UNQ FILE -> UNQ FILE;
   DoIllegal mess f
     -> ShowCommands f',
        f': FWriteL msg f,
        msg: ["YOU HAVE ENTERED AN INVALID COMMAND (", mess, ")\n\n"];

The Statusline function gives a list of strings to be printed as part of the description of the current Life pattern. It shows the coordinates and properties of the pattern and the viewing window. The ability to manipulate strings in this way simplifies input/output.

:: Statusline Lifestate -> [STRING];
   Statusline s 
     -> ["#", ITOS (Stepno s),"    DEAD\n\n"], IF Dead s
     -> ["#", ITOS (Stepno s),"  ", ITOS (Numcells s), " Cells  ",
        Shstatus (Status s), "  Pic (", ITOS p, ",", ITOS q, ")-(", 
        ITOS u, ",", ITOS v, ")  CofG (", ITOS x, ",", ITOS y,
        ")  Win (", ITOS a, ",", ITOS b, ")-(", ITOS c, ",", 
        ITOS d, ")\n\n"],
        (a,b): e,
        (c,d): f,
        (e,f): Winrect s,
        (p,q): m,
        (u,v): n,
        (m,n): Picrect s,
        (x,y): CentOfGrav s;
                          
:: Shstatus Lifestatus -> STRING;
   Shstatus DEAD -> "DEAD";
   Shstatus STABLE -> "STABLE";
   Shstatus DYNAMIC -> "DYNAMIC";

The ShowRect function prints the viewing window, by using a recursive loop through relative coordinates (x,y) ranging from (0,0) to (w-1,h-1). The loop is started at (-1,0), with the negative coordinate used to signal the start of a line. When a coordinate (w,i) is reached, this signals the end of a line, and the scan continues with (-1,i+1). When the coordinates of a point in the given list are reached, a star is printed at that position. An unexpected failure in the ordering of the points list (which has been sorted at this point) causes abortion, using Concat to assemble an error message string.

:: ShowRect INT INT PntList !UNQ FILE -> UNQ FILE;
   ShowRect w h l f -> ShowRectAux -1 0 w h l f',  == start at x=-1, y=0
                       f': DashLine w f;

:: ShowRectAux !INT !INT !INT !INT PntList !UNQ FILE -> UNQ FILE;
   ShowRectAux x y w h l f
        -> FWriteC '\n' (DashLine w f), IF >= y h  == end of rectangle
        -> ShowRectAux -1 (++ y) w h l (FWriteS "|\n" f), IF >= x w
        -> ShowRectAux 0 y w h l (FWriteS "| " f), IF < x 0;
   ShowRectAux x y w h [] f 
        -> ShowRectAux (++ x) y w h [] (FWriteS Blank f);
   ShowRectAux x y w h l:[(x',y')|t] f 
        -> p:ShowRectAux (++ x) y w h l (FWriteS Blank f), IF < y y'
        -> q:ABORT (Concat ["Error in ShowRectAux at (" ,
                            ITOS x', ",", ITOS y', ")\n"]), IF > y y'
        -> p, IF < x x'  == now have y=y'
        -> q, IF > x x'
        -> ShowRectAux (++ x) y w h t (FWriteS Star f);
                         == now have x=x' and y=y'

:: DashLine !INT !UNQ FILE -> UNQ FILE;
   DashLine i f -> FWriteS "---\n" f, IF = 0 i
                -> DashLine (-- i) (FWriteS "--" f);

The Showstate operation prints the state of the current pattern (held in the Lifestate variable) to a file, and also prints the viewing window if the pattern is not dead:

:: Showstate Lifestate !UNQ FILE -> UNQ FILE;
   Showstate s f 
        -> f', IF Dead s
        -> ShowRect (Width s) (Height s) (Croppedpoints s) f',
           f': FWriteL (Statusline s) f;

The Loop operation performs the major user interaction. It uses Readcommand to read a user command, and calls LoopAux to perform the appropriate action, by pattern-matching. The parameters required are the current Lifestate s, the standard input-output file f, and the file system fs. The result is a modified file system, so the LoopAux function must take responsibility for closing the standard input/output file.

:: Loop !Lifestate !UNQ FILE !FILES -> !FILES;
   Loop s f fs -> LoopAux com s f'' fs,
                  f': ShortCommands f,
                  (com, f''): Readcommand f';

The LoopAux function pattern-matches on the various possible commands. It handles the Quit command by closing the standard input/output and terminating. The Help and Illegal commands result in the output of the messages defined above:

:: LoopAux Command !Lifestate !UNQ FILE !FILES -> !FILES;
   LoopAux Quit s f fs -> fs',
                          (dummy, fs'): FCloseStd f fs;

   LoopAux Help s f fs -> Loop s (DoHelp f) fs;

   LoopAux (Illegal mess) s f fs -> Loop s (DoIllegal mess f) fs;

The Erase, GoToCentre, GoTo and ChgPnt commands alter the current pattern using the appropriate abstract data type operations, then print the new state:

   LoopAux Erase s f fs -> Loop s' (Showstate s' f) fs,
                           s': Loadpoint [] s;

   LoopAux GoToCentre s f fs -> Loop s' (Showstate s' f) fs,
                                s': GoCentre s;

   LoopAux (GoTo pnt) s f fs -> Loop s' (Showstate s' f) fs,
                                s': CentreAt pnt s;

   LoopAux (ChgPnt pnt) s f fs -> Loop s' (Showstate s' f) fs,
                                  s': Changepoint ABSOLUTE pnt s;

The Load, Store, and Pscript commands handle input/output similarly to the lifeconvert program in section 7:

   LoopAux (Load name) s f fs 
     -> Loop s (FWriteL ["CAN'T OPEN FILE '",
                         name, "'\n"] f) fs', IF NOT ok
     -> Loop s (FWriteL ["NO CELLS FOUND IN FILE '",
                         name, "'\n"] f) fs'', IF = 0 (Numcells s')
     -> Loop s' (Showstate s' f) fs'',
       (ok, g, fs'): FOpen name FReadText fs,
       (pnts, g'):  ReadPtsList g,
       s':  Loadpoint pnts s,
       (ok', fs''): FClose g' fs';

   LoopAux (Store name) s f fs 
     -> Loop s (FWriteL ["CAN'T OPEN FILE '", name, "'\n"] f) fs', 
                                                        IF NOT ok
     -> Loop s (FWriteL ["CAN'T CLOSE FILE '", name, "'\n"] f) fs'', 
                                                        IF NOT ok'
     -> Loop s (FWriteS messg f) fs'',
        (ok, g, fs'): FOpen name FWriteText fs,
        g': WritePtsList (Allpoints s) g,
        (ok', fs''): FClose g' fs',
        messg: Concat ["Pattern written to file ", name, "\n"];

   LoopAux (Pscript name) s f fs
     -> Loop s (FWriteL ["CAN'T OPEN FILE '", name, "'\n"] f) fs', 
                                                        IF NOT ok
     -> Loop s (FWriteL ["CAN'T CLOSE FILE '", name, "'\n"] f) fs'', 
                                                        IF NOT ok'
     -> Loop s (FWriteS messg f) fs'',
        (ok, g, fs'): FOpen name FWriteText fs,
        g': WritePS head (Picrect s) (Allpoints s) g,
        head: Concat [name, "   ", ITOS (Numcells s),
                      " cells   step ", ITOS (Stepno s)],
        (ok', fs''): FClose g' fs',
        messg: Concat ["PostScript pattern written to file ",
                       name, "\n"];

The Run command prints a message if the existing pattern is already stable or dead, otherwise it executes the first step and calls DoRun. This function loops until the pattern becomes stable, or the desired number of steps is reached. It always prints the current viewing window before performing subsequent steps:

   LoopAux (Run track i) s f fs
     -> Loop s (FWriteS "\nPATTERN IS DEAD: NO CHANGE\n" f) fs, 
                                                        IF Dead s
     -> Loop s (FWriteS "\nPATTERN IS STABLE: NO CHANGE\n" f) fs,
                                                        IF Stable s
     -> DoRun track (-- i) (Trackstep track s) f fs;

:: DoRun !TRACKMODE !INT Lifestate !UNQ FILE !FILES -> FILES;
   DoRun track i s f fs 
     -> Loop s (FWriteS "DEAD\n" f) fs, IF Dead s
     -> Loop s (FWriteS "STABLE\n" f) fs, IF Stable s
     -> Loop s (FWriteS "STOPPED\n" (Showstate s f)) fs, IF = i 0
     -> DoRun track (-- i) (Trackstep track s) (Showstate s f) fs;

Finally the Start rule opens the file system and standard input/output file before calling the Loop function with an initially empty pattern. The file system is closed after Loop terminates:

:: Start UNQ WORLD -> UNQ WORLD;
   Start world
     -> world'',
        (file1, world'): OpenFiles world,
        (f, file2): StdIO file1,
        s: Emptystate W H,
        file3: Loop s (Showstate s f) file2,
        world'': CloseFiles file3 world';

UpTop Level

BackAn Abstract Data Type for Animating the Game of Life

ForwardSome Useful GUI Operations