steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Bootstrap fix for draw-world error handling

slava 2006-07-19 06:28:13 +00:00
parent 9a7b1402b2
commit ceb0313028
2 changed files with 29 additions and 29 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

30
library/ui/paint.factor
View File

@ -1,8 +1,8 @@
! Copyright (C) 2005, 2006 Slava Pestov. ! Copyright (C) 2005, 2006 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: alien arrays freetype generic hashtables USING: alien arrays freetype generic hashtables io kernel
io kernel math namespaces opengl sequences strings math namespaces opengl sequences strings styles
styles vectors ; vectors ;
IN: gadgets IN: gadgets
SYMBOL: clip SYMBOL: clip
@ -77,30 +77,6 @@ DEFER: draw-gadget
dup rect-dim init-gl draw-gadget dup rect-dim init-gl draw-gadget
] with-gl-context ; ] 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 <world-error> error-window
f over set-world-active?
] recover
] with-scope
] when drop ;
! Pen paint properties ! Pen paint properties
M: f draw-interior 2drop ; M: f draw-interior 2drop ;
M: f draw-boundary 2drop ; M: f draw-boundary 2drop ;

28
library/ui/ui.factor
View File

@ -3,8 +3,8 @@
IN: gadgets IN: gadgets
USING: arrays errors gadgets gadgets-frames gadgets-grids USING: arrays errors gadgets gadgets-frames gadgets-grids
gadgets-labels gadgets-panes gadgets-theme gadgets-viewports gadgets-labels gadgets-panes gadgets-theme gadgets-viewports
hashtables kernel math models namespaces queues sequences generic hashtables io kernel math models namespaces prettyprint
threads ; queues sequences threads ;
! Assoc mapping aliens to gadgets ! Assoc mapping aliens to gadgets
SYMBOL: windows SYMBOL: windows
@ -144,6 +144,30 @@ C: titled-gadget ( gadget title -- )
: ui-try ( quot -- ) : ui-try ( quot -- )
[ error-window ] recover ; [ 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 <world-error> error-window
f over set-world-active?
] recover
] with-scope
] when drop ;
IN: shells IN: shells
DEFER: ui DEFER: ui