home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Environments / Clean 1.2.4 / IOInterface / menuInternal.icl < prev    next >
Encoding:
Modula Implementation  |  1997-04-23  |  7.4 KB  |  197 lines  |  [TEXT/3PRM]
  1. implementation module menuInternal;
  2.  
  3. import StdClass, StdMisc, StdChar, StdInt, StdString, StdBool,StdArray;
  4. import    menus;
  5. import    ioState;
  6.  
  7. AppleMenuId        :== 128;
  8.  
  9. SystemAble        :== True;
  10. SystemUnable    :== False;
  11.  
  12. MenuInternalError :: String String -> * x;
  13. MenuInternalError rule error =  Error rule "menuInternal" error;
  14.  
  15. //    Initialization and Allocation:
  16.  
  17. AppleMenu :: !Toolbox -> (!MenuHandle s, !Toolbox);
  18. AppleMenu tb
  19.     =    InsertAppleMenu menuH tb1;
  20.     where {
  21.         (menuH, tb1) = NewMenuHandle (PullDownMenu AppleMenuId AppleString Able []) AppleMenuId tb;
  22.     };
  23.     
  24. InsertAppleMenu    :: !(MenuHandle s) !Toolbox -> (!MenuHandle s, !Toolbox);
  25. InsertAppleMenu menuH=:(PullDownHandle menu id macId able items) tb
  26.     =    (menuH, tb4);
  27.     where {
  28.         tb1 = AppendMenu menu "About..." tb;
  29.         tb2 = AppendMenu menu "-(" tb1;
  30.         tb3 = AddResMenu menu DriverType tb2;
  31.         tb4 = InsertMenu menu InsertPullDownPosition tb3;
  32.     };
  33.  
  34. DriverType :: Int;
  35. DriverType = s4;
  36.     where {
  37.         s3 = toInt 'V'  + s2 << 8;
  38.         s2 = toInt 'R'  + s1 << 8;
  39.         s1 = toInt 'D';
  40.         s4 = toInt 'R'  + s3 << 8;
  41.     };
  42.  
  43. AppleString    :: String;
  44. AppleString = toString (toChar 20);
  45.  
  46. EmptyMenuHandle :: !MenuId !Toolbox -> (!MenuHandle s, !Toolbox);
  47. EmptyMenuHandle macId tb
  48.     =    (PullDownHandle menu macId macId Unable [], tb1);
  49.     where {
  50.         (menu, tb1) = NewMenu macId "" tb;
  51.     };
  52.  
  53. NewMenuHandle :: !(MenuDef s (IOState s)) !MenuId !Toolbox -> (!MenuHandle s, !Toolbox);
  54. NewMenuHandle (PullDownMenu menuId title select items) macId tb
  55. |    Enabled select    = (menuH, EnableItem  menu 0 tb1);
  56.                     = (menuH, DisableItem menu 0 tb1);
  57.     where {
  58.         menuH        = PullDownHandle menu menuId macId select [];
  59.         (menu, tb1)    = NewMenu macId title tb;
  60.     };
  61.  
  62. NewMenuElementHandle :: !(MenuElement s (IOState s)) !MenuId !Toolbox -> (!MenuHandle s, !Toolbox);
  63. NewMenuElementHandle (SubMenuItem menuId title select items) mId tb
  64. |    Enabled select    = (SubMenuItemHandle menu menuId mId [], EnableItem  menu 0 tb1);
  65.                     = (SubMenuItemHandle menu menuId mId [], DisableItem menu 0 tb1);
  66.     where {
  67.         (menu,tb1)    = NewMenu mId title tb;
  68.     };
  69. NewMenuElementHandle (MenuItem         id _ c _   f)    _ tb = (MenuItemHandle        id    (KeyCHAR c) f, tb);
  70. NewMenuElementHandle (CheckMenuItem     id _ c _ _ f)    _ tb = (CheckMenuItemHandle id    (KeyCHAR c) f, tb);
  71. NewMenuElementHandle (MenuItemGroup     id _)            _ tb = (MenuItemGroupHandle id    [], tb);
  72. NewMenuElementHandle (MenuRadioItems _ _)            _ tb = (MenuRadioItemsHandle    [], tb);
  73. NewMenuElementHandle MenuSeparator                    _ tb = (MenuSeparatorHandle, tb);
  74.  
  75. KeyCHAR    :: !KeyShortcut -> Char;
  76. KeyCHAR (Key c) =  c;
  77. KeyCHAR key =  '0';
  78.  
  79. DisposeMenuHandles :: ![MenuHandle s] !Toolbox -> Toolbox;
  80. DisposeMenuHandles [PullDownHandle menu menuId macId able items : m_and_hs] tb
  81.     =     DisposeMenuHandles m_and_hs (DisposeMenu menu tb);
  82. DisposeMenuHandles m_and_hs tb =  tb;
  83.  
  84. DisposeMenuSystemState :: !(DeviceSystemState s) !Toolbox -> Toolbox;
  85. DisposeMenuSystemState (MenuSystemState (menus, cuts, handle, systemAble)) tb
  86.     =     DrawMenuBar (ClearMenuBar (DisposeMenuHandles menus tb));
  87. DisposeMenuSystemState _ _
  88.     =     MenuInternalError "DisposeMenuSystemState" "argument is no MenuSystemState";
  89.  
  90.  
  91. //    Forming the MenuBar:
  92.  
  93. InsertPullDownPosition    :== 0;
  94. InsertSubPosition        :== -1;
  95.  
  96. Insert_menu    :: !(MenuHandle s) !Toolbox -> Toolbox;
  97. Insert_menu (PullDownHandle menu id macId able items) tb
  98.     =     InsertMenu menu InsertPullDownPosition tb;
  99. Insert_menu (SubMenuItemHandle menu id macId items) tb
  100.     =     InsertMenu menu InsertSubPosition tb;
  101.  
  102. GetMenuSystem :: !(DeviceSystemState s) !Toolbox -> (!DeviceSystemState s, !Toolbox);
  103. GetMenuSystem (MenuSystemState (menus, cuts, menuBar`, systemAble)) tb
  104.     =    (MenuSystemState (menus, cuts, menuBar, systemAble), tb1);
  105.     where {
  106.         (menuBar, tb1) = GetMenuBar tb;
  107.     };
  108.  
  109. SetMenuSystem :: !(DeviceSystemState s) !Toolbox -> Toolbox;
  110. SetMenuSystem (MenuSystemState (_,_,menuBar,_)) tb = SetMenuBar menuBar tb;
  111.  
  112.  
  113. //    Access-rules on MenuSystemStates:
  114.     
  115. MenuSystemState_MenuFunction :: !MenuId !Int !(DeviceSystemState s)
  116.     ->    (!Bool, !MenuFunction s (IOState s));
  117. MenuSystemState_MenuFunction menu_id item_nr (MenuSystemState (menus, cuts, handle, system_able))
  118.     =     MenuHandles_MenuFunction menu_id item_nr menus;
  119.  
  120. MenuHandles_MenuFunction :: !MenuId !Int ![MenuHandle s] -> (!Bool, !MenuFunction s (IOState s));
  121. MenuHandles_MenuFunction menu_id item_nr [PullDownHandle handle id mac_id able items : handles]
  122. |    menu_id == mac_id    = MenuElements_MenuFunction item_nr items;
  123. |    not in_here            = MenuHandles_MenuFunction menu_id item_nr handles;
  124.                         = in_here_f;
  125.     where {
  126.         (in_here, f)= in_here_f;
  127.         in_here_f    = SubMenuHandles_MenuFunction menu_id item_nr items;
  128.     };
  129. MenuHandles_MenuFunction menu_id _ _
  130.     =    MenuInternalError "MenuHandles_MenuFunction" ("unknown MenuId: " +++ toString menu_id);
  131.  
  132. SubMenuHandles_MenuFunction :: !MenuId !Int ![MenuHandle s] -> (!Bool, !MenuFunction s (IOState s));
  133. SubMenuHandles_MenuFunction menu_id item_nr [SubMenuItemHandle handle id mac_id items : handles]
  134. |    menu_id == mac_id    = MenuElements_MenuFunction item_nr items;
  135. |    not in_here            = SubMenuHandles_MenuFunction menu_id item_nr handles;
  136.                         = in_here_f;
  137.     where {
  138.         (in_here, f)= in_here_f;
  139.         in_here_f    = SubMenuHandles_MenuFunction menu_id item_nr items;
  140.     };
  141. SubMenuHandles_MenuFunction menu_id item_nr [MenuItemGroupHandle id items : handles]
  142.     =     SubMenuHandles_MenuFunction menu_id item_nr (Concat items handles);
  143. SubMenuHandles_MenuFunction menu_id item_nr [MenuRadioItemsHandle items : handles]
  144.     =     SubMenuHandles_MenuFunction menu_id item_nr (Concat items handles);
  145. SubMenuHandles_MenuFunction menu_id item_nr [item_handle : handles]
  146.     =     SubMenuHandles_MenuFunction menu_id item_nr handles;
  147. SubMenuHandles_MenuFunction menu_id item_nr handles = (False, LazyMenuFunction);
  148.         
  149. MenuElements_MenuFunction :: !Int ![MenuHandle s] -> (!Bool, !MenuFunction s (IOState s));
  150. MenuElements_MenuFunction 1 [MenuItemHandle         _ _ f    : _] = (True, f);
  151. MenuElements_MenuFunction 1 [CheckMenuItemHandle _ _ f    : _] = (True, f);
  152. MenuElements_MenuFunction 1 [MenuSeparatorHandle        : _] = (False,LazyMenuFunction);
  153. MenuElements_MenuFunction v [MenuItemGroupHandle _ items : handles]
  154.     =     MenuElements_MenuFunction v (Concat items handles);
  155. MenuElements_MenuFunction v [MenuRadioItemsHandle items : handles]
  156.     =     MenuElements_MenuFunction v (Concat items handles);
  157. MenuElements_MenuFunction v [_ : handles]
  158.     =     MenuElements_MenuFunction (dec v) handles;
  159. MenuElements_MenuFunction v _
  160.     =    MenuInternalError "MenuElements_MenuFunction" ("illegal index value v: " +++ toString v);
  161.  
  162. LazyMenuFunction :: *s (IOState *s) -> (*s, IOState *s);
  163. LazyMenuFunction s ioState = (s, ioState);
  164.  
  165. SplitMenuHandle    :: !(MenuHandle s) !Int -> (![MenuHandle s], !MenuHandle s);
  166. SplitMenuHandle (PullDownHandle handle id mac_id able items) number
  167.     =    (back_items, PullDownHandle handle id mac_id able front_items);
  168.     where {
  169.         (front_items, back_items) = SplitMenuElements items number;
  170.     };
  171. SplitMenuHandle (SubMenuItemHandle handle id mac_id items) number
  172.     =    (back_items, SubMenuItemHandle handle id mac_id front_items);
  173.     where {
  174.         (front_items, back_items) = SplitMenuElements items number;
  175.     };
  176. SplitMenuHandle handle _ = ([], handle);
  177.  
  178. SplitMenuElements :: ![MenuHandle s] !Int -> (![MenuHandle s], ![MenuHandle s]);
  179. SplitMenuElements items=:[h : hs] n
  180. |    n < 1    = ([], items);
  181.             = ([h : front_hs], back_hs);
  182.     where {
  183.         (front_hs, back_hs) = SplitMenuElements hs (dec n);
  184.     }; 
  185. SplitMenuElements _ _ = ([], []);
  186.  
  187.  
  188. /*    CheckItemTitle transforms the item-title when it's empty or when it begins
  189.     with a hyphen. */
  190.  
  191. CheckItemTitle    :: !String -> String;
  192. CheckItemTitle "" = " ";
  193. CheckItemTitle str
  194.     | str.[0]  <> '-'    
  195.         = str;
  196.         = str := (0,'\320');
  197.