Save window positions, re-arrange source tree a bit

slava 2006-05-27 21:39:38 +00:00
parent 04ac5717ef
commit 13f392737e
63 changed files with 198 additions and 158 deletions

View File

@ -1,19 +1,4 @@
+ prettyprinter bug: - make-image in the UI leaks memory...
IN: gadgets-listener SYMBOL: listener-gadget
TUPLE: listener-gadget scroller stack ;
IN: gadgets M: listener-gadget focusable-child*
listener-gadget-pane ;
IN: gadgets-layouts M: listener-gadget pref-dim*
drop { 600 600 0 } ;
IN: gadgets-listener M: listener-gadget
set-listener-gadget-scroller 4 set-slot ;
IN: gadgets-listener M: listener-gadget listener-gadget-stack
5 slot ;
IN: gadgets-listener M: listener-gadget
set-listener-gadget-stack 5 set-slot ;
IN: gadgets-listener M: listener-gadget
listener-gadget-scroller 4 slot ;
+ httpd: + httpd:
- outliners don't work - outliners don't work
@ -62,6 +47,10 @@ listener-gadget-scroller 4 slot ;
+ ui/help: + ui/help:
- restore windows with the correct stacking order
- if the listener is running a command when the image is saved, it
restores to an unresponsive gadget
- save window positions on x11
- roundoff is still not quite right with tracks - roundoff is still not quite right with tracks
- clearing pane with ^L leaves scrollbar a pixel off - clearing pane with ^L leaves scrollbar a pixel off
- new browser: - new browser:
@ -84,11 +73,11 @@ listener-gadget-scroller 4 slot ;
- polish OS X menu bar code - polish OS X menu bar code
- dock menu - dock menu
- services do not launch if factor not running - services do not launch if factor not running
- new syntax
- when scrolling wheel, or moving mouse out of window, rollover is not - when scrolling wheel, or moving mouse out of window, rollover is not
updated updated
- focus is not top-level window aware - focus is not top-level window aware
- display lists - display lists
- saving the image should save window configuration
- variable width word wrap - variable width word wrap
+ compiler/ffi: + compiler/ffi:

View File

@ -163,45 +163,45 @@ vectors words ;
! This must be the last file of parsing words loaded ! This must be the last file of parsing words loaded
"/library/syntax/parse-syntax.factor" "/library/syntax/parse-syntax.factor"
"/library/opengl/gl.factor" "/library/ui/opengl/gl.factor"
"/library/opengl/glu.factor" "/library/ui/opengl/glu.factor"
"/library/opengl/opengl-utils.factor" "/library/ui/opengl/opengl-utils.factor"
"/library/freetype/freetype.factor" "/library/ui/freetype/freetype.factor"
"/library/freetype/freetype-gl.factor" "/library/ui/freetype/freetype-gl.factor"
"/library/ui/backend.factor" "/library/ui/backend.factor"
"/library/ui/timers.factor" "/library/ui/timers.factor"
"/library/ui/gadgets.factor" "/library/ui/gadgets.factor"
"/library/ui/layouts.factor" "/library/ui/layouts.factor"
"/library/ui/hierarchy.factor" "/library/ui/hierarchy.factor"
"/library/ui/frames.factor" "/library/ui/gadgets/frames.factor"
"/library/ui/world.factor" "/library/ui/world.factor"
"/library/ui/paint.factor" "/library/ui/paint.factor"
"/library/ui/theme.factor" "/library/ui/gadgets/theme.factor"
"/library/ui/labels.factor" "/library/ui/gadgets/labels.factor"
"/library/ui/gestures.factor" "/library/ui/gestures.factor"
"/library/ui/borders.factor" "/library/ui/gadgets/borders.factor"
"/library/ui/buttons.factor" "/library/ui/gadgets/buttons.factor"
"/library/ui/tiles.factor" "/library/ui/gadgets/tiles.factor"
"/library/ui/line-editor.factor" "/library/ui/gadgets/line-editor.factor"
"/library/ui/sliders.factor" "/library/ui/gadgets/sliders.factor"
"/library/ui/viewports.factor" "/library/ui/gadgets/viewports.factor"
"/library/ui/scrolling.factor" "/library/ui/gadgets/scrolling.factor"
"/library/ui/editors.factor" "/library/ui/gadgets/editors.factor"
"/library/ui/tracks.factor" "/library/ui/gadgets/tracks.factor"
"/library/ui/incremental.factor" "/library/ui/gadgets/incremental.factor"
"/library/ui/paragraphs.factor" "/library/ui/gadgets/paragraphs.factor"
"/library/ui/panes.factor" "/library/ui/gadgets/panes.factor"
"/library/ui/tabs.factor" "/library/ui/gadgets/tabs.factor"
"/library/ui/outliner.factor" "/library/ui/gadgets/outliner.factor"
"/library/ui/environment.factor" "/library/ui/ui.factor"
"/library/ui/presentations.factor" "/library/ui/gadgets/presentations.factor"
"/library/ui/listener.factor" "/library/ui/tools/listener.factor"
"/library/ui/browser.factor" "/library/ui/tools/browser.factor"
"/library/ui/apropos.factor" "/library/ui/tools/apropos.factor"
"/library/ui/help.factor" "/library/ui/tools/help.factor"
"/library/ui/launchpad.factor" "/library/ui/tools/launchpad.factor"
"/library/continuations.facts" "/library/continuations.facts"
"/library/errors.facts" "/library/errors.facts"

