Save window positions, re-arrange source tree a bit
parent
04ac5717ef
commit
13f392737e
|
@ -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:
|
||||||
|
|
|
@ -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"
|
||||||
|
|
|
@ -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 [
|
||||||
|
|
|
@ -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
|
|
|
@ -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.
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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 ;
|
||||||
|
|
|
@ -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"
|
|
@ -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
|
|
@ -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
|
|
@ -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
|
|
@ -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 ;
|
|
|
@ -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 -- )
|
|
@ -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 -- )
|
|
@ -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 -- )
|
||||||
[
|
[
|
|
@ -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 ;
|
|
@ -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 ;
|
|
@ -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 ;
|
||||||
|
|
|
@ -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 ;
|
||||||
|
|
|
@ -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
|
|
@ -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 ;
|
|
@ -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 ;
|
|
@ -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 ;
|
|
@ -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
|
|
Loading…
Reference in New Issue