!       ABEL_GRAPHIC.TPU
!
!       Table of Contents as of 27-Mar-1988
!
!       Procedure name              Page    Description
!       --------------              ----    -----------
!
!       abl$gsr_free_hor               1    Move freely horizontal
!       abl$gsr_free_ver               2    Move freely vertical
!       abl$gsr_line                   3    Draw a simple line
!       abl$gsr_line3                  4    Draw a line with end characters
!       abl$gsr_square                 5    Draw a square (full)
!       abl$gsr_square1                6    Draw a square (limited)
!       abl$gsr_cube                   7    Draw a cube (full)
!       abl$gsr_cube1                  8    Draw a cube (limited)
!       eve_box                        9    Draw a box
!       eve_cube                       10    Draw a cube


!                                                                       Page 1


procedure abl$gsr_free_hor($x)          ! Move freely horizontal

! Provides a cross between vaxtpu's cursor_horizontal and move_horizontal.
! Cursor movement is relative to current cursor position.  If the move is
! to the right (positive parameter) the cursor is moved to the right over
! text or spaces are added to make text.  If the move is to the left
! (negative parameter) the cursor is move_horizontal'd left.
!
! Parameters:
!   $x              integer     # of columns to move relative to current
!                                   cursor position
!
! Source:
!   Eva2

local abs_x;

if $x=0 then return 1 endif;
abs_x := abl$abs($x);
loop
    exitif abs_x<=0;
    if $x>0 then
        if mark(none)=end_of(current_buffer) then copy_text(" ")
        else
            if current_character="" then copy_text(" ")
            else move_horizontal(1)
            endif;
        endif;
    else
        if current_offset=0 then return 0 endif;
        move_horizontal(-1);
    endif;
    abs_x:=abs_x-1;
endloop;
return 1;
endprocedure



!                                                                       Page 2


procedure abl$gsr_free_ver($y)      ! Move freely vertical

! Provides a cross between vaxtpu's cursor_vertical and move_vertical.
! Cursor movement is relative to current cursor position.  The cursor
! will always be left in the first column of the new row.  An attempt
! to move past the beginning of the buffer will generate a warning
! message.
!
! Parameters:
!   $y              integer     # of rows to move relative to current cursor
!
! Source:
!   Eva2

local abs_y;

move_horizontal(-current_offset);
if $y=0 then return 1 endif;
abs_y := abl$abs($y);
loop
    exitif abs_y<=0;
    if $y>0 then
        if mark(none)=end_of(current_buffer) then split_line
        else move_vertical(1)
        endif;
    else !y<0
        if mark(none)=beginning_of(current_buffer) then return 0 endif;
        move_vertical(-1);
    endif;
    abs_y:=abs_y-1;
endloop;
return 1;
endprocedure



!                                                                       Page 3


procedure abl$gsr_line                  ! Draw a simple line
    ($line_length,$line_char)

! Provides a horizontal line of specified length using specified
! character at the current cursor position.  Using "?" as the character
! gives a "transparent" line.
!
!   $line_length    integer     length to make line
!   $line_char      integer     single character to use
!                                   ("?" for transparent line)
!
! Source:
!   Eva2

local
    line_length;

if length($line_char)<>1 then
    message("%abl$gsr_line, error in length of $line_char");
    return 0;
endif;
if $line_length<0 then
    message("%abl$gsr_line, $line_length cannot be negative");
    return 0;
endif;
if $line_length=0 then return 1 endif;
line_length:=$line_length;
loop
    exitif line_length=0;
    if $line_char="?" then abl$gsr_free_hor(1)
    else copy_text($line_char)
    endif;
    line_length:=line_length-1;
endloop;
return 1;
endprocedure



!                                                                       Page 4


procedure abl$gsr_line3                 ! Draw a line with end characters
    ($line_length,$line_chars)

! Provides a way to make a line of arbitrary length that begins, ends
! and contains in the middle 3 different characters.  For example,
! abl$gsr_line3(5,"<->") will generate the line <--->.
!
! Supports the "transparent" character (see abl$gsr_line).
!
! Parameters:
!   $line_length    integer     length of line
!   $line_chars     integer     character string (length=3) to define
!                                   characters to make line with
!
! Source:
!   Eva2

