path: root/web/yacco2/diagrams/o2diag.mp

% file: o2diag.mp - attempt to produce grammar railroad diagrams
input boxes
%tracingall;
%tracingmacros := 1;  
%tracingequations := 1;  
defaultfont := "cmtt8";


pair sr_indent,sr_dy,sr_bet_elem,sr[],spillover_sr[],exit_bnd;
numeric how_drw_obj;
numeric dx_exit,dy_exit;
numeric max_dx_bnd;
numeric half_exit;
numeric lft_recursion_ht;
numeric above,below,gap;

vardef is_epsilon_present(expr Str)=
  boolean present;present:=false;
  if(length Str = 1):
	if (substring (0,1) of Str = " "): 
	  present:=true;
	fi;
  fi;
  present
enddef;

vardef is_underscore_present(expr Str)=
  boolean present;present:=false;
  for i=1 upto length Str:
	if substring (i-1,i) of Str = "_": 
	  present:=true;
	fi;
  endfor
  present
enddef;

vardef bld_cmd_to_exec(expr Object,Name,Prefix)=
  string cmd;cmd := Prefix&Object&"( btex ";
  string nnm;nnm := "";
  for i=1 upto length Name:
	if substring (i-1,i) of Name = "_": 
	  nnm := nnm & "\";
	  nnm := nnm & substring (i-1,i) of Name;
	else:
	  nnm := nnm & substring (i-1,i) of Name;
	fi;
  endfor
  cmd := cmd & nnm;
  cmd := cmd & " etex);";
  cmd
enddef;

def exec_cmd(text Cmd)=
  scantokens Cmd;
enddef;

def init_variables =
  sr_indent :=(.3in,0);
  sr_dy :=(0,.4in);
  sr_bet_elem :=(.15in,0);  
  sr[0]:= sr_indent - (0,.2in);
  lft_recursion_ht:=.15in;
  dx_exit:=0;
  dy_exit:=0;
  above=below=.1in;
  gap=.025in;
  max_dx_bnd := 4.5in;
enddef;

