;; Copyright 2006-2017, Matthew Welland.
;;
;; This file is part of Megatest.
;;
;; Megatest is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;;
;; Megatest is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with Megatest. If not, see <http://www.gnu.org/licenses/>.
(use iup)
(define *debugger-control* #f)
(define *debugger-rownum* 0)
(define *debugger-matrix* #f)
(define *debugger* #f)
(define (debugger)
(if (not *debugger*)
(set! *debugger*
(thread-start!
(make-thread
(lambda ()
(show
(dialog
(let ((pause #f)
(mtrx (matrix
#:expand "YES"
#:numlin 30
#:numcol 3
#:numlin-visible 20
#:numcol-visible 2
#:alignment1 "ALEFT"
)))
(set! pause (button "Pause"
#:action (lambda (obj)
(set! *debugger-control* (not *debugger-control*))
(attribute-set! pause "BGCOLOR" (if *debugger-control*
"200 0 0"
"0 0 200")))))
(set! *debugger-matrix* mtrx)
(attribute-set! mtrx "WIDTH1" "300")
(vbox
mtrx
(hbox
pause)))))
(main-loop)))))))
(define (debugger-start #!key (start 2))
(set! *debugger-rownum* start))
(define (debugger-trace-var varname varval)
(let ((oldval (attribute *debugger-matrix* (conc *debugger-rownum* ":1")))
(newval (conc varval)))
(if (not (equal? oldval newval))
(begin
;; (print "DEBUG: " varname " = " newval)
(attribute-set! *debugger-matrix* (conc *debugger-rownum* ":0") varname)
(attribute-set! *debugger-matrix* (conc *debugger-rownum* ":1") (conc varval))
;; (attribute-set! *debugger-matrix* "FITTOTEXT" "C1")
))
(set! *debugger-rownum* (+ *debugger-rownum* 1))))
(define (debugger-pauser)
(debugger)
(attribute-set! *debugger-matrix* "REDRAW" "ALL")
(let loop ()
(if *debugger-control*
(begin
(print "PAUSED!")
(thread-sleep! 1)
(loop))
;;(thread-sleep! 0.01)
)))
;; ;; lets use the debugger eh?
;; (debugger-start)
;; (debugger-trace-var "can-run-more" can-run-more)
;; (debugger-trace-var "hed" hed)
;; (debugger-trace-var "prereqs-not-met" (runs:pretty-string prereqs-not-met))
;; (debugger-pauser)