# text-canvas.pkg
#
# NOTE: one optimization might be to exploit
# the situation in which a pen uses the
# default background. This can be done
# when redrawing text, and when filling
# the background.
# Compiled by:
# src/lib/x-kit/widget/xkit-widget.sublibstipulate
#
package g2d= geometry2d; # geometry2d is from src/lib/std/2d/geometry2d.pkg package xc = xclient; # xclient is from src/lib/x-kit/xclient/xclient.pkg #
package tw = text_widget; # text_widget is from src/lib/x-kit/widget/old/text/text-widget.pkgherein
package text_canvas: (weak) Text_Canvas { # Text_Canvas is from src/lib/x-kit/widget/old/fancy/graphviz/text/text-canvas.api /* +DEBUG */
tracing = logger::make_logtree_leaf { parent => xlogger::widgets_logging, name => "text_canvas::tracing", default => FALSE };
fun pr s = logger::log_if tracing 0 {. s; };
fun prf (fmt, items) = logger::log_if tracing 0 {. sfprintf::sprintf' fmt items; };
/* -DEBUG */
# A text canvas is a proto-widget
# for drawing text:
#
Text_Canvas
=
TEXT_CANVAS
{
window: xc::Window, # The window.
drawable: xc::Drawable, # The drawable surface.
font: xc::Font, # The default font.
foreground: xc::Rgb, # The default foreground color.
background: xc::Rgb, # The default background color.
default_pen: xc::Pen # The default pen.
};
fun make_text_canvas
{ window,
size,
font: xc::Font,
foreground,
background
}
=
{ screen = xc::screen_of_window window;
fun default_color (NULL, color) => color;
default_color (THE c, _) => xc::get_color c;
end;
foreground = default_color (foreground, xc::black);
background = default_color (background, xc::white);
xc::change_window_attributes window
[
xc::a::BACKGROUND_COLOR background,
xc::a::BIT_GRAVITY xc::NORTHWEST_GRAVITY
];
TEXT_CANVAS
{
window,
font,
drawable => xc::drawable_of_window window,
#
foreground,
background,
default_pen
=>
xc::make_pen
[
xc::p::FOREGROUND (xc::rgb8_from_rgb foreground),
xc::p::BACKGROUND (xc::rgb8_from_rgb background)
]
};
};
# Clear a canvas to its
# background color:
#
fun clear (TEXT_CANVAS { drawable, ... } )
=
xc::clear_drawable drawable;
# Specifies canvas, font, color, etc.
# for writing text:
#
Typeball
=
TYPEBALL
{
drawable: xc::Drawable, # The text display that this
# typeball is associated with.
foreground_color: xc::Color_Spec, #
background_color: xc::Color_Spec, #
fore: xc::Pen, # Pen to draw foreground.
back: xc::Pen, # Pen to draw background.
under: Null_Or( xc::Pen ), # Pen to draw underline; if enabled
font: xc::Font, # Font used.
line_high: Int, # The height the line.
ascent: Int
};
Typeball_Val
#
= TBV_FONT xc::Font # Font.
| TBV_LINEHEIGHT Int # Total height of line.
| TBV_ASCENT Int # Height of line above baseline.
| TBV_UNDERLINE Bool # Underline mode.
| TBV_FOREGROUND xc::Color_Spec # Forground (text) color.
| TBV_BACKGROUND xc::Color_Spec # Background color.
| TBV_UNDERGRND xc::Color_Spec # Color of underline.
;
# Create a new typeball:
#
fun make_typeball
( TEXT_CANVAS { window, drawable, font, foreground, background, ... },
vl
)
=
{ font = REF font;
foreground_color = REF (xc::CMS_NAME "black");
background_color = REF (xc::CMS_NAME "white");
fore = REF foreground;
back = REF background;
line_high = REF NULL;
ascent = REF NULL;
underline = REF FALSE;
under = REF foreground;
color_of = xc::get_color;
fun do_val (TBV_FONT f) => font := f;
do_val (TBV_LINEHEIGHT n) => line_high := THE n;
do_val (TBV_ASCENT n) => ascent := THE n;
do_val (TBV_UNDERLINE b) => underline := b;
do_val (TBV_FOREGROUND c) => { foreground_color := c; fore := color_of c; };
do_val (TBV_BACKGROUND c) => { background_color := c; back := color_of c; };
do_val (TBV_UNDERGRND c) => under := color_of c;
end;
apply do_val vl;
fun make_pen (f, b)
=
xc::make_pen
[
xc::p::FUNCTION xc::OP_COPY,
xc::p::FOREGROUND (xc::rgb8_from_rgb *f),
xc::p::BACKGROUND (xc::rgb8_from_rgb *b)
];
fore_pen = make_pen (fore, back);
under_pen
=
if *underline
#
if (xc::same_rgb(*fore, *under)) THE fore_pen;
else THE (make_pen (under, back));
fi;
else
NULL;
fi;
my (font_ht, font_ascent)
=
{ my { ascent, descent }
=
xc::font_high *font;
(ascent+descent, ascent);
};
fun max (NULL, x: Int) => x;
max (THE x, y: Int) => (x > y) ?? x :: y;
end;
TYPEBALL
{
drawable,
foreground_color => *foreground_color,
background_color => *background_color,
fore => fore_pen,
back => make_pen (back, fore),
under => under_pen,
font => *font,
line_high => max(*line_high, font_ht),
ascent => max(*ascent, font_ascent)
};
};
# Return the default typeball
# for the canvas:
#
fun default_typeball txt_canvas
=
make_typeball (txt_canvas, []);
# Copy a typeball, updating
# some attributes
#
fun copy_typeball (TYPEBALL { ... }, vl)
=
raise exception DIE "unimplemented";
Text_Elem
#
= TEXT { tb: Typeball, text: String }
| FILL { tb: Typeball, chr_wid: Int, pix_wid: Int };
# Return the width (in pixels)
# of a text element
#
fun pix_width_of (TEXT { tb=>TYPEBALL { font, ... }, text } )
=>
xc::text_width font text;
pix_width_of (FILL { pix_wid, ... } )
=>
pix_wid;
end;
# Return the width (in characters)
# of a text element:
#
fun chr_width_of (TEXT { text, ... } ) => size text;
chr_width_of (FILL { chr_wid, ... } ) => chr_wid;
end;
# Return the width of a text string
# using the given typeball:
#
fun text_width (TYPEBALL { font, ... } )
=
xc::text_width font;
# Return the substring
# of a text element:
#
fun substr (TEXT { tb, text }, i, n)
=>
TEXT { tb, text=>string::substring (text, i, n) };
substr (FILL { tb, chr_wid, pix_wid }, i, n)
=>
if (i < 0 or n < 0 or chr_wid < i+n)
#
raise exception INDEX_OUT_OF_BOUNDS;
else
FILL { tb, chr_wid=>n-i, pix_wid=>(pix_wid*(n-i)) % chr_wid };
fi;
end;
# Return the font of a typeball:
#
fun font_of (TYPEBALL { font, ... } )
=
font;
# Do a copy_blt on the canvas:
#
fun blt (TEXT_CANVAS { drawable, default_pen, ... } )
=
xc::copy_blt_mailop
drawable
default_pen;
# Clear the specified box
# to the background color
#
fun clear_box (TEXT_CANVAS { drawable, ... } )
=
xc::clear_box drawable;
fun draw_opaque_string (TYPEBALL { drawable, font, fore, ... } )
=
xc::draw_opaque_string drawable fore font;
fun fill (TYPEBALL { drawable, back, line_high, ascent, ... } )
=
{ draw = xc::fill_box drawable back;
\\ ({ col, row }, wide)
=
draw ({ col, row=>row-ascent, wide, high=>line_high } );
};
# What about background??? XXX BUGGO FIXME
#
fun draw { at=>{ col=>x, row=>y }, elems }
=
draw_it (elems, x)
where
fun draw_it ([], _)
=>
();
draw_it (TEXT { tb, text } ! r, x)
=>
{ draw_opaque_string tb ({ col=>x, row=>y }, text);
draw_it (r, x + text_width tb text);
};
draw_it (FILL { tb, pix_wid, ... } ! r, x)
=>
{ fill tb ({ col=>x, row=>y }, pix_wid);
draw_it (r, x+pix_wid);
};
end;
end;
fun draw_text tb
=
{ draw = draw_opaque_string tb;
\\ { at, text }
=
draw (at, text);
};
fun draw_fill tb
=
{ draw = fill tb;
\\ { at, wid }
=
draw (at, wid);
};
/**
# Cursors
enum text_cursor
= NO_CURSOR
| BOX_CURSOR ??
| OUTLINE_CURSOR ??
| CARET_CURSOR ??
| BAR_CURSOR ??
| XTERM_CURSOR ??
| GLYPH_CURSOR ??
;
fun set_cursor: (Text_Canvas, Text_Cursor) -> Void;
# set the type of the cursor
fun move_cursor: (Text_Canvas, tw::Char_Point) -> Void;
# set the current cursor position
fun cursor_on (Text_Canvas {... } ) = ??
# enable display of the text cursor
fun cursor_off (TextCanvas {... } ) = ??
# Disable display of the text cursor
**/
}; # package text_canvas
end;