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

Merge branch 'master' of git://factorcode.org/git/factor

db4
Doug Coleman 2008-06-01 00:02:36 -05:00
parent e5b370194d 3ab71b00a9
commit 41a9bb9ac4
14 changed files with 541 additions and 126 deletions

70
extra/cairo/gadgets/gadgets.factor
View File

@ -1,73 +1,39 @@
! Copyright (C) 2008 Matthew Willis.
! See http://factorcode.org/license.txt for BSD license.
USING: cairo cairo.ffi ui.render kernel opengl.gl opengl
math byte-arrays ui.gadgets accessors arrays
namespaces io.backend ;
USING: sequences math opengl.gadgets kernel
byte-arrays cairo.ffi cairo io.backend
opengl.gl arrays ;
IN: cairo.gadgets
! We need two kinds of gadgets:
! one performs the cairo ops once and caches the bytes, the other
! performs cairo ops every refresh
TUPLE: cairo-gadget width height quot cache? bytes ;
PREDICATE: cached-cairo < cairo-gadget cache?>> ;
: <cairo-gadget> ( width height quot -- cairo-gadget )
cairo-gadget construct-gadget
swap >>quot
swap >>height
swap >>width ;
: <cached-cairo> ( width height quot -- cairo-gadget )
<cairo-gadget> t >>cache? ;
: width>stride ( width -- stride ) 4 * ;
: copy-cairo ( width height quot -- byte-array )
>r over width>stride
: copy-cairo ( dim quot -- byte-array )
>r first2 over width>stride
[ * nip <byte-array> dup CAIRO_FORMAT_ARGB32 ]
[ cairo_image_surface_create_for_data ] 3bi
r> with-cairo-from-surface ;
: (cairo>bytes) ( gadget -- byte-array )
[ width>> ] [ height>> ] [ quot>> ] tri copy-cairo ;
: <cairo-gadget> ( dim quot -- )
over 2^-bounds swap copy-cairo
GL_BGRA rot <texture-gadget> ;
GENERIC: cairo>bytes
M: cairo-gadget cairo>bytes ( gadget -- byte-array )
(cairo>bytes) ;
M: cached-cairo cairo>bytes ( gadget -- byte-array )
dup bytes>> [ ] [
dup (cairo>bytes) [ >>bytes drop ] keep
] ?if ;
: cairo>png ( gadget path -- )
>r [ cairo>bytes CAIRO_FORMAT_ARGB32 ] [ width>> ]
[ height>> ] tri over width>stride
cairo_image_surface_create_for_data
r> [ cairo_surface_write_to_png check-cairo ] curry with-surface ;
M: cairo-gadget draw-gadget* ( gadget -- )
origin get [
0 0 glRasterPos2i
1.0 -1.0 glPixelZoom
[ width>> ] [ height>> GL_BGRA GL_UNSIGNED_BYTE ]
[ cairo>bytes ] tri glDrawPixels
] with-translation ;
M: cairo-gadget pref-dim* ( gadget -- rect )
[ width>> ] [ height>> ] bi 2array ;
! maybe also texture>png
! : cairo>png ( gadget path -- )
! >r [ cairo>bytes CAIRO_FORMAT_ARGB32 ] [ width>> ]
! [ height>> ] tri over width>stride
! cairo_image_surface_create_for_data
! r> [ cairo_surface_write_to_png check-cairo ] curry with-surface ;
: copy-surface ( surface -- )
cr swap 0 0 cairo_set_source_surface
cr cairo_paint ;
: <bytes-gadget> ( width height bytes -- cairo-gadget )
>r [ ] <cached-cairo> r> >>bytes ;
: <png-gadget> ( path -- gadget )
normalize-path cairo_image_surface_create_from_png
[ cairo_image_surface_get_width ]
[ cairo_image_surface_get_height 2dup ]
[ cairo_image_surface_get_height 2array dup 2^-bounds ]
[ [ copy-surface ] curry copy-cairo ] tri
<bytes-gadget> ;
GL_BGRA rot <texture-gadget> ;

20
extra/cairo/pango/gadgets/gadgets.factor
View File

