/*  AWM.P  */


section $-awm => new_awm
                 awm_undefchar
                 ved_awm
                 awm_x_known_min awm_x_known_max
                 awm_y_known_min awm_y_known_max
                 awm_x_actual_min awm_x_actual_max
                 awm_y_actual_min awm_y_actual_max
                 awm_move_bug_to
                 awm_set_direction
                 awm_move
                 awm_left awm_right awm_forward awm_back
                 awm_forwardvector awm_rightvector awm_direction
                 awm_x awm_y
                 awm_position
                 awm_retina_coords_to_awm_coords
                 awm_awm_coords_to_retina_coords
                 awm_merge_retina
                 app_awm
                 awm_neighbour
                 awm_app_neighbours awm_app_vh_neighbours
                 awm_replace;


/*
SPECIFICATION
-------------

This module defines some routines and structures for Bugs to use when
storing information about their world in analogical form as a 2-D map of
the surroundings. I call the structures AWMs, for "array world-model".


Externally, an AWM looks like a 2-D array. Create one by calling
    new_awm( undefchar )
where 'undefchar' is the character to be stored in otherwise undefined
array elements.

Access it by subscripting:
    awm(3,4) =>
    `#` -> awm(x,y);
AWMs are mapped onto strings, so you'll get an error if you try to
store anything other than a character in them.

Their class_print is set to a line-by-line display routine, so the
print-arrow will automatically print the contents.

AWMs are flexible arrays. They are created with initial bounds running
from -10 to 10 in both dimensions. If you try to put a character outside
the present bounds, the array will be expanded automatically. If you try
to read outside the current bounds, or to read a location that hasn't
been set, you'll get the character indicating "undefined": this is the
undefchar argument to new_awm.

You can find out how much of an AWM is known using the routines
    awm_x_known_min awm_x_known_max
and
    awm_y_known_min awm_y_known_max
These delimit a rectangle for which at least one character in each line
and column is not undefined. Outside this rectangle, all the characters
are undefined. When an AWM is created, all characters are undefined.

You can discover the total size of an AWM by calling
    awm_x_actual_min awm_x_actual_max
    awm_y_actual_min awm_y_actual_max
These indicate the actual space allocated to the array. They are
completely irrelevant as far as finding out what information is in the
AWM, because an AWM is virtually infinite. However, you can use them to
calculate the amount of memory used - once your AWM gets too big, you
may want to discard some regions and begin again.

You can also use AWMs to keep track of the Bug's position. An AWM
contains internal coordinates and direction vectors corresponding for a
notional bug. You can change these with various routines, such as
awm_left and awm_forward, and can read out the resulting values. This
enables your Bug's world-model to keep track of the Bug itself. The
internal bug's coordinate system is as you would expect: north lies along
the Y axis, and corresponds to the forwardvector (0,1).         

AWMs are useful for tasks like finding paths between points, and
dividing the world into regions. Many of these are best done
analogically; for example, you can easily find regions by picking a
blank, flooding with some character until you hit obstructions on all
sides, and repeating until there are no blanks left. This module
therefore exports some routines for finding and processing the
neighbours of a point, and for replacing characters in an AWM.

Finally, there is a routine for merging the contents of a bug's retina
into an AWM.


PUBLIC new_awm( undefchar ):

Returns a new AWM whose undefined-character is undefchar. The x_known
and y_known bounds initially run from +1 to -1, and all characters are
undefined. The internal bug is created at (0,0), facing internal north:
forwardvector and rightvector are (0,1) and (1,0).


PUBLIC awm_undefchar( awm ):

Returns awm's undefined-character.


PUBLIC awm_x_known_min( awm ):
PUBLIC awm_x_known_max( awm ):
PUBLIC awm_y_known_min( awm ):
PUBLIC awm_y_known_max( awm ):

Return the lower and upper x-bounds, and the lower and upper y-bounds,
on the known area of awm. Within this rectangle, there is at least one
known location in every line and column. Outside it, all locations are
undefined.


PUBLIC awm_x_actual_min( awm ):
PUBLIC awm_x_actual_max( awm ):
PUBLIC awm_y_actual_min( awm ):
PUBLIC awm_y_actual_max( awm ):

Return the lower and upper x-bounds, and the lower and upper y-bounds,
on the actual storage used by AWM.


PUBLIC ved_awm():

Defines the Ved command 'awm', which copies the contents of the current
Ved buffer into an AWM.

The command can have the following forms:
    awm
    awm name
    awm name undefchar

These commands create a new awm and assign it to valof(name). If
undefchar is omitted, it defaults to ? . If name is omitted, it defaults
to "awm". The x-bounds of the AWM run from the leftmost non-blank column
(indexed at 1) to the rightmost non-blank column; its y-bounds run from
the top non-blank Ved line to the bottom (indexed at 1). If the buffer
contains a B, this will be taken to give the position of the internal
bug, and the square will be assumed blank.


PUBLIC app_awm( awm, p ):

Applies procedure p to every non-undefined location in awm. p must take
three arguments: p(awm,i,j), where the latter two give the location's
coordinates.


PUBLIC awm_replace( awm, c, newc ):

Replaces specified characters in awm by character newc. If c is a
character, all occurrences of it will be replaced by newc. If it is a
procedure, it must take a character as argument and return true or
false; all characters c for which p(c) is true will be replaced by newc.


PUBLIC awm_app_neighbours( awm, x, y, p ):

This applies p to every neighbour of awm(x,y). p must be a procedure of
three arguments, p(awm,i,j), as for app_awm.


PUBLIC awm_app_vh_neighbours( awm, x, y, p ):

This is like awm_app_neighbours, but only applies p to vertical and
horizontal neighbours. awm_app_neighbours also applies it to diagonal
ones. Both procedures avoid applying p to any undefined cells, i.e.
those which contain awm.awm_undefchar.


PUBLIC awm_neighbour( awm, x, y, p ):

This is used for finding a neighbour with specified properties. p must
be a procedure of three arguments, p(awm,i,j), returning true or false.
awm_neighbour applies p to each neighbour (including diagonal ones)
until it finds one for which p is true. If it finds one, it returns
true, otherwise false.


PUBLIC awm_move_bug_to( awm, x, y ):

Moves awm's internal bug to (x,y), without changing its bearing.


PUBLIC awm_set_direction( awm, direction ):

Sets awm's internal bug's direction to direction. This must be one of
"north", "east", "south", "west".


PUBLIC awm_move( awm, action ):

action must be one of "left", "right", "forward", "back". This procedure
changes awm's internal bug's location or bearing accordingly.


PUBLIC awm_right( awm ):
PUBLIC awm_left( awm ):
PUBLIC awm_forward( awm ):
PUBLIC awm_back( awm ):

Equivalent to awm_move( awm, "right" ) ... awm_move( awm, "back" ).


PUBLIC awm_direction( awm ):
PUBLIC awm_forwardvector( awm ):
PUBLIC awm_rightvector( awm ):

These return the bearing of awm's internal bug. The direction is one of
"north", "east", "south", "west". The forwardvector and rightvector are
unit vectors along the bug's Y and X axis, and are returned as a 'vec':
see lib vec.


PUBLIC awm_x( awm ):
PUBLIC awm_y( awm ):
PUBLIC awm_position( awm ):

These return the x and y coordinates of awm's internal bug, and the
bug's position as a 'vec'.


PUBLIC awm_retina_coords_to_awm_coords( rvec ):

This routine converts the retinal coordinates rvec into an AWM coordinate
vector.


PUBLIC awm_awm_coords_to_retina_coords( avec ):

This routine converts the AWM coordinates avec into a retinal coordinate
vector.


PUBLIC awm_merge_retina( awm, retina ):

This routine copies retinal contents into an AWM. 'retina' is a retina,
which must be as described in HELP EDEN, e.g. a 7*5 array whose bug is
at location (3,2). awm_merge_retina copies each retinal element into the
corresponding position of awm, assuming that the bug whose retina it is
has its location and bearing given by awm's internal bug.
*/


