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

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

db4
Slava Pestov 2008-11-01 16:38:04 -05:00
parent 7fc44aa444 8a494a0da4
commit b5c3c19ebe
13 changed files with 69 additions and 21 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
basis/db/postgresql/postgresql.factor
View File

@ -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 )

2
basis/io/windows/files/files.factor
View File

@ -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+ <byte-array> dup length

5
basis/unix/statfs/freebsd/freebsd.factor
View File

@ -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

4
basis/unix/statfs/linux/64/64.factor
View File

@ -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

2
basis/unix/statfs/linux/linux.factor
View File

@ -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 ;

2
basis/unix/statfs/macosx/macosx.factor
View File

@ -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 ]

2
basis/unix/statfs/netbsd/netbsd.factor
View File

@ -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 ;

5
basis/unix/statfs/openbsd/openbsd.factor
View File

@ -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

2
core/io/files/files.factor
View File

@ -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 )

31
extra/cap/cap.factor Normal file
View File

@ -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 * <byte-array> ;
: 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 <graphics-gadget> ] [ title>> ] bi open-window ;

7
extra/dns/forwarding/forwarding.factor
View File

@ -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|| ;

4
extra/dns/resolver/resolver.factor
View File

@ -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 ] ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

18
extra/graphics/bitmap/bitmap.factor
View File

@ -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