Merge branch 'master' of git://factorcode.org/git/factor into struct-updates

db4
Joe Groff 2009-08-31 12:35:47 -05:00
commit 175529c938
4 changed files with 44 additions and 42 deletions

View File

@ -4,7 +4,8 @@ USING: accessors alien.c-types alien.strings alien.syntax
combinators io.backend io.files io.files.info io.files.unix kernel math
sequences system unix unix.getfsstat.openbsd grouping
unix.statfs.openbsd unix.statvfs.openbsd unix.types
arrays io.files.info.unix classes.struct struct-arrays ;
arrays io.files.info.unix classes.struct struct-arrays
io.encodings.utf8 ;
IN: io.files.unix.openbsd
TUPLE: freebsd-file-system-info < unix-file-system-info
@ -34,9 +35,9 @@ M: openbsd statfs>file-system-info ( file-system-info statfs -- file-system-info
[ f_fsid>> >>id ]
[ f_namemax>> >>name-max ]
[ f_owner>> >>owner ]
[ f_fstypename>> alien>native-string >>type ]
[ f_mntonname>> alien>native-string >>mount-point ]
[ f_mntfromname>> alien>native-string >>device-name ]
[ f_fstypename>> utf8 alien>string >>type ]
[ f_mntonname>> utf8 alien>string >>mount-point ]
[ f_mntfromname>> utf8 alien>string >>device-name ]
} cleave ;
M: openbsd file-system-statvfs ( normalized-path -- statvfs )
@ -47,6 +48,6 @@ M: openbsd statvfs>file-system-info ( file-system-info statvfs -- file-system-in
M: openbsd file-systems ( -- seq )
f 0 0 getfsstat dup io-error
\ statfs <c-type-array>
\ statfs <struct-array>
[ dup length 0 getfsstat io-error ]
[ [ f_mntonname>> utf8 alien>string file-system-info ] map ] bi ;

View File

@ -5,7 +5,7 @@ USING: arrays sequences alien alien.c-types alien.destructors
alien.syntax math math.functions math.vectors destructors combinators
colors fonts accessors assocs namespaces kernel pango pango.fonts
pango.cairo cairo cairo.ffi glib unicode.data images cache init
math.rectangles fry memoize io.encodings.utf8 ;
math.rectangles fry memoize io.encodings.utf8 classes.struct ;
IN: pango.layouts
LIBRARY: pango
@ -84,8 +84,8 @@ SYMBOL: dpi
[ set-layout-text ] keep ;
: layout-extents ( layout -- ink-rect logical-rect )
"PangoRectangle" <c-object>
"PangoRectangle" <c-object>
PangoRectangle <struct>
PangoRectangle <struct>
[ pango_layout_get_extents ] 2keep
[ PangoRectangle>rect ] bi@ ;

View File

@ -2,7 +2,8 @@
! Copyright (C) 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license
USING: arrays system alien.destructors alien.c-types alien.syntax alien
combinators math.rectangles kernel math alien.libraries ;
combinators math.rectangles kernel math alien.libraries classes.struct
accessors ;
IN: pango
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
@ -25,13 +26,13 @@ CONSTANT: PANGO_SCALE 1024
FUNCTION: PangoContext*
pango_context_new ( ) ;
C-STRUCT: PangoRectangle
{ "int" "x" }
{ "int" "y" }
{ "int" "width" }
{ "int" "height" } ;
STRUCT: PangoRectangle
{ x int }
{ y int }
{ width int }
{ height int } ;
: PangoRectangle>rect ( PangoRectangle -- rect )
[ [ PangoRectangle-x pango>float ] [ PangoRectangle-y pango>float ] bi 2array ]
[ [ PangoRectangle-width pango>float ] [ PangoRectangle-height pango>float ] bi 2array ] bi
[ [ x>> pango>float ] [ y>> pango>float ] bi 2array ]
[ [ width>> pango>float ] [ height>> pango>float ] bi 2array ] bi
<rect> ;

View File

@ -2,50 +2,50 @@
! See http://factorcode.org/license.txt for BSD license.
USING: alien.accessors alien.c-types alien.syntax byte-arrays
destructors generalizations hints kernel libc locals math math.order
sequences sequences.private ;
sequences sequences.private classes.struct accessors ;
IN: benchmark.yuv-to-rgb
C-STRUCT: yuv_buffer
{ "int" "y_width" }
{ "int" "y_height" }
{ "int" "y_stride" }
{ "int" "uv_width" }
{ "int" "uv_height" }
{ "int" "uv_stride" }
{ "void*" "y" }
{ "void*" "u" }
{ "void*" "v" } ;
STRUCT: yuv_buffer
{ y_width int }
{ y_height int }
{ y_stride int }
{ uv_width int }
{ uv_height int }
{ uv_stride int }
{ y void* }
{ u void* }
{ v void* } ;
:: fake-data ( -- rgb yuv )
[let* | w [ 1600 ]
h [ 1200 ]
buffer [ "yuv_buffer" <c-object> ]
buffer [ yuv_buffer <struct> ]
rgb [ w h * 3 * <byte-array> ] |
w buffer set-yuv_buffer-y_width
h buffer set-yuv_buffer-y_height
h buffer set-yuv_buffer-uv_height
w buffer set-yuv_buffer-y_stride
w buffer set-yuv_buffer-uv_stride
w h * [ dup * ] B{ } map-as malloc-byte-array &free buffer set-yuv_buffer-y
w h * 2/ [ dup dup * * ] B{ } map-as malloc-byte-array &free buffer set-yuv_buffer-u
w h * 2/ [ dup * dup * ] B{ } map-as malloc-byte-array &free buffer set-yuv_buffer-v
rgb buffer
w >>y_width
h >>y_height
h >>uv_height
w >>y_stride
w >>uv_stride
w h * [ dup * ] B{ } map-as malloc-byte-array &free >>y
w h * 2/ [ dup dup * * ] B{ } map-as malloc-byte-array &free >>u
w h * 2/ [ dup * dup * ] B{ } map-as malloc-byte-array &free >>v
] ;
: clamp ( n -- n )
255 min 0 max ; inline
: stride ( line yuv -- uvy yy )
[ yuv_buffer-uv_stride swap 2/ * ] [ yuv_buffer-y_stride * ] 2bi ; inline
[ uv_stride>> swap 2/ * ] [ y_stride>> * ] 2bi ; inline
: compute-y ( yuv uvy yy x -- y )
+ >fixnum nip swap yuv_buffer-y swap alien-unsigned-1 16 - ; inline
+ >fixnum nip swap y>> swap alien-unsigned-1 16 - ; inline
: compute-v ( yuv uvy yy x -- v )
nip 2/ + >fixnum swap yuv_buffer-u swap alien-unsigned-1 128 - ; inline
nip 2/ + >fixnum swap u>> swap alien-unsigned-1 128 - ; inline
: compute-u ( yuv uvy yy x -- v )
nip 2/ + >fixnum swap yuv_buffer-v swap alien-unsigned-1 128 - ; inline
nip 2/ + >fixnum swap v>> swap alien-unsigned-1 128 - ; inline
:: compute-yuv ( yuv uvy yy x -- y u v )
yuv uvy yy x compute-y
@ -77,12 +77,12 @@ C-STRUCT: yuv_buffer
: yuv>rgb-row ( index rgb yuv y -- index )
over stride
pick yuv_buffer-y_width
pick y_width>>
[ yuv>rgb-pixel ] with with with with each ; inline
: yuv>rgb ( rgb yuv -- )
[ 0 ] 2dip
dup yuv_buffer-y_height
dup y_height>>
[ yuv>rgb-row ] with with each
drop ;