update graphics for new accessors and delegation

db4
Doug Coleman 2008-09-04 12:55:11 -05:00
parent 446fa8bbfa
commit ac364b077a
10 changed files with 161 additions and 0 deletions

View File

@ -0,0 +1 @@
Doug Coleman

View File

@ -0,0 +1 @@
Doug Coleman

View File

@ -0,0 +1,136 @@
! Copyright (C) 2007 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
USING: alien arrays byte-arrays combinators summary
io.backend graphics.viewer io io.binary io.files kernel libc
math math.functions namespaces opengl opengl.gl prettyprint
sequences strings ui ui.gadgets.panes io.encodings.binary
accessors ;
IN: graphics.bitmap
! Currently can only handle 24bit bitmaps.
! Handles row-reversed bitmaps (their height is negative)
TUPLE: bitmap magic size reserved offset header-length width
height planes bit-count compression size-image
x-pels y-pels color-used color-important rgb-quads color-index array ;
: raw-bitmap>string ( str n -- str )
{
{ 32 [ "32bit" throw ] }
{ 24 [ ] }
{ 16 [ "16bit" throw ] }
{ 8 [ "8bit" throw ] }
{ 4 [ "4bit" throw ] }
{ 2 [ "2bit" throw ] }
{ 1 [ "1bit" throw ] }
} case ;
ERROR: bitmap-magic ;
M: bitmap-magic summary
drop "First two bytes of bitmap stream must be 'BM'" ;
: parse-file-header ( bitmap -- )
2 read >string dup "BM" = [ bitmap-magic ] unless >>magic
4 read le> >>size
4 read le> >>reserved
4 read le> >>offset drop ;
: parse-bitmap-header ( bitmap -- )
4 read le> >>header-length
4 read le> >>width
4 read le> >>height
2 read le> >>planes
2 read le> >>bit-count
4 read le> >>compression
4 read le> >>size-image
4 read le> >>x-pels
4 read le> >>y-pels
4 read le> >>color-used
4 read le> >>color-important drop ;
: rgb-quads-length ( bitmap -- n )
[ offset>> 14 - ] keep header-length>> - ;
: color-index-length ( bitmap -- n )
[ width>> ] keep [ planes>> * ] keep
[ bit-count>> * 31 + 32 /i 4 * ] keep
height>> abs * ;
: parse-bitmap ( bitmap -- )
dup rgb-quads-length read >>rgb-quads
dup color-index-length read >>color-index drop ;
: load-bitmap ( path -- bitmap )
normalize-path binary [
T{ bitmap } clone
dup parse-file-header
dup parse-bitmap-header
dup parse-bitmap
] with-file-reader
dup color-index>> over bit-count>>
raw-bitmap>string >byte-array >>array ;
: save-bitmap ( bitmap path -- )
binary [
"BM" write
dup array>> length 14 + 40 + 4 >le write
0 4 >le write
54 4 >le write
40 4 >le write
{
[ width>> 4 >le write ]
[ height>> 4 >le write ]
[ planes>> 1 or 2 >le write ]
[ bit-count>> 24 or 2 >le write ]
[ compression>> 0 or 4 >le write ]
[ size-image>> 4 >le write ]
[ x-pels>> 4 >le write ]
[ y-pels>> 4 >le write ]
[ color-used>> 4 >le write ]
[ color-important>> 4 >le write ]
[ rgb-quads>> write ]
[ color-index>> write ]
} cleave
] with-file-writer ;
M: bitmap draw-image ( bitmap -- )
dup height>> 0 < [
0 0 glRasterPos2i
1.0 -1.0 glPixelZoom
] [
0 over height>> abs glRasterPos2i
1.0 1.0 glPixelZoom
] if
[ width>> ] keep
[
[ height>> abs ] keep
bit-count>> {
! { 32 [ GL_BGRA GL_UNSIGNED_INT_8_8_8_8 ] } ! broken
{ 24 [ GL_BGR GL_UNSIGNED_BYTE ] }
} case
] keep array>> glDrawPixels ;
M: bitmap width ( bitmap -- ) width>> ;
M: bitmap height ( bitmap -- ) height>> ;
: bitmap. ( path -- )
load-bitmap <graphics-gadget> gadget. ;
: bitmap-window ( path -- gadget )
load-bitmap <graphics-gadget> [ "bitmap" open-window ] keep ;
: test-bitmap24 ( -- )
"resource:extra/graphics/bitmap/test-images/thiswayup24.bmp" bitmap. ;
: test-bitmap8 ( -- )
"resource:extra/graphics/bitmap/test-images/rgb8bit.bmp" bitmap. ;
: test-bitmap4 ( -- )
"resource:extra/graphics/bitmap/test-images/rgb4bit.bmp" bitmap. ;
: test-bitmap1 ( -- )
"resource:extra/graphics/bitmap/test-images/1bit.bmp" bitmap. ;

Binary file not shown.

After

Width:  |  Height:  |  Size: 1.6 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 5.2 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 11 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 59 KiB

1
extra/graphics/tags.txt Normal file
View File

@ -0,0 +1 @@
bitmap graphics

View File

@ -0,0 +1 @@
Doug Coleman

View File

@ -0,0 +1,21 @@
! Copyright (C) 2007 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
USING: arrays kernel math math.functions namespaces opengl
ui.gadgets ui.render accessors ;
IN: graphics.viewer
TUPLE: graphics-gadget < gadget image ;
GENERIC: draw-image ( image -- )
GENERIC: width ( image -- w )
GENERIC: height ( image -- h )
M: graphics-gadget pref-dim*
image>> [ width ] keep height abs 2array ;
M: graphics-gadget draw-gadget* ( gadget -- )
origin get [ image>> draw-image ] with-translation ;
: <graphics-gadget> ( bitmap -- gadget )
\ graphics-gadget new-gadget
swap >>image ;