new add word, got rid of unused stdio-stream
parent
50b0eee15f
commit
69608069e1
|
@ -90,7 +90,7 @@ M: list3 (eval-infix)
|
|||
swap-in-infix \ dup swons swap append ;
|
||||
|
||||
M: list2 (eval-infix)
|
||||
2unlist swapd (eval-infix) swap arith-1 word-prop unit append ;
|
||||
2unlist swapd (eval-infix) swap arith-1 word-prop add ;
|
||||
|
||||
: build-prefix ( num-of-vars -- quote )
|
||||
#! What needs to be placed in front of the eval-infix quote
|
||||
|
|
|
@ -56,7 +56,7 @@ USE: http
|
|||
: add-todo-item ( <todo> <item> -- )
|
||||
#! Add the item to the todo list
|
||||
swap [
|
||||
"items" get swap unit append "items" set
|
||||
"items" get swap add "items" set
|
||||
] bind ;
|
||||
|
||||
: >yes/no ( bool -- str )
|
||||
|
|
|
@ -96,9 +96,13 @@ M: object contains? ( obj seq -- ? )
|
|||
[ over push ] each drop ;
|
||||
|
||||
: append ( s1 s2 -- s1+s2 )
|
||||
#! Return a new sequence of the same type as s1.
|
||||
#! Outputs a new sequence of the same type as s1.
|
||||
swap [ swap nappend ] immutable ;
|
||||
|
||||
: add ( seq elt -- seq )
|
||||
#! Outputs a new sequence of the same type as seq.
|
||||
unit append ;
|
||||
|
||||
: append3 ( s1 s2 s3 -- s1+s2+s3 )
|
||||
#! Return a new sequence of the same type as s1.
|
||||
rot [ [ rot nappend ] keep swap nappend ] immutable ;
|
||||
|
|
|
@ -30,9 +30,11 @@ M: line-reader stream-readln ( line -- string )
|
|||
|
||||
M: line-reader stream-read ( count line -- string )
|
||||
[ delegate stream-read ] keep dup cr> [
|
||||
over empty?
|
||||
[ drop ]
|
||||
[ >r 1 swap tail r> stream-read1 [ append ] when* ] ifte
|
||||
over empty? [
|
||||
drop
|
||||
] [
|
||||
>r 1 swap tail r> stream-read1 [ add ] when*
|
||||
] ifte
|
||||
] [
|
||||
drop
|
||||
] ifte ;
|
||||
|
|
|
@ -29,8 +29,3 @@ USING: errors kernel lists namespaces generic strings ;
|
|||
swap stdio set
|
||||
[ [ close rethrow ] when* ] catch
|
||||
] with-scope ;
|
||||
|
||||
TUPLE: stdio-stream ;
|
||||
C: stdio-stream ( stream -- stream ) [ set-delegate ] keep ;
|
||||
M: stdio-stream stream-auto-flush ( -- ) delegate stream-flush ;
|
||||
M: stdio-stream stream-close ( -- ) drop ;
|
||||
|
|
|
@ -19,7 +19,7 @@ M: resize-event handle-event ( event -- )
|
|||
world get relayout ;
|
||||
|
||||
: button-gesture ( button gesture -- )
|
||||
swap unit append hand hand-clicked handle-gesture drop ;
|
||||
swap add hand hand-clicked handle-gesture drop ;
|
||||
|
||||
M: button-down-event handle-event ( event -- )
|
||||
button-event-button dup hand button/
|
||||
|
|
|
@ -78,7 +78,7 @@ C: hand ( world -- hand )
|
|||
|
||||
: motion-gesture ( hand gadget gesture -- )
|
||||
#! Send a gesture like [ drag 2 ].
|
||||
rot hand-buttons car unit append swap handle-gesture drop ;
|
||||
rot hand-buttons car add swap handle-gesture drop ;
|
||||
|
||||
: fire-motion ( hand -- )
|
||||
#! Fire a motion gesture to the gadget underneath the hand,
|
||||
|
|
|
@ -11,7 +11,7 @@ sequences ;
|
|||
|
||||
: (add-gadget) ( gadget box -- )
|
||||
#! This is inefficient.
|
||||
[ gadget-children swap unit append ] keep
|
||||
[ gadget-children swap add ] keep
|
||||
set-gadget-children ;
|
||||
|
||||
: unparent ( gadget -- )
|
||||
|
|
Loading…
Reference in New Issue