if length($line_chars)<>3 then
    message("%abl$gsr_line3, $line_chars invalid length");
    return 0;
endif;
if $line_length<0 then
    message("%abl$gsr_line3, $line_length cannot be negative");
    return 0;
endif;
if $line_length=0 then
    return 1
endif;
abl$gsr_line(1,substr($line_chars,1,1));
if $line_length > 2 then
    abl$gsr_line($line_length-2,substr($line_chars,2,1));
endif;
if $line_length > 1 then
    abl$gsr_line(1,substr($line_chars,3,1))
endif;
return 1;
endprocedure



!                                                                       Page 5


procedure abl$gsr_square                ! Draw a square (full)
    ($x,$y,$sqr9)

! Draw a square.  Each character in the square (each corner, each line, and
! the fill character) can be specified.  Supports the "transparent" character.
!
! Supports the "transparent" character (see abl$gsr_line).
!
! Parameters:
!   $x              integer     x axis length
!   $y              integer     y axis length
!   $sqr9           string      character 1 NW corner character
!                               character 2 N side character
!                               character 3 NE corner character
!                               character 4 E side character
!                               character 5 SE corner character
!                               character 6 S side character
!                               character 7 SW corner character
!                               character 8 W side character
!                               character 9 fill character
!
! Source:
!   Eva2

local
    p1,
    p2,
    ofs,
    prev_mode,
    prev_loc,
    cnw,
    sn,
    cne,
    se,
    cse,
    ss,
    csw,
    sw,
    fil;

if length($sqr9)<>9 then                   !check all params
    message("%abl$gsr_square, $sqr9 invalid length");
    return 0;
endif;
if ($x<0) or ($y<0) then
    message("%abl$gsr_square, $x and $y must be > 0");
    return 0;
endif;
if ($x=0) or ($y=0) then return 1 endif;
cnw:=substr($sqr9,1,1);                !strip $sqr9
sn :=substr($sqr9,2,1);
cne:=substr($sqr9,3,1);
se :=substr($sqr9,4,1);
cse:=substr($sqr9,5,1);
ss :=substr($sqr9,6,1);
csw:=substr($sqr9,7,1);
sw :=substr($sqr9,8,1);
fil:=substr($sqr9,9,1);
abl$virtual_mark;
prev_mode:=get_info(current_buffer,"mode");     !remember/change mode
set(overstrike,current_buffer);
ofs:=current_offset;                            !remember where we start
!
! Draw top
!
if not abl$gsr_line3($x,cnw+sn+cne) then
    return 0
endif;
!
! Draw sides
!
p2:=$y-2;
loop
    exitif p2<=0;
    if not abl$gsr_free_ver(1) then return 0 endif;             ! new line
    if not abl$gsr_free_hor(ofs) then return 0 endif;           ! space in
    if not abl$gsr_line3($x,sw+fil+se) then return 0 endif; ! draw
    p2:=p2-1;
endloop;
!
! Draw bottom
!
if $y>1 then
    if not abl$gsr_free_ver(1) then return 0 endif;
    if not abl$gsr_free_hor(ofs) then return 0 endif;
    if not abl$gsr_line3($x,csw+ss+cse) then return 0 endif;
endif;

set(prev_mode,current_buffer);              ! restore mode
abl$virtual_position;                       ! restore location
return 1;
endprocedure



!                                                                       Page 6


procedure abl$gsr_square1($x,$y,$sqr4)  ! Draw a square (limited)

! Provides simpler interface to abl$gsr_square.
!
! Parameters:
!   $x              integer     x axis length
!   $y              integer     y axis length
!   $sqr4           string      character 1 corners
!                                         2 horizontal character
!                                         3 vertical character
!                                         4 fill character
!
! Supports the "transparent" character (see abl$gsr_line).
!
! Source
!   Eva2

local
    sqr9,
    cor,
    hor,
    ver,
    fil;

if length($sqr4)<>4 then               !check all params
    message("%abl$gsr_square, $sqr4 invalid length");
    return 0;
