! Copyright (C) 2006, 2010 Slava Pestov
! See http://factorcode.org/license.txt for BSD license.
+
USING: accessors alien alien.c-types alien.data alien.strings
arrays assocs classes cocoa cocoa.application cocoa.classes
cocoa.pasteboard cocoa.runtime cocoa.subclassing cocoa.touchbar
-cocoa.types cocoa.views combinators core-foundation.strings
-core-graphics core-graphics.types core-text io.encodings.utf8
-kernel literals locals math math.order math.parser
-math.rectangles namespaces opengl sequences splitting threads
-ui.commands ui.gadgets ui.gadgets.private ui.gadgets.worlds
-ui.gestures ui.private words sorting math.vectors
-ui.baseline-alignment ui.gadgets.line-support
-ui.gadgets.editors ui.backend.cocoa.input-methods
-ui.backend.cocoa.input-methods.editors io.encodings.utf16n
-io.encodings.string classes.struct ;
+cocoa.types cocoa.views combinators continuations
+core-foundation.strings core-graphics core-graphics.types
+core-text debugger io.encodings.string io.encodings.utf16
+io.encodings.utf8 kernel literals math math.order math.parser
+math.rectangles math.vectors namespaces opengl sequences
+splitting threads ui.backend.cocoa.input-methods ui.commands
+ui.gadgets ui.gadgets.editors ui.gadgets.line-support
+ui.gadgets.private ui.gadgets.worlds ui.gestures ui.private
+words ;
+
IN: ui.backend.cocoa.views
SLOT: window
CONSTANT: modifiers {
{ S+ $ NSShiftKeyMask }
{ C+ $ NSControlKeyMask }
- { A+ $ NSCommandKeyMask }
- { M+ $ NSAlternateKeyMask }
+ { M+ $ NSCommandKeyMask }
+ { A+ $ NSAlternateKeyMask }
}
CONSTANT: key-codes
: send-action$ ( view event gesture -- )
[ drop window ] dip over [ send-action ] [ 2drop ] if ;
-: add-resize-observer ( observer object -- )
- [
- "updateFactorGadgetSize:"
- "NSViewFrameDidChangeNotification" <NSString>
- ] dip add-observer ;
-
: string-or-nil? ( NSString -- ? )
[ CF>string NSStringPboardType = ] [ t ] if* ;
:: >codepoint-index ( str utf16-index -- codepoint-index )
0 utf16-index 2 * str utf16n encode subseq utf16n decode length ;
-
+
:: >utf16-index ( str codepoint-index -- utf16-index )
- 0 codepoint-index str subseq utf16n encode length 2 / >integer ;
+ 0 codepoint-index str subseq utf16n encode length 2 /i ;
:: earlier-caret/mark ( editor -- loc )
editor editor-caret :> caret
0 0 <NSRange> :> effective-range
text -> string CF>string :> str
str utf16n encode :> byte-16n
- 0 :> cp-loc!
+ 0 :> cp-loc!
"NSMarkedClauseSegment" <NSString> :> segment-attr
[ effective-range [ location>> ] [ length>> ] bi + text-length < ] [
text
[ str swap >codepoint-index ] bi@ swap - :> len
cp-loc cp-loc len + dup cp-loc!
2array thickness 2array
- suffix underlines!
+ suffix underlines!
] while
underlines length 1 = [
underlines first first 2 2array 1array ! thickness: 2
] [ underlines ] if ;
:: update-marked-text ( gadget str selectedRange replacementRange -- )
- replacementRange location>> NSNotFound = not ! [
- replacementRange length>> NSNotFound = not and [ ! erase this line
+ replacementRange location>> NSNotFound = [
gadget editor-caret first
dup gadget editor-line
[
- replacementRange length>> ! location>>
+ replacementRange location>>
>codepoint-index
2array gadget set-caret
] [
- replacementRange length>> 1 + ! [ location>> ] [ length>> ] bi +
+ replacementRange [ location>> ] [ length>> ] bi +
>codepoint-index
2array gadget set-mark
] 2bi
gadget earlier-caret/mark dup
gadget preedit-start<<
0 1 2array v+ gadget preedit-end<<
- ] when
+ ] unless
gadget preedit? [
gadget remove-preedit-text
] when
-
+
gadget earlier-caret/mark dup
gadget preedit-start<<
0 str length 2array v+ gadget preedit-end<<
[ str swap >codepoint-index ] bi@ -
2array v+
dup gadget preedit-selected-end<<
- dup gadget set-caret gadget set-mark
+ dup gadget set-caret gadget set-mark
gadget preedit-start>> gadget preedit-end>> = [
gadget remove-preedit-info
] when ;
+: set-scale-factor ( n -- )
+ [ 1.0 > ] keep f ? gl-scale-factor set-global
+ cached-lines get-global clear-assoc ;
+
PRIVATE>
<CLASS: FactorView < NSOpenGLView
COCOA-PROTOCOL: NSTextInputClient
METHOD: void prepareOpenGL [
+ self -> backingScaleFactor set-scale-factor
+ self -> update
+ ] ;
- self SEL: setWantsBestResolutionOpenGLSurface:
- -> respondsToSelector: c-bool> [
-
- self 1 { void { id SEL char } } ?-> setWantsBestResolutionOpenGLSurface:
-
- self { double { id SEL } } ?-> backingScaleFactor
-
- dup 1.0 > [
- gl-scale-factor set-global t retina? set-global
- cached-lines get-global clear-assoc
- ] [ drop ] if
-
- self -> update
+ METHOD: void reshape [
+ self window :> window
+ window [
+ self view-dim window dim<<
] when
] ;
] ;
! Rendering
- METHOD: void drawRect: NSRect rect [ self window [ draw-world ] when* ] ;
+ METHOD: void drawRect: NSRect rect [
+ self window [
+ [ draw-world yield ] [ print-error drop ] recover
+ ] when*
+ ] ;
+
+ ! Light/Dark Mode
+
+! METHOD: void viewDidChangeEffectiveAppearance [
+! self -> effectiveAppearance -> name [
+! CF>string "NSAppearanceNameDarkAqua" =
+! dark-theme light-theme ? switch-theme-if-default
+! ] when*
+! ] ;
! Events
METHOD: char acceptsFirstMouse: id event [ 0 ] ;
! Text input
METHOD: void insertText: id text replacementRange: NSRange replacementRange [
- self window :> window
- window [
- "" clone :> str!
- text NSString -> class -> isKindOfClass: 0 = not [
- text CF>string str!
- ] [
- text -> string CF>string str!
- ] if
- window world-focus :> gadget
- gadget [
- gadget support-input-methods? [
- replacementRange location>> NSNotFound = [
- gadget editor-caret first
- dup gadget editor-line
- [
- replacementRange location>> >codepoint-index
- 2array gadget set-caret
- ] [
- replacementRange [ location>> ] [ length>> ] bi +
- >codepoint-index
- 2array gadget set-mark
- ] 2bi
- ] unless
- gadget preedit? [
- gadget [ remove-preedit-text ] [ remove-preedit-info ] bi
- str gadget user-input* drop
- f gadget preedit-selection-mode?<<
+ self window :> window
+ window [
+ "" clone :> str!
+ text NSString -> class -> isKindOfClass: 0 = not [
+ text CF>string str!
+ ] [
+ text -> string CF>string str!
+ ] if
+ window world-focus :> gadget
+ gadget [
+ gadget support-input-methods? [
+ replacementRange location>> NSNotFound = [
+ gadget editor-caret first
+ dup gadget editor-line
+ [
+ replacementRange location>> >codepoint-index
+ 2array gadget set-caret
] [
- str window user-input
- ] if
- ] [
+ replacementRange [ location>> ] [ length>> ] bi +
+ >codepoint-index
+ 2array gadget set-mark
+ ] 2bi
+ ] unless
+ gadget preedit? [
+ gadget remove-preedit-text
+ gadget remove-preedit-info
+ str gadget user-input* drop
+ f gadget preedit-selection-mode?<<
+ ] [
str window user-input
] if
- ] when
+ ] [
+ str window user-input
+ ] if
] when
- ] ;
+ ] when
+ ] ;
METHOD: char hasMarkedText [
- self window :> window
- window [
- window world-focus :> gadget
- gadget [
- gadget preedit? [ 1 ] [ 0 ] if
- ] [ 0 ] if
+ self window :> window
+ window [
+ window world-focus :> gadget
+ gadget [
+ gadget preedit? 1 0 ?
] [ 0 ] if
- ] ;
+ ] [ 0 ] if
+ ] ;
- METHOD: NSRange markedRange [
- self window :> window
- window [
- window world-focus :> gadget
- gadget [
- gadget preedit? [
- gadget [ preedit-start>> second ] [ preedit-end>> second ] bi >= [
- NSNotFound 0
- ] [
- gadget preedit-start>> first gadget editor-line :> str
- gadget
- [ preedit-start>> second ] ! location
- [ preedit-end>> second ]
- bi [ str swap >utf16-index ] bi@ over - ! length
- ] if
- ] [ NSNotFound 0 ] if
- ] [ NSNotFound 0 ] if
+ METHOD: NSRange markedRange [
+ self window :> window
+ window [
+ window world-focus :> gadget
+ gadget [
+ gadget preedit? [
+ gadget preedit-start>> second
+ gadget preedit-end>> second < [
+ gadget preedit-start>> first gadget editor-line :> str
+ gadget preedit-start>> second ! location
+ gadget preedit-end>> second
+ [ str swap >utf16-index ] bi@ over - ! length
+ ] [ NSNotFound 0 ] if
+ ] [ NSNotFound 0 ] if
] [ NSNotFound 0 ] if
- <NSRange>
- ] ;
+ ] [ NSNotFound 0 ] if
+ <NSRange>
+ ] ;
METHOD: NSRange selectedRange [
- self window :> window
- window [
- window world-focus :> gadget
- gadget [
- gadget support-input-methods? [
- gadget editor-caret first gadget editor-line :> str
- gadget preedit? [
- str
- gadget
- [ preedit-selected-start>> second ]
- [ preedit-start>> second ]
- bi - >utf16-index ! location
- gadget
- [ preedit-selected-end>> second ]
- [ preedit-selected-start>> second ]
- bi [ str swap >utf16-index ] bi@ - ! length
- ] [
- str gadget editor-caret second >utf16-index 0
- ] if
- ] [ 0 0 ] if
- ] [ 0 0 ] if
- ] [ 0 0 ] if
- <NSRange>
- ] ;
-
- METHOD: void setMarkedText: id text selectedRange: NSRange selectedRange
- replacementRange: NSRange replacementRange [
- self window :> window
- window [
- window world-focus :> gadget
- gadget [
- { } clone :> underlines!
- "" clone :> str!
- text NSString -> class -> isKindOfClass: 0 = not [
- text CF>string str!
+ self window :> window
+ window [
+ window world-focus :> gadget
+ gadget [
+ gadget support-input-methods? [
+ gadget editor-caret first gadget editor-line :> str
+ gadget preedit? [
+ str
+ gadget preedit-selected-start>> second
+ gadget preedit-start>> second
+ - >utf16-index ! location
+ gadget preedit-selected-end>> second
+ gadget preedit-selected-start>> second
+ [ str swap >utf16-index ] bi@ - ! length
] [
- text -> string CF>string str!
- gadget support-input-methods? [
- gadget text selectedRange make-preedit-underlines underlines!
- ] when
+ str gadget editor-caret second >utf16-index 0
] if
+ ] [ 0 0 ] if
+ ] [ 0 0 ] if
+ ] [ 0 0 ] if
+ <NSRange>
+ ] ;
+
+ METHOD: void setMarkedText: id text selectedRange: NSRange selectedRange
+ replacementRange: NSRange replacementRange [
+ self window :> window
+ window [
+ window world-focus :> gadget
+ gadget [
+ { } clone :> underlines!
+ "" clone :> str!
+ text NSString -> class -> isKindOfClass: 0 = not [
+ text CF>string str!
+ ] [
+ text -> string CF>string str!
gadget support-input-methods? [
- gadget str selectedRange replacementRange update-marked-text
- underlines gadget preedit-underlines<<
+ gadget text selectedRange make-preedit-underlines underlines!
] when
+ ] if
+ gadget support-input-methods? [
+ gadget str selectedRange replacementRange update-marked-text
+ underlines gadget preedit-underlines<<
] when
- ] when
- ] ;
-
- METHOD: void unmarkText [
- self window :> window
- window [
- window world-focus :> gadget
- gadget [
- gadget support-input-methods? [
- gadget preedit? [
- gadget {
- [ preedit-start>> second ]
- [ preedit-end>> second ]
- [ preedit-start>> first ] [ editor-line ]
- } cleave subseq
- gadget [ remove-preedit-text ] [ remove-preedit-info ] bi
- gadget user-input* drop
- ] when
- f gadget preedit-selection-mode?<<
+ ] when
+ ] when
+ ] ;
+
+ METHOD: void unmarkText [
+ self window :> window
+ window [
+ window world-focus :> gadget
+ gadget [
+ gadget support-input-methods? [
+ gadget preedit? [
+ gadget {
+ [ preedit-start>> second ]
+ [ preedit-end>> second ]
+ [ preedit-start>> first ]
+ [ editor-line ]
+ } cleave subseq
+ gadget remove-preedit-text
+ gadget remove-preedit-info
+ gadget user-input* drop
] when
+ f gadget preedit-selection-mode?<<
] when
] when
- ] ;
-
- METHOD: id validAttributesForMarkedText [
- NSArray "NSMarkedClauseSegment" <NSString> -> arrayWithObject:
- ] ;
+ ] when
+ ] ;
+
+ METHOD: id validAttributesForMarkedText [
+ NSArray "NSMarkedClauseSegment" <NSString> -> arrayWithObject:
+ ] ;
METHOD: id attributedSubstringForProposedRange: NSRange aRange
actualRange: id actualRange [ f ] ;
-
+
METHOD: NSUInteger characterIndexForPoint: NSPoint point [ 0 ] ;
METHOD: NSRect firstRectForCharacterRange: NSRange aRange
actualRange: NSRange actualRange [
- self window :> window
- window [
- window world-focus :> gadget
- gadget [
- gadget support-input-methods? [
- gadget editor-caret first gadget editor-line :> str
- str aRange location>> >codepoint-index :> start-pos
- gadget editor-caret first start-pos 2array gadget loc>x
- gadget caret-loc second gadget caret-dim second +
- 2array ! character pos
- gadget screen-loc v+ ! + gadget pos
- { 1 -1 } v*
- window handle>> window>> dup -> frame -> contentRectForFrameRect:
- CGRect-top-left 2array v+ ! + window pos
- first2 [ >fixnum ] bi@ 0 gadget line-height >fixnum
- ] [ 0 0 0 0 ] if
+ self window :> window
+ window [
+ window world-focus :> gadget
+ gadget [
+ gadget support-input-methods? [
+ gadget editor-caret first gadget editor-line :> str
+ str aRange location>> >codepoint-index :> start-pos
+ gadget editor-caret first start-pos 2array gadget loc>x
+ gadget caret-loc second gadget caret-dim second +
+ 2array ! character pos
+ gadget screen-loc v+ ! + gadget pos
+ { 1 -1 } v*
+ window handle>> window>> dup -> frame -> contentRectForFrameRect:
+ CGRect-top-left 2array v+ ! + window pos
+ first2 [ >fixnum ] bi@ 0 gadget line-height >fixnum
] [ 0 0 0 0 ] if
] [ 0 0 0 0 ] if
- <CGRect>
- ] ;
+ ] [ 0 0 0 0 ] if
+ <CGRect>
+ ] ;
METHOD: void doCommandBySelector: SEL selector [ ] ;
-
- ! Initialization
- METHOD: void updateFactorGadgetSize: id notification
- [
- self window :> window
- window [
- self view-dim window dim<< yield
- ] when
- ] ;
+ ! Initialization
METHOD: id initWithFrame: NSRect frame pixelFormat: id pixelFormat
[
self frame pixelFormat SUPER-> initWithFrame:pixelFormat:
- dup dup add-resize-observer
] ;
METHOD: char isOpaque [ 0 ] ;
CGLSetParameter drop ;
: <FactorView> ( dim pixel-format -- view )
- [ FactorView ] 2dip <GLView> [ sync-refresh-to-screen ] keep ;
+ [ FactorView ] 2dip <GLView>
+ [ -> backingScaleFactor set-scale-factor ] keep
+ [ sync-refresh-to-screen ] keep ;
: save-position ( world window -- )
-> frame CGRect-top-left 2array >>window-loc drop ;
METHOD: void windowDidChangeBackingProperties: id notification
[
-
- notification -> object dup SEL: backingScaleFactor
- -> respondsToSelector: c-bool> [
- { double { id SEL } } ?-> backingScaleFactor
-
- [ [ 1.0 > ] keep f ? gl-scale-factor set-global ]
- [ 1.0 > retina? set-global ] bi
- ] [ drop ] if
+ notification -> object -> backingScaleFactor set-scale-factor
] ;
;CLASS>
projects / factor.git / blobdiff