Check-in [cc15b9f12f]
Not logged in

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:merge with trunk
Timelines: family | ancestors | descendants | both | wtf-8-experiment
Files: files | file ages | folders
SHA1: cc15b9f12fc02d16d9248cad9473696ffd2e6a9e
User & Date: chw 2019-06-21 09:29:49
Context
2019-06-22
06:24
merge with trunk check-in: e5dc71ed9d user: chw tags: wtf-8-experiment
2019-06-21
09:29
merge with trunk check-in: cc15b9f12f user: chw tags: wtf-8-experiment
09:28
improve twv examples check-in: eba164d3ac user: chw tags: trunk
2019-06-20
06:02
merge with trunk check-in: 00c1373454 user: chw tags: wtf-8-experiment
Changes

Changes to jni/sdl2tk/win/tkWinInit.c.

195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
    }

    if ((p = _tcsrchr(lpBuffer, TEXT('\r'))) != NULL) {
	*p = TEXT('\0');
    }

#ifdef _UNICODE
    Tcl_WinTCharToUtf(lpBuffer, wcslen(lpBuffer) * sizeof (WCHAR), &ds);
    errPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds), Tcl_DStringLength(&ds));
    Tcl_DStringFree(&ds);
#else
    errPtr = Tcl_NewStringObj(lpBuffer, (int)strlen(lpBuffer));
#endif /* _UNICODE */

    if (lpBuffer != sBuffer) {







|







195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
    }

    if ((p = _tcsrchr(lpBuffer, TEXT('\r'))) != NULL) {
	*p = TEXT('\0');
    }

#ifdef _UNICODE
    Tcl_WinTCharToUtf(lpBuffer, -1, &ds);
    errPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds), Tcl_DStringLength(&ds));
    Tcl_DStringFree(&ds);
#else
    errPtr = Tcl_NewStringObj(lpBuffer, (int)strlen(lpBuffer));
#endif /* _UNICODE */

    if (lpBuffer != sBuffer) {

Changes to jni/tcl/generic/tclEnsemble.c.

2690
2691
2692
2693
2694
2695
2696




2697
2698
2699
2700
2701
2702
2703
2704
		     * substituted part of the command (as a list) as their
		     * content!
		     */

		    if (isNew) {
			Tcl_Obj *cmdObj, *cmdPrefixObj;





			cmdObj = Tcl_NewStringObj(nsCmdName, -1);
			cmdPrefixObj = Tcl_NewListObj(1, &cmdObj);
			Tcl_SetHashValue(hPtr, cmdPrefixObj);
			Tcl_IncrRefCount(cmdPrefixObj);
		    }
		    break;
		}
	    }







>
>
>
>
|







2690
2691
2692
2693
2694
2695
2696
2697
2698
2699
2700
2701
2702
2703
2704
2705
2706
2707
2708
		     * substituted part of the command (as a list) as their
		     * content!
		     */

		    if (isNew) {
			Tcl_Obj *cmdObj, *cmdPrefixObj;

			TclNewObj(cmdObj);
			Tcl_AppendStringsToObj(cmdObj,
				ensemblePtr->nsPtr->fullName,
				(ensemblePtr->nsPtr->parentPtr ? "::" : ""),
				nsCmdName, NULL);
			cmdPrefixObj = Tcl_NewListObj(1, &cmdObj);
			Tcl_SetHashValue(hPtr, cmdPrefixObj);
			Tcl_IncrRefCount(cmdPrefixObj);
		    }
		    break;
		}
	    }

Changes to jni/tcl/generic/tclExecute.c.

3712
3713
3714
3715
3716
3717
3718

3719
3720
3721
3722
3723
3724
3725
3726
3727
3728


3729
3730
3731



3732
3733
3734
3735

3736
3737

3738
3739
3740
3741
3742
3743
3744
3745
3746
3747
3748
3749
3750
	}
	if (arrayPtr && TclIsVarInHash(arrayPtr)) {
	    VarHashRefCount(arrayPtr)--;
	}

	{
	    int createdNewObj = 0;


	    if (!objResultPtr) {
		objResultPtr = valuePtr;
	    } else if (TclListObjLength(interp, objResultPtr, &len)!=TCL_OK) {
		TRACE_ERROR(interp);
		goto gotError;
	    } else {
		if (Tcl_IsShared(objResultPtr)) {
		    objResultPtr = Tcl_DuplicateObj(objResultPtr);
		    createdNewObj = 1;


		}
		if (Tcl_ListObjReplace(interp, objResultPtr, len,0, objc,objv)
			!= TCL_OK) {



		    goto errorInLappendListPtr;
		}
	    }
	    DECACHE_STACK_INFO();

	    objResultPtr = TclPtrSetVarIdx(interp, varPtr, arrayPtr, part1Ptr,
		    part2Ptr, objResultPtr, TCL_LEAVE_ERR_MSG, opnd);

	    CACHE_STACK_INFO();
	    if (!objResultPtr) {
	    errorInLappendListPtr:
		if (createdNewObj) {
		    TclDecrRefCount(objResultPtr);
		}
		TRACE_ERROR(interp);
		goto gotError;
	    }
	}
	TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
	NEXT_INST_V(pcAdjustment, cleanup, 1);
    }







>


|





|

>
>

|
|
>
>
>




>

|
>



<
<
<







3712
3713
3714
3715
3716
3717
3718
3719
3720
3721
3722
3723
3724
3725
3726
3727
3728
3729
3730
3731
3732
3733
3734
3735
3736
3737
3738
3739
3740
3741
3742
3743
3744
3745
3746
3747
3748



3749
3750
3751
3752
3753
3754
3755
	}
	if (arrayPtr && TclIsVarInHash(arrayPtr)) {
	    VarHashRefCount(arrayPtr)--;
	}

	{
	    int createdNewObj = 0;
	    Tcl_Obj *valueToAssign;

	    if (!objResultPtr) {
		valueToAssign = valuePtr;
	    } else if (TclListObjLength(interp, objResultPtr, &len)!=TCL_OK) {
		TRACE_ERROR(interp);
		goto gotError;
	    } else {
		if (Tcl_IsShared(objResultPtr)) {
		    valueToAssign = Tcl_DuplicateObj(objResultPtr);
		    createdNewObj = 1;
		} else {
		    valueToAssign = objResultPtr;
		}
		if (Tcl_ListObjReplace(interp, valueToAssign, len, 0,
			objc, objv) != TCL_OK) {
		    if (createdNewObj) {
			TclDecrRefCount(valueToAssign);
		    }
		    goto errorInLappendListPtr;
		}
	    }
	    DECACHE_STACK_INFO();
	    Tcl_IncrRefCount(valueToAssign);
	    objResultPtr = TclPtrSetVarIdx(interp, varPtr, arrayPtr, part1Ptr,
		    part2Ptr, valueToAssign, TCL_LEAVE_ERR_MSG, opnd);
	    TclDecrRefCount(valueToAssign);
	    CACHE_STACK_INFO();
	    if (!objResultPtr) {
	    errorInLappendListPtr:



		TRACE_ERROR(interp);
		goto gotError;
	    }
	}
	TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
	NEXT_INST_V(pcAdjustment, cleanup, 1);
    }

