[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

Re: Has anyone written a simple progress dialog?



In article <lynch-2402950000030001@lynch.ils.nwu.edu>, lynch@ils.nwu.edu
(Richard Lynch) wrote:

> There's a progress-window.lisp in Lynch Lib that might suit your needs.
> I seem to recall that it was pretty simplistic, and I wanted to do
> something to improve it, but I'll be damned if I can now remember what
> that was.  :-)
We took richards code as a start and sort of improved it.

Unfortunately the code and the doc is in German, but it may be of help

We have ported the code to ACL/WINDOWS too

Karsten
(require :quickdraw)
(require :scrollers)

#-wuerzburg
(defconstant b_Chicagoschrift    `("chicago" 12 :plain))

#-wuerzburg
(defclass *b-window* (window)
  ())

#-wuerzburg
(defclass *B-STATIC-TEXT-DIALOG-ITEM* (static-text-dialog-item)
  ())

#-wuerzburg
(defclass *B-STATIC-TEXT-DIALOG-ITEM-MIT-KASTEN* (static-text-dialog-item)
  ())

#-wuerzburg
(defclass *B-ABBRECHEN-BUTTON* (button-dialog-item)
  ()
  (
   :default-initargs
   :dialog-item-text "Abbrechen"))
  

#-wuerzburg
(defun b=erzeuge-string (something)
  (princ-to-string something))

#-wuerzburg
(defun m->a=erzeuge-dialog-item (class &rest args)
  (declare (dynamic-extent args))
  (apply #'make-instance class args))


#-wuerzburg
(defun b=string-punkte-kuerzen (String  punkte &key (schrift
b_Chicagoschrift)(Auffuellzeichen #\
  "Kuerzt den String auf hoechstens punkte pixel,
   eventuell zu kurz"
;karsten  31.9.90
  (let ((groesse (string-width string schrift)))
    (if (< groesse punkte)
      string
      (let* ((drei-punkte  (string Auffuellzeichen))
             (drei-punkte-groesse (string-width drei-punkte schrift))
             (max-punkte (- punkte drei-punkte-groesse))
             ;abgeschnittener String darf hoechstens max-punkte gross sein
             (bisherige-groesse 0))
        (dotimes (index (length string))
          (incf bisherige-groesse
              (string-width (string (char string index)) schrift))
          (when (> bisherige-groesse max-punkte)
            (return 
             (concatenate 'string
              (subseq string 0 index) drei-punkte))))))))

(defmacro b=mit-zeitstrahlanzeige ((&rest zeitstrahl-parameter) &body body)
  (let ((fenstervariable (gensym "Fenster")))
    
    `(let ((,fenstervariable (make-instance '*b-zeitstrahl-window*
                               ,@zeitstrahl-parameter)))
       (labels 
         (
          (b=anzeigen (&key absolut aktuell)
            (anzeigen ,fenstervariable :absolut absolut :aktuell aktuell))
          (b=absoluter-gesamtaufwand-aktualisieren (zahl)
            (absoluter-gesamtaufwand-aktualisieren ,fenstervariable zahl)
            )
          )
         (unwind-protect
           (catch :otto
             ,@body)
           (window-close ,fenstervariable))))))


(defclass progress-dialog-item (ccl::box-dialog-item)
  ((num-steps
    :accessor progress-gesamtaufwand
    :initarg :progress-gesamtaufwand)
   (current-step
    :accessor progress-aktueller-aufwand
    :initform 0)
   )
  )

(defmethod view-draw-contents :after ((item progress-dialog-item))
  "Draws the percentage indicator based on progress-gesamtaufwand and
progress-aktueller-aufwand."
  ;;
  (unless (= 0 (progress-gesamtaufwand item))
     (let* ((width (point-h (view-size item)))
           (height (point-v (view-size item)))
           (step-width (/ width (progress-gesamtaufwand item)))
           (right (round (* (progress-aktueller-aufwand item) step-width)))
           )
      (fill-rect item *gray-pattern* 1 1 (1- right) (1- height)))))

