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 >
Text File  |  1996-06-04  |  11KB  |  451 lines
  1. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  2. %    $Id: xtools_l.lf,v 1.3 1996/02/01 23:29:17 vorbeck Exp $    
  3. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  4. %
  5. % XTOOLS: LOOK TYPES
  6. %
  7. % Author: Bruno Dumant
  8. % (c) Copyright 1993 - Digital Equipment Corporation 
  9. % All Rights Reserved
  10. %
  11. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  12. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  13.  
  14. %%% interface
  15.  
  16. public(
  17.         look,
  18.     text_box,field,frame,led,
  19.     v_slide_bar_l,h_slide_bar_l,
  20.  
  21.     draw_look,refresh_look,change_look,
  22.     draw_static,draw_dynamic,
  23.  
  24.     draw_button,draw_deep_button, 
  25.     draw_shade,draw_deep_shade,
  26.     draw_text,
  27.  
  28.         main_colors,highlight_colors,shade_colors,
  29.     new_color,def_color,
  30.     new_font,def_font
  31.        ) ?
  32.  
  33. dynamic(draw_static) ?
  34. dynamic(draw_dynamic) ?
  35.  
  36. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  37. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  38. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  39.  
  40. %%% look types
  41. %%%
  42. %%% for each look type, two predicates are defined:
  43. %%%   - draw_static draws the static part of the look
  44. %%%   - draw_dynamic draws the dynamic part of the look
  45.  
  46. %%% draw_look(A) draws the object A using ALL the clauses of draw_static and
  47. %%% draw_dynamic that have an argument more general than A (use of implies).
  48. %%% This implements the inheritance of looks
  49.  
  50. draw_look(A) -> true |
  51.     (
  52.         implies(draw_static(A)),fail
  53.     ;
  54.     implies(draw_dynamic(A)),fail
  55.     ;
  56.     succeed
  57.     ).
  58.  
  59.  
  60. %%% refresh_look only redraws the dynamic part of the look
  61.  
  62. change_look(A) :-
  63.     cond( has_feature(change_state,A,B),
  64.         (
  65.         B,
  66.         refresh_look(A)
  67.         )
  68.     ).
  69.  
  70.  
  71. refresh_look(A) :- 
  72.     (
  73.         implies(draw_dynamic(A)),fail
  74.     ;
  75.         cond( has_feature(daughters,A,Daughters),
  76.             refresh_daughters(features(Daughters),Daughters)
  77.         )
  78.     ).
  79.  
  80. refresh_daughters([]) :- !.
  81. refresh_daughters([A|B],D) :-
  82.     refresh_look(D.A),
  83.     refresh_daughters(B,D).
  84.  
  85.  
  86. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  87. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  88. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  89.  
  90. %%% predefined look types.
  91. %%% These are the look types used by the predefined objects of the toolkit; It
  92. %%% is always possible to extend this hierarchy to use other kinds of looks
  93.  
  94. %%%
  95. %%%                   ,- field    
  96. %%%                   |
  97. %%%                   |- text_box   
  98. %%%      box - look  -|           
  99. %%%                   |- frame
  100. %%%                   |       
  101. %%%                   `- led
  102. %%%
  103.  
  104. look <| box.
  105.  
  106.  
  107. %%% fields 
  108.  
  109. field <| look.
  110. :: field(field_state => S,
  111.        color_id => Cid,
  112.        true_field_color_id => Tid) |
  113.     init_state(S),
  114.     !.
  115.  
  116. draw_dynamic(Box:field) :-
  117.     X = get_choice,
  118.     Box = @(X0,Y0,DX,DY,window => W,
  119.             field_state => State,
  120.             color_id => ID:{d_field;@},
  121.         true_field_color_id => SID:{d_selected_field;@}),
  122.     set_choice(X),
  123.     cond( State,
  124.         xFillRectangle(W,
  125.                        X0*IG:ig(Box),Y0*IG,
  126.                DX,DY,color => m_colors(SID)),
  127.         xFillRectangle(W,
  128.                        X0*IG,Y0*IG,
  129.                DX,DY,color => m_colors(ID))
  130.     ).
  131.     
  132.  
  133. %%% text_box
  134.  
  135. text_box <| look.
  136. text_box <| t_box.
  137. :: text_box(text_state => State,
  138.         text_color_id => @,
  139.         true_text_color_id => @,
  140.         font_id => @,
  141.         offset => @) | 
  142.     init_state(State).
  143.  
  144. draw_dynamic(Box:text_box) :-
  145.     get_choice = X,
  146.     Box = @(text_color_id => TC:{d_text;@},
  147.         true_text_color_id => TT:{d_selected_text;@},
  148.         font_id => F:{bold;@},
  149.         offset => O:{d_offset;@}),
  150.     set_choice(X),
  151.     draw_text(offset => O,
  152.           box  => Box,
  153.           text => Box.text,
  154.           font => text_font(F),
  155.           color => m_colors(cond(Box.text_state, TT, TC))).
  156.  
  157. %%% frame
  158.  
  159. frame <| look.
  160. :: frame(depth => @,
  161.      flat => @,
  162.      frame_state => State,
  163.      color_id => @) |
  164.     init_state(State).
  165.  
  166. draw_dynamic(F:frame) :-
  167.     X = get_choice,
  168.     F = @(depth => D,color_id => C:{d_panel;@},frame_state => State,
  169.           flat => Flat:{false;@}),
  170.     set_choice(X),
  171.     cond( State,
  172.         (
  173.         Shade = h_colors(C),
  174.         Highlight = s_colors(C)
  175.         ),
  176.         cond( Flat,
  177.             (
  178.             Shade = m_colors(C),
  179.             Highlight = m_colors(C)
  180.         ),
  181.         (
  182.             Shade = s_colors(C),
  183.             Highlight = h_colors(C)
  184.         )
  185.         )
  186.     ),
  187.     cond( D :== @ or D :== 1,
  188.         draw_shade(0,0,
  189.                    box => F,
  190.                shade => Shade,
  191.                highlight => Highlight),
  192.         draw_deep_shade(0,0,
  193.                    box => F,
  194.                depth => D,
  195.                shade => Shade,
  196.                highlight => Highlight)
  197.     ).
  198.  
  199.  
  200. %%% led
  201. %%% Added features led_width, led_height, led_position,led_offset
  202. %%% which replace the old global variables
  203. %%% before, customization was not easy, nor documented
  204. %%% these features will be part of the led-look documentation
  205. %%% 29/09/94  Vorbeck
  206.  
  207. led <| look.
  208.  
  209. :: led(led_color_id => C, led_on_color_id => LedOn,
  210.        led_off_color_id => LedOff,
  211.        led_width => W, led_height => H,
  212.        led_position => P, led_offset => O,
  213.        led_state => State) | 
  214.     LedOn = {d_led_on; @},
  215.     LedOff = {d_led_off; @},
  216.     C = {d_button;@},
  217.     W = {d_led_width;@},
  218.     H = {d_led_height;@},
  219.     P = {d_led_position;@},
  220.     init_state(State), !.
  221.  
  222. draw_static(L:led) :-
  223.     X = get_choice,
  224.     C:(L.color_id) = {d_button;@},
  225.     set_choice(X),
  226.     draw_shade(L.led_position, (L.height - L.led_height)/2,
  227.            L.led_width, L.led_height,
  228.            box => L,
  229.            shade => h_colors(C), 
  230.            highlight => s_colors(C)).
  231.  
  232. draw_dynamic(L:led) :-
  233.     draw_led(L).
  234.  
  235. draw_led(L:@(led_state => Bool)) :-
  236.     C = cond(Bool,L.led_on_color_id, L.led_off_color_id),
  237.     draw_button( L.led_position + 1,
  238.              ( L.height - L.led_height ) / 2 + 1,
  239.              L.led_width - 2,L.led_height -2,
  240.              box => L,
  241.              color => m_colors(C),
  242.              shade => s_colors(C), 
  243.              highlight => h_colors(C)
  244.            ).
  245.  
  246. %%% slide_bars
  247.  
  248. v_slide_bar_l <| look.
  249. draw_static(SP:v_slide_bar_l) :-
  250.     C = SP.color_id,
  251.     draw_shade( (SP.width)/2-1,0,3,
  252.                 box => SP,
  253.             shade => h_colors(C),
  254.             highlight => s_colors(C)).
  255.  
  256. h_slide_bar_l <| look.
  257. draw_static(SP:h_slide_bar_l) :-
  258.     C = SP.color_id,
  259.     draw_shade( 0,(SP.height)/2-1,_,3,
  260.                 box => SP,
  261.             shade => h_colors(C),
  262.             highlight => s_colors(C)).
  263.  
  264. %%% utility
  265.  
  266. %%% Removed variable Value, since it is never used, and init_state is
  267. %%% not exported. Changed the calls to init_state accordingly
  268. %%% 22/09/94 Vorbeck
  269. %%% Previous code was:
  270. %%% init_state(S,Value) :- 
  271. %%%    cond( S :== @,
  272. %%%        S <<- false,
  273. %%%        S <<- copy_pointer(S)
  274. %%%    ).
  275.  
  276. init_state(S) :- 
  277.     cond( S :== @,
  278.           S <<- false
  279.         ).
  280.  
  281. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  282. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  283. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  284.  
  285. %%% color functions
  286.  
  287. persistent(main_colors) ?  
  288. persistent(highlight_colors) ?
  289. persistent(shade_colors) ?
  290.  
  291. m_colors(Id) -> copy_term(main_colors.Id).
  292. h_colors(Id) -> copy_term(highlight_colors.Id).
  293. s_colors(Id) -> copy_term(shade_colors.Id).
  294.  
  295. %%% relating a table, an id, and a color
  296.  
  297. def_color(TableName,Id,Color) :-
  298.     TableName.Id <<- Color.
  299.  
  300. %%% loading a new color, using RGB values
  301.  
  302. new_color(X,Y,Z) -> Color |
  303.     xRequestColor(default_window,X,Y,Z,Color).
  304.  
  305. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  306. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  307. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  308.  
  309. %%% loading a font. 
  310. %%% load_font also stores the font metrics in a persistent term
  311.  
  312. persistent(font_metrics) ?
  313. new_font(FontName) -> Font |
  314.     xLoadFont(default_display,Font,FontName),
  315.     xQueryTextExtents(default_display,Font,"toto",
  316.                       font_ascent => FA,
  317.               font_descent => FD
  318.               ),
  319.     font_metrics.fontid(Font) <<- @(ascent => FA,descent => FD).
  320.  
  321. fontid(X) -> strcon("f",int2str(X)).
  322.  
  323.  
  324. %%% font function
  325.  
  326. persistent(fonts) ?
  327. text_font(X) -> copy_term(cond(X :== @,fonts.bold,fonts.X)).
  328.  
  329.  
  330. %%% relating an id and a font
  331.  
  332. def_font(Id,Font) :-
  333.     fonts.Id <<- Font.
  334.  
  335.  
  336. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  337. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  338. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  339.  
  340. %%% some utilities
  341.  
  342. draw_button( X0,Y0,DX:{DXB;real},DY:{DYB;real},
  343.          box => Box:@(XB,YB,DXB,DYB,window => W),
  344.          color => BC,
  345.          shade => SC, 
  346.          highlight => HC) :-
  347.     !,
  348.     draw_shade_rectangle( XD:(XB*IG:ig(Box) + X0),
  349.                           YD:(YB*IG + Y0),
  350.                   DX,DY,
  351.                   shade => SC, 
  352.                   highlight => HC,
  353.                   window => W),
  354.     xFillRectangle(W,XD+1,YD+1,DX-2,DY-2,color => BC).
  355.  
  356. draw_deep_button( X0,Y0,DX:{DXB;real},DY:{DYB;real},
  357.               box => Box:@(XB,YB,DXB,DYB,window => W),
  358.           depth => D,
  359.           color => BC,
  360.           shade => SC, 
  361.           highlight => HC) :-
  362.     !,
  363.     draw_deep_shade2(XD:(XB*IG:ig(Box) + X0),
  364.                      YD:(YB*IG + Y0),
  365.              DX,DY,
  366.              depth => D,
  367.              shade => SC, 
  368.              highlight => HC,
  369.              window => W),
  370.     xFillRectangle(W,XD+D,YD+D,DX-2*D,DY-2*D,color => BC).
  371.  
  372.  
  373. draw_shade( X0,Y0,DX:{DXB;real},DY:{DYB;real},
  374.         box => Box:@(XB,YB,DXB,DYB,window => W),
  375.         shade => SC, 
  376.         highlight => HC) :-
  377.     !,
  378.     draw_shade_rectangle( XD:(XB*IG:ig(Box) + X0),
  379.                           YD:(YB*IG + Y0),
  380.                   DX,DY,
  381.                   shade => SC, 
  382.                   highlight => HC,
  383.                   window => W).
  384.  
  385. draw_deep_shade( X0,Y0,DX:{DXB;real},DY:{DYB;real},
  386.              box => Box:@(XB,YB,DXB,DYB,window => W),
  387.          depth => D,
  388.          shade => SC, 
  389.          highlight => HC) :-
  390.     !,
  391.     draw_deep_shade2(XD:(XB*IG:ig(Box) + X0),
  392.                      YD:(YB*IG + Y0),
  393.              DX,DY,
  394.                      depth => D,
  395.              shade => SC, 
  396.              highlight => HC,
  397.              window => W).
  398.  
  399.  
  400. draw_deep_shade2(X0,Y0,DX,DY,
  401.                    depth => D,
  402.          shade => SC, 
  403.          highlight => HC,
  404.          window => W) :-
  405.     xFillPolygon(W,[(X0,Y0),(XB1:(X0+DX),Y0),(XB2:(X0+DX-D),YB2:(Y0+D)),
  406.                     (XB3:(X0+D),YB2),(XB3,YB3:(Y0+DY-D)),(X0,YB4:(Y0+DY))],
  407.                  color => HC),
  408.     xFillPolygon(W,[(XB1,Y0),(XB2,YB2),(XB2,YB3),(XB3,YB3),(X0,YB4),
  409.                     (XB1,YB4)],color => SC).
  410.  
  411.  
  412. draw_shade_rectangle( X1, Y1, DX, DY,
  413.                   shade => SC, highlight => HC,
  414.                   window => W ) :-
  415.     xDrawLine( W, X1,Y1,X2:(X1+DX-1),Y1,
  416.                color => HC,linewidth => 1),
  417.     xDrawLine( W, X1,Y1,X1,Y2:(Y1+DY-1),
  418.                color => HC,linewidth => 1),
  419.     xDrawLine( W, X2,Y2,X1,Y2,
  420.                color => SC,linewidth => 1),
  421.     xDrawLine( W, X2,Y2,X2,Y1,
  422.                color => SC,linewidth => 1).
  423.  
  424.  
  425. draw_text( offset => Offset,
  426.        box => Box:@(XB,YB,DXB,DYB, window => W),
  427.        color => C,
  428.        font => Font, text => Text) :-
  429.     xQueryTextExtents(default_display,Font, Text,
  430.                       text_width => TW,
  431.               font_ascent => Ascent,
  432.               font_descent => Descent),
  433.     xDrawString( W,
  434.                  XB*IG:ig(Box) + compute_start(DXB,TW,Offset),
  435.              YB*IG + (DYB + Ascent - Descent)/2, 
  436.                  Text, font => Font, color => C).
  437.  
  438.  
  439. compute_start(DX,TW,Offset) ->
  440.     cond( Offset =:= 0,
  441.           (DX - TW) / 2,
  442.           cond( Offset > 0,
  443.             Offset,
  444.             DX + Offset - TW
  445.           )
  446.         ).
  447.  
  448.  
  449.  
  450.  
  451.