/* tk_examp.q: simple example using the Tcl/Tk interface */ include tk; /* This tiny sample Q-Tk application allows you to evaluate Q expressions in a Tk window. */ private init_app, main_loop; tk_examp = init_app || main_loop; /* init_app: initialize (create the application's widgets) */ init_app = // start a new interpreter tk_quit || // unmap the main window (will be shown when all widgets have // been created, to reduce flickering) tk "wm withdraw ." || // set the window title tk "wm title . \"Q-Tk Example\"" || // title label tk "label .title -font 8x13bold -text \ \"A Simple Q-Tk Application\"" || tk "label .descr -text \ \"Type in a Q expression and click Eval to evaluate.\n\ Click Quit to quit.\"" || // main area: input expression and output result with labels tk "frame .f" || tk "label .f.expr_l -text \"Expression:\"" || tk "entry .f.expr_e -textvariable expr_val -width 40" || tk "label .f.result_l -text \"Result:\"" || tk "entry .f.result_e -textvariable result_val -width 40" || // buttons tk "frame .buttons" || tk "button .buttons.eval -text Eval -command { q eval_cb }" || tk "button .buttons.quit -text Quit -command { q quit_cb }" || // pack widgets into the main window // title and main frame tk "pack .title .descr" || tk "pack .f -fill x" || // grid layout of the main frame tk "grid config .f.expr_l -column 0 -row 0 -sticky w" || tk "grid config .f.expr_e -column 1 -row 0 -sticky we" || tk "grid config .f.result_l -column 0 -row 1 -sticky w" || tk "grid config .f.result_e -column 1 -row 1 -sticky we" || // make entry widgets expand horizontally to fill main window tk "grid columnconfigure .f 0 -weight 0" || tk "grid columnconfigure .f 1 -weight 1" || // buttons tk "pack .buttons" || tk "pack .buttons.eval .buttons.quit -side left" || // bind Return key in expression entry to evaluation command tk "bind .f.expr_e { q eval_cb }" || // show the main window tk "wm deiconify ."; /* main_loop: the main loop of the application */ main_loop = tk_read || main_loop if tk_ready; = () otherwise; /* check syntax of expression and evaluate */ res 'X = str X; res X = "*** syntax error ***" otherwise; eval S = res (valq S); /* callbacks */ eval_cb = tk ("set result_val {" ++ eval (tk "return $expr_val") ++ "}"); quit_cb = tk_quit;