Merge branch 'master' of git://factorcode.org/git/factor

db4
Slava Pestov 2009-05-13 22:42:13 -05:00
commit be17ed9132
8 changed files with 36 additions and 39 deletions

View File

@ -7,9 +7,9 @@ SYMBOL: ui-backend
HOOK: set-title ui-backend ( string world -- )
HOOK: set-fullscreen* ui-backend ( ? world -- )
HOOK: (set-fullscreen) ui-backend ( world ? -- )
HOOK: fullscreen* ui-backend ( world -- ? )
HOOK: (fullscreen?) ui-backend ( world -- ? )
HOOK: (open-window) ui-backend ( world -- )

View File

@ -101,10 +101,10 @@ M: cocoa-ui-backend set-title ( string world -- )
: exit-fullscreen ( world -- )
handle>> view>> f -> exitFullScreenModeWithOptions: ;
M: cocoa-ui-backend set-fullscreen* ( ? world -- )
swap [ enter-fullscreen ] [ exit-fullscreen ] if ;
M: cocoa-ui-backend (set-fullscreen) ( world ? -- )
[ enter-fullscreen ] [ exit-fullscreen ] if ;
M: cocoa-ui-backend fullscreen* ( world -- ? )
M: cocoa-ui-backend (fullscreen?) ( world -- ? )
handle>> view>> -> isInFullScreenMode zero? not ;
M:: cocoa-ui-backend (open-window) ( world -- )

View File

@ -556,11 +556,9 @@ M: windows-ui-backend do-events
[ DispatchMessage drop ] bi
] if ;
: register-wndclassex ( -- class )
"WNDCLASSEX" <c-object>
f GetModuleHandle
class-name-ptr get-global
pick GetClassInfoEx zero? [
:: register-window-class ( class-name-ptr -- )
"WNDCLASSEX" <c-object> f GetModuleHandle
class-name-ptr pick GetClassInfoEx 0 = [
"WNDCLASSEX" heap-size over set-WNDCLASSEX-cbSize
{ CS_HREDRAW CS_VREDRAW CS_OWNDC } flags over set-WNDCLASSEX-style
ui-wndproc over set-WNDCLASSEX-lpfnWndProc
@ -571,9 +569,9 @@ M: windows-ui-backend do-events
over set-WNDCLASSEX-hIcon
f IDC_ARROW LoadCursor over set-WNDCLASSEX-hCursor
class-name-ptr get-global over set-WNDCLASSEX-lpszClassName
RegisterClassEx dup win32-error=0/f
] when ;
class-name-ptr over set-WNDCLASSEX-lpszClassName
RegisterClassEx win32-error=0/f
] [ drop ] if ;
: adjust-RECT ( RECT -- )
style 0 ex-style AdjustWindowRectEx win32-error=0/f ;
@ -594,9 +592,16 @@ M: windows-ui-backend do-events
dup adjust-RECT
swap [ dup default-position-RECT ] when ;
: get-window-class ( -- class-name )
class-name-ptr [
dup expired? [ drop "Factor-window" utf16n malloc-string ] when
dup register-window-class
dup
] change-global ;
: create-window ( rect -- hwnd )
make-adjusted-RECT
[ class-name-ptr get-global f ] dip
[ get-window-class f ] dip
[
[ ex-style ] 2dip
{ WS_CLIPSIBLINGS WS_CLIPCHILDREN style } flags
@ -611,8 +616,6 @@ M: windows-ui-backend do-events
: init-win32-ui ( -- )
V{ } clone nc-buttons set-global
"MSG" malloc-object msg-obj set-global
"Factor-window" utf16n malloc-string class-name-ptr set-global
register-wndclassex drop
GetDoubleClickTime milliseconds double-click-timeout set-global ;
: cleanup-win32-ui ( -- )
@ -758,10 +761,10 @@ M: windows-ui-backend (ungrab-input) ( handle -- )
[ SW_RESTORE ShowWindow win32-error=0/f ]
} cleave ;
M: windows-ui-backend set-fullscreen* ( ? world -- )
swap [ enter-fullscreen ] [ exit-fullscreen ] if ;
M: windows-ui-backend (set-fullscreen) ( ? world -- )
[ enter-fullscreen ] [ exit-fullscreen ] if ;
M: windows-ui-backend fullscreen* ( world -- ? )
M: windows-ui-backend (fullscreen?) ( world -- ? )
[ handle>> hWnd>> hwnd>RECT ]
[ handle>> hWnd>> fullscreen-RECT ] bi
[ get-RECT-dimensions 2array 2nip ] bi@ = ;

