: <PixelFormat> ( attributes -- pixelfmt )
NSOpenGLPixelFormat -> alloc swap [
%
- NSOpenGLPFAWindow ,
- NSOpenGLPFADoubleBuffer ,
NSOpenGLPFADepthSize , 16 ,
+software-renderer+ get [
NSOpenGLPFARendererID , kCGLRendererGenericFloatID ,
-> autorelease ;
: <GLView> ( class dim -- view )
- [ -> alloc 0 0 ] dip first2 <NSRect> { } <PixelFormat>
+ [ -> alloc 0 0 ] dip first2 <NSRect>
+ NSOpenGLPFAWindow NSOpenGLPFADoubleBuffer 2array <PixelFormat>
-> initWithFrame:pixelFormat:
dup 1 -> setPostsBoundsChangedNotifications:
dup 1 -> setPostsFrameChangedNotifications: ;
C: <window-handle> window-handle
C: <offscreen-handle> offscreen-handle
+! XXX gross!
M: offscreen-handle window>> drop f ;
M: offscreen-handle view>> drop f ;
{ [ * * malloc ] [ 2drop ] [ drop nip ] [ nip * ] } 3cleave ;
: gadget-offscreen-context ( world -- context buffer )
- { NSOpenGLPFAOffScreen } <PixelFormat>
- [ NSOpenGLContext -> alloc swap f -> initWithFormat:shareContext: dup ]
- [ offscreen-buffer ] bi
+ NSOpenGLPFAOffScreen 1array <PixelFormat>
+ [ nip NSOpenGLContext -> alloc swap f -> initWithFormat:shareContext: dup ]
+ [ offscreen-buffer ] 2bi
4 npick [ -> setOffScreen:width:height:rowbytes: ] dip ;
M: cocoa-ui-backend (open-offscreen-buffer) ( world -- )
fonts handle
window-loc ;
+TUPLE: offscreen-world < world ;
+
: find-world ( gadget -- world/f ) [ world? ] find-parent ;
: show-status ( string/f gadget -- )
2dup eq?
[ 2drop ] [ dup focused?>> (request-focus) ] if ;
-: <world> ( gadget title status -- world )
- { 0 1 } world new-track
+: new-world ( gadget title status class -- world )
+ { 0 1 } swap new-track
t >>root?
t >>active?
H{ } clone >>fonts
swap 1 track-add
dup request-focus ;
+: <world> ( gadget title status -- world )
+ world new-world ;
+: <offscreen-world> ( gadget title status -- world )
+ offscreen-world new-world ;
+
M: world layout*
dup call-next-method
dup glass>> [
focus-path f swap focus-gestures ;
M: world graft*
- dup (open-window)
- dup title>> over set-title
- request-focus ;
+ [ (open-window) ]
+ [ [ title>> ] keep set-title ]
+ [ request-focus ] tri ;
: reset-world ( world -- )
#! This is used when a window is being closed, but also
#! when restoring saved worlds on image startup.
- dup fonts>> clear-assoc
- dup unfocus-world
- f >>handle drop ;
+ [ fonts>> clear-assoc ]
+ [ unfocus-world ]
+ [ f >>handle drop ] tri ;
+
+: (ungraft-world) ( world -- )
+ [ free-fonts ]
+ [ hand-clicked close-global ]
+ [ hand-gadget close-global ] tri ;
M: world ungraft*
- dup free-fonts
- dup hand-clicked close-global
- dup hand-gadget close-global
- dup handle>> (close-window)
- reset-world ;
+ [ (ungraft-world) ]
+ [ handle>> (close-window) ]
+ [ reset-world ] tri ;
+
+M: offscreen-world graft*
+ (open-offscreen-buffer) ;
+
+M: offscreen-world ungraft*
+ [ (ungraft-world) ]
+ [ handle>> (close-offscreen-buffer) ]
+ [ reset-world ] tri ;
: find-window ( quot -- world )
windows get values
swap [ >>array ] [ >>color-index ] bi
24 >>bit-count ;
+: bgra>bitmap ( array height width -- bitmap )
+ bitmap new
+ 2over * 4 * >>size-image
+ swap >>height
+ swap >>width
+ swap [ >>array ] [ >>color-index ] bi
+ 32 >>bit-count ;
+
: 8bit>array ( bitmap -- array )
[ rgb-quads>> 4 <sliced-groups> [ 3 head-slice ] map ]
[ color-index>> >array ] bi [ swap nth ] with map concat ;