# Some functions to create xfig .fig files:

XFIG_COLORS := rec(
  Default := -1, Black := 0, Blue := 1, Green := 2, 
  Cyan := 3, Red := 4, Magenta := 5, Yellow := 6,
  White := 7, Blue4 := 8, Blue3 := 9, Blue2 := 10, LtBlue := 11,
  Green4 := 12, Green3 := 13, Green2 := 14,
  Cyan4 := 15, Cyan3 := 16, Cyan2 := 17,
  Red4 := 18, Red3 := 19, Red2 := 20,
  Magenta4 := 21, Magenta3 := 22, Magenta2 := 23,
  Brown4 := 24, Brown3 := 25, Brown2 := 26,
  Pink4 := 27, Pink3 := 28, Pink2 := 29, Pink := 30,
  Gold := 31,
);

XFIG_LINESTYLES := rec(
  Default := -1, Solid := 0, Dashed := 1, Dotted := 2,
  DashDotted := 3, DashDoubleDotted := 4, DashTripleDotted := 5,
);

XFIG_SUBTYPES := rec(
  Polyline := 1, Box := 2, Polygon := 3, ArcBox := 4, Picture := 5,
  EllipseRadius := 1, EllipseDiameters := 2, 
  CircleRadius := 3, CircleDiameter := 4,
  ClosedApproximatedSpline := 1, OpenInterpolatedSpline := 2,
  ClosedInterpolatedSpline := 3, OpenXSpline := 4, ClosedXSpline := 5,
  LeftJustified := 0, CenterJustified := 1, RightJustified := 2,
  OpenEnded := 1, PieWedge := 2,
);

XFIG_AREAFILLS := rec(
  NotFilled := -1,
  Black := 0, Grey1 := 1, Grey2 := 2, Grey3 := 3, Grey4 := 4, Grey5 := 5,
  Grey6 := 6, Grey7 := 7, Grey8 := 8, Grey9 := 9, Grey10 := 10, Grey11 := 11,
  Grey12 := 12, Grey13 := 13, Grey14 := 14, Grey15 := 15, Grey16 := 16,
  Grey17 := 17, Grey18 := 18, Grey19 := 19, White := 20,
);

XFIG_JOINSTYLES := rec(
  Miter := 0, Round := 1, Bevel := 2,
);

XFIG_CAPSTYLES := rec(
  Butt := 0, Round := 1, Projecting := 2,
);

XFIG_DIRECTIONS := rec(
  Clockwise := 0, Counterclockwise := 1,
);

XFIG_ARROWTYPES := rec(
  Stick := 0, Closed := 1, ClosedIndented := 2, ClosedPointed := 3,
);

XFIG_ARROWSTYLES := rec(
  Hollow := 0, Filled := 1,
);

XFIG_FONTS := rec(
   DefaultLaTeX := 0, 
   Roman := 1, Bold := 2, Italic := 3, SansSerif := 4, Typewriter := 5,
   Default := -1, TimesRoman := 0, TimesItalic := 1, TimesBold := 2,
   TimesBoldItalic := 3, AvantGardeBook := 4, AvantGardeBookOblique := 5,
   AvantGardeDemi := 6, AvantGardeDemiOblique := 7, BookmanLight := 8,
   BookmanLightItalic := 9, BookmanDemi := 10, BookmanDemiItalic := 11,
   Courier := 12, CourierOblique := 13, CourierBold := 14,
   CourierBoldOblique := 15, Helvetica := 16, HelveticaOblique := 17,
   HelveticaBold := 18, HelveticaBoldOblique := 19, HelveticaNarrow := 20,
   HelveticaNarrowOblique := 21, HelveticaNarrowBold := 22,
   HelveticaNarrowBoldOblique := 23, NewCenturySchoolbookRoman := 24,
   NewCenturySchoolbookItalic := 25, NewCenturySchoolbookBold := 26,
   NewCenturySchoolbookBoldItalic := 27, PalatinoRoman := 28,
   PalatinoItalic := 29, PalatinoBold := 30, PalatinoBoldItalic := 31,
   Symbol := 32, ZapfChanceryMediumItalic := 33, ZapfDingbats := 34,
);