(defmethod absoluter-gesamtaufwand-aktualisieren ((ich
progress-dialog-item) zahl)
  (setf (progress-gesamtaufwand ich) zahl)
  (invalidate-view ich t)
  )

(defmethod set-step ((item progress-dialog-item)
                     (new-step integer)
                     &optional step-text)
  (declare (ignore step-text))
  (setf (progress-aktueller-aufwand item) new-step)
  (invalidate-view item))

(defclass *b-zeitstrahl-window* (*b-window*)
  (
   (absolutanzeige-objekt :Accessor absolutanzeige-objekt :initform nil)
   (aktuellanzeige-objekt :Accessor aktuellanzeige-objekt :initform nil)
   (aktuellanzeige-breite :accessor aktuellanzeige-breite)
   (relativanzeige-objekt :Accessor relativanzeige-objekt :initform nil)
   (f-aktuellanzeige-text :Accessor f-aktuellanzeige-text :initarg
:f-aktuellanzeige-text)
   (aktuelles-objekt :initform nil :accessor aktuelles-objekt)
   (aufsteigend-zaehlen-p :initform nil :initarg :aufsteigend-zaehlen-p
                          :accessor bz-aufsteigend-zaehlen-p)
   )
  (
   :default-initargs 
   :window-type :document ;:double-edge-box
   :window-title "Anzeige"
   :view-size (make-point 300 300)
   :f-aktuellanzeige-text #'b=erzeuge-string
   :close-box-p nil)
  )
    

(defmethod anzeigen ((ich *b-zeitstrahl-window*)
                     &key 
                     (absolut)
                     (aktuell))
  (progn 
   (when (and (numberp absolut)(absolutanzeige-objekt ich))
     (set-dialog-item-text (absolutanzeige-objekt ich) (b=erzeuge-string
absolut))
     (invalidate-view (absolutanzeige-objekt ich))
     )
   
   (when (and (numberp absolut) (relativanzeige-objekt ich))
     (set-step (relativanzeige-objekt ich)
               (if (bz-aufsteigend-zaehlen-p ich)
                 absolut
               (- (progress-gesamtaufwand (relativanzeige-objekt ich))
absolut)))
     )
   
   (when (and aktuell (aktuellanzeige-objekt ich))
     (setf (aktuelles-objekt ich) aktuell)
     (set-dialog-item-text (aktuellanzeige-objekt ich)
                           (b=string-punkte-kuerzen
                            (funcall (f-aktuellanzeige-text ich)
                                     aktuell)
                            (aktuellanzeige-breite ich)
                            :schrift
                            (view-font (aktuellanzeige-objekt ich))
                            ))
     (invalidate-view (aktuellanzeige-objekt ich))
     )
   )
  #+:ccl (window-update-event-handler ich)
  )

(defmethod absoluter-gesamtaufwand-aktualisieren ((ich
*b-zeitstrahl-window*) zahl)
  (absoluter-gesamtaufwand-aktualisieren 
   (relativanzeige-objekt ich) zahl)
  #+:ccl (window-update-event-handler ich)
  )

