classchart.ps

%!PS-Adobe-2.0
%%DocumentPaperSizes: a2
%
% we need to define metric units
/mm {2.834 mul} def
/cm {28.34 mul } def
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%  Configurable section
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Print head classes on separate pages ?
% 1=yes 0=no
/SeparatePages {
0 %
} def
% Draw Lazarus classes ?
% 1 = Yes, 0 = No;
/lcl { 1  % set this to zero if you don't want to include the lcl classes
} def

% sets the line width of the class graph to 0.5 points
/SetLineWidth { 0.5 setlinewidth} def

% sets the line color of the class graph to black
/SetLineColor { 0 0 0 setrgbcolor } def

% sets the default font for class names
/SetClassFont
{
/Arial-BoldMT findfont
10 scalefont
setfont
} def

% sets the default font for large written class names
/SetLargeClassFont
{
/Arial-BoldMT findfont
18 scalefont
setfont
} def

% RGB colors of the texts
/StandardTextColor { 0 0 0 } def
/MissingTextColor { 0.50 0.50 0.50 } def

% RGB colors of the boxes
/MissingColor { 0.92 0.92 0.92 } def
/IncompleteColor { 1 0.5 0.5 } def
/UntestedColor { 1 1 0.6} def
/ReadyColor { 0.7 1 0.7 } def

% Starting point of the class graph 
% (0,0) is the lower left corner of the paper
/startx { 0 mm } def
/starty { 390 mm } def
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%  End of Configurable section
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% some setups
/Missing {0} def
/Incomplete {1} def
/Untested {2} def
/Ready {3} def
/nextx startx def
/nexty starty def
/maxx 0 mm def
%%%%%%%%%%%%%%%%%%%%%%%%
% drawbox
% takes two parameters: 
%     classname........name of the class
%     status......status of development
/drawbox
{
  % save parameters
  /status exch def  
  /classname exch def
  % save enviroment
  gsave
  newpath

  % determine the size of the class name
  SetClassFont
  classname
  stringwidth

  % and save it ...
  /widthy exch def
  /widthx exch def

  % moveto start point of the box
  nextx 8 mm add
  nexty  
  moveto

  % calculate the place for the icons
  nextx 8 mm add
  widthx 4.5 mm add add
  /nexticonx exch def 

  % max. ?
  nexticonx 1.5 mm sub maxx gt { /maxx nexticonx def } if

  % set box color
  status Missing eq { MissingColor setrgbcolor } if
  status Incomplete eq { IncompleteColor setrgbcolor } if
  status Untested eq { UntestedColor setrgbcolor } if
  status Ready eq { ReadyColor setrgbcolor } if

  % draw box
  0 mm 2.1 mm rlineto
  widthx 3 mm add 0 mm rlineto
  0 mm -4.2 mm rlineto
  0 widthx 3 mm add sub 0 mm rlineto
  0 mm 2.1 mm rlineto
  closepath
  fill

  % set text color
  status Missing eq { MissingTextColor setrgbcolor } 
  { StandardTextColor setrgbcolor } ifelse

  % set text pos and write text
  nextx 9.5 mm add
  nexty 1.25 mm sub
  moveto
  classname
  show

  grestore
} def
%%%%%%%%%%%%%%%%%%%%%%%%
% drawlargebox
% takes two parameters: 
%     classname........name of the class
%     status......status of development
/drawlargebox
{
  % save parameters
  /status exch def  
  /classname exch def
  % save enviroment
  gsave
  newpath

  % determine the size of the class name
  SetLargeClassFont
  classname
  stringwidth

  % and save it ...
  /widthy exch def
  /widthx exch def

  % moveto start point of the box
  nextx 8 mm add
  nexty  
  moveto

  % calculate the place for the icons
  nextx 8 mm add
  % add text with and additional space
  widthx 7.5 mm add add  
  /nexticonx exch def 

  % max. ?  (remove icon offset using 1.5 mm sub)
  nexticonx 1.5 mm sub maxx gt { /maxx nexticonx def } if

  %save x-pos for the horizontal line (remove icon offset using 4.5 mm sub)
  /lastlargeobjectx nexticonx 1.5 mm sub def

  % set box color
  status Missing eq { MissingColor setrgbcolor } if
  status Incomplete eq { IncompleteColor setrgbcolor } if
  status Untested eq { UntestedColor setrgbcolor } if
  status Ready eq { ReadyColor setrgbcolor } if

  % draw box
  0 mm 4.2 mm rlineto
  widthx 6 mm add 0 mm rlineto
  0 mm -8.4 mm rlineto
  0 widthx 6 mm add sub 0 mm rlineto
  0 mm 4.2 mm rlineto
  closepath
  fill

  % set text color
  status Missing eq { MissingTextColor setrgbcolor } 
  { StandardTextColor setrgbcolor } ifelse

  % set text pos and write text
  nextx 11 mm add
  nexty 2.5 mm sub
  moveto
  classname
  show
  nexty 2.1 mm sub
  /nexty exch def
  grestore
} def
%%%%%%%%%%%%%%%%%%%%%%%%
% newchildclass
% draws a new class 
% takes two parameters: 
%     name of the class
%     status of development
/newchildclass
{
   % save parameters
   /status exch def  
   /classname exch def
   % save enviroment
   % push this on the stack for onelevelback
   nexty 
   newpath
   SetLineWidth 
   SetLineColor
   nexty -2.1 mm add
   /nexty exch def
   nextx 11 mm add
   /nextx exch def   
   nextx nexty moveto
   0 mm -2.9 mm rlineto
   8 mm 0 mm rlineto stroke
   nexty -2.9 mm add
   /nexty exch def
   classname   
   status
   drawbox
} def

