diff options
Diffstat (limited to 'appl/spree/other')
| -rw-r--r-- | appl/spree/other/tst.b | 151 | ||||
| -rw-r--r-- | appl/spree/other/tstboing.b | 158 | ||||
| -rwxr-xr-x | appl/spree/other/tstlines.sh | 53 | ||||
| -rw-r--r-- | appl/spree/other/tstwin.b | 351 |
4 files changed, 713 insertions, 0 deletions
diff --git a/appl/spree/other/tst.b b/appl/spree/other/tst.b new file mode 100644 index 00000000..3b35fefa --- /dev/null +++ b/appl/spree/other/tst.b @@ -0,0 +1,151 @@ +implement Tst; +include "sys.m"; + sys: Sys; +include "draw.m"; + draw: Draw; + Point, Rect: import draw; +include "bufio.m"; + bufio: Bufio; + Iobuf: import bufio; + +Tst: module +{ + init: fn(ctxt: ref Draw->Context, argv: list of string); +}; + +File: adt { + name: string; + fd: ref Sys->FD; + pid: int; +}; + +files: list of ref File; + +stderr: ref Sys->FD; +outputch: chan of chan of string; +init(ctxt: ref Draw->Context, argv: list of string) +{ + sys = load Sys Sys->PATH; + stderr = sys->fildes(2); + bufio = load Bufio Bufio->PATH; + sys->print(":cardtst\n"); + stdin := bufio->fopen(sys->fildes(0), Sys->OREAD); + line := ""; + currfd: ref Sys->FD; + outputch = chan of chan of string; + spawn outputproc(); + while ((s := stdin.gets('\n')) != nil) { + if (len s > 1 && s[len s - 2] == '\\') + line += s[0:len s - 2] + "\n"; + else { + s = line + s; + line = nil; + if (s[0] == ':') { + (nil, toks) := sys->tokenize(s, " \n"); + case hd toks { + ":open" => + if (tl toks == nil) { + sys->fprint(stderr, "usage: open file\n"); + continue; + } + f := open(hd tl toks); + if (f != nil) { + currfd = f.fd; + sys->print("current file is now %s\n", f.name); + } + ":close" => + if (tl toks == nil) { + sys->fprint(stderr, "usage: close file\n"); + continue; + } + fl := files; + f: ref File; + for (files = nil; fl != nil; fl = tl fl) { + if ((hd fl).name == hd tl toks) + f = hd fl; + else + files = hd fl :: files; + } + if (f == nil) { + sys->fprint(stderr, "unknown file '%s'\n", hd tl toks); + continue; + } + sys->fprint(f.fd, ""); + f = nil; + ":files" => + for (fl := files; fl != nil; fl = tl fl) { + if ((hd fl).fd == currfd) + sys->print(":%s <--- current\n", (hd fl).name); + else + sys->print(":%s\n", (hd fl).name); + } + * => + for (fl := files; fl != nil; fl = tl fl) + if ((hd fl).name == (hd toks)[1:]) + break; + if (fl == nil) { + sys->fprint(stderr, "unknown file '%s'\n", (hd toks)[1:]); + continue; + } + currfd = (hd fl).fd; + } + } else if (currfd == nil) + sys->fprint(stderr, "no current file\n"); + else if (len s > 1 && sys->fprint(currfd, "%s", s[0:len s - 1]) == -1) + sys->fprint(stderr, "command failed: %r\n"); + } + } + for (fl := files; fl != nil; fl = tl fl) + kill((hd fl).pid); + outputch <-= nil; +} + +open(f: string): ref File +{ + fd := sys->open("/n/remote/" + f, Sys->ORDWR); + if (fd == nil) { + sys->fprint(stderr, "cannot open %s: %r\n", f); + return nil; + } + sync := chan of int; + spawn updateproc(f, fd, sync); + files = ref File(f, fd, <-sync) :: files; + sys->print("opened %s\n", f); + return hd files; +} + +updateproc(name: string, fd: ref Sys->FD, sync: chan of int) +{ + sync <-= sys->pctl(0, nil); + c := chan of string; + buf := array[Sys->ATOMICIO] of byte; + while ((n := sys->read(fd, buf, len buf)) > 0) { + (nt, toks) := sys->tokenize(string buf[0:n], "\n"); + outputch <-= c; + c <-= "++ " + name + ":\n"; + for (; toks != nil; toks = tl toks) + c <-= sys->sprint("+%s\n", hd toks); + c <-= nil; + } + if (n < 0) + sys->fprint(stderr, "cards: error reading %s: %r\n", name); + sys->fprint(stderr, "cards: updateproc (%s) exiting\n", name); +} + +outputproc() +{ + for (;;) { + c := <-outputch; + if (c == nil) + exit; + while ((s := <-c) != nil) + sys->print("%s", s); + } +} + +kill(pid: int) +{ + if ((fd := sys->open("/prog/"+string pid+"/ctl", Sys->OWRITE)) != nil) + sys->write(fd, array of byte "kill", 4); +} + diff --git a/appl/spree/other/tstboing.b b/appl/spree/other/tstboing.b new file mode 100644 index 00000000..a599a0ab --- /dev/null +++ b/appl/spree/other/tstboing.b @@ -0,0 +1,158 @@ +implement Tst; + +include "sys.m"; + sys: Sys; +include "draw.m"; + draw: Draw; + Point, Rect: import draw; +include "sh.m"; + sh: Sh; + Context: import Sh; +include "math.m"; + math: Math; +ZERO: con 1e-6; + +stderr: ref Sys->FD; + +Tst: module { + init: fn(nil: ref Draw->Context, argv: list of string); +}; +π: con Math->Pi; +Maxδ: con π / 4.0; + +init(nil: ref Draw->Context, argv: list of string) +{ + sys = load Sys Sys->PATH; + stderr = sys->fildes(2); + math = load Math Math->PATH; + if (len argv != 9) { + sys->fprint(stderr, "args?\n"); + exit; + } + ar := argv2r(tl argv); + br := argv2r(tl tl tl tl tl argv); + + a := Line.new(ar.min, ar.max); # ball + b := Line.new(br.min, br.max); # bat + (hit, hitp, s, t) := b.intersection(a.p, a.v); + if (hit) { + nv := boing(a.v, b); + rl := ref Line(hitp, nv, 50.0); + ballθ := a.θ(); + batθ := b.θ(); + φ := ballθ - batθ; + δ: real; + if (math->sin(φ) > 0.0) + δ = (t / b.s) * Maxδ * 2.0 - Maxδ; + else + δ = (t / b.s) * -Maxδ * 2.0 + Maxδ; + nl := Line.newpolar(rl.p, rl.θ() + δ, rl.s); + sys->print("%s %s %s\n", p2s(rl.point(0.0)), p2s(rl.point(rl.s)), p2s(nl.point(nl.s))); + } else + sys->fprint(stderr, "no hit\n"); +} + +argv2r(v: list of string): Rect +{ + r: Rect; + (r.min.x, v) = (int hd v, tl v); + (r.min.y, v) = (int hd v, tl v); + (r.max.x, v) = (int hd v, tl v); + (r.max.y, v) = (int hd v, tl v); + return r; +} +Line: adt { + p, v: Realpoint; + s: real; + new: fn(p1, p2: Point): ref Line; + hittest: fn(l: self ref Line, p: Point): (Realpoint, real, real); + intersection: fn(b: self ref Line, p, v: Realpoint): (int, Realpoint, real, real); + point: fn(b: self ref Line, s: real): Point; + θ: fn(b: self ref Line): real; + newpolar: fn(p: Realpoint, θ: real, s: real): ref Line; +}; + +Realpoint: adt { + x, y: real; +}; + +Line.new(p1, p2: Point): ref Line +{ + ln := ref Line; + ln.p = (real p1.x, real p1.y); + v := Realpoint(real (p2.x - p1.x), real (p2.y - p1.y)); + ln.s = math->sqrt(v.x * v.x + v.y * v.y); + if (ln.s > ZERO) + ln.v = (v.x / ln.s, v.y / ln.s); + else + ln.v = (1.0, 0.0); + return ln; +} + +Line.newpolar(p: Realpoint, θ: real, s: real): ref Line +{ + l := ref Line; + l.p = p; + l.s = s; + l.v = (math->cos(θ), math->sin(θ)); + return l; +} + +Line.θ(l: self ref Line): real +{ + return math->atan2(l.v.y, l.v.x); +} + +# return normal from line, perpendicular distance from line and distance down line +Line.hittest(l: self ref Line, ip: Point): (Realpoint, real, real) +{ + p := Realpoint(real ip.x, real ip.y); + v := Realpoint(-l.v.y, l.v.x); + (nil, nil, perp, ldist) := l.intersection(p, v); + return (v, perp, ldist); +} + +Line.point(l: self ref Line, s: real): Point +{ + return (int (l.p.x + s * l.v.x), int (l.p.y + s * l.v.y)); +} + +# compute the intersection of lines a and b. +# b is assumed to be fixed, and a is indefinitely long +# but doesn't extend backwards from its starting point. +# a is defined by the starting point p and the unit vector v. +# return whether it hit, the point at which it hit if so, +# the distance of the intersection point from p, +# and the distance of the intersection point from b.p. +Line.intersection(b: self ref Line, p, v: Realpoint): (int, Realpoint, real, real) +{ + det := b.v.x * v.y - v.x * b.v.y; + if (det > -ZERO && det < ZERO) + return (0, (0.0, 0.0), 0.0, 0.0); + + y21 := b.p.y - p.y; + x21 := b.p.x - p.x; + s := (b.v.x * y21 - b.v.y * x21) / det; + t := (v.x * y21 - v.y * x21) / det; + if (s < 0.0) + return (0, (0.0, 0.0), s, t); + hit := t >= 0.0 && t <= b.s; + hp: Realpoint; + if (hit) + hp = (p.x+v.x*s, p.y+v.y*s); + return (hit, hp, s, t); +} + +# bounce ball travelling in direction av off line b. +# return the new unit vector. +boing(av: Realpoint, b: ref Line): Realpoint +{ + d := math->atan2(real b.v.y, real b.v.x) * 2.0 - math->atan2(av.y, av.x); + return (math->cos(d), math->sin(d)); +} + +p2s(p: Point): string +{ + return string p.x + " " + string p.y; +} + diff --git a/appl/spree/other/tstlines.sh b/appl/spree/other/tstlines.sh new file mode 100755 index 00000000..7e75b3a4 --- /dev/null +++ b/appl/spree/other/tstlines.sh @@ -0,0 +1,53 @@ +#!/dis/sh +load tk std +pctl newpgrp +wid=${tk window 'Test lines'} +fn x {tk $wid $*} +x canvas .c +x pack .c +x 'bind .c <ButtonRelease-1> {send b1 %x %y}' +x 'bind .c <ButtonRelease-2> {send b2 %x %y}' +x update +chan b1 b2 +tk namechan $wid b1 +tk namechan $wid b2 +while {} {tk winctl $wid ${recv $wid}} & +chan show +ifs=' +' +v1 := 0 0 1 1 +v2 := 1 1 2 2 +while {} { + args:=${split ${recv show}} + (t args) = $args + $t = $args + + tk 0 .c delete lines + echo $v1 $v2 + r := `{tstboing $v1 $v2} + (ap1x ap1y ap2x ap2y bp1x bp1y bp2x bp2y) := $v1 $v2 + tk 0 .c create line $ap1x $ap1y $ap2x $ap2y -tags lines -fill black -width 3 -arrow last + tk 0 .c create line $bp1x $bp1y $bp2x $bp2y -tags lines -fill red + and {~ $#r 6} { + (rp1x rp1y rp2x rp2y sp2x sp2y) := $r + tk 0 .c create line $ap2x $ap2y $rp1x $rp1y -tags lines -fill black + tk 0 .c create line $rp1x $rp1y $rp2x $rp2y -tags lines -fill green -arrow last + tk 0 .c create line $rp1x $rp1y $sp2x $sp2y -tags lines -fill blue -arrow last + } + tk 0 update +} & + +fn show { + a:=$* + if {~ $#a 8} {echo usage} { + send show ${join ' ' $a} + } +} + +for i in 1 2 { + while {} { + p1:=${recv b^$i} + p2:=${recv b^$i} + send show ${join ' ' v^$i $p1 $p2} + } & +} diff --git a/appl/spree/other/tstwin.b b/appl/spree/other/tstwin.b new file mode 100644 index 00000000..de7c7ab4 --- /dev/null +++ b/appl/spree/other/tstwin.b @@ -0,0 +1,351 @@ +implement Tstwin; + +include "sys.m"; + sys: Sys; + +include "draw.m"; + draw: Draw; + Context, Display, Point, Rect, Image, Screen: import draw; + +include "tk.m"; + tk: Tk; + Toplevel: import tk; + +include "tkclient.m"; + tkclient: Tkclient; + +include "math.m"; + math: Math; + +Tstwin: module +{ + init: fn(ctxt: ref Context, argv: list of string); +}; + +screen: ref Screen; +display: ref Display; +win: ref Toplevel; + +NC: con 6; + +task_cfg := array[] of { +"label .xy -text {0 0}", +"canvas .c -height 500 -width 500", +"pack .xy -side top -fill x", +"pack .c -side bottom -fill both -expand 1", +"bind .c <ButtonRelease-1> {send cmd 0 1 %x %y}", +"bind .c <ButtonRelease-2> {send cmd 0 2 %x %y}", +"bind .c <Button-1> {send cmd 1 1 %x %y}", +"bind .c <Button-2> {send cmd 1 2 %x %y}", +}; + +Obstacle: adt { + line: ref Line; + s1, s2: real; + id: int; + config: fn(b: self ref Obstacle); + new: fn(id: int): ref Obstacle; +}; + +Line: adt { + p, v: Realpoint; + s: real; + new: fn(p1, p2: Point): ref Line; + hittest: fn(l: self ref Line, p: Point): (Realpoint, real, real); + intersection: fn(b: self ref Line, p, v: Realpoint): (int, Realpoint, real, real); + point: fn(b: self ref Line, s: real): Point; +}; +bats: list of ref Obstacle; +init(ctxt: ref Context, argv: list of string) +{ + sys = load Sys Sys->PATH; + draw = load Draw Draw->PATH; + tk = load Tk Tk->PATH; + tkclient = load Tkclient Tkclient->PATH; + math = load Math Math->PATH; + + sys->pctl(Sys->NEWPGRP, nil); + + display = ctxt.display; + screen = ctxt.screen; + + tkclient->init(); + + menubut: chan of string; + (win, menubut) = tkclient->toplevel(screen, nil, "Window testing", 0); + + cmd := chan of string; + tk->namechan(win, cmd, "cmd"); + + tkclient->tkcmds(win, task_cfg); + + mch := chan of (int, Point); + spawn mouseproc(mch); + + bat := Obstacle.new(0); + bats = bat :: nil; + bat.line = Line.new((100, 0), (150, 500)); + bat.s1 = 10.0; + bat.s2 = 110.0; + bat.config(); + + tk->cmd(win, "update"); + buts := 0; + for(;;) alt { + menu := <-menubut => + tkclient->wmctl(win, menu); + + c := <-cmd => + (nil, toks) := sys->tokenize(c, " "); + if ((hd toks)[0] == '1') + buts |= int hd tl toks; + else + buts &= ~int hd tl toks; + mch <-= (buts, Point(int hd tl tl toks, int hd tl tl tl toks)); + } +} + +Realpoint: adt { + x, y: real; +}; + +cmd(top: ref Tk->Toplevel, s: string): string +{ + e := tk->cmd(top, s); + if (e != nil && e[0] == '!') + sys->print("tk error %s on '%s'\n", e, s); + return e; +} + +p2s(p: Point): string +{ + return string p.x + " " + string p.y; +} + +mouseproc(mch: chan of (int, Point)) +{ + for (;;) { + hitbat: ref Obstacle = nil; + minperp, hitdist: real; + (buts, p) := <-mch; + for (bl := bats; bl != nil; bl = tl bl) { + b := hd bl; + (normal, perp, dist) := b.line.hittest(p); + perp = abs(perp); + + if ((hitbat == nil || perp < minperp) && (dist >= b.s1 && dist <= b.s2)) + (hitbat, minperp, hitdist) = (b, perp, dist); + } + if (hitbat == nil || minperp > 30.0) { + while ((<-mch).t0) + ; + continue; + } + offset := hitdist - hitbat.s1; + if (buts & 2) + (buts, p) = aim(mch, hitbat, p); + if (buts & 1) + drag(mch, hitbat, offset); + } +} + + +drag(mch: chan of (int, Point), hitbat: ref Obstacle, offset: real) +{ + line := hitbat.line; + batlen := hitbat.s2 - hitbat.s1; + + cvsorigin := Point(int cmd(win, ".c cget -actx"), int cmd(win, ".c cget -acty")); + +# cmd(win, "grab set .c"); +# cmd(win, "focus ."); +loop: for (;;) alt { + (buts, p) := <-mch => + if (buts & 2) + (buts, p) = aim(mch, hitbat, p); + (v, perp, dist) := line.hittest(p); + dist -= offset; + # constrain bat and mouse positions + if (dist < 0.0 || dist + batlen > line.s) { + if (dist < 0.0) { + p = line.point(offset); + dist = 1.0; + } else { + p = line.point(line.s - batlen + offset); + dist = line.s - batlen; + } + p.x -= int (v.x * perp); + p.y -= int (v.y * perp); + win.image.display.cursorset(p.add(cvsorigin)); + } + (hitbat.s1, hitbat.s2) = (dist, dist + batlen); + hitbat.config(); + cmd(win, "update"); + if (!buts) + break loop; + } +# cmd(win, "grab release .c"); +} + +CHARGETIME: con 1000.0; +MAXCHARGE: con 50.0; + +α: con 0.999; # decay in one millisecond +Max: con 60.0; +D: con 5; +ZERO: con 1e-6; +aim(mch: chan of (int, Point), hitbat: ref Obstacle, p: Point): (int, Point) +{ + cvsorigin := Point(int cmd(win, ".c cget -actx"), int cmd(win, ".c cget -acty")); + startms := ms := sys->millisec(); + delta := Realpoint(0.0, 0.0); + line := hitbat.line; + charge := 0.0; + pivot := line.point((hitbat.s1 + hitbat.s2) / 2.0); + s1 := p2s(line.point(hitbat.s1)); + s2 := p2s(line.point(hitbat.s2)); + cmd(win, ".c create line 0 0 0 0 -tags wire"); + cmd(win, ".c create oval 0 0 1 1 -fill green -tags ball"); + p2: Point; + buts := 2; + for (;;) { + v := makeunit(delta); + bp := pivot.add((int (v.x * charge), int (v.y * charge))); + cmd(win, ".c coords wire "+s1+" "+p2s(bp)+" "+s2); + cmd(win, ".c coords ball "+string (bp.x - D) + " " + string (bp.y - D) + " " + + string (bp.x + D) + " " + string (bp.y + D)); + cmd(win, "update"); + if ((buts & 2) == 0) + break; + (buts, p2) = <-mch; + now := sys->millisec(); + fade := math->pow(α, real (now - ms)); + charge = real (now - startms) * (MAXCHARGE / CHARGETIME); + if (charge > MAXCHARGE) + charge = MAXCHARGE; + ms = now; + delta.x = delta.x * fade + real (p2.x - p.x); + delta.y = delta.y * fade + real (p2.y - p.y); + mag := delta.x * delta.x + delta.y * delta.y; + win.image.display.cursorset(p.add(cvsorigin)); + } + sys->print("pow\n"); + cmd(win, ".c delete wire ball"); + cmd(win, "update"); + return (buts, p2); +} + +makeunit(v: Realpoint): Realpoint +{ + mag := math->sqrt(v.x * v.x + v.y * v.y); + if (mag < ZERO) + return (1.0, 0.0); + return (v.x / mag, v.y / mag); +} + +#drag(mch: chan of (int, Point), p: Point) +#{ +# down := 1; +# cvsorigin := Point(int cmd(win, ".c cget -actx"), int cmd(win, ".c cget -acty")); +# ms := sys->millisec(); +# delta := Realpoint(0.0, 0.0); +# id := cmd(win, ".c create line " + p2s(p) + " " + p2s(p)); +# coords := ".c coords " + id + " " + p2s(p) + " "; +# do { +# p2: Point; +# (down, p2) = <-mch; +# now := sys->millisec(); +# fade := math->pow(α, real (now - ms)); +# ms = now; +# delta.x = delta.x * fade + real (p2.x - p.x); +# delta.y = delta.y * fade + real (p2.y - p.y); +# mag := delta.x * delta.x + delta.y * delta.y; +# d: Realpoint; +# if (mag > Max * Max) { +# fade = Max / math->sqrt(mag); +# d = (delta.x * fade, delta.y * fade); +# } else +# d = delta; +# +# cmd(win, coords + p2s(p.add((int d.x, int d.y)))); +# win.image.display.cursorset(p.add(cvsorigin)); +# cmd(win, "update"); +# } while (down); +#} +# +Line.new(p1, p2: Point): ref Line +{ + ln := ref Line; + ln.p = (real p1.x, real p1.y); + v := Realpoint(real (p2.x - p1.x), real (p2.y - p1.y)); + ln.s = math->sqrt(v.x * v.x + v.y * v.y); + if (ln.s > ZERO) + ln.v = (v.x / ln.s, v.y / ln.s); + else + ln.v = (1.0, 0.0); + return ln; +} + +# return normal from line, perpendicular distance from line and distance down line +Line.hittest(l: self ref Line, ip: Point): (Realpoint, real, real) +{ + p := Realpoint(real ip.x, real ip.y); + v := Realpoint(-l.v.y, l.v.x); + (nil, nil, perp, ldist) := l.intersection(p, v); + return (v, perp, ldist); +} + +Line.point(l: self ref Line, s: real): Point +{ + return (int (l.p.x + s * l.v.x), int (l.p.y + s * l.v.y)); +} + +# compute the intersection of lines a and b. +# b is assumed to be fixed, and a is indefinitely long +# but doesn't extend backwards from its starting point. +# a is defined by the starting point p and the unit vector v. +# return whether it hit, the point at which it hit if so, +# the distance of the intersection point from p, +# and the distance of the intersection point from b.p. +Line.intersection(b: self ref Line, p, v: Realpoint): (int, Realpoint, real, real) +{ + det := b.v.x * v.y - v.x * b.v.y; + if (det > -ZERO && det < ZERO) + return (0, (0.0, 0.0), 0.0, 0.0); + + y21 := b.p.y - p.y; + x21 := b.p.x - p.x; + s := (b.v.x * y21 - b.v.y * x21) / det; + t := (v.x * y21 - v.y * x21) / det; + if (s < 0.0) + return (0, (0.0, 0.0), s, t); + hit := t >= 0.0 && t <= b.s; + hp: Realpoint; + if (hit) + hp = (p.x+v.x*s, p.y+v.y*s); + return (hit, hp, s, t); +} + +blankobstacle: Obstacle; +Obstacle.new(id: int): ref Obstacle +{ + cmd(win, ".c create line 0 0 0 0 -width 3 -fill #aaaaaa" + " -tags l" + string id); + o := ref blankobstacle; + o.line = Line.new((0, 0), (0, 0)); + o.id = id; + return o; +} + +Obstacle.config(o: self ref Obstacle) +{ + cmd(win, ".c coords l" + string o.id + " " + + p2s(o.line.point(o.s1)) + " " + p2s(o.line.point(o.s2))); + cmd(win, ".c itemconfigure l" + string o.id + " -fill red"); +} + +abs(x: real): real +{ + if (x < 0.0) + return -x; + return x; +} |