| 1 | {- | |
|---|
| 2 | Module : $Header$ |
|---|
| 3 | Description : Central GUI for Hets, with display of development graph |
|---|
| 4 | Copyright : (c) Jorina Freya Gerken, Till Mossakowski, Uni Bremen 2002-2006 |
|---|
| 5 | License : similar to LGPL, see HetCATS/LICENSE.txt or LIZENZ.txt |
|---|
| 6 | |
|---|
| 7 | Maintainer : till@informatik.uni-bremen.de |
|---|
| 8 | Stability : provisional |
|---|
| 9 | Portability : non-portable (imports Logic) |
|---|
| 10 | |
|---|
| 11 | Conversion of development graphs from Logic.DevGraph |
|---|
| 12 | to abstract graphs of the graph display interface |
|---|
| 13 | |
|---|
| 14 | A composition table is used when abstracting the graph and composing |
|---|
| 15 | multiple edges. It looks like this |
|---|
| 16 | |
|---|
| 17 | @ |
|---|
| 18 | [(\"normal\",\"normal\",\"normal\"), |
|---|
| 19 | (\"normal\",\"inclusion\",\"normal\"), |
|---|
| 20 | (\"inclusion\",\"normal\",\"normal\"), |
|---|
| 21 | (\"inclusion\",\"inclusion\",\"inclusion\")] |
|---|
| 22 | @ |
|---|
| 23 | |
|---|
| 24 | A ginfo can be created with initgraphs. The graph is then created with |
|---|
| 25 | addnode and addlink. |
|---|
| 26 | |
|---|
| 27 | -} |
|---|
| 28 | |
|---|
| 29 | module GUI.GraphDisplay |
|---|
| 30 | (convertGraph,initializeConverter) |
|---|
| 31 | where |
|---|
| 32 | |
|---|
| 33 | import Static.DevGraph |
|---|
| 34 | |
|---|
| 35 | import GUI.GraphMenu |
|---|
| 36 | import GUI.GraphTypes |
|---|
| 37 | import GUI.GraphLogic( convert, applyChanges, hideNodes) |
|---|
| 38 | import qualified GUI.GraphAbstraction as GA |
|---|
| 39 | |
|---|
| 40 | import qualified GUI.HTkUtils as HTk |
|---|
| 41 | |
|---|
| 42 | import Data.IORef |
|---|
| 43 | import qualified Data.Map as Map(lookup, insert) |
|---|
| 44 | import Control.Concurrent.MVar |
|---|
| 45 | |
|---|
| 46 | initializeConverter :: IO (GInfo,HTk.HTk) |
|---|
| 47 | initializeConverter = do |
|---|
| 48 | wishInst <- HTk.initHTk [HTk.withdrawMainWin] |
|---|
| 49 | gInfo <- emptyGInfo |
|---|
| 50 | return (gInfo,wishInst) |
|---|
| 51 | |
|---|
| 52 | {- | converts the development graph given by its libname into an |
|---|
| 53 | abstract graph and returns the descriptor of the latter, the |
|---|
| 54 | graphInfo it is contained in and the conversion maps. -} |
|---|
| 55 | convertGraph :: ConvFunc |
|---|
| 56 | convertGraph gInfo@(GInfo { libEnvIORef = ioRefProofStatus |
|---|
| 57 | , gi_GraphInfo = actGraphInfo |
|---|
| 58 | , gi_LIB_NAME = libname |
|---|
| 59 | , windowCount = wc |
|---|
| 60 | }) title showLib = do |
|---|
| 61 | libEnv <- readIORef ioRefProofStatus |
|---|
| 62 | case Map.lookup libname libEnv of |
|---|
| 63 | Just dgraph -> do |
|---|
| 64 | case openlock dgraph of |
|---|
| 65 | Just lock -> do |
|---|
| 66 | notopen <- tryPutMVar lock $ \ hist -> do |
|---|
| 67 | hhn <- GA.hasHiddenNodes actGraphInfo |
|---|
| 68 | case hhn of |
|---|
| 69 | True -> do |
|---|
| 70 | GA.showAll actGraphInfo |
|---|
| 71 | applyChanges actGraphInfo hist |
|---|
| 72 | hideNodes gInfo |
|---|
| 73 | False -> |
|---|
| 74 | applyChanges actGraphInfo hist |
|---|
| 75 | GA.redisplay actGraphInfo |
|---|
| 76 | case notopen of |
|---|
| 77 | True -> do |
|---|
| 78 | count <- takeMVar wc |
|---|
| 79 | putMVar wc $ count + 1 |
|---|
| 80 | initializeGraph gInfo title showLib |
|---|
| 81 | if (isEmptyDG dgraph) then return () |
|---|
| 82 | else do |
|---|
| 83 | convert actGraphInfo dgraph |
|---|
| 84 | return () |
|---|
| 85 | False -> error $ "development graph with libname " ++ show libname |
|---|
| 86 | ++" is already open" |
|---|
| 87 | Nothing -> do |
|---|
| 88 | lock <- newEmptyMVar |
|---|
| 89 | writeIORef ioRefProofStatus |
|---|
| 90 | $ Map.insert libname dgraph{openlock = Just lock} libEnv |
|---|
| 91 | convertGraph gInfo title showLib |
|---|
| 92 | Nothing -> error $ "development graph with libname " ++ show libname |
|---|
| 93 | ++" does not exist" |
|---|
| 94 | |
|---|
| 95 | -- | initializes an empty abstract graph with the needed node and edge types, |
|---|
| 96 | -- return type equals the one of convertGraph |
|---|
| 97 | initializeGraph :: GInfo -> String -> LibFunc -> IO () |
|---|
| 98 | initializeGraph gInfo@(GInfo { gi_LIB_NAME = ln }) title showLib = do |
|---|
| 99 | let title' = (title ++ " for " ++ show ln) |
|---|
| 100 | createGraph gInfo title' (convertGraph) (showLib) |
|---|