From 03d96cc1bd804d4335db41611f8c094511ed112c Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Thu, 23 Oct 2008 13:18:00 -0500 Subject: [PATCH 1/7] rename name to mount-point --- basis/io/windows/files/files.factor | 2 +- basis/unix/statfs/linux/linux.factor | 2 +- basis/unix/statfs/macosx/macosx.factor | 2 +- basis/unix/statfs/netbsd/netbsd.factor | 2 +- core/io/files/files.factor | 2 +- 5 files changed, 5 insertions(+), 5 deletions(-) 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/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/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 ) From a42c8d4ab7da4b8b474de55a494cc5bc0c1905ef Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Thu, 23 Oct 2008 13:37:14 -0500 Subject: [PATCH 2/7] fix using --- basis/unix/statfs/openbsd/openbsd.factor | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) 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 From 2937f71702dac0f89a4071feb1837f86d787682b Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Thu, 23 Oct 2008 13:38:26 -0500 Subject: [PATCH 3/7] more usings --- basis/unix/statfs/freebsd/freebsd.factor | 5 +++-- basis/unix/statfs/linux/64/64.factor | 4 ++-- 2 files changed, 5 insertions(+), 4 deletions(-) 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 From 89db7676c417c6db80b23aef3e1c70c5258ba6b8 Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Thu, 23 Oct 2008 18:24:11 -0500 Subject: [PATCH 4/7] dns.forwarding: Use new 'ask-servers' --- extra/dns/forwarding/forwarding.factor | 7 +++++-- extra/dns/resolver/resolver.factor | 4 +++- 2 files changed, 8 insertions(+), 3 deletions(-) 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 ] ; +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + From 310ed5585cc25154970c2c2078ab953502f8f736 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Thu, 30 Oct 2008 16:16:03 -0700 Subject: [PATCH 5/7] working on screen capture --- extra/cap/cap.factor | 53 +++++++++++++++++++++++++++++ extra/graphics/bitmap/bitmap.factor | 18 +++++++--- 2 files changed, 66 insertions(+), 5 deletions(-) create mode 100644 extra/cap/cap.factor diff --git a/extra/cap/cap.factor b/extra/cap/cap.factor new file mode 100644 index 0000000000..858ec3e596 --- /dev/null +++ b/extra/cap/cap.factor @@ -0,0 +1,53 @@ +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_COLOR_ATTACHMENT0_EXT 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 ; + +: gadget-world ( gadget -- world ) + "fake" f ; + +: draw-world-to-fbo ( world fbo -- ) + [ relayout-1 ] with-framebuffer ; + +: ( w h -- fbo ) + GL_DEPTH_TEST glDisable + gen-framebuffer [ '[ + gen-renderbuffer + GL_RENDERBUFFER_EXT over glBindRenderbufferEXT + GL_RENDERBUFFER_EXT GL_RGB _ _ glRenderbufferStorageEXT + GL_FRAMEBUFFER_EXT + GL_COLOR_ATTACHMENT0_EXT + GL_RENDERBUFFER_EXT roll glFramebufferRenderbufferEXT + check-framebuffer + ] with-framebuffer ] keep ; + +: draw-gadget-to-bgr ( gadget -- byte-array ) + [ [ prefer ] [ gadget-world ] bi ] [ dim>> first2 ] bi + [ gl-screenshot ] with-framebuffer ; + +: save-screenshot ( window path -- ) + [ screenshot ] dip save-bitmap ; + +: screenshot. ( window -- ) + screenshot "Screenshot" open-window ; + + + 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 From f860d97d43c4dc3160d5ad491a567d422d80400e Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Thu, 30 Oct 2008 16:54:55 -0700 Subject: [PATCH 6/7] remove the fbo code, use the gadget title --- extra/cap/cap.factor | 26 ++------------------------ 1 file changed, 2 insertions(+), 24 deletions(-) diff --git a/extra/cap/cap.factor b/extra/cap/cap.factor index 858ec3e596..5f3ee7b960 100644 --- a/extra/cap/cap.factor +++ b/extra/cap/cap.factor @@ -8,7 +8,7 @@ IN: cap : gl-screenshot ( gadget -- byte-array ) [ - GL_COLOR_ATTACHMENT0_EXT glReadBuffer + GL_BACK glReadBuffer GL_PACK_ALIGNMENT 1 glPixelStorei 0 0 ] dip @@ -21,33 +21,11 @@ IN: cap [ dim>> first2 ] bi bgr>bitmap ; -: gadget-world ( gadget -- world ) - "fake" f ; - -: draw-world-to-fbo ( world fbo -- ) - [ relayout-1 ] with-framebuffer ; - -: ( w h -- fbo ) - GL_DEPTH_TEST glDisable - gen-framebuffer [ '[ - gen-renderbuffer - GL_RENDERBUFFER_EXT over glBindRenderbufferEXT - GL_RENDERBUFFER_EXT GL_RGB _ _ glRenderbufferStorageEXT - GL_FRAMEBUFFER_EXT - GL_COLOR_ATTACHMENT0_EXT - GL_RENDERBUFFER_EXT roll glFramebufferRenderbufferEXT - check-framebuffer - ] with-framebuffer ] keep ; - -: draw-gadget-to-bgr ( gadget -- byte-array ) - [ [ prefer ] [ gadget-world ] bi ] [ dim>> first2 ] bi - [ gl-screenshot ] with-framebuffer ; - : save-screenshot ( window path -- ) [ screenshot ] dip save-bitmap ; : screenshot. ( window -- ) - screenshot "Screenshot" open-window ; + [ screenshot ] [ title>> ] bi open-window ; From 8a494a0da41516a6855ee79dc7541f8f8f87490e Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sat, 1 Nov 2008 15:24:05 -0500 Subject: [PATCH 7/7] fix the way postgresql creates functions --- basis/db/postgresql/postgresql.factor | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) 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 )