tkeden1.46/004075500025250000147000000000000756052526100140565ustar00ashleydcsother00003520000005tkeden1.46/lib-tkeden/004075500025250000147000000000000756052526100160745ustar00ashleydcsother00003520000005tkeden1.46/lib-tkeden/arca.eden010064400025250000147000000570020753024127200176320ustar00ashleydcsother00003520000005/*** * - EDEN library routines - * * - edenlib.e - * ****/ /* $Id: arca.lib,v 1.2 2001/08/01 17:58:02 cssbz Exp $ */ /* used the operator `varname` which turns a string into a variable */ setbuf(stdout, 0); NullStr =""; ON = 1; OFF = 0; CART ='C'; LINE ='L'; LABEL ='T'; ABST ='A'; EXPL ='E'; INT ='I'; VERT ='V'; COL ='C'; DIAG ='D'; DEBUG ='N'; ARROW_BEGIN = 0.51; ARROW_END = 0.6; ARROW_FACTOR = 0.05; _ARROW = ON; _LABEL = ON; _line_colour=["red","blue","green","brown","thistle","yellow","lightblue"]; proc debugmsg { if (DEBUG=='Y') writeln($1); } proc _writeln { auto count; for (count = 1; count <= $#; count++) writeln($[count]); } func if_assign { return $1 ? $2 : $3; } proc check_mode { if ($1 == 0) writeln("ERROR LHS IS ABSTRACT OR UNDEFINED"); } func one_int { return [INT,EXPL,0,$1]; } UNDEF = one_int(@); UNDEF_VERT = [VERT, EXPL, 2, [[UNDEF], [UNDEF]]]; UNDEF_COL = [COL, EXPL, @, [[UNDEF]]]; func op_and { return $1 && $2; } func op_or { return $1 || $2; } func check_int{ auto modval, val,value, int; int = ($# == 2) ? $1 : $1[4][$3]; val = int[4]; if (val==@) return [$2[1],$2[2],$2[3],value]; modval = $2[3]; value = (modval==0 || modval==1 ) ? val : val % modval; if (value == 0) value = modval; if (modval==@) return[INT,ABST,int[3],value]; if ($2!=@) if (int[3]!=$2[3] && int[3]) { writeln("ERROR INTS OF INCOMPATIBLE MODULUS"); exit(0); } else return ($2[2]==EXPL) ? [$2[1],$2[2],$2[3],value] : [$2[1],$2[2],int[3],value]; else return[INT,@,@,int[4]]; } func int_mult { /* if ($1==2 || $2==@) return [INT,@,@,@]; */ if ($1[3]!=$2[3] && $1[3] && $2[3]) writeln("ERROR INTEGERS OF INCOMPATIBLE DIM"); else return [$1[1],$1[2],$1[3],$1[4] * $2[4]]; } func int_div { /* if ($1==2 || $2==@) return [INT,@,@,@]; */ if ($1[3]!=$2[3] && $1[3] && $2[3]) writeln("ERROR INTEGERS OF INCOMPATIBLE DIM"); else return [$1[1],$1[2],$1[3],int($1[4] / $2[4])]; } func int_add { /* if ($1==2 || $2==@) return [INT,@,@,@]; */ if ($1[3]!=$2[3] && $1[3] && $2[3]) writeln("ERROR INTEGERS OF INCOMPATIBLE DIM"); else return [$1[1],$1[2],$1[3],$1[4] + $2[4]]; } func int_sub { /* if ($1==2 || $2==@) return UNDEF; */ if ($1[3]!=$2[3] && $1[3] || $2[3]) { writeln("ERROR INTEGERS OF INCOMPATIBLE DIM"); return UNDEF; } else return ($1[3]>$2[3]) ? [$1[1],$1[2],$1[3],$1[4] - $2[4]] : [$1[1],$1[2],$2[3],$1[4] - $2[4]]; } func int_mod { if ($2[3]==0) return [$1[1],$1[2],$1[3],$1[4] % $2[4]]; else { writeln("ERROR ILLEGAL DIM IN MOD INT"); return UNDEF; }; } func int_rup { auto result, sign; if ($1[4] == @ || $2[4] == @) return UNDEF; sign = ($2[4] < 0) ? -1 : 1; result = $1[4] % $2[4]; return one_int((result == 0) ? $1[4] : (result > 0) ? $1[4] - result + sign * $2[4] : $1[4] + result - sign * $2[4]); } func int_smash { auto new_mod, int1, int2, result; int1 = $1[4]; int2 = $2[4]; if (int1 == @ || int2 == @ || $1[3] == @ || $2[3] == @) return UNDEF; new_mod = $1[3] * $2[3]; result = int1+$1[3]; while (result%$1[3] != int1 || result%$2[3] != int2) result = result+$1[3]; return [INT,$1[2],new_mod,result]; } func int_inv { auto u,v,q,r,f,g,h,m,n; n = $1[3]; m = $1[4]; if (n == @ || m == @) return UNDEF; u=m; v=n; r=n; f=1; g=0; h=0; while (r) { q=u/v; h=f-g*q; r=u-v*q; f=g; u=v; g=h; v=r; }; if (u==1) return [INT,EXPL,$1[3],f]; writeln("NO INVERSE - INT INV"); return UNDEF; } func int_prime {return [INT, EXPL, 0,$1[4]];}/*normalises after mod calc*/ func int_size {return [INT,EXPL,0,$1[3]];} func i_eq { return ($1[4]==$2[4]); } func int_lt { if ($1[3] == $2[3]) { return ($1[4] == @ || $2[4] == @) ? 0 : ($1[4] < $2[4]); } else { writeln("ERROR INTS OF INCOMPATIBLE DIM"); return 0; }; } func int_grt { if ($1[3] == $2[3]) { return ($1[4] == @ || $2[4] == @) ? 0 : ($1[4] > $2[4]); } else { writeln("ERROR INTS OF INCOMPATIBLE DIM"); return 0; } } func int_ltoe { if ($1[3] == $2[3]) { return ($1[4] == @ || $2[4] == @) ? 0 : ($1[4] <= $2[4]); } else { writeln("ERROR INTS OF INCOMPATIBLE DIM"); return 0; } } func int_gtoe { if ($1[3] == $2[3]) { return ($1[4] == @ || $2[4] == @) ? 0 : ($1[4] >= $2[4]); } else { writeln("ERROR INTS OF INCOMPATIBLE DIM"); return 0; } } func int_ne { if ($1[3] == $2[3]) { return ($1[4] == @ || $2[4] == @) ? 0 : ($1[4] != $2[4]); } else { writeln("ERROR INTS OF INCOMPATIBLE DIM"); return 0; } } func i_actval {return @;} /*replaces symbolic expressions with values */ func find_min { auto min, count; min = @; for(count=1; count<=$1#; count++) if ($1[count]!=@ && $2[count]) min = (min==@ || $1[count]<$1[min]) ? count : min; return min; } func col_dist{ para start, end; auto count, ncols, at, dists, useable; useable = []; dists = []; ncols = $# ; for(count = 1; count<=$3[3]; count++) { useable = useable//[1]; dists = dists//[@]; } if (start == 0 || end == 0) return UNDEF; if (start > $3[3] || end > $3[3]) { writeln( "START OR END POINT OUT OF RANGE OF PERM"); return UNDEF; } dists[start] = 0; for (at = find_min(dists,useable); at!=end && at!=@; at = find_min(dists,useable)) { for (count=3; count<=ncols; count++){ if ($[count][4][at][4]!=@ && $[count][4][at][4] && (dists[$[count][4][at][4]]==@ || dists[$[count][4][at][4]]>dists[at]+1)) dists[$[count][4][at][4]]=dists[at]+1; }; useable[at]=0; } return(one_int(dists[end])); } func col_mult { auto count, permsize, result; permsize = $1[4]#; result = []; if (($1[4]# != $2[4]#)) { writeln("ERROR INCOMPATIBLE PERMS"); return UNDEF_COL; } for (count = 1; count <= permsize; count= count+1) result = ($2[4][count][4]!=@ && $2[4][count][4] && $1[4][$2[4][count][4]][4]) ? result // [$1[4][$2[4][count][4]]] : result // [UNDEF]; return [COL,EXPL,permsize,result]; } func vert_col { return [COL, $1[2], $1[3], $1[4]]; } func join_cols { auto count, size, result; if ($1[3] == 0 || $2[3] == 0) return UNDEF_COL; if ($1[3] > $2[3]) { size = $1[3]; result = $1[4]; for (count = 1; count <= $2[3]; count++) if (result[count][4] == @) result[count] = $2[4][count]; } else { size = $2[3]; result = $2[4]; for (count = 1; count <= $1[3]; count++) if ($1[4][count][4] != @ && $1[4][count][4]) result[count] = $1[4][count]; }; return [COL, EXPL, size, result]; } func col_size { auto length, count, largest; length = $1#; largest = length; for (count = 1; count <= length; count++) if ($1[count][4] != @ && $1[count][4] > largest) largest = $1[count][4]; return largest; } func list_undef { para length; auto count, result; result = []; for (count = 1; count < length; count ++) append result, UNDEF; return result; } func check_col { auto ERROR, count, undef; ERROR = 0; if ($2[3] != 0){ undef = list_undef($2[3]); if ($1[4]# != $2[3]) { writeln("ERROR COLS OF INCOMPATIBLE SIZE"); ERROR = 1; } else for (count = 1; count <= $1[4]#; count++) { if ($1[4][count][4] != @ && $1[4][count][4] > $2[3]){ writeln("INT OUT OF RANGE IN COL"); ERROR = 1; }; }; } else undef = list_undef($1[4]#); return (ERROR==1) ? [COL,$2[2],$2[3], undef] : [COL,$2[2],$1[3],$1[4]]; } func c_make { auto size, count, result ; result = []; size = col_size($1); for (count = 1; count <= size; count++) append result, UNDEF; for (count = 1; count <= $1# - 1; count++) { if ($1[count][4] != @ && $1[count][4]) result[$1[count][4]] = $1[count+1]; if ($1[count+1][4] == @ && $1[count][4] == 0) result[$1[count][4]]= UNDEF; }; if ($1[$1#][4] != @ && $1[$1#][4]) result[$1[$1#][4]] = $1[1]; return [COL,EXPL,size,result]; } func col_exp { auto count, result, size; size = $2[4]; result = $1; if ($2[4] != @){ if ($2[4] < 0) size = - $2[4]; for (count = 1; count <= size-1; count++) result = col_mult(result ,$1); }; if ($2[4]==0){ result = []; for (count= 1; count<= $1[4]#; count++) append result, one_int(count); result = [COL,EXPL,$1[3]]//[result]; }; return ($2[4] != @) ? (($2[4] > -1) ? result : col_inv(result)) : UNDEF_COL; } func cactval {return @;} func col_inv { /*inverse of a perm*/ auto result, count; result = []; if ($1[3] != $1[4]# || $1[3]==@ || $1[4]==@) return UNDEF_COL; for (count = 1; count<= $1[3]; count++) append result, UNDEF; for (count = 1; count<= $1[3]; count++) if (($1[4][count][4]==@)||($1[4][count][4]==0)); /* writeln("WARNING-PERM NOT COMPLETELY DEFINED - INV");*/ else result[$1[4][count][4]] = one_int(count); return [$1[1], $1[2], $1[3], result]; } func cat_cols { auto count, size, result; size = $1[3] + $2[3]; result = $1[4] // $2[4]; for (count = $1[3]+1; count <= size; count++) if (result[count][4] != @) result[count][4] += $1[3]; return [COL, EXPL, size, result]; } func colisize {return [INT,EXPL,0,$1[3]];} /*degree of the perm*/ proc c_bin_fns { /*works for binary functions*/ auto ERROR, count, undef; ERROR = 0; if ($1[3] != 0){ undef = list_undef($1[3]); if ($2[4]# != $1[3]){ writeln("ERROR COLS OF INCOMPATIBLE SIZE"); ERROR = 1; }; for (count = 1; ERROR == 0 && count <= $1[3]; count++){ if ($2[4][count][4] != @ && $2[4][count][4] > $1[3]){ writeln("INT OUT OF RANGE IN COL"); ERROR = 1; }; }; }; } proc v_make { return [VERT,EXPL,$1#,$1]; } func check_vert { auto vert; vert = ($#==2) ? $1 : $1[$3]; if (vert[3] != $2[3] && $2[3]!=0){ writeln("ERROR VERTS OF INCOMPATIBLE DIM"); return UNDEF_VERT; } else return [vert[1], $2[2], vert[3], vert[4]]; } proc v_bin_fns { /*works for binary functions*/ if ($1[3]!=$2[3] && $1[2]!=ABST) writeln("ERROR VERTS OF INCOMPATIBLE DIM"); } func vert_add { auto result, count; if ($1[4]==@ || $2[4]==@) return UNDEF_VERT; if($1[3]!=$2[3]) writeln("ERROR VERTS INCOMPATIBLE DIM (RHS)"); result =[]; for (count = 1; count <= $1[3]; count++) append result, int_add($1[4][count],$2[4][count]); return [$1[1],$1[2],$1[3],result]; } func vert_sub { auto result, count; if ($1[4]==@ || $2[4]==@) return UNDEF_VERT; if($1[3]!=$2[3]) writeln("ERROR VERTS INCOMPATIBLE DIM (RHS)"); result =[]; for (count = 1; count <= $1[3]; count++) append result, int_sub($1[4][count],$2[4][count]); return [$1[1],$1[2],$1[3],result]; } proc vert_mult { auto result, count; if ($1[4]==@ || $2[4]==@) return UNDEF_VERT; result =[]; for (count = 1; count <= $2[3]; count++) append result, int_mult($1,$2[4][count]); return [$2[1],$2[2],$2[3],result]; } func vert_rot { para vert, other; auto xc, yc, xr, yr, angle, plane1, plane2; angle = other[4][1][4] * PI / 180; plane1 = other[4][2][4]; plane2 = other[4][3][4]; xc = vert[4][plane1][4]; yc = vert[4][plane2][4]; if ((angle * plane1 * plane2 * xc * yc) == @) return UNDEF_VERT; xr = int(xc * cos(angle) - yc * sin(angle)); yr = int(xc * sin(angle) + yc * cos(angle)); vert[4][plane1] = one_int(xr); vert[4][plane2] = one_int(yr); return vert; } func v_ref {return @;} /*reflection*/ func vert_smash { /*cat vertices dim N ,M -> N+M*/ return [$1[1],$2[2],$1[3]+$2[3], $1[4]//$2[4]]; } func v_actval {return @;} func vert_size {return [INT,EXPL,0,$1[3]];} func vneq { auto count, result; result = 0; if ($1[3] != $2[3]) writeln("ERROR VERTS Of INCOMPATIBLE DIM (IF)"); else for (count = 1; count <= $1[3]; count++) if ($1[4][count] == $2[4][count]) result++; return result!=$1[3]; } func veq { auto count, result; if ($1[3] != $2[3]) writeln("ERROR VERTS Of INCOMPATIBLE DIM (IF)"); else for (count = 1; count <= $1[3]; count++) if ($1[4][count] == $2[4][count]) result++; return result==$1[3]; } proc d_bin_fns{ if ($1[3]!=$2[3] && $1[3]!=0) writeln("ERROR DIAGS OF INCOMPATIBLE SIZE"); } func check_diag { if ($2[3]==0 || $1[3]==$2[3]) return $1[4][2]; } func diag_join { return [DIAG, EXPL, $2[3]+$1[3], [EXPL, $1[4][2]//$2[4][2]]]; } func sub_diag { auto subsize, result, count; subsize = $# - 1; result = []; for (count = 1; count <= subsize; count++) { if ($[count+1][4] != @) append result, $1[4][2][$[count+1][4]]; else append result, UNDEF_VERT; } return [DIAG, EXPL, $#-1, [EXPL, result]]; } func diag_mult { auto result, count; result = []; for (count = 1;count <= $2[3]; count++) append result, vert_mult($1,$2[4][2][count]); return [DIAG, EXPL, $2[3], [EXPL, result]]; } func diag_rot { auto result, count; result = []; for (count = 1;count <= $1[3]; count++) append result, vert_rot($1[4][2][count], $2); return [DIAG, EXPL, $1[3], [EXPL, result]]; } func v_trans { auto count, verts, result; result = []; verts = $2[4][2]#; for (count=1; count <= verts; count++) append result, vert_add( $1, $2[4][2][count]); return [$2[1],$2[2],$2[3], [$2[4][1], result], $2[5]]; } func diag_smash { auto count, result; result = []; for (count = 1; count <= $1[3]; count++) result = result//v_trans($1[4][2][count],$2)[4][2]; return [$2[1],$2[2],$2[3]*$1[3], [$1[4][1], result]]; } func diag_size {return [INT,EXPL,0,$1[2][2]];} /*number of verts*/ func nd_2d { para vert; auto count, count2, dim; dim = vert#; for (count = dim; count>=3; count--) for (count2 = dim-1; count2 >= 1; count2--) if (vert[count2][4] > 0) { vert[count2][4] = vert[count2][4] - 0.1*vert[count][4]; if (vert[count2][4] < 0) vert[count2][4] = 0; } else if (vert[count2][4] < 0 ) { vert[count2][4] = vert[count2][4] + 0.1*vert[count][4]; if (vert[count2][4] > 0)vert[count2][4] = 0; }; return [vert[1],vert[2]]; } func inColList { para list, item; auto i; if (list == []) return 0; for (i = 1; i <= list#; i++) if (list[i] == item) return i; return 0; } /*** Functions for manipulating assocative memory ***/ func searchKey { para map, key; auto start, mid, end; start = 1; end = (*map)#; mid = (start + end) / 2; while ( start <= mid && mid <= end ) { if ((*map)[mid][1] > key) end = mid - 1; else if ((*map)[mid][1] < key) start = mid + 1; else /* match */ return [ mid, (*map)[mid][2] ]; mid = (start + end) / 2; } return [mid < start ? start : mid, @]; } func putKey { para map, key, data; auto ans; ans = searchKey(map, key); if (ans[2] == @) { insert *map, ans[1], [key, data]; return ans[1]; } else /* already there */ return 0; /* fail */ } func deleteKey { para map, key; auto ans; ans = searchKey(map, key); if (ans[2] == @) { return 0; /* fail */ } else { /* found */ delete *map, ans[1]; return ans[1]; } } func replaceKey { para map, key, data; auto ans; ans = searchKey(map, key); if (ans[1] > (*map)# || (*map)[ans[1]][1] != key) /* not there */ insert *map, ans[1], [key, data]; else /* found */ (*map)[ans[1]][2] = data; return ans[1]; } proc dispNoLabels { auto diag, dname, oldDiagCols, cols, window, j, vertex; auto collist, pos; diag = *($[$#-1]); dname = nameof($[$#-1]); oldDiagCols = "old_"//dname//"_cols"; if (`oldDiagCols` == @) `oldDiagCols` = []; collist = []; cols = $#-2; window = $[$#]; for (j = cols; j >= 2; j -= 2) { append collist, $[j-1]; if (pos = inColList(`oldDiagCols`, $[j-1])) { delete `oldDiagCols`, pos; } delete_shape(&`$[j-1]//"__"`); draw_col($[j-1],$[j][4],diag[4][2],window); } while (`oldDiagCols` != []) { delete_shape(&``oldDiagCols`[1]//"__"`); shift `oldDiagCols`; } vertex = "L_"//dname; delete_shape(&`vertex`); `oldDiagCols` = collist; } proc dispWithLabels { auto diag, dname, oldDiagCols, cols, window, i, j, vertex; /* auto collist, pos; */ auto collist, pos, _p1, x1, y1, _L_attr; auto var, viewport_name; diag = *($[$#-1]); dname = nameof($[$#-1]); oldDiagCols = "old_"//dname//"_cols"; if (`oldDiagCols` == @) `oldDiagCols` = []; collist = []; cols = $#-2; window = $[$#]; for (j = cols; j >= 2; j -= 2) { append collist, $[j-1]; if (pos = inColList(`oldDiagCols`, $[j-1])) { delete `oldDiagCols`, pos; } delete_shape(&`$[j-1]//"__"`); draw_col($[j-1],$[j][4],diag[4][2],window); } while (`oldDiagCols` != []) { delete_shape(&``oldDiagCols`[1]//"__"`); shift `oldDiagCols`; } vertex = "L_"//dname; delete_shape(&`vertex`); `oldDiagCols` = collist; for(i = 1; i<=diag[4][2]#; i++){ x1 = nd_2d(diag[4][2][i][4])[1][4]; y1 = nd_2d(diag[4][2][i][4])[2][4]; _p1 = cart(x1,y1); _L_attr = "color=gray1"; `vertex` = label(str(i),_p1); PLOT_label(`window`, &`vertex`, &_L_attr); } } proc draw_col { para c_nm,cols,verts,window; auto k1,x1,y1,x2,y2,li,vert; /* auto colour, style, _L_attr; */ auto colour, style, _L_attr, _p1, _p2; auto var, viewport_name; colour = c_nm[c_nm#]-'a'+1; colour = colour ? colour : _line_colour#; style = (displayDepth > 1) ? "solid,color="//_line_colour[colour] : (colour == 1) ? "solid,color=gray1" : "dashed,dash="//str(colour*20+2); _L_attr = "linestyle="//style ; for (k1=1;k1<=cols#;k1++){ vert = nd_2d(verts[k1][4]); x1=vert[1][4]; y1=vert[2][4]; _p1 = cart(x1,y1); if ((cols[k1][4] != @ && cols[k1][4])&& (k1!=cols[cols[k1][4]][4] || k1 Execute caused "notationGet called when currentNotation is not set sensibly" errors when the executed file contained a notation change. (An error introduced around 1.43). Fixed. Notation changes in files introduced by File -> Execute didn't persist, although the interface showed them persisting. This bug has existed since at least 1.30. Fixed. ** 1.45 Thursday October 24 21:33:17 BST 2002 ** DCS Linux now needs -I to compile, as readline libraries #include . Created dcs-linux-i686.configure, dcs-solaris-i386.configure, dcs-solaris-sparc.configure. Notations with names of length multiple 8 characters (including the % and terminating character, eg %sqlzero) previously failed to work. Now fixed. The reason is something I don't quite understand, to do with getheap(). Tcl procedure removeNotationRadioButton now given an Eden procedure, which works also in ttyeden (where it silently does nothing). Now, if you want to hide a notation radio button to hide the notation's existence (note that the notation itself is not actually removed), use the Eden removeNotationRadioButton procedure, passing the name of the notation, including the % character. For example: %eden removeNotationRadioButton("%eden"); 'notation' command reinstated as a quick workaround to get existing models which use AOP to work. This function will be removed in the future once we've fixed the existing models to use the new installAOP procedure. symboltable() and symboldetail() now include the symbol's "master" information, which describes the last agent to change the symbol, as the last item in the list (inner list for symboltable()) returned. This may possibly break existing models which use these functions. Making attempts to debug sqleddi (mainly within the model). Added more output to debug(2), showing when todo() is actually called. The new notations framework now understands the ## comment syntax, so all parsers (including AOP) should now automatically ignore ## single line comments. Fixed bugs in ttyeden's handling of todo(), hopefully now allowing sqleddiBeynon2002 to function correctly in ttyeden. The "currently active notation at the end of an included file doesn't persist" bug (an attempt was made to fix this in version 1.31 below) still persists, but the prompt faithfully reflects the currently active notation. ** 1.44 Fri Aug 30 18:51:19 2002 ** Compiled dtkeden on Windows, fixing minor problems along the way. A major problem remains: the server is killed with signal 11 when a client logs in. When run under a debugger, this problem does not occur. ** 1.43 Monday August 19 20:56:44 BST 2002 ** Implemented ipopen on Mac OS X also (pseudo-terminals on BSD require a different approach to SVR4). Added regmatch() and regreplace() regular expression functions to Eden, using the PCRE (Perl Compatibile Regular Expressions) library. regmatch needs some rethinking to return more than one match. Added documentation to eden.txt. Examples: writeln(regreplace("a", "z", "123a4567a89a0")); writeln(regreplace("(.)\\[(.)\\]", "ashfunc($1,$2)", "l[1] is l[2];")); writeln(regmatch("(?U)(.*)a(.*)$", "hallo chrisababe")); Added PCRE and Chris Roe to credits.txt. Added more detail about authors of libraries. Periods at ends of sentences in eden.txt. Added debug(8192) for debugging the regular expression code (including the string memory allocation code). Generic framework for new notations implemented. Call newNotation(name, switchProcPtr, transProcPtr) to install a new notation, which is implemented in raw Eden. Agent-oriented parsers will be worked into this framework soon. Added %edensl notation: Eden Symbol Lists, where each element in a list resides in its own symbol, and can therefore trigger other items and have its own independent definition. The notation is the same as normal Eden. Call installedensl(); to install it, then use %edensl to switch to it. It is incomplete: at present, list concatenation is not implemented and there is no way to reference the entire contents of a list. Implemented dirname and basename functions when missing (on Mac OS X) in Eden using the new regular expression functions. This will fix an error that occurs when doing File -> Open on Mac OS X. Generic code for Interactive Process -based translators (ones that run in an external concurrent process, eg current arca and denota) implemented. Call installIPTrans(name, path) to install a new IP-based notation. Got edensl working in tkeden (newNotation now adds a radio button etc). Made it possible for new notations to override the built-in ones (eg %donald, %scout). Test with: proc p {} newNotation("%scout", &p, &p); Fitted Chris Brown's agent-oriented parser (AOP) into the new framework. The 'notation' builtin command has been removed, and is replaced by the new installAOP(); Eden command, which has the same arguments as the old notation command, except that the first argument (the notation name) must now start with the '%' character. Example modification required: change notation("eddi", "eddi_notation"); to installAOP("%eddi", "eddi_notation");. No further modification should be necessary. Added %donald0 as an alias for %donald, making it possible to define a new notation overwriting the built-in %donald but still be able to use it. Added eden_debug_notations Eden variable, and documented in eden.txt. Added a notationStack. This is used when a non-builtin notation is active and execute() or include() are called. These commands cause arbitrary text to be interpreted by Eden, and the currently active notation is expected to be restored afterwards. The notationStack handles this. Note that parsers cannot reenter themselves (ie, during a call to their "parseChar" function, invoke a call to execute() or include() which includes a notation switch to their own notation). Parsers can use other non-builtin parsers, but only if buffers are not shared between notations. Note that the IP translators do not share buffers, but AOP translators do currently, and so AOP-implemented notations cannot be used within the implementation of another AOP notation. ipopen() now returns a sensible error message if the command passed cannot be executed or doesn't exist. installarca() now starts Arca as an IP translator (the version in arcaWard2002). So Arca is now "integrated" into tkeden... but it runs slowly due to the one-second delay translator sychronisation problem. %edensl now makes a "whole" definition for each symbol list, which is defined to be the composite of the components, which were previously only accessible individually. A triggered procedure is automatically introduced for each list which updates the "whole" list definition if the list length changes. Concatenation is now handled in the standard Eden domain, using the "whole" value. %edensl has problems remaining when translating procs and with quoted parameters. Merged in Meurig's changes to arca.eden (a few variables were not declared as auto). Integrated Arca and Denota translators with a new empublic installation for these. In the DCS installation, these translators can be installed into ttyeden or tkeden by using installarca(); or installdenota(); Documented the above new commands roughly in eden.txt. ** 1.42 Wed Jul 10 20:34:37 BST 2002 ** Minor coding style improvements in eden.eden. arca.lib moved to arca.eden. Added installarca() function to eden.eden. Models using Arca should call installarca() once, before any Arca code is interpreted (rather like installeddi() and eddi code). The Arca translator will hopefully eventually be integrated into tkeden in a similar fashion to eddi, but for now we only have an external translator (arcaBird1991), which must be used to preprocess files with arca code before tkeden can load it. Improved Donald openshape example in donald.txt. Figured out what arc parameters [p1, p2, a] are and documented in donald.txt. Added information about trace() to eden.txt. Added info about errors from fopen to eden.txt. Added Eden ipopen(), ipclose(), fdready(), rawread() and rawwrite() functions in order to implement external translators in Eden. Documented in eden.txt. Removed traces of (commented out) kbhit() implementation, as fdready() does this job and actually works. Removed "ghost white" from rgb.txt. Checked into CVS. ** 1.41 Friday May 24 16:55:49 BST 2002 ** Fixed Scout image scaling for attributeexplorernnRoe2000: scaling by an integer size is now handled by Tk, which should work on all platforms. Non-integer scaling is handled by the external pnmscale utility, which might not exist on all platforms. Added note to Donald Quick Reference about arc's strange syntax (which doesn't match circle, rectangle etc. Added section numbering and contents information to quick reference guides. Eden modulus operator (%) now works on real numbers as well as integers. Added note to Eden Quick Reference about math functions returning floats. Added 26 new functions defined by Chris Roe to eden.eden. They are: max, min, sum, average, abs, nthroot, factorial, product, sign, even, odd, mround, sumsq, trunc, combin, ceiling, floor, degrees, radians, rounddigits, gcd, lcm, variance, stdev, sort, median. Each is listed below with the parameters that should be passed and some examples of how they can be used. In all the examples the list a = [3,4,5,6]; max(number, ...) or max([list of numbers]) : returns the maximum of the numbers e.g max(1,2)=2, max(a)=6. min(number, ...) or min([list of numbers]) : returns the minimum of the numbers e.g min(1,2)=1, min(a)=3. sum(number, ...) or sum([list of numbers]) : returns the sum of the numbers e.g sum(a)=18, sum(2,3,4)=9. average(number, ...) or average([list of numbers]) : returns the average of the numbers e.g average(a)=4.5, average(7,9,11)=9. abs(number) : returns number if > 0, otherwise returns -number e.g abs(-7)=7, abs(2)=2. nthroot(number,n) : returns the n'th root of the number given e.g nthroot(4,2)=2, nthroot(81,4)=3. **There may be some problems with precision of the answer with large n due to the C library function used. ** factorial(number) : returns the factorial of the number given e.g factorial(4)=24, factorial(-2)=@. product(number, ... ) : returns the numbers passed multiplied together e.g product(2,3)=6, product(a)=360. sign(number) : returns -1 if number is < 0, 0 if number = 0, 1 if number > 0 e.g sign(4)=1, sign(-230.2323)=-1. even(number) : returns the nearest even number to the number given e.g even(4.5)=4, even(5.5)=6. odd(number) : returns the nearest odd number to the number given e.g odd(4.5)=5, odd(3.5)=3. mround(number,multiple) : returns the number rounded to the nearest multiple of the given multiple e.g mround(62,6)=60. sumsq(number, .. ) or sumsq([list of numbers]) : returns the sum of the squares of the numbers passed e.g sumsq(2,3,4)=29, sumsq(a)=86. trunc(number) : returns the integer part of the number given e.g trunc(4.56)=4. combin(total,n) : returns the number of ways n numbers can be picked from total number of items e.g combin(4,2)=6. ceiling(number,multiple) : returns the number rounded to the nearest multiple of the given multiple that is greater than the number e.g ceiling(62,6)=66. floor(number,multiple) : returns the number rounded to the nearest multiple of the given multiple that is lower than the number e.g floor(64,6)=60. degrees(angle) : returns an angle given in radians with its equivalent in degrees in a range 0-360 e.g degrees(PI)=180. radians(angle) : returns an angle given in degrees with its equivalent in radians in a range 0-2*PI e.g radians(180)=3.14... rounddigits(number,digits) : returns the number rounded to the specified number of digits e.g round(123,2)=120, round(123,1)=100, round(123.232,4)=123.2. gcd(number, ...) or gcd([list of numbers]) : returns the largest number which will divide exactly into all the numbers passed e.g gcd(2,6)=2, gcd(6,9,24)=3, gcd(3,7,24,28)=1, gcd(a)=1. lcm(number, ...) or lcm([list of numbers]) : returns the smallest number that all the numbers passed will divide exactly into it e.g lcm(8,12)=24, lcm(4,6,8)=24, lcm(a)=60. variance(number, ...) or variance([list of numbers]) : returns the variance of the numbers passed or the list of numbers passed to it e.g variance(23,34,46,43)=80.5, variance(a) = 1.5. stdev(number, ...) or stdev([list of numbers]) : returns the standard deviation of the numbers passed or the list of numbers passed to it e.g stdev(23,45,67)=17.96..., stdev(a)=1.22... sort([list of numbers], direction) : returns the list of numbers sorted. the direction parameter should be 1 to return an ascending list, 2 to return a descending list e.g sort(a,2)=[6,5,4,3]. median([list of numbers]) : returns the median element of a list of elements, those elements do not need to be in any sorted order e.g median(a)=4.5. These functions have been tested, but there may still be some bugs in some of the routines. Please email croe@dcs if you find any problems with the routines. Most of the functions do not perform any error checking, they assume you are providing a valid list of parameters. Added two more functions from Chris Roe, inspired by functions from complexGardner1999: randomise() : seeds the random number generator with a random number rnd(number) : returns a random number between 0 and the number. Note that both 0 and number are included in the range. e.g rnd(1234)=567, rnd(9)=4. Lack of specification about rand() range documented in eden.txt. Added rgb2color and rgb2colour functions to eden.eden. Examples of use: %donald line l l=[{10,10}, {200,200}] %scout string g; window ash = { type: TEXT string: "Ash" frame: ([{10, 10}, {100, 100}]) bgcolor : g }; screen=; %eden g is rgb2colour(ri,gi,bi); A_l is strcat("linewidth=5,color=", g); ri=0;gi=10;bi=255; Added Help->Colour names, which contains the information from the file /usr/openwin/lib/X11/rgb.txt and some help about how to use colours in Donald and Scout. Added small amount of detail about EOF to Eden fgets file function in eden.txt. ** 1.40 Wed Apr 17 11:47:12 BST 2002 ** A few silly mistakes in the reimplementation of mouseClick observables (in 1.39) fixed. The multiple backups of the ~/.tkeden-history file added in 1.12 caused problems with multiple concurrent instances of tkeden running in the same user account with an NFS mounted home directory: machine 1 shifts history files, starts to use tkeden-history, machine 2 shifts history files, machine 1 gives stale NFS handle error. Changed from renaming files to shift them to copying instead. This means all the tkeden-history files will have the same file date, making it more difficult to find the relevant data when grubbing around in the history files, but it is possible to run multiple tkedens from the same account without problem. ** 1.39 Mon Apr 15 20:19:51 BST 2002 ** Reorganised descriptions of file handling functions in eden.txt slightly. The fix added in 1.37 which gives an error message on an attempt to eval() a local variable is now extended to attempts to reference the local variable $. The new builtin Donald reflect function was not working when given an openshape and a line: the parser was expecting it to return an openshape due to a missing break in Donald/check.c, whereas it actually (and should) return a shape. Fixed. Also added an extra test and error message to open2shape, and fixed donald.txt, which implied that rot, scale, reflect etc only take shapes, whereas in fact they take any Donald type. Optionally reinstated the "VB-like" feature of mouseClick observables removed in scout.init.e 1.11 (Eden version 1.17). To turn this old feature back on again, do "tkeden_vbfeatures=1;" in Eden. This is for use in getting old models to work only: new models should not use mouseClick and other "VB-like" features as they have been found in general to create more problems than they solve currently. ** 1.38 Fri Mar 1 23:31:32 GMT 2002 ** Fixed an inconsistency: query (?) previously ommitted the semi-colon after a procedural variable. Now the output from ?a; will show a semi-colon after both procedural and formulae variables. Added Eden stat() function, which provides access to meta-data about files (modification times etc). Updated fgets() documentation in eden.txt. Changed filenames in lib-tkeden to use the new extension names: .eden etc. Renamed macro.e to eden.eden, which is now loaded at startup (if it can be found). Removed eddipf.e file -- the text of this is now included at the start of eddi.eden. Added Eden symboldefinition function, which is intended to fix problems with the data returned by symboldetail() and relatives, as it returns the definition of an Eden symbol in a form that can be fed back to Eden using execute(), todo() etc. Bug fixed in agent-based parser: characters can now be escaped in strings: TEST << ["oh \"quote\""]; is now valid. Changed occurrances of "definitive parser" in this text to the more correct "observation-oriented parser", as the parser makes little use of definitions. Added copyproc() and showpara() procs to eden.eden. Introduced an optimisation that will allow the use of a particular list append idiom on long lists. The list concatenation operator is limited in the resultant size of list that it can produce, meaning that 'l=l//[q]' would fail with a stack overflow error if l was larger than 1023 items. This particular operation is now optimised (by additions to the parser and virtual machine) to the effect that 'l=l//[q]' is effectively translated internally to 'append l, q'. Note that the value of the expression 'l=l//[q]' is now @, not the value of the new list as previously, due to space limitations. A variation on the problem, 'l=[q]//l', is not optimised as it is a less common idiom. The optimisation also copes with strings, although the concatenation is not done in-place in this case. This change should allow EDDI to cope with much larger results (eg large joins). Added some more possibilities to debug(). debug(256): prints calls to execute, debug(512): prints calls to func / proc / procmacros with their arguments and return results (including indentation to show level of nesting), debug(1024): prints VMWRIT output (when opcodes are created in the VM for later execution). This last is also a part of the debug(1) output, which is generally far too detailed to be useful. Modularised tkeden notation radio button code. Added a Tcl proc named "removeNotationRadioButton" to allow scripts to remove the radio button for a notation in order to hide the notation's existence (note the notation itself is not actually removed). An example of use: %eden tcl("removeNotationRadioButton donald"); Added printstdout C function for use from gdb. Fixed commas within strings in EDDI: T << ["h,w"]; is now possible (previously the comma would have caused this to be recognised as two attributes). Fixed bug in EX/script.c: a textual script store was not being resized correctly when given a large amount of script. A fix was introduced in the last version to cope with the fact that TEXTBOXes are a different kind of Tk widget to the other types (TEXT, DONALD, ARCA, IMAGE). The previous fix was not correct: the code which was enabled was actually handling frames (lists of boxes). The obtuse and lengthy DisplayScreen procedure is now more understood and some comments have been added, as well as a more reasonable fix for this problem. Previously, Eden floating point values that were very close to their integer equivalent would be printed out as integers by query (?), writeln etc. 169.9999 would be shown as 170, for example. Now, floating point values are printed out at the precision available on the machine. Added Chris Brown to credits.txt. dtkeden bug fixed, which was introduced in release 1.21 (builtin.c 1.39) with the introduction of the 'procmacro' facility. When defining a procedure or function on the server, the redefinition sent to the client was corrupted: func definitions had 'proc procmacro' appended, procs had 'procmacro', due to some missing break statements in a switch. PI was previously undefined in ttyeden (as it was part of Donald), and defined to only 7 significant figures. Made PI a standard Eden definition, set from the more precise value available on the system from . Added information to Eden and Donald quick reference guides (eg note that in Donald, it is referred to as lower case pi). Added Chris Roe's round() function to eden.eden. Added documentation for macro, copyproc, showpara, round and eval to the Eden quick reference. Added documentation about ~/x, /x etc to Donald quick reference. Added debug(2048) to debug the Donald parser. Added debug(4096), which causes tkeden to print errors on stderr as well as in the error window. Donald parser was having problems on UNIX when reading files with DOS line feeds. In particular, within x NEWLINE { } was failing, because DOS line feeds are CR (\r), LF (\n), which was being treated as two NEWLINEs. The Donald lexer now ignores a \n which follows a \r. Optionally reinstated some code to do with back-ticks which appears to make the project timetable model work. Enable this hack by setting the Eden variable eden_backticks_dependency_hack to 1. Exactly what the hack does is not yet well understood, so it is optional for the moment. ** 1.37 Tue Feb 19 17:29:00 GMT 2002 ** Sync'd code with CVS. Attempts to eval() a local variable now give an error message instead of a crash. Eg 'func t { auto i; i=2; writeln(eval(i)); }'. eval is defined to give the value of a variable at point of definition. This is at the entry of the function in this case, when the function is not being evaluated, and so any local variables as yet have no value (although we do know that they are local variables). Hence an error is appropriate. Mac OS X tkeden port is progressing. Now automatically locates lib-tkeden, which is situated within the Resources directory of the application bundle. Bug fixed in call_float (which is where real-valued C library functions are called) on Mac OS X. sin(3.14159/2.0) would return 0.909297, not 1. In 1.19, a change was made: all values passed to a C library functions declared as SameReal (which are functions that return a real value, eg sin, cos) are passed double values -- integer parameters are cast to double type before passing. Now a more subtle internal change has been added to this: the C library is now given an array of doubles, not ints. Added debug(128) option for debugging calls to Tcl_EvalEC and Tcl_GlobalEvalEC. Added information about arguments to debug to eden.txt. Added an additional example to scout.txt. Fixed a bug where redefining the Scout screen to one that included TEXTBOXes might fail. When the screen variable is changed, the corresponding Tk widgets are modified in place if possible, not destroyed and recreated from scratch. Scout windows of type TEXT, DONALD, IMAGE and ARCA all seem to use the Tk canvas widget. TEXTBOX however uses the Tk text widget, and so when a window changes type to and from TEXTBOX, the corresponding Tk widget must be destroyed and recreated, else various Tk error messages occur when the widget attributes are changed. DisplayScreen is now nearly unmaintainable, being 400 lines of obtuse C code. It seems to contain some code which appears to try to manage the above situation. It seems to have been failing due to two erronous "+1"s, which are now commented out. Further use may reveal the original intention of these "+1"s and require a different solution. ** 1.36 Thursday November 29 19:26:19 GMT 2001 ** Using the system's close window button on the View Eden Definitions window previously caused a Tcl/Tk error, as I'd changed the menu code for this window, but not the close window code which relies on it. Updated EDDI files from Meurig's current version a little: new version of deps.e and new file newaddvals.e. Also cleaned up my modifications a little. ** 1.35 Tue Nov 20 13:22:19 GMT 2001 ** Merged in Chris Roe's Donald reflect primitive as a new Donald built-in. Added one line giving the syntax to the Donald Quick Reference on the Help menu. Fixed ttyeden on Darwin (Mac OS X). Now compiles and works OK (were problems with header files etc). No dirname and basename functions. Fixed implementation of Eden str() function when dealing with lists. Previously it had the same fault that was corrected in printing (writeln etc) in 1.29: strings and chars in lists were converted by str and were not given surrounding quotes. Now this example functions correctly: 1|> l=["hi",'h',5,[6]]; 2|> writeln(l); ["hi",'h',5,[6]] 3|> writeln(str(l)); ["hi",'h',5,[6]] ** 1.34 Thursday November 15 20:03:13 GMT 2001 ** EDDI in dtkeden server previously printed "Unrecognised EDDI statement" on stdout if the server's notation was set to EDDI and a client started or finished or if broadcast mode was selected. This problem was narrowed down to the EDDI parser not understanding virtual agent commands: a line containing '>>' is executed in the these scenarios. The EDDI parser is now fixed so that it ignores statements that begin with the virtual agent >>, <>, ><, << and >~ prefixes. ** 1.33 Thursday November 15 16:52:38 GMT 2001 ** Improved MAKING.A.RELEASE checklist. The scale function in donald.init.e previously ignored arcs. Chris Roe fixed this for his COG model. This improvement is now merged into tkeden, so Donald should now scale arcs. However, Chris' fix may be a slight fudge as it apparently doesn't scale the arc's "bend". ** 1.32 Fri Nov 2 12:24:37 GMT 2001 ** Typo fix in builtin.h and builtinf.h ** 1.31 Fri Nov 2 11:58:24 GMT 2001 ** Change to Meurig's newpivctn.e EDDI file. The prompt in ttyeden was previously incorrect after including a script file with a change of notation (or providing a -e option with a change of notation). The machine would actually revert to accepting Eden (incorrect) but the prompt would still show the other notation (actually correct). Given the time limitations today, I have made the easier fix, which is to fix the prompt to correctly show the state of the machine. As the semantics of an include() (or mention of a script file on the command line) is direct inclusion of that file in the input stream (rather than a "procedure call"), the machine should actually stay in the new notation (ie notation changes should persist across EOF). This will however require some restructuring of the lexer. This problem does not occur when typing input directly, as stdin never gives EOF. tkeden does not have this problem as notation changes are handled by functions in EX (which is not in ttyeden). ** 1.30 Thu Nov 1 19:31:37 GMT 2001 ** When using eager() in a tight Eden loop to modify a Sasami display, this previously caused a Segmentation fault. The crash no longer occurs, but the Sasami display is corrupted. Improved debug(2) output (RunSet debugging). Test with (eg): writeln(1); todo("writeln(2);"); todo("todo(\"writeln(3);\");"); Eden include() now stores number of parameters (file names) in a C stack variable, rather than relying on being able to read it from the Eden stack after each include. This should stop a few crashes due to nonsense values being read from the Eden stack. tkeden now correctly appends information to the history about the files stated for execution on the command line on UNIX. (On Windows, "cd(dirname(filename))" is done for each file before execution of "include(basename(filename)", which appears in the history). Both platforms now have a comment appended in the history which states the files were invoked from the command line. It was previously possible for the tkeden prompt (eg "Enter Eden Statements") and radio buttons to get out of synch with the actual current notation. Specifically, the Eden include() function, invocation of files mentioned on the command line and observation-oriented parser generator may have had this problem. This problem was not observed on Windows (for some reason). Added installeddi() Eden procedure, which adds the eddi parser to the environment when invoked. Added this info to the Eden Quick Reference. The Update button in the View Eden Definitions window now keeps the vertical scrollbar position instead of resetting it to the top of the document each time it is pressed. Added an Edit menu with Copy, Cut, Paste options to the View Eden Definitions window. This required reworking of the Eden Definitions menubar. Added information about return codes of forget() and type casting to the Eden Quick Reference. Tcl now sets the prompt label using the correct case of "statements" (which is later overwritten by C code anyway..., but which can be observed when running on a slow machine). The Eden forget() function can now take a pointer. However it will never return 1 (for "not found") as use of a pointer reference causes Eden to create the pointed-to item (as @) if it does not already exist. Added slightly more detail to Eden quick ref about nested comments. There was a bug in the one-line comment (##) code, which caused the next line to be ignored if the comment characters were followed immediately by a newline. "Merged in" Meurig's eddi changes by concatenating them into one long eddi.e file. ** 1.29 Tuesday October 16 19:22:15 BST 2001 ** Fixed bug introduced into ttyeden in 1.27. The fix was introduced as ttyeden didn't seem to deal with items in the todo() list correctly. The "fix" caused clearGarbage to be called at incorrect points, meaning Datums that were actually in use were freed: writeln("what the ****"); would print "(type=-14907, val=-976894523)" (as the string Datum was corrupted). checkRunSet and the associated clearGarbage, incGarbageLevel are now only done in one instance of print_prompt_if_necessary. This may reinstate the problems with todo() that the "fix" was introduced to solve, but there was no clean test case for it, and I no longer have Michael's ttyeden model code to test. Changed printing of strings and chars. Strings are now output with surrounding double quotes, chars are output with single quotes, unless their output was caused by writeln (in which case the contents of the string is usually required). This should help debugging (the ? query operator now shows the type more clearly) and reflection (when Eden code observes Eden code, perhaps re-executing it). writeln on a list always shows quotes, as it is also surrounded with list constructors and is therefore a "reflection" type of output. Fixed a bug introduced when improving the Donald error output. If Donald was "within" a context, this was not reset (an oversight introduced when adding this improvement). There was no way to return to the root context (as the Donald parser looks for "within { ... }" and will not accept "}" without the preceeding tokens). The context is now correctly reset and notice is given of this in the Donald error message. For example: %donald openshape ash within ash { error ** 1.28 Monday October 15 16:23:30 BST 2001 ** Fixed 'invalid command name: "tcl_wordBreakAfter"' error on Windows after Michael found how to reproduce it (double click in the input window). The problem was caused by the ommission of the tclIndex file from the Windows distribution (quite a few of the Tcl/Tk files are ommitted in order to save space). Files using DOS line-feeds (CR, LF: \r\n) in non-Eden notations (Donald, Scout, LSD, Sasami, custom) were causing errors when interpreted with the include() function (interpreting the code via the input window: File -> Open was OK as Tcl reads the file and seems to correct the line feeds). This is a very old bug: a problem even in tkeden-dec151997. Now fixed. ** 1.27 Thu Sep 27 18:44:13 2001 ** Now guessing location of library files directory on Windows in ttyeden (previously was only doing this for tkeden). eddi.e now tries to find eddipf.e in TKEDEN_LIB, not the current directory, so the command given below for starting tk/ttyeden with the eddi parser should now work even if eddipf.e is not in the current directory. File -> Execute -> eddi.e now works. Previously any Tcl code which required access to a global Tcl variable would fail when run from File -> Execute (as the Tcl 'eden' command was run within the access scope of the Tcl 'include' procedure). Moved checkRunSet into print_prompt_if_necessary (ttyeden only). This fixes a bug where ttyeden didn't seem to deal with items in the todo() list correctly. ** 1.26 Thursday September 27 12:49:42 BST 2001 ** Chris Brown's fix for strings containing single-quotes ttyeden now shows -l setting on -v. Fixed bug where %eddiarrgh would be a valid notation change. Other built-in notation changes with additional postfixes (eg %lsdarrgh) should still be valid, but notations in the observation-oriented parser now require an exact match. Fixed bug where a notation starting with an uppercase letter would cause an error in tkeden (as Tk doesn't seem to allow window names that start with uppercase letters). Including the eddi observation-oriented parser into the standard distribution. Load it with the Eden code 'include(getenv("TKEDEN_LIB")//"/eddi.e");'. This can be done from the command line: tkeden -l lib-tkeden -e 'include(getenv("TKEDEN_LIB")//"/eddi.e");' (this also works with ttyeden). ** 1.25 Friday September 14 17:11:49 BST 2001 ** Fixed minor bug preventing tkeden compiling without Sasami. Made it possible to use the observation-oriented parser within ttyeden. The observation-oriented parser requires the file trans.e within the library files directory, and so the -l argument now applies to ttyeden. If the -l argument is not given, ttyeden still operates, but the observation-oriented parser is not available (functions defined in trans.e are not available - likely error messages include "...'ident_ex' needed..."). The ttyeden prompt now includes the name of the current notation if this is not Eden, for example: "%eddi 4|>". Fixed many input-reading bugs to allow this to happen correctly (to do with EOF handling, prompt printing, line termination etc). There may still be some more bugs as the code is messy (Eden/lex.c really needs a rewrite in many places) and it is difficult to test all possible conditions. Fixed a memory bug in tkeden's prompt ("Enter xx statements:") setting code. ** 1.24 Wed Aug 15 16:15:34 2001 ** Eden "system" command now defined as a built-in, meaning that it should now work in a non-root virtual agent context (previously, the tilde "root virtual agent" specifier would have needed to be appended, ie "~system"). The cd(dirname(fileToInclude)) hack introduced in 1.17 which makes it possible to drag a model start-up file onto the tkeden icon on Windows (the hack sets the working directory such that the other model files can be found) was causing problems on UNIX when people start the tool with a command line including relative pathnames, so this hack is now only used on Windows. Chris's observation-oriented parser is now not compiled into ttyeden. It could be, but the executable then needs to be able to find trans.e and the -l option would then become mandatory for ttyeden, meaning it wouldn't be just a simple stand-alone executable. Since the current notation development using the parser seems to be proceeding using tkeden functionality, ommitting the parser from ttyeden shouldn't cause too much of a problem for now. ** 1.23 Monday August 13 18:18:58 BST 2001 ** Chris's updates to his observation-oriented parser: some functionality has been moved into Eden - particularly the decision about when to start parsing a complete 'chunk', meaning that a parser for a language with definitions spread across several lines is now possible. ** 1.22 Friday August 3 16:49:31 BST 2001 ** Merged in Chris Brown's observation-oriented parser. This may cause problems with some models as the additional Eden code which implements the observation-oriented parser may use namespace that is already used by some other models. Made installnot create a new radio button on the interface for a newly installed notation. Added 'notation' to eden.txt quick reference guide. ** 1.21 Thursday August 2 18:02:12 BST 2001 ** Fixed CVS/Root files which contained cssbz@127.0.0.1... instead of the correct cssbz@cvs.eden.sourceforge.net... Undoing a change I made in 1.19 which was to rename all upper-case filenames, as this will cause too much hassle with CVS. Compiled Tk Img package at DCS and made edenio.tcl load it if it is available. This gives Scout the ability to load images in the formats BMP, XBM, XPM, GIF (with transparency, but without LZW), PNG, JPEG, TIFF and postscript (previously it could only handle the Tk default of PPM/PGM and GIF). Updated various documentation with credits, installation and usage information. Help -> About tkeden now shows patch level of Tcl and Tk (eg 8.3.3 instead of 8.3), and also whether the Img package is available. Sync'd all the code with CVS again. Added 'setcvstag' target to Makefile to enable recording of releases in CVS. ** 1.20 Wed Jul 18 18:26:59 2001 ** Added ENTSTK to possible debug() output reset_stack and reset_compiler_status now give debug output Fixed "bug42": introducing the screen_width etc definitions in 1.19 caused a segv after an error in some circumstances (in particular, when the user made an error in a file that they included from a file after a %scout line). I had previously worked around this problem by leaving out a Tk "update" after adding text to the error window. If an "update" is not performed at that point, the error window appears to freeze during a series of repeated errors. Adding this update is in fact a new feature, but adding it revealed the above problem - that the error handling code was causing some Eden code to run with the intent of updating the screen_width definitions, and this foobarred the stack state (which is actually above the current stack pointer and so supposedly "discarded", but is still required after an error condition). Now the machine state is reset after the call to the error handling code, meaning the error handling code uses stack space above the state that must be left undisturbed. Limited testing so far seems to show that this fixes the problem. Now error messages should be visible in the error window even if Eden is in a tight loop (which is especially important now that complete error messages are not logged to a file). Added 'tkwait visibility' to OpenDisplay procedure, which means that any Scout screens should be shown even if Eden goes straight into a tight loop when starting up. Added to debug(2) output Fixed bug in error line buffer implementation. The 'rtos' function in donald.init.e had a bug causing memory to be overwritten. The first argument to sprintf must first be initialised to a string of length the same size or longer than the string to be written into it. Added warnings to eden.txt documentation. Proper error message if scoutScreenInitOpen can't be found (ie we are using the wrong -l settings). Character number reported on error now starts at 1, not 0. Donald dashed and dotted lines will now appear solid if your Tk version is less than 8.3 (the old dash_bitmap hack was removed in 1.19, which caused these lines to not appear at all). So we now have a dashed/dotted lines solution which should work reliably on all platforms and fail safe to solid if the platform cannot cope. (Note that the current Windows distribution uses Tk 8.0 and so dotted lines will not appear there). ** 1.19 Sat, 14 Jul 2001 21:35:52 ** Previously, calling touch() with a non-pointer (eg touch(me)) caused a Segmentation Fault and crash. Now it gives an error. Removed code from scout.init.e which fudges heights and widths to work with "buggy Tk" (version 4.0b3? - very old now). Added warningf C function (using varargs) to enable more complex warning output. Made warning use it. Improved error messages in the C-implemented Tcl commands, eg eden, todo, evaluate etc (see EX/ex.c). Scout now 'knows' the size of each display. Implemented some Tcl / Eden which defines Scout integers, named displayname_width and displayname_height which are the width and height of the display window. These observables are redefined when the window is resized by the user. This should make it possible to centre things within Scout windows, etc. This particular interface doesn't fit cleanly with the rest of Scout - perhaps this information should be obtained from Scout using displayname.width etc, but this would require more work. This hack will do for the moment - beware of future changes if you use it. Defined the new functions cd, cwd, dirname, basename as built-in functions so that when we are not in the root VA, the agent name does not get prepended. Unfortunately this means that the user cannot redefine the initial versions of these functions. Added Scout DFwidth and DFheight parameters describing the width and height of the screen to be opened (meaning we can redefine these before screen is opened...) Calling the Eden tcl() function with @ now results in an error message, not a Segmentation Fault. Control-C twice to kill tkeden on Linux now works correctly and doesn't go into a loop. Figured out Donald {distance @ angle} operator and added to (the previously extremely poor) documentation (also documented that Eden sin and cos require radians...) Fixed a bug involving passing strings with " characters in text boxes to Scout (a Tcl problem). Find... didn't work on Linux as \c was being interpreted as an escape sequence there (not sure what it is supposed to be interpreted as). Quickly fixed by using marks instead - not sure if this is a good solution. Made a separate Errors window and separated out history entries from errors. Now no longer a need to surround errors with comment characters. Errors from all notations should now appear in a uniform and more helpful way. Adding the startup stuff provided on the command line (eg -e, filenames...) to the history. Fixed (well, avoiding) a bug which caused tkeden to fail with Seg fault after encountering an error during initial startup (specifically, it seems to appear when the user makes an error in a file that they have included from a file included from a file, after a %scout line, all of which appears to be causing the errorf longjmp to jump to the include() C function (which it shouldn't) which then dereferences paracount and gets a nonsense value since there is nothing on the stack at that point). Somewhat obscurely, removing the Tcl "update" call after the error (which I inserted to get the display of error messages working OK during an error loop) causes this to work OK - eh?! The Tcl "raise" procedure (which brings a window to the front) appears to be causing problems on Linux, so I've redefined it to blank for the moment. Added what was encountered to the information given on a parse error (previously just printed what was expected) from translators using bison.simple (Eden, Donald, Scout). The error location indicator (^) now takes account of tabs in the input line, so points to the correct place if tabs are used. Fixed a bug where the heap was not freed when a empty statement list was used. Eg 'while (f()) {}' would cause heap overflow if f() did not return false fairly quickly, as the arguments to f() (a list of length 0) were added to heap on every call. The heap space would normally be reclaimed after execution of the first statement in the loop, but not in this circumstance. Added debugging output to internal C malloc function. Enable with debug(64); Circle colouring in Donald has been reported previously as not working. It is still working - at some point in the past, the attribute name required changed from 'color' to 'outlinecolor'. The -e command line option didn't work correctly on Linux when it followed a filename (eg ttyeden errortest/args.e -e "writeln('n');"), as getopt on that platform permutes the contents of argv as it scans so that eventually all non-options are at the end. Turned this behaviour off and -e now works correctly on Linux. ttyeden -u output was incorrect. C-lib "illegally typed" error message improved. Stack trace given for error messages now says "in ..." for first func/proc... rather than "called by". This should help to understand where the error occurred, for example in the case where a proc/func etc tries to reference outside the parameter list - the location of the error was likely to be construed as the caller in the old error message style. Code that would have probably caused "called by action " fixed. Error message formatting improved where 'stack pointer was inconsistent' is mixed with an error message. Decided to remove 'stack pointer was inconsistent' notice as most of the time it simply seems to just add more noise to error messages - the pointer was inconsistent because an error occurred, I believe probably in all circumstances. Added an 'error number' identifier which shows up in the history and error windows, allowing us to reconcile the two together if need be, and as a reminder in the history file that the input caused an error. In 1.13 C-lib real-valued functions were modified to give an error when called with non-real parameters (before, they used to silently return strange values). Now any integer values passed to one of these functions (eg sin, sqrt...) are internally cast to floating point before calling the C function, so that meaningful results are now obtained when calling these functions with integer values. Improved 'not read/write variable' error message (which happens in eg 'writeln++' where writeln is not a local variable). Now giving the name and type of the offending variable. arca.lib now uses a modern-style font name declaration, so has more hope of working on multiple platforms. Added '##' as a one-line comment to Eden. The character sequence '##' now causes Eden to ignore input until after the end of the line is encountered. The single '#' character cannot be used as a one-line comment token in Eden as '#' is already used to denote list/string length (and the C++ one-line comment '//' is also already used in Eden for list/string concatenation). '##' comments can already be used in Donald, Scout and Sasami as those notations already implement the '#' one-line comment syntax. '##' can therefore be used in any notation currently built-in to tkeden. 'Error number' identifiers now inserted into history are now commented with '##', so that history can be re-run in tkeden with no modification. Turned filename completion (a function provided by readline when you press Tab) off in ttyeden. Readline now knows that the application name is ttyeden, so conditionals using this information are possible in ~/.inputrc (but this is currently untested). Fixed a bug in and improved the ttyeden prompt. Previously, a comment would cause the prompt to fail to reset from the "waiting" prompt ("+> ") to the usual prompt (":> "). Now the prompt correctly resets, and there are multiple possible "waiting" prompts. The usual prompt has been modified to make the difference between it and the "waiting for semi-colon" prompt clearer. The new prompts are: |> - the usual prompt ;> - prompt when waiting for a semi-colon |> - prompt when waiting for a close-quote *> - prompt when waiting for a close-comment Reworked the tkeden previous/next history implementation added in 1.13, which used a cyclic buffer to represent history. This implementation wasn't the same as other implementations of history (eg in various shells) and caused the history to be overwritten after using Previous to "go back in time" and then continuing to make entries (overwriting history). On inspection, other implementations of history seem to be simpler than this and "go back in time" only for the duration of the current entry. tkeden now follows this scheme, retaining twenty items of history, and beeping if the user attempts to go beyond the recorded limits. Added Alt-p and Alt-n key shortcuts to tkeden for previous / next in history, as some configurations have no Meta key and Alt-Control-Up/Down is used by the window manager. Shift-Control-Tab was causing the entire menu bar to tear itself off. Fixed. Donald dashed and dotted attribute support reworked using the third party Tk "dash patch" which was finally merged into Tk in version 8.3. These attributes will not function if you are using earlier versions of Tk, but if you are, they are likely to function correctly (unlike the previous hack which involved 'stippling' the geometry with a dotty bitmap, which failed to function at certain angles on certain platforms). This version of Tk does not seem to be easily available in cygwin and hence the PC port, but the previously hacked version didn't work on the PC anyway. It seems that the attribute "linestyle=dotted" was not supported at all in the previous version (despite existing in the documentation) - it should work now. Renamed files with all upper-case names as they cause problems when they exist on a vfat (Windows) partition mounted from Linux. Checked out memory leak bug in COMICAL/ROADSYS, which was mostly fixed in 1.1 ("bug5"). There is still a small leak, but it looks like this is probably attributable to Tcl (specifically TclpAlloc). Added eden_prompt variable to ttyeden Eden which specifies whether the prompt will be displayed: 1 (default) means the prompt will be displayed, 0 means don't show the prompt. The value can be modified directly or via the -n and -i command line options (which do correctly trigger any actions triggered by eden_prompt as they should). Had to work around a bug in libreadline4 (reported to Debian as bug #105231) to get this to work. Bug fix: ttyeden previously would quit after two control-C presses, no matter how length a time interval between them. Bug fix: ttyeden does not now use readline if the current input file is a pipe (technically, ISFIFO), meaning that the 'old-style' pipeline translators still behave as they did. Removed some dead code relating to storage about input. Reworked my line buffer (added for error handling) so that it resizes dynamically, meaning Eden once again has no line length limit (I unwittingly introduced one probably around version 1.13). ** 1.18 Fri Jun 29 2001 5:30am :( ** Changed Scout "parse error" to something more informative. The 'sensitive' functionality added for Chris in 1.13 below is still not right, despite some more fixes in 1.17. When 'sensitive' is used in a window in a virtual agent context, the ON, MOTION etc values were being prepended with an agent name, meaning their value was unknown, meaning that the parser moaned. Changed these values back into items in the constants table, meaning that the VA name translation is not done. Had to hack the values of these constants, given that Scout lacks a proper 'integer' type (they are actually 'double' - see below). Now added an 'integerhonest' type, the tree constructor function of which actually takes an integer. The internal value is still stored as a double, as per Simon's original hack (which was added before the start of version control on this source). In summary: 'sensitive' now works in VAs, but Scout still needs un-hacking wrt the integer type. Renamed 'dummy.c' to 'nothing.c' as the configure script seems to keep removing it on Linux. Got dtkeden to compile on Linux (need different headers for MAXHOSTNAMELEN) Bug fixed: previously trying to File -> Open a file without an extension would lead to an attempt to load the filename with a .e extension. Documented font specifications in Help -> About Donald, Scout Updated Eden Quick Reference with a few more of the additions I've made. Changed default file extension in File -> Open etc to *, as none of our existing models use the .eden, .donald... extensions yet. Fixed a bug introduced in 1.17 where Scout windows always seemed to have a border. This was actually due to yet another bug in my 'sensitive' reimplementation, which caused screen[n][14] (the sensitive attribute) to be defined as @ if it wasn't specified by the modeller. Previously it would have been defined as 0 in this case. Now it is defined as DFsensitive, which is zero by default. ** 1.17 Wed Jun 27 2001 4am :( ** The Scout 'integer' type is actually more subtle than described below. Actually Scout has another type, 'real' (which is only mentioned in an example in the documentation). Both 'real' and 'integer' are stored as C doubles, and have the parser identifier INTEGER. When a Scout number is output to Eden, tests are performed to see if the decimal part is zero - if it is, then the number is output (mostly) as an integer. We still need the 'real' type, particularly when scaling images, and replacing this hack with a proper implementation of real and integer separate types would take more time than is available at present, so moving back to the previous (hacked) implementation. This implementation causes problems when feeding numbers from Scout to some Eden functions, but this can be worked around in the models by casting to (int) when required. The 'sensitive' functionality added for Chris in 1.13 below was actually buggy (it was untested until now): the functions in scout.init.e were being passed the value of the pointer to the sensitive attribute, not the actual value. This is now fixed, and the mouse / key Tcl bindings are now set up by one procedure in scout.init.e instead of two. MOTION, ENTER and LEAVE will not work within TEXTBOXes for now, as some more work needs to be done on TEXTBOX first. _mouseClick ("VB-like"?) functionality removed from scout.init.e at the same time as above, as the use of this feature in models seems to cause more problems than it solves. (Note: this will break some existing models). Minor bug fixed: errors from keyboard input in ttyeden would be reported as from file '@': now correctly from file "stdin". Added Eden cwd() function and cd() procedure. The cwd() function is marked as out-of-date whenever cd is called, so the procedure 'proc pcwd : cwd { writeln("cwd now ", cwd()); }', giving a UNIX shell-like prompt is possible. Added Eden dirname() and basename() functions, which give the containing directory and filename of a file path respectively. Now, for each initial file to load specified on the command line, cd-ing into the containing directory of each file before attempting to execute it. This will leave the cwd set to the containing directory of the last file on the command line. This is intended to make Eden include(...) calls in a script more effective if the tool doesn't have a sensible initial cwd (which is true on Windows most of the time). Some of the code for this trick is implemented in Eden, so that the cwd() function will be correctly re-evaluated when the cds are performed. Note that it is possible to make Eden appear in the Send To right-button menu in Windows by setting up a short-cut to it in the C:\WINDOWS\SHORTCUTS folder. This cd hack should make this short-cut trick work in more situations (note that it is also possible to select multiple files to Send To Eden). Note that the include() Eden function does not itself do a cd() - if you are using include(), you may do a cd() in the script yourself. Rewritten the File -> Open / Execute cd trick introduced in 1.15 from Tcl into Eden, meaning the cwd() function will be correctly re-evaluated when including files via this interface-driven route. Removed traces of 'tkusage', which apparently was an external application intended to keep track of the use of tkeden. Now storing the last twenty items of tkeden previous/next history. Deleted some stuff from edenio.tcl that was no longer needed (some comments and the old file browser things). Set the colours for the radio button bar to something other than grey to distinguish it from the menu bar on Windows. Removed code from edenio.tcl which fudges the text search to work with "buggy Tk" (version 4.0b3? - very old now). Added key shortcuts Alt-s and to View Options dialog. Find dialog: added case sensitivity option, "find in...", key short-cuts. Improved display of found text: previously it used the selection (sel) to highlight the text, which was not visible unless the window has focus on windows. It is worth noting that the Find dialog can take regular expressions (eg "ash.ey", '.' meaning any character or "^start", '^' meaning start of line etc etc) as the search string. Added Help -> Scout, DoNaLD and Sasami quick references, but they aren't really finished yet. ** 1.16 Mon Jun 25 2001 10pm ** Eden include() can now take multiple filenames: eg 'include("one.e", "two.e");'. This should assist us with replacing our many 'run' UNIX shell scripts (of the form 'tkeden stuff.e blurb.s') with 'run.e' Eden scripts (of the form 'include("stuff.e", "blurb.s");'). "multiplePossible" trivial Windows bug introduced in 1.15 fixed. File menu now has File -> Open and File -> Execute, as the meaning of Include was a little unclear (although it is technically correct, referring to the Eden function). Changed file types used: now using .eden, .donald, .scout, .sasami and .script. The single character file-types were inadequate in many ways (we now have >1 notation as a candidate for .s, .s is also used for assembler files etc). '.script' is intended to be used for the circumstance where a text file contains a script which uses mixed notations: Eden and Donald, for instance. Hopefully this won't cause problems with Windows 8.3 filename limitations. Adjusted keys.txt slightly - moved previous / next up as they are quite a common need. Eden's IPC functions (send_msg...) are now an optional compile (enable with ./configure --enable-ipc) as I can't get them to compile on Linux. Rewrote Eden gets() function to actually use fgets() as use of gets() results in the compiler warning "the `gets' function is dangerous and should not be used." Reworked the curses stuff a bit to make it compile on Solaris and Linux more easily. Rethought the declaration of the 'rand' function to make it compile on Solaris and Linux more easily. Also 'srand'. Sasami had some source files where the end of the file was missing a newline - the compiler on Linux warns about this, so corrected. (Probably) fixed a bug where Tcl would give 'invalid command name "tcl_wordBreakAfter"' when clicking in the input window after an error. This was introduced in the previous version when the Windows distribution was optimised to fit onto a floppy disk, missing out the file tcl8.0/word.tcl. Previously, the Scout 'integer' type was actually stored internally as a double and passed to Eden as a floating point number. This caused problems in the jugs model as the value was then passed to an Eden function which expected an integer type. Scout now holds 'integer' values as integer, and attempting to define a non-integer Scout value will result in "failed assertion" error at runtime. Previously redefining the type of a variable in Scout would cause a segmentation fault and a crash. It seems that 'extern char *scoutErrorStr' and 'extern char scoutErrorStr[]' are not equivalent and this is where the problem stems from (the area of memory designated for the error message was in read-only memory). So now Scout gives a nicer error message and doesn't crash. ** Rel1.15 Mon Jun 25 2001 ** Ancient history added to this file. Improved window creation on Windows: hopefully they should mostly be created on top now. Fixed bug in View Eden Definitions that caused some agents not to be displayed (bug due to me forgetting that malloc doesn't zero memory). Now specifying font for input window as courier - so we get fixed width characters on Windows. Tcl_Init was falling over with "couldn't stat "": no such file or directory" - fixed by inserting a call to Tcl_FindExecutable in main.c Changed many #include <...> to #include "..." to denote that they are not system header files. Removed -I., -I.. and -I../Eden from CC Make rule, so the location of all header files should now be explicitly stated. Ported the new Sasami implementation (using Togl) back onto Windows. Changed right mouse button being used to button 3 so it works on Windows (this will cause the button used to be changed on UNIX). now deiconifies and raises windows that were iconified (eg minimised on the Windows taskbar) Changed method of specifying ~/.tkeden-history, meaning this should now work on Windows (but assuming the $HOME variable is set...). Auto-detecting where the Eden library files and Tcl init files (ie the setting of the TCL_LIBRARY environment variable) are from the current working directory on Windows, meaning we can do away with needing the run.bat hack to start tkeden (which previously required some manual user configuration). Things even seem to work when we install into a directory with spaces in the path (eg "My Documents", "Program Files" etc), although I'd guess that not all models will handle this situation well. Updated the make windist implementation. DOS line feed versions of the text files are now created using a unix2dos.sh script I created, so that Windows users attempting to read the documentation with Notepad are not stuck. Previously we needed the binary cygpath to be installed along with tkeden, as we need the functionality to convert from UNIX style paths to Windows style paths in edenio.tcl. Now a new Tcl command cygwin_conv_to_full_win32_path is implemented which calls the CYGWIN DLL to give this functionality instead, so we no longer need the cygpath binary. Updated credits.txt to show libraries used. Rewritten some font and display handling functions (StringWidth, FontWidth, FontHeight, DisplayDepth) that were previously in C in Eden, using Tcl functions. Removed EX/disp.c and EX/disp.h as the functions are no longer needed. Fonts should now work on Windows as they do on UNIX (the jugs demo seems to work correctly, for example). The default Scout font is now specified in a platform- independent manner, and seems to be a good size on Windows at least. Note that now that the font handling is mainly Eden code, some dynamic configuration can be achieved - eg the value of DFfont can be changed (eg 'DFfont = "{courier 18}";') and the screen will update automatically etc. As the DOS tkeden stdout/stderr window now disappears as soon as tkeden exits, which gives the user very little time to view any error messages, tkeden now includes a signal handler which asks for the return key to be pressed in the window before the signal takes effect. This won't work in all potential cases, but it should do some. Reworked the menu bar in order to get the key shortcuts working correctly on Windows. Unfortunately the changes required mean it is no longer possible to show the Accept and Interrupt menu entries differently from the others. To solve this, Accept and Interrupt are now buttons in the radio buttons frame. Reworked the file save / open dialogs, using functionality that Tk provides. The result will look the same on Windows, but a better dialog will be provided on UNIX. Removed win32ex.c, win32ex.h as no longer needed. It is now possible to File -> Include multiple files simultaneously (but on Windows only - this has only recently been implemented in Tk 8.4a2 on UNIX). Use Control or Shift to select multiple files on Windows. Previously, File -> Include always inserted the text of the given file into the input window, and then into the history window when the accept button was pressed. This fills up the history rather quickly. Now we have File -> Open, which gives this behaviour, and File -> Include, which does an Eden include(...) to read the contents of the file into the tool without filling the history too much. Changed default value of undef_reference_notice to 0 as we have too many existing models which reference undefined values as they load. If you are debugging a model and suspect that problems may be being caused by undefined values, try setting undef_reference_notice=1; Checked: I've heard reports previously that running models with intensive continuous computation may cause the tkeden interface to have problems (eg allegedly it was difficult to do File -> Quit whilst the VCCS was running). I've checked this problem again now and it seems to have been fixed. Now cd'ing into the directory containing the file when doing File -> Open or File -> Include, which helps Eden include(...)'s in the model to work. Added code to main.c which makes the library location path an absolute path if it was specified as relative (by prepending the current working directory) to make the Help items work in this circumstance. Decided on size of 10 points for the edencode default font, which seems to give our customary size on UNIX (although it may be a little large on Windows). ** Rel1.14 Thu Jun 14 2001 ** Added Help -> CHANGELOG Merged Ben's Windows Changelog information into this file. Added Help -> Credits Fixed bug in errorf that caused Tcl errors (eg from Tcl_EvalEC) to come up with no information. Fixed sasami_viewport_bpp (I don't see how it could have worked before). Debugging facility getting still more functionality. Call the Eden function debug() with a sum from these values to set what you want to see: 1: various 2: RunSet debugging 4: Eden parser debugging (=yydebug) 8: Sasami 16: Donald 32: Scout parser debugging (=st_debug) Improved the input window text insert cursor: it is now coloured, bigger and the flashing is hopefully a bit better (it spends little time being off, meaning you shouldn't lose sight of it). Added Help -> Eden Quick Reference, with formatted (blue) "optional" syntax text. Added ellipsis (...) where appropriate on menu entries to show that they lead to dialogue boxes... Added a -e argument, which enables the passing of some code to execute from the command line. Any occurrances of \n are translated to newline characters (as the shell passes them literally) before execution of the string, to enable notations to be switched etc. Examples of use: tkeden one.e -e "writeln(1);" two.e tkeden -e "%sasami\nopen_display" Note this might cause problems if you actually want to use a \n as you normally would (eg in an Eden writeln). Fixed some bugs in command line handling (I think -n, -i would not have worked on ttyeden in combination with files since I changed option handling to use getopt...). Figured out how to work around a bug which causes Sasami to use false colours on a Solaris machine with a cheap graphics card. There is a bug somewhere (Sasami, Togl, Tk, X, OpenGL?) which causes Eden to use the wrong visual and colormap when running using Solaris 8 X and OpenGL on a machine with an 8-bit (old, low end) graphics card. The easiest way to solve this problem currently seems to be to link Eden using Mesa (which is most simply described as an open-source OpenGL)... so I've added the necessary tests and options to configure to allow Mesa to be used instead of the Solaris OpenGL. Sasami seems to work now even on an XDM terminal (albeit extremely slowwwly). ** Rel1.13 Mon Jun 4 2001 ** Attempting to add a 'procmacro' feature, similar to 'proc' but with a screen update and user input phase (ie tcl "update") - basically, a call to eager() between each statement as they are executed. Eden procs appear to have two optimisations compared to entering statements line by line in the input window: screen update is delayed during RunSet evaluation, and the formula queue is not updated unless it is necessary (eg writeln on a changed variable). This optimisation is useful and necessary as we quite often want state change to be indivisible. 'procmacro' was named thus due to the existing definition of a procedure named 'macro', which does string substitution and is used by Donald and some of the older models I should think. Defined YYERROR_VERBOSE to get more information during parse errors. Added errorf function which operates like printf. This has allowed me to improve many of the error messages, giving extra detail of the problem (typically, I'm printing out the value that causes a problem and what was expected). Added information to the UNDEF (@) Datum which allows me to give an error message stating /which/ func/proc/procmacro could not be found in that event. Made Eden use bison.simple, meaning we should get more helpful parse error messages and possibly fairer input input / calculation balance. Added to debug() functionality - it now controls yydebug as well. Now giving decent location information on errors, in the form: error blah while blah near line x, char x: original line ^ (char indicator) Added %expect definitions to parsers to prevent shift/reduce conflict errors on parsing expect when the number of conflicts changes. Added an Update button to the View Eden Definitions window which rebuilds using the options that the user chose last time (avoiding having to select them again using the View Options window). Fixed a bug which shows when a triggered action combined with an internal formula redefinition use the same triggers, eg proc xx : b { a is b+1; }. In this example, b was previously given the trigger [xx] when it should really be given [xx, a]. The lack of triggering means that the definitions involved suffered from lack of reevaluation and their value could get out of date. Fixed a bug which occurred when the frame overflowed. For example proc p { p(); }; p(); would give an error with "called by action ^A^CX" or even seg fault. Now not attempting to print out nonsense frame information. Improved information (giving type of item called) given in this error message as well. Internal documentation improved a lot whereever I can. C-lib real-valued functions (eg sin, cos, pow...) used to give strange results when called with non-real parameters. All of these functions seem to require real-valued parameters, so Eden now gives an informative error message when the wrong type is encountered. Put more information into the int-valued C-lib error message as well. Fixed a bug involving use of query which would in some circumstances cause a seg fault. Eg proc p { para q; ?q; }; p(42);. Changed query operator. When it encountered values, previously it would simply display them: 4:> a=42; 5:> ?a; 42 a ~> []; Now the query operator prints "a=42" for consistency with its other outputs. It also now prints out the identity of the agent who changed the symbol last. Improving debug() output a lot. Categorising each output: CALSTK call stack (changes call stack) SYMTBL symbol table modification DEFNET definition network (changes definition network structure in SYMTBL) VMREAD reads data from prog array VMWRIT writes data to prog array VMEXEC virtual machine execute change progp DATSTK data stack operation MCSTAT use of other machine state HEAPAL involves some heap allocation VMOPER virtual machine op (in inst.h + probably invoked via func ptr deref) FQUEUE formula queue AQUEUE action queue PARSER parser use | (bitwise OR) to form combinations, in the order that it occurs procedurally. Added a disassembler function disAss and using this in execute and other places to display the symbolic name of the opcode about to be executed etc. Rewrote push and pop as functions for DEBUG, which will slow performance in DEBUG mode but lets me print out valuable stack debugging information. Added a notice if you attempt to get the value of a variable which is actually undefined (this should be useful as people frequently mis-type variable names, I'm told!). You can turn this on and off with using the variable undef_reference_notice - required as this isn't an error and can be intended behaviour in some models. The default is for these warnings to be on - might need to reconsider this later. Added a Next item to the Edit menu. Now have Previous / Next. The input window now stores ten previous items entered and you can cycle through them with Edit -> Previous and Next. As well as the Alt-E, [r|n] shortcuts for these (can't use Alt-E, p as this might be used in the future for paste), I've implemented Control-Alt-[up|down]: use the cursor keys. Had to use the two modifiers together as CDE uses Alt-[up|down] and Tcl seems to give a simple up/down through the text with Control-[up|down]. Also added Control-Alt-0 key shortcut for clear for completeness. The key shortcuts are marked in the Edit menu. Also added Meta- shortcuts for those with meta keys. Changed Accept into a raised button, to show it is different to File etc which are menus. Giving current value in a comment for formula on ? query to save people having to writeln formulae to get values as well as ? query to find the definition. Previously tkeden beeped every time an error occurred. If you were unlucky and got a series of errors or even a loop, you had an embarrassing stream of beeps. Now tkeden only beeps if it hasn't beeped in the last three seconds. Scout screen window does not now appear when tkeden is initially started (it always used to previously, usually causing the input window to be obscured). The screen window is created on the first occurrance of '%scout', when we can assume that the window is going to be used. Made the default input window a bit bigger. Made tabs in the input window the width of two characters to try and help people format their code there more easily. Control-U in the input window now deletes any text to the left of the cursor on the current line (as per many UNIX shells etc) - an easy way to quickly undo something you just typed which was wrong. Added a few more items to the Edit menu: Select all, Select non, Copy, Cut, Paste. The title of all windows created by tkeden now include the tkeden version number, and for dtkeden, whether dtkeden is running in server or client mode. This should help to identify whether the history window that has just popped up in dtkeden is from the server or the client. Now when you attempt to close the History window, Eden definitions etc using the window manager (clicking on the window's close box), it works. (Hopefully including windows created by scout here). Added help to the Eden Redefinitions window which reminds us that control-click can be used to select individual items. Now, if Shift-Control-Tab is pressed in any tkeden (input window, View Definitions, scout windows...), all the tkeden windows are brought to the top, with the Input window top-most. This should help with window management when there are many windows on the screen. Additions to Eden built-ins specifying behaviour now changed to eden_error_index_range and eden_notice_undef_reference - more sensible and hopefully avoids most clashes with user code. Made it possible to do related by statements with a LHS that is evaluated at run-time, eg r="c";`r`~>[q]; Fixed a bug which prevented the use of related by statements within procs eg proc q : w { a ~> [q]; } (before, note that ?q would have shown the lack of identification of the w trigger). Removed some code added by Patrick to yacc.y 1.8 (Rel1.0) which looks like it was attempting to fix the problem of referential dependency. It actually makes this problem (if indeed it was attempting to fix it) worse. Moved Edit menu next to File menu (so order is now File, Edit, View...) Added source code Makefile dependency checking, using the preprocessor options to get this information. Enable with --enable-depend to ./configure: see INSTALL.TXT. Made dtkeden View -> Client connections window consistent with the other View windows in the interface. Also, the dtkeden client Send button is now raised, whereas on the server it is normal, in an attempt to show whether the button is a menu heading or an action button. Improved usage information (-u) for dtkeden. Made Tcl aware if Sasami is available or not, and hide the relevant options if it is not. Added radio buttons above the tkeden prompt which emphasise the currently selected notation (ie which interpreter we are talking to) and which can be used to set the currently selected notation without needing to type %donald etc at the top of the input text. Gave the text input window a white background to make the interface look less mono coloured and to make text there more readable, both on the screen and in printed screen shots. Added a Help -> About key shortcuts dialogue giving lots of information about possible key presses in the input window and elsewhere. Ported Sasami to UNIX. Replaced Ben's Windows-specific Sasami window-creation code - using an implementation of an OpenGL Tk widget named Togl (http://togl.sourceforge.net/ - had to get the most recent development version from SourceForge CVS) instead. Sasami also uses GLpng for loading PNG images as texture maps (http://www.wyatt100.freeserve.co.uk/download.htm) - luckily this compiles OK on Solaris. Now the Sasami window creation code is mainly Tcl/Tk, in edenio.tcl. The mouse movement code is also now in Tcl. Sasami errors now use the Eden (not Windows) facilities. These changes should allow portability of Sasami across UNIX / PC / Mac (in the future) and should allow extensions: 1) feedback of which polygons the mouse is currently positioned over to Eden, 2) wrapping of (multiple?) Sasami windows in Scout. Sasami is now always included in tkeden, unless you specify not using a configure option. The Sasami window now seems to be resizable (I assume Tcl is passing events through to the togl widget), so if a model is running slowly on your particular machine, you can make the window smaller. Now when Eden changes some Sasami state, the renderer is not immediately invoked - rendering is delayed until the next Tcl update (until a change of RunSet) and so rendering a change to the Rubiks cube etc is now much, much faster. I've changed the default camera position too, to be further away from the origin as most models seem to be quite large. LICENSE files added to Docs for Togl, GLpng. Major re-implementation of the Makefiles as the make 'include' directive seems to be fairly globally available, so all the Makefiles now include ../generic.mk. Control-C now just causes the error message to occur on stderr, as the reentrant call into Tcl when interrupted in Sasami causes Tcl to crash. Also now using a timer (like the beep timer) for control-c: previously, control-c could only be pressed once during a session - the second interrupt killed tkeden. Now tkeden can be killed by interrupting twice within three seconds - if the interval is longer than three seconds, the warning message appears again. main.c: checkRunSet unified multiple TTYEDEN, DISTRIB etc versions into one piece of code. Run time behaviour of the versions may change slightly as a result - hopefully for the better. Pressing the interrupt button now gives a visual indication of the press. The VMEXEC machine now stops executing if the interrupt button was pressed (so it should be easier to stop tkeden if it is stuck in a tight loop). Wrote a Tcl_EvalEC function to evaluate Tcl code and do an error check on the result. Actually uses Tcl_EvalEx which should speed things up slightly. Bug fixed: definition of a TEXTBOX in Scout would show up as UNKNOWN in the View Scout window and in a Scout query ? operation. Added 'bitand' and 'bitor' infix operators to Eden: same syntax as the eager 'and' and 'or' operators, but they give the bitwise result. Added sensitive: ENTER and sensitive: LEAVE functionality for Chris. OFF, ON, MOTION, ENTER and LEAVE are now pre-defined Scout symbols: combine them by adding, eg: 'sensitive: ON + ENTER'. ** Rel1.12 ** Fixed a bug with back-ticks ``. A change that Patrick introduced made back-ticks evaluate at first definition, even if autocalc was off, causing possible undefined function errors etc (unfortunate as the View Eden Definitions etc show definitions first, then functions). Also the code had a confusing and unnecessary * pointer dereference - fixed. Got Tcl to sort the list given in File -> Include (finally). Added index_range_error Eden integer value. It works in a similar way to `autocalc'. If the value is 1 (as it is by default), then Eden's behaviour is as previously: it gives an error "index error: out of range" when asked to evaluate a reference into a string or list which is out of range. Setting index_range_error to 0 causes Eden to simply return @ and give no error instead. Added an Edit menu with Previous and Clear options. Added key short cuts for windows opened with OpenDisplay (so you can now remove the annoying default scout window using the keyboard only if you don't want it). Now keeping three backups of ~/.tkeden-history (as people don't seem to look at this file after a crash until they've restarted tkeden a few times). ** Rel1.11 ** Added GPL license and changed existing CHANGES.TXT to add this Removed 'doubling stack allocation' experiment which never should have really found it's way into a release 'cos it didn't work. Added changes required to tkeden/Makefile.in and configure.in in order to be able to build on my Sparc 2 at home (Solaris 7 + some GNU things). Improved build documentation - removed very outdated INSTALL document, replaced with a document describing requirements and build process. ** Wed Nov 15 16:40:41 GMT 2000 Rel1.10 ** About to create a tarball for import into SourceForge. Will leave the RCS information around in the hope that they can import it into CVS, but remove all generated files and also the stuff in the Windows dir that isn't part of Eden source. Also it looks like it is difficult to rename directories etc in CVS so lib-tkeden1.9 will become lib-tkeden. Reworked this CHANGE.LOG into reverse chronological order. ** Wednesday October 11 17:55:40 BST 2000 Rel1.9 ** Minor changes to documentation in Windows/run.bat and TODO Had been experimenting to try and get something like cat - | arca.trans | tkeden to work (ie tkeden reads commands from stdin whilst running all other stuff simultaneously). Ran into problems with buffering in pipes, so the kbhit() function I added is now ifdef'd out. ** Sunday September 3 21:49:19 BST 2000 Rel1.8 ** Added comment to scout.init.e about using Tcl to do trivial ImageScale-ing. Copied $PUBLIC/lib/tkeden/nArca.init.e into the lib directory as arca.lib, and added revision control header as arca seems to be considered more "mainstream" than I thought. Sorted out Docs/TODO a lot. windist target strips the executable now - this makes it all fit onto one floppy :) ** Thursday August 31 18:57:44 BST 2000 Rel1.7 ** Found a copy of config.guess and config.sub from /dcs/rap/mp3/cdparanoia/cdparanoia-III-alpha9.7/ as the GNU CVS site is down. This seems to be required now that locally, autoconf seems to have been "upgraded" to 2.14a (and the older version has been removed). Directory structure cleaned up a little: Docs and Windows subdirectories introduced, README.TXT in the main directory. (Rel1.7 released, but again in a minute) config.sub wasn't recent enough to work on Cygwin. Found more recent copies in /package/gap4r2/cnf. Copied some of Ben C's support files into the Windows subdirectory... Glpng etc. Fixing bugs to do with configur-ating Sasami Merging in Ben C's changes to the Tcl code Put some of the info from Ben C's Readme into the Windows directory. (Rel1.7 released, but again in a minute) Added a windist target to the main Makefile and wrote a run.bat script that detects whether tkeden is in the current directory or not. Added more directories to the setrcsstate target in main Makefile.in Removed guessLibLocation as it just doesn't work in too many circumstances. We'll have to rely on wrapper scripts etc using the -l argument. Merged in changes from BenC's Sasami version 0.6 (previously I had his version 0.3, and I'd simply left out all of the actual Sasami notation, just keeping the changes necessary to get tkeden to run on Windows. It now looks like Sasami will be considered a "standard" part of tkeden (a nicer solution would be a plug-in style thing, but we don't have the time to do this), and so I've made it optionally compiled when WANT_SASAMI is defined. Sasami only works on Windoz at present). Windows version 0.4 -> 0.6 changes: --Win32-V0.4---------------------------------------------------------------- Added support for materials (which gives full control over lighting parameters and texturing) through the "material" object type. Linked in the glPNG library for loading PNG files as textures. This means that Sasami now needs the glPNG libraries compiled and installed to compile correctly. glPNG can be found in the Sasami distribution (hopefully) or at http://www.wyatt100.freeserve.co.uk/download.htm . Commented out the glBindTexture/glGenTextures calls in glpng.c to avoid needing to link it with the non-existant OpenGL 1.1 library for CygWin. (note : this hack is no longer needed - see below) Added texture-mapping support, with auto-generation of texture co-ordinates if they aren't provided, and support for using texture binding to prevent texture-thrashing. Built the "Rubik's cube" example script. Increased the default ambient lighting a bit so objects no longer appear 100% black when not facing the light source. Built a new libopengl32.a based on MSVCs one, which includes the 1.1 functions - most notably glGenTextures and glBindTexture, which are used by the texture-mapping code. This fixes the problems with OpenGL implementations which don't export these via wglGetProcAddress (such as the MS and SGI software implementations), and means that a custom build of glPNG is no longer required. Packaged up the Sasami examples in a slightly more convienient directory. First "public" release version --Win32-V0.5---------------------------------------------------------------- Rewrote the Sasami parser to cope with variable number of parameters in notations, and altered various functions to take advantage of this - mainly by allowing multiple vertices/polys/etc to be specified in one call. Added commas to the list of things the parser considers seperators, allowing for scripts to use (easier to read in some circumstances) comma seperated notation. Fixed a stupid bug where the whole parsed string was converted to lowercase, including variable names - effectively preventing Sasami from reading Eden variables whose names contained uppercase characters! Fixed a *very* nasty bug where texture loading and rendering could take place before OpenGL was initialised, resulting in an instant crash...! Implemented a parser for Lightwave format .OBJ and .MTL files, converting them to Sasami code on-the-fly (and hence into Sasami objects). Reenginnered billiards model to give a 3D display. --Win32-V0.6---------------------------------------------------------------- Added better Windows message handling - Sasami now responds correctly to window actions when Eden is blocking the main thread (eg : "while (1) eager();"). Built animation sample (animate.s) to demonstation time-delta-based animation loops. Fixed a bug that caused textures to be lost when the viewport was resized. Added support for user-definable lighting. Fixed user-definable lighting to work properly, and added sa_r_maxlights to reflect the number of OpenGL-accelerated lights available. Finished up support for alpha-transparency, and wrote glass.s sample to demonstrate it. Altered default lighting so that models are reasonably evenly lit. Altered "load_obj" command so that by default it only loads the object and material definations as Eden declarations, and added "load_full_obj" command which loads everything (the previous behaviour). Fixed a stupid glFrustrum typo that was causing the far clip plane to be ridiculously close, and objects to appear to be microscopic in size (perspective-wise)! Fixed a bug in the OBJ loader that prevented objects with co-ordinates specified with exponents from being loaded correctly. Edited animate.s sample to use todo() instead of eager() so that it doesn't block Eden from executing user input. Added visible flag to objects. ** Monday April 3 20:18:06 BST 2000 Rel1.6: onto new Dell PC, Windoz again, with merged in changes (and again a few mins later) And into $PUBLIC/bin ** Fixed silly bug in Scout/Makefile.in that caused Scout to fail to recover from parse errors. (bug15) Increased size of a buffer that was being overwritten by Patrick's code (bug16) in the SIT! model. Fixes made on the new PC for Windoz: o -X11 doesn't work on Windoz: need -lGDI32 -lUSER32 -lCOMDLG32 -lOPENGL32 -lKERNEL32 instead o Eden/main.c libgen.h not on Windoz. dirname does not exist. Commented out - will have to manually provide the location with -l. o Misc/custom.h needs the __WIN32__ declaration o EX/disp.c different fontHeight etc required on Windoz - replaced Ben's nominal values libLocation error message added if not set. winportextras files (.dlls, run.bat etc) added to the distribution. ** Thursday March 23 16:18:11 GMT 2000 Rel1.5: onto new Dell PC, Windoz ** tkeden prompt changed to show the current VA. Installed at DCS. Version number not updated. bug10 (railway accident server seg fault) fixed in my copy scout.init.e updated: Tcl bound events now all redefine symbols with a "~" prepended in an attempt to avoid problems with the current VA setting. Need to update DCS copy bug11 (timetable @ screen seg fault) fixed in my copy Added a new function, symboltext() for Chris. Need to document. Attempted to make stack resize dynamically. Fixed readline prompt problem by making readline print the prompt (previously it was done by Eden and would fail to be reprinted for example on a Ctrl-U). ** Fri Jan 14 15:27:40 GMT 2000 Rel1.4: into $PUBLIC ** o A copyright notice in the about dialogue o Get rid of HOSTNAME env variable o Change use of CHAR to something else to prevent clashes with Windoz header files (says Ben) o `@` now gives @, not an "expecting string" error. o Get ttyeden to use GNU readline to enable decent editing. o Merged in Ben's changes, as follows: You need to set up the PUBLIC variable with something like "export PUBLIC=/programs/eden". Also, set TCL_LIBRARY=/cygwin/cygwin-b20/share/tcl8.0. --Win32-V0.1---------------------------------------------------------------- Modified : configure makefile.in eden\builtin.c eden\eden.h ex\disp.c ex\disp.h misc\customlib.h donald\tree.h Initial Win32 port. Not much works! --Win32-V0.2----------------------------------------------------------------- Modified : tkeden\configure tkeden\ex\disp.c tkeden\ex\ex.c tkeden\version.h lib\tkeden\edenio.tcl tkeden\ex\win32ex.c tkeden\ex\win32ex.h tkeden\ex\makefile.in Implemented "hacked" versions of FontWidth & FontHeight. Altered configure script to link in Windows GDI functions. Implemented native DisplayDepth() function. Implemented slightly dodgy version of StringWidth. RoomViewer now works (FontWidth/FontHeight problems), albeit with misaligned text. Added Win32 version numbering to version.h. Added Win32 version number message to Help->About window. Removed the focus-follows-mouse flag when running on Windows, as this is not normal Windows behaviour and will only confuse/annoy users! Added win32ex files to EX to hold Windows GUI functions. Rewrote the File->Include code to use a standard Windows dialog. Rewrote the File->Save code to use a standard Windows dialog. --Win32-V0.3----------------------------------------------------------------- Modified : tkeden\version.h tkeden\ex\parser.c tkeden\eden\notation.h tkeden\ex\lex.c tkeden\ex\script.c tkeden\sasami\* tkeden\makefile.in tkeden\configure tkeden\* , pretty much! :-( Added hooks to allow Sasami code to be entered and parsed. Created modified lexer/parser based on Donald code. Dumped Donald lexer/parser as it's way too complex. Wrote parser for Sasami code. Added Sasami OpenGL rendering code. Added Sasami functions to builtin.c for reading back changes to data. Sasami vertex rendering now works. Fixed up some structural bugs and implemented polygon rendering. Added auto-normal generation so OpenGL lighting works. Fixed crash-on-shutdown bug due to not destroying WGL context correctly. Fixed support for comments in Sasami Added object handling code, and modelview matrix logic for objects Moved variables like background colour to be "true" Eden variables rather than function calls. Fixed lazy-creation of certain objects causing crashes if the object was used before any parameters set. Added "`" notation for passing code to Eden. Added the ability to change viewport resolution from Eden, and to toggle the axes indicators. Created a simple morphing object demo. ** Mon Nov 8 21:54:31 GMT 1999 Rel1.3: to take home with me! ** o Investigated with tcl/tk 8.2.0 (was previously using tcl/tk 8.0). Fixed environment variable handling. Now OK. o Makefile should mark lib files with version number o configure: don't stop compilation if we don't have tcl/tk o Error message "unexpected end-of-file in chararcter constant" !! ** Wed Nov 3 16:16:12 GMT 1999 Rel1.2: bug fixes to 1.1. Ooops - didn't mean to increment the version no. ** o Bug fix: myttyeden, s=0;s=1l; - seg fault. Not in ttyeden Investigated, and found only in wierd set of circumstances - ignore. o Error message "type clash: expectingint" !! o Error message "no such variable ash ...called by" o Error message "func/proc needed ...while executing" o bug7 at ITS Same as above - found it happened lots at ITS. Worked around. ** Wed Nov 3 13:51:59 GMT 1999 Rel1.1: installed at ITS under ~cssbz for CS233 experiments with Eddi ** o $PUBLIC. Could eliminate by using dirname(argv[0]) or similar. However, Eden support code uses it. Could rewrite Eden support code, but other Eden code might assume it. Perhaps could detect with this procedure, then set the variable once the tkeden process has started. However - this looses us flexibility - cannot set PUBLIC to somewhere else deliberately. Perhaps could allow an override with a command line option. Would this solve more problems than it causes (esp wrt the Windoz port?). Perhaps change to EM_PUBLIC whilst about it. Or set EM_PUBLIC in a wrapper around tkeden etc... then users don't need to keep modifying their setup. Or maybe EM_LIB would be more appropriate. Wrapper script should set the variable if it is not already set to allow overriding. Or perhaps lib files should be in a subdirectory of dirname, including the tkeden version number to allow installation of multiple versions. o Provide a way to override the library files detection result o Rewrote emalloc etc as macros and other stuff to enable dmalloc to give sensible reports o Fix the Scout memory leak that Simon found: bug5 o Redid COPYING file. Couldn't reproduce: o Fix the Tcl bug that Simon found: OXO demo "Tcl errors occur when you shut the model down with the clock (animation) still running." o Copy and paste problems on UNIX. A Tcl problem. Don't move the mouse whilst you click the middle button. ** (about) Fri Oct 8 20:13:02 1999 Rel1.0: to Ben Carter for OpenGL expts ** o These changes made by Ashley Ward. o Throw away Imake stuff, start again with autoconf. o Merge in Patrick's dtkeden changes o Put unused code in Attic. Also their RCS files o Fix ttyeden on Linux (rethink linking to curses?) o Remove -R and -ldl from linking on Linux. Also need -I/usr/include/ncurses. Also need -lncurses, not -lcurses o Move Attic directories into one directory, possibly out of the source distribution o Fix curses stuff - try with ncurses_g? o Check through error messages etc output from tkeden - fix for good English :) o Check for PUBLIC being set - if unset, crashes with seg fault on ARML. o Check what happens when DISPLAY is not set or xhost problem - falls over nicely? o "...near line " could do with some more description of the line. o Compile with optimisation (gcc -O2, cc -xO2 + change the number) o Move Imakefiles into Attic o Remove unnecessary gunk from start of Makefile.ins - install eg o Can ttyeden do donald and scout? If not, remove the code from the link... o Remove UNIX command dependencies: 'ls' in file handling o dtkeden has a new TEXTBOX functionality - document! o Need a dynamic buf in type.c, t_str to prevent overflow and Seg fault when converting long lists to strings. o Do we have a Y2K problem, with the results from gettime(), time(), ftime()? o Eden gettime() uses C-lib time() and C-lib localtime(), the year result of which is years since 1900. So applications, currently receiving the number 99, will receive the number 100 next year. So OK. o Eden time() is basically a call to C-lib time(), so OK. o Eden ftime() is basically a call to C-lib gettimeofday(), so OK. o A -v option to show the current version (of tk and tty eden) o Help -> About Tkeden to show version number. Perhaps also print it on stdout when started up. (no!). Perhaps also show $tcl_version. o Remove RCS Log header o Make sure all the code has a static RCS Id header so we can use strings on the executable. o Move lib/bison into the source directory. Remove the sym links. o Fixed the Segmentation fault found when running the dtkeden railway demo o Tcl error messages seem to be swallowed and replaced with less helpful ones. See especially the definition of tcl() - whereever that is... o Rewrote curses linkage to remove SunOS dependencies o Added a new hook: _tkeden_showxoutput = 1; shows xoutput tcl output And now some ancient history... ** September 3 1999 ** o tkeden.S and tkeden.C merged into one dtkeden version with a command argument -s(superagent)|-a(agent). o -h command argument added ** December 15 1997 ** o Unknown changes ** December 9 1997 ** o tkeden.S and tkeden.C (server and client) variants created by Patrick Sun, later to be called dtkeden, created from the tkeden source. o -c command argument added. o This version must be run on gem (as gem is hard-coded as the host). ** September 26 1997 ** o Two versions of tkeden compiled for DCS, possibly by Richard Cartwright, it looks like one for 'sun5' (tkeden-sep2619972) and one other (tkeden-sep261997). ** October 28 1996 ** o A version of tkeden compiled for DCS (by Simon Yung?). ** June 20 1996 ** o A version of ttyeden compiled for DCS (by Simon Yung?) on SunOS? ** February 27 1996 ** o Last RCS check-in made by Simon Yung? ** July 7 1995 ** o First RCS check-in made by Simon Yung? up the PUBLIC variable with something like "export PUBLIC=/programs/eden". Also, set TCL_LIBRARY=/cygwin/cygwin-b20/share/tcl8.0. --Win32-V0.1---------------------------------------------------------------- Modified : configure makefile.in eden\builtin.c edetkeden1.46/lib-tkeden/client.tcl010064400025250000147000000152100733204162400200430ustar00ashleydcsother00003520000005# # $Id: client.tcl,v 1.6 2001/08/01 17:59:47 cssbz Exp $ # # Just the client specific bits of tcl. This is sourced when appropriate # from edenio.tcl [Ash] # Client-Server & Socket # display the message of client connection on client window # read script line-by-line sent by the server from socket and # evoke eden evaluation proc read_sock {sock} { global receiveScripts EOF esvrSock global EOS ECS serverReply variantversion set lineScript [gets $sock] set lineScript [string trimright $lineScript] if {[eof $sock]} { close $sock set esvrSock "" tk_dialog .message "$variantversion: Network Message" \ "The dtkeden server has been shut down and the connection has been closed." \ warning 0 OK # puts "Connection is closed..." } else { if {$lineScript == $ECS} { incr serverReply return } if {$lineScript == $EOF || $lineScript == $EOS} { appendHist $receiveScripts # set receiveScripts "ScoutWinTrigged = 0;\n$receiveScripts\n" set receiveScripts "$receiveScripts\n" evaluate $receiveScripts if {$lineScript == $EOS} { #puts $esvrSock $EOS sendServer $EOS } set receiveScripts "" } else { set receiveScripts "$receiveScripts\n$lineScript" } } } proc sendUsrName {} { global usrName EOU getUsrName variantversion _tkeden_version set getUsrName 1 sendServer1 "$EOU" set variantversion "dtkeden $_tkeden_version (client:$usrName)" wm title . "$variantversion: Input" } proc loginUsrName {} { global esport eshost variantversion toplevel .login wm title .login "$variantversion: Login" label .login.mess -text "You have connected to the dtkeden server \n\ with channel <[expr $esport-9000]>\ on host <$eshost>.\n\ Please login with your agent name" entry .login.usrName -relief sunken -textvariable usrName pack .login.mess .login.usrName -side top -padx 1m -pady 2m button .login.ok -text "OK" -command { if {[string trim $usrName] != ""} { sendUsrName; destroy .login } else { bell } } # button .login.cancel -text "Cancel" -command { notLogin; destroy .login } button .login.clear -text "Clear" -command { set usrName ""; focus .login.usrName } pack .login.ok .login.clear -side left -expand 1 bind .login.usrName { sendUsrName; destroy .login } focus .login.usrName grab .login } proc setupSocket {} { global usrName getUsrName global esvrSock eshost esport variantversion puts "$variantversion: connecting to dtkeden server channel <[expr $esport-9000]> on host <$eshost>..." # this is a synchronous connection: # The command does not return until the server responds to the # connection request set errCode [catch {set esvrSock [socket $eshost $esport]} string] # puts $errCode # Setup monitoring on the socket so that when there is data to be # read the proc "read_sock" is called if {$errCode == 0 } { # puts "You are connected to tkServer in 'gem'...\n" fileevent $esvrSock readable [list read_sock $esvrSock] # configure channel modes # ensure the socket is line buffered so we can get a line of text # at a time (Cos thats what the server expects)... # Depending on your needs you may also want this unbuffered so # you don't block in reading a chunk larger than has been fed # into the socket # i.e fconfigure $esvrSock -blocking off fconfigure $esvrSock -buffering line -translation {crlf crlf} # set up our keyboard read event handler: # Vector stdin data to the socket #fileevent stdin readable [list read_stdin $esvrSock] # message indicating connection accepted and we're ready to go # wait for and handle either socket or stdin events... #vwait eventLoop if {$usrName == "" } { loginUsrName } else { sendUsrName } vwait getUsrName } else { puts "Fail to connect dtkeden server channel <[expr $esport-9000]> on host <$eshost>." puts "Using dtkeden as a stand-alone environment" .radios.send config -state disabled bell } } # read scripts from tkeden input window and send them to server set sendServerDebug 0 proc sendServer { text } { global EOF ECS synchronize serverReply sendServerDebug # don't change synchronize which comes from ../Eden/main.client.c if ($sendServerDebug) { puts "sendServerDebug: sendServer1" } if {$synchronize > 0} { while {$serverReply < 0} { vwait serverReply } } if ($sendServerDebug) { puts "sendServerDebug: sendServer2" } if {$synchronize > 0} { set text "$text\n$ECS" } else { set text "$text\n$EOF" } if ($sendServerDebug) { puts "sendServerDebug: sendServer3" } sendServer1 $text } proc sendServer1 {text} { global esvrSock usrName EOF currentNotation global synchronize serverReply sendServerDebug if ($sendServerDebug) { puts "sendServerDebug: sendServer4" } set isCancel -1 set text "$text$usrName" if {$esvrSock == "" } { set isCancel [connectServer] } if {$isCancel == "0"} return if {$esvrSock != ""} { # set errCode [catch {.menu.accept invoke} string] ; # may need to handle error control??? # puts "text $text" set errCode -1 while {$errCode !=0} { getCurrentNotation # cannot change currentNotation below. It comes from EX/Exinit() set errCode [catch {puts $esvrSock "$currentNotation\n$text"} string] if {$errCode != 0} { set isCancel [connectServer] if {$isCancel == "0"} break } } if {$synchronize > 0} { incr serverReply -1 while {$serverReply < 0} { vwait serverReply } } } } proc connectServer {} { global esvrSock variantversion set selectButton -1 while { $selectButton != 0 } { set selectButton [tk_dialog .message "$variantversion: Connection Failed" \ "Cannot connect to server" warning 0 Cancel Retry ] if {$selectButton == "1"} { set esvrSock "" setupSocket if {$esvrSock != ""} break } } return $selectButton } set EOF "@#$%EOF%$#@" set EOU "@#$%EOU%$#@" set EOS "@#$%EOS%$#@" set ECS "@#$%ECS%$#@" set serverReply 0 set receiveScripts "" set usrName "" set getUsrName 0 #set eshost "gem" #set esport 7000 #puts "eshost $eshost esport $esport" set esvrSock "" setupSocket tkeden1.46/lib-tkeden/credits.txt010064400025250000147000000070070751675466200203050ustar00ashleydcsother00003520000005Eden: the Evaluator of DEfinitive Notations Copyright (c) 1995-2001 The University of TV. All rights reserved. Authors: Edward Yun Wai Yung (Eden) Simon Yun Pui Yung (tkeden) Pi-Hwa (Patrick) Sun (dtkeden) Richard Cartwright (initial work on PC port, bug fixes etc) Amanda Wright (initial work on PC port) Ben Carter (Sasami on PC, finishing PC port) Chris Brown (Observation-oriented parser) Ashley Ward (rationalisation, new auto-configure system, Sasami on UNIX, bug fixes, CVS, interface improvements, Mac OS X port, teeth gnashing...) Chris Roe (Eden spreadsheet functions) Certain variants of Eden use some of these libraries: Tcl/Tk, originally by John Ousterhout http://tcl.activestate.com cygwin by Steve Chamberlain and many others http://www.cygwin.com readline, maintained by Chet Ramey http://cnswww.cns.cwru.edu/~chet/readline/rltop.html Togl by Brian Paul and Ben Bederson http://togl.sourceforge.net/ GLpng by Ben Wyatt http://www.wyatt100.freeserve.co.uk/download.htm libpng by Greg Roelofs http://www.libpng.org/pub/png libz by Jean-loup Gailly and Mark Adler http://www.zlib.org/ ncurses by Zeyd Ben-Halim, Eric S. Raymond and others http://www.clark.net/pub/dickey/ncurses/ncurses.html Tk Img package by Jan Nijtmans http://members1.chello.nl/~j.nijtmans/img.html PCRE (Perl Compatible Regular Expressions) by Philip Hazel http://www.pcre.org/ ("Regular expression support is provided by the PCRE library package, which is open source software, written by Philip Hazel, and copyright by the University of Cambridge, England.") This software is provided "as is", and no warranty, express or implied, is given. Neither the author nor the University of TV takes any responsibility whatsoever for any use or misuse of this software, or any damage created by its use or misuse. This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. Permission to use, copy, modify, and distribute this software and documentation for non-commercial purposes and without fee is hereby granted, provided that the University of TV copyright notices and this permission notice appear in all copies. Neither the author nor The University of TV makes any representations about the suitability of this software and documentation for any purpose. It is provided ``as is'' without express or implied warranty. Commercial use of this software requires specific permission from the University of TV; contact the Empirical Modelling project through the web pages at http://www.dcs.warwick.ac.uk/modelling/ or by snail mail at The Empirical Modelling Project, Department of Computer Science, University of TV, Coventry, CV4 7AL, UK for further information. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA tkeden1.46/lib-tkeden/donald.eden010064400025250000147000001034050751310531000201550ustar00ashleydcsother00003520000005/* * $Id: donald.eden,v 1.3 2002/07/10 19:28:08 cssbz Exp $ */ /* --- SPECIFICATION FOR OPERATORS AND INITIALIZE GRAPHICS --- */ setbuf(stdout, 0); OFF = 0; ON = 1; FALSE = 0; TRUE = 1; NullStr = ""; NullList = []; /* PI = 3.141593; */ /* TYPE = 1; X = 2; Y = 3; P1 = 2; P2 = 3; P3 = 4; CENTRE = 2; RADIUS = 3; TEXT = 2; */ INF = '!'; /* [ INF ] */ /* INT = 'I'; /* [ INT, I ] */ */ REAL = 'R'; /* [ REAL, ??? ] */ CHAR = 'W'; /* [ CHAR, ??? ] */ BOOLEAN = 'B'; /* [ BOOLEAN, B ] */ CART = 'C'; /* [ CART, X, Y ] */ POLAR = 'P'; /* [ POLAR, R, A ] */ LINE = 'L'; /* [ LINE, P1, P2 ] */ ARC = 'U'; /* [ ARC, P1, P2, R ] */ CIRCLE = 'E'; /* [ CIRCLE, P, R] */ RECTANGLE = 'G'; /* [ RECTANGLE, P1, P2] */ ELLIPSE = 'Q'; /* [ ELLIPSE, P, P, P ] */ LABEL = 'T'; /* [ LABEL, W, P ] */ SHAPE = 'S'; /* [ SHAPE, ??? ] */ OPENSHAPE = 'O'; /* [ OPENSHAPE, ... ] */ IMAGE = 'I'; /* [ IMAGE, W, P ] */ /* MONITOR = 'M'; /* [ MONITOR, B, ...] */ IMPOSE = 'I'; /* [ IMPOSE, I ] */ */ if (tcl("set tk_version") < "8.3") { dashedopt = ""; dottedopt = ""; } else { dashedopt = " -dash {_}"; dottedopt = " -dash {.}"; } /* check for ill-defined value argument: list return: @ if the list is @ 1 if all terms are well-defined 0 if partly undefined */ func idv { para d; auto i; if (d == @) return 1; if (type(d) != "list") return 0; for (i = d#; i > 0; --i) { if (idv(d[i])) return 1; } return 0; } /* real to string conversion using sprintf(), see sprintf(3) for format spec */ func rtos { para r, format; auto s; s = substr("", 1, 255); /* create a 255-char long string */ sprintf(s, "%"//format, r); if (s# > 255) { error("rtos: goofed up with memory allocation"); } return s; } func DD_random { if (type($1) == "int") { return rand() % $1; } else { return rand() * $1 / 2147483647; } } /* POINT */ func cart { return [CART, $1, $2]; /* [ CART, X, Y ] */ } /* POINT */ func polar { return [POLAR, $1, $2]; /* [ POLAR, R, A ] */ } /* LINE */ func line { return [LINE, $1, $2]; /* [ LINE, P1, P2 ] */ } /* ARC */ func arc { return [ARC, $1, $2, $3]; /* [ LINE, P1, P2, ANGLE ] */ } /* CIRCLE */ func circle { return [CIRCLE, $1, $2]; /* [ CIRCLE, P, R] */ } /* RECTANGLE */ func rectangle { return [RECTANGLE, $1, $2]; /* [ RECTANGLE, P1, P2] */ } /* ELLIPSE */ func ellipse { return [ELLIPSE, $1, $2, $3]; /* [ ELLIPSE, P, P, P] */ } /* LABEL */ func image /* CHAR $1; POINT $2; */ { return [IMAGE, $1, $2]; /* [ IMAGE, T, P] */ } /* LABEL */ func label /* CHAR $1; POINT $2; */ { return [LABEL, $1, $2]; /* [ LABEL, T, P] */ } /* /* MONITOR */ func monitor { return [MONITOR, $2, $1, $3]; /* [ MONITOR, mesg1, bool, mesg2 ] */ } */ /* SHAPE */ /* Takes a list of pointers (an OPENSHAPE) and dereferences each item recursively. Thus translating ["O", &t, &v] into ["S", t, v] [Ash] */ func open2shape { para openShape; auto shape, entity, i; if (openShape == @) return @; if (openShape[1] != 'O') error("open2shape given " // openShape[1] // " type and not an openshape"); shape = [SHAPE]; for (i = 2; i <= openShape#; i++) { entity = *(openShape[i]); if (type(entity) == "list") if (entity[1] == 'O') shape = shape // [open2shape(entity)]; else shape = shape // [entity]; } return shape; } /* POINT */ func intersect { para line1, line2; auto a1, a2, b1, b2, c1, c2, s, t; if (idv(line1) || idv(line2)) return @; a1 = line1[3][3] - line1[2][3]; /* implicit eqn */ b1 = line1[2][2] - line1[3][2]; /* of line line1 */ c1 = line1[2][3] * line1[3][2] - line1[3][3] * line1[2][2]; a2 = line2[3][3] - line2[2][3]; /* implicit eqn */ b2 = line2[2][2] - line2[3][2]; /* of line line2 */ c2 = line2[2][3] * line2[3][2] - line2[3][3] * line2[2][2]; if (a1 * b2 == a2 * b1) writeln("intersect(): Can't happen on parallel lines"); else { /* find intersection of lines */ s = (b1 * c2 - b2 * c1) / (a1 * b2 - a2 * b1); t = (c1 * a2 - c2 * a1) / (a1 * b2 - a2 * b1); return [CART, s, t]; } } /* LINE */ func parallel { para line, point, alpha, beta; auto a1, a2, b1, b2, m; if (idv(line) || idv(point) || alpha == @ || beta == @) return @; alpha = float(alpha); /* make sure it is real number */ beta = float(beta); /* vert and horiz lines have no gradient */ /* parallel lines have the same gradient */ m = (line[2][2] == line[3][2] || line[2][3] == line[3][3]) ? 0.0 : float(line[3][3] - line[2][3] / line[3][2] - line[2][2]); if (line[2][2] == line[3][2]) { /* line is vertical */ b1 = point[3] - alpha; b2 = point[3] + beta; if (m == 0) a1 = a2 = float(point[2]); else { a1 = (b1 - point[3]) / m + point[2]; a2 = (b2 - point[3]) / m + point[2]; } } else { /* line is horizontal or other */ a1 = point[2] - alpha; b1 = (a1 - point[2]) * m + point[3]; a2 = point[2] + beta; b2 = (a2 - point[2]) * m + point[3]; } return [LINE, [CART, a1, b1], [CART, a2, b2]]; } /* LINE */ func perpend { para point, line; auto a1, a2, b1, b2, c1, c2, x, y; if (idv(point) || idv(line)) return @; /* implicit eqn of point $1 */ a1 = float(line[2][2] - line[3][2]); b1 = float(line[2][3] - line[3][3]); c1 = -a1 * point[2] - b1 * point[3]; /* implicit eqn of line $2 */ a2 = float(line[3][3] - line[2][3]); b2 = float(line[2][2] - line[3][2]); c2 = float(line[2][3] * line[3][2] - line[3][3] * line[2][2]); /* find perpendicular */ x = (b1 * c2 - b2 * c1) / (a1 * b2 - a2 * b1); y = (c1 * a2 - c2 * a1) / (a1 * b2 - a2 * b1); return [LINE, point, [CART, x, y]]; } /* REAL */ func dist /* POINT(LINE) $1; POINT(LINE) $2 */ { para arg1, arg2; auto a, b, c; if (idv(arg1) || idv(arg2)) return @; switch (arg1[1]) { case 'C': case 'P': if (arg1[1] == POLAR) arg1 = polar_to_cart(arg1); if (arg2[1] == POLAR) arg2 = polar_to_cart(arg2); a = (arg1[2] - arg2[2]) * (arg1[2] - arg2[2]); b = (arg1[3] - arg2[3]) * (arg1[3] - arg2[3]); return sqrt(float(a + b)); case 'L': if (arg1[2][1] == POLAR) arg1[2] = polar_to_cart(arg1[2]); if (arg1[3][1] == POLAR) arg1[3] = polar_to_cart(arg1[3]); if (arg2[2][1] == POLAR) arg2[2] = polar_to_cart(arg2[2]); if (arg2[3][1] == POLAR) arg2[3] = polar_to_cart(arg2[3]); a = arg1[3][3] - arg1[2][3]; b = arg1[3][2] - arg1[2][2]; c = arg1[2][3] * arg2[2][2] - arg1[3][3] * arg1[2][2]; return sqrt(float(a * arg2[2] + b * arg2[3] + c)) * (a * arg2[2] + b * arg2[3] + c) / (a * a + b * b); } } /* POINT */ func midpoint { para line; auto s, t; if (idv(line)) return @; if (line[2][1] == POLAR) line[2] = polar_to_cart(line[2]); if (line[3][1] == POLAR) line[3] = polar_to_cart(line[3]); s = (line[2][2] + line[3][2]) / 2.0; t = (line[2][3] + line[3][3]) / 2.0; return [CART, s, t]; } /* ENTITY */ func trans { para entity, x, y; auto point, i; if (idv(entity) || x == @ || y == @) return @; point = [CART, x, y]; switch (entity[1]) { case 'C': case 'P': return vector_add(entity, point); case 'R': writeln("trans(): Can't happen on ", entity[1]); break; case 'L': return [LINE, vector_add(entity[2], point), vector_add(entity[3], point)]; case 'U': return [ARC, vector_add(entity[2], point), vector_add(entity[3], point), entity[4]]; case 'E': return [CIRCLE, vector_add(entity[2], point), entity[3]]; case 'G': return [RECTANGLE, vector_add(entity[2], point), vector_add(entity[3], point)]; case 'Q' : return[ELLIPSE, vector_add(entity[2],point), vector_add(entity[3],point), vector_add(entity[4],point)]; case 'L': /* 3D line ? */ return [LINE, vector_add(entity[2], point), vector_add(entity[3], point), vector_add(entity[4], point)]; case 'O': entity = open2shape(entity); case 'S': for (i = 2; i <= entity#; i++) entity[i] = trans(entity[i], x, y); return entity; case 'T': return [LABEL, entity[2], vector_add(entity[3], point)]; case 'I': return [IMAGE, entity[2], vector_add(entity[3], point)]; } } /* ENTITY */ func rot { para entity, point, angle; auto i, s, t, dx, dy, center; auto s1, t1, s2, t2; if (idv(entity) || idv(point) || angle == @) return @; angle = float(angle); switch (entity[1]) { case 'C': case 'P': if (entity[1] == POLAR) entity = polar_to_cart(entity); if (point[1] == POLAR) point = polar_to_cart(point); dx = entity[2] - point[2]; dy = entity[3] - point[3]; s = dx * cos(angle) - dy * sin(angle) + point[2]; t = dx * sin(angle) + dy * cos(angle) + point[3]; return [CART, s, t]; case 'R': writeln("rot(): Can't happen on ", entity[1]); return entity; case 'L': return [LINE, rot(entity[2], point, angle), rot(entity[3], point, angle)]; case 'U': return [ARC, rot(entity[2], point, angle), rot(entity[3], point, angle), entity[4]]; case 'E': return [CIRCLE, rot(entity[2], point, angle), entity[3]]; case 'G': return [RECTANGLE, rot(entity[2], point, angle), rot(entity[3], point, angle)]; case 'Q': return [ELLIPSE, rot(entity[2], point, angle), rot(entity[3], point, angle), rot(entity[4], point, angle)]; case 'O': entity = open2shape(entity); case 'S': for (i = 2; i <= entity#; i++) entity[i] = rot(entity[i], point, angle); return entity; case 'T': return [LABEL, entity[2], rot(entity[3], point, angle)]; case 'I': return [IMAGE, entity[2], rot(entity[3], point, angle)]; } } /* ENTITY */ func scale { para entity, factor; auto i, dx, dy, s1, s2, t1, t2, r, center; if (idv(entity) || factor == @) return @; switch (entity[1]) { case 'P': entity = polar_to_cart(entity); case 'C': return [CART, entity[2] * factor, entity[3] * factor]; case 'L' : return [LINE, scale(entity[2], factor), scale(entity[3], factor)]; case 'E' : r = entity[3] * factor; /* scale radius */ center = scale(entity[2], factor); return [CIRCLE, center, r]; case 'G' : return [RECTANGLE, scale(entity[2], factor), scale(entity[3], factor)]; /* ARC ('U') case by Chris Roe, who mentioned that this might be a fudge as it doesn't scale the arc's "bend" */ case 'U' : return [ARC, scale(entity[2], factor), scale(entity[3], factor), entity[4]]; case 'Q' : return [ELLIPSE, scale(entity[2], factor), scale(entity[3], factor), scale(entity[4], factor)]; case 'O': entity = open2shape(entity); case 'S': for (i = 2; i <= entity# ; i++) entity[i] = scale(entity[i], factor); return entity; case 'T': return [LABEL, entity[2], scale(entity[3], factor)]; case 'I': return [IMAGE, entity[2], scale(entity[3], factor)]; } } /* The reflect Eden function below is by Chris Roe. The implement-it-as-a-builtin stuff is Ash's fault. */ func reflect { para entity, line; auto i, s, t, l, px, py, center; auto s1, t1, s2, t2; if (idv(entity) || idv(line) == @) return @; switch (entity[1]) { case 'C': case 'P': if (entity[1] == POLAR) entity = polar_to_cart(entity); l = perpend([CART,entity[2],entity[3]],line); px = l[3][2]; /* intersection point of the normal and the mirror */ py = l[3][3]; /* is the point at which reflection takes place */ s = entity[2] + (2*(px-entity[2])); t = entity[3] + (2*(py-entity[3])); return [CART, s, t]; case 'R': writeln("reflect(): Can't happen on ", entity[1]); return entity; case 'L': return [LINE, reflect(entity[2], line), reflect(entity[3], line)]; case 'U': return [ARC, reflect(entity[2], line), reflect(entity[3], line), entity[4]]; case 'E': return [CIRCLE, reflect(entity[2], line), entity[3]]; case 'G': return [RECTANGLE, reflect(entity[2], line), reflect(entity[3], line)]; case 'Q': return [ELLIPSE, reflect(entity[2], line), reflect(entity[3], line), reflect(entity[4], line)]; case 'O': entity = open2shape(entity); case 'S': for (i = 2; i <= entity#; i++) entity[i] = reflect(entity[i], line); return entity; case 'T': return [LABEL, entity[2], reflect(entity[3], line)]; case 'I': return [IMAGE, entity[2], reflect(entity[3], line)]; } } /* LINE */ func line_reverse { if ($1 == @) return @; return [LINE, $1[3], $1[2]]; } /* POINT */ func dotx { para point; if (point == @) return @; point = polar_to_cart(point); return [CART, point[2], 0.0]; } /* POINT */ func doty { para point; if (point == @) return @; point = polar_to_cart(point); return [CART, 0.0, point[3]]; } func dot1 { if ($1 == @) return @; return $1[2]; } func dot2 { if ($1 == @) return @; return $1[3]; } func dotrad { if ($1 == @) return @; return cart_to_polar($1)[2]; } func dotarg { if ($1 == @) return @; return cart_to_polar($1)[3]; } func vector_add { para point1, point2; if (idv(point1) || idv(point2)) return @; if (point1[1] == POLAR) point1 = polar_to_cart(point1); if (point2[1] == POLAR) point2 = polar_to_cart(point2); return [CART, point1[2] + point2[2], point1[3] + point2[3]]; } func vector_sub { para point1, point2; if (idv(point1) || idv(point2)) return @; if (point1[1] == POLAR) point1 = polar_to_cart(point1); if (point2[1] == POLAR) point2 = polar_to_cart(point2); return [CART, point1[2] - point2[2], point1[3] - point2[3]]; } func scalar_mult { para point, value; if (idv(point) || idv(value)) return @; if (point[1] == POLAR) return [POLAR, float(point[3]) * value, point[2]]; else return [CART, float(point[2]) * value, float(point[3] * value)]; } func scalar_div { para point, value; if (idv(point) || idv(value)) return @; if (point[1] == POLAR) return [POLAR, float(point[3]) / value, point[2]]; else return [CART, float(point[2]) / value, float(point[3] / value)]; } func scalar_mod { para point, value; if (idv(point) || idv(value)) return @; if (point[1] == POLAR) return [POLAR, int(point[3]) % int(value), point[2]]; else return [CART, int(point[2]) % int(value), int(point[3]) % int(value)]; } /* ----- BOOLEAN CONDITIONS ----- */ /* BOOLEAN */ func pt_betwn_pts { para point1, point2, point3; if (idv(point1) || idv(point2) || idv(point3)) return @; if (point1[1] == POLAR) point1 = polar_to_cart(point1); if (point2[1] == POLAR) point2 = polar_to_cart(point2); return ( (point1[2] <= point2[2] && point2[2] <= point3[2]) || (point1[2] >= point2[2] && point2[2] >= point3[2]) ) && ( (point1[3] <= point2[3] && point2[3] <= point3[3]) || (point1[3] >= point2[3] && point2[3] >= point3[3]) ) ; } /* BOOLEAN */ func colinear { para point1, point2, point3; auto dab, dbc, dac; if (idv(point1) || idv(point2) || idv(point3)) return @; dab = dist(point1, point2); dbc = dist(point2, point3); dac = dist(point1, point3); return dab == dbc + dac || dac == dab + dbc || dbc == dab + dac; } /* BOOLEAN */ func intersects { para line1, line2; auto a1, a2, b1, b2, c1, c2, s, t; if (idv(line1) || idv(line2)) return @; a1 = float(line1[3][3] - line1[2][3]); /* implicit eqn */ b1 = float(line1[2][2] - line1[3][2]); /* of line1 */ c1 = float(line1[2][3] * line1[3][2] - line1[3][3] * line1[2][2]); a2 = float(line2[3][3] - line2[2][3]); /* implicit eqn */ b2 = float(line2[2][2] - line2[3][2]); /* of line2 */ c2 = float(line2[2][3] * line2[3][2] - line2[3][3] * line2[2][2]); if (a1 * b2 == a2 * b1) { writeln("intersect(): Can't happen on parallel lines"); return FALSE; } else { /* find point of intersection */ s = (b1 * c2 - b2 * c1) / (a1 * b2 - a2 * b1); /* x co-ord */ t = (c1 * a2 - c2 * a1) / (a1 * b2 - a2 * b1); /* y co-ord */ if (pt_betwn_pts(line1[2], [CART, s, t], line1[3]) && pt_betwn_pts(line2[2], [CART, s, t], line2[3])) return TRUE; /* intersection of */ else return FALSE; /* actual line only */ } } /* BOOLEAN */ func separates { para line, point1, point2; auto a1, a2, a3, b1, b2, b3, c1, c2, c3, s2, s3; if (idv(line) || idv(point1) || idv(point2)) return @; a1 = float(line[3][3] - line[2][3]); /* implicit eqn */ b1 = float(line[2][2] - line[3][2]); /* line $1 */ c1 = float(line[2][3] * line[3][2] - line[3][3] * line[2][2]); /* perpendicular line from point2 to line */ a2 = float(line[2][2] - line[3][2]); b2 = float(line[2][3] - line[3][3]); c2 = -a2 * point1[2] - b2 * point1[3]; a3 = a2; /* perpendicular line */ b3 = b2; /* from point2 to line */ c3 = -a3 * point2[2] - b3 * point2[3]; s2 = (b1 * c2 - b2 * c1) / (a1 * b2 - a2 * b1); s3 = (b1 * c3 - b3 * c1) / (a1 * b3 - a3 * b1); if (point1[2] > s2 && point2[2] > s3) return FALSE; /* Points on +side of line */ if (point1[2] < s2 && point2[2] < s3) return FALSE; /* Points on -side of line */ else return TRUE; /* Line separates points */ } /* BOOLEAN */ func includes { para Circle, point; auto s, t; if (idv(Circle) || idv(point)) return @; s = (Circle[2][2] - point[2]) * (Circle[2][2] - point[2]); t = (Circle[2][3] - point[3]) * (Circle[2][3] - point[3]); return (sqrt(float (s + t)) <= Circle[3]); } /* BOOLEAN */ func incident { para entity, point; auto s, t; if (idv(entity) || idv(point)) return @; switch (entity[1]) { case 'L': /* LINE */ return (colinear(entity[2], point, entity[3])); /* substitute x- and y- coordinate into circle */ case 'E': /* CIRCLE */ s = (entity[2][2] - point[2]) * (entity[2][2] - point[2]); t = (entity[2][3] - point[3]) * (entity[2][3] - point[3]); return (sqrt(float(s + t)) == entity[3]); } } /* BOOLEAN */ func distlarger { para entity, point, value; auto a, b, c, d; if (idv(entity) || idv(point) || idv(value)) return @; switch (entity[1]) { case 'C': case 'P': if (entity[1] == POLAR) entity = polar_to_cart(entity); if (point[1] == POLAR) point = polar_to_cart(point); a = (entity[2] - point[2]) * (entity[2] - point[2]); b = (entity[3] - point[3]) * (entity[3] - point[3]); d = sqrt(float(a + b)); return d > value; case 'L': if (entity[2][1] == POLAR) entity[2] = polar_to_cart(entity[2]); if (entity[3][1] == POLAR) entity[3] = polar_to_cart(entity[3]); if (point[1] == POLAR) point = polar_to_cart(point); a = entity[3][3] - entity[2][3]; b = entity[3][2] - entity[2][2]; c = entity[2][3] * entity[2][2] - entity[3][3] * entity[2][2]; d = sqrt(float(a * point[2] + b * point[3] + c)) * (a * point[2] + b * point[3] + c) / (a * a + b * b); return d > value; } } /* BOOLEAN */ func distsmaller { para entity, point, value; auto a, b, c, d; if (idv(entity) || idv(point) || idv(value)) return @; switch (entity[1]) { case 'C': case 'P': if (entity[1] == POLAR) entity = polar_to_cart(entity); if (point[1] == POLAR) point = polar_to_cart(point); a = (entity[2] - point[2]) * (entity[2] - point[2]); b = (entity[3] - point[3]) * (entity[3] - point[3]); d = sqrt(float(a + b)); return d < value; case 'L': if (entity[2][1] == POLAR) entity[2] = polar_to_cart(entity[2]); if (entity[3][1] == POLAR) entity[3] = polar_to_cart(entity[3]); if (point[1] == POLAR) point = polar_to_cart(point); a = entity[3][2] - entity[2][2]; b = entity[3][3] - entity[2][3]; c = entity[2][3] * entity[2][2] - entity[3][3] * entity[2][2]; d = sqrt(float(a * point[2] + b * point[3] + c)) * (a * point[2] + b * point[3] + c) / (a * a + b * b); return d < value; } } func cart_to_polar { para cart; if (idv(cart)) return @; if (cart[1] == POLAR) return cart; if (cart[1] != CART) error("argument is not in cart coordinate"); cart[2] = float(cart[2]); cart[3] = float(cart[3]); if (cart[2] == 0.0 && cart[3] == 0.0) return [POLAR, 0.0, 0.0]; return [POLAR, sqrt(cart[2]*cart[2]+cart[3]*cart[3]), atan2(cart[3], cart[2])]; } func polar_to_cart { para polar; if (idv(polar)) return @; if (polar[1] == CART) return polar; if (polar[1] != POLAR) error("argument is not in polar coordinate"); return [CART, polar[2] * cos(float(polar[3])), polar[2] * sin(float(polar[3]))]; } func toComma { para s; auto i; for (i = 1; i <= s# && s[i] != ','; i++); return (i > 0) ? substr(s, 1, i-1) : ""; } func lookAttr { para s, attr; auto head; if (s# <= attr# + 1) return ""; head = toComma(s); if (substr(s, 1, attr#+1) == (attr//"=")) return substr(head, attr#+2, head#); else if (s# > head# + 1 + attr# + 1) return lookAttr(substr(s, head# + 2, s#), attr); else return ""; } /* ----- GRAPHICS DRAWING ROUTINE ----- */ _tkeden_showxoutput = 0; proc xoutput { auto i, s; if ($# == 0) return; s = str($1); for (i = 2; i <= $#; i++) s = strcat(s, " ", str($[i])); /* do '_tkeden_showxoutput = 1;' to debug Donald graphics [Ash] */ if (_tkeden_showxoutput) writeln("xoutput: tcl(\"", s, "\");"); tcl(s); } proc xdelete { para viewport_name, segid; auto command; command = "."//viewport_name[1]//"."//viewport_name[2]; xoutput("if [winfo exists", command, "] {",command, "delete", "t"//str(int(segid)), "}"); } proc xpoint { para viewport_name, segid, x, y, attr, xOrigin, yOrigin, xScale, yScale; auto command, color, var; var = viewport_name[2]; command = "."//viewport_name[1]//"."//var; color = lookAttr(*attr, "color"); color = (color == "") ? "-fill $"//var//"_fg" : "-fill "//color; x = x * xScale + xOrigin; y = y * yScale + yOrigin; xoutput(command, "create line", x, y, x, y, color, "-tags {all t"//str(int(segid))//"}"); } proc xline { para viewport_name, segid, x1, y1, x2, y2, attr, xOrigin, yOrigin, xScale, yScale; auto command, val, opt, var; var = viewport_name[2]; command = "."//viewport_name[1]//"."//var; val = lookAttr(*attr, "color"); opt = "-fill " // ((val == "") ? "$"//var//"_fg" : val); val = lookAttr(*attr, "arrow"); opt = opt // " -arrow " // ((val == "") ? "none" : val); val = lookAttr(*attr, "linewidth"); if (val != "") opt = opt // " -width " // val; val = lookAttr(*attr, "linestyle"); if (val == "dashed") opt = opt // dashedopt; else if (val == "dotted") opt = opt // dottedopt; x1 = x1 * xScale + xOrigin; y1 = y1 * yScale + yOrigin; x2 = x2 * xScale + xOrigin; y2 = y2 * yScale + yOrigin; xoutput(command, "create line", x1, y1, x2, y2, opt, "-tags {all t"//str(int(segid))//"}"); } proc xrectangle { para viewport_name, segid, x1, y1, x2, y2, attr, xOrigin, yOrigin, xScale, yScale; auto command, col, val, var, opt, outcol; var = viewport_name[2]; command = "."//viewport_name[1]//"."//var; opt = ""; outcol = lookAttr(*attr, "outlinecolor"); opt = "-outline " // ((outcol == "") ? "$"//var//"_fg" : outcol); col = lookAttr(*attr, "color"); val = lookAttr(*attr, "fill"); opt = opt // " -fill " // ((val == "solid") ? ((col == "") ? "$"//var//"_fg" : col) : "{}"); val = lookAttr(*attr, "linewidth"); opt = opt // " -width " // ((val == "") ? "1.0" : val); val = lookAttr(*attr, "linestyle"); if (val == "dashed") opt = opt // dashedopt; else if (val == "dotted") opt = opt // dottedopt; x1 = x1 * xScale + xOrigin; y1 = y1 * yScale + yOrigin; x2 = x2 * xScale + xOrigin; y2 = y2 * yScale + yOrigin; xoutput(command, "create rect", x1, y1, x2, y2, opt, "-tags {all t"//str(int(segid))//"}"); } proc xarc { para viewport_name, segid, x1, y1, x2, y2, a, attr, xOrigin, yOrigin, xScale, yScale; auto p1, p2, cx, cy, r, rad, b, c, start, col, outcol; auto command, val, opt, var; var = viewport_name[2]; command = "."//viewport_name[1]//"."//var; if ((a >= 0 ? a : -a) < 1.0) { /* small angle, treat as straight line */ x1 = x1 * xScale + xOrigin; y1 = y1 * yScale + yOrigin; x2 = x2 * xScale + xOrigin; y2 = y2 * yScale + yOrigin; xline(viewport_name, segid, x1, y1, x2, y2, xOrigin, yOrigin, xScale, yScale); return; } col = lookAttr(*attr, "color"); opt = "-fill " // ((col == "") ? "$"//var//"_fg" : col); outcol = lookAttr(*attr, "outlinecolor"); opt = opt // " -outline " // ((outcol == "") ? "$"//var//"_fg" : outcol); val = lookAttr(*attr, "linewidth"); if (val != "") opt = opt // " -width " // val; val = lookAttr(*attr, "linestyle"); if (val == "dashed") opt = opt // dashedopt; else if (val == "dotted") opt = opt // dottedopt; val = lookAttr(*attr, "fill"); opt = opt // " -style " // ((val == "") ? "arc" : "pieslice"); /* treat it properly as a genuine arc */ a = float(a); if (a > 360 || a < -360) error("arc angle must be in between -360 and 360"); x1 = float(x1); y1 = float(y1); x2 = float(x2); y2 = float(y2); p1 = [CART, x1, y1]; p2 = [CART, x2, y2]; rad = a * PI / 180; rad = rad >= 0 ? rad : 2 * PI + rad; b = (PI - rad) / 2; c = cart_to_polar(vector_sub(p2, p1))[3]; r = sqrt((x2-x1)*(x2-x1)+(y2-y1)*(y2-y1)) / 2 / sin(rad / 2); r = r >= 0 ? r : -r; cx = x1 + r * cos(c - b); cy = y1 + r * sin(c - b); start = 90 + (c - rad / 2) * 180 / PI; start = start - int(start / 360) * 360; start = start >= 0 ? start : start + 360; x1 = (cx - r) * xScale + xOrigin; y1 = (cy - r) * yScale + yOrigin; x2 = (cx + r) * xScale + xOrigin; y2 = (cy + r) * yScale + yOrigin; xoutput(command, "create arc", x1, y1, x2, y2, "-start", start, "-extent", a, opt, "-tags {all t"//str(int(segid))//"}"); } proc xcircle { para viewport_name, segid, x, y, r, attr, xOrigin, yOrigin, xScale, yScale; auto command, col, val, var, opt, outcol; var = viewport_name[2]; command = "."//viewport_name[1]//"."//var; opt = ""; outcol = lookAttr(*attr, "outlinecolor"); opt = "-outline " // ((outcol == "") ? "$"//var//"_fg" : outcol); col = lookAttr(*attr, "color"); val = lookAttr(*attr, "fill"); opt = opt // " -fill " // ((val == "solid") ? ((col == "") ? "$"//var//"_fg" : col) : "{}"); val = lookAttr(*attr, "linewidth"); opt = opt // " -width " // ((val == "") ? "1.0" : val); val = lookAttr(*attr, "linestyle"); if (val == "dashed") opt = opt // dashedopt; else if (val == "dotted") opt = opt // dottedopt; x = x * xScale + xOrigin; y = y * yScale + yOrigin; xoutput(command, "create oval", x-r*xScale, y-r*yScale, x+r*xScale, y+r*yScale, opt, "-tags {all t"//str(int(segid))//"}"); } proc xellipse { para viewport_name, segid, x0, y0, x1, y1, x2, y2, attr, xOrigin, yOrigin, xScale, yScale; auto command, val, opt, var, dx1, dy1, dx2, dy2, outcol; var = viewport_name[2]; command = "."//viewport_name[1]//"."//var; val = lookAttr(*attr, "color"); opt = (val == "") ? "-fill $"//var//"_fg" : "-fill "//val; val = lookAttr(*attr, "linewidth"); opt = opt // " -width " // ((val == "") ? "1.0" : val); val = lookAttr(*attr, "linestyle"); if (val == "dashed") opt = opt // dashedopt; else if (val == "dotted") opt = opt // dottedopt; x0 = x0 * xScale + xOrigin; y0 = y0 * yScale + yOrigin; x1 = x1 * xScale + xOrigin; y1 = y1 * yScale + yOrigin; x2 = x2 * xScale + xOrigin; y2 = y2 * yScale + yOrigin; val = lookAttr(*attr, "fill"); dx1 = 4.0 * (x1 - x0) / 3; dy1 = 4.0 * (y1 - y0) / 3; dx2 = 4.0 * (x2 - x0) / 3; dy2 = 4.0 * (y2 - y0) / 3; if (val == "") { xoutput(command, "create line", x0-dx2, y0-dy2, x0+dx1, y0+dy1, x0+dx2, y0+dy2, x0-dx1, y0-dy1, x0-dx2, y0-dy2, opt, "-smooth true -splinesteps 5 -tags {all t" //str(int(segid))//"}"); } else { outcol = lookAttr(*attr, "outlinecolor"); opt = opt // " -outline " // ((outcol == "") ? "$"//var//"_fg" : outcol); xoutput(command, "create polygon", x0-dx2, y0-dy2, x0+dx1, y0+dy1, x0+dx2, y0+dy2, x0-dx1, y0-dy1, x0-dx2, y0-dy2, opt, "-smooth true -splinesteps 5 -tags {all t" //str(int(segid))//"}"); } } proc xtext { para viewport_name, segid, x, y, text, attr, xOrigin, yOrigin, xScale, yScale; auto command, var, val, opt; var = viewport_name[2]; command = "."//viewport_name[1]//"."//var; opt = "-fill "; val = lookAttr(*attr, "color"); opt = opt // (val == "" ? "$"//var//"_fg" : val); val = lookAttr(*attr, "font"); opt = opt // " -font " // (val == "" ? "$"//var//"_font" : val); x = x * xScale + xOrigin; y = y * yScale + yOrigin; xoutput(command, "create text", x, y, "-text {"//text//"}", opt, "-tags {all t"//str(int(segid))//"}"); } proc ximage { para viewport_name, segid, x, y, image, attr, xOrigin, yOrigin, xScale, yScale; auto command, var, val, opt; var = viewport_name[2]; command = "."//viewport_name[1]//"."//var; x = x * xScale + xOrigin; y = y * yScale + yOrigin; xoutput(command, "create image", x, y, "-image", image, "-tags {all t"//str(int(segid))//"}"); } /**** * INITIALIZE ROOT CONTEXT * ****/ /*-----------------------------------------------------------------------------+ | plot_point, plot_line, plot_rectangle, plot_circle, plot_ellipse, plot_shape | +-----------------------------------------------------------------------------*/ plot_point is plot_shape; plot_line is plot_shape; plot_arc is plot_shape; plot_circle is plot_shape; plot_ellipse is plot_shape; plot_rectangle is plot_shape; plot_label is plot_shape; plot_shape is PlotShape; proc draw_shape { para viewport_name, SegName, entity, attr, xOrigin, yOrigin, xScale, yScale; auto x1, y1, x2, y2, i, p1, p2; if (viewport_name == @ || SegName == @ || idv(entity)) return; switch (entity[1]) { case 'C': xpoint(viewport_name, SegName, entity[2], entity[3], attr, xOrigin, yOrigin, xScale, yScale); break; case 'P': p1 = polar_to_cart(entity); xpoint(viewport_name, SegName, p1[2], p1[3], attr, xOrigin, yOrigin, xScale, yScale); break; case 'L': if (entity[2][1] == POLAR) { entity[2] = polar_to_cart(entity[2]); } if (entity[3][1] == POLAR) { entity[3] = polar_to_cart(entity[3]); } xline(viewport_name, SegName, entity[2][2], entity[2][3], entity[3][2], entity[3][3], attr, xOrigin, yOrigin, xScale, yScale); break; case 'G': xrectangle(viewport_name, SegName, entity[2][2], entity[2][3], entity[3][2], entity[3][3], attr, xOrigin, yOrigin, xScale, yScale); break; case 'U': if (entity[2][1] == POLAR) { entity[2] = polar_to_cart(entity[2]); } if (entity[3][1] == POLAR) { entity[3] = polar_to_cart(entity[3]); } xarc(viewport_name, SegName, entity[2][2], entity[2][3], entity[3][2], entity[3][3], entity[4], attr, xOrigin, yOrigin, xScale, yScale); break; case 'E': if (entity[2][1] == POLAR) { entity[2] = polar_to_cart(entity[2]); } xcircle(viewport_name, SegName, entity[2][2], entity[2][3], entity[3], attr, xOrigin, yOrigin, xScale, yScale); break; case 'Q': if (entity[2][1] == POLAR) { entity[2] = polar_to_cart(entity[2]); } if (entity[3][1] == POLAR) { entity[3] = polar_to_cart(entity[3]); } if (entity[4][1] == POLAR) { entity[4] = polar_to_cart(entity[4]); } xellipse(viewport_name, SegName, entity[2][2], entity[2][3], entity[3][2], entity[3][3], entity[4][2], entity[4][3], attr, xOrigin, yOrigin, xScale, yScale); break; case 'T': if (entity[3][1] == POLAR) entity[3] = polar_to_cart(entity[3]); xtext(viewport_name, SegName, entity[3][2], entity[3][3], str(entity[2]), attr, xOrigin, yOrigin, xScale, yScale); break; case 'I': if (entity[3][1] == POLAR) entity[3] = polar_to_cart(entity[3]); ximage(viewport_name, SegName, entity[3][2], entity[3][3], str(entity[2]), attr, xOrigin, yOrigin, xScale, yScale); break; case 'S': for (i = 2; i <= entity#; i++) draw_shape(viewport_name, SegName, entity[i], attr, xOrigin, yOrigin, xScale, yScale); break; default: writeln("ERROR: draw_shape(" , entity, ");"); break; } } proc dd_delete { para id, viewport, attr; plot_shape([], id, attr); *id = @; } proc InitDoNaLDViewport { OpenDisplay("donaldscreen", 500, 500); tcl("wm title .donaldscreen DoNaLD"); execute("%scout window DoNaLDdefaultWin = { type: DONALD pict: \"DoNaLD\" box: [{0,0}, {500, 500}] border: 1 };\n%eden"); tcl("canvas .donaldscreen.default"); DoNaLD is scout_show_2D_window(DoNaLDdefaultWin, ".donaldscreen.default", "default") ? [["donaldscreen", "default"]] : [["donaldscreen", "default"]]; } /* include(getenv("TKEDEN_LIB") // "/macro.e"); */ proc SetGraph { para ename, dname; execute(macro(" proc P?1 : ?1_viewport, ?1__fi_, ?1__xi_, ?1_nSegment, ?1_?3, ?1_?4 { auto i, j, s, xi, xi_1, fi, fi_1; xi = \"(\"//?1__xi_//\")\"; xi_1 = macro(xi, \"??2\"); fi = \"(\"//macro(?1__fi_, \"??1\", xi)//\")\"; fi_1 = macro(fi, \"??2\"); execute(\"%donald\\nviewport \"//?1_viewport//\"\\nwithin ?2 {\\n\"); if (o?1_nNode != @) for (j = o?1_nNode[2]; j > 0; j--) for (i = o?1_nNode[1]; i > 0; i--) execute(macro(\"%donald\\ndelete ?3??2_??1\", str(i-1),str(j))); if (o?1_nSegment != @) for (j = o?1_nSegment[2]; j > 0; j--) for (i = o?1_nSegment[1]; i > 0; i--) execute(macro(\"%donald\\ndelete ?4??2_??1\", str(i), str(j))); "//" if (?1_?3 != []) { for (j = 0; j < ?1_?3# / 2; j++) { s = \"\"; for (i = ?1_nSegment; i >= 0; i--) { s = s // macro(\" ?3??2_??1\", str(i), str(j+1)); if (i > 0) s = s // ','; } if (?1_nSegment > 0) execute(\"%donald\\n\"//?1_?3[2*j+1]//s); if (?1_?3[2*j+2] != \"\") for (i = ?1_nSegment; i >= 0; i--) execute(macro(macro(\"%donald\\n?3????3_??1 = \"//?1_?3[2*j+2], \"??1\", xi, fi, \"??2\", xi_1, fi_1), str(i), str(i-1), str(j+1))); } o?1_nNode = [?1_nSegment + 1, ?1_?3# / 2]; } else o?1_nNode = [0,0]; "//" if (?1_?4 != []) { for (j = 0; j < ?1_?4# / 2; j++) { s = \"\"; for (i = ?1_nSegment; i > 0; i--) { s = s // macro(\" ?4??2_??1\", str(i), str(j+1)); if (i > 1) s = s // ','; } if (?1_nSegment >= 0) execute(\"%donald\\n\"//?1_?4[2*j+1]//s); if (?1_?4[2*j+2] != \"\") for (i = ?1_nSegment; i > 0; i--) execute(macro(macro(\"%donald\\n?4????3_??1 = \"//?1_?4[2*j+2], \"??1\", xi, fi, \"??2\", xi_1, fi_1), str(i), str(i-1), str(j+1))); } o?1_nSegment = [?1_nSegment, ?1_?4# / 2]; } else o?1_nSegment = [0,0]; execute(\"%donald\\n}\"); } ", ename, dname, "node", "segment")); } proc quit {} ttr(*attr, "linestyle"); if (val == "dashed") opt = opt // dashedopt; else if (val == "dotted") opt = opt // dottedopt; val = lookAttr(*attr, "fill"); opt = opt // " -style " // ((val == "") ? "arc" : "pieslice"); /* treat it properly as atkeden1.46/lib-tkeden/donald.txt010064400025250000147000000100410750464240400200640ustar00ashleydcsother00003520000005------ DoNaLD (Definitive Notation for Line Drawing) QUICK REFERENCE ------ Warning: this documentation isn't quite finished yet... CONTENTS OF THIS QUICK REFERENCE: 1. Syntax 2. Data types 3. Functions 4. References 5. Pre-defined variables 6. Attributes 7. Viewports 8. More information -- 1. SYNTAX ----------------------------------------------------------------- No semi-colons: line feeds are terminators Line continuation: use \ at the end of a line to continue to the next # UNIX shell style one-line comments Variables must be declared before use (except when using the ! operator) Redeclaration of type is not possible Name space: append ! to an identifier to reference an Eden variable: eg eq!(a, b) Escaping to Eden: ? is a one-line escape to Eden (remember to terminate with a semi-colon) -- 2. DATA TYPES ------------------------------------------------------------- int: 34 real: 10.0 char: "abc" boolean: true, false point: {50, 100} point: {modulo @ angle} ie distance and angle (radians) from the origin line: [{10, 10}, {80, 90}] arc: [point1, point2, angle] -- 'angle' (degrees) portion of a circle, end points are point1, point2: note NOT arc(p, p, a) circle: circle(centre, radius), circle({500, 500}, 400) ellipse: ellipse(centre, major, minor) rectangle: rectangle(point1, point2) label: label(string, point) image: I!ImageFile("gif", "hill.gif") openshape: openshape cross within cross { line l1, l2 l2 = [{300, 300}, {100, 100}] l1 = [{300, 100}, {100, 300}] } shape: shape S S = trans(cross, 100, 200) graph: (see other documentation) -- 3. FUNCTIONS -------------------------------------------------------------- Arithmetic: + - * div mod sqrt log exp trunc float rand Trigonometric: sin cos tan asin acos atan Relational: && || ! < <= == > >= Geometric: point midpoint(line) point intersect(line, line) line perpend(point, line) real dist(point, point) bool intersects(line, line) bool separates(line, point, point) bool includes(circle, point) bool incident(line, point) bool incident(circle, point) bool pt_betwn_pts(point, point, point) bool colinear(point, point, point) bool distlarger(point, point, value) bool distlarger(line, point, value) bool distsmaller(point, point, value) bool distsmaller(line, point, value) Shape transformations (note "entity" can be any Donald type): trans(entity, x, y) scale(entity, ratio) rot(entity, point, angle) reflect(entity, line) String functions: // (string concatenation) itos(int) rtos(real, fprintf-format-string) Image functions: I!functionName denotes a function returning an image -- 4. REFERENCES ------------------------------------------------------------- x: variable x in the immediate context ~/x: variable x in the context one level up /x: variable x in the root (topmost) context x!: the Eden variable x .1, .2: first and second points of a line or first and second coordinates of a point .x, .y: projection of a point onto the x- and y- axes -- 5. PRE-DEFINED VARIABLES -------------------------------------------------- pi: ratio of circle circumference to diameter (note upper case PI in Eden) -- 6. ATTRIBUTES ------------------------------------------------------------- To give an attribute to the DoNaLD variable Obj/line1, use the Eden escape: ?A_Obj_line1 = "attribute1=value1,attribute2=value2..."; color outlinecolor linewidth linestyle: dotted, dashed or solid arrow: first, last, both or none locus: true, false fill: solid or hollow font: a string: "{family size style}"... family = times, courier or helvetica, size = in points (1/72th inch) style = normal, bold, roman, italic, underline, overstrike (multiple styles are possible: "{times 12 {bold italic}}") -- 7. VIEWPORTS -------------------------------------------------------------- viewport VIEW1 The default viewport is DoNaLD. -- 8. MORE INFORMATION ------------------------------------------------------- See http://www.dcs.warwick.ac.uk/modelling/ for more detail. tkeden1.46/lib-tkeden/eddi.eden010064400025250000147000002077710755377242000176540ustar00ashleydcsother00003520000005%eden /* * $Id: eddi.eden,v 1.1 2002/02/28 14:15:28 cssbz Exp $ * Warning: this is a generated file */ ## ## Original file eddipf.e (length 10703, dated Oct 23 08:58) follows... ## %eden /* File: eddipf.e Program: EDEN functions for EDDI/P Date: 6/2/96 Author: Son V Truong */ /* Generally messed around with since by Ashley and Meurig */ /* Added some checking to the input of functions - Michael */ /* */ /* Make a version of a table with no repeated rows */ func Makedistinct { para l; auto result, elt, ix; result = []; while (l#!=0) { elt = l[1]; shift l; ix = 1; while ((ix<=result#)&&(elt!=result[ix])) ix++; if (result#" : { for (i=1; i<=keys#; i++) { if (keys[i] > $4) append tlist1,$1[i+1]; } break; } case ">=" : { for (i=1; i<=keys#; i++) { if (keys[i] >= $4) append tlist1,$1[i+1]; } break; } default : writeln("EDDI/P Error: not a comparison."); } return makedistinct(tlist1); } func getkcols { auto i; tlist = []; for (i=1; i<=$1[1][1]#; i++) if ($1[1][1][i] == 1) append tlist, $1[1][i+1]; return tlist; } func rdupcols { auto i,j,k; tlist = [[[]]]; colnos = [2]; delcols = [$1[1][2]]; for (i=3; i<=$1[1]#; i++) if (notin(delcols,$1[1][i])) { append colnos, i; append delcols, $1[1][i]; } for (j=1; j<=colnos#; j++) { append tlist[1][1], $1[1][1][colnos[j]-1]; append tlist[1], $1[1][colnos[j]]; } for (k=2; k<=$1#; k++) { append tlist, []; for (j=1; j<=colnos#; j++) append tlist[k], $1[k][colnos[j]-1]; } return makedistinct(tlist); } func matchcols /* [[mct1],[mct2]] = matchcols(t1,t2) */ { auto i,j; mct1 = []; mct2 = []; for(i=2;i<=$1[1]#;i++) for(j=2;j<=$2[1]#;j++) { if ($1[1][i] == $2[1][j]) { append mct1,i; append mct2,j; } } return [mct1,mct2]; } func njoin { auto i,j,k,x,y,z; if ($#<2) { writeln("EDEN: ERROR: two tables not provided for njoin."); return [[[]]]; } else if (($1==@) || ($2==@)) { writeln("EDEN: ERROR: njoin has received at least one "// "undefined table."); return [[[]]]; } tlist1 = []; vals1 = []; vals2 = []; nvals1 = []; nvals2 = []; append tlist1, $1[1]; matcols = matchcols($1,$2); if (matcols != [[],[]]) { for (i=1; i<=matcols[1]#; i++) append vals1, getcolval($1,matcols[1][i]-1); for (i=1; i<=matcols[2]#; i++) append vals2, getcolval($2,matcols[2][i]-1); for (j=1; j<=vals1[1]#; j++) { append nvals1, []; for (k=1; k<=vals1#; k++) append nvals1[j], vals1[k][j]; } for (j=1; j<=vals2[1]#; j++) { append nvals2, []; for (k=1; k<=vals2#; k++) append nvals2[j], vals2[k][j]; } attr = $1[1]; attr[1] = attr[1] // $2[1][1]; for (i=2; i<=$2[1]#; i++) append attr, $2[1][i]; tlist = [attr]; z = 1; for (x=1; x<=nvals1#; x++) for (y=1; y<=nvals2#; y++) if (nvals1[x] == nvals2[y]) { append tlist, $1[x+1]; z++; for (i=1; i<=$2[y+1]#; i++) append tlist[z], $2[y+1][i]; } return rdupcols(tlist); } else { attr = $1[1]; attr[1] = attr[1] // $2[1][1]; for (i=2; i<=$2[1]#; i++) append attr, $2[1][i]; tlist = [attr]; for (x=2;x<=$1#;x++) for (y=2; y<=$2#; y++) { append tlist, ($1[x] // $2[y]); } return tlist; } } func epipe { auto i; tlist = []; for(i=2;i<=$1#;i++) append tlist,$1[i]; return tlist; } ## ## Original file eddi.e (length 6144, dated Feb 21 22:43) follows... ## %eden /* Modification by Ash */ /* include ("eddi/eddipf.e"); */ /* Removed by Ash Feb 21 2002: will be inserted above */ /* include(getenv("TKEDEN_LIB")//"/eddipf.e"); */ operators = [[':',"select_wrapper"],['%',"project"],['.',"inter"],['*',"njoin"],['+',"union"],['-',"diff"]]; func lookupop { para op; auto i; for (i = 1; i <= operators#; i++) if (char (op) == operators [i][1]) return operators [i][2]; return "unknown"; } func select_wrapper { para tbl, pred; auto var, op, val, i, j; i = 1; while (i <= pred# && (isalphanum (pred[i]) || pred[i] == ' ')) i++; var = stripspace(substr (pred, 1, i - 1)); j = i; while (i <= pred# && pred[i] != ' ' && !isalphanum (pred [i])) i++; op = stripspace (substr (pred, j, i - 1)); val = converttonum (stripspace (substr (pred, i, pred#))); if (type (val) == "string") val = cutquotes (val); return select (tbl, var, op, val); } eddi_tables = []; proc droptable { para tbl; auto i, new_tables; new_tables = []; for (i = 1; i <= eddi_tables#; i++) if (eddi_tables [i] != tbl) new_tables = new_tables // [eddi_tables [i]]; eddi_tables = new_tables; forget (tbl); } proc addtotablelist { para tbl; eddi_tables = eddi_tables // [tbl]; } proc listtables { auto i; writeln ("----------------"); for (i = 1; i <= eddi_tables#; i++) writeln (eddi_tables [i]); writeln ("----------------"); } eddi_notation = [";", "eddi_statement", []]; eddi_statement = ["suffix", ";", "eddi_statement_1", ["fail", "eddi_statement_1"]]; /* eddi_statement_1 = ["prefix", "?", "table_val", ["script", ["declare", "relname"], ["setparas", ["relname"]], ["later", "showrel (%%);", "relname"]], ["fail", "eddi_statement_2"]]; */ /* For reg_exp queries rather than just table name */ eddi_statement_1 = ["prefix", "?", "rel_exp", ["script", ["declare", "relname"], ["setparas", ["relname"]], ["later", "showrel (%%);", "relname"]], ["fail", "eddi_statement_2"]]; eddi_statement_2 = ["prefix", "~", "table_name", ["script", ["declare", "relname"], ["setparas", ["relname"]], ["later", "droptable (%%);", "relname"]], ["fail", "eddi_statement_3"]]; eddi_statement_3 = ["pivot", "<<", ["table_name", "tuples"], ["script", ["declare", "relname"], ["setparas", ["relname"], []], ["later", "$$ = addvals ($$, %%);", "relname", "relname", "v_substrs[2]"]], ["fail", "eddi_statement_4"]]; eddi_statement_4 = ["pivot", "!!", ["table_name", "tuples"], ["script", ["declare", "relname"], ["setparas", ["relname"], []], ["later", "$$ = delvals ($$, %%);", "relname", "relname", "v_substrs[2]"]], ["fail", "eddi_statement_5"]]; eddi_statement_5 = ["pivot", "is", ["table_name", "rel_exp"], ["script", ["declare", "relname", "expr"], ["setparas", ["relname"], ["expr"]], ["later", "$$ is %%;", "relname", "expr"]], ["fail", "eddi_statement_6"]]; eddi_statement_6 = ["pivot", "(", ["table_name", "create_state"], ["script", ["declare", "relname", "cdata"], ["setparas", ["relname"], ["cdata"]], ["later", "$$ = create ($$); addtotablelist (\"$$\");", "relname", "cdata", "relname"]], ["fail", "eddi_statement_7"]]; eddi_statement_7 = ["literal", "#", ["script", ["execute", "listtables ();"]]]; table_name = ident_ex ([["script", ["execute", "%% = \"%%\";", "v_paras[1]", "v_string"]]]); table_val = ident_ex ([["script", ["execute", "%% is %%;", "v_paras[1]", "v_string"]]]); func op_exp { para op, next; return ["pivot", str (op), ["rel_exp", "rel_exp"], ["script", ["declare", "p1", "p2"], ["setparas", ["p1"], ["p2"]], ["execute", "%% is " // lookupop (op) // "(%%, %%);", "v_paras[1]", "p1", "p2"]], ["ignore", ["bras"]], ["fail", next]]; } rel_exp = op_exp ('+', "rel_exp_1"); rel_exp_1 = op_exp ('-', "rel_exp_2"); rel_exp_2 = op_exp ('*', "rel_exp_3"); rel_exp_3 = op_exp ('.', "rel_exp_4"); rel_exp_4 = ["rev_pivot", "%", ["rel_exp", "attr_list"], ["script", ["declare", "expr_part", "attr_part"], ["setparas", ["expr_part"], ["attr_part"]], ["execute", "%% is " // lookupop ('%') // "(%%, %%);", "v_paras[1]", "expr_part", "attr_part"]], ["ignore", ["bras"]], ["fail", "rel_exp_5"]]; rel_exp_5 = ["rev_pivot", ":", ["rel_exp", "predicate"], ["script", ["declare", "expr_part"], ["setparas", ["expr_part"], []], ["execute", "%% is " // lookupop (':') // "(%%, ##);", "v_paras[1]", "expr_part", "v_substrs[2]"]], ["ignore", ["bras"]], ["fail", "rel_exp_6"]]; rel_exp_6 = ["prefix", "(", "rel_exp_7", ["fail", "table_val"], ["script", ["setparas", ["v_paras[1]"]]]]; rel_exp_7 = ["suffix", ")", "rel_exp", ["script", ["setparas", ["v_paras[1]"]]]]; tuples = ["split", ",", "tuple", ["ignore", ["sq_bras"]]]; tuple = ["prefix", "[", "tuple_1"]; tuple_1 = ["suffix", "]", "tuple_2"]; tuple_2 = ["split", ",", "tuple_3"]; tuple_3 = ["prefix", "\"", "tuple_5", ["fail", "float_num"]]; tuple_5 = ["suffix", "\"", "stringval"]; attr_list = ["split", ",", "col_name", ["script", ["allparas", "attrs"], ["execute", "%% is %%;", "v_paras[1]", "attrs"]]]; col_name = ident_ex ([["script", ["execute", "%% = \"%%\";", "v_paras[1]", "v_string"]]]); predicate = anything; stringval = anything; func convertcols { para inlist; auto outstr, i; if (inlist# < 1) return ""; outstr = "\"" // inlist [1][1] // "\", \"" // inlist [1][2] // "\""; for (i = 2; i <= inlist#; i++) outstr = outstr // ", \"" // inlist [i][1] // "\", \"" // inlist [i][2] // "\""; return outstr; } create_state = ["suffix", ")", "create_state_1", ["script", ["declare", "cdata"], ["setparas", ["cdata"]], ["execute", "%% is convertcols (%%);", "v_paras[1]", "cdata"]]]; create_state_1 = ["split", ",", "col_info", ["script", ["allparas", "cols"], ["execute", "%% is %%;", "v_paras[1]", "cols"]]]; col_info = ["pivot", " ", ["col_name", "col_info_2"], ["script", ["declare", "cname", "cdata"], ["setparas", ["cname"], ["cdata"]], ["execute", "%% is [%%, %%];", "v_paras[1]", "cname", "cdata"]]]; col_info_2 = ["suffix", "key", "anything", ["script", ["execute", "%% = \"#\";", "v_paras[1]"]], ["fail", "col_info_3"]]; col_info_3 = ["read_all", [], ["script", ["execute", "%% = \"X\";", "v_paras[1]"]]]; installAOP("%eddi", "eddi_notation"); ## ## Original file neweddipf.e (length 10034, dated Oct 23 20:07) follows... ## %eden /* File: eddipf.e Program: EDEN functions for EDDI/P Date: 6/2/96 Author: Son V Truong */ /* Generally messed around with since by Ashley and Meurig */ /* Added some checking to the input of functions - Michael */ /* */ /* Make a version of a table with no repeated rows */ func Makedistinct { para l; auto result, elt, ix; result = []; while (l#!=0) { elt = l[1]; shift l; ix = 1; while ((ix<=result#)&&(elt!=result[ix])) ix++; if (result#" : { for (i=1; i<=keys#; i++) { if (keys[i] > $4) append tlist1,$1[i+1]; } break; } case ">=" : { for (i=1; i<=keys#; i++) { if (keys[i] >= $4) append tlist1,$1[i+1]; } break; } default : writeln("EDDI/P Error: not a comparison."); } return makedistinct(tlist1); } func getkcols { auto i; tlist = []; for (i=1; i<=$1[1][1]#; i++) if ($1[1][1][i] == 1) append tlist, $1[1][i+1]; return tlist; } func rdupcols { auto i,j,k; tlist = [[[]]]; colnos = [2]; delcols = [$1[1][2]]; for (i=3; i<=$1[1]#; i++) if (notin(delcols,$1[1][i])) { append colnos, i; append delcols, $1[1][i]; } for (j=1; j<=colnos#; j++) { append tlist[1][1], $1[1][1][colnos[j]-1]; append tlist[1], $1[1][colnos[j]]; } for (k=2; k<=$1#; k++) { append tlist, []; for (j=1; j<=colnos#; j++) append tlist[k], $1[k][colnos[j]-1]; } return makedistinct(tlist); } func matchcols /* [[mct1],[mct2]] = matchcols(t1,t2) */ { auto i,j; mct1 = []; mct2 = []; for(i=2;i<=$1[1]#;i++) for(j=2;j<=$2[1]#;j++) { if ($1[1][i] == $2[1][j]) { append mct1,i; append mct2,j; } } return [mct1,mct2]; } func njoin { auto i,j,k,x,y,z; if ($#<2) { writeln("EDEN: ERROR: two tables not provided for njoin."); return @; } else if (($1==@) || ($2==@)) { writeln("EDEN: ERROR: njoin has received at least one "// "undefined table."); return @; } tlist1 = []; vals1 = []; vals2 = []; nvals1 = []; nvals2 = []; append tlist1, $1[1]; matcols = matchcols($1,$2); if (matcols != [[],[]]) { for (i=1; i<=matcols[1]#; i++) append vals1, getcolval($1,matcols[1][i]-1); for (i=1; i<=matcols[2]#; i++) append vals2, getcolval($2,matcols[2][i]-1); for (j=1; j<=vals1[1]#; j++) { append nvals1, []; for (k=1; k<=vals1#; k++) append nvals1[j], vals1[k][j]; } for (j=1; j<=vals2[1]#; j++) { append nvals2, []; for (k=1; k<=vals2#; k++) append nvals2[j], vals2[k][j]; } attr = $1[1]; attr[1] = attr[1] // $2[1][1]; for (i=2; i<=$2[1]#; i++) append attr, $2[1][i]; tlist = [attr]; z = 1; for (x=1; x<=nvals1#; x++) for (y=1; y<=nvals2#; y++) if (nvals1[x] == nvals2[y]) { append tlist, $1[x+1]; z++; for (i=1; i<=$2[y+1]#; i++) append tlist[z], $2[y+1][i]; } return rdupcols(tlist); } else { attr = $1[1]; attr[1] = attr[1] // $2[1][1]; for (i=2; i<=$2[1]#; i++) append attr, $2[1][i]; tlist = [attr]; for (x=2;x<=$1#;x++) for (y=2; y<=$2#; y++) { append tlist, ($1[x] // $2[y]); } return tlist; } } func epipe { auto i; tlist = []; for(i=2;i<=$1#;i++) append tlist,$1[i]; return tlist; } ## ## Original file newshowrel2.e (length 4517, dated Oct 9 17:57) follows... ## %eden _DUMMY = [[[0],"A"],[0]]; /* a dummy eddi relation _DUMMY (A int); _DUMMY << [1]; */ curr_rel = _DUMMY; /* file derived from newshowrel.dev.e which contains some development stuff */ /* Added check for a defined table to showrel(rel) - Michael */ num_tuple is curr_rel#-1; curr_attr is curr_rel[1][curr_index+1]; curr_attr_value is curr_rel[curr_tuple_num+1][curr_index]; /* curr_attr_str is (curr_rel[1][1][curr_index]==1)?curr_attr_value:ntzstr(curr_attr_value); */ curr_attr_str is ntzstr(curr_attr_value); curr_attr_len is curr_attr_str#; /* curr_attr_len is (curr_rel[1][1][curr_index]==1)?curr_attr_value#:str(curr_attr_value)#; */ func ntzstr { /* no trailing zeros display for real x */ /* this conversion function also passes strings through unmodified */ /* this is because of the boundary problem in the definitive environment */ /* whereby neither curr_tuple_num = 0 / 1 is appropriate */ para x; auto strx, i, j, result; strx = str(x); j = strx#; if (x==int(x)) return(str(int(x))); if (x!=str(x)) { i=1; while (strx[i]!='.') i++; while ((j>i) && (strx[j]=='0')) j--; }; result = ""; for (i=1; i<=j; i++) result = result // strx[i]; return result; }; func normalise_len { para s, n; auto i, result; i = 0; result = ""; while (i display list for $1 above $2 */ auto s,i; s = $1; for (i=1; i<=$2#; i++) { append s, $2[i]; } return s; } func displayrt { /* two display lists $1 and $2 -> display list for $1 to right of $2 */ auto s,i; s = []; for (i=1; i<=$1#; i++) { append s, ($1[i] // $2[i]); } return s; } /* some instances of showrel() in action that can be used to test above in connection with the fruits.eddi database */ /* curr_rel = ALLFRUITS; display_list(mkdisplist_rel()); NEWFRUITS = [ALLFRUITS[1]]; /* empty relation */ curr_rel = NEWFRUITS; display_list(mkdisplist_rel()); curr_rel = CITRUS; display_list(mkdisplist_rel()); MIX = union(APPLE, CITRUS); curr_rel = MIX; display_list(mkdisplist_rel()); */ proc showrel { para rel; if (rel==@) { writeln("EDEN: ERROR: showrel has been given an "// "undefined table."); return [[[]]]; } autocalc = 0; curr_rel = rel; display_list(mkdisplist_rel()); if (rel# == 2) writeln("(1 row)"); else writeln("(" // str(rel#-1) // " rows)"); curr_rel = _DUMMY; autocalc = 1; }; ## ## Original file newselect2.e (length 2709, dated Oct 27 10:57) follows... ## autocalc=0; func select /* t2 = select(t1,c,c_op,c_val) */ { auto i,j,k,addcol,compval, constval, constelt; tlist1 = []; /* why isn't tlist auto? */ if ($1==@) { writeln("EDEN: ERROR: select has been given an "// "undefined table."); return @; } else if (!isinlist($2, tail($1[1]))) { writeln("EDEN: ERROR: select has been given an "// "invalid attribute."); return @; } append tlist1, $1[1]; keys = getcolval($1,getcolumn($1,$2)); /* writeln(type($4), " ", $4); indicates types of selection */ constelt =((type($4) == "string") && ($4[1]== '\"')) ? cutquotes($4) : $4; constval = []; for (i=1; i<=$1#-1; i++) constval = constval // [constelt]; compval = constval; /* constval is the list of constant values of type number or string that is appropriate when $4 is a literal value */ if ((type($4) == "string") && ($4[1]!= '\"')) { if (!isinlist($4, tail($1[1]))) { writeln("EDEN: ERROR: select has been given an "// "invalid attribute."); return @; } else compval = getcolval($1,getcolumn($1,$4)); } /* compval is the list of values resulting from column selection where $4 is the name of an attribute in the relation $1 */ switch($3) { case "==" : { for (i=1; i<=keys#; i++) { if (keys[i] == compval[i]) append tlist1,$1[i+1]; } break; } case "!=" : { for (i=1; i<=keys#; i++) { if (keys[i] != compval[i]) append tlist1,$1[i+1]; } break; } case "<" : { for (i=1; i<=keys#; i++) { if (keys[i] < compval[i]) append tlist1,$1[i+1]; } break; } case "<=" : { for (i=1; i<=keys#; i++) { if (keys[i] <= compval[i]) append tlist1,$1[i+1]; } break; } case ">" : { for (i=1; i<=keys#; i++) { if (keys[i] > compval[i]) append tlist1,$1[i+1]; } break; } case ">=" : { for (i=1; i<=keys#; i++) { if (keys[i] >= compval[i]) append tlist1,$1[i+1]; } break; } default : writeln("EDDI/P Error: not a comparison."); return(@); } return makedistinct(tlist1); } func select_wrapper { para tbl, pred; auto var, op, val, i, j; i = 1; while (i <= pred# && (isalphanum (pred[i]) || pred[i] == ' ')) i++; var = stripspace(substr (pred, 1, i - 1)); j = i; while (i <= pred# && pred[i] != ' ' && !isalphanum (pred [i]) && pred[i] != '\"') i++; /* originally the terminating condition pred[i] == '\"' was omitted */ op = stripspace (substr (pred, j, i - 1)); val = converttonum (stripspace (substr (pred, i, pred#))); return select (tbl, var, op, val); } autocalc=1; ## ## Original file curragent.e (length 2560, dated Oct 10 10:04) follows... ## %eden /* this resets curr_agent to 0 whenever an sql query is parsed, and so ensures that the vanilla pivot operation is applied in eddi translation phase */ SQL0_statement is ["suffix", ";", "SQL1", ["script", ["execute", "curr_agent = 0;"], ["declare","statement"], ["setparas",["statement"]], ["later","append SQL0_statement_list, %%;","statement"]] ]; SQL_statement is ["suffix", ";", "SQL1", ["script", ["execute", "curr_agent = 0;"], ["declare","statement"], ["setparas",["statement"]], ["later","append SQL_statement_list, %%;","statement"]] ]; SQL_to_eddi_statement is ["suffix", ";", "SQL1", ["script", ["execute", "curr_agent = 0;"], ["declare","statement"], ["setparas",["statement"]], ["later","append SQL_to_eddi_statement_list, %%;","statement"]] ]; /* eddi_statement_1 = ["prefix", "?", "table_val", ["script", ["declare", "relname"], ["setparas", ["relname"]], ["later", "showrel (%%);", "relname"], ["execute", "curr_agent=1;"]], ["fail", "eddi_statement_2"]]; */ /* For reg_exp queries rather than just table name */ eddi_statement_1 = ["prefix", "?", "rel_exp", ["script", ["declare", "relname"], ["setparas", ["relname"]], ["later", "showrel (%%);", "relname"], ["execute", "curr_agent = 1;"] ], ["fail", "eddi_statement_2"]]; eddi_statement_2 = ["prefix", "~", "table_name", ["script", ["declare", "relname"], ["setparas", ["relname"]], ["later", "droptable (%%);", "relname"], ["execute", "curr_agent = 2;"] ], ["fail", "eddi_statement_3"]]; eddi_statement_3 = ["pivot", "<<", ["table_name", "tuples"], ["script", ["declare", "relname"], ["setparas", ["relname"], []], ["later", "$$ = addvals ($$, %%);", "relname", "relname", "v_substrs[2]"], ["execute", "curr_agent = 3;"] ], ["fail", "eddi_statement_4"]]; eddi_statement_4 = ["pivot", "!!", ["table_name", "tuples"], ["script", ["declare", "relname"], ["setparas", ["relname"], []], ["later", "$$ = delvals ($$, %%);", "relname", "relname", "v_substrs[2]"], ["execute", "curr_agent = 4;"] ], ["fail", "eddi_statement_5"]]; eddi_statement_5 = ["pivot", "is", ["table_name", "rel_exp"], ["script", ["declare", "relname", "expr"], ["setparas", ["relname"], ["expr"]], ["later", "$$ is %%;", "relname", "expr"], ["execute", "curr_agent = 5;"] ], ["fail", "eddi_statement_6"]]; eddi_statement_6 = ["pivot", "(", ["table_name", "create_state"], ["script", ["declare", "relname", "cdata"], ["setparas", ["relname"], ["cdata"]], ["later", "$$ = create ($$); addtotablelist (\"$$\");", "relname", "cdata", "relname"], ["execute", "curr_agent = 6;"] ], ["fail", "eddi_statement_7"]]; ## ## Original file newpivctn.e (length 3229, dated Nov 1 20:08) follows... ## %eden autocalc=0; /* func pivot { para instr, piv, ignore; auto i; i = extract (instr, piv, ignore, 1); if ( (i == 0) || ( ((curr_agent==1) || (curr_agent==5) || (curr_agent==8)) && ( (isdigit(instr[i-1])) || (i+piv#==instr#) || (isdigit(instr[i+piv#+1])) ) ) ) return []; else return [substr(instr,1,i-1), substr(instr,i+piv#,instr#)]; } */ /* func pivot { para instr, piv, ignore; auto i; i = extract (instr, piv, ignore, 1); /* consult setting of curr_agent to determine whether there is a possibility that '.' appears a decimal point and a rel op curr_agent is 1 (query), 5 (definition), 6 (assignment) */ if (i!=0) while ( (i!=0) && ((curr_agent==1) || (curr_agent==5) || (curr_agent==6)) && ( (isdigit(instr[i-1])) && (i+piv#<=instr#) &&(isdigit(instr[i+piv#])) ) ) i = extract (instr, piv, ignore, i+piv#); if (i == 0) return []; else return [substr(instr,1,i-1), substr(instr,i+piv#,instr#)]; } */ func pivot { para instr, piv, ignore; auto i; i = extract (instr, piv, ignore, 1); /* consult setting of curr_agent to determine whether there is a possibility that '.' appears a decimal point and a rel op curr_agent is 1 (query), 5 (definition), 6 (assignment) */ if (i!=0) while ( (i!=0) && ( ( ((curr_agent==1)||(curr_agent==5)||(curr_agent==6)) && ( (i>1) && (isdigit(instr[i-1])) && (i+piv#<=instr#) &&(isdigit(instr[i+piv#])) ) ) || ( ((i>1) && (ischar(instr[i-1])) && (ischar(instr[i])) ) ||( (ischar(instr[i+piv#-1])) && (i+piv#<=instr#) && (ischar(instr[i+piv#])) ) ) ) ) i = extract (instr, piv, ignore, i+piv#); if (i == 0) return []; else return [substr(instr,1,i-1), substr(instr,i+piv#,instr#)]; } /* the three versions of pivot above are a flawed pivot that distinguishes decimal point from intersect, but can this overlook intersect, a better version that finds intersect OK in any event, and a version that also detects when a alphabetic pivot occurs in the adjacent context of a letter, as in IN in SINNING */ func converttonum { para instr; auto i, radix, sum; i = instr#; radix = 1; sum = 0; while ((i >= 1) && (isdigit (instr [i]))) { sum += ((instr [i] - '0') * radix); radix = radix * 10; i--; } if (i==0) return sum; if (!isdigit(instr [i]) && (instr[i]!='.')) return instr; if (instr[i]=='.') sum2 = float(sum) / float(radix); radix = 1; i--; /* writeln(sum2); */ sum= 0; while (i >= 1) { if (!isdigit(instr[i])) return instr; if (isdigit (instr [i])) { sum += ((instr [i] - '0') * radix); radix = radix * 10; i--; } } /* writeln(" ", i); */ return sum+sum2; } autocalc=1; ## ## Original file asgn.e (length 957, dated Oct 10 10:47) follows... ## /* adding an assignment of relations to eddi, as in X = APPLE : PRICE > 0.25;*/ /* observe assignment before the create table clause which is identified through its use of the round brackets. Otherwise have problems with assignments of the form X = ( ... ); Statement 6 is =, statement 7 is create, statement 8 is # */ %eden eddi_statement_7 = ["pivot", "(", ["table_name", "create_state"], ["script", ["declare", "relname ", "cdata"], ["setparas", ["relname"], ["cdata"]], ["later", "$$ = create ($$); addtotablelist (\"$$\");", "relname", "cdata", "relname"], ["execute", "curr_agent=7;"]], ["fail", "eddi_statement_8"]]; eddi_statement_6 = ["pivot", "=", ["table_name", "rel_exp"], ["script", ["declare", "relname", "expr"], ["setparas", ["relname"], ["expr"]], ["later", "$$ = %%;", "relname", "expr"], ["execute", "curr_agent=6;"]], ["fail", "eddi_statement_7"]]; eddi_statement_8 = ["literal", "#", ["script", ["execute", "listtables ();"]]]; ## ## Original file prec.e (length 1191, dated Oct 9 17:57) follows... ## %eden /* this file changes the precedence of the eddi ops - giving higher precedence to * than to % and : and lowest precedence to +, - and . */ rel_exp = op_exp ('+', "rel_exp_1"); rel_exp_1 = op_exp ('-', "rel_exp_2"); rel_exp_5 = op_exp ('*', "rel_exp_6"); rel_exp_2 = op_exp ('.', "rel_exp_3"); rel_exp_3 = ["rev_pivot", "%", ["rel_exp", "attr_list"], ["script", ["declare", "expr_part", "attr_part"], ["setparas", ["expr_part"], ["attr_part"]], ["execute", "%% is " // lookupop ('%') // "(%%, %%);", "v_paras[1]", "expr_part", "attr_part"]], ["ignore", ["bras"]], ["fail", "rel_exp_4"]]; rel_exp_4 = ["rev_pivot", ":", ["rel_exp", "predicate"], ["script", ["declare", "expr_part"], ["setparas", ["expr_part"], []], ["execute", "%% is " // lookupop (':') // "(%%, ##);", "v_paras[1]", "expr_part", "v_substrs[2]"]], ["ignore", ["bras"]], ["fail", "rel_exp_5"]]; /* it overcomes the problems of parsing eddi expressions such as: ?ALLFRUITS * APPLE : BEGIN < 4; and deals with the sql equivalent SELECT * FROM ALLFRUITS, APPLE WHERE BEGIN < 4; well also More complex expressions such as SELECT * FROM ALLFRUITS WHERE (BEGIN < 4 AND END > 8) OR BEGIN = 5; still parse also */ ## ## Original file catalogue.e (length 5792, dated Oct 31 08:21) follows... ## %eddi _CATALOGUE ( relname CHAR, reltype CHAR, defn CHAR, ptr POINTER); %eden /* this line was added after type checking: it makes use of redundant fields in the relation table record that had been inappropriately used for key information */ _CATALOGUE[1][1] = ["string", "string", "string", "pointer"]; func search_CAT { para tablename; auto cat, i, result; cat = _CATALOGUE; i= 1; result = 0; shift cat; while (cat!=[]) { i++; if (cat[1][1] == tablename) result = i; shift cat; } return result; } proc delrelvar { para tablename; /* name of table - as string - presumed to be in the catalogue */ *(_CATALOGUE[search_CAT(tablename)][4]) = @; } eddi_statement_8 = ["literal", "#", ["script", ["execute", "curr_agent=8; showrel(CATALOGUE);"]]]; eddi_statement_1 = ["prefix", "?", "rel_exp", ["script", ["declare", "relname"], ["setparas", ["relname"]], ["later", "showrel (%%);", "relname"], ["execute", "curr_agent=1;"]],["fail", "eddi_statement_2"]]; /* handle this checking elsewhere in parsing rel expressions eddi_statement_1 = ["prefix", "?", "rel_exp", ["script", ["declare", "relname"], ["setparas", ["relname"]], ["later", "if (search_CAT(%%)!=0) showrel (%%); else writeln(\"Table not in catalogue\");", "relname", "relname"], ["execute", "curr_agent=1;"]],["fail", "eddi_statement_2"]]; */ eddi_statement_2 = ["prefix", "~", "table_name", ["script", ["declare", "relname"], ["setparas", ["relname"]], ["later", "if ((%%[1]!='_') && (search_CAT(%%)>2)) { delrelvar(%%); delete _CATALOGUE, search_CAT(%%);} else {if (search_CAT(%%)==2) writeln (\"Can't delete the catalogue\"); else writeln(\"Table / view name is not in the catalogue\");}", "relname", "relname", "relname", "relname", "relname"], ["execute", "curr_agent=2;"]], ["fail", "eddi_statement_3"]]; eddi_statement_5 = ["pivot", "is", ["table_name", "rel_exp"], ["script", ["declare", "relname", "expr"], ["setparas", ["relname"], ["expr"]], ["execute", "curr_agent=5; instr = v_string;"], ["later", "if (search_CAT(%%)==0) { $$ is %%; _CATALOGUE = addvals (_CATALOGUE, [\"$$\", \"view\", instr, &$$]); } else writeln(\"Table name already in use\");", "relname", "relname", "expr", "relname", "relname"]], ["fail", "eddi_statement_6"]]; eddi_statement_6 = ["pivot", "=", ["table_name", "rel_exp"], ["script", ["declare", "relname", "expr"], ["setparas", ["relname"], ["expr"]], ["later", "if (search_CAT(%%)==0) { $$ = %%; _CATALOGUE = addvals (_CATALOGUE, [\"$$\", \"table\", \"\", &$$]); } else writeln(\"Table name already in use\");", "relname", "relname", "expr", "relname", "relname"], ["execute", "curr_agent=6;"]], ["fail", "eddi_statement_7"]]; eddi_statement_7 = ["pivot", "(", ["table_name", "create_state"], ["script", ["declare", "relname", "cdata"], ["setparas", ["relname"], ["cdata"]], ["later", "if (search_CAT(%%)==0) { $$ = create ($$); _CATALOGUE = addvals (_CATALOGUE, [\"$$\", \"table\", \"\", &$$]); } else writeln(\"Table name already in use\");", "relname", "relname", "cdata", "relname", "relname"], ["execute", "curr_agent=7;"]], ["fail", "eddi_statement_8"]]; %eddi CATALOGUE is _CATALOGUE % relname, reltype; %eden func size { para tblname; return *(_CATALOGUE[search_CAT(tblname)][4])# -1; } /* writeln(size("CATALOGUE")); */ func typerel { para tblname; return tail((*(_CATALOGUE[search_CAT(tblname)][4]))[1]); } /* writeln(typerel("CATALOGUE")); */ func typedom { para tblname; return (*(_CATALOGUE[search_CAT(tblname)][4]))[1][1]; } /* writeln(typedom("CATALOGUE")); */ func relvartype { para tblname; return _CATALOGUE[search_CAT(tblname)][2]; } /* writeln(relvartype("CATALOGUE")); */ func viewdefn { para tblname; return _CATALOGUE[search_CAT(tblname)][3]; } func searchCAT { para tablename; auto cat, i, result; cat = CATALOGUE; i= 1; result = 0; shift cat; while (cat!=[]) { i++; if (cat[1][1] == tablename) result = i; shift cat; } return result; } proc describe { para tblname; if (searchCAT(tblname)!= 0) { writeln(tblname // " is a " // relvartype(tblname)); if (relvartype(tblname)=="view") writeln("\tdefn: " // viewdefn(tblname)); write("\ttype: "); writeln(typedom(tblname)); write("\tattr: "); writeln(typerel(tblname)); write("\tsize: "); writeln(size(tblname)); } else writeln ("There is no table or view ", tblname); } eddi_statement = ["suffix", ";", "eddi_statement_0", ["fail", "eddi_statement_0"]]; eddi_statement_0 = ["prefix", "??", ["describetbl"], ["fail", "eddi_statement_1"]]; describetbl = ["read_all", [], ["script", ["execute", "if (searchCAT(\"%%\")!=0) describe(\"%%\"); else writeln(\"%%\" // \" is not in the catalogue\");", "v_string", "v_string", "v_string"]]]; eddi_statement_6 = ["pivot", "=", ["table_name", "rel_exp"], ["script", ["declare", "relname", "expr"], ["setparas", ["relname"], ["expr"]], ["later", "if (search_CAT(%%)==0) { if (%%!=@) {$$ = %%; _CATALOGUE = addvals (_CATALOGUE, [\"$$\", \"table\", \"\", &$$]);} else writeln(\"Invalid assignment\"); } else writeln(\"Table name already in use\");", "relname", "expr", "relname", "expr", "relname", "relname"], ["execute", "curr_agent=6;"]], ["fail", "eddi_statement_7"]]; eddi_statement_5 = ["pivot", "is", ["table_name", "rel_exp"], ["script", ["declare", "relname", "expr"], ["setparas", ["relname"], ["expr"]], ["execute", "curr_agent=5; instr = v_string;"], ["later", "if (search_CAT(%%)==0) { if (%%!=@) {$$ is %%; _CATALOGUE = addvals (_CATALOGUE, [\"$$\", \"view\", instr, &$$]);} else writeln(\"Invalid definition\"); } else writeln(\"Table name already in use\");", "relname", "expr", "relname", "expr", "relname", "relname"]], ["fail", "eddi_statement_6"]]; ## ## Original file newproject.e (length 3268, dated Oct 23 09:35) follows... ## %eden /* 22/10/01 WMB attempts to prevent serious errors when projection called with invalid arguments. Now check to see whether list of attrs in projection is valid, and whether really have a table value to project from. If invalid, returns @ rather than [[[]]] */ func isinlist { para elt, lst; auto result; result = 0; while(lst!=[]) { if (elt==lst[1]) result = 1; shift lst; } return result; } func inclist { para l1, l2; auto result; result = 1; while (l2!=[]) { if (!isinlist(l2[1], l1)) result = 0; shift l2; } return result; } /* func project /* t2 = project(t1,c_list) */ { auto i,j,k; /* writeln("Project called with pars ", $1, " ", $2); */ if ($#<1) { writeln("EDEN: ERROR: table not provided for project."); return @; } else { if ($1==@) { writeln("EDEN: ERROR: project has received an "// "undefined table."); return @; } else if (!inclist(tail($1[1]), $2)){ writeln("EDEN: ERROR: invalid attribute "// "in projection."); return @; } } tlist = [[[]]]; /* For renaming attrs: c_list can contain [col_name,new_name] - ME*/ for (i=1; i<=$2#; i++) if (type($2[i]) == "list") { append tlist[1],$2[i][2]; $2[i] = $2[i][1]; } else append tlist[1],$2[i]; for (i=2; i<=$1#; i++) append tlist,[]; for (i=1; i<=$2#; i++) { addcol = getcolumn($1,$2[i]); append tlist[1][1], $1[1][1][addcol]; for (j=2; j<=$1#; j++) append tlist[j], $1[j][addcol]; } return makedistinct(tlist); } */ func extractattrs { para attrlist; auto result; result = []; while (attrlist != []) { result = result // [(type(attrlist[1])=="list")?attrlist[1][1]:attrlist[1]]; shift attrlist; } return result; } func project { auto i,j,k,attr; /* project takes as its 2nd argument a single attribute name or an (attribute name, rename) pair */ /* writeln("Project called with pars ", $1, " ", $2); */ if ($#<1) { writeln("EDEN: ERROR: table not provided for project."); return @; } else { if ($1==@) { writeln("EDEN: ERROR: project has received an "// "undefined table."); return @; } else if (!inclist(tail($1[1]), extractattrs($2))) { writeln("EDEN: ERROR: invalid attribute "// "in projection."); return @; } } tlist = [[[]]]; /* For renaming attrs: c_list can contain [col_name,new_name] - ME*/ for (i=1; i<=$2#; i++) if (type($2[i]) == "list") { append tlist[1],$2[i][2]; $2[i] = $2[i][1]; } else append tlist[1],$2[i]; for (i=2; i<=$1#; i++) append tlist,[]; for (i=1; i<=$2#; i++) { addcol = getcolumn($1,$2[i]); append tlist[1][1], $1[1][1][addcol]; for (j=2; j<=$1#; j++) append tlist[j], $1[j][addcol]; } return makedistinct(tlist); } ## ## Original file renameattrs.e (length 445, dated Oct 22 21:47) follows... ## attr_list = ["split", ",", "col_naming", ["script", ["allparas", "attrs"], ["execute", "%% is %%;", "v_paras[1]", "attrs"]]]; col_naming = ["pivot", ">>", ["col_name", "col_name"], ["script",["declare", "nameL", "nameR"], ["setparas", ["nameL"], ["nameR"]], ["execute", "%% is [%%, %%];", "v_paras[1]", "nameL", "nameR"]], ["fail", "col_name"]]; col_name = ident_ex ([["script", ["execute", "%% = \"%%\";", "v_paras[1]", "v_string"]]]); ## ## Original file comment.e (length 816, dated Oct 25 22:16) follows... ## eddi_statement = ["suffix", ";", "eddi_comment", ["fail", "eddi_comment"]]; eddi_comment = ["prefix", "##", ["anything"], ["fail", "eddi_statement_0"]]; eddi_notation = ["\n", "eddi_statement", []]; /* eddi_comment = ["prefix", "##", ["anyline"], ["fail", "eddi_statement_0"]]; anyline = ["read_line", []]; func read_line { para instr; auto i, result; result = ""; i=1; if (instr#>0) while ((i<=instr#) && (instr[i]!='\n')) { result = result // instr[i]; i++; } return result; } */ /* having problems with this - with read_all comments are eating into lines until terminated by a semi-colon, and above is causing index errors. Previous attempts giving lower precedence to the match with prefix ## interfered with comments with keywords (such as 'is') in them! */ ## ## Original file deps.e (length 3753, dated Nov 20 15:56) follows... ## /* Warning: this func is overwritten by one in SQLextra.e in sqleddi... */ func dependants { para tblname; auto result, symbolinfo, currvar, ddcurrvar; result = [[], []]; symbolinfo = symboldetail(tblname)[4]; /* writeln("SYMBOLDETAIL="//symboldetail(tblname)[4]); */ if (symbolinfo!=[]) while (symbolinfo!=[]) { currvar = symbolinfo[1]; if (search_CAT(currvar)!=0) result[1] = result[1] // [currvar]; else result[2] = result[2] // [currvar]; ddcurrvar = dependants(currvar); result[1] = result[1] // ddcurrvar[1]; result[2] = result[2] // ddcurrvar[2]; shift symbolinfo; } result[1] = Makedistinct(result[1]); result[2] = Makedistinct(result[2]); return result; } func dependees { para tblname; auto result, symbolinfo, currvar, ddcurrvar; result = [[], []]; symbolinfo = symboldetail(tblname)[5]; /* writeln(symboldetail(tblname)[4]); */ if (symbolinfo!=[]) while (symbolinfo!=[]) { currvar = symbolinfo[1]; if (search_CAT(currvar)!=0) result[1] = result[1] // [currvar]; else result[2] = result[2] // [currvar]; ddcurrvar = dependees(currvar); result[1] = result[1] // ddcurrvar[1]; result[2] = result[2] // ddcurrvar[2]; shift symbolinfo; } result[1] = Makedistinct(result[1]); result[2] = Makedistinct(result[2]); return result; } /* Makedistinct invocation introduced here by WMB on 20/11/01 */ /* proc garbage_collect { auto i, j, dCAT; for (i=3; i<=CATALOGUE#; i++) { dCAT = dependants(CATALOGUE[i][1]); writeln("i = ", i); writeln(dCAT); writeln((dCAT[2])#); for (j=1; j<=dCAT[2]#; j++) { writeln(dependants(dCAT[2][j])); if ((dependants(dCAT[2][j])[1])==[]) { writeln(dCAT[2][j]); } } } } */ /* idea is to inspect the list of dependants of variables in the CATALOGUE that are of the form var_ ... , and perform x=x; for each one that has no dependant in the CATALOGUE */ proc garbage_collect { auto i, j, dCAT; for (i=2; i<=CATALOGUE#; i++) { dCAT = dependants(CATALOGUE[i][1]); /* writeln("i = ", i); writeln(dCAT); writeln((dCAT[2])#); */ for (j=1; j<=dCAT[2]#; j++) { /* writeln(dependants(dCAT[2][j])); */ if ((dependants(dCAT[2][j])[1])==[]) { /* writeln(dCAT[2][j]); */ self_asgn(dCAT[2][j]); } } } } proc self_asgn { para varname; execute (varname // "=" // varname //";"); } /* this removes all links to var_n variables that aren't used to maintain views - could also execute forget(varname); to delete entirely */ eddi_statement = ["suffix", ";", "eddi_comment", ["script", ["later", "garbage_collect();"]], ["fail", "eddi_comment"]]; /* eliminate inappropriate dependencies after each eddi_statement */ proc describe { para tblname; if (searchCAT(tblname)!= 0) { writeln(); writeln(tblname // " is a " // relvartype(tblname)); if (relvartype(tblname)=="view") writeln("\tdefn: " // viewdefn(tblname)); write("\ttype: "); writeln(typedom(tblname)); write("\t\attr: "); writeln(typerel(tblname)); write("\tsize: "); writeln(size(tblname)); write("The list of views dependent on ", tblname, " is : "); writeln(dependants(tblname)[1]); writeln(); } else writeln ("There is no table or view ", tblname); } eddi_statement_2 = ["prefix", "~", "table_name", ["script", ["declare", "relname"], ["setparas", ["relname"]], ["later", "if ((%%[1]!='_') && (search_CAT(%%)>2) && (dependants(%%)[1]==[])) { delrelvar(%%); delete _CATALOGUE, search_CAT(%%);} else {if (search_CAT(%%)==2) writeln (\"Can't delete the catalogue\"); else {if ((search_CAT(%%)>2) && (dependants(%%)[1]!=[])) writeln(\"Cannot delete table / view with dependants\"); else writeln(\"Table / view name is not in the catalogue\");}}", "relname", "relname", "relname", "relname", "relname", "relname", "relname", "relname"], ["execute", "curr_agent=2;"]], ["fail", "eddi_statement_3"]]; ## ## Original file checktype.e (length 5671, dated Oct 31 08:05) follows... ## /* these observation rules need not be changed - include for info: eddi_statement_7 = ["pivot", "(", ["table_name", "create_state"], ["script", ["declare", "relname", "cdata"], ["setparas", ["relname"], ["cdata"]], ["later", "if (search_CAT(%%)==0) { $$ = create ($$); _CATALOGUE = addvals (_CATALOGUE, [\"$$\", \"table\", \"\", &$$]); } else writeln(\"Table name already in use\");", "relname", "relname", "cdata", "relname", "relname"], ["execute", "curr_agent=7;"]], ["fail", "eddi_statement_8"]]; create_state = ["suffix", ")", "create_state_1", ["script", ["declare", "cdata"], ["setparas", ["cdata"]], ["execute", "%% is convertcols (%%);", "v_paras[1]", "cdata"]]]; create_state_1 = ["split", ",", "col_info", ["script", ["allparas", "cols"], ["execute", "%% is %%;", "v_paras[1]", "cols"]]]; col_info = ["pivot", " ", ["col_name", "col_info_2"], ["script", ["declare", "cname", "cdata"], ["setparas", ["cname"], ["cdata"]], ["execute", "%% is [%%, %%];", "v_paras[1]", "cname", "cdata"]]]; col_info_2 = ["suffix", "key", "anything", ["script", ["execute", "%% = \"#\";", "v_paras[1]"]], ["fail", "col_info_3"]]; */ col_info_3 = ["read_all", [], ["script", ["execute", "%% = \"%%\";", "v_paras[1]", "v_string"]]]; /* modifying col_info_3 to return the type of the domain for col */ /* func create { auto i, tlist; tlist = [[[]]]; for (i=1; i<=$#; i+=2) { append tlist[1],$[i]; if (($[i+1] == "CHAR")||($[i+1] == "char")) append tlist[1][1],"string"; else if (($[i+1] == "REAL")||($[i+1] == "real")) append tlist[1][1],"float"; else append tlist[1][1],"int"; } return tlist; } */ /* for type checking in tuple introduction not to pose problems initially, must ensure that _CATALOGUE has typeseq as given by _CATALOGUE[1][1] = ["string", "string", "string", "pointer"]; */ func create { auto i, tlist; /* for (i=1; i<=$#; i++) writeln($[i]); */ tlist = [[[]]]; for (i=1; i<=$#; i+=2) { append tlist[1],$[i]; if (($[i+1] == "CHAR")||($[i+1] == "char")) append tlist[1][1],"string"; else if (($[i+1] == "REAL")||($[i+1] == "real")) append tlist[1][1],"float"; else if (($[i+1] == "INT")||($[i+1] == "int")) append tlist[1][1],"int"; else if (($[i+1] == "POINTER")||($[i+1] == "pointer")) append tlist[1][1],"pointer"; else { writeln("Unrecognised type - defaults to int"); append tlist[1][1], "int";} } return tlist; } /* also need to restrict add and delete tuples to views eddi_statement_3 = ["pivot", "<<", ["table_name", "tuples"], ["script", ["declare", "relname"], ["setparas", ["relname"], []], ["later", "$$ = addvals ($$, %%);", "relname", "relname", "v_substrs[2]"]], ["fail", "eddi_statement_4"]]; */ func istablevar { para tblname; return ((search_CAT(tblname)!=0) && (CATALOGUE[search_CAT(tblname)][2]=="table")); } /* writeln(istablevar("allfruits")); writeln(istablevar("allfruit")); writeln(istablevar("FRUITS")); */ eddi_statement_3 = ["pivot", "<<", ["table_name", "tuples"], ["script", ["declare", "relname"], ["setparas", ["relname"], []], ["execute", "curr_agent=3;"],["later", "if(istablevar(\"$$\")) $$ = addvals ($$, %%); else writeln(\"Can't add tuples to a view / non-existent table\");", "relname", "relname", "relname", "v_substrs[2]"]], ["fail", "eddi_statement_4"]]; eddi_statement_4 = ["pivot", "!!", ["table_name", "tuples"], ["script", ["declare", "relname"], ["setparas", ["relname"], []], ["execute", "curr_agent=4;"], ["later", "if(istablevar(\"$$\")) $$ = delvals ($$, %%); else writeln(\"Can't delete tuples from a view / non-existent table\");", "relname", "relname", "relname", "v_substrs[2]"]], ["fail", "eddi_statement_5"]]; /* eddi_statement_3 and eddi_statement_4 have been modified to prevent adding to / deleting from a view: require no further modification - only addvals needs to be changed to prevent inappropriately typed tuples from being introduced */ func addvals /* table2 = addvals(t1,tup1,tup2,...,tupN) */ { auto i; if ($#<1) { writeln("EDEN: ERROR: table not provided for addvals."); return [[[]]]; } else if ($1==@) { writeln("EDEN: ERROR: addvals has received an "// "undefined table."); return [[[]]]; } for (i=2; i<=$#; i++) { if ($1[1]#-1 == $[i]#) { if (typeseq($[i])==$1[1][1]) { if (notin($1,$[i])==1) { append $1,$[i]; /* writeln("Tuple added to table"); */ } else writeln("EDDI/EDEN ERROR: tuple exists already."); } else writeln("EDEN: ERROR: Tuple of incorrect datatype"); } else writeln("EDEN: ERROR: incorrect number of values."); } return $1; } /* typeseq returns the list of types of tuple elts in a list */ func typeseq { para tple; auto result; result = []; while (tple!=[]) { result = result // [type(tple[1])]; shift tple; } return result; } func ucompatdom /* bool = ucompat(t1,t2): union compatible on domain */ { return ($1[1][1] == $2[1][1]); } func ucompatrel /* bool = ucompat(t1,t2): union compatible on attrname */ { return (tail($1[1]) == tail($2[1])); } /* propose to define ucompat(x,y) as ucompatdom(x,y) && ucompatdom(x,y); */ func ucompat { para x,y; return ucompatdom(x,y) && ucompatrel(x,y); } ## ## Original file error.e (length 2401, dated Oct 31 08:03) follows... ## eddi_statement_8 = ["literal", "#", ["script", ["execute", "curr_agent = 8; showrel (CATALOGUE);"]], ["fail", "error_unrecog"]]; error_unrecog = ["read_all", [], ["script", ["execute", "writeln(\"Unrecognised EDDI statement\");"]]]; table_name = ident_ex ([["script", ["execute", "%% = \"%%\";", "v_paras[1]", "v_string"]], ["fail", "error_tblname"]]); table_val = ident_ex ([["script", ["execute", "if (search_CAT(%%) != 0) %% is %%; else writeln(\"Invalid table\"", "v_string", "v_paras[1]", "v_string"]], ["fail", "error_tblval"]]); /* table_val = ident_ex ([["script", ["execute", "%% is %%;", "v_paras[1]", "v_string"]], ["fail", "error_tblval"]]); */ table_val = ident_ex ([["script", ["execute", "if (search_CAT(\"%%\")!=0) %% is %%; else writeln(\"Invalid table reference\");", "v_string", "v_paras[1]", "v_string"]], ["fail", "error_tblval"]]); error_tblval = ["read_all", [], ["script", ["execute", "writeln(\"Unrecognised table value\");"]]]; error_tblname = ["read_all", [], ["script", ["execute", "writeln(\"Unrecognised table name\");"]]]; /* other error issue addressed 27/10/01 is response to ?select; in eddi: don't invoke showrel(tblname) unless the table name is in the catalogue - modified table_val above is to fix this */ alphanum = ["read_all", [["a", "z"], ["A", "Z"], ["_"], ["0", "9"]], ["fail", "error_ident"]]; error_ident = ["read_all", [], ["script", ["execute", "writeln(\"Unrecognised EDDI identifier\");"]]]; col_name = ident_ex ([["script", ["execute", "%% = \"%%\";", "v_paras[1]", "v_string"]], ["fail", "error_col_name"]]); error_col_name = ["read_all", [], ["script", ["execute", "writeln(\"EDDI: unrecognised column name\");"]]]; col_info = ["pivot", " ", ["col_name", "col_info_2"], ["script", ["declare", "cname", "cdata"], ["setparas", ["cname"], ["cdata"]], ["execute", "%% is [%%, %%];", "v_paras[1]", "cname", "cdata"]], ["fail", "error_col_info"]]; error_col_info = ["read_all", [], ["script", ["execute", "writeln(\"EDDI: unrecognised column for projection\");"]]]; create_state = ["suffix", ")", "create_state_1", ["script", ["declare", "cdata"], ["setparas", ["cdata"]], ["execute", "%% is convertcols (%%);", "v_paras[1]", "cdata"]], ["fail", "error_create_state"]]; error_create_state = ["read_all", [], ["script", ["execute", "writeln(\"EDDI: unrecognised tuple list in table create\");"]]]; ## ## Original file truncate.e (length 1629, dated Oct 29 13:00) follows... ## /* this introduces ~~X; for DROP and ~X; for TRUNCATE */ /* eddi_statement_2 = ["prefix", "~~", "table_name", ["script", ["declare", "relname"], ["setparas", ["relname"]], ["later", "if ((%%[1]!='_') && (search_CAT(%%)>2)) { delrelvar(%%); delete _CATALOGUE, search_CAT(%%);} else {if (search_CAT(%%)==2) writeln (\"Can't delete the catalogue\"); else writeln(\"Table / view name is not in the catalogue\");}", "relname", "relname", "relname", "relname", "relname"], ["execute", "curr_agent=2;"]], ["fail", "eddi_statement_2a"]]; */ eddi_statement_2a = ["prefix", "~", "table_name", ["script", ["declare", "relname"], ["setparas", ["relname"]], ["later", "if ((%%[1]!='_') && (search_CAT(%%)!=0)) {if (CATALOGUE[search_CAT(%%)][2]==\"table\") $$ = [$$[1]]; else writeln(\"Can't truncate a view\");} else writeln(\"Table / view name is not in the catalogue\");", "relname", "relname", "relname", "relname", "relname"],["execute", "curr_agent = 2;"]],["fail", "eddi_statement_3"]]; eddi_statement_2 = ["prefix", "~~", "table_name", ["script", ["declare", "relname"], ["setparas", ["relname"]], ["later", "if ((%%[1]!='_') && (search_CAT(%%)>2) && (dependants(%%)[ 1]==[])) { delrelvar(%%); delete _CATALOGUE, search_CAT(%%);} else {if (search_CAT(%%)==2) writeln (\"Can't delete the catalogue\"); else {if ((search_CAT(%%)>2) && (dependants(%%)[1]!=[])) writeln(\"Cannot delete table / view with dependants\"); else writeln(\"Table / view name is not in the catalogue\");}}", "relname", "relname", "relname", "relname", "relname", "relname", "relname", "relname"], ["execute", "curr_agent=2;"]], ["fail", "eddi_statement_2a"]]; ## ## Original file unnjoin.e (length 957, dated Oct 31 23:22) follows... ## /* this is the SQL style unnatural join that replaces natural join */ func unnjoin { auto i,j,k,x,y,z; if ($#<2) { writeln("EDEN: ERROR: two tables not provided for njoin."); return @; } else if (($1==@) || ($2==@)) { writeln("EDEN: ERROR: njoin has received at least one "// "undefined table."); return @; } tlist1 = []; vals1 = []; vals2 = []; nvals1 = []; nvals2 = []; append tlist1, $1[1]; matcols = matchcols($1,$2); for (i=1; i<=matcols[1]#; i++) { $1[1][matcols[1][i]] = $1[1][matcols[1][i]] // "_1"; $2[1][matcols[2][i]] = $2[1][matcols[2][i]] // "_2"; } /* writeln($1[1]); */ attr = $1[1]; attr[1] = attr[1] // $2[1][1]; /* writeln($2[1]); */ for (i=2; i<=$2[1]#; i++) append attr, $2[1][i]; tlist = [attr]; /* writeln(tlist); */ for (x=2;x<=$1#;x++) for (y=2; y<=$2#; y++) { append tlist, ($1[x] // $2[y]); } return tlist; } ## ## Original file uneddify.e (length 909, dated Nov 1 17:08) follows... ## %eden ## the uneddifying interface func ucompatdomrel { para x,y; return ucompatdom(x,y) && ucompatrel(x,y); } distinctvals = [1,0]; ucompatval = [ucompatdomrel, ucompatdom, ucompatrel]; joinval = ["njoin", "unnjoin"]; /* these descriptive identifiers aren't used except to initialise variables temporarily, but indicate the semantics of the various options for ucompatix etc */ CHECKDOMREL = 1; CHECKDOM = 2; CHECKREL = 3; NODUPROWS = 1; DUPROWS = 2; NATJOIN = 1; UNNATJOIN = 2; ucompatix = CHECKDOMREL; distinctix = NODUPROWS; joinix = NATJOIN; ucompat is ucompatval[ucompatix]; EDDI_distinct is distinctvals[distinctix]; EDDI_join is joinval[joinix]; operators is [[':',"select_wrapper"],['%',"project"],['.',"inter"],['*',EDDI_join],['+',"union"],['-',"diff"]]; rel_exp_5 is op_exp('*', "rel_exp_6"); proc changejoin: joinix { touch(&op_exp); } ## ## Original file ignoreva.e (length 559, dated Nov 29 19:13) follows... ## %eden /* Fix by Ash: Ignore virtual agent statements */ eddi_comment = ["prefix", "##", ["anything"], ["fail", "eddi_virtualagent1"]]; eddi_virtualagent1 = ["prefix", ">>", ["anything"], ["fail", "eddi_virtualagent2"]]; eddi_virtualagent2 = ["prefix", "<>", ["anything"], ["fail", "eddi_virtualagent3"]]; eddi_virtualagent3 = ["prefix", "><", ["anything"], ["fail", "eddi_virtualagent4"]]; eddi_virtualagent4 = ["prefix", "<<", ["anything"], ["fail", "eddi_virtualagent5"]]; eddi_virtualagent5 = ["prefix", ">~", ["anything"], ["fail", "eddi_statement_0"]]; ## ## Original file newaddvals.e (length 730, dated Nov 29 09:25) follows... ## /* this modified version of addvals allows duplicate tuples to be added to a table when EDDI is working in "allow duplicate tuple" evaluation mode */ func addvals /* table2 = addvals(t1,tup1,tup2,...,tupN) */ { auto i; if ($#<1) { writeln("EDEN: ERROR: table not provided for addvals."); return @; } else if ($1==@) { writeln("EDEN: ERROR: addvals has received an "// "undefined table."); return @; } for (i=2; i<=$#; i++) { if ($1[1]#-1 == $[i]#) { if ((notin($1,$[i])==1) || EDDI_distinct==0) append $1,$[i]; else writeln("EDDI/EDEN ERROR: tuple exists already."); } else writeln("EDEN: ERROR: incorrect number of values."); } return $1; } ## ## Original file commafix.e (length 173, dated Feb 27 20:49) follows... ## /* Allows strings to contain commas - fix by Ash 24-2-2002 */ quotes=[["\"", "\""], ["quotes"]]; addblocks("quotes"); tuple_2=["split",",","tuple_3",["ignore",["quotes"]]]; */ ftkeden1.46/lib-tkeden/eden.eden010064400025250000147000000651410755604471700176570ustar00ashleydcsother00003520000005/* * $Id: eden.eden,v 1.3 2002/07/10 19:29:38 cssbz Exp $ */ /*--------------------------------------------------------------------------- function macro(macro_str, para_str1, para_str2, .., para_strN) Expands 'macro_str' by substituting 'para_strI' for "?I" and returns the resultant string (ref.: Edward Yung, M.Sc. thesis, `89, vol.2). ---------------------------------------------------------------------------*/ func macro { auto i, j, l, m, n, c, s; s = ""; l = (m = $1)#; shift; i = 1; while (i <= l) { for (j = i; j <= l && m[j] != '?'; j++); if (i != j) s = s // substr(m, i, j - 1); if (j <= l) { j++; n = (c = (j > l) ? '?' : m[j]) - '0'; s = s // ((1 <= n && n <= $#) ? $[n] : c); } i = j + 1; } return s; } proc installeddi { include(getenv("TKEDEN_LIB")//"/eddi.eden"); } /* symboldefinition returns the Eden definition of a symbol s in a form that can be given to the Eden parser (via execute(), todo() etc), whatever the type of symbol s. It will return a blank string when asked for the definition of a builtin function (since there is no meaningful Eden code representation of the function). This function is intended to fix problems with the data returned by symboldetail() etc. Pass symboldefinition a string naming the symbol or a pointer to the symbol. */ func symboldefinition { para s; auto sd, ret; /* convert s to a pointer if it is not already */ if (type(s) == "string") s = &`s`; else if (type(s) != "pointer") error("address or symbol name needed (got "//type(s)//")"); sd = symboldetail(s); switch (sd[2]) { case "var": if (type(*s) == "string") ret = nameof(s) // "=\"" // str(*s) // "\";"; else ret = nameof(s) // "=" // str(*s) // ";"; break; case "formula": ret = nameof(s) // " is" // sd[3]; break; case "proc": ret = "proc " // nameof(s) // " " // sd[3] // ";"; break; case "procmacro": ret = "procmacro " // nameof(s) // " " // sd[3] // ";"; break; case "func": ret = "func " // nameof(s) // " " // sd[3] // ";"; break; case "builtin": case "Real-func": case "C-func": ret = ""; break; } return ret; } /* this copies a proc to a new name. copy("rot", "rotnew"); copies the definition of proc rot to proc rotnew. */ proc copyproc { para old, new; execute("proc " // new // " " // symboltext(old) // ";"); } /* this adjusts the definition of a proc so that, when called, the parameters and, optionally, return result are printed. showpara("rot", 1) causes proc rot to show its parameters when called. */ proc showpara { para p, showret; copy(p, p // "_preshowpara"); execute(macro(" proc ?1 { auto ret; write(\"?1: \", $, \"...\"); ret=apply(?1_preshowpara, $); if (?2) writeln(ret); return ret; }; ", str(p), str(showret))); } /* Make a real value into an integer with rounding. (by Chris Roe) */ func round { para r; if (r-int(r)>=0.5) return int(r)+1; else return int(r); } /* The following are some eden primitive functions */ /* Chris Roe - May 2002 */ /* Each function has a header comment to explain its usage and an example */ /* max returns the maximum of the parameters it is passed. e.g max(1,2)=2, max(1,2,3,4,5,6) = 6. */ func max { auto result,i,data; if (type($[1])=="list") {data= $[1];} else {data = $;} result = data[1]; for (i=1; i<=data#; i++) { if (data[i]>result) {result = data[i];} } return result; } /* min returns the minimum of the parameters it is passed. e.g min(1,2)=1, min(3,4,5,6) = 3 */ func min { auto result,i,data; if (type($[1])=="list") {data= $[1];} else {data = $;} result = data[1]; for (i=1; i<=data#; i++) { if (data[i]=0) {return num;} else {return -num;} } /* nthroot returns the nth root of the number it is passed and the root it is asked for. e.g nthroot(4,2)=2, nthroot(81,4)=3 */ /* there may be some problems with this .. e.g nthroot(1028,10) should = 2 but actually comes out as 2.0000789 etc */ func nthroot { para num, root; return pow(num,1.0/root); } /* factorial returns the factorial of the number it is passed. Only works with integers.. e.g factorial(4)=24, */ func factorial { para num; auto i,result; if ((type(num)!="int")||(num<0)) {return @;} if (num==0) {return 1;} result = 1; for (i=1; i<=num; i++) { result = result * i; } return result; } /* product returns the product of the parameters it is passed. Only works with numbers... e.g product(2,3)=6, product(4,7,2)= 56 */ func product { auto i,result,data; if (type($[1])=="list") {data= $[1];} else {data = $;} result = 1; for (i=1; i<=data#; i++) { if ((type(data[i])!="int")&&(type(data[i])!="float")) {return @;} result = result * data[i]; } return result; } /* sign returns -1 if the number passed is -ve, 0 if it is 0 and 1 if it is +ve e.g sign(4)=1, sign(-230.2323)= -1 */ func sign { para num; if (num<0) {return -1;} if (num>0) {return 1;} return 0; } /* even returns the nearest even number to the number given. negative numbers are adjusted away from zero. e.g even(4.5)=4, even(5.5)=6*/ func even { para num; /* e.g 4.5 .. int(4.5) = 4, 4%2=0.. so 4 closest even number */ if (int(num) % 2 == 0) {return int(num);} /* otherwise got to be odd and closer to the next even number which will be +1 */ /* use sign for -ve numbers which will have % result of -1.. try writeln(int(-3.2)%2); */ return int(num)+sign(num); } /* even returns the nearest odd number to the number given. negative numbers are adjusted away from zero. e.g odd(4.5)=5, odd(3.5)=3*/ func odd { para num; /* if its closest to an even number, return num+sign(num), i.e the nearest odd */ if (int(num) % 2 == 0) { return int(num)+sign(num); } /* otherwise int is already odd so return that.. */ return int(num); } /* mround returns the number rounded to the nearest multiple.. e.g mround(62,6)=60 */ func mround { para num,multiple; /* need to force floating point division */ return sign(num)*round(float(abs(num))/multiple)*multiple; } /* sumsq returns the sum of the squares of the parameters passed to it, e.g sumsq(2,3,4) = 29 */ func sumsq { auto i, result,data; if (type($[1])=="list") {data= $[1];} else {data = $;} result = 0; for (i=1; i<=data#; i++) { if ((type(data[i])!="int")&&(type(data[i])!="float")) {return @;} result = result + (data[i]*data[i]); } return result; } /* trunc returns the number with the fractional part removed. this is the same as the int function in eden - included for completeness.. e.g trunc(4.56)=4 */ func trunc { return int($[1]); } /* combin returns the number of ways n items can be picked from a total number of items. the n cannot be more than the total.. e.g combin(4,2)=6 */ func combin { para total,n; if (n>total) {return @;} return factorial(total)/(factorial(n)*factorial(total-n)); } /* ceiling returns the number rounded *up* to the nearest multiple of significance, e.g ceiling(62,6)=66 */ func ceiling { para num, multiple; /* i.e the case that matches mround() */ if (mround(num,multiple)>=((float(num)/multiple)*multiple)) { return mround(num,multiple); } /* otherwise if mround rounds down, add the multiple to it */ return mround(num,multiple)+multiple; } /* floor returns the number rounded *down* to the nearest multiple of significance, e.g floor(64,6)=60 */ func floor { para num, multiple; /* i.e the case that matches mround() */ if (mround(num,multiple)<=((num/multiple)*multiple)) { return mround(num,multiple); } /* otherwise if mround rounds down, add the multiple to it */ return mround(num,multiple)-multiple; } /* degrees takes an angle in radians and converts it to degrees, e.g degrees(PI)=180 */ func degrees { para angleinradians; return (angleinradians * (180/PI)) - (trunc((angleinradians * (180/PI))/360)*360) ; } /* radians takes an angle in degrees and converts it to radians, e.g radians(180)=3.14 etc */ /*NOTE - see degrees for implementational issue */ func radians { para angleindegrees; return (angleindegrees / (180/PI)) - (trunc((angleindegrees / ((180/PI))/(2*PI)))*(2*PI)); } /* rounddigits takes a number and rounds it to the number of digits specified.. e.g round(123,2) = 120, round(123,1) = 100, round(123.232,4)=123.2 */ func rounddigits { para num,digits; auto intpart,fracpart,numdigits; auto negative; negative = sign(num); if (sign(num)==-1) {num = -num;} intpart = int(num); fracpart = num-int(num); numintdigits = ceiling(log10(num),1); /* no fractional part - and more digits specified than in num, e.g round(123,4)=123 */ if ((fracpart==0)&&(pow(10,digits-1)>num)) {return num*negative;} /* if the number has a fractional part but the number of digits required is less than this, i.e rounddigits(123.56767,2) we can ignore the fraction. Note that we cannot ignore the fraction if the same.. e.g rounddigits(123.8,3)=129... */ if (ceiling(log10(num),1)>digits) {num = int(num);} if ((pow(10,digits-1) <= num) ) { /*i.e we are returning an integer */ if ((num % (int(pow(10,numintdigits-digits)))) < (pow(10,numintdigits-digits)/2)) { /* pow and % used to return the values */ return (num - num % (int(pow(10,numintdigits-digits))))*negative; } else { return (num - num % (int(pow(10,numintdigits-digits))) + pow(10,numintdigits-digits))*negative; } } /* otherwise we've got a real number to deal with */ /* sorts out case when e.g rounddigits(123.8,3) or rounddigits(1234.4,4).. */ if (ceiling(log10(num),1)==digits) {return round(num)*negative;} /* otherwise the answer will also be a real number and we have a real number.. */ return (intpart +round(fracpart*pow(10,digits-numintdigits))* (pow(10,-(digits-numintdigits))))*negative; } /* more eden primitive functions - 2nd may 2002, chris roe */ /* gcd takes numeric parameters and returns their greatest common divisor. any number of numbers can be passed.. e.g gcd(2,6)=2, gcd(6,9,24)=3, gcd(3,7,24,28)=1 */ func gcd { auto n1,n2,data,temp; if (type($[1])=="list") {data = $[1];} else {data = $;} while (data#>2) { temp = gcd(data[1],data[2]); data[2] = temp; delete data,1; } n1 = data[1]; n2 = data[2]; /* now have 2 numbers.. n1 & n2.. can compute gcd directly */ /* use euclid's algorithm.. */ r = 1; while (r>0) { /* ensure n1>n2 by swapping if neccessary */ if (n2>n1) {temp = n2; n2 = n1; n1 = temp;} r = n1 % n2; if (r==0) {return n2;} n1 = r; } return min(n1,n2); } /* lcm takes numeric parameters and returns the lowest common multiple of them.. e.g lcm(8,12)=24, lcm(4,6,8)=24. Note - use the fact that gcd(a,b)*lcm(a,b)=a*b for all a and b integers... see maths textbook for a proof!! */ func lcm { auto n1,n2,data,temp; if (type($[1])=="list") {data = $[1];} else {data = $;} while (data#>2) { temp = lcm(data[1],data[2]); data[2] = temp; delete data,1; } n1 = data[1]; n2 = data[2]; /* now assume have 2 numbers, n1 & n2.. can compute lcm directly */ return (n1*n2)/gcd(n1,n2); } /* variance takes and calculates the variance, i.e the sum of the deviations between each element and the mean divided by the number of data points. It can cope with either a number of numeric parameters passed to it, or a list containing numbers... e.g variance(23,34,46,2343) or variance(b) where b=[432,43,56,78] etc */ func variance { auto avg,data,i,result; if (type($[1])=="list") {data = $[1];} else {data = $;} /* data now contains a list of numbers */ avg = average(data); result = 0; for (i=1; i<=data#; i++) { result = result + ((data[i]-avg)*(data[i]-avg)); } return float(result) / data#; } /* stdev takes a list of numbers or numeric parameters and returns the standard deviation, or the square root of the variance... e.g stdev(23,45,67) or stdev(b) where b=[3,4,5,9] */ func stdev { auto data; if (type($[1])=="list") {data = $[1];} else {data = $;} return sqrt(variance(data)); } /* given a list of numbers, sorts them into ascending or descending order... */ /* uses bubble sort! improve sorting algorithm... */ /* 1 = ascending, 2 = descending */ func sort { para l,dir; auto i,j,result,temp,swap,ascending,descending; ascending = 1; descending = 2; swap = 1; while (swap>0) { swap = 0; for (i=1; i<=l#-1; i++) { if ( ((dir==ascending)&&(l[i]>l[i+1])) || ((dir==descending)&&(l[i]255)||(greenval>255)||(blueval>255)) error("colour out of range"); /* round to nearest integer - need to have each component as a strict 2 +character length hex number - can't deal with real numbers directly, and don't need to? */ redval = round(redval); greenval = round(greenval); blueval = round(blueval); /* use the c func to get the string back */ s = ""; sprintf(s,"#%02x%02x%02x",redval,greenval,blueval); return s; } /* English spelling of rgb2color */ func rgb2colour { return apply(rgb2color, $); } /* Install the Arca notation */ proc installarca { include(getenv("TKEDEN_LIB")//"/arca.eden"); } /* Install the Eden Symbol Lists notation */ proc installedensl { include(getenv("TKEDEN_LIB")//"/edensl.eden"); } /* Install the Denota notation */ proc installdenota { auto d; d = cwd(); /* store the current working directory so we can restore it */ cd("/dcs/emp/empublic/projects/denotaMeziani1987/lib"); include("init.e"); cd(d); installIPTrans("%denota", "/dcs/emp/empublic/bin/denota"); } /* notations is a list of lists holding parameters required to implement any notations using translators. notations holds one list per notation. Each sublist contains three elements: 1: name of the notation (including initial '%' character) 2: pointer to the procedure to call when the user switches to this notation. No arguments are provided when this procedure is called, but it may use the value of currentNotation to determine which notation is in effect if this procedure is serving more than one notation, for example. 3: pointer to the procedure to call when the user provides input in this notation. This "parseChar" procedure is called once for each character provided, with the char as the sole argument. This procedure is called one character at a time so that it can implement any necessary form of blocking (eg parse one line at a time, or parse one statement at a time, where statements are ended with a ';'). currentNotation is an index into notations, or -1 meaning that the current notation is implemented in some other way. */ notations = []; eden_debug_notations = 0; /* newNotation: call this with three parameters to install a new notation or redefine an existing one. Parameters are: name: name of the new or existing notation, starting with the '%' character switchProcPtr: a pointer to the procedure to call when the user switches to this notation. transProcPtr: a pointer to the procedure to call when the user provides input in this notation. (see the comment for the "notations" list for more detail). Returns the index into the notations list for this notation. */ proc newNotation { para name, switchProcPtr, transProcPtr; auto i, si; if (name[1] != '%') error("notation names must start with %"); si = -1; /* searching index */ for (i = 1; i <= notations#; i++) { if (name == notations[i][1]) { si = i; break; } } if (si == -1) { /* a new notation: add a dummy entry which will be overwritten below */ append notations, [1, 2, 3]; si = notations#; /* add a radio button for the new notation, but not in ttyeden */ if (tcl != @) tcl("addNotationRadioButton " // substr(name, 2, name#)); } notations[si][1] = name; notations[si][2] = switchProcPtr; notations[si][3] = transProcPtr; return si; } currentNotation = -1; /* notationSwitch: is called when the current notation is changed using the % notation. This is passed the string starting % which describes the new notation. It should return 1 if the new notation is recognised and can be interpreted, 0 otherwise. This is called on every notation change, so the end of a block of script in a certain notation can be detected by the call to notationSwitch into the next notation at the end. */ proc notationSwitch { para name; auto found, i; currentNotation = -1; for (i = 1; i <= notations#; i++) { if (name == notations[i][1]) { currentNotation = i; /* call setup procedure */ (*(notations[i][2]))(); break; } } if (eden_debug_notations) writeln("notationSwitch " // name // " = " // str(currentNotation)); return (currentNotation != -1); } /* notationStack: Eden's execute() and include() commands cause the Eden interpreter to interpret a string. The string may contain a notation switch command, but after the string has been interpreted, the notation context is expected to be restored. I originally thought that the C "entryStack" structure in main.c was handling this, but that code seems to be doing something more complex. So, here, I represent the stack of interpreter notation contexts in an Eden list. Each element is an index into the notations list. The buffers of the current parser are not stored and restored. This means that: 1) a parser cannot reenter itself during a call to its "parseChar" function by using execute("%self\nstuff") or by include()-ing a file which contains code written in the notation implemented by the parser. 2) buffers should not be shared between notations. Note the implementation of the IP translator below, which holds a list of buffers, one for each notation implemented. Note the AOP translator will probably not cope with a reentrant call as it uses only one buffer (meaning that AOP-implemented notations cannot be used within the implementation of another AOP notation). */ notationStack = []; /* notationPushPop: is called just before and just after another instance of the Eden interpreter is started during a call to execute() or include(). The procedure needs to push the current notation context onto the notationStack just before the call, and pop it off just after, and notationPushPop is passed "1" or "-1" to indicate whether we are just before or just after respectively. */ proc notationPushPop { para direction; switch (direction) { case "1": insert notationStack, 1, currentNotation; if (eden_debug_notations) writeln("notationPushPop: PUSH " // str(currentNotation) // " NOW " // str(notationStack)); break; case "-1": if (notationStack# <= 0) error("can't pop an empty notationStack"); currentNotation = notationStack[1]; delete notationStack, 1; if (eden_debug_notations) writeln("notationPushPop: POP " // str(currentNotation) // " NOW " // str(notationStack)); break; default: error("bad direction " // direction // " passed to notationPushPop"); } } /* notationGet: called to obtain the name (including %) of the current notation, for use in the prompt. */ func notationGet { if ((currentNotation == -1) || (currentNotation > notations#)) error("notationGet called when currentNotation is not set sensibly (" // str(currentNotation) // ")"); return notations[currentNotation][1]; } /* notationChar: when a recognised notation is being interpreted (after notationSwitch has returned 1), this is given the script text, one character at a time. It should interpret the text, possibly maintain internal state, and use "execute" to create Eden state. */ proc notationChar { para c; auto i; if (eden_debug_notations) writeln("notationChar " // c // " (currentNotation = " // str(currentNotation) // ")"); if ((currentNotation == -1) || (currentNotation > notations#)) error("notationChar called when currentNotation is not set sensibly (" // str(currentNotation) // ")"); /* call the current notation's parseChar procedure */ (*(notations[currentNotation][3]))(c); } /* IP (Interactive Process) -based translators */ /* the indexes in iptfds and iptbufs should correspond to the notations list, so blank entries will be required if there are non-IP notations present. */ iptfds = []; iptbufs = []; proc ipTransSwitch { /* this should actually be unnecessary as it isn't possible to change notations without using a line feed, and so the previous ipParseChar should have cleared the buffer already. We'll do it for safety anyway. */ iptbufs[currentNotation] = ""; } proc ipTransParseChar { para c; auto l, r, w, e; if ((currentNotation < 1) || (currentNotation > iptfds#)) error("ipParseChar called when a non-IP notation is in effect"); l = iptfds[currentNotation]; if (l# != 3) error("wrong number of fds in iptfds for " // notations[currentNotation] // " notation " // "- was the IP translator opened?"); r = l[1]; w = l[2]; e = l[3]; iptbufs[currentNotation] = iptbufs[currentNotation] // c; if (c == '\n') { rawwrite(w, iptbufs[currentNotation]); out = ""; /* have to pause for a short while even if there appears to be no input as the concurrent translator might just be being slow -- there is no way of telling when the current input has finished (hand shaking) in this simple scheme */ while (fdready(r, 'r', [1, 0])) { out = out // rawread(r, 255); } if (fdready(e, 'r', [0, 0])) { error("<" // rawread(e, 255) // ">"); } if (eden_debug_notations) writeln("<" // notations[currentNotation][1] // ": " // out // ">"); execute(out); iptbufs[currentNotation] = ""; } } /* installIPTrans: call this to install an Interactive Process -based translator. Two arguments are required: name: name of the new notation, starting with the '%' character. This procedure should be able to cope with a change to an existing ip-based translator, but I doubt it does correctly at present. path: complete path to the external translator program which will be started up as a concurrent interactive process. User input in this new notation will be given to stdin of the process. Output from the process on stdout should be Eden code, which will be execute()'d. Output from the process on stderr is assumed to be an error message, which will have the same effect as normal errors. */ proc installIPTrans { para name, path; auto ni; ni = newNotation(name, &ipTransSwitch, &ipTransParseChar); while (ni > iptfds#) append iptfds, ""; while (ni > iptbufs#) append iptbufs, ""; iptfds[ni] = ipopen(path, basename(path)); iptbufs[ni] = ""; } /* Chris Brown's agent-oriented parser (AOP) */ include(getenv("TKEDEN_LIB")//"/trans.eden"); /* this list holds the 'info' information required for AOP translators. The indexes should correspond to the notations list, so blank entries will be required if there are non-AOP notations present. */ aopinfos = []; /* installlAOP: install an agent-oriented parser. This replaces Chris Brown's original 'notation' command. Two arguments are required: name: name of the new notation. This should include the initial '%' character (this is different to Chris Brown's original notation command, for consistency with the generic framework above). info: the name of an Eden list symbol which describes the chunking (or blocking) to be used when parsing this notation and the first agent statement to be used. */ proc installAOP { para name, info; auto ni; ni = newNotation(name, &aopSwitch, &aopParseChar); while (ni > aopinfos#) append aopinfos, ""; aopinfos[ni] = info; } proc aopSwitch { flush_parser(); setup_parser(aopinfos[currentNotation]); } proc aopParseChar { para c; parsechar(c); } /* notation used to be a built-in procedure, written by Chris Brown in C. Really we should fix the models to use the new installAOP proc above, but leave this here for a while... */ proc notation { para namenopercent, info; installAOP("%" // namenopercent, info); } /* remove a radio button for the new notation, but not in ttyeden. Pass the name of a notation, including the initial % character. */ proc removeNotationRadioButton { para name; if (name[1] != '%') error("removeNotationRadioButton should be passed a string starting with %"); if (tcl != @) tcl("removeNotationRadioButton " // substr(name, 2, name#)); } ended with a ';'). currentNotation is an index into notations, or -1 meaning that the current notation is implemented in some other way. */ notations = []; eden_debug_notations = 0; /* newNotation: call this with three parameters to install a new notation or redefine an existing one. Parameters are: name: name of the new or existing notation, starting with the '%' character switchPrtkeden1.46/lib-tkeden/eden.txt010064400025250000147000000426300755553424500175600ustar00ashleydcsother00003520000005---------- EDEN (Evaluator of DEfinitive Notations) QUICK REFERENCE ---------- Parts of syntax which are !@Ooptional are shown like this!@P CONTENTS OF THIS QUICK REFERENCE: 1. C-like syntax 2. Data types 3. Operators 4. Procedural statements 5. User-defined functions, procedures, actions... 6. Pre-defined variables 7. Pre-defined functions and procedures 8. C-library functions and procedures 9. Writing a clock 10. More information -- 1. C-LIKE SYNTAX ---------------------------------------------------------- Statements are followed by the semi-colon; /* Multi-line C-style comments /* ...although note they may nest in Eden */ */ ## one-line comments start with two hash characters Assignment: v = 1; Definition: a is f(b, c); Function: func square { return $1*$1; } Procedure: proc inc_a { a++; } Action: proc print : q { writeln("q is ", q); } Name space: can access Scout variables directly. to access Donald variables, prepend an underscore _ Variable declaration is not required or possible. Redeclaration of type is automatic. -- 2. DATA TYPES ------------------------------------------------------------- Undefined: @ Integer: 123, 018 (octal), 0xAB (hex) Character: 'A', '\n', '\009' Floating point: 1.23e-15 String: s = "this is a string" s[1] is the first character of the string s. Pointer: ip = &int_variable * dereferences a pointer: *ip == int_variable List: L = [ 100, 'a', "string", [1,2,3] ] L[1] is the first item of L. L[4][2] is the second item in the fourth item of L. L# is the length of list L. L // M is the concatenation of L and M. See also append, insert, delete and shift. -- 3. OPERATORS -------------------------------------------------------------- Strict: Returns @ if an operand is @ Lazy: Leaves the second operand unevaluated if it is unnecessary Eager: Always evaluates both operands Arithmetic (strict): + - (difference and unary) * / % (remainder) Relational: < > <= >= Equality: == != Logical (lazy): && || ! Logical (eager): and or not Bitwise (eager): bitand bitor Conditional: cond ? iftrue : iffalseor@ Assignment: = += -= Prefix assignment: ++lvalue --lvalue Postfix assignment: lvalue++ lvalue-- Indirection: a=1; r="a"; v=`r`; Now v == 1 (note: there are problems with use of indirection on the RHS of a definition). Type casting is implemented through functions: see int(), char() etc below. -- 4. PROCEDURAL STATEMENTS -------------------------------------------------- Compound statements: { statement; !@Ostatements...!@P } insert list, position, value; (note: - no brackets - these are not functions append list, value; - they operate only only lists, not delete list, position; strings) shift !@Olist!@P; (shift with no argument deletes the first item from $) if (expression) statement !@Oelse statement!@P while (expression) statement do statement while (expression); for (!@Oinitialisation!@P; !@Opre-iteration-test!@P; !@Opost-statement!@P) statement switch (expression) { case constant: statement; !@Odefault statement;!@P } break; causes termination of the smallest enclosing while, do, for, switch continue; causes continuation of smallest enclosing while, do, for return !@Oexpression!@P; Null statement: ; Dependency link: identifier ~> [ !@Oidentifier_list!@P ]; Query: ?lvalue; Value freezing: eval(sym): takes the value of sym at definition entry time (note this is at proc definition time if eval is used within a proc). -- 5. USER-DEFINED FUNCTIONS, PROCEDURES, ACTIONS... ------------------------- func identifier { !@Opara id_list;!@P !@Oauto id_list;!@P !@Ostatements...!@P } proc identifier !@O: id_list!@P { !@Opara id_list;!@P !@Oauto id_list;!@P !@Ostatements...!@P } procmacro identifier { !@Opara id_list;!@P !@Oauto id_list;!@P !@Ostatements...!@P } $ is the argument list of a function. $3 is the third argument. $[n] is the n-th argument. Function call: four = square(2); -- 6. PRE-DEFINED VARIABLES -------------------------------------------------- stdin: standard input. stdout: standard output. stderr: standard error. autocalc: whether Eden automatically recalculates formula definitions. _tkeden_showxoutput: whether to show info sent to Tcl for debugging purposes (see also debug(128)). eden_error_index_range: whether to generate an error or @ when referencing outside an array. eden_notice_undef_reference: whether to give notices about references to undefined values. eden_debug_notations: whether the notation-handling Eden code should give debugging output tkeden_vbfeatures: whether to implement "VB-like features" in Scout (eg mouseClick observables). These features are not recommended for use in new models. PI: ratio of circle circumference to diameter (note lower case pi in DoNaLD). -- 7. PRE-DEFINED FUNCTIONS AND PROCEDURES ----------------------------------- write(args...): print arguments on stdout. writeln(args...): print arguments on stdout, appending a newline (\n). type(data): returns the type of data as a string. int(data): returns data after cast to integer type. char(data): returns data after cast to character type. str(data): returns data after cast to character type. float(data): returns data after cast to floating point type. substr(string, from, to): returns a substring of string. strcat(strings...): returns the string concatenation of its arguments. nameof(pointer): returns the name of the symbol to which the pointer points. sublist(list, from, to): returns a sublist of list. listcat(lists...): returns the list concatenation of its arguments. array(size, data): returns a list constructed from data items, of length size. time(): returns the current time in seconds since Jan 1, 1970. ftime(): returns the current time in [second, milli] form. gettime(): returns the current time in [second, minute, hour, day of month, month of year, year, day of week] form. apply(function, list): calls function with list as argument. execute(string): executes string as Eden statements. todo(string): will execute string as Eden statements after current evaluation terminates. include(string!@O, string...!@P): executes the contents of the named file(s) as Eden statements. cd(string): changes the current working directory. cwd(): returns the current working directory. dirname(string): returns the containing directory of a given filepath. basename(string): returns the filename (leafname) of a given filepath. exit(status): terminates the program, returning status as exit status. forget(string): attempts to remove the named variable from the symbol table. Returns 0 for OK, 1 for not found, 2 for failure. forget(pointer): attempts to remove the pointed-to variable from the symbol table. Returns 0 for OK, 2 for failure (1 is not possible). eager(): evaluate all out of date formula variables and actions now, update the screen, whatever the state of autocalc. touch(pointers...): put the targets of the pointed to variables on the evaluation queue. formula_list(): returns list of pointers to queued formula variables. action_list(): returns list of pointers to queued actions. symboltable(): returns the current symbol table as a list of lists. symbols(string): returns a list of symbols from the symbol table which are of the specified type. symboldetail(string): returns a list of information about the named symbol. symboldetail(pointer): returns a list of information about the named symbol. symboltext(string): returns the original text used when defining a symbol. symboltext(pointer): returns the original text used when defining a symbol. symboldefinition(string): returns a symbol in Eden-interpretable form. symboldefinition(pointer): returns a symbol in Eden-interpretable form. getenv(env): returns the string contents of the environment variable env. putenv(env): set environment variable: env should have the form "name=value". error(message): generate an Eden error. error_no(): returns the last system (not Eden) error number. backgnd(path, cmd, arg1, arg2...): executes a process in the background. pipe(path, cmd, arg1, arg2...): pipes stdout to the process given by path. get_msgq(key flag): gets a message queue. remove_msgq(msgqid): removes a message from the message queue msgqid. send_msg(msgid, [msg_type, msg_text], flag): send a message on a message queue. receive_msg(msgqid, msg_type, flag): receive a message from a message queue. installAOP(notation, agentname): install a new Agent-Oriented Parser notation. notation string must include the initial % character. This function replaces the old "notation" built-in: replace notation("eddi", "eddi_notation"); with installAOP("%eddi", "eddi_notation"); newNotation(name, switchProcPtr, transProcPtr): install a new notation. installIPTrans(name, path): install a new Interactive Process -based translator. removeNotationRadioButton(notation): removes a notation radio button from the tkeden interface. Pass the name of a notation, including the initial % character. installeddi(): install the EDDI notation. installarca(): install the ARCA notation. installdenota(): install the DENOTA notation. installedensl(): install the EdenSL notation. macro(s, para1, para2, ..., paraN): substitute ?1 in s with para1, ?2 with para2 etc and return the result. copyproc(oldname, newname): copy a proc to a new name. showpara(procname, showret): adjust the definition of a proc so that, when called, the parameters and, optionally, return result are printed. (Superseded for most purposes by debug(512)). round(r): make a real value into an integer with rounding. max(number, ...) or max([list of numbers]) : returns the maximum of the numbers. min(number, ...) or min([list of numbers]) : returns the minimum of the numbers. sum(number, ...) or sum([list of numbers]) : returns the sum of the numbers. abs(number) : returns number if > 0, otherwise returns -number (e.g abs(-7)=7). average(number, ...) or average([list of numbers]) : returns the average of the numbers. nthroot(number, n) : returns the n'th root of the number given. factorial(number) : returns the factorial of the number given. product(number, ... ) : returns the numbers passed multiplied together. sign(number) : returns -1 if number is < 0, 0 if number = 0, 1 if number > 0. even(number) : returns the nearest even number to the number given. odd(number) : returns the nearest odd number to the number given. mround(number, multiple) : returns the number rounded to the nearest multiple of the given multiple (e.g mround(62,6)=60). sumsq(number, .. ) or sumsq([list of numbers]) : returns the sum of the squares of the numbers passed. trunc(number) : returns the integer part of the number given. combin(total, n) : returns the number of ways n numbers can be picked from total number of items. ceiling(number, multiple) : returns the number rounded to the nearest multiple of the given multiple that is greater than the number. floor(number, multiple) : returns the number rounded to the nearest multiple of the given multiple that is lower than the number. degrees(angle) : returns an angle given in radians with its equivalent in degrees in a range 0-360. radians(angle) : returns an angle given in degrees with its equivalent in radians in a range 0-2*PI. rounddigits(number, digits) : returns the number rounded to the specified number of digits (e.g rounddigits(123.45,2)=120). gcd(number, ...) or gcd([list of numbers]) : returns the largest number which will divide exactly into all the numbers passed. lcm(number, ...) or lcm([list of numbers]) : returns the smallest number that all the numbers passed will divide exactly into it. variance(number, ...) or variance([list of numbers]) : returns the variance of the numbers passed or the list of numbers passed to it. stdev(number, ...) or stdev([list of numbers]) : returns the standard deviation of the numbers passed or the list of numbers passed to it. sort([list of numbers], direction) : returns the list of numbers sorted. the direction parameter should be 1 to return an ascending list, 2 to return a descending list. median([list of numbers]) : returns the median element of a list of elements, those elements do not need to be in any sorted order. randomise() : seeds the random number generator with a random number. rnd(number) : returns a random number between 0 and the number. Note that both 0 and number are included in the range. rgb2color(r, g, b): takes values in range 0-255 and returns a colour reference (which should be treated as opaque) to be used in SCOUT/DoNaLD. rgb2colour(r, g, b): same as rgb2color. ipopen(path, cmd, arg1, arg2...): creates a concurrent interactive process, returning a list [rfd, wfd, efd] of stdin, stdout, stderr file descriptors. ipclose([rfd, wfd, efd]): terminates the process created with ipopen. fdready(fd, type, [sec, milli]): returns non-zero if the file descriptor can be read from, written to, or has an exception, depending on the second argument, which should be 'r', 'w' or 'e'. Will block for the time stated in third argument (which can be zero), or indefinately until the necessary condition is achieved if the third argument is @. rawread(fd, maxbytes): returns a string, maximum maxbytes long, read from the file descriptor fd, with no file buffering. rawwrite(fd, string): writes string to the file descriptor, with no file buffering. regmatch(pattern, subject): returns a list of subpatterns in the first match found by the (Perl-compatible) regular expression pattern in subject. The first subpattern is the entire match. regreplace(pattern, replacement, subject!@O, limit!@P): replaces the matches found by pattern in subject with replacement. The optional limit sets the number of replacements that are made. replacement can contain references to parenthesised subpatterns in pattern, in the form "$n" (0<=n<=99). A literal $ can be achieved by escaping it: "\\$" (note the need to escape the backslash in an Eden string). -- 8. C-LIBRARY FUNCTIONS AND PROCEDURES ------------------------------------- (see their man pages for more detail) fopen(filename, mode): opens a file, returning the fileid or 0 on error. fclose(fileid): closes a file stream. fgetc(fileid): gets and returns a character from a file stream. fgets(n, fileid): returns a string (max n characters) read from a file stream and @ when end of file has been reached. fscanf(fileid, format, &out1, &out2...): formatted read from the input stream. gets(): returns a string read from stdin. ungetc(c, fileid): pushes the character back onto the input stream fileid. fprintf(fileid, format, args...): prints a formatted string to a file stream. fputc(char, fileid): prints a character to a file stream. pclose(fileid): close a pipe. popen(command, mode): open a pipe, returning fileid. putw(w, fileid): puts a machine word to a file stream. setbuf(fileid, buf): set the buffer size of a file. sprintf(&s, format, args...): formatted print to a string (warning: s must first be initialised to a string of appropriate length). sscanf(&s, format, &out1, &out2...): formatted read from string s. system(string): execute command in a sub-shell. stat(filename): returns a list of information about the named file: UID, GID, size, times of last access, data modification, file status change. srand(seed): seed the random number generator. rand(): return a random number (range is system dependent). sin(float): returns the sine of its (radians) argument. cos(float): returns the cosine of its (radians) argument. tan(float): returns the tangent of its (radians) argument. asin(float): returns the principle arcsine of its (radians) argument. acos(float): returns the principle arccosine of its (radians) argument. atan(float): returns the principle arctangent of its (radians) argument. atan2(y, x): returns the principle value of the arctangent of y/x (floats). sqrt(float): returns the square root of its argument. pow(x, y): returns the value of x raised to the power y (floats). log(float): returns the natural logarithm of its argument (which must be +ve). log10(float): returns the logarithm to base 10 of its argument. exp(float): returns the exponential (pow(e,x)) of its argument. ... the above always return a float, even if all arguments are ints debug(status): sets the interpreter debugging mode. Add these values to form the parameter: 1: various 2: RunSet (inc todo()) debugging 4: Eden parser debugging (=yydebug) 8: Sasami 16: Donald 32: Scout parser debugging (=st_debug) 64: malloc debugging (emalloc macro) 128: Tcl_Eval debugging 256: execute debugging 512: func / proc / procmacro call debugging 1024: VMWRIT debugging (in 1 also) 2048: Donald parser debugging (=dd_debug) 4096: Print errors on stderr as well as the error window. 8192: regular expression debugging 16384: notation debugging trace(): prints a stack trace of proc/func calls made on stderr. pack(data...): stores data in a newly allocated memory space on the heap. ... there may be more built-in functions and procedures depending upon the Eden variant you are using. -- 9. WRITING A CLOCK -------------------------------------------------------- proc clocking : clock { /* a clocking process */ todo("clock++;"); /* increment clock after current evaluation finishes */ } proc device1 : clock { /* action synchronised by the clock */ ... /* action body */ } proc device2 : clock { ... /* action body */ } -- 10. MORE INFORMATION ------------------------------------------------------ See the full manual available at http://www.dcs.warwick.ac.uk/modelling/ for more detail. original text used when defining a symbol. symboldefinition(string): returns a symbol in Eden-interprettkeden1.46/lib-tkeden/edenio.tcl010064400025250000147000001375450755621536700200670ustar00ashleydcsother00003520000005# $Id: edenio.tcl,v 1.24 2002/07/10 19:31:18 cssbz Exp $ # # [Ben] Only use focusfollowsmouse on Unix, as on Win32 this is non-standard # behaviour and will confuse users if {$_tkeden_win32_version == "0.0"} { tk_focusFollowsMouse } if {$_tkeden_variant == "dtkeden"} { if {$_dtkeden_isServer} { set variantversion "dtkeden $_tkeden_version (server)" } else { set variantversion "dtkeden $_tkeden_version (client)" } } else { # tkeden set variantversion "tkeden $_tkeden_version" } wm title . "$variantversion: Input" set radiosBg grey60 set radiosButtonBg grey50 frame .radios -background $radiosBg -borderwidth 0 button .radios.accept -text "Accept" -underline 0 \ -background $radiosButtonBg -command {accept} pack .radios.accept -side left if {$_tkeden_variant == "dtkeden"} { if {$_dtkeden_isServer} { button .radios.send -text "Send" -underline 0 \ -background $radiosButtonBg -command {selectClients} } else { button .radios.send -text "Send" -underline 0 \ -background $radiosButtonBg -command { set text [.text get 1.0 end] set text [string trim $text] if {$text != ""} { set errCode [catch {.menu.accept invoke} string] sendServer $text } } } pack .radios.send -side left } set notation "%eden" proc addNotationRadioButton {notation} { global radiosBg # Tk widgets must start with a lowercase letter set widget ".radios.[string tolower $notation]" # Ignore errors that occur if the radiobutton is already defined catch { radiobutton $widget -variable notation \ -highlightbackground $radiosBg -background $radiosBg \ -value "%$notation" -text "%$notation" \ -command { # the % at the start doesn't seem to be required here appendHist "$notation\n"; evaluate "$notation\n" } } pack $widget -side left } # provided so people can customise the tkeden interface a little proc removeNotationRadioButton {notation} { set widget ".radios.[string tolower $notation]" destroy $widget } addNotationRadioButton eden addNotationRadioButton donald addNotationRadioButton scout if {$_tkeden_sasamiAvail == "1"} { addNotationRadioButton sasami } if {$_tkeden_variant == "dtkeden"} { addNotationRadioButton lsd } button .radios.interrupt -text "Interrupt" \ -background $radiosButtonBg -command {interrupt} pack .radios.interrupt -side right menu .menu . config -menu .menu # This is similar to the background colour used for the menus on Solaris # but not quite (unfortunately) set bg grey60 frame .labelframe -borderwidth 0 -background $bg # The prompt shows the current notation [Ash] label .prompt -anchor w -text "Enter EDEN statements:" -background $bg # The labelframe also contains the current virtual agent [Ash] label .agentName -anchor e -text "" -background $bg pack .prompt -side left -fill x -in .labelframe pack .agentName -side right -fill x -in .labelframe # ideally we should use this font whereever Eden code is displayed font create edencode -family courier -size 10 text .text -width 80 -height 15 -yscrollcommand ".scroll set" \ -background white -foreground black -insertbackground blue \ -insertofftime 80 -insertontime 1000 -insertwidth 2p \ -font edencode # set tabs to width of two characters (have to set it in pixels) [Ash] .text configure -tabs [font measure [.text cget -font] 00] scrollbar .scroll -command ".text yview" pack .radios -side top -fill x pack .labelframe -side top -fill x pack .scroll -side right -fill y pack .text -side right -fill both -expand 1 set m [menu .menu.file -tearoff 0] .menu add cascade -label "File" -underline 0 -menu .menu.file $m add command -label "Open..." -command {include Open} -underline 0 $m add command -label "Execute..." -command {include Execute} -underline 0 $m add separator set saveAsReusable 1 $m add checkbutton -label "Save as reusable definitions" \ -variable saveAsReusable -offvalue 0 -onvalue 1 $m add command -label "Save all definitions..." \ -command {save all} -underline 5 $m add command -label "Save Scout definitions..." \ -command {save scout} -underline 5 $m add command -label "Save DoNaLD definitions..." \ -command {save donald} -underline 5 $m add command -label "Save Eden definitions..." \ -command {save eden} -underline 5 if {$_tkeden_variant == "dtkeden"} { if {$_dtkeden_isServer} { $m add command -label "Save LSD description..." \ -command {save lsd} -underline 5 } } $m add command -label "Save history..." \ -command {save hist} -underline 5 $m add separator $m add command -label "Quit" -command { close $histfile; quit; } -underline 0 if {$_tkeden_apple} { set m [menu .menu.apple -tearoff 0] .menu add cascade -menu .menu.apple $m add command -label "About $_tkeden_variant..." -command about ## !@!@ thought this might stop the error on Apple-Q, but it doesn't ## $m add command -label "Quit tkeden" -command { close $histfile; quit; } } # don't use tearoffs on the Apple platform set m [menu .menu.edit -tearoff [expr !$_tkeden_apple]] .menu add cascade -label "Edit" -underline 0 -menu .menu.edit # (I found the keysym names using xmodmap -pk as I don't know the # virtual event names for select all and select none). $m add command -label "Select all" -underline 7 \ -accelerator "Control-/" \ -command {event generate .text } $m add command -label "Select none" \ -accelerator "Control-\\" \ -command {event generate .text } $m add command -label "Copy" -underline 0 \ -command {event generate .text <>} $m add command -label "Cut" -underline 2 \ -command {event generate .text <>} $m add command -label "Paste" -underline 0 \ -command {event generate .text <>} $m add command -label "Previous" \ -accelerator "Control-Alt-Up or Meta-Up" \ -command {previous} -underline 1 $m add command \ -label "Next" \ -accelerator "Control-Alt-Down or Meta-Down" \ -command {next} -underline 0 $m add command -label "Clear" \ -accelerator "Control-Alt-0 or Meta-0" \ -command {clearInputWindow} -underline 1 set m [menu .menu.show -tearoff [expr !$_tkeden_apple]] .menu add cascade -label "View" -underline 0 -menu .menu.show $m add checkbutton -label "View history..." \ -variable showhist -command {show hist $showhist} -underline 5 $m add checkbutton -label "View errors..." \ -variable showerr -command {show err $showerr} -underline 6 $m add checkbutton -label "View Scout definitions..." \ -variable showscout -command {show scout $showscout} -underline 5 $m add checkbutton -label "View DoNaLD definitions..." \ -variable showdonald -command {show donald $showdonald} -underline 5 $m add checkbutton -label "View Eden definitions..." \ -variable showeden -command {show eden $showeden} -underline 5 if {$_tkeden_variant == "dtkeden"} { if {$_dtkeden_isServer} { $m add checkbutton -label "View LSD descriptions..." \ -variable showlsd -command {show lsd $showlsd} -underline 5 $m add checkbutton -label "View client connections..." \ -variable showclient -command {show client $showclient} \ -underline 5 set m2 [menu .menu.type] .menu add cascade -label "Type" -menu .menu.type -underline 0 set proType 0 $m2 add radiobutton -label "Normal mode" \ -variable proType -value 0 $m2 add radiobutton -label "Interference mode" \ -variable proType -value 1 $m2 add radiobutton -label "Broadcast mode" \ -variable proType -value 2 \ -command { appendHist ">>\n"; evaluate ">>\n" } $m2 add radiobutton -label "Private mode" \ -variable proType -value 3 } } set m [menu .menu.help -tearoff 0] .menu add cascade -label "Help" -underline 0 -menu .menu.help # About is in the Apple menu on the Apple platform if {$_tkeden_apple == "0"} { $m add command -label "About $_tkeden_variant..." -command about \ -underline 0 } $m add command -label "Credits..." -command credits \ -underline 0 $m add command -label "Key shortcuts..." -command keys \ -underline 0 $m add command -label "Eden quick reference..." \ -command edenQuickRef -underline 0 $m add command -label "Scout quick reference..." \ -command scoutQuickRef -underline 0 $m add command -label "Donald quick reference..." \ -command donaldQuickRef -underline 0 $m add command -label "Sasami quick reference..." \ -command sasamiQuickRef -underline 4 $m add command -label "Colour names..." \ -command colourNames -underline 7 $m add command -label "ChangeLog..." -command changeLog \ -underline 1 bind .text { accept } bind .text { accept } bind .text { previous } bind .text { previous } bind .text { previous } bind .text { previous } bind .text { next } bind .text { next } bind .text { next } bind .text { next } bind .text { clearInputWindow } bind .text { clearInputWindow } bind .text { controlU } bind .text { controlU } proc bringToTop {} { set wins "[winfo children .] ."; foreach w $wins { set tlw [winfo toplevel $w]; if {[wm state $tlw] == "iconic"} { wm deiconify $tlw; } if {$w != ".menu"} { raise $w } } } # bring all our windows to the top if this combination of keys is pressed bind all { bringToTop } bindtags .text {all .text Text} update # History window toplevel .hist wm title .hist "$variantversion: Command History" frame .hist.menu -relief raised -borderwidth 2 pack .hist.menu -side top -fill x button .hist.menu.save -text "Save" -underline 0 -command {save hist} \ -relief flat -highlightthickness 0 bind .hist { .hist.menu.save invoke } bind .hist { .hist.menu.save invoke } button .hist.menu.find -text "Find" -underline 0 -command {find hist} \ -relief flat -highlightthickness 0 bind .hist { .hist.menu.find invoke } bind .hist { .hist.menu.find invoke } button .hist.menu.close -text "Close" -underline 0 \ -command {global showhist; set showhist 0; show hist 0} \ -relief flat -highlightthickness 0 bind .hist { .hist.menu.close invoke } bind .hist { .hist.menu.close invoke } pack .hist.menu.save .hist.menu.find .hist.menu.close -side left frame .hist.t pack .hist.t -fill both -expand 1 text .hist.t.text -state disabled -width 80 -height 10 \ -yscrollcommand ".hist.t.scroll set" -font edencode scrollbar .hist.t.scroll -command ".hist.t.text yview" pack .hist.t.scroll -side right -fill y pack .hist.t.text -side right -fill both -expand 1 wm withdraw .hist wm protocol .hist WM_DELETE_WINDOW ".hist.menu.close invoke;" update # Error window toplevel .err wm title .err "$variantversion: Errors" frame .err.menu -relief raised -borderwidth 2 pack .err.menu -side top -fill x button .err.menu.save -text "Save" -underline 0 -command {save err} \ -relief flat -highlightthickness 0 bind .err { .err.menu.save invoke } bind .err { .err.menu.save invoke } button .err.menu.find -text "Find" -underline 0 -command {find err} \ -relief flat -highlightthickness 0 bind .err { .err.menu.find invoke } bind .err { .err.menu.find invoke } button .err.menu.close -text "Close" -underline 0 \ -command {global showerr; set showerr 0; show err 0} \ -relief flat -highlightthickness 0 bind .err { .err.menu.close invoke } bind .err { .err.menu.close invoke } pack .err.menu.save .err.menu.find .err.menu.close -side left frame .err.t pack .err.t -fill both -expand 1 text .err.t.text -state disabled -width 80 -height 10 \ -yscrollcommand ".err.t.scroll set" -font edencode scrollbar .err.t.scroll -command ".err.t.text yview" pack .err.t.scroll -side right -fill y pack .err.t.text -side right -fill both -expand 1 wm withdraw .err wm protocol .err WM_DELETE_WINDOW ".err.menu.close invoke;" update if {$_tkeden_variant == "dtkeden"} { if {$_dtkeden_isServer} { toplevel .client wm title .client "$variantversion: Client Connections" frame .client.menu -relief raised -borderwidth 2 pack .client.menu -side top -fill x button .client.menu.close -text "Close" -underline 0 \ -relief flat -highlightthickness 0 \ -command {global showclient; set showclient 0; show client 0;} bind .client { .client.menu.close invoke } bind .client { .client.menu.close invoke } pack .client.menu.close -side left frame .client.t pack .client.t -fill both -expand 1 text .client.t.text -state disabled -width 80 -height 10 \ -yscrollcommand ".client.t.scroll set" scrollbar .client.t.scroll -command ".client.t.text yview" pack .client.t.scroll -side right -fill y pack .client.t.text -side right -fill both -expand 1 wm withdraw .client wm protocol .client WM_DELETE_WINDOW ".client.menu.close invoke;" update } } toplevel .scout wm title .scout "$variantversion: Scout Definitions" frame .scout.menu -relief raised -borderwidth 2 pack .scout.menu -side top -fill x button .scout.menu.save -text "Save" -underline 0 -command {save scout} \ -relief flat -highlightthickness 0 bind .scout { .scout.menu.save invoke } bind .scout { .scout.menu.save invoke } button .scout.menu.find -text "Find" -underline 0 -command {find scout} \ -relief flat -highlightthickness 0 bind .scout { .scout.menu.find invoke } bind .scout { .scout.menu.find invoke } button .scout.menu.rebuild -text "Rebuild" -underline 0 \ -command {dumpscout} \ -relief flat -highlightthickness 0 bind .scout { .scout.menu.rebuild invoke } bind .scout { .scout.menu.rebuild invoke } button .scout.menu.close -text "Close" -underline 0 \ -command {global showscout; set showscout 0; show scout 0} \ -relief flat -highlightthickness 0 bind .scout { .scout.menu.close invoke } bind .scout { .scout.menu.close invoke } pack .scout.menu.save .scout.menu.find .scout.menu.rebuild .scout.menu.close \ -side left frame .scout.t pack .scout.t -fill both -expand 1 text .scout.t.text -state disabled -width 80 -height 20 \ -yscrollcommand ".scout.t.scroll set" -font edencode scrollbar .scout.t.scroll -command ".scout.t.text yview" pack .scout.t.scroll -side right -fill y pack .scout.t.text -side right -fill both -expand 1 wm withdraw .scout wm protocol .scout WM_DELETE_WINDOW ".scout.menu.close invoke;" update toplevel .donald wm title .donald "$variantversion: DoNaLD Definitions" frame .donald.menu -relief raised -borderwidth 2 pack .donald.menu -side top -fill x button .donald.menu.save -text "Save" -underline 0 -command {save donald} \ -relief flat -highlightthickness 0 bind .donald { .donald.menu.save invoke } bind .donald { .donald.menu.save invoke } button .donald.menu.find -text "Find" -underline 0 -command {find donald} \ -relief flat -highlightthickness 0 bind .donald { .donald.menu.find invoke } bind .donald { .donald.menu.find invoke } button .donald.menu.rebuild -text "Rebuild" -underline 0 \ -command {dumpdonald} \ -relief flat -highlightthickness 0 bind .donald { .donald.menu.rebuild invoke } bind .donald { .donald.menu.rebuild invoke } button .donald.menu.close -text "Close" -underline 0 \ -command {global showdonald; set showdonald 0; show donald 0} \ -relief flat -highlightthickness 0 bind .donald { .donald.menu.close invoke } bind .donald { .donald.menu.close invoke } pack .donald.menu.save .donald.menu.find .donald.menu.rebuild \ .donald.menu.close -side left frame .donald.t pack .donald.t -fill both -expand 1 text .donald.t.text -state disabled -width 80 -height 20 \ -yscrollcommand ".donald.t.scroll set" -font edencode .donald.t.text tag config viewport -background #efd4b4 .donald.t.text tag config master -background #efd4b4 scrollbar .donald.t.scroll -command ".donald.t.text yview" pack .donald.t.scroll -side right -fill y pack .donald.t.text -side right -fill both -expand 1 wm withdraw .donald wm protocol .donald WM_DELETE_WINDOW ".donald.menu.close invoke;" update if {$_tkeden_variant == "dtkeden"} { if {$_dtkeden_isServer} { toplevel .lsd wm title .lsd "$variantversion: LSD Descriptions" frame .lsd.menu -relief raised -borderwidth 2 pack .lsd.menu -side top -fill x button .lsd.menu.save -text "Save" -underline 0 -command {save lsd} \ -relief flat -highlightthickness 0 bind .lsd { .lsd.menu.save invoke } bind .lsd { .lsd.menu.save invoke } button .lsd.menu.find -text "Find" -underline 0 -command {find lsd} \ -relief flat -highlightthickness 0 bind .lsd { .lsd.menu.find invoke } bind .lsd { .lsd.menu.find invoke } button .lsd.menu.rebuild -text "Rebuild" -underline 0 \ -command {dumpLSD} \ -relief flat -highlightthickness 0 bind .lsd { .lsd.menu.rebuild invoke } bind .lsd { .lsd.menu.rebuild invoke } button .lsd.menu.close -text "Close" -underline 0 \ -command {global showlsd; set showlsd 0; show lsd 0} \ -relief flat -highlightthickness 0 bind .lsd { .lsd.menu.close invoke } bind .lsd { .lsd.menu.close invoke } pack .lsd.menu.save .lsd.menu.find .lsd.menu.rebuild .lsd.menu.close \ -side left frame .lsd.t pack .lsd.t -fill both -expand 1 text .lsd.t.text -state disabled -width 80 -height 20 \ -yscrollcommand ".lsd.t.scroll set" scrollbar .lsd.t.scroll -command ".lsd.t.text yview" pack .lsd.t.scroll -side right -fill y pack .lsd.t.text -side right -fill both -expand 1 wm withdraw .lsd wm protocol .lsd WM_DELETE_WINDOW ".lsd.menu.close invoke;" update } } toplevel .eden wm title .eden "$variantversion: Eden Definitions" menu .eden.menu .eden config -menu .eden.menu set m [menu .eden.menu.edit -tearoff [expr !$_tkeden_apple]] .eden.menu add cascade -label "Edit" -underline 0 -menu .eden.menu.edit $m add command -label "Copy" -underline 0 \ -command {event generate .eden.t.text <>} $m add command -label "Cut" -underline 2 \ -command {event generate .eden.t.text <>} $m add command -label "Paste" -underline 0 \ -command {event generate .eden.t.text <>} .eden.menu add command -label "Save" -underline 0 -command {save eden} .eden.menu add command -label "Find" -underline 0 -command {find eden} .eden.menu add command -label "Rebuild" -underline 0 -command {viewOption} .eden.menu add command -label "Update" -underline 0 -command {edenUpdate} .eden.menu add command -label "Close" -underline 0 \ -command {global showeden; set showeden 0; show eden 0} frame .eden.t pack .eden.t -fill both -expand 1 text .eden.t.text -state disabled -width 80 -height 20 \ -yscrollcommand ".eden.t.scroll set" -font edencode .eden.t.text tag config masteragent -background #efd4b4 .eden.t.text tag config scout -foreground red .eden.t.text tag config donald -foreground blue scrollbar .eden.t.scroll -command ".eden.t.text yview" pack .eden.t.scroll -side right -fill y pack .eden.t.text -side right -fill both -expand 1 wm withdraw .eden wm protocol .eden WM_DELETE_WINDOW "set showeden 0; show eden 0" update if {$_tkeden_win32_version == "0.0"} { # we're on UNIX set histfilename $env(HOME)/.tkeden-history } else { # cygwin seems to require filenames in DOS (C:\blah) format set histfilename \ [cygwin_conv_to_full_win32_path "$env(HOME)/.tkeden-history"] } # Keep a few backups around as people don't seem to look for the # history file until they've restarted tkeden once or twice. Ideally # this would preserve file dates to make it easier to find data when # grubbing around in the history files, but there isn't an option for # this in Tcl file copy. We could use file rename, but this causes # problems with multiple concurrent instances of tkeden running in the # same user account with an NFS mounted home directory (machine 1 # shifts history files, starts to use tkeden-history, machine 2 shifts # history files, machine 1 gives stale NFS handle error). [Ash] catch {file copy -force ${histfilename}.2 ${histfilename}.3} catch {file copy -force ${histfilename}.1 ${histfilename}.2} catch {file copy -force $histfilename ${histfilename}.1} set histfile [open $histfilename w] proc appendHist {text} { global histfile .hist.t.text config -state normal .hist.t.text insert end $text puts $histfile $text nonewline flush $histfile .hist.t.text see end .hist.t.text config -state disabled } set errorNo 0 set errorAppendNo 0 set error "" proc appendErr {text} { global errorNo errorAppendNo error .err.t.text config -state normal if {$errorAppendNo == 0} { .err.t.text insert end "## ERROR number [incr errorNo]:\n" } incr errorAppendNo append error $text .err.t.text insert end $text .err.t.text see end .err.t.text config -state disabled } proc errorComplete {beep} { global errorNo errorAppendNo error set errorInitialText [string range $error 0 55] if {[string length $error] > 55} {append errorInitialText "..."} appendHist "## ERROR number $errorNo: $errorInitialText\n" set errorAppendNo 0 set error "" set showerr 1 show err 1 raise .err if {$beep} {bell} # Force .err to refresh, meaning the new error information is # shown on the screen even if we are in a tight loop. This call # causes any events on windows to trigger, which may then # cause some Eden to execute - this was the cause of "bug42". update idletasks } # Previous text set pentries "" # Number of entries of previous text to keep set pmax 20 # Current (per-entry session) position in history set ppos 0 proc accept {} { global pentries pmax ppos set text [.text get 1.0 end] appendHist $text # 1) remove the spurious \n that comes from Tcl's text widget # 2) append this entry to the list we are keeping # 3) remove an old entry from the front of the list if necessary # 3) if {[llength $pentries] >= $pmax} { set pentries [lrange $pentries 1 end] } # 2), 1) lappend pentries [string range $text 0 [expr [string length $text]-2]] evaluate $text clearInputWindow set ppos [llength $pentries]; } proc previous {} { global pentries pmax ppos set text [.text get 1.0 end] clearInputWindow set ppos [expr $ppos - 1] if {$ppos < 0} { set ppos 0 bell } .text insert end [lindex $pentries $ppos] } proc next {} { global pentries pmax ppos set text [.text get 1.0 end] clearInputWindow incr ppos if {$ppos > [llength $pentries]} { set ppos [llength $pentries] bell } .text insert end [lindex $pentries $ppos] } proc clearInputWindow {} { .text delete 1.0 end } proc controlU {} { # delete the text to the left of the cursor .text delete {insert linestart} insert } proc interface {statement} { global _tkeden_variant _dtkeden_isServer appendHist $statement if {$_tkeden_variant == "dtkeden"} { if {! ($_dtkeden_isServer)} { # Patrick's change to client only - dunno why [Ash] set statement "$statement\n" } } todo $statement } # This is used in scout.init.e for TEXTBOX [Ash] proc interfaceTEXT {statement} { todo $statement } proc cleanup {w} { .$w.t.text config -state normal .$w.t.text delete 1.0 end .$w.t.text config -state disabled } proc Review {} { global viewToBeDefined viewOption viewScout viewDoNaLD viewSasami set viewOption 0 if {$viewScout} { set viewOption [expr $viewOption + 1] } if {$viewDoNaLD} { set viewOption [expr $viewOption + 2] } if {$viewSasami} { set viewOption [expr $viewOption + 4] } dumpeden $viewOption $viewToBeDefined } proc edenDefn {v n d} { set r [.eden.t.text tag ranges eden%$v] .eden.t.text config -state normal if [llength $r] { .eden.t.text delete eden%$v.first eden%$v.last .eden.t.text insert [lindex $r 0] $d [list $n eden%$v] } else { .eden.t.text insert end $d [list $n eden%$v] } .eden.t.text config -state disabled } proc scoutDefn {v d} { set r [.scout.t.text tag ranges scout%$v] .scout.t.text config -state normal if [llength $r] { .scout.t.text delete scout%$v.first scout%$v.last .scout.t.text insert [lindex $r 0] $d scout%$v } else { .scout.t.text insert end $d scout%$v } .scout.t.text config -state disabled } # This based on mkDialogue below... [Ash] proc fileDialogue {fileName w winTitle} { global variantversion env catch {destroy $w} toplevel $w -class Dialog wm title $w "$variantversion: $winTitle" wm iconname $w "$winTitle" # Create two frames in the main window. The top frame will hold the # message and the bottom one will hold the buttons. Arrange them # one above the other, with any extra vertical space split between # them. frame $w.top -relief raised -border 1 frame $w.bot -relief raised -border 1 pack $w.top $w.bot -side top -fill both -expand yes text $w.top.text -state disabled -width 78 -height 31 \ -yscrollcommand "$w.top.scroll set" -background white \ -foreground black -font edencode scrollbar $w.top.scroll -command "$w.top.text yview" pack $w.top.scroll -side right -fill y pack $w.top.text -side top -expand yes -padx 3 -pady 3 if [catch {open "$env(TKEDEN_LIB)/$fileName" r} fileId] { puts stderr "Cannot open $env(TKEDEN_LIB)/$fileName: $fileId" } else { $w.top.text config -state normal $w.top.text insert end [read $fileId] close $fileId $w.top.text config -state disabled } # Create as many buttons as needed and arrange them from left to right # in the bottom frame. Embed the left button in an additional sunken # frame to indicate that it is the default button, and arrange for that # button to be invoked as the default action for clicks and returns in # the dialog. set args "OK" if {[llength $args] > 0} { set arg [lindex $args 0] frame $w.bot.0 -relief sunken -border 1 pack $w.bot.0 -side left -expand yes -padx 10 -pady 10 button $w.bot.0.button -text [lindex $arg 0] \ -command "[lindex $arg 1]; destroy $w" pack $w.bot.0.button -expand yes -padx 6 -pady 6 bind $w "[lindex $arg 1]; destroy $w" focus $w set i 1 foreach arg [lrange $args 1 end] { button $w.bot.$i -text [lindex $arg 0] \ -command "[lindex $arg 1]; destroy $w" pack $w.bot.$i -side left -expand yes -padx 10 set i [expr $i+1] } } bind $w [list focus $w] focus $w } # Create the About key shortcuts dialogue box containing info... [Ash] # See the Tcl text(n) man page for some of the information in the file proc keys {} { fileDialogue "keys.txt" .keys "Key shortcuts" } proc changeLog {} { fileDialogue "change.log" .changeLog "ChangeLog" } proc credits {} { fileDialogue "credits.txt" .credits "Credits" } # this from Ousterhout "Tcl and the Tk toolkit" page 219 proc forAllMatches {w pattern script} { scan [$w index end] %d numLines for {set i 1} {$i < $numLines} {incr i} { $w mark set last $i.0 while {[regexp -indices $pattern \ [$w get last "last lineend"] indices]} { $w mark set first \ "last + [lindex $indices 0] chars" $w mark set last "last + 1 chars \ + [lindex $indices 1] chars" uplevel $script } } } # Translate text file markup into formatted text by adding appropriate tags # [Ash] proc setTags {w} { $w.top.text config -state normal # Surround text denoting optional stuff with !@O and !@P. See # Ousterhout "Tcl and the Tk toolkit" page 91 for information # about Tcl regular expressions forAllMatches $w.top.text {!@O[^!@]*!@P} { $w.top.text delete first "first + 3 char" $w.top.text delete "last - 3 char" last $w.top.text tag add optional first last } $w.top.text tag configure optional -foreground blue $w.top.text config -state disabled } proc edenQuickRef {} { fileDialogue "eden.txt" .edenQuickRef "Eden Quick Reference" setTags .edenQuickRef } proc scoutQuickRef {} { fileDialogue "scout.txt" .scoutQuickRef "Scout Quick Reference" } proc donaldQuickRef {} { fileDialogue "donald.txt" .scoutQuickRef "DoNaLD Quick Reference" } proc sasamiQuickRef {} { fileDialogue "sasami.txt" .sasamiQuickRef "Sasami Quick Reference" } proc colourNames {} { fileDialogue "rgb.txt" .colourNames "Colour Names" } proc reinit {} { global env #set wins "[winfo children .] ."; #foreach w $wins { destroy $w; } destroy . # This almost works: $_tkeden_win32_version is undefined tho :( source $env(TKEDEN_LIB)/edenio.tcl } # Create the About dialogue box containing version and other information [Ash] proc about {} { global _tkeden_variant _tkeden_version _tkeden_web_site \ _dtkeden_isServer tcl_patchLevel tk_patchLevel \ _tkeden_win32_version env variantversion haveImg toplevel .about -class Dialog wm title .about "$variantversion: About" label .about.variant -text "This is $_tkeden_variant, version $_tkeden_version" if {$_tkeden_variant == "dtkeden"} { if {$_dtkeden_isServer} { label .about.isserver -text "Invoked in super-agent (server) mode" } else { label .about.isserver -text "Invoked in agent (client) mode" } } label .about.copyright -text "Copyright (C) The University of TV. All rights reserved" label .about.separator1 -text "--------------------------------" label .about.usage -text "Invoke $_tkeden_variant with the -u option for details of command line options usage" label .about.website -text "See $_tkeden_web_site for more information" label .about.separator2 -text "--------------------------------" label .about.diagnosis -text "This information may be useful when diagnosing problems:" if {$_tkeden_win32_version != "0.0"} { label .about.win32version -text "Win32 version V$_tkeden_win32_version" } else { label .about.win32version -text "Unix version" } label .about.libfiles -text "Library files are located in \n$env(TKEDEN_LIB)" label .about.tclversion -text "Tcl is version $tcl_patchLevel, Tk is version $tk_patchLevel\nTk Img package (PNG, JPEG...) is [expr {$haveImg ? {available} : {not available}}]" button .about.ok -text OK -command {destroy .about} if {$_tkeden_variant == "dtkeden"} { pack .about.variant .about.isserver .about.copyright \ .about.separator1 .about.usage .about.website \ .about.separator2 .about.diagnosis .about.win32version \ .about.libfiles .about.tclversion \ .about.ok -pady 5 } else { pack .about.variant .about.copyright \ .about.separator1 .about.usage .about.website \ .about.separator2 .about.diagnosis .about.win32version \ .about.libfiles .about.tclversion \ .about.ok -pady 5 } } # These long extensions have been re-thought from the original .e, .d, # .s practice. [Ash] set fileTypes { {{All files} *} {{Eden files} {.eden}} {{DoNaLD files} {.donald}} {{Scout files} {.scout}} {{Sasami files} {.sasami}} {{Eddi files} {.eddi}} {{Script (multi-notation) files} {.script}} } proc include style { global variantversion fileTypes notation _tkeden_win32_version if {$_tkeden_win32_version == "0.0"} { # tk_getOpenFile -multiple true isn't possible until 8.4a2 on UNIX # and I can't find where to download that version (and it's alpha) set fileNames [tk_getOpenFile \ -filetypes $fileTypes -parent . \ -title "$variantversion: $style" ] } else { # we're on Windows: -multiple is possible set fileNames [tk_getOpenFile \ -filetypes $fileTypes -parent . \ -multiple true \ -title "$variantversion: $style"] } foreach file $fileNames { # Change directory so that Eden include(...) is more likely to # work. 'cd [file dirname $file]' is the Tcl version, but # I've rewritten it in Eden so that the cwd() function will be # correctly re-evaluated eden "cd(dirname(\"$file\"));" if {$style == "Open"} { set errCode [catch {set incFile [open $file r]} string] if {$errCode == 0} { while {[gets $incFile line] >= 0} { .text insert end "$line\n" } .text see end close $incFile } else { tk_dialog .message "$variantversion: Warning" \ "Cannot open file \"$file\"" warning 0 OK } } elseif {$style == "Execute"} { appendHist "%eden\n" appendHist "include(\"$file\");\n" # want to do this: todo "include(\"$file\");" # but at evaluation level 0 (so that global variables such as # $radiosBg can be found). $file needs to be evaluated # now, but the rest must not be. # Using todo and not eden, as the Tcl eden command restores # the currently active notation after use, and that isn't the # semantics of include(). set cmd {todo "include(\"} append cmd "$file" append cmd {\");"} uplevel #0 $cmd # now switch back to current notation appendHist "$notation\n" } else { error {internal error: include style unknown} } } } proc save w { global variantversion saveAsReusable fileTypes set fileName [tk_getSaveFile -initialfile untitled.$w -parent . \ -title "$variantversion: Save $w As" -defaultextension $w \ -filetypes $fileTypes] if {$fileName != ""} { SaveToFile $w $fileName $saveAsReusable } } proc SaveToFile {w file executable} { global viewOption viewToBeDefined _tkeden_variant _dtkeden_isServer if {[catch {open $file w} fid]} { mkDialog .error "-aspect 300 -text \{$fid\}" {OK {}} tkwait visibility .error grab .error } else { case $w { all { dumpeden 63 0 dumpscout dumpdonald if {$_tkeden_variant == "dtkeden"} { if {$_dtkeden_isServer} { dumpLSD } } if {$executable} { edenDefn autocalc eden "" puts $fid {autocalc = 0;} eden {tcl("set vp_in_use {"//vp_in_use(DFscreen)//"}");} global vp_in_use foreach vp $vp_in_use { edenDefn $vp eden "" } puts $fid %scout SaveScout $fid $executable if {$_tkeden_variant == "dtkeden"} { if {$_dtkeden_isServer} { puts $fid %lsd Savelsd $fid $executable } } puts $fid %donald SaveDonald $fid $executable puts $fid %eden SaveEden $fid $executable -omit masteragent scout donald system } else { puts $fid %scout SaveScout $fid $executable if {$_tkeden_variant == "dtkeden"} { if {$_dtkeden_isServer} { puts $fid %lsd Savelsd $fid $executable } } puts $fid %donald SaveDonald $fid $executable puts $fid %eden SaveEden $fid $executable } if {$executable} { puts $fid {autocalc = 1;} } dumpeden $viewOption $viewToBeDefined } hist { puts $fid [.hist.t.text get 1.0 end] nonewline } eden { if {$executable} { dumpeden 63 0 edenDefn autocalc eden "" puts $fid {autocalc = 0;} eden {tcl("set vp_in_use {"//vp_in_use(DFscreen)//"}");} global vp_in_use foreach vp $vp_in_use { edenDefn $vp eden "" } SaveEden $fid $executable -omit masteragent system } else { dumpeden $viewOption $viewToBeDefined SaveEden $fid $executable } if {$executable} { puts $fid {autocalc = 1;} dumpeden $viewOption $viewToBeDefined } } scout { dumpscout puts $fid "%scout" SaveScout $fid $executable } lsd { # This code should never happen in client and plain tkeden dumpLSD puts $fid "%lsd" Savelsd $fid $executable } donald { dumpdonald puts $fid "%donald" SaveDonald $fid $executable } } close $fid } } proc SaveEden {fid executable args} { if {[lsearch $args -omit] == 0} { set args [lrange $args 1 end] } set lastline [lindex [split [.eden.t.text index end] "."] 0] for {set i 1} {$i <= $lastline} {incr i} { set in 1 set tags [.eden.t.text tag names $i.0] foreach filter $args { if {[lsearch $tags $filter] != -1} { set in 0 break } } if {$in} { puts $fid [.eden.t.text get $i.0linestart $i.0lineend] } } } proc SaveScout {fid executable} { if $executable { foreach t [.scout.t.text tag names] { if [string match scout%* $t] { set text [.scout.t.text get $t.first $t.last] set eq [string first = $text] if {$eq == -1} { puts $fid $text nonewline } else { puts $fid [string range $text 0 [expr $eq - 2]] nonewline puts $fid {;} } } } foreach t [.scout.t.text tag names] { if [string match scout%* $t] { set text [.scout.t.text get $t.first $t.last] set eq [string first = $text] if {$eq != -1} { puts $fid $text nonewline } } } } else { puts $fid [.scout.t.text get 1.0 end] nonewline } } proc SaveDonald {fid executable} { for {set i 1} {$i <= [.donald.t.text index end]} {incr i} { set line [.donald.t.text get $i.0 "$i.0 lineend"] if {![string match AGENT* $line]} { puts $fid $line } } } if {$_tkeden_variant == "dtkeden"} { if {$_dtkeden_isServer} { proc Savelsd {fid executable} { for {set i 1} {$i <= [.lsd.t.text index end]} {incr i} { set line [.lsd.t.text get $i.0 "$i.0 lineend"] puts $fid $line } } } } proc TextSearch {w direction caseSensitive string} { if {[expr [string compare [.$w.t.text tag nextrange found 1.0] ""] \ && [string compare $direction -forwards] == 0]} { if {[expr [string compare [.$w.t.text index insert] \ [.$w.t.text index found.first]] == 0]} { .$w.t.text mark set insert [.$w.t.text index found.last] } } .$w.t.text tag remove found 1.0 end if {$caseSensitive} { set caseSwitch "-exact" } else { set caseSwitch "-nocase" } set index [.$w.t.text search $direction $caseSwitch -regexp \ -count len -- $string insert] if {[string length $index] > 0} { .$w.t.text mark set insert $index .$w.t.text see $index # This doesn't work on Linux as \c is an escape - rewritten [Ash] #.$w.t.text tag add found $index $index+$len\chars .$w.t.text mark set first $index .$w.t.text mark set last "$index + $len chars" .$w.t.text tag add found first last .$w.t.text tag configure found -background blue } else { bell } } proc find w { global variantversion catch {destroy .find} toplevel .find -class Dialog wm title .find "$variantversion: Find in $w" frame .find.top pack .find.top -fill both entry .find.top.e -relief sunken -textvariable searchString checkbutton .find.top.case -variable caseSensitive -text "case sensitive" pack .find.top.e .find.top.case -side left -padx 5 frame .find.bot pack .find.bot -fill both button .find.bot.forward -text "Forward" -underline 0 -width 8 \ -command "TextSearch $w -forwards \$caseSensitive \$searchString" button .find.bot.backward -text "Backward" -underline 0 -width 8 \ -command "TextSearch $w -backwards \$caseSensitive \$searchString" button .find.bot.cancel -text Cancel -command "destroy .find" -width 8 bind .find { .find.bot.forward invoke } bind .find { .find.bot.forward invoke } bind .find { .find.bot.backward invoke } bind .find { .find.bot.backward invoke } pack .find.bot.forward -side left -expand yes -padx 5 -pady 5 pack .find.bot.backward -side left -expand yes -padx 5 -pady 5 pack .find.bot.cancel -side left -expand yes -padx 5 -pady 5 tkwait visibility .find grab .find } set viewOption 0 set viewToBeDefined 0 set viewScout 0 set viewDoNaLD 0 set viewSasami 0 proc edenUpdate {} { global viewOption viewToBeDefined # save the position of the vertical scrollbar set yscroll [lindex [.eden.t.text yview] 0] # dumpeden is a tkeden Tcl command created in EX/ex.c dumpeden [expr $viewOption + 8] $viewToBeDefined .eden.t.text yview moveto $yscroll } # viewOption is called when the Rebuild button is pressed [Ash] proc viewOption {} { global variantversion _tkeden_sasamiAvail catch {destroy .view} toplevel .view -class Dialog wm title .view "$variantversion: View Options" wm transient .view .eden frame .view.left pack .view.left -fill both -side left -expand yes label .view.left.name -justify left \ -text "Highlight to view:\ncontrol-click: individual items,\nshift-click: a range:" pack .view.left.name -side top -fill none -anchor nw scrollbar .view.left.scroll -command ".view.left.list yview" pack .view.left.scroll -side right -fill y listbox .view.left.list -yscroll ".view.left.scroll set" \ -selectmode extended -relief sunken -width 20 -height 20 -setgrid yes pack .view.left.list -side left -fill both -expand yes frame .view.right pack .view.right -side right checkbutton .view.right.yet \ -text "with yet-to-be-defined variables" \ -variable viewToBeDefined checkbutton .view.right.scout \ -text "with translated Scout definitions" \ -variable viewScout checkbutton .view.right.donald \ -text "with translated DoNaLD definitions" \ -variable viewDoNaLD if {$_tkeden_sasamiAvail == "1"} { checkbutton .view.right.sasami \ -text "with translated Sasami definitions" \ -variable viewSasami } button .view.right.all -text "Select All" -width 12 -underline 0 \ -command { .view.left.list selection set 0 end } button .view.right.none -text "Clear All" -width 12 \ -command { .view.left.list selection clear 0 end } frame .view.right.ok -relief sunken -border 1 button .view.right.ok.button -text OK -width 12 \ -command { Review; destroy .view; raise .eden } pack .view.right.ok.button -padx 10 -pady 10 button .view.right.cancel -text Cancel -command "destroy .view" -width 12 pack .view.right.all .view.right.none -side top -padx 5 -pady 5 pack .view.right.yet .view.right.scout .view.right.donald \ -side top -anchor sw if {$_tkeden_sasamiAvail == "1"} { pack .view.right.yet .view.right.sasami -side top -anchor sw } pack .view.right.ok .view.right.cancel -side top -padx 5 -pady 5 bind .view { .view.right.ok.button invoke } bind .view { .view.right.all invoke } bind .view { .view.right.all invoke } # setupViewOptions is a tkeden Tcl command created in EX/ex.c setupViewOptions tkwait visibility .view grab .view } if {$_tkeden_variant == "dtkeden"} { if {$_dtkeden_isServer} { proc selectClients {} { global clientSock sockName clientName variantversion if {[llength $clientSock] <= 0} { tk_dialog .message "$variantversion: Message" "No connected client" warning -1 OK return } else { catch {destroy .select} toplevel .select -class Dialog wm title .select "$variantversion: Select Clients" frame .select.left pack .select.left -fill both -side left -expand yes label .select.left.name -text "Select clients to receive:" pack .select.left.name -side top -fill none -anchor nw scrollbar .select.left.scroll -command ".select.left.list yview" pack .select.left.scroll -side right -fill y listbox .select.left.list -yscroll ".select.left.scroll set" \ -selectmode multiple -relief sunken -width 20 -height 10 -setgrid yes pack .select.left.list -side left -fill both -expand yes frame .select.right pack .select.right -side right # Something may be wrong here - emacs gets the formatting # wrong [Ash] button .select.right.all -text "Select All" -command { .select.left.list selection set 0 end } -width 12 button .select.right.none -text "Clear All" -command { .select.left.list selection clear 0 end } -width 12 button .select.right.ok -text OK -command { global sockName set text [.text get 1.0 end] set selectedClients {} foreach i [.select.left.list curselection] { set currClient [.select.left.list get $i] lappend selectedClients $sockName($currClient) } sendClientsSock $selectedClients $text .text delete 1.0 end destroy .select } -width 12 button .select.right.cancel -text Cancel -command "destroy .select" -width 12 pack .select.right.all .select.right.none -side top -padx 5 -pady 5 pack .select.right.ok .select.right.cancel -side top -padx 5 -pady 5 .select.left.list insert end "Own" foreach wsock $clientSock { # puts $clientName($wsock) .select.left.list insert end $clientName($wsock) } tkwait visibility .select grab .select } } } } # mkDialog w msgArgs list list ... # # Create a dialog box with a message and any number of buttons at # the bottom. # # Arguments: # w - Name to use for new top-level window. # msgArgs - List of arguments to use when creating the message of the # dialog box (e.g. text, justifcation, etc.) # list - A two-element list that describes one of the buttons that # will appear at the bottom of the dialog. The first element # gives the text to be displayed in the button and the second # gives the command to be invoked when the button is invoked. # # @(#) mkDialog.tcl 1.1 94/08/10 15:35:00 proc mkDialog {w msgArgs args} { global variantversion catch {destroy $w} toplevel $w -class Dialog wm title $w "$variantversion: Dialog Box" wm iconname $w "Dialog" # Create two frames in the main window. The top frame will hold the # message and the bottom one will hold the buttons. Arrange them # one above the other, with any extra vertical space split between # them. frame $w.top -relief raised -border 1 frame $w.bot -relief raised -border 1 pack $w.top $w.bot -side top -fill both -expand yes # Create the message widget and arrange for it to be centered in the # top frame. eval message $w.top.msg -justify center $msgArgs pack $w.top.msg -side top -expand yes -padx 3 -pady 3 # Create as many buttons as needed and arrange them from left to right # in the bottom frame. Embed the left button in an additional sunken # frame to indicate that it is the default button, and arrange for that # button to be invoked as the default action for clicks and returns in # the dialog. if {[llength $args] > 0} { set arg [lindex $args 0] frame $w.bot.0 -relief sunken -border 1 pack $w.bot.0 -side left -expand yes -padx 10 -pady 10 button $w.bot.0.button -text [lindex $arg 0] \ -command "[lindex $arg 1]; destroy $w" pack $w.bot.0.button -expand yes -padx 6 -pady 6 bind $w "[lindex $arg 1]; destroy $w" focus $w set i 1 foreach arg [lrange $args 1 end] { button $w.bot.$i -text [lindex $arg 0] \ -command "[lindex $arg 1]; destroy $w" pack $w.bot.$i -side left -expand yes -padx 10 set i [expr $i+1] } } bind $w [list focus $w] focus $w } proc show {w yes} { if $yes { wm deiconify .$w raise .$w case $w { scout {dumpscout} donald {dumpdonald} eden {viewOption} lsd {dumpLSD} } # the lsd above should never be matched in client # or plain tkeden [Ash] } else { wm withdraw .$w } } # Called when the user does %sasami open_display: called from Sasami render.c proc sasamiWindow {width height} { global variantversion toplevel .sasami -width $width -height $height wm title .sasami "$variantversion: Sasami" frame .sasami.f togl .sasami.f.togl -width $width -height $height -double true \ -privatecmap false -depth true -rgba true pack .sasami.f.togl -fill both -expand t pack .sasami.f -fill both -expand t bind .sasami.f.togl {sasamiB %x %y} bind .sasami.f.togl {sasamiB1Motion %x %y} bind .sasami.f.togl {sasamiB %x %y} bind .sasami.f.togl {sasamiB3Motion %x %y} } set sasamiOldX 0 set sasamiOldY 0 proc sasamiB { x y } { global sasamiOldX sasamiOldY set sasamiOldX $x set sasamiOldY $y } # This is called when mouse button 1 is pressed and moved in the Sasami # window: rotate about the X & Y axes. proc sasamiB1Motion { x y } { global sasamiOldX sasamiOldY set diffX [expr $x - $sasamiOldX] set diffY [expr $y - $sasamiOldY] .sasami.f.togl setXrot [expr [sasami_getXrot] - $diffY] .sasami.f.togl setYrot [expr [sasami_getYrot] - $diffX] .sasami.f.togl render set sasamiOldX $x set sasamiOldY $y } # This is called when mouse button 3 is pressed and moved in the Sasami # window: zoom in and out on the Z axis. proc sasamiB3Motion { x y } { global sasamiOldY set diffY [expr $y - $sasamiOldY] .sasami.f.togl setZpos [expr [sasami_getZpos] - $diffY] .sasami.f.togl render set sasamiOldX $x set sasamiOldY $y } proc sasamiWindowClose {} { destroy .sasami } # If the Img package (PNG etc) is available then load it set haveImg [expr ! [catch {package require Img}]] if {$_tkeden_variant == "dtkeden"} { if {$_dtkeden_isServer} { source $env(TKEDEN_LIB)/server.tcl } else { source $env(TKEDEN_LIB)/client.tcl } } ton .find.bot.backward -text "Backward" -underline 0 -width 8 \ -command "TextSearch $w -backwards \$caseSensitive \$searchString" button .find.botkeden1.46/lib-tkeden/edensl.eden010064400025250000147000000173440753050011200201720ustar00ashleydcsother00003520000005/* edensl.eden: Eden Symbol Lists */ /* Missing dependency on elements in l Two versions: simulation of Eden 1.x internal, and better... What would performance difference be? Perhaps not much. Range checking? Test cases */ /* Can't use edensl_define("l", 4, a) as the value of a will then be passed to the function, and we need the name. Passing &a allows us to use the nameof() function, but then we can't pass constants in as we can't have pointers to constants eg &2. So we'll have to resort to passing a string in, which is parsed by execute at the time of the function execution. This doesn't make the Eden language look too respectable: this obviously requires an interpreting parser, and will give us problems when attempting static analysis. Other attempts: `str($1)//str(i)` is (reference to the thing pointed to by $2[i]); The RHS of this is not `nameof($2[i])`: this is the current value of the thing pointed to by $2[i]. Need an eval() as don't want dependency for ever more on the value of $2[i], just its current contents. `str($1)//str(i)` is eval(nameof($2[i])); ? ... but can't do this as we can't eval() local variables (see change.log for 1.37 and 1.39). So the execute above will have to do (a shame as this means the language is not expressive enough to solve this case without resorting to a re-parse). */ /* But isn't this all just a band-aid over a fundamentally flawed implementation? +: it is enabling me to see yet more problems with Eden. -: it isn't a realistic solution. +: it should provide thesis material, but -: perhaps it isn't worth explaining within the thesis -- it is rather complex for what it is. -: probably better off concentrating on a new foundation? */ /* But can we write a function for m//n independent of its context? If we have l=m//n, we must be careful (and can possibly optimise) if m or n are l. If we have l is m//n, a change to a single element of m or n should not require a recompute of the entire concatenation. What if a concatenation is used along with other elements? What about the different types that concatenation can take? */ /* !@!@ concat to do */ ## !@!@ what if m or n are l?? proc concattol { auto i; for (i=1; i<=$1#; i++) `"l"//str(i)` = $1[i]; for (i=1; i<=$2#; i++) `"l"//str(i+$1#)` = $2[i]; ll = $1# + $2#; } ## writeln(l); ## -> bl_writeln("l"); proc bl_writeln { auto i; write("["); for (i=1; i<=`str($1)//"l"`; i++) { write(`str($1)//str(i)`); if (i < `str($1)//"l"`) write(","); } writeln("]"); } wholeproc = " %eden0 proc ?1_constructwhole : ?1l { auto i, s; s = \"%eden0\n?1 is [\"; for (i = 1; i <= ?1l; i++) { if (i != 1) s = s // \", \"; s = s // \"?1\" // str(i); } s = s // \"];\"; execute(s); } "; proc edensl_constructwhole { para l; execute(macro(wholeproc, l)); } proc edensl_assignconstruct { para l, v; auto i; `str(l)//"l"` = v#; for (i=1; i<=v#; i++) edensl_assignelement(l, i, v[i]); edensl_constructwhole(l); } proc edensl_defineconstruct { para l, sv; auto i; `str(l)//"l"` = sv#; for (i=1; i<=sv#; i++) edensl_defineelement(l, i, sv[i]); edensl_constructwhole(l); } proc edensl_assignelement { para l, i, v; if (i > `str(l)//"l"`) error("index out of range"); `str(l)//str(i)` = v; } proc edensl_defineelement { para l, i, sv; if (i > `str(l)//"l"`) error("index out of range"); execute("%eden0\n"//str(l)//str(i)//" is "//sv//";"); } proc edensl_append { para l, v; `str(l)//str((++`str(l)//"l"`))` = v; } proc edensl_delete { para l, i; auto j; if ((i < 1) || (i > `str(l)//"l"`)) error("index out of range"); for (j=i; j<=`str(l)//"l"`-1; j++) `str(l)//str(j)` = `str(l)//str(j+1)`; `str(l)//"l"`--; } proc edensl_insert { para l, i, v; auto j; if ((i < 1) || (i > `str(l)//"l"`)) error("index out of range"); for (j=`str(l)//"l"`; j>=i; j--) `str(l)//str(j+1)` = `str(l)//str(j)`; `str(l)//str(i)` = v; `str(l)//"l"`++; } proc edensl_shift { edensl_delete($1, 1); } proc edensl_assign { para l, v; if (type(v) == "list") edensl_assignconstruct(l, v); else `str(l)` = v; } edenslbuf = ""; proc edenslTransSwitch { edenslbuf = ""; } edenSymRE = "([[:alpha:]][[:alnum:]]*)"; listRefRE = "\\[([^]]*)\\]"; func edenslTransStatement { para s; auto q, l; ## l = [a, b, 42]; -> edensl_assignconstruct("l", [a, b, 42...]); s = regreplace(edenSymRE // "\\s*=\\s*" // listRefRE // "\\s*;$", "edensl_assignconstruct(\"$1\", [$2]);", s); ## l is [a, b, 42]; -> edensl_defineconstruct("l", ["a", "b", "42"...]); /* !@!@ need to escape quotes etc inside the string result */ /* !@!@ easier to quote the entire list? "[a, b, 42]" */ q = regmatch(edenSymRE // "\\s*is\\s*" // listRefRE // "\\s*;$", s); if (q != []) { /* place quotes around elements in the list */ l = regmatch(listRefRE, q[1]); /* !@!@ FIXED? "([^,]*)(,|$)" causes a crash here - whoops */ l = regreplace("\\s*([^,]*),", "\"$1\",", l[2]); l = regreplace(",\\s*([^,]*)$", ",\"$1\"", l); /* !@!@ this assumes s is only one statement */ /* now translate to procedure call */ s = "edensl_defineconstruct(\"" // q[2] // "\", [" // l // "]);"; } ## l[4] = a; -> edensl_assignelement("l", 4, a); s = regreplace(edenSymRE // "\\s*" // listRefRE // "\\s*=\\s*(.*);$", "edensl_assignelement(\"$1\", $2, $3);", s); /* note this one can't be done in standard %eden */ /* !@!@ need to escape quotes etc inside the string result */ ## l[4] is a; -> edensl_defineelement("l", 4, "a"); s = regreplace(edenSymRE // "\\s*" // listRefRE // "\\s*is\\s*(.*);$", "edensl_defineelement(\"$1\", $2, \"$3\");", s); ## l# -> ll s = regreplace(edenSymRE // "\\s*#", "$1l", s); ## l[i] on RHS (LHS catered for above) -> li s = regreplace(edenSymRE // "\\s*" // listRefRE, "$1$2", s); ## append l, v; -> edensl_append("l", v); s = regreplace("append\\s+" // edenSymRE // ",\\s*(.*)\\s*;$", "edensl_append(\"$1\", $2);", s); ## delete l, i; -> edensl_delete("l", i); s = regreplace("delete\\s+" // edenSymRE // ",\\s*(.*)\\s*;$", "edensl_delete(\"$1\", $2);", s); ## insert l, i, v; -> -> edensl_insert("l", i, v); s = regreplace("insert\\s+" // edenSymRE // ",\\s*(.*)\\s*;$", "edensl_insert(\"$1\", $2);", s); ## shift l; -> edensl_shift("l"); s = regreplace("shift\\s+" // edenSymRE // "\\s*;$", "edensl_shift(\"$1\");", s); ## l = ... -> edensl_assign("l", ...); ## "..." could be result of a func, an expression involving concatenation s = regreplace(edenSymRE // "\\s*=\\s*(.*);$", "edensl_assign(\"$1\", $2);", s); ## l is ... -> leave unchanged. Expressions involving concatenation ## etc will be handled as normal. return s; } proc edenslParseChar { para c; auto t, q, l; edenslbuf = edenslbuf // c; if (c == ';') { t = edenslTransStatement(edenslbuf); t = "%eden0\n" // t; if (eden_debug_notations) writeln(""); execute(t); edenslbuf = ""; } } /* The notation name can actually be %eden, so that this translator replaces the built-in Eden. The built-in Eden would still be accessible with %eden0. Probably need to make sure that execute, include etc all do a "%eden\n" before they run to make sure this fully works. Leave as %edensl for the time being. */ newNotation("%edensl", &edenslTransSwitch, &edenslParseChar); (l)//str(j)` = `str(l)//str(j+1)`; `str(l)//"l"`--; } proc edensl_insert { para l, i, v; auto j; if ((i < 1) || (i > `str(l)//"l"`)) error("index out of range"); for (j=`str(l)//"l"`; j>=i; j--) `str(l)//str(j+1)` = `str(l)//str(j)`; `str(l)//str(i)` = v; `str(l)//tkeden1.46/lib-tkeden/keys.txt010064400025250000147000000043360733204136400176050ustar00ashleydcsother00003520000005Some menus and buttons have key shortcuts. These are shown with an underlined letter, and can be activated by pressing Alt and that letter. For example: Accept the current input: Alt-a View the Eden Definitions window: Alt-v Alt-e Valid throughout Eden: Bring all Eden windows to the front: Shift-Control-Tab (in any window) Using the mouse in the input window: Select text: drag Select word: double-click Select words: drag after a double-click Select line: triple-click Select lines: drag after a triple-click Adjust ends of selection: Shift + drag button 1 Reposition cursor without affecting selection: Control + click Insert text at mouse cursor: click button 2 Scroll view: drag button 2 Using the keyboard in the input window: Move backwards in input history: Meta-Up or Control-Alt-Up or Alt-p Move forwards in input history: Meta-Down or Control-Alt-Down or Alt-n Cursor left: Left or Control-b Cursor right: Right or Control-f Move cursor by words: as above, with Control or Meta Move cursor to start of line: Home or Control-a Move cursor to end of line: End or Control-e Cursor up: Up or Control-p Cursor down: Down or Control-n Move cursor by paragraphs: as above, with Control Move cursor up one screenful: Prior (Page up) Move cursor down one screenful: Next (Page down) or Control-v Move cursor to start of text: Control-Home or Meta-< Move cursor to end of text: Control-End or Meta-> Select text: as above, with Shift Select all text: Control-/ Select no text: Control-\\ Copy selection to clipboard: Copy (F16) or Meta-w Cut selection to clipboard: Cut (F20) or Control-w Insert clipboard at cursor: Paste (F18) or Control-y Delete to left of cursor: Backspace or Control-h Delete to right of cursor: Delete or Control-d Delete word to right of cursor: Meta-d Delete word to left of cursor: Meta-Backspace or Meta-Delete Delete to end of line: Control-k Delete to beginning of line: Control-u Delete selection: Control-x Clear all text in input window: Meta-0 or Control-Alt-0 Open new line (insert newline): Control-o Reverse order of two characters to right of cursor: Control-t Indent: tab stops (use the Tab key) are set to two character widths tkeden1.46/lib-tkeden/rgb.txt010064400025250000147000000370400751310350200173740ustar00ashleydcsother00003520000005This is a list of all the colours that are predefined. You can use the colour name as a string to define DoNaLD attributes and SCOUT window properties. The Red, Grn (Green) and Blu (Blue) columns show you the red, green and blue components of the colour, in a range from 0 (none) to 255 (maximum). These values can be used in the rgb2color (or rgb2colour) function if you prefer. This example below shows you how to use the rgb2color (rgb2colour) function. The colour being used in this example has the predefined name of CornflowerBlue. ------------------------------------------------------------------ %donald line l l=[{10,10}, {200,200}] %scout string g; window ash = { type: TEXT string: "Ash" frame: ([{10, 10}, {100, 100}]) bgcolor : g }; screen=; %eden g is rgb2colour(ri,gi,bi); A_l is strcat("linewidth=5,color=", g); ri=100;gi=149;bi=237; ------------------------------------------------------------------- =========== COLOUR LIST =========== Red Grn Blu Colour Name --- --- --- ----------- 255 250 250 snow 248 248 255 GhostWhite 245 245 245 WhiteSmoke 220 220 220 gainsboro 255 250 240 FloralWhite 253 245 230 OldLace 250 240 230 linen 250 235 215 AntiqueWhite 255 239 213 PapayaWhip 255 235 205 BlanchedAlmond 255 228 196 bisque 255 218 185 PeachPuff 255 222 173 NavajoWhite 255 228 181 moccasin 255 248 220 cornsilk 255 255 240 ivory 255 250 205 LemonChiffon 255 245 238 seashell 240 255 240 honeydew 245 255 250 MintCream 240 255 255 azure 240 248 255 AliceBlue 230 230 250 lavender 255 240 245 LavenderBlush 255 228 225 MistyRose 255 255 255 white 0 0 0 black 47 79 79 DarkSlateGray 47 79 79 DarkSlateGrey 105 105 105 DimGray 105 105 105 DimGrey 112 128 144 SlateGray 112 128 144 SlateGrey 119 136 153 LightSlateGray 119 136 153 LightSlateGrey 190 190 190 gray 190 190 190 grey 211 211 211 LightGrey 211 211 211 LightGray 25 25 112 MidnightBlue 0 0 128 navy 0 0 128 NavyBlue 100 149 237 CornflowerBlue 72 61 139 DarkSlateBlue 106 90 205 SlateBlue 123 104 238 MediumSlateBlue 132 112 255 LightSlateBlue 0 0 205 MediumBlue 65 105 225 RoyalBlue 0 0 255 blue 30 144 255 DodgerBlue 0 191 255 DeepSkyBlue 135 206 235 SkyBlue 135 206 250 LightSkyBlue 70 130 180 SteelBlue 176 196 222 LightSteelBlue 173 216 230 LightBlue 176 224 230 PowderBlue 175 238 238 PaleTurquoise 0 206 209 DarkTurquoise 72 209 204 MediumTurquoise 64 224 208 turquoise 0 255 255 cyan 224 255 255 LightCyan 95 158 160 CadetBlue 102 205 170 MediumAquamarine 127 255 212 aquamarine 0 100 0 DarkGreen 85 107 47 DarkOliveGreen 143 188 143 DarkSeaGreen 46 139 87 SeaGreen 60 179 113 MediumSeaGreen 32 178 170 LightSeaGreen 152 251 152 PaleGreen 0 255 127 SpringGreen 124 252 0 LawnGreen 0 255 0 green 127 255 0 chartreuse 0 250 154 MediumSpringGreen 173 255 47 GreenYellow 50 205 50 LimeGreen 154 205 50 YellowGreen 34 139 34 ForestGreen 107 142 35 OliveDrab 189 183 107 DarkKhaki 240 230 140 khaki 238 232 170 PaleGoldenrod 250 250 210 LightGoldenrodYellow 255 255 224 LightYellow 255 255 0 yellow 255 215 0 gold 238 221 130 LightGoldenrod 218 165 32 goldenrod 184 134 11 DarkGoldenrod 188 143 143 RosyBrown 205 92 92 IndianRed 139 69 19 SaddleBrown 160 82 45 sienna 205 133 63 peru 222 184 135 burlywood 245 245 220 beige 245 222 179 wheat 244 164 96 SandyBrown 210 180 140 tan 210 105 30 chocolate 178 34 34 firebrick 165 42 42 brown 233 150 122 DarkSalmon 250 128 114 salmon 255 160 122 LightSalmon 255 165 0 orange 255 140 0 DarkOrange 255 127 80 coral 240 128 128 LightCoral 255 99 71 tomato 255 69 0 OrangeRed 255 0 0 red 255 105 180 HotPink 255 20 147 DeepPink 255 192 203 pink 255 182 193 LightPink 219 112 147 PaleVioletRed 176 48 96 maroon 199 21 133 MediumVioletRed 208 32 144 VioletRed 255 0 255 magenta 238 130 238 violet 221 160 221 plum 218 112 214 orchid 186 85 211 MediumOrchid 153 50 204 DarkOrchid 148 0 211 DarkViolet 138 43 226 BlueViolet 160 32 240 purple 147 112 219 MediumPurple 216 191 216 thistle 255 250 250 snow1 238 233 233 snow2 205 201 201 snow3 139 137 137 snow4 255 245 238 seashell1 238 229 222 seashell2 205 197 191 seashell3 139 134 130 seashell4 255 239 219 AntiqueWhite1 238 223 204 AntiqueWhite2 205 192 176 AntiqueWhite3 139 131 120 AntiqueWhite4 255 228 196 bisque1 238 213 183 bisque2 205 183 158 bisque3 139 125 107 bisque4 255 218 185 PeachPuff1 238 203 173 PeachPuff2 205 175 149 PeachPuff3 139 119 101 PeachPuff4 255 222 173 NavajoWhite1 238 207 161 NavajoWhite2 205 179 139 NavajoWhite3 139 121 94 NavajoWhite4 255 250 205 LemonChiffon1 238 233 191 LemonChiffon2 205 201 165 LemonChiffon3 139 137 112 LemonChiffon4 255 248 220 cornsilk1 238 232 205 cornsilk2 205 200 177 cornsilk3 139 136 120 cornsilk4 255 255 240 ivory1 238 238 224 ivory2 205 205 193 ivory3 139 139 131 ivory4 240 255 240 honeydew1 224 238 224 honeydew2 193 205 193 honeydew3 131 139 131 honeydew4 255 240 245 LavenderBlush1 238 224 229 LavenderBlush2 205 193 197 LavenderBlush3 139 131 134 LavenderBlush4 255 228 225 MistyRose1 238 213 210 MistyRose2 205 183 181 MistyRose3 139 125 123 MistyRose4 240 255 255 azure1 224 238 238 azure2 193 205 205 azure3 131 139 139 azure4 131 111 255 SlateBlue1 122 103 238 SlateBlue2 105 89 205 SlateBlue3 71 60 139 SlateBlue4 72 118 255 RoyalBlue1 67 110 238 RoyalBlue2 58 95 205 RoyalBlue3 39 64 139 RoyalBlue4 0 0 255 blue1 0 0 238 blue2 0 0 205 blue3 0 0 139 blue4 30 144 255 DodgerBlue1 28 134 238 DodgerBlue2 24 116 205 DodgerBlue3 16 78 139 DodgerBlue4 99 184 255 SteelBlue1 92 172 238 SteelBlue2 79 148 205 SteelBlue3 54 100 139 SteelBlue4 0 191 255 DeepSkyBlue1 0 178 238 DeepSkyBlue2 0 154 205 DeepSkyBlue3 0 104 139 DeepSkyBlue4 135 206 255 SkyBlue1 126 192 238 SkyBlue2 108 166 205 SkyBlue3 74 112 139 SkyBlue4 176 226 255 LightSkyBlue1 164 211 238 LightSkyBlue2 141 182 205 LightSkyBlue3 96 123 139 LightSkyBlue4 198 226 255 SlateGray1 185 211 238 SlateGray2 159 182 205 SlateGray3 108 123 139 SlateGray4 202 225 255 LightSteelBlue1 188 210 238 LightSteelBlue2 162 181 205 LightSteelBlue3 110 123 139 LightSteelBlue4 191 239 255 LightBlue1 178 223 238 LightBlue2 154 192 205 LightBlue3 104 131 139 LightBlue4 224 255 255 LightCyan1 209 238 238 LightCyan2 180 205 205 LightCyan3 122 139 139 LightCyan4 187 255 255 PaleTurquoise1 174 238 238 PaleTurquoise2 150 205 205 PaleTurquoise3 102 139 139 PaleTurquoise4 152 245 255 CadetBlue1 142 229 238 CadetBlue2 122 197 205 CadetBlue3 83 134 139 CadetBlue4 0 245 255 turquoise1 0 229 238 turquoise2 0 197 205 turquoise3 0 134 139 turquoise4 0 255 255 cyan1 0 238 238 cyan2 0 205 205 cyan3 0 139 139 cyan4 151 255 255 DarkSlateGray1 141 238 238 DarkSlateGray2 121 205 205 DarkSlateGray3 82 139 139 DarkSlateGray4 127 255 212 aquamarine1 118 238 198 aquamarine2 102 205 170 aquamarine3 69 139 116 aquamarine4 193 255 193 DarkSeaGreen1 180 238 180 DarkSeaGreen2 155 205 155 DarkSeaGreen3 105 139 105 DarkSeaGreen4 84 255 159 SeaGreen1 78 238 148 SeaGreen2 67 205 128 SeaGreen3 46 139 87 SeaGreen4 154 255 154 PaleGreen1 144 238 144 PaleGreen2 124 205 124 PaleGreen3 84 139 84 PaleGreen4 0 255 127 SpringGreen1 0 238 118 SpringGreen2 0 205 102 SpringGreen3 0 139 69 SpringGreen4 0 255 0 green1 0 238 0 green2 0 205 0 green3 0 139 0 green4 127 255 0 chartreuse1 118 238 0 chartreuse2 102 205 0 chartreuse3 69 139 0 chartreuse4 192 255 62 OliveDrab1 179 238 58 OliveDrab2 154 205 50 OliveDrab3 105 139 34 OliveDrab4 202 255 112 DarkOliveGreen1 188 238 104 DarkOliveGreen2 162 205 90 DarkOliveGreen3 110 139 61 DarkOliveGreen4 255 246 143 khaki1 238 230 133 khaki2 205 198 115 khaki3 139 134 78 khaki4 255 236 139 LightGoldenrod1 238 220 130 LightGoldenrod2 205 190 112 LightGoldenrod3 139 129 76 LightGoldenrod4 255 255 224 LightYellow1 238 238 209 LightYellow2 205 205 180 LightYellow3 139 139 122 LightYellow4 255 255 0 yellow1 238 238 0 yellow2 205 205 0 yellow3 139 139 0 yellow4 255 215 0 gold1 238 201 0 gold2 205 173 0 gold3 139 117 0 gold4 255 193 37 goldenrod1 238 180 34 goldenrod2 205 155 29 goldenrod3 139 105 20 goldenrod4 255 185 15 DarkGoldenrod1 238 173 14 DarkGoldenrod2 205 149 12 DarkGoldenrod3 139 101 8 DarkGoldenrod4 255 193 193 RosyBrown1 238 180 180 RosyBrown2 205 155 155 RosyBrown3 139 105 105 RosyBrown4 255 106 106 IndianRed1 238 99 99 IndianRed2 205 85 85 IndianRed3 139 58 58 IndianRed4 255 130 71 sienna1 238 121 66 sienna2 205 104 57 sienna3 139 71 38 sienna4 255 211 155 burlywood1 238 197 145 burlywood2 205 170 125 burlywood3 139 115 85 burlywood4 255 231 186 wheat1 238 216 174 wheat2 205 186 150 wheat3 139 126 102 wheat4 255 165 79 tan1 238 154 73 tan2 205 133 63 tan3 139 90 43 tan4 255 127 36 chocolate1 238 118 33 chocolate2 205 102 29 chocolate3 139 69 19 chocolate4 255 48 48 firebrick1 238 44 44 firebrick2 205 38 38 firebrick3 139 26 26 firebrick4 255 64 64 brown1 238 59 59 brown2 205 51 51 brown3 139 35 35 brown4 255 140 105 salmon1 238 130 98 salmon2 205 112 84 salmon3 139 76 57 salmon4 255 160 122 LightSalmon1 238 149 114 LightSalmon2 205 129 98 LightSalmon3 139 87 66 LightSalmon4 255 165 0 orange1 238 154 0 orange2 205 133 0 orange3 139 90 0 orange4 255 127 0 DarkOrange1 238 118 0 DarkOrange2 205 102 0 DarkOrange3 139 69 0 DarkOrange4 255 114 86 coral1 238 106 80 coral2 205 91 69 coral3 139 62 47 coral4 255 99 71 tomato1 238 92 66 tomato2 205 79 57 tomato3 139 54 38 tomato4 255 69 0 OrangeRed1 238 64 0 OrangeRed2 205 55 0 OrangeRed3 139 37 0 OrangeRed4 255 0 0 red1 238 0 0 red2 205 0 0 red3 139 0 0 red4 255 20 147 DeepPink1 238 18 137 DeepPink2 205 16 118 DeepPink3 139 10 80 DeepPink4 255 110 180 HotPink1 238 106 167 HotPink2 205 96 144 HotPink3 139 58 98 HotPink4 255 181 197 pink1 238 169 184 pink2 205 145 158 pink3 139 99 108 pink4 255 174 185 LightPink1 238 162 173 LightPink2 205 140 149 LightPink3 139 95 101 LightPink4 255 130 171 PaleVioletRed1 238 121 159 PaleVioletRed2 205 104 137 PaleVioletRed3 139 71 93 PaleVioletRed4 255 52 179 maroon1 238 48 167 maroon2 205 41 144 maroon3 139 28 98 maroon4 255 62 150 VioletRed1 238 58 140 VioletRed2 205 50 120 VioletRed3 139 34 82 VioletRed4 255 0 255 magenta1 238 0 238 magenta2 205 0 205 magenta3 139 0 139 magenta4 255 131 250 orchid1 238 122 233 orchid2 205 105 201 orchid3 139 71 137 orchid4 255 187 255 plum1 238 174 238 plum2 205 150 205 plum3 139 102 139 plum4 224 102 255 MediumOrchid1 209 95 238 MediumOrchid2 180 82 205 MediumOrchid3 122 55 139 MediumOrchid4 191 62 255 DarkOrchid1 178 58 238 DarkOrchid2 154 50 205 DarkOrchid3 104 34 139 DarkOrchid4 155 48 255 purple1 145 44 238 purple2 125 38 205 purple3 85 26 139 purple4 171 130 255 MediumPurple1 159 121 238 MediumPurple2 137 104 205 MediumPurple3 93 71 139 MediumPurple4 255 225 255 thistle1 238 210 238 thistle2 205 181 205 thistle3 139 123 139 thistle4 0 0 0 gray0 0 0 0 grey0 3 3 3 gray1 3 3 3 grey1 5 5 5 gray2 5 5 5 grey2 8 8 8 gray3 8 8 8 grey3 10 10 10 gray4 10 10 10 grey4 13 13 13 gray5 13 13 13 grey5 15 15 15 gray6 15 15 15 grey6 18 18 18 gray7 18 18 18 grey7 20 20 20 gray8 20 20 20 grey8 23 23 23 gray9 23 23 23 grey9 26 26 26 gray10 26 26 26 grey10 28 28 28 gray11 28 28 28 grey11 31 31 31 gray12 31 31 31 grey12 33 33 33 gray13 33 33 33 grey13 36 36 36 gray14 36 36 36 grey14 38 38 38 gray15 38 38 38 grey15 41 41 41 gray16 41 41 41 grey16 43 43 43 gray17 43 43 43 grey17 46 46 46 gray18 46 46 46 grey18 48 48 48 gray19 48 48 48 grey19 51 51 51 gray20 51 51 51 grey20 54 54 54 gray21 54 54 54 grey21 56 56 56 gray22 56 56 56 grey22 59 59 59 gray23 59 59 59 grey23 61 61 61 gray24 61 61 61 grey24 64 64 64 gray25 64 64 64 grey25 66 66 66 gray26 66 66 66 grey26 69 69 69 gray27 69 69 69 grey27 71 71 71 gray28 71 71 71 grey28 74 74 74 gray29 74 74 74 grey29 77 77 77 gray30 77 77 77 grey30 79 79 79 gray31 79 79 79 grey31 82 82 82 gray32 82 82 82 grey32 84 84 84 gray33 84 84 84 grey33 87 87 87 gray34 87 87 87 grey34 89 89 89 gray35 89 89 89 grey35 92 92 92 gray36 92 92 92 grey36 94 94 94 gray37 94 94 94 grey37 97 97 97 gray38 97 97 97 grey38 99 99 99 gray39 99 99 99 grey39 102 102 102 gray40 102 102 102 grey40 105 105 105 gray41 105 105 105 grey41 107 107 107 gray42 107 107 107 grey42 110 110 110 gray43 110 110 110 grey43 112 112 112 gray44 112 112 112 grey44 115 115 115 gray45 115 115 115 grey45 117 117 117 gray46 117 117 117 grey46 120 120 120 gray47 120 120 120 grey47 122 122 122 gray48 122 122 122 grey48 125 125 125 gray49 125 125 125 grey49 127 127 127 gray50 127 127 127 grey50 130 130 130 gray51 130 130 130 grey51 133 133 133 gray52 133 133 133 grey52 135 135 135 gray53 135 135 135 grey53 138 138 138 gray54 138 138 138 grey54 140 140 140 gray55 140 140 140 grey55 143 143 143 gray56 143 143 143 grey56 145 145 145 gray57 145 145 145 grey57 148 148 148 gray58 148 148 148 grey58 150 150 150 gray59 150 150 150 grey59 153 153 153 gray60 153 153 153 grey60 156 156 156 gray61 156 156 156 grey61 158 158 158 gray62 158 158 158 grey62 161 161 161 gray63 161 161 161 grey63 163 163 163 gray64 163 163 163 grey64 166 166 166 gray65 166 166 166 grey65 168 168 168 gray66 168 168 168 grey66 171 171 171 gray67 171 171 171 grey67 173 173 173 gray68 173 173 173 grey68 176 176 176 gray69 176 176 176 grey69 179 179 179 gray70 179 179 179 grey70 181 181 181 gray71 181 181 181 grey71 184 184 184 gray72 184 184 184 grey72 186 186 186 gray73 186 186 186 grey73 189 189 189 gray74 189 189 189 grey74 191 191 191 gray75 191 191 191 grey75 194 194 194 gray76 194 194 194 grey76 196 196 196 gray77 196 196 196 grey77 199 199 199 gray78 199 199 199 grey78 201 201 201 gray79 201 201 201 grey79 204 204 204 gray80 204 204 204 grey80 207 207 207 gray81 207 207 207 grey81 209 209 209 gray82 209 209 209 grey82 212 212 212 gray83 212 212 212 grey83 214 214 214 gray84 214 214 214 grey84 217 217 217 gray85 217 217 217 grey85 219 219 219 gray86 219 219 219 grey86 222 222 222 gray87 222 222 222 grey87 224 224 224 gray88 224 224 224 grey88 227 227 227 gray89 227 227 227 grey89 229 229 229 gray90 229 229 229 grey90 232 232 232 gray91 232 232 232 grey91 235 235 235 gray92 235 235 235 grey92 237 237 237 gray93 237 237 237 grey93 240 240 240 gray94 240 240 240 grey94 242 242 242 gray95 242 242 242 grey95 245 245 245 gray96 245 245 245 grey96 247 247 247 gray97 247 247 247 grey97 250 250 250 gray98 250 250 250 grey98 252 252 252 gray99 252 252 252 grey99 255 255 255 gray100 255 255 255 grey100 169 169 169 DarkGrey 169 169 169 DarkGray 0 0 139 DarkBlue 0 139 139 DarkCyan 139 0 139 DarkMagenta 139 0 0 DarkRed 144 238 144 LightGreen (end colours) 0 0 139 blue4 30 144 255 DodgerBlue1 28 134 238 DodgerBlue2 24 116 205 DodgerBlue3 16 78 139 DodgerBlue4 99 184 255 SteelBlue1 92 172 238 SteelBlue2 79 148 205 SteelBlue3 54 100 139 SteelBlue4 0 191 255 DeepSkyBlue1 0 178 238 DeepSkyBlue2 0 154 205 DeepSkyBlue3 0 104 139 DeepSkyBlue4 135 206 255 SkyBlue1 126 192 238 SkyBlue2 108 166 205 SkyBlue3 74 112 139 SkyBlue4 176 226 255 LightSkyBlue1 164 211 238 LightSkyBlue2 141 182 205 LightStkeden1.46/lib-tkeden/sasami.txt010064400025250000147000000041330746225727200201150ustar00ashleydcsother00003520000005------------------------- Sasami QUICK REFERENCE ----------------------------- CONTENTS OF THIS QUICK REFERENCE: 1. Syntax 2. Commands 3. Variables 4. More information -- 1. SYNTAX ----------------------------------------------------------------- No semi-colons: line feeds are terminators # UNIX shell style one-line comments Whitespace and commas are command / parameter separators Escaping to Eden: ` (back-tick) is a one-line escape to Eden. -- 2. COMMANDS --------------------------------------------------------------- open_display close_display vertex [z] polygon poly_geom_vertex poly_tex_vertex poly_colour [a] poly_material material material_ambient [a] (ambient = in darkness) material_diffuse [a] (diffuse = in normal light) material_specular [a] (specular = in direct light) material_texture object object_poly object_pos object_rot object_scale light light_pos light_enabled light_directional light_attenuation light_ambient [a] light_diffuse [a] light_specular [a] load_full_obj load_obj (loads only objects and materials into Eden) bgcolour viewport -- 3. VARIABLES -------------------------------------------------------------- sasami_viewport_xsize sasami_viewport_ysize sasami_viewport_bpp sasami_bgcolour_r sasami_bgcolour_g sasami_bgcolour_b sasami_show_axes -- 4. MORE INFORMATION ------------------------------------------------------- See http://www.dcs.warwick.ac.uk/modelling/ for more detail. tkeden1.46/lib-tkeden/scout.eden010064400025250000147000000534370751310600200200610ustar00ashleydcsother00003520000005/* * $Id: scout.eden,v 1.2 2002/07/10 19:33:21 cssbz Exp $ */ /**** * * * This file is the function library of the SCOUT system * * It contains definitions of attributes, EDEN version of * * some SCOUT functions, screen updating functions and * * its sub-functions and initialization procedures * * * ****/ /** Initialise EX **/ /* luckily these first two are the same as required by donald in donald.init.e. These must be the same values as are defined in the Scout namespace in Scout/lex.c (init_scout). Also define these in builtinf.h [Ash] */ OFF = 0; ON = 1; MOTION = 2; ENTER = 4; LEAVE = 8; CLIENT_LIST = []; /* declare a list for server end to list all connected clients */ DFfont = "{courier 10}"; DFscreen = "screen"; /* should not change this */ DFalign = 0; /* 0 - no, 1 - left, 2 - right, 3 - centre, 4 - left & right */ DFbgcolor = tcl(". cget -background"); DFfgcolor = "black"; DFbdcolor = "black"; DFborder = 0; DFrelief = "raise"; DFxmin = 0; DFymin = 0; DFxmax = 1000; DFymax = 1000; DFhighlight = 1; DFsensitive = OFF; DFwidth = 500; DFheight = 500; proc HandleDisplayResizeEvent { para widget, name, width, height; /* Ignore messages about child widgets */ if (widget == "." // name) { /* Don't redefine if the values haven't changed. This will cause "reference to undefined variable" notices if they are enabled the first time this is done. */ if ((`name//"_width"` != width) || (`name//"_height"` != height)) { execute("%scout\ninteger "//name//"_width="//str(width)// "; integer "//name//"_height="//str(height)//";"); } } } proc OpenDisplay { para name, width, height; if (name[1] >= 'A' && name[1] <= 'Z') name = "_"//name; tcl("toplevel ."//name//" -background "//DFbgcolor// " -width "//str(width)//" -height "//str(height)); tcl("wm protocol ."//name//" WM_DELETE_WINDOW { set show_"//name// " 0; show "//name//" 0;}"); tcl("wm title ."//name//" \""//name//" ($variantversion)\""); tcl("uplevel #0 {set show_"//name//" 1}"); /* the -underline here should really look through the other items in the * menu and find the first unique character to use as a key shortcut * [Ash], April 2001 */ tcl(".menu.show add checkbutton -label "//name// " -variable show_"//name//" -command {show "//name// " $show_"//name//"} -underline 1"); tcl("bind ."//name//" { " // "eden {~HandleDisplayResizeEvent(\"%W\", \""//name//"\", %w, %h);}" // " }"); HandleDisplayResizeEvent("."//name, name, width, height); execute("%scout\ndisplay ~" // name // ";\n%eden\n"); tcl("tkwait visibility ."//name); } proc DestroyDisplay { para name; if (name[1] >= 'A' && name[1] <= 'Z') name = "_"//name; tcl("destroy ."//name); tcl(".menu.show delete "//name); tcl("unset show_"//name); } func StringWidth { para win, font, string; if ((win == @) || (font == @) || (string == @)) return @; return int(tcl("font measure " // font // " -displayof ." // win // " " // "{" // string // "}")); } func FontWidth { para win, font; /* Measuring the width of the (wide) character 'W' */ return StringWidth(win, font, "W"); } func FontHeight { para win, font; return int(tcl("font metrics " // font // " -displayof ." // win // " -linespace")); } func DisplayDepth { para win; return int(tcl("winfo depth ." // win)); } /* This gets called when '%scout' is done for the first time */ proc scoutScreenInitOpen { OpenDisplay(DFscreen, DFwidth, DFheight); fontWidth is FontWidth(DFscreen, DFfont); fontHeight is FontHeight(DFscreen, DFfont); displayDepth is DisplayDepth(DFscreen); } /**** * SCOUT functions * ****/ func pt_add /* ( point, point) */ /* + (point addition) */ { return [$1[1] + $2[1], $1[2] + $2[2]]; } func pt_subtract /* ( point, point) */ /* - (point subtraction) */ { return [$1[1] - $2[1], $1[2] - $2[2]]; } func row { return $1 * fontHeight; } func column { return $1 * fontWidth; } proc update_row : fontHeight { touch(&row); } proc update_column : fontWidth { touch(&column); } func dotint /* ( list, int ) */ /* .1 (i.e. dotint(point, 1)) .2 (i.e. dotint(point, 2)) .type (i.e. dotint(window, 1)) .frame (i.e. dotint(window, 2)) .string (i.e. dotint(window, 3)) .box (i.e. dotint(window, 4)) .pict (i.e. dotint(window, 5)) .xmin (i.e. dotint(window, 6)) .ymin (i.e. dotint(window, 7)) .xmax (i.e. dotint(window, 8)) .ymax (i.e. dotint(window, 9)) .bg (i.e. dotint(window, 10)) .fg (i.e. dotint(window, 11)) .border (i.e. dotint(window, 12)) .align (i.e. dotint(window, 13)) .sensitive (i.e. dotint(window, 14)) .bordercolor (i.e. dotint(window, 15)) .font (i.e. dotint(window, 16)) .relief (i.e. dotint(window, 17)) .(int) (for frame and display) */ { return $1[int($2)]; } func dotne /* ( box ) */ /* .ne */ { return [$1[3], $1[2]]; } func dotnw /* ( box ) */ /* .nw */ { return [$1[1], $1[2]]; } func dotse /* ( box ) */ /* .se */ { return [$1[3], $1[4]]; } func dotsw /* ( box ) */ /* .sw */ { return [$1[1], $1[4]]; } func dotn /* ( box ) */ /* .n */ { return [($1[1] + $1[3]) / 2, $1[2]]; } func dote /* ( box ) */ /* .e */ { return [$1[3], ($1[2] + $1[4]) / 2]; } func dots /* ( box ) */ /* .s */ { return [($1[1] + $1[3]) / 2, $1[4]]; } func dotw /* ( box ) */ /* .w */ { return [$1[1], ($1[2] + $1[4]) / 2]; } func boxshift /* ( box, x, y ) */ { para box, x, y; return [box[1] + x, box[2] + y, box[3] + x, box[4] + y]; } func app /* ( list, position, element ) */ /* append (for both frame and display) */ { insert $1, int($2) + 1, $3; return $1; } func del /* ( list, position ) */ /* delete (for both frame and display) */ { delete $1, $2; return $1; } func list_append /* ( list, list ) */ /* & (for both frame and display) */ { return $1 // $2; } func formbox /* ( point, point ) */ /* constructor of box : < P1, P2 > */ { return [$1[1], $1[2], $2[1], $2[2]]; } proc update_textbox : column, row { touch(&textbox); } func textbox { return [$1[1], $1[2], $1[1] + column($3) + 1, $1[2] + row($2) - 1]; } func box_width /* ( box ) */ /* return the width of the box in pixel */ { return $1[3] - $1[1] + 1; } func box_height /* ( box ) */ /* return the height of the box in pixel */ { return $1[4] - $1[2] + 1; } func capacity /* ( box ) */ /* return [r, c], no of row and no of col the box can hold */ { return [($1[4] - $1[2] - 1) / fontHeight, ($1[3] - $1[1] - 1) / fontWidth]; } /*** * string manipulating functions * ***/ /* this doesn't seem to be used anywhere [Ash] */ func Quote { para s; auto ret, i; if (type(s) != "string") { return str(s); } ret = "\""; for (i = 1; i <= s#; i++) { switch (s[i]) { case '"': ret = ret // "\\\""; break; case '\\': ret = ret // "\\\\"; break; default: ret = ret // s[i]; break; } } return ret // "\""; } /** * image related functions * **/ /* return the height of an image */ func ImageHeight { return tcl("image height "//$1); } /* return the width of an image */ func ImageWidth { return tcl("image width "//$1); } /* read, name and return the image from file image format currently available are ppm and gif */ func ImageFile { para imageName, type, filename; xoutput("image create photo", imageName, "-format", type, "-file", filename); return imageName; } func isInteger { return ($1 == int($1)); } /* scale the srcImage, name and return the scaled image as imageName */ /* This function uses the external utility pnmscale to do the job as Tcl can only currently scale images by integer amounts, and requires "zoom" for positive and "subsample" for negative amounts. Unfortunately the pnm utilities seem to be quite a UNIX thing and getting this way of things to work on Windoz could be quite a headache. :(. Anyway - if you want to fudge a scaled image using only Tcl, use something like xoutput("image create photo ", imageName); xoutput(imageName, "copy", srcImage, "-subsample 3"); return imageName here. [Ash, Sept 2000] */ func ImageScale { para imageName, srcImage, xscale, yscale; writeln("ImageScale: xscale ", xscale, " yscale ", yscale); if ((isInteger(xscale*10)) && (isInteger(yscale*10))) { xoutput("image create photo ", imageName); /* see man photo(n) for -subsample details */ xoutput(imageName, "copy", srcImage, "-subsample " // str(int(xscale*10)) // " " // str(int(yscale*10))); return imageName; } else { tcl("image create photo "//imageName); xoutput(srcImage, "write /tmp/1"//imageName); xoutput("exec pnmscale -xscale", xscale, "-yscale", yscale, "/tmp/1"//imageName, "> /tmp/2"//imageName); xoutput(imageName, "read /tmp/2"//imageName); xoutput("exec rm /tmp/1"//imageName, "/tmp/2"//imageName); return imageName; } } /* cut a rectangle out of the srcImage, name and return result as imageName */ func ImageCut { para imageName, srcImage, x, y, width, height; tcl("image create photo "//imageName); xoutput(srcImage, "write /tmp/1"//imageName); xoutput("exec pnmcut", x, y, width, height, "/tmp/1"//imageName, "> /tmp/2"//imageName); xoutput(imageName, "read /tmp/2"//imageName); xoutput("exec rm /tmp/1"//imageName, "/tmp/2"//imageName); return imageName; } /* create pattern using ppmpat */ /* ppmpat generates ascii PPM which cannot be recognised by Tk */ func ImagePat { para imageName, form, width, height; tcl("image create photo "//imageName); xoutput("exec ppmpat -"//form, width, height, "> /tmp/1"//imageName); xoutput(imageName, "read /tmp/1"//imageName); xoutput("exec rm /tmp/1"//imageName); return imageName; } /* procedure for displaying an image */ proc ShowImage { para I_source, source; auto command, i, width, height; for (i = 1; i <= (*source)#; i++) { command = "."//(*source)[i][1]//"."//(*source)[i][2]; width = int(tcl(command//" cget -width")); height = int(tcl(command//" cget -height")); xoutput(command, "create image", width / 2, height / 2, "-tags image -image", *I_source); } } / screen updating actions / func Position { para bd, width, just; auto x, j, anchor; switch (int(just)) { case 1: x = 0; j = "left"; anchor = "nw"; break; case 2: x = width; j = "right"; anchor = "ne"; break; case 3: x = width / 2; j = "center"; anchor = "n"; break; case 0: case 4: /* not supported by Tk */ default: x = 0; j = "left"; anchor = "nw"; break; } return str(int(bd + x))//" "//str(int(bd))//" -anchor "//anchor //" -justify "//j; } proc scout_show_2D /* display a DoNaLD/ARCA picture */ { para screen, winNo, boxName; /* writeln("scout_show_2D: ", $); */ scout_show_2D_window(`screen`[winNo], "."//screen//"."//boxName//"_1", boxName//"_1"); } proc dobinding { para sensitive, widget, windowName, var, boxNumber; auto mouseName, keyName, mousePosName, mouseEnterName, mouseLeaveName, xCoord, yCoord, mouseClickName, mouseClickStuff; sensitive = int(sensitive); /* yuk - integerhonest hack [Ash] */ if (boxNumber > 0) { /* TEXT - have the boxNumber within the frame to deal with */ mouseName = "~"//windowName//"_mouse_"//str(boxNumber); keyName = "~"//windowName//"_key_"//str(boxNumber); mousePosName = "~"//windowName//"_mousePos_"//str(boxNumber); mouseEnterName = "~"//windowName//"_mouseEnter_"//str(boxNumber); mouseLeaveName = "~"//windowName//"_mouseLeave_"//str(boxNumber); mouseClickName = "~"//windowName//"_mouseClick"; xCoord = "%x"; yCoord = "%y"; } else { /* not TEXT - no boxNumber but must correct for window coordinate system */ mouseName = "~"//windowName//"_mouse"; keyName = "~"//windowName//"_key"; mousePosName = "~"//windowName//"_mousePos"; mouseEnterName = "~"//windowName//"_mouseEnter"; mouseLeaveName = "~"//windowName//"_mouseLeave"; mouseClickName = "~"//windowName//"_mouseClick"; xCoord = "[expr (%x-$"//var//"_xOrigin)/$"//var//"_xScale]"; yCoord = "[expr (%y-$"//var//"_yOrigin)/$"//var//"_yScale]"; } if (sensitive bitand ON) { /* the window is interested in mouse actions and key strokes */ /* implement some old, deprecated features if required */ if (tkeden_vbfeatures == 1) { mouseClickStuff = mouseClickName // " = TRUE;\\n"; } else { mouseClickStuff = ""; } xoutput("bind", widget, "