factor: fix load-all
parent
1a57f8180a
commit
c715b0d505
|
|
@ -32,8 +32,8 @@ IN: escape-strings
|
||||||
[ escape-string ] dip prepend ;
|
[ escape-string ] dip prepend ;
|
||||||
|
|
||||||
: escape-simplest ( str -- str' )
|
: escape-simplest ( str -- str' )
|
||||||
dup { char: \' char: \" char: \r char: \n char: \s } counts {
|
dup { char: ' char: \" char: \r char: \n char: \s } counts {
|
||||||
{ [ dup { char: \' char: \r char: \n char: \s } values-of sum 0 = ] [ drop "'" prepend ] }
|
{ [ dup { char: ' char: \r char: \n char: \s } values-of sum 0 = ] [ drop "'" prepend ] }
|
||||||
{ [ dup char: \" of not ] [ drop "\"" "\"" surround ] }
|
{ [ dup char: \" of not ] [ drop "\"" "\"" surround ] }
|
||||||
[ drop escape-string ]
|
[ drop escape-string ]
|
||||||
} cond ;
|
} cond ;
|
||||||
|
|
|
||||||
|
|
@ -22,24 +22,6 @@ MACRO: cond-case ( assoc -- quot )
|
||||||
MACRO: cleave-array ( quots -- quot )
|
MACRO: cleave-array ( quots -- quot )
|
||||||
[ '[ _ cleave ] ] [ length '[ _ narray ] ] bi compose ;
|
[ '[ _ cleave ] ] [ length '[ _ narray ] ] bi compose ;
|
||||||
|
|
||||||
: 3bi* ( u v w x y z p q -- )
|
|
||||||
[ 3dip ] dip call ; inline
|
|
||||||
|
|
||||||
: 3bi@ ( u v w x y z quot -- )
|
|
||||||
dup 3bi* ; inline
|
|
||||||
|
|
||||||
: 4bi ( w x y z p q -- )
|
|
||||||
[ 4keep ] dip call ; inline
|
|
||||||
|
|
||||||
: 4bi* ( s t u v w x y z p q -- )
|
|
||||||
[ 4dip ] dip call ; inline
|
|
||||||
|
|
||||||
: 4bi@ ( s t u v w x y z quot -- )
|
|
||||||
dup 4bi* ; inline
|
|
||||||
|
|
||||||
: 4tri ( w x y z p q r -- )
|
|
||||||
[ [ 4keep ] dip 4keep ] dip call ; inline
|
|
||||||
|
|
||||||
: plox ( ... x/f quot: ( ... x -- ... ) -- ... )
|
: plox ( ... x/f quot: ( ... x -- ... ) -- ... )
|
||||||
dupd when ; inline
|
dupd when ; inline
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -183,7 +183,7 @@ ERROR: bad-filter n ;
|
||||||
bit-depth :> depth!
|
bit-depth :> depth!
|
||||||
#components width * :> count!
|
#components width * :> count!
|
||||||
|
|
||||||
#components bit-depth * width * 8 math::align 8 /i :> stride
|
#components bit-depth * width * 8 math:align 8 /i :> stride
|
||||||
|
|
||||||
height [
|
height [
|
||||||
stride 1 + byte-reader stream-read
|
stride 1 + byte-reader stream-read
|
||||||
|
|
|
||||||
|
|
@ -18,7 +18,7 @@ SYMBOL: current-irc-client
|
||||||
\ current-irc-client swap with-variable ; inline
|
\ current-irc-client swap with-variable ; inline
|
||||||
|
|
||||||
UNION: to-target privmsg notice ;
|
UNION: to-target privmsg notice ;
|
||||||
UNION: to-channel irc.messages::join part topic kick rpl-channel-modes
|
UNION: to-channel irc.messages:join part topic kick rpl-channel-modes
|
||||||
topic rpl-names rpl-names-end ;
|
topic rpl-names rpl-names-end ;
|
||||||
UNION: to-one-chat to-target to-channel mode ;
|
UNION: to-one-chat to-target to-channel mode ;
|
||||||
UNION: to-many-chats nick quit ;
|
UNION: to-many-chats nick quit ;
|
||||||
|
|
|
||||||
|
|
@ -76,7 +76,7 @@ GENERIC: process-message ( irc-message -- )
|
||||||
M: object process-message drop ;
|
M: object process-message drop ;
|
||||||
M: ping process-message trailing>> /PONG ;
|
M: ping process-message trailing>> /PONG ;
|
||||||
! FIXME: it shouldn't be checking for the presence of chat here...
|
! FIXME: it shouldn't be checking for the presence of chat here...
|
||||||
M: irc.messages::join
|
M: irc.messages:join
|
||||||
process-message [ sender>> ] [ chat> ] bi
|
process-message [ sender>> ] [ chat> ] bi
|
||||||
[ join-participant ] [ drop ] if* ;
|
[ join-participant ] [ drop ] if* ;
|
||||||
M: part process-message [ sender>> ] [ chat> ] bi [ part-participant ] [ drop ] if* ;
|
M: part process-message [ sender>> ] [ chat> ] bi [ part-participant ] [ drop ] if* ;
|
||||||
|
|
|
||||||
|
|
@ -23,7 +23,7 @@ M: privmsg >log-line
|
||||||
: prefix% ( string -- )
|
: prefix% ( string -- )
|
||||||
" [" % % "]" % ;
|
" [" % % "]" % ;
|
||||||
|
|
||||||
M: irc.messages::join >log-line
|
M: irc.messages:join >log-line
|
||||||
[
|
[
|
||||||
[ "* " % sender>> % ]
|
[ "* " % sender>> % ]
|
||||||
[ prefix>> prefix% " has joined the channel." % ] bi
|
[ prefix>> prefix% " has joined the channel." % ] bi
|
||||||
|
|
|
||||||
|
|
@ -215,7 +215,7 @@ M: no-method error.
|
||||||
[ "multi-method-specializer" word-prop ]
|
[ "multi-method-specializer" word-prop ]
|
||||||
[ "multi-method-generic" word-prop ] bi prefix ;
|
[ "multi-method-generic" word-prop ] bi prefix ;
|
||||||
|
|
||||||
: define-generic ( word effect -- )
|
: define-multi-generic ( word effect -- )
|
||||||
[ set-stack-effect ] keepd
|
[ set-stack-effect ] keepd
|
||||||
dup "multi-methods" word-prop [ drop ] [
|
dup "multi-methods" word-prop [ drop ] [
|
||||||
[ H{ } clone "multi-methods" set-word-prop ]
|
[ H{ } clone "multi-methods" set-word-prop ]
|
||||||
|
|
|
||||||
|
|
@ -3,7 +3,7 @@
|
||||||
USING: accessors alien.c-types grouping kernel locals math
|
USING: accessors alien.c-types grouping kernel locals math
|
||||||
math.order math.ranges math.vectors math.vectors.homogeneous
|
math.order math.ranges math.vectors math.vectors.homogeneous
|
||||||
sequences specialized-arrays ;
|
sequences specialized-arrays ;
|
||||||
SPECIALIZED-ARRAY: alien.c-types::float
|
SPECIALIZED-ARRAY: alien.c-types:float
|
||||||
IN: nurbs
|
IN: nurbs
|
||||||
|
|
||||||
TUPLE: nurbs-curve
|
TUPLE: nurbs-curve
|
||||||
|
|
|
||||||
|
|
@ -250,7 +250,7 @@ M: table-row pdf-render
|
||||||
] each widths >alist sort-keys values
|
] each widths >alist sort-keys values
|
||||||
|
|
||||||
! make last cell larger
|
! make last cell larger
|
||||||
dup sum 400 swap [-] [ + ] curry dupd sequences.extras::change-last
|
dup sum 400 swap [-] [ + ] curry dupd sequences.extras:change-last
|
||||||
|
|
||||||
! size down each column
|
! size down each column
|
||||||
dup sum dup 400 > [ 400 swap / [ * ] curry map ] [ drop ] if ;
|
dup sum dup 400 > [ 400 swap / [ * ] curry map ] [ drop ] if ;
|
||||||
|
|
|
||||||
Loading…
Reference in New Issue