## pen-guts.pkg
#
# A read-only drawing context.
# This is gets mapped onto an
# X-server graphics context (GC) by
# src/lib/x-kit/xclient/src/window/pen-to-gcontext-imp-old.pkg#
# See also:
# src/lib/x-kit/xclient/src/window/pen.pkg# Compiled by:
# src/lib/x-kit/xclient/xclient-internals.sublib# The internal representation of pen values.
stipulate
package g2d= geometry2d; # geometry2d is from src/lib/std/2d/geometry2d.pkg package xt = xtypes; # xtypes is from src/lib/x-kit/xclient/src/wire/xtypes.pkgherein
package pen_guts
: (weak) Pen_Guts # Pen_Guts is from src/lib/x-kit/xclient/src/window/pen-guts.api {
Pen_Part # Internal representation of pen trait values.
= IS_DEFAULT
| IS_WIRE Unt # A trait's wire representation.
| IS_PIXMAP xt::Pixmap_Id
| IS_POINT g2d::Point
| IS_BOXES (xt::Box_Order, List( g2d::Box ))
| IS_DASHES List( Int )
;
Pen = { traits: vector::Vector( Pen_Part ), # The state vector (read-only).
bitmask: Unt # Bitmask giving which vector entries have non-default values.
};
pen_slot_count = 19;
default_pen
=
{ traits => vector::from_fn (pen_slot_count, \\ _ = IS_DEFAULT),
bitmask => 0u0
}
: Pen
;
fun pen_match (0u0, _, _)
=>
TRUE; # Bitmask selects no state components, so match is vacuously true.
pen_match
( used_mask,
{ bitmask => bitmask1, traits => traits1 }: Pen,
{ bitmask => bitmask2, traits => traits2 }: Pen
)
=>
(traits1 == traits2) # first test for same chunk
or
{
m = (used_mask & bitmask1);
#
(m == (bitmask2 & used_mask))
and
match_vals (m, 0)
where
fun match_val (IS_WIRE a, IS_WIRE b)
=>
a == b;
match_val (IS_PIXMAP xid_a, IS_PIXMAP xid_b)
=>
(xt::xid_to_unt xid_a) == (xt::xid_to_unt xid_b);
match_val (IS_POINT a, IS_POINT b)
=>
a == b;
match_val (IS_BOXES (o1, rl1), IS_BOXES (o2, rl2))
=>
(o1 == o2) and eq (rl1, rl2)
where
fun eq ([], []) => TRUE;
eq ((a: g2d::Box) ! ra, b ! rb) => (a==b) and eq (ra, rb);
eq _ => FALSE;
end;
end;
match_val (IS_DASHES a, IS_DASHES b)
=>
{
fun eq ([], []) => TRUE;
eq ((a: Int) ! ra, b ! rb) => (a==b) and eq (ra, rb);
eq _ => FALSE;
end;
eq (a, b);
};
match_val _ => FALSE;
end;
fun match_vals (0u0, _)
=> TRUE;
match_vals (m, i)
=>
(((m & 0u1) == 0u0)
or match_val (traits1[i], traits2[i]))
and match_vals (m >> 0u1, i+1);
end;
end;
};
end;
}; # package pen_guts
end;