1implement GR; 2 3include "sys.m"; 4 sys: Sys; 5 print, sprint: import sys; 6include "math.m"; 7 math: Math; 8 ceil, fabs, floor, Infinity, log10, pow10, sqrt: import math; 9include "draw.m"; 10 screen: ref Draw->Screen; 11include "tk.m"; 12 tk: Tk; 13 Toplevel: import tk; 14include "tkclient.m"; 15 tkclient: Tkclient; 16include "gr.m"; 17 18gr_cfg := array[] of { 19 "frame .fc", 20 "frame .fc.b", 21 "label .fc.b.xy -text {0 0} -anchor e", 22 "pack .fc.b.xy -fill x", 23 "pack .fc.b -fill both -expand 1", 24 "canvas .fc.c -relief sunken -bd 2 -width 600 -height 480 -bg white"+ 25 " -font /fonts/lucidasans/unicode.8.font", 26 "pack .fc.c -fill both -expand 1", 27 "pack .Wm_t -fill x", 28 "pack .fc -fill both -expand 1", 29 "pack propagate . 0", 30 "bind .fc.c <ButtonPress-1> {send grcmd down1,%x,%y}", 31}; 32 33TkCmd(t: ref Toplevel, arg: string): string 34{ 35 rv := tk->cmd(t,arg); 36 if(rv!=nil && rv[0]=='!') 37 print("tk->cmd(%s): %s\n",arg,rv); 38 return rv; 39} 40 41 42open(ctxt: ref Draw->Context, title: string): ref Plot 43{ 44 if(sys==nil){ 45 sys = load Sys Sys->PATH; 46 math = load Math Math->PATH; 47 tk = load Tk Tk->PATH; 48 tkclient = load Tkclient Tkclient->PATH; 49 tkclient->init(); 50 } 51 textsize := 8.; # textsize is in points, if no user transform 52 (t, tb) := tkclient->toplevel(ctxt, "", title, Tkclient->Appl); 53 cc := chan of string; 54 tk->namechan(t, cc, "grcmd"); 55 p := ref Plot(nil, Infinity,-Infinity,Infinity,-Infinity, textsize, t, tb, cc); 56 for (i:=0; i<len gr_cfg; i++) 57 tk->cmd(p.t,gr_cfg[i]); 58 tkclient->onscreen(p.t, nil); 59 tkclient->startinput(p.t, "kbd"::"ptr"::nil); 60 return p; 61} 62 63Plot.bye(p: self ref Plot) 64{ 65 cmdloop: for(;;) alt { 66 s := <-p.t.ctxt.kbd => 67 tk->keyboard(p.t, s); 68 s := <-p.t.ctxt.ptr => 69 tk->pointer(p.t, *s); 70 s := <-p.t.ctxt.ctl or 71 s = <-p.t.wreq or 72 s = <-p.titlechan => 73 if(s == "exit") 74 break cmdloop; 75 tkclient->wmctl(p.t, s); 76 case s{ 77 "size" => 78 canvw := int TkCmd(p.t, ".fc.c cget -width"); 79 canvh := int TkCmd(p.t, ".fc.c cget -height"); 80 TkCmd(p.t,".fc.b.xy configure -text {"+sprint("%d %d",canvw,canvh)+"}"); 81 } 82 press := <-p.canvaschan => 83 (nil,cmds) := sys->tokenize(press,","); 84 if(cmds==nil) continue; 85 case hd cmds { 86 "down1" => 87 xpos := real(hd tl cmds); 88 ypos := real(hd tl tl cmds); 89 x := (xpos-bx)/ax; 90 y := -(ypos-tky+by)/ay; 91 TkCmd(p.t,".fc.b.xy configure -text {"+sprint("%.3g %.3g",x,y)+"}"); 92 } 93 } 94 TkCmd(p.t,"destroy .;update"); 95 p.t = nil; 96} 97 98Plot.equalxy(p: self ref Plot) 99{ 100 r := 0.; 101 if( r < p.xmax - p.xmin ) r = p.xmax - p.xmin; 102 if( r < p.ymax - p.ymin ) r = p.ymax - p.ymin; 103 m := (p.xmax + p.xmin)/2.; 104 p.xmax = m + r/2.; 105 p.xmin = m - r/2.; 106 m = (p.ymax + p.ymin)/2.; 107 p.ymax = m + r/2.; 108 p.ymin = m - r/2.; 109} 110 111Plot.graph(p: self ref Plot, x, y: array of real) 112{ 113 n := len x; 114 op := OP(GR->GRAPH, n, array[n] of real, array[n] of real, nil); 115 while(n--){ 116 t := x[n]; 117 op.x[n] = t; 118 if(t < p.xmin) 119 p.xmin = t; 120 if(t > p.xmax) 121 p.xmax = t; 122 t = y[n]; 123 op.y[n] = t; 124 if(t < p.ymin) 125 p.ymin = t; 126 if(t > p.ymax) 127 p.ymax = t; 128 } 129 p.op = op :: p.op; 130} 131 132Plot.text(p: self ref Plot, justify: int, s: string, x, y: real) 133{ 134 op := OP(GR->TEXT, justify, array[1] of real, array[1] of real, s); 135 op.x[0] = x; 136 op.y[0] = y; 137 p.op = op :: p.op; 138} 139 140Plot.pen(p: self ref Plot, nib: int) 141{ 142 p.op = OP(GR->PEN, nib, nil, nil, nil) :: p.op; 143} 144 145 146#--------------------------------------------------------- 147# The rest of this file is concerned with sending the "display list" 148# to Tk. The only interesting parts of the problem are picking axes 149# and drawing dashed lines properly. 150 151ax, bx, ay, by: real; # transform user to pixels 152tky: con 630.; # Tk_y = tky - y 153nseg: int; # how many segments in current stroke path 154pendown: int; # is pen currently drawing? 155xoff := array[] of{"w","","e"}; # LJUST, CENTER, RJUST 156yoff := array[] of{"n","","s","s"}; # HIGH, MED, BASE, LOW 157linewidth: real; 158toplevel: ref Toplevel; # p.t 159tkcmd: string; 160 161mv(x, y: real) 162{ 163 tkcmd = sprint(".fc.c create line %.1f %.1f", ax*x+bx, tky-(ay*y+by)); 164} 165 166stroke() 167{ 168 if(pendown){ 169 tkcmd += " -width 3"; # -capstyle round -joinstyle round 170 TkCmd(toplevel,tkcmd); 171 tkcmd = nil; 172 pendown = 0; 173 nseg = 0; 174 } 175} 176 177vec(x, y: real) 178{ 179 tkcmd += sprint(" %.1f %.1f", ax*x+bx, tky-(ay*y+by)); 180 pendown = 1; 181 nseg++; 182 if(nseg>1000){ 183 stroke(); 184 mv(x,y); 185 } 186} 187 188circle(u, v, radius: real) 189{ 190 x := ax*u+bx; 191 y := tky-(ay*v+by); 192 r := radius*(ax+ay)/2.; 193 tkcmd = sprint(".fc.c create oval %.1f %.1f %.1f %.1f -width 3", 194 x-r, y-r, x+r, y+r); 195 TkCmd(toplevel,tkcmd); 196 tkcmd = nil; 197} 198 199text(s: string, x, y: real, xoff, yoff: string) 200{ 201 # rot = rotation in degrees. 90 is used for y-axis 202 # x,y are in PostScript coordinate system, not user 203 anchor := yoff + xoff; 204 if(anchor!="") 205 anchor = "-anchor " + anchor + " "; 206 tkcmd = sprint(".fc.c create text %.1f %.1f %s-text '%s", 207 ax*x+bx, 208 tky-(ay*y+by), anchor, s); 209 TkCmd(toplevel,tkcmd); 210 tkcmd = nil; 211} 212 213datarange(xmin, xmax, margin: real): (real,real) 214{ 215 r := 1.e-30; 216 if( r < 0.001*fabs(xmin) ) 217 r = 0.001*fabs(xmin); 218 if( r < 0.001*fabs(xmax) ) 219 r = 0.001*fabs(xmax); 220 if( r < xmax-xmin ) 221 r = xmax-xmin; 222 r *= 1.+2.*margin; 223 x0 :=(xmin+xmax)/2. - r/2.; 224 return ( x0, x0 + r); 225} 226 227dashed(ndash: int, x, y: array of real) 228{ 229 cx, cy: real; # current position 230 d: real; # length undone in p[i],p[i+1] 231 t: real; # length undone in current dash 232 n := len x; 233 if(n!=len y || n<=0) 234 return; 235 236 # choose precise dashlen 237 s := 0.; 238 for(i := 0; i < n - 1; i += 1){ 239 u := x[i+1] - x[i]; 240 v := y[i+1] - y[i]; 241 s += sqrt(u*u + v*v); 242 } 243 i = int floor(real ndash * s); 244 if(i < 2) 245 i = 2; 246 dashlen := s / real(2 * i - 1); 247 248 t = dashlen; 249 ink := 1; 250 mv(x[0], y[0]); 251 cx = x[0]; 252 cy = y[0]; 253 for(i = 0; i < n - 1; i += 1){ 254 u := x[i+1] - x[i]; 255 v := y[i+1] - y[i]; 256 d = sqrt(u * u + v * v); 257 if(d > 0.){ 258 u /= d; 259 v /= d; 260 while(t <= d){ 261 cx += t * u; 262 cy += t * v; 263 if(ink){ 264 vec(cx, cy); 265 stroke(); 266 }else{ 267 mv(cx, cy); 268 } 269 d -= t; 270 t = dashlen; 271 ink = 1 - ink; 272 } 273 cx = x[i+1]; 274 cy = y[i+1]; 275 if(ink){ 276 vec(cx, cy); 277 }else{ 278 mv(cx, cy); 279 } 280 t -= d; 281 } 282 } 283 stroke(); 284} 285 286labfmt(x:real): string 287{ 288 lab := sprint("%.6g",x); 289 if(len lab>2){ 290 if(lab[0]=='0' && lab[1]=='.') 291 lab = lab[1:]; 292 else if(lab[0]=='-' && len lab>3 && lab[1]=='0' && lab[2]=='.') 293 lab = "-"+lab[2:]; 294 } 295 return lab; 296} 297 298Plot.paint(p: self ref Plot, xlabel, xunit, ylabel, yunit: string) 299{ 300 oplist: list of OP; 301 302 # tunable parameters for dimensions of graph (fraction of box side) 303 margin: con 0.075; # separation of data from box boundary 304 ticksize := 0.02; 305 sep := ticksize; # separation of text from box boundary 306 307 # derived coordinates of various feature points... 308 x0, x1, y0, y1: real; # box corners, in original coord 309 # radius := 0.2*p.textsize; # radius for circle marker 310 radius := 0.8*p.textsize; # radius for circle marker 311 312 Pen := SOLID; 313 width := SOLID; 314 linewidth = 2.; 315 nseg = 0; 316 pendown = 0; 317 318 if(xunit=="") xunit = nil; 319 if(yunit=="") yunit = nil; 320 321 (x0,x1) = datarange(p.xmin,p.xmax,margin); 322 ax = (400.-2.*p.textsize)/((x1-x0)*(1.+2.*sep)); 323 bx = 506.-ax*x1; 324 (y0,y1) = datarange(p.ymin,p.ymax,margin); 325 ay = (400.-2.*p.textsize)/((y1-y0)*(1.+2.*sep)); 326 by = 596.-ay*y1; 327 # PostScript version 328 # magic numbers here come from BoundingBox: 106 196 506 596 329 # (x0,x1) = datarange(p.xmin,p.xmax,margin); 330 # ax = (400.-2.*p.textsize)/((x1-x0)*(1.+2.*sep)); 331 # bx = 506.-ax*x1; 332 # (y0,y1) = datarange(p.ymin,p.ymax,margin); 333 # ay = (400.-2.*p.textsize)/((y1-y0)*(1.+2.*sep)); 334 # by = 596.-ay*y1; 335 336 # convert from fraction of box to PostScript units 337 ticksize *= ax*(x1-x0); 338 sep *= ax*(x1-x0); 339 340 # revert to original drawing order 341 log := p.op; 342 oplist = nil; 343 while(log!=nil){ 344 oplist = hd log :: oplist; 345 log = tl log; 346 } 347 p.op = oplist; 348 349 toplevel = p.t; 350 #------------send display list to Tk----------------- 351 while(oplist!=nil){ 352 op := hd oplist; 353 n := op.n; 354 case op.code{ 355 GRAPH => 356 if(Pen == DASHED){ 357 dashed(17, op.x, op.y); 358 }else if(Pen == DOTTED){ 359 dashed(85, op.x, op.y); 360 }else{ 361 for(i:=0; i<n; i++){ 362 xx := op.x[i]; 363 yy := op.y[i]; 364 if(Pen == CIRCLE){ 365 circle(xx, yy, radius/(ax+ay)); 366 }else if(Pen == CROSS){ 367 mv(xx-radius/ax, yy); 368 vec(xx+radius/ax, yy); 369 stroke(); 370 mv(xx, yy-radius/ay); 371 vec(xx, yy+radius/ay); 372 stroke(); 373 }else if(Pen == INVIS){ 374 }else{ 375 if(i==0){ 376 mv(xx, yy); 377 }else{ 378 vec(xx, yy); 379 } 380 } 381 } 382 stroke(); 383 } 384 TEXT => 385 angle := 0.; 386 if(op.n&UP) angle = 90.; 387 text(op.t,op.x[0],op.y[0],xoff[n&7],yoff[(n>>3)&7]); 388 PEN => 389 Pen = n; 390 if( Pen==SOLID && width!=SOLID ){ 391 linewidth = 2.; 392 width=SOLID; 393 }else if( Pen==REFERENCE && width!=REFERENCE ){ 394 linewidth = 0.8; 395 width=REFERENCE; 396 } 397 } 398 oplist = tl oplist; 399 } 400 401 #--------------------now add axes----------------------- 402 mv(x0,y0); 403 vec(x1,y0); 404 vec(x1,y1); 405 vec(x0,y1); 406 vec(x0,y0); 407 stroke(); 408 409 # x ticks 410 (lab1,labn,labinc,k,u,s) := mytic(x0,x1); 411 for (i := lab1; i <= labn; i += labinc){ 412 r := real i*s*u; 413 mv(r,y0); 414 vec(r,y0+ticksize/ay); 415 stroke(); 416 mv(r,y1); 417 vec(r,y1-ticksize/ay); 418 stroke(); 419 text(labfmt(real i*s),r,y0-sep/ay,"","n"); 420 } 421 yy := y0-(2.*sep+p.textsize)/ay; 422 labelstr := ""; 423 if(xlabel!=nil) 424 labelstr = xlabel; 425 if(k!=0||xunit!=nil) 426 labelstr += " /"; 427 if(k!=0) 428 labelstr += " ₁₀"+ string k; 429 if(xunit!=nil) 430 labelstr += " " + xunit; 431 text(labelstr,(x0+x1)/2.,yy,"","n"); 432 433 # y ticks 434 (lab1,labn,labinc,k,u,s) = mytic(y0,y1); 435 for (i = lab1; i <= labn; i += labinc){ 436 r := real i*s*u; 437 mv(x0,r); 438 vec(x0+ticksize/ax,r); 439 stroke(); 440 mv(x1,r); 441 vec(x1-ticksize/ax,r); 442 stroke(); 443 text(labfmt(real i*s),x0-sep/ax,r,"e",""); 444 } 445 xx := x0-(4.*sep+p.textsize)/ax; 446 labelstr = ""; 447 if(ylabel!=nil) 448 labelstr = ylabel; 449 if(k!=0||yunit!=nil) 450 labelstr += " /"; 451 if(k!=0) 452 labelstr += " ₁₀"+ string k; 453 if(yunit!=nil) 454 labelstr += " " + yunit; 455 text(labelstr,xx,(y0+y1)/2.,"e",""); 456 457 TkCmd(p.t, "update"); 458} 459 460 461 462# automatic tic choice Eric Grosse 9 Dec 84 463# Input: low and high endpoints of expanded data range 464# Output: lab1, labn, labinc, k, u, s where the tics are 465# (lab1*s, (lab1+labinc)*s, ..., labn*s) * 10^k 466# and u = 10^k. k is metric, i.e. k=0 mod 3. 467 468max3(a, b, c: real): real 469{ 470 if(a<b) a=b; 471 if(a<c) a=c; 472 return(a); 473} 474 475my_mod(i, n: int): int 476{ 477 while(i< 0) i+=n; 478 while(i>=n) i-=n; 479 return(i); 480} 481 482mytic(l, h: real): (int,int,int,int,real,real) 483{ 484 lab1, labn, labinc, k, nlab, j, ndig, t1, tn: int; 485 u, s: real; 486 eps := .0001; 487 k = int floor( log10((h-l)/(3.+eps)) ); 488 u = pow10(k); 489 t1 = int ceil(l/u-eps); 490 tn = int floor(h/u+eps); 491 lab1 = t1; 492 labn = tn; 493 labinc = 1; 494 nlab = labn - lab1 + 1; 495 if( nlab>5 ){ 496 lab1 = t1 + my_mod(-t1,2); 497 labn = tn - my_mod( tn,2); 498 labinc = 2; 499 nlab = (labn-lab1)/labinc + 1; 500 if( nlab>5 ){ 501 lab1 = t1 + my_mod(-t1,5); 502 labn = tn - my_mod( tn,5); 503 labinc = 5; 504 nlab = (labn-lab1)/labinc + 1; 505 if( nlab>5 ){ 506 u *= 10.; 507 k++; 508 lab1 = int ceil(l/u-eps); 509 labn = int floor(h/u+eps); 510 nlab = labn - lab1 + 1; 511 labinc = 1; 512 } else if( nlab<3 ){ 513 lab1 = t1 + my_mod(-t1,4); 514 labn = tn - my_mod( tn,4); 515 labinc = 4; 516 nlab = (labn-lab1)/labinc + 1; 517 } 518 } 519 } 520 ndig = int(1.+floor(log10(max3(fabs(real lab1),fabs(real labn),1.e-30)))); 521 if( ((k<=0)&&(k>=-ndig)) # no zeros have to be added 522 || ((k<0)&&(k>=-3)) 523 || ((k>0)&&(ndig+k<=4)) ){ # even with zeros, label is small 524 s = u; 525 k = 0; 526 u = 1.; 527 }else if(k>0){ 528 s = 1.; 529 j = ndig; 530 while(k%3!=0){ 531 k--; 532 u/=10.; 533 s*=10.; 534 j++; 535 } 536 if(j-3>0){ 537 k+=3; 538 u*=1000.; 539 s/=1000.; 540 } 541 }else{ # k<0 542 s = 1.; 543 j = ndig; 544 while(k%3!=0){ 545 k++; 546 u*=10.; 547 s/=10.; 548 j--; 549 } 550 if(j<0){ 551 k-=3; 552 u/=1000.; 553 s*=1000.; 554 } 555 } 556 return (lab1, labn, labinc, k, u, s); 557} 558