home *** CD-ROM | disk | FTP | other *** search
/ PC World 1997 November / PCWorld_1997-11_cd.bin / software / programy / komix / DATA.Z / flows.tcl < prev    next >
Text File  |  1996-11-22  |  4KB  |  153 lines
  1. #---------------------------------------------------------------------------
  2. #
  3. #    (c) Cadre Technologies Inc. 1995
  4. #
  5. #    File:        @(#)flows.tcl    /main/hindenburg/1
  6. #    Author:        Harm Leijendeckers
  7. #    Description:    Report on flows
  8. #    Usage in:    SystemVersions and DFD editor
  9. #
  10. #---------------------------------------------------------------------------
  11. # SccsId = @(#)flows.tcl    /main/hindenburg/1    22 Nov 1996    Copyright 1995 Cadre Technologies Inc.
  12.  
  13.  
  14. eval [$cc getCustomFileContents semanticbase tcl reports]
  15.  
  16.  
  17. Class ReportFlows : {SemanticBase} {
  18.     constructor
  19.     method doReport
  20.  
  21.     method makeFlow
  22. }
  23.  
  24.  
  25. constructor ReportFlows {class this} {
  26.     set this [SemanticBase::constructor $class $this]
  27.     $this reportName Flows
  28.  
  29.     defineTypes
  30.     defineArrows
  31.  
  32.     return $this
  33. }
  34.  
  35.  
  36. method ReportFlows::doReport {this model} {
  37.     # get all DFD nodes
  38.     set nodes [query {getSemType.name in {"DFD DataProcess" \
  39.     "DFD DataStore" "DFD Actor" "DFD Anchor"} && objType == SMNode} \
  40.     [$model getSMObjects $ANY]]
  41.     if [lempty $nodes] { return 0 }
  42.  
  43.     set report [$this report]
  44.     $report header {
  45.     set report [$this report]
  46.     $report print "--- Data Flow -->" 32 center
  47.     $report print "- - Control Flow - >" 32 center
  48.     $report print "=== Result Flow ==>" 32 center
  49.     $report print "<-< Update Flow >->" 32 center line
  50.     $report line
  51.     $report print "From Type" 12
  52.     $report print "From Node" 27
  53.     $report print Flow 54
  54.     $report print "To Node" 27
  55.     $report print "To Type" line
  56.     $report line
  57.     }
  58.  
  59.     set sortedNodes [concat [query "getItem.isNil == 1" $nodes] \
  60.             [osort getItem.name [query "getItem.isNil == 0" $nodes]]]
  61.  
  62.     foreach node $sortedNodes {
  63.     set outFlows [getOut $node]
  64.     if [lempty $outFlows] { continue }
  65.  
  66.     $report print [string range [$this objType $node] 4 end] 11
  67.     $report space
  68.     $report print [$this objName $node] 26
  69.     $report space
  70.  
  71.     foreach flow $outFlows {
  72.         if ![$report queued] { $report space 39 }
  73.         $report print [$this makeFlow $flow] 53
  74.         $report space
  75.         set toNode [lindex $flow [expr [llength $flow]-1]]
  76.         $report print [$this objName $toNode] 26
  77.         $report space
  78.         $report print [string range [$this objType $toNode] 4 end] 11
  79.         $report line
  80.     }
  81.  
  82.     $report line
  83.     }
  84.  
  85.     $report page
  86.     $report remove header
  87.  
  88.     return 0
  89. }
  90.  
  91.  
  92. method ReportFlows::makeFlow {this flows} {
  93.     set flowType [[lindex $flows 0] getSemType]
  94.     set result $leftArrow($flowType)
  95.     while { [llength $flows] != 2 } {
  96.     set txt [$this labelValue [lvarpop flows]]
  97.     if { $txt == "" } { continue }
  98.     set result [concat $result $txt $middleArrow($flowType)]
  99.     }
  100.     return [concat $result [$this labelValue [lvarpop flows]] \
  101.            $rightArrow($flowType)]
  102. }
  103.  
  104.  
  105. proc getOut {node} {
  106.     set connsOut [$node getConnectorsOut $ANY $ANY]
  107.  
  108.     if { $connsOut == "" } { return "" }
  109.  
  110.     set result ""
  111.     foreach conn $connsOut {
  112.     set endNode [concat [$conn getTo $OMT_DFD_DataProcess] \
  113.                 [$conn getTo $OMT_DFD_DataStore] \
  114.                 [$conn getTo $OMT_DFD_Actor] \
  115.                 [$conn getTo $OMT_DFD_Anchor]]
  116.     if { $endNode != "" } {
  117.         lappend result [concat $conn $endNode]
  118.     } else {
  119.         set toSplit [$conn getTo $OMT_DFD_Node]
  120.         foreach subResult [getOut $toSplit] {
  121.         lappend result [concat $conn $subResult]
  122.         }
  123.     }
  124.     }
  125.  
  126.     return $result
  127. }
  128.  
  129.  
  130. proc defineArrows {} {
  131.     global leftArrow middleArrow rightArrow
  132.  
  133.     set leftArrow($OMT_DFD_DataFlow) "---"
  134.     set leftArrow($OMT_DFD_UpdateFlow) "<-<"
  135.     set leftArrow($OMT_DFD_ControlFlow) "- -"
  136.     set leftArrow($OMT_DFD_ResultFlow) ""
  137.  
  138.     set middleArrow($OMT_DFD_DataFlow) "---"
  139.     set middleArrow($OMT_DFD_UpdateFlow) "<->"
  140.     set middleArrow($OMT_DFD_ControlFlow) "- -"
  141.     set middleArrow($OMT_DFD_ResultFlow) ""
  142.  
  143.     set rightArrow($OMT_DFD_DataFlow) "-->"
  144.     set rightArrow($OMT_DFD_UpdateFlow) ">->"
  145.     set rightArrow($OMT_DFD_ControlFlow) "- >"
  146.     set rightArrow($OMT_DFD_ResultFlow) "==>"
  147. }
  148.  
  149.  
  150. # ----------------------------------------------------------------------
  151. #
  152. set executeMe [ReportFlows new]
  153.