Paste: Loupe - a gadget inspector

USING: accessors cursor kernel namespaces ui ui.gadgets
ui.gadgets.borders ui.gadgets.buttons ui.gadgets.worlds
ui.gestures ui.tools.inspector ;
IN: loupe

<PRIVATE
: unloupe ( -- )
    arrow cursor-hand
    f button-up-hook set-global ;
PRIVATE>

: loupe ( -- )
    crosshairs cursor-hand 
    [ pick-up inspector unloupe ] button-up-hook set-global ;

: <loupe-gadget> ( -- gadget )
    "Loupe" [ drop loupe ] <border-button> ;

: <loupe-world-attributes> ( -- world-attributes )
    <world-attributes> 
        "Tools" >>title
        { small-title-bar close-button } >>window-controls ;

: main ( -- ) [ <loupe-gadget> { 10 10 } <border> 
                <loupe-world-attributes> open-window ] with-ui ;

MAIN: main

! --------------------------------------

USING: cocoa cocoa.classes ;
IN: cursor

! TODO: make cross-platform

FRAMEWORK: /System/Library/Frameworks/AppKit.framework
IMPORT: NSCursor

: arrow ( -- cursor )
    NSCursor -> arrowCursor ;

: crosshairs ( -- cursor )
   NSCursor -> crosshairCursor ;

: cursor-hand ( cursor -- )
   -> set ;

! --------------------------------------
!
! Plus the following changes to gestures.factor 
! in order to hook into the gesture dispatch.
! (note: you must add ui.tools.inspector to the USE: statement)

SYMBOL: button-up-hook
! 'f' when disabled. Otherwise, a quot with stack effect ( loc world -- )

: send-button-up ( gesture loc world -- )
    button-up-hook get
    [ call( loc world -- ) ]
    [ move-hand ] if*
    dup #>> hand-buttons get-global delete
    stop-drag-timer
    button-gesture ;