(defmethod initialize-instance :after
           ((ich *b-zeitstrahl-window*) &rest init-list
            &key
            (absolutanzeige-text "Objekte noch zu bearbeiten:")
            (aktuellanzeige-text "Aktuell in Arbeit:")
            (abbrechen-button-p t)
            (absolutanzeige-p t)
            (aktuellanzeige-p t)
            (relativanzeige-p t)
            (f-abbrechen)
            (fensterbreite 400)
            (absoluter-gesamtaufwand 100)
            )
  (declare (ignore init-list))
  (let* ((y_akt 10)
         (Abstand-dialog-items-horizontal 10)
         (dialog-item-hoehe 20)
         (zeilenabstand-y 25)
         (breite-fuer-aktuellanzeige-text (string-width
aktuellanzeige-text b_chicagoschrift))
         (breite-fuer-absolutanzeige 100)
         (breite-fuer-abbrechen-knopf 120)
         absolutanzeige-objekt absolutanzeige-objekt-dynamisch
         aktuellanzeige-objekt aktuellanzeige-objekt-dynamisch
         relativ-anzeige-objekt abbrechen-knopf-objekt
         objektliste
         )
    (if fensterbreite
      ;eventuell den String kuerzen
      (setq absolutanzeige-text
            (b=string-punkte-kuerzen absolutanzeige-text
                                     (- fensterbreite 115)
                                     :schrift b_chicagoschrift))
      ;fensterbreite Bestimmen
      (setq fensterbreite
            (max (+ 10 Abstand-dialog-items-horizontal (* 2
breite-fuer-abbrechen-knopf))
                 (cond ((and absolutanzeige-p absolutanzeige-text)
                        (+ 5 (string-width absolutanzeige-text
b_chicagoschrift) Abstand-dialog-items-horizontal
breite-fuer-absolutanzeige 5))
                       ((and aktuellanzeige-p aktuellanzeige-text)
                        (+ 5 (string-width aktuellanzeige-text
b_chicagoschrift) 5 breite-fuer-abbrechen-knopf
breite-fuer-abbrechen-knopf))
                       (t 400)))))
    (when absolutanzeige-p
      (setq  absolutanzeige-objekt
             (m->a=erzeuge-dialog-item '*b-static-text-dialog-item*
                                       :dialog-item-text absolutanzeige-text
                                       :view-position (make-point 5 y_akt)))
      (setq absolutanzeige-objekt-dynamisch
            (m->a=erzeuge-dialog-item '*b-static-text-dialog-item-mit-kasten*
                                      :view-size (make-point
breite-fuer-absolutanzeige dialog-item-hoehe)
                                      :dialog-item-text (b=erzeuge-string
absoluter-gesamtaufwand)
                                      :view-position (make-point (-
fensterbreite 100 5) y_akt)))
      (setf (absolutanzeige-objekt ich) absolutanzeige-objekt-dynamisch)
      (incf y_akt zeilenabstand-y)
      (push absolutanzeige-objekt objektliste)
      (push absolutanzeige-objekt-dynamisch objektliste))
    
    (when aktuellanzeige-p
      (setq aktuellanzeige-objekt
            (m->a=erzeuge-dialog-item '*b-static-text-dialog-item*
                                      :dialog-item-text aktuellanzeige-text
                                      :view-position (make-point 5 y_akt)))
      (setq aktuellanzeige-objekt-dynamisch
            (m->a=erzeuge-dialog-item '*b-static-text-dialog-item*
                                      :view-size (make-point (-
fensterbreite Abstand-dialog-items-horizontal
breite-fuer-aktuellanzeige-text 5) dialog-item-hoehe)
                                      :dialog-item-text ""
                                      :view-position (make-point (+ 5
breite-fuer-aktuellanzeige-text Abstand-dialog-items-horizontal) y_akt)))
      (setf (aktuellanzeige-objekt ich) aktuellanzeige-objekt-dynamisch)
      (setf (aktuellanzeige-breite ich)(point-h (view-size
(aktuellanzeige-objekt ich))))
      (push aktuellanzeige-objekt objektliste)
      (push aktuellanzeige-objekt-dynamisch objektliste)
      (incf y_akt zeilenabstand-y))
    
    (when relativanzeige-p
      (setq relativ-anzeige-objekt
            (m->a=erzeuge-dialog-item 'progress-dialog-item
                                      :view-position (make-point 5 (+
(floor dialog-item-hoehe 4) y_akt))
                                      :view-size (make-point (- fensterbreite 5
                                                               
Abstand-dialog-items-horizontal 
                                                               
breite-fuer-abbrechen-knopf Abstand-dialog-items-horizontal) 10)
                                      :progress-gesamtaufwand
absoluter-gesamtaufwand))
      (setf (relativanzeige-objekt ich) relativ-anzeige-objekt)
      (push relativ-anzeige-objekt objektliste))
    
    (when abbrechen-button-p
      (setq abbrechen-knopf-objekt
            (m->a=erzeuge-dialog-item '*b-abbrechen-button*
                                      :view-position (make-point (-
fensterbreite 5 breite-fuer-abbrechen-knopf) y_akt)
                                      :dialog-item-action #'(lambda(was)
                                                              (declare
(ignore was))
                                                              (when f-abbrechen
                                                                (funcall
f-abbrechen
                                                                        
(progress-gesamtaufwand (relativanzeige-objekt ich))
                                                                        
(progress-aktueller-aufwand (relativanzeige-objekt ich))
                                                                        
(aktuelles-objekt ich)))
                                                              (throw :otto
nil))))
      (push abbrechen-knopf-objekt objektliste))
    
    (set-view-size ich (make-point fensterbreite (+ y_akt 30)))
    (apply #'add-subviews ich objektliste)
    (window-select ich)
    #+:ccl (window-update-event-handler ich)
    )
  )