/*
IMPLEMENTATION
--------------

We represent a awm as a one-element record, whose single field is an
array. We define the record's class_apply routine so that subscripting
it accesses this array, and we modify its class_print routine so that
printing it displays the awm a line at a time.

The array is mapped onto a message by newanyarray. I originally did this
just because I wanted to be able to give newanyarray a second
(initialising) argument, and you can't do that without giving it a third
one too. (The documentation suggests you can, but it doesn't work.)
However, using messages is useful because it stops people putting
non-characters in the array.

ved_awm depends on getvedargs and vedbounds, from utils.
*/


needs vec;
needs retina;
needs fault;


recordclass awm
    awm_chars
    ;;; The underlying array.

    awm_undefchar
    ;;; The undef character.

    awm_x_known_min awm_x_known_max
    awm_y_known_min awm_y_known_max
    ;;; Bounds on known space.

    awm_x_actual_min awm_x_actual_max
    awm_y_actual_min awm_y_actual_max
    ;;; Bounds on actual space.

    awm_x awm_y
    awm_direction
    awm_forwardvector awm_rightvector;
    ;;; Internal bug location and heading.


define global new_awm( undefchar );
    consawm( newanyarray( [% -10, 10, -10, 10 %], undefchar, key_of_dataword("string") ),
             undefchar,
             1, -1, 1, -1,
             -10, 10, -10, 10,
             0, 0,
             "north",
             consvec(0,1), consvec(1,0)
           );
