Many hyperlinks are disabled.
Use anonymous login
to enable hyperlinks.
Overview
Comment: | First step of a Tk canvas emulation in NaTcl based on the HTML5 canvas. Optimized for move-only updates. |
---|---|
Downloads: | Tarball | ZIP archive | SQL archive |
Timelines: | family | ancestors | descendants | both | ferrieux-nacl |
Files: | files | file ages | folders |
SHA1: |
6f398fb8eff95b265baed0df6e81a65d |
User & Date: | ferrieux 2011-04-10 23:11:38 |
Context
2011-04-11
| ||
21:11 | Full emulation of the Google-balls demo. 40fps, but 3x CPU consumption check-in: ab96ed1ba7 user: ferrieux tags: ferrieux-nacl | |
2011-04-10
| ||
23:11 | First step of a Tk canvas emulation in NaTcl based on the HTML5 canvas. Optimized for move-only upda... check-in: 6f398fb8ef user: ferrieux tags: ferrieux-nacl | |
11:25 | Cleanup of init, wrappers now compiled in. Coro-based [source $url]. Detailed description in README. check-in: 4d49dfa58c user: ferrieux tags: ferrieux-nacl | |
Changes
Changes to nacl/balls.html.
︙ | ︙ | |||
9 10 11 12 13 14 15 | <title>NaTcl : Tcl in Nacl</title> <script type="text/javascript"> // NaTcl -- JS glue | | > > > > > > > | 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 | <title>NaTcl : Tcl in Nacl</title> <script type="text/javascript"> // NaTcl -- JS glue var tclModule = null; // our singleton Tcl interp var canvas = null; var context = null; var canvcoords = []; // give it global scope. will be regen'd by canv code. function repaint() {} // debugging stuff function printf(s) { // I like debugging to stderr instead of console.log, // because when things go wrong, the JS console is not |
︙ | ︙ | |||
100 101 102 103 104 105 106 107 108 109 110 111 112 113 | // If the page loads before the Native Client module loads, then set the // status message indicating that the module is still loading. Otherwise, // do not change the status message. function pageDidLoad() { statusField = document.getElementById('modstatus'); if (tclModule == null) { updateStatus('Loading Nacl...'); } else { // It's possible that the Native Client module onload event fired // before the page's onload event. In this case, the status message // will reflect 'SUCCESS', but won't be displayed. This call will // display the current message. | > > | 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 | // If the page loads before the Native Client module loads, then set the // status message indicating that the module is still loading. Otherwise, // do not change the status message. function pageDidLoad() { statusField = document.getElementById('modstatus'); canvas=document.getElementById('canvas'); context=canvas.getContext("2d"); if (tclModule == null) { updateStatus('Loading Nacl...'); } else { // It's possible that the Native Client module onload event fired // before the page's onload event. In this case, the status message // will reflect 'SUCCESS', but won't be displayed. This call will // display the current message. |
︙ | ︙ | |||
127 128 129 130 131 132 133 | </script> </head> <body onload="pageDidLoad()"> <h1>NaTcl -- Native Client Tcl Module</h1> <p> | | | | < < | 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 | </script> </head> <body onload="pageDidLoad()"> <h1>NaTcl -- Native Client Tcl Module</h1> <p> <canvas id="canvas" width="576" height="300"></canvas> <!-- Load the published .nexe. This includes the 'nacl' attribute which shows how to load multi-architecture modules. Each entry in the "nexes" object in the .nmf manifest file is a key-value pair: the key is the runtime ('x86-32', 'x86-64', etc.); the value is a URL for the desired NaCl module. To load the debug versions of your .nexes, set the 'nacl' attribute to the _dbg.nmf version of the manifest file. --> |
︙ | ︙ |
Changes to nacl/balls.natcl.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 | printf BEFORE-TOPLEVEL-SOURCE source a.natcl source b.natcl printf AFTER-TOPLEVEL-SOURCE set cnt 0 proc daemon {} { after 1000 daemon printf DAEMON:$::cnt domset statusField "<h1 align='center'>DAEMON:$::cnt</h1>" incr ::cnt if {$::cnt>10} { error "Oh, I barfed !" } } #------ Runtime printf Salut!!! daemon | > > > > > > > > > > > > > > > | 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 | printf BEFORE-TOPLEVEL-SOURCE source a.natcl source b.natcl source canv.natcl printf AFTER-TOPLEVEL-SOURCE set cnt 0 proc daemon {} { after 1000 daemon printf DAEMON:$::cnt domset statusField "<h1 align='center'>DAEMON:$::cnt</h1>" incr ::cnt if {$::cnt>10} { error "Oh, I barfed !" } } proc daemon2 {} { after 100 daemon2 foreach id $::lst { canv_move $id [expr {-3+int(rand()*7)}] [expr {-3+int(rand()*7)}] } } #------ Runtime printf Salut!!! lappend lst [canv_create rect 100 60 150 80 -fill "#FF0000" -outline "#00FF00"] lappend lst [canv_create rect 110 70 120 90 -fill "#0000FF" -outline "#FFFF00"] lappend lst [canv_create rect 150 30 180 40 -fill "#FF00FF" -outline "#00FFFF"] daemon daemon2 |
Added nacl/canv.natcl.
> > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 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 | # # crude canvas emulation for NaTcl -- mapping to HTML5 canvas # set ::canv_uniq 1 set ::canv_hooked 0 set ::canv_tlist {} set ::canv_jlist {} set ::canv_status_func 0 set ::canv_status_coords 0 # canv_status_coords : 1: some old items moved # canv_status_func: 0:unchanged 1:new-items-on-top 2:changed proc canv_addhook {} { if {$::canv_hooked} return set ::canv_hooked 1 lappend ::naclhooks canv_hook } proc canv_new_items {} { return [lrange $::canv_tlist [llength $::canv_jlist] end] } proc canv_compile_repaint l { set j "" set oldprep "" foreach i $l { set prep $::canv_jprep($i) if {[string compare $prep $oldprep]} { set oldprep $prep append j $prep } append j $::canv_jdraw($i) } return $j } proc canv_hook {} { set ::canv_hooked 0 set repaint 0 if {$::canv_status_coords} { set repaint 1 } if {![info exists ::canv_jcode]} { set ::canv_status_func 2 } switch $::canv_status_func { 0 { # valid, do nothing } 1 { # incremental, append set jnew [canv_compile_repaint [canv_new_items]] append ::canv_jcode $jnew append js "repaint = function(){\n$::canv_jcode\n}\n" if {!$repaint} { # old ones didn't move: just draw the new ones append js $jnew } set ::canv_jlist $::canv_tlist } 2 { # invalid, recompute set ::canv_jcode "context.clearRect(0,0,canvas.width,canvas.height); \n" append ::canv_jcode [canv_compile_repaint $::canv_tlist] append js "repaint=function(){\n$::canv_jcode\n}\n" set ::canv_jlist $::canv_tlist set repaint 1 } } foreach i [array names ::canv_moved] { append js "canvcoords\[$i\]=\[[join $::canv_coords($i) ,]\];\n" } if {$repaint} { append js "repaint();\n" } set ::canv_status_func 0 set ::canv_status_coords 0 array unset ::canv_moved if {[info exists js]} { printf "CANV_HOOK emits:\n$js\n" append ::JS $js } } proc canv_create {ty args} { set id $::canv_uniq incr ::canv_uniq lappend ::canv_tlist $id set att(-fill) "#FFFFFF" set att(-outline) "#000000" switch -exact -- $ty { rect { set ::canv_coords($id) [lrange $args 0 3] array set att [lrange $args 4 end] set ::canv_jprep($id) "context.strokeStyle='$att(-outline)';context.fillStyle='$att(-fill)';\n" set ::canv_jdraw($id) "context.beginPath();context.rect(canvcoords\[$id\]\[0\],canvcoords\[$id\]\[1\],canvcoords\[$id\]\[2\]-canvcoords\[$id\]\[0\],canvcoords\[$id\]\[3\]-canvcoords\[$id\]\[1\]);context.fill();context.stroke();\n" } default {error "Unknown canv item type '$ty'"} } if {!$::canv_status_func} { # incremental set ::canv_status_func 1 } set ::canv_moved($id) 1 canv_addhook return $id } proc canv_move {id dx dy} { set cc {} foreach {x y} $::canv_coords($id) { incr x $dx incr y $dy lappend cc $x $y } set ::canv_coords($id) $cc if {![info exists ::canv_moved($id)]} { set ::canv_moved($id) 1 set ::canv_status_coords 1 } } |
Changes to nacl/init.natcl.
1 2 3 4 5 6 7 8 9 10 11 | #------ Standard NaTcl preamble # core JS/Tcl interaction proc jsquote s { regsub -all {[''\\]} $s {\\&} s regsub -all \n $s {'+"\\n"+'} s return '${s}' } proc bgerror s { | | > > | > > > | 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 | #------ Standard NaTcl preamble # core JS/Tcl interaction proc jsquote s { regsub -all {[''\\]} $s {\\&} s regsub -all \n $s {'+"\\n"+'} s return '${s}' } proc bgerror s { printf "### BGERROR: $s\n# [info errorstack]" set ::JS "alert([jsquote "BGERROR: $s"]);" } set ::naclhooks {} proc naclwrap s { set ::JS "" if {[catch { uplevel 1 $s foreach x $::naclhooks {uplevel #0 $x} } err]} { printf "Wrapper error: $err" bgerror $err } return $::JS } # Coro-based [source] necessary for bootstrapping |
︙ | ︙ |