/*  UTILS.P  */


section $-utils => vedbounds
                   getvedargs
                   first_non_space_pos
                   last_non_space_pos
                   starts_with
                   vedformat_print
                   vedpause
                   distance
                   pr_property
                   wait
                   expand
                   trunc;


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

This file defines some miscellaneous library routines.


PUBLIC vedbounds():

This is to be called when a file is being edited. It finds the first and
last non-blank line, and the leftmost and rightmost occupied column.
These values are returned, in the order
    x_min, x_max, line_min, line_max.


PUBLIC getvedargs( lengths ):

This helps write Ved commands with varying numbers of arguments.

lengths must be a list of integers.

getvedargs truncs vedargument into successive items delimited by commas
or spaces, and gives an error if the number of items is not a member of
lengths.

It returns the number of items, and the items as a list, in the order
    number list.


PUBLIC vedformat_print( format, args, y ):

Used for formatted output to a Ved buffer. Jumps to ved position (1,y),
clears the line, and then calls format_print(format,args), writing the
result to the line.


PUBLIC vedpause( thing ):

This is useful for writing diagnostics from inside Ved. It prints
'thing' on the status line, and then waits for you to hit any key before
continuing.


PUBLIC first_non_space_pos( s ):

Returns the position of the first non-space in s. Undefined if s is
entirely spaces, or empty.


PUBLIC last_non_space_pos( s ):

Returns the position of the last non-space in s. Undefined if s is
entirely spaces, or empty.


PUBLIC starts_with( s, c ):

True if the first non-space in string s is character c.


PUBLIC distance( x1, x2, y1, y2 ):

Returns the Euclidean distance between (x1,y1) and (x2,y2).


PUBLIC pr_property( property ):

Prints the property, one pair per line. Intended for debugging.


PUBLIC wait( n ):

Waits for approximately n seconds.


PUBLIC expand( lv, n ):

lv is either a list or a vector. This procedure returns a list or vector
padded to length n, whose first length(lv) elements are the same as
lv's, and whose remaining ones are undef.


PUBLIC trunc( s, n ):

s is any object. trunc converts it to a string and then returns that,
truncated on the right so that it is no more than n characters wide.
*/


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

I suspect that I pinched at least part of getvedargs from some system
library, but I can't remember which. It uses sysparse_string to trunc up
vedargument and extract the items, after replacing commas by spaces.
*/


/*
Distance
--------
*/


define global distance( x1, y1, x2, y2 );
    lvars x1, y1, x2, y2;
    sqrt( (x1-x2)**2 + (y1-y2)**2 )
enddefine;


/*
Strings.
--------
*/


define global first_non_space_pos( s );
    lvars s;
    skipchar( ` `, 1, s )
enddefine;


define global last_non_space_pos( s );
    lvars s;
    lvars i;
    for i from datalength(s) by -1 to 1 do
        if i /= ` ` then return(i) endif
    endfor;
enddefine;


define global starts_with(s,c);
    lvars s, c;
    lvars m;
    ( locchar( c, 1, s ) ->> m ) /= false and skipchar( ` `, 1, s ) = m
enddefine;


define global trunc( s, n );
    lvars s, n;
    lvars i;
    '' >< s -> s;
    for i to min(n,s.datalength) do
        s(i)
    endfor;
    consstring(min(n,s.datalength))
enddefine;


/*
Ved things.
-----------
*/


define global vedbounds();
    lvars i, x_min, x_max, line_min, line_max;

    /*  Find first non-blank line.  */
    1 -> i;
    while ( vedjumpto(i,1); vedtrimline(); vvedlinesize = 0 ) do
        1 + i -> i;
    endwhile;
    i -> line_min;

    /*  Find last non-blank line.  */
    vvedbuffersize -> i;
    while ( vedjumpto(i,1); vedtrimline(); vvedlinesize = 0 ) do
        i - 1 -> i;
    endwhile;
    i -> line_max;

    /*  Find first and last column.  */
    999 -> x_min;
    1 -> x_max;
    for i from line_min to line_max do
        vedjumpto(i,1);
        vedtrimline();
        if vedthisline() /= '' then
            min( x_min, first_non_space_pos(vedthisline()) ) -> x_min;
            max( x_max, last_non_space_pos(vedthisline()) ) -> x_max;
        endif;
    endfor;

    x_min; x_max; line_min; line_max;
enddefine;


define global getvedargs( nlist ) -> args -> len;
    lvars m, args, len, nlist;

    ;;; Replace commas with spaces
    while strmember(`,`,vedargument)->> m do
        `\s` -> fast_subscrs(m,vedargument);
    endwhile;

    listlength(sysparse_string(vedargument) ->> args) -> len;

    unless member(len,nlist) then
        vederror('ONE OF '><nlist><' ARGUMENTS NEEDED');
    endunless

enddefine;


define global vedformat_print( format, args, y );
    lvars format, args, y;
    lvars saved_cucharout;
    cucharout -> saved_cucharout;
    vedcharinsert -> cucharout;
    vedjumpto( y, 1 );
    vedcleartail();
    format_print( format, args );
    saved_cucharout -> cucharout;
enddefine;


define global vedpause( thing );
    lvars thing;
    vedputmessage( thing><'' );
    rawcharin().erase;
enddefine;


/*
Printing properties
-------------------
*/


define global pr_property( p );
    lvars p;
    appproperty( p, procedure(key,value);
                        lvars key, value;
                        printf( 'key: %p  value: %p\n', [% key, value %] )
                    endprocedure
               );
enddefine;


/*
Wait
----
*/


define global wait( secs );
    lvars secs;
    lvars done=false;

    syssettimer( intof(secs*100), procedure(); true->done; endprocedure );
    until done do ; enduntil;
enddefine;


/*
Expanding lists
---------------
*/


define global expand( l, n );
    lvars l, n;
    if n > length(l) then
        if islist(l) then
            [ ^^l ^^([%repeat n-length(l) times undef endrepeat %]) ]
        else
            l <> initv(n-length(l))
        endif
    else
        l
    endif;
enddefine;



endsection;