]> gitweb.factorcode.org Git - factor.git/commitdiff
Fixing bootstrap with specialized arrays
authorSlava Pestov <slava@slava-pestovs-macbook-pro.local>
Tue, 2 Dec 2008 08:44:19 +0000 (02:44 -0600)
committerSlava Pestov <slava@slava-pestovs-macbook-pro.local>
Tue, 2 Dec 2008 08:44:19 +0000 (02:44 -0600)
32 files changed:
basis/alien/c-types/c-types-docs.factor
basis/bit-arrays/bit-arrays.factor
basis/cocoa/enumeration/enumeration.factor
basis/cocoa/messages/messages.factor
basis/cocoa/pasteboard/pasteboard.factor
basis/compiler/tree/propagation/propagation-tests.factor
basis/core-foundation/core-foundation.factor
basis/core-foundation/fsevents/fsevents.factor
basis/functors/functors.factor
basis/io/unix/files/files.factor
basis/io/unix/pipes/pipes.factor
basis/locals/locals.factor
basis/opengl/opengl.factor
basis/random/mersenne-twister/mersenne-twister.factor
basis/specialized-arrays/direct/alien/alien.factor
basis/specialized-arrays/direct/bool/bool.factor
basis/specialized-arrays/direct/char/char.factor
basis/specialized-arrays/direct/direct-tests.factor [new file with mode: 0644]
basis/specialized-arrays/direct/double/double.factor
basis/specialized-arrays/direct/float/float.factor
basis/specialized-arrays/direct/int/int.factor
basis/specialized-arrays/direct/long/long.factor
basis/specialized-arrays/direct/longlong/longlong.factor
basis/specialized-arrays/direct/short/short.factor
basis/specialized-arrays/direct/uchar/uchar.factor
basis/specialized-arrays/direct/uint/uint.factor
basis/specialized-arrays/direct/ulong/ulong.factor
basis/specialized-arrays/direct/ulonglong/ulonglong.factor
basis/specialized-arrays/direct/ushort/ushort.factor
basis/ui/freetype/freetype.factor
basis/ui/gadgets/buttons/buttons.factor
basis/unix/utilities/utilities.factor

index 739b45486f0fe89ae4224cc2978912115fb8a750..102d7b9612af0cc7963779c34d2a924613cbf1d8 100644 (file)
@@ -89,16 +89,6 @@ HELP: malloc-byte-array
 { $warning "Don't forget to deallocate the memory with a call to " { $link free } "." }
 { $errors "Throws an error if memory allocation fails." } ;
 
-HELP: define-nth
-{ $values { "name" "a word name" } { "vocab" "a vocabulary name" } }
-{ $description "Defines a word " { $snippet { $emphasis "name" } "-nth" } " with stack effect " { $snippet "( n c-ptr -- value )" } " for reading the value with C type " { $snippet "name" } " stored at an alien pointer, displaced by a multiple of the C type's size." }
-{ $notes "This is an internal word called when defining C types, there is no need to call it on your own." } ;
-
-HELP: define-set-nth
-{ $values { "name" "a word name" } { "vocab" "a vocabulary name" } }
-{ $description "Defines a word " { $snippet "set-" { $emphasis "name" } "-nth" } " with stack effect " { $snippet "( value n c-ptr -- )" } " for writing the value with C type " { $snippet "name" } " to an alien pointer, displaced by a multiple of the C type's size." }
-{ $notes "This is an internal word called when defining C types, there is no need to call it on your own." } ;
-
 HELP: box-parameter
 { $values { "n" integer } { "ctype" string } }
 { $description "Generates code for converting a C value stored at  offset " { $snippet "n" } " from the top of the stack into a Factor object to be pushed on the data stack." }
index 11601f7b63bf1464de68382ee4ccf3dc55be012c..4cb2032f4f27e8434dc3a8182a0c5efd9501ef79 100644 (file)
@@ -2,7 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: alien.c-types accessors math alien.accessors kernel
 kernel.private locals sequences sequences.private byte-arrays
-parser prettyprint.backend ;
+parser prettyprint.backend fry ;
 IN: bit-arrays
 
 TUPLE: bit-array
