#
#  writedg.pl
#
#  This package allows the user to easily create a Diagram file.
#
#  Copyright (C) 1993 Lighthouse Design Ltd.
#
#  You may freely copy, distribute, and reuse the code in
#  this example provided this copyright legend and disclaimer
#  are preserved in all copies and derivative work.
#
#  Lighthouse Design disclaims any warranty of any kind,
#  expressed or implied, as to this code's fitness
#  for any particular use.
#
#

package writedg;
#
# defaults
#
$defViewHorizSize = 756.0;
$defViewVertSize = 576.0;
$defaultSymbolX = 10;
$defaultSymbolY = 10;
$defaultSymbolW = 10;
$defaultSymbolH = 10;

#
# initialization
#
$currentDocumentIndex = 1;

$legalSymbol{"Circle"}= 1;
$legalSymbol{"Cylinder"}= 1;
$legalSymbol{"Diamond"}= 1;
$legalSymbol{"Hexagon"}= 1;
$legalSymbol{"Horizontal Arrow"}= 1;
$legalSymbol{"Vertical Arrow"}= 1;
$legalSymbol{"Horizontal Triangle"}= 1;
$legalSymbol{"Vertical Triangle"}= 1;
$legalSymbol{"Rectangle"}= 1;
$legalSymbol{"Rounded Rectangle"}= 1;
$legalSymbol{"Parallelogram"}= 1;
$legalSymbol{"Parallel Lines"}= 1;

$legalHead{"arrow"} = 1;
$legalHead{"doubleArrow"} = 1;
$legalHead{"hollowArrow"} = 1;
$legalHead{"circle"} = 1;
$legalHead{"solidCircle"} = 1;

$legalPlacement{"top"} = 1;
$legalPlacement{"bottom"} = 1;
$legalPlacement{"centered"} = 1;

$debugging = 0;

sub main'setDebugging{ # onOff (0 = off, 1 = on)
    $debugging = $_[0];
}

sub main'newDocument{ #nothing -> document identifier
    local($newDocumentID) = $currentDocumentIndex;
    print "New Document -> $newDocumentID\n" unless !$debugging;
    $currentDocumentIndex++;
    $documentExists{$newDocumentID} = 1;
    $documentCurrentObjectID{$newDocumentID} = 1;
    $documentSymbols{$newDocumentID} = "";
    $documentLines{$newDocumentID} = "";
    $documentVertexes{$newDocumentID} = "";
    $documentGroups{$newDocumentID} = "";
    return $newDocumentID;
}

sub main'setDocumentRuler{ # documentID rulerShowing (1 = yes, 0 = no)
    local($documentID, $rulerShowing) = @_;
    print "SetDocumentRuler -> @_\n" unless !$debugging;
    $documentExists{$documentID} || &error("Invalid Document ID -> $documentID");
    $documentRuler{$documentID} = $rulerShowing;
    $documentID;
}

sub main'setDocumentButtons{ # documentID buttonsShowing (1 = yes, 0 = no)
    local($documentID, $buttonsShowing) = @_;
    print "SetDocumentButtons -> @_\n" unless !$debugging;
    $documentExists{$documentID} || &error("Invalid Document ID -> $documentID");
    $documentButtons{$documentID} = $buttonsShowing;
    $documentID;
}

sub main'setDocumentDefaultFont{ # documentID fontName fontSize
    local($documentID, $fontName, $fontSize) = @_;
    print "SetDocumentDefaultFont -> @_\n" unless !$debugging;
    $documentExists{$documentID} || &error("Invalid Document ID -> $documentID");
    $defaultFont{$documentID} = $fontName;
    $defaultFontSize{$documentID} = $fontSize;
    $documentID;
}

