home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Environments / Clean 1.2.4 / IO Examples / IO Utilities / Help.icl < prev    next >
Encoding:
Modula Implementation  |  1996-12-11  |  7.4 KB  |  220 lines  |  [TEXT/3PRM]
  1. implementation module Help
  2.  
  3. import StdString, StdInt, StdChar, StdBool, StdFile, StdArray, StdTuple, StdList
  4. import deltaSystem, deltaEventIO, deltaIOSystem, deltaWindow, deltaPicture, deltaFont
  5.     
  6. ::    InfoDef        :== (Int,Int,[InfoLine])
  7. ::    InfoLine    :== (InfoFontDef,Int,Int,String)
  8. ::    InfoFontDef    =    InfoFont Font Centred
  9.                 |    NoFont     Centred
  10. ::    Centred        :== Bool
  11. ::    Fonts        :== (Font,Font,Font,Font)
  12. ::    Heights        :== (Int,Int)
  13.  
  14. HelpWdID        :== 30000
  15. InfoFontName1    :== "Geneva"
  16. InfoFontName2    :== "Helvetica"
  17. InfoFontName3    :== "Times"
  18. NormalSize1        :== 9
  19. NormalSize2        :== 12
  20. LargeSize1        :== 12
  21. LargeSize2        :== 14
  22. NormalStyle        :== []
  23. BoldStyle        :== ["Bold"]
  24. Margin            :== 8
  25. AboutBegin        :== "\\About"
  26. AboutEnd        :== "\\EndAbout"
  27. HelpBegin        :== "\\Help"
  28. HelpEnd            :== "\\EndHelp"
  29. About            :== False
  30. Help            :== True
  31.  
  32. //
  33. //    General AboutDialog construction.
  34. //
  35.  
  36. MakeAboutDialog :: String String Files (*s -> *((IOState *s) -> (*s,IOState *s)))
  37.                 -> (DialogDef *s (IOState *s), Files)
  38. MakeAboutDialog appname infofile files helpf
  39. #    (xmax,ymax,text,files)    = ReadInfo About fonts AboutBegin AboutEnd infofile files
  40.     picture                    = DrawAboutInfo nft (xmax,ymax,text)
  41.     aboutDialog                = AboutDialog appname ((0,0),(xmax,ymax)) picture (AboutHelp "Help" helpf)
  42. =    (aboutDialog,files)
  43. where
  44.     fonts                    = InfoFonts
  45.     (nft,lft,bft,dft)        = fonts
  46.  
  47. InfoFonts :: Fonts
  48. InfoFonts
  49.     = (    selectfont [(InfoFontName1,NormalSize1),(InfoFontName2,NormalSize2)] NormalStyle
  50.       ,    selectfont [(InfoFontName1,LargeSize1 ),(InfoFontName2,LargeSize2 )] NormalStyle
  51.       ,    selectfont [(InfoFontName1,NormalSize1),(InfoFontName2,NormalSize2)] BoldStyle
  52.       ,    selectfont [(InfoFontName1,LargeSize1 ),(InfoFontName2,LargeSize2 )] BoldStyle
  53.       )
  54. where
  55.     selectfont :: ![(String,Int)] ![FontStyle] -> Font
  56.     selectfont [(fontname,size):preffonts] style
  57.     #    (found,font)    = SelectFont fontname style size
  58.     |    found            = font
  59.     |    otherwise        = selectfont preffonts style
  60.     selectfont _ style    = snd (SelectFont InfoFontName3 style NormalSize2)
  61.  
  62. /*    Reading and pre-processing of the file containing the about- and help-info. */
  63.  
  64. ReadInfo :: Bool Fonts String String String Files -> (Int,Int,[InfoLine],Files)
  65. ReadInfo help fonts begin end filename files
  66. #    (succes,file,files)    = fopen (ApplicationPath filename) FReadText files
  67. |    not succes && help    = (x,y,lines,files)
  68.                         with
  69.                             (x,y,lines)    = ProcessInfoStrings fonts [errpref+++"could not be found."]
  70. |    not succes            = (defaultx,defaulty,defaultlines,files)
  71. #    (found,info,file)    = ReadInfoFile begin end file
  72.     (b,files)            = fclose file files
  73. |    not found && help    = (x,y,lines,files)
  74.                         with
  75.                             (x,y,lines)    = ProcessInfoStrings fonts [errpref+++"does not contain help information."]
  76. |    not found            = (defaultx,defaulty,defaultlines,files)
  77. |    otherwise            = (x,y,lines,files)
  78.                         with
  79.                             (x,y,lines)    = ProcessInfoStrings fonts info
  80. where
  81.     (defaultx,defaulty,defaultlines)
  82.                         = ProcessInfoStrings fonts ["\\DThis is a Clean program."]
  83.     errpref                = "The help file \'"+++filename+++"\' " 
  84.  
  85. ProcessInfoStrings :: Fonts [String] -> InfoDef
  86. ProcessInfoStrings fonts=:(nft,lft,_,_) lines
  87.                         = (maxx1,maxy+Margin-lat,lines2)
  88. where
  89.     heights                = (nat+ndt+nld,lat+ldt+lld)
  90.     (maxx,maxy,lines1)    = AddFontToInfoLines fonts heights 0 (Margin+lat) lines
  91.     maxx1                = Margin+maxx+Margin
  92.     lines2                = map (CenterInfoLine nft maxx1) lines1
  93.     (nat,ndt,_,nld)        = FontMetrics nft
  94.     (lat,ldt,_,lld)        = FontMetrics lft
  95.     
  96.     AddFontToInfoLines :: Fonts Heights Int Int [String] -> InfoDef
  97.     AddFontToInfoLines fonts heights maxx maxy [line:rest]
  98.     =    (maxx1,maxy1,[(font,Margin,maxy,line1):rest1])
  99.     where
  100.         (font,wid,hgt,line1)= ParseInfoLine fonts heights line
  101.         (maxx1,maxy1,rest1)    = AddFontToInfoLines fonts heights (max maxx wid) (maxy+hgt) rest
  102.         
  103.         ParseInfoLine :: Fonts Heights String -> (InfoFontDef,Int,Int,String)
  104.         ParseInfoLine fonts=:(nft,lft,bft,dft) heights=:(nhgt,lhgt) line
  105.         |    linelen<2 || line.[0]<>'\\'
  106.         =    (NoFont False, FontStringWidth line nft, nhgt,line )
  107.         |    otherwise
  108.         =    (infofont, FontStringWidth line1 font, height,line1)
  109.         with
  110.             line1                    = line%(2,dec linelen)
  111.             (infofont,font,height)    = case (line.[1]) of
  112.                                             'L' -> (InfoFont lft False, lft, lhgt)
  113.                                             'b' -> (InfoFont bft False, bft, nhgt)
  114.                                             'B' -> (InfoFont dft False, dft, lhgt)
  115.                                             'c' -> (NoFont True       , nft, nhgt)
  116.                                             'C' -> (InfoFont lft True , lft, lhgt)
  117.                                             'd' -> (InfoFont bft True , bft, nhgt)
  118.                                             'D' -> (InfoFont dft True , dft, lhgt)
  119.                                             _   -> (NoFont False      , nft, nhgt)
  120.         where
  121.             linelen                    = size line
  122.     AddFontToInfoLines _ _ maxx maxy _
  123.     =    (maxx,maxy,[])
  124.     
  125.     CenterInfoLine :: Font Int InfoLine -> InfoLine
  126.     CenterInfoLine nft maxx info=:(inft=:NoFont centered,x,y,line)
  127.     |    centered    = (inft,(maxx-FontStringWidth line nft)/2,y,line)
  128.     |    otherwise    = info
  129.     CenterInfoLine nft maxx info=:(inft=:InfoFont font centered,x,y,line)
  130.     |    centered    = (inft,(maxx-FontStringWidth line font)/2,y,line)
  131.     |    otherwise    = info
  132.  
  133. ReadInfoFile :: String String *File -> (Bool,[String],*File)
  134. ReadInfoFile begin end file
  135. #    (begin_found,file)        = FindInfoBegin begin file
  136. |    not begin_found            = (False,[],file)
  137. #    (lines,file)            = ReadInfoUntil end file
  138. |    otherwise                = (True,lines,file)
  139.  
  140. FindInfoBegin :: String *File -> (Bool,*File)
  141. FindInfoBegin begin file
  142. |    sfend file                = (False,file)
  143. #    (line,file)                = freadline file
  144. |    isPrefixOf begin line    = (True,file)
  145. |    otherwise                = FindInfoBegin begin file
  146.  
  147. ReadInfoUntil :: String *File -> ([String],*File)
  148. ReadInfoUntil end file
  149. |    sfend file                = ([],file)
  150. #    (line,file)                = freadline file
  151. |    isPrefixOf end line        = ([],file)
  152. #    (lines,file)            = ReadInfoUntil end file
  153. |    otherwise                = ([StripNewline line:lines],file)
  154.  
  155.  
  156. /*    The drawing of the about/help info. */
  157.  
  158. DrawAboutInfo :: Font InfoDef -> [DrawFunction]
  159. DrawAboutInfo nft (xmax,ymax,lines)
  160. =    [    SetFont        nft
  161.     ,    DrawInfo    nft 0 ymax lines
  162.     ]
  163.  
  164. DrawInfo :: Font Int Int [InfoLine] Picture -> Picture
  165. DrawInfo nft top bot [(InfoFont font c,x,y,line):rest] pic
  166. |    y>bot        = pic
  167. |    y<top        = DrawInfo nft top bot rest pic
  168. |    otherwise    = DrawInfo nft top bot rest (SetFont nft (DrawString line (SetFont font (MovePenTo (x,y) pic))))
  169. DrawInfo nft top bot [(NoFont c,x,y,line):rest] pic
  170. |    y>bot        = pic
  171. |    y<top        = DrawInfo nft top bot rest pic
  172. |    otherwise    = DrawInfo nft top bot rest (DrawString line (MovePenTo (x,y) pic))
  173. DrawInfo _ _ _ _ pic
  174.                 = pic
  175.  
  176. //
  177. //    The Help function.
  178. //
  179.  
  180. ShowHelp :: String Files (IOState s) -> (Files, IOState s)
  181. ShowHelp infofile files io
  182. #    (xmax,ymax,text,files)    = ReadInfo Help fonts HelpBegin HelpEnd infofile files
  183.     window                    = FixedWindow HelpWdID (0,0) "Help" ((0,0),(xmax,ymax)) (UpdateHelpWd nft text) []
  184.     io                        = OpenWindows [window] io
  185. =    (files,io)
  186. where
  187.     fonts                    = InfoFonts
  188.     (nft,lft,bft,dft)        = fonts
  189.     
  190.     UpdateHelpWd :: Font [InfoLine] UpdateArea *s -> (*s,[DrawFunction])
  191.     UpdateHelpWd nft lines areas s
  192.         = (    s
  193.           ,    [    SetFont        nft
  194.               ,    RedrawAreas    nft lines areas
  195.               ]
  196.           )
  197.     where
  198.         RedrawAreas :: Font [InfoLine] UpdateArea Picture -> Picture
  199.         RedrawAreas nft lines [area=:((l,t),(r,b)):rest] pic
  200.             = RedrawAreas nft lines rest (DrawInfo nft (dec t) (b+40) lines pic)
  201.         RedrawAreas _ _ _ pic
  202.             = pic
  203.  
  204. /*    Support functions for the AboutDialog construction. */
  205.  
  206. isPrefixOf :: String String -> Bool
  207. isPrefixOf prefix string
  208. |    prefixlen>size string    = False
  209. |    otherwise                = prefix==string%(0,dec prefixlen) 
  210. where
  211.     prefixlen                = size prefix
  212.  
  213. StripNewline :: String -> String
  214. StripNewline string
  215. |    string==""                = string
  216. |    string.[last]<>'\n'        = string
  217. |    otherwise                = string%(0,dec last)
  218. where
  219.     last                    = dec (size string)
  220.