From 2a0a733df59b5c7d85d190c433cbe0d6fdadc89d Mon Sep 17 00:00:00 2001 From: Karl Berry Date: Mon, 17 Aug 2009 23:52:56 +0000 Subject: new metapost package suanpan (11aug09) git-svn-id: svn://tug.org/texlive/trunk@14741 c570f23f-e606-0410-a88d-b1316a301751 --- Master/texmf-dist/doc/metapost/suanpan/README | 6 + Master/texmf-dist/doc/metapost/suanpan/article.txt | 5 + Master/texmf-dist/metapost/suanpan/abacus.mp | 138 ++++++ Master/texmf-dist/metapost/suanpan/suanpan.mp | 501 +++++++++++++++++++++ 4 files changed, 650 insertions(+) create mode 100644 Master/texmf-dist/doc/metapost/suanpan/README create mode 100644 Master/texmf-dist/doc/metapost/suanpan/article.txt create mode 100644 Master/texmf-dist/metapost/suanpan/abacus.mp create mode 100644 Master/texmf-dist/metapost/suanpan/suanpan.mp (limited to 'Master/texmf-dist') diff --git a/Master/texmf-dist/doc/metapost/suanpan/README b/Master/texmf-dist/doc/metapost/suanpan/README new file mode 100644 index 00000000000..5bbee910e47 --- /dev/null +++ b/Master/texmf-dist/doc/metapost/suanpan/README @@ -0,0 +1,6 @@ +suanpan.mp is the macro file, and abacus.mp is the user file. +To process abacus.mp, write + + metapost abacus.mp + +The macros are released under the LPPL. diff --git a/Master/texmf-dist/doc/metapost/suanpan/article.txt b/Master/texmf-dist/doc/metapost/suanpan/article.txt new file mode 100644 index 00000000000..1fad3a977cb --- /dev/null +++ b/Master/texmf-dist/doc/metapost/suanpan/article.txt @@ -0,0 +1,5 @@ +Metapost macros used in + + Denis Roegel: MetaPost macros for drawing Chinese and Japanese abaci, + TUGboat (volume 30, number 1, 2009, pages 74-79) + diff --git a/Master/texmf-dist/metapost/suanpan/abacus.mp b/Master/texmf-dist/metapost/suanpan/abacus.mp new file mode 100644 index 00000000000..fbd23eed722 --- /dev/null +++ b/Master/texmf-dist/metapost/suanpan/abacus.mp @@ -0,0 +1,138 @@ +input suanpan + +setup_abacus(N=13,NBL=5,NBU=2,bead="suanpan",units=0); + +% initial value of a suanpan +beginfig(1); + rod_numbers:=false; + reset_abacus; + draw_abacus; +endfig; + + +setup_abacus(N=13,NBL=4,NBU=1,bead="soroban",units=1); + +% initial value of a soroban +beginfig(2); + rod_numbers:=false; + reset_abacus; + draw_abacus; +endfig; + +setup_abacus(N=13,NBL=5,NBU=2,bead="suanpan",units=0); +beginfig(3); + rod_numbers:=true; + reset_abacus; + valL[1]:=2; + valL[3]:=5; + valU[2]:=1; + valU[4]:=2; + draw_abacus; +endfig; + +beginfig(4); + reset_abacus; + set_abacus_val("10552"); + draw_abacus; +endfig; + +beginfig(10); + reset_abacus; + valL[1]:=2; + valL[3]:=5; + valU[2]:=1; + valU[4]:=2; + draw_abacus; +endfig; + +beginfig(20); + reset_abacus; + valL[1]:=3; + valL[3]:=5; + valU[2]:=1; + valU[4]:=2; + draw_abacus; +endfig; + +% soroban? +beginfig(30); + setup_abacus(N=13,NBL=4,NBU=1,bead="soroban",units=1); + set_abacus_val("651324"); + set_abacus_gray(deck="lower",below="000011", + above="000010"); + set_abacus_gray(deck="upper",below="000001", + above="000010"); + draw_abacus; + mark_abacus(i=1,j=5)(btex 1 etex); + mark_abacus(i=2,j=2)(btex 2 etex); + mark_abacus(i=2,j=3)(btex 3 etex); +endfig; + + +%show_val; + +setup_abacus(N=13,NBL=4,NBU=1,bead="soroban",units=1); +set_abacus_val("651324"); +reset_abacus_gray; +add_val(v="82363456",iv=100,fig=true); +%message "**********************************"; +%show_val; + +setup_abacus(N=13,NBL=5,NBU=2,bead="suanpan",units=0); + +% detailing one of the addition cases +beginfig(200); + reset_abacus; + reset_abacus_gray; + set_abacus_val("82951324"); + draw_abacus; +endfig; + +beginfig(201); + set_abacus_val("82951324"); + add_val(v="60000",iv=100,fig=false); + draw_abacus; +endfig; + +%------------------------------------------- + +beginfig(202); + reset_abacus; + reset_abacus_gray; + set_abacus_val("82951324"); + set_abacus_gray(deck="lower",below="1010000", + above="0400000"); + set_abacus_gray(deck="upper",below="0110000", + above="0000000"); + draw_abacus; +endfig; + +beginfig(203); + reset_abacus_gray; + add_val(v="60000",iv=100,fig=false); + set_abacus_gray(deck="lower",below="0400000", + above="1010000"); + set_abacus_gray(deck="upper",below="0000000", + above="0110000"); + draw_abacus; + mark_abacus(i=5,j=5)(btex 1 etex); +endfig; + +% the following two commands enable a base-8 abacus +vbu:=4; % value of a bead in the upper deck +setup_abacus(N=13,NBL=3,NBU=1,bead="suanpan",units=0); + +beginfig(300); + reset_abacus; + reset_abacus_gray; + set_abacus_val("3401256"); + draw_abacus; +endfig; + +beginfig(301); + add_val(v="1234",iv=100,fig=false); + draw_abacus; +endfig; + +end + diff --git a/Master/texmf-dist/metapost/suanpan/suanpan.mp b/Master/texmf-dist/metapost/suanpan/suanpan.mp new file mode 100644 index 00000000000..37745ea3a78 --- /dev/null +++ b/Master/texmf-dist/metapost/suanpan/suanpan.mp @@ -0,0 +1,501 @@ +% modeling of a suanpan (Chinese abacus) +% D. Roegel 9 September - 12 October 2008 +% +% These macros provide basic functions for producing suanpan (Chinese abacus) +% figures as well as soroban ones (Japanese abacus) + +numeric u; +u=1cm; + +% key-val mechanism (from LGC2, p. 59-60) +vardef executekeyval(text k)= + save _equals; + let _equals= =; + tertiarydef _ll_ _assign _rr_ = + hide(_ll_ _equals _rr_ ) 1 + enddef; + save =; + let = _equals _assign ; + for _xx_ _equals k:endfor; +enddef; + +numeric n; % number of digits +numeric nbl,vbu,nbu; % number of beads (lower/upper) + % vbu=value of a bead in the upper deck +numeric hsep,vsep,beadw,thframe,beadsp,wdvline,hlwindow,huwindow; +numeric wdframe,huwindow; + +numeric beadtype; +boolean rod_numbers; +rod_numbers=true; % default + +boolean overflow; + +numeric abacus_units; +abacus_units=0; % a value of 1 marks every third rod by a dot + % other values may be used in the future + +n=13; % default +vbu=5; % value of a bead in the upper deck +nbl=5; % total beads below (lower deck) +nbu=2; % total beads above (upper deck) +hsep=.8u; % distance between lines of beads +ihsep=.5hsep; % initial hsep +vsep=.5u; % smallest distance between bead centers +beadw=.4hsep; % bead width +thframe=.3u; % frame thickness +beadsp=u; % bead spacing +wdvline=.1u; % thickness of bamboo lines +beadtype=1; % 1=round (suanpan), 2=biconal (soroban) + +vardef setup_abacus(text kv)= + save N,NBL,NBU,bead,units; % key names + numeric N,NBL,NBU,units; + string bead; + executekeyval(kv); + n:=N; + nbl:=NBL; + nbu:=NBU; + abacus_units:=units; + wdframe:=(n-1)*hsep+2ihsep+2thframe; + htframe:=3thframe+(nbl+nbu-2)*vsep+vsep+vsep+2beadsp; + hlwindow:=(nbl-1)*vsep+vsep+beadsp; % height of lower window + huwindow:=htframe-3thframe-hlwindow; % height of upper window + if bead="suanpan": + beadtype:=1; + elseif bead="soroban": + beadtype:=2; + fi; +enddef; + +vardef draw_abacus_frame= + save P;pair P[]; + % -------------- outer frame -------------- + P0=origin; + P1-P0=P2-P3=wdframe*right; + P2-P1=htframe*up; + draw P0--P1--P2--P3--cycle; + %--------- lower inner frame -------------- + P4-P0=(thframe,thframe); + P5-P1=(-thframe,thframe); + P9=P0+(1.5thframe+hlwindow)*up; + P10-P9=P1-P0; + P7=P9+(thframe,-.5thframe); + P6-P7=P5-P4; + draw P4--P5--P6--P7--cycle; + %--------- upper inner frame -------------- + P14-P9=(thframe,.5thframe); + P15-P10=(-thframe,.5thframe); + P16-P2=(-thframe,-thframe); + P17-P3=(thframe,-thframe); + draw P14--P15--P16--P17--cycle; +enddef; + +vardef draw_abacus_rods= + save h,ha,hb,savep; + savep=savepen; + ha=hlwindow; + hb=huwindow; + h=ha+hb+thframe; + for i=1 upto n: + draw (thframe+ihsep+(i-1)*hsep-.5wdvline,thframe) + --(thframe+ihsep+(i-1)*hsep-.5wdvline,thframe+ha); + draw (thframe+ihsep+(i-1)*hsep+.5wdvline,thframe) + --(thframe+ihsep+(i-1)*hsep+.5wdvline,thframe+ha); + draw (thframe+ihsep+(i-1)*hsep-.5wdvline,thframe+h-hb) + --(thframe+ihsep+(i-1)*hsep-.5wdvline,thframe+h); + draw (thframe+ihsep+(i-1)*hsep+.5wdvline,thframe+h-hb) + --(thframe+ihsep+(i-1)*hsep+.5wdvline,thframe+h); + if rod_numbers: + label.bot(decimal i,(thframe+ihsep+(n-i)*hsep,0)); + label.top(decimal i,(thframe+ihsep+(n-i)*hsep,2thframe+h)); + fi + endfor; + pickup pencircle scaled 3pt; + if abacus_units=1: + for i=3 step 3 until n: + draw (thframe+ihsep+(n-i)*hsep,thframe+ha+.5thframe); + endfor; + fi; + pickup savep; +enddef; + +numeric valU[],valL[],vl; % stores the abacus values and the number of digits +numeric valUMu[],valUMs[],valLMs[],valLMu[]; % moved values will be in gray + +def reset_abacus= + for i=1 upto n: + valU[i]:=0; + valL[i]:=0; + endfor; + reset_abacus_gray_above; + reset_abacus_gray_below; +enddef; + +def reset_abacus_gray_above= + for i=1 upto n: + valUMs[i]:=0;valUMu[i]:=0; + endfor; +enddef; + +def reset_abacus_gray_below= + for i=1 upto n: + valLMu[i]:=0;valLMs[i]:=0; + endfor; +enddef; + +def suanpan_bead(expr X,Y)= + fullcircle xscaled 2beadw yscaled vsep shifted (X,Y) +enddef; + +def draw_suanpan_bead(expr X,Y) text options= + fill suanpan_bead(X,Y) options; +enddef; + +def draw_suanpan_gray_bead(expr X,Y) text options= + fill suanpan_bead(X,Y) options; + draw suanpan_bead(X,Y); +enddef; + +def draw_suanpan_bead_contour(expr X,Y) text options= + draw_suanpan_gray_bead(X,Y) withcolor white; +enddef; + +def define_soroban_bead_points(expr X,Y)= + save p,pa;pair p[];path pa; + p0=(X,Y);p1=p0+(beadw,.5wdvline);p2=p0+(.5wdvline,.5vsep); + p3=p0+(-.5wdvline,.5vsep);p4=p0+(-beadw,.5wdvline); + p5=p0+(-beadw,-.5wdvline);p6=p0+(-.5wdvline,-.5vsep); + p7=p0+(.5wdvline,-.5vsep);p8=p0+(beadw,-.5wdvline); + pa=p1--p2--p3--p4--p5--p6--p7--p8--cycle; +enddef; + +% this macro draws a biconal bead, like on a soroban +vardef draw_soroban_bead(expr X,Y) text options= + define_soroban_bead_points(X,Y); + unfill pa; + draw pa;draw p1--p4;draw p5--p8; +enddef; + +% this macro draws a biconal bead, like on a soroban +vardef draw_soroban_gray_bead(expr X,Y) text options= + define_soroban_bead_points(X,Y); + fill pa withcolor .7white; + draw pa;draw p1--p4;draw p5--p8; +enddef; + +vardef draw_soroban_bead_contour(expr X,Y)= + define_soroban_bead_points(X,Y); + unfill pa; + draw pa; +enddef; + +def draw_bead_contour(expr X,Y) text options= + if beadtype=1: + draw_suanpan_bead_contour(X,Y); + else: + draw_soroban_bead_contour(X,Y); + fi; +enddef; + +def draw_bead(expr X,Y) text options= + if beadtype=1: + draw_suanpan_bead(X,Y) options; + elseif beadtype=2: + draw_soroban_bead(X,Y) options; + fi; +enddef; + +def draw_gray_bead(expr X,Y)= + if beadtype=1: + draw_suanpan_gray_bead(X,Y) withcolor .7white; + elseif beadtype=2: + draw_soroban_gray_bead(X,Y) withcolor .7white; + fi; +enddef; + +vardef draw_abacus_beads= + save na,nb,X,Y; + % we go through every bead line: + for i=1 upto n: + X:=thframe+ihsep+(n-i)*hsep; + % first, we handle the lower beads: + na:=nbl-valL[i]; + nb:=valL[i]; + % ------------------------------------------------------------ + % these are the lower beads which have not been raised (unset) + for j=1 upto na: + Y:=thframe+.5vsep+(j-1)*vsep; + draw_bead(X,Y); + endfor; + % some of the previous ones are in gray: + for j=na downto na-(valLMu[i]-1): + Y:=thframe+.5vsep+(j-1)*vsep; + draw_gray_bead(X,Y); + + endfor; + %------------------------------------------------------------- + % these are the lower beads which have been raised (set) + for j=1 upto nb: + Y:=thframe+hlwindow-(.5vsep+(j-1)*vsep); + draw_bead(X,Y); + endfor; + % some of the previous ones are in gray: + for j=nb downto nb-(valLMs[i]-1): + Y:=thframe+hlwindow-(.5vsep+(j-1)*vsep); + draw_gray_bead(X,Y); + endfor; + %------------------------------------------------------------- + % then we handle the upper beads: + na:=nbu-valU[i]; + nb:=valU[i]; + %-------------------------------------------------------------- + % these are the upper beads which have not been lowered (unset) + for j=1 upto na: + Y:=htframe-(thframe+.5vsep+(j-1)*vsep); + draw_bead(X,Y); + endfor; + for j=na downto na-(valUMu[i]-1): + Y:=htframe-(thframe+.5vsep+(j-1)*vsep); + draw_gray_bead(X,Y); + endfor; + %-------------------------------------------------------------- + % these are the upper beads which have been lowered (set) + for j=1 upto nb: + Y:=2thframe+hlwindow+(.5vsep+(j-1)*vsep); + draw_bead(X,Y); + endfor; + for j=nb downto nb-(valUMs[i]-1): + Y:=2thframe+hlwindow+(.5vsep+(j-1)*vsep); + draw_gray_bead(X,Y); + endfor; + %-------------------------------------------------------------- + endfor; +enddef; + +def draw_abacus= + draw_abacus_frame; + draw_abacus_rods; + draw_abacus_beads; +enddef; + +% v must be a string +vardef set_abacus_val(expr v)= + save vx; + numeric vx[]; + reset_abacus; + vl:=min(length(v),n)-1; % handle overflows in the input + for i=0 upto length(v)-1: + vx[i]=ASCII(substring(i,i+1) of v)-ASCII("0"); + endfor; + for i=1 upto length(v): + valL[i]:=vx[length(v)-i]; + if valL[i]>vbu-1: % we must use vbu and not nbl, although + % they are usually the same + valU[i]:=1; + valL[i]:=valL[i]-vbu; % same remark + fi; + endfor; +enddef; + +vardef reset_abacus_gray= + save s; + string s; + s=""; + for i=1 upto n:s:=s & "0";endfor; + set_abacus_gray(deck="lower",below=s,above=s); + set_abacus_gray(deck="upper",below=s,above=s); +enddef; + +vardef set_abacus_gray_below= + save vx; + numeric vx[]; + reset_abacus_gray_below; + % reading the first string, for the lower part (which beads are gray) + for i=0 upto length(below)-1: + vx[i]:=ASCII(substring(i,i+1) of below)-ASCII("0"); + endfor; + for i=1 upto length(below): + valLMu[i]:=vx[length(below)-i]; + endfor; + % reading the second string, for the upper part (which beads are gray) + for i=0 upto length(above)-1: + vx[i]:=ASCII(substring(i,i+1) of above)-ASCII("0"); + endfor; + for i=1 upto length(above): + valLMs[i]:=vx[length(above)-i]; + endfor; + % we check that there is no conflict in the graying of beads: + % a bead can only be grayed if it exists + for i=1 upto n: + % lower beads ............................... + na:=nbl-valL[i]; + nb:=valL[i]; + % we force threshholds if necessary: + if valLMs[i]>valL[i]:valLMs[i]:=valL[i];fi + if valLMu[i]>na:valLMu[i]:=na;fi + endfor; +enddef; + +vardef set_abacus_gray_above= + save vx; + numeric vx[]; + reset_abacus_gray_above; + % reading the first string, for the lower part (which beads are gray) + for i=0 upto length(below)-1: + vx[i]:=ASCII(substring(i,i+1) of below)-ASCII("0"); + endfor; + for i=1 upto length(below): + valUMs[i]:=vx[length(below)-i]; + endfor; + % reading the second string, for the upper part (which beads are gray) + for i=0 upto length(above)-1: + vx[i]:=ASCII(substring(i,i+1) of above)-ASCII("0"); + endfor; + for i=1 upto length(above): + valUMu[i]:=vx[length(above)-i]; + endfor; + % we check that there is no conflict in the graying of beads: + % a bead can only be grayed if it exists + for i=1 upto n: + % upper beads ............................... + na:=nbu-valU[i]; + nb:=valU[i]; + % we force threshholds if necessary: + if valUMs[i]>valU[i]:valUMs[i]:=valU[i];fi + if valUMu[i]>na:valUMu[i]:=na;fi + endfor; +enddef; + +vardef set_abacus_gray(text kv)= + save deck,below,above; % key names + string deck,below,above; + executekeyval(kv); + if deck="lower": + set_abacus_gray_below; + elseif deck="upper": + set_abacus_gray_above; + fi; +enddef; + +% put the label `lab' on the j-th bead on row i (i=1 at the right) +vardef mark_abacus(text kv)(expr lab)= + save i,j; % key names + numeric i,j; + executekeyval(kv); + + save X,Y,na,nb,ju; + X:=thframe+ihsep+(n-i)*hsep; + if j<=nbl: % the bead to mark is below: + % first, we handle the lower beads: + na:=nbl-valL[i]; + nb:=valL[i]; + % ------------------------------------------------------------ + if j<=na: + % these are the lower beads which have not been raised (unset) + Y:=thframe+.5vsep+(j-1)*vsep; + else: + %------------------------------------------------------------- + % these are the lower beads which have been raised (set) + Y:=thframe+hlwindow-(.5vsep+(nb-(j-na))*vsep); + fi + else: % the bead to mark is above: + ju=j-nbl; + %------------------------------------------------------------- + % then we handle the upper beads: + na:=nbu-valU[i]; + nb:=valU[i]; + if ju>nb: + %-------------------------------------------------------------- + % these are the upper beads which have not been lowered (unset) + Y:=htframe-(thframe+.5vsep+(na-(ju-nb))*vsep); + else: + %-------------------------------------------------------------- + % these are the upper beads which have been lowered (set) + Y:=2thframe+hlwindow+(.5vsep+(ju-1)*vsep); + fi; + fi; + draw_bead_contour(X,Y); + draw thelabel(lab,(X,Y)); % withcolor white; +enddef; + +def show_val= + for i=1 upto vl+1: + message "valU[" & decimal i & "]=" & decimal (valU[i]); + message "valL[" & decimal i & "]=" & decimal (valL[i]); + endfor; +enddef; + +% v=value, iv=image view +def add_val(text kv)= + save v,iv,fig; % key names + string v;numeric iv;boolean fig; + executekeyval(kv); + save vx,VL,VU,carry; + numeric vx[],vL[],vU[],vx.len; + overflow:=false; + % we store the new value to add in one array + vx.len=min(length(v),n)-1; % we consider at most n digits + %message "vx.len=" & decimal vx.len; + for i=0 upto vx.len: + vx[i]=ASCII(substring(i,i+1) of v)-ASCII("0"); + endfor; + for i=1 upto length(v): + vL[i]:=vx[length(v)-i]; + endfor; + + % if necessary, we modify the size of the first number: + if vx.len>vl:vl:=vx.len;fi + % the result will be either this wide, or will have one more digit + % to the left + + if fig: + % the initial configuration: + beginfig(iv); + draw_abacus; + endfig; + fi + + % we add the digits from left to right: + for i=vx.len+1 downto 1: + valL[i]:=valL[i]+vL[i]; + % if there would be too many beads below, we adjust the upper ones: + forever: + if valL[i]>vbu-1: + valL[i]:=valL[i]-vbu; + valU[i]:=valU[i]+1; + fi + exitif valL[i]1: % valU[i]=2 or 3 are possible values + carry:=1; + % propagate carry + valU[i]:=valU[i]-2; + for j=i+1 upto vl+1: + valL[j]:=valL[j]+carry; + if valL[j]>4:valL[j]:=0;valU[j]:=valU[j]+1;fi + if valU[j]>1:carry:=1;valU[j]:=valU[j]-2;else:carry:=0;fi + exitif carry=0; % no need to go all the way through, + % if the carry becomes 0 + endfor; + if carry=1: + % we increment vl and we add the carry: + vl:=vl+1; + valL[vl+1]:=1; + if vl+1>n:overflow:=true;fi + fi + fi + %message "adding " & decimal vL[i] & " at position " & decimal i + % & " and generating view " & decimal (iv+(vx.len+1-i)+1); + if fig: + beginfig(iv+(vx.len+1-i)+1); + draw_abacus; + endfig; + fi + endfor; + +enddef; + +endinput -- cgit v1.2.3