View File

@ -41,11 +41,11 @@ H{ } clone help-graph set-global xref-articles
"native-io" get [ init-io ] when "native-io" get [ init-io ] when
"cocoa" get [ "cocoa" get [
"/library/cocoa/load.factor" run-resource "/library/ui/cocoa/load.factor" run-resource
] when ] when
"x11" get [ "x11" get [
"/library/x11/load.factor" run-resource "/library/ui/x11/load.factor" run-resource
] when ] when
windows? "native-io" get and [ windows? "native-io" get and [

View File

@ -1,24 +0,0 @@
USING: compiler io parser sequences words ;
{
"/library/cocoa/runtime.factor"
"/library/cocoa/utilities.factor"
"/library/cocoa/subclassing.factor"
"/library/cocoa/core-foundation.factor"
"/library/cocoa/types.factor"
"/library/cocoa/init-cocoa.factor"
"/library/cocoa/callback.factor"
"/library/cocoa/application-utils.factor"
"/library/cocoa/view-utils.factor"
"/library/cocoa/window-utils.factor"
"/library/cocoa/dialogs.factor"
"/library/cocoa/menu-bar.factor"
"/library/cocoa/pasteboard-utils.factor"
"/library/cocoa/services.factor"
"/library/cocoa/ui.factor"
} [
run-resource
] each
"Compiling Cocoa bindings..." print
vocabs [ "objc-" head? ] subset compile-vocabs

View File

@ -88,6 +88,8 @@ M: wrapper apply-object wrapped apply-literal ;
GENERIC: infer-quot GENERIC: infer-quot
M: f infer-quot ( f -- ) drop ;
M: quotation infer-quot ( quot -- ) M: quotation infer-quot ( quot -- )
#! Recursive calls to this word are made for nested #! Recursive calls to this word are made for nested
#! quotations. #! quotations.

View File

@ -10,6 +10,7 @@ math math-internals namespaces parser sequences test vectors ;
[ t ] [ [ [ ] [ ] if ] dataflow dup [ [ ] map-nodes ] with-node-iterator = ] unit-test [ t ] [ [ [ ] [ ] if ] dataflow dup [ [ ] map-nodes ] with-node-iterator = ] unit-test
[ { 0 0 } ] [ f infer ] unit-test
[ { 0 2 } ] [ [ 2 "Hello" ] infer ] unit-test [ { 0 2 } ] [ [ 2 "Hello" ] infer ] unit-test
[ { 1 2 } ] [ [ dup ] infer ] unit-test [ { 1 2 } ] [ [ dup ] infer ] unit-test
@ -132,7 +133,7 @@ SYMBOL: sym-test
dup [ dup [
length length
] [ ] [
not-a-number "foo" throw
] if ; ] if ;
[ { 1 1 } ] [ [ terminator-branch ] infer ] unit-test [ { 1 1 } ] [ [ terminator-branch ] infer ] unit-test

View File

@ -82,7 +82,8 @@ M: object each-slot ( obj quot -- )
pprint " instances" print ; pprint " instances" print ;
: heap-stats. ( -- ) : heap-stats. ( -- )
heap-stats dup hash-keys natural-sort [ heap-stats dup hash-keys
[ [ word-name ] 2apply <=> ] sort [
( hash hash key -- ) ( hash hash key -- )
[ [ pick hash ] keep pick hash ] keep heap-stat. [ [ pick hash ] keep pick hash ] keep heap-stat.
] each 2drop ; ] each 2drop ;

View File

@ -15,6 +15,7 @@ USING: cocoa compiler io kernel objc sequences words ;
"NSException" "NSException"
"NSMenu" "NSMenu"
"NSMenuItem" "NSMenuItem"
"NSNotification"
"NSNotificationCenter" "NSNotificationCenter"
"NSObject" "NSObject"
"NSOpenGLContext" "NSOpenGLContext"

View File

@ -0,0 +1,24 @@
USING: compiler io parser sequences words ;
{
"/library/ui/cocoa/runtime.factor"
"/library/ui/cocoa/utilities.factor"
"/library/ui/cocoa/subclassing.factor"
"/library/ui/cocoa/core-foundation.factor"
"/library/ui/cocoa/types.factor"
"/library/ui/cocoa/init-cocoa.factor"
"/library/ui/cocoa/callback.factor"
"/library/ui/cocoa/application-utils.factor"
"/library/ui/cocoa/view-utils.factor"
"/library/ui/cocoa/window-utils.factor"
"/library/ui/cocoa/dialogs.factor"
"/library/ui/cocoa/menu-bar.factor"
"/library/ui/cocoa/pasteboard-utils.factor"
"/library/ui/cocoa/services.factor"
"/library/ui/cocoa/ui.factor"
} [
run-resource
] each
"Compiling Cocoa bindings..." print
vocabs [ "objc-" head? ] subset compile-vocabs

View File

@ -1,7 +1,7 @@
! Copyright (C) 2006 Slava Pestov ! Copyright (C) 2006 Slava Pestov
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
IN: cocoa IN: cocoa
USING: alien kernel math ; USING: alien gadgets kernel math sequences ;
BEGIN-STRUCT: NSRect BEGIN-STRUCT: NSRect
FIELD: float x FIELD: float x
@ -20,13 +20,13 @@ TYPEDEF: NSRect CGRect
[ set-NSRect-y ] keep [ set-NSRect-y ] keep
[ set-NSRect-x ] keep ; [ set-NSRect-x ] keep ;
: NSRect-x-y ( rect -- origin-x origin-y ) : NSRect-x-y ( alien -- origin-x origin-y )
[ NSRect-x ] keep NSRect-y ; [ NSRect-x ] keep NSRect-y ;
: NSRect-x-far-y ( rect -- origin-x far-y ) : NSRect-x-far-y ( alien -- origin-x far-y )
[ NSRect-x-y ] keep NSRect-h + ; [ NSRect-x-y ] keep NSRect-h + ;
: <far-y-NSRect> ( x y w h -- rect ) : <far-y-NSRect> ( x y w h -- alien )
tuck >r >r - r> r> <NSRect> ; tuck >r >r - r> r> <NSRect> ;
BEGIN-STRUCT: NSPoint BEGIN-STRUCT: NSPoint

View File

@ -5,8 +5,9 @@ IN: objc-FactorApplicationDelegate
DEFER: FactorApplicationDelegate DEFER: FactorApplicationDelegate
IN: cocoa IN: cocoa
USING: arrays gadgets gadgets-listener kernel objc USING: arrays gadgets gadgets-layouts gadgets-listener
objc-NSApplication objc-NSObject objc-NSWindow sequences ; hashtables kernel namespaces objc objc-NSApplication
objc-NSObject objc-NSWindow sequences ;
: finder-run-files ( alien -- ) : finder-run-files ( alien -- )
CF>string-array listener-run-files CF>string-array listener-run-files
@ -25,19 +26,21 @@ objc-NSApplication objc-NSObject objc-NSWindow sequences ;
FactorApplicationDelegate [alloc] [init] [setDelegate:] ; FactorApplicationDelegate [alloc] [init] [setDelegate:] ;
: init-cocoa-ui ( -- ) : init-cocoa-ui ( -- )
reset-views
reset-callbacks reset-callbacks
init-ui init-ui
install-app-delegate install-app-delegate
register-services register-services
default-main-menu ; default-main-menu ;
: rect>NSRect
dup world-loc first2 rot rect-dim first2 <NSRect> ;
: gadget-window ( world -- ) : gadget-window ( world -- )
[ [
<FactorView> dup <FactorView>
dup <ViewWindow> dup rot rect>NSRect <ViewWindow>
dup install-window-delegate dup install-window-delegate
dup [contentView] [release] over [release]
2array 2array
] keep set-world-handle ; ] keep set-world-handle ;
@ -52,8 +55,8 @@ objc-NSOpenGLView objc-NSView ;
world-handle second swap <NSString> [setTitle:] ; world-handle second swap <NSString> [setTitle:] ;
: open-window* ( world -- ) : open-window* ( world -- )
dup gadget-window dup add-notify dup gadget-window
dup gadget-title over set-title dup start-world
world-handle second f [makeKeyAndOrderFront:] ; world-handle second f [makeKeyAndOrderFront:] ;
: select-gl-context ( handle -- ) : select-gl-context ( handle -- )
@ -62,6 +65,13 @@ objc-NSOpenGLView objc-NSView ;
: flush-gl-context ( handle -- ) : flush-gl-context ( handle -- )
first [openGLContext] [flushBuffer] ; first [openGLContext] [flushBuffer] ;
: restore-windows ( -- )
views get hash-values reset-views
[ dup reset-world open-window* ] each ;
: restore-windows? ( -- ? )
views get [ hash-empty? not ] [ f ] if* ;
IN: shells IN: shells
: ui : ui
@ -71,7 +81,11 @@ IN: shells
[ [
[ [
init-cocoa-ui init-cocoa-ui
listener-window restore-windows? [
restore-windows
] [
listener-window
] if
finish-launching finish-launching
event-loop event-loop
] with-cocoa ] with-cocoa

View File

@ -18,21 +18,6 @@ sequences ;
: view-dim [bounds] dup NSRect-w swap NSRect-h 0 3array ; : view-dim [bounds] dup NSRect-w swap NSRect-h 0 3array ;
: NSViewFrameDidChangeNotification
"NSViewFrameDidChangeNotification" <NSString> ;
: add-resize-observer ( view selector -- )
NSViewFrameDidChangeNotification pick add-observer ;
! Hash mapping aliens to gadgets
SYMBOL: views
: reset-views ( hash -- hash ) H{ } clone views set-global ;
reset-views
: view ( handle -- world ) views get hash ;
: mouse-location ( view event -- loc ) : mouse-location ( view event -- loc )
over >r over >r
[locationInWindow] f [convertPoint:fromView:] [locationInWindow] f [convertPoint:fromView:]
@ -101,6 +86,11 @@ reset-views
: send-wheel$ ( view event -- ) : send-wheel$ ( view event -- )
[ [deltaY] 0 > ] 2keep mouse-location rot view send-wheel ; [ [deltaY] 0 > ] 2keep mouse-location rot view send-wheel ;
: add-resize-observer ( observer object -- )
>r "updateFactorGadgetSize:"
"NSViewFrameDidChangeNotification" <NSString>
r> add-observer ;
"NSOpenGLView" "FactorView" { "NSOpenGLView" "FactorView" {
{ "drawRect:" "void" { "id" "SEL" "NSRect" } { "drawRect:" "void" { "id" "SEL" "NSRect" }
[ 2drop view draw-world ] [ 2drop view draw-world ]
@ -170,7 +160,7 @@ reset-views
[ [
rot drop rot drop
SUPER-> [initWithFrame:pixelFormat:] SUPER-> [initWithFrame:pixelFormat:]
dup "updateFactorGadgetSize:" add-resize-observer dup dup add-resize-observer
] ]
} }
@ -178,7 +168,7 @@ reset-views
[ [
drop drop
dup view close-world dup view close-world
dup views get remove-hash dup unregister-view
dup remove-observer dup remove-observer
SUPER-> [dealloc] SUPER-> [dealloc]
] ]
@ -186,5 +176,4 @@ reset-views
} { } define-objc-class } { } define-objc-class
: <FactorView> ( world -- view ) : <FactorView> ( world -- view )
FactorView over rect-dim <GLView> FactorView over rect-dim <GLView> [ register-view ] keep ;
[ views get set-hash ] keep ;

View File

@ -4,8 +4,9 @@ IN: objc-FactorWindowDelegate
DEFER: FactorWindowDelegate DEFER: FactorWindowDelegate
IN: cocoa IN: cocoa
USING: gadgets gadgets-layouts kernel math objc objc-NSObject USING: arrays gadgets gadgets-layouts kernel math objc
objc-NSView objc-NSWindow sequences ; objc-NSNotification objc-NSObject objc-NSView objc-NSWindow
sequences ;
: NSBorderlessWindowMask 0 ; inline : NSBorderlessWindowMask 0 ; inline
: NSTitledWindowMask 1 ; inline : NSTitledWindowMask 1 ; inline
@ -28,9 +29,8 @@ objc-NSView objc-NSWindow sequences ;
standard-window-type NSBackingStoreBuffered 1 standard-window-type NSBackingStoreBuffered 1
[initWithContentRect:styleMask:backing:defer:] ; [initWithContentRect:styleMask:backing:defer:] ;
: <ViewWindow> ( view -- window ) : <ViewWindow> ( view bounds -- window )
dup [bounds] <NSWindow> <NSWindow> [ swap [setContentView:] ] keep
[ swap [setContentView:] ] keep
dup dup [contentView] [setInitialFirstResponder:] dup dup [contentView] [setInitialFirstResponder:]
dup 1 [setAcceptsMouseMovedEvents:] ; dup 1 [setAcceptsMouseMovedEvents:] ;
@ -55,6 +55,14 @@ objc-NSView objc-NSWindow sequences ;
frame-content-rect frame-content-rect
] ]
} }
{
"windowDidMove:" "void" { "id" "SEL" "id" } [
2nip [object]
dup window-content-rect NSRect-x-y 0 3array
swap [contentView] view set-world-loc
]
}
} { } define-objc-class } { } define-objc-class
: install-window-delegate ( window -- ) : install-window-delegate ( window -- )