XFIG_FONTFLAGS := rec(
  Rigid := 1, Special := 2, Postscript := 4, Hidden := 8,
);

XFIGOPT := rec(
  orientation := "Portrait",
  justification := "Center",
  units := "Metric",
  papersize := "A4",
  magnification := "100.0",
  multiplepage := "Single",
  transparentcolor := -2,
  linestyle := XFIG_LINESTYLES.Solid,
  thickness := 1,   # in 1/80 inch
  pencolor := XFIG_COLORS.Black,
  fillcolor := XFIG_COLORS.Black,
  depth := 50,
  penstyle := -1,   # not used
  areafill := XFIG_AREAFILLS.NotFilled,
  styleval := "20.000",   # in 1/80 inch
  joinstyle := XFIG_JOINSTYLES.Miter,
  capstyle := XFIG_CAPSTYLES.Butt,
  radius := -1,     # in 1/80 inch
  direction := XFIG_DIRECTIONS.Clockwise,
  fwarrowtype := XFIG_ARROWTYPES.Stick,
  fwarrowstyle := XFIG_ARROWSTYLES.Hollow,
  fwarrowthickness := 1,   # in 1/80 inch
  fwarrowwidth := 1,       # xfig units
  fwarrowheight := 1,      # xfig units
  bwarrowtype := XFIG_ARROWTYPES.Stick,
  bwarrowstyle := XFIG_ARROWSTYLES.Hollow,
  bwarrowthickness := 1,   # in 1/80 inch
  bwarrowwidth := 1,       # xfig units
  bwarrowheight := 1,      # xfig units
  angle := "0.000",        # radians
  color := XFIG_COLORS.Black,
  font := XFIG_FONTS.TimesRoman,
  fontsize := "12.000",    # in points
  fontflags := XFIG_FONTFLAGS.Postscript,   # bits!
);

XFigInternalWriter := Append;
XFigWriter := function(s,ob)
  local i;
  if IsStringRep(ob) then
      XFigInternalWriter(s,ob);
  elif IsList(ob) then
      if Length(ob) > 0 then XFigWriter(s,ob[1]); fi;
      for i in [2..Length(ob)] do
          XFigWriter(s," ");
          XFigWriter(s,ob[i]);
      od;
  else
      XFigInternalWriter(s,String(ob));
  fi;
end;

XFigHandleOption := function(s,opt,name,ws)
     if IsBound(opt.(name)) then
         XFigWriter(s,opt.(name));
     elif IsBound(XFIGOPT.(name)) then
         XFigWriter(s,XFIGOPT.(name));
     else
         Error("no default specified for option ",name);
     fi;
     if ws <> "" then XFigWriter(s,ws); fi;
  end;

XFigHeader := function(opt)
  local s;
  s := "#FIG 3.2 Created by GAP using writexfig.g\n";
  XFigHandleOption(s,opt,"orientation","\n");
  XFigHandleOption(s,opt,"justification","\n");
  XFigHandleOption(s,opt,"units","\n");
  XFigHandleOption(s,opt,"papersize","\n");
  XFigHandleOption(s,opt,"magnification","\n");
  XFigHandleOption(s,opt,"multiplepage","\n");
  XFigHandleOption(s,opt,"transparentcolor","\n");  # means None
  if IsBound(opt.comment) then
      XFigWriter(s,"# ");
      XFigHandleOption(s,opt,"comment","\n");
  fi;
  XFigWriter(s,"1200 2\n");  # 1200 units per inch, origin in upper left corner
  return s;
end;

