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

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

db4
Doug Coleman 2009-06-25 13:26:18 -05:00
parent 3afd2599ce 1c0a0155eb
commit c44df7832c
63 changed files with 2992 additions and 1226 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
Factor.app/Contents/Resources/English.lproj/Factor.nib/info.nib generated
View File

@ -3,15 +3,13 @@
<plist version="1.0">
<dict>
<key>IBFramework Version</key>
<string>629</string>
<string>677</string>
<key>IBOldestOS</key>
<integer>5</integer>
<key>IBOpenObjects</key>
<array>
<integer>305</integer>
</array>
<array/>
<key>IBSystem Version</key>
<string>9G55</string>
<string>9J61</string>
<key>targetFramework</key>
<string>IBCocoaFramework</string>
</dict>

BIN
Factor.app/Contents/Resources/English.lproj/Factor.nib/keyedobjects.nib generated
View File

Binary file not shown.

49
Factor.app/Contents/Resources/English.lproj/MiniFactor.nib/classes.nib generated
View File

@ -1,17 +1,32 @@
{
IBClasses = (
{
ACTIONS = {
newFactorWorkspace = id;
runFactorFile = id;
saveFactorImage = id;
saveFactorImageAs = id;
showFactorHelp = id;
};
CLASS = FirstResponder;
LANGUAGE = ObjC;
SUPERCLASS = NSObject;
}
);
IBVersion = 1;
}
<?xml version="1.0" encoding="UTF-8"?>
<!DOCTYPE plist PUBLIC "-//Apple//DTD PLIST 1.0//EN" "http://www.apple.com/DTDs/PropertyList-1.0.dtd">
<plist version="1.0">
<dict>
<key>IBClasses</key>
<array>
<dict>
<key>ACTIONS</key>
<dict>
<key>newFactorWorkspace</key>
<string>id</string>
<key>runFactorFile</key>
<string>id</string>
<key>saveFactorImage</key>
<string>id</string>
<key>saveFactorImageAs</key>
<string>id</string>
<key>showFactorHelp</key>
<string>id</string>
</dict>
<key>CLASS</key>
<string>FirstResponder</string>
<key>LANGUAGE</key>
<string>ObjC</string>
<key>SUPERCLASS</key>
<string>NSObject</string>
</dict>
</array>
<key>IBVersion</key>
<string>1</string>
</dict>
</plist>

19
Factor.app/Contents/Resources/English.lproj/MiniFactor.nib/info.nib generated
View File

@ -1,21 +1,18 @@
<?xml version="1.0" encoding="UTF-8"?>
<!DOCTYPE plist PUBLIC "-//Apple Computer//DTD PLIST 1.0//EN" "http://www.apple.com/DTDs/PropertyList-1.0.dtd">
<!DOCTYPE plist PUBLIC "-//Apple//DTD PLIST 1.0//EN" "http://www.apple.com/DTDs/PropertyList-1.0.dtd">
<plist version="1.0">
<dict>
<key>IBDocumentLocation</key>
<string>1266 155 525 491 0 0 2560 1578 </string>
<key>IBEditorPositions</key>
<dict>
<key>29</key>
<string>326 905 270 44 0 0 2560 1578 </string>
</dict>
<key>IBFramework Version</key>
<string>439.0</string>
<string>677</string>
<key>IBOldestOS</key>
<integer>5</integer>
<key>IBOpenObjects</key>
<array>
<integer>29</integer>
<integer>293</integer>
</array>
<key>IBSystem Version</key>
<string>8R218</string>
<string>9J61</string>
<key>targetFramework</key>
<string>IBCocoaFramework</string>
</dict>
</plist>

BIN
Factor.app/Contents/Resources/English.lproj/MiniFactor.nib/keyedobjects.nib generated
View File

Binary file not shown.

3
basis/cairo/cairo.factor
View File

@ -31,7 +31,8 @@ ERROR: cairo-error message ;
<cairo> &cairo_destroy
@
] make-memory-bitmap
BGRA >>component-order ; inline
BGRA >>component-order
ubyte-components >>component-type ; inline
: dummy-cairo ( -- cr )
#! Sometimes we want a dummy context; eg with Pango, we want

39
basis/compiler/cfg/linear-scan/allocation/allocation.factor
View File

@ -2,44 +2,27 @@
! See http://factorcode.org/license.txt for BSD license.
USING: accessors assocs heaps kernel namespaces sequences fry math
combinators arrays sorting compiler.utilities
compiler.cfg.linear-scan.live-intervals
compiler.cfg.linear-scan.allocation.coalescing
compiler.cfg.linear-scan.allocation.spilling
compiler.cfg.linear-scan.allocation.splitting
compiler.cfg.linear-scan.allocation.state ;
IN: compiler.cfg.linear-scan.allocation
: relevant-ranges ( new inactive -- new' inactive' )
! Slice off all ranges of 'inactive' that precede the start of 'new'
[ [ ranges>> ] bi@ ] [ nip start>> ] 2bi '[ to>> _ >= ] filter ;
: free-positions ( new -- assoc )
vreg>> reg-class>> registers get at [ 1/0. ] H{ } map>assoc ;
: intersect-live-range ( range1 range2 -- n/f )
2dup [ from>> ] bi@ > [ swap ] when
2dup [ to>> ] [ from>> ] bi* >= [ nip from>> ] [ 2drop f ] if ;
: active-positions ( new -- assoc )
vreg>> active-intervals-for [ reg>> 0 ] H{ } map>assoc ;
: intersect-live-ranges ( ranges1 ranges2 -- n )
{
{ [ over empty? ] [ 2drop 1/0. ] }
{ [ dup empty? ] [ 2drop 1/0. ] }
[
2dup [ first ] bi@ intersect-live-range dup [ 2nip ] [
drop
2dup [ first from>> ] bi@ <
[ [ rest-slice ] dip ] [ rest-slice ] if
intersect-live-ranges
] if
]
} cond ;
: intersect-inactive ( new inactive -- n )
relevant-ranges intersect-live-ranges ;
: inactive-positions ( new -- assoc )
dup vreg>> inactive-intervals-for
[ [ reg>> swap ] keep relevant-ranges intersect-live-ranges ]
with H{ } map>assoc ;
: compute-free-pos ( new -- free-pos )
dup vreg>>
[ nip reg-class>> registers get at [ 1/0. ] H{ } map>assoc ]
[ inactive-intervals-for [ [ reg>> swap ] keep intersect-inactive ] with H{ } map>assoc ]
[ nip active-intervals-for [ reg>> 0 ] H{ } map>assoc ]
2tri 3array assoc-combine
>alist alist-max ;
[ free-positions ] [ inactive-positions ] [ active-positions ] tri
3array assoc-combine >alist alist-max ;
: no-free-registers? ( result -- ? )
second 0 = ; inline

14
basis/compiler/cfg/linear-scan/allocation/coalescing/coalescing.factor
View File

@ -1,18 +1,28 @@
! Copyright (C) 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors kernel sequences
combinators.short-circuit
compiler.cfg.linear-scan.live-intervals
compiler.cfg.linear-scan.allocation.state ;
IN: compiler.cfg.linear-scan.allocation.coalescing
: active-interval ( vreg -- live-interval )
dup [ dup active-intervals-for [ vreg>> = ] with find nip ] when ;
: intersects-inactive-intervals? ( live-interval -- ? )
dup vreg>> inactive-intervals-for
[ relevant-ranges intersect-live-ranges 1/0. = ] with all? ;
: coalesce? ( live-interval -- ? )
[ start>> ] [ copy-from>> active-interval ] bi
dup [ end>> = ] [ 2drop f ] if ;
{
[ copy-from>> active-interval ]
[ [ start>> ] [ copy-from>> active-interval end>> ] bi = ]
[ intersects-inactive-intervals? ]
} 1&& ;
: coalesce ( live-interval -- )
dup copy-from>> active-interval
[ [ add-active ] [ [ delete-active ] [ add-handled ] bi ] bi* ]
[ reg>> >>reg drop ]
2bi ;

28
basis/compiler/cfg/linear-scan/assignment/assignment.factor
View File

@ -40,16 +40,23 @@ ERROR: already-spilled ;
2dup key? [ already-spilled ] [ set-at ] if ;
: insert-spill ( live-interval -- )
[ reg>> ] [ vreg>> reg-class>> ] [ spill-to>> ] tri _spill ;
{
[ reg>> ]
[ vreg>> reg-class>> ]
[ spill-to>> ]
[ end>> ]
} cleave f swap \ _spill boa , ;
: handle-spill ( live-interval -- )
dup spill-to>> [ [ record-spill ] [ insert-spill ] bi ] [ drop ] if ;
: insert-copy ( live-interval -- )
[ split-next>> reg>> ]
[ reg>> ]
[ vreg>> reg-class>> ]
tri _copy ;
{
[ split-next>> reg>> ]
[ reg>> ]
[ vreg>> reg-class>> ]
[ end>> ]
} cleave f swap \ _copy boa , ;
: handle-copy ( live-interval -- )
dup [ spill-to>> not ] [ split-next>> ] bi and
@ -68,7 +75,12 @@ ERROR: already-reloaded ;
2dup key? [ delete-at ] [ already-reloaded ] if ;
: insert-reload ( live-interval -- )
[ reg>> ] [ vreg>> reg-class>> ] [ reload-from>> ] tri _reload ;
{
[ reg>> ]
[ vreg>> reg-class>> ]
[ reload-from>> ]
[ end>> ]
} cleave f swap \ _reload boa , ;
: handle-reload ( live-interval -- )
dup reload-from>> [ [ record-reload ] [ insert-reload ] bi ] [ drop ] if ;
@ -141,6 +153,6 @@ M: insn assign-registers-in-insn drop ;
] V{ } make
] change-instructions drop ;
: assign-registers ( rpo live-intervals -- )
init-assignment
: assign-registers ( live-intervals rpo -- )
[ init-assignment ] dip
[ assign-registers-in-block ] each ;

9
basis/compiler/cfg/linear-scan/debugger/debugger.factor
View File

@ -1,8 +1,8 @@
! Copyright (C) 2008 Slava Pestov.
! Copyright (C) 2008, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors kernel sequences sets arrays math strings fry
prettyprint compiler.cfg.linear-scan.live-intervals
compiler.cfg.linear-scan.allocation ;
namespaces prettyprint compiler.cfg.linear-scan.live-intervals
compiler.cfg.linear-scan.allocation compiler.cfg ;
IN: compiler.cfg.linear-scan.debugger
: check-assigned ( live-intervals -- )
@ -34,3 +34,6 @@ IN: compiler.cfg.linear-scan.debugger
: live-intervals. ( seq -- )
[ interval-picture ] map simple-table. ;
: test-bb ( insns n -- )
[ <basic-block> swap >>number swap >>instructions ] keep set ;

639
basis/compiler/cfg/linear-scan/linear-scan-tests.factor
View File