sub main'setDocumentCanvasSize{ # documentID canvasW canvasH
    local($documentID, $canvasW, $canvasH) = @_;
    print "SetDocumentCanvasSize -> @_\n" unless !$debugging;
    $documentExists{$documentID} || &error("Invalid Document ID -> $documentID");
    $documentCanvasW{$documentID} = $canvasW;
    $documentCanvasH{$documentID} = $canvasH;
    $documentID;
}

sub main'setDocumentGridVisible{ # documentID gridVisible (1 = yes, 0 = no)
    local($documentID, $gridShowing) = @_;
    print "SetDocumentGridVis -> @_\n" unless !$debugging;
    $documentExists{$documentID} || &error("Invalid Document ID -> $documentID");
    $documentGrid{$documentID} = $gridShowing;
    $documentID;

}

sub main'setDocumentGridSize{ # documentID gridSpacing
    local($documentID, $gridSpacing) = @_;
    print "SetDocumentGridSpacing -> @_\n" unless !$debugging;
    $documentExists{$documentID} || &error("Invalid Document ID -> $documentID");
    $documentGridSpacing{$docuementID} = $gridSpacing;
    $documentID;
}

sub main'setDocumentSnapToGrid{ # documentID snapOn (1 = yes, 0 = no)
    local($documentID, $snapOn) = @_;
    print "SetDocumentSnapToGrid -> @_\n" unless !$debugging;
    $documentExists{$documentID} || &error("Invalid Document ID -> $documentID");
    $documentExists{$documentID} || &error("Invalid Document ID -> $documentID");
    $documentSnap{$docuementID} = $snapOn;
    $documentID;
    
}

sub main'setDocumentZoom{ # documentID zoomPercentage
    local($documentID, $zoom) = @_;
    print "SetDocumentZoom -> @_\n" unless !$debugging;
    $documentExists{$documentID} || &error("Invalid Document ID -> $documentID");
    $documentZoom{$documentID} = $zoom;
    $documentID;
}

sub main'newSymbol{ # documentID type x y w h -> objectID
    local($documentID, $objectType, $x, $y, $w, $h) = @_;
    print "newSymbol -> @_\n" unless !$debugging;
    $documentExists{$documentID} || &error("Invalid Document ID -> $documentID");
    
    local($newObjectID) = &newObjectID($documentID);
    print "New Symbol -> $newObjectID\n" unless !$debugging;
    $documentSymbols{$documentID} .= "$newObjectID,";
    $objectFlavor{$newObjectID} = "Symbol";
    if($objectType){
	&main'setObjectType($newObjectID, $objectType);
    }
    ($objectX{$newObjectID} = $x)||($objectX{$newObjectID} = $defaultSymbolX);
    ($objectY{$newObjectID} = $y)||($objectY{$newObjectID} = $defaultSymbolY);
    ($objectW{$newObjectID} = $w)||($objectW{$newObjectID} = $defaultSymbolW);
    ($objectH{$newObjectID} = $h)||($objectH{$newObjectID} = $defaultSymbolH);
    &main'setObjectFramed($newObjectID, 1);

    $newObjectID;
}

sub main'newLine{ # documentID fromObject toObject -> objectID
    local($documentID, $fromObject, $toObject) = @_;
    $documentExists{$documentID} || &error("Invalid Document ID -> $documentID");
    local($newLineID) = &newObjectID($documentID);
    print "New Line -> $newLineID\n" unless !$debugging;
    $documentLines{$documentID} .= "$newLineID,";
    $objectFlavor{$newLineID} = "Line";
    local($vertex1) = &main'newVertex($documentID);
    local($vertex2) = &main'newVertex($documentID);
    $lineVertexList{$newLineID} = "$vertex1,$vertex2";
    ($fromObject && $toObject) || &error("Must specify both from and to");
    $objectFlavor{$fromObject} || &error("Invalid fromObject -> $fromObject");
    $lineFrom{$newLineID} = $fromObject;
    $objectFlavor{$toObject} || &error("Invalid toObject -> $toObject");
    $lineTo{$newLineID} = $toObject;
    
    $newLineID;
}

