;;; -*- mode:lisp; base:10.; fonts:cptfont; package:tv; -*- ;;; ;;; $Header: /ct/window/percent.l,v 1.2 84/05/03 17:49:10 jmiller Exp $ ;;; $Log: /ct/window/percent.l,v $ ;;;Revision 1.2 84/05/03 17:49:10 jmiller ;;;changed 3 pixel-wide percent bar to 10 pixels ;;; ;;;Revision 1.1 83/07/20 10:25:26 john ;;;Initial revision ;;; ;;; ;;; **************************************************************** ;;; ;;; John L. Shelton ;;; ;;; Percent ;;; ;;; This file is part of a proprietary software project. Source ;;; code and documentation describing implementation details are ;;; available on a confidential, non-disclosure basis only. These ;;; materials, including this file in particular, are trade secrets ;;; of Computer * Thought Corporation. ;;; ;;; (c) Copyright 1982 and 1983, Computer * Thought Corporation. ;;; All Rights Reserved. ;;; ;;; Reference materials: ;;; Foderaro and Sklower, The FRANZ LISP Manual, September 1981. ;;; Weinreb and Moon, LISP MACHINE MANUAL, Symbolics, July 1981. ;;; Charniak et al., 1980. Artificial Intelligence Programming. ;;; Miller, 1982. The C*T Ada Tutor: Guide to the Implementation. ;;; The following code assumes familiarity with these materials. ;;; Ensure presence of needed files. #| This file contains code to implement the PERCENT mixin for lisp machine windows. The percent mixin allows a window to indicate some percentage of something as a bar along one of the edges of the window. Commonly, this could be used to indicate how much of a file is visible, or has been looked at. The percent bar can be displayed against any side of the window. The percent-side instance variable tells which one, and should be set to one of 'top, 'bottom, 'left, or 'right. Generally, percentages increase from top to bottom, and from left to right. The percent bar can be solid from 0 to whatever by setting percent to a number from 0 to 100. Numbers outside this range have no effect. If a range is specified, as in '(40 60), then the bar will be drawn from 40% to 60%. The percent bar is always drawn as a line of thickness 3 just against the inside margin. ;;;;;;;;;;; ;;;;;;;;;;;JRM modification: changed thickness of 3 to 10, and eliminated ;;;;;;;;;;;other inner borders; changes flagged. ;;;;;;;;;;; |# ;;; The default-init-plist ascertains that we get our funny ;;; border drawing function, on the right side. (defflavor percent-mixin ((percent '(0 0)) (percent-side ':right)) () (:required-flavors tv:minimum-window) :gettable-instance-variables (:default-init-plist :borders '((draw-centered-border . 0) ;;;four jrm changes: (draw-centered-border . 0) ;;;was 3,3,3,3 (draw-percent-border . 10) (draw-centered-border . 0))) #+lispm :initable-instance-variables) (defflavor percent-window () (percent-mixin window)) ;;; Setting the instance variables, we are careful to check ;;; their validity. If a value is not valid, no action is taken, ;;; but the percentage bar is removed. (defmethod (percent-mixin :set-percent) (val) (cond ((and (numberp val) (<= 0 val 100)) (setq percent (list 0 val))) ((and (listp val) (numberp (car val)) (numberp (cadr val)) (<= 0 (car val) (cadr val) 100)) (setq percent val)) (t (setq val nil))) (if val (send self ':display-percent))) (defmethod (percent-mixin :set-percent-side) (side) (send self ':clear-current-side) (cond ((eq side ':right) (send self ':set-borders '((draw-centered-border . 0) ;;;jrm changes from (draw-centered-border . 0) ;;;3,3,3,3 (draw-percent-border . 10) (draw-centered-border . 0)))) ((eq side ':left) (send self ':set-borders '((draw-percent-border . 3) (draw-centered-border . 3) (draw-centered-border . 3) (draw-centered-border . 3)))) ((eq side ':top) (send self ':set-borders '((draw-centered-border . 3) (draw-percent-border . 3) (draw-centered-border . 3) (draw-centered-border . 3)))) ((eq side ':bottom) (send self ':set-borders '((draw-centered-border . 3) (draw-centered-border . 3) (draw-centered-border . 3) (draw-percent-border . 3)))) (t (setq side nil))) (if side (send self ':display-percent))) ; ;(defmethod (percent-mixin :after :expose) ; (&rest ignore) ; (send self ':display-percent)) ; (defmethod (percent-mixin :display-percent) () (send self ':refresh-margins)) (defmethod (percent-mixin :clear-current-side) () (let ((old-percent percent)) (setq percent '(0 0)) (send self ':display-percent) (setq percent old-percent))) ;;; Required by border system, even though I think this will never be ;;; used. (defprop draw-percent-border 10 default-border-size) ;;;jrm: 3 -> 10 ;;; This function runs in some other process, and actually draws the ;;; border on a window. We ask the window for a percentage; The border ;;; will be drawn only in that percentage interval. Function determines ;;; if it is drawing a horizontal (top or bottom) border, or a vertical ;;; (left or right) border, then draws a line of width 1 for the whole ;;; length. Finally, it draws a line of width in the right place. (defun draw-percent-border (window alu left top right bottom) (let ((percent (send window ':percent)) (wide (- right left)) (high (- bottom top))) (cond ;;;jrm changes: 3 -> 10 ((> wide high) ;top or bottom (%draw-rectangle wide 10 left top tv:alu-andca window) ;clear (%draw-rectangle wide 1 left (1+ top) alu window) ;draw thin line (%draw-rectangle (// (* (- (cadr percent) (car percent)) wide) 100.) 10 (+ left (// (* (car percent) wide) 100.)) top alu window)) (t ;left or right (%draw-rectangle 10 high left top tv:alu-andca window) ;clear (%draw-rectangle 1 high (1+ left) top alu window) ;draw thin line (%draw-rectangle 10 (// (* (- (cadr percent) (car percent)) high) 100.) left (+ top (// (* (car percent) high) 100.)) alu window))))) ;;; This is needed to draw a thin border in the center of a thick border. ;;; simple enough to implement. (defun draw-centered-border (window alu left top right bottom) (let ((wide (- right left)) (high (- bottom top))) (cond ((> wide high) ;top or bottom (%draw-rectangle wide 1 left (1+ top) alu window)) ;draw thin line (t ;left or right (%draw-rectangle 1 high (1+ left) top alu window))))) ;draw thin line