vardef cuta(suffix a,b) expr p =
drawarrow p cutbefore bpath.a cutafter bpath.b;
point .5*length p of p
enddef;
vardef self@# expr p =
cuta(@#,@#) @#.c{curl10}..@#.c+p..{curl10}@#.c
enddef;

def crt_rule_box(expr ruleno) =
  string vnm; vnm := "rule_" & rule_names[ruleno].vname;
  string lnm; lnm := rule_names[ruleno].literal;
  string Cmd;Cmd := "";
  boolean underscore_present;
  underscore_present := is_underscore_present(lnm);
  if(underscore_present = false):
	forsuffixes i = scantokens vnm :
		boxit.i(substring (0,infinity) of lnm);
	endfor
  else:
	%Cmd := bld_cmd_to_exec(vnm,lnm,"boxit.");
	%exec_cmd(Cmd);
	forsuffixes i = scantokens vnm :
		boxit.i(substring (0,infinity) of lnm);
	endfor
  fi
enddef;

def drw_rule_box(expr ruleno) =
  string vnm; vnm := "rule_" & rule_names[ruleno].vname;
  string lnm; lnm := rule_names[ruleno].literal;
  forsuffixes i = scantokens vnm :
    drawunboxed(i);
  endfor
enddef;

def crt_rule(expr ruleno,subruleno,elemno) =
  string vnm; vnm := rhs_elems[ruleno][subruleno][elemno].vname;
  string nm; nm := rhs_elems[ruleno][subruleno][elemno].literal;
	forsuffixes i = scantokens vnm :
		boxit.i(substring (0,infinity) of nm);
	endfor
enddef;

def crt_terminal(expr ruleno,subruleno,elemno) =
  string vnm; vnm := rhs_elems[ruleno][subruleno][elemno].vname;
  string nm; nm := rhs_elems[ruleno][subruleno][elemno].literal;
	forsuffixes i = scantokens vnm :
		circleit.i(substring (0,infinity) of nm);
		i.dx=i.dy;%make oval
	endfor
enddef;

def align_sr_start expr sr_no =
  if(sr_no = 1):
    sr[sr_no] := sr[0];
  else:
	if(ypart spillover_sr[sr_no - 1] <> 0):
		sr[sr_no] := spillover_sr[sr_no - 1] - sr_dy;
	else:
		sr[sr_no] := sr[sr_no - 1] - sr_dy;
	fi
  fi
enddef;

def align_spec_sr_start expr sr_no =
    sr[sr_no] := sr[0];
enddef;

vardef has_spillover_occured(suffix frm,too)=
  boolean spillover;spillover:=false;
  pair rt_obj_pos;
  %%% this makes mpost crazy when bpath the new element
  %%%rt_obj_pos  := urcorner bpath.too - ulcorner bpath.too;
  %%%numeric rt_obj_size;rt_obj_size := xpart rt_obj_pos;

  %%%numeric sxsxsxsx; sxsxsxsx := xpart urcorner too.w;
  %%%rt_obj_pos  := urcorner bpath.too - ulcorner bpath.too;
  %%%numeric rt_obj_size;rt_obj_size := xpart rt_obj_pos;


  pair cur_pos;cur_pos := urcorner bpath.frm;
  numeric new_rt_pos;
  new_rt_pos := xpart sr_bet_elem; 
  new_rt_pos := new_rt_pos + xpart cur_pos;
  %%%new_rt_pos := new_rt_pos + rt_obj_size;
  if(new_rt_pos  > max_dx_bnd):%shift down into start pt
     spillover := true;
  fi
  spillover
enddef;

def hz_align_rhs(expr rule_no,subrule_no) =
    spillover_sr[subrule_no] := sr_indent;
	for k=1 step 1 until rule_s_subrule_no_elems[rule_no][subrule_no]: % rhs's elems
      string vnm; vnm := rhs_elems[rule_no][subrule_no][k].vname;
      forsuffixes i=scantokens vnm:
        if(k=1):
          i.w = sr[subrule_no] + sr_bet_elem;
        else:
          % fetch previous elem
          numeric j; j := k-1;
          string pvnm; pvnm := rhs_elems[rule_no][subrule_no][j].vname;
          forsuffixes pi=scantokens pvnm:
			if(has_spillover_occured(pi,i)=true):%shift down into start pt
				if(ypart spillover_sr[subrule_no] = 0):
				  spillover_sr[subrule_no] := sr[subrule_no];
				fi
				spillover_sr[subrule_no] := spillover_sr[subrule_no] - sr_dy;
				i.w = spillover_sr[subrule_no] + sr_bet_elem;
			else:
				i.w = pi.e + sr_bet_elem;
			fi
		  endfor
        fi;
      endfor
	endfor
enddef;

def det_exit_bnd(expr rule_no) =
  dx_exit := 0;
  dy_exit := 0;
  for no_sr=1 step 1 until rule_s_no_rhs[rule_no]:
	for k=1 step 1 until rule_s_subrule_no_elems[rule_no][no_sr]: % rhs's elems
      string vnm; vnm := rhs_elems[rule_no][no_sr][k].vname;
      forsuffixes i=scantokens vnm:
        if(xpart urcorner bpath.i > dx_exit):
          dx_exit := xpart urcorner bpath.i;          
        fi;
      endfor
	endfor
  endfor
enddef;

def det_spec_sr_exit_bnd(expr rule_no,subruleno) =
  dx_exit := 0;
  dy_exit := 0;
  for no_sr=subruleno step 1 until subruleno:
	for k=1 step 1 until rule_s_subrule_no_elems[rule_no][no_sr]: % rhs's elems
      string vnm; vnm := rhs_elems[rule_no][no_sr][k].vname;
      forsuffixes i=scantokens vnm:
        if(xpart urcorner bpath.i > dx_exit):
          dx_exit := xpart urcorner bpath.i;          
        fi;
      endfor
	endfor
  endfor
enddef;

def crt_rhs_elems(expr rule_no,subrule_no) =
	for k=1 step 1 until rule_s_subrule_no_elems[rule_no][subrule_no]: % rhs's elems
      how_drw_obj := rhs_elems[rule_no][subrule_no][k].Drw_how;
      if ((how_drw_obj = Box_solid) or (how_drw_obj = Box_dotted)):
        crt_rule(rule_no,subrule_no,k);
      else:
        crt_terminal(rule_no,subrule_no,k);
      fi; 
	endfor
enddef;

def drw_spec_vt_exit_line(expr sr_no) =
  numeric ybot;
  if(ypart spillover_sr[sr_no] = 0):
    ybot := ypart sr[sr_no];
  else:
    ybot := ypart spillover_sr[sr_no];
  fi
  draw (dx_exit,ypart sr[sr_no]+above) .. (dx_exit,ybot-below);
  draw (dx_exit+gap,ypart sr[sr_no]+above) .. (dx_exit+gap,ybot-below);
enddef;

def drw_spec_vt_start_line(expr sr_no) =
  numeric ybot;
  if(ypart spillover_sr[sr_no] = 0):
    ybot := ypart sr[sr_no];
  else:
    ybot := ypart spillover_sr[sr_no];
  fi
  draw (xpart sr_indent,ypart sr[sr_no]+above) .. (xpart sr_indent,ybot-below);
  for i=sr_no step 1 until sr_no:
    draw(sr[i]..sr[i]+(xpart sr_bet_elem,0));%start arrow
  endfor
enddef;

def drw_vt_exit_line(expr to) =
  numeric ybot;
  if(ypart spillover_sr[to] = 0):
    ybot := ypart sr[to];
  else:
    ybot := ypart spillover_sr[to];
  fi
  draw (dx_exit,ypart sr[1]+above) .. (dx_exit,ybot-below);
  draw (dx_exit+gap,ypart sr[1]+above) .. (dx_exit+gap,ybot-below);
enddef;

def drw_vt_start_line(expr to) =
  numeric ybot;
  if(ypart spillover_sr[to] = 0):
    ybot := ypart sr[to];
  else:
    ybot := ypart spillover_sr[to];
  fi
  draw (xpart sr_indent,ypart sr[1]+above) .. (xpart sr_indent,ybot-below);
  for i=1 step 1 until to:
    draw(sr[i]..sr[i]+(xpart sr_bet_elem,0));%start arrow
  endfor
enddef;

def drw_snake(suffix frm,too)=
    pair jjj; jjj := (xpart frm.e+.1in,ypart frm.e);
    draw frm.e--jjj;
    pair dxdy; dxdy := .5[frm.s,too.n];
    dxdy := (xpart jjj,ypart dxdy);
    draw  jjj--dxdy;
    pair topof_too;topof_too := (xpart too.n,ypart dxdy);
    draw  dxdy--topof_too;
    
    drawarrow(topof_too..too.n);
enddef;

def drw_rhs(expr ruleno,subruleno) =
  numeric lst_elem;
  lst_elem := rule_s_subrule_no_elems[ruleno][subruleno];
  for e=1 step 1 until lst_elem:
	string vnm; vnm := rhs_elems[ruleno][subruleno][e].vname;
	string lnm; lnm := rhs_elems[ruleno][subruleno][e].literal;
	boolean how_dotted;% true dotted , false solid
    how_drw_obj := rhs_elems[ruleno][subruleno][e].Drw_how;
	if(is_epsilon_present(lnm) = false):
		forsuffixes i = scantokens vnm :
		   if((how_drw_obj = Box_solid) or ((how_drw_obj = Circle_solid))):
			 drawboxed(i);
		   else:
			fixsize(i);
			fixpos(i);
			draw pic_mac_.i;% contents
			if(how_drw_obj = Circle_dotted):
			  draw bpath.i dashed withdots;%dashed dots
			else:
			  draw bpath.i dashed evenly;%dashed line
			fi
		   fi
		endfor
	else:
		forsuffixes i = scantokens vnm :
			fixsize(i);
			fixpos(i);
		endfor
	fi
  endfor
  % link by arrows
  for e=1 step 1 until lst_elem:
	string vnm; vnm := rhs_elems[ruleno][subruleno][e].vname;
	forsuffixes i = scantokens vnm :
        if(e < lst_elem ):
	      string nvnm; nvnm := rhs_elems[ruleno][subruleno][e+1].vname;
          how_drw_obj := rhs_elems[ruleno][subruleno][e+1].Drw_how;
	      forsuffixes j = scantokens nvnm :
	        if(ypart i.c = ypart j.c):% are px + px+1 on same line?
	          if(how_drw_obj = Box_dotted):%called thread y then reverse arrow
                drawarrow(cuta(j,i) j.c..i.c);%link elements with arrows
	          else:
                drawarrow(cuta(i,j) i.c..j.c);%link elements with arrows
              fi
            else:%snake your way
              drw_snake(i,j);
            fi
          endfor
        fi
	endfor
  endfor
enddef;

def drw_spec_rhs(expr ruleno,subruleno) =
  numeric lst_elem;
  lst_elem := rule_s_subrule_no_elems[ruleno][subruleno];
  for e=1 step 1 until lst_elem:
	string vnm; vnm := rhs_elems[ruleno][subruleno][e].vname;
	string lnm; lnm := rhs_elems[ruleno][subruleno][e].literal;
	boolean how_dotted;% true dotted , false solid
    how_drw_obj := rhs_elems[ruleno][subruleno][e].Drw_how;
	if(is_epsilon_present(lnm) = false):
		forsuffixes i = scantokens vnm :
		   if((how_drw_obj = Box_solid) or ((how_drw_obj = Circle_solid))):
			 drawboxed(i);
		   else:
			fixsize(i);
			fixpos(i);
			draw pic_mac_.i;% contents
			if(how_drw_obj = Circle_dotted):
			  draw bpath.i dashed withdots;%dashed dots
			else:
			  draw bpath.i dashed evenly;%dashed line
			fi
		   fi
		endfor
	else:
		forsuffixes i = scantokens vnm :
			fixsize(i);
			fixpos(i);
		endfor
	fi
  endfor
  % link by arrows
  for e=1 step 1 until lst_elem:
	string vnm; vnm := rhs_elems[ruleno][subruleno][e].vname;
	forsuffixes i = scantokens vnm :
        if(e < lst_elem ):
	      string nvnm; nvnm := rhs_elems[ruleno][subruleno][e+1].vname;
          how_drw_obj := rhs_elems[ruleno][subruleno][e+1].Drw_how;
	      forsuffixes j = scantokens nvnm :
	        if(ypart i.c = ypart j.c):% are px + px+1 on same line?
	          if(how_drw_obj = Box_dotted):%called thread y then reverse arrow
                drawarrow(cuta(j,i) j.c..i.c);%link elements with arrows
	          else:
                drawarrow(cuta(i,j) i.c..j.c);%link elements with arrows
              fi
            else:%snake your way
              drw_snake(i,j);
            fi
          endfor
        fi
	endfor
  endfor
enddef;

def drw_rule_s_rhs(expr ruleno) =
  for sr=1 step 1 until rule_s_no_rhs[ruleno]:
    drw_rhs(ruleno,sr);
  endfor
  drw_rule_s_bnd_lines(ruleno);
enddef;

def drw_rule_s_spec_rhs(expr ruleno,subruleno) =
  for sr=subruleno step 1 until subruleno:
    drw_spec_rhs(ruleno,sr);
  endfor
  drw_rule_s_spec_subrule_bnd_lines(ruleno,subruleno);
  drw_rule_s_spec_subrule_parms(ruleno,subruleno);
enddef;

def drw_left_recursion_line(expr ruleno,subruleno,exitbnd) =
  string lrnm; lrnm := rule_names[ruleno].literal;
  string lenm; lenm := rhs_elems[ruleno][subruleno][1].literal;
  if(rule_s_subrule_no_elems[ruleno][subruleno] > 1): % lft recur reqs 2 or elems
	  if(lrnm = lenm):
		string vnm; vnm := rhs_elems[ruleno][subruleno][2].vname;
		half_exit := xpart exitbnd - xpart sr_bet_elem;
		forsuffixes $=scantokens vnm:
			draw (half_exit,ypart exitbnd)--
				 (half_exit,ypart $.c + lft_recursion_ht)
				-- $.c + (0,lft_recursion_ht) -- $.n  dashed withdots;
		endfor
      fi
  fi
enddef;

def drw_rule_s_spec_subrule_parms(expr ruleno,subruleno) =
  numeric lst_elem;
  lst_elem := rule_s_subrule_no_elems[ruleno][subruleno];
  for e=1 step 1 until lst_elem:
	string vnm; vnm := rhs_elems[ruleno][subruleno][e].vname;
	forsuffixes i = scantokens vnm :
	  string rst;
	  rst := decimal e;
	  label.bot(rst,i.s);	
    endfor
  endfor
enddef;

def drw_rule_s_spec_subrule_bnd_lines(expr ruleno,subruleno) =
	det_spec_sr_exit_bnd(ruleno,subruleno);% determine exit line bnds of rule 
	dx_exit := dx_exit + 2* (xpart sr_bet_elem);
	numeric sr_lst_elem;
    for srno=subruleno step 1 until subruleno:
      sr_lst_elem := rule_s_subrule_no_elems[ruleno][srno];
	  string vnm; vnm := rhs_elems[ruleno][srno][sr_lst_elem].vname;
	  string lnm; lnm := rhs_elems[ruleno][srno][sr_lst_elem].literal;
	  forsuffixes i = scantokens vnm :
	    dy_exit := ypart i.e;
	    exit_bnd := (dx_exit,dy_exit);
	    if(is_epsilon_present(lnm) = true):
	      draw(i.w..exit_bnd);% draw ht exit line
	    else:
	      draw(i.e..exit_bnd);% draw ht exit line
	      drw_left_recursion_line(ruleno,srno,exit_bnd);
	    fi
	  endfor
    endfor
	drw_spec_vt_exit_line(subruleno);
	drw_spec_vt_start_line(subruleno);	
enddef;

def drw_rule_s_bnd_lines(expr ruleno) =
	det_exit_bnd(ruleno);% determine exit line bnds of rule 
	dx_exit := dx_exit + 2* (xpart sr_bet_elem);
	numeric sr_lst_elem;
    for srno=1 step 1 until rule_s_no_rhs[ruleno]:
      sr_lst_elem := rule_s_subrule_no_elems[ruleno][srno];
	  string vnm; vnm := rhs_elems[ruleno][srno][sr_lst_elem].vname;
	  string lnm; lnm := rhs_elems[ruleno][srno][sr_lst_elem].literal;
	  forsuffixes i = scantokens vnm :
	    dy_exit := ypart i.e;
	    exit_bnd := (dx_exit,dy_exit);
	    if(is_epsilon_present(lnm) = true):
	      draw(i.w..exit_bnd);% draw ht exit line
	    else:
	      draw(i.e..exit_bnd);% draw ht exit line
	      drw_left_recursion_line(ruleno,srno,exit_bnd);
	    fi
	  endfor
    endfor
    numeric no_subrules;no_subrules := rule_s_no_rhs[ruleno];
	drw_vt_exit_line(no_subrules);
	drw_vt_start_line(no_subrules);	
enddef;

def drw_rule(expr ruleno) =
  crt_rule_box(ruleno);
  for j=1 step 1 until rule_s_no_rhs[ruleno]: % rhs
    align_sr_start(j);
    crt_rhs_elems(ruleno,j);% establish rhs variables 
    hz_align_rhs(ruleno,j);
  endfor

  drw_rule_box(ruleno);
  drw_rule_s_rhs(ruleno);
enddef;

def drw_rule_a_rhs(expr ruleno,subruleno) =
  for j=subruleno step subruleno until subruleno: % rhs
    align_spec_sr_start(j);
    crt_rhs_elems(ruleno,j);% establish rhs variables 
    hz_align_rhs(ruleno,j);
  endfor

  drw_rule_s_spec_rhs(ruleno,subruleno);
enddef;