%%%%%%%%%%%%%%%%%%%%%%%%
% newclass
% draws a new class 
% takes two parameters: 
%     name of the class
%     status of development
/newclass
{
   gsave
   newpath
   SetLineWidth 
   SetLineColor
   nextx nexty moveto
   0 mm -5 mm rlineto
   8 mm 0 mm rlineto stroke
   nexty -5 mm add
   /nexty exch def
   drawbox
   grestore
} def

%%%%%%%%%%%%%%%%%%%%%%%%
% newclassxmoved
% draws a new class 
% takes three parameters: 
%     name of the class
%     status of development
%     x offset in points
%
% Remark:
%  between newclassxmoved and restoreoldxy have to be a newchildclass, 
%  else the output gets scrambled, but don't do a 
%  onelevelback should be used, restoreoldxy removes one child level!
/newclassxmoved
{
   % save parameters
   /offsetx exch def
   /status exch def  
   /classname exch def
   % save enviroment
   % push this on the stack for onemovelevelback
   nextx
   nexty 
   newpath
   SetLineWidth 
   SetLineColor
   nextx nexty moveto
   0 mm -5 mm rlineto
   8 mm offsetx add 0 mm rlineto stroke
   nexty -5 mm add
   /nexty exch def
   /nextx nextx offsetx add def
   classname status drawbox
} def
%%%%%%%%%%%%%%%%%%%%%%%%
% restoreoldxy
% restores old state of nextx and nexty
/restoreoldxy
{
  % remove old child y coordinate 
  /dummy def
  5 mm sub 
  /nexty exch def 
  /nextx exch def 
} def

%%%%%%%%%%%%%%%%%%%%%%%%
% newlargeheadclass
% draws a new large class item to the head line (liek tobject)
% takes two parameters: 
%     name of the class
%     status of development
/newlargeheadclass
{
   gsave
   newpath
   SetLineWidth 
   SetLineColor
   nextx nexty moveto   
   8 mm 0 mm rlineto stroke
   drawlargebox
   grestore
} def

%%%%%%%%%%%%%%%%%%%%%%%%
% onelevelbackempty
% goes one level back in the class hierarchy
/onelevelbackempty
{
   /oldy exch def
   nextx -11 mm add
   /nextx exch def
} def

%%%%%%%%%%%%%%%%%%%%%%%%
% onelevelback
% goes one level back in the class hierarchy
/onelevelback
{
   /oldy exch def
   newpath
   SetLineWidth 
   SetLineColor
   nextx -11 mm add
   /nextx exch def
   nextx oldy moveto
   nextx nexty lineto stroke         
} def

%%%%%%%%%%%%%%%%%%%%%%%%
% Linuxonly
% draws the linux icon
/Linuxonly
{
  gsave
  newpath
  nexticonx
  nexty 1.25 mm sub
  moveto
  SetClassFont 
  StandardTextColor setrgbcolor
%  (Linux)
%  show
%!!!!!!  here we have to update maxx (max. len of the current column)
  grestore
} def

%%%%%%%%%%%%%%%%%%%%%%%%
% Win32only
% draws the win32 icon
/Win32only
{
  gsave
  newpath
  nexticonx
  nexty 1.25 mm sub
  moveto
  SetClassFont 
  StandardTextColor setrgbcolor
%  (Win32)
%  show
%!!!!!!  here we have to update maxx (max. len of the current column)  
  grestore
} def

%%%%%%%%%%%%%%%%%%%%%%%%
% Both
% dummy
/Both
{
} def

