## cs-pixmap.pkg "cs" == "client-side"
#
# Client-side rectangular arrays of pixels,
# Support for copying back and forth between them
# and server-side windows makes them useful for
# specifying icons, tiling patterns and other
# client-originated image data intended for X display.
#
# See also:
# src/lib/x-kit/xclient/src/window/ro-pixmap-old.pkg# src/lib/x-kit/xclient/src/window/window-old.pkg# src/lib/x-kit/xclient/src/window/rw-pixmap-old.pkg# Compiled by:
# src/lib/x-kit/xclient/xclient-internals.sublib#
# TODO XXX SUCKO FIXME
# - support a left-pad
# - support Z format
### "Science is what we understand well enough to explain
### to a computer. Art is everything else we do."
###
### -- Donald Knuth
stipulate
include package threadkit; # threadkit is from src/lib/src/lib/thread-kit/src/core-thread-kit/threadkit.pkg #
package byt = byte; # byte is from src/lib/std/src/byte.pkg package v1u = vector_of_one_byte_unts; # vector_of_one_byte_unts is from src/lib/std/src/vector-of-one-byte-unts.pkg package s1u = vector_slice_of_one_byte_unts; # vector_slice_of_one_byte_unts is from src/lib/std/src/vector-slice-of-one-byte-unts.pkg package w8 = one_byte_unt; # one_byte_unt is from src/lib/std/one-byte-unt.pkg package g2d = geometry2d; # geometry2d is from src/lib/std/2d/geometry2d.pkg package w2v = wire_to_value; # wire_to_value is from src/lib/x-kit/xclient/src/wire/wire-to-value.pkg package v2w = value_to_wire; # value_to_wire is from src/lib/x-kit/xclient/src/wire/value-to-wire.pkg package xt = xtypes; # xtypes is from src/lib/x-kit/xclient/src/wire/xtypes.pkg package xtr = xlogger; # xlogger is from src/lib/x-kit/xclient/src/stuff/xlogger.pkg #
package di = xserver_ximp; # xserver_ximp is from src/lib/x-kit/xclient/src/window/xserver-ximp.pkg package w2x = windowsystem_to_xserver; # windowsystem_to_xserver is from src/lib/x-kit/xclient/src/window/windowsystem-to-xserver.pkg# package dt = draw_types; # draw_types is from src/lib/x-kit/xclient/src/window/draw-types.pkg package dy = display; # display is from src/lib/x-kit/xclient/src/wire/display.pkg package sn = xsession_junk; # xsession_junk is from src/lib/x-kit/xclient/src/window/xsession-junk.pkg package wpm = rw_pixmap; # rw_pixmap is from src/lib/x-kit/xclient/src/window/rw-pixmap.pkg# package x2s = xclient_to_sequencer; # xclient_to_sequencer is from src/lib/x-kit/xclient/src/wire/xclient-to-sequencer.pkg package pn = pen; # pen is from src/lib/x-kit/xclient/src/window/pen.pkg #
trace = xtr::log_if xtr::io_logging 0; # Conditionally write strings to tracing.log or whatever.
herein
package cs_pixmap
: (weak) Cs_Pixmap # Cs_Pixmap is from src/lib/x-kit/xclient/src/window/cs-pixmap.api {
exception BAD_CS_PIXMAP_DATA;
v1uextract = s1u::to_vector
o
s1u::make_slice;
Cs_Pixmap = CS_PIXMAP { size: g2d::Size,
data: List( List( v1u::Vector ) )
};
# Two cs_pixmaps are the same
# iff their fields are the same:
#
fun same_cs_pixmap
( CS_PIXMAP { size => size1, data => data1 },
CS_PIXMAP { size => size2, data => data2 }
)
=
if (not (g2d::size::eq (size1, size2)))
#
FALSE;
else
same_planes (data1, data2)
where
fun same_plane ([], []) => TRUE;
same_plane (_, []) => FALSE;
same_plane ([], _ ) => FALSE;
same_plane ( scanline1 ! rest1,
scanline2 ! rest2
)
=>
scanline1 == scanline2
and
same_plane (rest1, rest2);
end;
fun same_planes ([], []) => TRUE;
same_planes (_, []) => FALSE;
same_planes ([], _ ) => FALSE;
same_planes ( plane1 ! rest1,
plane2 ! rest2
)
=>
same_plane (plane1, plane2)
and
same_planes (rest1, rest2);
end;
end;
fi;
#
fun string_to_data (wid, s) # Map a row of data coded as a string to a bit representation.
= # The data may be either encoded in hex (with a preceding "0x")
case (string::explode s) # or in binary (with a preceeding "0b").
#
('0' ! 'x' ! r)
=>
make_row (nbytes, r, [])
where
nbytes = ((wid + 7) / 8); # # of bytes per line
fun cvt_char c
=
if (char::is_digit c)
#
byte::char_to_byte c - byte::char_to_byte '0';
else
if (char::is_hex_digit c)
#
char::is_upper c
?? byte::char_to_byte c - byte::char_to_byte 'A'
:: byte::char_to_byte c - byte::char_to_byte 'a';
else
raise exception BAD_CS_PIXMAP_DATA;
fi;
fi;
fun make_row (0, [], l) => v1u::from_list (reverse l);
make_row (0, _, _) => raise exception BAD_CS_PIXMAP_DATA;
make_row (i, d1 ! d0 ! r, l)
=>
make_row (i - 1, r,
w8::bitwise_or (w8::(<<) (cvt_char d1, 0u4), cvt_char d0) ! l);
make_row _
=>
raise exception BAD_CS_PIXMAP_DATA;
end;
end;
('0' ! 'b' ! r)
=>
make_row (wid, 0ux80, r, 0u0, [])
where
fun make_row (0, _, [], b, l)
=>
v1u::from_list (reverse (b ! l));
make_row (_, _, [], _, _)
=>
raise exception BAD_CS_PIXMAP_DATA;
make_row (i, 0u0, l1, b, l2)
=>
make_row (i, 0ux80, l1, 0u0, b ! l2);
make_row (i, m, '0' ! r, b, l)
=>
make_row (i - 1, w8::(>>) (m, 0u1), r, b, l);
make_row (i, m, '1' ! r, b, l)
=>
make_row (i - 1, w8::(>>) (m, 0u1), r, w8::bitwise_or (m, b), l);
make_row _
=>
raise exception BAD_CS_PIXMAP_DATA;
end;
end;
_ => raise exception BAD_CS_PIXMAP_DATA;
esac;
reverse_bits = byt::reverse_byte_bits; # Reverse the bit-order of a byte
# Routines to re-order bits and bytes to the server's format (stolen from
# XPutImage::c in Xlib). We represent data in the following format:
#
# scan-line unit = 1 byte
# byte-order = MSB first (doen't matter for 1-byte scan units)
# bit-order = MSB first (bit 0 is leftmost on display)
#
# This is the "1Mm" format of XPutImagec in Xlib. The relevant lines
# in the conversion table are:
#
# 1Mm 2Mm 4Mm 1Ml 2Ml 4Ml 1Lm 2Lm 4Lm 1Ll 2Ll 4Ll
# 1Mm: n n n R S L n s l R R R
# 1Ml: R R R n s l R S L n n n
#
# legend:
# n no changes
# s reverse 8-bit units within 16-bit units
# l reverse 8-bit units within 32-bit units
# R reverse bits within 8-bit units
# S s+R
# L l+R
fun no_swap x = x;
fun swap_bits data
=
v1u::from_list
(v1u::fold_backward (\\ (b, l) = reverse_bits b ! l)
[]
data
);
fun explode_v data
=
v1u::fold_backward (!) [] data;
fun swap_two_bytes s
=
v1u::from_list (swap (explode_v s))
where
fun swap (a ! b ! r) => b ! a ! (swap r);
swap [] => [];
swap _ => xgripe::impossible "[swap_two_bytes: bad image data]";
end;
end;
fun swap_four_bytes s
=
v1u::from_list (swap (explode_v s))
where
fun swap (a ! b ! c ! d ! r) => d ! c ! b ! a ! (swap r);
swap [] => [];
swap _ => xgripe::impossible "[swap_four_bytes: bad image data]";
end;
end;
fun swap_bits_and_two_bytes s
=
v1u::from_list (swap (explode_v s))
where
fun swap (a ! b ! r) => (reverse_bits b) ! (reverse_bits a) ! (swap r);
swap [] => [];
swap _ => xgripe::impossible "[swap_bits_and_two_bytes: bad image data]";
end;
end;
fun swap_bits_and_four_bytes s
=
v1u::from_list (swap (explode_v s))
where
fun swap (a ! b ! c ! d ! r)
=>
(reverse_bits d) ! (reverse_bits c) ! (reverse_bits b) ! (reverse_bits a) ! (swap r);
swap [] => [];
swap _ => xgripe::impossible "[swap_bits_and_four_bytes: bad image data]";
end;
end;
fun swap_func (xt::RAW08, xt::MSBFIRST, xt::MSBFIRST) => no_swap;
swap_func (xt::RAW16, xt::MSBFIRST, xt::MSBFIRST) => no_swap;
swap_func (xt::RAW32, xt::MSBFIRST, xt::MSBFIRST) => no_swap;
swap_func (xt::RAW08, xt::MSBFIRST, xt::LSBFIRST) => swap_bits;
swap_func (xt::RAW16, xt::MSBFIRST, xt::LSBFIRST) => swap_bits_and_two_bytes;
swap_func (xt::RAW32, xt::MSBFIRST, xt::LSBFIRST) => swap_bits_and_four_bytes;
swap_func (xt::RAW08, xt::LSBFIRST, xt::MSBFIRST) => no_swap;
swap_func (xt::RAW16, xt::LSBFIRST, xt::MSBFIRST) => swap_two_bytes;
swap_func (xt::RAW32, xt::LSBFIRST, xt::MSBFIRST) => swap_four_bytes;
swap_func (xt::RAW08, xt::LSBFIRST, xt::LSBFIRST) => swap_bits;
swap_func (xt::RAW16, xt::LSBFIRST, xt::LSBFIRST) => swap_bits;
swap_func (xt::RAW32, xt::LSBFIRST, xt::LSBFIRST) => swap_bits;
end;
fun pad_to_bits xt::RAW08 => 0u8;
pad_to_bits xt::RAW16 => 0u16;
pad_to_bits xt::RAW32 => 0u32;
end;
fun round_down (nbytes, pad)
=
unt::to_int_x(
unt::bitwise_and (unt::from_int nbytes, unt::bitwise_not((pad_to_bits pad) - 0u1)));
fun round_up (nbytes, pad)
=
{ bits = (pad_to_bits pad) - 0u1;
#
unt::to_int_x (unt::bitwise_and (unt::from_int nbytes + bits, unt::bitwise_not bits));
};
# Pad and re-order image data as necessary
# to match the server's format.
#
stipulate
#
pad1 = v1u::from_fn (1, \\ _ = 0u0);
pad2 = v1u::from_fn (2, \\ _ = 0u0);
pad3 = v1u::from_fn (3, \\ _ = 0u0);
herein
fun adjust_image_data (dpy_info: dy::Xdisplay)
=
{
fun extra (v, m)
=
unt::bitwise_and (unt::from_int (v1u::length v), m);
pad_scan_line
=
case dpy_info.bitmap_scanline_pad
#
xt::RAW08
=>
\\ s = s;
xt::RAW16
=>
\\ s =
if (extra (s, 0u1) == 0u0) s;
else v1u::cat [s, pad1];
fi;
xt::RAW32
=>
\\ s = case (extra (s, 0u3))
#
0u0 => s;
0u1 => v1u::cat [s, pad3];
0u2 => v1u::cat [s, pad2];
_ => v1u::cat [s, pad1];
esac;
esac;
swapfn = swap_func
(
dpy_info.bitmap_scanline_unit,
dpy_info.image_byte_order,
dpy_info.bitmap_bit_order
);
\\ data = map (\\ s = swapfn (pad_scan_line s))
data;
};
end;
# Copy rectangle from clientside window
# into server-side offscreen window.
#
# It wouldn't take much to generalize
# this to all drawables & pens. Additional
# efficiency could be gained by having the
# extract_row function extract rows already
# padded correctly for the display when possible. XXX BUGGO FIXME
#
fun copy_from_clientside_pixmap_to_pixmap pm { from=>CS_PIXMAP { size, data }, from_box, to_point }
=
case (g2d::box::intersection (from_box, g2d::box::make (g2d::point::zero, size))) # Clip from_box to clientside window.
#
NULL => (); # No intersection so nothing to do.
#
THE from_box'
=>
put_sub_image (from_box', g2d::point::add (to_point, delta))
where
delta = g2d::point::subtract
( g2d::box::upperleft from_box',
g2d::box::upperleft from_box
);
depth = list::length data;
pm -> { pixmap_id, screen, per_depth_imps => { windowsystem_to_xserver, ... }: sn::Per_Depth_Imps, ... }: sn::Rw_Pixmap;
screen -> { xsession=>{ xdisplay as (dpy_info: dy::Xdisplay), ... }: sn::Xsession, ... }: sn::Screen ;
scanline_pad = dpy_info.bitmap_scanline_pad;
scanline_unit = dpy_info.bitmap_scanline_unit;
# Minimum no. of 4-byte words needed for PutImage.
# There should be a function in XRequest to provide this. XXX SUCKO FIXME
#
request_size = 6;
# Number of image bytes per request:
#
available = (int::min (dpy_info.max_request_length, 65536) - request_size) * 4;
fun copy_from_clientside_pixmap_to_pixmap_request (r as { col, row, wide, high }, to_point)
=
{
left_pad = unt::to_int_x
(
unt::bitwise_and
(
unt::from_int col,
pad_to_bits scanline_unit - 0u1
)
);
byte_offset = (col - left_pad) / 8;
num_bytes = round_up (wide + left_pad, xt::RAW08) / 8;
adjust = adjust_image_data xdisplay;
# Given the list of data for a plane, extract a list of substrings
# corresponding to given rectangle, to the nearest byte.
#
fun extract_box (rows: List( v1u::Vector ))
=
{
fun skip (0, r) => r;
skip (i, _ ! r) => skip (i - 1, r);
skip (i, []) => xgripe::impossible "cs_pixmap_old: extract_box (skip)";
end;
fun extract_row (0, _)
=>
[];
extract_row (i, my_row ! rest)
=>
if ( byte_offset == 0
and num_bytes == v1u::length my_row
)
my_row ! (extract_row (i - 1, rest));
else
(v1uextract (my_row, byte_offset, THE num_bytes))
!
(extract_row (i - 1, rest));
fi;
extract_row (i,[])
=>
xgripe::impossible "cs_pixmap_old: extract_row";
end;
extract_row (high, skip (row, rows));
};
xdata = map extract_box data;
windowsystem_to_xserver.draw_ops
[
{
to => pixmap_id,
pen => pn::default_pen,
op => w2x::x::PUT_IMAGE
[
{
to_point,
size => { wide, high },
depth,
lpad => left_pad,
format => xt::XYPIXMAP,
/*** THIS SHOULD BE
data => v1u::cat (list::cat (map adjust xdata))
***/
data => v1u::cat (map (v1u::cat o adjust) xdata)
}
]
}
];
}; # fun copy_from_clientside_pixmap_to_pixmap_request
# Decompose copy_from_clientside_pixmap_to_pixmap
# into multiple requests smaller than max size.
#
# First try to use as many rows as possible;
# if there is only one row left and it is
# still too large, decompose by columns:
#
fun put_sub_image (r as { col, row, wide, high }, pt as { col=>dx, row=>dy } )
=
{ left_pad
=
unt::to_int_x (unt::bitwise_and (unt::from_int col, pad_to_bits scanline_unit - 0u1));
bytes_per_row
=
(round_up (wide + left_pad, scanline_pad) / 8) * depth;
if ((bytes_per_row * high) <= available)
#
copy_from_clientside_pixmap_to_pixmap_request (r, pt);
else
if (high > 1)
#
high' = int::max (1, available / bytes_per_row);
put_sub_image ({ col, row, wide, high=>high' }, pt);
put_sub_image ({ col, row=>row+high', wide, high=>high-high' }, { col=>dx, row=>dy+high' } );
else
wide' = round_down (available * 8, scanline_pad) - left_pad;
put_sub_image ({ col, row, wide=>wide', high=>1 }, pt);
put_sub_image ({ col=>col+wide', row, wide=>wide-wide', high=>1 }, { col=>dx+wide', row=>dy } );
fi;
fi;
};
end; # fun copy_from_clientside_pixmap_to_pixmap
esac;
# Create image data from an ascii representation
#
fun make_clientside_pixmap_from_ascii (wide, p0 ! rest)
=>
{ fun mk (n, [], l) => (n, reverse l);
mk (n, s ! r, l) => mk (n+1, r, string_to_data (wide, s) ! l);
end;
(mk (0, p0, []))
->
(high, plane0);
fun check data
=
{ (mk (0, data,[]))
->
(h, plane);
if (h == high) plane;
else raise exception BAD_CS_PIXMAP_DATA;
fi;
};
CS_PIXMAP {
size => { wide, high },
data => plane0 ! (map check rest)
};
};
make_clientside_pixmap_from_ascii (wide, [])
=>
raise exception BAD_CS_PIXMAP_DATA;
end;
# Create a server-side offscreen window from
# data in a client-side window:
#
fun make_readwrite_pixmap_from_clientside_pixmap
screen
(cs_pixmap_old as CS_PIXMAP { size, data } )
=
pixmap
where
depth = length data;
pixmap
=
wpm::make_readwrite_pixmap
screen
(size, depth);
copy_from_clientside_pixmap_to_pixmap
pixmap
{
from => cs_pixmap_old,
from_box => g2d::box::make (g2d::point::zero, size),
to_point => g2d::point::zero
};
end;
# Create an pixmap from ascii data:
#
fun make_readwrite_pixmap_from_ascii_data
screen
(wide, ascii_rep)
=
make_readwrite_pixmap_from_clientside_pixmap
screen
(make_clientside_pixmap_from_ascii (wide, ascii_rep));
stipulate
# Create a client-side window from
# a server-side offscreen window.
#
# This should be better integrated with
# the draw_imp to avoid a possible race
# condition: We need to be sure the
# draw_imp flush has occurred before we
# ask for the clientside window. XXX BUGGO FIXME
#
fun make_clientside_pixmap_from_pixmap_or_window
(
box, # Get the pixelmap pixel contents from this part of
pixmap_or_window_id as xid, # this server-side pixmap or window.
# per_depth_imps,
screen
)
=
{ (g2d::box::size box) -> size as our_size;
# per_depth_imps -> { depth, to_screen_drawimp, ... }: sn::Per_Depth_Imps;
(sn::xsession_of_screen screen)
->
{ xdisplay, windowsystem_to_xserver, ... }: sn::Xsession;
# Avoid a race condition by flushing
# from the draw_imp any buffered draw
# commands for this drawable before
# sending our GetImage request to the
# X server:
#
# trace {. sprintf "XYZZY calling dt::flush_drawimp -- cs_pixmap_old::make_clientside_pixmap_from_pixmap_or_window pixmap_or_window_id x=%x (drawimp thread_id d=%d)" (unt::to_int u) (dt::drawimp_thread_id_of to_screen_drawimp); };
# dt::flush_drawimp to_screen_drawimp;
# trace {. sprintf "XYZZY done dt::flush_drawimp -- cs_pixmap_old::make_clientside_pixmap_from_pixmap_or_window pixmap_or_window_id x=%x (drawimp thread_id d=%d)" (unt::to_int u) (dt::drawimp_thread_id_of to_screen_drawimp); };
all_planes = unt::bitwise_not 0u0;
log::note_on_stderr {. "calling v2w::encode_get_image -- make_clientside_pixmap_from_pixmap_or_window() in cs-pixmap.pkg\n"; };
msg = v2w::encode_get_image
{
drawable => pixmap_or_window_id,
box,
plane_mask => xt::PLANEMASK all_planes,
format => xt::XYPIXMAP
};
# trace {. sprintf "XYZZY calling GetImage, string == %s -- cs_pixmap_old::make_clientside_pixmap_from_pixmap_or_window" (xok::bytes_to_hex msg); };
log::note_on_stderr {. "sending get-image request and reading reply... -- make_clientside_pixmap_from_pixmap_or_window() in cs-pixmap.pkg\n"; };
my { depth, data, visualid }
=
w2v::decode_get_image_reply
(
block_until_mailop_fires # XXX SUCKO FIXME
# ========================
(
# xok::send_xrequest_and_read_reply xdisplay.xsocket msg
windowsystem_to_xserver.xclient_to_sequencer.send_xrequest_and_read_reply msg
)
);
log::note_on_stderr {. "sent get-image request and read reply... -- make_clientside_pixmap_from_pixmap_or_window() in cs-pixmap.pkg\n"; };
# trace {. sprintf "XYZZY done GetImage, string == %s -- cs_pixmap_old::make_clientside_pixmap_from_pixmap_or_window" (xok::bytes_to_hex msg); };
swapfn = swap_func
(
xdisplay.bitmap_scanline_unit,
xdisplay.image_byte_order,
xdisplay.bitmap_bit_order
);
lines_per_plane = our_size.high;
bytes_per_line = round_up (our_size.wide, xdisplay.bitmap_scanline_pad) / 8;
bytes_per_plane = bytes_per_line * lines_per_plane;
log::note_on_stderr {. sprintf "depth d=%d lines_per_plane d=%d bytes_per_line d=%d bytes_per_plane d=%d -- make_clientside_pixmap_from_pixmap_or_window() in cs-pixmap.pkg\n" depth lines_per_plane bytes_per_line bytes_per_plane; };
fun do_line start
=
swapfn (v1uextract (data, start, THE bytes_per_line));
fun make_line (i, start)
=
i == lines_per_plane
?? []
:: (do_line start) ! (make_line (i+1, start+bytes_per_line));
fun make_plane (i, start)
=
i == depth
?? []
:: (make_line (0, start)) ! (make_plane (i+1, start+bytes_per_plane));
CS_PIXMAP { size, data=>make_plane (0, 0) };
}; # fun make_clientside_pixmap_from_pixmap_or_window
herein
# Create a client-side pixmap from
# a server-side offscreen window.
#
fun make_clientside_pixmap_from_readwrite_pixmap ({ pixmap_id, size, screen, per_depth_imps }: sn::Rw_Pixmap)
=
{ # Before attempting to read back pixels
# from the X server we want to be sure that
# any relevant draw commands have been flushed
# from the relevant draw-imp. For a RW_PIXMAP
# that means to_screen_drawimp:
#
per_depth_imps -> { windowsystem_to_xserver, ... }: sn::Per_Depth_Imps;
# dt::flush_drawimp to_screen_drawimp;
box = g2d::box::make (g2d::point::zero, size); # Copy all of pixmap.
#
make_clientside_pixmap_from_pixmap_or_window (box, pixmap_id, screen);
};
# Create a client-side window from part of
# a server-side onscreen window. The underlying
# GetImage X call is snarky:
#
# o The window must be entirely onscreen.
# o Any parts of it obscured by non-descendents come back undefined.
# o Any parts of it obscured by different-depth kids come back undefined.
#
# According to he docs on p57 of http://mythryl.org/pub/exene/X-protocol-R6.pdf
#
# "This request is not general-purpose in the same sense
# as other graphics-related requests. It is intended
# specifically for rudimentary hardcopy support."
#
fun make_clientside_pixmap_from_window (box, window as { window_id, screen, windowsystem_to_xserver, ... }: sn::Window )
=
{ # Before attempting to read back pixels
# from the X server we want to be sure that
# any relevant draw commands have been flushed
# from the relevant draw-imp. For a WINDOW
# that means to_hostwindow_drawimp:
#
# dt::flush_drawimp to_hostwindow_drawimp;
# per_depth_imps -> { depth, to_screen_drawimp, ... }: sn::Per_Depth_Imps;
# trace {. sprintf "XYZZY make_clientside_pixmap_from_window: window.id x=%x drawimp_thread_id_of window d=%d PER_DEPTH_IMPS.to_screen_drawimp.thread_id d=%d" (dt::id_of_window window) (draw::drawimp_thread_id_of (dt::drawable_of_window window)) (dt::drawimp_thread_id_of to_screen_drawimp); };
make_clientside_pixmap_from_pixmap_or_window (box, window_id, screen);
};
end;
fun make_clientside_pixmap_from_readonly_pixmap (sn::RO_PIXMAP pm)
=
make_clientside_pixmap_from_readwrite_pixmap pm;
}; # package cs_pixmap_old
end;