home *** CD-ROM | disk | FTP | other *** search
/ Club Amiga de Montreal - CAM / CAM_CD_1.iso / files / 144.lha / Gadgets_Forth / cb.f < prev    next >
Text File  |  1986-11-20  |  3KB  |  109 lines
  1. \ ---------------------------------------------------
  2. \ CheckBoxBorder.f
  3. \ ---------------------------------------------------
  4. {  TBG.f and CSG.f Version 1.0
  5.    Text Boolean Gadgets and String/Integer gadget creation helper.
  6.  
  7.    by Marc Lupien,  Montreal, Canada.
  8.    June of 1988
  9.    CIS user no. 71550,640
  10. }
  11. { 
  12. This word allocate and define Borders and Coordinate pairs
  13.    for a gadget.  Space is allocated in the dictionnary.
  14.  
  15. For use with TextBoolGadget defining word.
  16.     C.F file TBG.f
  17.  
  18. A check box border is used with ToggleSelect gadgets.
  19.   The design looks like a small square left of a text. 
  20.   The box is either empty or contains a small cross
  21.   indicating that the gadget is selected or not.
  22.  
  23. This word will force a TextBoolGadget to be of type TOGGLESELECT.
  24.  
  25. Note also that with this border, you can't change the color of the
  26. borders by using the myFrontPen and myHighlightPen global vars...
  27. }
  28. \ ---------------------------------------------------
  29.  
  30. Find GDefault_F not
  31. Iftrue
  32.   include GDefault.f
  33. Ifend
  34.  
  35. Find CheckBoxBorder_f not
  36. Iftrue
  37. cr ." loading CheckBoxBorder.f..." cr  decimal
  38.  
  39. anew CheckBoxBorder_f
  40.  
  41. \ create appropriate PairData
  42.  
  43.     15 constant xx
  44.      7 constant yy
  45.  
  46.     Create CheckBoxPairs    \ 5 pairs
  47.      0 w,  0 w,
  48.     xx w,  0 w,
  49.     xx w, yy w,
  50.      0 w, yy w,
  51.      0 w,  0 w,
  52.  
  53.     Create CheckCrossPairs    \ 4 pairs
  54.      0 w,  0 w,
  55.     xx w, yy w,
  56.      0 w, yy w,
  57.     xx w,  0 w,
  58.  
  59.     \ This border draws a black box
  60.     Create CBoxbd
  61.      -25 w,            \ +bdLeftEdge
  62.        2 w,            \ +bdTopEdge
  63.        1 c,            \ +bdFrontPen
  64.        0 c,            \ +bdBackPen
  65.     JAM1 c,            \ +bdDrawMode
  66.        5 c,            \ +bdCount
  67.     CheckBoxPairs R,    \ +bdXY
  68.        0 ,            \ +bdNextBorder
  69.  
  70.     \ This border erase the cross in the box
  71.     \ and then redraws the black box
  72.     Create CheckBoxOffbd
  73.      -25 w,            \ +bdLeftEdge
  74.        2 w,            \ +bdTopEdge
  75.        0 c,            \ +bdFrontPen
  76.        0 c,            \ +bdBackPen
  77.     JAM1 c,            \ +bdDrawMode
  78.        4 c,            \ +bdCount
  79.     CheckCrossPairs R,    \ +bdXY
  80.     CBoxbd R,        \ +bdNextBorder
  81.  
  82.     \ This border draws the cross in the box
  83.     \ and then draws the black box
  84.     Create CheckBoxOnbd
  85.      -25 w,            \ +bdLeftEdge
  86.        2 w,            \ +bdTopEdge
  87.        1 c,            \ +bdFrontPen
  88.        0 c,            \ +bdBackPen
  89.     JAM1 c,            \ +bdDrawMode
  90.        4 c,            \ +bdCount
  91.     CheckCrossPairs R,    \ +bdXY
  92.     CBoxbd R,        \ +bdNextBorder
  93.  
  94. axe xx  axe yy  axe CBoxbd
  95.  
  96. : CheckBoxBorder  ( Gadget -- Gadget )
  97.     1 needed ?exec        \ check stack depth and exec state
  98.     0 locals| bdStruct Gstruct |
  99.     Gstruct STRGADGET?
  100.        error" ERROR!!! CheckBox cannot be used with String gadgets"
  101.     GADGHIMAGE Gstruct +ggFlags w!    \ use alternate image
  102.     RELVERIFY TOGGLESELECT |    \ change the style
  103.         Gstruct +ggActivation w!
  104.     CheckBoxOffbd Gstruct  +ggGadgetRender R!
  105.     CheckBoxOnbd  Gstruct  +ggSelectRender R!
  106.     Gstruct ; immediate
  107.  
  108. Ifend
  109.