Changes to jni/tcl/tests/execute.test.

1062
1063
1064
1065
1066
1067
1068







































1069
1070
1071
1072
1073
1074
1075
    trace add execution crash enterstep {apply {args {info frame -2}}}
} -body {
    string is double [crash]
} -cleanup {
    trace remove execution crash enterstep {apply {args {info frame -2}}}
    rename crash {}
} -result 1







































 
# cleanup
if {[info commands testobj] != {}} {
   testobj freeallvars
}
catch {namespace delete {*}[namespace children :: test_ns_*]}
catch {rename foo ""}







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
    trace add execution crash enterstep {apply {args {info frame -2}}}
} -body {
    string is double [crash]
} -cleanup {
    trace remove execution crash enterstep {apply {args {info frame -2}}}
    rename crash {}
} -result 1

test execute-12.1 {failing multi-lappend to unshared} -setup {
    unset -nocomplain x y
} -body {
    set x 1
    lappend x 2 3
    trace add variable x write {apply {args {error boo}}}
    lappend x 4 5
} -cleanup {
    unset -nocomplain x y
} -returnCodes error -result {can't set "x": boo}
test execute-12.2 {failing multi-lappend to shared} -setup {
    unset -nocomplain x y
} -body {
    set x 1
    lappend x 2 3
    set y $x
    trace add variable x write {apply {args {error boo}}}
    lappend x 4 5
} -cleanup {
    unset -nocomplain x y
} -returnCodes error -result {can't set "x": boo}
test execute-12.3 {failing multi-lappend to unshared: LVT} -body {
    apply {{} {
	set x 1
	lappend x 2 3
	trace add variable x write {apply {args {error boo}}}
	lappend x 4 5
    }}
} -returnCodes error -result {can't set "x": boo}
test execute-12.4 {failing multi-lappend to shared: LVT} -body {
    apply {{} {
	set x 1
	lappend x 2 3
	set y $x
	trace add variable x write {apply {args {error boo}}}
	lappend x 4 5
    }}
} -returnCodes error -result {can't set "x": boo}
 
# cleanup
if {[info commands testobj] != {}} {
   testobj freeallvars
}
catch {namespace delete {*}[namespace children :: test_ns_*]}
catch {rename foo ""}

Changes to jni/tcl/tests/namespace.test.

1793
1794
1795
1796
1797
1798
1799
1800
1801
1802
1803
1804
1805
1806
1807
....
2124
2125
2126
2127
2128
2129
2130
2131
2132
2133
2134
2135
2136
2137
2138
....
3223
3224
3225
3226
3227
3228
3229
3230
3231
3232
3233
3234
3235
3236
3237
....
3308
3309
3310
3311
3312
3313
3314
3315
3316
3317
3318
3319
3320
3321
3322
3323
3324
3325













3326
3327
3328
3329
3330
3331
3332
3333
3334
3335
3336
3337
3338
	proc x2 {} {format 2}
	proc x3 {} {format 3}
	namespace ensemble create
    }
    list [ns x0 z] [ns x1] [ns x2] [ns x3]
} -cleanup {
    namespace delete ns
} -result {{1 z} 1 2 3}
test namespace-42.8 {
    ensembles: [Bug 1670091], panic due to pointer to a deallocated List
    struct.
} -setup {
    proc demo args {}
    variable target [list [namespace which demo] x]
    proc trial args {variable target; string length $target}
................................................................................
    set result {}
    lappend result [catch {ns a b c} msg] $msg
    lappend result [catch {ns a b c} msg] $msg
    lappend result [catch {ns b c d} msg] $msg
    lappend result [catch {ns c d e} msg] $msg
    lappend result [catch {ns Magic foo bar spong wibble} msg] $msg
    list $result [lsort [info commands ::ns::*]] $log [namespace delete ns]
} {{0 2 0 2 0 2 0 2 1 {unknown or protected subcommand "Magic"}} {::ns::Magic ::ns::a ::ns::b ::ns::c} {{making a} {running a b c} {running a b c} {making b} {running b c d} {making c} {running c d e} {unknown Magic - args = foo bar spong wibble}} {}}
test namespace-47.2 {ensemble: unknown handler} {
    namespace eval ns {
	namespace export {[a-z]*}
	proc Magic {ensemble subcmd args} {
	    error foobar
	}
	namespace ensemble create -unknown ::ns::Magic
................................................................................
} -cleanup {
    namespace delete ns
} -result\
   {0 0\
    1 {wrong # args: should be "ns z1 x a1"}\
    1 {wrong # args: should be "ns z2 x a1 a2"}\
    1 {wrong # args: should be "ns z2 x a1 a2"}\
    1 {wrong # args: should be "z0"}\
    0 {1 v}\
    1 {wrong # args: should be "ns v x z2 a2"}\
    0 {2 v v2}}
test namespace-53.11 {ensembles: nested rewrite} -setup {
    namespace eval ns {
	namespace export x
	namespace eval x {
................................................................................
	    return [lsort $gone]
	} finally {
	    namespace delete ::testing
	}
    }
} {::testing::abc::def ::testing::abc::ghi}

test namespace-56.4 {bug 16fe1b5807: names starting with ":"} {
namespace eval : {
    namespace ensemble create
    namespace export *
    proc p1 {} {
	    return 16fe1b5807
    }
}

: p1
} 16fe1b5807













 
# cleanup
catch {rename cmd1 {}}
catch {unset l}
catch {unset msg}
catch {unset trigger}
namespace delete {*}[namespace children :: test_ns_*]
::tcltest::cleanupTests
return

# Local Variables:
# mode: tcl
# End:







|







 







|







 







|







 







|










>
>
>
>
>
>
>
>
>
>
>
>
>













1793
1794
1795
1796
1797
1798
1799
1800
1801
1802
1803
1804
1805
1806
1807
....
2124
2125
2126
2127
2128
2129
2130
2131
2132
2133
2134
2135
2136
2137
2138
....
3223
3224
3225
3226
3227
3228
3229
3230
3231
3232
3233
3234
3235
3236
3237
....
3308
3309
3310
3311
3312
3313
3314
3315
3316
3317
3318
3319
3320
3321
3322
3323
3324
3325
3326
3327
3328
3329
3330
3331
3332
3333
3334
3335
3336
3337
3338
3339
3340
3341
3342
3343
3344
3345
3346
3347
3348
3349
3350
3351
	proc x2 {} {format 2}
	proc x3 {} {format 3}
	namespace ensemble create
    }
    list [ns x0 z] [ns x1] [ns x2] [ns x3]
} -cleanup {
    namespace delete ns
} -result {{1 ::ns::x0::z} 1 2 3}
test namespace-42.8 {
    ensembles: [Bug 1670091], panic due to pointer to a deallocated List
    struct.
} -setup {
    proc demo args {}
    variable target [list [namespace which demo] x]
    proc trial args {variable target; string length $target}
................................................................................
    set result {}
    lappend result [catch {ns a b c} msg] $msg
    lappend result [catch {ns a b c} msg] $msg
    lappend result [catch {ns b c d} msg] $msg
    lappend result [catch {ns c d e} msg] $msg
    lappend result [catch {ns Magic foo bar spong wibble} msg] $msg
    list $result [lsort [info commands ::ns::*]] $log [namespace delete ns]
} {{0 2 0 2 0 2 0 2 1 {unknown or protected subcommand "Magic"}} {::ns::Magic ::ns::a ::ns::b ::ns::c} {{making a} {running ::ns::a b c} {running ::ns::a b c} {making b} {running ::ns::b c d} {making c} {running ::ns::c d e} {unknown Magic - args = foo bar spong wibble}} {}}
test namespace-47.2 {ensemble: unknown handler} {
    namespace eval ns {
	namespace export {[a-z]*}
	proc Magic {ensemble subcmd args} {
	    error foobar
	}
	namespace ensemble create -unknown ::ns::Magic
................................................................................
} -cleanup {
    namespace delete ns
} -result\
   {0 0\
    1 {wrong # args: should be "ns z1 x a1"}\
    1 {wrong # args: should be "ns z2 x a1 a2"}\
    1 {wrong # args: should be "ns z2 x a1 a2"}\
    1 {wrong # args: should be "::ns::x::z0"}\
    0 {1 v}\
    1 {wrong # args: should be "ns v x z2 a2"}\
    0 {2 v v2}}
test namespace-53.11 {ensembles: nested rewrite} -setup {
    namespace eval ns {
	namespace export x
	namespace eval x {
................................................................................
	    return [lsort $gone]
	} finally {
	    namespace delete ::testing
	}
    }
} {::testing::abc::def ::testing::abc::ghi}

test namespace-56.4 {bug 16fe1b5807: names starting with ":"} knownBug {
namespace eval : {
    namespace ensemble create
    namespace export *
    proc p1 {} {
	    return 16fe1b5807
    }
}

: p1
} 16fe1b5807

test namespace-56.5 {Bug 8b9854c3d8} -setup {
    namespace eval namespace-56.5 {
	proc cmd {} {string match ::* [lindex [[string cat info] level 0] 0]}
	namespace export *
	namespace ensemble create
    }
} -body {
    namespace-56.5 cmd
} -cleanup {
    namespace delete namespace-56.5
} -result 1

 
# cleanup
catch {rename cmd1 {}}
catch {unset l}
catch {unset msg}
catch {unset trigger}
namespace delete {*}[namespace children :: test_ns_*]
::tcltest::cleanupTests
return

# Local Variables:
# mode: tcl
# End:

Changes to undroid/tsb/examples/cheatsheet.tsb.

48
49
50
51
52
53
54
55






56
57
58
59
60
61
62
 <dt><code><b>tsb::canvas</b> ?-width w -height h?</code></dt>
 <dd>Creates a <code>canvas</code> emulation implementing enough
     methods for Plotchart, returns a widget command.</dd><br>
 <dt><code><b>tsb::canvascmd</b> cmd ...</code></dt>
 <dd>Implementation of the canvas widget command, supports
     <code>create</code>, <code>delete</code> and other methods plus
     method <code>svg</code> which renders the canvas as SVG after
     the corresponding input field.</dd><br>






 <dt><code><b>tsb::clear</b></code></dt>
 <dd>Clears the entire page.</dd><br>
 <dt><code><b>tsb::eval</b> id</code></dt>
 <dd>Re-evaluates field with number <code>id</code>.</dd><br>
 <dt><code><b>tsb::load</b> ?filename?</code></dt>
 <dd>Load page from given <code>filename</code>, if file name omitted,
     present file selection.</dd><br>







|
>
>
>
>
>
>







48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
 <dt><code><b>tsb::canvas</b> ?-width w -height h?</code></dt>
 <dd>Creates a <code>canvas</code> emulation implementing enough
     methods for Plotchart, returns a widget command.</dd><br>
 <dt><code><b>tsb::canvascmd</b> cmd ...</code></dt>
 <dd>Implementation of the canvas widget command, supports
     <code>create</code>, <code>delete</code> and other methods plus
     method <code>svg</code> which renders the canvas as SVG after
     the invoking input field. The <code>svg</code> method takes
     optionally four numeric arguments which describe the SVG view box
     and resemble the scroll region of a real Tk canvas widget.
     The very first call of the <code>svg</code> method remembers
     the context w.r.t. the output field in the page. Subsequent
     calls of <code>svg</code> replace the content of that output
     field (useful for animations).</dd><br>
 <dt><code><b>tsb::clear</b></code></dt>
 <dd>Clears the entire page.</dd><br>
 <dt><code><b>tsb::eval</b> id</code></dt>
 <dd>Re-evaluates field with number <code>id</code>.</dd><br>
 <dt><code><b>tsb::load</b> ?filename?</code></dt>
 <dd>Load page from given <code>filename</code>, if file name omitted,
     present file selection.</dd><br>

Added undroid/tsb/examples/geneva.tsb.











































































































































































































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
1 {h2 "Geneva Drive"} 2 {#HTML
<p>How a film is moved through a movie projector? The film must
advance frame by frame with each frame pausing in front of the
lens for 1/24 of a second.<p>
 
<p>This intermittent motion is achieved using a Geneva Drive.</p>
 
<p>The name derives from the devices earliest application in mechanical
watches, Geneva being an important center of watchmaking. Other
application include pen change mechanism in plotters, automated
sampling devices, and so on.</p>

<p>This is an adapted version of Keith Vetter's "Geneva Drive" demo
from the Tcl'ers Wiki.<p>} 3 {array set S {
    title "Geneva Drive" w 500 h 500 lw 3
    animate 1 aid "" delay 50 angle 0 angle2 45
}
 
# Gear centers and radii
set V(gear1,o) {0 57}
set V(gear1,r0) 2
set V(gear1,r1) 10
set V(gear1,r2) 90
set V(gear1,r3) 161
set V(gear1,clr,r1) \#ccce34
set V(gear1,clr,r2) \#ccce34
set V(gear1,clr,r3) \#9c9a04
 
# Driving peg
set V(gear1,o2) {-114 0}
set V(gear1,p) 0              ;# Used for computing angles
set V(gear1,r10) 2
set V(gear1,r11) 10
set V(gear1,r12) 83
set V(gear1,clr,p) black
set V(gear1,clr,r0) black
set V(gear1,clr,r10) black
set V(gear1,clr,r11) red
set V(gear1,clr,r12) \#ccce34
 
set V(gear2,o) {0 -103}
set V(gear2,r0) 2
set V(gear2,r1) 10
set V(gear2,clr) \#64ce9c
set V(gear2,clr,r0) black
set V(gear2,clr,r1) \#64ce9c} 4 proc\ DoDisplay\ \{\}\ \{\n\ \ \ global\ S\ C\n\ \ \ set\ C\ \[tsb::canvas\ .c\ -width\ \$S(w)\ -height\ \$S(h)\]\n\ \ \ #\ Set\ the\ SVG\ viewBox\n\ \ \ set\ S(vbox)\ \[list\ \\\n\ \ \ \ \ \ \ \[expr\ \{0\ -\ \$S(w)\ /\ 2\}\]\ \[expr\ \{0\ -\ \$S(h)\ /\ 2\}\]\ \\\n\ \ \ \ \ \ \ \$S(w)\ \$S(h)\ \\\n\ \ \ \]\n\} 5 proc\ Gear1\ \{\}\ \{\n\ \ \ global\ V\ S\ C\n\ \ \ foreach\ \{x0\ y0\}\ \$V(gear1,o)\ break\n\ \ \ #\ Big\ disk\ and\ middle\ pin\n\ \ \ foreach\ who\ \{r3\ r1\ r0\}\ \{\n\ \ \ \ \ \ \ set\ xy\ \[MakeBox\ \$x0\ \$y0\ \$V(gear1,\$who)\]\n\ \ \ \ \ \ \ \$C\ create\ oval\ \{*\}\$xy\ -tags\ gear1,\$who\ -fill\ \$V(gear1,clr,\$who)\ \\\n\ \ \ \ \ \ \ \ \ \ \ -width\ \$S(lw)\n\ \ \ \}\n\ \ \ #\ Outer\ peg\n\ \ \ foreach\ \{x1\ y1\}\ \$V(gear1,o2)\ break\n\ \ \ set\ x1\ \[expr\ \{\$x0\ +\ \$x1\}\]\n\ \ \ set\ y1\ \[expr\ \{\$y0\ +\ \$y1\}\]\n\ \ \ foreach\ who\ \{p\ r11\ r10\}\ \{\n\ \ \ \ \ \ \ set\ xy\ \[MakeBox\ \$x1\ \$y1\ \$V(gear1,\$who)\]\n\ \ \ \ \ \ \ set\ xy2\ \[eval\ RegularPolygon2\ \$xy\ -start\ 0\ -extent\ 360\]\n\ \ \ \ \ \ \ \$C\ create\ polygon\ \{*\}\$xy2\ -tags\ \[list\ gear1\ gear1,\$who\]\ \\\n\ \ \ \ \ \ \ \ \ \ \ -fill\ \$V(gear1,clr,\$who)\ -width\ \$S(lw)\ -outline\ black\n\ \ \ \ \}\n\ \ \ \ #\ Rotating\ inner\ disk:\ concatentation\ of\ two\ arcs\n\ \ \ \ set\ xy2\ \[eval\ RegularPolygon2\ \[MakeBox\ \$x0\ \$y0\ \$V(gear1,r2)\]\ \\\n\ \ \ \ \ \ \ \ -start\ 135\ -extent\ 270\]\n\ \ \ \ set\ xy3\ \[eval\ RegularPolygon2\ \[MakeBox\ \$x1\ \$y1\ \$V(gear1,r12)\]\ \\\n\ \ \ \ \ \ \ \ -start\ -47\ -extent\ -94\]\n\ \ \ \ set\ xy\ \[concat\ \$xy2\ \$xy3\]\n\ \ \ \ \$C\ create\ polygon\ \{*\}\$xy\ -tags\ gear1\ \\\n\ \ \ \ \ \ \ \ -fill\ \$V(gear1,clr,r2)\ -outline\ black\ -width\ \$S(lw)\n\ \ \ \ \$C\ raise\ gear1,r1\n\ \ \ \ \$C\ raise\ gear1,r0\n\} 6 proc\ Gear2\ \{\}\ \{\n\ \ \ \ global\ V\ S\ C\n\ \ \ \ foreach\ \{x0\ y0\}\ \$V(gear1,o)\ break\n\ \ \ \ foreach\ \{Gx\ Gy\}\ \$V(gear2,o)\ break\n\ \ \ \ set\ xy\ \[MakeBox\ \$x0\ \$y0\ \$V(gear1,r2)\]\n\ \ \ \ set\ xy0\ \[eval\ RegularPolygon2\ \$xy\ -start\ 135\ -extent\ 90\]\n\ \ \ \ #\ Create\ one\ cusp\ and\ inlet\n\ \ \ \ foreach\ \{x1\ y1\}\ \[lrange\ \$xy0\ end-1\ end\]\ break\n\ \ \ \ set\ dx\ \[expr\ \{\$x1-\$x0\}\]\n\ \ \ \ set\ dy\ \[expr\ \{\$y1-\$y0\}\]\n\ \ \ \ set\ dist\ \[expr\ \{hypot(\$dx,\$dy)\}\]\n\ \ \ \ set\ nx\ \[expr\ \{\$dy\}\]\n\ \ \ \ set\ ny\ \[expr\ \{-\$dx\}\]\n\ \ \ \ set\ x2\ \[expr\ \{\$x1\ +\ \$dx\ *\ 10\ /\ \$dist\}\]\n\ \ \ \ set\ y2\ \[expr\ \{\$y1\ +\ \$dy\ *\ 10\ /\ \$dist\}\]\n\ \ \ \ set\ x3\ \[expr\ \{\$x2\ +\ \$nx\ *\ 80\ /\ \$dist\}\]\n\ \ \ \ set\ y3\ \[expr\ \{\$y2\ +\ \$ny\ *\ 80\ /\ \$dist\}\]\n\ \ \ \ set\ x4\ \[expr\ \{\$x3\ +\ \$dx\ *\ 26\ /\ \$dist\}\]\n\ \ \ \ set\ y4\ \[expr\ \{\$y3\ +\ \$dy\ *\ 26\ /\ \$dist\}\]\n\ \ \ \ set\ x5\ \[expr\ \{\$x4\ -\ \$nx\ *\ 80\ /\ \$dist\}\]\n\ \ \ \ set\ y5\ \[expr\ \{\$y4\ -\ \$ny\ *\ 80\ /\ \$dist\}\]\n\ \ \ \ set\ x6\ \[expr\ \{\$x5\ +\ \$dx\ *\ 10\ /\ \$dist\}\]\n\ \ \ \ set\ y6\ \[expr\ \{\$y5\ +\ \$dy\ *\ 10\ /\ \$dist\}\]\n\ \ \ \ lappend\ xy0\ \$x1\ \$y1\ \$x2\ \$y2\ \$x3\ \$y3\ \$x4\ \$y4\ \$x5\ \$y5\ \$x6\ \$y6\n\ \ \ \ #\ Rotate\ 3\ times\ and\ join\ all\ the\ points\n\ \ \ \ set\ xy1\ \[RotateCoords\ \$xy0\ \$Gx\ \$Gy\ -90\]\n\ \ \ \ set\ xy2\ \[RotateCoords\ \$xy0\ \$Gx\ \$Gy\ -180\]\n\ \ \ \ set\ xy3\ \[RotateCoords\ \$xy0\ \$Gx\ \$Gy\ -270\]\n\ \ \ \ set\ xy\ \[concat\ \$xy0\ \$xy1\ \$xy2\ \$xy3\]\n\ \ \ \ \$C\ create\ polygon\ \{*\}\$xy\ -tags\ gear2\ -fill\ \$V(gear2,clr)\ \\\n\ \ \ \ \ \ \ \ -outline\ black\ -width\ 4\n\ \ \ \ foreach\ who\ \{r1\ r0\}\ \{\n\ \ \ \ \ \ \ \ set\ xy\ \[MakeBox\ \$Gx\ \$Gy\ \$V(gear2,\$who)\]\n\ \ \ \ \ \ \ \ \$C\ create\ oval\ \{*\}\$xy\ -tags\ gear2,\$who\ \\\n\ \ \ \ \ \ \ \ \ \ \ \ -fill\ \$V(gear2,clr,\$who)\ -width\ \$S(lw)\n\ \ \ \ \}\n\} 7 {proc MakeBox {x y r} {
    return [list [expr {$x-$r}] [expr {$y-$r}] [expr {$x+$r}] [expr {$y+$r}]]
}} 8 {# from https://wiki.tcl-lang.org/Regular%20Polygons%202
proc RegularPolygon2 {x0 y0 x1 y1 args} {
    array set V {-sides 0 -start 90 -extent 360} ;# Default values
    foreach {a value} $args {
        if {! [info exists V($a)]} {error "unknown option $a"}
        if {$value == {}} {error "value of \"$a\" missing"}
        set V($a) $value
    }
    if {$V(-extent) == 0} {return {}}
    set xm [expr {($x0+$x1)/2.}]
    set ym [expr {($y0+$y1)/2.}]
    set rx [expr {$xm-$x0}]
    set ry [expr {$ym-$y0}]
    set n $V(-sides)
    if {$n == 0} {                              ;# 0 sides => circle
        set n [expr {round(($rx+$ry)*0.5)}]
        if {$n <= 2} {set n 4}
    }
    set dir [expr {$V(-extent) < 0 ? -1 : 1}]   ;# Extent can be negative
    if {abs($V(-extent)) > 360} {
        set V(-extent) [expr {$dir * (abs($V(-extent)) % 360)}]
    }
    set step [expr {$dir * 360.0 / $n}]
    set numsteps [expr {1 + double($V(-extent)) / $step}]
    set xy {}
    set DEG2RAD [expr {acos(-1)*2/360}]
    for {set i 0} {$i < int($numsteps)} {incr i} {
        set rad [expr {($V(-start) - $i * $step) * $DEG2RAD}]
        set x [expr {$rx*cos($rad)}]
        set y [expr {$ry*sin($rad)}]
        lappend xy [expr {$xm + $x}] [expr {$ym - $y}]
    }
    # Figure out where last segment should end
    if {$numsteps != int($numsteps)} {
        # Vecter V1 is last drawn vertext (x,y) from above
        # Vector V2 is the edge of the polygon
        set rad2 [expr {($V(-start) - int($numsteps) * $step) * $DEG2RAD}]
        set x2 [expr {$rx*cos($rad2) - $x}]
        set y2 [expr {$ry*sin($rad2) - $y}]
        # Vector V3 is unit vector in direction we end at
        set rad3 [expr {($V(-start) - $V(-extent)) * $DEG2RAD}]
        set x3 [expr {cos($rad3)}]
        set y3 [expr {sin($rad3)}]
        # Find where V3 crosses V1+V2 => find j s.t.  V1 + kV2 = jV3
        set j [expr {($x*$y2 - $x2*$y) / ($x3*$y2 - $x2*$y3)}]
        lappend xy [expr {$xm + $j * $x3}] [expr {$ym - $j * $y3}]
    }
    return $xy
}} 9 {# From https://wiki.tcl-lang.org/CanvasRotation
proc RotateItem {w tagOrId Ox Oy angle} {
    set angle [expr {$angle * atan(1) * 4 / 180.0}] ;# Radians
    foreach id [$w find withtag $tagOrId] {
        # Do each component separately
        set xy {}
        foreach {x y} [$w coords $id] {
            # rotates vector (Ox,Oy)->(x,y) by angle clockwise
            set x [expr {$x - $Ox}]             ;# Shift to origin
            set y [expr {$y - $Oy}]
            set xx [expr {$x * cos($angle) - $y * sin($angle)}] ;# Rotate
            set yy [expr {$x * sin($angle) + $y * cos($angle)}]
            set xx [expr {$xx + $Ox}]           ;# Shift back
            set yy [expr {$yy + $Oy}]
            lappend xy $xx $yy
        }
        $w coords $id {*}$xy
    }
}} 10 {proc RotateCoords {xy Ox Oy angle} {
    set angle [expr {$angle * atan(1) * 4 / 180.0}] ;# Radians
    set xy2 {}
    foreach {x y} $xy {
        # rotates vector (Ox,Oy)->(x,y) by angle clockwise
        set x [expr {$x - $Ox}]             ;# Shift to origin
        set y [expr {$y - $Oy}]
        set xx [expr {$x * cos($angle) - $y * sin($angle)}] ;# Rotate
        set yy [expr {$x * sin($angle) + $y * cos($angle)}]
        set xx [expr {$xx + $Ox}]           ;# Shift back
        set yy [expr {$yy + $Oy}]
        lappend xy2 $xx $yy
    }
    return $xy2
}} 11 {proc StepIt {dir} {
    global S V C
    foreach {x0 y0} $V(gear1,o) break
    RotateItem $C gear1 $x0 $y0 $dir
    set S(angle) [expr {($S(angle) + $dir) % 360}]
    if {$S(angle) == 45} {
        set S(angle2) 45
    } elseif {$S(angle) > 45 && $S(angle) <= 135} {
        foreach {Gx Gy} $V(gear2,o) break
        foreach {x1 y1} [$C coords gear1,p] break
        set dx [expr {$x1 - $Gx}] ; set dy [expr {$y1 - $Gy}]
        set degree [expr {
            round((acos($dy /hypot($dx,$dy))) * 180 / acos(-1))
        }]
        set S(degree) $degree
        set da [expr {-abs($degree - abs($S(angle2)))}]
        if {$da != 0} {
            RotateItem $C gear2 $Gx $Gy $da
            incr S(angle2) $da
        }
    }
}} 12 {proc Animate {} {
    after cancel $::S(aid)
    StepIt 5
    if {$::S(animate)} {
        set ::S(aid) [after $::S(delay) Animate]
    }
    lassign $::S(vbox) vx vy vw vh
    # Retro feeling: jitter on the viewBox
    set vx [expr {$vx + 1 * (rand() - 0.5)}]
    set vy [expr {$vy + 1 * (rand() - 0.5)}]
    set vw [expr {$vw + 1 * (rand() - 0.5)}]
    set vh [expr {$vh + 1 * (rand() - 0.5)}]
    $::C svg $vx $vy $vw $vw
}} 13 {DoDisplay
Gear1
Gear2
Animate} 14 {tsb::save geneva.tsb}

Changes to undroid/tsb/examples/northwind.tsb.

7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
    catch {$handle perform} code
    if {$code != 0} {
        return -code error [curl::easystrerror $code]
    }
    $handle cleanup
    return $result
}} 4 {#HTML
<p>The Northwind Sample data is on github, here's the base URL</p>} 5 {set BASEURL https://raw.githubusercontent.com/jpwhite3/northwind-SQLite3/master} 6 {#HTML
<p>Let's retrieve the schema diagram of the Northwind database ...</p>} 7 {img_from_binary [curl_get ${BASEURL}/Northwind_ERD.png] image/png 0} 8 {#HTML
<p>Now we create an in-memory SQLite3 database,
fill it with the NorthWind data from SQL source,
and finally list data from the [Categories] table.</p>} 9 package\ require\ sqlite3\n\nsqlite3\ DB\ :memory:\n\nDB\ eval\ \[encoding\ convertfrom\ iso8859-15\ \\\n\ \ \ \ \[curl_get\ \$\{BASEURL\}/Northwind.Sqlite3.create.sql\]\]\n\ntable\ \{CategoryID\ CategoryName\ Description\}\ \\\n\ \ \ \ \[DB\ eval\ \{select\ CategoryID,\ CategoryName,\ Description\ from\ \[Categories\]\}\] 10 {#HTML
<p>Display the images from table [Categories].</p>} 11 {foreach img [DB eval {select Picture from [Categories]}] {
    img_from_binary $img image/jpeg 0
}} 12 {tsb::save northwind.tsb}







|



|



7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
    catch {$handle perform} code
    if {$code != 0} {
        return -code error [curl::easystrerror $code]
    }
    $handle cleanup
    return $result
}} 4 {#HTML
<p>The Northwind Sample data is on github, here's the base URL</p>} 5 set\ BASEURL\ \\\n\ \ \ \ https://raw.githubusercontent.com/jpwhite3/northwind-SQLite3/master 6 {#HTML
<p>Let's retrieve the schema diagram of the Northwind database ...</p>} 7 {img_from_binary [curl_get ${BASEURL}/Northwind_ERD.png] image/png 0} 8 {#HTML
<p>Now we create an in-memory SQLite3 database,
fill it with the NorthWind data from SQL source,
and finally list data from the [Categories] table.</p>} 9 package\ require\ sqlite3\n\nsqlite3\ DB\ :memory:\n\nDB\ eval\ \[encoding\ convertfrom\ iso8859-15\ \\\n\ \ \ \ \[curl_get\ \$\{BASEURL\}/Northwind.Sqlite3.create.sql\]\]\n\ntable\ \{CategoryID\ CategoryName\ Description\}\ \[DB\ eval\ \{\n\ \ \ \ select\ CategoryID,\ CategoryName,\ Description\ from\ \[Categories\]\n\}\] 10 {#HTML
<p>Display the images from table [Categories].</p>} 11 {foreach img [DB eval {select Picture from [Categories]}] {
    img_from_binary $img image/jpeg 0
}} 12 {tsb::save northwind.tsb}

Changes to undroid/tsb/tsb.tcl.







1
2
3
4
5
6
7
..
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
..
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
...
438
439
440
441
442
443
444









445
446
447
448
449
450
451
452



453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
...
612
613
614
615
616
617
618








619
620





621
622
623



624
625
626
627
628
629
630
...
642
643
644
645
646
647
648
649











650
651
652
653
654
655
656
...
795
796
797
798
799
800
801

802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824









825
826
827
828









829
830
831
832
833
834
835
...
844
845
846
847
848
849
850

851
852
853
854
855
856
857
858
...
886
887
888
889
890
891
892
893




894
895
896
897
898
899
900
901
902
903
904
905
906

907
908
909
910
911
912
913
...
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
...
989
990
991
992
993
994
995

996
997
998
999
1000
1001
1002
1003
....
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053






# Load webview and other stuff.

package require twv
package require Markdown

# On MacOSX we need Tk early, otherwise crashes occur.

................................................................................
	# Should be the ping, Vasily.
	# But can be the reload, too.
	catch {uplevel \#0 $str}
	return
    }
    set ::H($id) $str
    if {$str eq ""} {
	$::W call Wclear $id
	return
    }
    set newfield 0
    set ::ID $id
    if {[string first "#HTML" $str] == 0} {
	set n [string first "\n" $str]
	if {$n > 4} {
................................................................................
	set str [Markdown::convert $str]
	$::W call Wraw $id $str 1
	$::W call Inhide $id 1
	set newfield 1
    } elseif {[catch {uplevel \#0 $str} ret opts]} {
	if {[dict get $opts -code] == 4} {
	    # continue
	    $::W call Wclear $id
	} else {
	    $::W call Werror $id $::errorInfo
	}
    } else {
	if {$ret ne ""} {
	    $::W call Wresult $id $ret
	} else {
	    $::W call Wclear $id
	}
	set newfield 1
    }
    if {$newfield} {
	incr id
	if {![info exists ::H($id)]} {
	    set ::H($id) ""
................................................................................
    if {$name eq ""} {
	set selname 1
	set name [$::W dialog open "Write HTML To File"]
    }
    if {$name eq ""} {
	return
    }









    set t $title
    if {$file ne ""} {
	append t " - [file tail $file]"
    }
    set t [htmlquote $t]
    set f [open $name w]
    puts $f $D_head
    puts $f "<title>$t</title>"



    puts $f $D_style
    puts $f "</head><body>\n"
    puts $f [::tsb::dump]
    puts $f "</body></html>"
    close $f
    if {$selname} {
	set cmd [dict get [info frame -1] cmd]
	set newcmd $cmd
	lappend newcmd $name
	::tsb::change_field $cmd $newcmd
    }
    return -code 4 ;# continue
}

# A minimal canvas emulation for plotchart. The svg method
# produces SVG into the current (output) field.
#
#  set C [::tsb::canvas ...]
................................................................................
		    }
		} elseif {[llength $coords]} {
		    dict set C($c,$id) -coords $coords
		} else {
		    set ret [dict get $C($c,$id) -coords]
		}
	    }








	    sv* {
		# svg





		package require can2svg
		set xml "<?xml version='1.0'?>\n"
		append xml "<svg width='$C($c,width)' height='$C($c,height)'"



		append xml " version='1.1'"
		append xml " xmlns='http://www.w3.org/2000/svg'"
		append xml " xmlns:xlink='http://www.w3.org/1999/xlink'>\n"
		foreach item $C($c,dlist) {
		    set type [dict get $C($c,$item) -type]
		    switch -- $type {
			image - window {
................................................................................
				lappend cmd $key [dict get $C($c,$item) $key]
			    }
			}
		    }
		    append xml "  " [can2svg::can2svg $cmd {*}$args] "\n"
		}
		append xml "</svg>\n"
		htmlraw $xml 0











	    }
	}
	return $ret
    }

    proc canvas {args} {
	variable C
................................................................................
    set D_head {<!DOCTYPE html><html lang="en"><head>}
    append D_head {<meta charset="utf-8">}

    # STYLE, CSS
    set D_style {
	<style>
	body {

	    font-family: sans-serif, Arial, Tahoma, Helvetica;
	    font-size: 90%;
	}
	textarea {
	    font-family: Consolas, Monaco, monospace;
	    font-size: 100%;
	}
	label {
	    font-family: Consolas, Monaco, monospace;
	    margin: 1px;
	    padding: 1px;
	}
	pre {
	    /* overflow-x: auto; */
	    white-space: pre-wrap;
	    white-space: -moz-pre-wrap;
	    white-space: -pre-wrap;
	    white-space: -o-pre-wrap;
	    word-wrap: break-word;
	}
	pre, code {
	    font-family: Consolas, Monaco, monospace;
	    font-size: 100%;









	}
	.infield * {
	    vertical-align: middle;
	}









	.tin {
	    width: 85%;
	    resize: none;
	    overflow: auto;
	}
	.tin, .tin:disabled {
	    border: 1px solid #AAAAAA;
................................................................................
	    margin: 2px;
	    padding: 4px;
	}
	.tbl {
	    border: 1px solid;
	    border-collapse: collapse;
	    margin-left: 1em;

	    width: 90%;
	}
	.tbl th {
	    border: 1px solid;
	    border-collapse: collapse;
	}
	.tbl td {
	    border: 1px solid;
................................................................................
	};

	/* The 2nd sin: this drives the Tcl event loop. */
	var Gtimer = window.setInterval(function() {
	    window.external.invoke("0 ::tsb::ping");
	}, 20);

	var Wclear = function(id) {




	    if (!needsClear[id]) {
		return;
	    }
	    var output =
		document.getElementById('out' + id + '-pre').firstChild;
	    if (output.innerHTML.length > 0) {
		output.style.color = 'inherit';
		output.innerHTML = '';
	    }
	    output = document.getElementById('out' + id + '-raw');
	    if (output.innerHTML.length > 0) {
		output.innerHTML = '';
	    }

	};

	var Wresult = function(id, str) {
	    var output =
		document.getElementById('out' + id + '-pre').firstChild;
	    str = str.replace(/&/g, '&amp;');
	    str = str.replace(/</g, '&lt;');
................................................................................
	    }
	};

	var Winput = function(id, str) {
	    var input = document.getElementById('code' + id);
	    input.value = str;
	    var lines = str.split(/\r?\n|\r/);
	    var nlines = (lines.length < 43) ? lines.length : 43;
	    input.rows = nlines;
	};

	var Feval = function(id) {
	    var input = document.getElementById('code' + id);
	    needsClear[id] = true;
	    RunTcl("" + id + " " + input.value);
................................................................................
	};

	var Field = function(id) {
	    var div = document.createElement('div');
	    div.className = 'field';
	    var html = '\n <a href="#in' + id + '"></a>';
	    html += '\n <div class="infield" id="in' + id + '">';

	    html += '\n  <label for="code' + id + '">in(' + id + ')</label>';
	    html += '\n  <textarea class="tin" id="code' + id + '" rows="1"';
	    html += '></textarea>\n </div>';
	    html += '\n <a href="#out' + id + '"></a>';
	    html += '\n <div id="out' + id + '-pre">';
	    html += '<pre></pre></div>';
	    html += '\n <div id="out' + id + '-raw"></div>\n';
	    div.innerHTML = html;
................................................................................
		    RunTcl("" + id + " " + input.value);
		    event.preventDefault();
		    return false;
		}
	    });
	    input.addEventListener('input', function(event) {
		var lines = input.value.split(/\r?\n|\r/);
		var nlines = (lines.length < 43) ? lines.length : 43;
		input.rows = nlines;
	    });
	    input.focus();
	    return input;
	};

	var InitField = function(id, str) {
	    var input = Field(id);
	    input.value = str;
	    var lines = str.split(/\r?\n|\r/);
	    var nlines = (lines.length < 43) ? lines.length : 43;
	    input.rows = nlines;
	};

	var GotoTop = function() {
	    window.location.href = "#top";
	};

>
>
>
>
>
>







 







|







 







|







|







 







>
>
>
>
>
>
>
>
>








>
>
>
|




<
<
<
<
<
<







 







>
>
>
>
>
>
>
>


>
>
>
>
>



>
>
>







 







|
>
>
>
>
>
>
>
>
>
>
>







 







>




|
|
<
<
<
<
<










|
|
>
>
>
>
>
>
>
>
>




>
>
>
>
>
>
>
>
>







 







>
|







 







|
>
>
>
>













>







 







|







 







>
|







 







|










|







1
2
3
4
5
6
7
8
9
10
11
12
13
..
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
..
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
...
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475






476
477
478
479
480
481
482
...
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
...
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
...
834
835
836
837
838
839
840
841
842
843
844
845
846
847





848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
...
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
...
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
....
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
....
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
....
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
# Taygete Scrap Book - a poor man's clone of Jupyter Notebook
#
# chw June 2019
#
####################################################################

# Load webview and other stuff.

package require twv
package require Markdown

# On MacOSX we need Tk early, otherwise crashes occur.

................................................................................
	# Should be the ping, Vasily.
	# But can be the reload, too.
	catch {uplevel \#0 $str}
	return
    }
    set ::H($id) $str
    if {$str eq ""} {
	$::W call Wclear $id 0
	return
    }
    set newfield 0
    set ::ID $id
    if {[string first "#HTML" $str] == 0} {
	set n [string first "\n" $str]
	if {$n > 4} {
................................................................................
	set str [Markdown::convert $str]
	$::W call Wraw $id $str 1
	$::W call Inhide $id 1
	set newfield 1
    } elseif {[catch {uplevel \#0 $str} ret opts]} {
	if {[dict get $opts -code] == 4} {
	    # continue
	    $::W call Wclear $id 0
	} else {
	    $::W call Werror $id $::errorInfo
	}
    } else {
	if {$ret ne ""} {
	    $::W call Wresult $id $ret
	} else {
	    $::W call Wclear $id 0
	}
	set newfield 1
    }
    if {$newfield} {
	incr id
	if {![info exists ::H($id)]} {
	    set ::H($id) ""
................................................................................
    if {$name eq ""} {
	set selname 1
	set name [$::W dialog open "Write HTML To File"]
    }
    if {$name eq ""} {
	return
    }
    if {$selname} {
	set cmd [dict get [info frame -1] cmd]
	set newcmd $cmd
	lappend newcmd $name
	::tsb::change_field $cmd $newcmd
    }
    if {[info exists ::ID]} {
	$::W call Wclear $::ID 0
    }
    set t $title
    if {$file ne ""} {
	append t " - [file tail $file]"
    }
    set t [htmlquote $t]
    set f [open $name w]
    puts $f $D_head
    puts $f "<title>$t</title>"
    # No hover in output
    set style $D_style
    regsub -all -- :hover $style :nohover style
    puts $f $style
    puts $f "</head><body>\n"
    puts $f [::tsb::dump]
    puts $f "</body></html>"
    close $f






    return -code 4 ;# continue
}

# A minimal canvas emulation for plotchart. The svg method
# produces SVG into the current (output) field.
#
#  set C [::tsb::canvas ...]
................................................................................
		    }
		} elseif {[llength $coords]} {
		    dict set C($c,$id) -coords $coords
		} else {
		    set ret [dict get $C($c,$id) -coords]
		}
	    }
	    fi* {
		# find ?withtag?
		set args [lassign $args tags]
		if {$tags eq "withtag"} {
		    lassign $args tags
		}
		set ret [tagfind $c $tags]
	    }
	    sv* {
		# svg
		set vx ""
		set vy ""
		set vw ""
		set vh ""
		lassign $args vx vy vw vh
		package require can2svg
		set xml "<?xml version='1.0'?>\n"
		append xml "<svg width='$C($c,width)' height='$C($c,height)'"
		if {$vx ne "" && $vy ne "" && $vw ne "" && $vh ne ""} {
		    append xml " viewBox='$vx $vy $vw $vh'"
		}
		append xml " version='1.1'"
		append xml " xmlns='http://www.w3.org/2000/svg'"
		append xml " xmlns:xlink='http://www.w3.org/1999/xlink'>\n"
		foreach item $C($c,dlist) {
		    set type [dict get $C($c,$item) -type]
		    switch -- $type {
			image - window {
................................................................................
				lappend cmd $key [dict get $C($c,$item) $key]
			    }
			}
		    }
		    append xml "  " [can2svg::can2svg $cmd {*}$args] "\n"
		}
		append xml "</svg>\n"
		# If (output) field set, use it; otherwise use
		# the current one from ::ID and remember it.
		if {[info exists C($c,field)]} {
		    $::W call Wclear $C($c,field) 1
		    set fid $C($c,field)
		} elseif {[info exists ::ID]} {
		    set fid $::ID
		    set C($c,field) $fid
		}
		if {[info exists fid]} {
		    $::W call Wraw $fid $xml
		}
	    }
	}
	return $ret
    }

    proc canvas {args} {
	variable C
................................................................................
    set D_head {<!DOCTYPE html><html lang="en"><head>}
    append D_head {<meta charset="utf-8">}

    # STYLE, CSS
    set D_style {
	<style>
	body {
	    margin: 1em 2em 1em 2em;
	    font-family: sans-serif, Arial, Tahoma, Helvetica;
	    font-size: 90%;
	}
	textarea {
	    font-family: Consolas, Roboto Mono, Liberation Mono, monospace;
	    font-size: 90%;





	}
	pre {
	    /* overflow-x: auto; */
	    white-space: pre-wrap;
	    white-space: -moz-pre-wrap;
	    white-space: -pre-wrap;
	    white-space: -o-pre-wrap;
	    word-wrap: break-word;
	}
	pre, code {
	    font-family: Consolas, Roboto Mono, Liberation Mono, monospace;
	    font-size: 90%;
	}
	img {
	    max-width: 95%;
	}
	.field {
	    border: 1px solid transparent;
	}
	.field:hover {
	    border: 1px dotted #AAAAAA;
	}
	.infield * {
	    vertical-align: middle;
	}
	.tlabel {
	    font-family: Consolas, Roboto Mono, Liberation Mono, monospace;
	    font-size: 90%;
	    margin: 1px;
	    padding: 1px;
	    width: 7ex;
	    display: inline-block;
	    text-align: right;
	}
	.tin {
	    width: 85%;
	    resize: none;
	    overflow: auto;
	}
	.tin, .tin:disabled {
	    border: 1px solid #AAAAAA;
................................................................................
	    margin: 2px;
	    padding: 4px;
	}
	.tbl {
	    border: 1px solid;
	    border-collapse: collapse;
	    margin-left: 1em;
	    margin-right: 1em;
	    max-width: 100%;
	}
	.tbl th {
	    border: 1px solid;
	    border-collapse: collapse;
	}
	.tbl td {
	    border: 1px solid;
................................................................................
	};

	/* The 2nd sin: this drives the Tcl event loop. */
	var Gtimer = window.setInterval(function() {
	    window.external.invoke("0 ::tsb::ping");
	}, 20);

	var Wclear = function(id, later) {
	    if (later) {
		needsClear[id] = true;
		return;
	    }
	    if (!needsClear[id]) {
		return;
	    }
	    var output =
		document.getElementById('out' + id + '-pre').firstChild;
	    if (output.innerHTML.length > 0) {
		output.style.color = 'inherit';
		output.innerHTML = '';
	    }
	    output = document.getElementById('out' + id + '-raw');
	    if (output.innerHTML.length > 0) {
		output.innerHTML = '';
	    }
	    needsClear[id] = null;
	};

	var Wresult = function(id, str) {
	    var output =
		document.getElementById('out' + id + '-pre').firstChild;
	    str = str.replace(/&/g, '&amp;');
	    str = str.replace(/</g, '&lt;');
................................................................................
	    }
	};

	var Winput = function(id, str) {
	    var input = document.getElementById('code' + id);
	    input.value = str;
	    var lines = str.split(/\r?\n|\r/);
	    var nlines = (lines.length < 50) ? lines.length : 50;
	    input.rows = nlines;
	};

	var Feval = function(id) {
	    var input = document.getElementById('code' + id);
	    needsClear[id] = true;
	    RunTcl("" + id + " " + input.value);
................................................................................
	};

	var Field = function(id) {
	    var div = document.createElement('div');
	    div.className = 'field';
	    var html = '\n <a href="#in' + id + '"></a>';
	    html += '\n <div class="infield" id="in' + id + '">';
	    html += '\n  <label class="tlabel"';
	    html += ' for="code' + id + '">in(' + id + ')</label>';
	    html += '\n  <textarea class="tin" id="code' + id + '" rows="1"';
	    html += '></textarea>\n </div>';
	    html += '\n <a href="#out' + id + '"></a>';
	    html += '\n <div id="out' + id + '-pre">';
	    html += '<pre></pre></div>';
	    html += '\n <div id="out' + id + '-raw"></div>\n';
	    div.innerHTML = html;
................................................................................
		    RunTcl("" + id + " " + input.value);
		    event.preventDefault();
		    return false;
		}
	    });
	    input.addEventListener('input', function(event) {
		var lines = input.value.split(/\r?\n|\r/);
		var nlines = (lines.length < 50) ? lines.length : 50;
		input.rows = nlines;
	    });
	    input.focus();
	    return input;
	};

	var InitField = function(id, str) {
	    var input = Field(id);
	    input.value = str;
	    var lines = str.split(/\r?\n|\r/);
	    var nlines = (lines.length < 50) ? lines.length : 50;
	    input.rows = nlines;
	};

	var GotoTop = function() {
	    window.location.href = "#top";
	};