enddefine;


/*  Subscripting routine.  */
define access_awm( x, y, awm );
    lvars x, y, awm;

    define prmishap( message, culprits );
        lvars message, culprits;
        if issubstring('INVALID ARRAY SUBSCRIPT',1,message) then
            clearstack();
            awm.awm_undefchar;
            exitfrom(access_awm)
        else
            sysprmishap(message,culprits)
        endif;
    enddefine;

    (awm.awm_chars)(x,y);
enddefine;
access_awm -> class_apply( key_of_dataword("awm") );
/*
I use the error-handler to detect out-of-range subscripts, for
efficiency. Note the call to clearstack() - it appears, though this
isn't documented, that the stack contains one or both of the subscripts,
depending on which was faulty. We have to clear these.
*/


vars expand_awm;/*forward*/


/*  Updater for subscripts.  */
define update_awm( c, x, y, awm );
    vars c, x, y, awm;

    if c = awm.awm_undefchar then return endif;

    if x < awm.awm_x_known_min or x > awm.awm_x_known_max or
       y < awm.awm_y_known_min or y > awm.awm_y_known_max then
        expand_awm( awm, x, y );
        min( awm.awm_x_known_min, x ) -> awm.awm_x_known_min;
        max( awm.awm_x_known_max, x ) -> awm.awm_x_known_max;
        min( awm.awm_y_known_min, y ) -> awm.awm_y_known_min;
        max( awm.awm_y_known_max, y ) -> awm.awm_y_known_max;
    endif;

    c -> (awm.awm_chars)(x,y);

enddefine;
update_awm -> updater( class_apply( key_of_dataword("awm") ) );
/*
I don't use error-trapping here, because it kept giving problems
and causing extraneous errors. The routine that wouldn't quite
work is commented out below.
*/

