From 36b97dd4ee95e32b9993a2312c8813bf5e46ea46 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sat, 12 Feb 2005 00:09:48 +0000 Subject: [PATCH] working on labels and fields --- TODO.FACTOR.txt | 1 - library/sdl/sdl-keyboard.factor | 39 +++---------------------- library/sdl/sdl-utils.factor | 52 +++++---------------------------- library/ui/events.factor | 2 +- library/ui/fields.factor | 33 +++++++++++++++++++++ library/ui/hand.factor | 6 ++-- library/ui/labels.factor | 13 ++------- library/ui/paint.factor | 18 +++++++++++- 8 files changed, 68 insertions(+), 96 deletions(-) create mode 100644 library/ui/fields.factor diff --git a/TODO.FACTOR.txt b/TODO.FACTOR.txt index 029fbd05e2..4f2f0aef39 100644 --- a/TODO.FACTOR.txt +++ b/TODO.FACTOR.txt @@ -8,7 +8,6 @@ - special completion for USE:/IN: - vectors: ensure its ok with bignum indices - if gadgets are moved, added or deleted, update hand. -- keyboard focus - keyboard gestures - text fields - code gc diff --git a/library/sdl/sdl-keyboard.factor b/library/sdl/sdl-keyboard.factor index 5198d5f6db..6de8f49c2f 100644 --- a/library/sdl/sdl-keyboard.factor +++ b/library/sdl/sdl-keyboard.factor @@ -1,39 +1,8 @@ -! :folding=indent:collapseFolds=1: - -! $Id$ -! -! Copyright (C) 2004 Slava Pestov. -! -! Redistribution and use in source and binary forms ; with or without -! modification ; are permitted provided that the following conditions are met: -! -! 1. Redistributions of source code must retain the above copyright notice ; -! this list of conditions and the following disclaimer. -! -! 2. Redistributions in binary form must reproduce the above copyright notice ; -! this list of conditions and the following disclaimer in the documentation -! and/or other materials provided with the distribution. -! -! THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES ; -! INCLUDING ; BUT NOT LIMITED TO ; THE IMPLIED WARRANTIES OF MERCHANTABILITY AND -! FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE -! DEVELOPERS AND CONTRIBUTORS BE LIABLE FOR ANY DIRECT ; INDIRECT ; INCIDENTAL ; -! SPECIAL ; EXEMPLARY ; OR CONSEQUENTIAL DAMAGES (INCLUDING ; BUT NOT LIMITED TO ; -! PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE ; DATA ; OR PROFITS; -! OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY ; -! WHETHER IN CONTRACT ; STRICT LIABILITY ; OR TORT (INCLUDING NEGLIGENCE OR -! OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE ; EVEN IF -! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. - +! Copyright (C) 2004, 2005 Slava Pestov. +! See http://factor.sf.net/license.txt for BSD license. IN: sdl-keyboard -USE: alien -USE: lists -USE: sdl-keysym -USE: namespaces -USE: sdl-event -USE: kernel -USE: math -USE: hashtables +USING: alien lists sdl-keysym namespaces sdl-event kernel +math hashtables ; : SDL_EnableUNICODE ( enable -- ) "int" "sdl" "SDL_EnableUNICODE" [ "int" ] alien-invoke ; diff --git a/library/sdl/sdl-utils.factor b/library/sdl/sdl-utils.factor index 84b7772780..3f8ecfb1f1 100644 --- a/library/sdl/sdl-utils.factor +++ b/library/sdl/sdl-utils.factor @@ -1,48 +1,9 @@ -! :folding=indent:collapseFolds=1: - -! $Id$ -! ! Copyright (C) 2004, 2005 Slava Pestov. -! -! Redistribution and use in source and binary forms, with or without -! modification, are permitted provided that the following conditions are met: -! -! 1. Redistributions of source code must retain the above copyright notice, -! this list of conditions and the following disclaimer. -! -! 2. Redistributions in binary form must reproduce the above copyright notice, -! this list of conditions and the following disclaimer in the documentation -! and/or other materials provided with the distribution. -! -! THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, -! INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND -! FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE -! DEVELOPERS AND CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, -! SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, -! PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; -! OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, -! WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR -! OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF -! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. - +! See http://factor.sf.net/license.txt for BSD license. IN: sdl -USE: alien -USE: math -USE: namespaces -USE: compiler -USE: words -USE: parser -USE: kernel -USE: errors -USE: lists -USE: prettyprint -USE: sdl-event -USE: sdl-gfx -USE: sdl-video -USE: streams -USE: strings -USE: sdl-ttf -USE: hashtables +USING: alien math namespaces compiler words parser kernel errors +lists prettyprint sdl-event sdl-gfx sdl-keyboard sdl-video +streams strings sdl-ttf hashtables ; SYMBOL: surface SYMBOL: width @@ -57,6 +18,9 @@ SYMBOL: surface : with-screen ( width height bpp flags quot -- ) #! Set up SDL graphics and call the quotation. SDL_INIT_EVERYTHING SDL_Init drop TTF_Init + 1 SDL_EnableUNICODE drop + SDL_DEFAULT_REPEAT_DELAY SDL_DEFAULT_REPEAT_INTERVAL + SDL_EnableKeyRepeat drop [ >r init-screen r> call SDL_Quit ] with-scope ; inline : rgb ( [ r g b ] -- n ) @@ -180,7 +144,7 @@ global [ ] ifte ; : size-string ( font text -- w h ) - dup str-length 0 = [ + >r lookup-font r> dup str-length 0 = [ drop TTF_FontHeight 0 swap ] [ [ TTF_SizeUNICODE drop ] 2keep diff --git a/library/ui/events.factor b/library/ui/events.factor index 566d9a7ecb..c0994f910b 100644 --- a/library/ui/events.factor +++ b/library/ui/events.factor @@ -36,4 +36,4 @@ M: motion-event handle-event ( event -- ) motion-event-pos my-hand move-hand ; M: key-down-event handle-event ( event -- ) - keyboard-event>binding my-hand hand-gadget handle-gesture ; + keyboard-event>binding my-hand hand-focus handle-gesture ; diff --git a/library/ui/fields.factor b/library/ui/fields.factor new file mode 100644 index 0000000000..40c9e7015a --- /dev/null +++ b/library/ui/fields.factor @@ -0,0 +1,33 @@ +! Copyright (C) 2005 Slava Pestov. +! See http://factor.sf.net/license.txt for BSD license. +IN: gadgets +USING: generic kernel lists math namespaces sdl line-editor ; + +TUPLE: field active? delegate ; + +: field-border ( gadget -- border ) + bevel-border dup f bevel-up? set-paint-property ; + +C: field ( delegate -- field ) + [ >r field-border r> set-field-delegate ] keep + {{ + [[ [ gain-focus ] [ dup blue foreground set-paint-property redraw ] ]] + [[ [ lose-focus ] [ dup black foreground set-paint-property redraw ] ]] + [[ [ button-down 1 ] [ my-hand request-focus ] ]] + [[ [ "RETURN" ] [ drop "foo!" USE: stdio print ] ]] + }} over set-gadget-gestures ; + +TUPLE: editor line delegate ; + +C: editor ( -- ) + 0 0 0 0 over set-editor-delegate + [ set-editor-line ] keep ; + +: editor-text ( editor -- text ) + editor-line [ line-text get ] bind ; + +M: editor layout* ( label -- ) + [ editor-text dup shape-w swap shape-h ] keep resize-gadget ; + +M: editor draw-shape ( label -- ) + dup [ editor-text draw-shape ] with-translation ; diff --git a/library/ui/hand.factor b/library/ui/hand.factor index e627c1ba86..b6461eb1db 100644 --- a/library/ui/hand.factor +++ b/library/ui/hand.factor @@ -85,8 +85,8 @@ C: hand ( world -- hand ) dup fire-motion r> swap fire-enter ; -: request-focus ( gadget -- ) - my-hand hand-focus +: request-focus ( gadget hand -- ) + dup >r hand-focus 2dup lose-focus - swap dup my-hand set-hand-focus + swap dup r> set-hand-focus gain-focus ; diff --git a/library/ui/labels.factor b/library/ui/labels.factor index d19da43cc1..4befbeabe1 100644 --- a/library/ui/labels.factor +++ b/library/ui/labels.factor @@ -12,16 +12,7 @@ C: label ( text -- ) [ set-label-text ] keep ; M: label layout* ( label -- ) - [ - dup label-text swap gadget-paint - [ font get lookup-font ] bind - swap size-string - ] keep resize-gadget ; + [ label-text dup shape-w swap shape-h ] keep resize-gadget ; M: label draw-shape ( label -- ) - dup shape-x x get + - over shape-y y get + - rot label-text - >r font get lookup-font r> - foreground get 3unlist make-color - draw-string drop ; + dup [ label-text draw-shape ] with-translation ; diff --git a/library/ui/paint.factor b/library/ui/paint.factor index cf0153e0ad..960c62d89a 100644 --- a/library/ui/paint.factor +++ b/library/ui/paint.factor @@ -2,7 +2,7 @@ ! See http://factor.sf.net/license.txt for BSD license. IN: gadgets USING: generic hashtables kernel lists math namespaces -sdl sdl-gfx ; +sdl sdl-gfx sdl-ttf strings ; ! The painting protocol. Painting is controlled by various ! dynamically-scoped variables. @@ -125,3 +125,19 @@ M: plain-ellipse draw-shape ( ellipse -- ) gadget-children [ draw-gadget ] each ] with-translation ] bind ; + +! Strings are shapes too. This is somewhat of a hack and strings +! do not have x/y co-ordinates. +M: string shape-x drop 0 ; +M: string shape-y drop 0 ; +M: string shape-w + font get swap size-string ( h -) drop ; + +M: string shape-h ( text -- h ) + #! This is just the height of the current font. + drop font get lookup-font TTF_FontHeight ; + +M: string draw-shape ( text -- ) + >r x get y get font get lookup-font r> + foreground get 3unlist make-color + draw-string drop ;