Groups | Search | Server Info | Keyboard shortcuts | Login | Register [http] [https] [nntp] [nntps]

Groups > comp.lang.forth > #19369

Re: Tcl Forth + TclForth !

Show key headers only | View raw

Wolf Wejgaard <wejgaard@gmail.com> 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 <Return> {send_DOXY}
bind .y1 <Return> {send_DOXY}
bind .x2 <Return> {send_DOXY}
bind .y2 <Return> {send_DOXY}
bind .x  <Return> {send_DOY}
bind .y  <Return> {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]

Back to comp.lang.forth | Previous | Next — Previous in thread | Next in thread | Find similar | Unroll thread

Thread

Tcl Forth + TclForth ! Wolf Wejgaard <wejgaard@gmail.com> - 2013-02-02 00:32 -0800
  Re: Tcl Forth + TclForth ! "A. K." <akk@nospam.org> - 2013-02-02 10:26 +0100
  Re: Tcl Forth + TclForth ! mhx@iae.nl (Marcel Hendrix) - 2013-02-02 12:14 +0200
    Re: Tcl Forth + TclForth ! Wolf Wejgaard <wejgaard@gmail.com> - 2013-02-05 02:15 -0800
    Re: Tcl Forth + TclForth ! mhx@iae.nl (Marcel Hendrix) - 2013-02-06 20:52 +0200
  Re: Tcl Forth + TclForth ! "Rod Pemberton" <do_not_have@notemailnotz.cnm> - 2013-02-05 06:24 -0500
    Re: Tcl Forth + TclForth ! Brad Eckert <hwfwguy@gmail.com> - 2013-02-06 09:28 -0800
    Re: Tcl Forth + TclForth ! Wolf Wejgaard <wejgaard@gmail.com> - 2013-02-10 04:37 -0800
  Re: Tcl Forth + TclForth ! Eduardo Costa <edu500ac@gmail.com> - 2013-02-10 07:52 -0800

csiph-web