#!./wafeperl

&wafe_cmd(<<'__');
mergeResources topLevel \
	*Label.borderWidth 0 \
        *background wheat

form f topLevel translations {<Key>q: exec(quit)}
  label infoLine f label "Press a Button!"
  box b f orientation horizontal fromVert infoLine
    command c1 b \
	label "Perl: test1" \
	callback {perl test1 {"Hello World! Button %w was pressed!\n"}}
    command c2 b \
	label "Perl: test2" \
	callback {puts "the result from perl is <[perl test2 a b c]>"}
    command c3 b \
	label "Tcl: test3" \
	callback {test3 [string length %w]}
    command c4 b \
	label "Perl: test4" \
	callback {puts stderr "Test4: returns <[perl test4 testing...]>"}
    command quit b \
	callback %w
realize
sV infoLine resizable true width [gV b width]
sV infoLine resizable false

proc test3 {w} {
   puts stderr "Test3: the perl routine returns <[perl test3 $w]>"
}
__

# a perl subroutine with one argument called via callback
sub test1 {
  local($_) = @_;
  print "Test1: <$_>\n";
}

# a perl subroutine with three arguments called via callback
# returning a result
sub test2 {
  local($a,$b,$c) = @_;
  print "Test2: <$a> <$b> <$c>\n";
  return "ok";
}

# a perl subroutine with one argument called via callback,
# obtaining a numeric argument from Wafe, doing arithmetic 
# and returning result
sub test3 {
  local($i) = @_;
  return "$i*$i = ".($i*$i);
}

# A perl subroutine with one argument called via callback,
# calling Wafe again via &wafe_cmd, which calls perl.
# The return value of the inner perl subrouting (test3)
# is returned to Wafe, which returns it to the outer perl
# subroutine (test4) that returns a result to the callback

sub test4 {
  local($_) = @_;
  print "...... Test4 got <$_>\n";
  return "the result <".&wafe_cmd("perl test3 123").">";
}

# getting a value from Wafe back to perl
print "The width of the topLevel shell is ",&wafe_cmd("gV topLevel width"),"!\n";

# calling the xt event loop
&wafe_process_events();


