Progress bars for long-running operations that yield.

diff --git a/extra/progress-bars/authors.txt b/extra/progress-bars/authors.txt
new file mode 100644 (file)
index 0000000..7c1b2f2
--- /dev/null
+++ b/extra/progress-bars/authors.txt
@@ -0,0 +1 @@
+Doug Coleman

diff --git a/extra/progress-bars/models/authors.txt b/extra/progress-bars/models/authors.txt
new file mode 100644 (file)
index 0000000..7c1b2f2
--- /dev/null
+++ b/extra/progress-bars/models/authors.txt
@@ -0,0 +1 @@
+Doug Coleman

diff --git a/extra/progress-bars/models/models-docs.factor b/extra/progress-bars/models/models-docs.factor
new file mode 100644 (file)
index 0000000..6313e6b
--- /dev/null
+++ b/extra/progress-bars/models/models-docs.factor
@@ -0,0 +1,42 @@
+! Copyright (C) 2011 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: help.markup help.syntax kernel quotations threads ;
+IN: progress-bars.models
+
+HELP: set-progress-bar
+{ $values
+    { "ratio/float" "a real number between 0 and 1" }    
+}
+{ $description "Sets the progress-bar model in the current scope to the percent that the task has been completed." } ;
+
+HELP: with-file-reader-progress
+{ $values
+    { "path" "a pathname string" } { "encoding" "an encoding" } { "quot" quotation }    
+}
+{ $description "Opens a file for reading, displays a progress bar, and calls the quotation for processing the file. The progress bar will automtically update every 100 milliseconds, but only if the quotation yields (by calling " { $link yield } ") so that the UI has a chance to redraw." }
+{ $examples
+    "Loop through the Factor image file, discarding each character as it's read and updating a progress bar:"
+    { $unchecked-example """USING: system progress-bars.models prettyprint io.encodings.binary threads ;
+image binary [
+    [ 4096 read yield ] loop
+] with-file-reader-progress"""
+""
+    }
+} ;
+
+HELP: with-progress-bar
+{ $values
+    { "quot" quotation }    
+}
+{ $description "Makes a new model for a progress bar for a task that is 0% complete, sets this model in a dynamic variable in a new scope, and calls a quotation that has access to this model. Progress can be updated with " { $link set-progress-bar } "." } ;
+
+ARTICLE: "progress-bars.models" "Progress bar models"
+"The " { $vocab-link "progress-bars.models" } " vocabulary makes a progress bar model and various utility words that make progress bars for common tasks." $nl
+"Making a generic progress bar:"
+{ $subsections with-progress-bar }
+"Updating a progress-bar:"
+{ $subsections set-progress-bar }
+"A progress bar for reading files:"
+{ $subsections with-file-reader-progress } ;
+
+ABOUT: "progress-bars.models"

diff --git a/extra/progress-bars/models/models.factor b/extra/progress-bars/models/models.factor
new file mode 100644 (file)
index 0000000..eb53daf
--- /dev/null
+++ b/extra/progress-bars/models/models.factor
@@ -0,0 +1,41 @@
+! Copyright (C) 2011 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors calendar fonts fry io io.files io.files.info
+kernel math models models.arrow namespaces nested-comments
+progress-bars threads ui.gadgets.labels ui.gadgets.panes ;
+IN: progress-bars.models
+
+SYMBOL: progress-bar
+
+: set-progress-bar ( ratio/float -- )
+    \ progress-bar get set-model ;
+
+: with-progress-bar ( quot -- )
+    [ 0 <model> \ progress-bar ] dip with-variable ; inline
+
+SYMBOL: file-size
+
+: update-file-progress ( -- n )
+    tell-input file-size get / [ set-progress-bar ] keep ;
+
+: file-progress-loop ( -- )
+    update-file-progress 1 = [
+        100 milliseconds sleep file-progress-loop
+    ] unless ;
+
+: <file-progress-display> ( model n -- gadget )
+    [ '[ _ make-progress-bar ] <arrow> <label-control> ] keep
+    [ 0 ] dip make-progress-bar >>string
+    monospace-font >>font ;
+
+: with-file-reader-progress ( path encoding quot -- )
+    '[
+        _ dup file-info size>> file-size set
+        _ _ [
+            [ file-progress-loop ] "file-reader-progress" spawn drop
+            \ progress-bar get 40 <file-progress-display> gadget. yield
+        ] prepose
+        [ update-file-progress drop ] compose
+        with-file-reader
+    ] with-progress-bar ; inline
+

diff --git a/extra/progress-bars/progress-bars-docs.factor b/extra/progress-bars/progress-bars-docs.factor
new file mode 100644 (file)
index 0000000..d600e72
--- /dev/null
+++ b/extra/progress-bars/progress-bars-docs.factor
@@ -0,0 +1,19 @@
+! Copyright (C) 2011 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: help.markup help.syntax kernel math strings ;
+IN: progress-bars
+
+HELP: make-progress-bar
+{ $values
+    { "percent" "a real number between 0 and 1" } { "length" integer }
+    { "string" string }
+}
+{ $description "Makes a progress bar " { $snippet "percent" } " completed that is " { $snippet "length" } " characters long." } ;
+
+ARTICLE: "progress-bars" "Progress bars"
+"The " { $vocab-link "progress-bars" } " vocabulary implements a simple progress bar string." $nl
+"To make a generic progress bar string:"
+{ $subsections make-progress-bar }
+"The " { $vocab-link "progress-bars.models" } " vocabulary implements a word to display a progress bar that shows how much of a file has been read so far." ;
+
+ABOUT: "progress-bars"

diff --git a/extra/progress-bars/progress-bars.factor b/extra/progress-bars/progress-bars.factor
new file mode 100644 (file)
index 0000000..f1796b4
--- /dev/null
+++ b/extra/progress-bars/progress-bars.factor
@@ -0,0 +1,24 @@
+! Copyright (C) 2011 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: combinators.short-circuit kernel math math.order
+sequences ;
+IN: progress-bars
+
+ERROR: invalid-percent x ;
+
+: check-percent ( x -- x )
+    dup 0 1 between? [ invalid-percent ] unless ;
+
+ERROR: invalid-length x ;
+
+: check-length ( x -- x )
+    dup { [ 0 > ] [ integer? ] } 1&& [ invalid-length ] unless ;
+
+: (make-progress-bar) ( percent len completed-ch pending-ch -- string )
+    [ [ * >integer ] keep over - ] 2dip
+    [ <repetition> ] bi-curry@ bi* "" append-as ;
+
+: make-progress-bar ( percent length -- string )
+    [ check-percent ] [ check-length ] bi*
+    CHAR: = CHAR: - (make-progress-bar) ;
+