XFigDoForwardArrow := function(s,opt)
  XFigHandleOption(s,opt,"fwarrowtype"," ");
  XFigHandleOption(s,opt,"fwarrowstyle"," ");
  XFigHandleOption(s,opt,"fwarrowthickness"," ");
  XFigHandleOption(s,opt,"fwarrowwidth"," ");
  XFigHandleOption(s,opt,"fwarrowheight"," ");
  XFigWriter(s,"\n");
end;

XFigDoBackwardArrow := function(s,opt)
  XFigHandleOption(s,opt,"bwarrowtype"," ");
  XFigHandleOption(s,opt,"bwarrowstyle"," ");
  XFigHandleOption(s,opt,"bwarrowthickness"," ");
  XFigHandleOption(s,opt,"bwarrowwidth"," ");
  XFigHandleOption(s,opt,"bwarrowheight"," ");
  XFigWriter(s,"\n");
end;

XFigDoPicture := function(s,opt)
  XFigHandleOption(s,opt,"flipped"," ");
  XFigHandleOption(s,opt,"picname","\n");
end;

XFigComment := function(s,comment)
  # comment should be exactly one line without end of line character
  XFigWriter(s,"#");
  XFigWriter(s,comment);
  XFigWriter(s,"\n");
end;

XFigColor := function(s,number,rgb)
  XFigWriter(s,["0",number,rgb]);
  XFigWriter(s,"\n");
end;

XFigArc := function(s,subtype,center,threepoints,opt)
  local fwarrow, bwarrow, i;
  if Length(center) <> 2 then
      Error("need two coordinates for center");
      return;
  fi;
  if Length(threepoints) <> 6 then
      Error("need three points for threepoints");
      return;
  fi;
  XFigWriter(s,[5,subtype]);
  XFigWriter(s," ");
  XFigHandleOption(s,opt,"linestyle"," ");
  XFigHandleOption(s,opt,"thickness"," ");
  XFigHandleOption(s,opt,"pencolor"," ");
  XFigHandleOption(s,opt,"fillcolor"," ");
  XFigHandleOption(s,opt,"depth"," ");
  XFigHandleOption(s,opt,"penstyle"," ");
  XFigHandleOption(s,opt,"areafill"," ");
  XFigHandleOption(s,opt,"styleval"," ");
  XFigHandleOption(s,opt,"capstyle"," ");
  XFigHandleOption(s,opt,"direction"," ");
  if IsBound(opt.forwardarrow) and opt.forwardarrow = 1 then
      fwarrow := true;
      XFigWriter(s,"1 ");
  else
      fwarrow := false;
      XFigWriter(s,"0 ");
  fi;
  if IsBound(opt.backwardarrow) and opt.backwardarrow = 1 then
      bwarrow := true;
      XFigWriter(s,"1 ");
  else
      bwarrow := false;
      XFigWriter(s,"0 ");
  fi;
  XFigWriter(s,center);
  XFigWriter(s," ");
  XFigWriter(s,threepoints);
  XFigWriter(s,"\n");
  if fwarrow then XFigDoForwardArrow(s,opt); fi;
  if bwarrow then XFigDoBackwardArrow(s,opt); fi;
end;

