without some visual happening
this will not make it --- ( visual like pictures ( you know ) )....
The following I think is serious if a bit confusing -----
https://groups.google.com/forum/#!topic/comp.lang.forth/_MAttQoY3pw
Now some more pie in the face::::
\ collector.fs
cr s" loading collector.fs " type cr
include oof.fs
\ we reserve a set of memory locations to back
\ up the collection state at any given time :
\ this is passed to the collection object in init
create vbp 9 cells allot
object class precollect
method @1
method !1
method @2
method !2
method @3
method !3
method @4
method !4
method @5
method !5
method @6
method !6
method @7
method !7
method @8
method !8
method @9
method !9
method nextval@
method nextval!
method sv-next@
method sv-next!
method nv@
method nv!
method dump-collection
method nextval-prt
method reset-all
method sv-nextval
method reset-nextval
method check-unique
method store-input
method backup-current
method restore-current
method nextvalinc
class;
precollect class collector
cell var v1
cell var v2
cell var v3
cell var v4
cell var v5
cell var v6
cell var v7
cell var v8
cell var v9
cell var nextval
cell var sv-next
cell var inpv
cell var dupr
cell var lclvbp
how:
: @1 v1 @ ;
: !1 v1 ! ;
: @2 v2 @ ;
: !2 v2 ! ;
: @3 v3 @ ;
: !3 v3 ! ;
: @4 v4 @ ;
: !4 v4 ! ;
: @5 v5 @ ;
: !5 v5 ! ;
: @6 v6 @ ;
: !6 v6 ! ;
: @7 v7 @ ;
: !7 v7 ! ;
: @8 v8 @ ;
: !8 v8 ! ;
: @9 v9 @ ;
: !9 v9 ! ;
: nextval@ nextval @ ;
: nextval! nextval ! ;
: nextvalinc nextval@ 1 + nextval! ;
: sv-next@ sv-next @ ;
: sv-next! sv-next ! ;
: nv! nextval@ 1 = if !1 else nextval@
2 = if !2 else nextval@
3 = if !3 else nextval@
4 = if !4 else nextval@
5 = if !5 else nextval@
6 = if !6 else nextval@
7 = if !7 else nextval@
8 = if !8 else nextval@
9 = if !9
then then then then then then then then then ;
: nv@ nextval@ 1 = if @1 else nextval@
2 = if @2 else nextval@
3 = if @3 else nextval@
4 = if @4 else nextval@
5 = if @5 else nextval@
6 = if @6 else nextval@
7 = if @7 else nextval@
8 = if @8 else nextval@
9 = if @9
then then then then then then then then then ;
: reset-nextval sv-next@ nextval! ;
: sv-nextval nextval@ sv-next! ;
: nextval-prt cr s" nextval = " type nextval@ . ;
: reset-all 10 1 ?do i nextval! 42 nv! loop 1 nextval ! ;
: dump-collection sv-nextval 10 1 ?do i nextval! nv@ dup 10 < if . else emit then s" - " type loop reset-nextval ;
: check-unique inpv ! 0 dupr ! sv-nextval
10 1 ?do i nextval! nv@ inpv @ = if 1 dupr ! leave then loop
reset-nextval dupr @ ;
: store-input check-unique 0 = if inpv @ nv! nextval@ 1 + nextval! then ;
: backup-current sv-nextval 9 0 ?do i nextval! 1 + nv@ lclvbp nextval@ + ! loop reset-nextval ;
: restore-current sv-nextval 9 0 ? do i dup nextval! lclvbp + @ nextvalinc nv! loop reset-nextval ;
: init lclvbp ! reset-all cr s" init collector " type cr ;
class;
cr s" collector class loaded " type cr
and more :
\ sub square
\ https://groups.google.com/forum/#!topic/comp.lang.forth/_MAttQoY3pw
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
class;
square class squareobj
cell var terr
cell var blkn
cell var col-no-here
cell var line-no-here
cell var board-addr-here
cell var width-here
cell var offset-here
cell var sq-no
: 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
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
+ + + + + + + + ;
: 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 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 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 then loop loop ;
: sq4-load 6 3 ?do i line-no-here ! 3 0 ?do i column-calc2 + c@ 42 <> if store-input 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 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 then loop loop ;
: sq7-load 9 6 ?do i line-no-here ! 3 0 ?do i column-calc2 + c@ 42 <> if store-input 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 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 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 ;
class;
and even more ----
include oof.fs
object class dum
method prt
class;
object class dumb
method prt2
class;
dum class dum-dum
cell var rad
how:
: prt rad @ . ;
: init rad ! ;
class;
25 dum-dum : mydumdum
dumb class dumber
how:
: prt2 cr s" dumber " type mydumdum prt ;
: init s" init dumber " type ;
class;
if your not laughing with me -
then ? you must be laughing at me
No comments:
Post a Comment