home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
OS/2 Shareware BBS: 10 Tools
/
10-Tools.zip
/
lifeos2.zip
/
LIFE-1.02
/
LIB
/
XTOOLS_L.LF
< prev
next >
Wrap
Text File
|
1996-06-04
|
11KB
|
451 lines
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% $Id: xtools_l.lf,v 1.3 1996/02/01 23:29:17 vorbeck Exp $
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
% XTOOLS: LOOK TYPES
%
% Author: Bruno Dumant
% (c) Copyright 1993 - Digital Equipment Corporation
% All Rights Reserved
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%% interface
public(
look,
text_box,field,frame,led,
v_slide_bar_l,h_slide_bar_l,
draw_look,refresh_look,change_look,
draw_static,draw_dynamic,
draw_button,draw_deep_button,
draw_shade,draw_deep_shade,
draw_text,
main_colors,highlight_colors,shade_colors,
new_color,def_color,
new_font,def_font
) ?
dynamic(draw_static) ?
dynamic(draw_dynamic) ?
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%% look types
%%%
%%% for each look type, two predicates are defined:
%%% - draw_static draws the static part of the look
%%% - draw_dynamic draws the dynamic part of the look
%%% draw_look(A) draws the object A using ALL the clauses of draw_static and
%%% draw_dynamic that have an argument more general than A (use of implies).
%%% This implements the inheritance of looks
draw_look(A) -> true |
(
implies(draw_static(A)),fail
;
implies(draw_dynamic(A)),fail
;
succeed
).
%%% refresh_look only redraws the dynamic part of the look
change_look(A) :-
cond( has_feature(change_state,A,B),
(
B,
refresh_look(A)
)
).
refresh_look(A) :-
(
implies(draw_dynamic(A)),fail
;
cond( has_feature(daughters,A,Daughters),
refresh_daughters(features(Daughters),Daughters)
)
).
refresh_daughters([]) :- !.
refresh_daughters([A|B],D) :-
refresh_look(D.A),
refresh_daughters(B,D).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%% predefined look types.
%%% These are the look types used by the predefined objects of the toolkit; It
%%% is always possible to extend this hierarchy to use other kinds of looks
%%%
%%% ,- field
%%% |
%%% |- text_box
%%% box - look -|
%%% |- frame
%%% |
%%% `- led
%%%
look <| box.
%%% fields
field <| look.
:: field(field_state => S,
color_id => Cid,
true_field_color_id => Tid) |
init_state(S),
!.
draw_dynamic(Box:field) :-
X = get_choice,
Box = @(X0,Y0,DX,DY,window => W,
field_state => State,
color_id => ID:{d_field;@},
true_field_color_id => SID:{d_selected_field;@}),
set_choice(X),
cond( State,
xFillRectangle(W,
X0*IG:ig(Box),Y0*IG,
DX,DY,color => m_colors(SID)),
xFillRectangle(W,
X0*IG,Y0*IG,
DX,DY,color => m_colors(ID))
).
%%% text_box
text_box <| look.
text_box <| t_box.
:: text_box(text_state => State,
text_color_id => @,
true_text_color_id => @,
font_id => @,
offset => @) |
init_state(State).
draw_dynamic(Box:text_box) :-
get_choice = X,
Box = @(text_color_id => TC:{d_text;@},
true_text_color_id => TT:{d_selected_text;@},
font_id => F:{bold;@},
offset => O:{d_offset;@}),
set_choice(X),
draw_text(offset => O,
box => Box,
text => Box.text,
font => text_font(F),
color => m_colors(cond(Box.text_state, TT, TC))).
%%% frame
frame <| look.
:: frame(depth => @,
flat => @,
frame_state => State,
color_id => @) |
init_state(State).
draw_dynamic(F:frame) :-
X = get_choice,
F = @(depth => D,color_id => C:{d_panel;@},frame_state => State,
flat => Flat:{false;@}),
set_choice(X),
cond( State,
(
Shade = h_colors(C),
Highlight = s_colors(C)
),
cond( Flat,
(
Shade = m_colors(C),
Highlight = m_colors(C)
),
(
Shade = s_colors(C),
Highlight = h_colors(C)
)
)
),
cond( D :== @ or D :== 1,
draw_shade(0,0,
box => F,
shade => Shade,
highlight => Highlight),
draw_deep_shade(0,0,
box => F,
depth => D,
shade => Shade,
highlight => Highlight)
).
%%% led
%%% Added features led_width, led_height, led_position,led_offset
%%% which replace the old global variables
%%% before, customization was not easy, nor documented
%%% these features will be part of the led-look documentation
%%% 29/09/94 Vorbeck
led <| look.
:: led(led_color_id => C, led_on_color_id => LedOn,
led_off_color_id => LedOff,
led_width => W, led_height => H,
led_position => P, led_offset => O,
led_state => State) |
LedOn = {d_led_on; @},
LedOff = {d_led_off; @},
C = {d_button;@},
W = {d_led_width;@},
H = {d_led_height;@},
P = {d_led_position;@},
init_state(State), !.
draw_static(L:led) :-
X = get_choice,
C:(L.color_id) = {d_button;@},
set_choice(X),
draw_shade(L.led_position, (L.height - L.led_height)/2,
L.led_width, L.led_height,
box => L,
shade => h_colors(C),
highlight => s_colors(C)).
draw_dynamic(L:led) :-
draw_led(L).
draw_led(L:@(led_state => Bool)) :-
C = cond(Bool,L.led_on_color_id, L.led_off_color_id),
draw_button( L.led_position + 1,
( L.height - L.led_height ) / 2 + 1,
L.led_width - 2,L.led_height -2,
box => L,
color => m_colors(C),
shade => s_colors(C),
highlight => h_colors(C)
).
%%% slide_bars
v_slide_bar_l <| look.
draw_static(SP:v_slide_bar_l) :-
C = SP.color_id,
draw_shade( (SP.width)/2-1,0,3,
box => SP,
shade => h_colors(C),
highlight => s_colors(C)).
h_slide_bar_l <| look.
draw_static(SP:h_slide_bar_l) :-
C = SP.color_id,
draw_shade( 0,(SP.height)/2-1,_,3,
box => SP,
shade => h_colors(C),
highlight => s_colors(C)).
%%% utility
%%% Removed variable Value, since it is never used, and init_state is
%%% not exported. Changed the calls to init_state accordingly
%%% 22/09/94 Vorbeck
%%% Previous code was:
%%% init_state(S,Value) :-
%%% cond( S :== @,
%%% S <<- false,
%%% S <<- copy_pointer(S)
%%% ).
init_state(S) :-
cond( S :== @,
S <<- false
).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%% color functions
persistent(main_colors) ?
persistent(highlight_colors) ?
persistent(shade_colors) ?
m_colors(Id) -> copy_term(main_colors.Id).
h_colors(Id) -> copy_term(highlight_colors.Id).
s_colors(Id) -> copy_term(shade_colors.Id).
%%% relating a table, an id, and a color
def_color(TableName,Id,Color) :-
TableName.Id <<- Color.
%%% loading a new color, using RGB values
new_color(X,Y,Z) -> Color |
xRequestColor(default_window,X,Y,Z,Color).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%% loading a font.
%%% load_font also stores the font metrics in a persistent term
persistent(font_metrics) ?
new_font(FontName) -> Font |
xLoadFont(default_display,Font,FontName),
xQueryTextExtents(default_display,Font,"toto",
font_ascent => FA,
font_descent => FD
),
font_metrics.fontid(Font) <<- @(ascent => FA,descent => FD).
fontid(X) -> strcon("f",int2str(X)).
%%% font function
persistent(fonts) ?
text_font(X) -> copy_term(cond(X :== @,fonts.bold,fonts.X)).
%%% relating an id and a font
def_font(Id,Font) :-
fonts.Id <<- Font.
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%% some utilities
draw_button( X0,Y0,DX:{DXB;real},DY:{DYB;real},
box => Box:@(XB,YB,DXB,DYB,window => W),
color => BC,
shade => SC,
highlight => HC) :-
!,
draw_shade_rectangle( XD:(XB*IG:ig(Box) + X0),
YD:(YB*IG + Y0),
DX,DY,
shade => SC,
highlight => HC,
window => W),
xFillRectangle(W,XD+1,YD+1,DX-2,DY-2,color => BC).
draw_deep_button( X0,Y0,DX:{DXB;real},DY:{DYB;real},
box => Box:@(XB,YB,DXB,DYB,window => W),
depth => D,
color => BC,
shade => SC,
highlight => HC) :-
!,
draw_deep_shade2(XD:(XB*IG:ig(Box) + X0),
YD:(YB*IG + Y0),
DX,DY,
depth => D,
shade => SC,
highlight => HC,
window => W),
xFillRectangle(W,XD+D,YD+D,DX-2*D,DY-2*D,color => BC).
draw_shade( X0,Y0,DX:{DXB;real},DY:{DYB;real},
box => Box:@(XB,YB,DXB,DYB,window => W),
shade => SC,
highlight => HC) :-
!,
draw_shade_rectangle( XD:(XB*IG:ig(Box) + X0),
YD:(YB*IG + Y0),
DX,DY,
shade => SC,
highlight => HC,
window => W).
draw_deep_shade( X0,Y0,DX:{DXB;real},DY:{DYB;real},
box => Box:@(XB,YB,DXB,DYB,window => W),
depth => D,
shade => SC,
highlight => HC) :-
!,
draw_deep_shade2(XD:(XB*IG:ig(Box) + X0),
YD:(YB*IG + Y0),
DX,DY,
depth => D,
shade => SC,
highlight => HC,
window => W).
draw_deep_shade2(X0,Y0,DX,DY,
depth => D,
shade => SC,
highlight => HC,
window => W) :-
xFillPolygon(W,[(X0,Y0),(XB1:(X0+DX),Y0),(XB2:(X0+DX-D),YB2:(Y0+D)),
(XB3:(X0+D),YB2),(XB3,YB3:(Y0+DY-D)),(X0,YB4:(Y0+DY))],
color => HC),
xFillPolygon(W,[(XB1,Y0),(XB2,YB2),(XB2,YB3),(XB3,YB3),(X0,YB4),
(XB1,YB4)],color => SC).
draw_shade_rectangle( X1, Y1, DX, DY,
shade => SC, highlight => HC,
window => W ) :-
xDrawLine( W, X1,Y1,X2:(X1+DX-1),Y1,
color => HC,linewidth => 1),
xDrawLine( W, X1,Y1,X1,Y2:(Y1+DY-1),
color => HC,linewidth => 1),
xDrawLine( W, X2,Y2,X1,Y2,
color => SC,linewidth => 1),
xDrawLine( W, X2,Y2,X2,Y1,
color => SC,linewidth => 1).
draw_text( offset => Offset,
box => Box:@(XB,YB,DXB,DYB, window => W),
color => C,
font => Font, text => Text) :-
xQueryTextExtents(default_display,Font, Text,
text_width => TW,
font_ascent => Ascent,
font_descent => Descent),
xDrawString( W,
XB*IG:ig(Box) + compute_start(DXB,TW,Offset),
YB*IG + (DYB + Ascent - Descent)/2,
Text, font => Font, color => C).
compute_start(DX,TW,Offset) ->
cond( Offset =:= 0,
(DX - TW) / 2,
cond( Offset > 0,
Offset,
DX + Offset - TW
)
).