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

dialogs

cvs
Slava Pestov 2005-02-20 02:49:37 +00:00
parent 8d139c621a
commit 3b98c55ecf
15 changed files with 101 additions and 48 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

17
examples/gadget-test.factor
View File

@ -36,22 +36,6 @@ USE: stdio
USE: prettyprint
USE: words
: grab ( gadget hand -- )
[ swap screen-pos swap screen-pos - >rect ] 2keep
>r [ move-gadget ] keep r> add-gadget ;
: release ( gadget world -- )
>r dup screen-pos >r
dup unparent
r> >rect pick move-gadget
r> add-gadget ;
: moving-actions
{{
[[ [ button-down 1 ] [ my-hand grab ] ]]
[[ [ button-up 1 ] [ world get release ] ]]
}} swap set-gadget-gestures ;
: filled? "filled" get checkbox-selected? ;
: <funny-rect>
@ -72,6 +56,7 @@ USE: words
"New Rectangle" [ drop 100 100 100 100 <funny-rect> dup [ 255 255 0 ] background set-paint-property world get add-gadget ] <button> "shelf" get add-gadget
"New Ellipse" [ drop 100 100 200 100 <funny-ellipse> dup [ 0 255 0 ] background set-paint-property world get add-gadget ] <button> "shelf" get add-gadget
"New Line" [ drop 100 100 200 100 <funny-line> dup [ 255 0 0 ] background set-paint-property world get add-gadget ] <button> "shelf" get add-gadget
"Prompt" [ drop "Enter input text:" input-dialog . flush ] <button> "shelf" get add-gadget
"Filled?" <checkbox> dup "filled" set "shelf" get add-gadget
"shelf" get "pile" get add-gadget
"Welcome to Factor " version cat2 <label> "pile" get add-gadget

14
factor/DefaultVocabularyLookup.java
View File

@ -121,19 +121,19 @@ public class DefaultVocabularyLookup implements VocabularyLookup
pushWord.parsing = new PushWord(pushWord);
/* OOP */
FactorWord generic = define("generic","GENERIC:");
FactorWord generic = define("syntax","GENERIC:");
generic.parsing = new Definer(generic);
FactorWord traits = define("generic","TRAITS:");
FactorWord traits = define("syntax","TRAITS:");
traits.parsing = new Definer(traits);
FactorWord beginMethod = define("generic","M:");
FactorWord beginMethod = define("syntax","M:");
beginMethod.parsing = new BeginMethod(beginMethod);
FactorWord beginConstructor = define("generic","C:");
FactorWord beginConstructor = define("syntax","C:");
beginConstructor.parsing = new BeginConstructor(beginConstructor);
FactorWord beginPredicate = define("generic","PREDICATE:");
FactorWord beginPredicate = define("syntax","PREDICATE:");
beginPredicate.parsing = new BeginPredicate(beginPredicate);
FactorWord beginUnion = define("generic","UNION:");
FactorWord beginUnion = define("syntax","UNION:");
beginUnion.parsing = new BeginUnion(beginUnion);
FactorWord tuple = define("generic","TUPLE:");
FactorWord tuple = define("syntax","TUPLE:");
tuple.parsing = new Tuple(tuple);
} //}}}

2
factor/FactorReader.java
View File

@ -204,6 +204,8 @@ public class FactorReader
//{{{ addUse() method
public void addUse(String name)
{
if(name.equals("!syntax"))
return;
setUse(new Cons(name,getUse()));
} //}}}

1
factor/jedit/FactorPlugin.java
View File

