|
2
|
1 ;;; w3-imap.el --- Imagemap functions
|
|
0
|
2 ;; Author: wmperry
|
|
16
|
3 ;; Created: 1997/01/10 00:13:05
|
|
|
4 ;; Version: 1.7
|
|
0
|
5 ;; Keywords: hypermedia
|
|
|
6
|
|
|
7 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
2
|
8 ;;; Copyright (c) 1996 by William M. Perry (wmperry@cs.indiana.edu)
|
|
16
|
9 ;;; Copyright (c) 1996, 1997 Free Software Foundation, Inc.
|
|
0
|
10 ;;;
|
|
|
11 ;;; This file is part of GNU Emacs.
|
|
|
12 ;;;
|
|
|
13 ;;; GNU Emacs is free software; you can redistribute it and/or modify
|
|
|
14 ;;; it under the terms of the GNU General Public License as published by
|
|
|
15 ;;; the Free Software Foundation; either version 2, or (at your option)
|
|
|
16 ;;; any later version.
|
|
|
17 ;;;
|
|
|
18 ;;; GNU Emacs is distributed in the hope that it will be useful,
|
|
|
19 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
|
20 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
|
21 ;;; GNU General Public License for more details.
|
|
|
22 ;;;
|
|
|
23 ;;; You should have received a copy of the GNU General Public License
|
|
14
|
24 ;;; along with GNU Emacs; see the file COPYING. If not, write to the
|
|
|
25 ;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
|
|
|
26 ;;; Boston, MA 02111-1307, USA.
|
|
0
|
27 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
28
|
|
|
29 (require 'w3-vars)
|
|
14
|
30 (eval-and-compile
|
|
|
31 (require 'widget))
|
|
0
|
32
|
|
|
33 (eval-when-compile
|
|
|
34 (defmacro x-coord (pt) (list 'aref pt 0))
|
|
|
35 (defmacro y-coord (pt) (list 'aref pt 1)))
|
|
|
36
|
|
|
37 (defun w3-point-in-rect (point coord1 coord2 &rest ignore)
|
|
|
38 "Return t iff POINT is within a rectangle defined by COORD1 and COORD2.
|
|
|
39 All arguments are vectors of [X Y] coordinates."
|
|
|
40 ;; D'uhhh, this is hard.
|
|
|
41 (and (>= (x-coord point) (x-coord coord1))
|
|
|
42 (<= (x-coord point) (x-coord coord2))
|
|
|
43 (>= (y-coord point) (y-coord coord1))
|
|
|
44 (<= (y-coord point) (y-coord coord2))))
|
|
|
45
|
|
|
46 (defun w3-point-in-circle (point coord1 coord2 &rest ignore)
|
|
|
47 "Return t iff POINT is within a circle defined by COORD1 and COORD2.
|
|
|
48 All arguments are vectors of [X Y] coordinates."
|
|
|
49 ;; D'uhhh, this is (barely) slightly harder.
|
|
|
50 (let (radius1 radius2)
|
|
|
51 (setq radius1 (+
|
|
|
52 (*
|
|
|
53 (- (y-coord coord1) (y-coord coord2))
|
|
|
54 (- (y-coord coord1) (y-coord coord2)))
|
|
|
55 (*
|
|
|
56 (- (x-coord coord1) (x-coord coord2))
|
|
|
57 (- (x-coord coord1) (x-coord coord2)))
|
|
|
58 )
|
|
|
59 radius2 (+
|
|
|
60 (*
|
|
|
61 (- (y-coord coord1) (y-coord point))
|
|
|
62 (- (y-coord coord1) (y-coord point)))
|
|
|
63 (*
|
|
|
64 (- (x-coord coord1) (x-coord point))
|
|
|
65 (- (x-coord coord1) (x-coord point)))
|
|
|
66 )
|
|
|
67 )
|
|
|
68 (<= radius2 radius1)))
|
|
|
69
|
|
|
70 ;; A polygon is a vector
|
|
|
71 ;; poly[0] = # of sides
|
|
|
72 ;; poly[1] = # of sides used
|
|
|
73 ;; poly[2] = vector of X coords
|
|
|
74 ;; poly[3] = vector of Y coords
|
|
|
75
|
|
|
76 (defsubst w3-image-poly-nsegs (p)
|
|
|
77 (aref p 0))
|
|
|
78
|
|
|
79 (defsubst w3-image-poly-used-segs (p)
|
|
|
80 (aref p 1))
|
|
|
81
|
|
|
82 (defsubst w3-image-poly-x-coords (p)
|
|
|
83 (aref p 2))
|
|
|
84
|
|
|
85 (defsubst w3-image-poly-y-coords (p)
|
|
|
86 (aref p 3))
|
|
|
87
|
|
|
88 (defsubst w3-image-poly-x-coord (p n)
|
|
|
89 (aref (w3-image-poly-x-coords p) n))
|
|
|
90
|
|
|
91 (defsubst w3-image-poly-y-coord (p n)
|
|
|
92 (aref (w3-image-poly-y-coords p) n))
|
|
|
93
|
|
|
94 (defun w3-image-poly-alloc (n)
|
|
|
95 (if (< n 3)
|
|
|
96 (error "w3-image-poly-alloc: invalid number of sides (%d)" n))
|
|
|
97
|
|
|
98 (vector n 0 (make-vector n nil) (make-vector n nil)))
|
|
|
99
|
|
|
100 (defun w3-image-poly-assign (p x y)
|
|
|
101 (if (>= (w3-image-poly-used-segs p) (w3-image-poly-nsegs p))
|
|
|
102 (error "w3-image-poly-assign: out of space in the w3-image-polygon"))
|
|
|
103 (aset (w3-image-poly-x-coords p) (w3-image-poly-used-segs p) x)
|
|
|
104 (aset (w3-image-poly-y-coords p) (w3-image-poly-used-segs p) y)
|
|
|
105 (aset p 1 (1+ (w3-image-poly-used-segs p))))
|
|
|
106
|
|
|
107 (defun w3-image-ccw (p0 p1 p2)
|
|
|
108 (let (dx1 dx2 dy1 dy2 retval)
|
|
|
109 (setq dx1 (- (x-coord p1) (x-coord p0))
|
|
|
110 dy1 (- (y-coord p1) (y-coord p0))
|
|
|
111 dx2 (- (x-coord p2) (x-coord p0))
|
|
|
112 dy2 (- (y-coord p2) (y-coord p0)))
|
|
|
113 (cond
|
|
|
114 ((> (* dx1 dy2) (* dy1 dx2))
|
|
|
115 (setq retval 1))
|
|
|
116 ((< (* dx1 dy2) (* dy1 dx2))
|
|
|
117 (setq retval -1))
|
|
|
118 ((or (< (* dx1 dx2) 0)
|
|
|
119 (< (* dy1 dy2) 0))
|
|
|
120 (setq retval -1))
|
|
|
121 ((< (+ (* dx1 dx1) (* dy1 dy1))
|
|
|
122 (+ (* dx2 dx2) (* dy2 dy2)))
|
|
|
123 (setq retval 1))
|
|
|
124 (t
|
|
|
125 (setq retval 0)))
|
|
|
126 retval))
|
|
|
127
|
|
|
128 (defun w3-image-line-intersect (l1 l2)
|
|
|
129 (and (<= (* (w3-image-ccw (car l1) (cdr l1) (car l2))
|
|
|
130 (w3-image-ccw (car l1) (cdr l1) (cdr l2))) 0)
|
|
|
131 (<= (* (w3-image-ccw (car l2) (cdr l2) (car l1))
|
|
|
132 (w3-image-ccw (car l2) (cdr l2) (cdr l1))) 0)))
|
|
|
133
|
|
|
134 (defun w3-point-in-poly (point &rest pgon)
|
|
|
135 "Return t iff POINT is within a polygon defined by the list of points PGON.
|
|
|
136 All arguments are either vectors of [X Y] coordinates or lists of such
|
|
|
137 vectors."
|
|
|
138 ;; Right now, this fails on some points that are right on a line segment
|
|
|
139 ;; but it works for everything else (I think)
|
|
|
140 (if (< (length pgon) 3)
|
|
|
141 ;; Malformed polygon!!!
|
|
|
142 nil
|
|
|
143 (let ((p (w3-image-poly-alloc (length pgon)))
|
|
|
144 (hitcount 0)
|
|
|
145 (i 0)
|
|
|
146 (ip1 0)
|
|
|
147 (l1 nil)
|
|
|
148 (l2 (cons (vector (x-coord point) (1+ (y-coord point)))
|
|
|
149 (vector (x-coord point) (y-coord point))))
|
|
|
150 )
|
|
|
151 (while pgon
|
|
|
152 (w3-image-poly-assign p (x-coord (car pgon)) (y-coord (car pgon)))
|
|
|
153 (setq pgon (cdr pgon)))
|
|
|
154 (while (< i (w3-image-poly-nsegs p))
|
|
|
155 ;; Check for wraparound
|
|
|
156 (setq ip1 (1+ i))
|
|
|
157 (if (= ip1 (w3-image-poly-nsegs p))
|
|
|
158 (setq ip1 0))
|
|
|
159
|
|
|
160 (setq l1 (cons (vector (w3-image-poly-x-coord p i)
|
|
|
161 (w3-image-poly-y-coord p i))
|
|
|
162 (vector (w3-image-poly-x-coord p ip1)
|
|
|
163 (w3-image-poly-y-coord p ip1))))
|
|
|
164
|
|
|
165 (if (w3-image-line-intersect l1 l2)
|
|
|
166 (setq hitcount (1+ hitcount)))
|
|
|
167 (setq i (1+ i)))
|
|
|
168 (= 1 (% hitcount 2)))))
|
|
|
169
|
|
|
170 (defun w3-point-in-default (point &rest ignore)
|
|
|
171 t)
|
|
|
172
|
|
|
173 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
174
|
|
|
175 (defun w3-point-in-map (point map &optional alt-text)
|
|
|
176 (let (func args done cur default slot)
|
|
|
177 (setq slot (if alt-text 3 2))
|
|
|
178 (while (and map (not done))
|
|
|
179 (setq cur (car map)
|
|
|
180 func (intern-soft (format "w3-point-in-%s" (aref cur 0)))
|
|
|
181 args (aref cur 1)
|
|
|
182 done (and func (fboundp func) (apply func point args))
|
|
|
183 map (cdr map))
|
|
|
184 (if (equal (aref cur 0) "default")
|
|
|
185 (setq default (aref cur slot)
|
|
|
186 done nil)))
|
|
|
187 (cond
|
|
|
188 ((and done (aref cur 2)) ; Found a link
|
|
|
189 (if alt-text
|
|
|
190 (or (aref cur 3) (aref cur 2))
|
|
|
191 (aref cur slot)))
|
|
|
192 (default
|
|
|
193 default)
|
|
|
194 (t nil))))
|
|
|
195
|
|
|
196
|
|
|
197 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
198 ;;; Regular image stuff
|
|
|
199 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
200 (defvar w3-allowed-image-types
|
|
|
201 (mapcar (function (lambda (x) (list (car x)))) w3-image-mappings))
|
|
|
202 (defvar w3-image-size-restriction nil)
|
|
|
203
|
|
|
204 (defmacro w3-image-cached-p (href)
|
|
|
205 "Return non-nil iff HREF is in the image cache."
|
|
|
206 (` (cdr-safe (assoc (, href) w3-graphics-list))))
|
|
|
207
|
|
|
208 (defun w3-image-loadable-p (href force)
|
|
|
209 (let ((attribs (url-file-attributes href)))
|
|
|
210 (or force
|
|
|
211 (assoc (nth 8 attribs) w3-allowed-image-types)
|
|
|
212 (null w3-image-size-restriction)
|
|
|
213 (<= (nth 7 attribs) 0)
|
|
|
214 (and (numberp w3-image-size-restriction)
|
|
|
215 (<= (nth 7 attribs) w3-image-size-restriction)))))
|
|
|
216
|
|
|
217 (defmacro w3-image-invalid-glyph-p (glyph)
|
|
|
218 (` (or (null (aref (, glyph) 0))
|
|
|
219 (null (aref (, glyph) 2))
|
|
|
220 (equal (aref (, glyph) 2) ""))))
|
|
|
221
|
|
|
222 ;; data structure in storage is a vector
|
|
|
223 ;; if (href == t) then no action should be taken
|
|
|
224 ;; [ type coordinates href (hopefully)descriptive-text]
|
|
|
225
|
|
|
226
|
|
|
227 (provide 'w3-imap)
|