View File

@ -268,10 +268,12 @@ M: x11-ui-backend set-title ( string world -- )
handle>> window>> swap
[ dpy get ] 2dip [ set-title-old ] [ set-title-new ] 3bi ;
M: x11-ui-backend set-fullscreen* ( ? world -- )
handle>> window>> "XClientMessageEvent" <c-object>
[ set-XClientMessageEvent-window ] keep
swap _NET_WM_STATE_ADD _NET_WM_STATE_REMOVE ?
M: x11-ui-backend (set-fullscreen) ( world ? -- )
[
handle>> window>> "XClientMessageEvent" <c-object>
[ set-XClientMessageEvent-window ] keep
] dip
_NET_WM_STATE_ADD _NET_WM_STATE_REMOVE ?
over set-XClientMessageEvent-data0
ClientMessage over set-XClientMessageEvent-type
dpy get over set-XClientMessageEvent-display

View File

@ -26,7 +26,7 @@ HELP: world-attributes
} ;
HELP: set-fullscreen
{ $values { "?" "a boolean" } { "gadget" gadget } }
{ $values { "gadget" gadget } { "?" "a boolean" } }
{ $description "Sets and unsets fullscreen mode for the gadget's world." } ;
HELP: fullscreen?

View File

@ -209,14 +209,14 @@ PRIVATE>
: open-window ( gadget title/attributes -- )
?attributes <world> open-world-window ;
: set-fullscreen ( ? gadget -- )
find-world set-fullscreen* ;
: set-fullscreen ( gadget ? -- )
[ find-world ] dip (set-fullscreen) ;
: fullscreen? ( gadget -- ? )
find-world fullscreen* ;
find-world (fullscreen?) ;
: toggle-fullscreen ( gadget -- )
[ fullscreen? not ] keep set-fullscreen ;
dup fullscreen? not set-fullscreen ;
: raise-window ( gadget -- )
find-world raise-window* ;

View File

@ -26,15 +26,6 @@ M: jamshred-gadget draw-gadget* ( gadget -- )
[ 100 milliseconds sleep jamshred-loop ] tri
] if ;
: fullscreen ( gadget -- )
find-world t swap set-fullscreen* ;
: no-fullscreen ( gadget -- )
find-world f swap set-fullscreen* ;
: toggle-fullscreen ( world -- )
[ fullscreen? not ] keep set-fullscreen* ;
M: jamshred-gadget graft* ( gadget -- )
[ find-gl-context init-graphics ]
[ [ jamshred-loop ] curry in-thread ] bi ;
@ -73,12 +64,12 @@ M: jamshred-gadget ungraft* ( gadget -- )
[ second mouse-scroll-y ] 2bi ;
: quit ( gadget -- )
[ no-fullscreen ] [ close-window ] bi ;
[ f set-fullscreen ] [ close-window ] bi ;
jamshred-gadget H{
{ T{ key-down f f "r" } [ jamshred-restart ] }
{ T{ key-down f f " " } [ jamshred>> toggle-running ] }
{ T{ key-down f f "f" } [ find-world toggle-fullscreen ] }
{ T{ key-down f f "f" } [ toggle-fullscreen ] }
{ T{ key-down f f "UP" } [ jamshred>> jamshred-player 1 swap change-player-speed ] }
{ T{ key-down f f "DOWN" } [ jamshred>> jamshred-player -1 swap change-player-speed ] }
{ T{ key-down f f "LEFT" } [ jamshred>> 1 jamshred-roll ] }

View File

@ -12,6 +12,7 @@ void main()
gl_Position = v;
vec4 p = gl_ProjectionMatrixInverse * v;
p.z = -abs(p.z);
float s = sin(sky_theta), c = cos(sky_theta);
direction = mat3(1, 0, 0, 0, c, s, 0, -s, c)