@@ -24,9 +24,8 @@ TUPLE: bit-array
 : bits>bytes 7 + n>byte ; inline
 
 : (set-bits) ( bit-array n -- )
-    [ [ length bits>cells ] keep ] dip
-    [ -rot underlying>> set-uint-nth ] 2curry
-    each ; inline
+    [ [ length bits>cells ] keep ] dip swap underlying>>
+    '[ [ _ _ ] dip set-alien-unsigned-4 ] each ; inline
 
 PRIVATE>
 
@@ -84,9 +83,9 @@ M: bit-array byte-length length 7 + -3 shift ;
     ] if ;
 
 : bit-array>integer ( bit-array -- n )
-    0 swap underlying>> [ length ] keep [
-        uchar-nth swap 8 shift bitor
-    ] curry each ;
+    0 swap underlying>> dup length [
+        alien-unsigned-1 swap 8 shift bitor
+    ] with each ;
 
 INSTANCE: bit-array sequence
 
index 7de1f24a3c6e04b1f0c57e287675a0e268d6cf6b..7f5b77728332eda4941093f4db1308abdd5d8f0c 100644 (file)
@@ -1,26 +1,31 @@
-USING: kernel cocoa cocoa.types alien.c-types locals math sequences
-vectors fry libc ;
+! Copyright (C) 2008 Joe Groff.
+! See http://factorcode.org/license.txt for BSD license.
+USING: kernel cocoa cocoa.types alien.c-types locals math
+sequences vectors fry libc destructors
+specialized-arrays.direct.alien ;
 IN: cocoa.enumeration
 
 : NS-EACH-BUFFER-SIZE 16 ; inline
 
-: (with-enumeration-buffers) ( quot -- )
-    "NSFastEnumerationState" heap-size swap '[
-        NS-EACH-BUFFER-SIZE "id" heap-size * [
-            NS-EACH-BUFFER-SIZE @
-        ] with-malloc
-    ] with-malloc ; inline
+: with-enumeration-buffers ( quot -- )
+    [
+        [
+            "NSFastEnumerationState" malloc-object &free
+            NS-EACH-BUFFER-SIZE "id" heap-size * malloc-object &free
+            NS-EACH-BUFFER-SIZE
+        ] dip call
+    ] with-destructors ; inline
 
 :: (NSFastEnumeration-each) ( object quot: ( elt -- ) state stackbuf count -- )
     object state stackbuf count -> countByEnumeratingWithState:objects:count:
