working on labels and fields

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

library/sdl/sdl-keyboard.factor

@@ -1,39 +1,8 @@
-! :folding=indent:collapseFolds=1:
+! Copyright (C) 2004, 2005 Slava Pestov.
-
+! See http://factor.sf.net/license.txt for BSD license.
-! $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.
-
 IN: sdl-keyboard
-USE: alien
+USING: alien lists sdl-keysym namespaces sdl-event kernel
-USE: lists
+math hashtables ;
-USE: sdl-keysym
-USE: namespaces
-USE: sdl-event
-USE: kernel
-USE: math
-USE: hashtables
 
 : SDL_EnableUNICODE ( enable -- )
     "int" "sdl" "SDL_EnableUNICODE" [ "int" ] alien-invoke ;

library/sdl/sdl-utils.factor

@@ -1,48 +1,9 @@
-! :folding=indent:collapseFolds=1:
-
-! $Id$
-!
 ! Copyright (C) 2004, 2005 Slava Pestov.
-! 
+! See http://factor.sf.net/license.txt for BSD license.
-! 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.
-
 IN: sdl
-USE: alien
+USING: alien math namespaces compiler words parser kernel errors
-USE: math
+lists prettyprint sdl-event sdl-gfx sdl-keyboard sdl-video
-USE: namespaces
+streams strings sdl-ttf hashtables ;
-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
 
 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
     ] [
         <int-box> <int-box> [ TTF_SizeUNICODE drop ] 2keep

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 ;

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 <rectangle> <gadget> over set-editor-delegate
+    [ <line-editor> 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 ;

library/ui/hand.factor

@@ -85,8 +85,8 @@ C: hand ( world -- hand )
     dup fire-motion
     r> swap fire-enter ;
 
-: request-focus ( gadget -- )
+: request-focus ( gadget hand -- )
-    my-hand hand-focus
+    dup >r hand-focus
     2dup lose-focus
-    swap dup my-hand set-hand-focus
+    swap dup r> set-hand-focus
     gain-focus ;

library/ui/labels.factor

@@ -12,16 +12,7 @@ C: label ( text -- )
     [ set-label-text ] keep ;
 
 M: label layout* ( label -- )
-    [
+    [ label-text dup shape-w swap shape-h ] keep resize-gadget ;
-        dup label-text swap gadget-paint
-        [ font get lookup-font ] bind
-        swap size-string
-    ] keep resize-gadget ;
 
 M: label draw-shape ( label -- )
-    dup shape-x x get +
+    dup [ label-text draw-shape ] with-translation ;
-    over shape-y y get +
-    rot label-text
-    >r font get lookup-font r>
-    foreground get 3unlist make-color
-    draw-string drop ;

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 ;