home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Environments / Clean 1.2.4 / IOInterface / sliderBar.icl < prev    next >
Encoding:
Modula Implementation  |  1997-04-23  |  6.4 KB  |  205 lines  |  [TEXT/3PRM]
  1. implementation module sliderBar;
  2.  
  3.  
  4. /*    General Slider Bar implementation. */
  5.  
  6.  
  7. import StdClass;
  8. import StdInt, StdString, StdChar, StdBool;
  9. import deltaDialog, deltaEventIO, deltaTimer, deltaFont, deltaPicture, deltaSystem;
  10. import commonDef;
  11.  
  12.  
  13. ::    SliderDirection    =    Horizontal | Vertical;
  14. ::    SliderMax         :==    Int;
  15. ::    SliderPos        :==    Int;
  16.  
  17.  
  18. SliderW        :==    9;
  19. SliderH        :==    20;
  20. SliderM        :==    4;
  21. FrameTop    :==    8;
  22. FrameBot    :==    12;
  23. MinDelta    :==    -10;
  24. MaxDelta    :==    10;
  25.  
  26.  
  27. SliderBarError :: String String Int -> * x;
  28. SliderBarError rule message id
  29.     =    Error rule "sliderBar" (message +++ " (item id = " +++ toString id +++ ")");
  30.  
  31. //
  32. //    The SliderBar item definition.
  33. //
  34.  
  35. SliderBar    ::    !DialogItemId !ItemPos !SelectState !SliderDirection !SliderPos !SliderMax
  36.                 !(DialogFunction s (IOState s))
  37.             ->    DialogItem s (IOState s);
  38. SliderBar id pos select dir=:Horizontal sPos sMax dialogF
  39.     =    Control id pos ((-1,0), (sMax` + inc SliderW,SliderH)) select cState
  40.                (SliderLook dir) (SliderFeel dir) (SliderDFunc id dialogF);
  41.     where {
  42.         cState    = IntCS (1000 * sMax` + sPos`);
  43.         sPos`    = SetBetween sPos 0 sMax`;
  44.         sMax`    = SetBetween sMax 0 999;
  45.     };
  46. SliderBar id pos select dir=:Vertical sPos sMax dialogF
  47.     =    Control id pos ((0,-1),(SliderH,sMax` + inc SliderW)) select cState
  48.                (SliderLook dir) (SliderFeel dir) (SliderDFunc id dialogF);
  49.     where {
  50.         cState    = IntCS (1000 * sMax` + sPos`);
  51.         sPos`    = SetBetween sPos 0 sMax`;
  52.         sMax`    = SetBetween sMax 0 999;
  53.     };
  54.  
  55.  
  56. /*    The ControlLook of the slider bar. */
  57.  
  58. SliderLook :: !SliderDirection !SelectState !ControlState -> [DrawFunction];
  59. SliderLook dir select cState
  60. |    IsHorizontal dir
  61.     =    [DrawRectangle ((-1,FrameTop),(sMax + inc SliderW,FrameBot)) : DrawHorSlider select sPos];
  62.     =    [DrawRectangle ((FrameTop,-1),(FrameBot,sMax + inc SliderW)) : DrawVerSlider select sMax sPos];
  63.     where {
  64.         sMax = GetSliderMax cState;
  65.         sPos = GetSliderPos cState;
  66.     };
  67.  
  68. DrawHorSlider :: !SelectState !SliderPos -> [DrawFunction];
  69. DrawHorSlider select sPos
  70. |    not (Enabled select)
  71.     =    [erase, draw];
  72.     =    [erase, draw, MovePenTo (lineX,3), LinePen (0,SliderH - 7)];
  73.     where {
  74.         erase    = EraseRectangle ((sPos, FrameTop), (send, FrameBot));
  75.         draw    = DrawRectangle ((sPos, 0), (send, SliderH));
  76.         send    = sPos + SliderW;
  77.         lineX    = sPos + SliderM;
  78.     };
  79.  
  80. DrawVerSlider :: !SelectState !SliderMax !SliderPos -> [DrawFunction];
  81. DrawVerSlider select sMax sPos
  82. |    not (Enabled select)
  83.     =    [erase, draw];
  84.     =    [erase, draw, MovePenTo (3,lineY), LinePen (SliderH - 7,0)];
  85.     where {
  86.         erase    = EraseRectangle ((FrameTop, sPos`), (FrameBot, send));
  87.         draw    = DrawRectangle ((0, sPos`), (SliderH, send));
  88.         send    = sPos` + SliderW;
  89.         lineY    = sPos` + SliderM;
  90.         sPos`    = sMax - sPos;
  91.     };
  92.  
  93.  
  94. /*    The ControlFeel of the slider bar. */
  95.  
  96. SliderFeel :: !SliderDirection !MouseState !ControlState -> (!ControlState, ![DrawFunction]);
  97. SliderFeel dir (pos, ButtonUp, mods) cState
  98.     =    (SetSliderChanged False cState, []);
  99. SliderFeel Horizontal ((x,y), buttonDown, mods) cState
  100. |    mX == sPos`    =    (SetSliderChanged False cState, []);
  101.                 =    (SetSliderChanged True  cState`, MoveHorSlider sMax sPos` sPos``);
  102.     where {
  103.         mX        = SetBetween (x - SliderM) 0 sMax;
  104.         sPos`    = GetSliderPos cState;
  105.         sMax    = GetSliderMax cState;
  106.         cState`    = SetSliderPos sPos`` cState;
  107.         sPos``    = sPos` + SetBetween (mX - sPos`) MinDelta MaxDelta;
  108.     };
  109. SliderFeel Vertical ((x,y), buttonDown, mods) cState
  110. |    mY == sPos`    =    (SetSliderChanged False cState, []);
  111.                 =    (SetSliderChanged True  cState`, MoveVerSlider sMax sPos` sPos``);
  112.     where {
  113.         mY        = SetBetween (y - SliderM) 0 sMax;
  114.         sPos`    = sMax - GetSliderPos cState ;
  115.         sMax    = GetSliderMax cState;
  116.         cState`    = SetSliderPos (sMax - sPos``) cState;
  117.         sPos``    = sPos` + SetBetween (mY - sPos`) MinDelta MaxDelta ;
  118.     };
  119.  
  120. MoveHorSlider :: !Int !Int !Int -> [DrawFunction];
  121. MoveHorSlider sMax oldX newX
  122. |    newX > oldX    =    [move, DrawRectangle ((-1,FrameTop), (inc newX, FrameBot))];
  123.                 =    [move, DrawRectangle ((newX+dec SliderW, FrameTop), (sMax+inc SliderW,FrameBot))];
  124.     where {
  125.         move = MoveRectangle ((oldX,0), (oldX + SliderW,SliderH)) (newX - oldX, 0);
  126.     };
  127.  
  128. MoveVerSlider :: !Int !Int !Int -> [DrawFunction];
  129. MoveVerSlider sMax oldY newY
  130. |    newY > oldY    =    [move, DrawRectangle ((FrameTop,-1), (FrameBot,inc newY))];
  131.                 =    [move, DrawRectangle ((FrameTop,newY+dec SliderW), (FrameBot,sMax+inc SliderW))];
  132.     where {
  133.         move = MoveRectangle ((0, oldY), (SliderH, oldY + SliderW)) (0, newY - oldY);
  134.     };
  135.  
  136.  
  137. /*    The DialogFunction of the slider bar. */
  138.  
  139. SliderDFunc ::    !DialogItemId !(DialogFunction s (IOState s))
  140.                 !DialogInfo !(DialogState s (IOState s))
  141.             ->    DialogState s (IOState s);
  142. SliderDFunc id dialogF info dState
  143. |    SliderChanged (GetControlState id info)    = dialogF info dState;
  144.                                             = dState;
  145.  
  146. GetControlStateFromSlider :: !ControlState -> (!Bool, !ControlState);
  147. GetControlStateFromSlider cState=:(IntCS state)    = (True, cState); 
  148. GetControlStateFromSlider _                        = (False, IntCS 0);
  149.  
  150.  
  151. //
  152. //    The function to move the slider explicitly.
  153. //
  154.  
  155. ChangeSliderBar    :: !DialogItemId !SliderPos !(DialogState s (IOState s))
  156.                 ->    DialogState s (IOState s);
  157. ChangeSliderBar id sPos dState
  158. |    isSlider    = ChangeControlState id (SetSliderPos sPos` cState) dState`;
  159.                 = SliderBarError "ChangeSliderBar" "Item is not a SliderBar" id;
  160.     where {
  161.         sPos`                = SetBetween sPos 0 (GetSliderMax cState);
  162.         (isSlider, cState)    = GetControlStateFromSlider (GetControlState id info);
  163.         (info, dState`)        = DialogStateGetDialogInfo dState;
  164.     };
  165.  
  166.  
  167. //
  168. //    The function to retrieve the position of the slider.
  169. //
  170.  
  171. GetSliderPosition :: !DialogItemId !DialogInfo -> SliderPos;
  172. GetSliderPosition id info
  173. |    isSlider    = GetSliderPos cState;
  174.                 = SliderBarError "GetSliderPosition" "Item is not a SliderBar" id;
  175.     where {
  176.         (isSlider, cState) = GetControlStateFromSlider (GetControlState id info);
  177.     };
  178.  
  179.  
  180. //
  181. //    Access function to the ControlState of the slider bar.
  182. //
  183.  
  184. SliderChanged :: !ControlState -> Bool;
  185. SliderChanged (IntCS state) = state > 1000000;
  186.  
  187. SetSliderChanged :: !Bool !ControlState -> ControlState;
  188. SetSliderChanged changed (IntCS state)
  189. |    changed        && state < 1000000    = IntCS (state+1000000);
  190. |    not changed && state > 1000000    = IntCS (state-1000000);
  191.                                     = IntCS state;
  192.  
  193. GetSliderPos :: !ControlState -> SliderPos;
  194. GetSliderPos (IntCS state) = state mod 1000;
  195.  
  196. SetSliderPos :: !SliderPos !ControlState -> ControlState;
  197. SetSliderPos pos (IntCS state) = IntCS (state-state mod 1000+pos);
  198.  
  199. GetSliderMax :: !ControlState -> SliderMax;
  200. GetSliderMax (IntCS state) = (state mod 1000000) / 1000;
  201.  
  202. IsHorizontal :: !SliderDirection -> Bool;
  203. IsHorizontal Horizontal = True;
  204. IsHorizontal vertical   = False;
  205.