sub main'newVertex{ # documentID x y
    local($documentID, $x, $y) = @_;
    $documentExists{$documentID} || &error("Invalid Document ID -> $documentID");
    local($newVertexID) = &newObjectID($documentID);
    print "New Vertext -> $newVertexID\n" unless !$debugging;
    $documentVertexes{$documentID} .= "$newVertexID,";
    $objectFlavor{$newVertexID} = "Vertex";
    $objectX{$newVertexID} = $x;
    $objectY{$newVertexID} = $y;

    $newVertexID;
}

sub main'newGroup{ # documentID groupedObjectID groupedObjectID2 etc
    local($documentID, @objectList) = @_;
    $documentExists{$documentID} || &error("Invalid Document ID -> $documentID");
    local($newGroupID) = &newObjectID($documentID);
    print "New Group -> $newGroupID\n" unless !$debugging;
    $documentGroups{$documentID} .= "$newGroupID,";
    $objectFlavor{$newGroupID} = "Group";
    $groupObjectList{$newGroupID} = "";
    foreach $thing (@objectList){
	$objectFlavor{$thing}|| &error("Invalid Object ID in Group -> $thing");
	$objectFlavor{$thing} && do {
	    $groupObjectList{$newGroupID} .= "$thing,";
	    $objectInGroup{$thing} = 1;
	};
    }

    $newGroupID;
}

sub main'vertexesForLine{ # objectID
    local($objectID) = @_;
    print "vertexesForLine (@_)\n" unless !$debugging;
    $objectFlavor{$objectID} eq "Line" || &error("Object not a line -> $objectID");
    split(/,/,$lineVertexList{$objectID});
}

sub main'setVertexesForLine{ # objectID vertex1, vertex2, ...
    local($objectID, @vertexList) = @_;
    print "setVertexesForLine (@_)\n" unless !$debugging;
    $objectFlavor{$objectID} eq "Line" || &error("Object not a line -> $objectID");
    $ok = 0;
    foreach $thing (@vertexList){
	$objectFlavor{$objectID} eq "Vertex" || &error("Object not a vertex -> $thing");
	if(!$ok){
	    $lineVertexList{$objectID} = "$thing,";
	    $ok = 1;
	}else{
	    $lineVertexList{$objectID} .= "$thing,";
	}
    }
    $objectID;
}

sub main'setObjectType{ # objectID type 
    local($objectID, $type) = @_;
    print "setObjectType (@_)\n" unless !$debugging;
    $objectFlavor{$objectID} eq "Symbol" || &error("Object not a symbol -> $objectID");
    ($legalSymbol{$type}) || &error("Invalid symbol type -> $type");
    $objectType{$objectID} = $type;
    $objectID;
}

sub main'setObjectLocation{ # objectID x y
    local($objectID, $x, $y) = @_;
    print "setObjectLocation (@_)\n" unless !$debugging;
    ($objectFlavor{$objectID} eq "Symbol" || $objectFlavor{$objectID} eq "Vertex" || $objectFlavor{$objectID} eq "Group") || &error("Object not valid for setObjectLocation -> $objectID");
    $objectX{$objectID} = $x;
    $objectY{$objectID} = $y;

    $objectID;
}

sub main'setObjectSize{ # documentID objectID w h
    local($objectID, $w, $h) = @_;
    print "setObjectSize (@_)\n" unless !$debugging;
    ($objectFlavor{$objectID} eq "Symbol" || $objectFlavor{$objectID} eq "Group") || &error("Object not valid for setObjectSize -> $objectID");
    $objectW{$objectID} = $w;
    $objectH{$objectID} = $h;

    $objectID;
}

