(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 view trace-display) (public on-update) (override on-scroll/xy) (define editor (new trace-object-editor% [view view])) (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 view) (public on-update) (define header-snip (new trace-header-snip% [view view])) (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 view) (override paint extent) (define (extent dc x y) (values (view-width view) HEADER-HEIGHT 0 0 0 0)) (define (paint easel) (draw-header easel view)))) )