DANDEGUI

(DEFINE-FILE-INFO PACKAGE (DEFPACKAGE "DANDEGUI" (USE "LISP" "XCL") (NICKNAMES "GUI")) READTABLE 
"XCL" BASE 10)


(IL:FILECREATED "31-May-2025 17:29:16" IL:|{DSK}<home>paolo>il>dandegui>DANDEGUI.;19|
 13214  

      :EDIT-BY "PA"

      :CHANGES-TO (IL:SETFS WINDOW-TITLE)
                  (IL:FUNCTIONS CLEAR-WINDOW PRINT-MESSAGE WINDOW-TITLE)

      :PREVIOUS-DATE "25-May-2025 19:44:40" IL:|{DSK}<home>paolo>il>dandegui>DANDEGUI.;18|)


(IL:PRETTYCOMPRINT IL:DANDEGUICOMS)

(IL:RPAQQ IL:DANDEGUICOMS

          ((IL:* IL:A IL:GUI IL:|library| IL:|for| IL:|simple| IL:|text| IL:|and| IL:|graphics| 
                 IL:|output.|)
           (FILE-ENVIRONMENTS IL:DANDEGUI)
           (IL:P (DEFPACKAGE "DANDEGUI" (:USE "LISP" "XCL")
                        (:NICKNAMES "GUI")
                        (:EXPORT *DEFAULT-FONT* OPEN-GRAPHICS-STREAM OPEN-WINDOW-STREAM CLEAR-WINDOW
                               PRINT-MESSAGE WINDOW-TITLE WITH-TEXT-STYLE WITH-GRAPHICS-STREAM 
                               WITH-GRAPHICS-WINDOW WITH-WINDOW-STREAM WITH-OUTPUT-TO-WINDOW)))
           (IL:FUNCTIONS CLEAR-WINDOW FONT-FAMILY-TO-SYM OPEN-GRAPHICS-STREAM OPEN-WINDOW-STREAM 
                  PRINT-MESSAGE TEXT-STYLE-TO-FD WINDOW-TITLE WITH-GRAPHICS-STREAM 
                  WITH-GRAPHICS-WINDOW WITH-OUTPUT-TO-WINDOW WITH-TEXT-STYLE WITH-WINDOW-STREAM 
                  WITH-WRITE-ENABLED)
           (IL:SEDIT-FORMATS WITH-GRAPHICS-STREAM WITH-GRAPHICS-WINDOW WITH-OUTPUT-TO-WINDOW 
                  WITH-TEXT-STYLE WITH-WINDOW-STREAM)
           (IL:SETFS WINDOW-TITLE)
           (IL:VARIABLES *DEFAULT-FONT*)
           (IL:FILES IL:SKETCH IL:SKETCH-STREAM)))



(IL:* IL:A IL:GUI IL:|library| IL:|for| IL:|simple| IL:|text| IL:|and| IL:|graphics| IL:|output.|)



(DEFINE-FILE-ENVIRONMENT IL:DANDEGUI
 :PACKAGE (DEFPACKAGE "DANDEGUI" (:USE "LISP" "XCL")
                                                     (:NICKNAMES "GUI"))
   :READTABLE "XCL"
   :COMPILER :COMPILE-FILE)

(DEFPACKAGE "DANDEGUI" (:USE "LISP" "XCL")
       (:NICKNAMES "GUI")
       (:EXPORT *DEFAULT-FONT* OPEN-GRAPHICS-STREAM OPEN-WINDOW-STREAM CLEAR-WINDOW PRINT-MESSAGE 
              WINDOW-TITLE WITH-TEXT-STYLE WITH-GRAPHICS-STREAM WITH-GRAPHICS-WINDOW 
              WITH-WINDOW-STREAM WITH-OUTPUT-TO-WINDOW))

(DEFUN CLEAR-WINDOW
 (STREAM)
                           (IL:* IL:\; "Edited 31-May-2025 16:53 by PA")


                                                       (IL:* IL:\; "Edited 26-Apr-2025 20:32 by PA")

   "Clear the text or graphics window associated with STREAM.
Returns STREAM."
   (COND
      ((IL:TEXTSTREAMP STREAM)
       (WITH-WRITE-ENABLED
 (STR STREAM)
              (IL:TEDIT.DELETE STR 1 (IL:TEDIT.NCHARS STR))
              STREAM))
      ((IL:IMAGESTREAMP STREAM)
       (IL:DSPRESET STREAM)

       (IL:* IL:|;;| 

       "DSPRESET sets the bottom margin to the top minus one line of text, so set it to the origin")


       (IL:DSPBOTTOMMARGIN 0 STREAM)
       STREAM)
      (T STREAM)))

