Fixes #32 - double clicks were not handled properly in ui.backend.gtk
							parent
							
								
									a67a59d5a1
								
							
						
					
					
						commit
						1f4da36b4b
					
				| 
						 | 
					@ -160,9 +160,6 @@ CONSTANT: action-key-codes
 | 
				
			||||||
        { $ GDK_SCROLL_RIGHT { 1 0 } }
 | 
					        { $ GDK_SCROLL_RIGHT { 1 0 } }
 | 
				
			||||||
    } at ;
 | 
					    } at ;
 | 
				
			||||||
 | 
					
 | 
				
			||||||
: mouse-event>gesture ( event -- modifiers button loc )
 | 
					 | 
				
			||||||
    [ event-modifiers ] [ button>> ] [ event-loc ] tri ;
 | 
					 | 
				
			||||||
 | 
					 | 
				
			||||||
: on-motion ( win event user-data -- ? )
 | 
					: on-motion ( win event user-data -- ? )
 | 
				
			||||||
    drop swap
 | 
					    drop swap
 | 
				
			||||||
    [ event-loc ] dip window
 | 
					    [ event-loc ] dip window
 | 
				
			||||||
| 
						 | 
					@ -173,23 +170,33 @@ CONSTANT: action-key-codes
 | 
				
			||||||
 | 
					
 | 
				
			||||||
:: on-button-press ( win event user-data -- ? )
 | 
					:: on-button-press ( win event user-data -- ? )
 | 
				
			||||||
    win window :> world
 | 
					    win window :> world
 | 
				
			||||||
    event mouse-event>gesture :> ( modifiers button loc )
 | 
					    event type>> GDK_BUTTON_PRESS = [
 | 
				
			||||||
    button {
 | 
					        event button>> {
 | 
				
			||||||
        { 8 [ ] }
 | 
					            { 8 [ ] }
 | 
				
			||||||
        { 9 [ ] }
 | 
					            { 9 [ ] }
 | 
				
			||||||
        [ modifiers swap <button-down> loc world
 | 
					            [
 | 
				
			||||||
          send-button-down ]
 | 
					                event event-modifiers swap <button-down>
 | 
				
			||||||
    } case t ;
 | 
					                event event-loc
 | 
				
			||||||
 | 
					                world
 | 
				
			||||||
 | 
					                send-button-down
 | 
				
			||||||
 | 
					            ]
 | 
				
			||||||
 | 
					        } case
 | 
				
			||||||
 | 
					    ] when t ;
 | 
				
			||||||
 | 
					
 | 
				
			||||||
:: on-button-release ( win event user-data -- ? )
 | 
					:: on-button-release ( win event user-data -- ? )
 | 
				
			||||||
    win window :> world
 | 
					    win window :> world
 | 
				
			||||||
    event mouse-event>gesture :> ( modifiers button loc )
 | 
					    event type>> GDK_BUTTON_RELEASE = [
 | 
				
			||||||
    button {
 | 
					        event button>> {
 | 
				
			||||||
        { 8 [ world left-action send-action ] }
 | 
					            { 8 [ world left-action send-action ] }
 | 
				
			||||||
        { 9 [ world right-action send-action ] }
 | 
					            { 9 [ world right-action send-action ] }
 | 
				
			||||||
        [ modifiers swap <button-up> loc world
 | 
					            [
 | 
				
			||||||
          send-button-up ]
 | 
					                event event-modifiers swap <button-up>
 | 
				
			||||||
    } case t ;
 | 
					                event event-loc
 | 
				
			||||||
 | 
					                world
 | 
				
			||||||
 | 
					                send-button-up
 | 
				
			||||||
 | 
					            ]
 | 
				
			||||||
 | 
					        } case
 | 
				
			||||||
 | 
					    ] when t ;
 | 
				
			||||||
 | 
					
 | 
				
			||||||