View File

@ -92,7 +92,6 @@ M: editor gadget-gestures
{ T{ key-down f f "HOME" } [ [ T{ document-elt } prev-elt ] with-editor ] } { T{ key-down f f "HOME" } [ [ T{ document-elt } prev-elt ] with-editor ] }
{ T{ key-down f f "END" } [ [ T{ document-elt } next-elt ] with-editor ] } { T{ key-down f f "END" } [ [ T{ document-elt } next-elt ] with-editor ] }
{ T{ key-down f { C+ } "k" } [ [ line-clear ] with-editor ] } { T{ key-down f { C+ } "k" } [ [ line-clear ] with-editor ] }
{ T{ key-down f f "TAB" } [ do-completion ] }
} ; } ;
C: editor ( text -- ) C: editor ( text -- )

View File

@ -42,8 +42,7 @@ SYMBOL: structured-input
"\"structured-input\" \"gadgets-panes\" lookup get-global call" "\"structured-input\" \"gadgets-panes\" lookup get-global call"
r> pane-eval ; r> pane-eval ;
: replace-input ( string pane -- ) : replace-input ( string pane -- ) pane-input set-editor-text ;
pane-input set-editor-text ;
: print-input ( string pane -- ) : print-input ( string pane -- )
[ [

View File

@ -52,7 +52,8 @@ C: listener-gadget ( -- gadget )
{ [ <input-pane> <scroller> ] set-listener-gadget-scroller @center } { [ <input-pane> <scroller> ] set-listener-gadget-scroller @center }
} make-frame* dup start-listener ; } make-frame* dup start-listener ;
M: listener-gadget pref-dim* drop { 600 600 0 } ; M: listener-gadget pref-dim*
delegate pref-dim* { 600 600 0 } vmax ;
M: listener-gadget focusable-child* ( listener -- gadget ) M: listener-gadget focusable-child* ( listener -- gadget )
listener-gadget-pane ; listener-gadget-pane ;

