# text-display.pkg
# Compiled by:
# src/lib/x-kit/widget/xkit-widget.sublibstipulate
package g2d= geometry2d; # geometry2d is from src/lib/std/2d/geometry2d.pkg #
# package wg = widget; # widget is from src/lib/x-kit/widget/old/basic/widget.pkg package tw = text_widget; # text_widget is from src/lib/x-kit/widget/old/text/text-widget.pkg #
package vb = view_buffer; # view_buffer is from src/lib/x-kit/widget/old/fancy/graphviz/text/view-buffer.pkg package tc = text_canvas; # text_canvas is from src/lib/x-kit/widget/old/fancy/graphviz/text/text-canvas.pkgherein
package text_display
: (weak) Text_Display # Text_Display is from src/lib/x-kit/widget/old/fancy/graphviz/text/text-display.api {
/* +DEBUG */
tracing = logger::make_logtree_leaf { parent => xlogger::widgets_logging, name => "text_display::tracing", default => FALSE };
fun pr s = logger::log_if tracing 0 {. s; };
fun prf (format_string, items) = logger::log_if tracing 0 {. sfprintf::sprintf' format_string items; };
/* -DEBUG */
Text_Display
=
TEXT_DISPLAY
{
canvas: tc::Text_Canvas,
text: vb::Text_Pool,
size: Ref( g2d::Size )
};
#
fun make_text_display { canvas, text, size }
=
TEXT_DISPLAY
{
canvas,
text,
size => REF size
};
# Update the size of the display:
#
fun resize (TEXT_DISPLAY { text, size, ... }, size')
=
{ size := size';
vb::resize (text, size');
};
# Return size:
#
fun size_of (TEXT_DISPLAY { size, ... } )
=
*size;
# Return a typeball for the display:
#
fun make_typeball (TEXT_DISPLAY { canvas, ... }, vl)
=
tc::make_typeball (canvas, vl);
# Return the default typeball
# for the display:
#
fun default_typeball (TEXT_DISPLAY { canvas, ... } )
=
tc::default_typeball canvas;
# Copy a typeball, updating some attributes:
#
copy_typeball = tc::copy_typeball;
# Scroll a region vertically, returning the
# vacated rectangle and a list of damaged
# rectangles that must be redrawn.
#
# The region coordinates are in pixels:
# "from" is the y-coord of the top of the region;
# "ht" is the height of the region; and
# "to" is the y-coord of the new top of the region.
#
fun scroll_v (td as TEXT_DISPLAY { canvas, ... } )
=
{ blt = tc::blt canvas;
#
fun scroll { from, to, high }
=
{ (size_of td)
->
{ wide, ... };
damage_mailop
=
blt {
to_pos => { col=>0, row=>to },
from_box => { col=>0, row=>from, wide, high }
};
my (yv, line)
=
if (from < to) (from, to-from);
else (to+high, from-to);
fi;
{ vacated => { col=>0, row=>yv, wide, high=>line },
damage => damage_mailop
};
};
scroll;
};
# Scroll a region horizontally, returning
# the vacated rectangle and a list of damaged
# rectangles that must be redrawn.
#
# The region coordinates are in pixels:
# "from" is the x-coord of the l.h.s. of the region;
# "wide" is the width of the region; and
# "to" is the x-coord of new l.h.s. of the region.
#
fun scroll_h (td as TEXT_DISPLAY { canvas, ... } )
=
scroll
where
blt = tc::blt canvas;
#
fun scroll { from, to, wide }
=
{ (size_of td)
->
{ high, ... };
damage_mailop
=
blt
{
to_pos => { col=>to, row=>0 },
from_box => { col=>from, row=>0, high, wide }
};
my (xv, wv)
=
from < to ?? (from, to-from)
:: (to+wide, from-to);
{ vacated => { col=>xv, row=>0, wide=>wv, high },
damage => damage_mailop
};
};
end;
# Scroll the contents of a line horizontally:
#
fun scroll_line (TEXT_DISPLAY { canvas, text, ... } )
=
scroll
where
blt = tc::blt canvas;
#
fun scroll { from as tw::CHAR_POINT { row, col }, to, wide }
=
{ (vb::coordinate_to_box (text, from))
->
{ col=>x, row=>y, high, ... }: g2d::Box;
damage_mailop
=
blt
{ to_pos => { col=>to, row=>y },
from_box => { col=>x, row=>y, high, wide }
};
my (xv, wv)
=
x < to ?? (x, to-x)
:: (to+wide, x-to);
{ vacated => { col=>xv, row=>y, wide=>wv, high },
damage => damage_mailop
};
};
end;
# Scroll the text vertically so that
# the specified row is at the top of
# the display. I.e., scroll the text
# up by the specified number of rows:
#
fun scroll_up (td as TEXT_DISPLAY { text, ... } )
=
scroll
where
scroll_v = scroll_v td;
#
fun scroll row
=
{ from = vb::row_to_y (text, row);
#
(size_of td)
->
{ high, ... };
scroll_v { from, to=>0, high=>high-from };
};
end;
# Scroll the text vertically so that
# the top of the screen occupies the
# specified row. I.e., scroll the text
# down by the specified number of rows:
#
fun scroll_down (td as TEXT_DISPLAY { text, ... } )
=
scroll
where
scroll_v = scroll_v td;
#
fun scroll row
=
{ to = vb::row_to_y (text, row);
#
(size_of td)
->
{ high, ... };
scroll_v { from=>0, to, high=>high-to };
};
end;
# Clear the specified rectangle:
#
fun clear_box (TEXT_DISPLAY { canvas, ... } )
=
tc::clear_box canvas;
# Clear from the character coordinate
# to the end of its line:
#
fun clear_to_eol' (clear_box, td as TEXT_DISPLAY { text, ... } )
=
clear
where
fun clear (cc as tw::CHAR_POINT { row, col } )
=
{ (vb::coord_to_pt (text, cc))
->
{ col=>x, row=>y };
(size_of td)
->
{ wide, ... };
high = vb::get_row_ht (text, row);
clear_box ({ col=>x, row=>y, wide=>wide-x, high } );
};
end;
fun clear_to_eol td
=
clear_to_eol' (clear_box td, td);
# Clear the lines [start..stop]:
#
fun clear_lines' (clear_box, td as TEXT_DISPLAY { text, ... } )
=
clear
where
fun clear { start, stop }
=
{ y = vb::row_to_y (text, start);
#
(size_of td)
->
{ wide, ... };
fun compute_ht (row, ht)
=
row <= stop ?? compute_ht (row+1, ht + vb::get_row_ht (text, row))
:: ht;
clear_box ({ col=>0, row=>y, wide, high=>compute_ht (start, 0) } );
};
end;
fun clear_lines td
=
clear_lines' (clear_box td, td);
# Clear the area from the coordinate start
# to the coordinate stop:
#
fun clear_area (td as TEXT_DISPLAY { text, ... } )
=
clear
where
clear_box = clear_box td;
#
clear_to_eol = clear_to_eol' (clear_box, td);
clear_lines = clear_lines' (clear_box, td);
fun clear { start as tw::CHAR_POINT { row=>r1, col=>c1 }, stop=>tw::CHAR_POINT { row=>r2, col=>c2 }}
=
if (r1 < r2)
#
r1 = if (c1 > 0)
#
clear_to_eol start;
r1+1;
else
r1;
fi;
(vb::coord_to_pt (text, tw::CHAR_POINT { row=>r2, col=>c2+1 } ))
->
{ col=>x, row=>y };
if (r1 < r2)
#
clear_lines { start => r1,
stop => r2 - 1
};
fi;
clear_box ({ col=>0, row=>y, high=>vb::get_row_ht (text, r1), wide=>x } );
elif (r1 == r2 and c1 <= c2)
(vb::coord_to_pt (text, start))
->
{ col=>x1, row=>y };
x2 = vb::coord_to_x (text, tw::CHAR_POINT { row=>r1, col=>c2+1 } );
clear_box ({ col=>x1, row=>y, high=>vb::get_row_ht (text, r1), wide=>x2-x1 } );
fi;
end;
# Redraw the damaged region:
#
fun redraw (TEXT_DISPLAY { text, size, ... } ) damage_boxes
=
case damage_boxes
#
[ { row=>0, col=>0, wide, high } ]
=>
{ my { wide=>w, high=>h }
=
*size;
if (wide == w and high == h) draw_all ();
else redraw' damage_boxes;
fi;
};
_ => redraw' damage_boxes;
esac
where
num_rows = vb::num_rows text;
# Redraw the whole canvas:
#
fun draw_all ()
=
draw 0
where
get_row = vb::get_row text;
fun draw i
=
if (i < num_rows)
#
tc::draw (get_row i);
draw (i+1);
fi;
end;
# Redraw the damaged regions
#
fun redraw' boxes
=
draw min_row
where
get_text = vb::get_text text;
#
fun pixel_rng_to_row_rng (y1, y2) # "rng" here may be "range".
=
vb::pixel_rng_to_row_rng (text, y1, y2);
fun pixel_rng_to_col_rng (row, x1, x2) # "rng" here may be "range".
=
vb::pixel_rng_to_col_rng (text, row, x1, x2);
damage = rw_vector::make_rw_vector (num_rows, []);
fun min (a: Int, b) = (a < b ?? a :: b);
fun max (a: Int, b) = (a > b ?? a :: b);
fun union (row, x1, x2)
=
rw_vector::set
( damage,
row,
ins (rw_vector::get (damage, row))
)
where
fun ins []
=>
[ (x1, x2) ];
ins ((rng as (x1', x2')) ! r)
=>
if (x2 < x1') (x1, x2) ! rng ! r;
elif (x2' < x1 ) rng ! (ins r);
else (min (x1, x1'), max (x2, x2')) ! r;
fi;
end;
end;
# For each rectangle, compute the
# affected rows and add the rectangle's
# span to the damaged pixel intervals:
#
fun mark_pixel_damage ([], min_row, max_row)
=>
(min_row, max_row);
mark_pixel_damage ({ row=>x, col=>y, wide, high } ! rest, min_row, max_row)
=>
{ (pixel_rng_to_row_rng (y, y + high - 1))
->
(r1, r2);
start = x;
stop = x + wide - 1;
fun mark row
=
if (row <= r2)
#
union (row, start, stop);
mark (row+1);
fi;
mark r1;
mark_pixel_damage
( rest,
min (r1, min_row),
max (r2, max_row)
);
};
end;
(mark_pixel_damage (boxes, num_rows, -1))
->
(min_row, max_row);
# For each damaged row, compute the
# damaged region in character coordinates
# and redraw:
#
fun draw row
=
if (row <= max_row)
#
case (rw_vector::get (damage, row))
#
[] => ();
[ (x1, x2) ]
=>
{ (pixel_rng_to_col_rng (row, x1, x2))
->
(c1, c2);
tc::draw (get_text { row, start=>c1, stop=>c2 } );
};
((x1, x2) ! r)
=>
convert (c1, c2, r)
where
(pixel_rng_to_col_rng (row, x1, x2))
->
(c1, c2);
fun convert (start, stop, [])
=>
tc::draw (get_text { row, start=>c1, stop=>c2 } );
convert (start, stop, (x1, x2) ! r)
=>
{ (pixel_rng_to_col_rng (row, x1, x2))
->
(c1, c2);
if (stop < c1 - 1)
#
tc::draw (get_text { row, start, stop } );
convert (c1, c2, r);
else
convert (start, c2, r);
fi;
};
end;
end;
esac;
draw (row+1);
fi; # fun draw
end; # fun redraw'
end; # fun redraw
}; # package text_display
end;