From 0b42f11683c5852e2b7072ccfb66fa76603eec4b Mon Sep 17 00:00:00 2001 From: Joe Groff Date: Mon, 8 Dec 2008 19:30:10 -0800 Subject: [PATCH 01/18] cocoa backend for offscreen world rendering --- basis/cocoa/views/views.factor | 7 +++-- basis/ui/backend/backend.factor | 8 ++++-- basis/ui/cocoa/cocoa.factor | 49 +++++++++++++++++++++++++++------ 3 files changed, 52 insertions(+), 12 deletions(-) diff --git a/basis/cocoa/views/views.factor b/basis/cocoa/views/views.factor index be67f03184..f8e95dad40 100644 --- a/basis/cocoa/views/views.factor +++ b/basis/cocoa/views/views.factor @@ -55,8 +55,11 @@ PRIVATE> : with-multisample ( quot -- ) t +multisample+ pick with-variable ; inline -: ( -- pixelfmt ) + + +: ( attributes -- pixelfmt ) NSOpenGLPixelFormat -> alloc [ + % NSOpenGLPFAWindow , NSOpenGLPFADoubleBuffer , NSOpenGLPFADepthSize , 16 , @@ -74,7 +77,7 @@ PRIVATE> -> autorelease ; : ( class dim -- view ) - [ -> alloc 0 0 ] dip first2 + [ -> alloc 0 0 ] dip first2 { } -> initWithFrame:pixelFormat: dup 1 -> setPostsBoundsChangedNotifications: dup 1 -> setPostsFrameChangedNotifications: ; diff --git a/basis/ui/backend/backend.factor b/basis/ui/backend/backend.factor index 0840d07cbc..8d5109ac7f 100644 --- a/basis/ui/backend/backend.factor +++ b/basis/ui/backend/backend.factor @@ -17,11 +17,15 @@ HOOK: (open-window) ui-backend ( world -- ) HOOK: (close-window) ui-backend ( handle -- ) +HOOK: (open-offscreen-buffer) ui-backend ( world -- ) + +HOOK: (close-offscreen-buffer) ui-backend ( handle -- ) + HOOK: raise-window* ui-backend ( world -- ) -HOOK: select-gl-context ui-backend ( handle -- ) +GENERIC: select-gl-context ( handle -- ) -HOOK: flush-gl-context ui-backend ( handle -- ) +GENERIC: flush-gl-context ( handle -- ) HOOK: beep ui-backend ( -- ) diff --git a/basis/ui/cocoa/cocoa.factor b/basis/ui/cocoa/cocoa.factor index a9b3b03b75..8861f8ffa2 100644 --- a/basis/ui/cocoa/cocoa.factor +++ b/basis/ui/cocoa/cocoa.factor @@ -5,12 +5,19 @@ command-line kernel memory namespaces cocoa.messages cocoa.runtime cocoa.subclassing cocoa.pasteboard cocoa.types cocoa.windows cocoa.classes cocoa.application sequences system ui ui.backend ui.clipboards ui.gadgets ui.gadgets.worlds -ui.cocoa.views core-foundation threads math.geometry.rect fry ; +ui.cocoa.views core-foundation threads math.geometry.rect fry +libc generalizations ; IN: ui.cocoa -TUPLE: handle view window ; +TUPLE: handle ; +TUPLE: window-handle < handle view window ; +TUPLE: offscreen-handle < handle context buffer ; -C: handle +C: window-handle +C: offscreen-handle + +M: offscreen-handle window>> f ; +M: offscreen-handle view>> f ; SINGLETON: cocoa-ui-backend @@ -38,7 +45,8 @@ M: pasteboard set-clipboard-contents : gadget-window ( world -- ) dup 2dup swap world>NSRect - [ [ -> release ] [ install-window-delegate ] bi* ] [ ] 2bi + [ [ -> release ] [ install-window-delegate ] bi* ] + [ ] 2bi >>handle drop ; M: cocoa-ui-backend set-title ( string world -- ) @@ -87,11 +95,36 @@ M: cocoa-ui-backend raise-window* ( world -- ) NSApp 1 -> activateIgnoringOtherApps: ] when* ; -M: cocoa-ui-backend select-gl-context ( handle -- ) - view>> -> openGLContext -> makeCurrentContext ; +: pixel-size ( pixel-format -- size ) + 0 [ NSOpenGLPFAColorSize 0 -> getValues:forAttribute:forVirtualScreen: ] + keep *int -3 shift ; -M: cocoa-ui-backend flush-gl-context ( handle -- ) - view>> -> openGLContext -> flushBuffer ; +: offscreen-buffer ( world pixel-format -- alien w h pitch ) + [ dim>> first2 ] [ pixel-size ] bi* + { [ * * malloc ] [ 2drop ] [ drop nip ] [ nip * ] } cleave ; + +: gadget-offscreen-context ( world -- context buffer ) + { NSOpenGLPFAOffscreen } + [ NSOpenGLContext -> alloc swap f -> initWithFormat:shareContext: ] + [ offscreen-buffer ] bi + 4 npick [ setOffScreen:width:height:rowbytes: ] dip ; + +M: cocoa-ui-backend (open-offscreen-buffer) ( world -- ) + dup gadget-offscreen-context >>handle drop ; + +M: cocoa-ui-backend (close-offscreen-buffer) ( handle -- ) + [ context>> -> release ] + [ buffer>> free ] bi ; + +GENERIC: gl-context ( handle -- context ) +M: window-handle gl-context view>> -> openGLContext ; +M: offscreen-handle gl-context context>> ; + +M: handle select-gl-context ( handle -- ) + gl-context -> makeCurrentContext ; + +M: handle flush-gl-context ( handle -- ) + gl-context -> flushBuffer ; M: cocoa-ui-backend beep ( -- ) NSBeep ; From 02e961ac7750d7902f5858b54226b805aae46340 Mon Sep 17 00:00:00 2001 From: Joe Groff Date: Mon, 8 Dec 2008 21:00:47 -0800 Subject: [PATCH 02/18] cocoa ui compile fixes --- basis/cocoa/views/views.factor | 4 +--- basis/ui/cocoa/cocoa.factor | 14 +++++++------- 2 files changed, 8 insertions(+), 10 deletions(-) diff --git a/basis/cocoa/views/views.factor b/basis/cocoa/views/views.factor index f8e95dad40..dded68df4d 100644 --- a/basis/cocoa/views/views.factor +++ b/basis/cocoa/views/views.factor @@ -55,10 +55,8 @@ PRIVATE> : with-multisample ( quot -- ) t +multisample+ pick with-variable ; inline - - : ( attributes -- pixelfmt ) - NSOpenGLPixelFormat -> alloc [ + NSOpenGLPixelFormat -> alloc swap [ % NSOpenGLPFAWindow , NSOpenGLPFADoubleBuffer , diff --git a/basis/ui/cocoa/cocoa.factor b/basis/ui/cocoa/cocoa.factor index 811d35a8a1..e4fa95d08d 100644 --- a/basis/ui/cocoa/cocoa.factor +++ b/basis/ui/cocoa/cocoa.factor @@ -6,7 +6,7 @@ cocoa.runtime cocoa.subclassing cocoa.pasteboard cocoa.types cocoa.windows cocoa.classes cocoa.application sequences system ui ui.backend ui.clipboards ui.gadgets ui.gadgets.worlds ui.cocoa.views core-foundation threads math.geometry.rect fry -libc generalizations ; +libc generalizations alien.c-types cocoa.views combinators ; IN: ui.cocoa TUPLE: handle ; @@ -16,8 +16,8 @@ TUPLE: offscreen-handle < handle context buffer ; C: window-handle C: offscreen-handle -M: offscreen-handle window>> f ; -M: offscreen-handle view>> f ; +M: offscreen-handle window>> drop f ; +M: offscreen-handle view>> drop f ; SINGLETON: cocoa-ui-backend @@ -101,13 +101,13 @@ M: cocoa-ui-backend raise-window* ( world -- ) : offscreen-buffer ( world pixel-format -- alien w h pitch ) [ dim>> first2 ] [ pixel-size ] bi* - { [ * * malloc ] [ 2drop ] [ drop nip ] [ nip * ] } cleave ; + { [ * * malloc ] [ 2drop ] [ drop nip ] [ nip * ] } 3cleave ; : gadget-offscreen-context ( world -- context buffer ) - { NSOpenGLPFAOffscreen } - [ NSOpenGLContext -> alloc swap f -> initWithFormat:shareContext: ] + { NSOpenGLPFAOffScreen } + [ NSOpenGLContext -> alloc swap f -> initWithFormat:shareContext: dup ] [ offscreen-buffer ] bi - 4 npick [ setOffScreen:width:height:rowbytes: ] dip ; + 4 npick [ -> setOffScreen:width:height:rowbytes: ] dip ; M: cocoa-ui-backend (open-offscreen-buffer) ( world -- ) dup gadget-offscreen-context >>handle drop ; From 4307234550b1a03ea79b26bd88b5e3092f24b290 Mon Sep 17 00:00:00 2001 From: Joe Groff Date: Mon, 8 Dec 2008 23:13:26 -0800 Subject: [PATCH 03/18] literals vocab. you can interpolate CONSTANT-WORD values into a literal sequence with { $ CONSTANT-WORD } . --- extra/literals/literals-tests.factor | 12 ++++++++++++ extra/literals/literals.factor | 4 ++++ 2 files changed, 16 insertions(+) create mode 100644 extra/literals/literals-tests.factor create mode 100644 extra/literals/literals.factor diff --git a/extra/literals/literals-tests.factor b/extra/literals/literals-tests.factor new file mode 100644 index 0000000000..b88a286a59 --- /dev/null +++ b/extra/literals/literals-tests.factor @@ -0,0 +1,12 @@ +USING: kernel literals tools.test ; +IN: literals.tests + +<< +: five 5 ; +: seven-eleven 7 11 ; +: six-six-six 6 6 6 ; +>> + +[ { 5 } ] [ { $ five } ] unit-test +[ { 7 11 } ] [ { $ seven-eleven } ] unit-test +[ { 6 6 6 } ] [ { $ six-six-six } ] unit-test diff --git a/extra/literals/literals.factor b/extra/literals/literals.factor new file mode 100644 index 0000000000..d46f492cd4 --- /dev/null +++ b/extra/literals/literals.factor @@ -0,0 +1,4 @@ +USING: continuations kernel parser words ; +IN: literals + +: $ scan-word [ execute ] curry with-datastack ; parsing From ec98a6c83db990301c44cfc902a35c494e7a69e7 Mon Sep 17 00:00:00 2001 From: Joe Groff Date: Tue, 9 Dec 2008 09:22:23 -0800 Subject: [PATCH 04/18] offscreen-world widgets and offscreen pixel format fixes --- basis/cocoa/views/views.factor | 5 ++-- basis/ui/cocoa/cocoa.factor | 7 +++--- basis/ui/gadgets/worlds/worlds.factor | 11 +++++++-- basis/ui/ui.factor | 33 ++++++++++++++++++--------- extra/graphics/bitmap/bitmap.factor | 8 +++++++ 5 files changed, 45 insertions(+), 19 deletions(-) diff --git a/basis/cocoa/views/views.factor b/basis/cocoa/views/views.factor index dded68df4d..03cafd0a0a 100644 --- a/basis/cocoa/views/views.factor +++ b/basis/cocoa/views/views.factor @@ -58,8 +58,6 @@ PRIVATE> : ( attributes -- pixelfmt ) NSOpenGLPixelFormat -> alloc swap [ % - NSOpenGLPFAWindow , - NSOpenGLPFADoubleBuffer , NSOpenGLPFADepthSize , 16 , +software-renderer+ get [ NSOpenGLPFARendererID , kCGLRendererGenericFloatID , @@ -75,7 +73,8 @@ PRIVATE> -> autorelease ; : ( class dim -- view ) - [ -> alloc 0 0 ] dip first2 { } + [ -> alloc 0 0 ] dip first2 + NSOpenGLPFAWindow NSOpenGLPFADoubleBuffer 2array -> initWithFrame:pixelFormat: dup 1 -> setPostsBoundsChangedNotifications: dup 1 -> setPostsFrameChangedNotifications: ; diff --git a/basis/ui/cocoa/cocoa.factor b/basis/ui/cocoa/cocoa.factor index e4fa95d08d..cafe928b3c 100644 --- a/basis/ui/cocoa/cocoa.factor +++ b/basis/ui/cocoa/cocoa.factor @@ -16,6 +16,7 @@ TUPLE: offscreen-handle < handle context buffer ; C: window-handle C: offscreen-handle +! XXX gross! M: offscreen-handle window>> drop f ; M: offscreen-handle view>> drop f ; @@ -104,9 +105,9 @@ M: cocoa-ui-backend raise-window* ( world -- ) { [ * * malloc ] [ 2drop ] [ drop nip ] [ nip * ] } 3cleave ; : gadget-offscreen-context ( world -- context buffer ) - { NSOpenGLPFAOffScreen } - [ NSOpenGLContext -> alloc swap f -> initWithFormat:shareContext: dup ] - [ offscreen-buffer ] bi + NSOpenGLPFAOffScreen 1array + [ 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 -- ) diff --git a/basis/ui/gadgets/worlds/worlds.factor b/basis/ui/gadgets/worlds/worlds.factor index 68a2a18210..d442e16ac4 100644 --- a/basis/ui/gadgets/worlds/worlds.factor +++ b/basis/ui/gadgets/worlds/worlds.factor @@ -13,6 +13,8 @@ title status fonts handle window-loc ; +TUPLE: offscreen-world < world ; + : find-world ( gadget -- world/f ) [ world? ] find-parent ; : show-status ( string/f gadget -- ) @@ -38,8 +40,8 @@ M: world request-focus-on ( child gadget -- ) 2dup eq? [ 2drop ] [ dup focused?>> (request-focus) ] if ; -: ( 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 @@ -49,6 +51,11 @@ M: world request-focus-on ( child gadget -- ) swap 1 track-add dup request-focus ; +: ( gadget title status -- world ) + world new-world ; +: ( gadget title status -- world ) + offscreen-world new-world ; + M: world layout* dup call-next-method dup glass>> [ diff --git a/basis/ui/ui.factor b/basis/ui/ui.factor index de2eb71307..3674f48efe 100644 --- a/basis/ui/ui.factor +++ b/basis/ui/ui.factor @@ -60,23 +60,34 @@ SYMBOL: stop-after-last-window? 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 diff --git a/extra/graphics/bitmap/bitmap.factor b/extra/graphics/bitmap/bitmap.factor index 4c35e3d7d0..e3191b3866 100755 --- a/extra/graphics/bitmap/bitmap.factor +++ b/extra/graphics/bitmap/bitmap.factor @@ -23,6 +23,14 @@ TUPLE: bitmap magic size reserved offset header-length width 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 [ 3 head-slice ] map ] [ color-index>> >array ] bi [ swap nth ] with map concat ; From c861ed9e2c4f00e6770df5d370e19670a6b958f1 Mon Sep 17 00:00:00 2001 From: Joe Groff Date: Tue, 9 Dec 2008 09:30:05 -0800 Subject: [PATCH 05/18] reenable BGRA case in draw-image --- extra/graphics/bitmap/bitmap.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/extra/graphics/bitmap/bitmap.factor b/extra/graphics/bitmap/bitmap.factor index e3191b3866..ae37ef0c5c 100755 --- a/extra/graphics/bitmap/bitmap.factor +++ b/extra/graphics/bitmap/bitmap.factor @@ -132,7 +132,7 @@ M: bitmap draw-image ( bitmap -- ) [ [ height>> abs ] keep bit-count>> { - ! { 32 [ GL_BGRA GL_UNSIGNED_INT_8_8_8_8 ] } ! broken + { 32 [ GL_BGRA GL_UNSIGNED_BYTE ] } { 24 [ GL_BGR GL_UNSIGNED_BYTE ] } { 8 [ GL_BGR GL_UNSIGNED_BYTE ] } { 4 [ GL_BGR GL_UNSIGNED_BYTE ] } From 98c0daae2a7d9aed759b81e005c3ff561420810a Mon Sep 17 00:00:00 2001 From: Joe Groff Date: Tue, 9 Dec 2008 10:07:57 -0800 Subject: [PATCH 06/18] Move offscreen-world widget and support words into ui.offscreen vocab --- basis/ui/backend/backend.factor | 2 ++ basis/ui/cocoa/cocoa.factor | 17 ++++++++--------- basis/ui/ui.factor | 8 -------- extra/ui/offscreen/offscreen.factor | 24 ++++++++++++++++++++++++ 4 files changed, 34 insertions(+), 17 deletions(-) create mode 100644 extra/ui/offscreen/offscreen.factor diff --git a/basis/ui/backend/backend.factor b/basis/ui/backend/backend.factor index 8d5109ac7f..7b808bb2be 100644 --- a/basis/ui/backend/backend.factor +++ b/basis/ui/backend/backend.factor @@ -27,6 +27,8 @@ GENERIC: select-gl-context ( handle -- ) GENERIC: flush-gl-context ( handle -- ) +GENERIC: offscreen-pixels ( handle -- alien ) + HOOK: beep ui-backend ( -- ) : with-gl-context ( handle quot -- ) diff --git a/basis/ui/cocoa/cocoa.factor b/basis/ui/cocoa/cocoa.factor index cafe928b3c..6e19f3ffe6 100644 --- a/basis/ui/cocoa/cocoa.factor +++ b/basis/ui/cocoa/cocoa.factor @@ -16,10 +16,6 @@ TUPLE: offscreen-handle < handle context buffer ; C: window-handle C: offscreen-handle -! XXX gross! -M: offscreen-handle window>> drop f ; -M: offscreen-handle view>> drop f ; - SINGLETON: cocoa-ui-backend M: cocoa-ui-backend do-events ( -- ) @@ -117,15 +113,18 @@ M: cocoa-ui-backend (close-offscreen-buffer) ( handle -- ) [ context>> -> release ] [ buffer>> free ] bi ; -GENERIC: gl-context ( handle -- context ) -M: window-handle gl-context view>> -> openGLContext ; -M: offscreen-handle gl-context context>> ; +GENERIC: (gl-context) ( handle -- context ) +M: window-handle (gl-context) view>> -> openGLContext ; +M: offscreen-handle (gl-context) context>> ; M: handle select-gl-context ( handle -- ) - gl-context -> makeCurrentContext ; + (gl-context) -> makeCurrentContext ; M: handle flush-gl-context ( handle -- ) - gl-context -> flushBuffer ; + (gl-context) -> flushBuffer ; + +M: offscreen-handle offscreen-pixels ( handle -- alien ) + buffer>> ; M: cocoa-ui-backend beep ( -- ) NSBeep ; diff --git a/basis/ui/ui.factor b/basis/ui/ui.factor index 3674f48efe..cf2a657439 100644 --- a/basis/ui/ui.factor +++ b/basis/ui/ui.factor @@ -81,14 +81,6 @@ M: world ungraft* [ 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 [ gadget-child swap call ] with find-last nip ; inline diff --git a/extra/ui/offscreen/offscreen.factor b/extra/ui/offscreen/offscreen.factor new file mode 100644 index 0000000000..c246453082 --- /dev/null +++ b/extra/ui/offscreen/offscreen.factor @@ -0,0 +1,24 @@ +USING: accessors graphics.bitmap kernel math sequences +ui.gadgets ui.gadgets.worlds ui ui.backend ; +IN: ui.offscreen + +TUPLE: offscreen-world < world ; + +: ( gadget title status -- world ) + offscreen-world new-world ; + +M: offscreen-world graft* + (open-offscreen-buffer) ; + +M: offscreen-world ungraft* + [ (ungraft-world) ] + [ handle>> (close-offscreen-buffer) ] + [ reset-world ] tri ; + +: open-offscreen ( gadget -- world ) + "" f [ open-world-window ] keep ; + +: offscreen-world>bitmap ( world -- bitmap ) + [ handle>> offscreen-pixels ] [ dim>> first2 neg ] bi + bgra>bitmap ; + From 4f6ed727d0b1bd7ead23699d5c4d283a33774d80 Mon Sep 17 00:00:00 2001 From: Joe Groff Date: Tue, 9 Dec 2008 10:19:14 -0800 Subject: [PATCH 07/18] Tweak windows and x11 backends to work with changes made for offscreen rendering --- basis/ui/windows/windows.factor | 4 ++-- basis/ui/x11/x11.factor | 4 ++-- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/basis/ui/windows/windows.factor b/basis/ui/windows/windows.factor index 1481287e95..f6f449625f 100755 --- a/basis/ui/windows/windows.factor +++ b/basis/ui/windows/windows.factor @@ -498,10 +498,10 @@ M: windows-ui-backend (open-window) ( world -- ) dupd (>>handle) hWnd>> show-window ; -M: windows-ui-backend select-gl-context ( handle -- ) +M: win select-gl-context ( handle -- ) [ hDC>> ] keep hRC>> wglMakeCurrent win32-error=0/f ; -M: windows-ui-backend flush-gl-context ( handle -- ) +M: win flush-gl-context ( handle -- ) hDC>> SwapBuffers win32-error=0/f ; ! Move window to front diff --git a/basis/ui/x11/x11.factor b/basis/ui/x11/x11.factor index b65236d1f9..6d6243449b 100755 --- a/basis/ui/x11/x11.factor +++ b/basis/ui/x11/x11.factor @@ -248,12 +248,12 @@ M: x11-ui-backend raise-window* ( world -- ) dpy get swap window>> XRaiseWindow drop ] when* ; -M: x11-ui-backend select-gl-context ( handle -- ) +M: x11-handle select-gl-context ( handle -- ) dpy get swap dup window>> swap glx>> glXMakeCurrent [ "Failed to set current GLX context" throw ] unless ; -M: x11-ui-backend flush-gl-context ( handle -- ) +M: x11-handle flush-gl-context ( handle -- ) dpy get swap window>> glXSwapBuffers ; M: x11-ui-backend ui ( -- ) From c3c50d2cda143b8cb3e72472fcf992869d9c93cf Mon Sep 17 00:00:00 2001 From: Joe Groff Date: Tue, 9 Dec 2008 14:50:54 -0800 Subject: [PATCH 08/18] suppress error when clicking the keyboard in key-caps --- extra/key-caps/key-caps.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/extra/key-caps/key-caps.factor b/extra/key-caps/key-caps.factor index 0865b0ada2..05edb205d2 100755 --- a/extra/key-caps/key-caps.factor +++ b/extra/key-caps/key-caps.factor @@ -139,7 +139,7 @@ TUPLE: key-caps-gadget < gadget keys alarm ; : make-key-gadget ( scancode dim array -- ) [ swap [ - " " [ ] + " " [ drop ] swap [ first >>loc ] [ second >>dim ] bi ] [ execute ] bi* ] dip set-nth ; From a0618d46b930578baa3e17cb181db1122455496d Mon Sep 17 00:00:00 2001 From: Joe Groff Date: Tue, 9 Dec 2008 15:27:30 -0800 Subject: [PATCH 09/18] do-offscreen combinator for managing resources while running a gadget offscreen. tweak bgr[a]>bitmap to copy the pixel memory --- extra/graphics/bitmap/bitmap.factor | 33 ++++++++++++++++------------- extra/ui/offscreen/offscreen.factor | 13 +++++++++--- 2 files changed, 28 insertions(+), 18 deletions(-) diff --git a/extra/graphics/bitmap/bitmap.factor b/extra/graphics/bitmap/bitmap.factor index ae37ef0c5c..9bb8db0f6d 100755 --- a/extra/graphics/bitmap/bitmap.factor +++ b/extra/graphics/bitmap/bitmap.factor @@ -4,32 +4,35 @@ USING: alien arrays byte-arrays combinators summary io.backend graphics.viewer io io.binary io.files kernel libc math math.functions math.bitwise namespaces opengl opengl.gl -prettyprint sequences strings ui ui.gadgets.panes -io.encodings.binary accessors grouping ; +prettyprint sequences strings ui ui.gadgets.panes fry +io.encodings.binary accessors grouping macros alien.c-types ; IN: graphics.bitmap -! Currently can only handle 24bit bitmaps. +! Currently can only handle 24/32bit bitmaps. ! Handles row-reversed bitmaps (their height is negative) TUPLE: bitmap magic size reserved offset header-length width height planes bit-count compression size-image x-pels y-pels color-used color-important rgb-quads color-index array ; +: (array-copy) ( bitmap array -- bitmap array' ) + over size-image>> abs memory>byte-array ; + +MACRO: (nbits>bitmap) ( bits -- ) + [ -3 shift ] keep '[ + bitmap new + 2over * _ * >>size-image + swap >>height + swap >>width + swap (array-copy) [ >>array ] [ >>color-index ] bi + _ >>bit-count + ] ; + : bgr>bitmap ( array height width -- bitmap ) - bitmap new - 2over * 3 * >>size-image - swap >>height - swap >>width - swap [ >>array ] [ >>color-index ] bi - 24 >>bit-count ; + 24 (nbits>bitmap) ; : bgra>bitmap ( array height width -- bitmap ) - bitmap new - 2over * 4 * >>size-image - swap >>height - swap >>width - swap [ >>array ] [ >>color-index ] bi - 32 >>bit-count ; + 32 (nbits>bitmap) ; : 8bit>array ( bitmap -- array ) [ rgb-quads>> 4 [ 3 head-slice ] map ] diff --git a/extra/ui/offscreen/offscreen.factor b/extra/ui/offscreen/offscreen.factor index c246453082..9fe8577a52 100644 --- a/extra/ui/offscreen/offscreen.factor +++ b/extra/ui/offscreen/offscreen.factor @@ -1,5 +1,5 @@ -USING: accessors graphics.bitmap kernel math sequences -ui.gadgets ui.gadgets.worlds ui ui.backend ; +USING: accessors continuations graphics.bitmap kernel math +sequences ui.gadgets ui.gadgets.worlds ui ui.backend ; IN: ui.offscreen TUPLE: offscreen-world < world ; @@ -16,9 +16,16 @@ M: offscreen-world ungraft* [ reset-world ] tri ; : open-offscreen ( gadget -- world ) - "" f [ open-world-window ] keep ; + "" f [ open-world-window ] keep + notify-queued ; + +: close-offscreen ( world -- ) + ungraft notify-queued ; : offscreen-world>bitmap ( world -- bitmap ) [ handle>> offscreen-pixels ] [ dim>> first2 neg ] bi bgra>bitmap ; +: do-offscreen ( gadget quot: ( offscreen-world -- ) -- ) + [ open-offscreen ] dip + over [ slip ] [ close-offscreen ] [ ] cleanup ; From 347eb5647bc6c765911ff59d911a824ebf508535 Mon Sep 17 00:00:00 2001 From: Joe Groff Date: Tue, 9 Dec 2008 18:55:54 -0800 Subject: [PATCH 10/18] windows backend for ui.offscreen --- basis/ui/windows/windows.factor | 53 +++++++++++++++++++++++--- basis/windows/opengl32/opengl32.factor | 8 ++-- 2 files changed, 52 insertions(+), 9 deletions(-) diff --git a/basis/ui/windows/windows.factor b/basis/ui/windows/windows.factor index f6f449625f..e696c3fa6f 100755 --- a/basis/ui/windows/windows.factor +++ b/basis/ui/windows/windows.factor @@ -69,9 +69,11 @@ M: pasteboard set-clipboard-contents drop copy ; clipboard set-global selection set-global ; -! world-handle is a -TUPLE: win hWnd hDC hRC world title ; +TUPLE: win-base hDC hRC ; +TUPLE: win hWnd < win-base world title ; +TUPLE: win-offscreen < win-base hBitmap bits ; C: win +C: win-offscreen SYMBOLS: msg-obj class-name-ptr mouse-captured ; @@ -478,7 +480,7 @@ M: windows-ui-backend do-events f class-name-ptr set-global f msg-obj set-global ; -: setup-pixel-format ( hdc -- ) +: setup-pixel-format ( hdc flags -- ) 16 make-pfd [ ChoosePixelFormat dup win32-error=0/f ] 2keep swapd SetPixelFormat win32-error=0/f ; @@ -489,7 +491,7 @@ M: windows-ui-backend do-events [ wglMakeCurrent win32-error=0/f ] keep ; : setup-gl ( hwnd -- hDC hRC ) - get-dc dup setup-pixel-format dup get-rc ; + get-dc dup windowed-pfd-dwFlags setup-pixel-format dup get-rc ; M: windows-ui-backend (open-window) ( world -- ) [ create-window dup setup-gl ] keep @@ -498,12 +500,51 @@ M: windows-ui-backend (open-window) ( world -- ) dupd (>>handle) hWnd>> show-window ; -M: win select-gl-context ( handle -- ) +M: win-base select-gl-context ( handle -- ) [ hDC>> ] keep hRC>> wglMakeCurrent win32-error=0/f ; -M: win flush-gl-context ( handle -- ) +M: win-base flush-gl-context ( handle -- ) hDC>> SwapBuffers win32-error=0/f ; +: (bitmap-info) ( dim -- BITMAPINFO ) + "BITMAPINFO" [ + BITMAPINFO-bmiHeader { + [ nip "BITMAPINFOHEADER" heap-size swap set-BITMAPINFOHEADER-biSize ] + [ [ first ] dip set-BITMAPINFOHEADER-biWidth ] + [ [ second ] dip set-BITMAPINFOHEADER-biHeight ] + [ nip 1 swap set-BITMAPINFOHEADER-biPlanes ] + [ nip 32 swap set-BITMAPINFOHEADER-biBitCount ] + [ nip BI_RGB swap set-BITMAPINFOHEADER-biCompression ] + [ [ first2 * 4 * ] dip swap set-BITMAPINFOHEADER-biSizeImage ] + [ nip 72 swap set-BITMAPINFOHEADER-biXPelsPerMeter ] + [ nip 72 swap set-BITMAPINFOHEADER-biYPelsPerMeter ] + [ nip 0 swap set-BITMAPINFOHEADER-biClrUsed ] + [ nip 0 swap set-BITMAPINFOHEADER-biClrImportant ] + } 2cleave + ] keep ; + +: make-offscreen-dc-and-bitmap ( dim -- hDC hBitmap bits ) + f CreateCompatibleDC + swap (bitmap-info) DIB_RGB_COLORS f + [ f 0 CreateDIBSection ] keep *void* + [ 2dup SelectObject drop ] dip ; + +: setup-offscreen-gl ( dim -- hDC hRC hBitmap bits ) + make-offscreen-dc-and-bitmap [ + [ dup offscreen-pfd-dwFlags setup-pixel-format ] + [ get-rc ] bi + ] 2dip ; + +M: windows-ui-backend (open-offscreen-buffer) ( world -- ) + dup dim>> setup-offscreen-gl + >>handle drop ; +M: windows-ui-backend (close-offscreen-buffer) ( handle -- ) + [ hDC>> DeleteObject drop ] + [ hBitmap>> DeleteObject drop ] bi ; + +M: win-offscreen offscreen-pixels ( handle -- alien ) + bits>> ; + ! Move window to front M: windows-ui-backend raise-window* ( world -- ) handle>> [ diff --git a/basis/windows/opengl32/opengl32.factor b/basis/windows/opengl32/opengl32.factor index df09d9327a..c09b30164f 100644 --- a/basis/windows/opengl32/opengl32.factor +++ b/basis/windows/opengl32/opengl32.factor @@ -71,15 +71,17 @@ IN: windows.opengl32 : WGL_SWAP_UNDERLAY14 HEX: 20000000 ; inline : WGL_SWAP_UNDERLAY15 HEX: 40000000 ; inline -: pfd-dwFlags ( -- n ) +: windowed-pfd-dwFlags ( -- n ) { PFD_DRAW_TO_WINDOW PFD_SUPPORT_OPENGL PFD_DOUBLEBUFFER } flags ; +: offscreen-pfd-dwFlags ( -- n ) + { PFD_DRAW_TO_BITMAP PFD_SUPPORT_OPENGL PFD_SUPPORT_GDI } flags ; ! TODO: compare to http://www.nullterminator.net/opengl32.html -: make-pfd ( bits -- pfd ) +: make-pfd ( flags bits -- pfd ) "PIXELFORMATDESCRIPTOR" "PIXELFORMATDESCRIPTOR" heap-size over set-PIXELFORMATDESCRIPTOR-nSize 1 over set-PIXELFORMATDESCRIPTOR-nVersion - pfd-dwFlags over set-PIXELFORMATDESCRIPTOR-dwFlags + rot over set-PIXELFORMATDESCRIPTOR-dwFlags PFD_TYPE_RGBA over set-PIXELFORMATDESCRIPTOR-iPixelType [ set-PIXELFORMATDESCRIPTOR-cColorBits ] keep 16 over set-PIXELFORMATDESCRIPTOR-cDepthBits From 3e587c2f89811e9434aa7d3fd7b95e1832312cb7 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Wed, 10 Dec 2008 00:31:57 -0600 Subject: [PATCH 11/18] gitter compilin' --- basis/ui/windows/windows.factor | 9 ++++----- basis/windows/gdi32/gdi32.factor | 16 ++++++++++++---- basis/windows/types/types.factor | 23 +++++++++++++++++++++++ 3 files changed, 39 insertions(+), 9 deletions(-) mode change 100644 => 100755 basis/windows/gdi32/gdi32.factor mode change 100644 => 100755 basis/windows/types/types.factor diff --git a/basis/ui/windows/windows.factor b/basis/ui/windows/windows.factor index ab895c10dd..145cba82a3 100755 --- a/basis/ui/windows/windows.factor +++ b/basis/ui/windows/windows.factor @@ -71,7 +71,7 @@ M: pasteboard set-clipboard-contents drop copy ; selection set-global ; TUPLE: win-base hDC hRC ; -TUPLE: win hWnd < win-base world title ; +TUPLE: win < win-base hWnd world title ; TUPLE: win-offscreen < win-base hBitmap bits ; C: win C: win-offscreen @@ -495,7 +495,7 @@ M: windows-ui-backend do-events get-dc dup windowed-pfd-dwFlags setup-pixel-format dup get-rc ; M: windows-ui-backend (open-window) ( world -- ) - [ create-window dup setup-gl ] keep + [ create-window [ setup-gl ] keep ] keep [ f ] keep [ swap hWnd>> register-window ] 2keep dupd (>>handle) @@ -526,7 +526,7 @@ M: win-base flush-gl-context ( handle -- ) : make-offscreen-dc-and-bitmap ( dim -- hDC hBitmap bits ) f CreateCompatibleDC - swap (bitmap-info) DIB_RGB_COLORS f + dup rot (bitmap-info) DIB_RGB_COLORS f [ f 0 CreateDIBSection ] keep *void* [ 2dup SelectObject drop ] dip ; @@ -540,13 +540,12 @@ M: windows-ui-backend (open-offscreen-buffer) ( world -- ) dup dim>> setup-offscreen-gl >>handle drop ; M: windows-ui-backend (close-offscreen-buffer) ( handle -- ) - [ hDC>> DeleteObject drop ] + [ hDC>> DeleteDC drop ] [ hBitmap>> DeleteObject drop ] bi ; M: win-offscreen offscreen-pixels ( handle -- alien ) bits>> ; -! Move window to front M: windows-ui-backend raise-window* ( world -- ) handle>> [ hWnd>> SetFocus drop diff --git a/basis/windows/gdi32/gdi32.factor b/basis/windows/gdi32/gdi32.factor old mode 100644 new mode 100755 index b9ba51844c..2ccd6b39f4 --- a/basis/windows/gdi32/gdi32.factor +++ b/basis/windows/gdi32/gdi32.factor @@ -26,6 +26,14 @@ IN: windows.gdi32 : DC_BRUSH 18 ; inline : DC_PEN 19 ; inline +: BI_RGB 0 ; inline +: BI_RLE8 1 ; inline +: BI_RLE4 2 ; inline +: BI_BITFIELDS 3 ; inline + +: DIB_RGB_COLORS 0 ; inline +: DIB_PAL_COLORS 1 ; inline + LIBRARY: gdi32 ! FUNCTION: AbortPath @@ -75,13 +83,13 @@ FUNCTION: int ChoosePixelFormat ( HDC hDC, PFD* ppfd ) ; ! FUNCTION: CreateColorSpaceA ! FUNCTION: CreateColorSpaceW ! FUNCTION: CreateCompatibleBitmap -! FUNCTION: CreateCompatibleDC +FUNCTION: HDC CreateCompatibleDC ( HDC hdc ) ; ! FUNCTION: CreateDCA ! FUNCTION: CreateDCW ! FUNCTION: CreateDIBitmap ! FUNCTION: CreateDIBPatternBrush ! FUNCTION: CreateDIBPatternBrushPt -! FUNCTION: CreateDIBSection +FUNCTION: HBITMAP CreateDIBSection ( HDC hdc, BITMAPINFO* pbmi, UINT iUsage, void** ppvBits, HANDLE hSection, DWORD dwOffset ) ; ! FUNCTION: CreateDiscardableBitmap ! FUNCTION: CreateEllipticRgn ! FUNCTION: CreateEllipticRgnIndirect @@ -169,7 +177,7 @@ FUNCTION: HRGN CreateRectRgn ( int x, int y, int w, int h ) ; ! FUNCTION: DdEntry8 ! FUNCTION: DdEntry9 ! FUNCTION: DeleteColorSpace -! FUNCTION: DeleteDC +FUNCTION: BOOL DeleteDC ( HDC hdc ) ; ! FUNCTION: DeleteEnhMetaFile ! FUNCTION: DeleteMetaFile FUNCTION: BOOL DeleteObject ( HGDIOBJ hObject ) ; @@ -552,7 +560,7 @@ FUNCTION: HGDIOBJ GetStockObject ( int fnObject ) ; ! FUNCTION: SelectClipPath FUNCTION: int SelectClipRgn ( HDC hDC, HRGN hrgn ) ; ! FUNCTION: SelectFontLocal -! FUNCTION: SelectObject +FUNCTION: HGDIOBJ SelectObject ( HDC hdc, HGDIOBJ hgdiobj ) ; ! FUNCTION: SelectPalette ! FUNCTION: SetAbortProc ! FUNCTION: SetArcDirection diff --git a/basis/windows/types/types.factor b/basis/windows/types/types.factor old mode 100644 new mode 100755 index 63ee6627c4..8cc18d4039 --- a/basis/windows/types/types.factor +++ b/basis/windows/types/types.factor @@ -253,6 +253,29 @@ C-STRUCT: RECT ! { "BYTE[32]" "rgbReserved" } ! ; +C-STRUCT: BITMAPINFOHEADER + { "DWORD" "biSize" } + { "LONG" "biWidth" } + { "LONG" "biHeight" } + { "WORD" "biPlanes" } + { "WORD" "biBitCount" } + { "DWORD" "biCompression" } + { "DWORD" "biSizeImage" } + { "LONG" "biXPelsPerMeter" } + { "LONG" "biYPelsPerMeter" } + { "DWORD" "biClrUsed" } + { "DWORD" "biClrImportant" } ; + +C-STRUCT: RGBQUAD + { "BYTE" "rgbBlue" } + { "BYTE" "rgbGreen" } + { "BYTE" "rgbRed" } + { "BYTE" "rgbReserved" } ; + +C-STRUCT: BITMAPINFO + { "BITMAPINFOHEADER" "bmiHeader" } + { "RGBQUAD[1]" "bmiColors" } ; + TYPEDEF: void* LPPAINTSTRUCT TYPEDEF: void* PAINTSTRUCT From 6fd87b747c445a9736a2c68206320113f6ad3d2e Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Wed, 10 Dec 2008 00:55:33 -0600 Subject: [PATCH 12/18] windows offscreen tweaks --- basis/ui/windows/windows.factor | 4 ++-- basis/windows/opengl32/opengl32.factor | 2 +- 2 files changed, 3 insertions(+), 3 deletions(-) mode change 100644 => 100755 basis/windows/opengl32/opengl32.factor diff --git a/basis/ui/windows/windows.factor b/basis/ui/windows/windows.factor index 145cba82a3..23d4104778 100755 --- a/basis/ui/windows/windows.factor +++ b/basis/ui/windows/windows.factor @@ -482,7 +482,7 @@ M: windows-ui-backend do-events f msg-obj set-global ; : setup-pixel-format ( hdc flags -- ) - 16 make-pfd [ ChoosePixelFormat dup win32-error=0/f ] 2keep + 32 make-pfd [ ChoosePixelFormat dup win32-error=0/f ] 2keep swapd SetPixelFormat win32-error=0/f ; : get-dc ( hWnd -- hDC ) GetDC dup win32-error=0/f ; @@ -516,7 +516,7 @@ M: win-base flush-gl-context ( handle -- ) [ nip 1 swap set-BITMAPINFOHEADER-biPlanes ] [ nip 32 swap set-BITMAPINFOHEADER-biBitCount ] [ nip BI_RGB swap set-BITMAPINFOHEADER-biCompression ] - [ [ first2 * 4 * ] dip swap set-BITMAPINFOHEADER-biSizeImage ] + [ [ first2 * 4 * ] dip set-BITMAPINFOHEADER-biSizeImage ] [ nip 72 swap set-BITMAPINFOHEADER-biXPelsPerMeter ] [ nip 72 swap set-BITMAPINFOHEADER-biYPelsPerMeter ] [ nip 0 swap set-BITMAPINFOHEADER-biClrUsed ] diff --git a/basis/windows/opengl32/opengl32.factor b/basis/windows/opengl32/opengl32.factor old mode 100644 new mode 100755 index c09b30164f..63384e8858 --- a/basis/windows/opengl32/opengl32.factor +++ b/basis/windows/opengl32/opengl32.factor @@ -74,7 +74,7 @@ IN: windows.opengl32 : windowed-pfd-dwFlags ( -- n ) { PFD_DRAW_TO_WINDOW PFD_SUPPORT_OPENGL PFD_DOUBLEBUFFER } flags ; : offscreen-pfd-dwFlags ( -- n ) - { PFD_DRAW_TO_BITMAP PFD_SUPPORT_OPENGL PFD_SUPPORT_GDI } flags ; + { PFD_DRAW_TO_BITMAP PFD_SUPPORT_OPENGL } flags ; ! TODO: compare to http://www.nullterminator.net/opengl32.html : make-pfd ( flags bits -- pfd ) From cd0f46c6685093ef92747478f2f8c5d9c29288dc Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Wed, 10 Dec 2008 01:05:03 -0600 Subject: [PATCH 13/18] GdiFlush when selecting gl context to make offscreen rendering work --- basis/ui/windows/windows.factor | 3 ++- basis/windows/gdi32/gdi32.factor | 2 +- 2 files changed, 3 insertions(+), 2 deletions(-) diff --git a/basis/ui/windows/windows.factor b/basis/ui/windows/windows.factor index 23d4104778..ca5d77e9f9 100755 --- a/basis/ui/windows/windows.factor +++ b/basis/ui/windows/windows.factor @@ -502,7 +502,8 @@ M: windows-ui-backend (open-window) ( world -- ) hWnd>> show-window ; M: win-base select-gl-context ( handle -- ) - [ hDC>> ] keep hRC>> wglMakeCurrent win32-error=0/f ; + [ hDC>> ] keep hRC>> wglMakeCurrent win32-error=0/f + GdiFlush drop ; M: win-base flush-gl-context ( handle -- ) hDC>> SwapBuffers win32-error=0/f ; diff --git a/basis/windows/gdi32/gdi32.factor b/basis/windows/gdi32/gdi32.factor index 2ccd6b39f4..32e4f3cd8a 100755 --- a/basis/windows/gdi32/gdi32.factor +++ b/basis/windows/gdi32/gdi32.factor @@ -321,7 +321,7 @@ FUNCTION: BOOL DeleteObject ( HGDIOBJ hObject ) ; ! FUNCTION: GdiEntry8 ! FUNCTION: GdiEntry9 ! FUNCTION: GdiFixUpHandle -! FUNCTION: GdiFlush +FUNCTION: BOOL GdiFlush ( ) ; ! FUNCTION: GdiFullscreenControl ! FUNCTION: GdiGetBatchLimit ! FUNCTION: GdiGetCharDimensions From 3629b9e5bdfc7a0a1ef1cbf718c80c30aeecfd1a Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Wed, 10 Dec 2008 08:49:50 -0600 Subject: [PATCH 14/18] win32 offscreen refinements --- basis/ui/backend/backend.factor | 2 +- basis/ui/cocoa/cocoa.factor | 4 ++-- basis/ui/windows/windows.factor | 18 +++++++++++++++--- extra/ui/offscreen/offscreen.factor | 8 +++++--- 4 files changed, 23 insertions(+), 9 deletions(-) mode change 100644 => 100755 basis/ui/backend/backend.factor diff --git a/basis/ui/backend/backend.factor b/basis/ui/backend/backend.factor old mode 100644 new mode 100755 index 7b808bb2be..aa84419d64 --- a/basis/ui/backend/backend.factor +++ b/basis/ui/backend/backend.factor @@ -27,7 +27,7 @@ GENERIC: select-gl-context ( handle -- ) GENERIC: flush-gl-context ( handle -- ) -GENERIC: offscreen-pixels ( handle -- alien ) +HOOK: offscreen-pixels ui-backend ( world -- alien w h ) HOOK: beep ui-backend ( -- ) diff --git a/basis/ui/cocoa/cocoa.factor b/basis/ui/cocoa/cocoa.factor index 1338983164..b4025b72b2 100755 --- a/basis/ui/cocoa/cocoa.factor +++ b/basis/ui/cocoa/cocoa.factor @@ -123,8 +123,8 @@ M: handle select-gl-context ( handle -- ) M: handle flush-gl-context ( handle -- ) (gl-context) -> flushBuffer ; -M: offscreen-handle offscreen-pixels ( handle -- alien ) - buffer>> ; +M: cocoa-ui-backend offscreen-pixels ( world -- alien w h ) + [ handle>> buffer>> ] [ dim>> first2 neg ] ; M: cocoa-ui-backend beep ( -- ) NSBeep ; diff --git a/basis/ui/windows/windows.factor b/basis/ui/windows/windows.factor index ca5d77e9f9..8e60ad1bc5 100755 --- a/basis/ui/windows/windows.factor +++ b/basis/ui/windows/windows.factor @@ -6,7 +6,7 @@ ui.gadgets ui.backend ui.clipboards ui.gadgets.worlds ui.gestures io kernel math math.vectors namespaces make sequences strings vectors words windows.kernel32 windows.gdi32 windows.user32 windows.opengl32 windows.messages windows.types -windows.nt windows threads libc combinators +windows.nt windows threads libc combinators fry combinators.short-circuit continuations command-line shuffle opengl ui.render ascii math.bitwise locals symbols accessors math.geometry.rect math.order ascii calendar @@ -544,8 +544,20 @@ M: windows-ui-backend (close-offscreen-buffer) ( handle -- ) [ hDC>> DeleteDC drop ] [ hBitmap>> DeleteObject drop ] bi ; -M: win-offscreen offscreen-pixels ( handle -- alien ) - bits>> ; +! Windows 32-bit bitmaps don't actually use the alpha byte of +! each pixel; it's left as zero + +: (make-opaque) ( byte-array -- byte-array' ) + [ length 4 / ] + [ '[ 255 swap 4 * 3 + _ set-nth ] each ] + [ ] tri ; + +: (opaque-pixels) ( world -- pixels ) + [ handle>> bits>> ] [ dim>> first2 * 4 * ] bi + memory>byte-array (make-opaque) ; + +M: windows-ui-backend offscreen-pixels ( world -- alien w h ) + [ (opaque-pixels) ] [ dim>> first2 ] bi ; M: windows-ui-backend raise-window* ( world -- ) handle>> [ diff --git a/extra/ui/offscreen/offscreen.factor b/extra/ui/offscreen/offscreen.factor index 779ecc0c31..33d4a92f37 100755 --- a/extra/ui/offscreen/offscreen.factor +++ b/extra/ui/offscreen/offscreen.factor @@ -23,9 +23,11 @@ M: offscreen-world ungraft* ungraft notify-queued ; : offscreen-world>bitmap ( world -- bitmap ) - [ handle>> offscreen-pixels ] [ dim>> first2 neg ] bi - bgra>bitmap ; + offscreen-pixels bgra>bitmap ; : do-offscreen ( gadget quot: ( offscreen-world -- ) -- ) [ open-offscreen ] dip - over [ slip ] [ close-offscreen ] [ ] cleanup ; + over [ slip ] [ close-offscreen ] [ ] cleanup ; inline + +: gadget>bitmap ( gadget -- bitmap ) + [ offscreen-world>bitmap ] do-offscreen ; From dc5727a212afe2d4fd93c36f492271ee98067ea5 Mon Sep 17 00:00:00 2001 From: Joe Groff Date: Wed, 10 Dec 2008 07:28:33 -0800 Subject: [PATCH 15/18] oops --- basis/ui/cocoa/cocoa.factor | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/basis/ui/cocoa/cocoa.factor b/basis/ui/cocoa/cocoa.factor index b4025b72b2..fecbb52a25 100755 --- a/basis/ui/cocoa/cocoa.factor +++ b/basis/ui/cocoa/cocoa.factor @@ -3,7 +3,7 @@ USING: accessors math arrays assocs cocoa cocoa.application command-line kernel memory namespaces cocoa.messages cocoa.runtime cocoa.subclassing cocoa.pasteboard cocoa.types -cocoa.windows cocoa.classes sequences system +cocoa.windows cocoa.classes cocoa.nibs sequences system ui ui.backend ui.clipboards ui.gadgets ui.gadgets.worlds ui.cocoa.views core-foundation threads math.geometry.rect fry libc generalizations alien.c-types cocoa.views combinators ; @@ -124,7 +124,7 @@ M: handle flush-gl-context ( handle -- ) (gl-context) -> flushBuffer ; M: cocoa-ui-backend offscreen-pixels ( world -- alien w h ) - [ handle>> buffer>> ] [ dim>> first2 neg ] ; + [ handle>> buffer>> ] [ dim>> first2 neg ] bi ; M: cocoa-ui-backend beep ( -- ) NSBeep ; From 88856fac215a790ba27a7bc6a3855894a68d9e79 Mon Sep 17 00:00:00 2001 From: Joe Groff Date: Wed, 10 Dec 2008 12:22:17 -0800 Subject: [PATCH 16/18] OSX VM requires function from Cocoa framework, so link against it even when building for X11 --- vm/Config.macosx | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/vm/Config.macosx b/vm/Config.macosx index 54078cfe8d..e5aac32b54 100644 --- a/vm/Config.macosx +++ b/vm/Config.macosx @@ -6,7 +6,7 @@ PLAF_DLL_OBJS += vm/os-macosx.o vm/mach_signal.o DLL_EXTENSION = .dylib ifdef X11 - LIBS = -lm -framework Foundation $(X11_UI_LIBS) -Wl,-dylib_file,/System/Library/Frameworks/OpenGL.framework/Versions/A/Libraries/libGL.dylib:/System/Library/Frameworks/OpenGL.framework/Versions/A/Libraries/libGL.dylib + LIBS = -lm -framework Cocoa $(X11_UI_LIBS) -Wl,-dylib_file,/System/Library/Frameworks/OpenGL.framework/Versions/A/Libraries/libGL.dylib:/System/Library/Frameworks/OpenGL.framework/Versions/A/Libraries/libGL.dylib else LIBS = -lm -framework Cocoa -framework AppKit endif From e795571639f0309424e37fd01a00cedcbe6c78af Mon Sep 17 00:00:00 2001 From: Joe Groff Date: Thu, 11 Dec 2008 16:50:37 -0800 Subject: [PATCH 17/18] seed of X11 offscreen backend --- basis/ui/gadgets/worlds/worlds.factor | 4 -- basis/ui/x11/x11.factor | 28 ++++++++++++-- basis/x11/glx/glx.factor | 12 +++--- basis/x11/windows/windows.factor | 28 +++++++++++++- basis/x11/xlib/xlib.factor | 54 +++++++++++++++++++++++++++ extra/ui/offscreen/offscreen.factor | 3 +- 6 files changed, 113 insertions(+), 16 deletions(-) diff --git a/basis/ui/gadgets/worlds/worlds.factor b/basis/ui/gadgets/worlds/worlds.factor index 9290af1f64..732a438203 100644 --- a/basis/ui/gadgets/worlds/worlds.factor +++ b/basis/ui/gadgets/worlds/worlds.factor @@ -13,8 +13,6 @@ title status fonts handle window-loc ; -TUPLE: offscreen-world < world ; - : find-world ( gadget -- world/f ) [ world? ] find-parent ; : show-status ( string/f gadget -- ) @@ -53,8 +51,6 @@ M: world request-focus-on ( child gadget -- ) : ( gadget title status -- world ) world new-world ; -: ( gadget title status -- world ) - offscreen-world new-world ; M: world layout* dup call-next-method diff --git a/basis/ui/x11/x11.factor b/basis/ui/x11/x11.factor index e5a3a8306b..b65185967a 100755 --- a/basis/ui/x11/x11.factor +++ b/basis/ui/x11/x11.factor @@ -14,9 +14,12 @@ SINGLETON: x11-ui-backend : XA_NET_WM_NAME ( -- atom ) "_NET_WM_NAME" x-atom ; -TUPLE: x11-handle window glx xic ; +TUPLE: x11-handle-base glx ; +TUPLE: x11-handle < x11-handle-base xic window ; +TUPLE: x11-pixmap-handle < x11-handle-base pixmap glx-pixmap ; C: x11-handle +C: x11-pixmap-handle M: world expose-event nip relayout ; @@ -185,7 +188,7 @@ M: world client-event : gadget-window ( world -- ) dup window-loc>> over rect-dim glx-window - over "Factor" create-xic + over "Factor" create-xic rot 2dup window>> register-window >>handle drop ; @@ -250,12 +253,31 @@ M: x11-ui-backend raise-window* ( world -- ) M: x11-handle select-gl-context ( handle -- ) dpy get swap - dup window>> swap glx>> glXMakeCurrent + [ window>> ] [ glx>> ] bi glXMakeCurrent [ "Failed to set current GLX context" throw ] unless ; M: x11-handle flush-gl-context ( handle -- ) dpy get swap window>> glXSwapBuffers ; +M: x11-pixmap-handle select-gl-context ( handle -- ) + dpy get swap + [ glx-pixmap>> ] [ glx>> ] bi glXMakeCurrent + [ "Failed to set current GLX context" throw ] unless ; + +M: x11-pixmap-handle flush-gl-context ( handle -- ) + drop ; + +M: x11-ui-backend (open-offscreen-buffer) ( world -- ) + dup dim>> glx-pixmap >>handle drop ; +M: x11-ui-backend (close-offscreen-buffer) ( handle -- ) + dpy get swap + [ glx-pixmap>> glXDestroyGLXPixmap ] + [ pixmap>> XFreePixmap drop ] + [ glx>> glXDestroyContext ] 2tri ; + +M: x11-ui-backend offscreen-pixels ( world -- alien w h ) + [ [ dim>> ] [ handle>> pixmap>> ] bi pixmap-bits ] [ dim>> first2 ] bi ; + M: x11-ui-backend ui ( -- ) [ f [ diff --git a/basis/x11/glx/glx.factor b/basis/x11/glx/glx.factor index 1fab283242..e0b786ce7d 100644 --- a/basis/x11/glx/glx.factor +++ b/basis/x11/glx/glx.factor @@ -84,13 +84,13 @@ FUNCTION: void* glXGetProcAddress ( char* procname ) ; FUNCTION: void* glXGetProcAddressARB ( char* procname ) ; ! GLX Events -! (also skipped for now. only has GLXPbufferClobberEvent, the rest is handled by xlib methinks +! (also skipped for now. only has GLXPbufferClobberEvent, the rest is handled by xlib methinks) -: choose-visual ( -- XVisualInfo* ) - dpy get scr get +: choose-visual ( flags -- XVisualInfo* ) + [ dpy get scr get ] dip [ + % GLX_RGBA , - GLX_DOUBLEBUFFER , GLX_DEPTH_SIZE , 16 , 0 , ] int-array{ } make underlying>> @@ -98,8 +98,8 @@ FUNCTION: void* glXGetProcAddressARB ( char* procname ) ; [ "Could not get a double-buffered GLX RGBA visual" throw ] unless* ; : create-glx ( XVisualInfo* -- GLXContext ) - >r dpy get r> f 1 glXCreateContext + [ dpy get ] dip f 1 glXCreateContext [ "Failed to create GLX context" throw ] unless* ; : destroy-glx ( GLXContext -- ) - dpy get swap glXDestroyContext ; \ No newline at end of file + dpy get swap glXDestroyContext ; diff --git a/basis/x11/windows/windows.factor b/basis/x11/windows/windows.factor index aed45655f6..3c41a78584 100644 --- a/basis/x11/windows/windows.factor +++ b/basis/x11/windows/windows.factor @@ -1,7 +1,8 @@ ! Copyright (C) 2005, 2006 Eduardo Cavazos and Slava Pestov ! See http://factorcode.org/license.txt for BSD license. USING: alien alien.c-types hashtables kernel math math.vectors -math.bitwise namespaces sequences x11.xlib x11.constants x11.glx ; +math.bitwise namespaces sequences x11.xlib x11.constants x11.glx +arrays fry ; IN: x11.windows : create-window-mask ( -- n ) @@ -50,11 +51,30 @@ IN: x11.windows dup r> auto-position ; : glx-window ( loc dim -- window glx ) - choose-visual + GLX_DOUBLEBUFFER 1array choose-visual [ create-window ] keep [ create-glx ] keep XFree ; +: create-pixmap ( dim visual -- pixmap ) + [ [ { 0 0 } swap ] dip create-window ] [ + drop [ dpy get ] 2dip first2 24 XCreatePixmap + [ "Failed to create offscreen pixmap" throw ] unless* + ] 2bi ; + +: (create-glx-pixmap) ( pixmap visual -- pixmap glx-pixmap ) + [ drop ] [ + [ dpy get ] 2dip swap glXCreateGLXPixmap + [ "Failed to create offscreen GLXPixmap" throw ] unless* + ] 2bi ; + +: create-glx-pixmap ( dim visual -- pixmap glx-pixmap ) + [ create-pixmap ] [ (create-glx-pixmap) ] bi ; + +: glx-pixmap ( dim -- glx pixmap glx-pixmap ) + { } choose-visual + [ nip create-glx ] [ create-glx-pixmap ] [ nip XFree ] 2tri ; + : destroy-window ( win -- ) dpy get swap XDestroyWindow drop ; @@ -65,3 +85,7 @@ IN: x11.windows : map-window ( win -- ) dpy get swap XMapWindow drop ; : unmap-window ( win -- ) dpy get swap XUnmapWindow drop ; + +: pixmap-bits ( dim pixmap -- alien ) + swap first2 '[ dpy get _ 0 0 _ _ AllPlanes ZPixmap XGetImage ] call + [ XImage-pixels ] [ XDestroyImage drop ] bi ; diff --git a/basis/x11/xlib/xlib.factor b/basis/x11/xlib/xlib.factor index 555eb573fc..996932e697 100644 --- a/basis/x11/xlib/xlib.factor +++ b/basis/x11/xlib/xlib.factor @@ -272,6 +272,17 @@ FUNCTION: Window XGetSelectionOwner ( Display* display, Atom selection ) ; FUNCTION: int XConvertSelection ( Display* display, Atom selection, Atom target, Atom property, Window requestor, Time time ) ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! 5 - Pixmap and Cursor Functions +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +! 5.1 - Creating and Freeing Pixmaps + +FUNCTION: Pixmap XCreatePixmap ( Display* display, Drawable d, uint width, uint height, uint depth ) ; +FUNCTION: int XFreePixmap ( Display* display, Pixmap pixmap ) ; + + ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! 6 - Color Management Functions ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @@ -429,6 +440,49 @@ FUNCTION: Status XDrawString ( char* string, int length ) ; +! 8.7 - Transferring Images between Client and Server + +: XYBitmap 0 ; inline +: XYPixmap 1 ; inline +: ZPixmap 2 ; inline +: AllPlanes -1 ; inline + +C-STRUCT: XImage-funcs + { "void*" "create_image" } + { "void*" "destroy_image" } + { "void*" "get_pixel" } + { "void*" "put_pixel" } + { "void*" "sub_image" } + { "void*" "add_pixel" } ; + +C-STRUCT: XImage + { "int" "width" } + { "int" "height" } + { "int" "xoffset" } + { "int" "format" } + { "char*" "data" } + { "int" "byte_order" } + { "int" "bitmap_unit" } + { "int" "bitmap_bit_order" } + { "int" "bitmap_pad" } + { "int" "depth" } + { "int" "bytes_per_line" } + { "int" "bits_per_pixel" } + { "ulong" "red_mask" } + { "ulong" "green_mask" } + { "ulong" "blue_mask" } + { "XPointer" "obdata" } + { "XImage-funcs" "f" } ; + +FUNCTION: XImage* XGetImage ( Display* display, Drawable d, int x, int y, uint width, uint height, ulong plane_mask, int format ) ; +FUNCTION: int XDestroyImage ( XImage *ximage ) ; + +: XImage-size ( ximage -- size ) + [ XImage-height ] [ XImage-bytes_per_line ] bi * ; + +: XImage-pixels ( ximage -- byte-array ) + [ XImage-data ] [ XImage-size ] bi memory>byte-array ; + ! ! 9 - Window and Session Manager Functions ! diff --git a/extra/ui/offscreen/offscreen.factor b/extra/ui/offscreen/offscreen.factor index 33d4a92f37..be6638bed8 100755 --- a/extra/ui/offscreen/offscreen.factor +++ b/extra/ui/offscreen/offscreen.factor @@ -16,7 +16,8 @@ M: offscreen-world ungraft* [ reset-world ] tri ; : open-offscreen ( gadget -- world ) - "" f [ open-world-window ] keep + "" f + [ open-world-window dup relayout-1 ] keep notify-queued ; : close-offscreen ( world -- ) From b7bad6b2bbddafb3ba2f871ff91e20d606f359ea Mon Sep 17 00:00:00 2001 From: Joe Groff Date: Thu, 11 Dec 2008 18:32:40 -0800 Subject: [PATCH 18/18] Metadata and docs for ui.offscreen --- extra/ui/offscreen/authors.txt | 1 + extra/ui/offscreen/offscreen-docs.factor | 63 ++++++++++++++++++++++++ extra/ui/offscreen/offscreen.factor | 5 +- extra/ui/offscreen/summary.txt | 1 + extra/ui/offscreen/tags.txt | 3 ++ 5 files changed, 72 insertions(+), 1 deletion(-) create mode 100644 extra/ui/offscreen/authors.txt create mode 100644 extra/ui/offscreen/offscreen-docs.factor create mode 100644 extra/ui/offscreen/summary.txt create mode 100644 extra/ui/offscreen/tags.txt diff --git a/extra/ui/offscreen/authors.txt b/extra/ui/offscreen/authors.txt new file mode 100644 index 0000000000..f13c9c1e77 --- /dev/null +++ b/extra/ui/offscreen/authors.txt @@ -0,0 +1 @@ +Joe Groff diff --git a/extra/ui/offscreen/offscreen-docs.factor b/extra/ui/offscreen/offscreen-docs.factor new file mode 100644 index 0000000000..5d800981bf --- /dev/null +++ b/extra/ui/offscreen/offscreen-docs.factor @@ -0,0 +1,63 @@ +! Copyright (C) 2008 Joe Groff. +! See http://factorcode.org/license.txt for BSD license. +USING: help.markup help.syntax kernel quotations ui.gadgets +graphics.bitmap strings ui.gadgets.worlds ; +IN: ui.offscreen + +HELP: +{ $values + { "gadget" gadget } { "title" string } { "status" "a boolean" } + { "world" offscreen-world } +} +{ $description "Constructs an " { $link offscreen-world } " gadget with " { $snippet "gadget" } " as its only child. Generally you should use " { $link open-offscreen } " or " { $link do-offscreen } " instead of calling this word directly." } ; + +HELP: close-offscreen +{ $values + { "world" offscreen-world } +} +{ $description "Releases the resources used by the rendering buffer for " { $snippet "world" } "." } ; + +HELP: do-offscreen +{ $values + { "gadget" gadget } { "quot" quotation } +} +{ $description "Constructs an " { $link offscreen-world } " around " { $snippet "gadget" } " with " { $link open-offscreen } ", calls " { $snippet "quotation" } " with the world on the top of the stack, and cleans up the world with " { $link close-offscreen } " at the end of " { $snippet "quotation" } "." } ; + +HELP: gadget>bitmap +{ $values + { "gadget" gadget } + { "bitmap" bitmap } +} +{ $description "Renders " { $snippet "gadget" } " to an " { $link offscreen-world } " and creates a " { $link bitmap } " from its contents." } ; + +HELP: offscreen-world +{ $class-description "The class of " { $link world } " objects that render to an offscreen buffer." } ; + +HELP: offscreen-world>bitmap +{ $values + { "world" offscreen-world } + { "bitmap" bitmap } +} +{ $description "Saves a copy of the contents of " { $snippet "world" } " to a " { $link bitmap } " object." } ; + +HELP: open-offscreen +{ $values + { "gadget" gadget } + { "world" offscreen-world } +} +{ $description "Creates and sets up an " { $link offscreen-world } " with " { $snippet "gadget" } " as its only child." } ; + +{ offscreen-world open-offscreen close-offscreen do-offscreen } related-words + +ARTICLE: "ui.offscreen" "Offscreen UI rendering" +"The " { $vocab-link "ui.offscreen" } " provides words for rendering gadgets to an offscreen buffer so that bitmaps can be made from their contents." +{ $subsection offscreen-world } +"Opening gadgets offscreen:" +{ $subsection open-offscreen } +{ $subsection close-offscreen } +{ $subsection do-offscreen } +"Creating bitmaps from offscreen buffers:" +{ $subsection offscreen-world>bitmap } +{ $subsection gadget>bitmap } ; + +ABOUT: "ui.offscreen" diff --git a/extra/ui/offscreen/offscreen.factor b/extra/ui/offscreen/offscreen.factor index be6638bed8..3897df71fa 100755 --- a/extra/ui/offscreen/offscreen.factor +++ b/extra/ui/offscreen/offscreen.factor @@ -1,5 +1,6 @@ USING: accessors continuations graphics.bitmap kernel math -sequences ui.gadgets ui.gadgets.worlds ui ui.backend ; +sequences ui.gadgets ui.gadgets.worlds ui ui.backend +destructors ; IN: ui.offscreen TUPLE: offscreen-world < world ; @@ -23,6 +24,8 @@ M: offscreen-world ungraft* : close-offscreen ( world -- ) ungraft notify-queued ; +M: offscreen-world dispose close-offscreen ; + : offscreen-world>bitmap ( world -- bitmap ) offscreen-pixels bgra>bitmap ; diff --git a/extra/ui/offscreen/summary.txt b/extra/ui/offscreen/summary.txt new file mode 100644 index 0000000000..51ef124d97 --- /dev/null +++ b/extra/ui/offscreen/summary.txt @@ -0,0 +1 @@ +Offscreen world gadgets for rendering UI elements to bitmaps diff --git a/extra/ui/offscreen/tags.txt b/extra/ui/offscreen/tags.txt new file mode 100644 index 0000000000..b796ebde91 --- /dev/null +++ b/extra/ui/offscreen/tags.txt @@ -0,0 +1,3 @@ +unportable +ui +graphics