nieh@hudson.steinmetz (nico nieh) (02/04/88)
I am doing some software development on KEE (Knowledge Engineering Environment, IntelliCorp). I tried to display a large file using Common-Window with extent scrolling feature and each token (word) is represented as a hostspot. Users may use mouse to pick up any token and to click a mouse button to activate an action. It worked OK. However the scrolling is extremely slow. I knew that I must did something stupid. Related code is enclosed. Can any one out there give me some help? Thanks in advance, PS: Please forward this message to whomever who may help me out. --------cut-------cut-------cut------------ ;; -*- Mode: LISP; Syntax:Common-lisp; Package:KEE; Base:10. -*- (defvar ww nil) ;; working window (defvar *working-file-name* nil) (defvar *active-hs* nil) (defun make-fop-window () (setq ww (make-window-stream :left 10 :bottom 10 :width 1100 :height 800 :inner-left 10 :inner-bottom 10 :activate-p t :title "FOP Parsing Table Generator" :parent *kee-root-window* :font-set (list (open-font 'fixed-width 'plain 'medium)))) ) (defvar *script-file* nil) (defvar *text* nil) (defun initialize-everything (file-name) (setq *text* nil) (setq *text* (revert-buffer-file file-name)) ) (defun fop (&optional (file-name "c.dat") (script-file "script.lisp")) (setq *script-file* script-file) (setq *working-file-name* file-name) (make-fop-window) (initialize-everything file-name) (enable-window-stream-extent-scrolling ww) (setf (window-stream-extent-height ww) 3000) (setf (window-stream-repaint ww) 'test-repaint) (setf (window-stream-button ww) 'button-fn) (setf (window-stream-y-offset ww) 2250) (repaint ww) ) (defun test-repaint (window region) (setf (window-stream-hotspot-list window) nil) (bitblt window (window-stream-x-offset window) (window-stream-y-offset window) window (window-stream-x-offset window) (window-stream-y-offset window) (window-stream-inner-width window) (window-stream-inner-height window) boole-clr) (setf (window-stream-x-position window) 0) (setf (window-stream-y-position window) (- (window-stream-extent-height window) (window-stream-ascent window))) (write-title ww (concat "FOP working buffer " " ---------- " *working-file-name*)) (setq khn *text*) (do (tmp line line-id word-id (seg-id 1)) ((null khn)) (if (< (nth 0 (car khn)) 0) (progn (format ww "~2D --: " seg-id) (setq seg-id (1+ seg-id))) (format ww "~5D: " (nth 0 (car khn)))) (setq line-id (nth 0 (car khn))) (setq line (nth 1 (car khn))) (setq word-id 0) (setq tmp (break-line line)) (do (str ) ((null tmp)) (setq str (car tmp)) (if (eq '#\space (char str 0)) (format ww str) (progn (generate-hotspot (window-stream-x-position window) (window-stream-y-position window) str line-id word-id window) (setq word-id (1+ word-id)))) (setq tmp (cdr tmp))) (terpri window) (setq khn (cdr khn))) ) (defstruct HOTSPOT region) (defstruct (MY-HOTSPOT (:include hotspot)) menu-to-pop-up yes-no-menu line-id word-id function-to-call) (defun generate-hotspot (x y text line-id word-id window &optional (function-to-call 'default-fn) (menu insert-mark-menu) (y-or-n-menu yes-or-no-menu)) (let* ((old-hs (window-stream-hotspot-list window)) (hs (make-my-hotspot)) (font (window-stream-font window)) (width (font-string-width font text)) (height (font-character-height font))) (setf (window-stream-x-position window) x) (setf (window-stream-y-position window) y) (format window text) (setf (my-hotspot-region hs) (make-region :left x :bottom (- y (window-stream-baseline window)) :width width :height height)) (setf (my-hotspot-function-to-call hs) function-to-call) (setf (my-hotspot-menu-to-pop-up hs) menu) (setf (my-hotspot-line-id hs) line-id) (setf (my-hotspot-word-id hs) word-id) (setf (my-hotspot-yes-no-menu hs) y-or-n-menu) (setf (window-stream-hotspot-list window) (cons hs old-hs)))) (defun button-fn (window mouse-state) (let ((hs (hotspot-under-position window (mouse-state-position mouse-state)))) (if hs (progn (setq *active-hs* hs) (funcall (my-hotspot-function-to-call hs) window mouse-state hs)) (documentation-print "nothing is picked")) )) (defun default-fn (window mouse-state hs) (let ((region (my-hotspot-region hs))) (bitblt window (region-left region) (region-bottom region) window (region-left region) (region-bottom region) (region-width region) (region-height region) boole-c1) (if (equal *hs-action-type* 'select-any-key-word) (pop-up-cascading-menu-choose (my-hotspot-yes-no-menu hs)) (pop-up-cascading-menu-choose (my-hotspot-menu-to-pop-up hs))) (bitblt window (region-left region) (region-bottom region) window (region-left region) (region-bottom region) (region-width region) (region-height region) boole-c1))) Ko-Haw Nieh General Electric Company | ARPA: nieh@ge-crd.arpa Corporate Research and Development | UUCP: nieh@moose.steinmetz.ge.com P.O BOX 8, K1-ES224 | UUCP: {uunet!}steinmetz!nieh!crd Schenectady, NY 12301 | 518-387-7431
nieh@moose (nico nieh) (02/05/88)
I am doing some software development on KEE (Knowledge Engineering Environment, IntelliCorp). I tried to display a large file using Common-Window with extent scrolling feature and each token (word) is represented as a hostspot. Users may use mouse to pick up any token and to click a mouse button to activate an action. It worked OK. However the scrolling is extremely slow. I knew that I must did something stupid. Related code is enclosed. Can any one out there give me some help? Thanks in advance, PS: Please forward this message to whomever who may help me out. Please directly send e-mail to me. --------cut-------cut-------cut------------ ;; -*- Mode: LISP; Syntax:Common-lisp; Package:KEE; Base:10. -*- (defvar ww nil) ;; working window (defvar *working-file-name* nil) (defvar *active-hs* nil) (defun make-fop-window () (setq ww (make-window-stream :left 10 :bottom 10 :width 1100 :height 800 :inner-left 10 :inner-bottom 10 :activate-p t :title "FOP Parsing Table Generator" :parent *kee-root-window* :font-set (list (open-font 'fixed-width 'plain 'medium)))) ) (defvar *script-file* nil) (defvar *text* nil) (defun initialize-everything (file-name) (setq *text* nil) (setq *text* (revert-buffer-file file-name)) ) (defun fop (&optional (file-name "c.dat") (script-file "script.lisp")) (setq *script-file* script-file) (setq *working-file-name* file-name) (make-fop-window) (initialize-everything file-name) (enable-window-stream-extent-scrolling ww) (setf (window-stream-extent-height ww) 3000) (setf (window-stream-repaint ww) 'test-repaint) (setf (window-stream-button ww) 'button-fn) (setf (window-stream-y-offset ww) 2250) (repaint ww) ) (defun test-repaint (window region) (setf (window-stream-hotspot-list window) nil) (bitblt window (window-stream-x-offset window) (window-stream-y-offset window) window (window-stream-x-offset window) (window-stream-y-offset window) (window-stream-inner-width window) (window-stream-inner-height window) boole-clr) (setf (window-stream-x-position window) 0) (setf (window-stream-y-position window) (- (window-stream-extent-height window) (window-stream-ascent window))) (write-title ww (concat "FOP working buffer " " ---------- " *working-file-name*)) (setq khn *text*) (do (tmp line line-id word-id (seg-id 1)) ((null khn)) (if (< (nth 0 (car khn)) 0) (progn (format ww "~2D --: " seg-id) (setq seg-id (1+ seg-id))) (format ww "~5D: " (nth 0 (car khn)))) (setq line-id (nth 0 (car khn))) (setq line (nth 1 (car khn))) (setq word-id 0) (setq tmp (break-line line)) (do (str ) ((null tmp)) (setq str (car tmp)) (if (eq '#\space (char str 0)) (format ww str) (progn (generate-hotspot (window-stream-x-position window) (window-stream-y-position window) str line-id word-id window) (setq word-id (1+ word-id)))) (setq tmp (cdr tmp))) (terpri window) (setq khn (cdr khn))) ) (defstruct HOTSPOT region) (defstruct (MY-HOTSPOT (:include hotspot)) menu-to-pop-up yes-no-menu line-id word-id function-to-call) (defun generate-hotspot (x y text line-id word-id window &optional (function-to-call 'default-fn) (menu insert-mark-menu) (y-or-n-menu yes-or-no-menu)) (let* ((old-hs (window-stream-hotspot-list window)) (hs (make-my-hotspot)) (font (window-stream-font window)) (width (font-string-width font text)) (height (font-character-height font))) (setf (window-stream-x-position window) x) (setf (window-stream-y-position window) y) (format window text) (setf (my-hotspot-region hs) (make-region :left x :bottom (- y (window-stream-baseline window)) :width width :height height)) (setf (my-hotspot-function-to-call hs) function-to-call) (setf (my-hotspot-menu-to-pop-up hs) menu) (setf (my-hotspot-line-id hs) line-id) (setf (my-hotspot-word-id hs) word-id) (setf (my-hotspot-yes-no-menu hs) y-or-n-menu) (setf (window-stream-hotspot-list window) (cons hs old-hs)))) (defun button-fn (window mouse-state) (let ((hs (hotspot-under-position window (mouse-state-position mouse-state)))) (if hs (progn (setq *active-hs* hs) (funcall (my-hotspot-function-to-call hs) window mouse-state hs)) (documentation-print "nothing is picked")) )) (defun default-fn (window mouse-state hs) (let ((region (my-hotspot-region hs))) (bitblt window (region-left region) (region-bottom region) window (region-left region) (region-bottom region) (region-width region) (region-height region) boole-c1) (if (equal *hs-action-type* 'select-any-key-word) (pop-up-cascading-menu-choose (my-hotspot-yes-no-menu hs)) (pop-up-cascading-menu-choose (my-hotspot-menu-to-pop-up hs))) (bitblt window (region-left region) (region-bottom region) window (region-left region) (region-bottom region) (region-width region) (region-height region) boole-c1))) Ko-Haw Nieh General Electric Company | ARPA: nieh@ge-crd.arpa Corporate Research and Development | UUCP: nieh@moose.steinmetz.ge.com