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