endif;
cor:=substr($sqr4,1,1);
hor:=substr($sqr4,2,1);
ver:=substr($sqr4,3,1);
fil:=substr($sqr4,4,1);
sqr9:=cor+hor+cor+ver+cor+hor+cor+ver+fil;
if not abl$gsr_square($x,$y,sqr9) then return 0 endif;
return 1;
endprocedure



!                                                                       Page 7


procedure abl$gsr_cube                  ! Draw a cube (full)
    ($x,$y,$z,$orientation,$sqr9end,$sqr9mid)

! This routine draws a cube
!
! Parameters:
!   $x              integer     x axis length
!   $y              integer     y axis length
!   $z              integer     z axis length
!   $orientation    integer     $orientation (1-4; 1=NW, 2=NE, 3=SE, 4=SW)
!   $sqr9end        string      end box characters
!                                   character 1 NW corner
!                                   character 2 N side
!                                   character 3 NE corner
!                                   character 4 E side
!                                   character 5 SE corner
!                                   character 6 S side
!                                   character 7 SW corner
!                                   character 8 W side
!                                   character 9 fill character
!   $sqr9mid        string      middle box characters
!                                   character 1 NW corner
!                                   character 2 N side
!                                   character 3 NE corner
!                                   character 4 E side
!                                   character 5 SE corner
!                                   character 6 S side
!                                   character 7 SW corner
!                                   character 8 W side
!                                   character 9 fill character
!
! Supports the "transparent" character (see abl$gsr_line).
!
! Source:
!   Eva2

local
    num_mid_sqr,
    ofs,
    here;

if length($sqr9end)<>9 then                   !check length $orientation
    message("%abl$gsr_square, $sqr9end invalid length");
    return 0;
endif;
if length($sqr9mid)<>9 then                   !check length $sqr9end
    message("%abl$gsr_square, $sqr9mid invalid length");
    return 0;
endif;
if ($x<0) or ($y<0) or ($z<0) then
    message("%abl$gsr_square, $x and $y and $z must be > 0");
    return 0;
endif;
if ($orientation<1) or ($orientation>4) then
    message("%abl$gsr_square, $orientation must be between 1 and 4");
    return 0;
endif;
case $orientation from 1 to 4
    [1]:    horadj:=-1; veradj:=-1;
    [2]:    horadj:= 1; veradj:=-1;
    [3]:    horadj:= 1; veradj:= 1;
    [4]:    horadj:=-1; veradj:= 1;
endcase;
abl$virtual_mark;
ofs:=current_offset;
if not abl$gsr_free_ver(veradj*($z-1)) then return 0 endif;
if not abl$gsr_free_hor(horadj*($z-1)+ofs) then return 0 endif;
if not abl$gsr_square($x,$y,$sqr9end) then return 0 endif;
num_mid_sqr:=$z-2;
loop
    exitif num_mid_sqr<=0;
    if not abl$gsr_free_ver(-veradj) then return 0 endif;
    if not abl$gsr_free_hor(horadj*num_mid_sqr+ofs) then return 0 endif;
    if not abl$gsr_square($x,$y,$sqr9mid) then return 0 endif;
    num_mid_sqr:=num_mid_sqr-1;
endloop;
if $z>1 then
    if not abl$gsr_free_ver(-veradj) then return 0 endif;
    if not abl$gsr_free_hor(ofs) then return 0 endif;
    if not abl$gsr_square($x,$y,$sqr9end) then return 0 endif;
endif;
abl$virtual_position;
endprocedure



!                                                                       Page 8


procedure abl$gsr_cube1                 ! Draw a cube (limited)
    ($x,$y,$z,$orientation,$sqr4end,$sqr4mid)

! This routine provides a simpler interface to draw a cube
!
! Supports the "transparent" character (see abl$gsr_line).
!
! Parameters:
!   $x              integer     x axis length
!   $y              integer     y axis length
!   $z              integer     z axis length
!   $orientation    integer     $orientation (1-4; 1=NW, 2=NE, 3=SE, 4=SW)
!   $sqr4end        string      box characters for front side of box facing user
!                                   and back side of box:
!                                   character 1 corners
!                                   character 2 horizontal lines
!                                   character 3 vertical lines
!                                   character 4 fill character
!   $srq4mid        string      box characters for sides between front and back:
!                                   character 1 corners
!                                   character 2 horizontal lines
!                                   character 3 vertical lines
!                                   character 4 fill character
!
! Source:
!   Eva2