/*
define update_awm( c, x, y, awm );
    vars c, x, y, awm;

    if c = awm.awm_undefchar then return endif;

    define prmishap( message, culprits );
        lvars message, culprits;
        if issubstring('INVALID ARRAY SUBSCRIPT',1,message) then
            expand_awm( awm, x, y );
            c -> (awm.awm_chars)(x,y);
            clearstack();
            exitfrom(update_awm)
        else
            sysprmishap(message,culprits)
        endif;
    enddefine;

    min( awm.awm_x_known_min, x ) -> awm.awm_x_known_min;
    max( awm.awm_x_known_max, x ) -> awm.awm_x_known_max;
    min( awm.awm_y_known_min, y ) -> awm.awm_y_known_min;
    max( awm.awm_y_known_max, y ) -> awm.awm_y_known_max;

    c -> (awm.awm_chars)(x,y);

enddefine;
update_awm -> updater( class_apply( key_of_dataword("awm") ) );
*/


/*  expand_awm( awm, x, y ):
        Expand awm so that it has enough space to store awm(x,y).       
*/
define expand_awm( awm, x, y );

    lvars awm, x, y;
    lvars new_x_actual_min, new_x_actual_max, new_y_actual_min, new_y_actual_max;
    lvars newchars, i, j;

    if x < awm.awm_x_actual_min then x-5 else awm.awm_x_actual_min endif -> new_x_actual_min;
    if x > awm.awm_x_actual_max then x+5 else awm.awm_x_actual_max endif -> new_x_actual_max;
    if y < awm.awm_y_actual_min then y-5 else awm.awm_y_actual_min endif -> new_y_actual_min;
    if y > awm.awm_y_actual_max then y+5 else awm.awm_y_actual_max endif -> new_y_actual_max;

    newanyarray( [% new_x_actual_min, new_x_actual_max, new_y_actual_min, new_y_actual_max %],
                 awm.awm_undefchar, key_of_dataword("string") ) -> newchars;

    for i from awm.awm_x_actual_min to awm.awm_x_actual_max do
        for j from awm.awm_y_actual_min to awm.awm_y_actual_max do
            (awm.awm_chars)(i,j)-> newchars(i,j);
        endfor;
    endfor;

    new_x_actual_min -> awm.awm_x_actual_min;
    new_x_actual_max -> awm.awm_x_actual_max;
    new_y_actual_min -> awm.awm_y_actual_min;
    new_y_actual_max -> awm.awm_y_actual_max;

    newchars -> awm.awm_chars;
enddefine;


/*  The print routine.  */                 
procedure( awm );
    lvars awm;
    lvars i, j;

    printf( 'AWM: xk: %p to %p;  yk: %p to %p \n' <>
            '     xbounds: %p to %p;   ybounds: %p to %p \n' <>
            '     position: (%p,%p) \n' <>
            '     forward: %p;   right: %p \n',
            [% awm.awm_x_known_min, awm.awm_x_known_max, awm.awm_y_known_min, awm.awm_y_known_max,
               awm.awm_x_actual_min, awm.awm_x_actual_max, awm.awm_y_actual_min, awm.awm_y_actual_max,
               awm.awm_x, awm.awm_y,
               awm.awm_forwardvector, awm.awm_rightvector
            %]
    );

    for j from awm.awm_y_known_max by -1 to awm.awm_y_known_min do
        for i from awm.awm_x_known_min to awm.awm_x_known_max do
            if i=awm.awm_x and j=awm.awm_y then
                cucharout( `B` )
            else
                cucharout( awm(i,j) );
            endif;
        endfor;
        1.nl;
    endfor;
    1.nl;

endprocedure -> class_print( key_of_dataword("awm") );


define global awm_retina_coords_to_awm_coords( awm, rvec );
    lvars awm, rvec;

    consvec(
        awm.awm_x + (rvec.vec_x-3)*(awm.awm_rightvector.vec_x)
                  + (rvec.vec_y-2)*(awm.awm_forwardvector.vec_x)
    ,
        awm.awm_y + (rvec.vec_x-3)*(awm.awm_rightvector.vec_y)
                  + (rvec.vec_y-2)*(awm.awm_forwardvector.vec_y)
    );
