[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
Re: Has anyone written a simple progress dialog?
- To: info-mcl@digitool.com
- Subject: Re: Has anyone written a simple progress dialog?
- From: poeck@informatik.uni-wuerzburg.de (Karsten Poeck)
- Date: 26 Feb 1995 12:36:30 GMT
- Organization: University of Wuerzburg
- References: <osiris-2002951800480001@slip-26-10.ots.utexas.edu>, <lynch-2402950000030001@lynch.ils.nwu.edu>
- Sender: owner-info-mcl@digitool.com
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