;;--------------------------------------------------------------------------
;; AriNET Project in Informatics IA by Dominique Guinard
;; dominique.guinard@unifr.ch
;;--------------------------------------------------------------------------
;; value dialogs
;;--------------------------------------------------------------------------
; ------------------------------------------------------------
; ABSTRACT:
; *********
; These are functions for building the forget-value!,
; set-value! and get-value dialogs.
; ------------------------------------------------------------
;(load "gui_helper.scm")
; ------------------------------------------------------------
; get value
; ------------------------------------------------------------
(define (get-value-box-proc MItem CEvent)
(let* ((theDialog (instantiate dialog% ("Get Value"
#f
200
70
(get-center-position 'x 200 70)
(get-center-position 'y 200 70))))
(hPanelTextBoxes1 (instantiate horizontal-panel% (theDialog)))
(hPanelTextBoxes2 (instantiate horizontal-panel% (theDialog)))
(hPanelButtons (instantiate horizontal-panel% (theDialog)))
(fieldVariable (instantiate text-field% ("Variable: " hPanelTextBoxes1 void) (stretchable-width #f))))
(instantiate button% ("OK"
hPanelButtons
(lambda (x y)
(get-value-from-box-proc x y (send fieldVariable get-value)))
'(border)))
(instantiate button% ("Cancel" hPanelButtons (lambda (x y) (send theDialog show #f))))
(send hPanelButtons set-alignment 'center 'center)
(send hPanelTextBoxes1 set-alignment 'center 'center)
(send hPanelTextBoxes2 set-alignment 'center 'center)
(send theDialog show #t)))
(define (get-value-from-box-proc MItem CEvent variable)
(driver-loop-for-gui (list 'get-value
(string->symbol variable)))
(send (send (send MItem get-parent) get-parent) show #f))
; ------------------------------------------------------------
; end of get value
; ------------------------------------------------------------
; ------------------------------------------------------------
; set value
; ------------------------------------------------------------
(define (set-value-box-proc MItem CEvent)
(let* ((theDialog (instantiate dialog% ("Set Value"
#f
200
150
(get-center-position 'x 200 150)
(get-center-position 'y 200 150))))
(vMain (instantiate vertical-panel% (theDialog)))
(h1Fields (instantiate horizontal-panel% (vMain) (alignment '(center center))))
(v1 (instantiate vertical-panel% (h1Fields) (alignment '(center center))))
(v2 (instantiate vertical-panel% (h1Fields) (alignment '(center center))))
(h2Buttons (instantiate horizontal-panel% (vMain) (alignment '(center center))))
;fields
(fieldVariable (instantiate text-field% ("" v2 void) (stretchable-width #f)))
(fieldValue (instantiate text-field% ("" v2 void) (stretchable-width #f)))
(fieldInformant (instantiate text-field% ("" v2 void) (stretchable-width #f))))
;buttons
(instantiate button% ("OK"
h2Buttons
(lambda (x y)
(set-value-from-box-proc x
y
(send fieldVariable get-value)
(send fieldValue get-value)
(send fieldInformant get-value)))
'(border)))
(instantiate button% ("Cancel" h2Buttons (lambda (x y) (send theDialog show #f))))
;labels
(instantiate message% ("Variable : " v1) (stretchable-width #f))
(instantiate message% ("Value : " v1) (stretchable-width #f))
(instantiate message% ("Informant : " v1) (stretchable-width #f))
(send theDialog show #t)))
(define (set-value-from-box-proc MItem CEvent variable value informant)
(let ((variable (string->symbol variable))
(value (string->number value))
(informant (string->symbol informant))
(numerical_informant (string->number informant)))
;if the converting was done correctly
(if (and variable value (not numerical_informant))
(begin
(driver-loop-for-gui `(set-value!
,variable
,value
',informant))
(send (send (send (send MItem get-parent) get-parent) get-parent) show #f))
(errormsg "Invalid value entered: field value must be a number, field informant must be a name" 'user))))
; ------------------------------------------------------------
; end of set value
; ------------------------------------------------------------
; ------------------------------------------------------------
; forget value
; ------------------------------------------------------------
(define (forget-value-box-proc MItem CEvent)
(let* ((theDialog (instantiate dialog% ("Forget Value"
#f
200
100
(get-center-position 'x 200 100)
(get-center-position 'y 200 100))))
(vMain (instantiate vertical-panel% (theDialog)))
(h1Fields (instantiate horizontal-panel% (vMain) (alignment '(center center))))
(v1 (instantiate vertical-panel% (h1Fields) (alignment '(center center))))
(v2 (instantiate vertical-panel% (h1Fields) (alignment '(center center))))
(h2Buttons (instantiate horizontal-panel% (vMain) (alignment '(center center))))
;fields
(fieldVariable (instantiate text-field% ("" v2 void) (stretchable-width #f)))
(fieldInformant (instantiate text-field% ("" v2 void) (stretchable-width #f))))
;buttons
(instantiate button% ("OK"
h2Buttons
(lambda (x y)
(forget-value-from-box-proc x
y
(send fieldVariable get-value)
(send fieldInformant get-value)))
'(border)))
(instantiate button% ("Cancel" h2Buttons (lambda (x y) (send theDialog show #f))))
;labels
(instantiate message% ("Variable : " v1) (stretchable-width #f))
(instantiate message% ("Informant : " v1) (stretchable-width #f))
(send theDialog show #t)))
(define (forget-value-from-box-proc MItem CEvent variable informant)
(let ((variable (string->symbol variable))
(informant (string->symbol informant)))
(driver-loop-for-gui `(forget-value!
,variable
',informant)))
(send (send (send (send MItem get-parent) get-parent) get-parent) show #f))
; ------------------------------------------------------------
; end of forget value
; ------------------------------------------------------------
;;--------------------------------------------------------------------------
;; end of value dialogs
;;--------------------------------------------------------------------------