steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

ui improvements, copy/paste added

release
erg 2006-07-24 18:57:36 +00:00
parent d85cf7b9ba
commit fcb6528ca8
2 changed files with 23 additions and 27 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
library/ui/windows/clipboard.factor
View File

@ -1,7 +1,7 @@
! Copyright (C) 2006 Doug Coleman. ! Copyright (C) 2006 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: kernel win32-api math namespaces io prettyprint errors sequences alien USING: kernel win32-api math namespaces io prettyprint errors sequences alien
libc ; libc gadgets ;
IN: win32 IN: win32
: (enum-clipboard) ( n -- ) : (enum-clipboard) ( n -- )
@ -39,7 +39,11 @@ IN: win32
CloseClipboard drop ; CloseClipboard drop ;
! TODO TUPLE: pasteboard ;
! M: win-clipboard paste-clipboard ( gadget clipboard -- ) M: pasteboard clipboard-contents ( pb -- str ) drop paste ;
! >r find-world world-handle win-hWnd r> clipboard-contents paste ; M: pasteboard set-clipboard-contents ( str pb -- ) drop copy ;
: init-clipboard ( -- )
<pasteboard> clipboard set-global ;
! Notes: SetClipboardViewer, ChangeClipboardChaifn

38
library/ui/windows/ui.factor
View File

@ -72,27 +72,31 @@ SYMBOL: class-name
: ctrl? ( -- ? ) left-ctrl? right-ctrl? or ; : ctrl? ( -- ? ) left-ctrl? right-ctrl? or ;
: alt? ( -- ? ) left-alt? right-alt? or ; : alt? ( -- ? ) left-alt? right-alt? or ;
: caps-lock? ( -- ? ) VK_CAPITAL GetKeyState zero? not ; : caps-lock? ( -- ? ) VK_CAPITAL GetKeyState zero? not ;
: lower-case? ( -- ? ) shift? caps-lock? and caps-lock? not shift? not and or ;
: key-modifiers ( -- list ) : key-modifiers ( -- list )
[ [
shift? [ S+ , ] when shift? [ S+ , ] when
ctrl? [ C+ , ] when ctrl? [ C+ , ] when
alt? [ A+ , ] when alt? [ A+ , ] when
] { } make dup empty? f swap ? ; ] { } make [ empty? not ] keep f ? ;
: wm-char-exclude-keys : exclude-keys
H{ H{
{ 8 "BACKSPACE" } ! { 8 "BACKSPACE" }
{ 9 "TAB" } ! { 9 "TAB" }
{ 13 "RETURN" } { 16 "SHIFT" }
{ 17 "CTRL" }
{ 18 "ALT" }
{ 20 "CAPS-LOCK" }
{ 27 "ESCAPE" } { 27 "ESCAPE" }
} ; } ;
: exclude-key? ( n -- bool ) wm-char-exclude-keys hash* nip ; : exclude-key? ( n -- bool ) exclude-keys hash* nip ;
: handle-key? ( n -- bool ) wm-keydown-codes hash* nip ; : handle-key? ( n -- bool ) wm-keydown-codes hash* nip ;
: keystroke>gesture ( n -- <key-down> ) : keystroke>gesture ( n -- <key-down> )
dup wm-keydown-codes hash* [ nip ] [ drop ch>string ] if dup wm-keydown-codes hash* [ nip ] [ drop ch>string lower-case? [ >lower ] when ] if
key-modifiers swap ; key-modifiers swap ;
SYMBOL: lParam SYMBOL: lParam
@ -105,29 +109,19 @@ SYMBOL: hWnd
: handle-wm-keydown ( hWnd uMsg wParam lParam -- ) : handle-wm-keydown ( hWnd uMsg wParam lParam -- )
lParam set wParam set uMsg set hWnd set lParam set wParam set uMsg set hWnd set
wParam get handle-key? [ wParam get exclude-key? [
wParam get keystroke>gesture <key-down> wParam get keystroke>gesture <key-down>
hWnd get get-focus handle-gesture [ hWnd get get-focus handle-gesture [
wParam get ch>string hWnd get get-focus user-input wParam get ch>string lower-case? [ >lower ] when
hWnd get get-focus user-input
] when ] when
] when ; ] unless ;
: handle-wm-keyup ( hWnd uMsg wParam lParam -- ) : handle-wm-keyup ( hWnd uMsg wParam lParam -- )
lParam set wParam set uMsg set hWnd set lParam set wParam set uMsg set hWnd set
wParam get keystroke>gesture <key-up> hWnd get get-focus handle-gesture wParam get keystroke>gesture <key-up> hWnd get get-focus handle-gesture
drop ; drop ;
: handle-wm-char ( hWnd uMsg wParam lParam -- int )
lParam set wParam set uMsg set hWnd set
wParam get exclude-key? [
wParam get ch>string hWnd get window world-focus
2dup >r unit r> handle-gesture [
user-input
] [
2drop
] if
] unless ;
: cleanup-window ( handle -- ) : cleanup-window ( handle -- )
[ win-hRC wglDeleteContext win32-error=0 ] keep [ win-hRC wglDeleteContext win32-error=0 ] keep
[ win-hWnd ] keep win-hDC ReleaseDC win32-error=0 ; [ win-hWnd ] keep win-hDC ReleaseDC win32-error=0 ;
@ -202,8 +196,6 @@ SYMBOL: hWnd
[ drop handle-wm-keydown 0 ] } [ drop handle-wm-keydown 0 ] }
{ [ dup WM_KEYUP = over WM_SYSKEYUP = or ] { [ dup WM_KEYUP = over WM_SYSKEYUP = or ]
[ drop handle-wm-keyup 0 ] } [ drop handle-wm-keyup 0 ] }
{ [ dup WM_CHAR = over WM_SYSCHAR = or ]
[ drop handle-wm-char 0 ] }
{ [ dup WM_SETFOCUS = ] [ drop handle-wm-set-focus 0 ] } { [ dup WM_SETFOCUS = ] [ drop handle-wm-set-focus 0 ] }
{ [ dup WM_KILLFOCUS = ] [ drop handle-wm-kill-focus 0 ] } { [ dup WM_KILLFOCUS = ] [ drop handle-wm-kill-focus 0 ] }