home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 4 / Apprentice-Release4.iso / Languages / Mops 2.7 / Mops source / Module source / DialogMod.txt < prev    next >
Encoding:
Text File  |  1995-02-27  |  4.3 KB  |  185 lines  |  [TEXT/MSET]
  1. \ Dialog class.
  2.  
  3. \ July 91  mrh    Moved to a module, and migrated some methods from Dialog+.
  4. \ Jan  95  mrh  Removed CALLER - can't bind to a word name any more
  5.  
  6.  
  7. \ Class Dialog handles modal dialogs.  For modeless dialogs, use the
  8. \ subclass Dialog+.
  9.  
  10. :class    DIALOG    super{ x-array }
  11. record
  12. {    int        RESID
  13.     ptr        DLGPTR
  14.     var        PROCPTR
  15.     int        BOLDITEM
  16. }
  17.  
  18. :m DLGPTR:
  19.     inline{ get: dlgPtr}
  20.     get: dlgPtr  ;m
  21.  
  22. :m CLOSE:
  23.     nil?: dlgPtr  ?EXIT
  24.     get: dlgPtr  call DisposDialog
  25.     clear: dlgPtr  ;m
  26.  
  27. :m OPEN?:
  28.     nil?: dlgPtr  ;m
  29.  
  30. :m ITEMHANDLE:  { item# -- hndl }
  31.     get: dlgPtr  item# makeInt
  32.     addr: itemType  addr: itemHandle  addr: tempRect
  33.     call GetDItem  get: itemHandle  ;m
  34.  
  35. :m DRAWBOLD:
  36.     nil?: dlgPtr  ?EXIT
  37.     get: boldItem  ?dup  0EXIT
  38.     savePort
  39.     get: dlgPtr  call setPort  3 3 pack  call Pensize
  40.     itemHandle: self  drop            \ Sets up tempRect
  41.     -4 -4 inset: tempRect
  42.     addr: tempRect  16 16 pack  call FrameRoundRect  call PenNormal
  43.     restPort  ;m
  44.  
  45. :m GETNEW:
  46.     0  int: resid  0  -1  call GetNewDialog  put: dlgPtr
  47.     drawBold: self  ;m
  48.  
  49.  
  50. :m SETPROC:        \ ( xt -- )  set dialog proc
  51.     put: procPtr  ;m
  52.  
  53. :m MODAL:
  54.     BEGIN
  55.         get: procPtr  addr: theItem  call ModalDialog
  56.         get: theItem 1- exec: super
  57.         rtm  false -> rtm
  58.     NUNTIL  ;m
  59.  
  60.  
  61. :m PUTITEM:        \ ( val item# -- )
  62.     itemHandle: self  swap makeint  call SetCtlValue  ;m
  63.  
  64. :m GETITEM:        \ ( item# -- val )  Gets value for an item#
  65.     itemHandle: self  >r  word0  r>
  66.     call GetCtlValue  word0  ;m
  67.  
  68. :m PUTRESID:    \ ( resID -- )
  69.     put: resID  ;m
  70.  
  71. :m INIT:    \ ( xt1 ... xtN N resID -- )
  72.     put: resID  put: super  ;m
  73.  
  74. :m SETBOLD:    \ ( item# -- )  Causes bold outline of the specified item
  75.     put: boldItem  ;m
  76.  
  77. :m GETTEXT:    \ ( item# -- addr len )  Returns a text item's text
  78.     itemHandle: self  buf255  get: ItemType 24 and
  79.     IF  call GetIText  ELSE  call GetCTitle  THEN
  80.     buf255 count  ;m
  81.  
  82. :m PUTTEXT: { addr len item# -- }  \ Stores an item's text
  83.     item#  itemHandle: self
  84.     addr len str255   get: ItemType 24 and
  85.     IF  call SetIText  ELSE  call SetCTitle  THEN  ;m
  86.  
  87. :m SETSELECT:  { start end item# -- }
  88.         \ Sets the selection range for text item
  89.     get: dlgPtr
  90.     item# makeInt start end pack  call SeliText  ;m
  91.  
  92. :m DRAW:    \ Forces drawing of dialog before going to modal:
  93.     get: dlgPtr  call DrawDialog  ;m
  94.  
  95.  
  96. \    ====== Extra methods for manipulating dialog items ======
  97.  
  98.  
  99. :m HIDEITEM:    \ ( item# -- )
  100.     get: dlgPtr  swap makeInt  call HideDItem  ;m
  101.  
  102. :m SHOWITEM:    \ ( item# -- )
  103.     get: dlgPtr  swap makeInt  call ShowDItem  ;m
  104.  
  105. :m DISABLEITEM:    \ ( item# -- )
  106.     itemHandle: self  w 254  call HiliteControl  ;m
  107.  
  108. :m ENABLEITEM:    \ ( item# -- )
  109.     itemHandle: self  word0  call HiliteControl  ;m
  110.  
  111. :m SETUSERPROC:  { ^proc item# -- }
  112.     get: dlgPtr  item# makeint
  113.     addr: itemType  addr: itemHandle  tempRect
  114.     call GetDitem
  115.     get: dlgPtr  item# makeint  word0  ^proc  tempRect
  116.     call SetDitem  ;m
  117.  
  118.  
  119. :m HITBOLD:
  120.     get: boldItem  dup  NIF  drop  EXIT  THEN
  121.     1-  exec: self  ;m
  122.  
  123. :m KEY:        \ ( -- b )
  124.         \ Called when a key down event occurs with this dialog's
  125.         \ window active.  Returns false if we've handled the key
  126.         \ here, so no further action is required.  Subclasses can
  127.         \ have customized KEY: methods; here we just provide a
  128.         \ hopefully sensible default action - namely, we treat a
  129.         \ Return or Enter as a click on the bold item, and ignore
  130.         \ all other keys.
  131.  
  132.     msg: fEvent  $ FF and  ( char typed )
  133.     dup 3 =  swap RET =  or
  134.     IF    \ Return or Enter typed - treat as click on bold item
  135.         hitBold: self  false  EXIT
  136.     THEN
  137.     true  ;m
  138.  
  139. :m TITLE:    \ ( addr len -- )
  140.     str255
  141.     get: dlgPtr  swap  call SetWTitle  ;m
  142.  
  143. :m MAXX:    \ ( -- x )
  144.     get: dlgPtr  maxX: window  ;m
  145.  
  146. :m MAXY:
  147.     get: dlgPtr  maxY: window  ;m
  148.  
  149. :m MOVE:    \ ( x y -- )
  150.     get: dlgPtr  move: window  ;m
  151.  
  152. :m CENTER:
  153.     get: dlgPtr  center: window  ;m
  154.  
  155. \            =================
  156.  
  157. :m SHOW:
  158.     get: dlgPtr  call ShowWindow  ;m
  159.  
  160. :m HIDE:
  161.     get: dlgPtr  call HideWindow  ;m
  162.  
  163. :m SELECT:
  164.     get: dlgPtr  call SelectWindow  ;m
  165.  
  166.  
  167. :m CLASSINIT:    \ Initializes default handlers to close the dialog box.
  168.     ['] closer  fill: self  ;m
  169.  
  170. ;class
  171.  
  172.  
  173. : TOGITEM    \ Toggles the check box or radio button
  174. \    get: theItem  1 over  caller getitem: []  -  swap  caller putitem: []
  175.     get: theItem  1 over  ^base getitem: []  -  swap  ^base putitem: []
  176.     returnToModal  ;
  177.  
  178.  
  179. : PARAMTEXT ( addr0 len0 addr1 len1 addr2 len2 addr3 len3 ) { \ p1 p2 p3 -- }
  180.         \ Substitutes Dialog text.
  181.      str255 dup -> p3  count +
  182.     >str255 dup -> p2  count +
  183.     >str255 dup -> p1  count +
  184.     >str255  p1 p2 p3  call ParamText  ;
  185.