home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / lifeos2.zip / LIFE-1.02 / LIB / XTOOLS_C.LF < prev    next >
Text File  |  1996-06-04  |  24KB  |  973 lines
  1. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  2. %    $Id: xtools_c.lf,v 1.3 1996/02/01 23:23:35 vorbeck Exp $    
  3. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  4. %
  5. % XTOOLKIT: CONSTRUCTOR 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(panel_c,menu_panel_c,sub_panel_c,
  17.        push_c,on_off_c, text_field_c,menu_button_c,item_c,
  18.        slider_c,v_slider_c,h_slider_c,
  19.        move_slider,
  20.        show_panel,hide_panel,close_panel,
  21.        show_menu,hide_menu,close_menu,
  22.        button_pressed,enabled,
  23.        grid_c
  24.       ) ?
  25.  
  26.  
  27. %%% event masks
  28.  
  29. global(panel_mask <- xButtonReleaseMask \/ xKeyPressMask  \/ xExposureMask) ?
  30. global(menu_panel_mask <- xButtonReleaseMask \/ xExposureMask) ?
  31.  
  32. global(button_mask <- xButtonPressMask  \/  xButtonReleaseMask \/
  33.                xLeaveWindowMask \/ 
  34.            xEnterWindowMask \/xExposureMask) ? 
  35.  
  36. global(text_field_mask <- xButtonPressMask  \/ xExposureMask) ?
  37. global(menu_button_mask <- xButtonPressMask \/ xButtonReleaseMask \/ 
  38.                           xOwnerGrabButtonMask \/ xExposureMask) ? 
  39. global(item_mask <- xButtonReleaseMask  \/xExposureMask \/ 
  40.                    xLeaveWindowMask \/ xEnterWindowMask) ?
  41.  
  42. global(slider_mask <- xButtonPressMask \/ xButtonReleaseMask \/
  43.                      xOwnerGrabButtonMask \/ xPointerMotionMask \/ 
  44.                  xExposureMask) ?
  45. global(slider_mask_1 <- xButtonPressMask \/ xButtonReleaseMask \/ 
  46.                        xPointerMotionMask \/ xExposureMask) ?
  47. global(slider_mask_2 <- xButtonReleaseMask  \/ xPointerMotionMask \/ 
  48.                        xExposureMask) ?
  49.  
  50. persistent(cur_orig) ?
  51. persistent(cur_zero) ?
  52. persistent(cur_ratio) ?
  53. persistent(is_cur_vertical) ?
  54. persistent(cur_max) ?
  55. persistent(cur_min) ?
  56. persistent(lastx) ?
  57. persistent(lasty) ?
  58. persistent(button_pressed) ?
  59.  
  60. persistent(enabled) ?
  61. enabled <<- false?
  62. persistent(clicked_in) ?
  63. clicked_in <<- false ?
  64.  
  65.  
  66. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  67. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  68. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  69.  
  70. %%% Panels
  71.  
  72. %%% standard panel
  73.  
  74. :: P:panel_c(constructor => build_panel(P),
  75.          selected_text => ST,
  76.          title => T).
  77. panel_c <| widget.
  78.  
  79.  
  80. %%% panel constructor
  81.  
  82. build_panel(P:@(X0:{0;real},Y0:{0;real},
  83.             Width,Height,title => T,color_id => C,
  84.         window => PanelWindow)) :-
  85.     C = {d_panel;@},
  86.     !,
  87.     cond(Width >= 1200,
  88.         RealWidth = 1200,
  89.         RealWidth = Width
  90.     ),
  91.     cond(Height >= 980,
  92.         RealHeight = 980,
  93.         RealHeight = Height
  94.     ),
  95.     xCreateWindow(default_display, 
  96.               X0,Y0,RealWidth,RealHeight,
  97.               PanelWindow,
  98.               windowtitle => T,
  99.               color     => m_colors(C),
  100.               eventmask => panel_mask, 
  101.               show => true),
  102.     P.selected_text <<- false,
  103.     P.clearable <<- true,
  104.     P.mother <<- no_mother,
  105.     catch_panel_events(P).
  106.  
  107.  
  108. %%% panel: events handler
  109.  
  110. catch_panel_events(Panel:@(window => PW:window)) -> 
  111.     handle_panel_event(xGetEvent(PW,eventmask => panel_mask),
  112.     PW,Panel).
  113.  
  114. handle_panel_event (E:expose_event,PW,Panel) -> true |
  115.     xRefreshWindow(PW),
  116.     handle_panel_event(xGetEvent(PW,eventmask =>  panel_mask),
  117.     PW,Panel).
  118.  
  119. handle_panel_event(keyboard_event (char => C),PW,
  120.     Panel:@(selected_text => S)) -> true |
  121.         cond(S,
  122.         handle_char(Panel.daughters.(S.1), Panel, char => C)
  123.     ),
  124.     handle_panel_event(xGetEvent(PW,eventmask => panel_mask),
  125.     PW,Panel).
  126.  
  127. handle_panel_event(B:button_event,PW,
  128.                Panel) -> true |
  129.     check_button_to_release(Panel),
  130.     handle_panel_event(xGetEvent(PW,eventmask => panel_mask),
  131.                            PW,Panel).
  132.  
  133.  
  134. %%% open and close a panel. 
  135.  
  136. show_panel(P:@(window => PW)) :-
  137.     xShowWindow(PW).
  138.  
  139. hide_panel(P:@(window => PW)) :-
  140.     xHideWindow(PW).
  141.  
  142. close_panel(P:@(window => PW)) :-    
  143.     xDestroyWindow(PW).
  144.  
  145.  
  146. %%% menu panel
  147.  
  148. :: P:menu_panel_c(0,0,
  149.               constructor => build_menu_panel(P),
  150.           menu_button => MB).
  151. menu_panel_c <| widget.
  152.  
  153.  
  154. %%% menu_panel constructor
  155.  
  156. build_menu_panel(P:@(width => Width,height => Height,
  157.                  color_id => C,
  158.              window => Window)) :-
  159.     C = {d_panel;@},
  160.     !,
  161.     P.mother = no_mother,
  162.     xCreateWindow(default_display, 
  163.               0,0,Width,Height,
  164.               Window,
  165.               color     => m_colors(C),
  166.               eventmask => menu_panel_mask,
  167.               borderwidth => 0,
  168.               overrideredirect => true,
  169.               show => false),
  170.     catch_menu_panel_events(P).
  171.  
  172. %%% menu_panel: events handler
  173.  
  174. catch_menu_panel_events(MenuPanel:@(window => PW:window)) -> 
  175.     handle_menu_panel_event(xGetEvent(PW,
  176.                                       eventmask => menu_panel_mask),
  177.                             PW,MenuPanel).
  178.  
  179. handle_menu_panel_event (expose_event,PW,MenuPanel) -> true |
  180.     xRefreshWindow(PW),
  181.     handle_menu_panel_event(xGetEvent(PW,
  182.                                       eventmask =>  menu_panel_mask),
  183.                     PW,MenuPanel).
  184.  
  185. handle_menu_panel_event(button_event,PW,MenuPanel) -> true |
  186.     hide_menu(MenuPanel),
  187.     handle_menu_panel_event(xGetEvent(PW,
  188.                                       eventmask => menu_panel_mask),
  189.                 PW,MenuPanel).
  190.  
  191.  
  192. %%% sub_panel
  193.  
  194. :: P:sub_panel_c(constructor => build_sub_panel(P)).
  195. sub_panel_c <| widget.
  196.  
  197.  
  198. %%% sub_panel constructor
  199.  
  200. build_sub_panel(SubPanel:@(X,Y,Width,Height,
  201.                        color_id => C,
  202.                window => Window,
  203.                mother => @(window => MW))) :-
  204.     C = {d_panel;@},
  205.     !,
  206.     create_subwindow(default_display, 
  207.                      X,Y,Width,Height,
  208.              Window,
  209.              parent => MW,
  210.              color  => m_colors(C),
  211.              eventmask => xExposureMask),
  212.     catch_sub_panel_events(SubPanel).
  213.  
  214. %%% sub_panel: events handler
  215.  
  216. catch_sub_panel_events(SubPanel:@(window => PW:window)) -> 
  217.     handle_sub_panel_event(xGetEvent(PW,
  218.                                      eventmask => xExposureMask),
  219.                             PW).
  220.  
  221. handle_sub_panel_event (expose_event,PW) -> true |
  222.     xRefreshWindow(PW),
  223.     handle_sub_panel_event(xGetEvent(PW,
  224.                                       eventmask => xExposureMask),
  225.                     PW).
  226.  
  227.  
  228. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  229. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  230. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  231.  
  232. %%% buttons
  233.  
  234. %%% generic button: 
  235.  
  236. :: button(active => Bool) | init_state(Bool). 
  237. button <| widget.
  238.  
  239.  
  240. %%%
  241. %%%                        ,- push_c
  242. %%%                        |
  243. %%%                        |- on_off_c
  244. %%%               button  -|
  245. %%%                        |- menu_button_c
  246. %%%                        |
  247. %%%                        `- text_field_c
  248.  
  249. %%% on_off button                  
  250.  
  251. on_off_c <| button.
  252. :: A:on_off_c(associated_action => on_off_action(A),
  253.           action => @,
  254.               constructor => build_on_off_button(A),
  255.           on => bool).
  256.  
  257. on_off_action(A:@(on => ON, action => RAct)) :-
  258.     ON <<- not(ON),
  259.     (
  260.         copy_pointer(RAct),
  261.         !
  262.     ;    
  263.         write_err("error"), nl_err
  264.     ).
  265.  
  266. %%% on_off button constructor
  267.  
  268. build_on_off_button(B:@(X0,Y0,Width,Height,color_id => C,
  269.                  window => ButtonWindow,
  270.              mother => @(window => PW))) :-
  271.     C = {d_button;@},
  272.     !,
  273.     create_subwindow(default_display,
  274.                      X0,Y0,Width,Height,
  275.              ButtonWindow,
  276.              parent => PW,
  277.              color => m_colors(C),
  278.              eventmask => button_mask),
  279.     B.on <<- false,
  280.     cond( BAction:(B.action) :== @,
  281.           BAction = succeed
  282.     ), 
  283.     catch_button_events(B).
  284.  
  285. %%% push button
  286.  
  287. push_c <| button.
  288. :: A:push_c(associated_action => push_action(A),
  289.         action => Action,
  290.             constructor => build_push_button(A)).
  291.  
  292. push_action(A:@(action => RAct)) :-
  293.     RAct.
  294.  
  295. %%% push button constructor
  296.  
  297. build_push_button(B:@(X0,Y0,Width,Height,color_id => C,
  298.                  window => ButtonWindow,
  299.              mother => @(window => PW))) :-
  300.     C = {d_button;@},
  301.     !,
  302.     create_subwindow(default_display,
  303.                      X0,Y0,Width,Height,
  304.              ButtonWindow,
  305.              parent => PW,
  306.              color => m_colors(C),
  307.                          eventmask => button_mask),
  308.     cond( BAction:(B.action) :== @,
  309.           BAction = succeed
  310.     ), 
  311.     catch_button_events(B).
  312.  
  313.  
  314. %%% Button events
  315.  
  316. catch_button_events(Button:@(window => BW:window)) -> true |
  317.     handle_button_events(xGetEvent(BW,eventmask => button_mask),
  318.                          BW,Button).
  319.     
  320. handle_button_events(B:button_event(state => 0),
  321.                  BW,Button) -> true |
  322.     button_pressed <<- B."button",
  323.     enabled <<- true,
  324.     Button.active <<- true,
  325.     change_look(Button),
  326.     handle_button_events(xGetEvent(BW,eventmask => button_mask),
  327.                          BW,Button).
  328.  
  329. handle_button_events(B:button_event, BW, Button) ->
  330.     true |
  331.     (Act:(Button.active),!,
  332.      (
  333.          B."button" =:= button_pressed,!, %%% releasing the
  334.                                               %%% pressed button
  335.          Act <<- false,
  336.          cond(enabled,
  337.           (
  338.               enabled <<- false,
  339.               Button.associated_action
  340.           )
  341.          ),
  342.          change_look(Button)
  343.      ;
  344.                                               %%% releasing another button
  345.          succeed
  346.      )
  347.     ;
  348.      check_button_to_release(Button)
  349.     ),
  350.     handle_button_events(xGetEvent(BW,eventmask => button_mask),
  351.                          BW, Button).
  352.  
  353.  
  354.  
  355.  
  356. handle_button_events(enter_event,W,Button) -> true |
  357.         cond( Button.active,
  358.             (
  359.         enabled <<- true,
  360.         change_look(Button)
  361.         )
  362.     ),
  363.     handle_button_events(xGetEvent(W,eventmask => button_mask),
  364.                      W,Button).
  365.  
  366.  
  367. handle_button_events(leave_event,W,Button) -> true |
  368.     cond( enabled and Button.active,
  369.             (
  370.         enabled <<- false,
  371.         change_look(Button)
  372.         )
  373.      ),
  374.     handle_button_events(xGetEvent(W,eventmask => button_mask),
  375.                      W,Button).
  376.  
  377. handle_button_events(expose_event,BW,Button) -> true |
  378.         xRefreshWindow(BW),
  379.     handle_button_events(xGetEvent(BW,eventmask =>  button_mask),
  380.                  BW,Button).
  381.  
  382.  
  383. %%% text fields
  384.  
  385. :: A:text_field_c(on => bool,
  386.               text => string,
  387.           action => Action,
  388.           constructor => build_text_field(A)).
  389. text_field_c <| widget.
  390.  
  391. text_action(A) :-
  392.     P:@(selected_text => Q) = find_panel(A),
  393.     (
  394.         Q :== true, !,
  395.         PrevButton = find_button((Q.1),P),
  396.         (
  397.         B:(not( PrevButton ===  A)),
  398.         PrevButton.action,
  399.         PrevButton.on <<- false,
  400.         change_look(PrevButton) 
  401.         ;
  402.             succeed
  403.         )
  404.     ;
  405.         succeed
  406.     ),
  407.     A.on <<- true,
  408.     P.clearable <<- true,
  409.     Q <<- true(A.id),
  410.     change_look(A).
  411.  
  412.  
  413. %%% very basic editor for a text-field
  414.  
  415. handle_char( B, P, char  => C) :-
  416.     ( 
  417.         C =:= 13,!, %%% return
  418.         P.selected_text <<- false,
  419.         B.on <<- false,
  420.         change_look(B),
  421.         copy_pointer(B.action)
  422.     ;
  423.         (
  424.         Q:(P.clearable),!,   
  425.         B.text <<- "",
  426.         change_look(B),
  427.         Q <<- false
  428.         ;
  429.             succeed
  430.         ),
  431.         ( 
  432.         C >= 32 and C =< 126,!,
  433.         add_new_char(B,C)
  434.         ;
  435.             C =:= 8,!,
  436.         remove_last_char(B)
  437.         ;
  438.             succeed
  439.         )
  440.     ).
  441.  
  442. add_new_char(B:@(text => T),K) :-
  443.     T <<- strcon(T,chr(K)),
  444.     change_look(B).
  445.  
  446. remove_last_char(B:@(text => T)) :-
  447.     cond( L:strlen(T) > 0,
  448.         (   
  449.         T <<- substr(T,1,L-1),
  450.         change_look(B)
  451.         )
  452.     ).
  453.  
  454.  
  455. %%% constructor of a text_field
  456.  
  457. build_text_field(B:@(X0,Y0,Width,Height,
  458.                  window => ButtonWindow)) :-
  459.     Panel:@(window => MW,color_id => C) = find_panel(B),
  460.     C = {d_button;@},
  461.     !,
  462.     create_subwindow(default_display,
  463.                      X0,Y0,Width,Height,
  464.              ButtonWindow,
  465.              parent => MW,
  466.              color => m_colors(C),
  467.              eventmask => text_field_mask),
  468.     B.on <<- false,
  469.     cond( BText:(B.text) :< string,
  470.         BText <<- copy_pointer(BText),
  471.         BText <<- ""
  472.     ),
  473.     cond( BAction:(B.action) :== @,
  474.         BAction = succeed
  475.     ),
  476.     catch_text_field_events(B).
  477.  
  478. %%% Text Field events
  479.  
  480. catch_text_field_events(Button:@(window => BW:window)) -> true |
  481.     handle_text_field_events(xGetEvent(BW,eventmask => text_field_mask),
  482.                              BW,Button).
  483.     
  484. handle_text_field_events(expose_event,BW,Button) -> true |
  485.         xRefreshWindow(BW),
  486.     handle_text_field_events(xGetEvent(BW,eventmask =>  text_field_mask),
  487.                      BW,Button).
  488.  
  489. handle_text_field_events(B:button_event,
  490.                  BW,Button) -> true |
  491.     Button.on <<- true,
  492.     change_look(Button),
  493.     text_action(Button),
  494.     handle_text_field_events(xGetEvent(BW,eventmask => text_field_mask),
  495.                  BW,Button).
  496.  
  497. %%% menu button
  498.  
  499. menu_button_c <| button.
  500. :: A:menu_button_c(on => On,
  501.                menu => @(menu_button => A),
  502.                    constructor => build_menu_button(A)).
  503.  
  504.  
  505. %%% constructor of a menu button
  506.  
  507. build_menu_button(B:@(X0,Y0,Width,Height,color_id => C,
  508.                   on => On,
  509.                   window => ButtonWindow,
  510.               mother => @(window => MW))) :-
  511.     C = {d_button;@},
  512.     !,
  513.     create_subwindow(default_display,
  514.                      X0,Y0,Width,Height,
  515.              ButtonWindow,
  516.              parent => MW,
  517.              color => m_colors(C),
  518.              eventmask => menu_button_mask),
  519.     catch_menu_button_events(B).
  520.  
  521. %%% menu button: events handler
  522.  
  523. catch_menu_button_events(Button:@(window => BW:window)) ->
  524.     handle_menu_button(xGetEvent(BW,eventmask => menu_button_mask),
  525.                        BW,Button).
  526.     
  527. handle_menu_button(expose_event,BW,Button) -> true |
  528.         xRefreshWindow(BW),
  529.     handle_menu_button(xGetEvent(BW,eventmask =>  menu_button_mask),
  530.                BW,Button).
  531.  
  532. handle_menu_button(B:button_event,BW,Button:@(menu => Menu)) -> true |
  533.     (
  534.         B.state =:= 0,!,    %%% button press    
  535.         Button.on <<- true,
  536.         clicked_in <<- true(Button.id),
  537.         show_menu(Menu),
  538.         change_look(Button)
  539.     ;
  540.         implies(release(Button))
  541.     ),      
  542.         handle_menu_button(xGetEvent(BW,eventmask => menu_button_mask),
  543.                        BW,Button).
  544.  
  545. release(Button:menu_button_c) :- 
  546.     !,
  547.     hide_menu(Button.menu),
  548.     Button.on <<- false,
  549.     change_look(Button),
  550.     clicked_in <<- false.    
  551.  
  552.  
  553. show_menu(Menu:@(_,_,WidthM,HeightM,window => MenuWindow,
  554.              menu_button => @(_,_,_,Height,on => ON,window => W1))) :-
  555.     xQueryPointer(W1,
  556.               Root_return,   Child_return,
  557.               Root_x_return, Root_y_return,
  558.               Win_x_return,  Win_y_return),
  559.     xSetWindowGeometry(MenuWindow,
  560.                        Root_x_return - Win_x_return,
  561.                Root_y_return - Win_y_return + Height,
  562.                WidthM,HeightM),
  563.     xRaiseWindow(MenuWindow),
  564.     xShowWindow(MenuWindow).
  565.  
  566. hide_menu(Menu:@(window => MenuWindow)) :-
  567.     xHideWindow(MenuWindow).
  568.  
  569. close_menu(Menu:@(window => MenuWindow)) :-
  570.     xDestroyWindow(MenuWindow).
  571.  
  572. %%% item
  573.  
  574. :: I:item_c(action => A,
  575.         on => bool,
  576.         menu => Menu,
  577.         constructor => build_item(I)).
  578. item_c <| widget.
  579.  
  580.  
  581. %%% item constructor
  582.  
  583. build_item (I:@(X0,Y0,Width,Height,
  584.             window => ItemWindow,
  585.             mother => @(window => PW),
  586.         color_id => C, on => On,
  587.             menu => Menu )) :-
  588.     C = {d_item;@},
  589.     !,
  590.     create_subwindow(default_display,
  591.                      X0,Y0,Width,Height,
  592.              ItemWindow,
  593.              parent => PW,
  594.              color => m_colors(C),
  595.              eventmask => item_mask),
  596.     Menu = find_panel(I), 
  597.     cond( Action:(I.action) :== @,
  598.         Action = succeed
  599.     ),
  600.     On <<- false,
  601.     catch_item_events(I).
  602.  
  603.  
  604.  
  605. %%% item: events handler
  606.  
  607. catch_item_events(MenuItem:@(window => W:window)) ->
  608.     handle_item_event(xGetEvent(W,eventmask => item_mask),
  609.                       W,MenuItem).
  610.  
  611. handle_item_event(expose_event,W,MenuItem) -> true |
  612.     xRefreshWindow(W),
  613.     handle_item_event(xGetEvent(W,eventmask => item_mask),
  614.               W,MenuItem).
  615.  
  616. handle_item_event(E:enter_event(state => State),W,MenuItem) -> true |
  617.     cond(State =\= 0,
  618.         (
  619.         MenuItem.on <<- true,
  620.         change_look(MenuItem)
  621.         )
  622.     ),
  623.     handle_item_event(xGetEvent(W,eventmask => item_mask),
  624.               W,MenuItem).
  625.  
  626. handle_item_event(L:leave_event,W,MenuItem) -> true |
  627.     MenuItem.on <<- false,
  628.     change_look(MenuItem),
  629.     handle_item_event(xGetEvent(W,eventmask => item_mask),
  630.                   W,MenuItem).
  631.  
  632. handle_item_event(button_event,W,MenuItem:@(action => Act,
  633.                                         menu => Menu)) -> true | 
  634.     Button:(Menu.menu_button).on <<- false,
  635.     clicked_in <<- false,
  636.     change_look(Button),
  637.     (
  638.         copy_pointer(Act),!
  639.     ;
  640.         succeed
  641.     ),
  642.     hide_menu(Menu),
  643.     handle_item_event(xGetEvent(W,eventmask => item_mask),
  644.               W,MenuItem).
  645.  
  646. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  647. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  648. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  649.  
  650. %%% slider button
  651.  
  652. :: Slider:slider_c(constructor => build_slider(Slider),
  653.            is_vertical => D,
  654.            value => V,
  655.            action => A,
  656.            ratio => R,
  657.            min => Min,
  658.            max => Max,
  659.            zero => Zero).
  660. slider_c <| widget.
  661.  
  662. v_slider_c <| slider_c.
  663. :: v_slider_c(is_vertical => true).
  664.  
  665. h_slider_c <| slider_c.
  666. :: h_slider_c(is_vertical => false).
  667.  
  668.  
  669. build_slider(Slider:@(X0,Y0,Width,Height,
  670.                   action => Action,
  671.               color_id => C,
  672.               is_vertical => IsVert,
  673.               value => V,
  674.               ratio => R,
  675.               max => Max, min => Min,
  676.               zero => Zero,
  677.               mother => @(width => WM,
  678.                   height => HM,
  679.                   border => B,
  680.                   window => PW),
  681.               window => SliderWindow)) :-
  682.     C = {d_slider;@},
  683.     !,
  684.     create_subwindow(default_display,
  685.                      X0,Y0,Width,Height,
  686.              SliderWindow,
  687.              parent => PW,
  688.              color => m_colors(C),
  689.              eventmask => slider_mask_1),
  690.     cond( Action :== @,
  691.         Action = succeed
  692.     ),
  693.             
  694.         %%% Coor = Zero + R * Value
  695.     
  696.         cond( IsVert,
  697.         (
  698.         R = (HM - 2*B - Height)/(Min - Max),
  699.         Zero = B - R*Max,
  700.         V <<- (Y0 - Zero)/R
  701.         ),
  702.         (
  703.         Zero = B - R*Min,
  704.         R = (WM -2*B - Width)/(Max - Min),
  705.         V <<- (X0 - Zero)/R
  706.         )
  707.     ),
  708.     catch_slider_events(Slider).
  709.  
  710. %%% slider button: events handler
  711.  
  712. catch_slider_events(Button:@(window => BW:window)) ->
  713.     handle_slider(xGetEvent(BW,eventmask => slider_mask_1),
  714.                   BW,Button).
  715.     
  716.  
  717. %%% Before sliding
  718.  
  719. handle_slider(expose_event,BW,Button) -> true |
  720.         xRefreshWindow(BW),
  721.     handle_slider(xGetEvent(BW,eventmask => slider_mask_1),
  722.                   BW,Button).
  723.  
  724. handle_slider(B:button_event(x_root => X, y_root => Y,state => 0),BW,
  725.           Button:@(is_vertical => IsVert,
  726.                ratio => Ratio,max => Max,min => Min,
  727.                zero => Zero,value => V)) -> true |
  728.     is_cur_vertical <<- IsVert,
  729.     cur_ratio <<- Ratio,
  730.     cur_max <<- Max,
  731.     cur_min <<- Min,
  732.     cur_zero <<- Zero,
  733.     cond( IsVert,
  734.         Start = Y,
  735.         Start = X
  736.     ),
  737.     cur_orig <<-  copy_pointer(V - Start/Ratio),
  738.     handle_slider2(xGetEvent(BW,eventmask => slider_mask_2),
  739.                    BW,Button).
  740.  
  741. global(cwin) ?
  742. handle_slider(motion_event,BW,Button) -> true |
  743.         handle_slider(xGetEvent(BW,eventmask => slider_mask_1),
  744.                       BW,Button).
  745.  
  746. handle_slider(button_event,BW,Button) -> true |
  747.         check_button_to_release(Button),
  748.     handle_slider(xGetEvent(BW,eventmask => slider_mask_1),
  749.                   BW,Button).
  750.  
  751.  
  752. %%% During sliding
  753.  
  754. handle_slider2(M:motion_event,BW,
  755.            Button) -> true |
  756.         lastx <<- @,
  757.     (
  758.         cwin = BW,
  759.         get_last_motion(xGetEvent(BW,eventmask => 64))
  760.     ;
  761.         cond( is_value(lastx),
  762.             move_slider(Button,pointer_value(lastx,lasty)),
  763.         move_slider(Button,pointer_value(M.x_root,M.y_root))
  764.         ),
  765.         Button.action,
  766.         handle_slider2(xGetEvent(BW,eventmask => slider_mask_2),
  767.                        BW,Button)
  768.     ).
  769.  
  770.  
  771. get_last_motion(M:motion_event) ->
  772.       get_last_motion(xGetEvent(cwin,eventmask => 64)) 
  773.   |
  774.       lasty <<- M.y_root,
  775.       lastx <<- M.x_root,
  776.       fail.
  777.  
  778.  
  779. handle_slider2(B:button_event(x_root => X,y_root => Y),BW,
  780.           Button:@(action => Action)) -> true |
  781.     move_slider(Button,pointer_value(X,Y)),
  782.     Action,
  783.         handle_slider(xGetEvent(BW,eventmask => slider_mask_1),
  784.                   BW,Button).
  785.  
  786. handle_slider2(expose_event,BW,Button) -> true |
  787.         xRefreshWindow(BW),
  788.     handle_slider2(xGetEvent(BW,eventmask => slider_mask_2),
  789.                    BW,Button).
  790.  
  791. M:move_slider(Button:@(X0,Y0,value => V,window => BW,
  792.                  is_vertical => Bool, zero => Zero, ratio => Ratio),
  793.         Value) :-
  794.     cond( Bool,
  795.           Y0 <- P:root_sort(Zero + Ratio*Value),
  796.           X0 <- P
  797.         ),
  798.     V <<- root_sort(Value),
  799.     xMoveWindow(BW,X0,Y0).
  800.  
  801. pointer_value(X,Y) ->
  802.     cond( is_cur_vertical,
  803.         get_value(Y),
  804.         get_value(X)
  805.     ).
  806.     
  807.  
  808. get_value(Coor) ->
  809.     cond( NewVal:(cur_orig + Coor/cur_ratio) > CMax:cur_max,
  810.         CMax,
  811.         cond( NewVal < CMin:cur_min,
  812.             CMin,
  813.         NewVal
  814.         )
  815.     ).
  816.     
  817. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  818. %%%
  819. %%% grid button
  820. %%%
  821. %%% Added by Martin Vorbeck
  822. %%%
  823. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  824.  
  825. grid_c <| look.
  826.  
  827. grid_c <| button.
  828. :: A:grid_c(associated_action => grid_action(A),
  829.         action => Action,
  830.             constructor => build_grid_button(A)).
  831.  
  832. grid_action(A:@(action => RAct)) :-
  833.     RAct.
  834.  
  835. %%% grid button constructor
  836.  
  837. build_grid_button(B:@(X0,Y0,Width,Height,color_id => C,
  838.                  window => ButtonWindow,
  839.              mother => @(window => PW))) :-
  840.     C = {d_button;@},
  841.     !,
  842.     create_subwindow(default_display,
  843.                      X0,Y0,Width,Height,
  844.              ButtonWindow,
  845.              parent => PW,
  846.              color => m_colors(C),
  847.                          eventmask => button_mask),
  848.     cond( GAction:(B.action) :== @,
  849.           GAction = succeed
  850.         ),
  851.     catch_grid_events(B).
  852.  
  853.  
  854. %%% Button events
  855.  
  856. catch_grid_events(Grid:@(window => BW:window)) -> true |
  857.     handle_grid_events(xGetEvent(BW,eventmask => button_mask),
  858.                          BW,Grid).
  859.     
  860. handle_grid_events(B:button_event(state => 0, x => X, y => Y),
  861.                  BW,Grid) -> true |
  862.     button_pressed <<- B."button",
  863.     enabled <<- true,
  864.     Grid.active <<- true,
  865.     Grid.old_x_pos <<- X,
  866.     Grid.old_y_pos <<- Y,
  867.     change_look(Grid),
  868.     handle_grid_events(xGetEvent(BW,eventmask => button_mask),
  869.                          BW,Grid).
  870.  
  871. handle_grid_events(B:button_event(x => X, y => Y),
  872.              BW,Grid) -> true |
  873.     (Act:(Grid.active),!,
  874.      (
  875.          B."button" =:= button_pressed,!, %%% releasing the
  876.                                               %%% pressed button
  877.          Act <<- false,
  878.          cond(enabled,
  879.           (
  880.               enabled <<- false,
  881.               Grid.x_pos <<- X,
  882.               Grid.y_pos <<- Y,
  883.               Grid.associated_action
  884.           )
  885.          ),
  886.          change_look(Grid)
  887.      ;
  888.                                               %%% releasing another button
  889.          succeed
  890.      )
  891.     ;
  892.      check_button_to_release(Grid)
  893.     ),
  894.     handle_grid_events(xGetEvent(BW,eventmask => button_mask),
  895.                          BW,Grid).
  896.  
  897.  
  898.  
  899.  
  900. handle_grid_events(enter_event,W,Grid) -> true |
  901.         cond( Grid.active,
  902.             (
  903.         enabled <<- true,
  904.         change_look(Grid)
  905.         )
  906.     ),
  907.     handle_grid_events(xGetEvent(W,eventmask => button_mask),
  908.                      W,Grid).
  909.  
  910.  
  911. handle_grid_events(leave_event,W,Grid) -> true |
  912.     cond( enabled and Grid.active,
  913.             (
  914.         enabled <<- false,
  915.         change_look(Grid)
  916.         )
  917.      ),
  918.     handle_grid_events(xGetEvent(W,eventmask => button_mask),
  919.                      W,Grid).
  920.  
  921. handle_grid_events(expose_event,BW,Grid) -> true |
  922.         xRefreshWindow(BW),
  923.     handle_grid_events(xGetEvent(BW,eventmask =>  button_mask),
  924.                  BW,Grid).
  925.  
  926. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  927. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  928. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  929.  
  930. create_subwindow(D,
  931.              X0,Y0,Width,Height,
  932.          SubWindow,
  933.          parent => PW:window,
  934.          color => C,
  935.          eventmask => M
  936.             ) -> true |
  937.     xCreateWindow(D,
  938.                   X0,Y0,Width,Height,
  939.               SubWindow,
  940.               parent => PW,
  941.               borderwidth => 0,
  942.               color => C,
  943.               eventmask => M).
  944.  
  945. C:writeln :- write&strip(C), nl.
  946.  
  947. check_button_to_release(X) :-
  948.     cond( C:clicked_in,
  949.         implies(release(find_button(C.1,find_panel(X))))
  950.     ).
  951.  
  952. find_panel(X:@(mother => M)) -> cond( M :== no_mother,
  953.                                 X,
  954.                     find_panel(M)
  955.                 ).
  956.  
  957. find_button(Id,X) -> cond( has_feature(daughters,X,D),
  958.                      cond(has_feature(Id,D,Button),
  959.                  Button,
  960.                  find_in_daughters(features(D),Id,D)
  961.              ),
  962.              {}
  963.              ).
  964.                  
  965. find_in_daughters([A|B],Id,D) -> Button |
  966.         (
  967.         Button = find_button(Id,D.A),!
  968.     ;
  969.         Button = find_in_daughters(B,Id,D)
  970.     ).
  971.  
  972. find_in_daughters([]) -> {}.
  973.