lambert@spinifex.eecs.unsw.oz (Timothy Lambert) (03/28/90)
The following program lets you display a bitmap in the background
under the Display Manager. (Like xsetroot -bitmap).
# This is a shell archive. Remove anything before this line, then
# unpack it by saving it in a file and typing "sh file". (Files
# unpacked will be owned by you and have default permissions.)
#
# This archive contains:
# bgc.hlp bgc.ins.pas bgc.pas bgc_rtn.pas makefile
echo x - bgc.hlp
cat > "bgc.hlp" << '//E*O*F bgc.hlp//'
"bgc" lets you use a bitmap as a background pattern.
If you give bgc more than one bitmap (e.g. "bgc *.bmf" it
picks one at random to use as background. If you don't
like that one the AGAIN key makes bgc pick another at
random, and the EXIT key terminates "bgc".
//E*O*F bgc.hlp//
echo x - bgc.ins.pas
cat > "bgc.ins.pas" << '//E*O*F bgc.ins.pas//'
{note that each variable in this file should be declared as EXTERN}
const name_len = 128;
type name_t = varying[name_len] of char;
pt_name_t = ^name_t;
argv_t = array[0..127] of pt_name_t;
argv_p_t = ^argv_t;
var status : extern status_$t; {all gpr calls return a status value indicating whether they've succeeded or failed}
display_bitmap : extern gpr_$bitmap_desc_t; {this is the bitmap corresponding to the screen}
display_size : extern gpr_$offset_t := [gpr_$max_x_size,gpr_$max_y_size]; {size of display bitmap}
display_hi_plane : extern integer; {highest plane on display}
fill_bitmap : extern gpr_$bitmap_desc_t; {this is the bitmap to fill with}
pattern : extern boolean; {if true fill_bitmap is 32x32 otherwise we have bitmap the size of the screen}
pad : extern ios_$id_t; {handle to the window we create for drawing in}
no_of_args : extern integer; {no of arguments to bg (counting argument 0) }
arg_pointer : extern pgm_$argv_ptr; {pointer to the arguments}
argv_p : extern argv_p_t;
//E*O*F bgc.ins.pas//
echo x - bgc.pas
cat > "bgc.pas" << '//E*O*F bgc.pas//'
program back_ground(input,output);
{displays bitmaps in "background"}
%nolist;
%include '/sys/ins/base.ins.pas'; {common include file for all system routines}
%include '/sys/ins/vfmt.ins.pas'; {routines for converting strings to real numbers}
%include '/sys/ins/pgm.ins.pas'; {declarations for pgm routines (for getting file arguments)}
%include '/sys/ins/pfm.ins.pas';
%include '/sys/ins/gpr.ins.pas'; {contains the declarations for gpr routines}
%include '/sys/ins/pad.ins.pas'; {contains the declarations for pad routines (for creating windows)}
%include '/sys/ins/ios.ins.pas';
%include '/sys/ins/ec2.ins.pas';
%include '/sys/ins/kbd.ins.pas';
%include '/sys/ins/time.ins.pas';
%include '/sys/ins/name.ins.pas';
function fork:integer32; extern;
function random:integer32; extern;
procedure srandom(seed:integer32);val_param; extern;
procedure unlink(in path: univ string); extern;
%list;
define status, {each variable that we declare in bg.ins.pas}
display_bitmap, {should be defined here}
display_size,
fill_bitmap,
pattern,
pad,
no_of_args,
arg_pointer,
argv_p;
%include 'bgc.ins.pas';
define display_hi_plane := gpr_$highest_plane; {number of highest plane on screen - 7 for 8 plane nodes
1 for monochrome nodes. we ask for maximum no of planes - gpr reduces this to fit}
const unit = 1;
var cmd : name_t;
window_name : name_t := '/tmp/bgc';
window : pad_$window_desc_t;
disp_chars : gpr_$disp_char_t;
disp_len : static integer16 := sizeof(gpr_$disp_char_t);
disp_len_ret : integer16;
decode_count,junk : integer; {vfmt_$decode insists on returning these - we don't use them}
event_type : gpr_$event_t; {type of event returned by gpr_$event_wait - not used}
event_char : char; {character user typed in window - not used}
event_pos : gpr_$position_t; {position where she typed it - not used}
keys : gpr_$keyset_t := []; {we wait until one of these keys is pressed}
time : time_$clock_t;
procedure refresh(in unobscured : boolean;
in position_change : boolean); extern;
procedure check(in messagex : string); extern;
{if last system call was unsuccesful prints an error message}
procedure pause(in t : real); extern;
{waits for t seconds - you might find this useful for debugging}
function randno(n:integer):integer; extern;
{returns a number in range 1..n}
procedure drawit(in file_name:name_t); extern;
{read in the bitmap in file_name and display it}
function again_pressed (IN f_status : pfm_$fault_rec_t): pfm_$fh_func_val_t; extern;
{this function is called when program gets a dq -c 0 signal}
begin
pgm_$get_args(no_of_args,arg_pointer);
if no_of_args<=1 then begin
writeln('Usage: bgc bitmap-names');
pgm_$exit;
end; {if}
{run in background}
if fork <> 0 then pgm_$exit;
{kill previous bg, if any}
cmd := 'dq ';
append(cmd,window_name);
append(cmd,';msg '' '''); {hide error message if window does not exist}
pad_$dm_cmd(stream_$stdout,cmd.body,cmd.length,status); check('dm command');
{initialize random number generator}
time_$clock(time);
srandom(time.low32);
gpr_$inq_disp_characteristics(gpr_$borrow,stream_$stdout, disp_len,disp_chars,disp_len_ret, status);
{create a window and initialise it for graphics}
with disp_chars do begin
window.left := x_window_origin;
window.top := y_window_origin;
window.width := x_window_size;
window.height := y_window_size;
end;{with}
pad_$create_window(window_name.body,window_name.length,pad_$transcript,unit,window,pad,status); check('creating window');
ptoc(window_name); unlink(window_name.body);
if window.width <> 0 then pad_$set_full_window(pad,1,window,status); check('set full window');
pad_$set_auto_close(pad,1,true,status);
pad_$set_border(pad,1,false,status);
gpr_$init(gpr_$direct, pad, display_size,
display_hi_plane, display_bitmap, status); check('gpr_init');
gpr_$inq_bitmap_dimensions(display_bitmap,display_size,display_hi_plane,status);
gpr_$set_obscured_opt(gpr_$ok_if_obs,status);
gpr_$set_cursor_active(true,status);
argv_p := argv_p_t(arg_pointer);
drawit(argv_p^[randno(no_of_args-1)]^);
{establish the refresh procedure. if window needs to be refreshed as
the result of a pop, the draw procedure will automatically be called.}
gpr_$set_refresh_entry (addr(refresh), nil, status);
check('setting the refresh entry procedure.');
{establish the again_pressed procedure. if window gets a dq -c 1 signal again_pressed will be called}
discard(pfm_$establish_fault_handler (1,[pfm_$fh_multi_level],ADDR(again_pressed),status));
check('establishing fault handler');
pad_$def_pfk(pad,'R2 ','dq -c 1',7,status); check('defining AGAIN');
pad_$def_pfk(pad,'R5 ','dq',2,status); check('defining EXIT');
discard(gpr_$event_wait (event_type, event_char, event_pos, status));
{We would have liked to have waited for a keystroke, but we can't do
input into partly obscured windows we resort to evil thing with signals
instead}
end.
//E*O*F bgc.pas//
echo x - bgc_rtn.pas
cat > "bgc_rtn.pas" << '//E*O*F bgc_rtn.pas//'
MODULE view;
{This module contains a procedure that the system automatically }
{calls when a refresh is required. }
%include '/sys/ins/base.ins.pas'; {required insert file}
%include '/sys/ins/gpr.ins.pas'; {required insert file}
%include '/sys/ins/pad.ins.pas'; {required insert file}
%include '/sys/ins/error.ins.pas'; {declaraions for error handling routines (see check)}
%include '/sys/ins/pfm.ins.pas';
%include '/sys/ins/pgm.ins.pas';
%include '/sys/ins/time.ins.pas';
function random:integer32; extern;
%include 'bgc.ins.pas';
var fill_size : gpr_$offset_t; {x and y size of our fill bitmap}
fill_hi_plane : gpr_$rgb_plane_t; {number of highest plane in fill bitmap}
PROCEDURE check(IN messagex : string);
{if last system call was unsuccesful prints an error message}
BEGIN
if status.all <> status_$ok then
begin
error_$print (status);
writeln('error occurred while ',messagex);
pgm_$exit;
end;
END;
Procedure pause(IN t : real);
{waits for t seconds - you might find this useful for debugging}
VAR
time : time_$clock_t;
BEGIN
time.high16 := 0;
time.low32 := trunc(250000 * t);
time_$wait (time_$relative, time, status);
check('In Procedure PAUSE.');
END;
function randno(n:integer):integer;
{returns a number in range 1..n}
begin randno := 1 + random mod n;
end; {randno}
procedure draw_image(in clip:gpr_$window_t);
var
window : static gpr_$window_t := [[0,0],[0,0]];
dest : gpr_$position_t; {destinition point for our bit-blts}
i,j : integer;
begin
gpr_$set_clip_window (clip, status) ;
discard(gpr_$acquire_display(status));
window.window_size := display_size;
if pattern then begin
gpr_$set_fill_pattern(fill_bitmap,1,status);
gpr_$rectangle(window,status); check('rectangle');
end else begin
for i := clip.window_base.x_coord div fill_size.x_size to (clip.window_base.x_coord+clip.window_size.x_size) div fill_size.x_size do begin
dest.x_coord := i*fill_size.x_size;
for j := clip.window_base.y_coord div fill_size.y_size to (clip.window_base.y_coord+clip.window_size.y_size) div fill_size.y_size do begin
dest.y_coord := j*fill_size.y_size;
gpr_$pixel_blt( fill_bitmap, window, dest, status ); check('pixel_blt'); {does a bit_blt from bitmap file to fill}
end;{for}
end;{for}
end; {if}
gpr_$release_display(status);
end; {draw_image}
PROCEDURE refresh(IN unobscured : boolean;
IN position_change : boolean);
const max_no_windows = 50;
var vis_list : ARRAY[1..max_no_windows] OF gpr_$window_t;
i, slots_total : integer;
BEGIN
gpr_$release_display(status);
pad_$pop_push_window(pad,1,false,status); check('push');
discard(gpr_$acquire_display(status));
gpr_$set_cursor_active(false,status);
gpr_$inq_vis_list (max_no_windows, slots_total, vis_list, status);
FOR i := 1 TO slots_total DO BEGIN
draw_image(vis_list[i]);
END;
gpr_$set_cursor_active(true,status);
END;{draw}
procedure getbitmap(in file_name:name_t;out fill_bitmap:gpr_$bitmap_desc_t);
{gets bitmap from file_name}
var dest : gpr_$position_t; {destinition point for our bit-blts}
file_size : gpr_$offset_t; {x and y size of our file bitmap}
file_hi_plane : gpr_$rgb_plane_t; {number of highest plane in file bitmap}
color_map : gpr_$color_vector_t;
version : gpr_$version_t; {some useless information returned by gpr_$open_bitmap_file}
groups : integer; {more of the same}
group_hs : gpr_$bmf_group_header_array_t; {field pixel_size * field n_sects should give # of planes in bitmap}
created : boolean; {tells us if the bitmap file was created - should be false}
attribs : gpr_$attribute_desc_t; {the attribute block for the bitmap file}
window : static gpr_$window_t := [[0,0],[0,0]];
file_bitmap : gpr_$bitmap_desc_t; {this is the bitmap to fill with}
i,j : integer;
begin
gpr_$allocate_attribute_block( attribs, status ); {our window}
gpr_$open_bitmap_file( gpr_$readonly, file_name.body, file_name.length, version, {open the bitmap file}
file_size, groups, group_hs,
attribs, file_bitmap, created, status );
if status.all <> status_$ok then begin
writeln('Couldn''t open ',file_name); pgm_$exit;
end; {if}
file_hi_plane := group_hs[0].pixel_size * group_hs[0].n_sects - 1; {calculates # of planes in file bitmap }
fill_hi_plane := min(display_hi_plane,file_hi_plane);
if fill_hi_plane = 7 then begin
gpr_$inq_bitmap_file_color_map( file_bitmap, 0, 256, color_map, status );
discard(gpr_$acquire_display(status));
gpr_$set_color_map( 16, 240, color_map[16], status ); check('set colour map');
gpr_$release_display(status);
end; {if}
if (file_size.x_size = 32) and (file_size.y_size =32) then begin
fill_size := file_size;
pattern := true;
end else begin
{make sure fill bitmap is at least 200x200}
fill_size.x_size := file_size.x_size*(1+ 200 div file_size.x_size);
fill_size.y_size := file_size.y_size*(1+ 200 div file_size.y_size);
pattern := false
end; {if}
gpr_$deallocate_bitmap(fill_bitmap,status); {deallocate fill_bitmap in case this isn't the first time we've been called}
gpr_$allocate_bitmap(fill_size,fill_hi_plane,attribs,fill_bitmap,status); {allocate a memory bitmap for bit-blting to}
window.window_size := file_size; {bitmap file}
gpr_$set_bitmap( fill_bitmap, status );
for i := 0 to (fill_size.x_size-1) div file_size.x_size do begin
dest.x_coord := i*file_size.x_size;
for j := 0 to (fill_size.y_size-1) div file_size.y_size do begin
dest.y_coord := j*file_size.y_size;
gpr_$pixel_blt( file_bitmap, window, dest, status ); check('pixel_blt'); {does a bit_blt from bitmap file to fill}
end;{for}
end;{for}
gpr_$deallocate_bitmap(file_bitmap,status);
end;
procedure drawit(in file_name:name_t);
{read in the bitmap in file_name and display it}
begin
getbitmap(file_name,fill_bitmap);
{draw the picture.}
discard(gpr_$acquire_display(status));
gpr_$set_bitmap(display_bitmap, status );
refresh(true,false);
gpr_$release_display(status);
end; {drawit}
function again_pressed (IN f_status : pfm_$fault_rec_t): pfm_$fh_func_val_t ;
{this function is called when program gets a dq -c 1 signal
this should happen when AGAIN is pressed}
var lock: static boolean := false; {we ignore further interupts till we're finished}
BEGIN
if not lock then begin
lock := true;
drawit(argv_p^[randno(no_of_args-1)]^);
lock := false;
end; {if}
again_pressed := pfm_$return_to_faulting_code;
END; {again_pressed}
//E*O*F bgc_rtn.pas//
echo x - makefile
cat > "makefile" << '//E*O*F makefile//'
PFLAGS = -cpu 3000
bgc: bgc.bin bgc_rtn.bin
/bin/ld bgc.bin bgc_rtn.bin -o bgc
bgc.bin: bgc.ins.pas
bgc_rtn.bin: bgc.ins.pas
//E*O*F makefile//
exit 0lambert@spinifex.eecs.unsw.oz (Timothy Lambert) (03/29/90)
If you are running SR10.2 the following patch to bgc
makes things go more smoothly.
*** bgc.pas Wed Mar 28 20:17:32 1990
--- bgc.pas.bak Wed Mar 28 20:18:50 1990
***************
*** 103,109 ****
if window.width <> 0 then pad_$set_full_window(pad,1,window,status); check('set full window');
pad_$set_auto_close(pad,1,true,status);
pad_$set_border(pad,1,false,status);
- pad_$set_erase(pad,1,false,status);
gpr_$init(gpr_$direct, pad, display_size,
display_hi_plane, display_bitmap, status); check('gpr_init');
gpr_$inq_bitmap_dimensions(display_bitmap,display_size,display_hi_plane,status);
--- 103,108 ----