(module trace-header mzscheme (require (lib "contract.ss") (lib "class.ss") (lib "mred.ss" "mred") (lib "etc.ss") "interfaces.ss" "util-mixins.ss" "pasteboard-mixins.ss" "snip-mixins.ss" "draw.ss" "../model/view.ss" "../model/pool.ss" ) (provide/contract [trace-header% (class/c editor-canvas% updatee<%>)]) (define trace-header% (class* (ensure-iface editor-canvas-util<%> editor-canvas-util-mixin editor-canvas%) (updatee<%>) (super-new [style '(auto-hscroll auto-vscroll)] [min-height (+ HEADER-HEIGHT SCROLLBAR-WIDTH)] [horizontal-inset 0] [vertical-inset 0]) (inherit set-editor) (init-field trace-display) (public on-update) (override on-scroll/xy) (define editor (new trace-object-editor% [trace-display trace-display])) (set-editor editor) (define (on-scroll/xy x y dx dy) (unless (= dx 0) (send trace-display scroll-trace/xy x #f))) (define (on-update) (send editor on-update)))) (define trace-object-editor% (class* (ensure-iface pasteboard-util<%> pasteboard-util-mixin (static-pasteboard-mixin pasteboard%)) (updatee<%>) (super-new) (inherit insert get-snip-location) (init-field trace-display) (public on-update) (define header-snip (new trace-header-snip% [trace-display trace-display])) (insert header-snip 0 0) (on-update) (define (on-update) (send header-snip on-update)) )) (define HEADER-OBJECT-HORIZ-OFFSET 50) (define HEADER-OBJECT-VERT-OFFSET 10) (define HEADER-DETAIL-HORIZ-OFFSET 50) (define HEADER-DETAIL-VERT-OFFSET 30) (define trace-header-snip% (class (updatable-snip-mixin (custom-snip-mixin snip%)) (super-new) (init-field trace-display) (override paint extent) (private get-view) (define (get-view) (send trace-display get-view)) (define (extent dc x y) (values (view-width (get-view)) HEADER-HEIGHT 0 0 0 0)) (define (paint easel) (draw-header easel (get-view))))) )