fix bootstrap errors

cvs
Slava Pestov 2005-03-02 03:19:26 +00:00
parent c918f60671
commit 779db3970d
5 changed files with 32 additions and 24 deletions

View File

@ -6,6 +6,8 @@
+ ui: + ui:
- inspector: complain if UI not running
- opening listeners fails
- menu dragging - menu dragging
- hide menu after item selected - hide menu after item selected
- scrollable inspector - scrollable inspector
@ -55,6 +57,7 @@
+ kernel: + kernel:
- hash-size regression
- vectors: ensure its ok with bignum indices - vectors: ensure its ok with bignum indices
- cat, reverse-cat primitives - cat, reverse-cat primitives
- code gc - code gc

View File

@ -173,8 +173,8 @@ cpu "x86" = "mini" get not and [
"/library/ui/gestures.factor" "/library/ui/gestures.factor"
"/library/ui/hand.factor" "/library/ui/hand.factor"
"/library/ui/layouts.factor" "/library/ui/layouts.factor"
"/library/ui/halo.factor"
"/library/ui/world.factor" "/library/ui/world.factor"
"/library/ui/halo.factor"
"/library/ui/labels.factor" "/library/ui/labels.factor"
"/library/ui/buttons.factor" "/library/ui/buttons.factor"
"/library/ui/line-editor.factor" "/library/ui/line-editor.factor"
@ -182,9 +182,11 @@ cpu "x86" = "mini" get not and [
"/library/ui/dialogs.factor" "/library/ui/dialogs.factor"
"/library/ui/events.factor" "/library/ui/events.factor"
"/library/ui/scrolling.factor" "/library/ui/scrolling.factor"
"/library/ui/menus.factor"
"/library/ui/presentations.factor" "/library/ui/presentations.factor"
"/library/ui/panes.factor" "/library/ui/panes.factor"
"/library/ui/inspector.factor" "/library/ui/inspector.factor"
"/library/ui/root-menu.factor"
] [ ] [
dup print dup print
run-resource run-resource

View File

@ -147,6 +147,13 @@ SYMBOL: clip
: intersect ( rect rect -- rect ) : intersect ( rect rect -- rect )
[ intersect-x ] 2keep intersect-y clip-rect ; [ intersect-x ] 2keep intersect-y clip-rect ;
: >sdl-rect ( rectangle -- sdlrect )
[ rectangle-x ] keep
[ rectangle-y ] keep
[ rectangle-w ] keep
rectangle-h
make-rect ;
: set-clip ( rect -- ? ) : set-clip ( rect -- ? )
#! The top/left corner of the clip rectangle is the location #! The top/left corner of the clip rectangle is the location
#! of the gadget on the screen. The bottom/right is the #! of the gadget on the screen. The bottom/right is the
@ -170,13 +177,6 @@ M: object shape-clip
call call
] with-scope ; inline ] with-scope ; inline
: >sdl-rect ( rectangle -- sdlrect )
[ rectangle-x ] keep
[ rectangle-y ] keep
[ rectangle-w ] keep
rectangle-h
make-rect ;
: draw-gadget ( gadget -- ) : draw-gadget ( gadget -- )
#! All drawing done inside draw-shape is done with the #! All drawing done inside draw-shape is done with the
#! gadget's paint. If the gadget does not have any custom #! gadget's paint. If the gadget does not have any custom

View File

@ -0,0 +1,18 @@
! Copyright (C) 2005 Slava Pestov.
! See http://factor.sf.net/license.txt for BSD license.
IN: gadgets
USING: kernel memory namespaces ;
SYMBOL: root-menu
: show-root-menu ( -- )
root-menu get <menu> show-menu ;
[
[[ "Listener" [ <console-pane> <scroller> world get add-gadget ] ]]
[[ "Globals" [ global inspect ] ]]
[[ "Save image" [ "image" get save-image ] ]]
[[ "Exit" [ f world get set-world-running? ] ]]
] root-menu set
world get [ drop show-root-menu ] [ button-down 1 ] set-action

View File

@ -56,18 +56,7 @@ DEFER: handle-event
drop world get world-step [ yield run-world ] when drop world get world-step [ yield run-world ] when
] ifte ; ] ifte ;
SYMBOL: root-menu
: show-root-menu ( -- )
root-menu get <menu> show-menu ;
global [ global [
[
[[ "Listener" [ <console-pane> <scroller> world get add-gadget ] ]]
[[ "Globals" [ global inspect ] ]]
[[ "Save image" [ "image" get save-image ] ]]
[[ "Exit" [ f world get set-world-running? ] ]]
] root-menu set
<world> world set <world> world set
@ -77,13 +66,9 @@ global [
[[ background [ 255 255 255 ] ]] [[ background [ 255 255 255 ] ]]
[[ foreground [ 0 0 0 ] ]] [[ foreground [ 0 0 0 ] ]]
[[ bevel-1 [ 224 224 255 ] ]]
[[ bevel-2 [ 192 192 216 ] ]]
[[ reverse-video f ]] [[ reverse-video f ]]
[[ font [[ "Sans Serif" 12 ]] ]] [[ font [[ "Sans Serif" 12 ]] ]]
}} world get set-gadget-paint }} world get set-gadget-paint
world get [ drop show-root-menu ] [ button-down 1 ] set-action
] bind ] bind
: title ( -- str ) : title ( -- str )