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 c7781629c0..69eac5dc15 100644 --- a/basis/tools/scaffold/scaffold.factor +++ b/basis/tools/scaffold/scaffold.factor @@ -4,19 +4,21 @@ 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 ; +ERROR: no-vocab vocab ; +> using get conjoin ; + vocabulary>> using get [ conjoin ] [ drop ] if* ; : ($values.) ( array -- ) [ @@ -140,18 +142,26 @@ ERROR: vocab-name-contains-dot path ; : $description. ( word -- ) drop - "{ $description } ;" print ; + "{ $description \"\" } ;" print ; : help-header. ( word -- ) "HELP: " write name>> print ; -: help. ( word -- ) +: (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 ; @@ -178,12 +188,33 @@ 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 + +: check-vocab ( vocab -- vocab ) + 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 -- ) - H{ } clone using [ + [ + check-vocab prepare-scaffold [ "-docs.factor" scaffold-path ] dip swap [ set-scaffold-help-file ] [ 2drop ] if - ] with-variable ; + ] with-scaffold ; + +: scaffold-undocumented ( string -- ) + [ interesting-words. ] [ link-vocab ] bi ; : scaffold-vocab ( vocab-root string -- ) prepare-scaffold 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 ) { diff --git a/unmaintained/graphics/authors.txt b/extra/graphics/authors.txt similarity index 100% rename from unmaintained/graphics/authors.txt rename to extra/graphics/authors.txt diff --git a/unmaintained/graphics/bitmap/authors.txt b/extra/graphics/bitmap/authors.txt similarity index 100% rename from unmaintained/graphics/bitmap/authors.txt rename to extra/graphics/bitmap/authors.txt diff --git a/unmaintained/graphics/bitmap/bitmap.factor b/extra/graphics/bitmap/bitmap.factor similarity index 54% rename from unmaintained/graphics/bitmap/bitmap.factor rename to extra/graphics/bitmap/bitmap.factor index d2ddad0ae3..82fdc334cb 100755 --- a/unmaintained/graphics/bitmap/bitmap.factor +++ b/extra/graphics/bitmap/bitmap.factor @@ -4,7 +4,8 @@ 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 ; +sequences strings ui ui.gadgets.panes io.encodings.binary +accessors ; IN: graphics.bitmap ! Currently can only handle 24bit bitmaps. @@ -31,36 +32,35 @@ 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 ; + 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> 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 ; + 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 ) - [ bitmap-offset 14 - ] keep bitmap-header-length - ; + [ offset>> 14 - ] keep header-length>> - ; : color-index-length ( bitmap -- n ) - [ bitmap-width ] keep [ bitmap-planes * ] keep - [ bitmap-bit-count * 31 + 32 /i 4 * ] keep - bitmap-height abs * ; + [ width>> ] keep [ planes>> * ] keep + [ bit-count>> * 31 + 32 /i 4 * ] keep + 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 ; + dup rgb-quads-length read >>rgb-quads + dup color-index-length read >>color-index drop ; : load-bitmap ( path -- bitmap ) normalize-path binary [ @@ -69,50 +69,52 @@ M: bitmap-magic summary 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 ; + dup color-index>> over bit-count>> + raw-bitmap>string >byte-array >>array ; : save-bitmap ( bitmap path -- ) binary [ "BM" write - dup bitmap-array length 14 + 40 + 4 >le write + dup 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 + { + [ 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 bitmap-height 0 < [ + dup height>> 0 < [ 0 0 glRasterPos2i 1.0 -1.0 glPixelZoom ] [ - 0 over bitmap-height abs glRasterPos2i + 0 over height>> abs glRasterPos2i 1.0 1.0 glPixelZoom ] if - [ bitmap-width ] keep + [ width>> ] keep [ - [ bitmap-height abs ] keep - bitmap-bit-count { + [ height>> abs ] keep + bit-count>> { ! { 32 [ GL_BGRA GL_UNSIGNED_INT_8_8_8_8 ] } ! broken { 24 [ GL_BGR GL_UNSIGNED_BYTE ] } } case - ] keep bitmap-array glDrawPixels ; + ] keep array>> glDrawPixels ; -M: bitmap width ( bitmap -- ) bitmap-width ; -M: bitmap height ( bitmap -- ) bitmap-height ; +M: bitmap width ( bitmap -- ) width>> ; +M: bitmap height ( bitmap -- ) height>> ; : bitmap. ( path -- ) load-bitmap gadget. ; diff --git a/unmaintained/graphics/bitmap/test-images/1bit.bmp b/extra/graphics/bitmap/test-images/1bit.bmp similarity index 100% rename from unmaintained/graphics/bitmap/test-images/1bit.bmp rename to extra/graphics/bitmap/test-images/1bit.bmp diff --git a/unmaintained/graphics/bitmap/test-images/rgb4bit.bmp b/extra/graphics/bitmap/test-images/rgb4bit.bmp similarity index 100% rename from unmaintained/graphics/bitmap/test-images/rgb4bit.bmp rename to extra/graphics/bitmap/test-images/rgb4bit.bmp diff --git a/unmaintained/graphics/bitmap/test-images/rgb8bit.bmp b/extra/graphics/bitmap/test-images/rgb8bit.bmp similarity index 100% rename from unmaintained/graphics/bitmap/test-images/rgb8bit.bmp rename to extra/graphics/bitmap/test-images/rgb8bit.bmp diff --git a/unmaintained/graphics/bitmap/test-images/thiswayup24.bmp b/extra/graphics/bitmap/test-images/thiswayup24.bmp similarity index 100% rename from unmaintained/graphics/bitmap/test-images/thiswayup24.bmp rename to extra/graphics/bitmap/test-images/thiswayup24.bmp diff --git a/unmaintained/graphics/tags.txt b/extra/graphics/tags.txt similarity index 100% rename from unmaintained/graphics/tags.txt rename to extra/graphics/tags.txt diff --git a/unmaintained/graphics/viewer/authors.txt b/extra/graphics/viewer/authors.txt similarity index 100% rename from unmaintained/graphics/viewer/authors.txt rename to extra/graphics/viewer/authors.txt diff --git a/unmaintained/graphics/viewer/viewer.factor b/extra/graphics/viewer/viewer.factor similarity index 57% rename from unmaintained/graphics/viewer/viewer.factor rename to extra/graphics/viewer/viewer.factor index 938dc61c09..0533ffaf5d 100644 --- a/unmaintained/graphics/viewer/viewer.factor +++ b/extra/graphics/viewer/viewer.factor @@ -1,26 +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 ; +ui.gadgets ui.render accessors ; IN: graphics.viewer -TUPLE: graphics-gadget image ; +TUPLE: graphics-gadget < gadget image ; GENERIC: draw-image ( image -- ) GENERIC: width ( image -- w ) GENERIC: height ( image -- h ) M: graphics-gadget pref-dim* - graphics-gadget-image - [ width ] keep height abs 2array ; + image>> [ width ] keep height abs 2array ; M: graphics-gadget draw-gadget* ( gadget -- ) - origin get [ - graphics-gadget-image draw-image - ] with-translation ; + origin get [ image>> draw-image ] with-translation ; : ( bitmap -- gadget ) - \ graphics-gadget construct-gadget - [ set-graphics-gadget-image ] keep ; - + \ graphics-gadget new-gadget + swap >>image ; diff --git a/unfinished/vocab-browser/vocab-browser.factor b/unfinished/vocab-browser/vocab-browser.factor index c5203a4894..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,10 +59,21 @@ IN: vocab-browser [ drop ] [ "Predicate Classes" $heading nl - [ pprint-class ] each + ! [ pprint-class ] each + [ { [ ] [ superclass ] } 1arr ] map + { "CLASS" "SUPERCLASS" } prefix + print-table + ] + 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 +91,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 @@ -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" } ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +