From 56dec43eb3bc7bcf3dc9f0006a8ffdfd82e299f1 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Thu, 4 Sep 2008 00:43:18 -0500 Subject: [PATCH 01/15] add scaffold-undocumented --- basis/tools/scaffold/scaffold.factor | 14 ++++++++++++-- 1 file changed, 12 insertions(+), 2 deletions(-) diff --git a/basis/tools/scaffold/scaffold.factor b/basis/tools/scaffold/scaffold.factor index c7781629c0..571266d0ef 100644 --- a/basis/tools/scaffold/scaffold.factor +++ b/basis/tools/scaffold/scaffold.factor @@ -178,12 +178,22 @@ ERROR: vocab-name-contains-dot path ; : prepare-scaffold ( vocab-root string -- string path ) check-scaffold [ vocab>scaffold-path ] keep ; +: with-scaffold ( quot -- ) + [ H{ } clone using ] dip with-variable ; inline + : scaffold-help ( vocab-root string -- ) - H{ } clone using [ + [ prepare-scaffold [ "-docs.factor" scaffold-path ] dip swap [ set-scaffold-help-file ] [ 2drop ] if - ] with-variable ; + ] with-scaffold ; + +: scaffold-undocumented ( string -- ) + [ + words + [ "help" word-prop not ] filter + natural-sort [ help. nl ] each + ] with-scaffold ; : scaffold-vocab ( vocab-root string -- ) prepare-scaffold From 6e8f5f50f18b704e4fb0b1a08126a13eecf293b6 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Thu, 4 Sep 2008 01:29:46 -0500 Subject: [PATCH 02/15] make parts of scaffold private, fix help. for single use --- basis/tools/scaffold/scaffold.factor | 20 +++++++++++--------- 1 file changed, 11 insertions(+), 9 deletions(-) diff --git a/basis/tools/scaffold/scaffold.factor b/basis/tools/scaffold/scaffold.factor index 571266d0ef..7f55d0a217 100644 --- a/basis/tools/scaffold/scaffold.factor +++ b/basis/tools/scaffold/scaffold.factor @@ -4,19 +4,20 @@ USING: assocs io.files hashtables kernel namespaces sequences vocabs.loader io combinators io.encodings.utf8 calendar accessors math.parser io.streams.string ui.tools.operations quotations strings arrays prettyprint words vocabs sorting sets cords -sequences.lib combinators.lib ; +classes sequences.lib combinators.lib ; IN: tools.scaffold SYMBOL: developer-name SYMBOL: using ERROR: not-a-vocab-root string ; +ERROR: vocab-name-contains-separator path ; +ERROR: vocab-name-contains-dot path ; : root? ( string -- ? ) vocab-roots get member? ; -ERROR: vocab-name-contains-separator path ; -ERROR: vocab-name-contains-dot path ; +> using get conjoin ; + vocabulary>> using get [ conjoin ] [ drop ] if* ; : ($values.) ( array -- ) [ @@ -144,10 +145,12 @@ ERROR: vocab-name-contains-dot path ; : help-header. ( word -- ) "HELP: " write name>> print ; +PRIVATE> : help. ( word -- ) [ help-header. ] [ $values. ] [ $description. ] tri ; + : scaffold-help ( vocab-root string -- ) [ @@ -189,11 +193,9 @@ ERROR: vocab-name-contains-dot path ; ] with-scaffold ; : scaffold-undocumented ( string -- ) - [ - words - [ "help" word-prop not ] filter - natural-sort [ help. nl ] each - ] with-scaffold ; + words + [ [ "help" word-prop ] [ predicate? ] bi or not ] filter + natural-sort [ help. nl ] each ; : scaffold-vocab ( vocab-root string -- ) prepare-scaffold From 62235b3f7bcd8c44566410cb9c33b88c81725034 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Thu, 4 Sep 2008 01:34:01 -0500 Subject: [PATCH 03/15] make sure a vocab exists before trying to document it --- basis/tools/scaffold/scaffold.factor | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/basis/tools/scaffold/scaffold.factor b/basis/tools/scaffold/scaffold.factor index 7f55d0a217..dc7e21bc39 100644 --- a/basis/tools/scaffold/scaffold.factor +++ b/basis/tools/scaffold/scaffold.factor @@ -13,6 +13,7 @@ SYMBOL: using ERROR: not-a-vocab-root string ; ERROR: vocab-name-contains-separator path ; ERROR: vocab-name-contains-dot path ; +ERROR: no-vocab vocab ; : root? ( string -- ? ) vocab-roots get member? ; @@ -183,10 +184,15 @@ PRIVATE> : with-scaffold ( quot -- ) [ H{ } clone using ] dip with-variable ; inline + +: check-vocab ( vocab -- vocab ) + dup find-vocab-root [ no-vocab ] unless ; PRIVATE> + : scaffold-help ( vocab-root string -- ) [ + check-vocab prepare-scaffold [ "-docs.factor" scaffold-path ] dip swap [ set-scaffold-help-file ] [ 2drop ] if From 27b97b0172c88305b245f72956cde456b8eada26 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Thu, 4 Sep 2008 01:50:26 -0500 Subject: [PATCH 04/15] make a word private, docs --- basis/tools/scaffold/scaffold-docs.factor | 47 +++++++++++++++++++++++ basis/tools/scaffold/scaffold.factor | 2 +- 2 files changed, 48 insertions(+), 1 deletion(-) create mode 100644 basis/tools/scaffold/scaffold-docs.factor diff --git a/basis/tools/scaffold/scaffold-docs.factor b/basis/tools/scaffold/scaffold-docs.factor new file mode 100644 index 0000000000..e22e10f8c9 --- /dev/null +++ b/basis/tools/scaffold/scaffold-docs.factor @@ -0,0 +1,47 @@ +! Copyright (C) 2008 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: help.markup help.syntax kernel strings words ; +IN: tools.scaffold + +HELP: developer-name +{ $description "Set this symbol to hold your name so that the scaffold tools can generate the correct file header for copyright. Setting this variable in your .factor-boot-rc file is recommended." } +{ $unchecked-example "USING: namespaces tools.scaffold ;\n\"Stacky Guy\" developer-name set-global" } ; + +HELP: help. +{ $values + { "word" word } } +{ $description "Prints out scaffold help markup for a given word." } ; + +HELP: scaffold-help +{ $values + { "vocab-root" "a vocabulary root string" } { "string" string } } +{ $description "Takes an existing vocabulary and creates a help file with scaffolded help for each word. This word only works if no help file yet exists." } ; + +HELP: scaffold-undocumented +{ $values + { "string" string } } +{ $description "Prints scaffolding documenation for undocumented words in a vocabuary except for automatically generated class predicates." } ; + +{ scaffold-help scaffold-undocumented } related-words + +HELP: scaffold-vocab +{ $values + { "vocab-root" "a vocabulary root string" } { "string" string } } +{ $description "Creates a direcory in the given root for a new vocabulary and adds a main .factor file, a tests file, and an authors.txt file." } ; + +HELP: using +{ $description "Stores the vocabularies that are pulled into the documentation file from looking up the stack effect types." } ; + +ARTICLE: "tools.scaffold" "Scaffold tool" +"Scaffold setup:" +{ $subsection developer-name } +"Generate new vocabs:" +{ $subsection scaffold-vocab } +"Generate help scaffolding:" +{ $subsection scaffold-help } +{ $subsection scaffold-undocumented } +{ $subsection help. } +"Types that are unrecognized by the scaffold generator will be of type " { $link null } ". The developer should change these to strings that describe the stack effect names instead." +; + +ABOUT: "tools.scaffold" diff --git a/basis/tools/scaffold/scaffold.factor b/basis/tools/scaffold/scaffold.factor index dc7e21bc39..50e02b93a5 100644 --- a/basis/tools/scaffold/scaffold.factor +++ b/basis/tools/scaffold/scaffold.factor @@ -15,10 +15,10 @@ ERROR: vocab-name-contains-separator path ; ERROR: vocab-name-contains-dot path ; ERROR: no-vocab vocab ; + Date: Thu, 4 Sep 2008 02:03:04 -0500 Subject: [PATCH 05/15] print out doc links after listing words --- basis/tools/scaffold/scaffold.factor | 20 ++++++++++++++------ 1 file changed, 14 insertions(+), 6 deletions(-) diff --git a/basis/tools/scaffold/scaffold.factor b/basis/tools/scaffold/scaffold.factor index 50e02b93a5..84636dc106 100644 --- a/basis/tools/scaffold/scaffold.factor +++ b/basis/tools/scaffold/scaffold.factor @@ -146,16 +146,14 @@ ERROR: no-vocab vocab ; : help-header. ( word -- ) "HELP: " write name>> print ; -PRIVATE> -: help. ( word -- ) +: (help.) ( word -- ) [ help-header. ] [ $values. ] [ $description. ] tri ; - dup find-vocab-root [ no-vocab ] unless ; PRIVATE> +: link-vocab ( vocab -- ) + check-vocab + "Edit documentation: " write + [ find-vocab-root ] keep + [ append-path ] keep "-docs.factor" append append-path + . ; + +: help. ( word -- ) + [ (help.) ] [ nl vocabulary>> link-vocab ] bi ; : scaffold-help ( vocab-root string -- ) [ @@ -199,9 +206,10 @@ PRIVATE> ] with-scaffold ; : scaffold-undocumented ( string -- ) - words + dup words [ [ "help" word-prop ] [ predicate? ] bi or not ] filter - natural-sort [ help. nl ] each ; + natural-sort [ (help.) nl ] each + link-vocab ; : scaffold-vocab ( vocab-root string -- ) prepare-scaffold From 2d48c99407892d54bbdfb5e4732d244d101a500a Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Thu, 4 Sep 2008 07:21:54 -0500 Subject: [PATCH 06/15] vocab-browser: Add indices for authors and tags --- unfinished/vocab-browser/vocab-browser.factor | 41 ++++++++++++++++++- 1 file changed, 40 insertions(+), 1 deletion(-) diff --git a/unfinished/vocab-browser/vocab-browser.factor b/unfinished/vocab-browser/vocab-browser.factor index c5203a4894..3f2d2d7b9a 100644 --- a/unfinished/vocab-browser/vocab-browser.factor +++ b/unfinished/vocab-browser/vocab-browser.factor @@ -254,6 +254,40 @@ M: load-this-vocab pprint* ( obj -- ) ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +M: vocab-author pprint* ( vocab-author -- ) [ name>> ] [ ] bi write-object ; + +: $vocab-authors ( seq -- ) + drop all-authors [ vocab-author boa ] map print-seq ; + +ARTICLE: "vocab-authors" "Vocabulary Authors" { $vocab-authors } ; + +: vocabs-by-author ( author -- vocab-names ) + authored values concat [ name>> ] map ; + +: $vocabs-by-author ( seq -- ) + first name>> vocabs-by-author print-these-vocabs ; + +M: vocab-author article-content ( vocab-author -- content ) + { $vocabs-by-author } swap suffix ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +M: vocab-tag pprint* ( vocab-tag -- ) [ name>> ] [ ] bi write-object ; + +: print-vocab-tags ( -- ) all-tags [ vocab-tag boa ] map print-seq ; + +: $vocab-tags ( seq -- ) drop print-vocab-tags ; + +ARTICLE: "vocab-tags" "Vocabulary Tags" { $vocab-tags } ; + +: $vocabs-with-tag ( seq -- ) + first tagged values concat [ name>> ] map print-these-vocabs ; + +M: vocab-tag article-content ( vocab-tag -- content ) + name>> { $vocabs-with-tag } swap suffix ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + ARTICLE: "vocab-index-all" "All Vocabularies" { $all-vocabs } ; ARTICLE: "vocab-index-loaded" "Loaded Vocabularies" { $loaded-vocabs } ; ARTICLE: "vocab-index-unloaded" "Unloaded Vocabularies" { $loaded-vocabs } ; @@ -268,4 +302,9 @@ ARTICLE: "vocab-indices" "Vocabulary Indices" { $subsection "vocab-index-extra" } { $subsection "vocab-index-all" } { $subsection "vocab-index-loaded" } - { $subsection "vocab-index-unloaded" } ; \ No newline at end of file + { $subsection "vocab-index-unloaded" } + { $subsection "vocab-authors" } + { $subsection "vocab-tags" } ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + From 19036845bdeba1689f371f27a7d5fa9841ccf523 Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Thu, 4 Sep 2008 09:07:53 -0500 Subject: [PATCH 07/15] vocab-browser: Display symbols separate from words --- unfinished/vocab-browser/vocab-browser.factor | 11 ++++++++++- 1 file changed, 10 insertions(+), 1 deletion(-) diff --git a/unfinished/vocab-browser/vocab-browser.factor b/unfinished/vocab-browser/vocab-browser.factor index 3f2d2d7b9a..b1e719dbfe 100644 --- a/unfinished/vocab-browser/vocab-browser.factor +++ b/unfinished/vocab-browser/vocab-browser.factor @@ -74,7 +74,15 @@ IN: vocab-browser [ pprint-class ] each ] if - + + dup vocab words [ class? not ] filter [ symbol? ] filter natural-sort + dup empty? + [ drop ] + [ + "Symbols" $heading nl + print-seq + ] + if dup vocab words [ generic? ] filter natural-sort dup empty? @@ -92,6 +100,7 @@ IN: vocab-browser [ builtin-class? not ] filter [ tuple-class? not ] filter [ generic? not ] filter + [ symbol? not ] filter [ word? ] filter natural-sort [ [ ] [ word-effect-as-string ] bi 2array ] map From fcd89748aaf182500498bde215ff519086736909 Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Thu, 4 Sep 2008 10:50:22 -0500 Subject: [PATCH 08/15] vocab-browser: Improve predicate class listing --- unfinished/vocab-browser/vocab-browser.factor | 17 ++++------------- 1 file changed, 4 insertions(+), 13 deletions(-) diff --git a/unfinished/vocab-browser/vocab-browser.factor b/unfinished/vocab-browser/vocab-browser.factor index b1e719dbfe..cec2dd21e7 100644 --- a/unfinished/vocab-browser/vocab-browser.factor +++ b/unfinished/vocab-browser/vocab-browser.factor @@ -20,18 +20,6 @@ IN: vocab-browser ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -: pprint-class ( class -- ) - [ - \ TUPLE: pprint-word dup pprint-word - dup superclass tuple eq? - [ "<" text dup superclass pprint-word ] unless - pprint-; - ] - with-pprint nl ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - : word-effect-as-string ( word -- string ) stack-effect dup [ effect>string ] @@ -71,7 +59,10 @@ IN: vocab-browser [ drop ] [ "Predicate Classes" $heading nl - [ pprint-class ] each + ! [ pprint-class ] each + [ { [ ] [ superclass ] } 1arr ] map + { "CLASS" "SUPERCLASS" } prefix + print-table ] if From 24b449fb36ee7189087dc89fc2c0194b133a202a Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Thu, 4 Sep 2008 12:36:47 -0500 Subject: [PATCH 09/15] only generate scaffold for interesting, ungenerated words --- basis/tools/scaffold/scaffold.factor | 15 ++++++++++----- 1 file changed, 10 insertions(+), 5 deletions(-) diff --git a/basis/tools/scaffold/scaffold.factor b/basis/tools/scaffold/scaffold.factor index 84636dc106..7d65d7ada0 100644 --- a/basis/tools/scaffold/scaffold.factor +++ b/basis/tools/scaffold/scaffold.factor @@ -150,10 +150,18 @@ ERROR: no-vocab vocab ; : (help.) ( word -- ) [ help-header. ] [ $values. ] [ $description. ] tri ; +: interesting-words ( vocab -- array ) + words + [ [ "help" word-prop ] [ predicate? ] bi or not ] filter + natural-sort ; + +: interesting-words. ( vocab -- ) + interesting-words [ (help.) nl ] each ; + : help-file-string ( str1 -- str2 ) [ [ "IN: " write print nl ] - [ words natural-sort [ (help.) nl ] each ] + [ interesting-words. ] [ "ARTICLE: " write unparse dup write bl print ";" print nl ] [ "ABOUT: " write unparse print ] quad ] with-string-writer ; @@ -206,10 +214,7 @@ PRIVATE> ] with-scaffold ; : scaffold-undocumented ( string -- ) - dup words - [ [ "help" word-prop ] [ predicate? ] bi or not ] filter - natural-sort [ (help.) nl ] each - link-vocab ; + [ interesting-words. ] [ link-vocab ] bi ; : scaffold-vocab ( vocab-root string -- ) prepare-scaffold From 446fa8bbfa84b4ed97018aa6a3dbce01d06bbd8f Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Thu, 4 Sep 2008 12:37:50 -0500 Subject: [PATCH 10/15] add empty string to $description --- basis/tools/scaffold/scaffold.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/basis/tools/scaffold/scaffold.factor b/basis/tools/scaffold/scaffold.factor index 7d65d7ada0..69eac5dc15 100644 --- a/basis/tools/scaffold/scaffold.factor +++ b/basis/tools/scaffold/scaffold.factor @@ -142,7 +142,7 @@ ERROR: no-vocab vocab ; : $description. ( word -- ) drop - "{ $description } ;" print ; + "{ $description \"\" } ;" print ; : help-header. ( word -- ) "HELP: " write name>> print ; From ac364b077a592cf241ea5dc718591ce71f534c37 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Thu, 4 Sep 2008 12:55:11 -0500 Subject: [PATCH 11/15] 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 ; From fcdb7727134df0d2fbf79a9be821026d150d3ca9 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Thu, 4 Sep 2008 12:55:39 -0500 Subject: [PATCH 12/15] remove graphics from unmaintained --- unmaintained/graphics/authors.txt | 1 - unmaintained/graphics/bitmap/authors.txt | 1 - unmaintained/graphics/bitmap/bitmap.factor | 134 ------------------ .../graphics/bitmap/test-images/1bit.bmp | Bin 1662 -> 0 bytes .../graphics/bitmap/test-images/rgb4bit.bmp | Bin 5318 -> 0 bytes .../graphics/bitmap/test-images/rgb8bit.bmp | Bin 11078 -> 0 bytes .../bitmap/test-images/thiswayup24.bmp | Bin 60054 -> 0 bytes unmaintained/graphics/tags.txt | 1 - unmaintained/graphics/viewer/authors.txt | 1 - unmaintained/graphics/viewer/viewer.factor | 26 ---- 10 files changed, 164 deletions(-) delete mode 100644 unmaintained/graphics/authors.txt delete mode 100755 unmaintained/graphics/bitmap/authors.txt delete mode 100755 unmaintained/graphics/bitmap/bitmap.factor delete mode 100644 unmaintained/graphics/bitmap/test-images/1bit.bmp delete mode 100644 unmaintained/graphics/bitmap/test-images/rgb4bit.bmp delete mode 100644 unmaintained/graphics/bitmap/test-images/rgb8bit.bmp delete mode 100644 unmaintained/graphics/bitmap/test-images/thiswayup24.bmp delete mode 100644 unmaintained/graphics/tags.txt delete mode 100755 unmaintained/graphics/viewer/authors.txt delete mode 100644 unmaintained/graphics/viewer/viewer.factor diff --git a/unmaintained/graphics/authors.txt b/unmaintained/graphics/authors.txt deleted file mode 100644 index 7c1b2f2279..0000000000 --- a/unmaintained/graphics/authors.txt +++ /dev/null @@ -1 +0,0 @@ -Doug Coleman diff --git a/unmaintained/graphics/bitmap/authors.txt b/unmaintained/graphics/bitmap/authors.txt deleted file mode 100755 index 7c1b2f2279..0000000000 --- a/unmaintained/graphics/bitmap/authors.txt +++ /dev/null @@ -1 +0,0 @@ -Doug Coleman diff --git a/unmaintained/graphics/bitmap/bitmap.factor b/unmaintained/graphics/bitmap/bitmap.factor deleted file mode 100755 index d2ddad0ae3..0000000000 --- a/unmaintained/graphics/bitmap/bitmap.factor +++ /dev/null @@ -1,134 +0,0 @@ -! 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 ; -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 - over set-bitmap-magic - 4 read le> over set-bitmap-size - 4 read le> over set-bitmap-reserved - 4 read le> swap set-bitmap-offset ; - -: parse-bitmap-header ( bitmap -- ) - 4 read le> over set-bitmap-header-length - 4 read le> over set-bitmap-width - 4 read le> over set-bitmap-height - 2 read le> over set-bitmap-planes - 2 read le> over set-bitmap-bit-count - 4 read le> over set-bitmap-compression - 4 read le> over set-bitmap-size-image - 4 read le> over set-bitmap-x-pels - 4 read le> over set-bitmap-y-pels - 4 read le> over set-bitmap-color-used - 4 read le> swap set-bitmap-color-important ; - -: rgb-quads-length ( bitmap -- n ) - [ bitmap-offset 14 - ] keep bitmap-header-length - ; - -: color-index-length ( bitmap -- n ) - [ bitmap-width ] keep [ bitmap-planes * ] keep - [ bitmap-bit-count * 31 + 32 /i 4 * ] keep - bitmap-height abs * ; - -: parse-bitmap ( bitmap -- ) - dup rgb-quads-length read over set-bitmap-rgb-quads - dup color-index-length read swap set-bitmap-color-index ; - -: 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 bitmap-color-index over bitmap-bit-count - raw-bitmap>string >byte-array over set-bitmap-array ; - -: save-bitmap ( bitmap path -- ) - binary [ - "BM" write - dup bitmap-array length 14 + 40 + 4 >le write - 0 4 >le write - 54 4 >le write - - 40 4 >le write - dup bitmap-width 4 >le write - dup bitmap-height 4 >le write - dup bitmap-planes 1 or 2 >le write - dup bitmap-bit-count 24 or 2 >le write - dup bitmap-compression 0 or 4 >le write - dup bitmap-size-image 4 >le write - dup bitmap-x-pels 4 >le write - dup bitmap-y-pels 4 >le write - dup bitmap-color-used 4 >le write - dup bitmap-color-important 4 >le write - dup bitmap-rgb-quads write - bitmap-color-index write - ] with-file-writer ; - -M: bitmap draw-image ( bitmap -- ) - dup bitmap-height 0 < [ - 0 0 glRasterPos2i - 1.0 -1.0 glPixelZoom - ] [ - 0 over bitmap-height abs glRasterPos2i - 1.0 1.0 glPixelZoom - ] if - [ bitmap-width ] keep - [ - [ bitmap-height abs ] keep - bitmap-bit-count { - ! { 32 [ GL_BGRA GL_UNSIGNED_INT_8_8_8_8 ] } ! broken - { 24 [ GL_BGR GL_UNSIGNED_BYTE ] } - } case - ] keep bitmap-array glDrawPixels ; - -M: bitmap width ( bitmap -- ) bitmap-width ; -M: bitmap height ( bitmap -- ) 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/unmaintained/graphics/bitmap/test-images/1bit.bmp b/unmaintained/graphics/bitmap/test-images/1bit.bmp deleted file mode 100644 index 2f244c1d058bfd63c99009e24e43db3d2af59902..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 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| diff --git a/unmaintained/graphics/bitmap/test-images/rgb4bit.bmp b/unmaintained/graphics/bitmap/test-images/rgb4bit.bmp deleted file mode 100644 index 0c6f00d06c025f6947899450afd91ace50e5b57a..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 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 ( bitmap -- gadget ) - \ graphics-gadget construct-gadget - [ set-graphics-gadget-image ] keep ; - From ac8075f30e5abdbc2c026e3f78bf1e506d2398e2 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Thu, 4 Sep 2008 13:22:35 -0500 Subject: [PATCH 13/15] support 8bit bitmaps --- extra/graphics/bitmap/bitmap.factor | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/extra/graphics/bitmap/bitmap.factor b/extra/graphics/bitmap/bitmap.factor index 82fdc334cb..eff4542da4 100755 --- a/extra/graphics/bitmap/bitmap.factor +++ b/extra/graphics/bitmap/bitmap.factor @@ -20,7 +20,7 @@ TUPLE: bitmap magic size reserved offset header-length width { 32 [ "32bit" throw ] } { 24 [ ] } { 16 [ "16bit" throw ] } - { 8 [ "8bit" throw ] } + { 8 [ ] } { 4 [ "4bit" throw ] } { 2 [ "2bit" throw ] } { 1 [ "1bit" throw ] } @@ -110,6 +110,7 @@ M: bitmap draw-image ( bitmap -- ) bit-count>> { ! { 32 [ GL_BGRA GL_UNSIGNED_INT_8_8_8_8 ] } ! broken { 24 [ GL_BGR GL_UNSIGNED_BYTE ] } + { 8 [ GL_LUMINANCE GL_UNSIGNED_BYTE ] } } case ] keep array>> glDrawPixels ; From a5966269474ce20371970453f4e403e183aaa1e5 Mon Sep 17 00:00:00 2001 From: "U-SLAVA-DFB8FF805\\Slava" Date: Thu, 4 Sep 2008 15:53:46 -0500 Subject: [PATCH 14/15] Fix dinput for recent slot renaming --- basis/windows/dinput/constants/constants.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/basis/windows/dinput/constants/constants.factor b/basis/windows/dinput/constants/constants.factor index b918ec121b..6c55ff0e67 100755 --- a/basis/windows/dinput/constants/constants.factor +++ b/basis/windows/dinput/constants/constants.factor @@ -22,7 +22,7 @@ SYMBOLS: : (offsetof) ( field struct -- offset ) [ (field-spec-of) offset>> ] [ drop 0 ] if* ; : (sizeof) ( field struct -- size ) - [ (field-spec-of) class>> "[" split1 drop heap-size ] [ drop 1 ] if* ; + [ (field-spec-of) type>> "[" split1 drop heap-size ] [ drop 1 ] if* ; : (flag) ( thing -- integer ) { From ca1e6f1f3f10a03f903f986bebae7426bb18625e Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Thu, 4 Sep 2008 17:31:22 -0500 Subject: [PATCH 15/15] Revert "support 8bit bitmaps" This reverts commit ac8075f30e5abdbc2c026e3f78bf1e506d2398e2. --- extra/graphics/bitmap/bitmap.factor | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/extra/graphics/bitmap/bitmap.factor b/extra/graphics/bitmap/bitmap.factor index eff4542da4..82fdc334cb 100755 --- a/extra/graphics/bitmap/bitmap.factor +++ b/extra/graphics/bitmap/bitmap.factor @@ -20,7 +20,7 @@ TUPLE: bitmap magic size reserved offset header-length width { 32 [ "32bit" throw ] } { 24 [ ] } { 16 [ "16bit" throw ] } - { 8 [ ] } + { 8 [ "8bit" throw ] } { 4 [ "4bit" throw ] } { 2 [ "2bit" throw ] } { 1 [ "1bit" throw ] } @@ -110,7 +110,6 @@ M: bitmap draw-image ( bitmap -- ) bit-count>> { ! { 32 [ GL_BGRA GL_UNSIGNED_INT_8_8_8_8 ] } ! broken { 24 [ GL_BGR GL_UNSIGNED_BYTE ] } - { 8 [ GL_LUMINANCE GL_UNSIGNED_BYTE ] } } case ] keep array>> glDrawPixels ;