: on-scroll ( win event user-data -- ? )
 | 
					: on-scroll ( win event user-data -- ? )
 | 
				
			||||||
    drop swap [
 | 
					    drop swap [
 | 
				
			||||||
| 
						 | 
					@ -202,7 +209,7 @@ CONSTANT: action-key-codes
 | 
				
			||||||
 | 
					
 | 
				
			||||||
: key-event>gesture ( event -- mods sym/f action? )
 | 
					: key-event>gesture ( event -- mods sym/f action? )
 | 
				
			||||||
    [ event-modifiers ] [ key-sym ] bi ;
 | 
					    [ event-modifiers ] [ key-sym ] bi ;
 | 
				
			||||||
  
 | 
					
 | 
				
			||||||
: on-key-press ( win event user-data -- ? )
 | 
					: on-key-press ( win event user-data -- ? )
 | 
				
			||||||
    drop swap [ key-event>gesture <key-down> ] [ window ] bi*
 | 
					    drop swap [ key-event>gesture <key-down> ] [ window ] bi*
 | 
				
			||||||
    propagate-key-gesture t ;
 | 
					    propagate-key-gesture t ;
 | 
				
			||||||
| 
						 | 
					@ -318,7 +325,7 @@ CONSTANT: action-key-codes
 | 
				
			||||||
:: configure-im ( win im -- )
 | 
					:: configure-im ( win im -- )
 | 
				
			||||||
    im win gtk_widget_get_window gtk_im_context_set_client_window
 | 
					    im win gtk_widget_get_window gtk_im_context_set_client_window
 | 
				
			||||||
    im f gtk_im_context_set_use_preedit
 | 
					    im f gtk_im_context_set_use_preedit
 | 
				
			||||||
    
 | 
					
 | 
				
			||||||
    im "commit" [ on-commit yield ]
 | 
					    im "commit" [ on-commit yield ]
 | 
				
			||||||
    GtkIMContext:commit win connect-signal-with-data
 | 
					    GtkIMContext:commit win connect-signal-with-data
 | 
				
			||||||
    im "retrieve-surrounding" [ on-retrieve-surrounding yield ]
 | 
					    im "retrieve-surrounding" [ on-retrieve-surrounding yield ]
 | 
				
			||||||
| 
						 | 
					@ -349,7 +356,7 @@ CONSTANT: window-controls>decor-flags
 | 
				
			||||||
        { normal-title-bar $ GDK_DECOR_TITLE }
 | 
					        { normal-title-bar $ GDK_DECOR_TITLE }
 | 
				
			||||||
        { textured-background 0 }
 | 
					        { textured-background 0 }
 | 
				
			||||||
    }
 | 
					    }
 | 
				
			||||||
    
 | 
					
 | 
				
			||||||
CONSTANT: window-controls>func-flags
 | 
					CONSTANT: window-controls>func-flags
 | 
				
			||||||
    H{
 | 
					    H{
 | 
				
			||||||
        { close-button $ GDK_FUNC_CLOSE }
 | 
					        { close-button $ GDK_FUNC_CLOSE }
 | 
				
			||||||
| 
						 | 
					@ -444,18 +451,18 @@ M:: gtk-ui-backend (open-window) ( world -- )
 | 
				
			||||||
    win im <window-handle> world handle<<
 | 
					    win im <window-handle> world handle<<
 | 
				
			||||||
 | 
					
 | 
				
			||||||
    world win register-window
 | 
					    world win register-window
 | 
				
			||||||
    
 | 
					
 | 
				
			||||||
    win world [ window-loc>> auto-position ]
 | 
					    win world [ window-loc>> auto-position ]
 | 
				
			||||||
    [ dim>> first2 gtk_window_set_default_size ] 2bi
 | 
					    [ dim>> first2 gtk_window_set_default_size ] 2bi
 | 
				
			||||||
 | 
					
 | 
				
			||||||
    win "factor" "Factor" [ utf8 string>alien ] bi@
 | 
					    win "factor" "Factor" [ utf8 string>alien ] bi@
 | 
				
			||||||
    gtk_window_set_wmclass
 | 
					    gtk_window_set_wmclass
 | 
				
			||||||
    
 | 
					
 | 
				
			||||||
    world configure-gl
 | 
					    world configure-gl
 | 
				
			||||||
 | 
					
 | 
				
			||||||
    win gtk_widget_realize
 | 
					    win gtk_widget_realize
 | 
				
			||||||
    win world window-controls>> configure-window-controls
 | 
					    win world window-controls>> configure-window-controls
 | 
				
			||||||
    
 | 
					
 | 
				
			||||||
    win im configure-im
 | 
					    win im configure-im
 | 
				
			||||||
    win connect-user-input-signals
 | 
					    win connect-user-input-signals
 | 
				
			||||||
    win connect-win-state-signals
 | 
					    win connect-win-state-signals
 | 
				
			||||||
| 
						 | 
					@ -478,7 +485,7 @@ M: gtk-ui-backend (set-fullscreen)
 | 
				
			||||||
 | 
					
 | 
				
			||||||
M: gtk-ui-backend (fullscreen?)
 | 
					M: gtk-ui-backend (fullscreen?)
 | 
				
			||||||
    handle>> fullscreen?>> ;
 | 
					    handle>> fullscreen?>> ;
 | 
				
			||||||
    
 | 
					
 | 
				
			||||||
M: gtk-ui-backend raise-window*
 | 
					M: gtk-ui-backend raise-window*
 | 
				
			||||||
    handle>> window>> gtk_window_present ;
 | 
					    handle>> window>> gtk_window_present ;
 | 
				
			||||||
 | 
					
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
		Loading…
	
		Reference in New Issue