%%%%%%%%%%%%%%%%%%%%%%%%
% goes to a new column
% newcolumn
/newcolumn
{
  % add 3 mm space 
  /nextx maxx 3 mm add def
  /nexty starty def
  SetLineWidth 
  SetLineColor
  newpath
  lastlargeobjectx nexty moveto
  nextx nexty lineto stroke
} def

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Footer.
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
/printfooter 
{
/Helvetica-BoldOblique findfont
% first draw outline, only then fill it up. 
% Needed because after stroke no rmoveto ??
72 scalefont
setfont
0 0 0 setrgbcolor
10 10 moveto
2 setlinewidth
(Free Pascal) true charpath stroke 
0 0 1 setrgbcolor
10 10 moveto
(Free Pascal) show 
10 0 rmoveto
/Helvetica-Bold findfont
36 scalefont 
setfont
0 0 0 setrgbcolor
(Object Chart) show
} def
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% See if we will include Lazarus stuff.
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
/lclonly
{
  /param exch def
  lcl 1 eq { param } if
} def

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% here the class tree follows
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

%%%%%%%%%%%%%%%%%%%%%%%
% TObject
%%%%%%%%%%%%%%%%%%%%%%%
(TObject) Ready drawlargebox

%%%%%%%%%%%%%%%%%%%%%%%
% Exception classes
%%%%%%%%%%%%%%%%%%%%%%%
(Exception) Ready newchildclass
  (EAbort) Incomplete newchildclass
  (EAbstractError) Ready newclass
  (EAccessViolation) Ready newclass
  (EBitsError) Ready newclass
  (EConvertError) Ready newclass
  (EDatabaseError) Ready newclass 
    (EDBCLient) Missing newchildclass
      (EReconcileError) Missing newchildclass 
      onelevelback
    (EDBEngineError) Missing newclass 
    (ENoResultSet) Missing newclass
    (EUpdateError) Missing newclass
    onelevelback
  (EDBEditError) Missing newclass
  (EDOMError) Ready newclass
    (EDomHierarchyRequest) Ready newchildclass
    (EDOMIndexSize) Ready newclass 
    (EDOMInUseAttribute) Ready newclass
    (EDOMNotFound) Ready newclass
    (EDOmNotSupported) Ready newclass
    (EDOMWrongDocument) Ready newclass
    onelevelback
  (EIntError) Ready newclass
    (EDivByZero) Ready newchildclass
    (EIntOverflow) Ready newclass
    (ERangeError) Ready newclass
    onelevelback
  (EInOutError) Ready newclass
  (EInvalidCast) Ready newclass
  (EInvalidOperation) Ready newclass
  (EInvalidPointer) Ready newclass
  (EDSWriter) Missing newclass
  (EListError) Ready newclass
  (EMathError) Ready newclass
    (EInvalidOp) Ready newchildclass
    (EOverflow) Ready newclass
    (EUnderflow) Ready newclass
    (EZeroDivide) Ready newclass
    onelevelback
  (EOutOfMemory) Ready newclass
    (EOutOfResources) Ready newchildclass
    onelevelback
  (EResNotFound) Ready newclass
  (EStreamError) Ready newclass
    (EFCreateError) Ready newchildclass
    (EFilerError) Ready newclass
      (EClassNotFound) Ready newchildclass
      (EInvalidImage) Ready newclass
      (EMethodNotFound) Ready newclass
      (EReadError) Ready newclass
      (EWriteError) Ready newclass
      onelevelback
    (EFOpenError) Ready newclass
    (EIOStreamError) Ready newclass
    (EPipeError) Ready newclass
      (ENoReadPipe) Ready newchildclass
      (ENoWritePipe) Ready newclass
      (EPipeCreation) Ready newclass
      (EPipeSeek) Ready newclass
      onelevelback
    (EZLibError) Ready newclass
      (ECompressionError) Ready newchildclass
      (EDecompressionError) Ready newclass
      onelevelback
    onelevelback
   (EStringListError) Ready newclass
   (EThread) Ready newclass
  onelevelback
(OutlineError) Missing newclass

%%%%%%%%%%%%%%%%%%%%%%%
% Some more base classes
%%%%%%%%%%%%%%%%%%%%%%%
newcolumn
(TBits) Untested newclass
(TCollection) Untested newclass
  (TCheckConstraints) Untested newchildclass
  onelevelback
(TCollectionItem) Untested newclass
  (TCheckConstraint) Untested newchildclass
  onelevelback
(TDOMimplementation) Ready newclass
(TDOMNode) Ready newclass
  (TDOMCharacterdata) Ready newchildclass
    (TDOMComment) Ready newchildclass
    (TDOMText) Ready newclass
      (TDOMCDATASection) Ready newchildclass
      onelevelback
    onelevelback
  (TDOMDocumentType) Ready newclass
  (TDOMElement) Ready newclass
  (TDOMNode_withChildren) Ready newclass
    (TDomAttr) Ready newchildclass
    (TDOMDocument) Ready newclass
      (TXMLDocument) Ready newchildclass
      onelevelback
    (TDOMDocumentFragment) Ready newclass
    (TDOMEntity) Ready newclass
    (TDOMEntityReference) Ready newclass
    onelevelback
  (TDOMNotation) Ready newclass
  (TDOMProcessinginstruction) Ready newclass
  onelevelback
