Merge branch 'master' of git://factorcode.org/git/factor
Slava Pestov
commit
5cbaa1d4fd
|
|
@ -105,6 +105,15 @@ CONSTANT: kCGLRendererGenericFloatID HEX: 00020400
|
|||
|
||||
FUNCTION: CGLError CGLSetParameter ( CGLContextObj ctx, CGLContextParameter pname, GLint* params ) ;
|
||||
|
||||
FUNCTION: CGDirectDisplayID CGMainDisplayID ( ) ;
|
||||
|
||||
FUNCTION: CGError CGDisplayHideCursor ( CGDirectDisplayID display ) ;
|
||||
FUNCTION: CGError CGDisplayShowCursor ( CGDirectDisplayID display ) ;
|
||||
|
||||
FUNCTION: CGError CGAssociateMouseAndMouseCursorPosition ( boolean_t connected ) ;
|
||||
|
||||
FUNCTION: CGError CGWarpMouseCursorPosition ( CGPoint newCursorPosition ) ;
|
||||
|
||||
<PRIVATE
|
||||
|
||||
: bitmap-flags ( -- flags )
|
||||
|
|
|
|||
|
|
@ -90,5 +90,8 @@ TYPEDEF: void* CGContextRef
|
|||
TYPEDEF: uint CGBitmapInfo
|
||||
|
||||
TYPEDEF: int CGLError
|
||||
TYPEDEF: int CGError
|
||||
TYPEDEF: uint CGDirectDisplayID
|
||||
TYPEDEF: int boolean_t
|
||||
TYPEDEF: void* CGLContextObj
|
||||
TYPEDEF: int CGLContextParameter
|
||||
|
|
@ -21,6 +21,8 @@ M: rect pprint*
|
|||
|
||||
: rect-extent ( rect -- loc ext ) rect-bounds over v+ ;
|
||||
|
||||
: rect-center ( rect -- center ) rect-bounds 2 v/n v+ ;
|
||||
|
||||
: with-rect-extents ( rect1 rect2 loc-quot: ( loc1 loc2 -- ) ext-quot: ( ext1 ext2 -- ) -- )
|
||||
[ [ rect-extent ] bi@ ] 2dip bi-curry* bi* ; inline
|
||||
|
||||
|
|
|
|||
|
|
@ -32,3 +32,7 @@ HOOK: offscreen-pixels ui-backend ( world -- alien w h )
|
|||
[ flush-gl-context gl-error ] bi ; inline
|
||||
|
||||
HOOK: (with-ui) ui-backend ( quot -- )
|
||||
|
||||
HOOK: (grab-input) ui-backend ( handle -- )
|
||||
|
||||
HOOK: (ungrab-input) ui-backend ( handle -- )
|
||||
|
|
|
|||
|
|
@ -122,6 +122,17 @@ M:: cocoa-ui-backend (open-window) ( world -- )
|
|||
M: cocoa-ui-backend (close-window) ( handle -- )
|
||||
window>> -> release ;
|
||||
|
||||
M: cocoa-ui-backend (grab-input) ( handle -- )
|
||||
0 CGAssociateMouseAndMouseCursorPosition drop
|
||||
CGMainDisplayID CGDisplayHideCursor drop
|
||||
window>> -> frame CGRect>rect rect-center
|
||||
first2 <CGPoint> CGWarpMouseCursorPosition drop ;
|
||||
|
||||
M: cocoa-ui-backend (ungrab-input) ( handle -- )
|
||||
drop
|
||||
CGMainDisplayID CGDisplayShowCursor drop
|
||||
1 CGAssociateMouseAndMouseCursorPosition drop ;
|
||||
|
||||
M: cocoa-ui-backend close-window ( gadget -- )
|
||||
find-world [
|
||||
handle>> [
|
||||
|
|
|
|||
|
|
@ -11,7 +11,7 @@ threads libc combinators fry combinators.short-circuit continuations
|
|||
command-line shuffle opengl ui.render ascii math.bitwise locals
|
||||
accessors math.rectangles math.order ascii calendar
|
||||
io.encodings.utf16n windows.errors literals ui.pixel-formats
|
||||
ui.pixel-formats.private memoize classes ;
|
||||
ui.pixel-formats.private memoize classes struct-arrays ;
|
||||
IN: ui.backend.windows
|
||||
|
||||
SINGLETON: windows-ui-backend
|
||||
|
|
@ -703,9 +703,23 @@ M: windows-ui-backend beep ( -- )
|
|||
"MONITORINFOEX" <c-object> dup length over set-MONITORINFOEX-cbSize
|
||||
[ GetMonitorInfo win32-error=0/f ] keep MONITORINFOEX-rcMonitor ;
|
||||
|
||||
: client-area>RECT ( hwnd -- RECT )
|
||||
"RECT" <c-object>
|
||||
[ GetClientRect win32-error=0/f ]
|
||||
[ "POINT" byte-array>struct-array [ ClientToScreen drop ] with each ]
|
||||
[ nip ] 2tri ;
|
||||
|
||||
: hwnd>RECT ( hwnd -- RECT )
|
||||
"RECT" <c-object> [ GetWindowRect win32-error=0/f ] keep ;
|
||||
|
||||
M: windows-ui-backend (grab-input) ( handle -- )
|
||||
0 ShowCursor drop
|
||||
hWnd>> client-area>RECT ClipCursor drop ;
|
||||
M: windows-ui-backend (ungrab-input) ( handle -- )
|
||||
drop
|
||||
f ClipCursor drop
|
||||
1 ShowCursor drop ;
|
||||
|
||||
: fullscreen-flags ( -- n )
|
||||
{ WS_CAPTION WS_BORDER WS_THICKFRAME } flags ; inline
|
||||
|
||||
|
|
|
|||
|
|
@ -11,7 +11,7 @@ CONSTANT: default-world-pixel-format-attributes
|
|||
{ windowed double-buffered T{ depth-bits { value 16 } } }
|
||||
|
||||
TUPLE: world < track
|
||||
active? focused?
|
||||
active? focused? grab-input?
|
||||
layers
|
||||
title status status-owner
|
||||
text-handle handle images
|
||||
|
|
@ -20,6 +20,7 @@ TUPLE: world < track
|
|||
|
||||
TUPLE: world-attributes
|
||||
{ world-class initial: world }
|
||||
grab-input?
|
||||
title
|
||||
status
|
||||
gadgets
|
||||
|
|
@ -63,13 +64,15 @@ M: world request-focus-on ( child gadget -- )
|
|||
vertical swap new-track
|
||||
t >>root?
|
||||
t >>active?
|
||||
{ 0 0 } >>window-loc ;
|
||||
{ 0 0 } >>window-loc
|
||||
f >>grab-input? ;
|
||||
|
||||
: apply-world-attributes ( world attributes -- world )
|
||||
{
|
||||
[ title>> >>title ]
|
||||
[ status>> >>status ]
|
||||
[ pixel-format-attributes>> >>pixel-format-attributes ]
|
||||
[ grab-input?>> >>grab-input? ]
|
||||
[ gadgets>> [ 1 track-add ] each ]
|
||||
} cleave ;
|
||||
|
||||
|
|
|
|||
|
|
@ -41,14 +41,23 @@ SYMBOL: windows
|
|||
lose-focus swap each-gesture
|
||||
gain-focus swap each-gesture ;
|
||||
|
||||
: ?grab-input ( world -- )
|
||||
dup grab-input?>> [ handle>> (grab-input) ] [ drop ] if ;
|
||||
|
||||
: ?ungrab-input ( world -- )
|
||||
dup grab-input?>> [ handle>> (ungrab-input) ] [ drop ] if ;
|
||||
|
||||
: focus-world ( world -- )
|
||||
t >>focused?
|
||||
[ ?grab-input ] [
|
||||
dup raised-window
|
||||
focus-path f focus-gestures ;
|
||||
focus-path f focus-gestures
|
||||
] bi ;
|
||||
|
||||
: unfocus-world ( world -- )
|
||||
f >>focused?
|
||||
focus-path f swap focus-gestures ;
|
||||
[ ?ungrab-input ]
|
||||
[ focus-path f swap focus-gestures ] bi ;
|
||||
|
||||
: try-to-open-window ( world -- )
|
||||
{
|
||||
|
|
|
|||
|
|
@ -652,9 +652,9 @@ FUNCTION: HDC BeginPaint ( HWND hwnd, LPPAINTSTRUCT lpPaint ) ;
|
|||
FUNCTION: HWND ChildWindowFromPoint ( HWND hWndParent, POINT point ) ;
|
||||
! FUNCTION: ChildWindowFromPointEx
|
||||
! FUNCTION: ClientThreadSetup
|
||||
! FUNCTION: ClientToScreen
|
||||
FUNCTION: BOOL ClientToScreen ( HWND hWnd, POINT* point ) ;
|
||||
! FUNCTION: CliImmSetHotKey
|
||||
! FUNCTION: ClipCursor
|
||||
FUNCTION: int ClipCursor ( RECT* clipRect ) ;
|
||||
FUNCTION: BOOL CloseClipboard ( ) ;
|
||||
! FUNCTION: CloseDesktop
|
||||
! FUNCTION: CloseWindow
|
||||
|
|
@ -1363,7 +1363,7 @@ CONSTANT: HWND_TOP f
|
|||
! FUNCTION: SetWindowWord
|
||||
! FUNCTION: SetWinEventHook
|
||||
! FUNCTION: ShowCaret
|
||||
! FUNCTION: ShowCursor
|
||||
FUNCTION: int ShowCursor ( BOOL show ) ;
|
||||
! FUNCTION: ShowOwnedPopups
|
||||
! FUNCTION: ShowScrollBar
|
||||
! FUNCTION: ShowStartGlass
|
||||
|
|
|
|||
|
|
@ -27,10 +27,10 @@ ARTICLE: "game-input" "Game controller input"
|
|||
{ $subsection mouse-state } ;
|
||||
|
||||
HELP: open-game-input
|
||||
{ $description "Initializes the game input interface. An exception will be thrown if the initialization fails. If the game input interface is already opened, nothing happens." } ;
|
||||
{ $description "Initializes the game input interface. An exception will be thrown if the initialization fails. Calls to open-game-input are reference counted; each call to open-game-input needs a corresponding call to close-game-input to close the game input interface." } ;
|
||||
|
||||
HELP: close-game-input
|
||||
{ $description "Closes the game input interface, releasing any allocated resources. Once this word is called, any remaining " { $link controller } " objects are invalid. If the game input interface is not opened, nothing happens." } ;
|
||||
{ $description "Closes the game input interface, releasing any allocated resources. Once this word is called, any remaining " { $link controller } " objects are invalid." } ;
|
||||
|
||||
HELP: game-input-opened?
|
||||
{ $values { "?" "a boolean" } }
|
||||
|
|
|
|||
|
|
@ -1,34 +1,57 @@
|
|||
USING: arrays accessors continuations kernel system
|
||||
USING: arrays accessors continuations kernel math system
|
||||
sequences namespaces init vocabs vocabs.loader combinators ;
|
||||
IN: game-input
|
||||
|
||||
SYMBOLS: game-input-backend game-input-opened ;
|
||||
|
||||
game-input-opened [ 0 ] initialize
|
||||
|
||||
HOOK: (open-game-input) game-input-backend ( -- )
|
||||
HOOK: (close-game-input) game-input-backend ( -- )
|
||||
HOOK: (reset-game-input) game-input-backend ( -- )
|
||||
|
||||
HOOK: get-controllers game-input-backend ( -- sequence )
|
||||
|
||||
HOOK: product-string game-input-backend ( controller -- string )
|
||||
HOOK: product-id game-input-backend ( controller -- id )
|
||||
HOOK: instance-id game-input-backend ( controller -- id )
|
||||
|
||||
HOOK: read-controller game-input-backend ( controller -- controller-state )
|
||||
HOOK: calibrate-controller game-input-backend ( controller -- )
|
||||
|
||||
HOOK: read-keyboard game-input-backend ( -- keyboard-state )
|
||||
|
||||
HOOK: read-mouse game-input-backend ( -- mouse-state )
|
||||
|
||||
HOOK: reset-mouse game-input-backend ( -- )
|
||||
|
||||
: game-input-opened? ( -- ? )
|
||||
game-input-opened get ;
|
||||
game-input-opened get zero? not ;
|
||||
|
||||
<PRIVATE
|
||||
|
||||
M: f (reset-game-input) ;
|
||||
|
||||
: reset-game-input ( -- )
|
||||
game-input-opened off
|
||||
(reset-game-input) ;
|
||||
|
||||
[ reset-game-input ] "game-input" add-init-hook
|
||||
|
||||
PRIVATE>
|
||||
|
||||
ERROR: game-input-not-open ;
|
||||
|
||||
: open-game-input ( -- )
|
||||
game-input-opened? [
|
||||
(open-game-input)
|
||||
game-input-opened on
|
||||
] unless ;
|
||||
] unless
|
||||
game-input-opened [ 1+ ] change-global
|
||||
reset-mouse ;
|
||||
: close-game-input ( -- )
|
||||
game-input-opened [
|
||||
dup zero? [ game-input-not-open ] when
|
||||
1-
|
||||
] change-global
|
||||
game-input-opened? [
|
||||
(close-game-input)
|
||||
reset-game-input
|
||||
|
|
@ -48,12 +71,6 @@ SYMBOLS:
|
|||
pov-up pov-up-right pov-right pov-down-right
|
||||
pov-down pov-down-left pov-left pov-up-left ;
|
||||
|
||||
HOOK: get-controllers game-input-backend ( -- sequence )
|
||||
|
||||
HOOK: product-string game-input-backend ( controller -- string )
|
||||
HOOK: product-id game-input-backend ( controller -- id )
|
||||
HOOK: instance-id game-input-backend ( controller -- id )
|
||||
|
||||
: find-controller-products ( product-id -- sequence )
|
||||
get-controllers [ product-id = ] with filter ;
|
||||
: find-controller-instance ( product-id instance-id -- controller/f )
|
||||
|
|
@ -63,25 +80,16 @@ HOOK: instance-id game-input-backend ( controller -- id )
|
|||
[ instance-id = ] 2bi* and
|
||||
] with with find nip ;
|
||||
|
||||
HOOK: read-controller game-input-backend ( controller -- controller-state )
|
||||
HOOK: calibrate-controller game-input-backend ( controller -- )
|
||||
|
||||
TUPLE: keyboard-state keys ;
|
||||
|
||||
M: keyboard-state clone
|
||||
call-next-method dup keys>> clone >>keys ;
|
||||
|
||||
HOOK: read-keyboard game-input-backend ( -- keyboard-state )
|
||||
|
||||
TUPLE: mouse-state dx dy scroll-dx scroll-dy buttons ;
|
||||
|
||||
M: mouse-state clone
|
||||
call-next-method dup buttons>> clone >>buttons ;
|
||||
|
||||
HOOK: read-mouse game-input-backend ( -- mouse-state )
|
||||
|
||||
HOOK: reset-mouse game-input-backend ( -- )
|
||||
|
||||
{
|
||||
{ [ os windows? ] [ "game-input.dinput" require ] }
|
||||
{ [ os macosx? ] [ "game-input.iokit" require ] }
|
||||
|
|
|
|||
|
|
@ -162,18 +162,19 @@ M: key-caps-gadget pref-dim* drop KEYBOARD-SIZE ;
|
|||
relayout-1 ;
|
||||
|
||||
M: key-caps-gadget graft*
|
||||
open-game-input
|
||||
dup '[ _ update-key-caps-state ] FREQUENCY every >>alarm
|
||||
drop ;
|
||||
|
||||
M: key-caps-gadget ungraft*
|
||||
alarm>> [ cancel-alarm ] when* ;
|
||||
alarm>> [ cancel-alarm ] when*
|
||||
close-game-input ;
|
||||
|
||||
M: key-caps-gadget handle-gesture
|
||||
drop [ key-down? ] [ key-up? ] bi or not ;
|
||||
|
||||
: key-caps ( -- )
|
||||
[
|
||||
open-game-input
|
||||
<key-caps-gadget> { 5 5 } <border> "Key Caps" open-window
|
||||
] with-ui ;
|
||||
|
||||
|
|
|
|||
|
|
@ -10,7 +10,7 @@ IN: terrain
|
|||
|
||||
CONSTANT: FOV $[ 2.0 sqrt 1+ ]
|
||||
CONSTANT: NEAR-PLANE $[ 1.0 1024.0 / ]
|
||||
CONSTANT: FAR-PLANE 1.0
|
||||
CONSTANT: FAR-PLANE 2.0
|
||||
CONSTANT: EYE-START { 0.5 0.5 1.2 }
|
||||
CONSTANT: TICK-LENGTH $[ 1000 30 /i ]
|
||||
CONSTANT: MOUSE-SCALE $[ 1.0 10.0 / ]
|
||||
|
|
@ -111,6 +111,7 @@ TUPLE: terrain-world < world
|
|||
key-s keys nth [ world move-backward ] when
|
||||
key-a keys nth [ world move-leftward ] when
|
||||
key-d keys nth [ world move-rightward ] when
|
||||
key-escape keys nth [ world close-window ] when
|
||||
world read-mouse rotate-with-mouse
|
||||
reset-mouse ;
|
||||
|
||||
|
|
@ -126,8 +127,8 @@ M: terrain-world draw*
|
|||
GL_TEXTURE_2D GL_TEXTURE0 bind-texture-unit
|
||||
GL_TEXTURE_2D GL_TEXTURE_MIN_FILTER GL_LINEAR glTexParameteri
|
||||
GL_TEXTURE_2D GL_TEXTURE_MAG_FILTER GL_LINEAR glTexParameteri
|
||||
GL_TEXTURE_2D GL_TEXTURE_WRAP_S GL_CLAMP glTexParameteri
|
||||
GL_TEXTURE_2D GL_TEXTURE_WRAP_T GL_CLAMP glTexParameteri ;
|
||||
GL_TEXTURE_2D GL_TEXTURE_WRAP_S GL_CLAMP_TO_EDGE glTexParameteri
|
||||
GL_TEXTURE_2D GL_TEXTURE_WRAP_T GL_CLAMP_TO_EDGE glTexParameteri ;
|
||||
|
||||
M: terrain-world begin-world
|
||||
"2.0" { "GL_ARB_vertex_buffer_object" "GL_ARB_shader_objects" }
|
||||
|
|
@ -146,10 +147,11 @@ M: terrain-world begin-world
|
|||
>>terrain-program
|
||||
vertex-array >vertex-buffer >>terrain-vertex-buffer
|
||||
TICK-LENGTH over <game-loop> [ >>game-loop ] keep start-loop
|
||||
reset-mouse
|
||||
open-game-input
|
||||
drop ;
|
||||
|
||||
M: terrain-world end-world
|
||||
close-game-input
|
||||
{
|
||||
[ game-loop>> stop-loop ]
|
||||
[ terrain-vertex-buffer>> delete-gl-buffer ]
|
||||
|
|
@ -177,7 +179,6 @@ M: terrain-world pref-dim* drop { 640 480 } ;
|
|||
|
||||
: terrain-window ( -- )
|
||||
[
|
||||
open-game-input
|
||||
f T{ world-attributes
|
||||
{ world-class terrain-world }
|
||||
{ title "Terrain" }
|
||||
|
|
@ -186,5 +187,6 @@ M: terrain-world pref-dim* drop { 640 480 } ;
|
|||
double-buffered
|
||||
T{ depth-bits { value 24 } }
|
||||
} }
|
||||
{ grab-input? t }
|
||||
} open-window
|
||||
] with-ui ;
|
||||
|
|
|
|||
Loading…
Reference in New Issue