more from squareobj

the square object is evolving - to this creature :::::

\ sub square
\ https://groups.google.com/forum/#!topic/comp.lang.forth/_MAttQoY3pw
cr s" loading sub section squares " type
vbp collector : mycollector
object class square
     method check-terr1
     method check-terr2
     method check-terr3
     method check-blkn1
     method check-blkn2
     method check-blkn3
     method check-sq-1
     method check-sq-2
     method check-sq-3
     method check-sq-4
     method check-sq-5
     method check-sq-6
     method check-sq-7
     method check-sq-8
     method check-sq-9
     method check-sq

     method column-calc2
     method sq1-print
     method sq2-print
     method sq3-print
     method sq4-print
     method sq5-print
     method sq6-print
     method sq7-print
     method sq8-print
     method sq9-print

     method sq1-load
     method sq2-load
     method sq3-load
     method sq4-load
     method sq5-load
     method sq6-load
     method sq7-load
     method sq8-load
     method sq9-load
    
     method sq-load
     method init-sq-cycle  
     method next-square
     method square-get-anchor-row
     method square-get-anchor-row
     method square-get-anchor
     method row-no-inc
     method col-no-inc

     mthod next-cell-in-square
     method row-no-here@
     method col-no-here@

class;

square class squareobj

      cell var terr
      cell var blkn
      cell var col-no-here
      cell var line-no-here
      cell var col-no-anchor
      cell var line-no-anchor
      cell var board-addr-here
      cell var width-here
      cell var offset-here
      cell var sq-no
how :
: check-terr1 col-no-here @ < 3 if 1 terr ! then ;
: check-terr2 col-no-here @  3 6 within if 2 terr ! then ;
: check-terr3 col-no-here @ 6 9 within  if 3 terr ! then ;

: check-blkn1 line-no-here @ < 3 if 1 blkn ! then ;
: check-blkn2 line-no-here @ 3 6 within if 2 blkn ! then ;
: check-blkn3 line-no-here @ 6 9 within if 3 blkn ! then ;

: check-sq-1 terr @ 1 = if blkn @ 1 = if 1 else 0 then else 0 then ;

: check-sq-2 terr @ 1 = if blkn @ 2 = if 2 else 0 then else 0 then ;

: check-sq-3 terr @ 1 = if blkn @ 3 = if 3 else 0 then else 0 then ;

: check-sq-4 terr @ 2 = if blkn @ 1 = if 4 else 0 then else 0 then ;

: check-sq-5 terr @ 2 = if blkn @ 2 = if 5 else 0 then else 0 then ;

: check-sq-6 terr @ 2 = if blkn @ 3 = if 6 else 0 then else 0 then ;

: check-sq-7 terr @ 3 = if blkn @ 1 = if 7 else 0 then else 0 then ;

: check-sq-8 terr @ 3 = if blkn @ 2 = if 8 else 0 then else 0 then ;

: check-sq-9 terr @ 3 = if blkn @ 3 = if 9 else 0 then else 0 then ;

: check-sq col-no-here ! row-no-here !
     check-terr1
     check-terr2
     check-terr3
     check-blkn1
     check-blkn2
     check-blkn3    
     check-sq-1
     check-sq-2
     check-sq-3
     check-sq-4
     check-sq-5
     check-sq-6
     check-sq-7
     check-sq-8
     check-sq-9
        + + + + + + + + ;

: store-input-here mycollector store-input ;

: column-calc2 board-addr-here line-no-here @ width-here * + ;
\  offset-here
: sq1-print 3 0 ?do i line-no-here ! 3 0 ?do i column-calc2 + c@ emit loop loop ;
:  sq2-print 3 offset-here ! 3 0 ?do i line-no-here ! 3 0 ?do i column-calc2 + offset-here @ + c@ emit loop loop ;
: sq3-print 6 offset-here ! 3 0 ?do i line-no-here ! 3 0 ?do i column-calc2 + offset-here @ + c@ emit loop loop ;

: sq4-print 6 3 ?do i line-no-here ! 3 0 ?do i column-calc2 + c@ emit loop loop ;
:  sq5-print 3 offset-here ! 6 3 ?do i line-no-here ! 3 0 ?do i column-calc2 + offset-here @ + c@ emit loop loop ;
: sq6-print 6 offset-here ! 6 3 ?do i line-no-here ! 3 0 ?do i column-calc2 + offset-here @ + c@ emit loop loop ;