enddefine;


define global awm_awm_coords_to_retina_coords( awm, avec );
    lvars awm, i, j, x, y, avec;
    lvars fv = awm.awm_forwardvector, rv = awm.awm_rightvector;

    avec.vec_x -> x;
    avec.vec_y -> y;

    (-y*fv.vec_x + x*fv.vec_y) / (rv.vec_y*fv.vec_x + rv.vec_x*fv.vec_y) -> i;
    (-x*rv.vec_y + y*rv.vec_x) / (rv.vec_x*fv.vec_y + rv.vec_y*fv.vec_x) -> j;

    consvec( i+3, j+2 );
enddefine;


define global awm_merge_retina( awm, retina );
    lvars awm, retina;
    lvars xmax, ymax, i, j, x, y, avec;

    retina_bounds( retina ) -> ymax -> xmax;

    for i to xmax do
        for j to ymax do
            awm_retina_coords_to_awm_coords( awm, [%i,j%] ) -> avec;
            retina(i,j) -> awm(avec.vec_x,avec.vec_y);
        endfor;
    endfor;

enddefine;


define global awm_position( awm );
    consvec( awm_x(awm), awm_y(awm) );
enddefine;


define global awm_move_bug_to( awm, x, y );
    lvars x, y;
    x -> awm.awm_x;
    y -> awm.awm_y;
enddefine;


define global awm_forward( awm );
    lvars awm;
    awm.awm_x + awm.awm_forwardvector.vec_x -> awm.awm_x;
    awm.awm_y + awm.awm_forwardvector.vec_y -> awm.awm_y;
enddefine;


define global awm_back( awm );
    lvars awm;
    awm.awm_x - awm.awm_forwardvector.vec_x -> awm.awm_x;
    awm.awm_y - awm.awm_forwardvector.vec_y -> awm.awm_y;
enddefine;


vars renew_direction_vectors;/*forward*/


define global awm_left( awm );
    lvars awm;
    switchon awm.awm_direction
    case = "north" then "west"
    case = "west"  then "south"
    case = "south" then "east"
    case = "east"  then "north"
    endswitchon -> awm.awm_direction;
    renew_direction_vectors( awm.awm_direction, awm );
enddefine;


define global awm_right( awm );
    lvars awm;
    switchon awm.awm_direction
    case = "north" then "east"
    case = "west"  then "north"
    case = "south" then "west"
    case = "east"  then "south"
    endswitchon -> awm.awm_direction;
    renew_direction_vectors( awm.awm_direction, awm );
enddefine;


define global awm_set_direction( awm, dir );
    lvars awm, dir;
    dir -> awm.awm_direction;
enddefine;


/*  renew_direction_vectors( dir, awm ):
        Recalculate internal bug's direction vectors to be consistent
        with dir.
*/
define renew_direction_vectors( dir, awm );
    lvars dir, awm;
    switchon dir
    case = "north" then
        consvec( 0, 1 ) -> awm.awm_forwardvector;
        consvec( 1, 0 ) -> awm.awm_rightvector;
    case = "east" then
        consvec( 1, 0 ) -> awm.awm_forwardvector;
        consvec( 0, -1 ) -> awm.awm_rightvector;
    case = "south" then
        consvec( 0, -1 ) -> awm.awm_forwardvector;
        consvec( -1, 0 ) -> awm.awm_rightvector;
    case = "west" then
        consvec( -1, 0 ) -> awm.awm_forwardvector;
        consvec( 0, 1 ) -> awm.awm_rightvector;
    else
        FAULT( 'renew_direction_vectors: bad direction' );
    endswitchon
enddefine;


define global awm_move( awm, action );
    lvars awm, action;
    switchon action
        case = "left" then awm_left( awm )
        case = "right" then awm_right( awm )
        case = "forward" then awm_forward( awm )
        case = "back" then awm_back( awm )
    endswitchon
enddefine;


