## draw-types.pkg
#
# Types of chunks that can be drawn on (or are pixel sources).
# Compiled by:
#
src/lib/x-kit/xclient/xclient-internals.sublib### "The Universe is a grand book which cannot be read
### until one first learns to comprehend the language
### and become familiar with the characters in which
### it is composed. It is written in the language of
### mathematics..."
###
### -- Galilei Galileo
stipulate
include threadkit; # threadkit is from
src/lib/src/lib/thread-kit/src/core-thread-kit/threadkit.pkg #
package xg = xgeometry; # xgeometry is from
src/lib/std/2d/xgeometry.pkg package xt = xtypes; # xtypes is from
src/lib/x-kit/xclient/pkg/wire/xtypes.pkg package sn = xsession; # xsession is from
src/lib/x-kit/xclient/pkg/window/xsession.pkg package di = draw_imp; # draw_imp is from
src/lib/x-kit/xclient/pkg/window/draw-imp.pkg package pg = pen_guts; # pen_guts is from
src/lib/x-kit/xclient/pkg/window/pen-guts.pkgherein
package draw_types
: (weak) Draw_Types # Draw_Types is from
src/lib/x-kit/xclient/pkg/window/draw-types.api {
# This basically does
#
# Window = sn::Window;
#
package x: api {
Window
=
WINDOW
{
window_id: xt::Window_Id,
screen: sn::Screen,
screen_pen_and_draw_imps: sn::Screen_Pen_And_Draw_Imps,
to_topwindow_drawimp: di::d::Draw_Op -> Void
};
} = xsession;
include xsession;
# An off-screen rectangular pixel array on X server:
#
Rw_Pixmap
=
RW_PIXMAP
{
pixmap_id: xt::Pixmap_Id,
screen: sn::Screen,
size: xg::Size,
screen_pen_and_draw_imps: sn::Screen_Pen_And_Draw_Imps
};
# Immutable pixmaps
#
Ro_Pixmap = RO_PIXMAP Rw_Pixmap;
# identity tests
same_window = sn::same_window;
fun same_rw_pixmap
(
RW_PIXMAP { pixmap_id=>id1, screen=>s1, ... },
RW_PIXMAP { pixmap_id=>id2, screen=>s2, ... }
)
=
(id1 == id2) and sn::same_screen (s1, s2);
fun same_ro_pixmap
( RO_PIXMAP p1,
RO_PIXMAP p2
)
=
same_rw_pixmap (p1, p2);
# Sources for bitblt operations:
#
Draw_From
= FROM_WINDOW Window
| FROM_RW_PIXMAP Rw_Pixmap
| FROM_RO_PIXMAP Ro_Pixmap
;
fun depth_of_window (WINDOW { screen_pen_and_draw_imps => sn::SCREEN_PEN_AND_DRAW_IMPS { depth, ... }, ... } ) = depth;
fun depth_of_rw_pixmap (RW_PIXMAP { screen_pen_and_draw_imps => sn::SCREEN_PEN_AND_DRAW_IMPS { depth, ... }, ... } ) = depth;
fun depth_of_ro_pixmap (RO_PIXMAP (RW_PIXMAP { screen_pen_and_draw_imps => sn::SCREEN_PEN_AND_DRAW_IMPS { depth, ... }, ... } )) = depth;
fun id_of_window (WINDOW { window_id => xt::XID u, ... } ) = unt::to_int u;
fun id_of_rw_pixmap (RW_PIXMAP { pixmap_id => xt::XID u, ... } ) = unt::to_int u;
fun id_of_ro_pixmap (RO_PIXMAP (RW_PIXMAP { pixmap_id => xt::XID u, ... } )) = unt::to_int u;
fun depth_of_draw_src (FROM_WINDOW w) => depth_of_window w;
depth_of_draw_src (FROM_RW_PIXMAP w) => depth_of_rw_pixmap w;
depth_of_draw_src (FROM_RO_PIXMAP w) => depth_of_ro_pixmap w;
end;
fun shape_of_window (WINDOW { window_id, screen=>sn::SCREEN { xsession, ... }, ... } )
=
{ include value_to_wire; # value_to_wire is from
src/lib/x-kit/xclient/pkg/wire/value-to-wire.pkg include wire_to_value; # wire_to_value is from
src/lib/x-kit/xclient/pkg/wire/wire-to-value.pkg reply = do_mailop
(sn::send_xrequest_and_read_reply
xsession
(encode_get_geometry { drawable=>window_id } )
);
my { depth, geometry=>xg::WINDOW_SITE { upperleft, size, border_thickness }, ... }
=
decode_get_geometry_reply reply;
{ upperleft, size, depth, border_thickness };
};
fun shape_of_rw_pixmap (RW_PIXMAP { size, screen_pen_and_draw_imps => sn::SCREEN_PEN_AND_DRAW_IMPS { depth, ... }, ... } )
=
{ upperleft => xg::point::zero,
size,
depth,
border_thickness => 0
};
fun shape_of_ro_pixmap (RO_PIXMAP pm)
=
shape_of_rw_pixmap pm;
fun shape_of_draw_src (FROM_WINDOW w) => shape_of_window w;
shape_of_draw_src (FROM_RW_PIXMAP pm) => shape_of_rw_pixmap pm;
shape_of_draw_src (FROM_RO_PIXMAP (RO_PIXMAP pm)) => shape_of_rw_pixmap pm;
end;
fun size_of_window window
=
{ my { size, ... }
=
shape_of_window window;
size;
};
fun size_of_rw_pixmap (RW_PIXMAP { size, ... } )
=
size;
fun size_of_ro_pixmap (RO_PIXMAP pm)
=
size_of_rw_pixmap pm;
fun flush_drawimp to_drawimp
=
{ done_flush_oneshot = make_oneshot_maildrop ();
#
to_drawimp (di::d::FLUSH done_flush_oneshot);
#
get done_flush_oneshot;
};
fun drawimp_thread_id_of to_drawimp
=
{ thread_id_oneshot = make_oneshot_maildrop ();
#
to_drawimp (di::d::THREAD_ID thread_id_oneshot);
#
get thread_id_oneshot;
};
# drawables **
#
# these are abstract views of drawable chunks (e.g., windows or pixmaps).
#
package r {
#
Window_Or_Pixmap
#
= WINDOW Window
| PIXMAP Rw_Pixmap
;
};
#
Drawable
=
DRAWABLE
{
root: r::Window_Or_Pixmap,
to_drawimp: di::d::Draw_Op -> Void
};
# Make a drawable from a window
#
fun drawable_of_window (w as WINDOW { to_topwindow_drawimp => to_drawimp, ... } )
=
DRAWABLE { root => r::WINDOW w, to_drawimp };
# Make a drawable from a rw_pixmap
#
fun drawable_of_rw_pixmap (pm as RW_PIXMAP { size, screen_pen_and_draw_imps => sn::SCREEN_PEN_AND_DRAW_IMPS { to_screen_drawimp, ... }, ... } )
=
DRAWABLE { root => r::PIXMAP pm, to_drawimp=>draw_command' }
where
fun draw_command' (di::d::DRAW { to, pen, op => di::o::CLEAR_AREA (xg::BOX { col, row, wide, high } ) } )
=>
{ fun clip (z, 0, max) => max - z;
clip (z, w, max) => if ( (z + w) > max ) max - z; else w; fi;
end;
my xg::SIZE { wide => pm_wide,
high => pm_high
}
=
size;
to_box
=
xg::BOX
{ col,
row,
wide => clip (col, wide, pm_wide),
high => clip (row, high, pm_high)
};
to_screen_drawimp (di::d::DRAW {
to,
pen => pg::default_pen,
op => di::o::POLY_FILL_BOX [ to_box ]
} );
# The following is needed to
# avoid race between updating
# the rw_pixmap and using it as
# the source of a blt:
#
flush_drawimp to_screen_drawimp;
};
draw_command' dmsg
=>
to_screen_drawimp dmsg;
end;
end;
fun depth_of_drawable (DRAWABLE { root => r::WINDOW w, ... } ) => depth_of_window w;
depth_of_drawable (DRAWABLE { root => r::PIXMAP pm, ... } ) => depth_of_rw_pixmap pm;
end;
# An unbuffered drawable is used to provide immediate
# graphical response to user interaction. Currently
# this is implemented by transparently adding a flush
# command after each draw command. There is probably
# a better way.
#
# This call is used in many of the src/lib/x-kit/tut
# programs, for an example in:
#
#
src/lib/x-kit/widget/fancy/graphviz/get-mouse-selection.pkg #
fun make_unbuffered_drawable (DRAWABLE { root as r::WINDOW w, to_drawimp } )
=>
DRAWABLE
{
root,
to_drawimp => fn msg = { to_drawimp msg;
flush_drawimp to_drawimp;
}
};
make_unbuffered_drawable d
=>
d;
end;
# The following exception is raised
# if an attempt is made to use a stale
# overlay drawable (i.e., one that has been released).
#
exception STALE_OVERLAY;
# Create a locked version of the given window.
# This provides exclusive access to its drawing
# surface (and that of its descendents) during
# OP_XOR rubber-banding. Usually used in conjunction
# with unbuffered drawing (below).
#
# The first result is the locked window on which to draw,
# the second is the unlock operation for the drawable.
# By convention, the overlay drawable is unbuffered.
#
#
# This call appears to be unused at present, but see
# much related-looking "overlay" code in
#
src/lib/x-kit/xclient/pkg/window/draw-imp.pkg # this may be a half-implemented idea.
#
fun make_locked_window w
=
{ release_1shot = make_oneshot_maildrop ();
new_draw_slot = make_mailslot ();
# The draw command for the overlay.
# It raises STALE_OVERLAY if called
# after the overlay is released.
error_mailop
=
get' release_1shot
==>
.{ raise exception STALE_OVERLAY; };
fun draw_fn msg
=
select [
give' (new_draw_slot, msg),
error_mailop
];
fun draw_and_flush msg
=
{ draw_fn msg;
flush_done_oneshot = make_oneshot_maildrop ();
draw_fn (di::d::FLUSH flush_done_oneshot);
get flush_done_oneshot;
};
# The function used to release the overlay.
# Multiple calls are allowed,
# so we must handle WriteTwice.
#
fun release_fn ()
=
set (release_1shot, ())
except
_ = ();
draw_fn (
di::d::LOCK_WINDOW_FOR_RUBBERBANDING
{
draw_slot => new_draw_slot,
release' => get' release_1shot
}
);
{ drawable => DRAWABLE { root => r::WINDOW w, to_drawimp => draw_and_flush },
release => release_fn
};
};
}; # draw_types
end;