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