diff --git a/basis/db/postgresql/postgresql.factor b/basis/db/postgresql/postgresql.factor index 2b4cadf489..57a16fc8ef 100644 --- a/basis/db/postgresql/postgresql.factor +++ b/basis/db/postgresql/postgresql.factor @@ -140,7 +140,7 @@ M: postgresql-db bind# ( spec object -- ) : create-function-sql ( class -- statement ) [ - [ remove-id ] dip + [ dup remove-id ] dip "create function add_" 0% dup 0% "(" 0% over [ "," 0% ] @@ -157,7 +157,9 @@ M: postgresql-db bind# ( spec object -- ) ") values(" 0% swap [ ", " 0% ] [ drop bind-name% ] interleave "); " 0% - "select currval(''" 0% 0% "_id_seq'');' language sql;" 0% + "select currval(''" 0% 0% "_" 0% + find-primary-key first column-name>> 0% + "_seq'');' language sql;" 0% ] query-make ; M: postgresql-db create-sql-statement ( class -- seq ) diff --git a/basis/io/windows/files/files.factor b/basis/io/windows/files/files.factor index d7b0b49dd1..3fb8029ee7 100644 --- a/basis/io/windows/files/files.factor +++ b/basis/io/windows/files/files.factor @@ -274,7 +274,7 @@ M: winnt file-system-info ( path -- file-system-info ) swap *ulonglong >>total-bytes swap *ulonglong >>free-space swap >>type - swap >>name ; + swap >>mount-point ; : find-first-volume ( word -- string handle ) MAX_PATH 1+ dup length diff --git a/basis/unix/statfs/freebsd/freebsd.factor b/basis/unix/statfs/freebsd/freebsd.factor index 64ee8716c2..b6179a4ad7 100644 --- a/basis/unix/statfs/freebsd/freebsd.factor +++ b/basis/unix/statfs/freebsd/freebsd.factor @@ -1,7 +1,8 @@ ! Copyright (C) 2008 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. -USING: alien.syntax kernel unix io.files math accessors -combinators system io.backend alien.c-types ; +USING: alien.syntax kernel unix math accessors +combinators system io.backend alien.c-types unix.statfs +io.files ; IN: unix.statfs.freebsd : ST_RDONLY 1 ; inline diff --git a/basis/unix/statfs/linux/64/64.factor b/basis/unix/statfs/linux/64/64.factor index a84bec0486..3bf2644e12 100644 --- a/basis/unix/statfs/linux/64/64.factor +++ b/basis/unix/statfs/linux/64/64.factor @@ -1,8 +1,8 @@ ! Copyright (C) 2008 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. -USING: alien.c-types combinators kernel io.files unix.stat +USING: alien.c-types combinators kernel unix.stat math accessors system unix io.backend layouts vocabs.loader -alien.syntax ; +alien.syntax unix.statfs io.files ; IN: unix.statfs.linux C-STRUCT: statfs64 diff --git a/basis/unix/statfs/linux/linux.factor b/basis/unix/statfs/linux/linux.factor index 5e6e5360ef..aae8d09145 100644 --- a/basis/unix/statfs/linux/linux.factor +++ b/basis/unix/statfs/linux/linux.factor @@ -37,7 +37,7 @@ M: linux mounted [ mount-point>> file-system-info ] keep { [ file-system-name>> >>device-name ] - [ mount-point>> >>name ] + [ mount-point>> >>mount-point ] [ type>> >>type ] } cleave ] map ; diff --git a/basis/unix/statfs/macosx/macosx.factor b/basis/unix/statfs/macosx/macosx.factor index e065fc6118..6bf09fcdc0 100644 --- a/basis/unix/statfs/macosx/macosx.factor +++ b/basis/unix/statfs/macosx/macosx.factor @@ -135,7 +135,7 @@ M: macosx >file-system-info ( byte-array -- file-system-info ) [ statfs64-f_bavail ] [ statfs64-f_bsize ] bi * >>free-space ] - [ statfs64-f_mntonname utf8 alien>string >>name ] + [ statfs64-f_mntonname utf8 alien>string >>mount-point ] [ statfs64-f_bsize >>block-size ] [ statfs64-f_iosize >>io-size ] diff --git a/basis/unix/statfs/netbsd/netbsd.factor b/basis/unix/statfs/netbsd/netbsd.factor index 5aff13cceb..56c632edb4 100644 --- a/basis/unix/statfs/netbsd/netbsd.factor +++ b/basis/unix/statfs/netbsd/netbsd.factor @@ -69,7 +69,7 @@ M: netbsd >file-system-info ( byte-array -- netbsd-file-system-info ) [ statvfs-f_owner >>owner ] [ statvfs-f_spare >>spare ] [ statvfs-f_fstypename utf8 alien>string >>file-system-type-name ] - [ statvfs-f_mntonname utf8 alien>string >>name ] + [ statvfs-f_mntonname utf8 alien>string >>mount-point ] [ statvfs-f_mntfromname utf8 alien>string >>mount-from ] } cleave ; diff --git a/basis/unix/statfs/openbsd/openbsd.factor b/basis/unix/statfs/openbsd/openbsd.factor index a64b60a078..fa86ef2bc2 100644 --- a/basis/unix/statfs/openbsd/openbsd.factor +++ b/basis/unix/statfs/openbsd/openbsd.factor @@ -1,7 +1,8 @@ ! Copyright (C) 2008 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. -USING: alien.syntax accessors combinators kernel io.files -unix.types math system io.backend alien.c-types unix ; +USING: alien.syntax accessors combinators kernel +unix.types math system io.backend alien.c-types unix +unix.statfs io.files ; IN: unix.statfs.openbsd C-STRUCT: statvfs diff --git a/core/io/files/files.factor b/core/io/files/files.factor index f643f4ca3c..9899f5a014 100644 --- a/core/io/files/files.factor +++ b/core/io/files/files.factor @@ -184,7 +184,7 @@ SYMBOL: +unknown+ ! File-system -TUPLE: file-system-info device-name name type free-space ; +TUPLE: file-system-info device-name mount-point type free-space ; HOOK: file-system-info os ( path -- file-system-info ) diff --git a/extra/cap/cap.factor b/extra/cap/cap.factor new file mode 100644 index 0000000000..5f3ee7b960 --- /dev/null +++ b/extra/cap/cap.factor @@ -0,0 +1,31 @@ +USING: accessors arrays byte-arrays kernel math namespaces +opengl.gl sequences math.vectors ui graphics.bitmap graphics.viewer +models opengl.framebuffers ui.gadgets.worlds ui.gadgets fry ; +IN: cap + +: screenshot-array ( world -- byte-array ) + dim>> product 3 * ; + +: gl-screenshot ( gadget -- byte-array ) + [ + GL_BACK glReadBuffer + GL_PACK_ALIGNMENT 1 glPixelStorei + 0 0 + ] dip + [ dim>> first2 GL_BGR GL_UNSIGNED_BYTE ] + [ screenshot-array ] bi + [ glReadPixels ] keep ; + +: screenshot ( window -- bitmap ) + [ gl-screenshot ] + [ dim>> first2 ] bi + bgr>bitmap ; + +: save-screenshot ( window path -- ) + [ screenshot ] dip save-bitmap ; + +: screenshot. ( window -- ) + [ screenshot ] [ title>> ] bi open-window ; + + + diff --git a/extra/dns/forwarding/forwarding.factor b/extra/dns/forwarding/forwarding.factor index 6d4fece949..4b7db30abd 100644 --- a/extra/dns/forwarding/forwarding.factor +++ b/extra/dns/forwarding/forwarding.factor @@ -2,7 +2,8 @@ USING: kernel sequences combinators accessors locals random combinators.short-circuit io.sockets - dns dns.util dns.cache.rr dns.cache.nx ; + dns dns.util dns.cache.rr dns.cache.nx + dns.resolver ; IN: dns.forwarding @@ -99,7 +100,9 @@ IN: dns.forwarding MSG additional-section>> [ cache-add ] each MSG ; -: answer-from-server ( msg servers -- msg ) random ask-server cache-message ; +! : answer-from-server ( msg servers -- msg ) random ask-server cache-message ; + +: answer-from-server ( msg servers -- msg ) ask-servers cache-message ; :: find-answer ( MSG SERVERS -- msg ) { [ MSG answer-from-cache ] [ MSG SERVERS answer-from-server ] } 0|| ; diff --git a/extra/dns/resolver/resolver.factor b/extra/dns/resolver/resolver.factor index f7983965d5..32ad23669c 100644 --- a/extra/dns/resolver/resolver.factor +++ b/extra/dns/resolver/resolver.factor @@ -60,7 +60,7 @@ IN: dns.resolver ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -: dns-ip ( name -- ips ) +: dns-ip4 ( name -- ips ) fully-qualified [let | MSG [ A IN query boa query->message dns-servers ask-servers ] | MSG rcode>> NO-ERROR = @@ -68,3 +68,5 @@ IN: dns.resolver [ "dns-ip: rcode = " MSG rcode>> unparse append throw ] if ] ; +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + diff --git a/extra/graphics/bitmap/bitmap.factor b/extra/graphics/bitmap/bitmap.factor index 82fdc334cb..651c5f7ca1 100755 --- a/extra/graphics/bitmap/bitmap.factor +++ b/extra/graphics/bitmap/bitmap.factor @@ -15,6 +15,14 @@ TUPLE: bitmap magic size reserved offset header-length width height planes bit-count compression size-image x-pels y-pels color-used color-important rgb-quads color-index array ; +: bgr>bitmap ( array height width -- bitmap ) + bitmap new + 2over * 3 * >>size-image + swap >>height + swap >>width + swap [ >>array ] [ >>color-index ] bi + 24 >>bit-count ; + : raw-bitmap>string ( str n -- str ) { { 32 [ "32bit" throw ] } @@ -74,7 +82,7 @@ M: bitmap-magic summary : save-bitmap ( bitmap path -- ) binary [ - "BM" write + "BM" >byte-array write dup array>> length 14 + 40 + 4 >le write 0 4 >le write 54 4 >le write @@ -87,10 +95,10 @@ M: bitmap-magic summary [ bit-count>> 24 or 2 >le write ] [ compression>> 0 or 4 >le write ] [ size-image>> 4 >le write ] - [ x-pels>> 4 >le write ] - [ y-pels>> 4 >le write ] - [ color-used>> 4 >le write ] - [ color-important>> 4 >le write ] + [ x-pels>> 0 or 4 >le write ] + [ y-pels>> 0 or 4 >le write ] + [ color-used>> 0 or 4 >le write ] + [ color-important>> 0 or 4 >le write ] [ rgb-quads>> write ] [ color-index>> write ] } cleave