@ -10,6 +10,8 @@ compiler.cfg.registers
compiler.cfg.liveness
compiler.cfg.predecessors
compiler.cfg.rpo
compiler.cfg.linearization
compiler.cfg.debugger
compiler.cfg.linear-scan
compiler.cfg.linear-scan.live-intervals
compiler.cfg.linear-scan.allocation
@ -410,7 +412,7 @@ SYMBOL: max-uses
[ ] [ 10 20 2 400 random-test ] unit-test
[ ] [ 10 20 4 300 random-test ] unit-test
USING: math.private compiler.cfg.debugger ;
USING: math.private ;
[ ] [
[ float+ float>fixnum 3 fixnum*fast ]
@ -1412,199 +1414,154 @@ USING: math.private compiler.cfg.debugger ;
{ uses { 5 10 } }
{ ranges V{ T{ live-range f 5 10 } } }
}
intersect-inactive
relevant-ranges intersect-live-ranges
] unit-test
! Bug in live spill slots calculation
T{ basic-block
{ id 205651 }
{ number 0 }
{ instructions V{ T{ ##prologue } T{ ##branch } } }
} 0 set
V{ T{ ##prologue } T{ ##branch } } 0 test-bb
T{ basic-block
{ id 205652 }
{ number 1 }
{ instructions
V{
T{ ##peek
{ dst V int-regs 703128 }
{ loc D 1 }
}
T{ ##peek
{ dst V int-regs 703129 }
{ loc D 0 }
}
T{ ##copy
{ dst V int-regs 703134 }
{ src V int-regs 703128 }
}
T{ ##copy
{ dst V int-regs 703135 }
{ src V int-regs 703129 }
}
T{ ##compare-imm-branch
{ src1 V int-regs 703128 }
{ src2 5 }
{ cc cc/= }
}
}
}
} 1 set
V{
T{ ##peek
{ dst V int-regs 703128 }
{ loc D 1 }
}
T{ ##peek
{ dst V int-regs 703129 }
{ loc D 0 }
}
T{ ##copy
{ dst V int-regs 703134 }
{ src V int-regs 703128 }
}
T{ ##copy
{ dst V int-regs 703135 }
{ src V int-regs 703129 }
}
T{ ##compare-imm-branch
{ src1 V int-regs 703128 }
{ src2 5 }
{ cc cc/= }
}
} 1 test-bb
T{ basic-block
{ id 205653 }
{ number 2 }
{ instructions
V{
T{ ##copy
{ dst V int-regs 703134 }
{ src V int-regs 703129 }
}
T{ ##copy
{ dst V int-regs 703135 }
{ src V int-regs 703128 }
}
T{ ##branch }
}
}
} 2 set
V{
T{ ##copy
{ dst V int-regs 703134 }
{ src V int-regs 703129 }
}
T{ ##copy
{ dst V int-regs 703135 }
{ src V int-regs 703128 }
}
T{ ##branch }
} 2 test-bb
T{ basic-block
{ id 205655 }
{ number 3 }
{ instructions
V{
T{ ##replace
{ src V int-regs 703134 }
{ loc D 0 }
}
T{ ##replace
{ src V int-regs 703135 }
{ loc D 1 }
}
T{ ##epilogue }
T{ ##return }
}
}
} 3 set
V{
T{ ##replace
{ src V int-regs 703134 }
{ loc D 0 }
}
T{ ##replace
{ src V int-regs 703135 }
{ loc D 1 }
}
T{ ##epilogue }
T{ ##return }
} 3 test-bb
1 get 1vector 0 get (>>successors)
2 get 3 get V{ } 2sequence 1 get (>>successors)
3 get 1vector 2 get (>>successors)
SYMBOL: linear-scan-result
:: test-linear-scan-on-cfg ( regs -- )
[ ] [
cfg new 0 get >>entry
compute-predecessors
compute-liveness
reverse-post-order
dup reverse-post-order
{ { int-regs regs } } (linear-scan)
flatten-cfg 1array mr.
] unit-test ;
{ 1 2 } test-linear-scan-on-cfg
! This test has a critical edge -- do we care about these?
! { 1 2 } test-linear-scan-on-cfg
! Bug in inactive interval handling
! [ rot dup [ -rot ] when ]
T{ basic-block
{ id 201486 }
{ number 0 }
{ instructions V{ T{ ##prologue } T{ ##branch } } }
} 0 set
V{ T{ ##prologue } T{ ##branch } } 0 test-bb
T{ basic-block
{ id 201487 }
{ number 1 }
{ instructions
V{
T{ ##peek
{ dst V int-regs 689473 }
{ loc D 2 }
}
T{ ##peek
{ dst V int-regs 689474 }
{ loc D 1 }
}
T{ ##peek
{ dst V int-regs 689475 }
{ loc D 0 }
}
T{ ##compare-imm-branch
{ src1 V int-regs 689473 }
{ src2 5 }
{ cc cc/= }
}
}
}
} 1 set
V{
T{ ##peek
{ dst V int-regs 689473 }
{ loc D 2 }
}
T{ ##peek
{ dst V int-regs 689474 }
{ loc D 1 }
}
T{ ##peek
{ dst V int-regs 689475 }
{ loc D 0 }
}
T{ ##compare-imm-branch
{ src1 V int-regs 689473 }
{ src2 5 }
{ cc cc/= }
}
} 1 test-bb
T{ basic-block
{ id 201488 }
{ number 2 }
{ instructions
V{
T{ ##copy
{ dst V int-regs 689481 }
{ src V int-regs 689475 }
}
T{ ##copy
{ dst V int-regs 689482 }
{ src V int-regs 689474 }
}
T{ ##copy
{ dst V int-regs 689483 }
{ src V int-regs 689473 }
}
T{ ##branch }
}
}
} 2 set
V{
T{ ##copy
{ dst V int-regs 689481 }
{ src V int-regs 689475 }
}
T{ ##copy
{ dst V int-regs 689482 }
{ src V int-regs 689474 }
}
T{ ##copy
{ dst V int-regs 689483 }
{ src V int-regs 689473 }
}
T{ ##branch }
} 2 test-bb
T{ basic-block
{ id 201489 }
{ number 3 }
{ instructions
V{
T{ ##copy
{ dst V int-regs 689481 }
{ src V int-regs 689473 }
}
T{ ##copy
{ dst V int-regs 689482 }
{ src V int-regs 689475 }
}
T{ ##copy
{ dst V int-regs 689483 }
{ src V int-regs 689474 }
}
T{ ##branch }
}
}
} 3 set
V{
T{ ##copy
{ dst V int-regs 689481 }
{ src V int-regs 689473 }
}
T{ ##copy
{ dst V int-regs 689482 }
{ src V int-regs 689475 }
}
T{ ##copy
{ dst V int-regs 689483 }
{ src V int-regs 689474 }
}
T{ ##branch }
} 3 test-bb
T{ basic-block
{ id 201490 }
{ number 4 }
{ instructions
V{
T{ ##replace
{ src V int-regs 689481 }
{ loc D 0 }
}
T{ ##replace
{ src V int-regs 689482 }
{ loc D 1 }
}
T{ ##replace
{ src V int-regs 689483 }
{ loc D 2 }
}
T{ ##epilogue }
T{ ##return }
}
}
} 4 set
V{
T{ ##replace
{ src V int-regs 689481 }
{ loc D 0 }
}
T{ ##replace
{ src V int-regs 689482 }
{ loc D 1 }
}
T{ ##replace
{ src V int-regs 689483 }
{ loc D 2 }
}
T{ ##epilogue }
T{ ##return }
} 4 test-bb
: test-diamond ( -- )
1 get 1vector 0 get (>>successors)
@ -1625,102 +1582,78 @@ T{ basic-block
{ instructions V{ T{ ##prologue } T{ ##branch } } }
} 0 set
T{ basic-block
{ id 201538 }
{ number 1 }
{ instructions
V{
T{ ##peek
{ dst V int-regs 689600 }
{ loc D 1 }
}
T{ ##peek
{ dst V int-regs 689601 }
{ loc D 0 }
}
T{ ##compare-imm-branch
{ src1 V int-regs 689600 }
{ src2 5 }
{ cc cc/= }
}
}
}
} 1 set
V{
T{ ##peek
{ dst V int-regs 689600 }
{ loc D 1 }
}
T{ ##peek
{ dst V int-regs 689601 }
{ loc D 0 }
}
T{ ##compare-imm-branch
{ src1 V int-regs 689600 }
{ src2 5 }
{ cc cc/= }
}
} 1 test-bb
T{ basic-block
{ id 201539 }
{ number 2 }
{ instructions
V{
T{ ##peek
{ dst V int-regs 689604 }
{ loc D 2 }
}
T{ ##copy
{ dst V int-regs 689607 }
{ src V int-regs 689604 }
}
T{ ##copy
{ dst V int-regs 689608 }
{ src V int-regs 689600 }
}
T{ ##copy
{ dst V int-regs 689610 }
{ src V int-regs 689601 }
}
T{ ##branch }
}
}
} 2 set
V{
T{ ##peek
{ dst V int-regs 689604 }
{ loc D 2 }
}
T{ ##copy
{ dst V int-regs 689607 }
{ src V int-regs 689604 }
}
T{ ##copy
{ dst V int-regs 689608 }
{ src V int-regs 689600 }
}
T{ ##copy
{ dst V int-regs 689610 }
{ src V int-regs 689601 }
}
T{ ##branch }
} 2 test-bb
T{ basic-block
{ id 201540 }
{ number 3 }
{ instructions
V{
T{ ##peek
{ dst V int-regs 689609 }
{ loc D 2 }
}
T{ ##copy
{ dst V int-regs 689607 }
{ src V int-regs 689600 }
}
T{ ##copy
{ dst V int-regs 689608 }
{ src V int-regs 689601 }
}
T{ ##copy
{ dst V int-regs 689610 }
{ src V int-regs 689609 }
}
T{ ##branch }
}
}
} 3 set
V{
T{ ##peek
{ dst V int-regs 689609 }
{ loc D 2 }
}
T{ ##copy
{ dst V int-regs 689607 }
{ src V int-regs 689600 }
}
T{ ##copy
{ dst V int-regs 689608 }
{ src V int-regs 689601 }
}
T{ ##copy
{ dst V int-regs 689610 }
{ src V int-regs 689609 }
}
T{ ##branch }
} 3 test-bb
T{ basic-block
{ id 201541 }
{ number 4 }
{ instructions
V{
T{ ##replace
{ src V int-regs 689607 }
{ loc D 0 }
}
T{ ##replace
{ src V int-regs 689608 }
{ loc D 1 }
}
T{ ##replace
{ src V int-regs 689610 }
{ loc D 2 }
}
T{ ##epilogue }
T{ ##return }
}
}
} 4 set
V{
T{ ##replace
{ src V int-regs 689607 }
{ loc D 0 }
}
T{ ##replace
{ src V int-regs 689608 }
{ loc D 1 }
}
T{ ##replace
{ src V int-regs 689610 }
{ loc D 2 }
}
T{ ##epilogue }
T{ ##return }
} 4 test-bb
test-diamond
@ -1729,76 +1662,130 @@ test-diamond
! compute-live-registers was inaccurate since it didn't take
! lifetime holes into account
T{ basic-block
{ id 0 }
{ number 0 }
{ instructions V{ T{ ##prologue } T{ ##branch } } }
} 0 set
V{ T{ ##prologue } T{ ##branch } } 0 test-bb
T{ basic-block
{ id 1 }
{ instructions
V{
T{ ##peek
{ dst V int-regs 0 }
{ loc D 0 }
}
T{ ##compare-imm-branch
{ src1 V int-regs 0 }
{ src2 5 }
{ cc cc/= }
}
}
}
} 1 set
V{
T{ ##peek
{ dst V int-regs 0 }
{ loc D 0 }
}
T{ ##compare-imm-branch
{ src1 V int-regs 0 }
{ src2 5 }
{ cc cc/= }
}
} 1 test-bb
T{ basic-block
{ id 2 }
{ instructions
V{
T{ ##peek
{ dst V int-regs 1 }
{ loc D 1 }
}
T{ ##copy
{ dst V int-regs 2 }
{ src V int-regs 1 }
}
T{ ##branch }
}
}
} 2 set
V{
T{ ##peek
{ dst V int-regs 1 }
{ loc D 1 }
}
T{ ##copy
{ dst V int-regs 2 }
{ src V int-regs 1 }
}
T{ ##branch }
} 2 test-bb
T{ basic-block
{ id 3 }
{ instructions
V{
T{ ##peek
{ dst V int-regs 3 }
{ loc D 2 }
}
T{ ##copy
{ dst V int-regs 2 }
{ src V int-regs 3 }
}
T{ ##branch }
}
}
} 3 set
V{
T{ ##peek
{ dst V int-regs 3 }
{ loc D 2 }
}
T{ ##copy
{ dst V int-regs 2 }
{ src V int-regs 3 }
}
T{ ##branch }
} 3 test-bb
T{ basic-block
{ id 4 }
{ instructions
V{
T{ ##replace
{ src V int-regs 2 }
{ loc D 0 }
}
T{ ##return }
}
}
} 4 set
V{
T{ ##replace
{ src V int-regs 2 }
{ loc D 0 }
}
T{ ##return }
} 4 test-bb
test-diamond
{ 1 2 3 4 } test-linear-scan-on-cfg
{ 1 2 3 4 } test-linear-scan-on-cfg
! Inactive interval handling: splitting active interval
! if it fits in lifetime hole only partially
V{ T{ ##peek f V int-regs 3 R 1 } T{ ##branch } } 0 test-bb
V{
T{ ##peek f V int-regs 2 R 0 }
T{ ##compare-imm-branch f V int-regs 2 5 cc= }
} 1 test-bb
V{
T{ ##peek f V int-regs 0 D 0 }
T{ ##branch }
} 2 test-bb
V{
T{ ##peek f V int-regs 1 D 1 }
T{ ##peek f V int-regs 0 D 0 }
T{ ##replace f V int-regs 1 D 2 }
T{ ##branch }
} 3 test-bb
V{
T{ ##replace f V int-regs 3 R 2 }
T{ ##replace f V int-regs 0 D 0 }
T{ ##return }
} 4 test-bb
test-diamond
{ 1 2 } test-linear-scan-on-cfg
USING: classes ;
[ ] [
1 get instructions>> first regs>> V int-regs 0 swap at
2 get instructions>> first regs>> V int-regs 1 swap at assert=
] unit-test
[ _copy ] [ 3 get instructions>> second class ] unit-test
! Resolve pass; make sure the spilling is done correctly
V{ T{ ##peek f V int-regs 3 R 1 } T{ ##branch } } 0 test-bb
V{
T{ ##peek f V int-regs 2 R 0 }
T{ ##compare-imm-branch f V int-regs 2 5 cc= }
} 1 test-bb
V{
T{ ##branch }
} 2 test-bb
V{
T{ ##replace f V int-regs 3 R 1 }
T{ ##peek f V int-regs 1 D 1 }
T{ ##peek f V int-regs 0 D 0 }
T{ ##replace f V int-regs 1 D 2 }
T{ ##replace f V int-regs 0 D 2 }
T{ ##branch }
} 3 test-bb
V{
T{ ##replace f V int-regs 3 R 2 }
T{ ##return }
} 4 test-bb
test-diamond
{ 1 2 } test-linear-scan-on-cfg
[ _spill ] [ 2 get instructions>> first class ] unit-test
[ _spill ] [ 3 get instructions>> second class ] unit-test
[ _reload ] [ 4 get instructions>> first class ] unit-test

16
basis/compiler/cfg/linear-scan/linear-scan.factor
View File

@ -1,6 +1,6 @@
! Copyright (C) 2008, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel accessors namespaces make
USING: kernel accessors namespaces make locals
cpu.architecture
compiler.cfg
compiler.cfg.rpo
@ -9,7 +9,8 @@ compiler.cfg.linear-scan.numbering
compiler.cfg.linear-scan.live-intervals
compiler.cfg.linear-scan.allocation
compiler.cfg.linear-scan.allocation.state
compiler.cfg.linear-scan.assignment ;
compiler.cfg.linear-scan.assignment
compiler.cfg.linear-scan.resolve ;
IN: compiler.cfg.linear-scan
! References:
@ -26,12 +27,11 @@ IN: compiler.cfg.linear-scan
! by Omri Traub, Glenn Holloway, Michael D. Smith
! http://citeseerx.ist.psu.edu/viewdoc/summary?doi=10.1.1.34.8435
: (linear-scan) ( rpo machine-registers -- )
[
dup number-instructions
dup compute-live-intervals
] dip
allocate-registers assign-registers ;
:: (linear-scan) ( rpo machine-registers -- )
rpo number-instructions
rpo compute-live-intervals machine-registers allocate-registers
rpo assign-registers
rpo resolve-data-flow ;
: linear-scan ( cfg -- cfg' )
[

22
basis/compiler/cfg/linear-scan/live-intervals/live-intervals.factor
View File

@ -144,3 +144,25 @@ M: ##copy-float compute-live-intervals*
live-intervals set
<reversed> [ compute-live-intervals-step ] each
] keep values dup finish-live-intervals ;
: relevant-ranges ( new inactive -- new' inactive' )
! Slice off all ranges of 'inactive' that precede the start of 'new'
[ [ ranges>> ] bi@ ] [ nip start>> ] 2bi '[ to>> _ >= ] filter ;
: intersect-live-range ( range1 range2 -- n/f )
2dup [ from>> ] bi@ > [ swap ] when
2dup [ to>> ] [ from>> ] bi* >= [ nip from>> ] [ 2drop f ] if ;
: intersect-live-ranges ( ranges1 ranges2 -- n )
{
{ [ over empty? ] [ 2drop 1/0. ] }
{ [ dup empty? ] [ 2drop 1/0. ] }
[
2dup [ first ] bi@ intersect-live-range dup [ 2nip ] [
drop
2dup [ first from>> ] bi@ <
[ [ rest-slice ] dip ] [ rest-slice ] if
intersect-live-ranges
] if
]
} cond ;

65
basis/compiler/cfg/linear-scan/resolve/resolve-tests.factor Normal file
View File

@ -0,0 +1,65 @@
USING: accessors arrays compiler.cfg compiler.cfg.instructions
compiler.cfg.linear-scan.debugger
compiler.cfg.linear-scan.live-intervals
compiler.cfg.linear-scan.numbering
compiler.cfg.linear-scan.resolve compiler.cfg.predecessors
compiler.cfg.registers compiler.cfg.rpo cpu.architecture kernel
namespaces tools.test vectors ;
IN: compiler.cfg.linear-scan.resolve.tests
[ { 1 2 3 4 5 6 } ] [
{ 3 4 } V{ 1 2 } clone [ { 5 6 } 3append-here ] keep >array
] unit-test
V{
T{ ##peek f V int-regs 0 D 0 }
T{ ##branch }
} 0 test-bb
V{
T{ ##replace f V int-regs 0 D 1 }
T{ ##return }
} 1 test-bb
1 get 1vector 0 get (>>successors)
cfg new 0 get >>entry
compute-predecessors
dup reverse-post-order number-instructions
drop
CONSTANT: test-live-interval-1
T{ live-interval
{ start 0 }
{ end 6 }
{ uses V{ 0 6 } }
{ ranges V{ T{ live-range f 0 2 } T{ live-range f 4 6 } } }
{ spill-to 0 }
{ vreg V int-regs 0 }
}
[ f ] [
0 get test-live-interval-1 spill-to
] unit-test
[ 0 ] [
1 get test-live-interval-1 spill-to
] unit-test
CONSTANT: test-live-interval-2
T{ live-interval
{ start 0 }
{ end 6 }
{ uses V{ 0 6 } }
{ ranges V{ T{ live-range f 0 2 } T{ live-range f 4 6 } } }
{ reload-from 0 }
{ vreg V int-regs 0 }
}
[ 0 ] [
0 get test-live-interval-2 reload-from
] unit-test
[ f ] [
1 get test-live-interval-2 reload-from
] unit-test

116
basis/compiler/cfg/linear-scan/resolve/resolve.factor
View File

@ -1,34 +1,118 @@
! Copyright (C) 2009 Slava Pestov
! See http://factorcode.org/license.txt for BSD license.
USING: accessors assocs kernel math namespaces sequences
compiler.cfg.linear-scan.live-intervals compiler.cfg.liveness ;
classes.tuple classes.parser parser fry words make arrays
locals combinators compiler.cfg.linear-scan.live-intervals
compiler.cfg.liveness compiler.cfg.instructions ;
IN: compiler.cfg.linear-scan.resolve
: add-mapping ( from to -- )
2drop
;
<<
TUPLE: operation from to reg-class ;
SYNTAX: OPERATION:
CREATE-CLASS dup save-location
[ operation { } define-tuple-class ]
[
[ scan-word scan-word ] keep
'[
[ [ _ execute ] [ _ execute ] bi* ]
[ vreg>> reg-class>> ]
bi _ boa ,
] (( from to -- )) define-declared
] bi ;
>>
: reload-from ( bb live-interval -- n/f )
2dup [ block-from ] [ start>> ] bi* =
[ nip reload-from>> ] [ 2drop f ] if ;
: spill-to ( bb live-interval -- n/f )
2dup [ block-to ] [ end>> ] bi* =
[ nip spill-to>> ] [ 2drop f ] if ;
OPERATION: memory->memory spill-to>> reload-from>>
OPERATION: register->memory reg>> reload-from>>
OPERATION: memory->register spill-to>> reg>>
OPERATION: register->register reg>> reg>>
:: add-mapping ( bb1 bb2 li1 li2 -- )
bb2 li2 reload-from [
bb1 li1 spill-to
[ li1 li2 memory->memory ]
[ li1 li2 register->memory ] if
] [
bb1 li1 spill-to
[ li1 li2 memory->register ]
[ li1 li2 register->register ] if
] if ;
: resolve-value-data-flow ( bb to vreg -- )
[ 2dup ] dip
live-intervals get at
[ [ block-to ] dip child-interval-at ]
[ [ block-from ] dip child-interval-at ]
bi-curry bi* 2dup = [ 2drop ] [
add-mapping
bi-curry bi* 2dup eq? [ 2drop 2drop ] [ add-mapping ] if ;
: compute-mappings ( bb to -- mappings )
[
dup live-in keys
[ resolve-value-data-flow ] with with each
] { } make ;
GENERIC: >insn ( operation -- )
M: memory->memory >insn
[ from>> ] [ to>> ] bi = [ "Not allowed" throw ] unless ;
M: register->memory >insn
[ from>> ] [ reg-class>> ] [ to>> ] tri _spill ;
M: memory->register >insn
[ to>> ] [ reg-class>> ] [ from>> ] tri _reload ;
M: register->register >insn
[ to>> ] [ from>> ] [ reg-class>> ] tri _copy ;
: mapping-instructions ( mappings -- insns )
[ [ >insn ] each ] { } make ;
: fork? ( from to -- ? )
[ successors>> length 1 >= ]
[ predecessors>> length 1 = ] bi* and ; inline
: insert-position/fork ( from to -- before after )
nip instructions>> [ >array ] [ dup delete-all ] bi swap ;
: join? ( from to -- ? )
[ successors>> length 1 = ]
[ predecessors>> length 1 >= ] bi* and ; inline
: insert-position/join ( from to -- before after )
drop instructions>> dup pop 1array ;
: insert-position ( bb to -- before after )
{
{ [ 2dup fork? ] [ insert-position/fork ] }
{ [ 2dup join? ] [ insert-position/join ] }
} cond ;
: 3append-here ( seq2 seq1 seq3 -- )
#! Mutate seq1
swap '[ _ push-all ] bi@ ;
: perform-mappings ( mappings bb to -- )
pick empty? [ 3drop ] [
[ mapping-instructions ] 2dip
insert-position 3append-here
] if ;
: resolve-mappings ( bb to -- )
2drop
;
: resolve-edge-data-flow ( bb to -- )
[ dup live-in [ resolve-value-data-flow ] with with each ]
[ resolve-mappings ]
2bi ;
[ compute-mappings ] [ perform-mappings ] 2bi ;
: resolve-block-data-flow ( bb -- )
dup successors>> [
resolve-edge-data-flow
] with each ;
dup successors>> [ resolve-edge-data-flow ] with each ;
: resolve-data-flow ( rpo -- )
[ resolve-block-data-flow ] each ;

85
basis/compiler/cfg/stack-analysis/merge/merge.factor Normal file
View File

@ -0,0 +1,85 @@
! Copyright (C) 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel assocs sequences accessors fry combinators grouping
sets compiler.cfg compiler.cfg.hats
compiler.cfg.stack-analysis.state ;
IN: compiler.cfg.stack-analysis.merge
: initial-state ( bb states -- state ) 2drop <state> ;
: single-predecessor ( bb states -- state ) nip first clone ;
ERROR: must-equal-failed seq ;
: must-equal ( seq -- elt )
dup all-equal? [ first ] [ must-equal-failed ] if ;
: merge-heights ( state predecessors states -- state )
nip
[ [ ds-height>> ] map must-equal >>ds-height ]
[ [ rs-height>> ] map must-equal >>rs-height ] bi ;
: insert-peek ( predecessor loc -- vreg )
! XXX critical edges
'[ _ ^^peek ] add-instructions ;
: merge-loc ( predecessors locs>vregs loc -- vreg )
! Insert a ##phi in the current block where the input
! is the vreg storing loc from each predecessor block
[ '[ [ _ ] dip at ] map ] keep
'[ [ ] [ _ insert-peek ] ?if ] 2map
dup all-equal? [ first ] [ ^^phi ] if ;
: (merge-locs) ( predecessors assocs -- assoc )
dup [ keys ] map concat prune
[ [ 2nip ] [ merge-loc ] 3bi ] with with
H{ } map>assoc ;
: merge-locs ( state predecessors states -- state )
[ locs>vregs>> ] map (merge-locs) >>locs>vregs ;
: merge-actual-loc ( locs>vregs loc -- vreg )
'[ [ _ ] dip at ] map
dup all-equal? [ first ] [ drop f ] if ;
: merge-actual-locs ( state predecessors states -- state )
nip
[ actual-locs>vregs>> ] map
dup [ keys ] map concat prune
[ [ nip ] [ merge-actual-loc ] 2bi ] with
H{ } map>assoc
[ nip ] assoc-filter
>>actual-locs>vregs ;
: merge-changed-locs ( state predecessors states -- state )
nip [ changed-locs>> ] map assoc-combine >>changed-locs ;
ERROR: cannot-merge-poisoned states ;
: multiple-predecessors ( bb states -- state )
dup [ not ] any? [
[ <state> ] 2dip
sift merge-heights
] [
dup [ poisoned?>> ] any? [
cannot-merge-poisoned
] [
[ state new ] 2dip
[ predecessors>> ] dip
{
[ merge-locs ]
[ merge-actual-locs ]
[ merge-heights ]
[ merge-changed-locs ]
} 2cleave
] if
] if ;
: merge-states ( bb states -- state )
! If any states are poisoned, save all registers
! to the stack in each branch
dup length {
{ 0 [ initial-state ] }
{ 1 [ single-predecessor ] }
[ drop multiple-predecessors ]
} case ;

150
basis/compiler/cfg/stack-analysis/stack-analysis.factor
View File

@ -1,42 +1,19 @@
! Copyright (C) 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors assocs kernel namespaces math sequences fry grouping
sets make combinators compiler.cfg.copy-prop compiler.cfg.def-use
compiler.cfg.instructions compiler.cfg.registers compiler.cfg.rpo
compiler.cfg.hats compiler.cfg ;
sets make combinators
compiler.cfg
compiler.cfg.copy-prop
compiler.cfg.def-use
compiler.cfg.instructions
compiler.cfg.registers
compiler.cfg.rpo
compiler.cfg.hats
compiler.cfg.stack-analysis.state
compiler.cfg.stack-analysis.merge ;
IN: compiler.cfg.stack-analysis
! Convert stack operations to register operations
! If 'poisoned' is set, disregard height information. This is set if we don't have
! height change information for an instruction.
TUPLE: state locs>vregs actual-locs>vregs changed-locs ds-height rs-height poisoned? ;
: <state> ( -- state )
state new
H{ } clone >>locs>vregs
H{ } clone >>actual-locs>vregs
H{ } clone >>changed-locs
0 >>ds-height
0 >>rs-height ;
M: state clone
call-next-method
[ clone ] change-locs>vregs
[ clone ] change-actual-locs>vregs
[ clone ] change-changed-locs ;
: loc>vreg ( loc -- vreg ) state get locs>vregs>> at ;
: record-peek ( dst loc -- )
state get [ locs>vregs>> set-at ] [ actual-locs>vregs>> set-at ] 3bi ;
: changed-loc ( loc -- )
state get changed-locs>> conjoin ;
: record-replace ( src loc -- )
dup changed-loc state get locs>vregs>> set-at ;
GENERIC: height-for ( loc -- n )
M: ds-loc height-for drop state get ds-height>> ;
@ -64,12 +41,6 @@ M: rs-loc untranslate-loc (translate-loc) + <rs-loc> ;
[ 2drop ] [ untranslate-loc ##replace ] if
] assoc-each ;
: clear-state ( state -- )
[ locs>vregs>> clear-assoc ]
[ actual-locs>vregs>> clear-assoc ]
[ changed-locs>> clear-assoc ]
tri ;
ERROR: poisoned-state state ;
: sync-state ( -- )
@ -84,6 +55,14 @@ ERROR: poisoned-state state ;
! Abstract interpretation
GENERIC: visit ( insn -- )
: adjust-ds ( n -- ) state get [ + ] change-ds-height drop ;
M: ##inc-d visit [ , ] [ n>> adjust-ds ] bi ;
: adjust-rs ( n -- ) state get [ + ] change-rs-height drop ;
M: ##inc-r visit [ , ] [ n>> adjust-rs ] bi ;
! Instructions which don't have any effect on the stack
UNION: neutral-insn
##flushable
@ -113,14 +92,6 @@ t local-only? set-global
M: sync-if-back-edge visit
sync-state? [ sync-state ] when , ;
: adjust-d ( n -- ) state get [ + ] change-ds-height drop ;
M: ##inc-d visit [ , ] [ n>> adjust-d ] bi ;
: adjust-r ( n -- ) state get [ + ] change-rs-height drop ;
M: ##inc-r visit [ , ] [ n>> adjust-r ] bi ;
: eliminate-peek ( dst src -- )
! the requested stack location is already in 'src'
[ ##copy ] [ swap copies get set-at ] 2bi ;
@ -138,7 +109,7 @@ M: ##copy visit
[ call-next-method ] [ record-copy ] bi ;
M: ##call visit
[ call-next-method ] [ height>> adjust-d ] bi ;
[ call-next-method ] [ height>> adjust-ds ] bi ;
! Instructions that poison the stack state
UNION: poison-insn
@ -167,7 +138,7 @@ UNION: kill-vreg-insn
M: kill-vreg-insn visit sync-state , ;
: visit-alien-node ( node -- )
params>> [ out-d>> length ] [ in-d>> length ] bi - adjust-d ;
params>> [ out-d>> length ] [ in-d>> length ] bi - adjust-ds ;
M: ##alien-invoke visit
[ call-next-method ] [ visit-alien-node ] bi ;
@ -180,87 +151,6 @@ M: ##alien-callback visit , ;
! Maps basic-blocks to states
SYMBOLS: state-in state-out ;
: initial-state ( bb states -- state ) 2drop <state> ;
: single-predecessor ( bb states -- state ) nip first clone ;
ERROR: must-equal-failed seq ;
: must-equal ( seq -- elt )
dup all-equal? [ first ] [ must-equal-failed ] if ;
: merge-heights ( state predecessors states -- state )
nip
[ [ ds-height>> ] map must-equal >>ds-height ]
[ [ rs-height>> ] map must-equal >>rs-height ] bi ;
: insert-peek ( predecessor loc -- vreg )
! XXX critical edges
'[ _ ^^peek ] add-instructions ;
: merge-loc ( predecessors locs>vregs loc -- vreg )
! Insert a ##phi in the current block where the input
! is the vreg storing loc from each predecessor block
[ '[ [ _ ] dip at ] map ] keep
'[ [ ] [ _ insert-peek ] ?if ] 2map
dup all-equal? [ first ] [ ^^phi ] if ;
: (merge-locs) ( predecessors assocs -- assoc )
dup [ keys ] map concat prune
[ [ 2nip ] [ merge-loc ] 3bi ] with with
H{ } map>assoc ;
: merge-locs ( state predecessors states -- state )
[ locs>vregs>> ] map (merge-locs) >>locs>vregs ;
: merge-loc' ( locs>vregs loc -- vreg )
! Insert a ##phi in the current block where the input
! is the vreg storing loc from each predecessor block
'[ [ _ ] dip at ] map
dup all-equal? [ first ] [ drop f ] if ;
: merge-actual-locs ( state predecessors states -- state )
nip
[ actual-locs>vregs>> ] map
dup [ keys ] map concat prune
[ [ nip ] [ merge-loc' ] 2bi ] with
H{ } map>assoc
[ nip ] assoc-filter
>>actual-locs>vregs ;
: merge-changed-locs ( state predecessors states -- state )
nip [ changed-locs>> ] map assoc-combine >>changed-locs ;
ERROR: cannot-merge-poisoned states ;
: multiple-predecessors ( bb states -- state )
dup [ not ] any? [
[ <state> ] 2dip
sift merge-heights
] [
dup [ poisoned?>> ] any? [
cannot-merge-poisoned
] [
[ state new ] 2dip
[ predecessors>> ] dip
{
[ merge-locs ]
[ merge-actual-locs ]
[ merge-heights ]
[ merge-changed-locs ]
} 2cleave
] if
] if ;
: merge-states ( bb states -- state )
! If any states are poisoned, save all registers
! to the stack in each branch
dup length {
{ 0 [ initial-state ] }
{ 1 [ single-predecessor ] }
[ drop multiple-predecessors ]
} case ;
: block-in-state ( bb -- states )
dup predecessors>> state-out get '[ _ at ] map merge-states ;

43
basis/compiler/cfg/stack-analysis/state/state.factor Normal file
View File

@ -0,0 +1,43 @@
! Copyright (C) 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel accessors namespaces assocs sets math ;
IN: compiler.cfg.stack-analysis.state
TUPLE: state
locs>vregs actual-locs>vregs changed-locs
ds-height rs-height poisoned? ;
: <state> ( -- state )
state new
H{ } clone >>locs>vregs
H{ } clone >>actual-locs>vregs
H{ } clone >>changed-locs
0 >>ds-height
0 >>rs-height ;
M: state clone
call-next-method
[ clone ] change-locs>vregs
[ clone ] change-actual-locs>vregs
[ clone ] change-changed-locs ;
: loc>vreg ( loc -- vreg ) state get locs>vregs>> at ;
: record-peek ( dst loc -- )
state get [ locs>vregs>> set-at ] [ actual-locs>vregs>> set-at ] 3bi ;
: changed-loc ( loc -- )
state get changed-locs>> conjoin ;
: record-replace ( src loc -- )
dup changed-loc state get locs>vregs>> set-at ;
: clear-state ( state -- )
[ locs>vregs>> clear-assoc ]
[ actual-locs>vregs>> clear-assoc ]
[ changed-locs>> clear-assoc ]
tri ;
: adjust-ds ( n -- ) state get [ + ] change-ds-height drop ;
: adjust-rs ( n -- ) state get [ + ] change-rs-height drop ;

3
basis/core-graphics/core-graphics.factor
View File

@ -140,4 +140,5 @@ PRIVATE>
: make-bitmap-image ( dim quot -- image )
'[ <CGBitmapContext> &CGContextRelease @ ] make-memory-bitmap
ARGB >>component-order ; inline
ARGB >>component-order
ubyte-components >>component-type ; inline

2
basis/images/bitmap/loading/loading.factor
View File

@ -370,5 +370,5 @@ M: bitmap-image load-image* ( path bitmap-image -- bitmap )
[ loading-bitmap>bytes >>bitmap ]
[ header>> [ width>> ] [ height>> abs ] bi 2array >>dim ]
[ header>> height>> 0 < not >>upside-down? ]
[ bitmap>component-order >>component-order ]
[ bitmap>component-order >>component-order ubyte-components >>component-type ]
} cleave ;

4
basis/images/images-tests.factor
View File

@ -3,7 +3,7 @@
USING: images tools.test kernel accessors ;
IN: images.tests
[ B{ 57 57 57 255 } ] [ 1 1 T{ image f { 2 3 } RGBA f B{
[ B{ 57 57 57 255 } ] [ 1 1 T{ image f { 2 3 } RGBA ubyte-components f B{
0 0 0 0
0 0 0 0
0 0 0 0
@ -19,7 +19,7 @@ IN: images.tests
57 57 57 255
0 0 0 0
0 0 0 0
} ] [ B{ 57 57 57 255 } 1 1 T{ image f { 2 3 } RGBA f B{
} ] [ B{ 57 57 57 255 } 1 1 T{ image f { 2 3 } RGBA ubyte-components f B{
0 0 0 0
0 0 0 0
0 0 0 0

112
basis/images/images.factor
View File

@ -3,13 +3,93 @@
USING: combinators kernel accessors sequences math arrays ;
IN: images
SINGLETONS: L LA BGR RGB BGRA RGBA ABGR ARGB RGBX XRGB BGRX XBGR
R16G16B16 R32G32B32 R16G16B16A16 R32G32B32A32 ;
SINGLETONS:
A L LA BGR RGB BGRA RGBA ABGR ARGB RGBX XRGB BGRX XBGR
INTENSITY DEPTH DEPTH-STENCIL R RG
ubyte-components ushort-components uint-components
half-components float-components
byte-integer-components ubyte-integer-components
short-integer-components ushort-integer-components
int-integer-components uint-integer-components
u-5-5-5-1-components u-5-6-5-components
u-10-10-10-2-components
u-24-components u-24-8-components
float-32-u-8-components
u-9-9-9-e5-components
float-11-11-10-components ;
UNION: alpha-channel BGRA RGBA ABGR ARGB R16G16B16A16 R32G32B32A32 ;
UNION: component-order
A L LA BGR RGB BGRA RGBA ABGR ARGB RGBX XRGB BGRX XBGR
INTENSITY DEPTH DEPTH-STENCIL R RG ;
: bytes-per-pixel ( component-order -- n )
UNION: component-type
ubyte-components ushort-components
half-components float-components
byte-integer-components ubyte-integer-components
short-integer-components ushort-integer-components
int-integer-components uint-integer-components
u-5-5-5-1-components u-5-6-5-components
u-10-10-10-2-components
u-24-components u-24-8-components
float-32-u-8-components
u-9-9-9-e5-components
float-11-11-10-components ;
UNION: unnormalized-integer-components
byte-integer-components ubyte-integer-components
short-integer-components ushort-integer-components
int-integer-components uint-integer-components ;
UNION: packed-components
u-5-5-5-1-components u-5-6-5-components
u-10-10-10-2-components
u-24-components u-24-8-components
float-32-u-8-components
u-9-9-9-e5-components
float-11-11-10-components ;
UNION: alpha-channel BGRA RGBA ABGR ARGB LA A INTENSITY ;
UNION: alpha-channel-precedes-colors ABGR ARGB XBGR XRGB ;
TUPLE: image dim component-order component-type upside-down? bitmap ;
: <image> ( -- image ) image new ; inline
: has-alpha? ( image -- ? ) component-order>> alpha-channel? ;
GENERIC: load-image* ( path class -- image )
: bytes-per-component ( component-type -- n )
{
{ ubyte-components [ 1 ] }
{ ushort-components [ 2 ] }
{ uint-components [ 4 ] }
{ half-components [ 2 ] }
{ float-components [ 4 ] }
{ byte-integer-components [ 1 ] }
{ ubyte-integer-components [ 1 ] }
{ short-integer-components [ 2 ] }
{ ushort-integer-components [ 2 ] }
{ int-integer-components [ 4 ] }
{ uint-integer-components [ 4 ] }
} case ;
: bytes-per-packed-pixel ( component-type -- n )
{
{ u-5-5-5-1-components [ 2 ] }
{ u-5-6-5-components [ 2 ] }
{ u-10-10-10-2-components [ 4 ] }
{ u-24-components [ 4 ] }
{ u-24-8-components [ 4 ] }
{ u-9-9-9-e5-components [ 4 ] }
{ float-11-11-10-components [ 4 ] }
{ float-32-u-8-components [ 8 ] }
} case ;
: component-count ( component-order -- n )
{
{ A [ 1 ] }
{ L [ 1 ] }
{ LA [ 2 ] }
{ BGR [ 3 ] }
@ -22,25 +102,25 @@ UNION: alpha-channel BGRA RGBA ABGR ARGB R16G16B16A16 R32G32B32A32 ;
{ XRGB [ 4 ] }
{ BGRX [ 4 ] }
{ XBGR [ 4 ] }
{ R16G16B16 [ 6 ] }
{ R32G32B32 [ 12 ] }
{ R16G16B16A16 [ 8 ] }
{ R32G32B32A32 [ 16 ] }
{ INTENSITY [ 1 ] }
{ DEPTH [ 1 ] }
{ DEPTH-STENCIL [ 1 ] }
{ R [ 1 ] }
{ RG [ 2 ] }
} case ;
TUPLE: image dim component-order upside-down? bitmap ;
: <image> ( -- image ) image new ; inline
: has-alpha? ( image -- ? ) component-order>> alpha-channel? ;
GENERIC: load-image* ( path class -- image )
: bytes-per-pixel ( image -- n )
dup component-type>> packed-components?
[ component-type>> bytes-per-packed-pixel ] [
[ component-order>> component-count ]
[ component-type>> bytes-per-component ] bi *
] if ;
<PRIVATE
: pixel@ ( x y image -- start end bitmap )
[ dim>> first * + ]
[ component-order>> bytes-per-pixel [ * dup ] keep + ]
[ bytes-per-pixel [ * dup ] keep + ]
[ bitmap>> ] tri ;
: set-subseq ( new-value from to victim -- )

1
basis/images/jpeg/jpeg.factor
View File

@ -298,6 +298,7 @@ MEMO: dct-matrix-blas ( -- m ) dct-matrix >float-blas-matrix ;
: setup-bitmap ( image -- )
dup dim>> 16 v/n [ ceiling ] map 16 v*n >>dim
BGR >>component-order
ubyte-components >>component-type
f >>upside-down?
dup dim>> first2 * 3 * 0 <array> >>bitmap
drop ;

2
basis/images/png/png.factor
View File

@ -85,7 +85,7 @@ ERROR: unimplemented-color-type image ;
[ <image> ] dip {
[ png-image-bytes >>bitmap ]
[ [ width>> ] [ height>> ] bi 2array >>dim ]
[ drop RGB >>component-order ]
[ drop RGB >>component-order ubyte-components >>component-type ]
} cleave ;
: decode-indexed-color ( loading-png -- loading-png )

2
basis/images/processing/processing.factor
View File

@ -17,7 +17,7 @@ IN: images.processing
<image> over matrix-dim >>dim
swap flip flatten
[ 128 * 128 + 0 max 255 min >fixnum ] map
>byte-array >>bitmap L >>component-order ;
>byte-array >>bitmap L >>component-order ubyte-components >>component-type ;
:: matrix-zoom ( m f -- m' )
m matrix-dim f v*n coord-matrix

20
basis/images/tesselation/tesselation-tests.factor
View File

@ -10,12 +10,12 @@ IN: images.tesselation
[
{
{
T{ image f { 2 2 } L f B{ 1 2 5 6 } }
T{ image f { 2 2 } L f B{ 3 4 7 8 } }
T{ image f { 2 2 } L ubyte-components f B{ 1 2 5 6 } }
T{ image f { 2 2 } L ubyte-components f B{ 3 4 7 8 } }
}
{
T{ image f { 2 2 } L f B{ 9 10 13 14 } }
T{ image f { 2 2 } L f B{ 11 12 15 16 } }
T{ image f { 2 2 } L ubyte-components f B{ 9 10 13 14 } }
T{ image f { 2 2 } L ubyte-components f B{ 11 12 15 16 } }
}
}
] [
@ -23,18 +23,19 @@ IN: images.tesselation
1 16 [a,b] >byte-array >>bitmap
{ 4 4 } >>dim
L >>component-order
ubyte-components >>component-type
{ 2 2 } tesselate
] unit-test
[
{
{
T{ image f { 2 2 } L f B{ 1 2 4 5 } }
T{ image f { 1 2 } L f B{ 3 6 } }
T{ image f { 2 2 } L ubyte-components f B{ 1 2 4 5 } }
T{ image f { 1 2 } L ubyte-components f B{ 3 6 } }
}
{
T{ image f { 2 1 } L f B{ 7 8 } }
T{ image f { 1 1 } L f B{ 9 } }
T{ image f { 2 1 } L ubyte-components f B{ 7 8 } }
T{ image f { 1 1 } L ubyte-components f B{ 9 } }
}
}
] [
@ -42,5 +43,6 @@ IN: images.tesselation
1 9 [a,b] >byte-array >>bitmap
{ 3 3 } >>dim
L >>component-order
ubyte-components >>component-type
{ 2 2 } tesselate
] unit-test
] unit-test

6
basis/images/tesselation/tesselation.factor
View File

@ -19,7 +19,7 @@ IN: images.tesselation
'[ _ tesselate-columns ] map ;
: tile-width ( tile-bitmap original-image -- width )
[ first length ] [ component-order>> bytes-per-pixel ] bi* /i ;
[ first length ] [ bytes-per-pixel ] bi* /i ;
: <tile-image> ( tile-bitmap original-image -- tile-image )
clone
@ -28,8 +28,8 @@ IN: images.tesselation
[ [ over tile-width ] [ length ] bi 2array >>dim ] bi ;
:: tesselate ( image tess-dim -- image-grid )
image component-order>> bytes-per-pixel :> bpp
image bytes-per-pixel :> bpp
image dim>> { bpp 1 } v* :> image-dim'
tess-dim { bpp 1 } v* :> tess-dim'
image bitmap>> image-dim' tess-dim' tesselate-bitmap
[ [ image <tile-image> ] map ] map ;
[ [ image <tile-image> ] map ] map ;

18
basis/images/tiff/tiff.factor
View File

@ -484,15 +484,15 @@ ERROR: unknown-component-order ifd ;
[ unknown-component-order ]
} case >>bitmap ;
: ifd-component-order ( ifd -- byte-order )
: ifd-component-order ( ifd -- component-order component-type )
bits-per-sample find-tag {
{ { 32 32 32 32 } [ R32G32B32A32 ] }
{ { 32 32 32 } [ R32G32B32 ] }
{ { 16 16 16 16 } [ R16G16B16A16 ] }
{ { 16 16 16 } [ R16G16B16 ] }
{ { 8 8 8 8 } [ RGBA ] }
{ { 8 8 8 } [ RGB ] }
{ 8 [ LA ] }
{ { 32 32 32 32 } [ RGBA float-components ] }
{ { 32 32 32 } [ RGB float-components ] }
{ { 16 16 16 16 } [ RGBA ushort-components ] }
{ { 16 16 16 } [ RGB ushort-components ] }
{ { 8 8 8 8 } [ RGBA ubyte-components ] }
{ { 8 8 8 } [ RGB ubyte-components ] }
{ 8 [ LA ubyte-components ] }
[ unknown-component-order ]
} case ;
@ -507,7 +507,7 @@ ERROR: unknown-component-order ifd ;
: ifd>image ( ifd -- image )
[ <image> ] dip {
[ [ image-width find-tag ] [ image-length find-tag ] bi 2array >>dim ]
[ ifd-component-order >>component-order ]
[ ifd-component-order [ >>component-order ] [ >>component-type ] bi* ]
[ bitmap>> >>bitmap ]
} cleave ;

10
basis/math/primes/erato/erato-docs.factor
View File

@ -3,10 +3,8 @@ IN: math.primes.erato
HELP: sieve
{ $values { "n" "the greatest odd number to consider" } { "arr" "a bit array" } }
{ $description "Return a bit array containing a primality bit for every odd number between 3 and " { $snippet "n" } " (inclusive). " { $snippet ">index" } " can be used to retrieve the index of an odd number to be tested." } ;
{ $description "Apply Eratostene sieve up to " { $snippet "n" } ". Primality can then be tested using " { $link sieve } "." } ;
HELP: >index
{ $values { "n" "an odd number" } { "i" "the corresponding index" } }
{ $description "Retrieve the index corresponding to the odd number on the stack." } ;
{ sieve >index } related-words
HELP: marked-prime?
{ $values { "n" "an integer" } { "arr" "a byte array returned by " { $link sieve } } { "?" "a boolean" } }
{ $description "Check whether a number between 3 and the limit given to " { $link sieve } " has been marked as a prime number."} ;

11
basis/math/primes/erato/erato-tests.factor
View File

@ -1,3 +1,10 @@
USING: bit-arrays math.primes.erato tools.test ;
USING: byte-arrays math math.bitwise math.primes.erato sequences tools.test ;
[ ?{ t t t f t t f t t f t f f t } ] [ 29 sieve ] unit-test
[ B{ 255 251 247 126 } ] [ 100 sieve ] unit-test
[ 1 100 sieve marked-prime? ] [ bounds-error? ] must-fail-with
[ 120 100 sieve marked-prime? ] [ bounds-error? ] must-fail-with
[ f ] [ 119 100 sieve marked-prime? ] unit-test
[ t ] [ 113 100 sieve marked-prime? ] unit-test
! There are 25997 primes below 300000. 1 must be removed and 3 5 7 added.
[ 25997 ] [ 299999 sieve [ bit-count ] sigma 2 + ] unit-test

46
basis/math/primes/erato/erato.factor
View File

@ -1,25 +1,41 @@
! Copyright (C) 2009 Samuel Tardieu.
! See http://factorcode.org/license.txt for BSD license.
USING: bit-arrays kernel math math.functions math.ranges sequences ;
USING: arrays byte-arrays kernel math math.bitwise math.functions math.order
math.ranges sequences sequences.private ;
IN: math.primes.erato
: >index ( n -- i )
3 - 2 /i ; inline
<PRIVATE
: index> ( i -- n )
2 * 3 + ; inline
CONSTANT: masks B{ 0 128 0 0 0 0 0 64 0 0 0 32 0 16 0 0 0 8 0 4 0 0 0 2 0 0 0 0 0 1 }
: mark-multiples ( i arr -- )
[ index> [ sq >index ] keep ] dip
[ length 1 - swap <range> f swap ] keep
[ set-nth ] curry with each ;
: bit-pos ( n -- byte/f mask/f )
30 /mod masks nth-unsafe dup zero? [ 2drop f f ] when ;
: maybe-mark-multiples ( i arr -- )
2dup nth [ mark-multiples ] [ 2drop ] if ;
: marked-unsafe? ( n arr -- ? )
[ bit-pos ] dip swap [ [ nth-unsafe ] [ bitand zero? not ] bi* ] [ 2drop f ] if* ;
: init-sieve ( n -- arr )
>index 1 + <bit-array> dup set-bits ;
: unmark ( n arr -- )
[ bit-pos swap ] dip
over [ [ swap unmask ] change-nth-unsafe ] [ 3drop ] if ;
: upper-bound ( arr -- n ) length 30 * 1 - ;
: unmark-multiples ( i arr -- )
2dup marked-unsafe? [
[ [ dup sq ] [ upper-bound ] bi* rot <range> ] keep
[ unmark ] curry each
] [
2drop
] if ;
: init-sieve ( n -- arr ) 29 + 30 /i 255 <array> >byte-array ;
PRIVATE>
: sieve ( n -- arr )
[ init-sieve ] [ sqrt >index [0,b] ] bi
over [ maybe-mark-multiples ] curry each ; foldable
init-sieve [ 2 swap upper-bound sqrt [a,b] ] keep
[ [ unmark-multiples ] curry each ] keep ;
: marked-prime? ( n arr -- ? )
2dup upper-bound 2 swap between? [ bounds-error ] unless
over { 2 3 5 } member? [ 2drop t ] [ marked-unsafe? ] if ;

12
basis/math/primes/primes-tests.factor
View File

@ -1,5 +1,5 @@
USING: arrays math math.primes math.primes.miller-rabin
tools.test ;
USING: arrays kernel math math.primes math.primes.miller-rabin
sequences tools.test ;
IN: math.primes.tests
{ 1237 } [ 1234 next-prime ] unit-test
@ -10,6 +10,9 @@ IN: math.primes.tests
{ { 4999963 4999999 5000011 5000077 5000081 } }
[ 4999962 5000082 primes-between >array ] unit-test
{ { 8999981 8999993 9000011 9000041 } }
[ 8999980 9000045 primes-between >array ] unit-test
[ 2 ] [ 1 next-prime ] unit-test
[ 3 ] [ 2 next-prime ] unit-test
[ 5 ] [ 3 next-prime ] unit-test
@ -18,3 +21,8 @@ IN: math.primes.tests
[ 100000000000031 ] [ 100000000000000 next-prime ] unit-test
[ 49 ] [ 50 random-prime log2 ] unit-test
[ t ] [ 5000077 dup find-relative-prime coprime? ] unit-test
[ 5 t { 14 14 14 14 14 } ]
[ 5 15 unique-primes [ length ] [ [ prime? ] all? ] [ [ log2 ] map ] tri ] unit-test

46
basis/math/primes/primes.factor
View File

@ -1,37 +1,55 @@
! Copyright (C) 2007-2009 Samuel Tardieu.
! See http://factorcode.org/license.txt for BSD license.
USING: combinators kernel math math.bitwise math.functions
math.order math.primes.erato math.primes.miller-rabin
math.ranges random sequences sets fry ;
USING: combinators combinators.short-circuit fry kernel math
math.bitwise math.functions math.order math.primes.erato
math.primes.erato.private math.primes.miller-rabin math.ranges
literals random sequences sets vectors ;
IN: math.primes
<PRIVATE
: look-in-bitmap ( n -- ? ) >index 4999999 sieve nth ;
: look-in-bitmap ( n -- ? ) $[ 8999999 sieve ] marked-unsafe? ; inline
: really-prime? ( n -- ? )
dup 5000000 < [ look-in-bitmap ] [ miller-rabin ] if ; foldable
: (prime?) ( n -- ? )
dup 8999999 <= [ look-in-bitmap ] [ miller-rabin ] if ;
! In order not to reallocate large vectors, we compute the upper bound
! of the number of primes in a given interval. We use a double inequality given
! by Pierre Dusart in http://www.ams.org/mathscinet-getitem?mr=99d:11133
! for x > 598. Under this limit, we know that there are at most 108 primes.
: upper-pi ( x -- y )
dup log [ / ] [ 1.2762 swap / 1 + ] bi * ceiling ;
: lower-pi ( x -- y )
dup log [ / ] [ 0.992 swap / 1 + ] bi * floor ;
: <primes-vector> ( low high -- vector )
swap [ [ upper-pi ] [ lower-pi ] bi* - >integer
108 max 10000 min <vector> ] keep
3 < [ [ 2 swap push ] keep ] when ;
: simple? ( n -- ? ) { [ even? ] [ 3 mod 0 = ] [ 5 mod 0 = ] } 1|| ;
PRIVATE>
: prime? ( n -- ? )
{
{ [ dup 2 < ] [ drop f ] }
{ [ dup even? ] [ 2 = ] }
[ really-prime? ]
{ [ dup 7 < ] [ { 2 3 5 } member? ] }
{ [ dup simple? ] [ drop f ] }
[ (prime?) ]
} cond ; foldable
: next-prime ( n -- p )
dup 2 < [
drop 2
] [
next-odd [ dup really-prime? ] [ 2 + ] until
next-odd [ dup prime? ] [ 2 + ] until
] if ; foldable
: primes-between ( low high -- seq )
[ dup 3 max dup even? [ 1 + ] when ] dip
2 <range> [ prime? ] filter
swap 3 < [ 2 prefix ] when ;
[ [ 3 max dup even? [ 1 + ] when ] dip 2 <range> ]
[ <primes-vector> ] 2bi
[ '[ [ prime? ] _ push-if ] each ] keep clone ;
: primes-upto ( n -- seq ) 2 swap primes-between ;
@ -65,5 +83,5 @@ ERROR: too-few-primes n numbits ;
: unique-primes ( n numbits -- seq )
2dup 2^ estimated-primes > [ too-few-primes ] when
2dup '[ _ random-prime ] replicate
2dup [ random-prime ] curry replicate
dup all-unique? [ 2nip ] [ drop unique-primes ] if ;

16
basis/opengl/framebuffers/framebuffers-docs.factor
View File

@ -4,32 +4,32 @@ IN: opengl.framebuffers
HELP: gen-framebuffer
{ $values { "id" integer } }
{ $description "Wrapper for " { $link glGenFramebuffersEXT } " to handle the common case of generating a single framebuffer ID." } ;
{ $description "Wrapper for " { $link glGenFramebuffers } " to handle the common case of generating a single framebuffer ID." } ;
HELP: gen-renderbuffer
{ $values { "id" integer } }
{ $description "Wrapper for " { $link glGenRenderbuffersEXT } " to handle the common case of generating a single render buffer ID." } ;
{ $description "Wrapper for " { $link glGenRenderbuffers } " to handle the common case of generating a single render buffer ID." } ;
HELP: delete-framebuffer
{ $values { "id" integer } }
{ $description "Wrapper for " { $link glDeleteFramebuffersEXT } " to handle the common case of deleting a single framebuffer ID." } ;
{ $description "Wrapper for " { $link glDeleteFramebuffers } " to handle the common case of deleting a single framebuffer ID." } ;
HELP: delete-renderbuffer
{ $values { "id" integer } }
{ $description "Wrapper for " { $link glDeleteRenderbuffersEXT } " to handle the common case of deleting a single render buffer ID." } ;
{ $description "Wrapper for " { $link glDeleteRenderbuffers } " to handle the common case of deleting a single render buffer ID." } ;
{ gen-framebuffer delete-framebuffer } related-words
{ gen-renderbuffer delete-renderbuffer } related-words
HELP: framebuffer-incomplete?
{ $values { "status/f" "The framebuffer error code, or " { $snippet "f" } " if the framebuffer is render-complete." } }
{ $description "Checks the framebuffer currently bound by " { $link glBindFramebufferEXT } " or " { $link with-framebuffer } " to see if it is incomplete, i.e., it is not ready to be rendered to." } ;
{ $description "Checks the framebuffer currently bound by " { $link glBindFramebuffer } " or " { $link with-framebuffer } " to see if it is incomplete, i.e., it is not ready to be rendered to." } ;
HELP: check-framebuffer
{ $description "Checks the framebuffer currently bound by " { $link glBindFramebufferEXT } " or " { $link with-framebuffer } " with " { $link framebuffer-incomplete? } ", and throws a descriptive error if the framebuffer is incomplete." } ;
{ $description "Checks the framebuffer currently bound by " { $link glBindFramebuffer } " or " { $link with-framebuffer } " with " { $link framebuffer-incomplete? } ", and throws a descriptive error if the framebuffer is incomplete." } ;
HELP: with-framebuffer
{ $values { "id" "The id of a framebuffer object." } { "quot" "a quotation" } }
{ $description "Binds framebuffer " { $snippet "id" } " in the dynamic extent of " { $snippet "quot" } ", restoring the window framebuffer when finished." } ;
{ $description "Binds framebuffer " { $snippet "id" } " for drawing in the dynamic extent of " { $snippet "quot" } ", restoring the window framebuffer when finished." } ;
ABOUT: "gl-utilities"
ABOUT: "gl-utilities"

42
basis/opengl/framebuffers/framebuffers.factor
View File

@ -5,30 +5,30 @@ alien.c-types ;
IN: opengl.framebuffers
: gen-framebuffer ( -- id )
[ glGenFramebuffersEXT ] (gen-gl-object) ;
[ glGenFramebuffers ] (gen-gl-object) ;
: gen-renderbuffer ( -- id )
[ glGenRenderbuffersEXT ] (gen-gl-object) ;
[ glGenRenderbuffers ] (gen-gl-object) ;
: delete-framebuffer ( id -- )
[ glDeleteFramebuffersEXT ] (delete-gl-object) ;
[ glDeleteFramebuffers ] (delete-gl-object) ;
: delete-renderbuffer ( id -- )
[ glDeleteRenderbuffersEXT ] (delete-gl-object) ;
[ glDeleteRenderbuffers ] (delete-gl-object) ;
: framebuffer-incomplete? ( -- status/f )
GL_FRAMEBUFFER_EXT glCheckFramebufferStatusEXT
dup GL_FRAMEBUFFER_COMPLETE_EXT = f rot ? ;
GL_DRAW_FRAMEBUFFER glCheckFramebufferStatus
dup GL_FRAMEBUFFER_COMPLETE = f rot ? ;
: framebuffer-error ( status -- * )
{
{ GL_FRAMEBUFFER_COMPLETE_EXT [ "framebuffer complete" ] }
{ GL_FRAMEBUFFER_UNSUPPORTED_EXT [ "framebuffer configuration unsupported" ] }
{ GL_FRAMEBUFFER_INCOMPLETE_ATTACHMENT_EXT [ "framebuffer incomplete (incomplete attachment)" ] }
{ GL_FRAMEBUFFER_INCOMPLETE_MISSING_ATTACHMENT_EXT [ "framebuffer incomplete (missing attachment)" ] }
{ GL_FRAMEBUFFER_COMPLETE [ "framebuffer complete" ] }
{ GL_FRAMEBUFFER_UNSUPPORTED [ "framebuffer configuration unsupported" ] }
{ GL_FRAMEBUFFER_INCOMPLETE_ATTACHMENT [ "framebuffer incomplete (incomplete attachment)" ] }
{ GL_FRAMEBUFFER_INCOMPLETE_MISSING_ATTACHMENT [ "framebuffer incomplete (missing attachment)" ] }
{ GL_FRAMEBUFFER_INCOMPLETE_DIMENSIONS_EXT [ "framebuffer incomplete (dimension mismatch)" ] }
{ GL_FRAMEBUFFER_INCOMPLETE_FORMATS_EXT [ "framebuffer incomplete (format mismatch)" ] }
{ GL_FRAMEBUFFER_INCOMPLETE_DRAW_BUFFER_EXT [ "framebuffer incomplete (draw buffer(s) have no attachment)" ] }
{ GL_FRAMEBUFFER_INCOMPLETE_READ_BUFFER_EXT [ "framebuffer incomplete (read buffer has no attachment)" ] }
{ GL_FRAMEBUFFER_INCOMPLETE_MULTISAMPLE_EXT [ "framebuffer incomplete (multisample counts don't match)" ] }
{ GL_FRAMEBUFFER_INCOMPLETE_DRAW_BUFFER [ "framebuffer incomplete (draw buffer(s) have no attachment)" ] }
{ GL_FRAMEBUFFER_INCOMPLETE_READ_BUFFER [ "framebuffer incomplete (read buffer has no attachment)" ] }
{ GL_FRAMEBUFFER_INCOMPLETE_MULTISAMPLE [ "framebuffer incomplete (multisample counts don't match)" ] }
[ drop gl-error "unknown framebuffer error" ]
} case throw ;
@ -36,19 +36,19 @@ IN: opengl.framebuffers
framebuffer-incomplete? [ framebuffer-error ] when* ;
: with-framebuffer ( id quot -- )
[ GL_FRAMEBUFFER_EXT swap glBindFramebufferEXT ] dip
[ GL_FRAMEBUFFER_EXT 0 glBindFramebufferEXT ] [ ] cleanup ; inline
[ GL_DRAW_FRAMEBUFFER swap glBindFramebuffer ] dip
[ GL_DRAW_FRAMEBUFFER 0 glBindFramebuffer ] [ ] cleanup ; inline
: with-draw-read-framebuffers ( draw-id read-id quot -- )
[
[ GL_DRAW_FRAMEBUFFER_EXT swap glBindFramebufferEXT ]
[ GL_READ_FRAMEBUFFER_EXT swap glBindFramebufferEXT ] bi*
[ GL_DRAW_FRAMEBUFFER swap glBindFramebuffer ]
[ GL_READ_FRAMEBUFFER swap glBindFramebuffer ] bi*
] dip
[
GL_DRAW_FRAMEBUFFER_EXT 0 glBindFramebufferEXT
GL_READ_FRAMEBUFFER_EXT 0 glBindFramebufferEXT
GL_DRAW_FRAMEBUFFER 0 glBindFramebuffer
GL_READ_FRAMEBUFFER 0 glBindFramebuffer
] [ ] cleanup ; inline
: framebuffer-attachment ( attachment -- id )
GL_FRAMEBUFFER_EXT swap GL_FRAMEBUFFER_ATTACHMENT_OBJECT_NAME_EXT
0 <uint> [ glGetFramebufferAttachmentParameterivEXT ] keep *uint ;
GL_FRAMEBUFFER swap GL_FRAMEBUFFER_ATTACHMENT_OBJECT_NAME
0 <uint> [ glGetFramebufferAttachmentParameteriv ] keep *uint ;

721
basis/opengl/gl/gl.factor
View File

@ -322,7 +322,7 @@ CONSTANT: GL_DECR HEX: 1E03
CONSTANT: GL_NONE HEX: 0
CONSTANT: GL_LEFT HEX: 0406
CONSTANT: GL_RIGHT HEX: 0407
CONSTANT: GL_FRONT_LEFT HEX: 0400
CONSTANT: GL_FRONT_RIGHT HEX: 0401
CONSTANT: GL_BACK_LEFT HEX: 0402
CONSTANT: GL_BACK_RIGHT HEX: 0403
@ -356,10 +356,6 @@ CONSTANT: GL_DITHER HEX: 0BD0
CONSTANT: GL_RGB HEX: 1907
CONSTANT: GL_RGBA HEX: 1908
! GL_BGRA_ext: http://www.opengl.org/registry/specs/EXT/bgra.txt
CONSTANT: GL_BGR_EXT HEX: 80E0
CONSTANT: GL_BGRA_EXT HEX: 80E1
! Implementation limits
CONSTANT: GL_MAX_LIST_NESTING HEX: 0B31
CONSTANT: GL_MAX_ATTRIB_STACK_DEPTH HEX: 0D35
@ -1171,6 +1167,22 @@ GL-FUNCTION: void glTexImage3D { glTexImage3DEXT } ( GLenum target, GLint level,
GL-FUNCTION: void glTexSubImage3D { glTexSubImage3DEXT } ( GLenum target, GLint level, GLint xoffset, GLint yoffset, GLint zoffset, GLsizei width, GLsizei height, GLsizei depth, GLenum format, GLenum type, GLvoid* pixels ) ;
! GL_ARB_imaging
CONSTANT: GL_CONSTANT_COLOR HEX: 8001
CONSTANT: GL_ONE_MINUS_CONSTANT_COLOR HEX: 8002
CONSTANT: GL_CONSTANT_ALPHA HEX: 8003
CONSTANT: GL_ONE_MINUS_CONSTANT_ALPHA HEX: 8004
CONSTANT: GL_BLEND_COLOR HEX: 8005
CONSTANT: GL_FUNC_ADD HEX: 8006
CONSTANT: GL_MIN HEX: 8007
CONSTANT: GL_MAX HEX: 8008
CONSTANT: GL_BLEND_EQUATION HEX: 8009
CONSTANT: GL_FUNC_SUBTRACT HEX: 800A
CONSTANT: GL_FUNC_REVERSE_SUBTRACT HEX: 800B
! OpenGL 1.3
@ -1374,6 +1386,8 @@ GL-FUNCTION: void glMultiDrawArrays { glMultiDrawArraysEXT } ( GLenum mode, GLin
GL-FUNCTION: void glMultiDrawElements { glMultiDrawElementsEXT } ( GLenum mode, GLsizei* count, GLenum type, GLvoid** indices, GLsizei primcount ) ;
GL-FUNCTION: void glPointParameterf { glPointParameterfARB } ( GLenum pname, GLfloat param ) ;
GL-FUNCTION: void glPointParameterfv { glPointParameterfvARB } ( GLenum pname, GLfloat* params ) ;
GL-FUNCTION: void glPointParameteri { glPointParameteriARB } ( GLenum pname, GLint param ) ;
GL-FUNCTION: void glPointParameteriv { glPointParameterivARB } ( GLenum pname, GLint* params ) ;
GL-FUNCTION: void glSecondaryColor3b { glSecondaryColor3bEXT } ( GLbyte red, GLbyte green, GLbyte blue ) ;
GL-FUNCTION: void glSecondaryColor3bv { glSecondaryColor3bvEXT } ( GLbyte* v ) ;
GL-FUNCTION: void glSecondaryColor3d { glSecondaryColor3dEXT } ( GLdouble red, GLdouble green, GLdouble blue ) ;
@ -1571,7 +1585,6 @@ CONSTANT: GL_UPPER_LEFT HEX: 8CA2
CONSTANT: GL_STENCIL_BACK_REF HEX: 8CA3
CONSTANT: GL_STENCIL_BACK_VALUE_MASK HEX: 8CA4
CONSTANT: GL_STENCIL_BACK_WRITEMASK HEX: 8CA5
CONSTANT: GL_BLEND_EQUATION HEX: 8009
ALIAS: GL_BLEND_EQUATION_RGB GL_BLEND_EQUATION
TYPEDEF: char GLchar
@ -1691,6 +1704,12 @@ CONSTANT: GL_COMPRESSED_SRGB HEX: 8C48
CONSTANT: GL_COMPRESSED_SRGB_ALPHA HEX: 8C49
CONSTANT: GL_COMPRESSED_SLUMINANCE HEX: 8C4A
CONSTANT: GL_COMPRESSED_SLUMINANCE_ALPHA HEX: 8C4B
CONSTANT: GL_FLOAT_MAT2x3 HEX: 8B65
CONSTANT: GL_FLOAT_MAT2x4 HEX: 8B66
CONSTANT: GL_FLOAT_MAT3x2 HEX: 8B67
CONSTANT: GL_FLOAT_MAT3x4 HEX: 8B68
CONSTANT: GL_FLOAT_MAT4x2 HEX: 8B69
CONSTANT: GL_FLOAT_MAT4x3 HEX: 8B6A
GL-FUNCTION: void glUniformMatrix2x3fv { } ( GLint location, GLsizei count, GLboolean transpose, GLfloat* value ) ;
GL-FUNCTION: void glUniformMatrix2x4fv { } ( GLint location, GLsizei count, GLboolean transpose, GLfloat* value ) ;
@ -1700,208 +1719,452 @@ GL-FUNCTION: void glUniformMatrix4x2fv { } ( GLint location, GLsizei count, GLbo
GL-FUNCTION: void glUniformMatrix4x3fv { } ( GLint location, GLsizei count, GLboolean transpose, GLfloat* value ) ;
! GL_EXT_framebuffer_object
! OpenGL 3.0
CONSTANT: GL_INVALID_FRAMEBUFFER_OPERATION_EXT HEX: 0506
CONSTANT: GL_MAX_RENDERBUFFER_SIZE_EXT HEX: 84E8
CONSTANT: GL_FRAMEBUFFER_BINDING_EXT HEX: 8CA6
CONSTANT: GL_RENDERBUFFER_BINDING_EXT HEX: 8CA7
CONSTANT: GL_FRAMEBUFFER_ATTACHMENT_OBJECT_TYPE_EXT HEX: 8CD0
CONSTANT: GL_FRAMEBUFFER_ATTACHMENT_OBJECT_NAME_EXT HEX: 8CD1
CONSTANT: GL_FRAMEBUFFER_ATTACHMENT_TEXTURE_LEVEL_EXT HEX: 8CD2
CONSTANT: GL_FRAMEBUFFER_ATTACHMENT_TEXTURE_CUBE_MAP_FACE_EXT HEX: 8CD3
CONSTANT: GL_FRAMEBUFFER_ATTACHMENT_TEXTURE_3D_ZOFFSET_EXT HEX: 8CD4
CONSTANT: GL_FRAMEBUFFER_COMPLETE_EXT HEX: 8CD5
CONSTANT: GL_FRAMEBUFFER_INCOMPLETE_ATTACHMENT_EXT HEX: 8CD6
CONSTANT: GL_FRAMEBUFFER_INCOMPLETE_MISSING_ATTACHMENT_EXT HEX: 8CD7
CONSTANT: GL_FRAMEBUFFER_INCOMPLETE_DIMENSIONS_EXT HEX: 8CD9
CONSTANT: GL_FRAMEBUFFER_INCOMPLETE_FORMATS_EXT HEX: 8CDA
CONSTANT: GL_FRAMEBUFFER_INCOMPLETE_DRAW_BUFFER_EXT HEX: 8CDB
CONSTANT: GL_FRAMEBUFFER_INCOMPLETE_READ_BUFFER_EXT HEX: 8CDC
CONSTANT: GL_FRAMEBUFFER_UNSUPPORTED_EXT HEX: 8CDD
CONSTANT: GL_MAX_COLOR_ATTACHMENTS_EXT HEX: 8CDF
CONSTANT: GL_COLOR_ATTACHMENT0_EXT HEX: 8CE0
CONSTANT: GL_COLOR_ATTACHMENT1_EXT HEX: 8CE1
CONSTANT: GL_COLOR_ATTACHMENT2_EXT HEX: 8CE2
CONSTANT: GL_COLOR_ATTACHMENT3_EXT HEX: 8CE3
CONSTANT: GL_COLOR_ATTACHMENT4_EXT HEX: 8CE4
CONSTANT: GL_COLOR_ATTACHMENT5_EXT HEX: 8CE5
CONSTANT: GL_COLOR_ATTACHMENT6_EXT HEX: 8CE6
CONSTANT: GL_COLOR_ATTACHMENT7_EXT HEX: 8CE7
CONSTANT: GL_COLOR_ATTACHMENT8_EXT HEX: 8CE8
CONSTANT: GL_COLOR_ATTACHMENT9_EXT HEX: 8CE9
CONSTANT: GL_COLOR_ATTACHMENT10_EXT HEX: 8CEA
CONSTANT: GL_COLOR_ATTACHMENT11_EXT HEX: 8CEB
CONSTANT: GL_COLOR_ATTACHMENT12_EXT HEX: 8CEC
CONSTANT: GL_COLOR_ATTACHMENT13_EXT HEX: 8CED
CONSTANT: GL_COLOR_ATTACHMENT14_EXT HEX: 8CEE
CONSTANT: GL_COLOR_ATTACHMENT15_EXT HEX: 8CEF
CONSTANT: GL_DEPTH_ATTACHMENT_EXT HEX: 8D00
CONSTANT: GL_STENCIL_ATTACHMENT_EXT HEX: 8D20
CONSTANT: GL_FRAMEBUFFER_EXT HEX: 8D40
CONSTANT: GL_RENDERBUFFER_EXT HEX: 8D41
CONSTANT: GL_RENDERBUFFER_WIDTH_EXT HEX: 8D42
CONSTANT: GL_RENDERBUFFER_HEIGHT_EXT HEX: 8D43
CONSTANT: GL_RENDERBUFFER_INTERNAL_FORMAT_EXT HEX: 8D44
CONSTANT: GL_STENCIL_INDEX1_EXT HEX: 8D46
CONSTANT: GL_STENCIL_INDEX4_EXT HEX: 8D47
CONSTANT: GL_STENCIL_INDEX8_EXT HEX: 8D48
CONSTANT: GL_STENCIL_INDEX16_EXT HEX: 8D49
CONSTANT: GL_RENDERBUFFER_RED_SIZE_EXT HEX: 8D50
CONSTANT: GL_RENDERBUFFER_GREEN_SIZE_EXT HEX: 8D51
CONSTANT: GL_RENDERBUFFER_BLUE_SIZE_EXT HEX: 8D52
CONSTANT: GL_RENDERBUFFER_ALPHA_SIZE_EXT HEX: 8D53
CONSTANT: GL_RENDERBUFFER_DEPTH_SIZE_EXT HEX: 8D54
CONSTANT: GL_RENDERBUFFER_STENCIL_SIZE_EXT HEX: 8D55
TYPEDEF: ushort GLhalf
GL-FUNCTION: void glBindFramebufferEXT { } ( GLenum target, GLuint framebuffer ) ;
GL-FUNCTION: void glBindRenderbufferEXT { } ( GLenum target, GLuint renderbuffer ) ;
GL-FUNCTION: GLenum glCheckFramebufferStatusEXT { } ( GLenum target ) ;
GL-FUNCTION: void glDeleteFramebuffersEXT { } ( GLsizei n, GLuint* framebuffers ) ;
GL-FUNCTION: void glDeleteRenderbuffersEXT { } ( GLsizei n, GLuint* renderbuffers ) ;
GL-FUNCTION: void glFramebufferRenderbufferEXT { } ( GLenum target, GLenum attachment, GLenum renderbuffertarget, GLuint renderbuffer ) ;
GL-FUNCTION: void glFramebufferTexture1DEXT { } ( GLenum target, GLenum attachment, GLenum textarget, GLuint texture, GLint level ) ;
GL-FUNCTION: void glFramebufferTexture2DEXT { } ( GLenum target, GLenum attachment, GLenum textarget, GLuint texture, GLint level ) ;
GL-FUNCTION: void glFramebufferTexture3DEXT { } ( GLenum target, GLenum attachment, GLenum textarget, GLuint texture, GLint level, GLint zoffset ) ;
GL-FUNCTION: void glGenFramebuffersEXT { } ( GLsizei n, GLuint* framebuffers ) ;
GL-FUNCTION: void glGenRenderbuffersEXT { } ( GLsizei n, GLuint* renderbuffers ) ;
GL-FUNCTION: void glGenerateMipmapEXT { } ( GLenum target ) ;
GL-FUNCTION: void glGetFramebufferAttachmentParameterivEXT { } ( GLenum target, GLenum attachment, GLenum pname, GLint* params ) ;
GL-FUNCTION: void glGetRenderbufferParameterivEXT { } ( GLenum target, GLenum pname, GLint* params ) ;
GL-FUNCTION: GLboolean glIsFramebufferEXT { } ( GLuint framebuffer ) ;
GL-FUNCTION: GLboolean glIsRenderbufferEXT { } ( GLuint renderbuffer ) ;
GL-FUNCTION: void glRenderbufferStorageEXT { } ( GLenum target, GLenum internalformat, GLsizei width, GLsizei height ) ;
CONSTANT: GL_VERTEX_ATTRIB_ARRAY_INTEGER HEX: 88FD
CONSTANT: GL_SAMPLER_CUBE_SHADOW HEX: 8DC5
CONSTANT: GL_UNSIGNED_INT_VEC2 HEX: 8DC6
CONSTANT: GL_UNSIGNED_INT_VEC3 HEX: 8DC7
CONSTANT: GL_UNSIGNED_INT_VEC4 HEX: 8DC8
CONSTANT: GL_INT_SAMPLER_1D HEX: 8DC9
CONSTANT: GL_INT_SAMPLER_2D HEX: 8DCA
CONSTANT: GL_INT_SAMPLER_3D HEX: 8DCB
CONSTANT: GL_INT_SAMPLER_CUBE HEX: 8DCC
CONSTANT: GL_INT_SAMPLER_2D_RECT HEX: 8DCD
CONSTANT: GL_INT_SAMPLER_1D_ARRAY HEX: 8DCE
CONSTANT: GL_INT_SAMPLER_2D_ARRAY HEX: 8DCF
CONSTANT: GL_UNSIGNED_INT_SAMPLER_1D HEX: 8DD1
CONSTANT: GL_UNSIGNED_INT_SAMPLER_2D HEX: 8DD2
CONSTANT: GL_UNSIGNED_INT_SAMPLER_3D HEX: 8DD3
CONSTANT: GL_UNSIGNED_INT_SAMPLER_CUBE HEX: 8DD4
CONSTANT: GL_UNSIGNED_INT_SAMPLER_2D_RECT HEX: 8DD5
CONSTANT: GL_UNSIGNED_INT_SAMPLER_1D_ARRAY HEX: 8DD6
CONSTANT: GL_UNSIGNED_INT_SAMPLER_2D_ARRAY HEX: 8DD7
CONSTANT: GL_MIN_PROGRAM_TEXEL_OFFSET HEX: 8904
CONSTANT: GL_MAX_PROGRAM_TEXEL_OFFSET HEX: 8905
CONSTANT: GL_RGBA32F HEX: 8814
CONSTANT: GL_RGB32F HEX: 8815
CONSTANT: GL_RGBA16F HEX: 881A
CONSTANT: GL_RGB16F HEX: 881B
CONSTANT: GL_TEXTURE_RED_TYPE HEX: 8C10
CONSTANT: GL_TEXTURE_GREEN_TYPE HEX: 8C11
CONSTANT: GL_TEXTURE_BLUE_TYPE HEX: 8C12
CONSTANT: GL_TEXTURE_ALPHA_TYPE HEX: 8C13
CONSTANT: GL_TEXTURE_DEPTH_TYPE HEX: 8C16
CONSTANT: GL_UNSIGNED_NORMALIZED HEX: 8C17
! GL_EXT_framebuffer_blit
CONSTANT: GL_QUERY_WAIT HEX: 8E13
CONSTANT: GL_QUERY_NO_WAIT HEX: 8E14
CONSTANT: GL_QUERY_BY_REGION_WAIT HEX: 8E15
CONSTANT: GL_QUERY_BY_REGION_NO_WAIT HEX: 8E16
CONSTANT: GL_HALF_FLOAT HEX: 140B
GL-FUNCTION: void glBlitFramebufferEXT { } ( GLint srcX0, GLint srcY0, GLint srcX1, GLint srcY1,
CONSTANT: GL_MAP_READ_BIT HEX: 0001
CONSTANT: GL_MAP_WRITE_BIT HEX: 0002
CONSTANT: GL_MAP_INVALIDATE_RANGE_BIT HEX: 0004
CONSTANT: GL_MAP_INVALIDATE_BUFFER_BIT HEX: 0008
CONSTANT: GL_MAP_FLUSH_EXPLICIT_BIT HEX: 0010
CONSTANT: GL_MAP_UNSYNCHRONIZED_BIT HEX: 0020
CONSTANT: GL_R8 HEX: 8229
CONSTANT: GL_R16 HEX: 822A
CONSTANT: GL_RG8 HEX: 822B
CONSTANT: GL_RG16 HEX: 822C
CONSTANT: GL_R16F HEX: 822D
CONSTANT: GL_R32F HEX: 822E
CONSTANT: GL_RG16F HEX: 822F
CONSTANT: GL_RG32F HEX: 8230
CONSTANT: GL_R8I HEX: 8231
CONSTANT: GL_R8UI HEX: 8232
CONSTANT: GL_R16I HEX: 8233
CONSTANT: GL_R16UI HEX: 8234
CONSTANT: GL_R32I HEX: 8235
CONSTANT: GL_R32UI HEX: 8236
CONSTANT: GL_RG8I HEX: 8237
CONSTANT: GL_RG8UI HEX: 8238
CONSTANT: GL_RG16I HEX: 8239
CONSTANT: GL_RG16UI HEX: 823A
CONSTANT: GL_RG32I HEX: 823B
CONSTANT: GL_RG32UI HEX: 823C
CONSTANT: GL_RG HEX: 8227
CONSTANT: GL_COMPRESSED_RED HEX: 8225
CONSTANT: GL_COMPRESSED_RG HEX: 8226
CONSTANT: GL_RG_INTEGER HEX: 8228
CONSTANT: GL_VERTEX_ARRAY_BINDING HEX: 85B5
CONSTANT: GL_CLAMP_READ_COLOR HEX: 891C
CONSTANT: GL_FIXED_ONLY HEX: 891D
CONSTANT: GL_DEPTH_COMPONENT32F HEX: 8CAC
CONSTANT: GL_DEPTH32F_STENCIL8 HEX: 8CAD
CONSTANT: GL_RGB9_E5 HEX: 8C3D
CONSTANT: GL_UNSIGNED_INT_5_9_9_9_REV HEX: 8C3E
CONSTANT: GL_TEXTURE_SHARED_SIZE HEX: 8C3F
CONSTANT: GL_R11F_G11F_B10F HEX: 8C3A
CONSTANT: GL_UNSIGNED_INT_10F_11F_11F_REV HEX: 8C3B
CONSTANT: GL_INVALID_FRAMEBUFFER_OPERATION HEX: 0506
CONSTANT: GL_MAX_RENDERBUFFER_SIZE HEX: 84E8
CONSTANT: GL_FRAMEBUFFER_BINDING HEX: 8CA6
CONSTANT: GL_RENDERBUFFER_BINDING HEX: 8CA7
CONSTANT: GL_FRAMEBUFFER_ATTACHMENT_OBJECT_TYPE HEX: 8CD0
CONSTANT: GL_FRAMEBUFFER_ATTACHMENT_OBJECT_NAME HEX: 8CD1
CONSTANT: GL_FRAMEBUFFER_ATTACHMENT_TEXTURE_LEVEL HEX: 8CD2
CONSTANT: GL_FRAMEBUFFER_ATTACHMENT_TEXTURE_CUBE_MAP_FACE HEX: 8CD3
CONSTANT: GL_FRAMEBUFFER_ATTACHMENT_COLOR_ENCODING HEX: 8210
CONSTANT: GL_FRAMEBUFFER_ATTACHMENT_COMPONENT_TYPE HEX: 8211
CONSTANT: GL_FRAMEBUFFER_ATTACHMENT_RED_SIZE HEX: 8212
CONSTANT: GL_FRAMEBUFFER_ATTACHMENT_GREEN_SIZE HEX: 8213
CONSTANT: GL_FRAMEBUFFER_ATTACHMENT_BLUE_SIZE HEX: 8214
CONSTANT: GL_FRAMEBUFFER_ATTACHMENT_ALPHA_SIZE HEX: 8215
CONSTANT: GL_FRAMEBUFFER_ATTACHMENT_DEPTH_SIZE HEX: 8216
CONSTANT: GL_FRAMEBUFFER_ATTACHMENT_STENCIL_SIZE HEX: 8217
CONSTANT: GL_FRAMEBUFFER_DEFAULT HEX: 8218
CONSTANT: GL_FRAMEBUFFER_UNDEFINED HEX: 8219
CONSTANT: GL_DEPTH_STENCIL_ATTACHMENT HEX: 821A
CONSTANT: GL_FRAMEBUFFER_COMPLETE HEX: 8CD5
CONSTANT: GL_FRAMEBUFFER_INCOMPLETE_ATTACHMENT HEX: 8CD6
CONSTANT: GL_FRAMEBUFFER_INCOMPLETE_MISSING_ATTACHMENT HEX: 8CD7
CONSTANT: GL_FRAMEBUFFER_INCOMPLETE_DRAW_BUFFER HEX: 8CDB
CONSTANT: GL_FRAMEBUFFER_INCOMPLETE_READ_BUFFER HEX: 8CDC
CONSTANT: GL_FRAMEBUFFER_UNSUPPORTED HEX: 8CDD
CONSTANT: GL_MAX_COLOR_ATTACHMENTS HEX: 8CDF
CONSTANT: GL_COLOR_ATTACHMENT0 HEX: 8CE0
CONSTANT: GL_COLOR_ATTACHMENT1 HEX: 8CE1
CONSTANT: GL_COLOR_ATTACHMENT2 HEX: 8CE2
CONSTANT: GL_COLOR_ATTACHMENT3 HEX: 8CE3
CONSTANT: GL_COLOR_ATTACHMENT4 HEX: 8CE4
CONSTANT: GL_COLOR_ATTACHMENT5 HEX: 8CE5
CONSTANT: GL_COLOR_ATTACHMENT6 HEX: 8CE6
CONSTANT: GL_COLOR_ATTACHMENT7 HEX: 8CE7
CONSTANT: GL_COLOR_ATTACHMENT8 HEX: 8CE8
CONSTANT: GL_COLOR_ATTACHMENT9 HEX: 8CE9
CONSTANT: GL_COLOR_ATTACHMENT10 HEX: 8CEA
CONSTANT: GL_COLOR_ATTACHMENT11 HEX: 8CEB
CONSTANT: GL_COLOR_ATTACHMENT12 HEX: 8CEC
CONSTANT: GL_COLOR_ATTACHMENT13 HEX: 8CED
CONSTANT: GL_COLOR_ATTACHMENT14 HEX: 8CEE
CONSTANT: GL_COLOR_ATTACHMENT15 HEX: 8CEF
CONSTANT: GL_DEPTH_ATTACHMENT HEX: 8D00
CONSTANT: GL_STENCIL_ATTACHMENT HEX: 8D20
CONSTANT: GL_FRAMEBUFFER HEX: 8D40
CONSTANT: GL_RENDERBUFFER HEX: 8D41
CONSTANT: GL_RENDERBUFFER_WIDTH HEX: 8D42
CONSTANT: GL_RENDERBUFFER_HEIGHT HEX: 8D43
CONSTANT: GL_RENDERBUFFER_INTERNAL_FORMAT HEX: 8D44
CONSTANT: GL_STENCIL_INDEX1 HEX: 8D46
CONSTANT: GL_STENCIL_INDEX4 HEX: 8D47
CONSTANT: GL_STENCIL_INDEX8 HEX: 8D48
CONSTANT: GL_STENCIL_INDEX16 HEX: 8D49
CONSTANT: GL_RENDERBUFFER_RED_SIZE HEX: 8D50
CONSTANT: GL_RENDERBUFFER_GREEN_SIZE HEX: 8D51
CONSTANT: GL_RENDERBUFFER_BLUE_SIZE HEX: 8D52
CONSTANT: GL_RENDERBUFFER_ALPHA_SIZE HEX: 8D53
CONSTANT: GL_RENDERBUFFER_DEPTH_SIZE HEX: 8D54
CONSTANT: GL_RENDERBUFFER_STENCIL_SIZE HEX: 8D55
CONSTANT: GL_READ_FRAMEBUFFER HEX: 8CA8
CONSTANT: GL_DRAW_FRAMEBUFFER HEX: 8CA9
ALIAS: GL_DRAW_FRAMEBUFFER_BINDING GL_FRAMEBUFFER_BINDING
CONSTANT: GL_READ_FRAMEBUFFER_BINDING HEX: 8CAA
CONSTANT: GL_RENDERBUFFER_SAMPLES HEX: 8CAB
CONSTANT: GL_FRAMEBUFFER_INCOMPLETE_MULTISAMPLE HEX: 8D56
CONSTANT: GL_MAX_SAMPLES HEX: 8D57
CONSTANT: GL_DEPTH_STENCIL HEX: 84F9
CONSTANT: GL_UNSIGNED_INT_24_8 HEX: 84FA
CONSTANT: GL_DEPTH24_STENCIL8 HEX: 88F0
CONSTANT: GL_TEXTURE_STENCIL_SIZE HEX: 88F1
CONSTANT: GL_RGBA32UI HEX: 8D70
CONSTANT: GL_RGB32UI HEX: 8D71
CONSTANT: GL_RGBA16UI HEX: 8D76
CONSTANT: GL_RGB16UI HEX: 8D77
CONSTANT: GL_RGBA8UI HEX: 8D7C
CONSTANT: GL_RGB8UI HEX: 8D7D
CONSTANT: GL_RGBA32I HEX: 8D82
CONSTANT: GL_RGB32I HEX: 8D83
CONSTANT: GL_RGBA16I HEX: 8D88
CONSTANT: GL_RGB16I HEX: 8D89
CONSTANT: GL_RGBA8I HEX: 8D8E
CONSTANT: GL_RGB8I HEX: 8D8F
CONSTANT: GL_RED_INTEGER HEX: 8D94
CONSTANT: GL_GREEN_INTEGER HEX: 8D95
CONSTANT: GL_BLUE_INTEGER HEX: 8D96
CONSTANT: GL_RGB_INTEGER HEX: 8D98
CONSTANT: GL_RGBA_INTEGER HEX: 8D99
CONSTANT: GL_BGR_INTEGER HEX: 8D9A
CONSTANT: GL_BGRA_INTEGER HEX: 8D9B
CONSTANT: GL_FLOAT_32_UNSIGNED_INT_24_8_REV HEX: 8DAD
CONSTANT: GL_TEXTURE_1D_ARRAY HEX: 8C18
CONSTANT: GL_TEXTURE_2D_ARRAY HEX: 8C1A
CONSTANT: GL_PROXY_TEXTURE_2D_ARRAY HEX: 8C1B
CONSTANT: GL_PROXY_TEXTURE_1D_ARRAY HEX: 8C19
CONSTANT: GL_TEXTURE_BINDING_1D_ARRAY HEX: 8C1C
CONSTANT: GL_TEXTURE_BINDING_2D_ARRAY HEX: 8C1D
CONSTANT: GL_MAX_ARRAY_TEXTURE_LAYERS HEX: 88FF
CONSTANT: GL_FRAMEBUFFER_ATTACHMENT_TEXTURE_LAYER HEX: 8CD4
CONSTANT: GL_SAMPLER_1D_ARRAY HEX: 8DC0
CONSTANT: GL_SAMPLER_2D_ARRAY HEX: 8DC1
CONSTANT: GL_SAMPLER_1D_ARRAY_SHADOW HEX: 8DC3
CONSTANT: GL_SAMPLER_2D_ARRAY_SHADOW HEX: 8DC4
CONSTANT: GL_COMPRESSED_RED_RGTC1 HEX: 8DBB
CONSTANT: GL_COMPRESSED_SIGNED_RED_RGTC1 HEX: 8DBC
CONSTANT: GL_COMPRESSED_RG_RGTC2 HEX: 8DBD
CONSTANT: GL_COMPRESSED_SIGNED_RG_RGTC2 HEX: 8DBE
CONSTANT: GL_TRANSFORM_FEEDBACK_BUFFER HEX: 8C8E
CONSTANT: GL_TRANSFORM_FEEDBACK_BUFFER_START HEX: 8C84
CONSTANT: GL_TRANSFORM_FEEDBACK_BUFFER_SIZE HEX: 8C85
CONSTANT: GL_TRANSFORM_FEEDBACK_BUFFER_BINDING HEX: 8C8F
CONSTANT: GL_INTERLEAVED_ATTRIBS HEX: 8C8C
CONSTANT: GL_SEPARATE_ATTRIBS HEX: 8C8D
CONSTANT: GL_PRIMITIVES_GENERATED HEX: 8C87
CONSTANT: GL_TRANSFORM_FEEDBACK_PRIMITIVES_WRITTEN HEX: 8C88
CONSTANT: GL_RASTERIZER_DISCARD HEX: 8C89
CONSTANT: GL_MAX_TRANSFORM_FEEDBACK_INTERLEAVED_COMPONENTS HEX: 8C8A
CONSTANT: GL_MAX_TRANSFORM_FEEDBACK_SEPARATE_ATTRIBS HEX: 8C8B
CONSTANT: GL_MAX_TRANSFORM_FEEDBACK_SEPARATE_COMPONENTS HEX: 8C80
CONSTANT: GL_TRANSFORM_FEEDBACK_VARYINGS HEX: 8C83
CONSTANT: GL_TRANSFORM_FEEDBACK_BUFFER_MODE HEX: 8C7F
CONSTANT: GL_TRANSFORM_FEEDBACK_VARYING_MAX_LENGTH HEX: 8C76
CONSTANT: GL_FRAMEBUFFER_SRGB HEX: 8DB9
CONSTANT: GL_MAJOR_VERSION HEX: 821B
CONSTANT: GL_MINOR_VERSION HEX: 821C
CONSTANT: GL_NUM_EXTENSIONS HEX: 821D
CONSTANT: GL_CONTEXT_FLAGS HEX: 821E
CONSTANT: GL_INDEX HEX: 8222
CONSTANT: GL_DEPTH_BUFFER HEX: 8223
CONSTANT: GL_STENCIL_BUFFER HEX: 8224
CONSTANT: GL_CONTEXT_FLAG_FORWARD_COMPATIBLE_BIT HEX: 0001
ALIAS: GL_COMPARE_REF_TO_TEXTURE GL_COMPARE_R_TO_TEXTURE
ALIAS: GL_MAX_VARYING_COMPONENTS GL_MAX_VARYING_FLOATS
ALIAS: GL_MAX_CLIP_DISTANCES GL_MAX_CLIP_PLANES
ALIAS: GL_CLIP_DISTANCE0 GL_CLIP_PLANE0
ALIAS: GL_CLIP_DISTANCE1 GL_CLIP_PLANE1
ALIAS: GL_CLIP_DISTANCE2 GL_CLIP_PLANE2
ALIAS: GL_CLIP_DISTANCE3 GL_CLIP_PLANE3
ALIAS: GL_CLIP_DISTANCE4 GL_CLIP_PLANE4
ALIAS: GL_CLIP_DISTANCE5 GL_CLIP_PLANE5
GL-FUNCTION: void glVertexAttribIPointer { glVertexAttribIPointerEXT } ( GLuint index, GLint size, GLenum type, GLsizei stride, void* pointer ) ;
GL-FUNCTION: void glGetVertexAttribIiv { glGetVertexAttribIivEXT } ( GLuint index, GLenum pname, GLint* params ) ;
GL-FUNCTION: void glGetVertexAttribIuiv { glGetVertexAttribIuivEXT } ( GLuint index, GLenum pname, GLuint* params ) ;
GL-FUNCTION: void glUniform1ui { glUniform1uiEXT } ( GLint location, GLuint v0 ) ;
GL-FUNCTION: void glUniform2ui { glUniform2uiEXT } ( GLint location, GLuint v0, GLuint v1 ) ;
GL-FUNCTION: void glUniform3ui { glUniform3uiEXT } ( GLint location, GLuint v0, GLuint v1, GLuint v2 ) ;
GL-FUNCTION: void glUniform4ui { glUniform4uiEXT } ( GLint location, GLuint v0, GLuint v1, GLuint v2, GLuint v3 ) ;
GL-FUNCTION: void glUniform1uiv { glUniform1uivEXT } ( GLint location, GLsizei count, GLuint* value ) ;
GL-FUNCTION: void glUniform2uiv { glUniform2uivEXT } ( GLint location, GLsizei count, GLuint* value ) ;
GL-FUNCTION: void glUniform3uiv { glUniform3uivEXT } ( GLint location, GLsizei count, GLuint* value ) ;
GL-FUNCTION: void glUniform4uiv { glUniform4uivEXT } ( GLint location, GLsizei count, GLuint* value ) ;
GL-FUNCTION: void glGetUniformuiv { glGetUniformuivEXT } ( GLuint program, GLint location, GLuint* params ) ;
GL-FUNCTION: void glBindFragDataLocation { glBindFragDataLocationEXT } ( GLuint program, GLuint colorNumber, GLchar* name ) ;
GL-FUNCTION: GLint glGetFragDataLocation { glGetFragDataLocationEXT } ( GLuint program, GLchar* name ) ;
GL-FUNCTION: void glBeginConditionalRender { glBeginConditionalRenderNV } ( GLuint id, GLenum mode ) ;
GL-FUNCTION: void glEndConditionalRender { glEndConditionalRenderNV } ( ) ;
GL-FUNCTION: void glBindVertexArray { glBindVertexArrayAPPLE } ( GLuint array ) ;
GL-FUNCTION: void glDeleteVertexArrays { glDeleteVertexArraysAPPLE } ( GLsizei n, GLuint* arrays ) ;
GL-FUNCTION: void glGenVertexArrays { glGenVertexArraysAPPLE } ( GLsizei n, GLuint* arrays ) ;
GL-FUNCTION: GLboolean glIsVertexArray { glIsVertexArrayAPPLE } ( GLuint array ) ;
GL-FUNCTION: void glClampColor { glClampColorARB } ( GLenum target, GLenum clamp ) ;
GL-FUNCTION: void glBindFramebuffer { glBindFramebufferEXT } ( GLenum target, GLuint framebuffer ) ;
GL-FUNCTION: void glBindRenderbuffer { glBindRenderbufferEXT } ( GLenum target, GLuint renderbuffer ) ;
GL-FUNCTION: GLenum glCheckFramebufferStatus { glCheckFramebufferStatusEXT } ( GLenum target ) ;
GL-FUNCTION: void glDeleteFramebuffers { glDeleteFramebuffersEXT } ( GLsizei n, GLuint* framebuffers ) ;
GL-FUNCTION: void glDeleteRenderbuffers { glDeleteRenderbuffersEXT } ( GLsizei n, GLuint* renderbuffers ) ;
GL-FUNCTION: void glFramebufferRenderbuffer { glFramebufferRenderbufferEXT } ( GLenum target, GLenum attachment, GLenum renderbuffertarget, GLuint renderbuffer ) ;
GL-FUNCTION: void glFramebufferTexture1D { glFramebufferTexture1DEXT } ( GLenum target, GLenum attachment, GLenum textarget, GLuint texture, GLint level ) ;
GL-FUNCTION: void glFramebufferTexture2D { glFramebufferTexture2DEXT } ( GLenum target, GLenum attachment, GLenum textarget, GLuint texture, GLint level ) ;
GL-FUNCTION: void glFramebufferTexture3D { glFramebufferTexture3DEXT } ( GLenum target, GLenum attachment, GLenum textarget, GLuint texture, GLint level, GLint zoffset ) ;
GL-FUNCTION: void glFramebufferTextureLayer { glFramebufferTextureLayerEXT }
( GLenum target, GLenum attachment,
GLuint texture, GLint level, GLint layer ) ;
GL-FUNCTION: void glGenFramebuffers { glGenFramebuffersEXT } ( GLsizei n, GLuint* framebuffers ) ;
GL-FUNCTION: void glGenRenderbuffers { glGenRenderbuffersEXT } ( GLsizei n, GLuint* renderbuffers ) ;
GL-FUNCTION: void glGenerateMipmap { glGenerateMipmapEXT } ( GLenum target ) ;
GL-FUNCTION: void glGetFramebufferAttachmentParameteriv { glGetFramebufferAttachmentParameterivEXT } ( GLenum target, GLenum attachment, GLenum pname, GLint* params ) ;
GL-FUNCTION: void glGetRenderbufferParameteriv { glGetRenderbufferParameterivEXT } ( GLenum target, GLenum pname, GLint* params ) ;
GL-FUNCTION: GLboolean glIsFramebuffer { glIsFramebufferEXT } ( GLuint framebuffer ) ;
GL-FUNCTION: GLboolean glIsRenderbuffer { glIsRenderbufferEXT } ( GLuint renderbuffer ) ;
GL-FUNCTION: void glRenderbufferStorage { glRenderbufferStorageEXT } ( GLenum target, GLenum internalformat, GLsizei width, GLsizei height ) ;
GL-FUNCTION: void glBlitFramebuffer { glBlitFramebufferEXT }
( GLint srcX0, GLint srcY0, GLint srcX1, GLint srcY1,
GLint dstX0, GLint dstY0, GLint dstX1, GLint dstY1,
GLbitfield mask, GLenum filter ) ;
CONSTANT: GL_READ_FRAMEBUFFER_EXT HEX: 8CA8
CONSTANT: GL_DRAW_FRAMEBUFFER_EXT HEX: 8CA9
ALIAS: GL_DRAW_FRAMEBUFFER_BINDING_EXT GL_FRAMEBUFFER_BINDING_EXT
CONSTANT: GL_READ_FRAMEBUFFER_BINDING_EXT HEX: 8CAA
! GL_EXT_framebuffer_multisample
GL-FUNCTION: void glRenderbufferStorageMultisampleEXT { } (
GL-FUNCTION: void glRenderbufferStorageMultisample { glRenderbufferStorageMultisampleEXT } (
GLenum target, GLsizei samples,
GLenum internalformat,
GLsizei width, GLsizei height ) ;
CONSTANT: GL_RENDERBUFFER_SAMPLES_EXT HEX: 8CAB
CONSTANT: GL_FRAMEBUFFER_INCOMPLETE_MULTISAMPLE_EXT HEX: 8D56
CONSTANT: GL_MAX_SAMPLES_EXT HEX: 8D57
GL-FUNCTION: void glTexParameterIiv { glTexParameterIivEXT } ( GLenum target, GLenum pname, GLint* params ) ;
GL-FUNCTION: void glTexParameterIuiv { glTexParameterIuivEXT } ( GLenum target, GLenum pname, GLuint* params ) ;
GL-FUNCTION: void glGetTexParameterIiv { glGetTexParameterIivEXT } ( GLenum target, GLenum pname, GLint* params ) ;
GL-FUNCTION: void glGetTexParameterIuiv { glGetTexParameterIuivEXT } ( GLenum target, GLenum pname, GLuint* params ) ;
GL-FUNCTION: void glColorMaski { glColorMaskIndexedEXT }
( GLuint buf, GLboolean r, GLboolean g, GLboolean b, GLboolean a ) ;
GL-FUNCTION: void glGetBooleani_v { glGetBooleanIndexedvEXT } ( GLenum value, GLuint index, GLboolean* data ) ;
GL-FUNCTION: void glGetIntegeri_v { glGetIntegerIndexedvEXT } ( GLenum value, GLuint index, GLint* data ) ;
GL-FUNCTION: void glEnablei { glEnableIndexedEXT } ( GLenum target, GLuint index ) ;
GL-FUNCTION: void glDisablei { glDisableIndexedEXT } ( GLenum target, GLuint index ) ;
GL-FUNCTION: GLboolean glIsEnabledi { glIsEnabledIndexedEXT } ( GLenum target, GLuint index ) ;
GL-FUNCTION: void glBindBufferRange { glBindBufferRangeEXT } ( GLenum target, GLuint index, GLuint buffer,
GLintptr offset, GLsizeiptr size ) ;
GL-FUNCTION: void glBindBufferBase { glBindBufferBaseEXT } ( GLenum target, GLuint index, GLuint buffer ) ;
GL-FUNCTION: void glBeginTransformFeedback { glBeginTransformFeedbackEXT } ( GLenum primitiveMode ) ;
GL-FUNCTION: void glEndTransformFeedback { glEndTransformFeedbackEXT } ( ) ;
GL-FUNCTION: void glTransformFeedbackVaryings { glTransformFeedbackVaryingsEXT } ( GLuint program, GLsizei count,
GLchar** varyings, GLenum bufferMode ) ;
GL-FUNCTION: void glGetTransformFeedbackVarying { glGetTransformFeedbackVaryingEXT } ( GLuint program, GLuint index,
GLsizei bufSize, GLsizei* length,
GLsizei* size, GLenum* type, GLchar* name ) ;
GL-FUNCTION: void glClearBufferiv { } ( GLenum buffer, GLint drawbuffer, GLint* value ) ;
GL-FUNCTION: void glClearBufferuiv { } ( GLenum buffer, GLint drawbuffer, GLuint* value ) ;
GL-FUNCTION: void glClearBufferfv { } ( GLenum buffer, GLint drawbuffer, GLfloat* value ) ;
GL-FUNCTION: void glClearBufferfi { } ( GLenum buffer, GLint drawbuffer, GLfloat depth, GLint stencil ) ;
GL-FUNCTION: GLubyte* glGetStringi { } ( GLenum value, GLuint index ) ;
GL-FUNCTION: GLvoid* glMapBufferRange { } ( GLenum target, GLintptr offset, GLsizeiptr length, GLbitfield access ) ;
GL-FUNCTION: void glFlushMappedBufferRange { glFlushMappedBufferRangeAPPLE } ( GLenum target, GLintptr offset, GLsizeiptr size ) ;
! GL_ARB_texture_float
! OpenGL 3.1
CONSTANT: GL_RED_SNORM HEX: 8F90
CONSTANT: GL_RG_SNORM HEX: 8F91
CONSTANT: GL_RGB_SNORM HEX: 8F92
CONSTANT: GL_RGBA_SNORM HEX: 8F93
CONSTANT: GL_R8_SNORM HEX: 8F94
CONSTANT: GL_RG8_SNORM HEX: 8F95
CONSTANT: GL_RGB8_SNORM HEX: 8F96
CONSTANT: GL_RGBA8_SNORM HEX: 8F97
CONSTANT: GL_R16_SNORM HEX: 8F98
CONSTANT: GL_RG16_SNORM HEX: 8F99
CONSTANT: GL_RGB16_SNORM HEX: 8F9A
CONSTANT: GL_RGBA16_SNORM HEX: 8F9B
CONSTANT: GL_SIGNED_NORMALIZED HEX: 8F9C
CONSTANT: GL_RGBA32F_ARB HEX: 8814
CONSTANT: GL_RGB32F_ARB HEX: 8815
CONSTANT: GL_ALPHA32F_ARB HEX: 8816
CONSTANT: GL_INTENSITY32F_ARB HEX: 8817
CONSTANT: GL_LUMINANCE32F_ARB HEX: 8818
CONSTANT: GL_LUMINANCE_ALPHA32F_ARB HEX: 8819
CONSTANT: GL_RGBA16F_ARB HEX: 881A
CONSTANT: GL_RGB16F_ARB HEX: 881B
CONSTANT: GL_ALPHA16F_ARB HEX: 881C
CONSTANT: GL_INTENSITY16F_ARB HEX: 881D
CONSTANT: GL_LUMINANCE16F_ARB HEX: 881E
CONSTANT: GL_LUMINANCE_ALPHA16F_ARB HEX: 881F
CONSTANT: GL_TEXTURE_RED_TYPE_ARB HEX: 8C10
CONSTANT: GL_TEXTURE_GREEN_TYPE_ARB HEX: 8C11
CONSTANT: GL_TEXTURE_BLUE_TYPE_ARB HEX: 8C12
CONSTANT: GL_TEXTURE_ALPHA_TYPE_ARB HEX: 8C13
CONSTANT: GL_TEXTURE_LUMINANCE_TYPE_ARB HEX: 8C14
CONSTANT: GL_TEXTURE_INTENSITY_TYPE_ARB HEX: 8C15
CONSTANT: GL_TEXTURE_DEPTH_TYPE_ARB HEX: 8C16
CONSTANT: GL_UNSIGNED_NORMALIZED_ARB HEX: 8C17
CONSTANT: GL_PRIMITIVE_RESTART HEX: 8F9D
CONSTANT: GL_PRIMITIVE_RESTART_INDEX HEX: 8F9E
CONSTANT: GL_COPY_READ_BUFFER HEX: 8F36
CONSTANT: GL_COPY_WRITE_BUFFER HEX: 8F37
! GL_EXT_gpu_shader4
CONSTANT: GL_UNIFORM_BUFFER HEX: 8A11
CONSTANT: GL_UNIFORM_BUFFER_BINDING HEX: 8A28
CONSTANT: GL_UNIFORM_BUFFER_START HEX: 8A29
CONSTANT: GL_UNIFORM_BUFFER_SIZE HEX: 8A2A
CONSTANT: GL_MAX_VERTEX_UNIFORM_BLOCKS HEX: 8A2B
CONSTANT: GL_MAX_GEOMETRY_UNIFORM_BLOCKS HEX: 8A2C
CONSTANT: GL_MAX_FRAGMENT_UNIFORM_BLOCKS HEX: 8A2D
CONSTANT: GL_MAX_COMBINED_UNIFORM_BLOCKS HEX: 8A2E
CONSTANT: GL_MAX_UNIFORM_BUFFER_BINDINGS HEX: 8A2F
CONSTANT: GL_MAX_UNIFORM_BLOCK_SIZE HEX: 8A30
CONSTANT: GL_MAX_COMBINED_VERTEX_UNIFORM_COMPONENTS HEX: 8A31
CONSTANT: GL_MAX_COMBINED_GEOMETRY_UNIFORM_COMPONENTS HEX: 8A32
CONSTANT: GL_MAX_COMBINED_FRAGMENT_UNIFORM_COMPONENTS HEX: 8A33
CONSTANT: GL_UNIFORM_BUFFER_OFFSET_ALIGNMENT HEX: 8A34
CONSTANT: GL_ACTIVE_UNIFORM_BLOCK_MAX_NAME_LENGTH HEX: 8A35
CONSTANT: GL_ACTIVE_UNIFORM_BLOCKS HEX: 8A36
CONSTANT: GL_UNIFORM_TYPE HEX: 8A37
CONSTANT: GL_UNIFORM_SIZE HEX: 8A38
CONSTANT: GL_UNIFORM_NAME_LENGTH HEX: 8A39
CONSTANT: GL_UNIFORM_BLOCK_INDEX HEX: 8A3A
CONSTANT: GL_UNIFORM_OFFSET HEX: 8A3B
CONSTANT: GL_UNIFORM_ARRAY_STRIDE HEX: 8A3C
CONSTANT: GL_UNIFORM_MATRIX_STRIDE HEX: 8A3D
CONSTANT: GL_UNIFORM_IS_ROW_MAJOR HEX: 8A3E
CONSTANT: GL_UNIFORM_BLOCK_BINDING HEX: 8A3F
CONSTANT: GL_UNIFORM_BLOCK_DATA_SIZE HEX: 8A40
CONSTANT: GL_UNIFORM_BLOCK_NAME_LENGTH HEX: 8A41
CONSTANT: GL_UNIFORM_BLOCK_ACTIVE_UNIFORMS HEX: 8A42
CONSTANT: GL_UNIFORM_BLOCK_ACTIVE_UNIFORM_INDICES HEX: 8A43
CONSTANT: GL_UNIFORM_BLOCK_REFERENCED_BY_VERTEX_SHADER HEX: 8A44
CONSTANT: GL_UNIFORM_BLOCK_REFERENCED_BY_GEOMETRY_SHADER HEX: 8A45
CONSTANT: GL_UNIFORM_BLOCK_REFERENCED_BY_FRAGMENT_SHADER HEX: 8A46
CONSTANT: GL_INVALID_INDEX HEX: FFFFFFFF
CONSTANT: GL_TEXTURE_RECTANGLE HEX: 84F5
CONSTANT: GL_TEXTURE_BINDING_RECTANGLE HEX: 84F6
CONSTANT: GL_PROXY_TEXTURE_RECTANGLE HEX: 84F7
CONSTANT: GL_MAX_RECTANGLE_TEXTURE_SIZE HEX: 84F8
CONSTANT: GL_SAMPLER_2D_RECT HEX: 8B63
CONSTANT: GL_SAMPLER_2D_RECT_SHADOW HEX: 8B64
GL-FUNCTION: void glVertexAttribI1iEXT { } ( GLuint index, GLint x ) ;
GL-FUNCTION: void glVertexAttribI2iEXT { } ( GLuint index, GLint x, GLint y ) ;
GL-FUNCTION: void glVertexAttribI3iEXT { } ( GLuint index, GLint x, GLint y, GLint z ) ;
GL-FUNCTION: void glVertexAttribI4iEXT { } ( GLuint index, GLint x, GLint y, GLint z, GLint w ) ;
CONSTANT: GL_SAMPLER_BUFFER HEX: 8DC2
CONSTANT: GL_INT_SAMPLER_BUFFER HEX: 8DD0
CONSTANT: GL_UNSIGNED_INT_SAMPLER_BUFFER HEX: 8DD8
GL-FUNCTION: void glVertexAttribI1uiEXT { } ( GLuint index, GLuint x ) ;
GL-FUNCTION: void glVertexAttribI2uiEXT { } ( GLuint index, GLuint x, GLuint y ) ;
GL-FUNCTION: void glVertexAttribI3uiEXT { } ( GLuint index, GLuint x, GLuint y, GLuint z ) ;
GL-FUNCTION: void glVertexAttribI4uiEXT { } ( GLuint index, GLuint x, GLuint y, GLuint z, GLuint w ) ;
CONSTANT: GL_TEXTURE_BUFFER HEX: 8C2A
GL-FUNCTION: void glVertexAttribI1ivEXT { } ( GLuint index, GLint* v ) ;
GL-FUNCTION: void glVertexAttribI2ivEXT { } ( GLuint index, GLint* v ) ;
GL-FUNCTION: void glVertexAttribI3ivEXT { } ( GLuint index, GLint* v ) ;
GL-FUNCTION: void glVertexAttribI4ivEXT { } ( GLuint index, GLint* v ) ;
CONSTANT: GL_MAX_TEXTURE_BUFFER_SIZE HEX: 8C2B
CONSTANT: GL_TEXTURE_BINDING_BUFFER HEX: 8C2C
CONSTANT: GL_TEXTURE_BUFFER_DATA_STORE_BINDING HEX: 8C2D
CONSTANT: GL_TEXTURE_BUFFER_FORMAT HEX: 8C2E
GL-FUNCTION: void glVertexAttribI1uivEXT { } ( GLuint index, GLuint* v ) ;
GL-FUNCTION: void glVertexAttribI2uivEXT { } ( GLuint index, GLuint* v ) ;
GL-FUNCTION: void glVertexAttribI3uivEXT { } ( GLuint index, GLuint* v ) ;
GL-FUNCTION: void glVertexAttribI4uivEXT { } ( GLuint index, GLuint* v ) ;
GL-FUNCTION: void glDrawArraysInstanced { glDrawArraysInstancedARB } ( GLenum mode, GLint first, GLsizei count, GLsizei primcount ) ;
GL-FUNCTION: void glDrawElementsInstanced { glDrawElementsInstancedARB } ( GLenum mode, GLsizei count, GLenum type, GLvoid* indices, GLsizei primcount ) ;
GL-FUNCTION: void glTexBuffer { glTexBufferEXT } ( GLenum target, GLenum internalformat, GLuint buffer ) ;
GL-FUNCTION: void glPrimitiveRestartIndex { } ( GLuint index ) ;
GL-FUNCTION: void glVertexAttribI4bvEXT { } ( GLuint index, GLbyte* v ) ;
GL-FUNCTION: void glVertexAttribI4svEXT { } ( GLuint index, GLshort* v ) ;
GL-FUNCTION: void glVertexAttribI4ubvEXT { } ( GLuint index, GLubyte* v ) ;
GL-FUNCTION: void glVertexAttribI4usvEXT { } ( GLuint index, GLushort* v ) ;
GL-FUNCTION: void glGetUniformIndices { } ( GLuint program, GLsizei uniformCount, GLchar** uniformNames, GLuint* uniformIndices ) ;
GL-FUNCTION: void glGetActiveUniformsiv { } ( GLuint program, GLsizei uniformCount, GLuint* uniformIndices, GLenum pname, GLint* params ) ;
GL-FUNCTION: void glGetActiveUniformName { } ( GLuint program, GLuint uniformIndex, GLsizei bufSize, GLsizei* length, GLchar* uniformName ) ;
GL-FUNCTION: GLuint glGetUniformBlockIndex { } ( GLuint program, GLchar* uniformBlockName ) ;
GL-FUNCTION: void glGetActiveUniformBlockiv { } ( GLuint program, GLuint uniformBlockIndex, GLenum pname, GLint* params ) ;
GL-FUNCTION: void glGetActiveUniformBlockName { } ( GLuint program, GLuint uniformBlockIndex, GLsizei bufSize, GLsizei* length, GLchar* uniformName ) ;
GL-FUNCTION: void glUniformBlockBinding { } ( GLuint buffer, GLuint uniformBlockIndex, GLuint uniformBlockBinding ) ;
GL-FUNCTION: void glVertexAttribIPointerEXT { } ( GLuint index, GLint size, GLenum type, GLsizei stride, void* pointer ) ;
GL-FUNCTION: void glGetVertexAttribIivEXT { } ( GLuint index, GLenum pname, GLint* params ) ;
GL-FUNCTION: void glGetVertexAttribIuivEXT { } ( GLuint index, GLenum pname, GLuint* params ) ;
GL-FUNCTION: void glUniform1uiEXT { } ( GLint location, GLuint v0 ) ;
GL-FUNCTION: void glUniform2uiEXT { } ( GLint location, GLuint v0, GLuint v1 ) ;
GL-FUNCTION: void glUniform3uiEXT { } ( GLint location, GLuint v0, GLuint v1, GLuint v2 ) ;
GL-FUNCTION: void glUniform4uiEXT { } ( GLint location, GLuint v0, GLuint v1, GLuint v2, GLuint v3 ) ;
GL-FUNCTION: void glUniform1uivEXT { } ( GLint location, GLsizei count, GLuint* value ) ;
GL-FUNCTION: void glUniform2uivEXT { } ( GLint location, GLsizei count, GLuint* value ) ;
GL-FUNCTION: void glUniform3uivEXT { } ( GLint location, GLsizei count, GLuint* value ) ;
GL-FUNCTION: void glUniform4uivEXT { } ( GLint location, GLsizei count, GLuint* value ) ;
GL-FUNCTION: void glGetUniformuivEXT { } ( GLuint program, GLint location, GLuint* params ) ;
GL-FUNCTION: void glBindFragDataLocationEXT { } ( GLuint program, GLuint colorNumber, GLchar* name ) ;
GL-FUNCTION: GLint glGetFragDataLocationEXT { } ( GLuint program, GLchar* name ) ;
CONSTANT: GL_VERTEX_ATTRIB_ARRAY_INTEGER_EXT HEX: 88FD
CONSTANT: GL_SAMPLER_1D_ARRAY_EXT HEX: 8DC0
CONSTANT: GL_SAMPLER_2D_ARRAY_EXT HEX: 8DC1
CONSTANT: GL_SAMPLER_BUFFER_EXT HEX: 8DC2
CONSTANT: GL_SAMPLER_1D_ARRAY_SHADOW_EXT HEX: 8DC3
CONSTANT: GL_SAMPLER_2D_ARRAY_SHADOW_EXT HEX: 8DC4
CONSTANT: GL_SAMPLER_CUBE_SHADOW_EXT HEX: 8DC5
CONSTANT: GL_UNSIGNED_INT_VEC2_EXT HEX: 8DC6
CONSTANT: GL_UNSIGNED_INT_VEC3_EXT HEX: 8DC7
CONSTANT: GL_UNSIGNED_INT_VEC4_EXT HEX: 8DC8
CONSTANT: GL_INT_SAMPLER_1D_EXT HEX: 8DC9
CONSTANT: GL_INT_SAMPLER_2D_EXT HEX: 8DCA
CONSTANT: GL_INT_SAMPLER_3D_EXT HEX: 8DCB
CONSTANT: GL_INT_SAMPLER_CUBE_EXT HEX: 8DCC
CONSTANT: GL_INT_SAMPLER_2D_RECT_EXT HEX: 8DCD
CONSTANT: GL_INT_SAMPLER_1D_ARRAY_EXT HEX: 8DCE
CONSTANT: GL_INT_SAMPLER_2D_ARRAY_EXT HEX: 8DCF
CONSTANT: GL_INT_SAMPLER_BUFFER_EXT HEX: 8DD0
CONSTANT: GL_UNSIGNED_INT_SAMPLER_1D_EXT HEX: 8DD1
CONSTANT: GL_UNSIGNED_INT_SAMPLER_2D_EXT HEX: 8DD2
CONSTANT: GL_UNSIGNED_INT_SAMPLER_3D_EXT HEX: 8DD3
CONSTANT: GL_UNSIGNED_INT_SAMPLER_CUBE_EXT HEX: 8DD4
CONSTANT: GL_UNSIGNED_INT_SAMPLER_2D_RECT_EXT HEX: 8DD5
CONSTANT: GL_UNSIGNED_INT_SAMPLER_1D_ARRAY_EXT HEX: 8DD6
CONSTANT: GL_UNSIGNED_INT_SAMPLER_2D_ARRAY_EXT HEX: 8DD7
CONSTANT: GL_UNSIGNED_INT_SAMPLER_BUFFER_EXT HEX: 8DD8
CONSTANT: GL_MIN_PROGRAM_TEXEL_OFFSET_EXT HEX: 8904
CONSTANT: GL_MAX_PROGRAM_TEXEL_OFFSET_EXT HEX: 8905
GL-FUNCTION: void glCopyBufferSubData { glCopyBufferSubDataEXT } ( GLenum readtarget, GLenum writetarget, GLintptr readoffset, GLintptr writeoffset, GLsizeiptr size ) ;
! GL_EXT_geometry_shader4
@ -1910,10 +2173,6 @@ CONSTANT: GL_MAX_PROGRAM_TEXEL_OFFSET_EXT HEX: 8905
GL-FUNCTION: void glProgramParameteriEXT { } ( GLuint program, GLenum pname, GLint value ) ;
GL-FUNCTION: void glFramebufferTextureEXT { } ( GLenum target, GLenum attachment,
GLuint texture, GLint level ) ;
GL-FUNCTION: void glFramebufferTextureLayerEXT { } ( GLenum target, GLenum attachment,
GLuint texture, GLint level, GLint layer ) ;
GL-FUNCTION: void glFramebufferTextureFaceEXT { } ( GLenum target, GLenum attachment,
GLuint texture, GLint level, GLenum face ) ;
CONSTANT: GL_GEOMETRY_SHADER_EXT HEX: 8DD9
CONSTANT: GL_GEOMETRY_VERTICES_OUT_EXT HEX: 8DDA
@ -1922,7 +2181,6 @@ CONSTANT: GL_GEOMETRY_OUTPUT_TYPE_EXT HEX: 8DDC
CONSTANT: GL_MAX_GEOMETRY_TEXTURE_IMAGE_UNITS_EXT HEX: 8C29
CONSTANT: GL_MAX_GEOMETRY_VARYING_COMPONENTS_EXT HEX: 8DDD
CONSTANT: GL_MAX_VERTEX_VARYING_COMPONENTS_EXT HEX: 8DDE
CONSTANT: GL_MAX_VARYING_COMPONENTS_EXT HEX: 8B4B
CONSTANT: GL_MAX_GEOMETRY_UNIFORM_COMPONENTS_EXT HEX: 8DDF
CONSTANT: GL_MAX_GEOMETRY_OUTPUT_VERTICES_EXT HEX: 8DE0
CONSTANT: GL_MAX_GEOMETRY_TOTAL_OUTPUT_COMPONENTS_EXT HEX: 8DE1
@ -1933,110 +2191,63 @@ CONSTANT: GL_TRIANGLE_STRIP_ADJACENCY_EXT HEX: D
CONSTANT: GL_FRAMEBUFFER_INCOMPLETE_LAYER_TARGETS_EXT HEX: 8DA8
CONSTANT: GL_FRAMEBUFFER_INCOMPLETE_LAYER_COUNT_EXT HEX: 8DA9
CONSTANT: GL_FRAMEBUFFER_ATTACHMENT_LAYERED_EXT HEX: 8DA7
ALIAS: GL_FRAMEBUFFER_ATTACHMENT_TEXTURE_LAYER_EXT GL_FRAMEBUFFER_ATTACHMENT_TEXTURE_3D_ZOFFSET_EXT
CONSTANT: GL_PROGRAM_POINT_SIZE_EXT HEX: 8642
! GL_EXT_framebuffer_object
CONSTANT: GL_FRAMEBUFFER_INCOMPLETE_DIMENSIONS_EXT HEX: 8CD9
CONSTANT: GL_FRAMEBUFFER_INCOMPLETE_FORMATS_EXT HEX: 8CDA
! GL_ARB_texture_float
CONSTANT: GL_ALPHA32F_ARB HEX: 8816
CONSTANT: GL_INTENSITY32F_ARB HEX: 8817
CONSTANT: GL_LUMINANCE32F_ARB HEX: 8818
CONSTANT: GL_LUMINANCE_ALPHA32F_ARB HEX: 8819
CONSTANT: GL_ALPHA16F_ARB HEX: 881C
CONSTANT: GL_INTENSITY16F_ARB HEX: 881D
CONSTANT: GL_LUMINANCE16F_ARB HEX: 881E
CONSTANT: GL_LUMINANCE_ALPHA16F_ARB HEX: 881F
CONSTANT: GL_TEXTURE_LUMINANCE_TYPE_ARB HEX: 8C14
CONSTANT: GL_TEXTURE_INTENSITY_TYPE_ARB HEX: 8C15
! GL_EXT_texture_integer
GL-FUNCTION: void glClearColorIiEXT { } ( GLint r, GLint g, GLint b, GLint a ) ;
GL-FUNCTION: void glClearColorIuiEXT { } ( GLuint r, GLuint g, GLuint b, GLuint a ) ;
GL-FUNCTION: void glTexParameterIivEXT { } ( GLenum target, GLenum pname, GLint* params ) ;
GL-FUNCTION: void glTexParameterIuivEXT { } ( GLenum target, GLenum pname, GLuint* params ) ;
GL-FUNCTION: void glGetTexParameterIivEXT { } ( GLenum target, GLenum pname, GLint* params ) ;
GL-FUNCTION: void glGetTexParameterIuivEXT { } ( GLenum target, GLenum pname, GLuint* params ) ;
CONSTANT: GL_RGBA_INTEGER_MODE_EXT HEX: 8D9E
CONSTANT: GL_RGBA32UI_EXT HEX: 8D70
CONSTANT: GL_RGB32UI_EXT HEX: 8D71
CONSTANT: GL_ALPHA32UI_EXT HEX: 8D72
CONSTANT: GL_INTENSITY32UI_EXT HEX: 8D73
CONSTANT: GL_LUMINANCE32UI_EXT HEX: 8D74
CONSTANT: GL_LUMINANCE_ALPHA32UI_EXT HEX: 8D75
CONSTANT: GL_RGBA16UI_EXT HEX: 8D76
CONSTANT: GL_RGB16UI_EXT HEX: 8D77
CONSTANT: GL_ALPHA16UI_EXT HEX: 8D78
CONSTANT: GL_INTENSITY16UI_EXT HEX: 8D79
CONSTANT: GL_LUMINANCE16UI_EXT HEX: 8D7A
CONSTANT: GL_LUMINANCE_ALPHA16UI_EXT HEX: 8D7B
CONSTANT: GL_RGBA8UI_EXT HEX: 8D7C
CONSTANT: GL_RGB8UI_EXT HEX: 8D7D
CONSTANT: GL_ALPHA8UI_EXT HEX: 8D7E
CONSTANT: GL_INTENSITY8UI_EXT HEX: 8D7F
CONSTANT: GL_LUMINANCE8UI_EXT HEX: 8D80
CONSTANT: GL_LUMINANCE_ALPHA8UI_EXT HEX: 8D81
CONSTANT: GL_RGBA32I_EXT HEX: 8D82
CONSTANT: GL_RGB32I_EXT HEX: 8D83
CONSTANT: GL_ALPHA32I_EXT HEX: 8D84
CONSTANT: GL_INTENSITY32I_EXT HEX: 8D85
CONSTANT: GL_LUMINANCE32I_EXT HEX: 8D86
CONSTANT: GL_LUMINANCE_ALPHA32I_EXT HEX: 8D87
CONSTANT: GL_RGBA16I_EXT HEX: 8D88
CONSTANT: GL_RGB16I_EXT HEX: 8D89
CONSTANT: GL_ALPHA16I_EXT HEX: 8D8A
CONSTANT: GL_INTENSITY16I_EXT HEX: 8D8B
CONSTANT: GL_LUMINANCE16I_EXT HEX: 8D8C
CONSTANT: GL_LUMINANCE_ALPHA16I_EXT HEX: 8D8D
CONSTANT: GL_RGBA8I_EXT HEX: 8D8E
CONSTANT: GL_RGB8I_EXT HEX: 8D8F
CONSTANT: GL_ALPHA8I_EXT HEX: 8D90
CONSTANT: GL_INTENSITY8I_EXT HEX: 8D91
CONSTANT: GL_LUMINANCE8I_EXT HEX: 8D92
CONSTANT: GL_LUMINANCE_ALPHA8I_EXT HEX: 8D93
CONSTANT: GL_RED_INTEGER_EXT HEX: 8D94
CONSTANT: GL_GREEN_INTEGER_EXT HEX: 8D95
CONSTANT: GL_BLUE_INTEGER_EXT HEX: 8D96
CONSTANT: GL_ALPHA_INTEGER_EXT HEX: 8D97
CONSTANT: GL_RGB_INTEGER_EXT HEX: 8D98
CONSTANT: GL_RGBA_INTEGER_EXT HEX: 8D99
CONSTANT: GL_BGR_INTEGER_EXT HEX: 8D9A
CONSTANT: GL_BGRA_INTEGER_EXT HEX: 8D9B
CONSTANT: GL_LUMINANCE_INTEGER_EXT HEX: 8D9C
CONSTANT: GL_LUMINANCE_ALPHA_INTEGER_EXT HEX: 8D9D
CONSTANT: GL_LUMINANCE_INTEGER_EXT HEX: 8D9C
CONSTANT: GL_LUMINANCE_ALPHA_INTEGER_EXT HEX: 8D9D
! GL_EXT_transform_feedback
GL-FUNCTION: void glBindBufferRangeEXT { } ( GLenum target, GLuint index, GLuint buffer,
GLintptr offset, GLsizeiptr size ) ;
GL-FUNCTION: void glBindBufferOffsetEXT { } ( GLenum target, GLuint index, GLuint buffer,
GLintptr offset ) ;
GL-FUNCTION: void glBindBufferBaseEXT { } ( GLenum target, GLuint index, GLuint buffer ) ;
GL-FUNCTION: void glBeginTransformFeedbackEXT { } ( GLenum primitiveMode ) ;
GL-FUNCTION: void glEndTransformFeedbackEXT { } ( ) ;
GL-FUNCTION: void glTransformFeedbackVaryingsEXT { } ( GLuint program, GLsizei count,
GLchar** varyings, GLenum bufferMode ) ;
GL-FUNCTION: void glGetTransformFeedbackVaryingEXT { } ( GLuint program, GLuint index,
GLsizei bufSize, GLsizei* length,
GLsizei* size, GLenum* type, GLchar* name ) ;
GL-FUNCTION: void glGetIntegerIndexedvEXT { } ( GLenum param, GLuint index, GLint* values ) ;
GL-FUNCTION: void glGetBooleanIndexedvEXT { } ( GLenum param, GLuint index, GLboolean* values ) ;
CONSTANT: GL_TRANSFORM_FEEDBACK_BUFFER_EXT HEX: 8C8E
CONSTANT: GL_TRANSFORM_FEEDBACK_BUFFER_START_EXT HEX: 8C84
CONSTANT: GL_TRANSFORM_FEEDBACK_BUFFER_SIZE_EXT HEX: 8C85
CONSTANT: GL_TRANSFORM_FEEDBACK_BUFFER_BINDING_EXT HEX: 8C8F
CONSTANT: GL_INTERLEAVED_ATTRIBS_EXT HEX: 8C8C
CONSTANT: GL_SEPARATE_ATTRIBS_EXT HEX: 8C8D
CONSTANT: GL_PRIMITIVES_GENERATED_EXT HEX: 8C87
CONSTANT: GL_TRANSFORM_FEEDBACK_PRIMITIVES_WRITTEN_EXT HEX: 8C88
CONSTANT: GL_RASTERIZER_DISCARD_EXT HEX: 8C89
CONSTANT: GL_MAX_TRANSFORM_FEEDBACK_INTERLEAVED_COMPONENTS_EXT HEX: 8C8A
CONSTANT: GL_MAX_TRANSFORM_FEEDBACK_SEPARATE_ATTRIBS_EXT HEX: 8C8B
CONSTANT: GL_MAX_TRANSFORM_FEEDBACK_SEPARATE_COMPONENTS_EXT HEX: 8C80
CONSTANT: GL_TRANSFORM_FEEDBACK_VARYINGS_EXT HEX: 8C83
CONSTANT: GL_TRANSFORM_FEEDBACK_BUFFER_MODE_EXT HEX: 8C7F
CONSTANT: GL_TRANSFORM_FEEDBACK_VARYING_MAX_LENGTH_EXT HEX: 8C76
GL-FUNCTION: void glClearColorIiEXT { } ( GLint r, GLint g, GLint b, GLint a ) ;
GL-FUNCTION: void glClearColorIuiEXT { } ( GLuint r, GLuint g, GLuint b, GLuint a ) ;

1
basis/opengl/gl3/authors.txt Normal file
View File

@ -0,0 +1 @@
Joe Groff

1007
basis/opengl/gl3/gl3.factor Normal file
View File

File diff suppressed because it is too large Load Diff

1
basis/opengl/gl3/summary.txt Normal file
View File

@ -0,0 +1 @@
Forward-compatible subset of OpenGL 3.1

2
basis/opengl/opengl-docs.factor
View File

@ -45,7 +45,7 @@ HELP: bind-texture-unit
{ $description "Binds texture " { $snippet "id" } " to texture target " { $snippet "target" } " of texture unit " { $snippet "unit" } ". Equivalent to " { $snippet "unit glActiveTexture target id glBindTexture" } "." } ;
HELP: set-draw-buffers
{ $values { "buffers" "A sequence of buffer words (e.g. " { $snippet "GL_BACK" } ", " { $snippet "GL_COLOR_ATTACHMENT0_EXT" } ")"} }
{ $values { "buffers" "A sequence of buffer words (e.g. " { $snippet "GL_BACK" } ", " { $snippet "GL_COLOR_ATTACHMENT0" } ")"} }
{ $description "Wrapper for " { $link glDrawBuffers } ". Sets up the buffers named in the sequence for simultaneous drawing." } ;
HELP: do-attribs

2
basis/opengl/shaders/shaders.factor
View File

@ -65,7 +65,7 @@ PREDICATE: fragment-shader < gl-shader (fragment-shader?) ;
glCreateProgram
[
[ swap [ glAttachShader ] with each ]
[ swap [ first2 swap glBindFragDataLocationEXT ] with each ] bi-curry bi*
[ swap [ first2 swap glBindFragDataLocation ] with each ] bi-curry bi*
]
[ glLinkProgram ]
[ ] tri

27
basis/opengl/textures/textures-tests.factor
View File

@ -1,7 +1,7 @@
! Copyright (C) 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: tools.test opengl.textures opengl.textures.private
images kernel namespaces accessors sequences ;
USING: tools.test opengl.gl opengl.textures opengl.textures.private
images kernel namespaces accessors sequences literals ;
IN: opengl.textures.tests
[
@ -15,4 +15,25 @@ IN: opengl.textures.tests
{ { 10 30 } { 30 300 } }
}
[ [ image new swap >>dim ] map ] map image-locs
] unit-test
] unit-test
${ GL_RGBA8 GL_RGBA GL_UNSIGNED_BYTE }
[ RGBA ubyte-components (image-format) ] unit-test
${ GL_RGBA8 GL_BGRA GL_UNSIGNED_BYTE }
[ BGRA ubyte-components (image-format) ] unit-test
${ GL_RGBA8 GL_BGRA GL_UNSIGNED_INT_8_8_8_8_REV }
[ ARGB ubyte-components (image-format) ] unit-test
${ GL_RGBA32F GL_RGBA GL_FLOAT }
[ RGBA float-components (image-format) ] unit-test
${ GL_RGBA32UI GL_BGRA_INTEGER GL_UNSIGNED_INT }
[ BGRA uint-integer-components (image-format) ] unit-test
${ GL_RGB9_E5 GL_RGB GL_UNSIGNED_INT_5_9_9_9_REV }
[ BGR u-9-9-9-e5-components (image-format) ] unit-test
${ GL_R11F_G11F_B10F GL_RGB GL_UNSIGNED_INT_10F_11F_11F_REV }
[ BGR float-11-11-10-components (image-format) ] unit-test

259
basis/opengl/textures/textures.factor
View File

@ -4,7 +4,7 @@ USING: accessors assocs cache colors.constants destructors kernel
opengl opengl.gl opengl.capabilities combinators images
images.tesselation grouping specialized-arrays.float sequences math
math.vectors math.matrices generalizations fry arrays namespaces
system ;
system locals literals ;
IN: opengl.textures
SYMBOL: non-power-of-2-textures?
@ -22,16 +22,235 @@ SYMBOL: non-power-of-2-textures?
: delete-texture ( id -- ) [ glDeleteTextures ] (delete-gl-object) ;
GENERIC: component-order>format ( component-order -- format type )
ERROR: unsupported-component-order component-order component-type ;
M: RGB component-order>format drop GL_RGB GL_UNSIGNED_BYTE ;
M: BGR component-order>format drop GL_BGR GL_UNSIGNED_BYTE ;
M: RGBA component-order>format drop GL_RGBA GL_UNSIGNED_BYTE ;
M: ARGB component-order>format drop GL_BGRA_EXT GL_UNSIGNED_INT_8_8_8_8_REV ;
M: BGRA component-order>format drop GL_BGRA_EXT GL_UNSIGNED_BYTE ;
M: BGRX component-order>format drop GL_BGRA_EXT GL_UNSIGNED_BYTE ;
M: LA component-order>format drop GL_LUMINANCE_ALPHA GL_UNSIGNED_BYTE ;
M: L component-order>format drop GL_LUMINANCE GL_UNSIGNED_BYTE ;
CONSTANT: image-internal-formats H{
{ { A ubyte-components } $ GL_ALPHA8 }
{ { A ushort-components } $ GL_ALPHA16 }
{ { A half-components } $ GL_ALPHA16F_ARB }
{ { A float-components } $ GL_ALPHA32F_ARB }
{ { A byte-integer-components } $ GL_ALPHA8I_EXT }
{ { A ubyte-integer-components } $ GL_ALPHA8UI_EXT }
{ { A short-integer-components } $ GL_ALPHA16I_EXT }
{ { A ushort-integer-components } $ GL_ALPHA16UI_EXT }
{ { A int-integer-components } $ GL_ALPHA32I_EXT }
{ { A uint-integer-components } $ GL_ALPHA32UI_EXT }
{ { L ubyte-components } $ GL_LUMINANCE8 }
{ { L ushort-components } $ GL_LUMINANCE16 }
{ { L half-components } $ GL_LUMINANCE16F_ARB }
{ { L float-components } $ GL_LUMINANCE32F_ARB }
{ { L byte-integer-components } $ GL_LUMINANCE8I_EXT }
{ { L ubyte-integer-components } $ GL_LUMINANCE8UI_EXT }
{ { L short-integer-components } $ GL_LUMINANCE16I_EXT }
{ { L ushort-integer-components } $ GL_LUMINANCE16UI_EXT }
{ { L int-integer-components } $ GL_LUMINANCE32I_EXT }
{ { L uint-integer-components } $ GL_LUMINANCE32UI_EXT }
{ { R ubyte-components } $ GL_R8 }
{ { R ushort-components } $ GL_R16 }
{ { R half-components } $ GL_R16F }
{ { R float-components } $ GL_R32F }
{ { R byte-integer-components } $ GL_R8I }
{ { R ubyte-integer-components } $ GL_R8UI }
{ { R short-integer-components } $ GL_R16I }
{ { R ushort-integer-components } $ GL_R16UI }
{ { R int-integer-components } $ GL_R32I }
{ { R uint-integer-components } $ GL_R32UI }
{ { INTENSITY ubyte-components } $ GL_INTENSITY8 }
{ { INTENSITY ushort-components } $ GL_INTENSITY16 }
{ { INTENSITY half-components } $ GL_INTENSITY16F_ARB }
{ { INTENSITY float-components } $ GL_INTENSITY32F_ARB }
{ { INTENSITY byte-integer-components } $ GL_INTENSITY8I_EXT }
{ { INTENSITY ubyte-integer-components } $ GL_INTENSITY8UI_EXT }
{ { INTENSITY short-integer-components } $ GL_INTENSITY16I_EXT }
{ { INTENSITY ushort-integer-components } $ GL_INTENSITY16UI_EXT }
{ { INTENSITY int-integer-components } $ GL_INTENSITY32I_EXT }
{ { INTENSITY uint-integer-components } $ GL_INTENSITY32UI_EXT }
{ { DEPTH ushort-components } $ GL_DEPTH_COMPONENT16 }
{ { DEPTH u-24-components } $ GL_DEPTH_COMPONENT24 }
{ { DEPTH uint-components } $ GL_DEPTH_COMPONENT32 }
{ { DEPTH float-components } $ GL_DEPTH_COMPONENT32F }
{ { LA ubyte-components } $ GL_LUMINANCE8_ALPHA8 }
{ { LA ushort-components } $ GL_LUMINANCE16_ALPHA16 }
{ { LA half-components } $ GL_LUMINANCE_ALPHA16F_ARB }
{ { LA float-components } $ GL_LUMINANCE_ALPHA32F_ARB }
{ { LA byte-integer-components } $ GL_LUMINANCE_ALPHA8I_EXT }
{ { LA ubyte-integer-components } $ GL_LUMINANCE_ALPHA8UI_EXT }
{ { LA short-integer-components } $ GL_LUMINANCE_ALPHA16I_EXT }
{ { LA ushort-integer-components } $ GL_LUMINANCE_ALPHA16UI_EXT }
{ { LA int-integer-components } $ GL_LUMINANCE_ALPHA32I_EXT }
{ { LA uint-integer-components } $ GL_LUMINANCE_ALPHA32UI_EXT }
{ { RG ubyte-components } $ GL_RG8 }
{ { RG ushort-components } $ GL_RG16 }
{ { RG half-components } $ GL_RG16F }
{ { RG float-components } $ GL_RG32F }
{ { RG byte-integer-components } $ GL_RG8I }
{ { RG ubyte-integer-components } $ GL_RG8UI }
{ { RG short-integer-components } $ GL_RG16I }
{ { RG ushort-integer-components } $ GL_RG16UI }
{ { RG int-integer-components } $ GL_RG32I }
{ { RG uint-integer-components } $ GL_RG32UI }
{ { DEPTH-STENCIL u-24-8-components } $ GL_DEPTH24_STENCIL8 }
{ { DEPTH-STENCIL float-32-u-8-components } $ GL_DEPTH32F_STENCIL8 }
{ { RGB ubyte-components } $ GL_RGB8 }
{ { RGB ushort-components } $ GL_RGB16 }
{ { RGB half-components } $ GL_RGB16F }
{ { RGB float-components } $ GL_RGB32F }
{ { RGB byte-integer-components } $ GL_RGB8I }
{ { RGB ubyte-integer-components } $ GL_RGB8UI }
{ { RGB byte-integer-components } $ GL_RGB8I }
{ { RGB ubyte-integer-components } $ GL_RGB8UI }
{ { RGB short-integer-components } $ GL_RGB16I }
{ { RGB ushort-integer-components } $ GL_RGB16UI }
{ { RGB int-integer-components } $ GL_RGB32I }
{ { RGB uint-integer-components } $ GL_RGB32UI }
{ { RGB u-5-6-5-components } $ GL_RGB5 }
{ { RGB u-9-9-9-e5-components } $ GL_RGB9_E5 }
{ { RGB float-11-11-10-components } $ GL_R11F_G11F_B10F }
{ { RGBA ubyte-components } $ GL_RGBA8 }
{ { RGBA ushort-components } $ GL_RGBA16 }
{ { RGBA half-components } $ GL_RGBA16F }
{ { RGBA float-components } $ GL_RGBA32F }
{ { RGBA byte-integer-components } $ GL_RGBA8I }
{ { RGBA ubyte-integer-components } $ GL_RGBA8UI }
{ { RGBA byte-integer-components } $ GL_RGBA8I }
{ { RGBA ubyte-integer-components } $ GL_RGBA8UI }
{ { RGBA short-integer-components } $ GL_RGBA16I }
{ { RGBA ushort-integer-components } $ GL_RGBA16UI }
{ { RGBA int-integer-components } $ GL_RGBA32I }
{ { RGBA uint-integer-components } $ GL_RGBA32UI }
{ { RGBA u-5-5-5-1-components } $ GL_RGB5_A1 }
{ { RGBA u-10-10-10-2-components } $ GL_RGB10_A2 }
}
GENERIC: fix-internal-component-order ( order -- order' )
M: object fix-internal-component-order ;
M: BGR fix-internal-component-order drop RGB ;
M: BGRA fix-internal-component-order drop RGBA ;
M: ARGB fix-internal-component-order drop RGBA ;
M: ABGR fix-internal-component-order drop RGBA ;
M: RGBX fix-internal-component-order drop RGBA ;
M: BGRX fix-internal-component-order drop RGBA ;
M: XRGB fix-internal-component-order drop RGBA ;
M: XBGR fix-internal-component-order drop RGBA ;
: image-internal-format ( component-order component-type -- internal-format )
2dup
[ fix-internal-component-order ] dip 2array image-internal-formats at
[ 2nip ] [ unsupported-component-order ] if* ;
: reversed-type? ( component-type -- ? )
{ u-9-9-9-e5-components float-11-11-10-components } member? ;
: (component-order>format) ( component-order component-type -- gl-format )
dup unnormalized-integer-components? [
swap {
{ A [ drop GL_ALPHA_INTEGER_EXT ] }
{ L [ drop GL_LUMINANCE_INTEGER_EXT ] }
{ R [ drop GL_RED_INTEGER ] }
{ LA [ drop GL_LUMINANCE_ALPHA_INTEGER_EXT ] }
{ RG [ drop GL_RG_INTEGER ] }
{ BGR [ drop GL_BGR_INTEGER ] }
{ RGB [ drop GL_RGB_INTEGER ] }
{ BGRA [ drop GL_BGRA_INTEGER ] }
{ RGBA [ drop GL_RGBA_INTEGER ] }
{ BGRX [ drop GL_BGRA_INTEGER ] }
{ RGBX [ drop GL_RGBA_INTEGER ] }
[ swap unsupported-component-order ]
} case
] [
swap {
{ A [ drop GL_ALPHA ] }
{ L [ drop GL_LUMINANCE ] }
{ R [ drop GL_RED ] }
{ LA [ drop GL_LUMINANCE_ALPHA ] }
{ RG [ drop GL_RG ] }
{ BGR [ reversed-type? GL_RGB GL_BGR ? ] }
{ RGB [ reversed-type? GL_BGR GL_RGB ? ] }
{ BGRA [ drop GL_BGRA ] }
{ RGBA [ drop GL_RGBA ] }
{ ARGB [ drop GL_BGRA ] }
{ ABGR [ drop GL_RGBA ] }
{ BGRX [ drop GL_BGRA ] }
{ RGBX [ drop GL_RGBA ] }
{ XRGB [ drop GL_BGRA ] }
{ XBGR [ drop GL_RGBA ] }
{ INTENSITY [ drop GL_INTENSITY ] }
{ DEPTH [ drop GL_DEPTH_COMPONENT ] }
{ DEPTH-STENCIL [ drop GL_DEPTH_STENCIL ] }
[ swap unsupported-component-order ]
} case
] if ;
GENERIC: (component-type>type) ( component-order component-type -- gl-type )
M: object (component-type>type) unsupported-component-order ;
: four-channel-alpha-first? ( component-order component-type -- ? )
over component-count 4 =
[ drop alpha-channel-precedes-colors? ]
[ unsupported-component-order ] if ;
: not-alpha-first ( component-order component-type -- )
over alpha-channel-precedes-colors?
[ unsupported-component-order ]
[ 2drop ] if ;
M: ubyte-components (component-type>type)
drop alpha-channel-precedes-colors?
[ GL_UNSIGNED_INT_8_8_8_8_REV ]
[ GL_UNSIGNED_BYTE ] if ;
M: ushort-components (component-type>type) not-alpha-first GL_UNSIGNED_SHORT ;
M: uint-components (component-type>type) not-alpha-first GL_UNSIGNED_INT ;
M: half-components (component-type>type) not-alpha-first GL_HALF_FLOAT ;
M: float-components (component-type>type) not-alpha-first GL_FLOAT ;
M: byte-integer-components (component-type>type) not-alpha-first GL_BYTE ;
M: ubyte-integer-components (component-type>type) not-alpha-first GL_UNSIGNED_BYTE ;
M: short-integer-components (component-type>type) not-alpha-first GL_SHORT ;
M: ushort-integer-components (component-type>type) not-alpha-first GL_UNSIGNED_SHORT ;
M: int-integer-components (component-type>type) not-alpha-first GL_INT ;
M: uint-integer-components (component-type>type) not-alpha-first GL_UNSIGNED_INT ;
M: u-5-5-5-1-components (component-type>type)
four-channel-alpha-first?
[ GL_UNSIGNED_SHORT_1_5_5_5_REV ]
[ GL_UNSIGNED_SHORT_5_5_5_1 ] if ;
M: u-5-6-5-components (component-type>type) 2drop GL_UNSIGNED_SHORT_5_6_5 ;
M: u-10-10-10-2-components (component-type>type)
four-channel-alpha-first?
[ GL_UNSIGNED_INT_2_10_10_10_REV ]
[ GL_UNSIGNED_INT_10_10_10_2 ] if ;
M: u-24-components (component-type>type)
over DEPTH =
[ 2drop GL_UNSIGNED_INT ] [ unsupported-component-order ] if ;
M: u-24-8-components (component-type>type)
over DEPTH-STENCIL =
[ 2drop GL_UNSIGNED_INT_24_8 ] [ unsupported-component-order ] if ;
M: u-9-9-9-e5-components (component-type>type)
over BGR =
[ 2drop GL_UNSIGNED_INT_5_9_9_9_REV ] [ unsupported-component-order ] if ;
M: float-11-11-10-components (component-type>type)
over BGR =
[ 2drop GL_UNSIGNED_INT_10F_11F_11F_REV ] [ unsupported-component-order ] if ;
: image-data-format ( component-order component-type -- gl-format gl-type )
[ (component-order>format) ] [ (component-type>type) ] 2bi ;
SLOT: display-list
@ -41,6 +260,12 @@ GENERIC: draw-scaled-texture ( dim texture -- )
DEFER: make-texture
: (image-format) ( component-order component-type -- internal-format format type )
[ image-internal-format ] [ image-data-format ] 2bi ;
: image-format ( image -- internal-format format type )
[ component-order>> ] [ component-type>> ] bi (image-format) ;
<PRIVATE
TUPLE: single-texture image dim loc texture-coords texture display-list disposed ;
@ -50,18 +275,16 @@ TUPLE: single-texture image dim loc texture-coords texture display-list disposed
[ dup 1 = [ next-power-of-2 ] unless ] map
] unless ;
: tex-image ( image bitmap -- )
[
[ GL_TEXTURE_2D 0 GL_RGBA ] dip
[ dim>> adjust-texture-dim first2 0 ]
[ component-order>> component-order>format ] bi
] dip
glTexImage2D ;
:: tex-image ( image bitmap -- )
image image-format :> type :> format :> internal-format
GL_TEXTURE_2D 0 internal-format
image dim>> adjust-texture-dim first2 0
format type bitmap glTexImage2D ;
: tex-sub-image ( image -- )
[ GL_TEXTURE_2D 0 0 0 ] dip
[ dim>> first2 ]
[ component-order>> component-order>format ]
[ image-format [ drop ] 2dip ]
[ bitmap>> ] tri
glTexSubImage2D ;

2
basis/stack-checker/stack-checker-docs.factor
View File

@ -74,7 +74,7 @@ $nl
"Combinators which are recursive require additional care. In addition to being declared " { $link POSTPONE: inline } ", they must be declared " { $link POSTPONE: recursive } ". There are three restrictions that only apply to combinators with this declaration:"
{ $heading "Input quotation declaration" }
"Input parameters which are quotations must be annotated as much in the stack effect. For example, the following will not infer:"
{ $example ": bad ( quot -- ) [ call ] keep foo ; inline recursive" "[ [ ] bad ] infer." "Got a computed value where a literal quotation was expected\n\nType :help for debugging help." }
{ $example ": bad ( quot -- ) [ call ] keep bad ; inline recursive" "[ [ ] bad ] infer." "Got a computed value where a literal quotation was expected\n\nType :help for debugging help." }
"The following is correct:"
{ $example ": good ( quot: ( -- ) -- ) [ call ] keep good ; inline recursive" "[ [ ] good ] infer." "( -- )" }
"The effect of the nested quotation itself is only present for documentation purposes; the mere presence of a nested effect is sufficient to mark that value as a quotation parameter."

60
basis/ui/backend/cocoa/views/views.factor
View File

@ -1,11 +1,12 @@
! Copyright (C) 2006, 2008 Slava Pestov
! See http://factorcode.org/license.txt for BSD license.
USING: accessors alien alien.c-types arrays assocs cocoa kernel math
cocoa.messages cocoa.subclassing cocoa.classes cocoa.views
cocoa.application cocoa.pasteboard cocoa.types cocoa.windows sequences
ui ui.private ui.gadgets ui.gadgets.private ui.gadgets.worlds
ui.gestures core-foundation.strings core-graphics core-graphics.types
threads combinators math.rectangles ;
USING: accessors alien alien.c-types alien.strings arrays assocs
cocoa kernel math cocoa.messages cocoa.subclassing cocoa.classes
cocoa.views cocoa.application cocoa.pasteboard cocoa.types
cocoa.windows sequences io.encodings.ascii ui ui.private ui.gadgets
ui.gadgets.private ui.gadgets.worlds ui.gestures
core-foundation.strings core-graphics core-graphics.types threads
combinators math.rectangles ;
IN: ui.backend.cocoa.views
: send-mouse-moved ( view event -- )
@ -121,6 +122,25 @@ CONSTANT: key-codes
[ drop dim>> first2 ]
2bi <CGRect> ;
CONSTANT: selector>action H{
{ "undo:" undo-action }
{ "redo:" redo-action }
{ "cut:" cut-action }
{ "copy:" copy-action }
{ "paste:" paste-action }
{ "delete:" delete-action }
{ "selectAll:" select-all-action }
{ "newDocument:" new-action }
{ "openDocument:" open-action }
{ "saveDocument:" save-action }
{ "saveDocumentAs:" save-as-action }
{ "revertDocumentToSaved:" revert-action }
}
: validate-action ( world selector -- ? validated? )
selector>action at
[ swap world-focus parents-handle-gesture? t ] [ drop f f ] if* ;
CLASS: {
{ +superclass+ "NSOpenGLView" }
{ +name+ "FactorView" }
@ -197,6 +217,14 @@ CLASS: {
[ nip send-key-up-event ]
}
{ "validateUserInterfaceItem:" "char" { "id" "SEL" "id" }
[
nip -> action
2dup [ window ] [ ascii alien>string ] bi* validate-action
[ [ 2drop ] dip >c-bool ] [ SUPER-> validateUserInterfaceItem: ] if
]
}
{ "undo:" "id" { "id" "SEL" "id" }
[ nip undo-action send-action$ ]
}
@ -225,6 +253,26 @@ CLASS: {
[ nip select-all-action send-action$ ]
}
{ "newDocument:" "id" { "id" "SEL" "id" }
[ nip new-action send-action$ ]
}
{ "openDocument:" "id" { "id" "SEL" "id" }
[ nip open-action send-action$ ]
}
{ "saveDocument:" "id" { "id" "SEL" "id" }
[ nip save-action send-action$ ]
}
{ "saveDocumentAs:" "id" { "id" "SEL" "id" }
[ nip save-as-action send-action$ ]
}
{ "revertDocumentToSaved:" "id" { "id" "SEL" "id" }
[ nip revert-action send-action$ ]
}
! Multi-touch gestures: this is undocumented.
! http://cocoadex.com/2008/02/nsevent-modifications-swipe-ro.html
{ "magnifyWithEvent:" "void" { "id" "SEL" "id" }

56
basis/ui/gestures/gestures-docs.factor
View File

@ -13,9 +13,20 @@ $nl
"Outputs " { $link f } " if the gesture was handled, and " { $link t } " if the gesture should be passed on to the gadget's parent."
$nl
"The default implementation looks at the " { $snippet "\"gestures\"" } " word property of each superclass of the gadget's class." }
{ $notes "Methods should be defined on this word if you desire to handle an arbitrary set of gestures. To define handlers for a fixed set, it is easier to use " { $link set-gestures } "." } ;
{ $notes "Methods should be defined on this word if you desire to handle an arbitrary set of gestures. To define handlers for a fixed set, it is easier to use " { $link set-gestures } ". If you define a method on " { $snippet "handle-gesture" } ", you should also override " { $link handles-gesture? } "." } ;
{ propagate-gesture handle-gesture set-gestures } related-words
HELP: handles-gesture?
{ $values { "gesture" "a gesture" } { "gadget" "the receiver of the gesture" } { "?" "a boolean" } }
{ $contract "Returns a true value if " { $snippet "gadget" } " would handle " { $snippet "gesture" } " in its " { $link handle-gesture } " method."
$nl
"The default implementation looks at the " { $snippet "\"gestures\"" } " word property of each superclass of the gadget's class and returns true if a handler is present for " { $snippet "gesture" } "." }
{ $notes "This word is used in Factor's MacOS X UI to validate menu items." } ;
HELP: parents-handle-gesture?
{ $values { "gesture" "a gesture" } { "gadget" "the receiver of the gesture" } { "?" "a boolean" } }
{ $contract "Returns a true value if " { $snippet "gadget" } " or any of its ancestors would handle " { $snippet "gesture" } " in its " { $link handle-gesture } " method." } ;
{ propagate-gesture handle-gesture handles-gesture? set-gestures } related-words
HELP: propagate-gesture
{ $values { "gesture" "a gesture" } { "gadget" gadget } }
@ -86,6 +97,30 @@ HELP: select-all-action
{ $class-description "Gesture sent when the " { $emphasis "select all" } " standard window system action is invoked." }
{ $examples { $code "select-all-action" } } ;
HELP: new-action
{ $class-description "Gesture sent when the " { $emphasis "new" } " standard window system action is invoked." }
{ $examples { $code "new-action" } } ;
HELP: open-action
{ $class-description "Gesture sent when the " { $emphasis "open" } " standard window system action is invoked." }
{ $examples { $code "open-action" } } ;
HELP: save-action
{ $class-description "Gesture sent when the " { $emphasis "save" } " standard window system action is invoked." }
{ $examples { $code "save-action" } } ;
HELP: save-as-action
{ $class-description "Gesture sent when the " { $emphasis "save as" } " standard window system action is invoked." }
{ $examples { $code "save-as-action" } } ;
HELP: revert-action
{ $class-description "Gesture sent when the " { $emphasis "revert" } " standard window system action is invoked." }
{ $examples { $code "revert-action" } } ;
HELP: close-action
{ $class-description "Gesture sent when the " { $emphasis "close" } " standard window system action is invoked." }
{ $examples { $code "close-action" } } ;
HELP: C+
{ $description "Control key modifier." } ;
@ -350,21 +385,34 @@ $nl
{ $subsection zoom-out-action } ;
ARTICLE: "action-gestures" "Action gestures"
"Action gestures exist to keep keyboard shortcuts for common clipboard operations consistent."
"Action gestures exist to keep keyboard shortcuts for common application operations consistent."
{ $subsection undo-action }
{ $subsection redo-action }
{ $subsection cut-action }
{ $subsection copy-action }
{ $subsection paste-action }
{ $subsection delete-action }
{ $subsection select-all-action }
{ $subsection new-action }
{ $subsection open-action }
{ $subsection save-action }
{ $subsection save-as-action }
{ $subsection revert-action }
{ $subsection close-action }
"The following keyboard gestures, if not handled directly, send action gestures:"
{ $table
{ { $strong "Keyboard gesture" } { $strong "Action gesture" } }
{ { $snippet "T{ key-down f { C+ } \"z\" }" } { $snippet "undo-action" } }
{ { $snippet "T{ key-down f { C+ } \"Z\" }" } { $snippet "redo-action" } }
{ { $snippet "T{ key-down f { C+ } \"y\" }" } { $snippet "redo-action" } }
{ { $snippet "T{ key-down f { C+ } \"x\" }" } { $snippet "cut-action" } }
{ { $snippet "T{ key-down f { C+ } \"c\" }" } { $snippet "copy-action" } }
{ { $snippet "T{ key-down f { C+ } \"v\" }" } { $snippet "paste-action" } }
{ { $snippet "T{ key-down f { C+ } \"a\" }" } { $snippet "select-all-action" } }
{ { $snippet "T{ key-down f { C+ } \"n\" }" } { $snippet "new-action" } }
{ { $snippet "T{ key-down f { C+ } \"o\" }" } { $snippet "open-action" } }
{ { $snippet "T{ key-down f { C+ } \"s\" }" } { $snippet "save-action" } }
{ { $snippet "T{ key-down f { C+ } \"S\" }" } { $snippet "save-as-action" } }
{ { $snippet "T{ key-down f { C+ } \"w\" }" } { $snippet "close-action" } }
}
"Action gestures should be used in place of the above keyboard gestures if possible. For example, on Mac OS X, the standard " { $strong "Edit" } " menu items send action gestures." ;

28
basis/ui/gestures/gestures.factor
View File

@ -7,13 +7,24 @@ sets columns fry deques ui.gadgets ui.gadgets.private ascii
combinators.short-circuit ;
IN: ui.gestures
: get-gesture-handler ( gesture gadget -- quot )
class superclasses [ "gestures" word-prop ] map assoc-stack ;
GENERIC: handle-gesture ( gesture gadget -- ? )
M: object handle-gesture
[ nip ]
[ class superclasses [ "gestures" word-prop ] map assoc-stack ] 2bi
[ get-gesture-handler ] 2bi
dup [ call( gadget -- ) f ] [ 2drop t ] if ;
GENERIC: handles-gesture? ( gesture gadget -- ? )
M: object handles-gesture? ( gesture gadget -- ? )
get-gesture-handler >boolean ;
: parents-handle-gesture? ( gesture gadget -- ? )
[ handles-gesture? not ] with each-parent not ;
: set-gestures ( class hash -- ) "gestures" set-word-prop ;
: gesture-queue ( -- deque ) \ gesture-queue get ;
@ -82,23 +93,32 @@ undo-action redo-action
cut-action copy-action paste-action
delete-action select-all-action
left-action right-action up-action down-action
zoom-in-action zoom-out-action ;
zoom-in-action zoom-out-action
new-action open-action save-action save-as-action
revert-action close-action ;
UNION: action
undo-action redo-action
cut-action copy-action paste-action
delete-action select-all-action
left-action right-action up-action down-action
zoom-in-action zoom-out-action ;
zoom-in-action zoom-out-action
new-action open-action save-action save-as-action
revert-action close-action ;
CONSTANT: action-gestures
{
{ "z" undo-action }
{ "Z" redo-action }
{ "y" redo-action }
{ "x" cut-action }
{ "c" copy-action }
{ "v" paste-action }
{ "a" select-all-action }
{ "n" new-action }
{ "o" open-action }
{ "s" save-action }
{ "S" save-as-action }
{ "w" close-action }
}
! Modifiers

4
basis/ui/ui-docs.factor
View File

@ -81,6 +81,10 @@ HELP: with-ui
HELP: beep
{ $description "Plays the system beep sound." } ;
HELP: topmost-window
{ $values { "world" world } }
{ $description "Returns the " { $link world } " representing the currently focused window." } ;
ARTICLE: "ui-glossary" "UI glossary"
{ $table
{ "color" { "an instance of " { $link color } } }

3
basis/ui/ui.factor
View File

@ -224,6 +224,9 @@ PRIVATE>
: raise-window ( gadget -- )
find-world raise-window* ;
: topmost-window ( -- world )
windows get last second ;
HOOK: close-window ui-backend ( gadget -- )
M: object close-window

3
basis/windows/offscreen/offscreen.factor
View File

@ -42,6 +42,7 @@ IN: windows.offscreen
swap >>dim
swap >>bitmap
BGRX >>component-order
ubyte-components >>component-type
t >>upside-down? ;
: with-memory-dc ( quot: ( hDC -- ) -- )
@ -50,4 +51,4 @@ IN: windows.offscreen
:: make-bitmap-image ( dim dc quot -- image )
dim dc make-bitmap [ &DeleteObject drop ] dip
quot dip
dim bitmap>image ; inline
dim bitmap>image ; inline

49
extra/bson/reader/reader.factor
View File

@ -2,13 +2,16 @@ USING: accessors assocs bson.constants byte-arrays byte-vectors fry io
io.binary io.encodings.string io.encodings.utf8 kernel math namespaces
sequences serialize arrays calendar io.encodings ;
FROM: kernel.private => declare ;
FROM: io.encodings.private => (read-until) ;
IN: bson.reader
<PRIVATE
TUPLE: element { type integer } name ;
TUPLE: state
{ size initial: -1 } { read initial: 0 } exemplar
{ size initial: -1 } exemplar
result scope element ;
: <state> ( exemplar -- state )
@ -17,25 +20,25 @@ TUPLE: state
clone [ >>result ] [ V{ } clone [ push ] keep >>scope ] bi
V{ } clone [ T_Object "" element boa swap push ] keep >>element ;
PREDICATE: bson-eoo < integer T_EOO = ;
PREDICATE: bson-not-eoo < integer T_EOO > ;
PREDICATE: bson-eoo < integer T_EOO = ;
PREDICATE: bson-double < integer T_Double = ;
PREDICATE: bson-integer < integer T_Integer = ;
PREDICATE: bson-string < integer T_String = ;
PREDICATE: bson-object < integer T_Object = ;
PREDICATE: bson-oid < integer T_OID = ;
PREDICATE: bson-array < integer T_Array = ;
PREDICATE: bson-integer < integer T_Integer = ;
PREDICATE: bson-double < integer T_Double = ;
PREDICATE: bson-date < integer T_Date = ;
PREDICATE: bson-binary < integer T_Binary = ;
PREDICATE: bson-boolean < integer T_Boolean = ;
PREDICATE: bson-regexp < integer T_Regexp = ;
PREDICATE: bson-null < integer T_NULL = ;
PREDICATE: bson-ref < integer T_DBRef = ;
PREDICATE: bson-binary-bytes < integer T_Binary_Bytes = ;
PREDICATE: bson-binary-function < integer T_Binary_Function = ;
PREDICATE: bson-binary-uuid < integer T_Binary_UUID = ;
PREDICATE: bson-binary-custom < integer T_Binary_Custom = ;
PREDICATE: bson-oid < integer T_OID = ;
PREDICATE: bson-boolean < integer T_Boolean = ;
PREDICATE: bson-date < integer T_Date = ;
PREDICATE: bson-null < integer T_NULL = ;
PREDICATE: bson-ref < integer T_DBRef = ;
GENERIC: element-read ( type -- cont? )
GENERIC: element-data-read ( type -- object )
@ -47,27 +50,27 @@ GENERIC: element-binary-read ( length type -- object )
: get-state ( -- state )
state get ; inline
: count-bytes ( count -- )
[ get-state ] dip '[ _ + ] change-read drop ; inline
: read-int32 ( -- int32 )
4 [ read byte-array>number ] [ count-bytes ] bi ; inline
4 read byte-array>number ; inline
: read-longlong ( -- longlong )
8 [ read byte-array>number ] [ count-bytes ] bi ; inline
8 read byte-array>number ; inline
: read-double ( -- double )
8 [ read byte-array>number bits>double ] [ count-bytes ] bi ; inline
8 read byte-array>number bits>double ; inline
: read-byte-raw ( -- byte-raw )
1 [ read ] [ count-bytes ] bi ; inline
1 read ; inline
: read-byte ( -- byte )
read-byte-raw first ; inline
: utf8-read-until ( seps stream encoding -- string/f sep/f )
[ { utf8 } declare decode-char dup [ dup rot member? ] [ 2drop f t ] if ]
3curry (read-until) ;
: read-cstring ( -- string )
input-stream get utf8 <decoder>
"\0" swap stream-read-until drop ; inline
"\0" input-stream get utf8 utf8-read-until drop ; inline
: read-sized-string ( length -- string )
drop read-cstring ; inline
@ -141,13 +144,13 @@ M: bson-not-eoo element-read ( type -- cont? )
M: bson-object element-data-read ( type -- object )
(object-data-read) ;
M: bson-array element-data-read ( type -- object )
(object-data-read) ;
M: bson-string element-data-read ( type -- object )
drop
read-int32 read-sized-string ;
M: bson-array element-data-read ( type -- object )
(object-data-read) ;
M: bson-integer element-data-read ( type -- object )
drop
read-int32 ;
@ -191,7 +194,7 @@ PRIVATE>
USE: tools.continuations
: stream>assoc ( exemplar -- assoc bytes-read )
: stream>assoc ( exemplar -- assoc )
<state> dup state
[ read-int32 >>size read-elements ] with-variable
[ result>> ] [ read>> ] bi ;
result>> ;

70
extra/bson/writer/writer.factor
View File

@ -6,25 +6,24 @@ io.encodings.utf8 io.streams.byte-array kernel math math.parser
namespaces quotations sequences sequences.private serialize strings
words combinators.short-circuit literals ;
FROM: io.encodings.utf8.private => char>utf8 ;
FROM: kernel.private => declare ;
IN: bson.writer
<PRIVATE
SYMBOL: shared-buffer
CONSTANT: CHAR-SIZE 1
CONSTANT: INT32-SIZE 4
CONSTANT: CHAR-SIZE 1
CONSTANT: INT64-SIZE 8
: (buffer) ( -- buffer )
shared-buffer get
[ 8192 <byte-vector> [ shared-buffer set ] keep ] unless* ; inline
: >le-stream ( x n -- )
swap
'[ _ swap nth-byte 0 B{ 0 }
[ set-nth-unsafe ] keep write ] each ; inline
[ BV{ } clone [ shared-buffer set ] keep ] unless*
{ byte-vector } declare ; inline
PRIVATE>
: reset-buffer ( buffer -- )
@ -33,40 +32,38 @@ PRIVATE>
: ensure-buffer ( -- )
(buffer) drop ; inline
: with-buffer ( quot -- byte-vector )
: with-buffer ( quot: ( -- ) -- byte-vector )
[ (buffer) [ reset-buffer ] keep dup ] dip
with-output-stream* dup encoder? [ stream>> ] when ; inline
with-output-stream* ; inline
: with-length ( quot: ( -- ) -- bytes-written start-index )
[ (buffer) [ length ] keep ] dip call
length swap [ - ] keep ; inline
[ (buffer) [ length ] keep ] dip
call length swap [ - ] keep ; inline
: (with-length-prefix) ( quot: ( -- ) length-quot: ( bytes-written -- length ) -- )
[ [ B{ 0 0 0 0 } write ] prepose with-length ] dip swap
[ call ] dip (buffer) copy ; inline
: with-length-prefix ( quot: ( -- ) -- )
[ B{ 0 0 0 0 } write ] prepose with-length
[ INT32-SIZE >le ] dip (buffer)
'[ _ over [ nth-unsafe ] dip _ + _ set-nth-unsafe ]
[ INT32-SIZE ] dip each-integer ; inline
[ INT32-SIZE >le ] (with-length-prefix) ; inline
: with-length-prefix-excl ( quot: ( -- ) -- )
[ B{ 0 0 0 0 } write ] prepose with-length
[ INT32-SIZE - INT32-SIZE >le ] dip (buffer)
'[ _ over [ nth-unsafe ] dip _ + _ set-nth-unsafe ]
[ INT32-SIZE ] dip each-integer ; inline
[ INT32-SIZE [ - ] keep >le ] (with-length-prefix) ; inline
<PRIVATE
GENERIC: bson-type? ( obj -- type ) foldable flushable
GENERIC: bson-write ( obj -- )
GENERIC: bson-type? ( obj -- type )
GENERIC: bson-write ( obj -- )
M: t bson-type? ( boolean -- type ) drop T_Boolean ;
M: f bson-type? ( boolean -- type ) drop T_Boolean ;
M: real bson-type? ( real -- type ) drop T_Double ;
M: tuple bson-type? ( tuple -- type ) drop T_Object ;
M: sequence bson-type? ( seq -- type ) drop T_Array ;
M: string bson-type? ( string -- type ) drop T_String ;
M: integer bson-type? ( integer -- type ) drop T_Integer ;
M: assoc bson-type? ( assoc -- type ) drop T_Object ;
M: real bson-type? ( real -- type ) drop T_Double ;
M: tuple bson-type? ( tuple -- type ) drop T_Object ;
M: sequence bson-type? ( seq -- type ) drop T_Array ;
M: timestamp bson-type? ( timestamp -- type ) drop T_Date ;
M: mdbregexp bson-type? ( regexp -- type ) drop T_Regexp ;
@ -76,28 +73,27 @@ M: word bson-type? ( word -- type ) drop T_Binary ;
M: quotation bson-type? ( quotation -- type ) drop T_Binary ;
M: byte-array bson-type? ( byte-array -- type ) drop T_Binary ;
: write-utf8-string ( string -- )
output-stream get utf8 <encoder> stream-write ; inline
: write-utf8-string ( string -- ) output-stream get '[ _ swap char>utf8 ] each ; inline
: write-byte ( byte -- ) CHAR-SIZE >le-stream ; inline
: write-int32 ( int -- ) INT32-SIZE >le-stream ; inline
: write-double ( real -- ) double>bits INT64-SIZE >le-stream ; inline
: write-byte ( byte -- ) CHAR-SIZE >le write ; inline
: write-int32 ( int -- ) INT32-SIZE >le write ; inline
: write-double ( real -- ) double>bits INT64-SIZE >le write ; inline
: write-cstring ( string -- ) write-utf8-string 0 write-byte ; inline
: write-longlong ( object -- ) INT64-SIZE >le-stream ; inline
: write-longlong ( object -- ) INT64-SIZE >le write ; inline
: write-eoo ( -- ) T_EOO write-byte ; inline
: write-type ( obj -- obj ) [ bson-type? write-byte ] keep ; inline
: write-pair ( name object -- ) write-type [ write-cstring ] dip bson-write ; inline
M: string bson-write ( obj -- )
'[ _ write-cstring ] with-length-prefix-excl ;
M: f bson-write ( f -- )
drop 0 write-byte ;
M: t bson-write ( t -- )
drop 1 write-byte ;
M: string bson-write ( obj -- )
'[ _ write-cstring ] with-length-prefix-excl ;
M: integer bson-write ( num -- )
write-int32 ;
@ -153,8 +149,8 @@ PRIVATE>
[ '[ _ bson-write ] with-buffer ] with-scope ; inline
: assoc>stream ( assoc -- )
bson-write ; inline
{ assoc } declare bson-write ; inline
: mdb-special-value? ( value -- ? )
{ [ timestamp? ] [ quotation? ] [ mdbregexp? ]
[ oid? ] [ byte-array? ] } 1|| ;
[ oid? ] [ byte-array? ] } 1|| ; inline

23
extra/bunny/outlined/outlined.factor
View File

@ -120,14 +120,13 @@ TUPLE: bunny-outlined
framebuffer framebuffer-dim ;
: outlining-supported? ( -- ? )
"2.0" {
"3.0" {
"GL_ARB_shader_objects"
"GL_ARB_draw_buffers"
"GL_ARB_multitexture"
} has-gl-version-or-extensions? {
"GL_EXT_framebuffer_object"
"GL_ARB_texture_float"
} has-gl-extensions? and ;
} has-gl-version-or-extensions? ;
: pass1-program ( -- program )
vertex-shader-source <vertex-shader> check-gl-shader
@ -154,14 +153,14 @@ TUPLE: bunny-outlined
GL_TEXTURE_2D 0 iformat dim first2 0 xformat GL_UNSIGNED_BYTE f glTexImage2D ;
:: (attach-framebuffer-texture) ( texture attachment -- )
GL_FRAMEBUFFER_EXT attachment GL_TEXTURE_2D texture 0 glFramebufferTexture2DEXT
GL_DRAW_FRAMEBUFFER attachment GL_TEXTURE_2D texture 0 glFramebufferTexture2D
gl-error ;
: (make-framebuffer) ( color-texture normal-texture depth-texture -- framebuffer )
3array gen-framebuffer dup [
swap GL_COLOR_ATTACHMENT0_EXT
GL_COLOR_ATTACHMENT1_EXT
GL_DEPTH_ATTACHMENT_EXT 3array [ (attach-framebuffer-texture) ] 2each
swap GL_COLOR_ATTACHMENT0
GL_COLOR_ATTACHMENT1
GL_DEPTH_ATTACHMENT 3array [ (attach-framebuffer-texture) ] 2each
check-framebuffer
] with-framebuffer ;
@ -182,8 +181,8 @@ MACRO: (framebuffer-texture>>draw) ( iformat xformat setter -- )
: (make-framebuffer-textures) ( draw dim -- draw color normal depth )
{
[ drop ]
[ GL_RGBA16F_ARB GL_RGBA [ >>color-texture ] (framebuffer-texture>>draw) ]
[ GL_RGBA16F_ARB GL_RGBA [ >>normal-texture ] (framebuffer-texture>>draw) ]
[ GL_RGBA16F GL_RGBA [ >>color-texture ] (framebuffer-texture>>draw) ]
[ GL_RGBA16F GL_RGBA [ >>normal-texture ] (framebuffer-texture>>draw) ]
[
GL_DEPTH_COMPONENT32 GL_DEPTH_COMPONENT
[ >>depth-texture ] (framebuffer-texture>>draw)
@ -202,17 +201,17 @@ MACRO: (framebuffer-texture>>draw) ( iformat xformat setter -- )
[ drop ] [ remake-framebuffer ] if ;
: clear-framebuffer ( -- )
GL_COLOR_ATTACHMENT0_EXT glDrawBuffer
GL_COLOR_ATTACHMENT0 glDrawBuffer
0.15 0.15 0.15 1.0 glClearColor
GL_COLOR_BUFFER_BIT GL_DEPTH_BUFFER_BIT bitor glClear
GL_COLOR_ATTACHMENT1_EXT glDrawBuffer
GL_COLOR_ATTACHMENT1 glDrawBuffer
0.0 0.0 0.0 0.0 glClearColor
GL_COLOR_BUFFER_BIT glClear ;
: (pass1) ( geom draw -- )
dup framebuffer>> [
clear-framebuffer
{ GL_COLOR_ATTACHMENT0_EXT GL_COLOR_ATTACHMENT1_EXT } set-draw-buffers
{ GL_COLOR_ATTACHMENT0 GL_COLOR_ATTACHMENT1 } set-draw-buffers
pass1-program>> (draw-cel-shaded-bunny)
] with-framebuffer ;

32
extra/images/normalization/normalization.factor
View File

@ -3,7 +3,8 @@
USING: kernel accessors grouping sequences combinators
math specialized-arrays.direct.uint byte-arrays fry
specialized-arrays.direct.ushort specialized-arrays.uint
specialized-arrays.ushort specialized-arrays.float images ;
specialized-arrays.ushort specialized-arrays.float images
half-floats ;
IN: images.normalization
<PRIVATE
@ -11,30 +12,31 @@ IN: images.normalization
: add-dummy-alpha ( seq -- seq' )
3 <groups> [ 255 suffix ] map concat ;
: normalize-floats ( byte-array -- byte-array )
byte-array>float-array [ 255.0 * >integer ] B{ } map-as ;
: normalize-floats ( float-array -- byte-array )
[ 255.0 * >integer ] B{ } map-as ;
GENERIC: normalize-component-type* ( image component-type -- image )
GENERIC: normalize-component-order* ( image component-order -- image )
: normalize-component-order ( image -- image )
dup component-type>> '[ _ normalize-component-type* ] change-bitmap
dup component-order>> '[ _ normalize-component-order* ] change-bitmap ;
M: RGBA normalize-component-order* drop ;
M: float-components normalize-component-type*
drop byte-array>float-array normalize-floats ;
M: half-components normalize-component-type*
drop byte-array>half-array normalize-floats ;
M: R32G32B32A32 normalize-component-order*
drop normalize-floats ;
M: R32G32B32 normalize-component-order*
drop normalize-floats add-dummy-alpha ;
: RGB16>8 ( bitmap -- bitmap' )
: ushorts>ubytes ( bitmap -- bitmap' )
byte-array>ushort-array [ -8 shift ] B{ } map-as ; inline
M: R16G16B16A16 normalize-component-order*
drop RGB16>8 ;
M: ushort-components normalize-component-type*
drop ushorts>ubytes ;
M: R16G16B16 normalize-component-order*
drop RGB16>8 add-dummy-alpha ;
M: ubyte-components normalize-component-type*
drop ;
M: RGBA normalize-component-order* drop ;
: BGR>RGB ( bitmap -- pixels )
3 <sliced-groups> [ <reversed> ] map B{ } join ; inline

34
extra/io/serial/unix/linux/linux.factor
View File

@ -95,23 +95,23 @@ CONSTANT: PENDIN OCT: 0040000
CONSTANT: IEXTEN OCT: 0100000
M: linux lookup-baud ( n -- n )
dup H{
{ 0 OCT: 0000000 }
{ 50 OCT: 0000001 }
{ 75 OCT: 0000002 }
{ 110 OCT: 0000003 }
{ 134 OCT: 0000004 }
{ 150 OCT: 0000005 }
{ 200 OCT: 0000006 }
{ 300 OCT: 0000007 }
{ 600 OCT: 0000010 }
{ 1200 OCT: 0000011 }
{ 1800 OCT: 0000012 }
{ 2400 OCT: 0000013 }
{ 4800 OCT: 0000014 }
{ 9600 OCT: 0000015 }
{ 19200 OCT: 0000016 }
{ 38400 OCT: 0000017 }
H{
{ 0 OCT: 0000000 }
{ 50 OCT: 0000001 }
{ 75 OCT: 0000002 }
{ 110 OCT: 0000003 }
{ 134 OCT: 0000004 }
{ 150 OCT: 0000005 }
{ 200 OCT: 0000006 }
{ 300 OCT: 0000007 }
{ 600 OCT: 0000010 }
{ 1200 OCT: 0000011 }
{ 1800 OCT: 0000012 }
{ 2400 OCT: 0000013 }
{ 4800 OCT: 0000014 }
{ 9600 OCT: 0000015 }
{ 19200 OCT: 0000016 }
{ 38400 OCT: 0000017 }
{ 57600 OCT: 0010001 }
{ 115200 OCT: 0010002 }
{ 230400 OCT: 0010003 }

5
extra/mongodb/benchmark/benchmark.factor
View File

@ -2,6 +2,7 @@ USING: calendar math fry kernel assocs math.ranges bson.reader io.streams.byte-a
sequences formatting combinators namespaces io tools.time prettyprint io.encodings.binary
accessors words mongodb.driver strings math.parser bson.writer ;
FROM: mongodb.driver => find ;
FROM: memory => gc ;
IN: mongodb.benchmark
@ -175,7 +176,7 @@ CONSTANT: DOC-LARGE H{ { "base_url" "http://www.example.com/test-me" }
: deserialize ( doc-quot: ( i -- doc ) -- quot: ( -- ) )
[ 0 ] dip call( i -- doc ) assoc>bv
'[ trial-size [ _ binary [ H{ } stream>assoc 2drop ] with-byte-reader ] times ] ;
'[ trial-size [ _ binary [ H{ } stream>assoc drop ] with-byte-reader ] times ] ;
: check-for-key ( assoc key -- )
CHECK-KEY [ swap key? [ "ups... where's the key" throw ] unless ] [ 2drop ] if ;
@ -246,7 +247,7 @@ CONSTANT: DOC-LARGE H{ { "base_url" "http://www.example.com/test-me" }
: [bench-quot] ( feat-seq op-word -- quot: ( doc-word -- ) )
'[ _ swap _
'[ [ [ _ execute( -- quot ) ] dip
[ execute( -- ) ] each _ execute( quot -- quot ) benchmark ] with-result ] each
[ execute( -- ) ] each _ execute( quot -- quot ) gc benchmark ] with-result ] each
print-separator ] ;
: run-serialization-bench ( doc-word-seq feat-seq -- )

1
extra/mongodb/mmm/authors.txt
View File

@ -1 +0,0 @@
Sascha Matzke

101
extra/mongodb/mmm/mmm.factor
View File

@ -1,101 +0,0 @@
USING: accessors fry io io.encodings.binary io.servers.connection
io.sockets io.streams.byte-array kernel math mongodb.msg classes formatting
namespaces prettyprint tools.walker calendar calendar.format bson.writer.private
json.writer mongodb.operations.private mongodb.operations ;
IN: mongodb.mmm
SYMBOLS: mmm-port mmm-server-ip mmm-server-port mmm-server mmm-dump-output mmm-t-srv ;
GENERIC: dump-message ( message -- )
: check-options ( -- )
mmm-port get [ 27040 mmm-port set ] unless
mmm-server-ip get [ "127.0.0.1" mmm-server-ip set ] unless
mmm-server-port get [ 27017 mmm-server-port set ] unless
mmm-server-ip get mmm-server-port get <inet> mmm-server set ;
: read-msg-binary ( -- )
read-int32
[ write-int32 ] keep
4 - read write ;
: read-request-header ( -- msg-stub )
mdb-msg new
read-int32 MSG-HEADER-SIZE - >>length
read-int32 >>req-id
read-int32 >>resp-id
read-int32 >>opcode ;
: read-request ( -- msg-stub binary )
binary [ read-msg-binary ] with-byte-writer
[ binary [ read-request-header ] with-byte-reader ] keep ; ! msg-stub binary
: dump-request ( msg-stub binary -- )
[ mmm-dump-output get ] 2dip
'[ _ drop _ binary [ read-message dump-message ] with-byte-reader ] with-output-stream ;
: read-reply ( -- binary )
binary [ read-msg-binary ] with-byte-writer ;
: forward-request-read-reply ( msg-stub binary -- binary )
[ mmm-server get binary ] 2dip
'[ _ opcode>> _ write flush
OP_Query =
[ read-reply ]
[ f ] if ] with-client ;
: dump-reply ( binary -- )
[ mmm-dump-output get ] dip
'[ _ binary [ read-message dump-message ] with-byte-reader ] with-output-stream ;
: message-prefix ( message -- prefix message )
[ now timestamp>http-string ] dip
[ class name>> ] keep
[ "%s: %s" sprintf ] dip ; inline
M: mdb-query-msg dump-message ( message -- )
message-prefix
[ collection>> ] keep
query>> >json
"%s -> %s: %s \n" printf ;
M: mdb-insert-msg dump-message ( message -- )
message-prefix
[ collection>> ] keep
objects>> >json
"%s -> %s : %s \n" printf ;
M: mdb-reply-msg dump-message ( message -- )
message-prefix
[ cursor>> ] keep
[ start#>> ] keep
[ returned#>> ] keep
objects>> >json
"%s -> cursor: %d, start: %d, returned#: %d, -> %s \n" printf ;
M: mdb-msg dump-message ( message -- )
message-prefix drop "%s \n" printf ;
: forward-reply ( binary -- )
write flush ;
: handle-mmm-connection ( -- )
read-request
[ dump-request ] 2keep
forward-request-read-reply
[ dump-reply ] keep
forward-reply ;
: start-mmm-server ( -- )
output-stream get mmm-dump-output set
binary <threaded-server> [ mmm-t-srv set ] keep
"127.0.0.1" mmm-port get <inet4> >>insecure
[ handle-mmm-connection ] >>handler
start-server* ;
: run-mmm ( -- )
check-options
start-mmm-server ;
MAIN: run-mmm

1
extra/mongodb/mmm/summary.txt
View File

@ -1 +0,0 @@
mongo-message-monitor - a small proxy to introspect messages send to MongoDB

50
extra/mongodb/operations/operations.factor
View File

@ -64,61 +64,13 @@ GENERIC: (read-message) ( message opcode -- message )
[ opcode>> ] keep [ >>opcode ] dip
flags>> >>flags ;
M: mdb-query-op (read-message) ( msg-stub opcode -- message )
drop
[ mdb-query-msg new ] dip copy-header
read-cstring >>collection
read-int32 >>skip#
read-int32 >>return#
H{ } stream>assoc change-bytes-read >>query
dup length>> bytes-read> >
[ H{ } stream>assoc change-bytes-read >>returnfields ] when ;
M: mdb-insert-op (read-message) ( msg-stub opcode -- message )
drop
[ mdb-insert-msg new ] dip copy-header
read-cstring >>collection
V{ } clone >>objects
[ '[ _ length>> bytes-read> > ] ] keep tuck
'[ H{ } stream>assoc change-bytes-read _ objects>> push ]
while ;
M: mdb-delete-op (read-message) ( msg-stub opcode -- message )
drop
[ mdb-delete-msg new ] dip copy-header
read-cstring >>collection
H{ } stream>assoc change-bytes-read >>selector ;
M: mdb-getmore-op (read-message) ( msg-stub opcode -- message )
drop
[ mdb-getmore-msg new ] dip copy-header
read-cstring >>collection
read-int32 >>return#
read-longlong >>cursor ;
M: mdb-killcursors-op (read-message) ( msg-stub opcode -- message )
drop
[ mdb-killcursors-msg new ] dip copy-header
read-int32 >>cursors#
V{ } clone >>cursors
[ [ cursors#>> ] keep
'[ read-longlong _ cursors>> push ] times ] keep ;
M: mdb-update-op (read-message) ( msg-stub opcode -- message )
drop
[ mdb-update-msg new ] dip copy-header
read-cstring >>collection
read-int32 >>upsert?
H{ } stream>assoc change-bytes-read >>selector
H{ } stream>assoc change-bytes-read >>object ;
M: mdb-reply-op (read-message) ( msg-stub opcode -- message )
drop
[ <mdb-reply-msg> ] dip copy-header
read-longlong >>cursor
read-int32 >>start#
read-int32 [ >>returned# ] keep
[ H{ } stream>assoc drop ] accumulator [ times ] dip >>objects ;
[ H{ } stream>assoc ] accumulator [ times ] dip >>objects ;
: read-header ( message -- message )
read-int32 >>length

3
extra/noise/noise.factor
View File

@ -64,7 +64,8 @@ HINTS: hashes { byte-array fixnum fixnum fixnum } ;
image new
swap >>dim
swap >>bitmap
L >>component-order ;
L >>component-order
ubyte-components >>component-type ;
:: perlin-noise-unsafe ( table point -- value )
point unit-cube :> cube

14
extra/spheres/spheres.factor
View File

@ -148,14 +148,14 @@ M: spheres-world distance-step
: (make-reflection-depthbuffer) ( -- depthbuffer )
gen-renderbuffer [
GL_RENDERBUFFER_EXT swap glBindRenderbufferEXT
GL_RENDERBUFFER_EXT GL_DEPTH_COMPONENT32 (reflection-dim) glRenderbufferStorageEXT
GL_RENDERBUFFER swap glBindRenderbuffer
GL_RENDERBUFFER GL_DEPTH_COMPONENT32 (reflection-dim) glRenderbufferStorage
] keep ;
: (make-reflection-framebuffer) ( depthbuffer -- framebuffer )
gen-framebuffer dup [
swap [ GL_FRAMEBUFFER_EXT GL_DEPTH_ATTACHMENT_EXT GL_RENDERBUFFER_EXT ] dip
glFramebufferRenderbufferEXT
swap [ GL_DRAW_FRAMEBUFFER GL_DEPTH_ATTACHMENT GL_RENDERBUFFER ] dip
glFramebufferRenderbuffer
] with-framebuffer ;
: (plane-program) ( -- program )
@ -244,9 +244,9 @@ M: spheres-world pref-dim*
: (reflection-face) ( gadget face -- )
swap reflection-texture>> [
GL_FRAMEBUFFER_EXT
GL_COLOR_ATTACHMENT0_EXT
] 2dip 0 glFramebufferTexture2DEXT
GL_DRAW_FRAMEBUFFER
GL_COLOR_ATTACHMENT0
] 2dip 0 glFramebufferTexture2D
check-framebuffer ;
: (draw-reflection-texture) ( gadget -- )

1
extra/terrain/generation/generation.factor
View File

@ -36,6 +36,7 @@ TUPLE: segment image ;
<image>
swap >>bitmap
RGBA >>component-order
ubyte-components >>component-type
terrain-segment-size >>dim ;
: terrain-segment ( terrain at -- image )