home *** CD-ROM | disk | FTP | other *** search
/ Club Amiga de Montreal - CAM / CAM_CD_1.iso / files / 144.lha / Gadgets_Forth / sb.f < prev    next >
Text File  |  1986-11-20  |  2KB  |  64 lines
  1. \ ---------------------------------------------------
  2. \ SimpleBorder.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. These words allocate and define Borders and coordinates pairs.
  13.  
  14. For use with words StringGadget, IntegerGadget and
  15.    TextBoolGadget.
  16. }
  17. \ ---------------------------------------------------
  18.  
  19. Find GDefault_F not
  20. Iftrue
  21.   include GDefault.f
  22. Ifend
  23.  
  24. Find SimpleBorder_f not
  25. Iftrue
  26. cr ." loading SimpleBorder.f..." cr  decimal
  27.  
  28. anew SimpleBorder_f
  29.  
  30. \ create appropriate PairData
  31.  
  32.     Create SimpleBdPdTight    \ tight around the select box
  33.     5 w,    \ 5 pairs defined
  34.     paABS w,    -1 w,    paABS w,    -1 w,
  35.     paWidth+ w,     0 w,    paABS w,    -1 w,
  36.     paWidth+ w,     0 w,    paHeight+ w,     0 w,
  37.     paABS w,    -1 w,    paHeight+ w,     0 w,
  38.     paABS w,    -1 w,    paABS w,    -1 w,
  39.  
  40.     Create SimpleBdPdSlack    \ slack around the select box
  41.     5 w,    \ 5 pairs defined
  42.     paABS w,    -3 w,    paABS w,    -2 w,
  43.     paWidth+ w,     3 w,    paABS w,    -2 w,
  44.     paWidth+ w,     3 w,    paHeight+ w,     1 w,
  45.     paABS w,    -3 w,    paHeight+ w,     1 w,
  46.     paABS w,    -3 w,    paABS w,    -2 w,
  47.  
  48. \ very simple box.  Nice for 320x200 or 640x400.
  49.  
  50. : SimpleBorder  ( Gadget -- Gadget )
  51.     1 needed ?exec        \ check stack depth and exec state
  52.     0 locals| bdStruct Gstruct |
  53.     myFrontPen AllotBorder to bdStruct
  54.     bdStruct Gstruct  +ggGadgetRender R!
  55.     bdStruct
  56.        Gstruct STRGADGET?
  57.         if   SimpleBdPdSlack      \ slack around string gadget
  58.         else SimpleBdPdTight then \ tight around other types
  59.        Gstruct AllotPairs
  60.     Gstruct ; immediate
  61.  
  62. Ifend
  63.  
  64.