97 lines
3.7 KiB
Racket
97 lines
3.7 KiB
Racket
#lang syndicate
|
|
|
|
(require "../../widgets.rkt")
|
|
(require "cells-canvas.rkt")
|
|
(require racket/set racket/list racket/format)
|
|
|
|
;; a simple spreadsheet (will not check for circularities)
|
|
|
|
(require 7GUI/task-7-exp)
|
|
(require 7GUI/task-7-view)
|
|
|
|
;; -----------------------------------------------------------------------------
|
|
(struct formula (formula dependents) #:transparent)
|
|
#; {Formula = [formula Exp* || Number || (Setof Ref*)]}
|
|
|
|
(define (spawn-control frame)
|
|
(spawn
|
|
(field [*content (make-immutable-hash)] ;; [Hashof Ref* Integer]
|
|
[*formulas (make-immutable-hash)] ;; [Hashof Ref* Formula]
|
|
)
|
|
|
|
|
|
(define-syntax-rule (iff selector e default) (let ([v e]) (if v (selector v) default)))
|
|
(define (get-exp ref*) (iff formula-formula (hash-ref (*formulas) ref* #f) 0))
|
|
(define (get-dep ref*) (iff formula-dependents (hash-ref (*formulas) ref* #f) (set)))
|
|
(define (get-content ref*) (hash-ref (*content) ref* 0))
|
|
|
|
(local-require 7GUI/should-be-racket)
|
|
(define (set-content! ref* vc)
|
|
(define current (get-content ref*))
|
|
(*content (hash-set (*content) ref* vc))
|
|
(when (and current (not (= current vc)))
|
|
(when* (get-dep ref*) => propagate-to)))
|
|
|
|
(define (propagate-to dependents)
|
|
(for ((d (in-set dependents)))
|
|
(set-content! d (evaluate (get-exp d) (*content)))))
|
|
|
|
(define (set-formula! ref* exp*)
|
|
(define new (formula exp* (or (get-dep ref*) (set))))
|
|
(*formulas (hash-set (*formulas) ref* new))
|
|
(register-with-dependents (depends-on exp*) ref*)
|
|
(set-content! ref* (evaluate exp* (*content))))
|
|
|
|
(define (register-with-dependents dependents ref*)
|
|
(for ((d (in-set dependents)))
|
|
(*formulas (hash-set (*formulas) d (formula (get-exp d) (set-add (get-dep d) ref*))))))
|
|
|
|
;; ---------------------------------------------------------------------------------------------------
|
|
;; cells and contents
|
|
(define ((mk-edit title-fmt validator registration source frame) x y)
|
|
(define cell (list (x->A x) (y->0 y)))
|
|
(when (and (first cell) (second cell))
|
|
(react
|
|
(define value0 (~a (or (source cell) "")))
|
|
;; maybe need to make use of queue-callback ?
|
|
(define dialog (spawn-dialog #:parent #f
|
|
#:style '(close-button)
|
|
#:label (format title-fmt cell)))
|
|
(define tf (spawn-text-field #:parent dialog
|
|
#:label #f
|
|
#:min-width 200
|
|
#:min-height 80
|
|
#:init-value value0))
|
|
(on (message (text-field-enter tf $contents))
|
|
(when* (validator contents)
|
|
=> (lambda (valid)
|
|
(stop-current-facet
|
|
(send! (show dialog #f))
|
|
(registration cell valid)
|
|
(send! (update-grid (*content)))))))
|
|
(on (asserted (dialog@ dialog))
|
|
(send! (show dialog #t))))))
|
|
|
|
(define content-edit (mk-edit "content for cell ~a" valid-content set-content! get-content frame))
|
|
|
|
(define formula-fmt "a formula for cell ~a")
|
|
(define formula-edit (mk-edit formula-fmt string->exp* set-formula! (compose exp*->string get-exp) frame))
|
|
|
|
;; ---------------------------------------------------------------------------------------------------
|
|
(on (message (single-click $x $y))
|
|
(content-edit x y))
|
|
(on (message (double-click $x $y))
|
|
(formula-edit x y))
|
|
(on-start (send! (update-grid (*content))))
|
|
))
|
|
|
|
;; ---------------------------------------------------------------------------------------------------
|
|
(define frame (spawn-frame #:label "Cells" #:width (/ WIDTH 2) #:height (/ HEIGHT 3)))
|
|
(define canvas (spawn-cells-canvas frame WIDTH HEIGHT))
|
|
(spawn-control frame)
|
|
|
|
(spawn
|
|
(on (asserted (frame@ frame))
|
|
(send! (show frame #t))
|
|
(stop-current-facet)))
|