sub main'setObjectX{ # documentID objectID x 
    local($objectID, $x) = @_;
    print "setObjectX (@_)\n" unless !$debugging;
    ($objectFlavor{$objectID} eq "Symbol" || $objectFlavor{$objectID} eq "Vertex" || $objectFlavor{$objectID} eq "Group") || &error("Object not valid for setObjectX -> $objectID");
    $objectX{$objectID} = $x;

    $objectID;
}

sub main'setObjectY{ # documentID objectID y
    local($objectID, $y) = @_;
    print "setObjectY (@_)\n" unless !$debugging;
    ($objectFlavor{$objectID} eq "Symbol" || $objectFlavor{$objectID} eq "Vertex" || $objectFlavor{$objectID} eq "Group") || &error("Object not valid for setObjectY -> $objectID");
    $objectY{$objectID} = $y;
    
    $objectID;
}

sub main'setObjectWidth{ # documentID objectID width
    local($objectID, $w) = @_;
    print "setObjectWidth (@_)\n" unless !$debugging;
    ($objectFlavor{$objectID} eq "Symbol" || $objectFlavor{$objectID} eq "Group") || &error("Object not valid for setObjectWidth -> $objectID");
    $objectW{$objectID} = $w;
    
    $objectID;
}

sub main'setObjectHeight{ # documentID objectID height
    local($objectID, $h) = @_;
    print "setObjectHeight (@_)\n" unless !$debugging;
    ($objectFlavor{$objectID} eq "Symbol" || $objectFlavor{$objectID} eq "Group") || &error("Object not valid for setObjectHeight -> $objectID");
    $objectH{$objectID} = $h;
    
    $objectID;
}

sub main'setObjectLocked{ # objectID locked (1 = yes, 0 = no)
    local($objectID, $locked) = @_;
    print "setObjectLocked (@_)\n" unless !$debugging;
    $objectFlavor{$objectID} || &error("Object not valid for setObjectLocked -> $objectID");
    $objectLocked{$objectID} = $locked;

    $objectID;
}

sub main'setObjectRotationAngle{ # objectID rotationAngle
    local($objectID, $rot) = @_;
    print "setObjectRotationAngle (@_)\n" unless !$debugging;
    ($objectFlavor{$objectID} eq "Symbol" || $objectFlavor{$objectID} eq "Group") || &error("Object not valid for setObjectRotationAngle -> $objectID");
    $objectRotationAngle{$objectID} = $rot;
    
    $objectID;
}

sub main'setObjectShadowed{ # documentID objectID shadowed (1 = yes, 0 = no)
    local($objectID, $flag) = @_;
    print "setObjectShadowed (@_)\n" unless !$debugging;
    ($objectFlavor{$objectID} eq "Symbol") || &error("Object not valid for setObjectShadowed -> $objectID");
    $objectShadowed{$objectID} = $flag;
    
    $objectID;
}

sub main'setObjectShadowColor{ # documentID objectID r g b
    local($objectID, $r, $g, $b) = @_;
    print "setObjectShadowColor(@_)\n" unless !$debugging;
    ($objectFlavor{$objectID} eq "Symbol") || &error("Object not valid for setObjectShadowColor -> $objectID");
    $objectShadowColor{$objectID} = "rgbColor $r $g $b";
    
    $objectID;
}

sub main'setObjectShadowGray{ # objectID gray
    local($objectID, $gray) = @_;
    print "setObjectShadowGray(@_)\n" unless !$debugging;
    ($objectFlavor{$objectID} eq "Symbol") || &error("Object not valid for setObjectShadowGray -> $objectID");
    $objectShadowColor{$objectID} = sprintf("gray %f", $gray);
    
    $objectID;
}

sub main'setObjectFilled{ # objectID filled (1 = yes, 0 = no)
    local($objectID, $filled) = @_;
    print "setObjectFilled(@_)\n" unless !$debugging;
    ($objectFlavor{$objectID} eq "Symbol" || $objectFlavor{$objectID} eq "Line") || &error("Object not valid for setObjectShadowGray -> $objectID");
    $objectFilled{$objectID} = $filled;
    
    $objectID;
}