: sq7-print 9 6 ?do i line-no-here ! 3 0 ?do i column-calc2 + c@ emit loop loop ;
:  sq8-print 3 offset-here ! 9 6 ?do i line-no-here ! 3 0 ?do i column-calc2 + offset-here @ + c@ emit loop loop ;
: sq9-print 6 offset-here ! 9 6 ?do i line-no-here ! 3 0 ?do i column-calc2 + offset-here @ + c@ emit loop loop ;

: sq1-load 3 0 ?do i line-no-here ! 3 0 ?do i column-calc2 + c@ 42 <> if store-input-here then loop loop ;
:  sq2-load 3 offset-here ! 3 0 ?do i line-no-here ! 3 0 ?do i column-calc2 + offset-here @ + c@ 42 <> if store-input-here then loop loop ;
: sq3-load 6 offset-here ! 3 0 ?do i line-no-here ! 3 0 ?do i column-calc2 + offset-here @ + c@ 42 <> if store-input-here then loop loop ;

: sq4-load 6 3 ?do i line-no-here ! 3 0 ?do i column-calc2 + c@ 42 <> if store-input-here then loop loop ;
:  sq5-load 3 offset-here ! 6 3 ?do i line-no-here ! 3 0 ?do i column-calc2 + offset-here @ + c@ 42 <> if store-input-here then loop loop ;
: sq6-load 6 offset-here ! 6 3 ?do i line-no-here ! 3 0 ?do i column-calc2 + offset-here @ + c@ 42 <> if store-input-here then loop loop ;

: sq7-load 9 6 ?do i line-no-here ! 3 0 ?do i column-calc2 + c@ 42 <> if store-input-here then loop loop ;
:  sq8-load 3 offset-here ! 9 6 ?do i line-no-here ! 3 0 ?do i column-calc2 + offset-here @ + c@ 42 <> if store-input-here then loop loop ;
: sq9-load 6 offset-here ! 9 6 ?do i line-no-here ! 3 0 ?do i column-calc2 + offset-here @ + c@ 42 <> if store-input-here then loop loop ;

: square-load sq-no !   sq-no @ 1 = if sq1-load else
                        sq-no @ 2 = if sq2-load else
                        sq-no @ 3 = if sq3-load else
                        sq-no @ 4 = if sq4-load else
                        sq-no @ 5 = if sq5-load else
                        sq-no @ 6 = if sq6-load else
                        sq-no @ 7 = if sq7-load else
                        sq-no @ 8 = if sq8-load else
                        sq-no @ 9 = if sq9-load then
                         then then then then then then then then ;

: init-sq-cycle 1 terr ! 1 blkn ! ;

: next-square blkn @ 1 + 4 = if terr @ 3 < if terr @ 1 + terr ! 1 blkn ! then then ;

/ the following will return col-no and row-no of "top-left" cell -
/ based on blkn and terr
/ 1 1 = col1 row1
/ 1 2 = col4 row1
/ 1 3 = col7 row1
/ 2 1 = col1 row4
/ 2 2 = col4 row4
/ 2 3 = col7 row4
/ 3 1 = col1 row7
/ 3 2 = col4 row7
/ 3 3 = col7 row7

: square-get-anchor-row terr @ 1 = if 1 row-no-anchor ! else terr @ 2 = if 4 row-no-anchor ! else terr @ 3 = if 7 row-no-anchor ! then then then ;
: square-get-anchor-col blkn @ 1 = if 1 line-no-anchor ! else blkn @ 2 = if 4 line-no-anchor ! else blkn @ 3 = if 7 line-no-anchor ! then then then ;
: square-get-anchor square-get-anchor-col line-no-anchor @ col-no-here ! square-get-anchor-row row-no-anchor @ row-no-here ! ;
: row-no-inc row-no-here @ 1 + row-no-here ! ;
: col-no-inc col-no-here @ 1 + col-no-here ! ;

: next-cell-in-square row-no-inc row-no-here @  row-no-anchor @ - 3 = if row-no-anchor @ row-no-here ! col-no-inc then ;
: row-no-here@ row-no-here @ ;
: col-no-here@ col-no-here @ ;
: init cr s" creating squareobj " type ;


class;