local
    sqr9end,
    sqr9mid;

sqr9end :=                          ! +-+|+-+|?
    substr($sqr4end,1,2) +           ! +-
    substr($sqr4end,1,1) +           ! +
    substr($sqr4end,3,1) +           ! |
    substr($sqr4end,1,2) +           ! +-
    substr($sqr4end,1,1) +           ! +
    substr($sqr4end,3,2);            ! |?

sqr9mid :=                          ! +-+|+-+|?
    substr($sqr4mid,1,2) +           ! +-
    substr($sqr4mid,1,1) +           ! +
    substr($sqr4mid,3,1) +           ! |
    substr($sqr4mid,1,2) +           ! +-
    substr($sqr4mid,1,1) +           ! +
    substr($sqr4mid,3,2);            ! |?

abl$gsr_cube($x,$y,$z,$orientation,sqr9end,sqr9mid);
return 1;

endprocedure



!                                                                       Page 9


procedure eve_box($box_string)          ! Draw a box

! Draws a box; leaves the cursor in the upper left of the box.  Use Block
! Select to mark any corner, move the cursor the diagonally opposite corner and
! give the box command.
!
! Supports the "transparent" character (see abl$gsr_line).
!
! Parameters:
!   $box_string     string      4 character string used to build box
!
! Qualifiers:
!   /reset          boolean     reset the block select when done
!
! Source:
!   Eva

local
    orig_buffer,                            ! handle for user's buffer
    old_mode,                               ! remember mode
    col_beg,                                ! first col
    col_end,                                ! last col
    row_beg,                                ! first row
    row_end,                                ! last row
    box_string;                             ! string for abl$gsr_sq p3

!
! Handle error situations
!
if get_info(get_info(current_buffer,"tab_stops"),"type") = string then
    message("Cannot perform block functions with irregularly spaced tabs");
    return 0;
endif;
if abl$x_block_select_position = 0 then
    message("Use Block Select before using Block Remove");
    return 0;
endif;
if get_info(mark(none),"buffer") <>
    get_info(abl$x_block_select_position,"buffer") then
    message("Block Select (buffer " +
        get_info(get_info(abl$x_block_select_position,"buffer"),"name") +
        ") and Box must be in same buffer");
    return 0;
endif;
!
! Initializations
!
if $box_string = eve$kt_null then
    box_string := "+-|?"
else
    if length($box_string) <> 4 then
        message("Box string must be 4 characters (corners, horizontals, "+
            "verticals, fill)");
        return 0;
    else
        box_string := $box_string
    endif;
endif;
!
set(screen_update,off);
orig_buffer:=current_buffer;                    !get a handle on user's buffer
old_mode:=get_info(current_buffer,"mode");      !remember current mode
set(insert,current_buffer);                     !give us insert
set(insert,paste_buffer);                       !set paste buffer insert
!
! Get information about marks
!
other_column_select_mark:=mark(none);           !determine mark beg and end
row_beg := eve$what_line;
col_beg := get_info(current_buffer,"offset_column");
position(abl$x_block_select_position);
row_end := eve$what_line;
col_end := get_info(current_buffer,"offset_column");
!
! Position to the upper-left of box
!
position(beginning_of(current_buffer));
if row_beg < row_end then
    abl$gsr_free_ver(row_beg - 1)
else
    abl$gsr_free_ver(row_end - 1)
endif;
!
if col_beg < col_end then
    abl$gsr_free_hor(col_beg - 1)
else
    abl$gsr_free_hor(col_end - 1)
endif;
!
! Draw box
!
abl$gsr_square1(abl$abs(col_beg - col_end) + 1, abl$abs(row_beg - row_end) + 1,
    box_string);
!
! Get rid of mark and restore original settings
!
if abl$q_reset then
    abl$x_block_select_position := 0;
endif;
set(old_mode,current_buffer);
set(screen_update,on);
update(current_window);
endprocedure;



!                                                                       Page 10


procedure eve_cube($box_end,$box_mid)   ! Draw a cube