sub main'setObjectFillColor{ # documentID objectID r g b
    local($objectID, $r, $g, $b) = @_;
    print "setObjectFillColor(@_)\n" unless !$debugging;
    ($objectFlavor{$objectID} eq "Symbol" || $objectFlavor{$objectID} eq "Line") || &error("Object not valid for setObjectFillColor -> $objectID");
    $objectFillColor{$objectID} = "rgbColor $r $g $b";
    
    $objectID;
}

sub main'setObjectFillGray{ # documentID objectID gray
    local($objectID, $gray) = @_;
    print "setObjectFillGray(@_)\n" unless !$debugging;
    ($objectFlavor{$objectID} eq "Symbol" || $objectFlavor{$objectID} eq "Line") || &error("Object not valid for setObjectFillGray -> $objectID");
    $objectFillColor{$objectID} = "gray $gray";
    
    $objectID;
}

sub main'setObjectFramed{ # documentID objectID framed (1 = yes, 0 = no)
    local($objectID, $framed) = @_;
    print "setObjectFramed(@_)\n" unless !$debugging;
    ($objectFlavor{$objectID} eq "Symbol") || &error("Object not valid for setObjectFramed -> $objectID");
    $objectFramed{$objectID} = $framed;
    
    $objectID;
}

sub main'setObjectFrameColor{ # documentID objectID r g b
    local($objectID, $r, $g, $b) = @_;
    print "setObjectFrameColor(@_)\n" unless !$debugging;
    ($objectFlavor{$objectID} eq "Symbol" || $objectFlavor{$objectID} eq "Line") || &error("Object not valid for setObjectFrameColor -> $objectID");
    $objectFrameColor{$objectID} = "rgbColor $r $g $b";
    
    $objectID;
}

sub main'setObjectFrameGray{ # documentID objectID gray
    local($objectID, $gray) = @_;
    print "setObjectFrameGray(@_)\n" unless !$debugging;
    ($objectFlavor{$objectID} eq "Symbol" || $objectFlavor{$objectID} eq "Line") || &error("Object not valid for setObjectFrameGray -> $objectID");
    $objectFrameColor{$objectID} = "gray $gray";
    
    $objectID;
}

sub main'setObjectLineWidth{ # documentID objectID gray
    local($objectID, $width) = @_;
    print "setObjectLineWidth(@_)\n" unless !$debugging;
    ($objectFlavor{$objectID} eq "Symbol" || $objectFlavor{$objectID} eq "Line") || &error("Object not valid for setObjectLineWidth -> $objectID");
    $objectLineWidth{$objectID} = $width;
    
    $objectID;
}

sub main'setObjectLineType{ # objectID type (0 = solid, 1 = dot, 2 = dash, 3 = dotDash
    local($objectID, $type) = @_;
    print "setObjectLineType(@_)\n" unless !$debugging;
    ($objectFlavor{$objectID} eq "Symbol" || $objectFlavor{$objectID} eq "Line") || &error("Object not valid for setObjectLineWidth -> $objectID");
    if($type == 0){
	$objectLineType{$objectID} = "solid";
    }elsif($type == 1){
	$objectLineType{$objectID} = "dot";
    }elsif($type == 2){
	$objectLineType{$objectID} = "dash";
    }elsif($type == 3){
	$objectLineType{$objectID} = "dotDash";
    }else{
	&error("Invalid type in setObjectLineType -> $type");
    }
    
    $objectID;
}

sub main'setObjectRtfText{ # objectID textString
    local($objectID, $rtf) = @_;
    print "setObjectRtfText(@_)\n" unless !$debugging;
    ($objectFlavor{$objectID} eq "Symbol" || $objectFlavor{$objectID} eq "Line") || &error("Object not valid for setObjectRtfText -> $objectID");
    $objectRtfText{$objectID} = $rtf;

    $objectID;
}

