gl-glxgears: Move per-frame notes to %trace2.

diff --git a/src/gl/gl-glxgears.scm b/src/gl/gl-glxgears.scm
index 4d62c72b55e8396be8c3b40ddcaa0d7ffab85197..4dad46c1b43166a8b6d9f8b562f79be69401ba55 100644 (file)
--- a/src/gl/gl-glxgears.scm
+++ b/src/gl/gl-glxgears.scm
@@ -59,7 +59,7 @@ USA.
     (gtk-window-set-opacity window 1.0)
     (gtk-window-set-title window title)
     (set-gtk-window-delete-event-callback!
-     window (lambda (w) (%trace ";closed "w"\n") 0))
+     window (lambda (w) (%trace "closed "w) 0))
     (gtk-container-set-border-width window 5)
     (let ((widget (%make-glxgears-demo width height)))
       (gtk-container-add window widget)
@@ -97,11 +97,11 @@ USA.
   (make-animation-thread widget))
 
 (define-method fix-widget-new-geometry-callback ((widget <glxgears-demo>))
-  (%trace "; (fix-widget-new-geometry-callback <glxgears-demo>)\n")
+  (%trace "fix-widget-new-geometry-callback <glxgears-demo>")
   (wake-animation-thread widget))
 
 (define (unrealize-callback widget)
-  (%trace "; unrealize-callback "widget" "(gtk-widget-destroyed? widget)"\n")
+  (%trace "unrealize-callback "widget" "(gtk-widget-destroyed? widget))
   ;; Is this necessary when the context is about to be (already?) destroyed?
   #;(let ((gears (glxgears-demo-gears widget)))
     (with-glx-widget widget
@@ -112,33 +112,33 @@ USA.
   (halt-animation-thread widget))
 
 (define (draw-callback widget area)
-  (%trace "; draw-callback "widget" "area"\n"))
+  (%trace "draw-callback "widget" "area))
 
 (define (map-handler widget)
-  (%trace "; map-handler "widget"\n")
+  (%trace "map-handler "widget)
   (set-glxgears-demo-mapped?! widget #t)
   (wake-animation-thread widget)
   #f)
 
 (define (unmap-handler widget)
-  (%trace "; unmap-handler "widget"\n")
+  (%trace "unmap-handler "widget)
   (set-glxgears-demo-mapped?! widget #f)
   #f)
 
 (define (enter-notify-handler widget)
-  (%trace "; enter-notify-handler "widget"\n")
+  (%trace "enter-notify-handler "widget)
   #f)
 
 (define (leave-notify-handler widget)
-  (%trace "; leave-notify-handler "widget"\n")
+  (%trace "leave-notify-handler "widget)
   #f)
 
 (define (focus-change-handler widget in?)
-  (%trace "; focus-change-handler "widget" "in?"\n")
+  (%trace "focus-change-handler "widget" "in?)
   #f)
 
 (define (visibility-notify-handler widget how)
-  (%trace "; visibility-notify-handler "widget" "how"\n")
+  (%trace "visibility-notify-handler "widget" "how)
   (let ((old (glxgears-demo-visibility widget)))
     (set-glxgears-demo-visibility! widget how)
     (if (and (eq? old 'OBSCURED) (not (eq? how 'OBSCURED)))
@@ -146,7 +146,7 @@ USA.
   #t)
 
 (define (key-press-handler widget key bits)
-  (%trace "; key-press-handler "widget" "key" "bits"\n")
+  (%trace "key-press-handler "widget" "key" "bits)
   ;;(declare (ignore bits))
   (case key
     ((#\escape #\q #\Q) (gtk-widget-destroy (gtk-widget-parent widget)))
@@ -184,11 +184,11 @@ USA.
    widget (+ incr (glxgears-demo-view-roty widget))))
 
 (define (motion-handler widget modifiers x y)
-  (%trace ";motion-handler "widget" "modifiers" "x"x"y"\n")
+  (%trace2 "motion-handler "widget" "modifiers" "x"x"y)
   #f)
 
 (define (button-handler widget name button modifiers x y)
-  (%trace ";button-handler "widget" "name" "button" "modifiers" "x"x"y"\n")
+  (%trace "button-handler "widget" "name" "button" "modifiers" "x"x"y)
   #f)
 
 (define (make-animation-thread widget)
@@ -199,6 +199,7 @@ USA.
             (call-with-current-continuation
              (lambda (halt)
                (set-glxgears-demo-animation-halt! widget halt)
+               (%trace "animation thread started")
                (let loop ()
 
                  ;; Sleep when not mapped?, not animate?, or obscured.
@@ -209,17 +210,14 @@ USA.
                               (not (glxgears-demo-animate? widget))
                               (eq? 'OBSCURED visibility))
                           (begin
-                            (fresh-line)
-                            (%trace ";glxgears: sleeping")
-                            (if (eq? 'OBSCURED visibility)
-                                (%trace " while obscured"))
-                            (%trace "...\n")
+                            (if (and %trace? (eq? 'OBSCURED visibility))
+                                (%trace "sleeping while obscured...")
+                                (%trace "sleeping..."))
                             (suspend-current-thread)
-                            (fresh-line)
-                            (%trace ";glxgears: ...awake!\n"))))))
+                            (%trace "...awake!"))))))
 
                  (if (not (glxgears-demo-mapped? widget))
-                     (%trace ";glxgears: not mapped\n")
+                     (%trace "not mapped!")
                      (begin
                        ;; Init, if necessary.
                        (if (not (glxgears-demo-gears widget))
@@ -244,7 +242,7 @@ USA.
      ((glxgears-demo-animation-halt widget) unspecific))))
 
 (define (draw-frame widget)
-  (%trace "; draw-frame\n")
+  (%trace2 "draw-frame")
 
   (if (glxgears-demo-animate? widget)
       (let ((now (real-time-clock))
@@ -262,9 +260,9 @@ USA.
   (with-glx-widget widget
     (lambda ()
       (draw widget)
-      (%trace ";     swap-buffers\n")
+      (%trace2 "swap-buffers")
       (glx:swap-buffers widget)
-      (%trace ";     flush\n")
+      (%trace2 "flush")
       (gl:flush)))
   (if (and (glxgears-demo-animate? widget)
           (glxgears-demo-report-fps? widget))
@@ -276,13 +274,13 @@ USA.
                   (->flonum (internal-time/ticks->seconds (fix:- now start)))))
              (if (>= seconds 5.0)
                  (let ((fps (/ (->flonum count) seconds)))
-                   (define-integrable (%3.1f n)
+                   (define-integrable (%.1f n)
                      (number->string (/ (round (* 10. n)) 10.)))
-                   (define-integrable (%6.3f n)
+                   (define-integrable (%.3f n)
                      (number->string (/ (round (* 1000. n)) 1000.)))
                    (for-each display (list "; glxgears: "count" frames"
-                                           " in "(%3.1f seconds)" seconds"
-                                           " = "(%6.3f fps)" FPS\n"))
+                                           " in "(%.1f seconds)" seconds"
+                                           " = "(%.3f fps)" FPS\n"))
                    (set-glxgears-demo-frame-count-start! widget now)
                    (set-glxgears-demo-frame-count! widget 0))))
            (begin
@@ -290,7 +288,7 @@ USA.
              (set-glxgears-demo-frame-count! widget 0))))))
 
 (define (draw widget)
-  (%trace "; draw "widget"\n")
+  (%trace2 "  draw "widget)
   (let ((angle (glxgears-demo-angle widget))
        (gears (glxgears-demo-gears widget))
        (view-rotx (glxgears-demo-view-rotx widget))
@@ -301,7 +299,8 @@ USA.
       (draw-gears angle gear1 gear2 gear3 view-rotx view-roty))))
 
 (define (draw-gears angle gear1 gear2 gear3 view-rotx view-roty)
-  (%trace "; draw-gears "angle" "gear1" "gear2" "gear3" "view-rotx" "view-roty"\n")
+  (%trace2 "    draw-gears "
+          angle" "gear1" "gear2" "gear3" "view-rotx" "view-roty)
   (gl:clear 'COLOR-BUFFER 'DEPTH-BUFFER)
   (gl:push-matrix)
   (gl:rotate view-rotx 1. 0. 0.)
@@ -336,7 +335,7 @@ USA.
       (if (not (and (fix:= (car w.h) width)
                    (fix:= (cdr w.h) height)))
          (begin
-           (%trace ";glxgears: reshape "width" "height" "widget"\n")
+           (%trace "reshape "width" "height" "widget)
            (with-glx-widget widget
              (lambda ()
                (gl:viewport 0 0 width height)
@@ -353,7 +352,7 @@ USA.
            (set-glxgears-demo-shape! widget (cons width height)))))))
 
 (define (init widget)
-  (%trace "; glxgears: init "widget"\n")
+  (%trace "init "widget)
   (reshape widget)
   (with-glx-widget widget
     (lambda ()
@@ -361,7 +360,7 @@ USA.
            (red (color 0.8 0.1 0.0 1.0))
            (green (color 0.0 0.8 0.2 1.0))
            (blue (color 0.2 0.2 1.0 1.0)))
-       (%trace ";light\n")
+       (%trace "light")
        (gl:light 'LIGHT0 'POSITION pos)
        (gl:enable 'CULL-FACE)
        (gl:enable 'LIGHTING)
@@ -370,21 +369,21 @@ USA.
 
        ;; make the gears
        (let ((gear1 (gl:gen-lists 1)))
-         (%trace ";gear1 => "gear1"\n")
+         (%trace "gear1 = "gear1)
          (gl:new-list gear1 'COMPILE)
          (gl:material 'FRONT 'AMBIENT-AND-DIFFUSE red)
          (draw-gear 1.0 4.0 1.0 20. 0.7)
          (gl:end-list)
 
          (let ((gear2 (gl:gen-lists 1)))
-           (%trace ";gear2 => "gear2"\n")
+           (%trace "gear2 = "gear2)
            (gl:new-list gear2 'COMPILE)
            (gl:material 'FRONT 'AMBIENT-AND-DIFFUSE green)
            (draw-gear 0.5 2.0 2.0 10. 0.7)
            (gl:end-list)
 
            (let ((gear3 (gl:gen-lists 1)))
-             (%trace ";gear3 => "gear3"\n")
+             (%trace "gear3 = "gear3)
              (gl:new-list gear3 'COMPILE)
              (gl:material 'FRONT 'AMBIENT-AND-DIFFUSE blue)
              (draw-gear 1.3 2.0 0.5 10. 0.7)
@@ -398,7 +397,7 @@ USA.
                   width                ; width of gear
                   teeth                ; number of teeth
                   tooth-depth)         ; depth of tooth
-  (%trace "; draw-gear "inner-radius" "outer-radius" "width" "teeth" "tooth-depth"\n")
+  (%trace "draw-gear "inner-radius" "outer-radius" "width" "teeth" "tooth-depth)
   (let ((r0 inner-radius)
        (r1 (- outer-radius (/ tooth-depth 2.)))
        (r2 (+ outer-radius (/ tooth-depth 2.)))
@@ -534,9 +533,16 @@ USA.
 
 (define-integrable color flo:4d)
 
-(define %trace? #f)
+(define %trace? #t)
 
 (define-syntax %trace
   (syntax-rules ()
     ((_ ARGS ...)
-     (if %trace? (display ARGS ...)))))
\ No newline at end of file
+     (if %trace? (outf-error "; " ARGS ... "\n")))))
+
+(define %trace2? #f)
+
+(define-syntax %trace2
+  (syntax-rules ()
+    ((_ ARGS ...)
+     (if %trace2? (outf-error ";   " ARGS ... "\n")))))
\ No newline at end of file