factor: CLASS: ; to CLASS< CLASS>. More cleanups
parent
087f09bfd1
commit
cbdd80277e
|
@ -539,12 +539,11 @@ CONSTANT: factor-lexing-rules {
|
||||||
! } case ; inline
|
! } case ; inline
|
||||||
|
|
||||||
![[
|
![[
|
||||||
|
|
||||||
vocab-roots get [ vocabs-from reject-some-paths ] map concat
|
vocab-roots get [ vocabs-from reject-some-paths ] map concat
|
||||||
{
|
{
|
||||||
"specialized-arrays" "specialized-vectors"
|
"specialized-arrays" "specialized-vectors"
|
||||||
"math.blas.matrices" "math.blas.vectors" "math.vectors.simd"
|
"math.blas.matrices" "math.blas.vectors" "math.vectors.simd"
|
||||||
"math.vectors.simd.cords"
|
"math.vectors.simd.cords" "game.debug"
|
||||||
} diff
|
} diff
|
||||||
[ modern-source-path dup <pathname> . path>literals ] map-zip
|
[ modern-source-path dup <pathname> . path>literals ] map-zip
|
||||||
]]
|
]]
|
|
@ -3,11 +3,11 @@ cocoa.types compiler.test core-graphics.types kernel math memory
|
||||||
namespaces tools.test ;
|
namespaces tools.test ;
|
||||||
in: cocoa.tests
|
in: cocoa.tests
|
||||||
|
|
||||||
CLASS: Foo < NSObject
|
CLASS< Foo < NSObject
|
||||||
METHOD: void foo: NSRect rect [
|
METHOD: void foo: NSRect rect [
|
||||||
gc rect "x" set
|
gc rect "x" set
|
||||||
] ;
|
] ;
|
||||||
;
|
CLASS>
|
||||||
|
|
||||||
: test-foo ( -- )
|
: test-foo ( -- )
|
||||||
Foo send\ alloc send\ init
|
Foo send\ alloc send\ init
|
||||||
|
@ -21,9 +21,9 @@ CLASS: Foo < NSObject
|
||||||
{ 101.0 } [ "x" get CGRect-w ] unit-test
|
{ 101.0 } [ "x" get CGRect-w ] unit-test
|
||||||
{ 102.0 } [ "x" get CGRect-h ] unit-test
|
{ 102.0 } [ "x" get CGRect-h ] unit-test
|
||||||
|
|
||||||
CLASS: Bar < NSObject
|
CLASS< Bar < NSObject
|
||||||
METHOD: NSRect bar [ test-foo "x" get ] ;
|
METHOD: NSRect bar [ test-foo "x" get ] ;
|
||||||
;
|
CLASS>
|
||||||
|
|
||||||
{ } [
|
{ } [
|
||||||
Bar [
|
Bar [
|
||||||
|
@ -39,11 +39,11 @@ CLASS: Bar < NSObject
|
||||||
{ 102.0 } [ "x" get CGRect-h ] unit-test
|
{ 102.0 } [ "x" get CGRect-h ] unit-test
|
||||||
|
|
||||||
! Make sure that we can add methods
|
! Make sure that we can add methods
|
||||||
CLASS: Bar < NSObject
|
CLASS< Bar < NSObject
|
||||||
METHOD: NSRect bar [ test-foo "x" get ] ;
|
METHOD: NSRect bar [ test-foo "x" get ] ;
|
||||||
|
|
||||||
METHOD: int babb: int x [ x sq ] ;
|
METHOD: int babb: int x [ x sq ] ;
|
||||||
;
|
CLASS>
|
||||||
|
|
||||||
{ 144 } [
|
{ 144 } [
|
||||||
Bar [
|
Bar [
|
||||||
|
|
|
@ -1,23 +1,23 @@
|
||||||
USING: help.markup help.syntax strings alien hashtables ;
|
USING: help.markup help.syntax strings alien hashtables ;
|
||||||
in: cocoa.subclassing
|
in: cocoa.subclassing
|
||||||
|
|
||||||
HELP: \ CLASS:
|
HELP: \ CLASS<
|
||||||
{ $syntax "CLASS: name < superclass protocols... imeth... ;" }
|
{ $syntax "CLASS< name < superclass protocols... imeth... CLASS>" }
|
||||||
{ $values { "name" "a new class name" } { "superclass" "a superclass name" } { "protocols" "zero or more protocol names" } { "imeth" "instance method definitions using " { $link postpone\ METHOD: } } }
|
{ $values { "name" "a new class name" } { "superclass" "a superclass name" } { "protocols" "zero or more protocol names" } { "imeth" "instance method definitions using " { $link \ METHOD: } } }
|
||||||
{ $description "Defines a new Objective C class. Instance methods are defined with the " { $link postpone\ METHOD: } " parsing word."
|
{ $description "Defines a new Objective C class. Instance methods are defined with the " { $link \ METHOD: } " parsing word."
|
||||||
$nl
|
$nl
|
||||||
"This word is preferred to calling " { $link define-objc-class } ", because it creates a class word in the " { $vocab-link "cocoa.classes" } " vocabulary at parse time, allowing code to refer to the class word in the same source file where the class is defined." } ;
|
"This word is preferred to calling " { $link define-objc-class } ", because it creates a class word in the " { $vocab-link "cocoa.classes" } " vocabulary at parse time, allowing code to refer to the class word in the same source file where the class is defined." } ;
|
||||||
|
|
||||||
{ define-objc-class postpone\ CLASS: postpone\ METHOD: } related-words
|
{ define-objc-class \ CLASS< \ METHOD: } related-words
|
||||||
|
|
||||||
HELP: \ METHOD:
|
HELP: \ METHOD:
|
||||||
{ $syntax "METHOD: return foo: type1 arg1 bar: type2 arg2 baz: ... [ body ] ;" }
|
{ $syntax "METHOD: return foo: type1 arg1 bar: type2 arg2 baz: ... [ body ] ;" }
|
||||||
{ $values { "return" "a C type name" } { "type1" "a C type name" } { "arg1" "a local variable name" } { "body" "arbitrary code" } }
|
{ $values { "return" "a C type name" } { "type1" "a C type name" } { "arg1" "a local variable name" } { "body" "arbitrary code" } }
|
||||||
{ $description "Defines a method inside of a " { $link postpone\ CLASS: } " form." } ;
|
{ $description "Defines a method inside of a " { $link \ CLASS< } " form." } ;
|
||||||
|
|
||||||
ARTICLE: "objc-subclassing" "Subclassing Objective C classes"
|
ARTICLE: "objc-subclassing" "Subclassing Objective C classes"
|
||||||
"Objective C classes can be subclassed, with new methods defined in Factor, using parsing words:"
|
"Objective C classes can be subclassed, with new methods defined in Factor, using parsing words:"
|
||||||
{ $subsections postpone\ CLASS: postpone\ METHOD: }
|
{ $subsections \ CLASS< \ METHOD: }
|
||||||
"Objective C class definitions are saved in the image. If the image is saved and Factor is restarted with the saved image, custom class definitions are made available to the Objective C runtime when they are first accessed from within Factor." ;
|
"Objective C class definitions are saved in the image. If the image is saved and Factor is restarted with the saved image, custom class definitions are made available to the Objective C runtime when they are first accessed from within Factor." ;
|
||||||
|
|
||||||
about: "objc-subclassing"
|
about: "objc-subclassing"
|
||||||
|
|
|
@ -74,11 +74,13 @@ C: <cocoa-protocol> cocoa-protocol ;
|
||||||
SYNTAX: \ cocoa-protocol:
|
SYNTAX: \ cocoa-protocol:
|
||||||
scan-token <cocoa-protocol> suffix! ;
|
scan-token <cocoa-protocol> suffix! ;
|
||||||
|
|
||||||
SYNTAX: \ CLASS:
|
defer: \ CLASS> delimiter
|
||||||
|
|
||||||
|
SYNTAX: \ CLASS<
|
||||||
scan-token
|
scan-token
|
||||||
"<" expect
|
"<" expect
|
||||||
scan-token
|
scan-token
|
||||||
\ ; parse-until [ cocoa-protocol? ] partition
|
\ CLASS> parse-until [ cocoa-protocol? ] partition
|
||||||
[ [ name>> ] map ] dip define-objc-class ;
|
[ [ name>> ] map ] dip define-objc-class ;
|
||||||
|
|
||||||
: (parse-selector) ( -- )
|
: (parse-selector) ( -- )
|
||||||
|
|
|
@ -51,7 +51,7 @@ CONSTANT: key-locations H{
|
||||||
{ key-p { { 105 25 } { 10 10 } } }
|
{ key-p { { 105 25 } { 10 10 } } }
|
||||||
{ key-lbracket { { 115 25 } { 10 10 } } }
|
{ key-lbracket { { 115 25 } { 10 10 } } }
|
||||||
{ key-rbracket { { 125 25 } { 10 10 } } }
|
{ key-rbracket { { 125 25 } { 10 10 } } }
|
||||||
{ key-\ { { 135 25 } { 15 10 } } }
|
{ \ key-\ { { 135 25 } { 15 10 } } }
|
||||||
|
|
||||||
{ key-caps-lock { { 0 35 } { 20 10 } } }
|
{ key-caps-lock { { 0 35 } { 20 10 } } }
|
||||||
{ key-a { { 20 35 } { 10 10 } } }
|
{ key-a { { 20 35 } { 10 10 } } }
|
||||||
|
@ -63,7 +63,7 @@ CONSTANT: key-locations H{
|
||||||
{ key-j { { 80 35 } { 10 10 } } }
|
{ key-j { { 80 35 } { 10 10 } } }
|
||||||
{ key-k { { 90 35 } { 10 10 } } }
|
{ key-k { { 90 35 } { 10 10 } } }
|
||||||
{ key-l { { 100 35 } { 10 10 } } }
|
{ key-l { { 100 35 } { 10 10 } } }
|
||||||
{ key-; { { 110 35 } { 10 10 } } }
|
{ key-semi { { 110 35 } { 10 10 } } }
|
||||||
{ key-' { { 120 35 } { 10 10 } } }
|
{ key-' { { 120 35 } { 10 10 } } }
|
||||||
{ key-return { { 130 35 } { 20 10 } } }
|
{ key-return { { 130 35 } { 20 10 } } }
|
||||||
|
|
||||||
|
|
|
@ -51,7 +51,7 @@ CONSTANT: key-lbracket 0x002f ;
|
||||||
CONSTANT: key-rbracket 0x0030 ;
|
CONSTANT: key-rbracket 0x0030 ;
|
||||||
CONSTANT: key-\ 0x0031 ;
|
CONSTANT: key-\ 0x0031 ;
|
||||||
CONSTANT: key-#-non-us 0x0032 ;
|
CONSTANT: key-#-non-us 0x0032 ;
|
||||||
CONSTANT: key-; 0x0033 ;
|
CONSTANT: key-semi 0x0033 ;
|
||||||
CONSTANT: key-' 0x0034 ;
|
CONSTANT: key-' 0x0034 ;
|
||||||
CONSTANT: key-backtick 0x0035 ;
|
CONSTANT: key-backtick 0x0035 ;
|
||||||
CONSTANT: key-, 0x0036 ;
|
CONSTANT: key-, 0x0036 ;
|
||||||
|
|
|
@ -44,7 +44,7 @@ CONSTANT: environment-cube-map-mv-matrices
|
||||||
{ 0.0 0.0 1.0 0.0 }
|
{ 0.0 0.0 1.0 0.0 }
|
||||||
{ 0.0 0.0 0.0 1.0 }
|
{ 0.0 0.0 0.0 1.0 }
|
||||||
} }
|
} }
|
||||||
}
|
} ;
|
||||||
|
|
||||||
GLSL-SHADER: window-vertex-shader vertex-shader
|
GLSL-SHADER: window-vertex-shader vertex-shader
|
||||||
attribute vec2 vertex;
|
attribute vec2 vertex;
|
||||||
|
@ -104,7 +104,7 @@ CONSTANT: window-vertexes
|
||||||
-1.0 1.0
|
-1.0 1.0
|
||||||
1.0 -1.0
|
1.0 -1.0
|
||||||
1.0 1.0
|
1.0 1.0
|
||||||
}
|
} ;
|
||||||
|
|
||||||
: <window-vertex-buffer> ( -- buffer )
|
: <window-vertex-buffer> ( -- buffer )
|
||||||
window-vertexes
|
window-vertexes
|
||||||
|
|
|
@ -201,9 +201,9 @@ M: cocoa-ui-backend system-alert
|
||||||
} cleave
|
} cleave
|
||||||
] [ 2drop ] if* ;
|
] [ 2drop ] if* ;
|
||||||
|
|
||||||
CLASS: FactorApplicationDelegate < NSObject
|
CLASS< FactorApplicationDelegate < NSObject
|
||||||
METHOD: void applicationDidUpdate: id obj [ reset-thread-timer ] ;
|
METHOD: void applicationDidUpdate: id obj [ reset-thread-timer ] ;
|
||||||
;
|
CLASS>
|
||||||
|
|
||||||
: install-app-delegate ( -- )
|
: install-app-delegate ( -- )
|
||||||
NSApp FactorApplicationDelegate install-delegate ;
|
NSApp FactorApplicationDelegate install-delegate ;
|
||||||
|
|
|
@ -21,7 +21,7 @@ in: ui.backend.cocoa.tools
|
||||||
image-path save-panel [ save-image ] when* ;
|
image-path save-panel [ save-image ] when* ;
|
||||||
|
|
||||||
! Handle Open events from the Finder
|
! Handle Open events from the Finder
|
||||||
CLASS: FactorWorkspaceApplicationDelegate < FactorApplicationDelegate
|
CLASS< FactorWorkspaceApplicationDelegate < FactorApplicationDelegate
|
||||||
|
|
||||||
METHOD: void application: id app openFiles: id files [ files finder-run-files ] ;
|
METHOD: void application: id app openFiles: id files [ files finder-run-files ] ;
|
||||||
|
|
||||||
|
@ -46,7 +46,7 @@ CLASS: FactorWorkspaceApplicationDelegate < FactorApplicationDelegate
|
||||||
METHOD: id switchDarkTheme: id app [ dark-mode f ] ;
|
METHOD: id switchDarkTheme: id app [ dark-mode f ] ;
|
||||||
|
|
||||||
METHOD: id refreshAll: id app [ [ refresh-all ] \ refresh-all call-listener f ] ;
|
METHOD: id refreshAll: id app [ [ refresh-all ] \ refresh-all call-listener f ] ;
|
||||||
;
|
CLASS>
|
||||||
|
|
||||||
: install-app-delegate ( -- )
|
: install-app-delegate ( -- )
|
||||||
NSApp FactorWorkspaceApplicationDelegate install-delegate ;
|
NSApp FactorWorkspaceApplicationDelegate install-delegate ;
|
||||||
|
@ -57,7 +57,7 @@ CLASS: FactorWorkspaceApplicationDelegate < FactorApplicationDelegate
|
||||||
dup [ quot call( string -- result/f ) ] when
|
dup [ quot call( string -- result/f ) ] when
|
||||||
[ pboard set-pasteboard-string ] when* ;
|
[ pboard set-pasteboard-string ] when* ;
|
||||||
|
|
||||||
CLASS: FactorServiceProvider < NSObject
|
CLASS< FactorServiceProvider < NSObject
|
||||||
|
|
||||||
METHOD: void evalInListener: id pboard userData: id userData error: id error
|
METHOD: void evalInListener: id pboard userData: id userData error: id error
|
||||||
[ pboard error [ eval-listener f ] do-service ] ;
|
[ pboard error [ eval-listener f ] do-service ] ;
|
||||||
|
@ -67,7 +67,7 @@ CLASS: FactorServiceProvider < NSObject
|
||||||
pboard error
|
pboard error
|
||||||
[ [ (eval>string) ] with-interactive-vocabs ] do-service
|
[ [ (eval>string) ] with-interactive-vocabs ] do-service
|
||||||
] ;
|
] ;
|
||||||
;
|
CLASS>
|
||||||
|
|
||||||
: register-services ( -- )
|
: register-services ( -- )
|
||||||
NSApp
|
NSApp
|
||||||
|
|
|
@ -160,7 +160,7 @@ CONSTANT: selector>action H{
|
||||||
selector>action at
|
selector>action at
|
||||||
[ swap world-focus parents-handle-gesture? t ] [ drop f f ] if* ;
|
[ swap world-focus parents-handle-gesture? t ] [ drop f f ] if* ;
|
||||||
|
|
||||||
CLASS: FactorView < NSOpenGLView
|
CLASS< FactorView < NSOpenGLView
|
||||||
cocoa-protocol: NSTextInput
|
cocoa-protocol: NSTextInput
|
||||||
|
|
||||||
METHOD: void prepareOpenGL [
|
METHOD: void prepareOpenGL [
|
||||||
|
@ -364,7 +364,8 @@ CLASS: FactorView < NSOpenGLView
|
||||||
self remove-observer
|
self remove-observer
|
||||||
self super-send\ dealloc
|
self super-send\ dealloc
|
||||||
] ;
|
] ;
|
||||||
;
|
|
||||||
|
CLASS>
|
||||||
|
|
||||||
: sync-refresh-to-screen ( GLView -- )
|
: sync-refresh-to-screen ( GLView -- )
|
||||||
send\ openGLContext send\ CGLContextObj NSOpenGLCPSwapInterval 1 int <ref>
|
send\ openGLContext send\ CGLContextObj NSOpenGLCPSwapInterval 1 int <ref>
|
||||||
|
@ -376,7 +377,7 @@ CLASS: FactorView < NSOpenGLView
|
||||||
: save-position ( world window -- )
|
: save-position ( world window -- )
|
||||||
send\ frame CGRect-top-left 2array >>window-loc drop ;
|
send\ frame CGRect-top-left 2array >>window-loc drop ;
|
||||||
|
|
||||||
CLASS: FactorWindowDelegate < NSObject
|
CLASS< FactorWindowDelegate < NSObject
|
||||||
|
|
||||||
METHOD: void windowDidMove: id notification
|
METHOD: void windowDidMove: id notification
|
||||||
[
|
[
|
||||||
|
@ -422,7 +423,7 @@ CLASS: FactorWindowDelegate < NSObject
|
||||||
[ 1.0 > retina? set-global ] bi
|
[ 1.0 > retina? set-global ] bi
|
||||||
] [ drop ] if
|
] [ drop ] if
|
||||||
] ;
|
] ;
|
||||||
;
|
CLASS>
|
||||||
|
|
||||||
: install-window-delegate ( window -- )
|
: install-window-delegate ( window -- )
|
||||||
FactorWindowDelegate install-delegate ;
|
FactorWindowDelegate install-delegate ;
|
||||||
|
|
|
@ -17,17 +17,17 @@ M: glue pref-dim* drop { 0 0 } ;
|
||||||
: <frame-grid> ( cols rows -- grid )
|
: <frame-grid> ( cols rows -- grid )
|
||||||
swap '[ _ [ <glue> ] replicate ] replicate ;
|
swap '[ _ [ <glue> ] replicate ] replicate ;
|
||||||
|
|
||||||
: (fill- ( frame grid-layout quot1 quot2 -- pref-dim gap filled-cell dims )
|
: fill- ( frame grid-layout quot1 quot2 -- pref-dim gap filled-cell dims )
|
||||||
[ '[ [ dim>> ] [ gap>> ] [ filled-cell>> ] tri _ tri@ ] dip ] dip call ; inline
|
[ '[ [ dim>> ] [ gap>> ] [ filled-cell>> ] tri _ tri@ ] dip ] dip call ; inline
|
||||||
|
|
||||||
: available-space ( pref-dim gap dims -- avail )
|
: available-space ( pref-dim gap dims -- avail )
|
||||||
length 1 + * [-] ; inline
|
length 1 + * [-] ; inline
|
||||||
|
|
||||||
: -center) ( pref-dim gap filled-cell dims -- )
|
: -center ( pref-dim gap filled-cell dims -- )
|
||||||
[ nip available-space ]
|
[ nip available-space ]
|
||||||
[ [ remove-nth sum [-] ] [ set-nth ] 2bi ] 2bi ; inline
|
[ [ remove-nth sum [-] ] [ set-nth ] 2bi ] 2bi ; inline
|
||||||
|
|
||||||
: (fill-center) ( frame grid-layout quot1 quot2 -- ) (fill- -center) ; inline
|
: (fill-center) ( frame grid-layout quot1 quot2 -- ) fill- -center ; inline
|
||||||
|
|
||||||
: fill-center ( frame grid-layout -- )
|
: fill-center ( frame grid-layout -- )
|
||||||
[ [ first ] [ column-widths>> ] (fill-center) ]
|
[ [ first ] [ column-widths>> ] (fill-center) ]
|
||||||
|
|
|
@ -19,7 +19,7 @@ PRIVATE<
|
||||||
{ char: \t "\\t" }
|
{ char: \t "\\t" }
|
||||||
{ char: \\ "\\\\" }
|
{ char: \\ "\\\\" }
|
||||||
{ char: \( "\\(" }
|
{ char: \( "\\(" }
|
||||||
{ char: ) "\\)" }
|
{ char: \) "\\)" }
|
||||||
} escape-string-by ;
|
} escape-string-by ;
|
||||||
|
|
||||||
PRIVATE>
|
PRIVATE>
|
||||||
|
|
|
@ -18,7 +18,7 @@ PRIVATE<
|
||||||
{ char: \t "\\t" }
|
{ char: \t "\\t" }
|
||||||
{ char: \\ "\\\\" }
|
{ char: \\ "\\\\" }
|
||||||
{ char: \( "\\(" }
|
{ char: \( "\\(" }
|
||||||
{ char: ) "\\)" }
|
{ char: \) "\\)" }
|
||||||
} escape-string-by "(" ")" surround ;
|
} escape-string-by "(" ")" surround ;
|
||||||
|
|
||||||
: pdf-object ( str n -- str' )
|
: pdf-object ( str n -- str' )
|
||||||
|
|
|
@ -125,11 +125,11 @@ PRIVATE<
|
||||||
[ 2 tail* ?first (complete-single-vocab?) ] [ drop f ] if
|
[ 2 tail* ?first (complete-single-vocab?) ] [ drop f ] if
|
||||||
] if ;
|
] if ;
|
||||||
|
|
||||||
: chop-; ( seq -- seq' )
|
: chop-semi ( seq -- seq' )
|
||||||
{ ";" } split1-last [ ] [ ] ?if ;
|
{ ";" } split1-last [ ] [ ] ?if ;
|
||||||
|
|
||||||
: complete-vocab-list? ( tokens -- ? )
|
: complete-vocab-list? ( tokens -- ? )
|
||||||
chop-; 1 short head* "USING:" swap member? ;
|
chop-semi 1 short head* "USING:" swap member? ;
|
||||||
|
|
||||||
PRIVATE>
|
PRIVATE>
|
||||||
|
|
||||||
|
|
|
@ -6,13 +6,13 @@ kernel math ;
|
||||||
FROM: alien.c-types => float ;
|
FROM: alien.c-types => float ;
|
||||||
in: tools.deploy.test.14
|
in: tools.deploy.test.14
|
||||||
|
|
||||||
CLASS: Bar < NSObject
|
CLASS< Bar < NSObject
|
||||||
METHOD: float bar: NSRect rect [
|
METHOD: float bar: NSRect rect [
|
||||||
rect origin>> [ x>> ] [ y>> ] bi +
|
rect origin>> [ x>> ] [ y>> ] bi +
|
||||||
rect size>> [ w>> ] [ h>> ] bi +
|
rect size>> [ w>> ] [ h>> ] bi +
|
||||||
+
|
+
|
||||||
] ;
|
] ;
|
||||||
;
|
CLASS>
|
||||||
|
|
||||||
: main ( -- )
|
: main ( -- )
|
||||||
Bar send\ alloc send\ init
|
Bar send\ alloc send\ init
|
||||||
|
|
Loading…
Reference in New Issue