diff --git a/TODO.FACTOR.txt b/TODO.FACTOR.txt index 23484ca014..7474924472 100644 --- a/TODO.FACTOR.txt +++ b/TODO.FACTOR.txt @@ -16,6 +16,7 @@ + ui: +- shift modifier not delivered - x11 copy to clipboard - finish gui stepper - windows are not updated while resizing diff --git a/library/ui/cocoa/application-utils.factor b/library/ui/cocoa/application-utils.factor index 24d971e8b5..efed2c78fa 100644 --- a/library/ui/cocoa/application-utils.factor +++ b/library/ui/cocoa/application-utils.factor @@ -35,7 +35,7 @@ objc-classes sequences threads ; dup do-event [ do-events ] [ drop ] if ; : event-loop ( -- ) - [ NSApp do-events ui-step ] with-autorelease-pool + [ [ NSApp do-events ui-step ] ui-try ] with-autorelease-pool event-loop ; : add-observer ( observer selector name object -- ) diff --git a/library/ui/cocoa/view-utils.factor b/library/ui/cocoa/view-utils.factor index bbb18da0b1..57a84f3471 100644 --- a/library/ui/cocoa/view-utils.factor +++ b/library/ui/cocoa/view-utils.factor @@ -99,79 +99,83 @@ opengl sequences ; } { "mouseEntered:" "void" { "id" "SEL" "id" } - [ nip send-mouse-moved ] + [ [ nip send-mouse-moved ] ui-try ] } { "mouseExited:" "void" { "id" "SEL" "id" } - [ 3drop forget-rollover ] + [ [ 3drop forget-rollover ] ui-try ] } { "mouseMoved:" "void" { "id" "SEL" "id" } - [ nip send-mouse-moved ] + [ [ nip send-mouse-moved ] ui-try ] } { "mouseDragged:" "void" { "id" "SEL" "id" } - [ nip send-mouse-moved ] + [ [ nip send-mouse-moved ] ui-try ] } { "rightMouseDragged:" "void" { "id" "SEL" "id" } - [ nip send-mouse-moved ] + [ [ nip send-mouse-moved ] ui-try ] } { "otherMouseDragged:" "void" { "id" "SEL" "id" } - [ nip send-mouse-moved ] + [ [ nip send-mouse-moved ] ui-try ] } { "mouseDown:" "void" { "id" "SEL" "id" } - [ nip send-button-down$ ] + [ [ nip send-button-down$ ] ui-try ] } { "mouseUp:" "void" { "id" "SEL" "id" } - [ nip send-button-up$ ] + [ [ nip send-button-up$ ] ui-try ] } { "rightMouseDown:" "void" { "id" "SEL" "id" } - [ nip send-button-down$ ] + [ [ nip send-button-down$ ] ui-try ] } { "rightMouseUp:" "void" { "id" "SEL" "id" } - [ nip send-button-up$ ] + [ [ nip send-button-up$ ] ui-try ] } { "otherMouseDown:" "void" { "id" "SEL" "id" } - [ nip send-button-down$ ] + [ [ nip send-button-down$ ] ui-try ] } { "otherMouseUp:" "void" { "id" "SEL" "id" } - [ nip send-button-up$ ] + [ [ nip send-button-up$ ] ui-try ] } { "scrollWheel:" "void" { "id" "SEL" "id" } - [ nip send-wheel$ ] + [ [ nip send-wheel$ ] ui-try ] } { "keyDown:" "void" { "id" "SEL" "id" } - [ nip send-key-down-event ] + [ [ nip send-key-down-event ] ui-try ] } { "keyUp:" "void" { "id" "SEL" "id" } - [ nip send-key-up-event ] + [ [ nip send-key-up-event ] ui-try ] } { "cut:" "id" { "id" "SEL" "id" } - [ nip T{ cut-action } send-action ] + [ [ nip T{ cut-action } send-action ] ui-try ] } { "copy:" "id" { "id" "SEL" "id" } - [ nip T{ copy-action } send-action ] + [ [ nip T{ copy-action } send-action ] ui-try ] } { "paste:" "id" { "id" "SEL" "id" } - [ nip T{ paste-action } send-action ] + [ [ nip T{ paste-action } send-action ] ui-try ] } { "updateFactorGadgetSize:" "void" { "id" "SEL" "id" } - [ 2drop dup view-dim swap window set-gadget-dim ] + [ + [ + 2drop dup view-dim swap window set-gadget-dim + ] ui-try + ] } { "acceptsFirstResponder" "bool" { "id" "SEL" } diff --git a/library/ui/paint.factor b/library/ui/paint.factor index f7dc66b991..79279ced75 100644 --- a/library/ui/paint.factor +++ b/library/ui/paint.factor @@ -72,14 +72,34 @@ DEFER: draw-gadget { [ t ] [ [ (draw-gadget) ] with-clipping ] } } cond ; +: (draw-world) ( world -- ) + dup world-handle [ + dup rect-dim init-gl draw-gadget + ] with-gl-context ; + +TUPLE: world-error world ; + +C: world-error ( error world -- error ) + [ set-world-error-world ] keep + [ set-delegate ] keep ; + +M: world-error error. ( world-error -- ) + "An error occurred while drawing the world " write + dup world-error-world pprint-short "." print + "This world has been deactivated to prevent cascading errors." print + delegate error. ; + : draw-world ( world -- ) - [ - dup world-handle [ - dup rect-dim init-gl - dup world set - draw-gadget - ] with-gl-context - ] with-scope ; + dup world-active? [ + [ + dup world set [ + dup (draw-world) + ] [ + over error-window + f over set-world-active? + ] recover + ] with-scope + ] when drop ; ! Pen paint properties M: f draw-interior 2drop ; diff --git a/library/ui/ui.factor b/library/ui/ui.factor index 8b35ca762f..165e1f0c57 100644 --- a/library/ui/ui.factor +++ b/library/ui/ui.factor @@ -1,9 +1,10 @@ ! Copyright (C) 2006 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. IN: gadgets -USING: arrays gadgets gadgets-frames gadgets-grids -gadgets-labels gadgets-theme gadgets-viewports hashtables kernel -math models namespaces queues sequences threads ; +USING: arrays errors gadgets gadgets-frames gadgets-grids +gadgets-labels gadgets-panes gadgets-theme gadgets-viewports +hashtables kernel math models namespaces queues sequences +threads ; ! Assoc mapping aliens to gadgets SYMBOL: windows @@ -137,6 +138,12 @@ C: titled-gadget ( gadget title -- ) : make-toolbar ( quot -- gadget ) { } make make-shelf dup highlight-theme ; inline +: error-window ( error -- ) + [ print-error ] make-pane "Error" open-titled-window ; + +: ui-try ( quot -- ) + [ error-window ] recover ; + IN: shells DEFER: ui diff --git a/library/ui/world.factor b/library/ui/world.factor index 2b4ed7d42d..8c5a95bf70 100644 --- a/library/ui/world.factor +++ b/library/ui/world.factor @@ -14,7 +14,13 @@ kernel math models namespaces opengl sequences ; ! we don't store this in the world's rect-loc, since the ! co-ordinate system might be different, and generally the ! UI code assumes that everything starts at { 0 0 }. -TUPLE: world gadget title status focus focused? fonts handle loc ; +TUPLE: world +active? +gadget +title status +focus focused? +fonts handle +loc ; : free-fonts ( world -- ) dup world-handle select-gl-context @@ -27,6 +33,7 @@ C: world ( gadget -- world ) [ >r dup gadget-title r> set-world-title ] keep { { f set-world-gadget f @center } } make-frame* t over set-gadget-root? + t over set-world-active? H{ } clone over set-world-fonts { 0 0 } over set-world-loc dup world-gadget request-focus ; diff --git a/library/ui/x11/events.factor b/library/ui/x11/events.factor index ad44e02e44..e16e3c1c0f 100644 --- a/library/ui/x11/events.factor +++ b/library/ui/x11/events.factor @@ -70,11 +70,9 @@ GENERIC: client-event ( event window -- ) { [ t ] [ 3drop ] } } cond ; -: event-loop ( -- ) - windows get empty? [ - wait-event dup XAnyEvent-window window dup - [ handle-event ] [ 2drop ] if event-loop - ] unless ; +: do-events ( -- ) + wait-event dup XAnyEvent-window window dup + [ handle-event ] [ 2drop ] if ; : char-array>string ( n -- string ) swap >string [ swap char-nth ] map-with ; diff --git a/library/ui/x11/ui.factor b/library/ui/x11/ui.factor index ca154a3586..c0c7864d40 100644 --- a/library/ui/x11/ui.factor +++ b/library/ui/x11/ui.factor @@ -126,6 +126,11 @@ M: world client-event ( event world -- ) [ register-window ] keep r> 2array ] keep set-world-handle ; +: event-loop ( -- ) + windows get empty? [ + [ do-events ] ui-try event-loop + ] unless ; + IN: gadgets : set-title ( string world -- )