cadence/breezewiki
2
4
Fork 4
Code Issues Pull requests 1 Releases Wiki Activity

Archiver GUI super-reset button

Browse source
This commit is contained in:
Cadence Ember 2023-12-15 21:23:12 +13:00
parent 9c3125d6be
commit 723bb92b0a
Signed by: cadence
GPG key ID: BC1C2C61CF521B17
1 changed files with 61 additions and 10 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

69
archiver/archiver-gui.rkt
View file

@ -2,11 +2,14 @@
(require racket/class (require racket/class
racket/draw racket/draw
racket/format racket/format
racket/function
racket/list racket/list
racket/math
racket/port racket/port
racket/set racket/set
racket/splicing racket/splicing
racket/string racket/string
(except-in pict text table)
db db
net/http-easy net/http-easy
memo memo
@ -65,7 +68,7 @@
(define/obs @auto-retry #f) (define/obs @auto-retry #f)
(define-struct qi^ (wikiname st stage progress max-progress eta th) #:transparent) ;; queue item (define-struct qi^ (wikiname st stage progress max-progress ticks eta th) #:transparent) ;; queue item
(define rows (query-rows* "select wikiname, progress from wiki where progress < 4")) (define rows (query-rows* "select wikiname, progress from wiki where progress < 4"))
(define/obs @queue null) (define/obs @queue null)
@ -74,7 +77,7 @@
(define already-exists? (findf (λ (qi) (equal? (qi^-wikiname qi) wikiname)) queue)) (define already-exists? (findf (λ (qi) (equal? (qi^-wikiname qi) wikiname)) queue))
(if already-exists? (if already-exists?
queue queue
(append queue (list (qi^ wikiname st stage 0 1 "..." #f))))))) (append queue (list (qi^ wikiname st stage 0 1 0 "..." #f)))))))
(for ([row rows]) (for ([row rows])
(add-wikiname-to-queue (vector-ref row 0) (add-wikiname-to-queue (vector-ref row 0)
(if (= (vector-ref row 1) 4) (if (= (vector-ref row 1) 4)
@ -88,7 +91,43 @@
(define color-green (make-color 90 212 68)) (define color-green (make-color 90 212 68))
(define/obs @input "") (define (resize coords fraction)
(for/list ([coord (in-list coords)])
(cons (* fraction (car coord))
(* fraction (cdr coord)))))
(define (flat-right-arrow #:height [height 32] #:color [color #f])
((if color
(curryr colorize color)
values)
(dc (λ (dc dx dy)
(send dc draw-polygon (resize
(list '(0 . 9) '(15 . 9) '(14 . 0)
'(31 . 15.5)
'(14 . 31) '(15 . 22) '(0 . 22))
(/ height 32))))
height height)))
(define (double-left-arrow-icon #:height [height 32])
(define shift (/ height 48))
(pict->bitmap
(scale-to-fit
(panorama
(pin-under
(bitmap
(left-over-arrow-icon #:color halt-icon-color #:height height
#:material rubber-icon-material))
(- (* -20 shift) 2) (+ (* 6 shift) 1)
(bitmap
(bitmap-render-icon
(pict->bitmap
(rotate
(flat-right-arrow #:color (make-object color% 255 64 64) #:height (/ height 1.26))
(* pi 1.23)))))
#;(rotate
(flat-right-arrow #:color (make-object color% 255 64 64) #:height (/ height 1.26))
(* pi 1.23))))
height height #:mode 'preserve/max)))
(splicing-let ([frame-count 20]) (splicing-let ([frame-count 20])
(define stickman-frames (define stickman-frames
@ -111,7 +150,8 @@
(define action-icons (define action-icons
(hasheq 'pause (pause-icon #:color syntax-icon-color #:height button-icon-size) (hasheq 'pause (pause-icon #:color syntax-icon-color #:height button-icon-size)
'resume (play-icon #:color color-green #:height button-icon-size) 'resume (play-icon #:color color-green #:height button-icon-size)
'reset (left-over-arrow-icon #:color halt-icon-color #:height button-icon-size))) 'reset (left-over-arrow-icon #:color halt-icon-color #:height button-icon-size)
'reseter (double-left-arrow-icon #:height button-icon-size)))
(define (bitmap-view @the-bitmap [min-width 1]) (define (bitmap-view @the-bitmap [min-width 1])
(pict-canvas #:min-size (@> (list (max min-width (send @the-bitmap get-width)) (send @the-bitmap get-height))) #;(if min-size (list min-size min-size) #f) (pict-canvas #:min-size (@> (list (max min-width (send @the-bitmap get-width)) (send @the-bitmap get-height))) #;(if min-size (list min-size min-size) #f)
@ -217,7 +257,9 @@
(define ((make-progress-updater @qi) a b c) (define ((make-progress-updater @qi) a b c)
;; (printf "~a: ~a/~a ~a~n" (qi^-wikiname (obs-peek @qi)) a b c) ;; (printf "~a: ~a/~a ~a~n" (qi^-wikiname (obs-peek @qi)) a b c)
(update-qi @qi [progress a] [max-progress b])) (update-qi @qi [progress a] [max-progress b] [ticks (add1 (qi^-ticks (obs-peek @qi)))]))
(define/obs @input "")
(define (do-add-to-queue) (define (do-add-to-queue)
(define wikiname (string-trim (obs-peek @input))) (define wikiname (string-trim (obs-peek @input)))
@ -259,6 +301,10 @@
(update-qi @qi [th #f] [st 'queued] [stage reset-progress-to] [progress 0] [max-progress 0]) (update-qi @qi [th #f] [st 'queued] [stage reset-progress-to] [progress 0] [max-progress 0])
(query-exec* "update wiki set progress = ? where wikiname = ?" reset-progress-to (qi^-wikiname (obs-peek @qi)))) (query-exec* "update wiki set progress = ? where wikiname = ?" reset-progress-to (qi^-wikiname (obs-peek @qi))))
(define (do-reseter-qi @qi)
(do-reset-qi @qi)
(query-exec* "delete from page where wikiname = ?" (qi^-wikiname (obs-peek @qi))))
(define (do-try-unpause-next-entry) (define (do-try-unpause-next-entry)
(define queue (obs-peek @queue)) (define queue (obs-peek @queue))
(define next-qi (for/last ([qi queue] (define next-qi (for/last ([qi queue]
@ -301,7 +347,7 @@
(λ (k @qi) (λ (k @qi)
(define @status-icons (define @status-icons
(@> (case (qi^-st @qi) (@> (case (qi^-st @qi)
[(running) (stick (qi^-progress @qi))] [(running) (stick (qi^-ticks @qi))]
[else (hash-ref status-icons (qi^-st @qi))]))) [else (hash-ref status-icons (qi^-st @qi))])))
(define @is-running? (define @is-running?
(@> (memq (qi^-st @qi) '(running)))) (@> (memq (qi^-st @qi) '(running))))
@ -319,13 +365,18 @@
(spacer) (spacer)
(hpanel (hpanel
#:stretch '(#f #f) #:stretch '(#f #f)
(button (hash-ref action-icons 'reset)
(λ () (do-reset-qi @qi)))
(if-view @is-running? (if-view @is-running?
(button (hash-ref action-icons 'pause) (button (hash-ref action-icons 'pause)
(λ () (do-stop-qi @qi))) (λ () (do-stop-qi @qi)))
(hpanel
#:stretch '(#f #f)
(button (hash-ref action-icons 'reseter)
(λ () (do-reseter-qi @qi)))
(button (hash-ref action-icons 'reset)
(λ () (do-reset-qi @qi)))
(button (hash-ref action-icons 'resume) (button (hash-ref action-icons 'resume)
(λ () (do-start-qi @qi)))))) (λ () (do-start-qi @qi)))))))
;; progress bar (bottom half) ;; progress bar (bottom half)
(hpanel (hpanel
(canvas (canvas