@ -1,20 +0,0 @@
USING: cairo.pango cairo cairo.ffi cairo.gadgets
alien.c-types kernel math ;
IN: cairo.pango.gadgets
: (pango-gadget) ( setup show -- gadget )
[ drop layout-size ]
[ compose [ with-pango ] curry <cached-cairo> ] 2bi ;
: <pango-gadget> ( quot -- gadget )
[ cr layout pango_cairo_show_layout ] (pango-gadget) ;
USING: prettyprint sequences ui.gadgets.panes ;
: hello-pango ( -- )
50 [ 6 + ] map [
"Sans Bold " swap unparse append
[ layout-font "Hello, Pango!" layout-text ] curry
<pango-gadget> gadget.
] each ;
MAIN: hello-pango

4
extra/cairo/samples/samples.factor
View File

@ -142,6 +142,6 @@ IN: cairo.samples
USING: quotations cairo.gadgets ui.gadgets.panes sequences ;
: samples ( -- )
{ arc clip clip-image dash gradient text utf8 }
[ 256 256 rot 1quotation <cached-cairo> gadget. ] each ;
[ { 256 256 } swap 1quotation <cairo-gadget> gadget. ] each ;
MAIN: samples
MAIN: samples

3
extra/memoize/memoize.factor
View File

@ -58,3 +58,6 @@ M: memoized reset-word
: reset-memoized ( word -- )
"memoize" word-prop clear-assoc ;
: invalidate-memoized ! ( inputs... word )
[ #in packer call ] [ "memoize" word-prop delete-at ] bi ;

72
extra/opengl/gadgets/gadgets.factor Normal file
View File

@ -0,0 +1,72 @@
! Copyright (C) 2008 Matthew Willis.
! See http://factorcode.org/license.txt for BSD license.
USING: locals math.functions math namespaces
opengl.gl accessors kernel opengl ui.gadgets
destructors sequences ui.render colors ;
IN: opengl.gadgets
TUPLE: texture-gadget bytes format dim tex ;
: 2^-ceil ( x -- y )
dup 2 < [ 2 * ] [ 1- log2 1+ 2^ ] if ; foldable flushable
: 2^-bounds ( dim -- dim' )
[ 2^-ceil ] map ; foldable flushable
: <texture-gadget> ( bytes format dim -- gadget )
texture-gadget construct-gadget
swap >>dim
swap >>format
swap >>bytes ;
:: render ( gadget -- )
GL_ENABLE_BIT [
GL_TEXTURE_2D glEnable
GL_TEXTURE_2D gadget tex>> glBindTexture
GL_TEXTURE_2D
0
GL_RGBA
gadget dim>> 2^-bounds first2
0
gadget format>>
GL_UNSIGNED_BYTE
gadget bytes>>
glTexImage2D
init-texture
GL_TEXTURE_2D 0 glBindTexture
] do-attribs ;
:: four-corners ( dim -- )
[let* | w [ dim first ]
h [ dim second ]
dim' [ dim dup 2^-bounds [ /f ] 2map ]
w' [ dim' first ]
h' [ dim' second ] |
0 0 glTexCoord2d 0 0 glVertex2d
0 h' glTexCoord2d 0 h glVertex2d
w' h' glTexCoord2d w h glVertex2d
w' 0 glTexCoord2d w 0 glVertex2d
] ;
M: texture-gadget draw-gadget* ( gadget -- )
origin get [
GL_ENABLE_BIT [
white gl-color
1.0 -1.0 glPixelZoom
GL_TEXTURE_2D glEnable
GL_TEXTURE_2D over tex>> glBindTexture
GL_QUADS [
dim>> four-corners
] do-state
GL_TEXTURE_2D 0 glBindTexture
] do-attribs
] with-translation ;
M: texture-gadget graft* ( gadget -- )
gen-texture >>tex [ render ]
[ f >>bytes f >>format drop ] bi ;
M: texture-gadget ungraft* ( gadget -- )
tex>> delete-texture ;
M: texture-gadget pref-dim* ( gadget -- dim ) dim>> ;