XFigPolyLine := function(s,subtype,coords,opt)
  local fwarrow, bwarrow, i;
  if Length(coords) mod 2 <> 0 then
      Error("Odd number of coordinates!");
      return;
  fi;
  XFigWriter(s,[2,subtype]);
  XFigWriter(s," ");
  XFigHandleOption(s,opt,"linestyle"," ");
  XFigHandleOption(s,opt,"thickness"," ");
  XFigHandleOption(s,opt,"pencolor"," ");
  XFigHandleOption(s,opt,"fillcolor"," ");
  XFigHandleOption(s,opt,"depth"," ");
  XFigHandleOption(s,opt,"penstyle"," ");
  XFigHandleOption(s,opt,"areafill"," ");
  XFigHandleOption(s,opt,"styleval"," ");
  XFigHandleOption(s,opt,"joinstyle"," ");
  XFigHandleOption(s,opt,"capstyle"," ");
  XFigHandleOption(s,opt,"radius"," ");
  if IsBound(opt.forwardarrow) and opt.forwardarrow = 1 then
      fwarrow := true;
      XFigWriter(s,"1 ");
  else
      fwarrow := false;
      XFigWriter(s,"0 ");
  fi;
  if IsBound(opt.backwardarrow) and opt.backwardarrow = 1 then
      bwarrow := true;
      XFigWriter(s,"1 ");
  else
      bwarrow := false;
      XFigWriter(s,"0 ");
  fi;
  XFigWriter(s,Length(coords)/2);
  XFigWriter(s,"\n");
  if fwarrow then XFigDoForwardArrow(s,opt); fi;
  if bwarrow then XFigDoBackwardArrow(s,opt); fi;
  if subtype = 5 or subtype = "5" then XFigDoPicture(s,opt); fi;
  for i in [1,3..Length(coords)-1] do
      XFigWriter(s,coords[i]);
      XFigWriter(s," ");
      XFigWriter(s,coords[i+1]);
      XFigWriter(s,"\n");
  od;
end;

XFigSpline := function(s,subtype,coords,control,opt)
  local fwarrow, bwarrow, i;
  if Length(coords) mod 2 <> 0 then
      Error("Odd number of coordinates!");
      return;
  fi;
  if Length(control) <> Length(coords)/2 then
      Error("control factors vector has length unequal to number of points");
      return;
  fi;
  XFigWriter(s,[3,subtype]);
  XFigWriter(s," ");
  XFigHandleOption(s,opt,"linestyle"," ");
  XFigHandleOption(s,opt,"thickness"," ");
  XFigHandleOption(s,opt,"pencolor"," ");
  XFigHandleOption(s,opt,"fillcolor"," ");
  XFigHandleOption(s,opt,"depth"," ");
  XFigHandleOption(s,opt,"penstyle"," ");
  XFigHandleOption(s,opt,"areafill"," ");
  XFigHandleOption(s,opt,"styleval"," ");
  XFigHandleOption(s,opt,"capstyle"," ");
  if IsBound(opt.forwardarrow) and opt.forwardarrow = 1 then
      fwarrow := true;
      XFigWriter(s,"1 ");
  else
      fwarrow := false;
      XFigWriter(s,"0 ");
  fi;
  if IsBound(opt.backwardarrow) and opt.backwardarrow = 1 then
      bwarrow := true;
      XFigWriter(s,"1 ");
  else
      bwarrow := false;
      XFigWriter(s,"0 ");
  fi;
  XFigWriter(s,Length(coords)/2);
  XFigWriter(s,"\n");
  if fwarrow then XFigDoForwardArrow(s,opt); fi;
  if bwarrow then XFigDoBackwardArrow(s,opt); fi;
  for i in [1,3..Length(coords)-1] do
      XFigWriter(s,coords[i]);
      XFigWriter(s," ");
      XFigWriter(s,coords[i+1]);
      XFigWriter(s,"\n");
  od;
  if Length(control) > 0 then XFigWriter(s,control[1]); fi;
  for i in [2..Length(control)] do
      XFigWriter(s," ");
      XFigWriter(s,control[i]);
  od;
  XFigWriter(s,"\n");
end;

XFigSqrtInt := function(n)
  local m,lastm;
  m := 2^(QuoInt(LogInt(n,2),2));
  repeat
      lastm := m;
      m := QuoInt( m + QuoInt(n+QuoInt(m,2),m), 2 );
  until AbsInt(m-lastm) <= 1;
  return m;
end;