vars vedawm;/*forward*/


define global ved_awm();
    vedawm(
        procedure(awm,varname);
            lvars awm,varname;
            awm -> valof(varname)
        endprocedure
    );
enddefine;


/*  vedawm( proc ):
        Reads the awm from the current Ved buffer, converts it to an awm
        record a, and calls
            proc( a, name )
        where name is the argument given to the Ved command.

        When using Pop-11, proc just assigns a to valof(name). However,
        we can also call vedawm from Prolog. Since Prolog users
        don't like accessing Pop-11 global variables, I supply _them_
        with a ved command for putting awms into the database.
        This requires encapsulating a differently, i.e. a different
        proc argument to vedawm.
*/
define vedawm( p );
    lvars p;
    lvars i, j, x_min, x_max, line_min, line_max;
    lvars varname, width, height, awm, c, undefchar, args, len;

    if vedargument = '' then
        vedbounds() -> line_max -> line_min -> x_max -> x_min;
        x_max -> width;
        line_max -> height;
        "awm" -> varname;
    else getvedargs( [1,2]) -> args -> len;
        vedbounds() -> line_max -> line_min -> x_max -> x_min;
        x_max -> width;
        line_max -> height;
        args(1).consword -> varname;
        if len = 2 then args(2)(1) else `?` endif -> undefchar;
    endif;
    new_awm( undefchar ) -> awm;

    for j to height do
        for i to width do
            vedjumpto(j,i);
            vedcurrentchar() -> c;
            if c = `B` then
                i->awm.awm_x;
                height-j+1 -> awm.awm_y;
                ` ` -> c;
            endif;
            c -> awm(i,height-j+1);
        endfor;
    endfor;
    p( awm, varname );

enddefine;


define global awm_app_neighbours( awm, x, y, p );
    lvars awm, x, y, p;
    lvars i, j;
    for i from max(x-1,awm.awm_x_known_min) to min(x+1,awm.awm_x_known_max) do
        for j from max(y-1,awm.awm_y_known_min) to min(y+1,awm.awm_y_known_max) do
            if not( i=x and j=y ) then p(awm,i,j) endif;
        endfor;
    endfor;
enddefine;


define global awm_app_vh_neighbours( awm, x, y, p );
    lvars awm, x, y, p;
    lvars i, j;

    for i from max(x-1,awm.awm_x_known_min) to min(x+1,awm.awm_x_known_max) do
        for j from max(y-1,awm.awm_y_known_min) to min(y+1,awm.awm_y_known_max) do
            if not( i=x and j=y ) and
               ( i=x or j=y ) then
                p(awm,i,j)
            endif;
        endfor;
    endfor;
enddefine;


define global awm_neighbour( awm, x, y, p );
    lvars awm, x, y, p;
    awm_app_neighbours( awm, x, y,
                        procedure(awm,i,j);
                            lvars awm, i, j;
                            if p(awm,i,j) then
                                true; exitfrom( awm_neighbour )
                            endif;
                        endprocedure
    );
    false;
enddefine;


vars app_awm;/*forward*/


define global awm_replace( awm, c, newc );
    lvars awm, c, newc;

    if isprocedure(c) then
        app_awm( awm,
                 procedure(awm,x,y);
                     lvars awm,x,y;
                     if c(awm(x,y)) then newc->awm(x,y) endif;
                 endprocedure
        )
    else
        app_awm( awm,
                 procedure(awm,x,y);
                     lvars awm,x,y;
                     if awm(x,y)=c then newc->awm(x,y) endif;
                 endprocedure
        )
    endif;
enddefine;


define global app_awm( awm, p );
    lvars awm, p;
    lvars i, j;
    for i from awm.awm_x_known_min to awm.awm_x_known_max do
        for j from awm.awm_y_known_min to awm.awm_y_known_max do
            p( awm, i, j );
        endfor;
    endfor;
enddefine;


endsection;