ref: 600bbfe4aaa9ad0f73d8d73eef1b7670e5f7d3a3
dir: /appl/wm/tetris.b/
# Copyright © 1999 Roger Peppe. All rights reserved. implement Tetris; include "sys.m"; sys: Sys; stderr: ref Sys->FD; include "draw.m"; draw: Draw; Point, Rect: import draw; include "tk.m"; tk: Tk; include "tkclient.m"; tkclient: Tkclient; include "rand.m"; rand: Rand; include "scoretable.m"; scoretab: Scoretable; include "arg.m"; include "keyboard.m"; Up, Down, Right, Left: import Keyboard; include "keyring.m"; include "security.m"; # for random seed Tetris: module { init: fn(ctxt: ref Draw->Context, argv: list of string); }; SCORETABLE: con "/lib/scores/tetris"; LOCKPORT: con 18343; # number of pieces across and down board. BOARDWIDTH: con 10; BOARDHEIGHT: con 22; awaitingscore := 1; Row: adt { tag: string; delete: int; }; Board: adt { new: fn(top: ref Tk->Toplevel, w: string, blocksize: int, maxsize: Point): ref Board; makeblock: fn(bd: self ref Board, colour: string, p: Point): string; moveblock: fn(bd: self ref Board, b: string, p: Point); movecurr: fn(bd: self ref Board, delta: Point); delrows: fn(bd: self ref Board, rows: list of int); landedblock: fn(bd: self ref Board, b: string, p: Point); setnextshape: fn(bd: self ref Board, colour: string, spec: array of Point); setscore: fn(bd: self ref Board, score: int); setlevel: fn(bd: self ref Board, level: int); setnrows: fn(bd: self ref Board, level: int); gameover: fn(bd: self ref Board); update: fn(bd: self ref Board); state: array of array of byte; w: string; dx: int; win: ref Tk->Toplevel; rows: array of Row; maxid: int; }; Piece: adt { shape: int; rot: int; }; Shape: adt { coords: array of array of Point; colour: string; score: array of int; }; Game: adt { new: fn(bd: ref Board): ref Game; move: fn(g: self ref Game, dx: int); rotate: fn(g: self ref Game, clockwise: int); tick: fn(g: self ref Game): int; drop: fn(g: self ref Game); bd: ref Board; level: int; delay: int; score: int; nrows: int; pieceids: array of string; pos: Point; next, curr: Piece; }; badmod(path: string) { sys->fprint(stderr, "tetris: cannot load %s: %r\n", path); raise "fail: bad module"; } usage() { sys->fprint(stderr, "usage: tetris [-b blocksize]\n"); raise "fail:usage"; } init(ctxt: ref Draw->Context, argv: list of string) { sys = load Sys Sys->PATH; stderr = sys->fildes(2); draw = load Draw Draw->PATH; tk = load Tk Tk->PATH; if (tk == nil) badmod(Tk->PATH); tkclient = load Tkclient Tkclient->PATH; if (tkclient == nil) badmod(Tkclient->PATH); tkclient->init(); rand = load Rand Rand->PATH; if (rand == nil) badmod(Rand->PATH); arg := load Arg Arg->PATH; if (arg == nil) badmod(Arg->PATH); if (ctxt == nil) ctxt = tkclient->makedrawcontext(); blocksize := 17; # preferred block size arg->init(argv); while ((opt := arg->opt()) != 0) { case opt { 'b' => if ((b := arg->arg()) == nil || int b <= 0) usage(); blocksize = int b; * => usage(); } } if (arg->argv() != nil) usage(); sys->pctl(Sys->NEWPGRP|Sys->FORKNS, nil); scoretab = load Scoretable Scoretable->PATH; scorech := chan of int; spawn scoresrvwait(scorech); (win, winctl) := tkclient->toplevel(ctxt, "", "Tetris",Tkclient->Hide); seedrand(); fromuser := chan of string; tk->namechan(win, fromuser, "user"); cmd(win, "bind . <Key> {send user k %s}"); cmd(win, "bind . <ButtonRelease-1> {focus .}"); cmd(win, "bind .Wm_t <ButtonRelease-1> +{focus .}"); cmd(win, "focus ."); maxsize := Point(10000, 10000); if (ctxt.display.image != nil) { img := ctxt.display.image; wsz := wsize(win, "."); maxsize.y = img.r.dy() - wsz.y; maxsize.x = img.r.dx(); } tkclient->onscreen(win, nil); tkclient->startinput(win, "kbd"::"ptr"::nil); for (;;) { bd := Board.new(win, ".f", blocksize, maxsize); if (bd == nil) { sys->fprint(stderr, "tetris: couldn't make board\n"); return; } cmd(win, "bind .f.c <ButtonRelease-1> {send user m %x %y}"); cmd(win, "pack .f -side top"); cmd(win, "update"); g := Game.new(bd); (finished, rank) := rungame(g, win, fromuser, winctl, scorech); if (finished) break; cmd(win, "pack propagate . 0"); if (scoretab != nil) { cmd(win, "destroy .f"); if (showhighscores(win, fromuser, winctl, rank) == 0) break; # Needs kicked after new game # Some may be erroneous cmd(win, "bind . <Key> {send user k %s}"); cmd(win, "bind . <ButtonRelease-1> {focus .}"); cmd(win, "bind .Wm_t <ButtonRelease-1> +{focus .}"); cmd(win, "focus ."); } else cmd(win, "destroy .f"); } } wsize(win: ref Tk->Toplevel, w: string): Point { bd := int cmd(win, w + " cget -bd"); return (int cmd(win, w + " cget -width") + bd * 2, int cmd(win, w + " cget -height") + bd * 2); } rungame(g: ref Game, win: ref Tk->Toplevel, fromuser: chan of string, winctl: chan of string, scorech: chan of int): (int, int) { tickchan := chan of int; spawn ticker(g, tickchan); paused := 0; tch := chan of int; gameover := 0; rank := -1; bdsize := wsize(win, ".f.c"); boundy := bdsize.y * 2 / 3; id := cmd(win, ".f.c create line " + p2s((0, boundy)) + " " + p2s((bdsize.x, boundy)) + " -fill white"); cmd(win, ".f.c lower " + id); for (;;) alt { key := <-win.ctxt.kbd => tk->keyboard(win, key); ptr := <-win.ctxt.ptr => tk->pointer(win, *ptr); s := <-fromuser => key: int; if (s[0] == 'm') { # Mouse (nil, toks) := sys->tokenize(s, " "); p := Point(int hd tl toks, int hd tl tl toks); if (p.y > boundy) key = ' '; else { x := p.x / (bdsize.x / 3); case x { 0 => key = '7'; 1 => key = '8'; 2 => key = '9'; * => break; } } } else if (s[0] == 'k') key = int s[1:]; else sys->print("oops (%s)\n", s); if (gameover) return (key == 'q', rank); if (paused) { paused = 0; (tickchan, tch) = (tch, tickchan); if (key != 'q') continue; } case key { '9' or 'c' or Right => g.move(1); '7' or 'z' or Left => g.move(-1); '8' or 'x' or Up => g.rotate(0); ' ' or Down => g.drop(); 'p' => paused = 1; (tickchan, tch) = (tch, tickchan); 'q' => g.delay = -1; while (<-tickchan) ; return (1, rank); } s := <-win.ctxt.ctl or s = <-win.wreq or s = <-winctl => tkclient->wmctl(win, s); n := <-tickchan => if (g.tick() == -1) { while (n) n = <-tickchan; if (awaitingscore && !<-scorech) { awaitingscore = 0; scoretab = nil; } if (scoretab != nil) rank = scoretab->setscore(g.score, sys->sprint("%d %d %bd", g.nrows, g.level, big readfile("/dev/time") / big 1000000)); gameover = 1; } ok := <-scorech => awaitingscore = 0; if (!ok) scoretab = nil; } } tablerow(win: ref Tk->Toplevel, w, bg: string, relief: string, vals: array of string, widths: array of string) { cmd(win, "frame " + w + " -bd 2 -relief " + relief); for (i := 0; i < len vals; i++) { cw := cmd(win, "label " + w + "." + string i + " -text " + tk->quote(vals[i]) + " -width " + widths[i] + bg); cmd(win, "pack " + cw + " -side left -anchor w"); } cmd(win, "pack " + w + " -side top"); } showhighscores(win: ref Tk->Toplevel, fromuser: chan of string, winctl: chan of string, rank: int): int { widths := array[] of {"10w", "7w", "7w", "5w"}; # user, score, level, rows cmd(win, "frame .f -bd 4 -relief raised"); cmd(win, "label .f.title -text {High Scores}"); cmd(win, "pack .f.title -side top -anchor n"); tablerow(win, ".f.h", nil, "raised", array[] of {"User", "Score", "Level", "Rows"}, widths); sl := scoretab->scores(); n := 0; while (sl != nil) { s := hd sl; bg := ""; if (n == rank) bg = " -bg white"; f := ".f.f" + string n++; nrows := level := ""; (nil, toks) := sys->tokenize(s.other, " "); if (toks != nil) (nrows, toks) = (hd toks, tl toks); if (toks != nil) level = hd toks; tablerow(win, f, bg, "sunken", array[] of {s.user, string s.score, level, nrows}, widths); sl = tl sl; } # New game button - breaks keyboard cmd(win, "button .f.b -text {New game} -command {send user s}"); cmd(win, "pack .f.b -side top"); # Renders final scores cmd(win, "pack .f -side top"); cmd(win, "update"); # Events for scoreboard for (;;) alt { key := <-win.ctxt.kbd => tk->keyboard(win, key); ptr := <-win.ctxt.ptr => tk->pointer(win, *ptr); s := <-fromuser => if (s[0] == 'k') { cmd(win, "destroy .f"); # Don't quit unless 'q' is pressed return int s[1:] != 'q'; } else if (s[0] == 's') { cmd(win, "destroy .f"); # Don't quit return 1; } s := <-win.ctxt.ctl or s = <-win.wreq or s = <-winctl => tkclient->wmctl(win, s); } } scoresrvwait(ch: chan of int) { if (scoretab == nil) { ch <-= 0; return; } (ok, err) := scoretab->init(LOCKPORT, readfile("/dev/user"), "tetris", SCORETABLE); if (ok != -1) ch <-= 1; else { if (err != "timeout") sys->fprint(stderr, "tetris: scoretable error: %s\n", err); else sys->fprint(stderr, "tetris: timed out trying to connect to score server\n"); ch <-= 0; } } readfile(f: string): string { fd := sys->open(f, Sys->OREAD); if (fd == nil) return nil; buf := array[Sys->ATOMICIO] of byte; n := sys->read(fd, buf, len buf); if (n <= 0) return nil; return string buf[0:n]; } ticker(g: ref Game, c: chan of int) { c <-= 1; while (g.delay >= 0) { sys->sleep(g.delay); c <-= 1; } c <-= 0; } seedrand() { random := load Random Random->PATH; if (random == nil) { sys->fprint(stderr, "tetris: cannot load %s: %r\n", Random->PATH); return; } seed := random->randomint(Random->ReallyRandom); rand->init(seed); } Game.new(bd: ref Board): ref Game { g := ref Game; g.bd = bd; g.level = 0; g.pieceids = array[4] of string; g.score = 0; g.delay = delays[g.level]; g.nrows = 0; g.next = randompiece(); newpiece(g); bd.update(); return g; } randompiece(): Piece { p: Piece; p.shape = rand->rand(len shapes); p.rot = rand->rand(len shapes[p.shape].coords); return p; } Game.move(g: self ref Game, dx: int) { np := g.pos.add((dx, 0)); if (canmove(g, g.curr, np)) { g.bd.movecurr((dx, 0)); g.bd.update(); g.pos = np; } } Game.rotate(g: self ref Game, clockwise: int) { inc := 1; if (!clockwise) inc = -1; npiece := g.curr; coords := shapes[npiece.shape].coords; nrots := len coords; npiece.rot = (npiece.rot + inc + nrots) % nrots; if (canmove(g, npiece, g.pos)) { c := coords[npiece.rot]; for (i := 0; i < len c; i++) g.bd.moveblock(g.pieceids[i], g.pos.add(c[i])); g.curr = npiece; g.bd.update(); } } Game.tick(g: self ref Game): int { if (canmove(g, g.curr, g.pos.add((0, 1)))) { g.bd.movecurr((0, 1)); g.pos.y++; } else { c := shapes[g.curr.shape].coords[g.curr.rot]; max := g.pos.y; min := g.pos.y + 4; for (i := 0; i < len c; i++) { p := g.pos.add(c[i]); if (p.y < 0) { g.delay = -1; g.bd.gameover(); g.bd.update(); return -1; } if (p.y > max) max = p.y; if (p.y < min) min = p.y; g.bd.landedblock(g.pieceids[i], p); } full: list of int; for (i = min; i <= max; i++) { for (x := 0; x < BOARDWIDTH; x++) if (g.bd.state[i][x] == byte 0) break; if (x == BOARDWIDTH) full = i :: full; } if (full != nil) { g.bd.delrows(full); g.nrows += len full; g.bd.setnrows(g.nrows); level := g.nrows / 10; if (level != g.level) { g.bd.setlevel(level); g.level = level; if (level >= len delays) level = len delays - 1; g.delay = delays[level]; } } g.score += shapes[g.curr.shape].score[g.curr.rot]; g.bd.setscore(g.score); newpiece(g); } g.bd.update(); return 0; } Game.drop(g: self ref Game) { p := g.pos.add((0, 1)); while (canmove(g, g.curr, p)) p.y++; p.y--; g.bd.movecurr((0, p.y - g.pos.y)); g.pos = p; g.bd.update(); } canmove(g: ref Game, piece: Piece, p: Point): int { c := shapes[piece.shape].coords[piece.rot]; for (i := 0; i < len c; i++) { q := p.add(c[i]); if (q.x < 0 || q.x >= BOARDWIDTH || q.y >= BOARDHEIGHT) return 0; if (q.y >= 0 && int g.bd.state[q.y][q.x]) return 0; } return 1; } newpiece(g: ref Game) { g.curr = g.next; g.next = randompiece(); g.bd.setnextshape(shapes[g.next.shape].colour, shapes[g.next.shape].coords[g.next.rot]); shape := shapes[g.curr.shape]; coords := shape.coords[g.curr.rot]; g.pos = (3, -4); for (i := 0; i < len coords; i++) g.pieceids[i] = g.bd.makeblock(shape.colour, g.pos.add(coords[i])); } p2s(p: Point): string { return string p.x + " " + string p.y; } Board.new(top: ref Tk->Toplevel, w: string, blocksize: int, maxsize: Point): ref Board { cmd(top, "frame " + w); cmd(top, "canvas " + w + ".c -borderwidth 2 -relief sunken -width 1 -height 1"); cmd(top, "frame " + w + ".f"); cmd(top, "canvas " + w + ".f.ns -width 1 -height 1"); makescorewidget(top, w + ".f.scoref", "Score"); makescorewidget(top, w + ".f.levelf", "Level"); makescorewidget(top, w + ".f.rowsf", "Rows"); cmd(top, "pack " + w + ".c -side left"); cmd(top, "pack " + w + ".f -side top"); cmd(top, "pack " + w + ".f.ns -side top"); cmd(top, "pack " + w + ".f.scoref -side top -fill x"); cmd(top, "pack " + w + ".f.levelf -side top -fill x"); cmd(top, "pack " + w + ".f.rowsf -side top -fill x"); sz := wsize(top, w); avail := Point(maxsize.x - sz.x, maxsize.y); avail.x /= BOARDWIDTH; avail.y /= BOARDHEIGHT; dx := avail.x; if (avail.y < avail.x) dx = avail.y; if (dx <= 0) return nil; if (dx > blocksize) dx = blocksize; cmd(top, w + ".f.ns configure -width " + string(4 * dx + 1 - 2*2) + " -height " + string(4 * dx + 1 - 2*2)); cmd(top, w + ".c configure -width " + string(dx * BOARDWIDTH + 1) + " -height " + string(dx * BOARDHEIGHT + 1)); bd := ref Board(array[BOARDHEIGHT] of {* => array[BOARDWIDTH] of {* => byte 0}}, w, dx, top, array[BOARDHEIGHT] of {* => Row(nil, 0)}, 1); return bd; } makescorewidget(top: ref Tk->Toplevel, w, title: string) { cmd(top, "frame " + w); cmd(top, "label " + w + ".title -text " + tk->quote(title)); cmd(top, "label " + w + ".val -bd 2 -relief sunken -width 5w -text 0 -anchor e"); cmd(top, "pack " + w + ".title -side left -anchor w"); cmd(top, "pack " + w + ".val -side right -anchor e"); } blockrect(bd: ref Board, p: Point): string { p = p.mul(bd.dx); q := p.add((bd.dx, bd.dx)); return string p.x + " " + string p.y + " " + string q.x + " " + string q.y; } Board.makeblock(bd: self ref Board, colour: string, p: Point): string { tag := cmd(bd.win, bd.w + ".c create rectangle " + blockrect(bd, p) + " -fill " + colour + " -tags curr"); if (tag != nil && tag[0] == '!') return nil; return tag; } Board.moveblock(bd: self ref Board, b: string, p: Point) { cmd(bd.win, bd.w + ".c coords " + b + " " + blockrect(bd, p)); } Board.movecurr(bd: self ref Board, delta: Point) { delta = delta.mul(bd.dx); cmd(bd.win, bd.w + ".c move curr " + string delta.x + " " + string delta.y); } Board.landedblock(bd: self ref Board, b: string, p: Point) { cmd(bd.win, bd.w + ".c dtag " + b + " curr"); rs := cmd(bd.win, bd.w + ".c coords " + b); if (rs != nil && rs[0] == '!') return; (nil, toks) := sys->tokenize(rs, " "); if (len toks != 4) { sys->fprint(stderr, "bad coords for block %s\n", b); return; } y := int hd tl toks / bd.dx; if (y < 0) return; if (y >= BOARDHEIGHT) { sys->fprint(stderr, "block '%s' too far down (coords %s)\n", b, rs); return; } rtag := bd.rows[y].tag; if (rtag == nil) rtag = bd.rows[y].tag = "r" + string bd.maxid++; cmd(bd.win, bd.w + ".c addtag " + rtag + " withtag " + b); if (p.y >= 0) bd.state[p.y][p.x] = byte 1; } Board.delrows(bd: self ref Board, rows: list of int) { while (rows != nil) { r := hd rows; bd.rows[r].delete = 1; rows = tl rows; } j := BOARDHEIGHT - 1; for (i := BOARDHEIGHT - 1; i >= 0; i--) { if (bd.rows[i].delete) { cmd(bd.win, bd.w + ".c delete " + bd.rows[i].tag); bd.rows[i] = (nil, 0); bd.state[i] = nil; } else { if (i != j && bd.rows[i].tag != nil) { dy := (j - i) * bd.dx; cmd(bd.win, bd.w + ".c move " + bd.rows[i].tag + " 0 " + string dy); bd.rows[j] = bd.rows[i]; bd.rows[i] = (nil, 0); bd.state[j] = bd.state[i]; bd.state[i] = nil; } j--; } } for (i = 0; i < BOARDHEIGHT; i++) if (bd.state[i] == nil) bd.state[i] = array[BOARDWIDTH] of {* => byte 0}; } Board.update(bd: self ref Board) { cmd(bd.win, "update"); } Board.setnextshape(bd: self ref Board, colour: string, spec: array of Point) { cmd(bd.win, bd.w + ".f.ns delete all"); min := Point(4,4); max := Point(0,0); for (i := 0; i < len spec; i++) { if (spec[i].x > max.x) max.x = spec[i].x; if (spec[i].x < min.x) min.x = spec[i].x; if (spec[i].y > max.y) max.y = spec[i].y; if (spec[i].y < min.y) min.y = spec[i].y; } o: Point; o.x = (4 - (max.x - min.x + 1)) * bd.dx / 2 - min.x * bd.dx; o.y = (4 - (max.y - min.y + 1)) * bd.dx / 2 - min.y * bd.dx; for (i = 0; i < len spec; i++) { br := Rect(o.add(spec[i].mul(bd.dx)), o.add(spec[i].add((1,1)).mul(bd.dx))); cmd(bd.win, bd.w + ".f.ns create rectangle " + string br.min.x + " " + string br.min.y + " " + string br.max.x + " " + string br.max.y + " -fill " + colour); } } Board.setscore(bd: self ref Board, score: int) { cmd(bd.win, bd.w + ".f.scoref.val configure -text " + string score); } Board.setlevel(bd: self ref Board, level: int) { cmd(bd.win, bd.w + ".f.levelf.val configure -text " + string level); } Board.setnrows(bd: self ref Board, nrows: int) { cmd(bd.win, bd.w + ".f.rowsf.val configure -text " + string nrows); } Board.gameover(bd: self ref Board) { cmd(bd.win, "label " + bd.w + ".gameover -text {Game over} -bd 4 -relief ridge"); p := Point(BOARDWIDTH * bd.dx / 2, BOARDHEIGHT * bd.dx / 3); cmd(bd.win, bd.w + ".c create window " + string p.x + " " + string p.y + " -window " + bd.w + ".gameover"); } cmd(top: ref Tk->Toplevel, s: string): string { e := tk->cmd(top, s); if (e != nil && e[0] == '!') sys->fprint(stderr, "tetris: tk error on '%s': %s\n", s, e); return e; } VIOLET: con "#ffaaff"; CYAN: con "#93ddf1"; delays := array[] of {300, 250, 200, 150, 100, 80}; shapes := array[] of { Shape( # #### array[] of { array[] of {Point(0,1), Point(1,1), Point(2,1), Point(3,1)}, array[] of {Point(1,0), Point(1,1), Point(1,2), Point(1,3)}, }, "red", array[] of {5, 8}), Shape( # ## # ## array[] of { array[] of {Point(0,0), Point(0,1), Point(1,0), Point(1,1)}, }, "orange", array[] of {6}), Shape( # # # ## # # array[] of { array[] of {Point(1,0), Point(0,1), Point(1,1), Point(2,1)}, array[] of {Point(1,0), Point(1,1), Point(2,1), Point(1,2)}, array[] of {Point(0,1), Point(1,1), Point(2,1), Point(1,2)}, array[] of {Point(1,0), Point(0,1), Point(1,1), Point(1,2)}, }, "yellow", array[] of {5,5,6,5}), Shape( # ## # ## array[] of { array[] of {Point(0,0), Point(1,0), Point(1,1), Point(2,1)}, array[] of {Point(1,0), Point(0,1), Point(1,1), Point(0,2)}, }, "green", array[] of {6,7}), Shape( # ## # ## array[] of { array[] of {Point(1,0), Point(2,0), Point(0,1), Point(1,1)}, array[] of {Point(0,0), Point(0,1), Point(1,1), Point(1,2)}, }, "blue", array[] of {6,7}), Shape( # ### # # array[] of { array[] of {Point(2,0), Point(0,1), Point(1,1), Point(2,1)}, array[] of {Point(0,0), Point(0,1), Point(0,2), Point(1,2)}, array[] of {Point(0,0), Point(1,0), Point(2,0), Point(0,1)}, array[] of {Point(0,0), Point(1,0), Point(1,1), Point(1,2)}, }, CYAN, array[] of {6,7,6,7}), Shape( # # # ### array[] of { array[] of {Point(0,0), Point(1,0), Point(2,0), Point(2,1)}, array[] of {Point(1,0), Point(1,1), Point(0,2), Point(1,2)}, array[] of {Point(0,0), Point(0,1), Point(1,1), Point(2,1)}, array[] of {Point(0,0), Point(1,0), Point(0,1), Point(0,2)}, }, VIOLET, array[] of {6,7,6,7} ), };