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

basis/ui/backend/backend.factor

@@ -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 -- )
 

basis/ui/backend/cocoa/cocoa.factor

@@ -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 -- )
+M: cocoa-ui-backend (set-fullscreen) ( world ? -- )
-    swap [ enter-fullscreen ] [ exit-fullscreen ] if ;
+    [ 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 -- )

basis/ui/backend/windows/windows.factor

@@ -556,11 +556,9 @@ M: windows-ui-backend do-events
         [ DispatchMessage drop ] bi
     ] if ;
 
-: register-wndclassex ( -- class )
+:: register-window-class ( class-name-ptr -- )
-    "WNDCLASSEX" <c-object>
+    "WNDCLASSEX" <c-object> f GetModuleHandle
-    f GetModuleHandle
+    class-name-ptr pick GetClassInfoEx 0 = [
-    class-name-ptr get-global
-    pick GetClassInfoEx zero? [
         "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
+        class-name-ptr over set-WNDCLASSEX-lpszClassName
-        RegisterClassEx dup win32-error=0/f
+        RegisterClassEx win32-error=0/f
-    ] when ;
+    ] [ 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 -- )
+M: windows-ui-backend (set-fullscreen) ( ? world -- )
-    swap [ enter-fullscreen ] [ exit-fullscreen ] if ;
+    [ 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@ = ;

basis/ui/backend/x11/x11.factor

@@ -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 -- )
+M: x11-ui-backend (set-fullscreen) ( world ? -- )
-    handle>> window>> "XClientMessageEvent" <c-object>
+    [
-    [ set-XClientMessageEvent-window ] keep
+        handle>> window>> "XClientMessageEvent" <c-object>
-    swap _NET_WM_STATE_ADD _NET_WM_STATE_REMOVE ?
+        [ 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

basis/ui/ui-docs.factor

@@ -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?

basis/ui/ui.factor

@@ -209,14 +209,14 @@ PRIVATE>
 : open-window ( gadget title/attributes -- )
     ?attributes <world> open-world-window ;
 
-: set-fullscreen ( ? gadget -- )
+: set-fullscreen ( gadget ? -- )
-    find-world set-fullscreen* ;
+    [ 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* ;

extra/jamshred/jamshred.factor

@@ -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 ] }

extra/terrain/shaders/shaders.factor

@@ -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)