diff --git a/basis/opengl/gl/gl.factor b/basis/opengl/gl/gl.factor index 6136115dbb..fb3b10354b 100644 --- a/basis/opengl/gl/gl.factor +++ b/basis/opengl/gl/gl.factor @@ -356,10 +356,6 @@ CONSTANT: GL_DITHER HEX: 0BD0 CONSTANT: GL_RGB HEX: 1907 CONSTANT: GL_RGBA HEX: 1908 -! GL_BGRA_ext: http://www.opengl.org/registry/specs/EXT/bgra.txt -CONSTANT: GL_BGR_EXT HEX: 80E0 -CONSTANT: GL_BGRA_EXT HEX: 80E1 - ! Implementation limits CONSTANT: GL_MAX_LIST_NESTING HEX: 0B31 CONSTANT: GL_MAX_ATTRIB_STACK_DEPTH HEX: 0D35 diff --git a/basis/opengl/textures/textures.factor b/basis/opengl/textures/textures.factor index 0a8fc945bf..c2fa02ac5e 100755 --- a/basis/opengl/textures/textures.factor +++ b/basis/opengl/textures/textures.factor @@ -44,10 +44,10 @@ M: BGR component-order>format drop GL_BGR ; M: RGBA component-order>format drop GL_RGBA ; M: ARGB component-order>format swap GL_UNSIGNED_BYTE = - [ drop GL_UNSIGNED_INT_8_8_8_8_REV GL_BGRA_EXT ] + [ drop GL_UNSIGNED_INT_8_8_8_8_REV GL_BGRA ] [ unsupported-component-order ] if ; -M: BGRA component-order>format drop GL_BGRA_EXT ; -M: BGRX component-order>format drop GL_BGRA_EXT ; +M: BGRA component-order>format drop GL_BGRA ; +M: BGRX component-order>format drop GL_BGRA ; M: LA component-order>format drop GL_LUMINANCE_ALPHA ; M: L component-order>format drop GL_LUMINANCE ; diff --git a/basis/ui/backend/cocoa/views/views.factor b/basis/ui/backend/cocoa/views/views.factor index 9fb83e4865..a7b9fd3801 100644 --- a/basis/ui/backend/cocoa/views/views.factor +++ b/basis/ui/backend/cocoa/views/views.factor @@ -1,11 +1,12 @@ ! Copyright (C) 2006, 2008 Slava Pestov ! See http://factorcode.org/license.txt for BSD license. -USING: accessors alien alien.c-types arrays assocs cocoa kernel math -cocoa.messages cocoa.subclassing cocoa.classes cocoa.views -cocoa.application cocoa.pasteboard cocoa.types cocoa.windows sequences -ui ui.private ui.gadgets ui.gadgets.private ui.gadgets.worlds -ui.gestures core-foundation.strings core-graphics core-graphics.types -threads combinators math.rectangles ; +USING: accessors alien alien.c-types alien.strings arrays assocs +cocoa kernel math cocoa.messages cocoa.subclassing cocoa.classes +cocoa.views cocoa.application cocoa.pasteboard cocoa.types +cocoa.windows sequences io.encodings.ascii ui ui.private ui.gadgets +ui.gadgets.private ui.gadgets.worlds ui.gestures +core-foundation.strings core-graphics core-graphics.types threads +combinators math.rectangles ; IN: ui.backend.cocoa.views : send-mouse-moved ( view event -- ) @@ -121,6 +122,25 @@ CONSTANT: key-codes [ drop dim>> first2 ] 2bi ; +CONSTANT: selector>action H{ + { "undo:" undo-action } + { "redo:" redo-action } + { "cut:" cut-action } + { "copy:" copy-action } + { "paste:" paste-action } + { "delete:" delete-action } + { "selectAll:" select-all-action } + { "newDocument:" new-action } + { "openDocument:" open-action } + { "saveDocument:" save-action } + { "saveDocumentAs:" save-as-action } + { "revertDocumentToSaved:" revert-action } +} + +: validate-action ( world selector -- ? validated? ) + selector>action at + [ swap world-focus parents-handle-gesture? t ] [ drop f f ] if* ; + CLASS: { { +superclass+ "NSOpenGLView" } { +name+ "FactorView" } @@ -197,6 +217,14 @@ CLASS: { [ nip send-key-up-event ] } +{ "validateUserInterfaceItem:" "char" { "id" "SEL" "id" } + [ + nip -> action + 2dup [ window ] [ ascii alien>string ] bi* validate-action + [ [ 2drop ] dip >c-bool ] [ SUPER-> validateUserInterfaceItem: ] if + ] +} + { "undo:" "id" { "id" "SEL" "id" } [ nip undo-action send-action$ ] } diff --git a/basis/ui/gestures/gestures-docs.factor b/basis/ui/gestures/gestures-docs.factor index 91c5ea8312..1e5a8df1dd 100644 --- a/basis/ui/gestures/gestures-docs.factor +++ b/basis/ui/gestures/gestures-docs.factor @@ -13,9 +13,20 @@ $nl "Outputs " { $link f } " if the gesture was handled, and " { $link t } " if the gesture should be passed on to the gadget's parent." $nl "The default implementation looks at the " { $snippet "\"gestures\"" } " word property of each superclass of the gadget's class." } -{ $notes "Methods should be defined on this word if you desire to handle an arbitrary set of gestures. To define handlers for a fixed set, it is easier to use " { $link set-gestures } "." } ; +{ $notes "Methods should be defined on this word if you desire to handle an arbitrary set of gestures. To define handlers for a fixed set, it is easier to use " { $link set-gestures } ". If you define a method on " { $snippet "handle-gesture" } ", you should also override " { $link handles-gesture? } "." } ; -{ propagate-gesture handle-gesture set-gestures } related-words +HELP: handles-gesture? +{ $values { "gesture" "a gesture" } { "gadget" "the receiver of the gesture" } { "?" "a boolean" } } +{ $contract "Returns a true value if " { $snippet "gadget" } " would handle " { $snippet "gesture" } " in its " { $link handle-gesture } " method." +$nl +"The default implementation looks at the " { $snippet "\"gestures\"" } " word property of each superclass of the gadget's class and returns true if a handler is present for " { $snippet "gesture" } "." } +{ $notes "This word is used in Factor's MacOS X UI to validate menu items." } ; + +HELP: parents-handle-gesture? +{ $values { "gesture" "a gesture" } { "gadget" "the receiver of the gesture" } { "?" "a boolean" } } +{ $contract "Returns a true value if " { $snippet "gadget" } " or any of its ancestors would handle " { $snippet "gesture" } " in its " { $link handle-gesture } " method." } ; + +{ propagate-gesture handle-gesture handles-gesture? set-gestures } related-words HELP: propagate-gesture { $values { "gesture" "a gesture" } { "gadget" gadget } } diff --git a/basis/ui/gestures/gestures.factor b/basis/ui/gestures/gestures.factor index dcfb8d4d66..26eb45c8d0 100644 --- a/basis/ui/gestures/gestures.factor +++ b/basis/ui/gestures/gestures.factor @@ -7,13 +7,24 @@ sets columns fry deques ui.gadgets ui.gadgets.private ascii combinators.short-circuit ; IN: ui.gestures +: get-gesture-handler ( gesture gadget -- quot ) + class superclasses [ "gestures" word-prop ] map assoc-stack ; + GENERIC: handle-gesture ( gesture gadget -- ? ) M: object handle-gesture [ nip ] - [ class superclasses [ "gestures" word-prop ] map assoc-stack ] 2bi + [ get-gesture-handler ] 2bi dup [ call( gadget -- ) f ] [ 2drop t ] if ; +GENERIC: handles-gesture? ( gesture gadget -- ? ) + +M: object handles-gesture? ( gesture gadget -- ? ) + get-gesture-handler >boolean ; + +: parents-handle-gesture? ( gesture gadget -- ? ) + [ handles-gesture? not ] with each-parent not ; + : set-gestures ( class hash -- ) "gestures" set-word-prop ; : gesture-queue ( -- deque ) \ gesture-queue get ; diff --git a/basis/ui/ui-docs.factor b/basis/ui/ui-docs.factor index b381c4e677..43dd22cde7 100644 --- a/basis/ui/ui-docs.factor +++ b/basis/ui/ui-docs.factor @@ -81,6 +81,10 @@ HELP: with-ui HELP: beep { $description "Plays the system beep sound." } ; +HELP: topmost-window +{ $values { "world" world } } +{ $description "Returns the " { $link world } " representing the currently focused window." } ; + ARTICLE: "ui-glossary" "UI glossary" { $table { "color" { "an instance of " { $link color } } } diff --git a/basis/ui/ui.factor b/basis/ui/ui.factor index 37ec4f35b1..db05465986 100644 --- a/basis/ui/ui.factor +++ b/basis/ui/ui.factor @@ -224,6 +224,9 @@ PRIVATE> : raise-window ( gadget -- ) find-world raise-window* ; +: topmost-window ( -- world ) + windows get last second ; + HOOK: close-window ui-backend ( gadget -- ) M: object close-window