stklos problem: stack corruption with scale and canvas

From: Mark Montague <monty_at_gg.caltech.edu>
Date: Wed, 05 Jun 2002 13:31:50 -0700

Hi, schemers--

I've been trying to write a little application with STklos 0.52, which
I compiled myself for debian i386 linux. When I run this program,
after some time fiddling with the sliders, it appears to pass the
wrong info somewhere, i.e.:

Error while executing file "minbug.byte" (%adj-ctrl: "bad adjustment
`(137.682157106091 114.056524563929 141.369126005883 117.433840115068
145.056094905675 120.811155666207 148.743063805468 124.188471217346
152.43003270526 127.565786768485 156.117001605052)'").
EXIT

It seems to be more likely to happen when I tweak one slider for a
while, then switch to another. The problem seems independent of
whether the program is compiled or interpreted. Decreasing the
complexity of the canvas objects updated seems to help, as does using
:update-policy 'delayed (commented out below) but neither of these
solves the problem completely. Suspiciously, it doesn't seem to crash
if I update only one slider.

Anyway, here's the code. Sorry its a little sloppy (and not very OO).

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(require "gtklos")

(define w (make <window> :title "bug-example" ))

(define c1 (make <canvas> :parent w :width 200 :height 200))

(define pi (* 4 (atan 1)))

(define numlines 8)
(define numsteps 20)
(define stepsize 5)
(define theta 0)
(define sfq 10)
(define phase 0)

(define c1lines '())

(define pointlist
  (lambda (theta sx sy)
    (let ((p '())
          (dx (* stepsize (cos (- theta (/ pi 2)))))
          (dy (* stepsize (sin (- theta (/ pi 2))))))
      (do ((n 0 (+ n 1))
           (x sx (+ x dx))
           (y sy (+ y dy)))
          ((>= n numsteps))
        (set! p (append p (list x y))))
      p)))

(do ((i 0 (+ i 1)))
    ((>= i numlines))
  (begin
    (set! c1lines
          (append c1lines (list (make <canvas-line> :parent c1
                                      :points (pointlist
                                               theta
                                               (+ 100 (* i (/ 50 sfq)))
                                               100)))))))
                        


(define update-lines
  (lambda ()
    (do ((i 0 (+ i 1)))
        ((>= i numlines))
      (let* ((c1l (list-ref c1lines i))
             (sp (/ 50 sfq))
             (ct (* (cos theta) sp))
             (st (* (sin theta) sp))
             (spx (* i ct))
             (spy (* i st))
             (phx (* phase ct))
             (phy (* phase st))
             (pts (pointlist theta
                             (+ 100 phx spx)
                             (+ 100 phy spy))))
        (set! (points c1l) pts)
        ))))
        

(define update-all
  ( lambda ()
    (begin
     (update-lines)
     )))
                   
(define update-theta
  (lambda (t)
    (begin
     (set! theta t)
     (update-all))))

(define update-sfq
  (lambda (f)
    (begin
     (set! sfq f)
     (update-all))))

(define update-phase
  (lambda (p)
    (begin
     (set! phase p)
     (update-all))))

            
;; sliders for angle, phase, frequency, propogation speed(?)

(define hb (make <box> :orientation 'horizontal :padding 4
                :expand #t :fill #t))
(container-add! (layout w) hb)
(make <label> :text "angle" :parent hb)
(make <scale> :orientation 'horizontal :parent hb
      :from 0 :to (* 2 pi) ; :update-policy 'delayed
      :command (lambda (e)
                 (let* ((t (value (event-widget e))))
                   (update-theta t))))

(set! hb (make <box> :orientation 'horizontal :padding 4
                :expand #t :fill #t))
(container-add! (layout w) hb)
(make <label> :text "spatial frequency" :parent hb)
(make <scale> :orientation 'horizontal :parent hb
      :from 2 :to 20 :value 10 ; :update-policy 'delayed
      :command (lambda (e)
                 (let* ((f (value (event-widget e))))
                   (update-sfq f))))
      


(set! hb (make <box> :orientation 'horizontal :padding 4
                :expand #t :fill #t))
(container-add! (layout w) hb)
(make <label> :text "phase" :parent hb)
(make <scale> :orientation 'horizontal :parent hb
      :from 0 :to 1 ; :update-policy 'delayed
      :command (lambda (e)
                 (let* ((p (value (event-widget e))))
                   (update-phase p))))

(make <button> :parent w :text "quit" :command
      (lambda (e) (exit 0)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

                thanks

                                - M
--
Mark "Monty" Montague | monty_at_gg.caltech.edu  | I don't do Windows(tm)
If a tree falls when there's no one observing, does its wave function collapse?
	  <URL:http://www.gg.caltech.edu/~monty/monty.shtml>
 X-PGP-Fingerprint: E4 EA 6D B1 82 46 DB A1  B0 FF 60 B9 F9 5D 5C F7
Received on Wed Jun 05 2002 - 22:32:05 CEST

This archive was generated by hypermail 2.3.0 : Mon Jul 21 2014 - 19:38:59 CEST