summaryrefslogtreecommitdiff
path: root/Master/texmf-dist/metapost
diff options
context:
space:
mode:
authorKarl Berry <karl@freefriends.org>2008-09-08 00:47:19 +0000
committerKarl Berry <karl@freefriends.org>2008-09-08 00:47:19 +0000
commit572d3c71718a606b766f8a2d553c3eeffc456587 (patch)
treec9a4beea408197273a35a0fe0a72f2b7eff0da26 /Master/texmf-dist/metapost
parent036469499e69e21110bdbbd77af3e90de86a382a (diff)
new metapost package metago (26aug08)
git-svn-id: svn://tug.org/texlive/trunk@10475 c570f23f-e606-0410-a88d-b1316a301751
Diffstat (limited to 'Master/texmf-dist/metapost')
-rw-r--r--Master/texmf-dist/metapost/metago/metago.mp799
1 files changed, 799 insertions, 0 deletions
diff --git a/Master/texmf-dist/metapost/metago/metago.mp b/Master/texmf-dist/metapost/metago/metago.mp
new file mode 100644
index 00000000000..54111ad1ded
--- /dev/null
+++ b/Master/texmf-dist/metapost/metago/metago.mp
@@ -0,0 +1,799 @@
+
+%% metago.mp
+%% Copyright 2008 Wentao Zheng
+ %
+ % This work may be distributed and/or modified under the conditions
+ % of the LaTeX Project Public License, either version 1.3 of this
+ % license or (at your option) any later version. The latest version
+ % of this license is in http://www.latex-project.org/lppl.txt and
+ % version 1.3 or later is part of all distributions of LaTeX version
+ % 2005/12/01 or later.
+ %
+ % This work has the LPPL maintenance status `maintained'.
+ %
+ % The Current Maintainer of this work is Wentao Zheng.
+ %
+ % This work consists of the file metago.mp
+
+input string;
+
+% --------------------------------
+% debug variable and logger method
+% --------------------------------
+boolean _DEBUG;
+_DEBUG = true;
+vardef log text t=
+ if _DEBUG:
+ show t;
+ fi;
+enddef;
+
+
+% ------------------------
+% Stack for pair variables
+% ------------------------
+% - declare a stack: stack.s
+% - push a pair into a stack: s.push(<pair>)
+% - pop a pair from a stack: <pair> = s.pop()
+% - clear a stack: s.clear()
+% - check whether a stack is empty: s.empty()
+
+vardef stack@#=
+ string @#.value[];
+ numeric @#.top;
+ @#.top := 1;
+enddef;
+
+vardef pop@#=
+ save tmp;
+ string tmp;
+ if @#.top > 1:
+ @#.top := @#.top - 1;
+ tmp = @#.value[@#.top];
+ else:
+ tmp = "";
+ fi;
+
+ save p;
+ pair p;
+ p = scantokens(tmp);
+ (p)
+enddef;
+
+vardef push@# expr p=
+ @#.value[@#.top] := "(" & (decimal xpart p) & "," & (decimal ypart p) & ")";
+ @#.top := @#.top + 1;
+enddef;
+
+vardef empty@#=
+ (@#.top = 1)
+enddef;
+
+vardef clear@#=
+ @#.top := 1;
+enddef;
+
+%% determine whether two pairs are equal
+vardef _is_pair_equal(expr p,q)=
+ ((xpart p = xpart q) and (ypart p = ypart q))
+enddef;
+
+%% convert a pair to string with the form of "(x,y)"
+vardef _point_str expr p=
+ ((decimal xpart p) & "," & (decimal ypart p))
+enddef;
+
+% --------------------
+% Parameters of MetaGo
+% --------------------
+
+u = 10pt; % !IMPORTANT, unit metric, DON'T user it or modify it
+
+color board_color; % color of board background color
+
+cell_width = 2u;
+cell_line_width = .05u;
+
+board_gap = 3u;
+board_dot_d = .4u;
+board_color = (1,200/255,100/255);
+board_size = 19;
+
+stone_d = .9cell_width;
+stone_line_width = cell_line_width;
+
+
+% -------------------------------------------
+% Internal functions (DO NOT use/modify them)
+% -------------------------------------------
+
+% Go coord: 0-18, 0-18 (internal coord)
+% MP coord: 0-18u + gap, 0-(-18u) + gap
+transform GoToMP;
+GoToMP := identity xscaled cell_width yscaled -cell_width
+shifted (board_gap,-board_gap);
+
+vardef mp_pos expr p=
+ (p transformed GoToMP)
+enddef;
+
+vardef draw_cell expr p=
+ save i,j;
+ i = xpart p;
+ j = ypart p;
+ draw (mp_pos (i,j)) -- (mp_pos (i+1,j)) -- (mp_pos (i+1,j+1))
+ -- (mp_pos (i,j+1)) -- cycle withpen pencircle scaled cell_line_width;
+enddef;
+
+vardef draw_dot expr p=
+ fill (fullcircle scaled board_dot_d) shifted (mp_pos p);
+enddef;
+
+vardef _draw_stone(expr p,c)=
+ save circ; path circ;
+ circ = (fullcircle scaled stone_d) shifted p;
+ fill circ withcolor c;
+ draw circ withpen pencircle scaled stone_line_width;
+enddef;
+
+vardef draw_stone@# expr p=
+ string type;
+ type = str @#;
+ if (type = "b") or (type = "B"):
+ _draw_stone((mp_pos p),black);
+ elseif (type = "w") or (type = "W"):
+ _draw_stone((mp_pos p),white);
+ else:
+ show "ERROR of stone type: " & type & "!!";
+ fi;
+enddef;
+
+% fout direction point of the pair p:
+% up, down, left, right
+% p \in (1-board_size,1-board_size)
+% if p is one the edge of the board, return p itself
+
+vardef _up expr p=
+ if (ypart p) = 1:
+ (xpart p, ypart p)
+ else:
+ (xpart p, ypart p - 1)
+ fi
+enddef;
+
+vardef _down expr p=
+ if (ypart p) = board_size:
+ (xpart p, ypart p)
+ else:
+ (xpart p, ypart p + 1)
+ fi
+enddef;
+
+vardef _left expr p=
+ if (xpart p) = 1:
+ (xpart p, ypart p)
+ else:
+ (xpart p - 1, ypart p)
+ fi
+enddef;
+
+vardef _right expr p=
+ if (xpart p) = board_size:
+ (xpart p, ypart p)
+ else:
+ (xpart p + 1, ypart p)
+ fi
+enddef;
+
+% board memory: 1 ~ board_size, 1 ~ board_size
+% - 0 means empty
+% - -1 means white
+% - 1 means black
+WHITE = -1;
+BLACK = 1;
+EMPTY = 0;
+numeric mem[][];
+for i=1 upto board_size:
+ for j=1 upto board_size:
+ mem[i][j] = EMPTY;
+ endfor;
+endfor;
+
+vardef MEM expr p=
+ if (xpart p < 1) or (xpart p > board_size)
+ or (ypart p < 1) or (ypart p > board_size):
+ (2)
+ else:
+ (mem[xpart p][ypart p])
+ fi
+enddef;
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%%% Open functions for Go visualization %%%%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+%% draw empty Go board
+vardef draw_board=
+ %% draw board side and fill color
+ save board; path board;
+ board = origin -- (mp_pos(board_size-1,0)) + (board_gap,board_gap)
+ -- (mp_pos(board_size-1,board_size-1)) + (board_gap,-board_gap)
+ -- (mp_pos(0,board_size-1)) + (-board_gap,-board_gap) -- cycle;
+ fill board withcolor board_color;
+ draw board;
+
+ %% draw cells
+ for i=0 upto board_size-2:
+ for j=0 upto board_size-2:
+ draw_cell (i,j);
+ endfor;
+ endfor;
+
+ %% draw dot if size = 19
+ if board_size = 19:
+ for i=3 step 6 until 15:
+ for j=3 step 6 until 15:
+ draw_dot (i,j);
+ endfor;
+ endfor;
+ fi;
+enddef;
+
+vardef _char expr p=
+ char(ASCII("A") + (p-1))
+enddef;
+
+%% draw label
+vardef draw_label=
+ for i=1 upto board_size:
+ label(_char i, mp_pos(i-1,-1));
+ label(_char i, mp_pos(i-1,board_size));
+
+ label((decimal i), mp_pos(-1,board_size-i));
+ label((decimal i), mp_pos(board_size,board_size-i));
+ endfor;
+enddef;
+
+%% put a stone on postion p
+%% B - black stone, p: 1~board_size, 1~board_size
+%% W - white stone, p: 1~board_size, 1~board_size
+%% C - clear stone, p: 1~board_size, 1~board_size
+
+vardef B expr p=
+ log "black " & (_point_str p);
+ if IS_PUT:
+ append_put "B " & (decimal (xpart p)) & " " & (decimal (ypart p));
+ fi;
+ mem[xpart p][ypart p] := BLACK;
+enddef;
+
+vardef W expr p=
+ log "white " & (_point_str p);
+ if IS_PUT:
+ append_put "W " & (decimal (xpart p)) & " " & (decimal (ypart p));
+ fi;
+ mem[xpart p][ypart p] := WHITE;
+enddef;
+
+vardef C expr p=
+ log "clear " & (_point_str p);
+ if IS_PUT:
+ if mem[xpart p][ypart p] = BLACK:
+ append_put "b " & (decimal (xpart p)) & " " & (decimal (ypart p));
+ elseif mem[xpart p][ypart p] = WHITE:
+ append_put "w " & (decimal (xpart p)) & " " & (decimal (ypart p));
+ fi;
+ fi;
+ mem[xpart p][ypart p] := EMPTY;
+enddef;
+
+%% draw current stones on board
+vardef draw_stones=
+ for i=1 upto board_size:
+ for j=1 upto board_size:
+ if mem[i][j] = BLACK:
+ draw_stone.b(i-1,j-1);
+ elseif mem[i][j] = WHITE:
+ draw_stone.w(i-1,j-1);
+ elseif mem[i][j] = EMPTY:
+ else
+ show "ERROR board memory with value " & (decimal mem[i][j]) & "!!";
+ fi;
+ endfor;
+ endfor;
+enddef;
+
+%% check life_or_death for all stones
+%% if stone s is dead, clear s from mem
+vardef life_or_death=
+ save m,count,ld;
+ numeric m[][];
+ for i=1 upto board_size:
+ for j=1 upto board_size:
+ m[i][j] = -1; %% -1, not checked; 0, pushed; 1 ..., checked
+ endfor;
+ endfor;
+
+ count = 1;
+ boolean ld[];
+ stack.h;
+
+ %% grouping and check life_or_death
+ for i=1 upto board_size:
+ for j=1 upto board_size:
+ if (m[i][j] = -1) and not ((MEM(i,j)) = EMPTY):
+ push.h(i,j);
+ m[i][j] := 0;
+ ld[count] := false;
+
+ forever:
+ exitif empty.h;
+
+ save test,p;
+ pair test[],p;
+
+ p := pop.h;
+ m[xpart p][ypart p] := count;
+
+ test[1] := _up p;
+ test[2] := _down p;
+ test[3] := _left p;
+ test[4] := _right p;
+
+ for k=1 upto 4:
+ if ((MEM test[k]) = (MEM(i,j))) and
+ (m[xpart test[k]][ypart test[k]] = -1):
+ push.h(test[k]);
+ m[xpart test[k]][ypart test[k]] := 0;
+ fi;
+
+ if (MEM test[k]) = EMPTY:
+ ld[count] := true;
+ fi;
+ endfor;
+ endfor;
+
+ count := count+1;
+ clear.s;
+ fi;
+ endfor;
+ endfor;
+
+ %% clear dead stones
+ for i=1 upto board_size:
+ for j=1 upto board_size:
+ if m[i][j] > 0:
+ if ld[m[i][j]] = false:
+ C(i,j);
+ fi;
+ fi;
+ endfor;
+ endfor;
+enddef;
+
+%% check if added stone at p captures other stones
+vardef _capture expr p=
+ save test;
+ pair test[];
+
+ test[1] := _up p;
+ test[2] := _down p;
+ test[3] := _left p;
+ test[4] := _right p;
+ for i=1 upto 4:
+ if (MEM test[i]) = -(MEM p):
+ _check_death_of(test[i]);
+ fi;
+ endfor;
+enddef;
+
+vardef _check_death_of expr pp=
+ stack.h;
+ numeric m[][];
+ for i=1 upto board_size:
+ for j=1 upto board_size:
+ m[i][j] = -1; %% un-pushed
+ endfor;
+ endfor;
+
+ push.h pp;
+ m[xpart pp][ypart pp] := 0;
+ save ld; boolean ld;
+ ld = false;
+
+ forever:
+ exitif empty.h;
+
+ save test,p;
+ pair test[],p;
+
+ p := pop.h;
+ %m[xpart p][ypart p] := 1;
+
+ test[1] := _up p;
+ test[2] := _down p;
+ test[3] := _left p;
+ test[4] := _right p;
+
+ for k=1 upto 4:
+ if ((MEM test[k]) = (MEM p)) and
+ (m[xpart test[k]][ypart test[k]] = -1):
+ push.h(test[k]);
+ m[xpart test[k]][ypart test[k]] := 0;
+ fi;
+
+ if (MEM test[k]) = EMPTY:
+ ld := true;
+ fi;
+ endfor;
+ endfor;
+
+ if ld = false:
+ for i=1 upto board_size:
+ for j=1 upto board_size:
+ if m[i][j] = 0:
+ C(i,j);
+ fi;
+ endfor;
+ endfor;
+ fi;
+enddef;
+
+%% check if added stone at p is dead
+vardef _suicide expr p=
+ _check_death_of p;
+enddef;
+
+%% putting stone history
+boolean IS_PUT;
+IS_PUT = false;
+string put_history[];
+numeric cur_put_his;
+cur_put_his = 1;
+string put_his;
+
+%% begin a put action
+vardef beginput=
+ IS_PUT := true;
+ put_his := "";
+enddef;
+
+%% append stoning in a put action
+vardef append_put text t=
+ if (length put_his) = 0:
+ put_his := t;
+ else:
+ put_his := put_his & " " & t;
+ fi;
+enddef;
+
+%% end a put action
+vardef endput=
+ IS_PUT := false;
+ put_history[cur_put_his] := put_his;
+ log "append history: " & put_his;
+ cur_put_his := cur_put_his + 1;
+enddef;
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%%% high level functions (encourged for use) %%%%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% set_board_size
+% set_board_color
+% init_board
+% put_b / put_w
+% display_board
+
+%% set board size between 1 and 19
+%% default value is 19
+vardef set_board_size expr p=
+ if (p > 0) and (p < 20):
+ board_size := p;
+ fi;
+enddef;
+
+%% set board color with rgb triple (r,g,b)
+vardef set_board_color text t=
+ board_color := t;
+enddef;
+
+%% init the board with no stones
+vardef init_board=
+ save db; boolean db;
+ db = _DEBUG;
+ _DEBUG := false;
+ for i=1 upto board_size:
+ for j=1 upto board_size:
+ C(i,j);
+ endfor;
+ endfor;
+ _DEBUG := db;
+enddef;
+
+%% generate a random distributed board with stones
+vardef random_board expr clear_ratio=
+ save tmp;
+ for i=1 upto board_size:
+ for j=1 upto board_size:
+ tmp := normaldeviate;
+ if tmp > 0.5 clear_ratio:
+ put_black(i,j);
+ elseif tmp < -0.5 clear_ratio:
+ put_white(i,j);
+ fi;
+ endfor;
+ endfor;
+enddef;
+
+%% generate a random location ranged from (1,1)--(board_size,board_size)
+vardef random_loc=
+ save x,y;
+ x = (uniformdeviate board_size);
+ y = (uniformdeviate board_size);
+
+ x := floor (abs (x - 0.0001));
+ y := floor (abs (y - 0.0001));
+
+ (x+1,y+1)
+enddef;
+
+%% display the Go board together with label, stones
+vardef display_board=
+ draw_board;
+ draw_label;
+ draw_stones;
+enddef;
+
+%% put a black stone at postion pp, if possible
+%% check life and death after putting the stone
+%% re-put the stone to make sure it survive
+vardef put_black expr pp=
+ save p;
+ pair p;
+ if pair pp:
+ p := pp;
+ else:
+ p := (random_loc);
+ fi;
+ %show "put black at " & (_point_str p);
+ if (legal_loc p):
+ beginput;
+ B p;
+ _capture p;
+ _suicide p;
+ endput;
+ fi;
+enddef;
+
+vardef put_b(text t)=
+ save tt,h,v;
+ string tt;
+ numeric h,v;
+ tt = str t;
+ h = ASCII(substring (0,1) of tt) - ASCII("A") + 1;
+ v = board_size - scantokens(substring (1, length tt) of tt) + 1;
+ % show h, v;
+ put_black(h,v);
+enddef;
+
+%% put a white stone at postion pp, if possible
+%% check life and death after putting the stone
+%% re-put the stone to make sure it survive
+vardef put_white expr pp=
+ save p;
+ pair p;
+ if pair pp:
+ p := pp;
+ else:
+ p := (random_loc);
+ fi;
+ %show "put white at " & (_point_str p);
+ if (legal_loc p):
+ beginput;
+ W p;
+ _capture p;
+ _suicide p;
+ endput;
+ fi;
+enddef;
+
+vardef put_w(text t)=
+ save tt,h,v;
+ string tt;
+ numeric h,v;
+ tt = str t;
+ h = ASCII(substring (0,1) of tt) - ASCII("A") + 1;
+ v = board_size - scantokens(substring (1, length tt) of tt) + 1;
+ % show h, v;
+ put_white(h,v);
+enddef;
+
+%% remove stone from position pp, if possible
+vardef remove_stone expr pp=
+ if (xpart pp > 0) and (xpart pp < board_size+1)
+ and (ypart pp > 0) and (ypart pp < board_size+1):
+ C pp;
+ fi;
+enddef;
+
+%% determine whether putting stone at p is leagal
+%% mem[p] is empty, and p is not out of bound
+vardef legal_loc expr p=
+ save tmp;
+ tmp = 1;
+ save x,y;
+ x = xpart p;
+ y = ypart p;
+ if ((xpart p) < 1) or ((xpart p) > board_size)
+ or ((ypart p) < 1) or ((ypart p) > board_size):
+ show "ILLEGAL OPERATION, cell out of bound";
+ (tmp = 2)
+ elseif not ((MEM p) = EMPTY):
+ show "ILLEGAL OPERATION, cell occupied";
+ (tmp = 2)
+ else:
+ % save prev; string prev;
+% prev = put_history[cur_put_his-1];
+
+% if:
+% show "ILLEGAL OPERATION, re-put comflict";
+% (tmp = 2)
+% else:
+ (tmp = 1)
+% fi
+ fi
+enddef;
+
+%% go script file, plain format, i.e., color x-coord y-coord
+string GO_FILE;
+GO_FILE := "";
+FIG_COUNT = 1;
+
+%% generate boards based on go script
+vardef generate_boards_from_file=
+ if (length GO_FILE) < 1:
+ else:
+ save line,x,y,t;
+ string line,t;
+
+ init_board;
+ display_board_fig; % empty board
+ forever:
+ line := readfrom GO_FILE;
+ exitif (length line) < 3;
+
+ t := loptok line;
+ x := scantokens(loptok line);
+ y := scantokens(loptok line);
+
+ %show "read position " & t & "=(" & (decimal x) & "," & (decimal y) & ")";
+
+ if (t = "b") or (t = "B"):
+ put_black(x,y);
+ elseif (t = "w") or (t = "W"):
+ put_white(x,y);
+ fi;
+ display_board_fig;
+ endfor;
+ fi;
+enddef;
+
+%% display board in new fig
+vardef display_board_fig=
+ beginfig(FIG_COUNT);
+ display_board;
+ FIG_COUNT := FIG_COUNT + 1;
+ endfig;
+enddef;
+
+%GO_FILE := "test.go";
+%generate_boards_from_file;
+
+%% if possible to retract the last put action
+vardef can_restore=
+ (cur_put_his > 1)
+enddef;
+
+%% extract put action from string
+vardef _extract_put suffix s=
+ save t,x,y;
+ string t,x,y;
+ if (length s) < 1:
+ ""
+ else:
+ t = loptok s;
+ x = loptok s;
+ y = loptok s;
+ t & "(" & x & "," & y & ")"
+ fi
+enddef;
+
+%% reverse put action, C->B|W, B|C, W|C
+vardef _reverse suffix s=
+ save t;
+ string t;
+ t = substring (0,1) of s;
+ if (t = "B") or (t = "W"):
+ t := "C";
+ else:
+ t := char(ASCII("A") + ASCII(t) - ASCII("a"));
+ fi;
+ t & (substring (1,length s) of s)
+enddef;
+
+%% retract the last put action
+vardef restore=
+ save prev,act;
+ string prev,act;
+ prev = put_history[cur_put_his-1];
+ cur_put_his := cur_put_his - 1;
+
+ forever:
+ act := _extract_put prev;
+ exitif (length act) = 0;
+ log "restore: " & act;
+ scantokens(_reverse act);
+ endfor;
+enddef;
+
+%% putting stones, format: {B|W}{A-Z}{decimal}
+vardef stone text tt=
+ if (length tt) < 3:
+ show "ERROR: stone string illegal";
+ else:
+ save t,ys,xs;
+ string t,ys,xs;
+ t = loptok tt; %substring (0,1) of tt;
+ xs = loptok tt; %substring (1,2) of tt;
+ ys := loptok tt; %substring (2,length tt) of tt;
+
+ save x,y;
+ x = ASCII(xs) - ASCII("A") + 1;
+ y = board_size - scantokens(ys) + 1;
+
+ log "stone " & t & " at " & (decimal x) & "," & (decimal y);
+ if (t = "B") or (t = "b"):
+ put_black(x,y);
+ elseif (t = "W") or (t = "w"):
+ put_white(x,y);
+ fi;
+ fi;
+enddef;
+
+%% retract the last stoning action if possible
+vardef retract=
+ if can_restore:
+ restore;
+ else:
+ show "restore can not be performed";
+ fi;
+enddef;
+
+%% scripting on file
+vardef script text file=
+ save sf;
+ string sf; sf = file;
+ if (length sf) < 1:
+ show "ERROR: script file name illegal";
+ else:
+ save line,x,y,t;
+ string line,t;
+
+ %set_board_size scantokens(readfrom sf);
+ init_board;
+ %display_board_fig; % empty board
+ forever:
+ line := readfrom sf;
+ exitif (length line) < 3;
+
+ stone line;
+ display_board_fig;
+ endfor;
+ fi;
+enddef;
+
+_DEBUG := false;
+
+%script "script.go";
+