sub main'setObjectText{ # objectID text
    local($objectID, $text) = @_;
    print "setObjectText(@_)\n" unless !$debugging;
    ($objectFlavor{$objectID} eq "Symbol" || $objectFlavor{$objectID} eq "Line") || &error("Object not valid for setObjectText -> $objectID");
    $objectText{$objectID} = $text;

    $objectID;
}

sub main'setObjectTextPlacement{ # objectID textPlacement
    local($objectID, $placement) = @_;
    print "setObjectTextPlacement(@_)\n" unless !$debugging;
    ($objectFlavor{$objectID} eq "Symbol" ) || &error("Object not valid for setObjectTextPlacement -> $objectID");
    $legalPlacement{$placement} || &error("Illegal placement parameter -> $placement");
    $objectTextPlacement{$objectID} = $placement;

    $objectID;
}

sub main'setObjectLayer{ # objectID level
    local($objectID, $layer) = @_;
    print "setObjectLayer(@_)\n" unless !$debugging;
    ($objectFlavor{$objectID}) || &error("Object not valid for setObjectText -> $objectID");
    $objectLayer{$objectID} = $layer;

    $objectID;
}

sub main'setLineTailType{ # lineID text
    local($objectID, $type) = @_;
    print "setLineTailType(@_)\n" unless !$debugging;
    ($objectFlavor{$objectID} eq "Line") || &error("Object not valid for setLineTailType -> $objectID");
    $legalHead{$type} || &error("Type not valid for line end -> $type");
    $lineTailType{$objectID} = $type;

    $objectID;
}

sub main'setLineHeadType{
    local($objectID, $type) = @_;
    print "setLineHeadType(@_)\n" unless !$debugging;
    ($objectFlavor{$objectID} eq "Line") || &error("Object not valid for setLineTailType -> $objectID");
    $legalHead{$type} || &error("Type not valid for line end -> $type");
    $lineHeadType{$objectID} = $type;
    
    $objectID;
}

sub main'setLineTo{ #objectID toObjectID
    local($objectID, $toObject) = @_;
    print "setLineTo(@_)\n" unless !$debugging;
    ($objectFlavor{$objectID} eq "Line") || &error("Object not valid for setLineTo -> $objectID");
    ($objectFlavor{$toObject}) || &error("Argument not valid for setLineTo -> $toObject");
    $lineTo{$objectID} = $toObject;

    $objectID;
}

sub main'setLineFrom{ #objectID toObjectID
    local($objectID, $fromObject) = @_;
    print "setLineFrom(@_)\n" unless !$debugging;
    ($objectFlavor{$objectID} eq "Line") || &error("Object not valid for setLineFrom -> $objectID");
    ($objectFlavor{$fromObject}) || &error("Argument not valid for setLineFrom -> $fromObject");
    $lineFrom{$objectID} = $fromObject;

    $objectID;
}

sub main'setLineCurved{ #objectID curved(1=yes, 0=no)
    local($objectID, $curved) = @_;
    print "setLineCurved(@_)\n" unless !$debugging;
    ($objectFlavor{$objectID} eq "Line") || &error("Object not valid for setLineCurved -> $objectID");
    $lineCurved{$objectID} = $curved;

    $objectID;

}

