/sys/doc/ Documentation archive

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

puzzle.b

This is a 15 block slider puzzle.  The blocks and space are
arrayed randomly.  Clicking a block in the same row or column as the
space moves the space under the cursor.  The object is to avoid the
puzzle and get some real work done.
	I'm a Tk novice and I suspect some of this could be done more
elegantly, even in the absence of a place command.  Make it better;
have fun.

#puzzle.b 15 sliding blocks, semi-devilish
#Author: Steve Arons

implement Puzzle;

include "sys.m";
    sys: Sys;
include "draw.m";
    draw: Draw;
    Context: import Draw;
include "tk.m";
    tk: Tk;
include "tklib.m";
    tklib: Tklib;
include "wmlib.m";
    wmlib: Wmlib;
include "lib.m";

Puzzle: module
{
    init: fn(ctxt: ref Context, argv: list of string);
};

frame_cfg := array[] of {
    "frame .f -height 129 -width 129 -borderwidth 4 -relief ridge",
    "pack propagate .f 0; pack .f",
    "frame .f.f0 -height 30 -width 120",
    "frame .f.f1 -height 30 -width 120",
    "frame .f.f2 -height 30 -width 120",
    "frame .f.f3 -height 30 -width 120",
    "pack .f.f0 .f.f1 .f.f2 .f.f3 -side top"
};
blocks_cfg := array[16] of {* => " "};
pack_cfg := array[] of {
    "pack .f.f0.0 .f.f0.1 .f.f0.2 .f.f0.3 -side left",
    "pack .f.f1.0 .f.f1.1 .f.f1.2 .f.f1.3 -side left",
    "pack .f.f2.0 .f.f2.1 .f.f2.2 .f.f2.3 -side left",
    "pack .f.f3.0 .f.f3.1 .f.f3.2 .f.f3.3 -side left",      
    "pack .Wm_t -fill x; pack propagate .f 0; pack .f; pack propagate .
0",
    "focus .f; update"      
};

t: ref Tk->Toplevel;

init(ctxt: ref Context, argv: list of string)
{
    sys = load Sys Sys->PATH;
    draw = load Draw Draw->PATH;
    tk = load Tk Tk->PATH;
    tklib = load Tklib Tklib->PATH;
    wmlib = load Wmlib Wmlib->PATH;

    tklib->init(ctxt);
    wmlib->init();
    t = tk->toplevel(ctxt.screen, "-borderwidth 2 -relief raised");
    menubut := wmlib->titlebar(t, "Puzzle", Wmlib->Hide);

    blocks := chan of string;
    tk->namechan(t, blocks, "blocks");
    
    makeblocks();
    tklib->tkcmds(t, frame_cfg);
    tklib->tkcmds(t, blocks_cfg);
    tklib->tkcmds(t, pack_cfg);

    for(;;){
        alt {
        menu := <-menubut =>
            if(menu[0] == 'e')
                return;
            wmlib->titlectl(t, menu);
        row_col := <- blocks =>
            moveblocks(row_col[0] - '0', row_col[1] - '0');
        }
    }
}


board:= array[4] of {* => array[4] of {* => " "}};
blocksz : con " -height 28 -width 28";
SP_mode : con " -bg gray -fg gray -state disabled -relief sunken";
SPACE : con "{}";
SProw, SPcol: int;

#buttons are named .f.f{row}.{col};  channel returns {row}{col} as
string
makeblocks()
{
    rand := load Rand Rand->PATH;
    rand->init(sys->millisec());
    
    board[0][0] = SPACE;
    for(k := 1; k < 16; k++) 
        board[k/4][k%4] = sys->sprint("%1d", k);
    for(k = 0; k < 16; k++){
        r := rand->rand(16);
        (rr, rc) := (r/4, r%4);
        t := board[rr][rc];
        (kr, kc) := (k/4, k%4);
        board[rr][rc] = board[kr][kc];
        board[kr][kc] = t;
    }
    
    mode: string;
    for(k = 0; k < 16; k++){          #assemble button descriptions
        (kr, kc) := (k/4, k%4);
        blocklabl := board[kr][kc];
        if(blocklabl != SPACE)
            mode = " ";
        else{
            SProw = kr;
            SPcol = kc;
            mode = SP_mode;
        }   
        blocklabl = sys->sprint(" -text %s", blocklabl);
        blockbutt := sys->sprint(".f.f%1d.%1d",kr,kc);
        cmd := sys->sprint(" -command {send blocks %1d%1d}",kr,kc);
        blocks_cfg[k] = "button "+blockbutt+blocklabl+blocksz+mode+cmd;
    }
}

cfg_str : con ".f.f%1d.%1d configure %s -text %s";
block_mode : con " -state normal -fg black -bg #dddddd -relief raised";

moveblocks(row, col: int)   #we only move labels
{
    (drow, dcol) := (SProw - row, SPcol - col);
    rowincr := colincr := 0;
    if(drow == 0){   #same row  
        if(dcol < 0) #move left
            colincr = -1;
        else
            colincr = 1;
    }else if (dcol == 0){
        if(drow > 0)
            rowincr = 1;
        else
            rowincr = -1;
    }else{
        return;
    }
        
    cmdstk := array[5] of {* => " "};
    stkp := 0;
    SProw = row;
    SPcol = col;
            
    nxt := board[row][col];
    board[row][col] = SPACE;
    cmdstk[stkp++] = sys->sprint(cfg_str, row, col, SP_mode, SPACE);
    while(nxt != SPACE){
        row += rowincr;
        col += colincr;
        save := board[row][col];
        board[row][col] = nxt;
        cmdstk[stkp++] = sys->sprint(cfg_str, row, col, block_mode,
nxt);
        nxt = save;
    }
    cmdstk[stkp] = "update";
    for(j := 0; j <= stkp; j++)
        tk->cmd(t, cmdstk[j]); #reconfigure
}