\ Forth code for threshold acquisition
\ Dave Jaffe 02/22/2002

\ Variables are:
\   number of ranges
\   range values
\   number of cycles within range

\ 1. there are no undefined sections within the acquisition continuum
\ 2. the next range starts just beyond the next range value
\ ("within" includes the lower but not the upper limit)

: it ;

: reverse   ( n - ) \ reverse n items on stack
    1+ 1 do i roll loop ;

: ctable ( nn ... n1 size ) \ compile time
         ( n - 8data )      \ run time
    create 0 do c, loop
    does> + c@  ;           \ index starts at 0

\ Get a number input at keyboard

: getnum ( - n )    \ any non-number key ends
    0   begin   key dup emit dup
                ascii 0 ascii 9 1+ within
                if      ascii 0 - swap 10 * +  0
                else    drop                   1
                then    
        until       ;


variable range-start    depth range-start !

\ enter up to ?? range boundary values in ascending order

0   10  20  30  40  50  60  70  80  90  100

\

depth range-start @ - dup       \ figure out how many ranges
    constant #range-values
    reverse                     \ make it ascending order
    #range-values ctable ranges \ create a byte table

: get-input ( - n )
        cr ascii ? emit space   getnum      ;

: classify  ( input - range ) \ classify into range
    #range-values 0 do  dup i ranges i 1+ ranges within
                        if  drop i leave
                        then
                    loop    ;

: ct
    cr  get-input   classify  .   ;

3 constant #reps    \ report after number of times in new range
variable vreps      \ number of consecutive = values
variable last-thres \ last threshold

: threshold     -1 last-thres !     #reps 1- vreps !
    get-input classify    
    begin   begin   get-input classify swap over =      \ find consecutive =
                if      -1 vreps +!                \ decrement rep counter
                else    #reps 1- vreps !           \ reset rep counter
                then    vreps @ 0=
            until       #reps 1- vreps !           \ reset reps

            dup last-thres @ = not                 \ same as last time?
            if  cr ." Threshold = " dup .          \ report classification
                dup last-thres !
            then

            begin   get-input classify swap over = not  \ look for not =
            until

            cr ." Continue? " key ascii n =
    until   drop    ;