(   Title:  Enhanced error display for ftester
     File:  ftester-errors.fs
 Log File:  xftester.log 
   Author:  David N. Williams
  License:  Public Domain
  Version:  1.4.3
  Revised:  January 18, 2021

The date above may reflect unlogged cosmetic changes.

This file assumes that ftester.fs and tester-display.fs are loaded.
)

VARIABLE FT-#ERRORS    0 FT-#ERRORS !
: FT-ERROR1  ( c-addr u -- )
\ Display an error message followed by the line that had the
\ error.
  red-text 1 FT-#ERRORS +! FT-ERROR-DEFAULT normal-text ;
\ ' FT-ERROR1 FT-ERROR-XT !

\ display results and goals
: ft-a.  ( 'buffer c-addr u -- )
  blue-text type
  ( 'buffer) dup >r @ dup
  IF   1- r> cell+ faligned swap floats over +  \ display deepest first
       DO i f@ f. -1 floats +LOOP
  ELSE r> 2drop ." none" THEN cr normal-text ;

: FT-ERROR2  ( c-addr u -- )
  FT-ERROR1
  FT-RESULTS s" fresults: " ft-a.
  FT-GOALS   s"   fgoals: " ft-a. ;
\ ' XT-ERROR2 XT-ERROR-XT !

\ fancy results and goals display
: ft-fancy-a.  ( 'buffer c-addr u -- )
  blue-text type
  ( 'buffer) dup @ swap cell+ faligned swap ?dup
  IF   ( n) 1- 0 swap  \ display deepest first 
       DO ( 'floats) i floats over + f@
          i 1+ FT-ERROR-INDEX @ =
          IF red-text f. blue-text ELSE f. THEN
       -1 +LOOP
  ELSE ." none" THEN drop cr normal-text ;

: FT-ERROR3  ( c-addr u -- )
  FT-ERROR1
  FT-RESULTS s" fresults: " ft-fancy-a.
  FT-GOALS   s"   fgoals: " ft-fancy-a. ;
' FT-ERROR3 FT-ERROR-XT !

: .ft-errors   ( -- )  blue-text ." FT-ERRORS: " normal-text FT-#ERRORS @ . ;
: ?.ft-errors  ( -- )  VERBOSE @ IF .ft-errors THEN ;