(TEZcgi) Ready newclass
(TFiler) Untested newclass
  (TReader) Untested newchildclass
  (TWriter) Untested newclass
  onelevelback
(TIndexDef) Untested newclass
(TIndexDefs) Untested newclass
(TInifile) Ready newclass
(TInterface) Missing newclass % 40 mm newclassxmoved
  (TIAddInNotifier) Missing newchildclass
  onelevelback
(TInterfacedObject) Missing newclass
(TList) Ready newclass
  (TDOMNamedNodeMap) Ready newchildclass
  onelevelback
(TLookupList) Missing newclass
(TParser) Ready newclass
(TPropertyEditor) Missing newclass %40 mm newclassxmoved
  (TClassProperty) Missing newchildclass
    (TFontProperty) Missing newchildclass
    onelevelback
  (TComponentProperty) Missing newclass
  onelevelback
(TRefClass) Ready newclass
  (TDOMNodeList) Ready newchildclass
  onelevelback
(TRegistry) Missing newclass
  (TRegIniFile) Missing newchildclass
  onelevelback
(TRTFParser) Ready newclass
(TRTLCriticalSection) Untested newclass
(TSessionList) Missing newclass
newcolumn
(TStream) Ready newclass
  (TBase64EncodingStream) Ready newchildclass
  (TCustomZlibStream) Ready newclass
    (TCompressionStream) Ready newchildclass
    (TDecompressionStream) Ready newclass
    onelevelback
  (TCustomMemoryStream) Ready newclass
    (TMemorySTream) Ready newchildclass
    onelevelback
  (THandleStream) Ready newclass
    (TFileStream) Ready newchildclass
    (TPipeStream) Ready newclass
    (TIOStream) Ready newclass
    onelevelback
  (TIDEAEncryptStream) Ready newclass
  (TIDEADecryptStream) Ready newclass
  (TResourceStream) Incomplete newclass
  (TStringStream) Untested newclass
  onelevelback 

%%%%%%%%%%%%%%%%%%%%%%%%
% Syncronization classes
(TSyncroObject) Untested newclass
  (TCriticalSection) Untested newchildclass Win32only
  (THandleObject) Untested newclass Win32only
    (TEvent) Incomplete newchildclass Win32only
      (TSimpleEvent) Incomplete newchildclass Win32only
      onelevelbackempty
    onelevelbackempty
  onelevelback
%%%%%%%%%%%%%%%%%%%%%%%%
% Thread classes

(TThread) Incomplete newclass
(TXMLConfig) Ready newclass
%%%%%%%%%%%%%%%%%%%%%%%
% TPersistent classes
%%%%%%%%%%%%%%%%%%%%%%%
newcolumn
(TPersistent) Untested newlargeheadclass
(TCanvas) Missing newchildclass
  (TControlCanvas) Missing newchildclass
  (TMetafileCanvas) Missing newclass
  onelevelback
(TClipboard) Missing newclass
(TStrings) Ready newclass
  (TStringList) Ready newchildclass
  onelevelback
(TTextAttributes) Missing newclass
%%%%%%%%%%%%%%%%%%%%%%%
% TComponent classes
%%%%%%%%%%%%%%%%%%%%%%%
newcolumn
(TComponent) Ready newlargeheadclass
(TDatabase) Untested newchildclass
(TDataset) Ready newclass
  (TDBdatset) Untested newchildclass
  onelevelback
(TField) Ready newclass
  (TBooleanField) Ready newchildclass
  (TBinaryField) Ready newclass
    (TBytesField) Ready newchildclass
      (TVarBytesField) Ready newchildclass
      onelevelback
    onelevelback 
  (TBlobField) Ready newclass
    (TGraphicsField) Ready newchildclass
    (TMemoField) Ready newclass
    onelevelback
  (TDateTimeField) Ready newclass
    (TDateField) Ready newchildclass
    (TTimeField) Ready newclass
    onelevelback
  (TNumericField) Ready newclass
    (TBCDField) Ready newchildclass
    (TFloatField) Ready newclass
    (TLongintField) Ready newclass
      (TAutoIncField) Ready newchildclass
      onelevelback
    (TSmallIntField) Ready newclass
    (TWordField) Ready newclass
    onelevelback
  (TStringField) Ready newclass
  onelevelback
(TFieldDef) Ready newclass
(TFieldDefs) Ready newclass
(TFields) Ready newclass
{
newcolumn
(TControl) Ready newlargeheadclass
} lclonly
% Print footer and eject (last) page
printfooter
showpage