60
extra/cairo/pango/pango.factor → extra/pango/cairo/cairo.factor
View File

@ -2,10 +2,10 @@
! See http://factorcode.org/license.txt for BSD license.
!
! pangocairo bindings, from pango/pangocairo.h
USING: cairo.ffi alien.c-types math
alien.syntax system combinators alien ;
IN: cairo.pango
alien.syntax system combinators alien
arrays pango pango.fonts ;
IN: pango.cairo
<< "pangocairo" {
! { [ os winnt? ] [ "libpangocairo-1.dll" ] }
@ -15,10 +15,6 @@ IN: cairo.pango
LIBRARY: pangocairo
TYPEDEF: void* PangoCairoFont
TYPEDEF: void* PangoCairoFontMap
TYPEDEF: void* PangoFontMap
FUNCTION: PangoFontMap*
pango_cairo_font_map_new ( ) ;
@ -92,49 +88,6 @@ pango_cairo_layout_path ( cairo_t* cr, PangoLayout* layout ) ;
FUNCTION: void
pango_cairo_error_underline_path ( cairo_t* cr, double x, double y, double width, double height ) ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! Helpful functions from other parts of pango
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: PANGO_SCALE 1024 ;
FUNCTION: void
pango_layout_set_text ( PangoLayout* layout, char* text, int length ) ;
FUNCTION: char*
pango_layout_get_text ( PangoLayout* layout ) ;
FUNCTION: void
pango_layout_get_size ( PangoLayout* layout, int* width, int* height ) ;
TYPEDEF: void* PangoFontDescription
FUNCTION: PangoFontDescription*
pango_font_description_from_string ( char* str ) ;
FUNCTION: char*
pango_font_description_to_string ( PangoFontDescription* desc ) ;
FUNCTION: char*
pango_font_description_to_filename ( PangoFontDescription* desc ) ;
FUNCTION: void
pango_layout_set_font_description ( PangoLayout* layout, PangoFontDescription* desc ) ;
FUNCTION: PangoFontDescription*
pango_layout_get_font_description ( PangoLayout* layout ) ;
FUNCTION: void
pango_layout_get_pixel_size ( PangoLayout* layout, int* width, int* height ) ;
FUNCTION: void
pango_font_description_free ( PangoFontDescription* desc ) ;
TYPEDEF: void* gpointer
FUNCTION: void
g_object_unref ( gpointer object ) ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! Higher level words and combinators
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
@ -162,8 +115,8 @@ M: pango-layout dispose ( alien -- ) alien>> g_object_unref ;
>r CAIRO_FORMAT_ARGB32 0 0 cairo_image_surface_create
r> [ with-pango ] curry with-cairo-from-surface ; inline
: layout-size ( quot -- width height )
[ layout pango-layout-get-pixel-size ] compose dummy-pango ; inline
: layout-size ( quot -- dim )
[ layout pango-layout-get-pixel-size 2array ] compose dummy-pango ; inline
: layout-font ( str -- )
pango_font_description_from_string
@ -173,3 +126,6 @@ M: pango-layout dispose ( alien -- ) alien>> g_object_unref ;
: layout-text ( str -- )
layout swap -1 pango_layout_set_text ;
: families ( -- families )
pango_cairo_font_map_get_default list-families ;

30
extra/pango/cairo/gadgets/gadgets.factor Normal file
View File

@ -0,0 +1,30 @@
! Copyright (C) 2008 Matthew Willis.
! See http://factorcode.org/license.txt for BSD license.
USING: pango.cairo cairo cairo.ffi cairo.gadgets
alien.c-types kernel math ;
IN: pango.cairo.gadgets
: (pango-gadget) ( setup show -- gadget )
[ drop layout-size ]
[ compose [ with-pango ] curry <cairo-gadget> ] 2bi ;
: <pango-gadget> ( quot -- gadget )
[ cr layout pango_cairo_show_layout ] (pango-gadget) ;
USING: prettyprint sequences ui.gadgets.panes
threads io.backend io.encodings.utf8 io.files ;
: hello-pango ( -- )
50 [ 6 + ] map [
"Sans " swap unparse append
[
cr 0 1 0.2 0.6 cairo_set_source_rgba
layout-font "今日は、 Pango!" layout-text
] curry
<pango-gadget> gadget. yield
] each
[
"resource:extra/pango/cairo/gadgets/gadgets.factor"
normalize-path utf8 file-contents layout-text
] <pango-gadget> gadget. ;
MAIN: hello-pango

40
extra/pango/fonts/fonts.factor Normal file
View File

@ -0,0 +1,40 @@
! Copyright (C) 2008 Matthew Willis.
! See http://factorcode.org/license.txt for BSD license
USING: pango alien.syntax alien.c-types
kernel ;
IN: pango.fonts
LIBRARY: pango
FUNCTION: void
pango_font_map_list_families ( PangoFontMap* fontmap, PangoFontFamily*** families, int* n_families ) ;
FUNCTION: char*
pango_font_family_get_name ( PangoFontFamily* family ) ;
FUNCTION: int
pango_font_family_is_monospace ( PangoFontFamily* family ) ;
FUNCTION: void
pango_font_family_list_faces ( PangoFontFamily* family, PangoFontFace*** faces, int* n_faces ) ;
FUNCTION: char*
pango_font_face_get_face_name ( PangoFontFace* face ) ;
FUNCTION: void
pango_font_face_list_sizes ( PangoFontFace* face, int** sizes, int* n_sizes ) ;
: list-families ( PangoFontMap* -- PangoFontFamily*-seq )
0 <int> 0 <int> [ pango_font_map_list_families ] 2keep
*int swap *void* [ swap c-void*-array> ] [ g_free ] bi ;
: list-faces ( PangoFontFamily* -- PangoFontFace*-seq )
0 <int> 0 <int> [ pango_font_family_list_faces ] 2keep
*int swap *void* [ swap c-void*-array> ] [ g_free ] bi ;
: list-sizes ( PangoFontFace* -- ints )
0 <int> 0 <int> [ pango_font_face_list_sizes ] 2keep
*int swap *void* [ swap c-int-array> ] [ g_free ] bi ;
: monospace? ( PangoFontFamily* -- ? )
pango_font_family_is_monospace 1 = ;

59
extra/pango/pango.factor Normal file
View File

@ -0,0 +1,59 @@
! Copyright (C) 2008 Matthew Willis.
! See http://factorcode.org/license.txt for BSD license
USING: system
alien.c-types alien.syntax alien combinators ;
IN: pango
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! Helpful functions from other parts of pango
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
<< "pango" {
! { [ os winnt? ] [ "libpango-1.dll" ] }
! { [ os macosx? ] [ "libpango.dylib" ] }
{ [ os unix? ] [ "libpango-1.0.so" ] }
} cond "cdecl" add-library >>
LIBRARY: pango
: PANGO_SCALE 1024 ;
FUNCTION: void
pango_layout_set_text ( PangoLayout* layout, char* text, int length ) ;
FUNCTION: char*
pango_layout_get_text ( PangoLayout* layout ) ;
FUNCTION: void
pango_layout_get_size ( PangoLayout* layout, int* width, int* height ) ;
FUNCTION: PangoFontDescription*
pango_font_description_from_string ( char* str ) ;
FUNCTION: char*
pango_font_description_to_string ( PangoFontDescription* desc ) ;
FUNCTION: char*
pango_font_description_to_filename ( PangoFontDescription* desc ) ;
FUNCTION: void
pango_layout_set_font_description ( PangoLayout* layout, PangoFontDescription* desc ) ;
FUNCTION: PangoFontDescription*
pango_layout_get_font_description ( PangoLayout* layout ) ;
FUNCTION: void
pango_layout_get_pixel_size ( PangoLayout* layout, int* width, int* height ) ;
FUNCTION: void
pango_font_description_free ( PangoFontDescription* desc ) ;
! glib functions
TYPEDEF: void* gpointer
FUNCTION: void
g_object_unref ( gpointer object ) ;
FUNCTION: void
g_free ( gpointer mem ) ;

1
extra/urls/authors.txt Normal file
View File

@ -0,0 +1 @@
Slava Pestov

1
extra/urls/summary.txt Normal file
View File

@ -0,0 +1 @@
Tools for working with URLs (uniform resource locators)

2
extra/urls/tags.txt Normal file
View File

@ -0,0 +1,2 @@
web
network

162
extra/urls/urls-tests.factor Normal file
View File

@ -0,0 +1,162 @@
IN: urls.tests
USING: urls tools.test tuple-syntax arrays kernel assocs ;
[ "hello%20world" ] [ "hello world" url-encode ] unit-test
[ "hello world" ] [ "hello%20world" url-decode ] unit-test
[ "~hello world" ] [ "%7ehello+world" url-decode ] unit-test
[ f ] [ "%XX%XX%XX" url-decode ] unit-test
[ f ] [ "%XX%XX%X" url-decode ] unit-test
[ "hello world" ] [ "hello+world" url-decode ] unit-test
[ "hello world" ] [ "hello%20world" url-decode ] unit-test
[ " ! " ] [ "%20%21%20" url-decode ] unit-test
[ "hello world" ] [ "hello world%" url-decode ] unit-test
[ "hello world" ] [ "hello world%x" url-decode ] unit-test
[ "hello%20world" ] [ "hello world" url-encode ] unit-test
[ "%20%21%20" ] [ " ! " url-encode ] unit-test
[ "\u001234hi\u002045" ] [ "\u001234hi\u002045" url-encode url-decode ] unit-test
[ "a=b&a=c" ] [ { { "a" { "b" "c" } } } assoc>query ] unit-test
[ H{ { "a" "b" } } ] [ "a=b" query>assoc ] unit-test
[ H{ { "a" { "b" "c" } } } ] [ "a=b&a=c" query>assoc ] unit-test
[ "a=3" ] [ { { "a" 3 } } assoc>query ] unit-test
: urls
{
{
TUPLE{ url
protocol: "http"
host: "www.apple.com"
port: 1234
path: "/a/path"
query: H{ { "a" "b" } }
anchor: "foo"
}
"http://www.apple.com:1234/a/path?a=b#foo"
}
{
TUPLE{ url
protocol: "http"
host: "www.apple.com"
path: "/a/path"
query: H{ { "a" "b" } }
anchor: "foo"
}
"http://www.apple.com/a/path?a=b#foo"
}
{
TUPLE{ url
protocol: "http"
host: "www.apple.com"
port: 1234
path: "/another/fine/path"
anchor: "foo"
}
"http://www.apple.com:1234/another/fine/path#foo"
}
{
TUPLE{ url
path: "/a/relative/path"
anchor: "foo"
}
"/a/relative/path#foo"
}
{
TUPLE{ url
path: "/a/relative/path"
}
"/a/relative/path"
}
{
TUPLE{ url
path: "a/relative/path"
}
"a/relative/path"
}
} ;
urls [
[ 1array ] [ [ string>url ] curry ] bi* unit-test
] assoc-each
urls [
swap [ 1array ] [ [ url>string ] curry ] bi* unit-test
] assoc-each
[
TUPLE{ url
protocol: "http"
host: "www.apple.com"
port: 1234
path: "/a/path"
}
] [
TUPLE{ url
path: "/a/path"
}
TUPLE{ url
protocol: "http"
host: "www.apple.com"
port: 1234
path: "/foo"
}
derive-url
] unit-test
[
TUPLE{ url
protocol: "http"
host: "www.apple.com"
port: 1234
path: "/a/path/relative/path"
query: H{ { "a" "b" } }
anchor: "foo"
}
] [
TUPLE{ url
path: "relative/path"
query: H{ { "a" "b" } }
anchor: "foo"
}
TUPLE{ url
protocol: "http"
host: "www.apple.com"
port: 1234
path: "/a/path"
}
derive-url
] unit-test
[
TUPLE{ url
protocol: "http"
host: "www.apple.com"
port: 1234
path: "/a/path/relative/path"
query: H{ { "a" "b" } }
anchor: "foo"
}
] [
TUPLE{ url
path: "relative/path"
query: H{ { "a" "b" } }
anchor: "foo"
}
TUPLE{ url
protocol: "http"
host: "www.apple.com"
port: 1234
path: "/a/path/"
}
derive-url
] unit-test

143
extra/urls/urls.factor Normal file
View File

@ -0,0 +1,143 @@
USING: kernel unicode.categories combinators sequences splitting
fry namespaces assocs arrays strings mirrors
io.encodings.string io.encodings.utf8
math math.parser accessors namespaces.lib ;
IN: urls
: url-quotable? ( ch -- ? )
#! In a URL, can this character be used without
#! URL-encoding?
{
{ [ dup letter? ] [ t ] }
{ [ dup LETTER? ] [ t ] }
{ [ dup digit? ] [ t ] }
{ [ dup "/_-.:" member? ] [ t ] }
[ f ]
} cond nip ; foldable
: push-utf8 ( ch -- )
1string utf8 encode
[ CHAR: % , >hex 2 CHAR: 0 pad-left % ] each ;
: url-encode ( str -- str )
[
[ dup url-quotable? [ , ] [ push-utf8 ] if ] each
] "" make ;
: url-decode-hex ( index str -- )
2dup length 2 - >= [
2drop
] [
[ 1+ dup 2 + ] dip subseq hex> [ , ] when*
] if ;
: url-decode-% ( index str -- index str )
2dup url-decode-hex [ 3 + ] dip ;
: url-decode-+-or-other ( index str ch -- index str )
dup CHAR: + = [ drop CHAR: \s ] when , [ 1+ ] dip ;
: url-decode-iter ( index str -- )
2dup length >= [
2drop
] [
2dup nth dup CHAR: % = [
drop url-decode-%
] [
url-decode-+-or-other
] if url-decode-iter
] if ;
: url-decode ( str -- str )
[ 0 swap url-decode-iter ] "" make utf8 decode ;
: add-query-param ( value key assoc -- )
[
at [
{
{ [ dup string? ] [ swap 2array ] }
{ [ dup array? ] [ swap suffix ] }
{ [ dup not ] [ drop ] }
} cond
] when*
] 2keep set-at ;
: query>assoc ( query -- assoc )
dup [
"&" split H{ } clone [
[
[ "=" split1 [ dup [ url-decode ] when ] bi@ swap ] dip
add-query-param
] curry each
] keep
] when ;
: assoc>query ( hash -- str )
[
{
{ [ dup number? ] [ number>string 1array ] }
{ [ dup string? ] [ 1array ] }
{ [ dup sequence? ] [ ] }
} cond
] assoc-map
[
[
[ url-encode ] dip
[ url-encode "=" swap 3append , ] with each
] assoc-each
] { } make "&" join ;
TUPLE: url protocol host port path query anchor ;
: parse-host-part ( protocol rest -- string' )
[ "protocol" set ] [
"//" ?head [ "Invalid URL" throw ] unless
"/" split1 [
":" split1
[ url-decode "host" set ] [
dup [
string>number
dup [ "Invalid port" throw ] unless
] when "port" set
] bi*
] [ "/" prepend ] bi*
] bi* ;
: string>url ( string -- url )
[
":" split1 [ parse-host-part ] when*
"#" split1 [
"?" split1 [ query>assoc "query" set ] when*
url-decode "path" set
] [
url-decode "anchor" set
] bi*
] url make-object ;
: unparse-host-part ( protocol -- )
%
"://" %
"host" get url-encode %
"port" get [ ":" % # ] when*
"path" get "/" head? [ "Invalid URL" throw ] unless ;
: url>string ( url -- string )
[
<mirror> [
"protocol" get [ unparse-host-part ] when*
"path" get url-encode %
"query" get [ "?" % assoc>query % ] when*
"anchor" get [ "#" % url-encode % ] when*
] bind
] "" make ;
: fix-relative-path ( url base -- url base )
over path>> '[
"/" ?tail drop "/" , 3append
] change-path
[ f >>path ] dip ; inline
: derive-url ( url base -- url' )
clone
over path>> "/" head? [ fix-relative-path ] unless
[ <mirror> swap <mirror> [ nip ] assoc-filter update ] keep ;