home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / lifeos2.zip / LIFE-1.02 / EXAMPLES / PALETTE.LF < prev    next >
Text File  |  1996-06-04  |  3KB  |  144 lines
  1. % Copyright 1994 Digital Equipment Corporation
  2. % All Rights Reserved
  3.  
  4. % X toolkit example: tool to compose a color.
  5.  
  6. module("palette") ?
  7.  
  8. public(palette) ?
  9. import("xtools","io") ?
  10.  
  11. persistent(palette_panel) ?
  12. global(end) ?
  13.  
  14.  
  15.  
  16. color_text <| text_field_button.
  17. :: color_text(text => "255",
  18.           offset => -2,
  19.           h_space => 4).
  20.  
  21.  
  22. color_slider <| v_slider.
  23. :: color_slider(min => 0,max => 255).
  24.  
  25. interface :-
  26.  
  27.     (Sred,Sgreen,Sblue) = @,
  28.     
  29.     palette_panel <<-
  30.     panel(title => "Palette") containing
  31.     
  32.     (
  33.         slide_bar(width => 100,height => 100,
  34.               window => W,color_id => blanc)
  35.         c_above
  36.  
  37.         v_box(5)
  38.  
  39.         c_above
  40.  
  41.         push_button(width => 100,
  42.             text => "quit",
  43.             action => stop_palette,
  44.             text_color_id => rouge)
  45.     )
  46.  
  47.     t_left_of h_box(5) c_left_of 
  48.     
  49.     (
  50.         (
  51.         v_slide_bar(height => 100) containing
  52.         Sred:color_slider(value => Red,
  53.                   action => set_color(Red,W,Tred,
  54.                               Red,Green,Blue)
  55.                  )
  56.         )
  57.         c_above v_box(3) c_above 
  58.         Tred:color_text(action => set_slider(Red,
  59.                          Tred,Sred,W,
  60.                          Red,Green,Blue)
  61.                )
  62.         c_above
  63.         text_box(text => "red")
  64.     )
  65.  
  66.     c_left_of %% h_box(3) c_left_of
  67.     (
  68.         (
  69.         v_slide_bar(height => 100) containing 
  70.         Sgreen:color_slider(value => Green,
  71.                  action => set_color(Green,W,Tgreen,
  72.                          Red,Green,Blue)
  73.                 )
  74.             )
  75.         c_above v_box(3) c_above 
  76.         Tgreen:color_text(action => set_slider(Green,
  77.                         Tgreen,Sgreen,W,
  78.                         Red,Green,Blue))
  79.         c_above
  80.         text_box(text => "green")
  81.     )
  82.  
  83.     c_left_of %% h_box(3) c_left_of
  84.     (
  85.         (
  86.         v_slide_bar(height => 100) containing
  87.         Sblue:color_slider(value => Blue,
  88.                  action => set_color(Blue,W,Tblue,
  89.                          Red,Green,Blue)
  90.                 )
  91.         )
  92.         c_above v_box(3) c_above 
  93.         Tblue:color_text(action => set_slider(Blue,
  94.                         Tblue,Sblue,W,
  95.                         Red,Green,Blue))
  96.         c_above
  97.         text_box(text => "blue")
  98.     ).
  99.  
  100.  
  101. def_color(main_colors,blanc,white) ?
  102. def_color(main_colors,rouge,red) ?
  103.  
  104. set_color(Color,W,T,Red,Green,Blue) :-
  105.     set_color2(W,Red,Green,Blue),
  106.     set_text(Color,T). 
  107.  
  108. set_slider(Color,@(text => T),Slider:@(max => Max,min => Min),W,
  109.        Red,Green,Blue) :-
  110.     Y = parse(T),
  111.     cond( Y :< real,
  112.         cond( Y >= Min and Y =< Max,
  113.           (
  114.               move_slider(Slider,Y),
  115.               set_color2(W,Red,Green,Blue)
  116.           )              
  117.         )
  118.     ).
  119.  
  120. set_text(Color,T:@(text => Text)) :-
  121.     Text <<- int2str(floor(Color)),
  122.     refresh_look(T).
  123.  
  124. set_color2(W,Red,Green,Blue) :-
  125.     C = new_color(floor(Red),floor(Green),floor(Blue)),
  126.     xSetWindowColor(W,C),
  127.     xFreeColor(W,C).
  128.  
  129. stop_palette :-
  130.     set_choice(end),
  131.     fail.
  132.  
  133.  
  134. interface ?
  135.  
  136. palette :-
  137.     ( end = get_choice,
  138.       create_box(copy_term(palette_panel))
  139.     ;
  140.       succeed
  141.     ).
  142.  
  143.  
  144.