From ac364b077a592cf241ea5dc718591ce71f534c37 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Thu, 4 Sep 2008 12:55:11 -0500 Subject: [PATCH] update graphics for new accessors and delegation --- extra/graphics/authors.txt | 1 + extra/graphics/bitmap/authors.txt | 1 + extra/graphics/bitmap/bitmap.factor | 136 ++++++++++++++++++ extra/graphics/bitmap/test-images/1bit.bmp | Bin 0 -> 1662 bytes extra/graphics/bitmap/test-images/rgb4bit.bmp | Bin 0 -> 5318 bytes extra/graphics/bitmap/test-images/rgb8bit.bmp | Bin 0 -> 11078 bytes .../bitmap/test-images/thiswayup24.bmp | Bin 0 -> 60054 bytes extra/graphics/tags.txt | 1 + extra/graphics/viewer/authors.txt | 1 + extra/graphics/viewer/viewer.factor | 21 +++ 10 files changed, 161 insertions(+) create mode 100644 extra/graphics/authors.txt create mode 100755 extra/graphics/bitmap/authors.txt create mode 100755 extra/graphics/bitmap/bitmap.factor create mode 100644 extra/graphics/bitmap/test-images/1bit.bmp create mode 100644 extra/graphics/bitmap/test-images/rgb4bit.bmp create mode 100644 extra/graphics/bitmap/test-images/rgb8bit.bmp create mode 100644 extra/graphics/bitmap/test-images/thiswayup24.bmp create mode 100644 extra/graphics/tags.txt create mode 100755 extra/graphics/viewer/authors.txt create mode 100644 extra/graphics/viewer/viewer.factor diff --git a/extra/graphics/authors.txt b/extra/graphics/authors.txt new file mode 100644 index 0000000000..7c1b2f2279 --- /dev/null +++ b/extra/graphics/authors.txt @@ -0,0 +1 @@ +Doug Coleman diff --git a/extra/graphics/bitmap/authors.txt b/extra/graphics/bitmap/authors.txt new file mode 100755 index 0000000000..7c1b2f2279 --- /dev/null +++ b/extra/graphics/bitmap/authors.txt @@ -0,0 +1 @@ +Doug Coleman diff --git a/extra/graphics/bitmap/bitmap.factor b/extra/graphics/bitmap/bitmap.factor new file mode 100755 index 0000000000..82fdc334cb --- /dev/null +++ b/extra/graphics/bitmap/bitmap.factor @@ -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 gadget. ; + +: bitmap-window ( path -- gadget ) + load-bitmap [ "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. ; + diff --git a/extra/graphics/bitmap/test-images/1bit.bmp b/extra/graphics/bitmap/test-images/1bit.bmp new file mode 100644 index 0000000000000000000000000000000000000000..2f244c1d058bfd63c99009e24e43db3d2af59902 GIT binary patch literal 1662 zcmd6mu}&N@5QY~a(QcXY+PnZo8WyGJ9a2QJkP4yX)=xlQ0r3D)UI5Obx(-^kP>P00mA^ zwBUF^jlQ?E;2?IzW6rM6HrH!wQhyj)b6UoD@XeYt9ody`K1_Mt%?}f{KVbJy%jcAj zt>KGpdF1)G8#sXx#Xjmy4aWdZ=sgF-W=L!giOF7nXWqQfqxQZB=n3}M&%h;db954z z5E@tMx~mVf%2{3&6~$+BXh5o3M#kinNOWWu>rFlx|3%95W4uyouK-4#SClXoB~%*C^4(}0onQG*9L-9b-!uM&JH<>m6OjuQDiV1l8blvI&dpWsH&fqeed;%iU%z`!sV;|oL`;1cM@txn1q zeNvtP$iOI5M`t`8&@TI<PT&zE=wk>n#+W#})qlnu6j zqKlaxW~`Q2))-G*FH&~!a+~whBxMUv@;vdku#nh6UAzYFMb4TYyweT-0k9zwR(&q} gI+mcb*Vx}V%YV4a?71qPKl;*mGj7Ahc<-2B0n`=D`~Uy| literal 0 HcmV?d00001 diff --git a/extra/graphics/bitmap/test-images/rgb4bit.bmp b/extra/graphics/bitmap/test-images/rgb4bit.bmp new file mode 100644 index 0000000000000000000000000000000000000000..0c6f00d06c025f6947899450afd91ace50e5b57a GIT binary patch literal 5318 zcmeH~J&xNj5QP;WN5~=4`v3&C50FFT3~?!6!4ht%;Vp6o}HvQbsetmbdm>Jba9`$>-CBW z&sXO?^>E{lhR9!(7a2zZE6-lcLCee=>GUfm*FpgFiOoJB;bmNH8kGz;lh9PADMtQ8LMIPr= zXg4}Uqs}^pqnuRP#EkO(krh!9^0kd57)N6zE6X#g6{4#dWUvKPGk8B|T2&OMaBU`Hog@}yCzSE?j_kY5ozzDdN&9^7!Rfd<~Nxb9m1`KP%+#GM8WL1Ugcx?c$r6yKiRhNYa{z z;u{%M*33`}Dz9KU-R}OvRzR|Q%B3OG4yLF=zP3^Z8GkYP&uMXERL-1k{?e{>`2>{r zXBYFNxa@j74)(^93d{zP*LoAcfxoXDV-do2s*vMm{E9N{zTBqwN zG1#7Iu*qn1FvMHgqeHitXfRDk6byN03)|m^F=c{JojpwQf{_*}O{7SdJ+KHc+c-;MVPqYwvxXF0!fj`A0o{+JNRhIw zhhH771rGBRM=g4>Jhcy1TLtv8%G#IcT;J`yria!-J7_cDVz(Y_*u}!5Rek=$$@DOrpS`!Ue5OClje^DA@<`&||frp?(E6`xTf`9`LAs?I3L<1HC9C!%%NUbIsupr>TL&(RC ziHHFU0uDTc{3tk0G+;r%frpSE6R(K|EC@L85Yi(gK@$yF5OCljC{O-gX)s_xz(M?k z{Ag)SG+;r%frpSEJEMsPEC@L85b`5wHPL_t0S6vJeq2Qp4OkFx;34Ek*=eEy3jz*2 zg#4I$O*CLZz^O0)4(h@>K~Je6{i$JyE#MP}Vt@5|TU~K{LG*Zv&s(|Tp58ji=Xs3z zCiTzo=xei<$Jcs|`@9#**2gO4Fny21H}C#hM=`7ITa8IC&NjW&%%^qhzG3Ke7hR$h zN~6q`M;tGcJc}c@0^70Y4#30y8Q|C zy=ie2&f=5B?4>m=p0~DnB;o066nSzUQ8jurS&T*-LZ8RIQYE4Lhq~g^c`RD22rW$G zQD3}kFU19!#i=fjrPtM>%JSsPW4S)nxASVfMehojBC)ci#672{$)) zs$Hj9bg7W4#wwlZQM60kU+L95s&s9v-m-T=RX*>z!h)x^UVC@AX?;y2t?ql91U4+1 zsm{6^1U4)=MRex-@|YE5q5G=ULUHC(=eNn)j*wzjr;>#IgV2AB2{8lx*Di6(ITJ5Hjk=w)u;ol zc4_0W;Z>6IXntf@l2-#oKgP8L%G&;Cd?k4`Q108|(c}>CT9j<%Q+rz;m-?p70=qmm zS)?R7*{*Z7@BIT~nX+vAy-e&}={sHs#|9e{ZsoQzy_pqb@<)vosqQn-@u4Rc98fFWRvas2os*BV7p%Oa#Sl zm0wg9X~oi~(tiDpOUI4()as$RbaKH{Iim_kTLlwAaSO_?s4ARd(Nk%9k-8Jrog+rZqi6H)kO8H6v z7zWA=Q}+QcKE&?EuerLmjmj}qIM!2QlF(Ag01M*NpQ+^F=*1D( zGX+S2<&aOZgo%{{lpw@I5UM;2+8cwDPO!BjKG*2}oYay(3yWxMk#GxLf>j9_d<2%D zahS5&qQukQh@5nYen)zv2oI}=APGm8-Lq3dNTXU6j!J|HG6HgwWh*s`d*^o{XPltl z%X7HV@6vOmQL07u&PAkkK+gu`uh*jimWi`)^i4QORcu>D!zv+&a)$)rp$s`6eu823 zyo%3yB(yDpty5DuvKnC7H7_!S)@3FHN>$vtop%Y(jvK!NU9A#!$`7eRyEwchIvVO3 zSq-oxTDYu`h0~=a1eM!w*vYXVoydgw;fEOZ(5+$#HV)lJ!Q|A$O0(b~C|2q6g;3!X z%Uwfzc6{{jm3k)MiLG^;v;-SZ)bf)2STzd{0`Jp8M51p_Xk`VTD4MwKPw9U4_|PGC z4T)bY-BnqFjf?&{Ek8BQf`cIU^jQ(=o1|LiE!007ICU$9Kln6m&uMhMH_8bIhX&LUQ!XaTr0uBN)nO^3nrdeJjWYhzae4is5R)Om7C}NDO3|^BRlgL|Ztl8QA8<&Y+2V&?t@V5LA=m8l?v-4vb-QkV zyFTn*={(oHTKDRV39Nf{##9gW{K(%cnSflab-NC|35T0~@YOne7R&Is39Nf{+$@*V z-xFB(>hD>s=(q{Uz52+j^;rMy{kThTj?+ipD;dSQTIbw{qg>a$I%<;3=Z8#S{bc=+ zgS^=`*1fvff&83y*46qsXL+Zcy!~Fiy@5NO#?R^Hy~irm-`l{?Imp6JblUb?5Y1EG zc(S_3`POfv#9^J(QPDr4Ns1ni5P_D7IWcuP>K~fSfp085*Kn@FAF@H1AP8GR7J;ROV3E+(S|5qQM?i$Lm+z`u z+1DYx?KdF@T4E!F(^6<2fmQ<{gq#p0tzBBajVEtP%~j01kw`zgwqnVFi`S@BykHTe6`l zsnSh_h8DE3ce7a=dnO@5)|c>PnfvG2#C9}wSs~k4aaOI~6c4i@XiHDTEl*cGMJsh%9L0UsBev*toY=NH@wLc=mYxr!$Sl&tw$4Nk z6TvlAs4*$pt(y?SR0vYtiDhmp*_>c260@i!l{G|cIh*_M`JicF$&@;3xu?WVt;iFH zBqe+IS&v*ZBB_hgTj4-K*7j7Me8bJs)~x5&>!D&u{u4{v(x`mDHgOnACFIdfd4An| zyZlV0H)`+t9{j`vp{_zs3*4_w9EMT}xz&6fubXd|-z&e1JM-@Ibo^-PRp&(#!{4)VH+)u;CMsff#Bxul_DNLuxQung6a>maU0v-TDavT@wD6u zZ7j8DnN)vcYBRG%8w!RgaEgJL=u7+%w46h#Tf;DZd~II>eTfDF;kwMT!s!x1TN2vF zrVU$#hVbocTwPVjR4`0+4T%6N31El-WX;kS*;9junU#&Ts7KIDk{aTGYy&dK5`iV} ziMOx6@g?X!o}+Rv^i1I>s1kg=wt}c!nXvUjO#!zmfF}hHGf#>2MJ<~JC_xLioH~tE zUg#V1k~w7i+P(z(CO#l5N0$Uj$|II<3BuG@2}560Nld^&10YjssC0$=_!=z8KoB6M zK?^6EEbC0tP7BGWyWGBSUzUVe2TJLZK;e5tO@JdH+}7&GVq)KrpA@20DBlAAsluFn;VN55{RV)h&>IRfK%i{mnzLXT)xaHJ4GsEEfwpg@?T5^~UGQjt=$4BgHEAMR>t6~gPKuNT&P6DH;?0llG* zr;)vZXo$e|-O$k`jVUKhxT2VZGID$G+-Sa;Ee!-G*w19HwjK zyC`NK-v>_1qKVR`wbR0Sd)xPI)`g$TeD9X!O!bukO0egdmQM@o-ERA~Rxh-eb^>~` zJI|Novb3))M==R0d&qKI_v(;24w~o%7!-ZGHueh5xs6sI;;(x(G_G5b> [ width ] keep height abs 2array ; + +M: graphics-gadget draw-gadget* ( gadget -- ) + origin get [ image>> draw-image ] with-translation ; + +: ( bitmap -- gadget ) + \ graphics-gadget new-gadget + swap >>image ;