#|
Beispiele:


(b=mit-zeitstrahlanzeige
  (
   :window-title "Zeitstrahl"
   :absoluter-gesamtaufwand 100000
   :aktuellanzeige-p nil
   )
  
  (dotimes (x 100000)
    (when (= 0 (mod x 500))
      (b=anzeigen :absolut (- 100000 x)))))

(let* ((alle-schnittstellenfunktionen (apropos-list "B="))
       (anzahl (length alle-schnittstellenfunktionen)))
  (b=mit-zeitstrahlanzeige
    (
     :fensterbreite 300
     :absoluter-gesamtaufwand anzahl
     :aktuellanzeige-p t
     )
    (do (
         (x 0 (1+ x))
         (die_liste alle-schnittstellenfunktionen (rest die_liste)))
        ((endp die_liste))
      (sleep 0.05)
      (when (= 0 (mod x 1))
        (b=anzeigen :absolut (- anzahl x) :aktuell (first die_liste))))))

(let* ((alle-schnittstellenfunktionen (apropos-list "B="))
       (anzahl (length alle-schnittstellenfunktionen)))
  (b=mit-zeitstrahlanzeige
    (
     :absoluter-gesamtaufwand anzahl
     :aktuellanzeige-p nil
     :absolutanzeige-p nil
     :relativanzeige-p t
     )
    (do (
         (x 0 (1+ x))
         (die_liste alle-schnittstellenfunktionen (rest die_liste)))
        ((endp die_liste))
      (sleep 0.05)
      (when (= 0 (mod x 1))
      (b=anzeigen  :absolut (- anzahl x))))))

(b=mit-zeitstrahlanzeige
  (
   :window-title "Zeitstrahl"
   :absoluter-gesamtaufwand 1000
   :aktuellanzeige-p nil
   :aufsteigend-zaehlen-p t
   :absolutanzeige-text "Schon bearbeitete Objekte"
   )
  (let ((max 1000))
    (dotimes (x 100000)
      (when (= x max)
        (setq max (* 2 max))
        (b=absoluter-gesamtaufwand-aktualisieren max))
      (when (= 0 (mod x 500))
        (b=anzeigen :absolut x)))))
|#

 Karsten A. Poeck, Lehrstuhl fuer Informatik VI, Universitaet Wuerzburg
 Allesgrundweg 12, 97218 Gerbrunn, Germany
 E-mail: poeck@informatik.uni-wuerzburg.de
 Tel ++ 49  931 70561 18, Fax ++ 49 931 70561 20
 http://wi6a76.informatik.uni-wuerzburg.de/HTMLs/ls6-info/Assis/poeck/poeck.html