factor/library/cocoa/ui.factor

170 lines
4.1 KiB
Factor

! Copyright (C) 2006 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: arrays cocoa freetype gadgets gadgets-launchpad
gadgets-layouts gadgets-listener gadgets-panes hashtables kernel
lists math namespaces objc objc-NSApplication objc-NSEvent
objc-NSObject objc-NSOpenGLView objc-NSView objc-NSWindow
sequences threads ;
! Cocoa backend for Factor UI
IN: objc-FactorView
DEFER: FactorView
IN: gadgets-cocoa
! Hash mapping aliens to gadgets
SYMBOL: views
H{ } clone views set-global
: register-view ( world -- )
dup world-handle views get set-hash ;
: unregister-view ( world -- )
world-handle views get remove-hash ;
: view ( handle -- world ) views get hash ;
: mouse-location ( view event -- loc )
over >r
[locationInWindow] f [convertPoint:fromView:]
dup NSPoint-x swap NSPoint-y
r> [frame] NSRect-h swap - 0 3array ;
: send-mouse-moved ( view event -- )
over >r mouse-location r> view move-hand ;
: button ( event -- n )
#! Cocoa -> Factor UI button mapping
[buttonNumber] H{ { 0 1 } { 2 2 } { 1 3 } } hash ;
: modifiers
{
{ "SHIFT" HEX: 10000 }
{ "CTRL" HEX: 40000 }
{ "ALT" HEX: 80000 }
{ "META" HEX: 100000 }
} ;
: key-codes
H{
{ 36 "RETURN" }
{ 48 "TAB" }
{ 51 "BACKSPACE" }
{ 115 "HOME" }
{ 117 "DELETE" }
{ 119 "END" }
{ 123 "LEFT" }
{ 124 "RIGHT" }
{ 125 "DOWN" }
{ 126 "UP" }
} hash ;
: modifier ( mod -- seq )
modifiers
[ second swap bitand 0 > ] subset-with
[ first ] map ;
: key-code ( event -- string )
dup [keyCode] key-codes
[ ] [ [charactersIgnoringModifiers] CF>string ] ?if ;
: event>binding ( event -- binding )
dup [modifierFlags] modifier swap key-code
[ add >list ] [ drop f ] if* ;
: send-key-event ( view event -- )
>r view world-focus r> dup event>binding
[ pick handle-gesture ] [ t ] if*
[ [characters] CF>string swap user-input ] [ 2drop ] if ;
"NSOpenGLView" "FactorView" {
{ "drawRect:" "void" { "id" "SEL" "NSRect" }
[ 2drop [ view draw-world ] with-gl-view ]
}
{ "mouseMoved:" "void" { "id" "SEL" "id" }
[ nip send-mouse-moved ]
}
{ "mouseDragged:" "void" { "id" "SEL" "id" }
[ nip send-mouse-moved ]
}
{ "rightMouseDragged:" "void" { "id" "SEL" "id" }
[ nip send-mouse-moved ]
}
{ "otherMouseDragged:" "void" { "id" "SEL" "id" }
[ nip send-mouse-moved ]
}
{ "mouseDown:" "void" { "id" "SEL" "id" }
[ 2nip button send-button-down ]
}
{ "mouseUp:" "void" { "id" "SEL" "id" }
[ 2nip button send-button-up ]
}
{ "rightMouseDown:" "void" { "id" "SEL" "id" }
[ 2nip button send-button-down ]
}
{ "rightMouseUp:" "void" { "id" "SEL" "id" }
[ 2nip button send-button-up ]
}
{ "otherMouseDown:" "void" { "id" "SEL" "id" }
[ 2nip button send-button-down ]
}
{ "otherMouseUp:" "void" { "id" "SEL" "id" }
[ 2nip button send-button-up ]
}
{ "scrollWheel:" "void" { "id" "SEL" "id" }
[ 2nip [deltaY] 0 > send-scroll-wheel ]
}
{ "keyDown:" "void" { "id" "SEL" "id" }
[ nip send-key-event ]
}
{ "updateFactorGadgetSize:" "void" { "id" "SEL" "id" }
[ 2drop dup view-dim swap view set-gadget-dim ]
}
{ "acceptsFirstResponder" "bool" { "id" "SEL" }
[ 2drop 1 ]
}
} { } define-objc-class
: <FactorView> ( gadget -- view )
FactorView over rect-dim <GLView>
dup "updateFactorGadgetSize:" add-resize-observer
[ over set-world-handle register-view ] keep ;
: <FactorWindow> ( gadget title -- window )
>r <FactorView> r> <ViewWindow> ;
IN: gadgets
: repaint-handle ( handle -- ) 1 [setNeedsDisplay:] ;
: in-window ( gadget status dim title -- )
>r <world> r> <FactorWindow> drop ;
IN: shells
: ui
[
[
launchpad-window
listener-window
finish-launching
event-loop
] with-cocoa
] with-freetype ;