## 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/pkg/window/pen-to-gcontext-imp.pkg# Compiled by:
# src/lib/x-kit/xclient/xclient-internals.sublib# The internal representation of pen values.
stipulate
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.pkgherein
package pen_guts
: (weak) Pen_Guts # pen_guts is from src/lib/x-kit/xclient/pkg/window/pen-guts.pkg {
my (&) = unt::bitwise_and;
my (>>) = unt::(>>);
# infix val & >>;
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 xg::Point
| IS_BOXES (xt::Box_Order, List( xg::Box ))
| IS_DASHES List( Int )
;
Pen = 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
=
PEN { traits => vector::tabulate (pen_slot_count, fn _ = IS_DEFAULT),
bitmask => 0u0
};
fun pen_match (0u0, _, _)
=>
TRUE; # Bitmask selects no state components, so match is vacuously true.
pen_match
( used_mask,
PEN { bitmask => bitmask1, traits => traits1 },
PEN { bitmask => bitmask2, traits => traits2 }
)
=>
(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 (xt::XID a), IS_PIXMAP (xt::XID b))
=>
a == 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: xg::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 (vector::get (traits1, i), vector::get (traits2, i)))
and match_vals (m >> 0u1, i+1);
end;
end;
};
end;
}; # package pen_guts
end;