View File

@ -5,6 +5,17 @@ USING: gadgets gadgets-labels gadgets-layouts gadgets-theme
gadgets-viewports hashtables kernel math namespaces queues gadgets-viewports hashtables kernel math namespaces queues
sequences threads ; sequences threads ;
! Hash mapping aliens to gadgets
SYMBOL: windows
: reset-windows ( hash -- hash ) H{ } clone windows set-global ;
: view ( handle -- world ) windows get hash ;
: register-view ( world handle -- ) windows get set-hash ;
: unregister-view ( handle -- ) windows get remove-hash ;
: layout-queued ( -- ) : layout-queued ( -- )
invalid dup queue-empty? [ invalid dup queue-empty? [
drop drop
@ -24,16 +35,6 @@ sequences threads ;
[ dup world-handle [ draw-world ] [ drop ] if ] each [ dup world-handle [ draw-world ] [ drop ] if ] each
10 sleep ; 10 sleep ;
: close-global ( world global -- )
dup get-global find-world rot eq?
[ f swap set-global ] [ drop ] if ;
: close-world ( world -- )
dup hand-clicked close-global
dup hand-gadget close-global
f over request-focus* dup remove-notify
dup free-fonts f swap set-world-handle ;
: <status-bar> ( -- gadget ) "" <label> dup highlight-theme ; : <status-bar> ( -- gadget ) "" <label> dup highlight-theme ;
GENERIC: gadget-title ( gadget -- string ) GENERIC: gadget-title ( gadget -- string )
@ -66,6 +67,13 @@ C: titled-gadget ( gadget title -- )
: open-titled-window ( gadget title -- ) : open-titled-window ( gadget title -- )
<titled-gadget> open-window ; <titled-gadget> open-window ;
: restore-windows ( -- )
windows get hash-values reset-windows
[ dup reset-world open-window* ] each ;
: restore-windows? ( -- ? )
windows get [ hash-empty? not ] [ f ] if* ;
: (open-tool) ( arg cons setter -- ) : (open-tool) ( arg cons setter -- )
>r call tuck r> call open-window ; inline >r call tuck r> call open-window ; inline
@ -78,3 +86,21 @@ C: titled-gadget ( gadget title -- )
] [ ] [
drop r> r> (open-tool) drop r> r> (open-tool)
] if ; ] if ;
: start-world ( world -- )
dup add-notify
dup gadget-title over set-title
dup relayout
world-gadget request-focus ;
: close-global ( world global -- )
dup get-global find-world rot eq?
[ f swap set-global ] [ drop ] if ;
: close-world ( world -- )
dup hand-clicked close-global
dup hand-gadget close-global
f over request-focus*
dup remove-notify
dup free-fonts
reset-world ;

