M: track layout* ( track -- ) dup track-layout pack-layout ;
: track-pref-dims-1 ( track -- dim )
- children>> pref-dims max-dim ;
+ [ children>> pref-dims max-dim ]
+ [ pref-dim>> { 0 0 } or ] bi vmax ;
: track-pref-dims-2 ( track -- dim )
[
status
gadgets
{ pixel-format-attributes initial: $ default-world-pixel-format-attributes }
- { window-controls initial: $ default-world-window-controls } ;
+ { window-controls initial: $ default-world-window-controls }
+ pref-dim ;
: <world-attributes> ( -- world-attributes )
world-attributes new ; inline
[ window-controls>> >>window-controls ]
[ initial-background-color >>background-color ]
[ grab-input?>> >>grab-input? ]
- [ gadgets>> [ 1 track-add ] each ]
+ [ gadgets>> dup sequence? [ [ 1 track-add ] each ] [ 1 track-add ] if ]
+ [ pref-dim>> >>pref-dim ]
} cleave ;
: <world> ( world-attributes -- world )
namespaces ui.backend ui.gadgets ui.gadgets.worlds
ui.gadgets.tracks ui.gadgets.packs ui.gadgets.grids
ui.gadgets.private math.rectangles colors ui.text fonts
-kernel ui.private classes sequences ;
+kernel ui.private vocabs.loader classes sequences ;
IN: ui
HELP: windows
"When the gadget is removed from a parent shown in a top-level window, or when the top-level window is closed, a corresponding generic word is called to clean up:"
{ $subsections ungraft* }
"The root of the gadget hierarchy in a window is a special gadget which is rarely operated on directly, but it is helpful to know it exists:"
-{ $subsections world } ;
+{ $subsections world }
+"There is also syntax for defining a main window as the entry point for a vocabulary:"
+{ $subsections POSTPONE: MAIN-WINDOW: } ;
ARTICLE: "ui-backend" "Developing UI backends"
"None of the words documented in this section should be called directly by user code. They are only of interest when developing new UI backends."
HELP: textured-background
{ $description "Asks for a window to have a background that blends seamlessly with the window frame. Factor will leave the window background transparent and pass mouse button gestures not handled directly by a gadget through to the window system so that the window can be dragged from anywhere on its background." } ;
+HELP: MAIN-WINDOW:
+{ $syntax "MAIN-WINDOW: window-word { attributes }
+ attribute-code ;" }
+{ $description "Defines a " { $link POSTPONE: MAIN: } " word for the current vocabulary named " { $snippet "window-word" } " that opens a UI window when the vocabulary is " { $link run } ". The " { $snippet "attributes" } " specify the key-value pairs of the window's " { $link world-attributes } ". The " { $snippet "attribute-code" } " is run with the " { $snippet "world-attributes" } " on the stack; this allows the word to construct gadget objects to place in the " { $snippet "gadget" } " slot or set other runtime-dependent world attributes." }
+{ $examples
+"From the " { $vocab-link "hello-ui" } " vocabulary. Creates a window with the title \"Hi\" containing a label reading \"Hello world\":"
+{ $code
+"""USING: accessors ui ui.gadgets.labels ;
+IN: hello-ui
+
+MAIN-WINDOW: hello { { title "Hi" } }
+ "Hello world" <label> >>gadgets ;"""
+} } ;
+
ARTICLE: "ui.gadgets.worlds-window-controls" "Window controls"
"The following window controls can be placed in a " { $link world } " window:"
{ $subsections
combinators combinators.short-circuit hashtables concurrency.flags
sets accessors calendar fry destructors ui.gadgets ui.gadgets.private
ui.gadgets.worlds ui.gadgets.tracks ui.gestures ui.backend ui.render
-strings ;
+strings classes.tuple classes.tuple.parser lexer vocabs.parser parser ;
IN: ui
<PRIVATE
ui-running? [ call( -- ) ] [ '[ init-ui @ ] (with-ui) ] if ;
HOOK: beep ui-backend ( -- )
+
+: parse-main-window-attributes ( class -- attributes )
+ "{" expect dup all-slots parse-tuple-literal-slots ;
+
+: define-main-window ( word attributes quot -- )
+ [
+ '[ [ f _ clone @ open-window ] with-ui ] (( -- )) define-declared
+ ] [ 2drop current-vocab (>>main) ] 3bi ;
+
+SYNTAX: MAIN-WINDOW:
+ CREATE
+ world-attributes parse-main-window-attributes
+ parse-definition
+ define-main-window ;
[ geom>> ] [ get-draw ] bi draw-bunny
] if ;
-M: bunny-world pref-dim* ( gadget -- dim )
- drop { 640 480 } ;
-
bunny-world H{
{ T{ key-down f f "TAB" } [ next-draw ] }
} set-gestures
-: bunny-window ( -- )
- [
- f T{ world-attributes
- { world-class bunny-world }
- { title "Bunny" }
- { pixel-format-attributes {
- windowed
- double-buffered
- T{ depth-bits { value 16 } }
- } }
- } open-window
- ] with-ui ;
-
-MAIN: bunny-window
+MAIN-WINDOW: bunny-window {
+ { world-class bunny-world }
+ { title "Bunny" }
+ { pixel-format-attributes {
+ windowed
+ double-buffered
+ T{ depth-bits { value 16 } }
+ } }
+ { pref-dim { 640 480 } }
+ } ;
! Copyright (C) 2006, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: kernel math math.functions math.parser models
+USING: arrays kernel math math.functions math.parser models
models.arrow models.range models.product sequences ui
ui.gadgets ui.gadgets.tracks ui.gadgets.labels ui.gadgets.packs
ui.gadgets.sliders ui.pens.solid ui.render math.rectangles accessors
] bi
] bi* ;
-: color-picker-window ( -- )
- [ <color-picker> "Color Picker" open-window ] with-ui ;
-
-MAIN: color-picker-window
+MAIN-WINDOW: color-picker-window { { title "Color Picker" } }
+ <color-picker> >>gadgets ;
10 >>min-rows
10 >>max-rows ;
-: color-table-demo ( -- )
- [ <color-table> <scroller> "Colors" open-window ] with-ui ;
-
-MAIN: color-table-demo
+MAIN-WINDOW: color-table-demo { { title "Colors" } }
+ <color-table> <scroller> >>gadgets ;
: <demo-runner> ( -- gadget )
<pile> 1 >>fill { 2 2 } >>gap demo-vocabs [ <run-vocab-button> add-gadget ] each ;
-: demos ( -- ) [ <demo-runner> { 2 2 } <border> <scroller> "Demos" open-window ] with-ui ;
-
-MAIN: demos
\ No newline at end of file
+MAIN-WINDOW: demos { { title "Demos" } }
+ <demo-runner> { 2 2 } <border> <scroller> >>gadgets ;
IN: game.loop
TUPLE: game-loop
- { tick-length integer read-only }
+ { tick-interval-micros integer read-only }
delegate
{ last-tick integer }
thread
last-tick>> system-micros swap - ;
: tick-slice ( loop -- slice )
- [ since-last-tick ] [ tick-length>> ] bi /f 1.0 min ;
+ [ since-last-tick ] [ tick-interval-micros>> ] bi /f 1.0 min ;
CONSTANT: MAX-FRAMES-TO-SKIP 5
: increment-tick ( loop -- )
[ 1 + ] change-tick-number
- dup tick-length>> [ + ] curry change-last-tick
+ dup tick-interval-micros>> [ + ] curry change-last-tick
drop ;
: ?tick ( loop count -- )
[ system-micros >>last-tick drop ] [
- over [ since-last-tick ] [ tick-length>> ] bi >=
+ over [ since-last-tick ] [ tick-interval-micros>> ] bi >=
[ [ drop increment-tick ] [ drop tick ] [ 1 - ?tick ] 2tri ]
[ 2drop ] if
] if-zero ;
f >>thread
drop ;
-: <game-loop> ( tick-length delegate -- loop )
+: <game-loop> ( tick-interval-micros delegate -- loop )
system-micros f f 0 0 system-micros 0 0
game-loop boa ;
-USING: accessors game.input game.loop kernel math ui.gadgets
-ui.gadgets.worlds ui.gestures threads ;
+USING: accessors combinators fry game.input game.loop generic kernel math
+parser sequences ui ui.gadgets ui.gadgets.worlds ui.gestures threads
+words ;
IN: game.worlds
TUPLE: game-world < world
game-loop
{ tick-slice float initial: 0.0 } ;
-GENERIC: tick-length ( world -- micros )
+GENERIC: tick-interval-micros ( world -- micros )
M: game-world draw*
swap >>tick-slice relayout-1 yield ;
M: game-world begin-world
open-game-input
- dup [ tick-length ] [ ] bi <game-loop> [ >>game-loop ] keep start-loop
+ dup [ tick-interval-micros ] [ ] bi <game-loop> [ >>game-loop ] keep start-loop
drop ;
M: game-world end-world
close-game-input
drop ;
+TUPLE: game-attributes < world-attributes
+ { tick-interval-micros fixnum read-only } ;
+
+: verify-game-attributes ( attributes -- )
+ world-class>> { f world } member?
+ [ "GAME: must be given a custom world-class" throw ] when ;
+
+: define-game-tick-interval-micros ( attributes -- )
+ [ world-class>> \ tick-interval-micros create-method ]
+ [ tick-interval-micros>> '[ drop _ ] ] bi
+ define ;
+
+: define-game-methods ( attributes -- )
+ {
+ [ verify-game-attributes ]
+ [ define-game-tick-interval-micros ]
+ } cleave ;
+
+: define-game ( word attributes -- )
+ [ [ ] define-main-window ]
+ [ nip define-game-methods ] 2bi ;
+
+SYNTAX: GAME:
+ CREATE
+ game-attributes parse-main-window-attributes
+ define-game ;
math.matrices math.vectors.simd math.parser math.vectors
method-chains namespaces sequences splitting threads ui ui.gadgets
ui.gadgets.worlds ui.pixel-formats specialized-arrays
-specialized-vectors ;
+specialized-vectors literals ;
FROM: alien.c-types => float ;
SPECIALIZED-ARRAY: float
SPECIALIZED-VECTOR: uint
AFTER: bunny-world resize-world
[ sobel>> framebuffer>> ] [ dim>> ] bi resize-framebuffer ;
-M: bunny-world pref-dim* drop { 1024 768 } ;
-M: bunny-world tick-length drop 1000000 60 /i ;
M: bunny-world wasd-movement-speed drop 1/160. ;
M: bunny-world wasd-near-plane drop 1/32. ;
M: bunny-world wasd-far-plane drop 256.0 ;
-: bunny-window ( -- )
- [
- f T{ world-attributes
- { world-class bunny-world }
- { title "Bunny" }
- { pixel-format-attributes {
- windowed
- double-buffered
- T{ depth-bits { value 24 } }
- } }
- { grab-input? t }
- } open-window
- ] with-ui ;
-
-MAIN: bunny-window
+GAME: bunny-game {
+ { world-class bunny-world }
+ { title "Bunny" }
+ { pixel-format-attributes {
+ windowed
+ double-buffered
+ T{ depth-bits { value 24 } }
+ } }
+ { grab-input? t }
+ { pref-dim { 1024 768 } }
+ { tick-interval-micros $[ 1,000,000 60 /i ] }
+ }
{ "vertex-array" [ vertex-array>> ] }
} <render-set> render ;
-M: raytrace-world pref-dim* drop { 1024 768 } ;
-M: raytrace-world tick-length drop 1000000 60 /i ;
M: raytrace-world wasd-movement-speed drop 1/4. ;
-: raytrace-window ( -- )
- [
- f T{ world-attributes
- { world-class raytrace-world }
- { title "Raytracing" }
- { pixel-format-attributes {
- windowed
- double-buffered
- } }
- { grab-input? t }
- } open-window
- ] with-ui ;
-
-MAIN: raytrace-window
+GAME: raytrace-game {
+ { world-class raytrace-world }
+ { title "Raytracing" }
+ { pixel-format-attributes {
+ windowed
+ double-buffered
+ } }
+ { grab-input? t }
+ { pref-dim { 1024 768 } }
+ { tick-interval-micros $[ 1,000,000 60 /i ] }
+ }
-USING: ui ui.gadgets.labels ;
+USING: accessors ui ui.gadgets.labels ;
IN: hello-ui
-: hello ( -- )
- [ "Hello world" <label> "Hi" open-window ] with-ui ;
-
-MAIN: hello
+MAIN-WINDOW: hello { { title "Hi" } }
+ "Hello world" <label> >>gadgets ;
! Copyright (C) 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: ui.gadgets.panes ui.gadgets.borders ui io io.styles ;
+USING: accessors ui.gadgets.panes ui.gadgets.borders ui io io.styles ;
IN: hello-unicode
: <hello-gadget> ( -- gadget )
] with-style
] make-pane { 10 10 } <border> ;
-: hello-unicode ( -- ) [ <hello-gadget> "გამარჯობა" open-window ] with-ui ;
-
-MAIN: hello-unicode
\ No newline at end of file
+MAIN-WINDOW: hello-unicode { { title "გამარჯობა" } }
+ <hello-gadget> >>gadgets ;
{ mouse-scroll [ handle-mouse-scroll ] }
} set-gestures
-: jamshred-window ( -- )
- [ <jamshred> <jamshred-gadget> "Jamshred" open-window ] with-ui ;
-
-MAIN: jamshred-window
+MAIN-WINDOW: jamshred-window { { title "Jamshred" } }
+ <jamshred> <jamshred-gadget> >>gadgets ;
M: key-caps-gadget handle-gesture
drop [ key-down? ] [ key-up? ] bi or not ;
-: key-caps ( -- )
- [
- <key-caps-gadget> { 5 5 } <border> "Key Caps" open-window
- ] with-ui ;
-
-MAIN: key-caps
+MAIN-WINDOW: key-caps { { title "Key Caps" } }
+ <key-caps-gadget> { 5 5 } <border> >>gadgets ;
"99:99:99" lcd >>string
monospace-font >>font ;
-: time-window ( -- )
- [ time get <time-display> "Time" open-window ] with-ui ;
-
-MAIN: time-window
+MAIN-WINDOW: time-window { { title "Time" } }
+ time get <time-display> >>gadgets ;
M: maze pref-dim* drop { 400 400 } ;
-: maze-window ( -- )
- [ <maze> "Maze" open-window ] with-ui ;
+MAIN-WINDOW: maze-window { { title "Maze" } }
+ <maze> >>gadgets ;
MAIN: maze-window
ui.gadgets.tracks ui.gadgets.labels ui.gadgets.glass
math.rectangles cocoa.dialogs ;
IN: merger
-: main ( -- ) [
+
+MAIN-WINDOW: merger-window {
+ { title "Merging" }
+ { pref-dim { 300 220 } }
+ }
vertical <track>
{ "From:" "To:" } f <model> f <model> 2array
[
] with-directory
] keep hide-glass
] [ drop ] if ]
- "merge" swap <border-button> 0.4 track-add { 300 220 } >>pref-dim "Merging" open-window
-] with-ui ;
-
-MAIN: main
\ No newline at end of file
+ "merge" swap <border-button> 0.4 track-add
+ >>gadgets ;
USING: arrays kernel math opengl opengl.gl opengl.glu
-opengl.demo-support ui ui.gadgets ui.render ;
+opengl.demo-support ui ui.gadgets ui.render literals accessors ;
IN: nehe.2
TUPLE: nehe2-gadget < gadget ;
: <nehe2-gadget> ( -- gadget )
nehe2-gadget new ;
-M: nehe2-gadget pref-dim* ( gadget -- dim )
- drop width height 2array ;
-
M: nehe2-gadget draw-gadget* ( gadget -- )
drop
GL_PROJECTION glMatrixMode
-1.0 -1.0 0.0 glVertex3f
] do-state ;
-: run2 ( -- )
- <nehe2-gadget> "NeHe Tutorial 2" open-window ;
+MAIN-WINDOW: run2 { { title "NeHe Tutorial 2" } { pref-dim { $ width $ height } } }
+ <nehe2-gadget> >>gadgets ;
USING: arrays kernel math opengl opengl.gl opengl.glu
-opengl.demo-support ui ui.gadgets ui.render ;
+opengl.demo-support ui ui.gadgets ui.render literals accessors ;
IN: nehe.3
TUPLE: nehe3-gadget < gadget ;
: <nehe3-gadget> ( -- gadget )
nehe3-gadget new ;
-M: nehe3-gadget pref-dim* ( gadget -- dim )
- drop width height 2array ;
-
M: nehe3-gadget draw-gadget* ( gadget -- )
drop
GL_PROJECTION glMatrixMode
-1.0 -1.0 0.0 glVertex3f
] do-state ;
-: run3 ( -- )
- <nehe3-gadget> "NeHe Tutorial 3" open-window ;
+MAIN-WINDOW: run3 { { title "NeHe Tutorial 3" } { pref-dim { $ width $ height } } }
+ <nehe3-gadget> >>gadgets ;
USING: arrays kernel math opengl opengl.gl opengl.glu
opengl.demo-support ui ui.gadgets ui.render threads accessors
-calendar ;
+calendar literals ;
IN: nehe.4
TUPLE: nehe4-gadget < gadget rtri rquad thread quit? ;
0.0 >>rtri
0.0 >>rquad ;
-M: nehe4-gadget pref-dim* ( gadget -- dim )
- drop width height 2array ;
-
M: nehe4-gadget draw-gadget* ( gadget -- )
GL_PROJECTION glMatrixMode
glLoadIdentity
M: nehe4-gadget ungraft* ( gadget -- )
t >>quit? drop ;
-: run4 ( -- )
- <nehe4-gadget> "NeHe Tutorial 4" open-window ;
+MAIN-WINDOW: run4 { { title "NeHe Tutorial 4" } { pref-dim { $ width $ height } } }
+ <nehe4-gadget> >>gadgets ;
USING: arrays kernel math opengl opengl.gl opengl.glu\r
opengl.demo-support ui ui.gadgets ui.render threads accessors\r
-calendar ;\r
+calendar literals ;\r
IN: nehe.5\r
\r
TUPLE: nehe5-gadget < gadget rtri rquad thread quit? ;\r
0.0 >>rtri\r
0.0 >>rquad ;\r
\r
-M: nehe5-gadget pref-dim* ( gadget -- dim )\r
- drop width height 2array ;\r
-\r
M: nehe5-gadget draw-gadget* ( gadget -- )\r
GL_PROJECTION glMatrixMode\r
glLoadIdentity\r
M: nehe5-gadget ungraft* ( gadget -- )\r
t >>quit? drop ;\r
\r
-\r
-: run5 ( -- )\r
- <nehe5-gadget> "NeHe Tutorial 5" open-window ;\r
+MAIN-WINDOW: run5 { { title "NeHe Tutorial 5" } { pref-dim { $ width $ height } } }\r
+ <nehe5-gadget> >>gadgets ;\r
USING: ui.gadgets.buttons ui.gadgets.packs ui.gadgets ui
-nehe.2 nehe.3 nehe.4 nehe.5 kernel ;
+nehe.2 nehe.3 nehe.4 nehe.5 kernel accessors ;
IN: nehe
-: nehe-window ( -- )
- [
- <filled-pile>
- "Nehe 2" [ drop run2 ] <border-button> add-gadget
- "Nehe 3" [ drop run3 ] <border-button> add-gadget
- "Nehe 4" [ drop run4 ] <border-button> add-gadget
- "Nehe 5" [ drop run5 ] <border-button> add-gadget
- "Nehe examples" open-window
- ] with-ui ;
+MAIN-WINDOW: nehe-window { { title "Nehe Examples" } }
+ <filled-pile>
+ "Nehe 2" [ drop run2 ] <border-button> add-gadget
+ "Nehe 3" [ drop run3 ] <border-button> add-gadget
+ "Nehe 4" [ drop run4 ] <border-button> add-gadget
+ "Nehe 5" [ drop run5 ] <border-button> add-gadget
+ >>gadgets ;
MAIN: nehe-window
[ plane-program>> [ delete-gl-program ] when* ]
} cleave ;
-M: spheres-world pref-dim*
- drop { 640 480 } ;
-
:: (draw-sphere) ( program center radius -- )
program "center" glGetAttribLocation center first3 glVertexAttrib3f
program "radius" glGetAttribLocation radius glVertexAttrib1f
]
} cleave ;
-: spheres-window ( -- )
- [
- f T{ world-attributes
- { world-class spheres-world }
- { title "Spheres" }
- { pixel-format-attributes {
- windowed
- double-buffered
- T{ depth-bits { value 16 } }
- } }
- } open-window
- ] with-ui ;
-
-MAIN: spheres-window
+MAIN-WINDOW: spheres-window {
+ { world-class spheres-world }
+ { title "Spheres" }
+ { pixel-format-attributes {
+ windowed
+ double-buffered
+ T{ depth-bits { value 16 } }
+ } }
+ { pref-dim { 640 480 } }
+ } ;
float-4{ 0.0 0.0 0.0 1.0 } >>velocity
VELOCITY-MODIFIER-NORMAL >>velocity-modifier ;
-M: terrain-world tick-length
- drop 1000000 60 /i ;
-
: frustum ( dim -- -x x -y y near far )
dup first2 min v/n
NEAR-PLANE FOV / v*n first2 [ [ neg ] keep ] bi@
] with-gl-program ]
} cleave gl-error ;
-M: terrain-world pref-dim* drop { 1024 768 } ;
-
-: terrain-window ( -- )
- [
- f T{ world-attributes
- { world-class terrain-world }
- { title "Terrain" }
- { pixel-format-attributes {
- windowed
- double-buffered
- T{ depth-bits { value 24 } }
- } }
- { grab-input? t }
- } open-window
- ] with-ui ;
-
-MAIN: terrain-window
+GAME: terrain-game {
+ { world-class terrain-world }
+ { title "Terrain" }
+ { pixel-format-attributes {
+ windowed
+ double-buffered
+ T{ depth-bits { value 24 } }
+ } }
+ { grab-input? t }
+ { pref-dim { 1024 768 } }
+ { tick-interval-micros $[ 1,000,000 60 /i ] }
+ }
M: null-world end-world drop ;
M: null-world draw-world* drop ;
M: null-world resize-world drop ;
-M: null-world pref-dim* drop { 512 512 } ;
: null-window ( title -- world )
<world-attributes>
backing-store
T{ depth-bits f 24 }
} >>pixel-format-attributes
+ { 512 512 } >>pref-dim
f swap open-window* ;
: into-window ( world quot -- world )
projects / factor.git / commitdiff