diff --git a/library/ui/paint.factor b/library/ui/paint.factor index 79279ced75..f4e86020cd 100644 --- a/library/ui/paint.factor +++ b/library/ui/paint.factor @@ -1,8 +1,8 @@ ! Copyright (C) 2005, 2006 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: alien arrays freetype generic hashtables -io kernel math namespaces opengl sequences strings -styles vectors ; +USING: alien arrays freetype generic hashtables io kernel +math namespaces opengl sequences strings styles +vectors ; IN: gadgets SYMBOL: clip @@ -77,30 +77,6 @@ DEFER: draw-gadget 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-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 ; M: f draw-boundary 2drop ; diff --git a/library/ui/ui.factor b/library/ui/ui.factor index 165e1f0c57..a54dd93241 100644 --- a/library/ui/ui.factor +++ b/library/ui/ui.factor @@ -3,8 +3,8 @@ IN: gadgets USING: arrays errors gadgets gadgets-frames gadgets-grids gadgets-labels gadgets-panes gadgets-theme gadgets-viewports -hashtables kernel math models namespaces queues sequences -threads ; +generic hashtables io kernel math models namespaces prettyprint +queues sequences threads ; ! Assoc mapping aliens to gadgets SYMBOL: windows @@ -144,6 +144,30 @@ C: titled-gadget ( gadget title -- ) : ui-try ( quot -- ) [ error-window ] recover ; +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-active? [ + [ + dup world set [ + dup (draw-world) + ] [ + over error-window + f over set-world-active? + ] recover + ] with-scope + ] when drop ; + IN: shells DEFER: ui