View File

@ -5,16 +5,20 @@ USING: errors freetype gadgets-layouts generic hashtables kernel
math namespaces opengl sequences ; math namespaces opengl sequences ;
! The world gadget is the top level gadget that all (visible) ! The world gadget is the top level gadget that all (visible)
! gadgets are contained in. ! gadgets are contained in. There is one world per top-level
! native window.
! fonts: mapping font tuples to sprite vectors ! fonts: mapping font tuples to sprite vectors
! handle: native resource ! handle: native resource
TUPLE: world gadget status focus fonts handle ; ! loc: location of native window on the screen.
! we don't store this in the world's rect-loc, since the
! co-ordinate system might be different, and generally the
! UI code assumes that everything starts at { 0 0 0 }.
TUPLE: world gadget status focus fonts handle loc ;
: free-fonts ( world -- ) : free-fonts ( world -- )
dup world-handle select-gl-context dup world-handle select-gl-context
world-fonts dup hash-values [ free-sprites ] each world-fonts hash-values [ free-sprites ] each ;
clear-hash ;
: font-sprites ( font world -- sprites ) : font-sprites ( font world -- sprites )
world-fonts [ drop V{ } clone ] cache ; world-fonts [ drop V{ } clone ] cache ;
@ -28,7 +32,8 @@ C: world ( gadget status -- world )
} make-frame* } make-frame*
t over set-gadget-root? t over set-gadget-root?
H{ } clone over set-world-fonts H{ } clone over set-world-fonts
dup world-gadget request-focus ; dup world-gadget request-focus
{ 0 0 0 } over set-world-loc ;
: find-world [ world? ] find-parent ; : find-world [ world? ] find-parent ;
@ -40,3 +45,8 @@ M: world pref-dim* ( world -- dim )
: draw-string ( open-fonts string -- ) : draw-string ( open-fonts string -- )
>r dup world get font-sprites r> (draw-string) ; >r dup world get font-sprites r> (draw-string) ;
: reset-world ( world -- )
f over set-world-focus
f over set-world-handle
world-fonts clear-hash ;