(DEFUN FONT-FAMILY-TO-SYM
 (FAMILY)
                     (IL:* IL:\; "Edited 10-May-2025 17:54 by PA")

   "Return the Interlisp symbol of the font family name that best matches FAMILY.
FAMILY must be one of :SERIF, :SANS, :FIX, or a keyword denoting a family name. If no matching name is found returns the family of *DEFAULT-FONT*."
   (OR (SECOND (ASSOC FAMILY '((:SERIF IL:TIMESROMAN)
                               (:SANS IL:HELVETICA)
                               (:FIX IL:TERMINAL))))
       (FIND-SYMBOL (SYMBOL-NAME FAMILY)
              (FIND-PACKAGE "IL"))
       (IL:FONTPROP *DEFAULT-FONT* 'IL:FAMILY)))

(DEFUN OPEN-GRAPHICS-STREAM
 (&KEY (TITLE "Untitled"))
  (IL:* IL:\; "Edited 25-May-2025 17:47 by PA")

   "Open a new window and return the associated IMAGESTREAM to send graphics output to.
Sets the window title to TITLE if supplied."
   (LET* ((STREAM (IL:OPENIMAGESTREAM '|Untitled| 'IL:SKETCH '(IL:FONTS ,*DEFAULT-FONT*)))
          (WINDOW (IL:\\SKSTRM.WINDOW.FROM.STREAM STREAM)))
         (IL:WINDOWPROP WINDOW 'IL:TITLE TITLE)

         (IL:* IL:|;;| "Disable left and middle-click title bar menu")


         (IL:WINDOWPROP WINDOW 'IL:BUTTONEVENTFN NIL)

         (IL:* IL:|;;| "Disable sketch editing via right-click actions")


         (IL:WINDOWPROP WINDOW 'IL:RIGHTBUTTONFN NIL)

         (IL:* IL:|;;| "Disable querying the user whether to save changes")


         (IL:WINDOWPROP WINDOW 'IL:DONTQUERYCHANGES T)
         STREAM))

(DEFUN OPEN-WINDOW-STREAM
 (&KEY (TITLE "Untitled"))
    (IL:* IL:\; "Edited  4-May-2025 17:08 by PA")


                                                       (IL:* IL:\; "Edited 13-Apr-2025 17:38 by PA")

   "Open a new window and return a text stream to send output to."

                                                       (IL:* IL:\; "Edited 12-Apr-2025 18:28 by PA")

   (LET ((STREAM (IL:TEXTSTREAM (IL:TEDIT
                                 NIL NIL NIL
                                 `(IL:FONT ,*DEFAULT-FONT* IL:HISTORY IL:OFF IL:READONLY IL:QUIET 

                                         (IL:* IL:|;;| 

                                "A dummy function to suppress TEdit's  left/middle button title menu")


                                         IL:TITLEMENUFN
                                         ,#'(LAMBDA (WINDOW)
                                                   (DECLARE
 (IGNORE WINDOW))
                                                   T))))))
        (IL:WINDOWPROP (IL:WFROMDS STREAM)
               'IL:TITLE TITLE)
        STREAM))

(DEFUN PRINT-MESSAGE
 (STREAM MESSAGE &OPTIONAL DONT-CLEAR-P)

                                                       (IL:* IL:\; "Edited 31-May-2025 17:26 by PA")


                                                       (IL:* IL:\; "Edited 26-Apr-2025 20:36 by PA")

   "Print MESSAGE to the prompt area of the window associated with STREAM if it is a text stream, to the system prompt window otherwise.
If DONT-CLEAR-P is non NIL the area or prompt window will be cleared first. Returns STREAM."
   (IF (IL:TEXTSTREAMP STREAM)
       (IL:TEDIT.PROMPTPRINT STREAM MESSAGE (NOT DONT-CLEAR-P))
       (IF DONT-CLEAR-P
           (PROGN (IL:FRESHLINE IL:PROMPTWINDOW)
                  (PRINC MESSAGE IL:PROMPTWINDOW))
           (IL:PROMPTPRINT MESSAGE)))
   STREAM)

(DEFUN TEXT-STYLE-TO-FD
 (FAMILY SIZE FACE)
             (IL:* IL:\; "Edited 10-May-2025 18:40 by PA")

   "Return a font descriptor that is a copy of *DEFAULT-FONT* modified according to the style specified by FAMILY, SIZE, and FACE.
FACE must be one of :STANDARD, :ITALIC, :BOLD, or :BOLDITALIC. Returns NIL if no matching font descriptor can be built."
   (LET ((PROPS (REMOVE NIL (APPEND (WHEN FAMILY
                                        (LIST 'IL:FAMILY (FONT-FAMILY-TO-SYM
 FAMILY)))
                                   (WHEN SIZE
                                       (LIST 'IL:SIZE SIZE))
                                   (WHEN FACE
                                       (LIST 'IL:FACE (OR (FIND-SYMBOL (SYMBOL-NAME FACE)
                                                                 (FIND-PACKAGE "IL"))
                                                          'IL:STANDARD)))
                                   (LIST 'IL:NOERROR T)))))
        (IL:FONTCOPY *DEFAULT-FONT* PROPS)))

(DEFUN WINDOW-TITLE
 (STREAM)
                           (IL:* IL:\; "Edited 31-May-2025 17:05 by PA")


                                                       (IL:* IL:\; "Edited 20-Apr-2025 13:02 by PA")

   "Return the title of the window associated with STREAM."
   (LET ((WINDOW (COND
                    ((IL:TEXTSTREAMP STREAM)
                     (IL:WFROMDS STREAM))
                    ((IL:IMAGESTREAMP STREAM)
                     (IL:\\SKSTRM.WINDOW.FROM.STREAM STREAM))
                    (T NIL))))
        (WHEN WINDOW
            (IL:WINDOWPROP WINDOW 'IL:TITLE))))

(DEFMACRO WITH-GRAPHICS-STREAM
 ((VAR STREAM)
                                &BODY BODY)
            (IL:* IL:\; "Edited 25-May-2025 17:55 by PA")

   "Perform the operations in BODY with VAR bound to the graphics window STREAM.
Evaluates the forms in BODY in a context in which VAR is bound to STREAM which must already exist, then returns the value of the last form of BODY."
   `(LET ((,VAR ,STREAM))
         ,@BODY))

(DEFMACRO WITH-GRAPHICS-WINDOW
 ((VAR &KEY TITLE)
                                &BODY BODY)
            (IL:* IL:\; "Edited 25-May-2025 19:37 by PA")

   "Perform the operations in BODY with VAR bound to a new graphics window stream.
Creates a new window titled TITLE if supplied, binds VAR to the IMAGESTREAM associated with the window, and executes BODY in this context. Returns the value of the last form of BODY."
   `(WITH-GRAPHICS-STREAM
 (,VAR (OPEN-GRAPHICS-STREAM
 :TITLE (OR ,TITLE "Untitled")))
           ,@BODY))

(DEFMACRO WITH-OUTPUT-TO-WINDOW
 ((VAR &KEY TITLE)
                                 &BODY BODY)
           (IL:* IL:\; "Edited 16-Apr-2025 14:17 by PA")

   "WITH-OUTPUT-TO-WINDOW (VAR &KEY TITLE) BODY
Perform the operations in BODY with VAR bound to a new window stream.
Opens a new window with title TITLE, binds VAR to the TEXTSTREAM associated with the window, and executes BODY in this context. Returns the value of the last form of BODY."
   `(WITH-WINDOW-STREAM
 

           (IL:* IL:|;;| 

  "If :TITLE is NIL the title bar disappear, so we must pass something non NIL to OPEN-WINDOW-STREAM")


           (,VAR (OPEN-WINDOW-STREAM
 :TITLE (OR ,TITLE "Untitled")))
           ,@BODY))

(DEFMACRO WITH-TEXT-STYLE
 ((STREAM &KEY FAMILY SIZE FACE)
                           &BODY BODY)
                 (IL:* IL:\; "Edited 10-May-2025 17:59 by PA")

   "Perform the operations in BODY in a context in which text printed to STREAM is rendered in the text style specified by FAMILY, SIZE, and FACE.
FAMILY must be one of :SERIF, :SANS, :FIX, or a keyword denoting a family name. FACE must be one of :STANDARD, :ITALIC, :BOLD, or :BOLDITALIC. Returns the value of the last expression of BODY."
   (ONCE-ONLY (STREAM)
          `(UNWIND-PROTECT
               (PROGN (IL:PRINTOUT ,STREAM IL:.FONT (TEXT-STYLE-TO-FD
 ,FAMILY ,SIZE ,FACE))
                      ,@BODY)
               (IL:PRINTOUT ,STREAM IL:.FONT *DEFAULT-FONT*))))

(DEFMACRO WITH-WINDOW-STREAM
 ((VAR STREAM)
                              &BODY BODY)
              (IL:* IL:\; "Edited 16-Apr-2025 13:25 by PA")

   "Perform the operations in BODY with VAR bound to a window STREAM.
Evaluates the forms in BODY in a context in which VAR is bound to STREAM which must already exist, then returns the value of the last form of BODY."
   `(WITH-WRITE-ENABLED
 (,VAR ,STREAM)
           ,@BODY))

(DEFMACRO WITH-WRITE-ENABLED
 ((VAR STREAM)
                              &BODY BODY)
              (IL:* IL:\; "Edited 26-Apr-2025 16:44 by PA")


                                                       (IL:* IL:\; "Edited 15-Apr-2025 19:34 by PA")

   "Perform the operations in BODY on STREAM after enabling write access, then set it to readonly.
Evaluates the forms in BODY in a context in which STREAM is bound to VAR and write access is enabled for STREAM, then sets STREAM back to readonly and returns the value of the last form of BODY."
   (ONCE-ONLY (STREAM)
          `(UNWIND-PROTECT
               (LET ((,VAR ,STREAM))
                    (IL:TEXTPROP ,STREAM 'IL:READONLY NIL)

                    (IL:* IL:|;;| 

                    "Ensure new text is appended to the end by setting the stream pointer to EOF=-1")


                    (IL:SETFILEPTR ,STREAM -1)
                    ,@BODY)

               (IL:* IL:|;;| 

           "Mark buffer  as not changed so the user is not prompted when to save when quitting TEdit")


               (IL:TEDIT.STREAMCHANGEDP ,STREAM T)
               (IL:TEXTPROP ,STREAM 'IL:READONLY 'IL:QUIET))))

(SEDIT:DEF-LIST-FORMAT WITH-GRAPHICS-STREAM
 WITH-OPEN-STREAM)

(SEDIT:DEF-LIST-FORMAT WITH-GRAPHICS-WINDOW
 WITH-OPEN-STREAM)

(SEDIT:DEF-LIST-FORMAT WITH-OUTPUT-TO-WINDOW
 WITH-OPEN-STREAM)

(SEDIT:DEF-LIST-FORMAT WITH-TEXT-STYLE
 WITH-OPEN-STREAM)

(SEDIT:DEF-LIST-FORMAT WITH-WINDOW-STREAM
 WITH-OPEN-STREAM)

(DEFSETF WINDOW-TITLE
 (STREAM) (TITLE)
   "Set to TITLE the title of the window associated with STREAM.
Returns the previous title."

   (IL:* IL:|;;| "TITLE must  not be NIL otherwise the title bar of the window gets hidden")


   `(LET ((WINDOW (COND
                     ((IL:TEXTSTREAMP ,STREAM)
                      (IL:WFROMDS ,STREAM))
                     ((IL:IMAGESTREAMP ,STREAM)
                      (IL:\\SKSTRM.WINDOW.FROM.STREAM ,STREAM))
                     (T NIL))))
         (WHEN WINDOW
             (IL:WINDOWPROP WINDOW 'IL:TITLE (OR ,TITLE "Untitled")))))

(DEFVAR *DEFAULT-FONT*
 (IL:FONTCREATE 'IL:TERMINAL 10)
                       "Default font of text windows.")

(IL:FILESLOAD IL:SKETCH IL:SKETCH-STREAM)
(IL:DECLARE\: IL:DONTCOPY
  (IL:FILEMAP (NIL (2312 3043 (CLEAR-WINDOW 2312 . 3043)) (3045 3671 (FONT-FAMILY-TO-SYM 3045 . 3671)) (
3673 4536 (OPEN-GRAPHICS-STREAM 3673 . 4536)) (4538 5639 (OPEN-WINDOW-STREAM 4538 . 5639)) (5641 6421 
(PRINT-MESSAGE 5641 . 6421)) (6423 7435 (TEXT-STYLE-TO-FD 6423 . 7435)) (7437 8036 (WINDOW-TITLE 7437
 . 8036)) (8038 8469 (WITH-GRAPHICS-STREAM 8038 . 8469)) (8471 9013 (WITH-GRAPHICS-WINDOW 8471 . 9013)
) (9015 9729 (WITH-OUTPUT-TO-WINDOW 9015 . 9729)) (9731 10482 (WITH-TEXT-STYLE 9731 . 10482)) (10484 
10921 (WITH-WINDOW-STREAM 10484 . 10921)) (10923 12107 (WITH-WRITE-ENABLED 10923 . 12107)))))
IL:STOP