extra/progress-bars/models/models.factor

   1 ! Copyright (C) 2011 Doug Coleman.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: accessors calendar fonts fry io io.files io.files.info
   4 kernel math models models.arrow namespaces nested-comments
   5 progress-bars threads ui.gadgets.labels ui.gadgets.panes ;
   6 IN: progress-bars.models
   7
   8 SYMBOL: progress-bar
   9
  10 : set-progress-bar ( ratio/float -- )
  11     \ progress-bar get set-model ;
  12
  13 : with-progress-bar ( quot -- )
  14     [ 0 <model> \ progress-bar ] dip with-variable ; inline
  15
  16 SYMBOL: file-size
  17
  18 : update-file-progress ( -- n )
  19     tell-input file-size get / [ set-progress-bar ] keep ;
  20
  21 : file-progress-loop ( -- )
  22     update-file-progress 1 = [
  23         100 milliseconds sleep file-progress-loop
  24     ] unless ;
  25
  26 : <file-progress-display> ( model n -- gadget )
  27     [ '[ _ make-progress-bar ] <arrow> <label-control> ] keep
  28     [ 0 ] dip make-progress-bar >>string
  29     monospace-font >>font ;
  30
  31 : with-file-reader-progress ( path encoding quot -- )
  32     '[
  33         _ dup file-info size>> file-size set
  34         _ _ [
  35             [ file-progress-loop ] "file-reader-progress" spawn drop
  36             \ progress-bar get 40 <file-progress-display> gadget. yield
  37         ] prepose
  38         [ update-file-progress drop ] compose
  39         with-file-reader
  40     ] with-progress-bar ; inline
  41