Path: csiph.com!v102.xanadu-bbs.net!xanadu-bbs.net!feeder.erje.net!eu.feeder.erje.net!newsfeed.freenet.ag!news2.euro.net!postnews2.euro.net!news.wanadoo.nl!not-for-mail From: mhx@iae.nl (Marcel Hendrix) Subject: Re: Tcl Forth + TclForth ! Newsgroups: comp.lang.forth Message-ID: <02899101018434@frunobulax.edu> Date: Sat, 2 Feb 2013 12:14:01 +0200 References: X-Newsreader: iForth 2.0 console (October 21, 2006) Lines: 122 Organization: Wanadoo NNTP-Posting-Date: 02 Feb 2013 11:13:35 GMT NNTP-Posting-Host: s529d937f.adsl.online.nl X-Trace: 1359803615 dr5.euro.net 226 82.157.147.127:50777 X-Complaints-To: abuse@wanadoo.nl Xref: csiph.com comp.lang.forth:19369 Wolf Wejgaard write Re: Tcl Forth + TclForth ! [..] > If, of course, if you are actually willing to embrace Tcl for a rich multi-platform > Forth system. But Tcl is so terribly verbose! Below is a wish script that is piped to the tcl interpreter. The S~ words send text to tcl's stdin and return tcl's stdout. The Forth part ends with MyTEST. It does a simple sum. The wish script is in the same file as the Forth code and starts after WISH:, ending on the first empty line. Can you demonstrate how Tcl Forth does this in an elegant and compact manner? -marcel -- ax+b8.frt ------------------------- NEEDS -tcltk ANEW -ax+b8 4 SET-PRECISION 0 VALUE stop? 0e FVALUE x 0e FVALUE y 0e FVALUE x1 0e FVALUE y1 0e FVALUE x2 0e FVALUE y2 : DoX ( -- ) x2 x1 F- y2 y1 F- F/ y y1 F- F* x1 F+ TO x S" set x " x (F.) $+ do-TCL 2DROP ; : DoY ( -- ) y2 y1 F- x2 x1 F- F/ x x1 F- F* y1 F+ TO y S" set y " y (F.) $+ do-TCL 2DROP ; : MyTEST ( -- ) CLEAR stop? BEGIN stop? 0= WHILE S~ puts stdout $cmd~ DUP 0= IF 2DROP ELSE EVALUATE S~ set cmd ""~ 2DROP ENDIF S~ update~ 2DROP REPEAT ; -- Wishing -------------------------------------------------------------------- [DEFINED] -tcltk [IF] OPEN-WISH ( load and activate the Tcl/Tk interpreter ) [THEN] WISH: proc send_DOXY {} { global cmd x y x1 y1 x2 y2 set cmd [format "%e TO x %e TO y %e TO x1 %e TO y1 %e TO x2 %e TO y2 DoX DoY" $x $y $x1 $x2 $y1 $y2] } proc send_DOX {} { global cmd x y x1 y1 x2 y2 set cmd [format "%e TO x %e TO y %e TO x1 %e TO y1 %e TO x2 %e TO y2 DoX" $x $y $x1 $x2 $y1 $y2] } proc send_DOY {} { global cmd x y x1 y1 x2 y2 set cmd [format "%e TO x %e TO y %e TO x1 %e TO y1 %e TO x2 %e TO y2 DoY" $x $y $x1 $x2 $y1 $y2] } proc send_STOP {} { global cmd set cmd "TRUE TO stop?" } proc send_BELL {} { global cmd set cmd "BELL" } set x1 4 set y1 0 set x2 20 set y2 100 set x 0 set y 0 set cmd "" label .lbl_x1 -text "x1 =" label .lbl_y1 -text "y1 =" label .lbl_x2 -text "x2 =" label .lbl_y2 -text "y2 =" label .lbl_newx -text "x =" label .lbl_newy -text "y =" entry .x1 -width 8 -relief sunken -textvariable x1 entry .y1 -width 8 -relief sunken -textvariable y1 entry .x2 -width 8 -relief sunken -textvariable x2 entry .y2 -width 8 -relief sunken -textvariable y2 entry .x -width 8 -relief sunken -textvariable x entry .y -width 8 -relief sunken -textvariable y bind .x1 {send_DOXY} bind .y1 {send_DOXY} bind .x2 {send_DOXY} bind .y2 {send_DOXY} bind .x {send_DOY} bind .y {send_DOX} button .b_compx -text "Compute x" -command send_DOX button .b_compy -text "Compute y" -command send_DOY button .b_beep -text "Beep" -command send_BELL button .b_exit -text "Exit" -command send_STOP grid .lbl_x1 -row 1 -column 1 -padx 2 -pady 2 grid .x1 -row 1 -column 2 -padx 2 -pady 2 grid .lbl_y1 -row 1 -column 3 -padx 2 -pady 2 grid .y1 -row 1 -column 4 -padx 2 -pady 2 grid .lbl_x2 -row 2 -column 1 -padx 2 -pady 2 grid .x2 -row 2 -column 2 -padx 2 -pady 2 grid .lbl_y2 -row 2 -column 3 -padx 2 -pady 2 grid .y2 -row 2 -column 4 -padx 2 -pady 2 grid .lbl_newx -row 3 -column 1 -padx 2 -pady 2 grid .x -row 3 -column 2 -padx 2 -pady 2 grid .b_compy -row 4 -column 3 -padx 2 -pady 2 grid .lbl_newy -row 4 -column 1 -padx 2 -pady 2 grid .y -row 4 -column 2 -padx 2 -pady 2 grid .b_compx -row 3 -column 3 -padx 2 -pady 2 grid .b_beep -row 5 -column 1 -padx 2 -pady 2 grid .b_exit -row 5 -column 4 -padx 2 -pady 2 CR .( ****** click on the "Exit" button to terminate ... ) MyTEST [DEFINED] -tcltk [IF] CLOSE-WISH [THEN]