home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Environments / Clean 1.2.4 / IO Examples / Scrabble / types.icl < prev   
Encoding:
Modula Implementation  |  1997-05-14  |  7.4 KB  |  259 lines  |  [TEXT/3PRM]
  1. implementation module types
  2.  
  3.  
  4. import    StdEnv
  5. import    language
  6.  
  7.  
  8. /***************************************************************************************************************
  9.     Type definitions.
  10. ****************************************************************************************************************/
  11. ::    Playmode            =    EndPlayer1 | EndPlayer2 | Playing
  12. ::    Playerkind            =    Computer | Person
  13. ::    Player                =    Player1 | Player2
  14. ::    Strength            =    Maximum | First | Strength Real
  15. ::    Direction            =    Hor | Ver 
  16. ::    Word                :==    String
  17. ::    Position            :==    (!Int,!Int)
  18.  
  19. MediumStrength            :==    Strength 0.5
  20. EasyStrength            :==    Strength 0.25
  21. VeryEasyStrength        :==    Strength 0.125
  22.  
  23. instance == Playmode
  24. where
  25.     (==) :: !Playmode !Playmode -> Bool
  26.     (==) EndPlayer1    mode    = case mode of
  27.                                 EndPlayer1    -> True
  28.                                 _            -> False
  29.     (==) EndPlayer2    mode    = case mode of
  30.                                 EndPlayer2    -> True
  31.                                 _            -> False
  32.     (==) Playing    mode    = case mode of
  33.                                 Playing        -> True
  34.                                 _            -> False
  35. instance == Playerkind
  36. where
  37.     (==) :: !Playerkind !Playerkind -> Bool
  38.     (==) Computer    Computer= True
  39.     (==) Person        Person    = True
  40.     (==) _            _        = False
  41. instance == Player
  42. where
  43.     (==) :: !Player !Player -> Bool
  44.     (==) Player1 Player1 = True
  45.     (==) Player2 Player2 = True
  46.     (==) _         _         = False
  47. instance == Strength
  48. where
  49.     (==) :: !Strength !Strength -> Bool
  50.     (==) Maximum        strength    = case strength of
  51.                                         Maximum            -> True
  52.                                         _                -> False
  53.     (==) First            strength    = case strength of
  54.                                         First            -> True
  55.                                         _                -> False
  56.     (==) (Strength s1)    strength    = case strength of
  57.                                         (Strength s2)    -> s1==s2
  58.                                         _                -> False
  59. instance == Direction
  60. where
  61.     (==) :: !Direction !Direction -> Bool
  62.     (==) Hor Hor = True
  63.     (==) Ver Ver = True
  64.     (==) _     _     = False
  65. instance == Placing
  66. where
  67.     (==) :: !Placing !Placing -> Bool
  68.     (==) p1 p2 = p1.word==p2.word && p1.pos==p2.pos && p1.dir==p2.dir && p1.score==p2.score
  69.  
  70. otherplayer :: !Player -> Player
  71. otherplayer Player1 = Player2
  72. otherplayer Player2 = Player1
  73.  
  74.  
  75. /***************************************************************************************************************
  76.     The type Progress is by the computer player function when determining a move. The computer player checks in 
  77.     alfabetic order all words starting with a particular letter.
  78.     
  79.     Words starting with a particular letter are handled quickly when the starting letter does not occur on the 
  80.     letter bar. In that case the positions on the board are checked if they are valid as a starting position for 
  81.     the word (horizontal and vertical are handled separately).
  82.     
  83.     For words starting with a particular letter on the letter bar more board positions need to be examined.
  84. ****************************************************************************************************************/
  85. ::    Progress
  86.     =    Letter Char Placing
  87.     |    Finish Placing
  88. ::    Placing
  89.     =    {    word    :: Word
  90.         ,    pos        :: Position
  91.         ,    dir        :: Direction
  92.         ,    score    :: Int
  93.         }
  94.  
  95. initplacing :: Placing
  96. initplacing = {word="",pos=(0,0),dir=Hor,score=0}
  97.  
  98. getplacing :: !Progress -> Placing
  99. getplacing (Letter _ p)    = p
  100. getplacing (Finish p)    = p
  101.  
  102. getletter :: !Progress -> Char
  103. getletter (Letter l _)    = l
  104. getletter (Finish _)    = 'z'
  105.     
  106. notyetready :: !Progress -> Bool
  107. notyetready (Finish _)    = False
  108. notyetready _            = True
  109.  
  110.  
  111. /***************************************************************************************************************
  112.     The Tree type stores the lexicon. 
  113. ****************************************************************************************************************/
  114.  
  115. ::    Tree
  116.     =    Leaf !String
  117.     |    Node Tree !String Tree
  118.  
  119. maketree :: ![Word] -> Tree
  120. maketree xs
  121. |    isEmpty xs        = Leaf ""
  122. |    nrwords==1        = Leaf (toString (hd xs))
  123. |    otherwise        = Node (maketree firsthalf) middle (maketree secondhalf)
  124. where
  125.     nrwords                            = length xs
  126.     (firsthalf,[middle:secondhalf])    = splitAt (nrwords/2) xs
  127.  
  128. wordsstartingwith :: !Char !Tree -> [Word]
  129. wordsstartingwith letter (Node l w r)
  130. |    w.[0]>letter
  131. =    wordsstartingwith letter l
  132. |    w.[0]<letter
  133. =    wordsstartingwith letter r
  134. =    wordsstartingwithleft letter l [w:wordsstartingwithright letter r]
  135. where
  136.     wordsstartingwithleft :: !Char !Tree ![Word] -> [Word]
  137.     wordsstartingwithleft letter (Node l w r) t
  138.     |    w.[0]==letter
  139.     =    wordsstartingwithleft letter l [w:wordsintree r t]
  140.     =    wordsstartingwithleft letter r t
  141.     wordsstartingwithleft letter (Leaf b) t
  142.     |    size b>0 && b.[0]==letter
  143.     =    [b:t]
  144.     =    t
  145.     
  146.     wordsstartingwithright :: !Char !Tree -> [Word]
  147.     wordsstartingwithright letter (Node l w r)
  148.     |    w.[0]==letter
  149.     =    wordsintree l [w:wordsstartingwithright letter r]
  150.     =    wordsstartingwithright letter l
  151.     wordsstartingwithright letter b
  152.     =    wordsstartingwith letter b
  153.     
  154.     wordsintree :: !Tree ![Word] -> [Word]
  155.     wordsintree (Node l w r) t
  156.     =    wordsintree l [w:wordsintree r t]
  157.     wordsintree (Leaf b) t
  158.     |    size b<>0
  159.     =    [b:t]
  160.     =    t
  161. wordsstartingwith letter (Leaf b)
  162. |    size b>0 && b.[0]==letter
  163. =    [b]
  164. =    []
  165.  
  166. readtree :: !Files -> (!Tree,!Files)
  167. readtree files
  168. #    (woorden,files)    = readwords lexiconfilename files
  169. =    (maketree woorden,files)
  170. where
  171.     readwords :: !String !Files -> (![Word],!Files)
  172.     readwords filename files
  173.     #    (ok,f,files)    = fopen filename FReadText files
  174.     |    not ok            = shownl ("Warning: could not open file '"+++filename+++"' for reading") ([],files)
  175.     #    (lines,f)        = readlines f
  176.         (_,files)        = fclose f files
  177.     |    otherwise        = (lines,files)
  178.     where
  179.         readlines :: !*File -> (![Word],!*File)
  180.         readlines f
  181.         |    sfend f        = ([],f)
  182.         #    (line, f)    = freadline f
  183.             (lines,f)    = readlines f
  184.             lengte        = size line
  185.         |    lengte>1    = ([fromString (line%(0,lengte-2)):lines],f)    // remove '\n'
  186.         |    otherwise    = (lines,f)
  187.  
  188. writetree :: !Tree !Files -> Files
  189. writetree b files
  190. =    writewords lexiconfilename (toList b) files
  191. where
  192.     writewords :: !String [String] !Files -> Files
  193.     writewords filename woorden files
  194.     #    (ok,f,files)    = fopen filename FWriteText files
  195.     |    not ok            = shownl ("Warning: could not open file '"+++filename+++"' for writing") files
  196.     #    (ok,f)            = writelines woorden f
  197.         (_,files)        = fclose f files
  198.     |    not ok            = shownl ("Error occurred while writing file '"+++filename+++"'") files
  199.     |    otherwise        = files
  200.     where
  201.         writelines :: ![String] !*File -> (!Bool,!*File)
  202.         writelines [w:ws] f
  203.         #    f            = fwrites (toString w) f
  204.             f            = fwritec '\n' f
  205.             (error,f)    = ferror f
  206.         |    error        = (False,f)
  207.         |    otherwise    = writelines ws f
  208.         writelines _ f    = (True,f)
  209.     
  210.     toList :: !Tree -> [String]
  211.     toList (Leaf word)
  212.     |    word==""
  213.     =    []
  214.     =    [word]
  215.     toList (Node l word r)
  216.     |    word==""
  217.     =    toList l ++ toList r
  218.     =    toList l ++ [word: toList r]
  219.  
  220. shownl :: !String .x -> .x
  221. shownl text x
  222. #!    written=fwrites (text+++"\n") stderr
  223. =    K x written
  224.  
  225. addwordstotree :: !Tree ![Word] -> Tree
  226. addwordstotree b wrds
  227. =    foldl addwordtotree b wrds
  228. where
  229.     addwordtotree :: !Tree !Word -> Tree
  230.     addwordtotree b=:(Node l w r) x
  231.     |    x<w            = Node (addwordtotree l x) w r
  232.     |    x>w            = Node l w (addwordtotree r x)
  233.     |    otherwise    = b
  234.     addwordtotree b=:(Leaf w) x
  235.     |    x<w            = Node (Leaf x)  w (Leaf "")
  236.     |    x>w            = Node (Leaf "") w (Leaf x)
  237.     |    otherwise    = b
  238.  
  239. seek :: !Tree !String -> Bool
  240. seek (Leaf b) x        = b==x
  241. seek (Node l w r) x    = w==x || (x<w && seek l x) || (x>w && seek r x)
  242.  
  243. sizetree :: !Tree -> Int
  244. sizetree (Leaf _)        = 1
  245. sizetree (Node l _ r)    = sizetree l+sizetree r+1
  246.  
  247. depthtree :: !Tree -> Int
  248. depthtree (Leaf _)        = 1
  249. depthtree (Node l _ r)    = max (depthtree l+1) (depthtree r+1)
  250.  
  251.  
  252. /***************************************************************************************************************
  253.     Global Ids.
  254. ****************************************************************************************************************/
  255.  
  256. scrabbleId        :==    1
  257. toevoegId        :==    2
  258. computerId        :== 1
  259.