/*  RETINA.P  */


section $-retina => new_retina
                    retina_bounds
                    ved_retina;


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

This module defines the data structure that makes up a bug's retina, and
a routine for creating retinal images from Ved buffers.


Externally, a retina looks like a 2-D array. Create one by calling
    new_retina( width, height ).

Access it by subscripting:
    retina(3,4).
    `#` -> retina(x,y).
Retinas are mapped onto strings, so you'll get an error if you try to
store anything other than a character in them. In fact, there's
an extra check that this character is printable.

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


PUBLIC new_retina( width, height ):

Returns a new retina, contents all spaces, of the specified width and
height.


PUBLIC retina_bounds( retina ):

Returns the retina's x and y upper bounds, in the order
    xmax ymax.


PUBLIC retina(x,y): (subscripting)

Returns the (x,y)th element of retina, as a character. The origin is
(1,1).


PUBLIC c -> retina(x,y): (updater via subscripting)

Sets the (x,y)th element of retina to character c.


PUBLIC ved_retina():

Defines the Ved command 'retina', which copies the contents of the
current file into a retina.

The command can have the following forms
    retina
    retina name
    retina xmax ymax
    retina name xmax ymax

These commands create a new retina and assign it to valof(name). If name
is omitted, it defaults to "retina".

If xmax and ymax are specified, then they act as the retina's upper
bounds. The retinal coordinate system runs with Y upwards, so the Ved
line ymax becomes retinal line 1: that is, retinal point (1,1)
corresponds to Ved point (1,ymax), and retinal point (1,ymax)
corresponds to Ved point (1,1). No prizes to whoever decided to invert
the Ved coordinate system.

If xmax and ymax are omitted, they default to the rightmost occupied
column, and to the highest-numbered occupied line.
*/


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

We represent a retina 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 retina a line at a time.

The array is mapped onto a string 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 strings is useful because it stops people putting
non-characters in the array.

ved_retina depends on getvedargs and vedbounds, from utils.


Portability
-----------

The check in the subscripting updater for retinas assumes that characters
are represented in ASCII, when checking that object symbols are in range.
*/


needs utils;
needs fault;


recordclass retina
    retina_chars;
    ;;; The contents.


define global new_retina( width, height );
    lvars width, height;
    consretina( newanyarray( [% 1, width, 1, height %], ` `, key_of_dataword("string") ) );
enddefine;


/*  Retina subscripting.  */
procedure( x, y, retina );
    lvars x, y, retina;
    (retina.retina_chars)(x,y);
endprocedure -> class_apply( key_of_dataword("retina") );


/*  Updater for subscripting.  */
procedure( c, x, y, retina );
    lvars c, x, y, retina;

    if c < ` ` or c > 127 then
        FAULT( 'updating retina: character out of range', [%c,x,y,retina%] );
    endif;

    c -> (retina.retina_chars)(x,y);
endprocedure -> updater( class_apply( key_of_dataword("retina") ) );


/*  Print routine.  */                     
procedure( retina );
    lvars retina;
    lvars i, j, width, height;

    explode( boundslist(retina.retina_chars) ) -> height -> () -> width -> ();

    printf( 'retina: height: %p;  width: %p\n', [% height, width %] );
    for j from height by -1 to 1 do
        for i to width do
            cucharout( retina(i,j) );
        endfor;
        1.nl;
    endfor;
    1.nl;
endprocedure -> class_print( key_of_dataword("retina") );


define global retina_bounds( retina );
    lvars retina;
    lvars bounds;
    boundslist(retina.retina_chars) -> bounds;
    bounds(2); bounds(4);
enddefine;


vars vedretina;  /*forward*/


define global ved_retina();
    vedretina(
        procedure(retina,varname);
            lvars retina,varname;
            retina -> valof(varname)
        endprocedure
    );
enddefine;


/*  vedretina( proc ):
        Reads the retinal image from the current Ved buffer, converts it
        to a retina record r, and calls
            proc( r, name )
        where name is the argument given to the Ved command.

        When using Pop-11, proc just assigns r to valof(name). However,
        we can also call vedretina from Prolog. Since Prolog users
        don't like accessing Pop-11 global variables, I supply _them_
        with a ved command for putting retinas into the database.
        This requires encapsulating r differently, i.e. a different
        proc argument to vedretina.

        Note: there is a comment under 'vedworld' in WORLDS.P that
        refers to this one.
*/
define vedretina( p );
    lvars p;
    lvars i, j, x_min, x_max, line_min, line_max;
    lvars varname, width, height, retina, args, len;          

    if vedargument = '' then
        vedbounds() -> line_max -> line_min -> x_max -> x_min;
        x_max -> width;
        line_max -> height;
        "retina" -> varname;
    else getvedargs( [1,2,3]) -> args -> len;
        if len = 1 then
            vedbounds() -> line_max -> line_min -> x_max -> x_min;
            x_max -> width;
            line_max -> height;
            args(1).consword -> varname;
        elseif len = 2 then
            "retina" -> varname;
            args(1) -> width;
            args(2) -> height;
        elseif len = 3 then
            args(1).consword -> varname;
            args(2) -> width;
            args(3) -> height;
        endif
    endif;

    new_retina( width, height ) -> retina;

    for j to height do
        for i to width do
            vedjumpto(j,i);
            vedcurrentchar() -> retina(i,height-j+1);
        endfor;
    endfor;

    p( retina, varname );

enddefine;


endsection;