Merge branch 'master' of git://factorcode.org/git/factor
Slava Pestov
commit
5f534fa1ca
Factor.app/Contents/Resources/English.lproj
Factor.nib
MiniFactor.nib
basis
cairo
core-graphics
images
bitmap/loading
jpeg
png
processing
tesselation
tiff
opengl
textures
ui
backend/cocoa/views
extra
|
|
@ -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>
|
||||
|
|
|
|||
Binary file not shown.
|
|
@ -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>
|
||||
|
|
|
|||
|
|
@ -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>
|
||||
|
|
|
|||
Binary file not shown.
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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 ;
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -3,12 +3,58 @@
|
|||
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:
|
||||
L LA BGR RGB BGRA RGBA ABGR ARGB RGBX XRGB BGRX XBGR
|
||||
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 ;
|
||||
|
||||
UNION: alpha-channel BGRA RGBA ABGR ARGB R16G16B16A16 R32G32B32A32 ;
|
||||
UNION: component-order
|
||||
L LA BGR RGB BGRA RGBA ABGR ARGB RGBX XRGB BGRX XBGR ;
|
||||
|
||||
: 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 ;
|
||||
|
||||
UNION: unnormalized-integer-components
|
||||
byte-integer-components ubyte-integer-components
|
||||
short-integer-components ushort-integer-components
|
||||
int-integer-components uint-integer-components ;
|
||||
|
||||
UNION: alpha-channel BGRA RGBA ABGR ARGB ;
|
||||
|
||||
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 )
|
||||
|
||||
DEFER: bytes-per-pixel
|
||||
|
||||
<PRIVATE
|
||||
|
||||
: bytes-per-component ( component-type -- n )
|
||||
{
|
||||
{ ubyte-components [ 1 ] }
|
||||
{ ushort-components [ 2 ] }
|
||||
{ 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 ;
|
||||
|
||||
: component-count ( component-order -- n )
|
||||
{
|
||||
{ L [ 1 ] }
|
||||
{ LA [ 2 ] }
|
||||
|
|
@ -22,25 +68,11 @@ UNION: alpha-channel BGRA RGBA ABGR ARGB R16G16B16A16 R32G32B32A32 ;
|
|||
{ XRGB [ 4 ] }
|
||||
{ BGRX [ 4 ] }
|
||||
{ XBGR [ 4 ] }
|
||||
{ R16G16B16 [ 6 ] }
|
||||
{ R32G32B32 [ 12 ] }
|
||||
{ R16G16B16A16 [ 8 ] }
|
||||
{ R32G32B32A32 [ 16 ] }
|
||||
} 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 )
|
||||
|
||||
<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 -- )
|
||||
|
|
@ -48,6 +80,10 @@ GENERIC: load-image* ( path class -- image )
|
|||
|
||||
PRIVATE>
|
||||
|
||||
: bytes-per-pixel ( image -- n )
|
||||
[ component-order>> component-count ]
|
||||
[ component-type>> bytes-per-component ] bi * ;
|
||||
|
||||
: pixel-at ( x y image -- pixel )
|
||||
pixel@ subseq ;
|
||||
|
||||
|
|
|
|||
|
|
@ -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 ;
|
||||
|
|
|
|||
|
|
@ -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 )
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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 ;
|
||||
|
|
|
|||
|
|
@ -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 ;
|
||||
|
||||
|
|
|
|||
|
|
@ -1801,6 +1801,12 @@ CONSTANT: GL_FRAMEBUFFER_INCOMPLETE_MULTISAMPLE_EXT HEX: 8D56
|
|||
CONSTANT: GL_MAX_SAMPLES_EXT HEX: 8D57
|
||||
|
||||
|
||||
! GL_ARB_half_float_pixel, GL_ARB_half_float_vertex
|
||||
|
||||
|
||||
CONSTANT: GL_HALF_FLOAT_ARB HEX: 140B
|
||||
|
||||
|
||||
! GL_ARB_texture_float
|
||||
|
||||
|
||||
|
|
|
|||
|
|
@ -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 ;
|
||||
IN: opengl.textures
|
||||
|
||||
SYMBOL: non-power-of-2-textures?
|
||||
|
|
@ -22,16 +22,46 @@ SYMBOL: non-power-of-2-textures?
|
|||
|
||||
: delete-texture ( id -- ) [ glDeleteTextures ] (delete-gl-object) ;
|
||||
|
||||
GENERIC: component-order>format ( component-order -- format type )
|
||||
GENERIC: component-type>type ( component-type -- internal-format type )
|
||||
GENERIC: component-order>format ( type component-order -- type format )
|
||||
GENERIC: component-order>integer-format ( type component-order -- type format )
|
||||
|
||||
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 ;
|
||||
ERROR: unsupported-component-order component-order ;
|
||||
|
||||
M: ubyte-components component-type>type drop GL_RGBA8 GL_UNSIGNED_BYTE ;
|
||||
M: ushort-components component-type>type drop GL_RGBA16 GL_UNSIGNED_SHORT ;
|
||||
M: half-components component-type>type drop GL_RGBA16F_ARB GL_HALF_FLOAT_ARB ;
|
||||
M: float-components component-type>type drop GL_RGBA32F_ARB GL_FLOAT ;
|
||||
M: byte-integer-components component-type>type drop GL_RGBA8I_EXT GL_BYTE ;
|
||||
M: short-integer-components component-type>type drop GL_RGBA16I_EXT GL_SHORT ;
|
||||
M: int-integer-components component-type>type drop GL_RGBA32I_EXT GL_INT ;
|
||||
M: ubyte-integer-components component-type>type drop GL_RGBA8I_EXT GL_UNSIGNED_BYTE ;
|
||||
M: ushort-integer-components component-type>type drop GL_RGBA16I_EXT GL_UNSIGNED_SHORT ;
|
||||
M: uint-integer-components component-type>type drop GL_RGBA32I_EXT GL_UNSIGNED_INT ;
|
||||
|
||||
M: RGB component-order>format drop GL_RGB ;
|
||||
M: BGR component-order>format drop GL_BGR ;
|
||||
M: RGBA component-order>format drop GL_RGBA ;
|
||||
M: ARGB component-order>format
|
||||
swap GL_UNSIGNED_BYTE =
|
||||
[ drop GL_UNSIGNED_INT_8_8_8_8_REV GL_BGRA_EXT ]
|
||||
[ unsupported-component-order ] if ;
|
||||
M: BGRA component-order>format drop GL_BGRA_EXT ;
|
||||
M: BGRX component-order>format drop GL_BGRA_EXT ;
|
||||
M: LA component-order>format drop GL_LUMINANCE_ALPHA ;
|
||||
M: L component-order>format drop GL_LUMINANCE ;
|
||||
|
||||
M: object component-order>format unsupported-component-order ;
|
||||
|
||||
M: RGB component-order>integer-format drop GL_RGB_INTEGER_EXT ;
|
||||
M: BGR component-order>integer-format drop GL_BGR_INTEGER_EXT ;
|
||||
M: RGBA component-order>integer-format drop GL_RGBA_INTEGER_EXT ;
|
||||
M: BGRA component-order>integer-format drop GL_BGRA_INTEGER_EXT ;
|
||||
M: BGRX component-order>integer-format drop GL_BGRA_INTEGER_EXT ;
|
||||
M: LA component-order>integer-format drop GL_LUMINANCE_ALPHA_INTEGER_EXT ;
|
||||
M: L component-order>integer-format drop GL_LUMINANCE_INTEGER_EXT ;
|
||||
|
||||
M: object component-order>integer-format unsupported-component-order ;
|
||||
|
||||
SLOT: display-list
|
||||
|
||||
|
|
@ -50,18 +80,25 @@ 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 -- )
|
||||
: image-format ( image -- internal-format format type )
|
||||
dup component-type>>
|
||||
[ nip component-type>type ]
|
||||
[
|
||||
[ GL_TEXTURE_2D 0 GL_RGBA ] dip
|
||||
[ dim>> adjust-texture-dim first2 0 ]
|
||||
[ component-order>> component-order>format ] bi
|
||||
] dip
|
||||
glTexImage2D ;
|
||||
unnormalized-integer-components?
|
||||
[ component-order>> component-order>integer-format ]
|
||||
[ component-order>> component-order>format ] if
|
||||
] 2bi swap ;
|
||||
|
||||
:: 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 ;
|
||||
|
||||
|
|
|
|||
|
|
@ -225,6 +225,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" }
|
||||
|
|
|
|||
|
|
@ -86,6 +86,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 +374,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." ;
|
||||
|
||||
|
|
|
|||
|
|
@ -82,23 +82,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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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 )
|
||||
|
|
|
|||
Loading…
Reference in New Issue