View File

@ -56,8 +56,8 @@ GENERIC: client-event ( event window -- )
} cond ; } cond ;
: event-loop ( -- ) : event-loop ( -- )
windows get hash-empty? [ views get hash-empty? [
wait-event dup XAnyEvent-window windows get hash dup wait-event dup XAnyEvent-window views get hash dup
[ handle-event ] [ 2drop ] if event-loop [ handle-event ] [ 2drop ] if event-loop
] unless ; ] unless ;

View File

@ -0,0 +1,16 @@
! Copyright (C) 2005, 2006 Eduardo Cavazos
! See http://factorcode.org/license.txt for BSD license.
USING: kernel parser words compiler sequences ;
{
"/library/ui/x11/xlib.factor"
"/library/ui/x11/glx.factor"
"/library/ui/x11/constants.factor"
"/library/ui/x11/utilities.factor"
"/library/ui/x11/events.factor"
"/library/ui/x11/glx-utils.factor"
"/library/ui/x11/windows.factor"
"/library/ui/x11/ui.factor"
} [ run-resource ] each
{ "x11" } compile-vocabs

View File

@ -134,8 +134,12 @@ IN: shells
[ [
f [ f [
init-ui init-ui
launchpad-window restore-windows? [
listener-window restore-windows
] [
launchpad-window
listener-window
] if
event-loop event-loop
] with-x ] with-x
] with-freetype ; ] with-freetype ;