XFigEllipse := function(s,subtype,opt)
  local center,radius;
  if not(IsBound(opt.first)) or not(IsBound(opt.second)) then
      Error("first and second option must be given");
      return;
  fi;
  XFigWriter(s,[1,subtype]);
  XFigWriter(s," ");
  XFigHandleOption(s,opt,"linestyle"," ");
  XFigHandleOption(s,opt,"thickness"," ");
  XFigHandleOption(s,opt,"pencolor"," ");
  XFigHandleOption(s,opt,"fillcolor"," ");
  XFigHandleOption(s,opt,"depth"," ");
  XFigHandleOption(s,opt,"penstyle"," ");
  XFigHandleOption(s,opt,"areafill"," ");
  XFigHandleOption(s,opt,"styleval"," ");
  XFigHandleOption(s,opt,"direction"," ");
  XFigHandleOption(s,opt,"angle"," ");
  if IsBound(opt.center) then
      XFigHandleOption(s,opt,"center");
  else
      if subtype = XFIG_SUBTYPES.CircleRadius or 
         subtype = XFIG_SUBTYPES.EllipseRadius then   
          # center given as first point
          XFigHandleOption(s,opt,"first"," ");
          center := opt.first;
      else
          Error("not yet implemented");
          return;
      fi;
  fi;
  if IsBound(opt.radius) then
      XFigHandleOption(s,opt,"radius"," ");
  else
      if subtype = XFIG_SUBTYPES.EllipseRadius then   
          # center given as first point
          XFigWriter(s,AbsInt(opt.second[1]-opt.first[1]));
          XFigWriter(s," ");
          XFigWriter(s,AbsInt(opt.second[2]-opt.first[2]));
          XFigWriter(s," ");
      elif subtype = XFIG_SUBTYPES.CircleRadius then   
          # center given as first point
          radius := XFigSqrtInt( (opt.second[1]-opt.first[1])^2+
                                 (opt.second[2]-opt.first[2])^2 );
          XFigWriter(s,radius);
          XFigWriter(s," ");
          XFigWriter(s,radius);
          XFigWriter(s," ");
      else
          Error("not yet implemented");
      fi;
  fi;
  XFigHandleOption(s,opt,"first"," ");
  XFigHandleOption(s,opt,"second","\n");
end;

XFigText := function(s,subtype,st,opt)
  local c, i, dummy;
  if not(IsBound(opt.height)) or not(IsBound(opt.length)) or
     not(IsBound(opt.x)) or not(IsBound(opt.y)) then
      Error("need options height, length, x, and y");
      return;
  fi;
  XFigWriter(s,[4,subtype]);
  XFigWriter(s," ");
  XFigHandleOption(s,opt,"color"," ");
  XFigHandleOption(s,opt,"depth"," ");
  XFigHandleOption(s,opt,"penstyle"," ");
  XFigHandleOption(s,opt,"font"," ");
  XFigHandleOption(s,opt,"fontsize"," ");
  XFigHandleOption(s,opt,"angle"," ");
  XFigHandleOption(s,opt,"fontflags"," ");
  XFigHandleOption(s,opt,"height"," ");
  XFigHandleOption(s,opt,"length"," ");
  XFigHandleOption(s,opt,"x"," ");
  XFigHandleOption(s,opt,"y"," ");
  for c in st do
      i := INT_CHAR(c);
      if i < 128 then
          dummy := " ";
          dummy[1] := c;
      else
          dummy := "\\000";
          dummy[2] := CHAR_INT(INT_CHAR('0')+QuoInt(i,64));
          i := i mod 64;
          dummy[3] := CHAR_INT(INT_CHAR('0')+QuoInt(i,8));
          i := i mod 8;
          dummy[4] := CHAR_INT(INT_CHAR('0')+i);
      fi;
      XFigWriter(s,dummy);
  od;
  XFigWriter(s,"\\001\n");
end;

XFigOpenCompound := function(s,boundingbox)
  XFigWriter(s,6);
  XFigWriter(s," ");
  XFigWriter(s,boundingbox);
  XFigWriter(s,"\n");
end;

XFigCloseCompound := function(s);
  XFigWriter(s,-6);
  XFigWriter(s,"\n");
end;