Posted to tcl by hypnotoad at Fri Jan 22 16:28:19 GMT 2016view raw

  1.  
  2. /*
  3. ** This file implements a TCL object that keeps track of the walls and
  4. ** bulkheads on a single deck of a ship.
  5. **
  6. ** This widget assumes a right-handed coordinate system if zoom is positive
  7. ** and a left-handed coordinate system is zoom is negative. The Tk canvas
  8. ** widget uses a left-handed coordinate system all the time. The READI
  9. ** database uses a right-handed coordinate system all the time. This module
  10. ** can be used to translate by setting zoom to +1.0 for database I/O and
  11. ** to -$g(zoom) for canvas I/O.
  12. **
  13. ** This module uses a purely 2-D model. It can only handle a single
  14. ** deck at a time. If a multi-deck model needs to be displayed then
  15. ** that multi-deck model should first be flattened into a stack of
  16. ** individual decks in the same plane using the separate "slicer" object.
  17. **
  18. ** This file implements a single new constructor tcl command named "wallset".
  19. ** The wallset command creates a new wallset object. Methods on this
  20. ** wallset object are used to manage the object.
  21. **
  22. ** The details of the various methods and what they do are provided in
  23. ** header comments above the implementation of each method.
  24. */
  25.  
  26. #include "odielibInt.h"
  27. #include <tclOO.h>
  28. #include <stdarg.h>
  29. #include <stdlib.h>
  30. #include <assert.h>
  31. #include <string.h>
  32. #include <math.h>
  33.  
  34. #ifndef M_PI
  35. # define M_PI 3.1415926535898
  36. #endif
  37.  
  38. /*
  39. ** Remove all of the ComptBox entries from the wallset.
  40. */
  41. static void clearComptBoxCache(Wallset *pWS){
  42. ComptBox *p = pWS->pComptBox;
  43. while( p ){
  44. ComptBox *pNext = p->pNext;
  45. Odie_Free((char *)p);
  46. p = pNext;
  47. }
  48. pWS->pComptBox = 0;
  49. }
  50.  
  51. /*
  52. ** This routine is invoked when the TCL command that implements a
  53. ** wallset is deleted. Free all memory associated with that
  54. ** wallset.
  55. */
  56. static void destroyWallset(void *pArg){
  57. Wallset *p = (Wallset*)pArg;
  58. Link *pLink = p->pAll;
  59. clearComptBoxCache(p);
  60. while( pLink ){
  61. Segment *pSeg = pLink->pLinkNode;
  62. pLink = pSeg->pAll.pNext;
  63. Odie_Free((char *) pSeg );
  64. }
  65. Odie_Free((char *) p );
  66. }
  67.  
  68. /*
  69. ** Clear the Segment.ignore flag on all segments within a wallset.
  70. */
  71. static void ignoreNone(Wallset *p){
  72. #if 0
  73. Link *pLink;
  74. for(pLink=p->pAll; pLink; pLink=pLink->pNext){
  75. pLink->pSeg->ignore = 0;
  76. }
  77. #endif
  78. }
  79.  
  80. /*
  81. ** Return a pointer to the segment with the given ID. Return NULL
  82. ** if there is no such segment.
  83. */
  84. static Segment *findSegment(Wallset *p, int id){
  85. int h;
  86. Link *pLink;
  87.  
  88. h = hashInt(id);
  89. for(pLink = p->hashId[h]; pLink; pLink=pLink->pNext){
  90. Segment *pSeg=pLink->pLinkNode;
  91. if( pSeg->id==id ) return pSeg;
  92. }
  93. return 0;
  94. }
  95.  
  96. /*
  97. ** Scan all segments looking for the vertex or vertices that are nearest
  98. ** to x,y. Return a pointer to a Segment.set that is the list of matching
  99. ** segments. Also write the nearest point into *pX,*pY.
  100. **
  101. ** The returned list uses the Segment.set link.
  102. */
  103. static Link *nearestVertex(
  104. Wallset *p, /* The wallset to be scanned */
  105. double x, double y, /* Search for points near to this point */
  106. double *pX, double *pY /* Write nearest vertex here */
  107. ){
  108. double nx, ny;
  109. double min = -1.0;
  110. Link *pList = 0;
  111. Link *pI;
  112.  
  113. x = roundCoord(x);
  114. y = roundCoord(y);
  115. for(pI=p->pAll; pI; pI=pI->pNext){
  116. double dx, dy, dist;
  117. Segment *pSeg = pI->pLinkNode;
  118. dx = x - pSeg->from[X_IDX];
  119. dy = y - pSeg->from[Y_IDX];
  120. dist = dx*dx + dy*dy;
  121. if( min<0.0 || dist<=min ){
  122. if( min<0.0 || nx!=pSeg->from[X_IDX] || ny!=pSeg->from[Y_IDX] ){
  123. pList = 0;
  124. nx = pSeg->from[X_IDX];
  125. ny = pSeg->from[Y_IDX];
  126. min = dist;
  127. }
  128. LinkInit(pSeg->pSet, pSeg);
  129. LinkInsert(&pList, &pSeg->pSet);
  130. }
  131. dx = x - pSeg->to[X_IDX];
  132. dy = y - pSeg->to[Y_IDX];
  133. dist = dx*dx + dy*dy;
  134. if( dist<=min ){
  135. if( nx!=pSeg->to[X_IDX] || ny!=pSeg->to[Y_IDX] ){
  136. pList = 0;
  137. nx = pSeg->to[X_IDX];
  138. ny = pSeg->to[Y_IDX];
  139. min = dist;
  140. }
  141. LinkInit(pSeg->pSet, pSeg);
  142. LinkInsert(&pList, &pSeg->pSet);
  143. }
  144. }
  145. *pX = nx;
  146. *pY = ny;
  147. return pList;
  148. }
  149.  
  150. /*
  151. ** Scan all segments looking for the point on a segment that is nearest
  152. ** to x,y. Return a pointer to a Segment.set that is the list of matching
  153. ** segments. This set might contain multiple members if the nearest point
  154. ** is actually a vertex shared by two or more segments. Write the nearest
  155. ** point into *pX, *pY.
  156. **
  157. ** /// Ignore any segment that has its Segment.ignore flag set. -- removed
  158. **
  159. ** The returned list uses the Segment.set list.
  160. */
  161. static Link *nearestPoint(
  162. Wallset *p, /* The wallset to be scanned */
  163. double x, double y, /* Search for points near to this point */
  164. double *pX, double *pY /* Write nearest vertex here */
  165. ){
  166. double nx, ny;
  167. double min = -1.0;
  168. Link *pList = 0;
  169. Link *pI;
  170.  
  171. x = roundCoord(x);
  172. y = roundCoord(y);
  173. for(pI=p->pAll; pI; pI=pI->pNext){
  174. double dx, dy, dist;
  175. Segment *pSeg;
  176. double acx, acy; /* Vector from x0,y0 to x,y */
  177. double abx, aby; /* Vector from x0,y0 to x1,y1 */
  178. double rx, ry; /* Nearest point on x0,y0->to[X_IDX],y1 to x,y */
  179. double r;
  180.  
  181. pSeg = pI->pLinkNode;
  182. /* if( pSeg->ignore ) continue; */
  183. acx = x - pSeg->from[X_IDX];
  184. acy = y - pSeg->from[Y_IDX];
  185. abx = pSeg->to[X_IDX] - pSeg->from[X_IDX];
  186. aby = pSeg->to[Y_IDX] - pSeg->from[Y_IDX];
  187. r = (acx*abx + acy*aby)/(abx*abx + aby*aby);
  188. if( r<=0 ){
  189. rx = pSeg->from[X_IDX];
  190. ry = pSeg->from[Y_IDX];
  191. }else if( r>=1 ){
  192. rx = pSeg->to[X_IDX];
  193. ry = pSeg->to[Y_IDX];
  194. }else{
  195. rx = pSeg->from[X_IDX] + abx*r;
  196. ry = pSeg->from[Y_IDX] + aby*r;
  197. }
  198. rx = roundCoord(rx);
  199. ry = roundCoord(ry);
  200. dx = x - rx;
  201. dy = y - ry;
  202. dist = dx*dx + dy*dy;
  203. if( min<0.0 || dist<=min ){
  204. if( min<0.0 || nx!=rx || ny!=ry ){
  205. pList = 0;
  206. nx = rx;
  207. ny = ry;
  208. min = dist;
  209. }
  210. LinkInit(pSeg->pSet, pSeg);
  211. LinkInsert(&pList, &pSeg->pSet);
  212. }
  213. }
  214. *pX = nx;
  215. *pY = ny;
  216. return pList;
  217. }
  218.  
  219. /*
  220. ** Return TRUE if the value x is in between x1 and x2.
  221. */
  222. static int between(double x, double x1, double x2){
  223. if( x1<x2 ){
  224. return x>=x1 && x<=x2;
  225. }else{
  226. return x>=x2 && x<=x1;
  227. }
  228. }
  229.  
  230. /*
  231. ** Return TRUE if the given segment is on the given list
  232. */
  233. static int segmentOnList(Segment *pSeg, Link *pList){
  234. while( pList ){
  235. if( pList->pLinkNode==pSeg ) return 1;
  236. pList = pList->pNext;
  237. }
  238. return 0;
  239. }
  240.  
  241. /*
  242. ** Return a list of all segments which have an end at the given vertex.
  243. ** The returned list uses Segment.set
  244. */
  245. static Link *segmentsAtVertex(Wallset *p, double x, double y){
  246. Link *pList = 0;
  247. Link *pI;
  248. int h;
  249.  
  250. x = roundCoord(x);
  251. y = roundCoord(y);
  252. h = hashCoord(x, y);
  253. for(pI=p->hashFrom[h]; pI; pI=pI->pNext){
  254. Segment *pSeg = pI->pLinkNode;
  255. /* if( pSeg->ignore ) continue; */
  256. if( floatCompare(x, pSeg->from[X_IDX])==0 && floatCompare(y, pSeg->from[Y_IDX])==0 ){
  257. assert( !segmentOnList(pSeg, pList) );
  258. LinkInit(pSeg->pSet, pSeg);
  259. LinkInsert(&pList, &pSeg->pSet);
  260. }
  261. }
  262. for(pI=p->hashTo[h]; pI; pI=pI->pNext){
  263. Segment *pSeg = pI->pLinkNode;
  264. /* if( pSeg->ignore ) continue; */
  265. if( floatCompare(x, pSeg->to[X_IDX])==0 && floatCompare(y, pSeg->to[Y_IDX])==0 ){
  266. assert( !segmentOnList(pSeg, pList) );
  267. LinkInit(pSeg->pSet, pSeg);
  268. LinkInsert(&pList, &pSeg->pSet);
  269. }
  270. }
  271. return pList;
  272. }
  273.  
  274. /*
  275. ** The point xV,yV is a vertex in the wallset. This routine locates
  276. ** a segment connected to that vertex which is the first segment in
  277. ** a clockwise direction from xR,yR->xV,yV. A pointer to the segment
  278. ** is written into *ppSeg. If the output segment moves backwards
  279. ** (in other words if x1,y1 of the segment is connected at xV,yV)
  280. ** then *pfBack is true.
  281. **
  282. ** If a suitable segment is found, 0 is returned. Non-zero is returned
  283. ** if no suitable segment could be found.
  284. **
  285. ** This routine uses the Segment.set list internally.
  286. */
  287. static int nextCwSegment(
  288. Wallset *p, /* The wallset */
  289. double xR, double yR, /* Remote end of input segment */
  290. double xV, double yV, /* Vertex (near end of input segment) */
  291. Segment **ppSeg, /* OUT: First segment clockwise from xR,yR->xV,yV */
  292. int *pfBack /* OUT: True if output segment goes backwards */
  293. ){
  294. Link *pList, *pI;
  295. double rRef, rBest;
  296. int i, nSeg, iBest;
  297. Segment *pSeg;
  298. struct {
  299. Segment *pSeg;
  300. int isBack;
  301. double rAngle;
  302. } *aSeg, aSegStatic[20];
  303.  
  304. /* Find all segments at xV,yV */
  305. pList = segmentsAtVertex(p, xV, yV);
  306. for(pI=pList, nSeg=0; pI; nSeg++, pI=pI->pNext){}
  307. if( nSeg==0 ) return 1;
  308. if( nSeg<=sizeof(aSegStatic)/sizeof(aSegStatic[0]) ){
  309. aSeg = aSegStatic;
  310. }else{
  311. aSeg = (void *)Odie_Alloc( nSeg*sizeof(*aSeg) );
  312. }
  313. for(pI=pList, i=0; pI; i++, pI=pI->pNext){
  314. aSeg[i].pSeg = pSeg = pI->pLinkNode;
  315. aSeg[i].isBack = floatCompare(xV, pSeg->to[X_IDX])==0
  316. && floatCompare(yV, pSeg->to[Y_IDX])==0;
  317. }
  318.  
  319. /* Find the reference angle */
  320. rRef = atan2(yR-yV, xR-xV)*180.0/M_PI;
  321.  
  322. /* Find angles on all segments */
  323. for(i=0; i<nSeg; i++){
  324. pSeg = aSeg[i].pSeg;
  325. if( aSeg[i].isBack ){
  326. aSeg[i].rAngle = atan2(pSeg->from[Y_IDX]-pSeg->to[Y_IDX], pSeg->from[X_IDX]-pSeg->to[X_IDX])*180.0/M_PI;
  327. }else{
  328. aSeg[i].rAngle = atan2(pSeg->to[Y_IDX]-pSeg->from[Y_IDX], pSeg->to[X_IDX]-pSeg->from[X_IDX])*180.0/M_PI;
  329. }
  330. }
  331.  
  332. /* Subtract 360 to any segment angle that is less than the reference angle */
  333. for(i=0; i<nSeg; i++){
  334. if( aSeg[i].rAngle<rRef ) aSeg[i].rAngle += 360;
  335. }
  336.  
  337. /* Choose the segment with the largest angle */
  338. rBest = aSeg[0].rAngle;
  339. iBest = 0;
  340. for(i=1; i<nSeg; i++){
  341. if( aSeg[i].rAngle>rBest ){
  342. iBest = i;
  343. rBest = aSeg[i].rAngle;
  344. }
  345. }
  346. *ppSeg = aSeg[iBest].pSeg;
  347. *pfBack = aSeg[iBest].isBack;
  348. if( aSeg!=aSegStatic ){
  349. Odie_Free((char *) aSeg );
  350. }
  351.  
  352. return 0;
  353. }
  354.  
  355. /*
  356. ** Consider a line beginning at x0,y0 then going from x1,y1 to x2,y2.
  357. ** x1,y1 is an elbow in the line. This routine returns -1 if the
  358. ** elbow bends to the right, and +1 if it bends to the left. zero is
  359. ** returned if the elbow does not bend at all.
  360. */
  361. static int bendDirection(
  362. double x0, double y0,
  363. double x1, double y1,
  364. double x2, double y2
  365. ){
  366. /* Algorithm: Rotate x0,y0->to[X_IDX],y1 90 degrees counter-clockwise. Take
  367. ** the dot product with x1,y1->x2,y2. The dot produce will be the product
  368. ** of two (non-negative) magnitudes and the cosine of the angle. So if
  369. ** the dot product is positive, the bend is to the left, or to the right if
  370. ** the dot product is negative.
  371. */
  372. double r = (y0-y1)*(x2-x1) + (x1-x0)*(y2-y1);
  373. return r<0.0 ? +1 : (r>0.0 ? -1 : 0);
  374. }
  375.  
  376. /*
  377. ** Given an interior point xI,yI, this routine finds a segment on the
  378. ** boundary that contains the interior point. That segment is returned
  379. ** in *ppSeg. *pfLeft is set to true if the interior point is to the left
  380. ** of the segment and false if it is to the right.
  381. **
  382. ** Zero is returned on success. Non-zero is returned if no suitable
  383. ** boundary could be located. Non-zero might be returned, for example,
  384. ** if xI,yI is positioned directly on top of a wall or if there are no
  385. ** walls in the wallset.
  386. **
  387. ** // Any segment marked with Segment.ignore is ignored for purposes of
  388. ** // this routine. -- removed
  389. **
  390. ** This routine uses the Segment.set list internally.
  391. */
  392. static int firstBoundarySegment(
  393. Wallset *p, /* The wallset */
  394. double xI, double yI, /* An interior point */
  395. Segment **ppSeg, /* OUT: A segment on the boundary containing xI,yI */
  396. int *pfLeft /* OUT: True if xI,yI is to the left side *ppSeg */
  397. ){
  398. Link *pList;
  399. double xN, yN;
  400.  
  401. /* Find nearest point, xN,yN */
  402. pList = nearestPoint(p, xI, yI, &xN, &yN);
  403. if( pList==0 ) return 1;
  404. if( pList->pNext ){
  405. /* xN,yN is a vertex...
  406. ** Locate the first segment clockwise from xI,yI->xN,yN and return
  407. */
  408. return nextCwSegment(p, xI, yI, xN, yN, ppSeg, pfLeft);
  409. }else{
  410. /* xN,yN is a point on single line segment...
  411. */
  412. Segment *pSeg;
  413. pSeg = *ppSeg = pList->pLinkNode;
  414. *pfLeft = bendDirection(pSeg->from[X_IDX], pSeg->from[Y_IDX], xN, yN, xI, yI)>0;
  415. }
  416. return 0;
  417. }
  418.  
  419. /*
  420. ** Fill the given Boundary array with a list of segments (with
  421. ** Segment.ignore set to false) that form a closed circuit. The
  422. ** first entry in aBound[] has already been filled in by the
  423. ** calling function and is used to seed the search.
  424. **
  425. ** At most nBound slots in aBound[] will be used. The return value
  426. ** is the number of slots in aBound[] that would have been used if those
  427. ** slots had been available. A return of 0 indicates that no boundary
  428. ** is available.
  429. **
  430. ** If the checkIsPrimary flag is true and the aBound[0] entry is not
  431. ** the primary segment for the compartment, then the aBound[] is not
  432. ** completely filled in and the routine returns 0;
  433. */
  434. static int completeBoundary(
  435. Wallset *p, /* The wallset */
  436. int checkIsPrimary, /* Abort if aBound[0] is not the primary segment */
  437. int nBound, /* Number of slots available in aBound[] */
  438. Boundary *aBound /* IN-OUT: Write results into aBound[1...] */
  439. ){
  440. int cnt = 1;
  441. Segment *pSeg, *pS;
  442. int isLeft;
  443. int isBack;
  444. double xR, yR, xV, yV;
  445.  
  446. pS = pSeg = aBound[0].pSeg;
  447. isLeft = aBound[0].backwards;
  448. if( !isLeft ){
  449. xR = pSeg->from[X_IDX];
  450. yR = pSeg->from[Y_IDX];
  451. xV = pSeg->to[X_IDX];
  452. yV = pSeg->to[Y_IDX];
  453. }else{
  454. xV = pSeg->from[X_IDX];
  455. yV = pSeg->from[Y_IDX];
  456. xR = pSeg->to[X_IDX];
  457. yR = pSeg->to[Y_IDX];
  458. }
  459. while( nextCwSegment(p,xR,yR,xV,yV,&pS,&isBack)==0 &&
  460. (isBack!=isLeft || pS!=pSeg) ){
  461. if( checkIsPrimary ){
  462. if( pS->id<pSeg->id ) return 0;
  463. if( pS->id==pSeg->id && !isLeft ) return 0;
  464. }
  465. if( isBack ){
  466. xV = pS->from[X_IDX];
  467. yV = pS->from[Y_IDX];
  468. xR = pS->to[X_IDX];
  469. yR = pS->to[Y_IDX];
  470. }else{
  471. xR = pS->from[X_IDX];
  472. yR = pS->from[Y_IDX];
  473. xV = pS->to[X_IDX];
  474. yV = pS->to[Y_IDX];
  475. }
  476. if( nBound>cnt ){
  477. aBound[cnt].pSeg = pS;
  478. aBound[cnt].backwards = isBack;
  479. }
  480. cnt++;
  481. if( cnt>1000 /* 00 */ ) return -cnt; /* Avoid an infinite loop */
  482. }
  483. return cnt;
  484. }
  485.  
  486. /*
  487. ** Compute the "spin" on a boundary. A positive value means the
  488. ** circulation is to counter-clockwise and a negative value means the
  489. ** circulation is clockwise. For boundaries, a positive
  490. ** value means the region is internal and a negative value means
  491. ** the region is external.
  492. */
  493. static double spin(Boundary *aBound, int nBound){
  494. double sum = 0;
  495. int i;
  496. for(i=0; i<nBound; i++){
  497. double x0, y0, x1, y1;
  498. double dx, dy;
  499. Segment *pSeg = aBound->pSeg;
  500. if( aBound->backwards ){
  501. x0 = pSeg->to[X_IDX];
  502. y0 = pSeg->to[Y_IDX];
  503. x1 = pSeg->from[X_IDX];
  504. y1 = pSeg->from[Y_IDX];
  505. }else{
  506. x0 = pSeg->from[X_IDX];
  507. y0 = pSeg->from[Y_IDX];
  508. x1 = pSeg->to[X_IDX];
  509. y1 = pSeg->to[Y_IDX];
  510. }
  511. aBound++;
  512. dx = x1-x0;
  513. dy = y1-y0;
  514. sum += x0*dy - y0*dx;
  515. }
  516. return sum;
  517. }
  518.  
  519. /*
  520. ** The input is two linked lists of ComptBox structures where each
  521. ** list is sorted by increasing area. Combine these two lists into
  522. ** a single sorted linked list.
  523. */
  524. static ComptBox *mergeComptBox(ComptBox *p1, ComptBox *p2){
  525. ComptBox head;
  526. ComptBox *pTail = &head;
  527. ComptBox *p;
  528. while( p1 && p2 ){
  529. if( p1->area<=p2->area ){
  530. p = p1->pNext;
  531. pTail->pNext = p1;
  532. pTail = p1;
  533. p1 = p;
  534. }else{
  535. p = p2->pNext;
  536. pTail->pNext = p2;
  537. pTail = p2;
  538. p2 = p;
  539. }
  540. }
  541. if( p1 ){
  542. pTail->pNext = p1;
  543. }else{
  544. pTail->pNext = p2;
  545. }
  546. return head.pNext;
  547. }
  548.  
  549. /*
  550. ** Construct the ComptBox cache. For each compartment (where a compartment
  551. ** is a closed circuit of Segments) make an entry on the Wallset.pComptBox
  552. ** list.
  553. **
  554. ** If the ComptBox cache already exists, this routine is a no-op.
  555. */
  556. static void buildComptBoxCache(Wallset *p){
  557. Link *pI;
  558. int i;
  559. ComptBox *aSort[30];
  560.  
  561. /* Return immediately if the cache already exists */
  562. if( p->pComptBox ) return;
  563.  
  564. /* Compute a linked list of all compartment boxes */
  565. for(pI=p->pAll; pI; pI=pI->pNext){
  566. int i, j, n;
  567. Boundary aBound[1000];
  568.  
  569. aBound[0].pSeg = pI->pLinkNode;
  570. for(j=0; j<2; j++){
  571. aBound[0].backwards = j;
  572. n = completeBoundary(p, 1, sizeof(aBound)/sizeof(aBound[0]), aBound);
  573. if( n>0 && spin(aBound,n)>0.0 ){
  574. double dx, dy;
  575. Segment *pSeg = pI->pLinkNode;
  576. ComptBox *pNew = (ComptBox *)Odie_Alloc( sizeof(*pNew) );
  577. pNew->pNext = p->pComptBox;
  578. pNew->bbox.l = pNew->bbox.r = pSeg->from[X_IDX];
  579. pNew->bbox.t = pNew->bbox.b = pSeg->from[Y_IDX];
  580. pNew->prim = aBound[0];
  581. for(i=1; i<n; i++){
  582. Segment *pSeg = aBound[i].pSeg;
  583. if( pSeg->from[X_IDX]<pNew->bbox.l ) pNew->bbox.l = pSeg->from[X_IDX];
  584. if( pSeg->from[X_IDX]>pNew->bbox.r ) pNew->bbox.r = pSeg->from[X_IDX];
  585. if( pSeg->from[Y_IDX]<pNew->bbox.b ) pNew->bbox.b = pSeg->from[Y_IDX];
  586. if( pSeg->from[Y_IDX]>pNew->bbox.t ) pNew->bbox.t = pSeg->from[Y_IDX];
  587. if( pSeg->to[X_IDX]<pNew->bbox.l ) pNew->bbox.l = pSeg->to[X_IDX];
  588. if( pSeg->to[X_IDX]>pNew->bbox.r ) pNew->bbox.r = pSeg->to[X_IDX];
  589. if( pSeg->to[Y_IDX]<pNew->bbox.b ) pNew->bbox.b = pSeg->to[Y_IDX];
  590. if( pSeg->to[Y_IDX]>pNew->bbox.t ) pNew->bbox.t = pSeg->to[Y_IDX];
  591. }
  592. dx = pNew->bbox.r - pNew->bbox.l;
  593. dy = pNew->bbox.t - pNew->bbox.b;
  594. pNew->area = sqrt(dx*dx+dy*dy);
  595. p->pComptBox = pNew;
  596. }
  597. }
  598. }
  599.  
  600. /* Sort the list into order of increasing area */
  601. for(i=0; i<sizeof(aSort)/sizeof(aSort[0]); i++) aSort[i] = 0;
  602. while( p->pComptBox ){
  603. ComptBox *pBox = p->pComptBox;
  604. p->pComptBox = pBox->pNext;
  605. pBox->pNext = 0;
  606. for(i=0; i<sizeof(aSort)/sizeof(aSort[0])-1 && aSort[i]!=0; i++){
  607. pBox = mergeComptBox(aSort[i], pBox);
  608. aSort[i] = 0;
  609. }
  610. aSort[i] = mergeComptBox(aSort[i], pBox);
  611. }
  612. for(i=0; i<sizeof(aSort)/sizeof(aSort[0]); i++){
  613. p->pComptBox = mergeComptBox(aSort[i], p->pComptBox);
  614. }
  615. }
  616.  
  617. /*
  618. ** Test to see if the point x,y is contained within the given
  619. ** boundary or is on the outside of the boundary.
  620. */
  621. static int pointWithinBoundary(
  622. Boundary *aBound, /* The boundary */
  623. int nBound, /* Number of segments in the boundary */
  624. double x, double y /* The point to test */
  625. ){
  626. int inside = 0;
  627. int i;
  628. for(i=0; i<nBound; i++){
  629. double x0, y0, x1, y1;
  630. Segment *p = aBound[i].pSeg;
  631. x0 = p->from[X_IDX];
  632. y0 = p->from[Y_IDX];
  633. x1 = p->to[X_IDX];
  634. y1 = p->to[Y_IDX];
  635. if( x0==x1 ) continue;
  636. if( (x0>x && x1>x) || (x0<x && x1<x) ) continue;
  637. if( y1 - (x1-x)*(y1-y0)/(x1-x0) >= y ) inside = !inside;
  638. }
  639. return inside;
  640. }
  641.  
  642. /*
  643. ** Find a boundary which contains xI, yI. If the size of the boundary
  644. ** is set to 0, that means no such boundary exists.
  645. */
  646. static int findBoundary(
  647. Wallset *p, /* The wallset */
  648. double xI, double yI, /* A point that the boundary should be near */
  649. int nBound, /* Number of slots available in aBound[] */
  650. Boundary *aBound /* OUT: Write results here */
  651. ){
  652. int n = 0;
  653. ComptBox *pBox;
  654.  
  655. buildComptBoxCache(p);
  656. for(pBox=p->pComptBox; pBox; pBox=pBox->pNext){
  657. if( xI<pBox->bbox.l || xI>pBox->bbox.r || yI<pBox->bbox.b || yI>pBox->bbox.t ) continue;
  658. aBound[0] = pBox->prim;
  659. n = completeBoundary(p, 0, nBound, aBound);
  660. if( n>0 && pointWithinBoundary(aBound, n, xI, yI) ) break;
  661. n = 0;
  662. }
  663. return n;
  664. }
  665.  
  666.  
  667. /*
  668. ** Do an check of the integrity of the internal data structures. If
  669. ** a problem is found, leave an error message in interp->result and
  670. ** return TCL_ERROR. Return TCL_OK if everything is OK.
  671. */
  672. static int selfCheck(Tcl_Interp *interp, Wallset *p){
  673. Link *pLink;
  674. Segment *pSeg;
  675. int h;
  676. char zErr[200];
  677.  
  678. for(pLink=p->pAll; pLink; pLink=pLink->pNext){
  679. pSeg = pLink->pLinkNode;
  680. h = hashInt(pSeg->id);
  681. if(!segmentOnList(pSeg, p->hashId[h]) ){
  682. sprintf(zErr, "segment %d missing from hashId[%d]", pSeg->id, h);
  683. Tcl_SetResult(interp, zErr, TCL_VOLATILE);
  684. return TCL_ERROR;
  685. }
  686. h = hashCoord(pSeg->from[X_IDX], pSeg->from[Y_IDX]);
  687. if(!segmentOnList(pSeg, p->hashFrom[h]) ){
  688. sprintf(zErr, "segment %d missing from hashFrom[%d]", pSeg->id, h);
  689. Tcl_SetResult(interp, zErr, TCL_VOLATILE);
  690. return TCL_ERROR;
  691. }
  692. h = hashCoord(pSeg->to[X_IDX], pSeg->to[Y_IDX]);
  693. if(!segmentOnList(pSeg, p->hashTo[h]) ){
  694. sprintf(zErr, "segment %d missing from hashTo[%d]", pSeg->id, h);
  695. Tcl_SetResult(interp, zErr, TCL_VOLATILE);
  696. return TCL_ERROR;
  697. }
  698. }
  699. return TCL_OK;
  700. }
  701.  
  702. static void Wallset_Delete(ClientData clientData) {
  703. Wallset *p = (Wallset *)clientData;
  704. Link *pLink = p->pAll;
  705. clearComptBoxCache(p);
  706. while( pLink ){
  707. Segment *pSeg = pLink->pLinkNode;
  708. pLink = pSeg->pAll.pNext;
  709. Odie_Free((char *) pSeg );
  710. }
  711. Odie_Free((char *) p );
  712. }
  713. static int Wallset_Clone(
  714. Tcl_Interp* interp, /* Tcl interpreter for error reporting */
  715. ClientData metadata, /* Metadata to be cloned */
  716. ClientData* newMetaData /* Where to put the cloned metadata */
  717. ) {
  718. Tcl_SetObjResult(interp,
  719. Tcl_NewStringObj("WALLSETs are not clonable", -1));
  720. /* For now... */
  721. return TCL_ERROR;
  722. }
  723.  
  724.  
  725. const static Tcl_ObjectMetadataType WallsetDataType = {
  726. TCL_OO_METADATA_VERSION_CURRENT,
  727. "Wallset",
  728. Wallset_Delete,
  729. Wallset_Clone
  730. };
  731.  
  732. /*
  733. ** The maximum number of segments in a boundary
  734. */
  735. #define MX_BOUND 1000
  736.  
  737. /*
  738. ** This routine runs when a method is executed against a wallset.
  739. */
  740. #define GETWALLSET(OBJCONTEXT) (Wallset *) Tcl_ObjectGetMetadata(Tcl_ObjectContextObject(objectContext),&WallsetDataType)
  741.  
  742. static int Wallset_Method_atvertex(ClientData clientData ,Tcl_Interp *interp ,Tcl_ObjectContext objectContext ,int objc ,Tcl_Obj *const *objv)
  743. {
  744. /*
  745. ** tclmethod: WALLSET atvertex X Y
  746. ** title: Return a list of wall IDs that connect to vertex X,Y
  747. */
  748. Wallset *p = GETWALLSET(objectContext);
  749. Link *pList;
  750. double x, y;
  751.  
  752. Tcl_Obj *pResult;
  753. if( objc!=4 ){
  754. Tcl_WrongNumArgs(interp, 1, objv, "X Y");
  755. return TCL_ERROR;
  756. }
  757. if( Tcl_GetDoubleFromObj(interp, objv[1], &x) ) return TCL_ERROR;
  758. if( Tcl_GetDoubleFromObj(interp, objv[2], &y) ) return TCL_ERROR;
  759. pResult = Tcl_NewObj();
  760. ignoreNone(p);
  761. pList = segmentsAtVertex(p, x*p->rXZoom, y*p->rYZoom);
  762. while( pList ){
  763. Segment *pSeg=pList->pLinkNode;
  764. Tcl_ListObjAppendElement(0, pResult, Tcl_NewIntObj(pSeg->id));
  765. pList = pList->pNext;
  766. }
  767. Tcl_SetObjResult(interp, pResult);
  768. return TCL_OK;
  769. }
  770. static int Wallset_Method_boundary(ClientData clientData ,Tcl_Interp *interp ,Tcl_ObjectContext objectContext ,int objc ,Tcl_Obj *const *objv)
  771. {
  772. /*
  773. ** tclmethod: WALLSET boundary X Y
  774. ** title: Return indices of segments forming a boundary around X Y
  775. */
  776. Wallset *p = GETWALLSET(objectContext);
  777. Boundary aBound[MX_BOUND];
  778. int nBound;
  779. double x, y;
  780. Tcl_Obj *pResult;
  781. int i;
  782. int showDetail = 0;
  783.  
  784. if( objc==5 && strcmp(Tcl_GetStringFromObj(objv[1],0),"-detail")==0 ){
  785. showDetail = 1;
  786. objc--;
  787. objv++;
  788. }
  789. if( objc!=4 ){
  790. Tcl_WrongNumArgs(interp, 1, objv, "?-detail? X Y");
  791. return TCL_ERROR;
  792. }
  793. if( Tcl_GetDoubleFromObj(interp, objv[1], &x) ) return TCL_ERROR;
  794. if( Tcl_GetDoubleFromObj(interp, objv[2], &y) ) return TCL_ERROR;
  795. nBound = findBoundary(p, x*p->rXZoom, y*p->rYZoom, MX_BOUND, aBound);
  796. if( nBound>MX_BOUND ) nBound = 0;
  797. pResult = Tcl_NewObj();
  798. for(i=0; i<nBound; i++){
  799. Tcl_ListObjAppendElement(0, pResult, Tcl_NewIntObj(aBound[i].pSeg->id));
  800. if( showDetail ){
  801. Tcl_ListObjAppendElement(0, pResult,
  802. ODIE_CONSTANT_STRING(aBound[i].backwards ? "right" : "left"));
  803. }
  804. }
  805. Tcl_SetObjResult(interp, pResult);
  806. return TCL_OK;
  807. }
  808. static int Wallset_Method_closure(ClientData clientData ,Tcl_Interp *interp ,Tcl_ObjectContext objectContext ,int objc ,Tcl_Obj *const *objv)
  809. {
  810. /*
  811. ** tclmethod: WALLSET closure WALLID BACKWARDS CHECKPRIMARY ?-coords?
  812. ** title: Return the closure of a wall
  813. **
  814. ** The closure is a path of walls going clockwise from the wall given.
  815. ** The return value is a list consisting of wall IDs alternating with
  816. ** keywords "left" or "right" indicating which side of the wall applies.
  817. ** If the CHECKPRIMARY flag is true and the WALLID/BACKWARDS is not the
  818. ** primary wall id for the closure, then return an empty string. The
  819. ** primary wall id is the wall id with the lowest id number, or if
  820. ** two walls in the closure have the same id, then the one that goes
  821. ** on the right side of the wall.
  822. */
  823. Wallset *p = GETWALLSET(objectContext);
  824. Boundary aBound[MX_BOUND];
  825. int id;
  826. int nBound, i, checkPrim;
  827. Tcl_Obj *pResult;
  828. int coordsFlag = 0;
  829. int noerrFlag = 0;
  830. if( objc!=4 && objc!=5 ){
  831. Tcl_WrongNumArgs(interp, 1, objv,
  832. "WALLID BACKWARDS CHECKPRIMARY ?-coords? ?-noerr?");
  833. return TCL_ERROR;
  834. }
  835. if( objc==5 ){
  836. const char *zOpt = Tcl_GetStringFromObj(objv[4],0);
  837. if( strcmp(zOpt,"-coords")==0 ){
  838. coordsFlag = 1;
  839. }else if( strcmp(zOpt,"-noerr")==0 ){
  840. noerrFlag = 1;
  841. }else{
  842. Tcl_AppendResult(interp, "unknown option: ", zOpt, 0);
  843. return TCL_ERROR;
  844. }
  845. }
  846. if( Tcl_GetIntFromObj(interp, objv[1], &id) ) return TCL_ERROR;
  847. if( (aBound[0].pSeg = findSegment(p, id))==0 ){
  848. Tcl_AppendResult(interp, "segment ",
  849. Tcl_GetStringFromObj(objv[1],0), " does not exist", 0);
  850. return TCL_ERROR;
  851. }
  852. if( Tcl_GetBooleanFromObj(interp, objv[2], &aBound[0].backwards) ){
  853. return TCL_ERROR;
  854. }
  855. if( Tcl_GetBooleanFromObj(interp, objv[3], &checkPrim) ){
  856. return TCL_ERROR;
  857. }
  858. ignoreNone(p);
  859. nBound = completeBoundary(p, checkPrim, MX_BOUND, aBound);
  860. pResult = Tcl_NewObj();
  861. if( nBound<0 && noerrFlag ) nBound = -nBound;
  862. for(i=0; i<nBound; i++){
  863. if( coordsFlag ){
  864. double x, y;
  865. Segment *pSeg = aBound[i].pSeg;
  866. if( aBound[i].backwards ){
  867. x = pSeg->to[X_IDX];
  868. y = pSeg->to[Y_IDX];
  869. }else{
  870. x = pSeg->from[X_IDX];
  871. y = pSeg->from[Y_IDX];
  872. }
  873. Tcl_ListObjAppendElement(0, pResult, Tcl_NewDoubleObj(x/p->rXZoom));
  874. Tcl_ListObjAppendElement(0, pResult, Tcl_NewDoubleObj(y/p->rYZoom));
  875. }else{
  876. Tcl_ListObjAppendElement(0, pResult,
  877. Tcl_NewIntObj(aBound[i].pSeg->id));
  878. Tcl_ListObjAppendElement(0, pResult,
  879. ODIE_CONSTANT_STRING(aBound[i].backwards ? "right" : "left"));
  880. }
  881. }
  882. Tcl_SetObjResult(interp, pResult);
  883. return TCL_OK;
  884. }
  885. static int Wallset_Method_comptlist(ClientData clientData ,Tcl_Interp *interp ,Tcl_ObjectContext objectContext ,int objc ,Tcl_Obj *const *objv)
  886. {
  887. /*
  888. ** tclmethod: WALLSET comptlist
  889. ** title: Return a list of all compartments
  890. **
  891. ** A compartment is a closed circuit of walls. This routine returns
  892. ** a list of all compartments. Each element of the list consists of
  893. ** the primary wall for the compartment followed by a bounding box
  894. ** for the compartment.
  895. */
  896. Wallset *p = GETWALLSET(objectContext);
  897. ComptBox *pBox;
  898. Tcl_Obj *pResult = Tcl_NewObj();
  899. buildComptBoxCache(p);
  900. for(pBox=p->pComptBox; pBox; pBox=pBox->pNext){
  901. Tcl_Obj *pElem = Tcl_NewObj();
  902. Tcl_ListObjAppendElement(0, pElem,Tcl_NewIntObj(pBox->prim.pSeg->id));
  903. Tcl_ListObjAppendElement(0, pElem, Tcl_NewIntObj(pBox->prim.backwards));
  904. Tcl_ListObjAppendElement(0, pElem, Tcl_NewDoubleObj(pBox->bbox.l/p->rXZoom));
  905. Tcl_ListObjAppendElement(0, pElem, Tcl_NewDoubleObj(pBox->bbox.b/p->rYZoom));
  906. Tcl_ListObjAppendElement(0, pElem, Tcl_NewDoubleObj(pBox->bbox.r/p->rXZoom));
  907. Tcl_ListObjAppendElement(0, pElem, Tcl_NewDoubleObj(pBox->bbox.t/p->rYZoom));
  908. Tcl_ListObjAppendElement(0, pResult, pElem);
  909. }
  910. Tcl_SetObjResult(interp, pResult);
  911. return TCL_OK;
  912. }
  913. static int Wallset_Method_corners(ClientData clientData ,Tcl_Interp *interp ,Tcl_ObjectContext objectContext ,int objc ,Tcl_Obj *const *objv)
  914. {
  915. /*
  916. ** tclmethod: WALLSET corners X Y
  917. ** title: Return vertices of compartment containing X,Y
  918. */
  919. Wallset *p = GETWALLSET(objectContext);
  920. Boundary aBound[MX_BOUND];
  921. int nBound, i;
  922. double x, y;
  923. Tcl_Obj *pResult;
  924. if( objc!=4 ){
  925. Tcl_WrongNumArgs(interp, 1, objv, "X Y");
  926. return TCL_ERROR;
  927. }
  928. if( Tcl_GetDoubleFromObj(interp, objv[1], &x) ) return TCL_ERROR;
  929. if( Tcl_GetDoubleFromObj(interp, objv[2], &y) ) return TCL_ERROR;
  930. nBound = findBoundary(p, x*p->rXZoom, y*p->rYZoom, MX_BOUND, aBound);
  931. if( nBound>MX_BOUND ) nBound = 0;
  932. pResult = Tcl_NewObj();
  933. for(i=0; i<nBound; i++){
  934. Segment *pSeg = aBound[i].pSeg;
  935. if( aBound[i].backwards ){
  936. x = pSeg->to[X_IDX];
  937. y = pSeg->to[Y_IDX];
  938. }else{
  939. x = pSeg->from[X_IDX];
  940. y = pSeg->from[Y_IDX];
  941. }
  942. Tcl_ListObjAppendElement(0, pResult, Tcl_NewDoubleObj(x/p->rXZoom));
  943. Tcl_ListObjAppendElement(0, pResult, Tcl_NewDoubleObj(y/p->rYZoom));
  944. }
  945. Tcl_SetObjResult(interp, pResult);
  946. return TCL_OK;
  947. }
  948. static int Wallset_Method_delete(ClientData clientData ,Tcl_Interp *interp ,Tcl_ObjectContext objectContext ,int objc ,Tcl_Obj *const *objv)
  949. {
  950. /*
  951. ** tclmethod: WALLSET delete ID
  952. ** title: Delete a single segment of a wall given by ID
  953. */
  954. Wallset *p = GETWALLSET(objectContext);
  955. int id;
  956. Segment *pSeg;
  957. if( objc!=3 ){
  958. Tcl_WrongNumArgs(interp, 1, objv, "ID");
  959. return TCL_ERROR;
  960. }
  961. if( p->busy ){
  962. Tcl_AppendResult(interp, "cannot \"delete\" from within a \"foreach\"",0);
  963. return TCL_ERROR;
  964. }
  965. if( Tcl_GetIntFromObj(interp, objv[1], &id) ) return TCL_ERROR;
  966. if( (pSeg = findSegment(p, id))==0 ){
  967. Tcl_AppendResult(interp, "segment ",
  968. Tcl_GetStringFromObj(objv[1],0), " does not exist", 0);
  969. return TCL_ERROR;
  970. }
  971. clearComptBoxCache(p);
  972. LinkRemove(&pSeg->pAll);
  973. /* We intentionally do not remove pSeg->pSet because it might not be
  974. ** a well-formed list */
  975. LinkRemove(&pSeg->pHash);
  976. LinkRemove(&pSeg->pFrom);
  977. LinkRemove(&pSeg->pTo);
  978. Odie_Free((char *)pSeg);
  979. return TCL_OK;
  980. }
  981. static int Wallset_Method_firstboundary(ClientData clientData ,Tcl_Interp *interp ,Tcl_ObjectContext objectContext ,int objc ,Tcl_Obj *const *objv)
  982. {
  983. /*
  984. ** tclmethod: WALLSET firstboundary X Y
  985. ** title: Find a wall on the boundary of compartment containing X Y
  986. **
  987. ** Returns a list of two elements on success or an empty list if no
  988. ** suitable boundary could be found. The first element is the ID of a
  989. ** wall that forms part of the boundary for the compartment containing
  990. ** point X,Y. The second element is TRUE if X,Y is to the right of the
  991. ** wall and false if it is to the left.
  992. **
  993. ** The right/left designation assumes a right-handed coordinate system.
  994. */
  995. Wallset *p = GETWALLSET(objectContext);
  996. int isBack;
  997. Segment *pSeg;
  998. double x, y;
  999. int rc;
  1000. if( objc!=4 ){
  1001. Tcl_WrongNumArgs(interp, 1, objv, "X Y");
  1002. return TCL_ERROR;
  1003. }
  1004. if( Tcl_GetDoubleFromObj(interp, objv[2], &x) ) return TCL_ERROR;
  1005. if( Tcl_GetDoubleFromObj(interp, objv[3], &y) ) return TCL_ERROR;
  1006. ignoreNone(p);
  1007. rc = firstBoundarySegment(p, x*p->rXZoom, y*p->rYZoom, &pSeg, &isBack);
  1008. if( rc==0 ){
  1009. Tcl_Obj *pResult = Tcl_NewObj();
  1010. Tcl_ListObjAppendElement(0, pResult, Tcl_NewIntObj(pSeg->id));
  1011. Tcl_ListObjAppendElement(0, pResult, Tcl_NewIntObj(isBack));
  1012. Tcl_SetObjResult(interp, pResult);
  1013. }
  1014. return TCL_OK;
  1015. }
  1016. static int Wallset_Method_foreach(ClientData clientData ,Tcl_Interp *interp ,Tcl_ObjectContext objectContext ,int objc ,Tcl_Obj *const *objv)
  1017. {
  1018. /*
  1019. ** tclmethod: WALLSET foreach CODE
  1020. ** title: Run CODE for each segment of the wallset
  1021. */
  1022. Wallset *p = GETWALLSET(objectContext);
  1023. Link *pLink;
  1024. int rc = TCL_OK;
  1025. if( objc!=2 ){
  1026. Tcl_WrongNumArgs(interp, 1, objv, "CODE");
  1027. return TCL_ERROR;
  1028. }
  1029. p->busy++;
  1030. for(pLink=p->pAll; pLink && rc==TCL_OK; pLink=pLink->pNext){
  1031. Segment *pSeg = pLink->pLinkNode;
  1032. Tcl_SetVar2Ex(interp, "x0", 0, Tcl_NewDoubleObj(pSeg->from[X_IDX]/p->rXZoom), 0);
  1033. Tcl_SetVar2Ex(interp, "y0", 0, Tcl_NewDoubleObj(pSeg->from[Y_IDX]/p->rYZoom), 0);
  1034. Tcl_SetVar2Ex(interp, "x1", 0, Tcl_NewDoubleObj(pSeg->to[X_IDX]/p->rXZoom), 0);
  1035. Tcl_SetVar2Ex(interp, "y1", 0, Tcl_NewDoubleObj(pSeg->to[Y_IDX]/p->rYZoom), 0);
  1036. Tcl_SetVar2Ex(interp, "id", 0, Tcl_NewIntObj(pSeg->id), 0);
  1037. Tcl_SetVar2Ex(interp, "lc", 0, Tcl_NewIntObj(pSeg->idLC), 0);
  1038. Tcl_SetVar2Ex(interp, "rc", 0, Tcl_NewIntObj(pSeg->idRC), 0);
  1039. Tcl_SetVar2Ex(interp, "virtual", 0, Tcl_NewIntObj(pSeg->isBoundary), 0);
  1040. rc = Tcl_EvalObjEx(interp, objv[1], 0);
  1041. }
  1042. if( rc==TCL_BREAK ) rc = TCL_OK;
  1043. p->busy--;
  1044. return rc;
  1045. }
  1046. static int Wallset_Method_info(ClientData clientData ,Tcl_Interp *interp ,Tcl_ObjectContext objectContext ,int objc ,Tcl_Obj *const *objv)
  1047. {
  1048. /*
  1049. ** tclmethod: WALLSET info ID
  1050. ** title: Return information about a single wall segment
  1051. */
  1052. Wallset *p = GETWALLSET(objectContext);
  1053. int id;
  1054. Segment *pSeg;
  1055. Tcl_Obj *pResult;
  1056. if( objc!=3 ){
  1057. Tcl_WrongNumArgs(interp, 2, objv, "ID");
  1058. return TCL_ERROR;
  1059. }
  1060. if( Tcl_GetIntFromObj(interp, objv[1], &id) ) return TCL_ERROR;
  1061. if( (pSeg = findSegment(p, id))==0 ){
  1062. Tcl_AppendResult(interp, "segment ",
  1063. Tcl_GetStringFromObj(objv[1],0), " does not exist", 0);
  1064. return TCL_ERROR;
  1065. }
  1066. pResult = Tcl_NewObj();
  1067. Tcl_ListObjAppendElement(0, pResult, Tcl_NewDoubleObj(pSeg->from[X_IDX]/p->rXZoom));
  1068. Tcl_ListObjAppendElement(0, pResult, Tcl_NewDoubleObj(pSeg->from[Y_IDX]/p->rYZoom));
  1069. Tcl_ListObjAppendElement(0, pResult, Tcl_NewDoubleObj(pSeg->to[X_IDX]/p->rXZoom));
  1070. Tcl_ListObjAppendElement(0, pResult, Tcl_NewDoubleObj(pSeg->to[Y_IDX]/p->rYZoom));
  1071. Tcl_ListObjAppendElement(0, pResult, Tcl_NewIntObj(pSeg->id));
  1072. Tcl_ListObjAppendElement(0, pResult, Tcl_NewIntObj(pSeg->idLC));
  1073. Tcl_ListObjAppendElement(0, pResult, Tcl_NewIntObj(pSeg->idRC));
  1074. Tcl_SetObjResult(interp, pResult);
  1075. return TCL_OK;
  1076. }
  1077. static int Wallset_Method_insert(ClientData clientData ,Tcl_Interp *interp ,Tcl_ObjectContext objectContext ,int objc ,Tcl_Obj *const *objv)
  1078. {
  1079. /*
  1080. ** tclmethod: WALLSET insert X0 Y0 X1 Y1 ID LC RC VIRTUAL
  1081. ** title: Create a new wall within the wallset
  1082. */
  1083. Wallset *p = GETWALLSET(objectContext);
  1084. int id;
  1085. int h,virtual=0;
  1086. double x0, y0, x1, y1;
  1087. int idLC, idRC;
  1088. Segment *pSeg;
  1089. if( objc!=8 && objc!=9){
  1090. Tcl_WrongNumArgs(interp, 1, objv, "X0 Y0 X1 Y1 ID LC RC ?1|0?");
  1091. return TCL_ERROR;
  1092. }
  1093. if( p->busy ){
  1094. Tcl_AppendResult(interp, "cannot \"insert\" from within a \"foreach\"",0);
  1095. return TCL_ERROR;
  1096. }
  1097. if( Tcl_GetDoubleFromObj(interp, objv[1], &x0) ) return TCL_ERROR;
  1098. if( Tcl_GetDoubleFromObj(interp, objv[2], &y0) ) return TCL_ERROR;
  1099. if( Tcl_GetDoubleFromObj(interp, objv[3], &x1) ) return TCL_ERROR;
  1100. if( Tcl_GetDoubleFromObj(interp, objv[4], &y1) ) return TCL_ERROR;
  1101. if( Tcl_GetIntFromObj(interp, objv[5], &id) ) return TCL_ERROR;
  1102. if( Tcl_GetIntFromObj(interp, objv[6], &idLC) ) {
  1103. Tcl_ResetResult(interp);
  1104. idLC=0;
  1105. }
  1106. if( Tcl_GetIntFromObj(interp, objv[7], &idRC) ) {
  1107. Tcl_ResetResult(interp);
  1108. idRC=0;
  1109. }
  1110. if(objc==10) {
  1111. if( Tcl_GetIntFromObj(interp, objv[8], &virtual) ) {
  1112. Tcl_ResetResult(interp);
  1113. virtual=0;
  1114. }
  1115. }
  1116. x0 = roundCoord(x0*p->rXZoom);
  1117. y0 = roundCoord(y0*p->rYZoom);
  1118. x1 = roundCoord(x1*p->rXZoom);
  1119. y1 = roundCoord(y1*p->rYZoom);
  1120. if( findSegment(p, id) ){
  1121. Tcl_AppendResult(interp, "segment ",
  1122. Tcl_GetStringFromObj(objv[6],0), " already exists", 0);
  1123. return TCL_ERROR;
  1124. }
  1125. if( floatCompare(x0,x1)==0 && floatCompare(y0,y1)==0 ){
  1126. /* Tcl_AppendResult(interp, "endpoints must be distinct", 0); */
  1127. /* return TCL_ERROR; */
  1128. return TCL_OK; /* Not an error. Just a no-op. */
  1129. }
  1130. clearComptBoxCache(p);
  1131. pSeg = (Segment *)Odie_Alloc( sizeof(*pSeg) );
  1132. if( pSeg==0 ) return TCL_ERROR;
  1133. pSeg->id = id;
  1134. pSeg->idLC = idLC;
  1135. pSeg->idRC = idRC;
  1136. pSeg->from[X_IDX] = x0;
  1137. pSeg->from[Y_IDX] = y0;
  1138. pSeg->to[X_IDX] = x1;
  1139. pSeg->to[Y_IDX] = y1;
  1140. pSeg->isBoundary=virtual;
  1141.  
  1142. LinkInit(pSeg->pAll, pSeg);
  1143. LinkInit(pSeg->pSet, pSeg);
  1144. LinkInit(pSeg->pHash, pSeg);
  1145. LinkInit(pSeg->pFrom, pSeg);
  1146. LinkInit(pSeg->pTo, pSeg);
  1147. LinkInsert(&p->pAll, &pSeg->pAll);
  1148. h = hashInt(id);
  1149. LinkInsert(&p->hashId[h], &pSeg->pHash);
  1150. h = hashCoord(pSeg->from[X_IDX], pSeg->from[Y_IDX]);
  1151. LinkInsert(&p->hashFrom[h], &pSeg->pFrom);
  1152. h = hashCoord(pSeg->to[X_IDX], pSeg->to[Y_IDX]);
  1153. LinkInsert(&p->hashTo[h], &pSeg->pTo);
  1154. return TCL_OK;
  1155. }
  1156. static int Wallset_Method_primary(ClientData clientData ,Tcl_Interp *interp ,Tcl_ObjectContext objectContext ,int objc ,Tcl_Obj *const *objv)
  1157. {
  1158. /*
  1159. ** tclmethod: WALLSET primary X Y
  1160. ** title: Return the primary segment of the compartment enclosing X,Y
  1161. **
  1162. ** The primary segment is the segment with the smallest ID. If the
  1163. ** same segment occurs twice on the list (in other words, if the
  1164. ** same compartment is on both sides of a wall), then the right side
  1165. ** (as measured facing the direction of travel from x0,y0 -> x1,y1)
  1166. ** is used.
  1167. */
  1168. Wallset *p = GETWALLSET(objectContext);
  1169. Boundary aBound[MX_BOUND];
  1170.  
  1171. int nBound;
  1172. double x, y;
  1173. int i, sideSmallest;
  1174. int idSmallest;
  1175. Tcl_Obj *pResult;
  1176. if( objc!=4 ){
  1177. Tcl_WrongNumArgs(interp, 1, objv, "X Y");
  1178. return TCL_ERROR;
  1179. }
  1180. if( Tcl_GetDoubleFromObj(interp, objv[2], &x) ) return TCL_ERROR;
  1181. if( Tcl_GetDoubleFromObj(interp, objv[3], &y) ) return TCL_ERROR;
  1182. nBound = findBoundary(p, x*p->rXZoom, y*p->rYZoom, MX_BOUND, aBound);
  1183. if( nBound>0 && nBound<MX_BOUND ){
  1184. idSmallest = aBound[0].pSeg->id;
  1185. sideSmallest = aBound[0].backwards;
  1186. for(i=1; i<nBound; i++){
  1187. if( aBound[i].pSeg->id>idSmallest ) continue;
  1188. if( aBound[i].pSeg->id<idSmallest || !sideSmallest ){
  1189. idSmallest = aBound[i].pSeg->id;
  1190. sideSmallest = aBound[i].backwards;
  1191. }
  1192. }
  1193. pResult = Tcl_NewObj();
  1194. Tcl_ListObjAppendElement(0, pResult, Tcl_NewIntObj(idSmallest));
  1195. Tcl_ListObjAppendElement(0, pResult, Tcl_NewIntObj(sideSmallest));
  1196. Tcl_SetObjResult(interp, pResult);
  1197. }
  1198. return TCL_OK;
  1199. }
  1200. static int Wallset_Method_intersect(ClientData clientData ,Tcl_Interp *interp ,Tcl_ObjectContext objectContext ,int objc ,Tcl_Obj *const *objv)
  1201. {
  1202. /*
  1203. ** tclmethod: WALLSET intersect X0 Y0 X1 Y1
  1204. ** title: Find the intersection of X0,Y0->X1,Y1 with a segment
  1205. **
  1206. ** Scan all segments in the wallset looking for one that intersects with
  1207. ** a line from X0,Y0 to X1,Y1. If the intersection occurs at x0,y0, it
  1208. ** is ignored, but intersections at x1,y1 count. If no such intersection
  1209. ** exists, return the empty string. If there are one or more intersections,
  1210. ** return the ID of the segment and the X and Y coordinates of the nearest
  1211. ** intersection to X0,Y0.
  1212. */
  1213. Wallset *p = GETWALLSET(objectContext);
  1214. double x0,y0,x1,y1;
  1215. double adx, ady;
  1216. Link *pI;
  1217. int id;
  1218. double nx, ny;
  1219. double mindist2 = -1.0;
  1220. if( objc!=5 ){
  1221. Tcl_WrongNumArgs(interp, 1, objv, "X0 Y0 X1 Y1");
  1222. return TCL_ERROR;
  1223. }
  1224. if( Tcl_GetDoubleFromObj(interp, objv[1], &x0) ) return TCL_ERROR;
  1225. if( Tcl_GetDoubleFromObj(interp, objv[2], &y0) ) return TCL_ERROR;
  1226. if( Tcl_GetDoubleFromObj(interp, objv[3], &x1) ) return TCL_ERROR;
  1227. if( Tcl_GetDoubleFromObj(interp, objv[4], &y1) ) return TCL_ERROR;
  1228. x0 = roundCoord(x0*p->rXZoom);
  1229. y0 = roundCoord(y0*p->rYZoom);
  1230. x1 = roundCoord(x1*p->rXZoom);
  1231. y1 = roundCoord(y1*p->rYZoom);
  1232. adx = x1-x0;
  1233. ady = y1-y0;
  1234. if( adx==0.0 && ady==0.0 ) {
  1235. return TCL_OK;
  1236. }
  1237. for(pI=p->pAll; pI; pI=pI->pNext){
  1238. double bdx, bdy, denom, num1;
  1239. Segment *pSeg;
  1240. pSeg = pI->pLinkNode;
  1241. bdx = pSeg->to[X_IDX] - pSeg->from[X_IDX];
  1242. bdy = pSeg->to[Y_IDX] - pSeg->from[Y_IDX];
  1243. denom = adx*bdy - ady*bdx;
  1244. num1 = (y0-pSeg->from[Y_IDX])*bdx - (x0-pSeg->from[X_IDX])*bdy;
  1245. if( denom==0.0 ){
  1246. /* The reference line and segment are parallel */
  1247. if( num1==0.0 ){
  1248. /* The reference line and segment are colinear */
  1249. if( samePoint(x0,y0,pSeg->from[X_IDX],pSeg->from[Y_IDX])
  1250. && adx*bdx<=0.0 && ady*bdy<=0.0 ){
  1251. continue;
  1252. }
  1253. if( samePoint(x0,y0,pSeg->to[X_IDX],pSeg->to[Y_IDX])
  1254. && adx*bdx>=0.0 && ady*bdy>=0.0 ){
  1255. continue;
  1256. }
  1257. if( between(pSeg->from[Y_IDX],y0,y1) && between(pSeg->from[X_IDX],x0,x1) ){
  1258. double dx, dy, dist2;
  1259. dx = pSeg->from[X_IDX] - x0;
  1260. dy = pSeg->from[Y_IDX] - y0;
  1261. dist2 = dx*dx + dy*dy;
  1262. if( mindist2<0 || mindist2>dist2 ){
  1263. mindist2 = dist2;
  1264. nx = pSeg->from[X_IDX];
  1265. ny = pSeg->from[Y_IDX];
  1266. id = pSeg->id;
  1267. }
  1268. }
  1269. if( between(pSeg->to[Y_IDX],y0,y1) && between(pSeg->to[X_IDX],x0,x1) ){
  1270. double dx, dy, dist2;
  1271. dx = pSeg->to[X_IDX] - x0;
  1272. dy = pSeg->to[Y_IDX] - y0;
  1273. dist2 = dx*dx + dy*dy;
  1274. if( mindist2<0 || mindist2>dist2 ){
  1275. mindist2 = dist2;
  1276. nx = pSeg->to[X_IDX];
  1277. ny = pSeg->to[Y_IDX];
  1278. id = pSeg->id;
  1279. }
  1280. }
  1281. if( between(y0,pSeg->from[Y_IDX],pSeg->to[Y_IDX]) && between(x0,pSeg->from[X_IDX],pSeg->to[X_IDX]) ){
  1282. if( mindist2<0 || mindist2>0.0 ){
  1283. mindist2 = 0.0;
  1284. nx = x0;
  1285. ny = y0;
  1286. id = pSeg->id;
  1287. }
  1288. }
  1289. }
  1290. }else{
  1291. /* The reference line and segment are not parallel */
  1292. double r, s;
  1293. r = num1/denom;
  1294. s = ((y0-pSeg->from[Y_IDX])*adx - (x0-pSeg->from[X_IDX])*ady)/denom;
  1295. if( r>0 && r<=1.0 && s>=0.0 && s<=1.0 ){
  1296. double dx, dy, dist2;
  1297. dx = r*adx;
  1298. dy = r*ady;
  1299. dist2 = dx*dx + dy*dy;
  1300. if( dist2>=GRAIN && (mindist2<0 || mindist2>dist2) ){
  1301. mindist2 = dist2;
  1302. nx = x0 + dx;
  1303. ny = y0 + dy;
  1304. id = pSeg->id;
  1305. }
  1306. }
  1307. }
  1308. }
  1309. if( mindist2>=0.0 ){
  1310. Tcl_Obj *pResult;
  1311. pResult = Tcl_NewObj();
  1312. nx = roundCoord(nx);
  1313. ny = roundCoord(ny);
  1314. Tcl_ListObjAppendElement(0, pResult, Tcl_NewDoubleObj(nx/p->rXZoom));
  1315. Tcl_ListObjAppendElement(0, pResult, Tcl_NewDoubleObj(ny/p->rYZoom));
  1316. Tcl_ListObjAppendElement(0, pResult, Tcl_NewIntObj(id));
  1317. Tcl_SetObjResult(interp, pResult);
  1318. }
  1319. return TCL_OK;
  1320. }
  1321. static int Wallset_Method_left(ClientData clientData ,Tcl_Interp *interp ,Tcl_ObjectContext objectContext ,int objc ,Tcl_Obj *const *objv)
  1322. {
  1323. /*
  1324. ** tclmethod: WALLSET left ID LC
  1325. ** title: Change the left compartment of a line segment
  1326. */
  1327. Wallset *p = GETWALLSET(objectContext);
  1328. int id, idLC;
  1329. Segment *pSeg;
  1330. if( objc!=3 ){
  1331. Tcl_WrongNumArgs(interp, 1, objv, "ID LC");
  1332. return TCL_ERROR;
  1333. }
  1334. if( Tcl_GetIntFromObj(interp, objv[1], &id) ) return TCL_ERROR;
  1335. if( Tcl_GetIntFromObj(interp, objv[2], &idLC) ) return TCL_ERROR;
  1336. if( (pSeg = findSegment(p, id))==0 ){
  1337. Tcl_AppendResult(interp, "segment ",
  1338. Tcl_GetStringFromObj(objv[2],0), " does not exist", 0);
  1339. return TCL_ERROR;
  1340. }
  1341. pSeg->idLC = idLC;
  1342. return TCL_OK;
  1343. }
  1344. static int Wallset_Method_list(ClientData clientData ,Tcl_Interp *interp ,Tcl_ObjectContext objectContext ,int objc ,Tcl_Obj *const *objv)
  1345. {
  1346. /*
  1347. ** tclmethod: WALLSET list
  1348. ** title: Return a list of all wall segment identifiers
  1349. */
  1350. Wallset *p = GETWALLSET(objectContext);
  1351. Link *pLink;
  1352. Tcl_Obj *pResult;
  1353. pResult = Tcl_NewObj();
  1354. for(pLink=p->pAll; pLink; pLink=pLink->pNext){
  1355. Segment *pSeg=pLink->pLinkNode;
  1356. Tcl_ListObjAppendElement(0, pResult, Tcl_NewIntObj(pSeg->id));
  1357. }
  1358. Tcl_SetObjResult(interp, pResult);
  1359. return TCL_OK;
  1360. }
  1361. static int Wallset_Method_looseends(ClientData clientData ,Tcl_Interp *interp ,Tcl_ObjectContext objectContext ,int objc ,Tcl_Obj *const *objv)
  1362. {
  1363. /*
  1364. ** tclmethod: WALLSET looseends
  1365. ** title: Return a list of walls that are have unconnected ends
  1366. **
  1367. ** For each unconnected end, the list contains four elements:
  1368. ** 1. The wallid
  1369. ** 2. 0 for the "from" end, "1" for the "to" end
  1370. ** 3. The X coordinate of the loose end
  1371. ** 4. The Y coordinate of the loose end
  1372. */
  1373. Wallset *p = GETWALLSET(objectContext);
  1374. Segment *pSeg;
  1375. Link *pAll, *pList;
  1376. Tcl_Obj *pRes = Tcl_NewObj();
  1377. for(pAll=p->pAll; pAll; pAll=pAll->pNext){
  1378. pSeg = pAll->pLinkNode;
  1379. pList = segmentsAtVertex(p, pSeg->from[X_IDX], pSeg->from[Y_IDX]);
  1380. if( LinkCount(pList)==1 ){
  1381. Tcl_ListObjAppendElement(0, pRes, Tcl_NewIntObj(pSeg->id));
  1382. Tcl_ListObjAppendElement(0, pRes, ODIE_INT_ZERO());
  1383. Tcl_ListObjAppendElement(0, pRes, Tcl_NewDoubleObj(pSeg->from[X_IDX]/p->rXZoom));
  1384. Tcl_ListObjAppendElement(0, pRes, Tcl_NewDoubleObj(pSeg->from[Y_IDX]/p->rYZoom));
  1385. }
  1386. pList = segmentsAtVertex(p, pSeg->to[X_IDX], pSeg->to[Y_IDX]);
  1387. if( LinkCount(pList)==1 ){
  1388. Tcl_ListObjAppendElement(0, pRes, Tcl_NewIntObj(pSeg->id));
  1389. Tcl_ListObjAppendElement(0, pRes, ODIE_INT_ONE());
  1390. Tcl_ListObjAppendElement(0, pRes, Tcl_NewDoubleObj(pSeg->to[X_IDX]/p->rXZoom));
  1391. Tcl_ListObjAppendElement(0, pRes, Tcl_NewDoubleObj(pSeg->to[Y_IDX]/p->rYZoom));
  1392. }
  1393. }
  1394. Tcl_SetObjResult(interp, pRes);
  1395. return TCL_OK;
  1396. }
  1397. static int Wallset_Method_nearest(ClientData clientData ,Tcl_Interp *interp ,Tcl_ObjectContext objectContext ,int objc ,Tcl_Obj *const *objv)
  1398. {
  1399. /*
  1400. ** tclmethod: WALLSET nearest vertex|point X Y
  1401. ** title: Find the nearest vertex or point to a point in the plan
  1402. */
  1403. Wallset *p = GETWALLSET(objectContext);
  1404. int type;
  1405. double x, y, near_x, near_y;
  1406. static const char *NEAR_strs[] = { "point", "vertex", 0 };
  1407. enum NEAR_enum { NEAR_POINT, NEAR_VERTEX, };
  1408. Link *pLink;
  1409. Tcl_Obj *pResult;
  1410. double dx, dy, dist;
  1411.  
  1412. if( objc!=5 ){
  1413. Tcl_WrongNumArgs(interp, 1, objv, "point|vertex X Y");
  1414. return TCL_ERROR;
  1415. }
  1416. if( Tcl_GetIndexFromObj(interp, objv[1], NEAR_strs, "option", 0, &type) ){
  1417. return TCL_ERROR;
  1418. }
  1419. if( Tcl_GetDoubleFromObj(interp, objv[2], &x) ) return TCL_ERROR;
  1420. if( Tcl_GetDoubleFromObj(interp, objv[3], &y) ) return TCL_ERROR;
  1421. x *= p->rXZoom;
  1422. y *= p->rYZoom;
  1423. ignoreNone(p);
  1424. if( type==NEAR_POINT ){
  1425. pLink = nearestPoint(p, x, y, &near_x, &near_y);
  1426. }else if( type==NEAR_VERTEX ){
  1427. pLink = nearestVertex(p, x, y, &near_x, &near_y);
  1428. }else{
  1429. /* Cannot happen */ return TCL_ERROR;
  1430. }
  1431. if( pLink==0 ) return TCL_OK; /* There are not segments in the wallset */
  1432. pResult = Tcl_NewObj();
  1433. Tcl_ListObjAppendElement(0, pResult, Tcl_NewDoubleObj(near_x/p->rXZoom));
  1434. Tcl_ListObjAppendElement(0, pResult, Tcl_NewDoubleObj(near_y/p->rYZoom));
  1435. dx = x - near_x;
  1436. dy = y - near_y;
  1437. dist = sqrt(dx*dx + dy*dy);
  1438. Tcl_ListObjAppendElement(0, pResult, Tcl_NewDoubleObj(dist/p->rXZoom));
  1439. Tcl_ListObjAppendElement(0, pResult, Tcl_NewObj());
  1440. while( pLink ){
  1441. Segment *pSeg=pLink->pLinkNode;
  1442. Tcl_ListObjAppendElement(0, pResult, Tcl_NewIntObj(pSeg->id));
  1443. pLink = pLink->pNext;
  1444. }
  1445. Tcl_SetObjResult(interp, pResult);
  1446. return TCL_OK;
  1447. }
  1448. static int Wallset_Method_nextcwwall(ClientData clientData ,Tcl_Interp *interp ,Tcl_ObjectContext objectContext ,int objc ,Tcl_Obj *const *objv)
  1449. {
  1450. /*
  1451. ** tclmethod: WALLSET nextcwwall X0 Y0 X1 Y1
  1452. ** title: Find a wall on X1,Y1 clockwise from X0,Y0->X1,Y1
  1453. */
  1454. Wallset *p = GETWALLSET(objectContext);
  1455. int isBack;
  1456. Segment *pSeg;
  1457. double x0, y0, x1, y1;
  1458. int rc;
  1459. if( objc!=5 ){
  1460. Tcl_WrongNumArgs(interp, 1, objv, "X0 Y0 X1 Y1");
  1461. return TCL_ERROR;
  1462. }
  1463. if( Tcl_GetDoubleFromObj(interp, objv[1], &x0) ) return TCL_ERROR;
  1464. if( Tcl_GetDoubleFromObj(interp, objv[2], &y0) ) return TCL_ERROR;
  1465. if( Tcl_GetDoubleFromObj(interp, objv[3], &x1) ) return TCL_ERROR;
  1466. if( Tcl_GetDoubleFromObj(interp, objv[4], &y1) ) return TCL_ERROR;
  1467. x0 = roundCoord(x0*p->rXZoom);
  1468. y0 = roundCoord(y0*p->rYZoom);
  1469. x1 = roundCoord(x1*p->rXZoom);
  1470. y1 = roundCoord(y1*p->rYZoom);
  1471. rc = nextCwSegment(p, x0, y0, x1, y1, &pSeg, &isBack);
  1472. if( rc==0 ){
  1473. Tcl_Obj *pResult = Tcl_NewObj();
  1474. Tcl_ListObjAppendElement(0, pResult, Tcl_NewIntObj(pSeg->id));
  1475. Tcl_ListObjAppendElement(0, pResult, Tcl_NewIntObj(isBack));
  1476. Tcl_SetObjResult(interp, pResult);
  1477. }
  1478. return TCL_OK;
  1479. }
  1480. static int Wallset_Method_right(ClientData clientData ,Tcl_Interp *interp ,Tcl_ObjectContext objectContext ,int objc ,Tcl_Obj *const *objv)
  1481. {
  1482. /*
  1483. ** tclmethod: WALLSET right ID RC
  1484. ** title: Change the right compartment of a line segment
  1485. */
  1486. Wallset *p = GETWALLSET(objectContext);
  1487. int id, idRC;
  1488. Segment *pSeg;
  1489. if( objc!=3 ){
  1490. Tcl_WrongNumArgs(interp, 1, objv, "ID RC");
  1491. return TCL_ERROR;
  1492. }
  1493. if( Tcl_GetIntFromObj(interp, objv[1], &id) ) return TCL_ERROR;
  1494. if( Tcl_GetIntFromObj(interp, objv[2], &idRC) ) return TCL_ERROR;
  1495. if( (pSeg = findSegment(p, id))==0 ){
  1496. Tcl_AppendResult(interp, "segment ",
  1497. Tcl_GetStringFromObj(objv[2],0), " does not exist", 0);
  1498. return TCL_ERROR;
  1499. }
  1500. pSeg->idRC = idRC;
  1501. return TCL_OK;
  1502. }
  1503. static int Wallset_Method_selfcheck(ClientData clientData ,Tcl_Interp *interp ,Tcl_ObjectContext objectContext ,int objc ,Tcl_Obj *const *objv)
  1504. {
  1505. /*
  1506. ** tclmethod: WALLSET selfcheck
  1507. ** title: Verify the integrity of internal data structures
  1508. */
  1509. Wallset *p = GETWALLSET(objectContext);
  1510. return selfCheck(interp, p);
  1511. }
  1512. static int Wallset_Method_zoom(ClientData clientData ,Tcl_Interp *interp ,Tcl_ObjectContext objectContext ,int objc ,Tcl_Obj *const *objv)
  1513. {
  1514. /*
  1515. ** tclmethod: WALLSET zoom ?ZOOM?
  1516. ** title: Query or change the zoom factor.
  1517. */
  1518. Wallset *p = GETWALLSET(objectContext);
  1519. Tcl_Obj *pResult;
  1520. if( objc!=2 && objc!=3 ){
  1521. Tcl_WrongNumArgs(interp, 2, objv, "?ZOOM?");
  1522. return TCL_ERROR;
  1523. }
  1524. if( objc==3 ){
  1525. double r;
  1526. if( Tcl_GetDoubleFromObj(interp, objv[2], &r) ) return TCL_ERROR;
  1527. if( r==0.0 ){
  1528. Tcl_AppendResult(interp, "zoom must be non-zero", 0);
  1529. return TCL_ERROR;
  1530. }
  1531. p->rYZoom = r;
  1532. p->rXZoom = fabs(r);
  1533. }
  1534. pResult = Tcl_NewDoubleObj(p->rYZoom);
  1535. Tcl_SetObjResult(interp, pResult);
  1536. return TCL_OK;
  1537. }
  1538. static int Wallset_Method_constructor(ClientData clientData ,Tcl_Interp *interp ,Tcl_ObjectContext objectContext ,int objc ,Tcl_Obj *const *objv)
  1539. {
  1540. /*
  1541. ** tclcmd: wallset WALLSET
  1542. ** title: Create a new wallset object
  1543. ** This routine runs when the "wallset" command is invoked to create a
  1544. ** new wallset.
  1545. */
  1546. Wallset *p;
  1547. Tcl_Object thisObject = Tcl_ObjectContextObject(objectContext);
  1548. /* The current connection object */
  1549. /*
  1550. ** if( objc!=1 ){
  1551. ** Tcl_WrongNumArgs(interp, 1, objv, "WALLSET");
  1552. ** return TCL_ERROR;
  1553. **}
  1554. **zCmd = Tcl_GetStringFromObj(objv[1], 0);
  1555. */
  1556.  
  1557. p = (Wallset *)Odie_Alloc( sizeof(*p) );
  1558. p->rXZoom = 100.0;
  1559. p->rYZoom = -100.0;
  1560.  
  1561. Tcl_ObjectSetMetadata(thisObject, &WallsetDataType, (ClientData) p);
  1562. return TCL_OK;
  1563. }
  1564. const static Tcl_MethodType WallsetMethodType_atvertex = {
  1565. TCL_OO_METADATA_VERSION_CURRENT,
  1566. "atvertex",
  1567. NULL,
  1568. NULL
  1569. };
  1570. const static Tcl_MethodType WallsetMethodType_boundary = {
  1571. TCL_OO_METADATA_VERSION_CURRENT,
  1572. "boundary",
  1573. NULL,
  1574. NULL
  1575. };
  1576. const static Tcl_MethodType WallsetMethodType_closure = {
  1577. TCL_OO_METADATA_VERSION_CURRENT,
  1578. "closure",
  1579. NULL,
  1580. NULL
  1581. };
  1582. const static Tcl_MethodType WallsetMethodType_comptlist = {
  1583. TCL_OO_METADATA_VERSION_CURRENT,
  1584. "comptlist",
  1585. NULL,
  1586. NULL
  1587. };
  1588. const static Tcl_MethodType WallsetMethodType_corners = {
  1589. TCL_OO_METADATA_VERSION_CURRENT,
  1590. "corners",
  1591. NULL,
  1592. NULL
  1593. };
  1594. const static Tcl_MethodType WallsetMethodType_delete = {
  1595. TCL_OO_METADATA_VERSION_CURRENT,
  1596. "delete",
  1597. NULL,
  1598. NULL
  1599. };
  1600. const static Tcl_MethodType WallsetMethodType_firstboundary = {
  1601. TCL_OO_METADATA_VERSION_CURRENT,
  1602. "firstboundary",
  1603. NULL,
  1604. NULL
  1605. };
  1606. const static Tcl_MethodType WallsetMethodType_foreach = {
  1607. TCL_OO_METADATA_VERSION_CURRENT,
  1608. "foreach",
  1609. NULL,
  1610. NULL
  1611. };
  1612. const static Tcl_MethodType WallsetMethodType_info = {
  1613. TCL_OO_METADATA_VERSION_CURRENT,
  1614. "info",
  1615. NULL,
  1616. NULL
  1617. };
  1618. const static Tcl_MethodType WallsetMethodType_insert = {
  1619. TCL_OO_METADATA_VERSION_CURRENT,
  1620. "insert",
  1621. NULL,
  1622. NULL
  1623. };
  1624. const static Tcl_MethodType WallsetMethodType_primary = {
  1625. TCL_OO_METADATA_VERSION_CURRENT,
  1626. "primary",
  1627. NULL,
  1628. NULL
  1629. };
  1630. const static Tcl_MethodType WallsetMethodType_intersect = {
  1631. TCL_OO_METADATA_VERSION_CURRENT,
  1632. "intersect",
  1633. NULL,
  1634. NULL
  1635. };
  1636. const static Tcl_MethodType WallsetMethodType_left = {
  1637. TCL_OO_METADATA_VERSION_CURRENT,
  1638. "left",
  1639. NULL,
  1640. NULL
  1641. };
  1642. const static Tcl_MethodType WallsetMethodType_list = {
  1643. TCL_OO_METADATA_VERSION_CURRENT,
  1644. "list",
  1645. NULL,
  1646. NULL
  1647. };
  1648. const static Tcl_MethodType WallsetMethodType_looseends = {
  1649. TCL_OO_METADATA_VERSION_CURRENT,
  1650. "looseends",
  1651. NULL,
  1652. NULL
  1653. };
  1654. const static Tcl_MethodType WallsetMethodType_nearest = {
  1655. TCL_OO_METADATA_VERSION_CURRENT,
  1656. "nearest",
  1657. NULL,
  1658. NULL
  1659. };
  1660. const static Tcl_MethodType WallsetMethodType_nextcwwall = {
  1661. TCL_OO_METADATA_VERSION_CURRENT,
  1662. "nextcwwall",
  1663. NULL,
  1664. NULL
  1665. };
  1666. const static Tcl_MethodType WallsetMethodType_right = {
  1667. TCL_OO_METADATA_VERSION_CURRENT,
  1668. "right",
  1669. NULL,
  1670. NULL
  1671. };
  1672. const static Tcl_MethodType WallsetMethodType_selfcheck = {
  1673. TCL_OO_METADATA_VERSION_CURRENT,
  1674. "selfcheck",
  1675. NULL,
  1676. NULL
  1677. };
  1678. const static Tcl_MethodType WallsetMethodType_zoom = {
  1679. TCL_OO_METADATA_VERSION_CURRENT,
  1680. "zoom",
  1681. NULL,
  1682. NULL
  1683. };
  1684. const static Tcl_MethodType WallsetMethodType_constructor = {
  1685. TCL_OO_METADATA_VERSION_CURRENT,
  1686. "constructor",
  1687. NULL,
  1688. NULL
  1689. };
  1690.  
  1691. int Odie_Wallset_Init(
  1692. Tcl_Interp *interp
  1693. )
  1694. {
  1695.  
  1696. /*
  1697. ** Build the "wallset" class
  1698. */
  1699. Tcl_Obj* nameObj; /* Name of a class or method being looked up */
  1700. Tcl_Object curClassObject; /* Tcl_Object representing the current class */
  1701. Tcl_Class curClass; /* Tcl_Class representing the current class */
  1702.  
  1703. /*
  1704. * Find the wallset class, and attach an 'init' method to it.
  1705. */
  1706.  
  1707. nameObj = Tcl_NewStringObj("::wallset", -1);
  1708. Tcl_IncrRefCount(nameObj);
  1709. if ((curClassObject = Tcl_GetObjectFromObj(interp, nameObj)) == NULL) {
  1710. Tcl_DecrRefCount(nameObj);
  1711. return TCL_ERROR;
  1712. }
  1713. Tcl_DecrRefCount(nameObj);
  1714. curClass = Tcl_GetObjectAsClass(curClassObject);
  1715. /* Attach the constructor to the 'connection' class */
  1716.  
  1717. Tcl_ClassSetConstructor(interp, curClass,
  1718. Tcl_NewMethod(interp, curClass, NULL, 1,
  1719. &WallsetMethodType_constructor, NULL));
  1720.  
  1721. nameObj=Tcl_NewStringObj("atvertex",-1);
  1722. Tcl_NewMethod(interp, curClass, nameObj, 1, &WallsetMethodType_atvertex, (ClientData) NULL);
  1723. Tcl_DecrRefCount(nameObj);
  1724. nameObj=Tcl_NewStringObj("boundary",-1);
  1725. Tcl_NewMethod(interp, curClass, nameObj, 1, &WallsetMethodType_boundary, (ClientData) NULL);
  1726. Tcl_DecrRefCount(nameObj);
  1727. nameObj=Tcl_NewStringObj("closure",-1);
  1728. Tcl_NewMethod(interp, curClass, nameObj, 1, &WallsetMethodType_closure, (ClientData) NULL);
  1729. Tcl_DecrRefCount(nameObj);
  1730. nameObj=Tcl_NewStringObj("comptlist",-1);
  1731. Tcl_NewMethod(interp, curClass, nameObj, 1, &WallsetMethodType_comptlist, (ClientData) NULL);
  1732. Tcl_DecrRefCount(nameObj);
  1733. nameObj=Tcl_NewStringObj("corners",-1);
  1734. Tcl_NewMethod(interp, curClass, nameObj, 1, &WallsetMethodType_corners, (ClientData) NULL);
  1735. Tcl_DecrRefCount(nameObj);
  1736. nameObj=Tcl_NewStringObj("delete",-1);
  1737. Tcl_NewMethod(interp, curClass, nameObj, 1, &WallsetMethodType_delete, (ClientData) NULL);
  1738. Tcl_DecrRefCount(nameObj);
  1739. nameObj=Tcl_NewStringObj("firstboundary",-1);
  1740. Tcl_NewMethod(interp, curClass, nameObj, 1, &WallsetMethodType_firstboundary, (ClientData) NULL);
  1741. Tcl_DecrRefCount(nameObj);
  1742. nameObj=Tcl_NewStringObj("foreach",-1);
  1743. Tcl_NewMethod(interp, curClass, nameObj, 1, &WallsetMethodType_foreach, (ClientData) NULL);
  1744. Tcl_DecrRefCount(nameObj);
  1745. nameObj=Tcl_NewStringObj("info",-1);
  1746. Tcl_NewMethod(interp, curClass, nameObj, 1, &WallsetMethodType_info, (ClientData) NULL);
  1747. Tcl_DecrRefCount(nameObj);
  1748. nameObj=Tcl_NewStringObj("insert",-1);
  1749. Tcl_NewMethod(interp, curClass, nameObj, 1, &WallsetMethodType_insert, (ClientData) NULL);
  1750. Tcl_DecrRefCount(nameObj);
  1751. nameObj=Tcl_NewStringObj("primary",-1);
  1752. Tcl_NewMethod(interp, curClass, nameObj, 1, &WallsetMethodType_primary, (ClientData) NULL);
  1753. Tcl_DecrRefCount(nameObj);
  1754. nameObj=Tcl_NewStringObj("intersect",-1);
  1755. Tcl_NewMethod(interp, curClass, nameObj, 1, &WallsetMethodType_intersect, (ClientData) NULL);
  1756. Tcl_DecrRefCount(nameObj);
  1757. nameObj=Tcl_NewStringObj("left",-1);
  1758. Tcl_NewMethod(interp, curClass, nameObj, 1, &WallsetMethodType_left, (ClientData) NULL);
  1759. Tcl_DecrRefCount(nameObj);
  1760. nameObj=Tcl_NewStringObj("list",-1);
  1761. Tcl_NewMethod(interp, curClass, nameObj, 1, &WallsetMethodType_list, (ClientData) NULL);
  1762. Tcl_DecrRefCount(nameObj);
  1763. nameObj=Tcl_NewStringObj("looseends",-1);
  1764. Tcl_NewMethod(interp, curClass, nameObj, 1, &WallsetMethodType_looseends, (ClientData) NULL);
  1765. Tcl_DecrRefCount(nameObj);
  1766. nameObj=Tcl_NewStringObj("nearest",-1);
  1767. Tcl_NewMethod(interp, curClass, nameObj, 1, &WallsetMethodType_nearest, (ClientData) NULL);
  1768. Tcl_DecrRefCount(nameObj);
  1769. nameObj=Tcl_NewStringObj("nextcwwall",-1);
  1770. Tcl_NewMethod(interp, curClass, nameObj, 1, &WallsetMethodType_nextcwwall, (ClientData) NULL);
  1771. Tcl_DecrRefCount(nameObj);
  1772. nameObj=Tcl_NewStringObj("right",-1);
  1773. Tcl_NewMethod(interp, curClass, nameObj, 1, &WallsetMethodType_right, (ClientData) NULL);
  1774. Tcl_DecrRefCount(nameObj);
  1775. nameObj=Tcl_NewStringObj("selfcheck",-1);
  1776. Tcl_NewMethod(interp, curClass, nameObj, 1, &WallsetMethodType_selfcheck, (ClientData) NULL);
  1777. Tcl_DecrRefCount(nameObj);
  1778. nameObj=Tcl_NewStringObj("zoom",-1);
  1779. Tcl_NewMethod(interp, curClass, nameObj, 1, &WallsetMethodType_zoom, (ClientData) NULL);
  1780. Tcl_DecrRefCount(nameObj);
  1781. return TCL_OK;
  1782. }
  1783.