View File

@ -4,10 +4,6 @@ IN: x11
USING: alien arrays errors gadgets hashtables io kernel math USING: alien arrays errors gadgets hashtables io kernel math
namespaces prettyprint sequences threads ; namespaces prettyprint sequences threads ;
! Global variable; maps X11 window handles to objects responding
! to the event protocol in /library/x11/events.factor
SYMBOL: windows
SYMBOL: dpy SYMBOL: dpy
SYMBOL: scr SYMBOL: scr
SYMBOL: root SYMBOL: root
@ -30,7 +26,7 @@ SYMBOL: root
: with-x ( display-string quot -- ) : with-x ( display-string quot -- )
[ [
H{ } clone windows set reset-views
swap initialize-x swap initialize-x
[ close-x ] cleanup [ close-x ] cleanup
] with-scope ; ] with-scope ;

View File

@ -1,7 +1,7 @@
! Copyright (C) 2005, 2006 Eduardo Cavazos and Slava Pestov ! Copyright (C) 2005, 2006 Eduardo Cavazos and Slava Pestov
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
IN: x11 IN: x11
USING: alien hashtables kernel math namespaces sequences ; USING: alien gadgets hashtables kernel math namespaces sequences ;
: create-window-mask ( -- n ) : create-window-mask ( -- n )
CWBackPixel CWBorderPixel bitor CWBackPixel CWBorderPixel bitor
@ -41,7 +41,7 @@ USING: alien hashtables kernel math namespaces sequences ;
dpy get swap XDestroyWindow drop ; dpy get swap XDestroyWindow drop ;
: destroy-window* ( win context -- ) : destroy-window* ( win context -- )
destroy-context dup windows get remove-hash destroy-window ; destroy-context dup views get remove-hash destroy-window ;
: set-closable ( win -- ) : set-closable ( win -- )
dpy get swap "WM_DELETE_WINDOW" x-atom <Atom> 1 dpy get swap "WM_DELETE_WINDOW" x-atom <Atom> 1
@ -52,6 +52,6 @@ USING: alien hashtables kernel math namespaces sequences ;
: map-window* ( world win -- ) dup set-closable map-window ; : map-window* ( world win -- ) dup set-closable map-window ;
: glx-window* ( world dim -- win context ) : glx-window* ( world dim -- win context )
glx-window >r [ windows get set-hash ] keep r> ; glx-window >r [ views get set-hash ] keep r> ;
: unmap-window ( win -- ) dpy get swap XUnmapWindow drop ; : unmap-window ( win -- ) dpy get swap XUnmapWindow drop ;

View File

@ -1,16 +0,0 @@
! Copyright (C) 2005, 2006 Eduardo Cavazos
! See http://factorcode.org/license.txt for BSD license.
USING: kernel parser words compiler sequences ;
{
"/library/x11/xlib.factor"
"/library/x11/glx.factor"
"/library/x11/constants.factor"
"/library/x11/utilities.factor"
"/library/x11/events.factor"
"/library/x11/glx-utils.factor"
"/library/x11/windows.factor"
"/library/x11/ui.factor"
} [ run-resource ] each
{ "x11" } compile-vocabs