r1363 - in cpu/x86/pc/olpc: . via

Author: wmb
Date: 2009-09-18 03:04:26 +0200 (Fri, 18 Sep 2009)
New Revision: 1363

Modified:
   cpu/x86/pc/olpc/gridmap.fth
   cpu/x86/pc/olpc/via/copynand.fth
Log:
OLPC file system update utility - added scaling to grid map display
so that large filesystem updates will fit on the screen.

Modified: cpu/x86/pc/olpc/gridmap.fth
===================================================================
--- cpu/x86/pc/olpc/gridmap.fth	2009-09-18 01:02:26 UTC (rev 1362)
+++ cpu/x86/pc/olpc/gridmap.fth	2009-09-18 01:04:26 UTC (rev 1363)
@@ -8,14 +8,30 @@
 9 constant grid-h

d# 128 value #cols
+d# 94 value #rows
+: max-grid  ( -- n )  #rows #cols *  ;
+
 \needs xy+ : xy+  ( x1 y1 x2 y2 -- x3 y3 )  rot + -rot  + swap  ;
 \needs xy* : xy*  ( x y w h -- x*w y*h )  rot *  >r  * r>  ;

: do-fill  ( color x y w h -- )  " fill-rectangle" $call-screen  ;

+1 value scale-factor
+: scale-block#  ( eblock# -- )  scale-factor /  ;
+: set-grid-scale  ( #eblocks -- )
+   d# 1000 1  do     ( #eblocks )
+      dup i /  max-grid <=  if   ( #eblocks )
+         drop                    ( )
+         i to scale-factor       ( )
+         unloop exit
+      then                       ( #eblocks )
+   loop
+   true abort" Grid map scale factor too large"
+;
+
 \ States:  0:erased  1:bad  2:waiting for write  3:written

-: >loc  ( eblock# -- x y )  #cols /mod  grid-w grid-h xy*  ulhc xy+  ;
+: >loc  ( eblock# -- x y )  scale-block# #cols /mod  grid-w grid-h xy*  ulhc xy+  ;

: show-state  ( eblock# state -- )  swap >loc  glyph-w glyph-h  do-fill  ;

Modified: cpu/x86/pc/olpc/via/copynand.fth
===================================================================
--- cpu/x86/pc/olpc/via/copynand.fth	2009-09-18 01:02:26 UTC (rev 1362)
+++ cpu/x86/pc/olpc/via/copynand.fth	2009-09-18 01:04:26 UTC (rev 1363)
@@ -129,17 +129,19 @@
 h# ff h# ff     0  rgb>565 constant pending-color  \ yellow
     0 h# ff     0  rgb>565 constant written-color  \ green
     0 h# ff h# ff  rgb>565 constant strange-color  \ cyan
-h# ff h# ff h# ff  rgb>565 constant starting-color \ white
+h# e8 h# e8 h# e8  rgb>565 constant starting-color \ very light gray

-d# 22 constant status-line
+d# 28 constant status-line

: gshow-init  ( #eblocks -- )
+   dup set-grid-scale
    cursor-off  " erase-screen" $call-screen

starting-color   ( #eblocks color )
-   swap 0  ?do  i over show-state  loop
-   drop
-   0 status-line at-xy  
+   over 0  ?do  i over show-state  loop  ( #eblocks color )
+   drop                                  ( #eblocks )
+   1 status-line at-xy  
+   ." Blocks/square: " scale-factor .d  ." Total blocks: " .d
 ;

: gshow-erasing ( #eblocks -- )   drop  ." Erasing  "  ;
@@ -150,7 +152,7 @@
 : gshow-clean     ( eblock# -- )  clean-color   show-state  ;
 : gshow-strange   ( eblock# -- )  strange-color show-state  ;

-: gshow-cleaning ( -- )  d# 26 status-line at-xy  ." Cleanmarkers"  cr  ;
+: gshow-cleaning ( -- )  7 status-line at-xy  ." Cleanmarkers"  cr  ;
 : gshow-done  ( -- )  cursor-on  ;

: gshow-pending  ( eblock# -- )  pending-color  show-state  ;
@@ -165,7 +167,7 @@
    drop
 ;

-: show-eblock#  ( eblock# -- )  d# 20 status-line at-xy .x  ;
+: show-eblock#  ( eblock# -- )  d# 40 status-line at-xy .d  ;
 : gshow-written  ( eblock# -- )
    dup  written-color  show-state
    show-eblock#