%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%	$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
		  )
	    ).




