diff --git a/library/cocoa/ui.factor b/library/cocoa/ui.factor index 914b23807f..94e5b10c7e 100644 --- a/library/cocoa/ui.factor +++ b/library/cocoa/ui.factor @@ -69,13 +69,22 @@ H{ } clone views set-global dup [keyCode] key-codes hash [ ] [ [charactersIgnoringModifiers] CF>string ] ?if ; -: event>gesture ( event -- gesture ) - dup [modifierFlags] modifiers modifier swap key-code - ; +: event>gesture ( event -- modifiers keycode ) + dup [modifierFlags] modifiers modifier swap key-code ; -: send-key-event ( view event -- ) - >r view world-focus r> dup event>gesture pick handle-gesture - [ [characters] CF>string swap user-input ] [ 2drop ] if ; +: send-key-event ( view event quot -- ) + >r event>gesture r> call swap view world-focus + handle-gesture ; inline + +: send-user-input ( view event -- ) + [characters] CF>string swap view world-focus user-input ; + +: send-key-down-event ( view event -- ) + 2dup [ ] send-key-event + [ send-user-input ] [ 2drop ] if ; + +: send-key-up-event ( view event -- ) + [ ] send-key-event ; : send-button-down$ ( view event -- ) over >r button&loc r> view send-button-down ; @@ -136,7 +145,11 @@ H{ } clone views set-global } { "keyDown:" "void" { "id" "SEL" "id" } - [ nip send-key-event ] + [ nip send-key-down-event ] + } + + { "keyUp:" "void" { "id" "SEL" "id" } + [ nip send-key-up-event ] } { "updateFactorGadgetSize:" "void" { "id" "SEL" "id" } diff --git a/library/ui/paint.factor b/library/ui/paint.factor index 80063bca1d..9a116ff9f7 100644 --- a/library/ui/paint.factor +++ b/library/ui/paint.factor @@ -8,7 +8,6 @@ IN: gadgets SYMBOL: clip : init-gl ( dim -- ) - { 1.0 0.0 0.0 1.0 } gl-color GL_PROJECTION glMatrixMode glLoadIdentity GL_MODELVIEW glMatrixMode @@ -21,7 +20,6 @@ SYMBOL: clip GL_BLEND glEnable GL_SRC_ALPHA GL_ONE_MINUS_SRC_ALPHA glBlendFunc GL_SCISSOR_TEST glEnable - GL_MODELVIEW glMatrixMode 1.0 1.0 1.0 1.0 glClearColor GL_COLOR_BUFFER_BIT glClear ; diff --git a/library/ui/world.factor b/library/ui/world.factor index 72d54f79cd..26654db4e5 100644 --- a/library/ui/world.factor +++ b/library/ui/world.factor @@ -30,13 +30,7 @@ C: world ( gadget status -- world ) H{ } clone over set-world-fonts dup world-gadget request-focus ; -GENERIC: find-world ( gadget -- world ) - -M: f find-world ; - -M: gadget find-world gadget-parent find-world ; - -M: world find-world ; +: find-world [ world? ] find-parent ; M: world pref-dim* ( world -- dim ) delegate pref-dim* { 1024 768 0 } vmin ;