sub main'writeDocument{ # documentID filename
    local($documentID, $filename) = @_;
    print "writeDocument(@_)\n" unless !$debugging;
    $documentExists{$documentID} || &error("Invalid document argument -> $documentID");

    local($dtFilename) = "$filename/DiagramText";
    if((-f "$dtFilename")){
	print "$filename exists, overwriting\n";
    }elsif((!mkdir($filename, 0775))){
	die "Couldn't create $filename - exiting.";
    }
    if(!open(DIAG, ">$dtFilename")){
	die "Couln't open $dtFilename";
    }
    select((select(DIAG), $| = 1)[0]);

    #
    # Document Stuff
    #
    print DIAG "#!DG_TEXT\n";
    print DIAG "# generated by writedg.pl library v. 1.0 ";
    print DIAG "\n";
    if($documentCanvasW{$documentID} &&  $documentCanvasH{$documentID}){
	print DIAG "canvasSize $documentCanvasW{$documentID} $documentCanvasH{$documentID}\n";
    }else{
	print DIAG "canvasSize 1 1\n";
    }
    if($documentRuler{$documentID}){
	print DIAG "showRulers\n";
    }
    if($documentButtons{$documentID}){
	print DIAG "showTools\n";
    }
    if($documentGrid{$documentID}){
	print DIAG "gridVisible\n";
    }
    if($documentGridSpacing{$documentID}){
	print DIAG "gridSpacing $documentGridSpacing\n";
    }
    if($documentSnap{$documentID}){
	print DIAG "snapToGrid\n";
    }
    print DIAG "viewSize $defViewHorizSize $defViewVertSize\n";
    if($documentZoom{$documentID}){
	print DIAG "zoom $documentZoom{$documentID}\n";
    }
    if($defaultFont{$documentID}){
	print DIAG "defaultFont \"$defaultFont{$documentID}\"\n";
    }
    if($defaultFontSize{$documentID}){
	print DIAG "defaultFontSize $defaultFontSize{$documentID}\n";
    }
    print DIAG "\n";
    
    #
    # Symbols
    #
    local(@symbolList) = split(/,/,$documentSymbols{$documentID});
    foreach $thing (@symbolList){
	$objectNum = &objectNumber($thing);
	print DIAG "symbol $objectNum\n";
	if(!$objectType{$thing}){
	    $objectType{$thing} = 9;
	}
	print DIAG "\tshape \"$objectType{$thing}\"\n";
	if($objectInGroup{$thing}){
	    print DIAG "\tlayer -1\n";
	}elsif($objectLayer{$thing}){
	    print DIAG "\tlayer $objectLayer{$thing}\n";
	}
	if($objectFramed{$thing}){
	    print DIAG "\tframed\n";
	}
	if($objectFrameColor{$thing}){
	    print DIAG "\tframeColor $objectFrameColor{$thing}\n";
	}
	if($objectLineWidth{$thing}){
	    print DIAG "\tlineWidth $objectLineWidth{$thing}\n";
	}
	if($objectLineType{$thing}){
	    print DIAG "\tlineType $objectLineType{$thing}\n";
	}
	if($objectFilled{$thing}){
	    print DIAG "\tfilled\n";
	}
	if($objectFillColor{$thing}){
	    print DIAG "\tfillColor $objectFillColor{$thing}\n";
	}
	if($objectShadowed{$thing}){
	    print DIAG "\tshadowed\n";
	}
	if($objectShadowColor{$thing}){
	    print DIAG "\tshadowColor $objectShadowColor{$thing}\n";
	}
	if($objectLocked{$thing}){
	    print DIAG "\tlocked\n";
	}
	if($objectTextPlacement{$thing}){
	    print DIAG "\ttextPlacement $objectTextPlacement{$thing}\n";
	}
	if($objectRtfText{$thing}){
	    print DIAG "\trtfText $objectRtfText{$thing}\n";
	}elsif($objectText{$thing}){
	    print DIAG "\ttext \"$objectText{$thing}\"\n";
	}
	print DIAG "\tlocation $objectX{$thing} $objectY{$thing}\n";
	print DIAG "\tsize $objectW{$thing} $objectH{$thing}\n";
	print DIAG "end\n\n";
    }
    #
    # Vertices
    #
    local(@vertexList) = split(/,/,$documentVertexes{$documentID});
    foreach $thing (@vertexList){
	$objectNum = &objectNumber($thing);
	print DIAG "vertex $objectNum\n";
	if($objectInGroup{$thing}){
	    print DIAG "\tlayer -1";
	}elsif($objectLayer{$thing}){
	    print DIAG "\tlayer $objectLayer{$thing}\n";
	}
	if($objectX{$thing} && $objectY{$thing}){
	    print DIAG "\tlocation $objectX{$thing} $objectY{$thing}\n";
	}
	print DIAG "end\n\n";
    }

    #
    # Lines
    #
    local(@lineList) = split(/,/,$documentLines{$documentID});
    foreach $thing (@lineList){
	$objectNum = &objectNumber($thing);
	print DIAG "line $objectNum\n";
	$num = &objectNumber($lineFrom{$thing});
	print DIAG "\tfrom $num\n";
	$num = &objectNumber($lineTo{$thing});
	print DIAG "\tto $num\n";
	foreach $vert (split(/,/,$lineVertexList{$thing})){
	    $vertNum = &objectNumber($vert);
	    print DIAG "\t$vertNum\n";
	}
	if($objectInGroup{$thing}){
	    print DIAG "\tlayer -1\n";
	}elsif($objectLayer{$thing}){
	    print DIAG "\tlayer $objectLayer{$thing}\n";
	}
	if($objectLineWidth{$thing}){
	    print DIAG "\tlineWidth $objectLineWidth{$thing}\n";
	}
	if($objectFilled{$thing}){
	    print DIAG "\tfilled\n";
	}
	if($objectFillColor{$thing}){
	    print DIAG "\tfillColor $objectFillColor{$thing}\n";
	}
	if($objectFramed{$thing}){
	    print DIAG "\tframed\n";
	}
	if($objectFrameColor{$thing}){
	    print DIAG "\tframeColor $objectFrameColor{$thing}\n";
	}
	if($lineHeadType{$thing}){
	    print DIAG "\theadType $lineHeadType{$thing}\n";
	}
	if($lineTailType{$thing}){
	    print DIAG "\ttailType $lineTailType{$thing}\n";
	}
	if($lineCurved{$thing}){
	    print DIAG "\tcurved\n";
	}
	
	print DIAG "end\n\n";
    }

    #
    # Groups
    #
    local(@groupList) = split(/,/,$documentGroups{$documentID});
    foreach $thing (@groupList){
	$objectNum = &objectNumber($thing);
	print DIAG "group $objectNum\n";
	print DIAG "\t";
	foreach $littlething (split(/,/,$groupObjectList{$thing})){
	    $num = &objectNumber($littlething);
	    print DIAG "$num ";
	}
	print DIAG "\n";
	if($objectInGroup{$thing}){
	    print DIAG "\tlayer -1\n";
	}elsif($objectLayer{$thing}){
	    print DIAG "\tlayer $objectLayer{$thing}\n";
	}
	if($objectX{$thing} && $objectY{$thing}){
	    print DIAG "\tlocation $objectX{$thing} $objectY{$thing}\n";
	}
	if($objectW{$thing} && $objectH{$thing}){
	    print DIAG "\tsize $objectW{$thing} $objectH{$thing}\n";
	}
	if($objectLocked{$thing}){
	    print DIAG "\tlocked\n";
	}
	print DIAG "end\n\n";
    }

}

#
# local subroutines
#
sub newObjectID { # documentID
    $documentExists{$documentID} || &error("Invalid Document ID -> $documentID");
    local($return) =  "$documentID:$documentCurrentObjectID{$documentID}";
    $documentCurrentObjectID{$documentID}++;
    return $return;
}

sub error{ # error string

    print STDERR ($_[0], "\n\n");
    sleep 1;
    exit 1;
}

sub objectNumber{ # objectID
    local($objectID) = @_;
    $objectID =~ /[^:]+:(\d+)/ || &error("Couldn't extract number from $objectID");
    return $1;
}

1;

# Place Emacs into Perl-mode
# Local Variables:
# mode: perl
# End:

