(DEFINE-FILE-INFO PACKAGE "ROOMS" READTABLE "XCL")

(IL:FILECREATED " 5-Dec-2020 16:37:08" 
IL:|{DSK}<Users>arunwelch>SKYDRIVE>DOCUMENTS>UNIX>LISP>LDE>ROOMS>MEDLEY-35>TOUCHY-BUTTONS.;2|
 7138   

      IL:|previous| IL:|date:| "17-Aug-90 14:46:54" 
IL:|{DSK}<Users>arunwelch>SKYDRIVE>DOCUMENTS>UNIX>LISP>LDE>ROOMS>MEDLEY-35>TOUCHY-BUTTONS.;1|)


; Copyright (c) 1987, 1988, 1990, 2020 by Venue & Xerox Corporation.  All rights reserved.

(IL:PRETTYCOMPRINT IL:TOUCHY-BUTTONSCOMS)

(IL:RPAQQ IL:TOUCHY-BUTTONSCOMS

          (
           (IL:* IL:|;;| "Includer buttons so you can have dynamic mixin rooms.  For example, you can have a \"Notecards-Mixin\" or \"Programming-Mixin\" Room and have buttons to include these in \"Pockets\"  then whenever you need these facilities you can mix them in.")


           (IL:FUNCTIONS MAKE-INCLUDER INCLUDER-TEXT INCLUDER-ACTION)
           
           (IL:* IL:|;;| "Toggle buttons for switching between variable settings.  This should obviously be generalized to something that allows you to select or circulate through value settings.")


           (IL:FUNCTIONS MAKE-TOGGLER MAKE-N-VALUER MAKE-EXSET-TOGGLER MAKE-RANGE-TOGGLER 
                  N-VALUER-ACTION N-VALUER-TEXT CHECK-EVAL)
           (IL:FUNCTIONS MAKE-SWITCH SWITCH-ACTION)
           
           (IL:* IL:|;;| "")


           
           (IL:* IL:|;;| 

         "(MAKE-ONCE-ONLY (IL:PROMPTPRINT \"Hello, World\") \"Fire...\" \"Exhausted\")")


           (IL:FUNCTIONS MAKE-ONCE-ONLY ONCE-ONLY-ACTION ONCE-ONLY-TEXT)
           (IL:DECLARE\: IL:DONTCOPY (IL:PROPS (IL:TOUCHY-BUTTONS IL:MAKEFILE-ENVIRONMENT)
                                            (IL:TOUCHY-BUTTONS IL:FILETYPE)))))



(IL:* IL:|;;| 
"Includer buttons so you can have dynamic mixin rooms.  For example, you can have a \"Notecards-Mixin\" or \"Programming-Mixin\" Room and have buttons to include these in \"Pockets\"  then whenever you need these facilities you can mix them in."
)



(DEFUN MAKE-INCLUDER
 (ROOM-NAME)
   (MAKE-BUTTON-WINDOW (MAKE-BUTTON :TEXT-FORM (LIST 'INCLUDER-TEXT ROOM-NAME)
                              :ACTION
                              'INCLUDER-ACTION :INCLUDER-ROOM-NAME ROOM-NAME)))

(DEFUN INCLUDER-TEXT
 (INCLUDER-ROOM-NAME)
   (LET ((INCLUSIONS (ROOM-INCLUSIONS *CURRENT-ROOM*)))
        (IF (LISTP INCLUSIONS)
            (IF (MEMBER INCLUDER-ROOM-NAME INCLUSIONS :TEST #'EQUAL)
                (FORMAT NIL "Exclude ~A" INCLUDER-ROOM-NAME)
                (FORMAT NIL "Include ~A" INCLUDER-ROOM-NAME))
            (FORMAT NIL "*-???-* ~A" INCLUDER-ROOM-NAME))))

(DEFUN INCLUDER-ACTION
 (DSP BUTTON)
   (LET* ((ROOM *CURRENT-ROOM*)
          (INCLUDER-ROOM-NAME (BUTTON-PROP BUTTON :INCLUDER-ROOM-NAME)))
         (UPDATE-PLACEMENTS)
         (IF (MEMBER INCLUDER-ROOM-NAME (ROOM-INCLUSIONS ROOM)
                    :TEST
                    #'EQUAL)
             (SETF (ROOM-INCLUSIONS ROOM)
                   (DELETE INCLUDER-ROOM-NAME (ROOM-INCLUSIONS ROOM)
                          :TEST
                          #'EQUAL))
             (PUSH INCLUDER-ROOM-NAME (ROOM-INCLUSIONS ROOM)))
         (ROOM-CHANGED ROOM :EDITED)))



(IL:* IL:|;;| 
"Toggle buttons for switching between variable settings.  This should obviously be generalized to something that allows you to select or circulate through value settings."
)



(DEFUN MAKE-TOGGLER
 (VARIABLE-NAME &REST KEYS)
   (APPLY #'MAKE-N-VALUER VARIABLE-NAME '(NIL T)
          KEYS))

(DEFUN MAKE-N-VALUER
 (VARIABLE-NAME N-VALUES &REST KEYS)
   (MAKE-BUTTON-WINDOW (APPLY #'MAKE-BUTTON :TEXT-FORM `(N-VALUER-TEXT
 ',VARIABLE-NAME)
                              :ACTION
                              'N-VALUER-ACTION :VARIABLE-NAME VARIABLE-NAME :N-VALUES N-VALUES KEYS)))

(DEFUN MAKE-EXSET-TOGGLER
 (VARIABLE-NAME EXPLICIT-SET &REST KEYS)
   (APPLY #'MAKE-N-VALUER VARIABLE-NAME EXPLICIT-SET :HELP (FORMAT NIL "Set variable ~S" 
                                                                  VARIABLE-NAME)
          KEYS))

(DEFUN MAKE-RANGE-TOGGLER
 (VARIABLE-NAME RANGE-START RANGE-END &REST KEYS)
   (APPLY #'MAKE-N-VALUER VARIABLE-NAME (DO ((I RANGE-START (1+ I))
                                             (ACCUMULATOR NIL ACCUMULATOR))
                                            ((> I RANGE-END)
                                             (NREVERSE ACCUMULATOR))
                                          (PUSH I ACCUMULATOR))
          :HELP
          (FORMAT NIL "Set variable ~S" VARIABLE-NAME)
          KEYS))

(DEFUN N-VALUER-ACTION
 (DSP BUTTON)
   (LET* ((N-VALUES (BUTTON-PROP BUTTON :N-VALUES))
          (VARIABLE-NAME (BUTTON-PROP BUTTON :VARIABLE-NAME)))
         (SETQ N-VALUES (REMOVE (CHECK-EVAL
 VARIABLE-NAME)
                               N-VALUES))
         (SET VARIABLE-NAME (IF (EQ (LENGTH N-VALUES)
                                    1)
                                (CAR N-VALUES)
                                (IL:MENU (IL:CREATE
 IL:MENU
                                                IL:ITEMS IL:_ N-VALUES))))))

(DEFUN N-VALUER-TEXT
 (VARIABLE-NAME)
   (FORMAT NIL "~A is ~a" VARIABLE-NAME (CHECK-EVAL
 VARIABLE-NAME)))

(DEFUN CHECK-EVAL
 (VARIABLE-NAME)
   (IF (BOUNDP VARIABLE-NAME)
       (EVAL VARIABLE-NAME)
       "Unbound"))

(DEFUN MAKE-SWITCH
 (DECISION-FN SET-FN TEXT-FORM &REST KEYS)
   (MAKE-BUTTON-WINDOW (APPLY #'MAKE-BUTTON :TEXT-FORM TEXT-FORM :ACTION 'SWITCH-ACTION :DECISION-FN
                              DECISION-FN :SET-FN SET-FN KEYS)))

(DEFUN SWITCH-ACTION
 (DSP BUTTON)
   (LET* ((VALUE (FUNCALL (BUTTON-PROP BUTTON :DECISION-FN)
                        BUTTON)))
         (FUNCALL (BUTTON-PROP BUTTON :SET-FN)
                BUTTON VALUE)))



(IL:* IL:|;;| "")





(IL:* IL:|;;| "(MAKE-ONCE-ONLY (IL:PROMPTPRINT \"Hello, World\") \"Fire...\" \"Exhausted\")")



(DEFUN MAKE-ONCE-ONLY
 (FORM INITIAL-TEXT FINAL-TEXT)
   (MAKE-BUTTON-WINDOW (MAKE-BUTTON :TEXT INITIAL-TEXT :TEXT-FORM 'ONCE-ONLY-TEXT :ACTION
                              'ONCE-ONLY-ACTION :ONCE-ONLY-FORM FORM :INITIAL-TEXT INITIAL-TEXT 
                              :FINAL-TEXT FINAL-TEXT)))

(DEFUN ONCE-ONLY-ACTION
 (STREAM BUTTON)
   (UNLESS (IL:STREAMPROP (IL:GETSTREAM STREAM)
                  BUTTON)

       (IL:* IL:|;;| "store the state of the button on its host, so that the state is reset each time the button is reconstituted.")


       (EVAL (BUTTON-PROP BUTTON :ONCE-ONLY-FORM))
       (IL:STREAMPROP (IL:GETSTREAM STREAM)
              BUTTON T)))

(DEFUN ONCE-ONLY-TEXT
 (STREAM BUTTON)
   (WHEN STREAM
       (IF (IL:STREAMPROP (IL:GETSTREAM STREAM)
                  BUTTON)
           (BUTTON-PROP BUTTON :FINAL-TEXT)
           (BUTTON-PROP BUTTON :INITIAL-TEXT))))
(IL:DECLARE\: IL:DONTCOPY 

(IL:PUTPROPS IL:TOUCHY-BUTTONS
 IL:MAKEFILE-ENVIRONMENT
 (:PACKAGE "ROOMS" :READTABLE "XCL"))

(IL:PUTPROPS IL:TOUCHY-BUTTONS
 IL:FILETYPE
 :COMPILE-FILE)
)
(IL:PUTPROPS IL:TOUCHY-BUTTONS IL:COPYRIGHT ("Venue & Xerox Corporation" 1987 1988 1990 2020))
(IL:DECLARE\: IL:DONTCOPY
  (IL:FILEMAP (NIL (1998 2231 (MAKE-INCLUDER 1998 . 2231)) (2233 2617 (INCLUDER-TEXT 2233 . 2617)) (2619
 3191 (INCLUDER-ACTION 2619 . 3191)) (3390 3506 (MAKE-TOGGLER 3390 . 3506)) (3508 3801 (MAKE-N-VALUER 
3508 . 3801)) (3803 4060 (MAKE-EXSET-TOGGLER 3803 . 4060)) (4062 4566 (MAKE-RANGE-TOGGLER 4062 . 4566)
) (4568 5108 (N-VALUER-ACTION 4568 . 5108)) (5110 5223 (N-VALUER-TEXT 5110 . 5223)) (5225 5339 (
CHECK-EVAL 5225 . 5339)) (5341 5571 (MAKE-SWITCH 5341 . 5571)) (5573 5783 (SWITCH-ACTION 5573 . 5783))
 (5913 6212 (MAKE-ONCE-ONLY 5913 . 6212)) (6214 6591 (ONCE-ONLY-ACTION 6214 . 6591)) (6593 6817 (
ONCE-ONLY-TEXT 6593 . 6817)))))
IL:STOP