! Draws a cube; leaves the cursor in the upper left of the cube.  Use Block
! Select to mark any corner, move the cursor the diagonally opposite corner and
! give the cube command.
!
! Supports the "transparent" character (see abl$gsr_line).
!
! Parameters:
!   $box_end        string      4 characters to use for end boxes
!   $box_mid        string      4 characters to use for middle boxes
!
! Qualifiers:
!   /reset          boolean     reset the block select when done
!   /depth          integer     how deep to make cube (z axis)
!   /orientation    string      NW, NE, SE, SW
!
! Source:
!   Abel

local
    orig_buffer,                            ! handle for user's buffer
    old_mode,                               ! remember mode
    col_beg,                                ! first col
    col_end,                                ! last col
    row_beg,                                ! first row
    row_end,                                ! last row
    orientation,                            ! for converting /orien to #
    end_box,                                ! box string for front and back
    mid_box;                                ! block string for middles

!
! Handle error situations
!
if get_info(get_info(current_buffer,"tab_stops"),"type") = string then
    message("Cannot perform block functions with irregularly spaced tabs");
    return 0;
endif;
if abl$x_block_select_position = 0 then
    message("Use Block Select before using Block Remove");
    return 0;
endif;
if get_info(mark(none),"buffer") <>
    get_info(abl$x_block_select_position,"buffer") then
    message("Block Select (buffer " +
        get_info(get_info(abl$x_block_select_position,"buffer"),"name") +
        ") and Box must be in same buffer");
    return 0;
endif;
!
! Initializations
!
if not abl$prompt_word("/nw/ne/sw/se",abl$q_orientation,abl$q_orientation,
    "Orientation of cube (nw, ne, sw, se) []? ","Aborted...")
    then return 0;
endif;
if abl$q_orientation = "nw" then
    orientation := 1;
    box_end := "+-| ";
    box_mid := "\  ?";
endif;
if abl$q_orientation = "ne" then
    orientation := 2;
    box_end := "+-| ";
    box_mid := "/  ?";
endif;
if abl$q_orientation = "se" then
    orientation := 3;
    box_end := "+-| ";
    box_mid := "\  ?";
endif;
if abl$q_orientation = "sw" then
    orientation := 4;
    box_end := "+-| ";
    box_mid := "/  ?";
endif;
!
if $box_end <> eve$kt_null then
    if length($box_end) <> 4 then
        message("Box-end string must be 4 characters (corners, horizontals, "+
            "verticals, fill)");
        return 0;
    else
        box_end := $box_end
    endif;
endif;
if $box_mid <> eve$kt_null then
    if length($box_mid) <> 4 then
        message("Box-mid string must be 4 characters (corners, horizontals, "+
            "verticals, fill)");
        return 0;
    else
        box_mid := $box_mid
    endif;
endif;
!
set(screen_update,off);
orig_buffer:=current_buffer;                    !get a handle on user's buffer
old_mode:=get_info(current_buffer,"mode");      !remember current mode
set(insert,current_buffer);                     !give us insert
set(insert,paste_buffer);                       !set paste buffer insert
!
! Get information about marks
!
other_column_select_mark:=mark(none);           !determine mark beg and end
row_beg := eve$what_line;
col_beg := get_info(current_buffer,"offset_column");
position(abl$x_block_select_position);
row_end := eve$what_line;
col_end := get_info(current_buffer,"offset_column");
!
! Position to the upper-left of box
!
position(beginning_of(current_buffer));
if row_beg < row_end then
    abl$gsr_free_ver(row_beg - 1)
else
    abl$gsr_free_ver(row_end - 1)
endif;
!
if col_beg < col_end then
    abl$gsr_free_hor(col_beg - 1)
else
    abl$gsr_free_hor(col_end - 1)
endif;
!
! Draw box
!
abl$gsr_cube1(
    abl$abs(col_beg - col_end) + 1,         ! x length
    abl$abs(row_beg - row_end) + 1,         ! y length
    abl$q_depth,                            ! z length
    orientation,                            ! orientation
    box_end,                                ! cube ends
    box_mid                                 ! cube middles
    );
!
! Get rid of mark and restore original settings
!
if abl$q_reset then
    abl$x_block_select_position := 0;
endif;
set(old_mode,current_buffer);
set(screen_update,on);
update(current_window);
endprocedure;