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