@ -116,6 +116,7 @@ public class FactorPlugin extends EditPlugin
List args = new ArrayList();
args.add(exePath);
args.add(imagePath);
args.add("-null-stdio");
args.add("-shell=telnet");
args.add("-telnetd-port=" + PORT);
String[] extraArgs = jEdit.getProperty(

2
library/bootstrap/boot-stage2.factor
View File

@ -177,6 +177,8 @@ cpu "x86" = "mini" get not and [
"/library/ui/labels.factor"
"/library/ui/buttons.factor"
"/library/ui/fields.factor"
"/library/ui/halo.factor"
"/library/ui/dialogs.factor"
"/library/ui/events.factor"
] [
dup print

3
library/bootstrap/init-stage2.factor
View File

@ -22,7 +22,8 @@ words unparser kernel-internals console assembler memory ;
init-error-handler
init-random
default-cli-args
parse-command-line ;
parse-command-line
"null-stdio" get [ << null-stream >> stdio set ] when ;
: shell ( str -- )
#! This handles the -shell:<foo> cli argument.

14
library/io/stream-impl.factor
View File

@ -41,9 +41,6 @@ M: fd-stream stream-close ( stream -- )
: <file-writer> ( path -- stream )
f t open-file <fd-stream> ;
: init-stdio ( -- )
stdin stdout <fd-stream> <stdio-stream> stdio set ;
: (fcopy) ( from to -- )
#! Copy the contents of the fd-stream 'from' to the
#! fd-stream 'to'. Use fcopy; this word does not close
@ -64,3 +61,14 @@ M: fd-stream stream-close ( stream -- )
: <resource-stream> ( path -- stream )
resource-path swap path+ <file-reader> ;
TUPLE: null-stream ;
M: null-stream stream-flush drop ;
M: null-stream stream-auto-flush drop ;
M: null-stream stream-read 2drop f ;
M: null-stream stream-readln drop f ;
M: null-stream stream-write-attr 3drop ;
M: null-stream stream-close drop ;
: init-stdio ( -- )
stdin stdout <fd-stream> <stdio-stream> stdio set ;

8
library/io/win32-io-internals.factor
View File

@ -138,14 +138,6 @@ END-STRUCT
] ifte*
win32-io-thread ;
TUPLE: null-stream ;
M: null-stream stream-flush drop ;
M: null-stream stream-auto-flush drop ;
M: null-stream stream-read 2drop f ;
M: null-stream stream-readln drop f ;
M: null-stream stream-write-attr 3drop ;
M: null-stream stream-close drop ;
: win32-init-stdio ( -- )
INVALID_HANDLE_VALUE NULL NULL 1 CreateIoCompletionPort
completion-port set

2
library/ui/buttons.factor
View File

@ -76,7 +76,7 @@ TUPLE: checkbox bevel selected? delegate ;
C: checkbox ( label -- checkbox )
<default-shelf> over set-checkbox-delegate
[ >r <label> r> add-gadget ] keep
[ f bevel-border swap init-checkbox-bevel ] keep
[ >r <label> r> add-gadget ] keep
dup [ toggle-checkbox ] button-actions
dup update-checkbox ;

38
library/ui/dialogs.factor Normal file
View File

@ -0,0 +1,38 @@
IN: gadgets
USING: kernel namespaces threads ;
TUPLE: dialog continuation delegate ;
: dialog-ok ( dialog -- )
dup unparent t swap dialog-continuation call ;
: dialog-cancel ( dialog -- )
dup unparent f swap dialog-continuation call ;
: <dialog-buttons> ( -- gadget )
<default-shelf>
"OK" [ [ dialog-ok ] swap handle-gesture drop ]
<button> over add-gadget
"Cancel" [ [ dialog-cancel ] swap handle-gesture drop ]
<button> over add-gadget ;
C: dialog ( content continuation -- gadget )
[ set-dialog-continuation ] keep
<default-pile> over set-dialog-delegate
[ add-gadget ] keep
[ >r <dialog-buttons> r> add-gadget ] keep
( bevel-border )
dup moving-actions
dup [ dialog-ok ] dup set-action
dup [ dialog-cancel ] dup set-action ;
: <prompt> ( prompt -- gadget )
0 default-gap <pile>
[ >r <label> r> add-gadget ] keep
[ >r "" <field> r> add-gadget ] keep ;
: <input-dialog> ( prompt continuation -- gadget )
>r <prompt> r> <dialog> ;
: input-dialog ( prompt -- input )
[ <input-dialog> world get add-gadget (yield) ] callcc1 ;

2
library/ui/fields.factor
View File

@ -85,7 +85,7 @@ TUPLE: field active? editor delegate ;
bevel-border dup f bevel-up? set-paint-property ;
M: field user-input* ( ch field -- ? )
field-editor [ insert-char ] with-editor f ;
field-editor [ insert-char ] with-editor t ;
: field-gestures ( -- hash )
{{

12
library/ui/gadgets.factor
View File

@ -44,7 +44,9 @@ C: gadget ( shape -- gadget )
f swap set-gadget-parent ;
: (add-gadget) ( gadget box -- )
[ gadget-children cons ] keep set-gadget-children ;
#! This is inefficient.
[ gadget-children swap unit append ] keep
set-gadget-children ;
: unparent ( gadget -- )
dup gadget-parent dup [ remove-gadget ] [ 2drop ] ifte ;
@ -78,15 +80,17 @@ C: gadget ( shape -- gadget )
] ifte ; inline
: each-parent ( gadget quot -- ? )
#! Keep executing the quotation on higher and higher
#! parents until it returns f.
>r parent-list r> (each-parent) ; inline
: relative-pos ( g1 g2 -- g2-p1 )
shape-pos swap screen-pos - ;
: screen-pos ( gadget -- point )
#! The position of the gadget on the screen.
0 swap [ shape-pos + t ] each-parent drop ;
: relative-pos ( g1 g2 -- g2-p1 )
shape-pos swap screen-pos - ;
: child? ( parent child -- ? )
dup [
2dup eq? [ 2drop t ] [ gadget-parent child? ] ifte

2
library/ui/gestures.factor
View File

@ -24,7 +24,7 @@ USING: alien generic hashtables kernel lists math sdl-event ;
[ dupd handle-gesture* ] each-parent nip ;
GENERIC: user-input* ( ch gadget -- ? )
M: gadget user-input* 2drop f ;
M: gadget user-input* 2drop t ;
: user-input ( ch gadget -- ? )
[ dupd user-input* ] each-parent nip ;

18
library/ui/halo.factor Normal file
View File

@ -0,0 +1,18 @@
! Copyright (C) 2005 Slava Pestov.
! See http://factor.sf.net/license.txt for BSD license.
IN: gadgets
USING: kernel math namespaces ;
: grab ( gadget hand -- )
[ swap screen-pos swap screen-pos - >rect ] 2keep
>r [ move-gadget ] keep r> add-gadget ;
: release ( gadget world -- )
>r dup screen-pos >r dup unparent
r> >rect pick move-gadget
r> add-gadget ;
: moving-actions ( gadget -- )
dup
[ my-hand grab ] [ button-down 1 ] set-action
[ world get release ] [ button-up 1 ] set-action ;

14
library/ui/world.factor
View File

@ -2,7 +2,7 @@
! See http://factor.sf.net/license.txt for BSD license.
IN: gadgets
USING: alien generic kernel lists math namespaces sdl sdl-event
sdl-video ;
sdl-video threads ;
! The world gadget is the top level gadget that all (visible)
! gadgets are contained in. The current world is stored in the
@ -52,14 +52,16 @@ DEFER: handle-event
world get world-step [ SDL_WaitEvent ] [ drop f ] ifte
] ifte ;
: run-world ( -- )
: run-world ( event -- )
world get world-step [
<event> dup eat-events [
handle-event run-world
dup eat-events [
[ handle-event ] in-thread run-world
] [
drop
] ifte
] when ;
] [
drop
] ifte ;
: start-world ( -- )
#! Start the Factor graphics subsystem with the given screen
@ -69,7 +71,7 @@ DEFER: handle-event
[
0 x set
0 y set
[ run-world ] with-screen
[ <event> run-world ] with-screen
] with-scope ;
global [