-    dup zero? [ drop ] [
+    dup 0 = [ drop ] [
         state NSFastEnumerationState-itemsPtr [ stackbuf ] unless*
-        '[ _ void*-nth quot call ] each
+        swap <direct-void*-array> quot each
         object quot state stackbuf count (NSFastEnumeration-each)
     ] if ; inline recursive
 
 : NSFastEnumeration-each ( object quot -- )
-    [ (NSFastEnumeration-each) ] (with-enumeration-buffers) ; inline
+    [ (NSFastEnumeration-each) ] with-enumeration-buffers ; inline
 
 : NSFastEnumeration-map ( object quot -- vector )
     NS-EACH-BUFFER-SIZE <vector>
index 5bcd6d6f607160ef272222debd0063e9c11c402d..791674428b138f16b03db0b66c10422653ae8c5e 100644 (file)
@@ -5,7 +5,8 @@ combinators compiler compiler.alien kernel math namespaces make
 parser prettyprint prettyprint.sections quotations sequences
 strings words cocoa.runtime io macros memoize debugger
 io.encodings.ascii effects libc libc.private parser lexer init
-core-foundation fry generalizations ;
+core-foundation fry generalizations
+specialized-arrays.direct.alien ;
 IN: cocoa.messages
 
 : make-sender ( method function -- quot )
@@ -198,8 +199,11 @@ assoc-union alien>objc-types set-global
     objc-methods get set-at ;
 
 : each-method-in-class ( class quot -- )
-    [ 0 <uint> [ class_copyMethodList ] keep *uint over ] dip
-    '[ _ void*-nth @ ] each (free) ; inline
+    [ 0 <uint> [ class_copyMethodList ] keep *uint ] dip
+    over 0 = [ 3drop ] [
+        [ <direct-void*-array> ] dip
+        [ each ] [ drop underlying>> (free) ] 2bi
+    ] if ; inline
 
 : register-objc-methods ( class -- )
     [ register-objc-method ] each-method-in-class ;
index 9302097adff00219b7bc5a2e69ca6178b4c48a30..b530ccbc3760620e0e1abb1a70d1f35efbe58c3b 100644 (file)
@@ -1,8 +1,8 @@
-! Copyright (C) 2006, 2007 Slava Pestov.
+! Copyright (C) 2006, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: alien.c-types arrays kernel cocoa.messages
-cocoa.classes cocoa.application cocoa core-foundation
-sequences ;
+USING: alien.accessors arrays kernel cocoa.messages
+cocoa.classes cocoa.application cocoa core-foundation sequences
+;
 IN: cocoa.pasteboard
 
 : NSStringPboardType "NSStringPboardType" ;
@@ -24,7 +24,7 @@ IN: cocoa.pasteboard
 
 : pasteboard-error ( error -- f )
     "Pasteboard does not hold a string" <NSString>
-    0 spin set-void*-nth f ;
+    0 set-alien-cell f ;
 
 : ?pasteboard-string ( pboard error -- str/f )
     over pasteboard-string? [
index a7d69bd5ed6f5aaa808d873f5685efb3a959db7f..06412209ca8021c9981d2c5c1316d1ada515e92f 100644 (file)
@@ -167,7 +167,8 @@ IN: compiler.tree.propagation.tests
 
 [ V{ fixnum } ] [
     [
-        [ uchar-nth ] 2keep [ uchar-nth ] 2keep uchar-nth
+        { fixnum byte-array } declare
+        [ nth-unsafe ] 2keep [ nth-unsafe ] 2keep nth-unsafe
         >r >r 298 * r> 100 * - r> 208 * - 128 + -8 shift
         255 min 0 max
     ] final-classes
index 8a5bd1d24015f77574a4776aa6fd1500207b2933..8e5051e75dfbe727074175d39eecd7adb36a43d9 100644 (file)
@@ -104,7 +104,7 @@ FUNCTION: CFTypeID CFGetTypeID ( CFTypeRef cf ) ;
     CF>array [ CF>string ] map ;
 
 : <CFStringArray> ( seq -- alien )
-    [ <CFString> ] map dup <CFArray> swap [ CFRelease ] each ;
+    [ <CFString> ] map [ <CFArray> ] [ [ CFRelease ] each ] bi ;
 
 : <CFFileSystemURL> ( string dir? -- url )
     [ <CFString> f over kCFURLPOSIXPathStyle ] dip
index 80678ec3dae7bfdee478e3f7471b0dd2825309f4..d4d5e88512e25c72c0e2c4d464a80c2b342d358f 100644 (file)
@@ -4,7 +4,9 @@ USING: alien alien.c-types alien.strings alien.syntax kernel
 math sequences namespaces make assocs init accessors
 continuations combinators core-foundation
 core-foundation.run-loop core-foundation.run-loop.thread
-io.encodings.utf8 destructors locals arrays ;
+io.encodings.utf8 destructors locals arrays
+specialized-arrays.direct.alien specialized-arrays.direct.int
+specialized-arrays.direct.longlong ;
 IN: core-foundation.fsevents
 
 : kFSEventStreamCreateFlagUseCFTypes 2 ; inline
@@ -160,11 +162,12 @@ SYMBOL: event-stream-callbacks
 : remove-event-source-callback ( id -- )
     event-stream-callbacks get delete-at ;
 
-:: >event-triple ( n eventPaths eventFlags eventIds -- triple )
-    n eventPaths void*-nth utf8 alien>string
-    n eventFlags int-nth
-    n eventIds longlong-nth
-    3array ;
+:: (master-event-source-callback) ( eventStream info numEvents eventPaths eventFlags eventIds -- )
+    eventPaths numEvents <direct-void*-array> [ utf8 alien>string ] { } map-as
+    eventFlags numEvents <direct-int-array>
+    eventIds numEvents <direct-longlong-array>
+    3array flip
+    info event-stream-callbacks get at [ drop ] or call ;
 
 : master-event-source-callback ( -- alien )
     "void"
@@ -176,19 +179,15 @@ SYMBOL: event-stream-callbacks
         "FSEventStreamEventFlags*"
         "FSEventStreamEventId*"
     }
-    "cdecl" [
-        [ >event-triple ] 3curry map
-        swap event-stream-callbacks get at
-        dup [ call drop ] [ 3drop ] if
-    ] alien-callback ;
+    "cdecl" [ (master-event-source-callback) ] alien-callback ;
 
 TUPLE: event-stream info handle disposed ;
 
 : <event-stream> ( quot paths latency flags -- event-stream )
-    >r >r >r
-    add-event-source-callback dup
-    >r master-event-source-callback r>
-    r> r> r> <FSEventStream>
+    [
+        add-event-source-callback dup
+        [ master-event-source-callback ] dip
+    ] 3dip <FSEventStream>
     dup enable-event-stream
     f event-stream boa ;
 
index 16f6f073f5b460f9b8fff58237c0d48013bf269c..d631a91eaed28ff9259c5f438e17419927757775 100644 (file)
@@ -54,7 +54,7 @@ IN: functors
     [ scan interpolate-locals ] dip
     '[ _ with-string-writer @ ] parsed ;
 
-: IS [ search ] (INTERPOLATE) ; parsing
+: IS [ dup search [ ] [ no-word ] ?if ] (INTERPOLATE) ; parsing
 
 : DEFINES [ in get create ] (INTERPOLATE) ; parsing
 
index de95a3a583a4660c143903d39876f6b0918cae0c..8e7e37134b879f0bba9958ca03626e8692884bd1 100644 (file)
@@ -313,8 +313,7 @@ PRIVATE>
 <PRIVATE
 
 : make-timeval-array ( array -- byte-array )
-    [ length "timeval" <c-array> ] keep
-    dup length [ over [ pick set-timeval-nth ] [ 2drop ] if ] 2each ;
+    [ [ "timeval" <c-object> ] unless* ] map concat ;
 
 : timestamp>timeval ( timestamp -- timeval )
     unix-1970 time- duration>microseconds make-timeval ;
index 5a1f2849d488dc7d66d3b2064fedba0cb82da466..a28738e14705112dd377f656b3e300a8a0104348 100644 (file)
@@ -1,11 +1,11 @@
 ! Copyright (C) 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: system kernel unix math sequences qualified
-io.unix.backend io.ports specialized-arrays.int ;
+io.unix.backend io.ports specialized-arrays.int accessors ;
 IN: io.unix.pipes
 QUALIFIED: io.pipes
 
 M: unix io.pipes:(pipe) ( -- pair )
     2 <int-array>
-    dup underlying>> pipe io-error
-    first2 [ <fd> init-fd ] bi@ io.pipes:pipe boa ;
+    [ underlying>> pipe io-error ]
+    [ first2 [ <fd> init-fd ] bi@ io.pipes:pipe boa ] bi ;
index adbd2ad063a1b33b165eb143f5d2875caa6194d2..903519fe1fe55062e88e8f2dbaf06755da51c715 100644 (file)
@@ -373,12 +373,12 @@ M: wlet local-rewrite*
     let-rewrite ;
 
 : parse-locals ( -- vars assoc )
-    ")" parse-effect
+    "(" expect ")" parse-effect
     word [ over "declared-effect" set-word-prop ] when*
     in>> [ dup pair? [ first ] when ] map make-locals dup push-locals ;
 
 : parse-locals-definition ( word -- word quot )
-    "(" expect parse-locals \ ; (parse-lambda) <lambda>
+    parse-locals \ ; (parse-lambda) <lambda>
     2dup "lambda" set-word-prop
     lambda-rewrite dup length 1 = [ first ] [ bad-lambda-rewrite ] if ;
 
index ac484c2ddd921d362702138d9879c68d9eabf71c..10f9c57a838129b54e34012f34b452a35f6b36fb 100644 (file)
@@ -62,7 +62,7 @@ MACRO: all-enabled-client-state ( seq quot -- )
     [ 4 GL_FLOAT 0 ] dip underlying>> glColorPointer ; inline
 
 : gl-texture-coord-pointer ( seq -- )
-    [ 2 GL_FLOAT 0 ] dip glTexCoordPointer ; inline
+    [ 2 GL_FLOAT 0 ] dip underlying>> glTexCoordPointer ; inline
 
 : line-vertices ( a b -- )
     [ first2 [ 0.5 + ] bi@ ] bi@ 4 float-array{ } nsequence
@@ -80,6 +80,7 @@ MACRO: all-enabled-client-state ( seq quot -- )
         [ first 0.3 - 0.5 ]
         [ [ first 0.3 - ] [ second 0.3 - ] bi ]
         [ second 0.3 - 0.5 swap ]
+        [ drop 0.5 0.5 ]
     } cleave 10 float-array{ } nsequence ;
 
 : rect-vertices ( dim -- )
index c31d338fac84672c5a5467666790b3b183a4987e..5610ef18c2911debd9a5530fb78f884b7461c22c 100644 (file)
@@ -2,9 +2,9 @@
 ! See http://factorcode.org/license.txt for BSD license.
 ! mersenne twister based on 
 ! http://www.math.sci.hiroshima-u.ac.jp/~m-mat/MT/MT2002/CODES/mt19937ar.c
-USING: arrays kernel math namespaces sequences system init
+USING: kernel math namespaces sequences system init
 accessors math.ranges random circular math.bitwise
-combinators ;
+combinators specialized-arrays.uint ;
 IN: random.mersenne-twister
 
 <PRIVATE
@@ -39,11 +39,11 @@ TUPLE: mersenne-twister seq i ;
 
 : init-mt-rest ( seq -- )
     mt-n 1- swap [
-        [ init-mt-formula ] [ >r 1+ r> set-nth ] 2bi
+        [ init-mt-formula ] [ [ 1+ ] dip set-nth ] 2bi
     ] curry each ;
 
 : init-mt-seq ( seed -- seq )
-    32 bits mt-n 0 <array> <circular>
+    32 bits mt-n <uint-array> <circular>
     [ set-first ] [ init-mt-rest ] [ ] tri ;
 
 : mt-temper ( y -- yt )
index b1dee2e1d1bf1d4b6dcfcda99234d03be80e272e..3949c40352aa99b0adfc55bd21b13abb364419c6 100644 (file)
@@ -1,4 +1,4 @@
-USE: specialized-arrays.direct.functor
+USING: specialized-arrays.alien specialized-arrays.direct.functor ;
 IN: specialized-arrays.direct.alien
 
 << "void*" define-direct-array >>
\ No newline at end of file
index 139723d39a46b0b8c55726e3cb6bae7be4509780..689fcc3069bf34f875966eea03b2d7ee0ba8b203 100644 (file)
@@ -1,4 +1,4 @@
-USE: specialized-arrays.direct.functor
+USING: specialized-arrays.bool specialized-arrays.direct.functor ;
 IN: specialized-arrays.direct.bool
 
 << "bool" define-direct-array >>
\ No newline at end of file
index cf4e3617edbed295505e082068324c3b0fca72dc..cca3a620108f52c699f683957ec3840bc7452cc4 100644 (file)
@@ -1,4 +1,4 @@
-USE: specialized-arrays.direct.functor
+USING: specialized-arrays.char specialized-arrays.direct.functor ;
 IN: specialized-arrays.direct.char
 
 << "char" define-direct-array >>
\ No newline at end of file
diff --git a/basis/specialized-arrays/direct/direct-tests.factor b/basis/specialized-arrays/direct/direct-tests.factor
new file mode 100644 (file)
index 0000000..2a48b5d
--- /dev/null
@@ -0,0 +1,7 @@
+IN: specialized-arrays.direct.tests
+USING: specialized-arrays.direct.ushort tools.test
+specialized-arrays.ushort alien.syntax sequences ;
+
+[ ushort-array{ 0 0 0 } ] [
+    3 ALIEN: 123 100 <direct-ushort-array> new-sequence
+] unit-test
index 423ceba688f511524da46fb2a44910e44f390241..c3089b3e4865b69ba67fdb9aad8ee188c35bef12 100644 (file)
@@ -1,4 +1,4 @@
-USE: specialized-arrays.direct.functor
+USING: specialized-arrays.double specialized-arrays.direct.functor ;
 IN: specialized-arrays.direct.double
 
 << "double" define-direct-array >>
\ No newline at end of file
index 91a117ada5180c0f7976daf346ce102ebc3beb30..94caa95685c9fb650fc9aa9ad8cbfb5cc343e123 100644 (file)
@@ -1,4 +1,4 @@
-USE: specialized-arrays.direct.functor
+USING: specialized-arrays.float specialized-arrays.direct.functor ;
 IN: specialized-arrays.direct.float
 
 << "float" define-direct-array >>
\ No newline at end of file
index 33410a7ad8794962b754338adb3425934bfc011d..c204e2706fd823411783268960aa71f85c33d828 100644 (file)
@@ -1,4 +1,4 @@
-USE: specialized-arrays.direct.functor
+USING: specialized-arrays.int specialized-arrays.direct.functor ;
 IN: specialized-arrays.direct.int
 
 << "int" define-direct-array >>
\ No newline at end of file
index ee2ed7188ae2cd44ca89d5d281e44e1a869d31d5..33c52bb524df3c93c478ebb3ed5fa7d87c91e100 100644 (file)
@@ -1,4 +1,4 @@
-USE: specialized-arrays.direct.functor
+USING: specialized-arrays.long specialized-arrays.direct.functor ;
 IN: specialized-arrays.direct.long
 
 << "long" define-direct-array >>
\ No newline at end of file
index 12306ff884f1174d1aa7e627511a81d79ef550a7..f1320002270940593484749392e02e34a36a241a 100644 (file)
@@ -1,4 +1,4 @@
-USE: specialized-arrays.direct.functor
+USING: specialized-arrays.longlong specialized-arrays.direct.functor ;
 IN: specialized-arrays.direct.longlong
 
 << "longlong" define-direct-array >>
\ No newline at end of file
index 375696ccda5e04d4cfe79051b3b28c24b454ec83..f837bebb84e7fd2e7a17deb5d9184dcb882952fc 100644 (file)
@@ -1,4 +1,4 @@
-USE: specialized-arrays.direct.functor
+USING: specialized-arrays.short specialized-arrays.direct.functor ;
 IN: specialized-arrays.direct.short
 
 << "short" define-direct-array >>
\ No newline at end of file
index d0a8f0ddd11c35b879466625ee634403b5cca0ec..34409798ad24724a5c694fa53d529a64ec5a8fe9 100644 (file)
@@ -1,4 +1,4 @@
-USE: specialized-arrays.direct.functor
+USING: specialized-arrays.uchar specialized-arrays.direct.functor ;
 IN: specialized-arrays.direct.uchar
 
 << "uchar" define-direct-array >>
\ No newline at end of file
index 18b3b630bb67d35dc1ab84d10d91be188b2b0e01..22f7ba333f40e4fd987a7bdda284d504ebd34761 100644 (file)
@@ -1,4 +1,4 @@
-USE: specialized-arrays.direct.functor
+USING: specialized-arrays.uint specialized-arrays.direct.functor ;
 IN: specialized-arrays.direct.uint
 
 << "uint" define-direct-array >>
\ No newline at end of file
index 89e6f29e74808887e1e5e09fff483abc4f2c8d4c..8a568ab63188b443ca1b43ea7cb79fa67bc99307 100644 (file)
@@ -1,4 +1,4 @@
-USE: specialized-arrays.direct.functor
+USING: specialized-arrays.ulong specialized-arrays.direct.functor ;
 IN: specialized-arrays.direct.ulong
 
 << "ulong" define-direct-array >>
\ No newline at end of file
index 8cb6af20e5f0e9a8f1a6861bd666641d3fd5aeff..10fa178c410ff9b1fb21afcc27638d19cb4fc475 100644 (file)
@@ -1,4 +1,4 @@
-USE: specialized-arrays.direct.functor
+USING: specialized-arrays.ulonglong specialized-arrays.direct.functor ;
 IN: specialized-arrays.direct.ulonglong
 
 << "ulonglong" define-direct-array >>
\ No newline at end of file
index 09f66b989da48c178d69c721a68c61dbdbb8d83b..6bd34c7eee51b41c659534a8e8cb7c81c84d7d2a 100644 (file)
@@ -1,4 +1,4 @@
-USE: specialized-arrays.direct.functor
+USING: specialized-arrays.ushort specialized-arrays.direct.functor ;
 IN: specialized-arrays.direct.ushort
 
 << "ushort" define-direct-array >>
\ No newline at end of file
index a4ef77e661bb1463a9ca586ab283c24de5e6bc6b..b0d152fc880fa557663f711a2d7f134a7b60f852 100644 (file)
@@ -4,8 +4,7 @@ USING: alien alien.accessors alien.c-types arrays io kernel libc
 math math.vectors namespaces opengl opengl.gl prettyprint assocs
 sequences io.files io.styles continuations freetype
 ui.gadgets.worlds ui.render ui.backend byte-arrays accessors
-locals ;
-
+locals specialized-arrays.direct.uchar ;
 IN: ui.freetype
 
 TUPLE: freetype-renderer ;
@@ -135,8 +134,8 @@ M: freetype-renderer string-height ( open-font string -- h )
     FT_RENDER_MODE_NORMAL FT_Render_Glyph freetype-error ;
 
 :: copy-pixel ( i j bitmap texture -- i j )
-    255 j texture set-char-nth
-    i bitmap char-nth j 1 + texture set-char-nth
+    255 j texture set-nth
+    i bitmap nth j 1 + texture set-nth
     i 1 + j 2 + ; inline
 
 :: (copy-row) ( i j bitmap texture end -- )
@@ -155,15 +154,18 @@ M: freetype-renderer string-height ( open-font string -- h )
             rows [ glyph glyph-bitmap-rows ]
             width [ glyph glyph-bitmap-width ]
             width2 [ width next-power-of-2 2 * ] |
-        0 0
-        rows [ bitmap texture width width2 copy-row ] times
-        2drop
+        bitmap [
+            [let | bitmap' [ bitmap rows width * <direct-uchar-array> ] |
+                0 0
+                rows [ bitmap' texture width width2 copy-row ] times
+                2drop
+            ]
+        ] when
     ] ;
 
 : bitmap>texture ( glyph sprite -- id )
-    tuck sprite-size2 * 2 * [
-        [ copy-bitmap ] keep gray-texture
-    ] with-malloc ;
+    tuck sprite-size2 * 2 * <byte-array>
+    [ copy-bitmap ] keep gray-texture ;
 
 : glyph-texture-loc ( glyph font -- loc )
     [ drop glyph-hori-bearing-x ft-floor ]
index 5d1868fdcaf036f0cc7ac310efa99ea79fd02803..75469671ef14ed47afb7358a84768e3cfc9b0037 100644 (file)
@@ -2,12 +2,11 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors arrays kernel math models namespaces sequences
 strings quotations assocs combinators classes colors
-<<<<<<< HEAD:basis/ui/gadgets/buttons/buttons.factor
 classes.tuple opengl opengl.gl math.vectors ui.commands ui.gadgets
 ui.gadgets.borders ui.gadgets.labels ui.gadgets.theme
 ui.gadgets.tracks ui.gadgets.packs ui.gadgets.worlds ui.gestures
 ui.render math.geometry.rect locals alien.c-types
-specialized-arrays.float ;
+specialized-arrays.float fry ;
 IN: ui.gadgets.buttons
 
 TUPLE: button < border pressed? selected? quot ;
index 67acd3737a319383f7a8c5545a1291d8a8cecb81..e2f780cd1346cdd2c5ed4b10cc46b816103e4f01 100644 (file)
@@ -2,7 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: alien alien.c-types alien.strings
 combinators.short-circuit fry kernel layouts sequences
-specialized-arrays.alien ;
+specialized-arrays.alien accessors ;
 IN: unix.utilities
 
 : more? ( alien -- ? )
@@ -17,4 +17,4 @@ IN: unix.utilities
     [ ] produce nip ;
 
 : strings>alien ( strings encoding -- alien )
-    '[ _ malloc-string ] void*-array{ } map f suffix underlying>> ;
+    '[ _ malloc-string ] void*-array{ } map-as f suffix underlying>> ;