factor/library/ui/world.factor

60 lines
1.5 KiB
Factor
Raw Normal View History

2005-01-31 22:32:06 -05:00
! Copyright (C) 2005 Slava Pestov.
! See http://factor.sf.net/license.txt for BSD license.
IN: gadgets
2005-03-02 21:26:11 -05:00
USING: alien errors generic kernel lists math memory namespaces
2005-04-30 17:17:10 -04:00
prettyprint sdl sequences stdio strings threads ;
2005-02-01 19:00:16 -05:00
2005-01-31 22:32:06 -05:00
! The world gadget is the top level gadget that all (visible)
! gadgets are contained in. The current world is stored in the
2005-03-01 22:11:08 -05:00
! world variable. The menu slot ensures that only one menu is
! open at any one time.
TUPLE: world running? hand menu ;
2005-02-01 19:00:16 -05:00
2005-01-31 22:32:06 -05:00
: <world-box> ( -- box )
0 0 0 0 <plain-rect> <gadget> ;
2005-01-31 22:32:06 -05:00
C: world ( -- world )
<world-box> over set-delegate
2005-01-31 22:32:06 -05:00
t over set-world-running?
2005-03-06 19:46:29 -05:00
dup <hand> over set-world-hand ;
2005-01-31 22:32:06 -05:00
M: world inside? ( point world -- ? ) 2drop t ;
2005-03-03 20:43:55 -05:00
: hand world get world-hand ;
2005-01-31 22:32:06 -05:00
2005-02-19 17:54:04 -05:00
: draw-world ( world -- )
dup gadget-redraw? [
2005-04-30 17:17:10 -04:00
[ draw-gadget ] with-surface
2005-02-01 19:00:16 -05:00
] [
drop
] ifte ;
2005-02-01 21:47:10 -05:00
DEFER: handle-event
2005-03-03 20:43:55 -05:00
2005-03-01 00:45:50 -05:00
: layout-world ( world -- )
dup
2005-03-06 19:46:29 -05:00
0 0 width get height get <rectangle> clip set-paint-prop
2005-04-30 17:17:10 -04:00
layout ;
2005-02-02 19:50:13 -05:00
2005-02-19 17:54:04 -05:00
: world-step ( world -- ? )
dup world-running? [
dup layout-world draw-world t
] [
drop f
] ifte ;
2005-03-01 18:55:25 -05:00
: run-world ( -- )
#! Keep polling for events until there are no more events in
#! the queue; then block for the next event.
2005-03-01 18:55:25 -05:00
<event> dup SDL_PollEvent [
[ handle-event ] in-thread drop run-world
] [
2005-03-01 18:55:25 -05:00
drop world get world-step [ yield run-world ] when
2005-02-19 21:49:37 -05:00
] ifte ;
2005-01-31 22:32:06 -05:00
2005-03-02 21:26:11 -05:00
: ensure-ui ( -- )
#! Raise an error if the UI is not running.
world get dup [ world-running? ] when [
2005-03-06 19:46:29 -05:00
"UI not running." throw
2005-03-02 21:26:11 -05:00
] unless ;