


## bounce-drawmaster.pkg
# Compiled by:
# src/lib/x-kit/tut/bouncing-heads/bouncing-heads-app.libstipulate
include threadkit; # threadkit is from src/lib/src/lib/thread-kit/src/core-thread-kit/threadkit.pkg #
package xc = xclient; # xdraw is from src/lib/x-kit/xclient/xclient.pkg package xg = xgeometry; # xgeometry is from src/lib/std/2d/xgeometry.pkgherein
package bounce_drawmaster {
Dm_Msg
= DRAW_BALL (Int, xc::Ro_Pixmap, xg::Point)
| ERASE_BALL (Int, xc::Ro_Pixmap, xg::Point)
| REDRAW Int
;
# The bounce DM is actually responsible for drawing the heads
#
fun bounce_dm window
=
{ draw_slot = make_mailslot ();
# xsession = xsession_of_window window; # 2010-01-10 CrT: Commented out -- unused.
pen = xc::make_pen
[
xc::p::FUNCTION xc::OP_XOR,
# xc::p::FOREGROUND xc::rgb8_color1,
xc::p::FOREGROUND xc::rgb8_green,
xc::p::BACKGROUND xc::rgb8_color0
];
drawable = xc::drawable_of_window window;
fun redraw ()
=
xc::clear_drawable drawable;
fun draw (icon, pt)
=
{ (xc::shape_of_ro_pixmap icon)
->
{ upperleft => xg::POINT { col, row },
size => xg::SIZE { wide, high },
...
};
xc::texture_blt drawable pen
#
{ from => icon,
to_pos => pt
};
};
fun loop1 seqn
=
case (nonblocking_take_from_mailslot draw_slot)
#
NULL =>
loop2 seqn;
THE (DRAW_BALL (n, pm, pt))
=>
{ if (n == seqn) draw (pm, pt); fi;
loop1 seqn;
};
THE (ERASE_BALL (n, pm, pt))
=>
{ if (n == seqn) draw (pm, pt); fi;
loop1 seqn;
};
THE (REDRAW n)
=>
{ redraw ();
loop1 n;
};
esac
also
fun loop2 seqn
=
case (take_from_mailslot draw_slot)
#
DRAW_BALL (n, pm, pt)
=>
if (n == seqn)
#
draw (pm, pt);
loop1 seqn;
else
loop2 seqn;
fi;
ERASE_BALL (n, pm, pt)
=>
if (n == seqn)
#
draw (pm, pt);
loop1 seqn;
else
loop2 seqn;
fi;
REDRAW n
=>
{ redraw ();
loop2 n;
};
esac;
xlogger::make_thread "bounce_drawmaster" .{ loop2 0; };
draw_slot;
};
};
end;
## COPYRIGHT (c) 1990, 1991 by John H. Reppy. See SMLNJ-COPYRIGHT file for details.
## Subsequent changes by Jeff Prothero Copyright (c) 2010-2013,
## released per terms of SMLNJ-COPYRIGHT.


