Random Bits of Open Code

Check-in [7fea4e7d8b]
Login

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:fixed couple dumb bugs in geolib
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1:7fea4e7d8bea5c64e7c3dc78cf5cae0abb27b857
User & Date: matt 2019-01-02 04:38:01
Context
2019-01-02
04:44
Cleanup Leaf check-in: 163f87e51a user: matt tags: trunk
04:38
fixed couple dumb bugs in geolib check-in: 7fea4e7d8b user: matt tags: trunk
2018-12-21
01:03
adjusted evaled calls to mtconfig methods to properly reflect namespace check-in: 48bff81ed5 user: bjbarcla tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to geolib/compgeom.scm.

1857
1858
1859
1860
1861
1862
1863
1864
1865
1866
1867
1868
1869
1870
1871
  (debug-check-param polygon? p1 "ERROR: poly-touching? p1 not a polygon " p1)
  (debug-check-param polygon? p2 "ERROR: poly-touching? p2 not a polygon " p2)
  ;; (print "poly-touching? p1=" (get-field p1 'name) ",p2=" (get-field p2 'name))
  ;; (print "poly-touching? p1=" p1 ",p2=" p2)
  (let ((points1 (get-field p1 'points))
	(is-poly-p1 (polygon? p1))
        (is-poly-p2 (polygon? p2))
        (points1 (get-field p1 'points))
        (points2 (get-field p2 'points)))
    ;; (print "points1=" points1)
    ;; (print "points2=" points2)
    (if (poly-point-touching? p2 (car points1))
        #t
        (let ((segments1 (get-field p1 'segments)) ;; (list->segments points1))
              (segments2 (get-field p2 'segments))) ;; (list->segments points2)))







|







1857
1858
1859
1860
1861
1862
1863
1864
1865
1866
1867
1868
1869
1870
1871
  (debug-check-param polygon? p1 "ERROR: poly-touching? p1 not a polygon " p1)
  (debug-check-param polygon? p2 "ERROR: poly-touching? p2 not a polygon " p2)
  ;; (print "poly-touching? p1=" (get-field p1 'name) ",p2=" (get-field p2 'name))
  ;; (print "poly-touching? p1=" p1 ",p2=" p2)
  (let ((points1 (get-field p1 'points))
	(is-poly-p1 (polygon? p1))
        (is-poly-p2 (polygon? p2))
        ;; (points1 (get-field p1 'points))
        (points2 (get-field p2 'points)))
    ;; (print "points1=" points1)
    ;; (print "points2=" points2)
    (if (poly-point-touching? p2 (car points1))
        #t
        (let ((segments1 (get-field p1 'segments)) ;; (list->segments points1))
              (segments2 (get-field p2 'segments))) ;; (list->segments points2)))

Changes to geolib/geolib.scm.

66
67
68
69
70
71
72
73
74
75
76
77
78
79

80
81
82
83

84
85
86
87
88
89
90
91
...
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
...
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
;; the idea here is to fake a simple object oriented like interface
;; that makes the routines work for lists or vectors (or anything else)
;; the user fills a vector with the accessor in 0 and the setter in 1
(define (geolib:box-getter v)(vector-ref v 0))
(define (geolib:box-setter v)(vector-ref v 1))

;; accessors for boxes as list
(define (geolib:box-as-list)
  (list->vector
   (list 
    list-ref        ;; access individual numbers
    (lambda (l i v) ;; set i-th to v
      (let ((vl (list->vector l)))
	(vector->list 

	 (vector-set! 
	  (if (> (- (vector-length vl) 1) i)
	      vl
	      (vector-resize vl (+ i 1)))

	  i v)))))))
    

(define (geolib:pt-in-box? x0 y0 x1 y1 ptx pty)
  (and (in-range? x1 x0 ptx)
       (in-range? y1 y0 pty)))

(define (geolib:box-in-box? x0 y0 x1 y1 ptx1 pty1 ptx2 pty2)
................................................................................
		   (tal (cdr lst-o-mirrors))
		   (len #f)
		   (res #f))
	  (let* ((refl   (ray-reflect ray hed))
		 (newlen (if refl
			     (line-length (list ray-xorig ray-yorig (car refl)(cadr refl)))
			     #f)))
	    (if (or (and refl (not len)(> newlen 0.1))
		    (and newlen (> newlen 0.1)(< newlen len))) ;; heuristically speaking
		(if (null? tal)
		    (list refl hed)
		    (loop (car tal)(cdr tal) newlen (list refl hed)))
		(if (null? tal)
		    res
		    (loop (car tal)(cdr tal) len res))))))))
................................................................................

(define (scale val)
  (/ val 40))

(define (rect->polar x0 y0 x1 y1)
  (let* ((deltax (- x0 x1))
         (deltay (- y0 y1))
         (r (sqrt (expt deltax 2)(expt deltay 2)))
         (t (atan (/ deltay deltax))))
    (list t r)))

(define (rotate-pt angle x y) ;; angle in _radians_
  (let ((sinval (sin angle))
        (cosval (cos angle)))
    (list (- (* x cosval)(* y sinval))







|
|
|
|
|
|
|
>
|
|
|
|
>
|







 







|







 







|







66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
...
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
...
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
;; the idea here is to fake a simple object oriented like interface
;; that makes the routines work for lists or vectors (or anything else)
;; the user fills a vector with the accessor in 0 and the setter in 1
(define (geolib:box-getter v)(vector-ref v 0))
(define (geolib:box-setter v)(vector-ref v 1))

;; accessors for boxes as list
;; (define (geolib:box-as-list)
;;   (list->vector
;;    (list 
;;     list-ref        ;; access individual numbers
;;     (lambda (l i v) ;; set i-th to v
;;       (let ((vl (list->vector l)))
;; 	(vector->list 
;; 	 (begin
;; 	   (vector-set! 
;; 	    (if (> (- (vector-length vl) 1) i)
;; 		vl
;; 		(vector-resize vl (+ i 1)))
;; 	    i v)
;; 	   ))))))
    

(define (geolib:pt-in-box? x0 y0 x1 y1 ptx pty)
  (and (in-range? x1 x0 ptx)
       (in-range? y1 y0 pty)))

(define (geolib:box-in-box? x0 y0 x1 y1 ptx1 pty1 ptx2 pty2)
................................................................................
		   (tal (cdr lst-o-mirrors))
		   (len #f)
		   (res #f))
	  (let* ((refl   (ray-reflect ray hed))
		 (newlen (if refl
			     (line-length (list ray-xorig ray-yorig (car refl)(cadr refl)))
			     #f)))
	    (if (or (and refl newlen (not len)(> newlen 0.1))
		    (and newlen (> newlen 0.1)(< newlen len))) ;; heuristically speaking
		(if (null? tal)
		    (list refl hed)
		    (loop (car tal)(cdr tal) newlen (list refl hed)))
		(if (null? tal)
		    res
		    (loop (car tal)(cdr tal) len res))))))))
................................................................................

(define (scale val)
  (/ val 40))

(define (rect->polar x0 y0 x1 y1)
  (let* ((deltax (- x0 x1))
         (deltay (- y0 y1))
         (r (sqrt (+ (expt deltax 2)(expt deltay 2))))
         (t (atan (/ deltay deltax))))
    (list t r)))

(define (rotate-pt angle x y) ;; angle in _radians_
  (let ((sinval (sin angle))
        (cosval (cos angle)))
    (list (- (* x cosval)(* y sinval))