aUCBLogo Demos and Tests / buttons

;;; Primitive GUI for Logo games.

;;; Displays buttons, then accepts mouseclicks or keystrokes
;;; to control actions.

;;; To clear the screen and all the remembered buttons:
;;;   init.buttons

;;; To install a button:
;;;   SETBUTTON [150 130] [40 25] [make "mysecret "true throw "newgame] ~
;;;             :mysecret 0 [Logo guess] []
;;;
;;; Inputs are:
;;;   1. Position of lower left corner of button
;;;   2. Size [x y] of button
;;;   3. Action to take if button pressed
;;;   4. TRUE if box should be drawn thick, FALSE if thin
;;;   5. Color to fill box (0 if no fill)
;;;   6. Text caption inside button (a word or a two-word list for
;;;        a two-line caption) or empty list for no caption
;;;   7. Equivalent keystroke (empty list if no equivalent keystroke)
;;;        (DEL means char 8 or 127; RET means char 10 or 13)
;;;        (Keystroke inside list, e.g., [X], means don't draw it.)

;;; REBUTTON (same inputs as SETBUTTON) looks for existing matching button
;;; and, if found, just redraws border (possibly changing thickness).

;;; To display a descriptive caption (e.g., for a group of buttons)
;;; without making a button:
;;;   CAPTION [150 130] [40 25] [Number of boxes:]
;;;   CENTER.CAPTION [150 130] [40 25] [Number of boxes:]
;;;
;;; Inputs are position, size, caption.
;;; CENTER.CAPTION centers the text within the box; CAPTION puts it
;;; at the left edge of the box.

;;; To loop reading keystrokes or mouseclicks and taking actions as set:
;;;   ACTION.LOOP
;;; Within an action, :CHAR is the character typed (or zero if the action
;;; was triggered by a mouse click), :BUTTON is the mouse button pressed
;;; (or zero if the action was triggered by a keystroke), and :MOUSEPOS is
;;; the mouse position (or unspecified for a keystroke).  Actions triggered
;;; by a mouse click happen when the mouse button is released.

; -----------------------------

;;; IMPORTANT:  Here is how we know the size of a text character as
;;; drawn by the LABEL command.  Change these numbers if necessary:

make "labelcharsize ifelse equalp LogoVersion.3 "Windows [[8 13]] [[6 11]]

; -----------------------------

to buttons
end

to init_buttons
   cs ht
   setLabelAlign 0 0
   make "buttons_ []
end

; -----------------------------

to setbutton :corner :size :action :thickp :fillcolor :caption_ :key
   pu setpos :corner
   seth 0
   pd setpensize ifelse :thickp [[3 3]] [[1 1]]
   setpc 7
   apply "button_rectangle :size
   setpensize [1 1]
   if not equalp :fillcolor 0
   [   setfc :fillcolor
      fillRect pensize/2 size-pensize
      setpc 7
   ]
   center_caption :corner :size :caption_
   if (and (not listp :key) (not emptyp :key) (not equalp :key :caption_))
   [   caption (list (sum first :corner first :size 4) last :corner+size/2) ~
            :size
            :key
   ]
   if and (listp :key) (not emptyp :key) [make "key first :key]
   push "buttons_ (list :corner :size :key :action)
end

to rebutton :corner :size :action :thickp :fillcolor :caption_ :key
   localmake "thekey :key
   if and listp :key not emptyp :key [make "thekey first :key]
   localmake "test_ (list :corner :size :thekey :action)
   localmake "button_ find [equalp ? :test_] :buttons_
   if emptyp :button_ ~
      [setbutton :corner :size :action :thickp :fillcolor :caption_ :key  stop]
   penup setpos :corner
   seth 0
   setpc 7
   penerase setpensize [3 3]
   apply "button_rectangle :size
   penpaint setpensize ifelse :thickp [[3 3]] [[1 1]]
   apply "button_rectangle :size
   setpensize [1 1]
end

to button_offset :corner :dx :dy
   penup setxy (first :corner)+:dx (last :corner)+:dy
end

to button_rectangle :x :y
   repeat 2 [fd :y rt 90 fd :x rt 90]
end

; -----------------------------

to caption :corner :size :caption_
   if emptyp :caption_ [stop]
   local [ls]
   ls=LabelSize caption_
   setpc 7
   ifelse listp :caption_
   [   button_offset :corner (first ls)/2 (first bf ls)/2
      seth 90 label last :caption_
      button_offset :corner (first ls)/2 -(first bf ls)/2
      seth 90 label first :caption_
   ][
      button_offset :corner (first ls)/2 0
      seth 90 label :caption_
   ]
end

to center_caption :corner :size :caption_
   if emptyp :caption_ [stop]
   setpc 7
   ifelse listp :caption_
   [   button_offset :corner (first :size)/2 (last :size)/4
      seth 90 label last :caption_
      button_offset :corner (first :size)/2 (last :size)*3/4
      seth 90 label first :caption_
   ][
      button_offset corner (first size)/2 (last size)/2
      seth 90 label :caption_
   ]
end

; -----------------------------

to action_loop
   forever [action_once]
end

to action_once
   if keyp [button_readkey]
   if MouseButtons != 0 [button_mouseclick]
   dispatchMessages
end

to button_readkey [:char_ rc] [:button_ 0]
   foreach :buttons_ [
     localmake "key item 3 ?
     ifelse equalp :key "DEL [
      if memberp (ascii :char_) [8 127] [run last ? stop]
     ] [
      ifelse equalp :key "RET [
        if memberp (ascii :char_) [10 13] [run last ? stop]
      ] [
        if equalp :char_ :key [run last ? stop]
      ]
     ]
   ]
end

to button_mouseclick [:mousepos_ mousepos] [:button_ mouseButtons] [:char_ 0]
   while [mouseButtons != 0] []   ; wait for release of button_
   foreach :buttons_
   [   if apply "button_inrange ? [run last ? stop]
   ]
end

to button_inrange :corner :size :key :action
   (foreach bl :mousepos_ :corner :size
   [   if ?1 < ?2 [output false]
      if ?1 > (?2 + ?3) [output false]
   ])
   output true
end