## pen.pkg
#
# "A pen is similar to the graphics context provided by xlib.
# The principal differences are that pens are immutable, do
# not specify a font, and can specify clipping rectangles and
# dashlists (which are handled separately in the X protocol)."
# -- p16 http://mythryl.org/pub/exene/1993-lib.ps
# (John H Reppy's 1993 eXene library manual.)
#
# A pen is represented by a Vector with one slot each for
# 19 drawing-related properties. Many of these properties
# date back to the 1-bit-per-pixel monochrome days and do
# not mean much in today's 24-bit red-green-blue world:
#
# 0 Draw function: How should incoming bit be combined with pre-existing pixel bit? Obsolete: COPY is the only sensible one in today's 24-bit world.
# 1 Plane mask: Which bitplanes should be written to? Allows overlay planes etc. Obsolete: These days alpha-driven RGB compositing operations are more relevant.
# 2 Foreground color: What color should line/letter/polygon draw into the screen buffer?
# 3 Background color: Obsolete: This is useless in the modern RGB world.
# 4 Line width: Pixel width in which to write lines.
# 5 Line style: Should lines be drawn solid, dashed,...? Default is SOLID. Obsolete: These days texture maps are used for everything else.
# 6 Line cap style: What shape should lines end in? Default is CAP.
# 7 Line join style: How should line segments in a sequence be joined? Default is MITER.
# 8 Fill style: How should polygons be filled in? Default is SOLID. Obsolete: These days texture maps are used for everything else.
# 9 Fill rule: Which fill algorithm? Default is EVEN_ODD. See Note[1].
# 10 Pixmap
# 11 Stipple Obsolete: These days texture maps are used.
# 12 Stipple origin: Useful for textures...?
# 13 Clipping form: Should drawing on a window overwrite subwindows. Current, but x-kit doesn't use subwindows, making this setting irrelevant.
# 14 Clip origin: Origin of clip mask. Default is (0,0).
# 15 Clip mask: Which destination pixels should be written? Bitmaps or rectangles.
# 16 Dash offset: Default is 0.
# 17 Dash pattern: Specified by length or list.
# 18 Arc mode: Should arcs be curved lines or pie slices? Default is PIE_SLICE.
#
# See also:
# src/lib/x-kit/xclient/src/window/pen-guts.pkg# src/lib/x-kit/xclient/src/window/pen-to-gcontext-imp-old.pkg#
# Note[1]:
# From http://www.x.org/archive/X11R7.5/doc/x11proto/proto.html
# :
# The fill-rule defines what pixels are inside (that is, are drawn) for
# paths given in FillPoly requests. EvenOdd means a point is inside if
# an infinite ray with the point as origin crosses the path an odd
# number of times. For Winding, a point is inside if an infinite ray
# with the point as origin crosses an unequal number of clockwise and
# counterclockwise directed path segments. A clockwise directed path
# segment is one that crosses the ray from left to right as observed
# from the point. A counter-clockwise segment is one that crosses the
# ray from right to left as observed from the point. The case where a
# directed line segment is coincident with the ray is uninteresting
# because one can simply choose a different ray that is not coincident
# with a segment.
# Compiled by:
# src/lib/x-kit/xclient/xclient-internals.sublib# Compiled by:
# src/lib/x-kit/xclient/xclient-internals.sublib# Support for symbolic names for pen component values.
stipulate
package rc = range_check; # range_check is from src/lib/std/2d/range-check.pkg package dt = draw_types; # draw_types is from src/lib/x-kit/xclient/src/window/draw-types.pkg package xt = xtypes; # xtypes is from src/lib/x-kit/xclient/src/wire/xtypes.pkg package v2w = value_to_wire; # value_to_wire is from src/lib/x-kit/xclient/src/wire/value-to-wire.pkg package g2d = geometry2d; # geometry2d is from src/lib/std/2d/geometry2d.pkg package rwv = rw_vector; # rw_vector is from src/lib/std/src/rw-vector.pkg package vec = vector; # vector is from src/lib/std/src/vector.pkg package sn = xsession_junk; # xsession_junk is from src/lib/x-kit/xclient/src/window/xsession-junk.pkgherein
package pen {
#
include package geometry2d; # geometry2d is from src/lib/std/2d/geometry2d.pkg exception BAD_PEN_TRAIT;
# These are the properties
# distinguishing one pen from
# another:
#
package p {
#
Pen_Trait
#
= FUNCTION xt::Graphics_Op # Slot #0. Default is xt::OP_COPY.
| PLANE_MASK xt::Plane_Mask # Slot #1.
| FOREGROUND rgb8::Rgb8 # Slot #2.
| BACKGROUND rgb8::Rgb8 # Slot #3.
| LINE_WIDTH Int # Slot #4. Default is 4.
#
| LINE_STYLE_SOLID # Slot #5. Default is SOLID..
| LINE_STYLE_ON_OFF_DASH
| LINE_STYLE_DOUBLE_DASH
#
| CAP_STYLE_BUTT # Slot #6. Default is BUTT.
| CAP_STYLE_NOT_LAST
| CAP_STYLE_ROUND
| CAP_STYLE_PROJECTING
#
| JOIN_STYLE_MITER # Slot #7. Default is MITER.
| JOIN_STYLE_ROUND
| JOIN_STYLE_BEVEL
#
| FILL_STYLE_SOLID # Slot #8. Default is SOLID.
| FILL_STYLE_TILED
| FILL_STYLE_STIPPLED
| FILL_STYLE_OPAQUE_STIPPLED
#
| FILL_RULE_EVEN_ODD # Slot #9. Default is EVEN_ODD.
| FILL_RULE_WINDING
#
| RO_PIXMAP sn::Ro_Pixmap # Slot #10.
| STIPPLE sn::Ro_Pixmap # Slot #11.
| STIPPLE_ORIGIN Point # Slot #12.
#
| CLIP_BY_CHILDREN # Slot #13. Default is CLIP_BY_CHILDREN.
| INCLUDE_INFERIORS
#
| CLIP_ORIGIN Point # Slot #14. Default is (0,0).
# #
| CLIP_MASK_NONE # Slot #15. Default is NONE.
| CLIP_MASK sn::Ro_Pixmap
| CLIP_MASK_UNSORTED_BOXES List( Box )
| CLIP_MASK_YSORTED_BOXES List( Box )
| CLIP_MASK_YXSORTED_BOXES List( Box )
| CLIP_MASK_YXBANDED_BOXES List( Box )
#
| DASH_OFFSET Int # Slot #16. Default is 0.
#
| DASH_FIXED Int # Slot #17. Default is DASH_FIXED(4).
| DASH_LIST List(Int)
#
| ARC_MODE_PIE_SLICE # Slot #18. Default is PIE_SLICE.
| ARC_MODE_CHORD
;
};
stipulate
include package pen_guts; # pen_guts is from src/lib/x-kit/xclient/src/window/pen-guts.pkg fun check_list chkfn l
=
{ apply (\\ x = { chkfn x; ();})
l;
l;
};
fun check_item chkfn
=
\\ v = if (chkfn v) v;
else raise exception BAD_PEN_TRAIT;
fi;
check_card16 = unt::from_int o (check_item rc::valid16);
check_card8 = unt::from_int o (check_item rc::valid8);
check_point = check_item g2d::valid_point;
check_box = check_item g2d::valid_box;
check_boxes = check_list check_box;
check_card8s = check_list check_card8;
# Map a pen trait to its slot and representation
#
fun trait_to_rep (p::FUNCTION xt::OP_COPY) # CAVEAT PROGRAMMER! If you change slot numbers here you'll have to make corresponding changes
=> # to the pen_* constants in src/lib/x-kit/xclient/src/window/xserver-ximp.pkg (0, IS_DEFAULT);
trait_to_rep (p::FUNCTION gr_op)
=>
(0, IS_WIRE (v2w::graph_op_to_wire gr_op));
trait_to_rep (p::PLANE_MASK (xt::PLANEMASK mask))
=>
(1, IS_WIRE mask);
trait_to_rep (p::FOREGROUND rgb8)
=>
{ i = rgb8::rgb8_to_int rgb8;
#
i == 0 ?? (2, IS_DEFAULT)
:: (2, IS_WIRE (unt::from_int i));
};
trait_to_rep (p::BACKGROUND rgb8)
=>
{ i = rgb8::rgb8_to_int rgb8;
#
i == 1 ?? (3, IS_DEFAULT)
:: (3, IS_WIRE (unt::from_int i));
};
trait_to_rep (p::LINE_WIDTH 0 ) => (4, IS_DEFAULT);
trait_to_rep (p::LINE_WIDTH wd) => (4, IS_WIRE (check_card16 wd));
trait_to_rep (p::LINE_STYLE_SOLID ) => (5, IS_DEFAULT);
trait_to_rep (p::LINE_STYLE_ON_OFF_DASH) => (5, IS_WIRE 0u1);
trait_to_rep (p::LINE_STYLE_DOUBLE_DASH) => (5, IS_WIRE 0u2);
trait_to_rep (p::CAP_STYLE_BUTT ) => (6, IS_DEFAULT);
trait_to_rep (p::CAP_STYLE_NOT_LAST ) => (6, IS_WIRE 0u0);
trait_to_rep (p::CAP_STYLE_ROUND ) => (6, IS_WIRE 0u2);
trait_to_rep (p::CAP_STYLE_PROJECTING) => (6, IS_WIRE 0u3);
trait_to_rep (p::JOIN_STYLE_MITER) => (7, IS_DEFAULT);
trait_to_rep (p::JOIN_STYLE_ROUND) => (7, IS_WIRE 0u1);
trait_to_rep (p::JOIN_STYLE_BEVEL) => (7, IS_WIRE 0u2);
trait_to_rep (p::FILL_STYLE_SOLID ) => (8, IS_DEFAULT);
trait_to_rep (p::FILL_STYLE_TILED ) => (8, IS_WIRE 0u1);
trait_to_rep (p::FILL_STYLE_STIPPLED ) => (8, IS_WIRE 0u2);
trait_to_rep (p::FILL_STYLE_OPAQUE_STIPPLED) => (8, IS_WIRE 0u3);
trait_to_rep (p::FILL_RULE_EVEN_ODD) => (9, IS_DEFAULT);
trait_to_rep (p::FILL_RULE_WINDING ) => (9, IS_WIRE 0u1);
trait_to_rep (p::RO_PIXMAP (sn::RO_PIXMAP ({ pixmap_id, ... }: sn::Rw_Pixmap))) => (10, IS_PIXMAP pixmap_id);
trait_to_rep (p::STIPPLE (sn::RO_PIXMAP ({ pixmap_id, ... }: sn::Rw_Pixmap))) => (11, IS_PIXMAP pixmap_id);
trait_to_rep (p::STIPPLE_ORIGIN pt) => (12, IS_POINT (check_point pt));
trait_to_rep (p::CLIP_BY_CHILDREN ) => (13, IS_DEFAULT);
trait_to_rep (p::INCLUDE_INFERIORS) => (13, IS_WIRE 0u1);
trait_to_rep (p::CLIP_ORIGIN ({ col=>0, row=>0 } )) => (14, IS_DEFAULT);
trait_to_rep (p::CLIP_ORIGIN pt) => (14, IS_POINT (check_point pt));
trait_to_rep (p::CLIP_MASK_NONE) => (15, IS_DEFAULT);
trait_to_rep (p::CLIP_MASK (sn::RO_PIXMAP ({ pixmap_id, ... }: sn::Rw_Pixmap))) => (15, IS_PIXMAP pixmap_id);
trait_to_rep (p::CLIP_MASK_UNSORTED_BOXES r) => (15, IS_BOXES (xt::UNSORTED_ORDER, check_boxes r));
trait_to_rep (p::CLIP_MASK_YSORTED_BOXES r) => (15, IS_BOXES (xt::YSORTED_ORDER, check_boxes r));
trait_to_rep (p::CLIP_MASK_YXSORTED_BOXES r) => (15, IS_BOXES (xt::YXSORTED_ORDER, check_boxes r));
trait_to_rep (p::CLIP_MASK_YXBANDED_BOXES r) => (15, IS_BOXES (xt::YXBANDED_ORDER, check_boxes r));
trait_to_rep (p::DASH_OFFSET 0) => (16, IS_DEFAULT);
trait_to_rep (p::DASH_OFFSET n) => (16, IS_WIRE (check_card16 n));
trait_to_rep (p::DASH_FIXED 4) => (17, IS_DEFAULT);
trait_to_rep (p::DASH_FIXED n) => (17, IS_WIRE (check_card8 n));
trait_to_rep (p::DASH_LIST dashes) => (17, IS_DASHES (check_card8s dashes));
trait_to_rep (p::ARC_MODE_PIE_SLICE) => (18, IS_DEFAULT);
trait_to_rep (p::ARC_MODE_CHORD ) => (18, IS_WIRE 0u0);
end;
# Return a bitmask showing which slots in # CAVEAT PROGRAMMER! This bitmask numbering reflects the above slot numbers
# pen-guts rw_vector 'vec' are not IS_DEFAULT. # but must be kept sync'd with the pen_* constants in
# # src/lib/x-kit/xclient/src/window/xserver-ximp.pkg # This mask will have
#
# bit[0] == 1 iff vec[0] != IS_DEFAULT,
# bit[1] == 1 iff vec[1] != IS_DEFAULT,
# ...
# bit[i] == 1 iff vec[i] != IS_DEFAULT.
#
fun extract_mask vec
=
loop (0u0, 0, 0u1)
where
fun loop (m, i, b)
=
if (i == pen_slot_count) m;
else
case (vec[i])
#
IS_DEFAULT => loop (m, i+1, unt::(<<) (b, 0u1));
_ => loop (unt::bitwise_or (m, b), i+1, unt::(<<) (b, 0u1));
esac;
fi;
end;
# Make a pen from a rw_vector of initial
# values and a list of new values
#
fun make_pen' (vec, trait_list: List(p::Pen_Trait))
=
{ fun update (slot, rep)
=
vec[slot] := rep;
apply (\\ trait = update (trait_to_rep trait))
trait_list;
{ traits => vec::from_fn (pen_slot_count, \\ i = vec[i]),
bitmask => extract_mask vec
}
: Pen
;
};
herein
default_pen
=
pen_guts::default_pen;
# Create a new drawing context
# from a list of pen traits:
#
fun make_pen (traits: List(p::Pen_Trait)) # PUBLIC.
=
make_pen' (rwv::make_rw_vector (pen_slot_count, IS_DEFAULT), traits);
# Create a new pen from an existing
# pen by functional update:
#
fun clone_pen
( { traits, ... }: Pen,
new_traits: List(p::Pen_Trait)
)
=
make_pen' (rwv::from_fn (pen_slot_count, \\ i = traits[i]), new_traits);
end; # stipulate
}; # package pen
end;