+ added more example scripts.
This commit is contained in:
		
							parent
							
								
									35cbba0dc3
								
							
						
					
					
						commit
						9a316771fc
					
				|  | @ -0,0 +1,54 @@ | ||||||
|  | #!/bin/sh | ||||||
|  | 
 | ||||||
|  | ../../scx <<EOF | ||||||
|  | 
 | ||||||
|  | ,batch on | ||||||
|  | ,open xlib | ||||||
|  | ,batch off | ||||||
|  | 
 | ||||||
|  | (define (picture point-count) | ||||||
|  |   (let* ((dpy (open-display)) | ||||||
|  | 	 (width 400) | ||||||
|  | 	 (height 400) | ||||||
|  | 	 (black (black-pixel dpy)) | ||||||
|  | 	 (white (white-pixel dpy)) | ||||||
|  | 	 (root (display-root-window dpy)) | ||||||
|  | 	 (win (create-window root width height  | ||||||
|  | 			     'background-pixel white | ||||||
|  | 			     'event-mask '(exposure button-press))) | ||||||
|  | 	 (gc (create-gcontext win | ||||||
|  | 			      'background white 'foreground black))) | ||||||
|  |     (map-window win) | ||||||
|  |     (let event-loop () | ||||||
|  |       (let ((e (next-event dpy))) | ||||||
|  | 	(if | ||||||
|  | 	 (case (event-type e) | ||||||
|  | 	   ((expose) (begin | ||||||
|  | 		       (clear-window win) | ||||||
|  | 		       (draw-points win gc point-count 0 0  | ||||||
|  | 				    (/ width 2) (/ height 2)) | ||||||
|  | 		       (draw-poly-text win gc 10 10 "Click a button to exit" | ||||||
|  | 				       '1-byte) | ||||||
|  | 		       #f)) | ||||||
|  | 	   (else #t)) | ||||||
|  | 	 #t | ||||||
|  | 	 (event-loop)))) | ||||||
|  |     (close-display dpy))) | ||||||
|  | 
 | ||||||
|  | (define (draw-points win gc count x y hw hh) | ||||||
|  |   (if (zero? (modulo count 100)) | ||||||
|  |       (display-flush-output (window-display win))) | ||||||
|  |   (if (not (zero? count)) | ||||||
|  |       (let ((xf (floor (* (+ 1.2 x) hw ))) ; These lines center the picture | ||||||
|  | 	    (yf (floor (* (+ 0.5 y) hh )))) | ||||||
|  | 	(draw-point win gc (cons (inexact->exact xf) (inexact->exact yf))) | ||||||
|  | 	(draw-points win gc (- count 1) | ||||||
|  | 		     (- (* y (+ 1 (sin (* 0.7 x)))) (* 1.2 (sqrt (abs x)))) | ||||||
|  | 		     (- 0.21 x) | ||||||
|  | 		     hw hh)))) | ||||||
|  | 
 | ||||||
|  | (picture 1000) | ||||||
|  | 
 | ||||||
|  | ,exit | ||||||
|  | y | ||||||
|  | EOF | ||||||
|  | @ -0,0 +1,73 @@ | ||||||
|  | ../../scx <<EOF | ||||||
|  | 
 | ||||||
|  | ,batch on | ||||||
|  | ,open xlib | ||||||
|  | ,batch off | ||||||
|  | 
 | ||||||
|  | (define (regions) | ||||||
|  |   (let* ((dpy (open-display)) | ||||||
|  | 	(cm (display-default-colormap dpy)) | ||||||
|  | 	(black (black-pixel dpy)) | ||||||
|  | 	(white (white-pixel dpy)) | ||||||
|  | 	(blue (alloc-named-color cm 'blue)) | ||||||
|  | 	(win (create-window (display-root-window dpy) 500 500  | ||||||
|  | 			    'event-mask '(button-press exposure) | ||||||
|  | 			    'background-pixel white)) | ||||||
|  | 	(gc (create-gcontext win | ||||||
|  | 			     'background white | ||||||
|  | 			     'foreground black)) | ||||||
|  | 	 | ||||||
|  | 	(rectangles '((10 20 60 60) (50 100 30 30))) | ||||||
|  | 	(colors (list black blue)) | ||||||
|  | 	(regions-alist  | ||||||
|  | 	 (list (cons (union-rectangle-with-region (car rectangles) | ||||||
|  | 						  (create-region)) | ||||||
|  | 		     "black rectangle") | ||||||
|  | 	       (cons (union-rectangle-with-region (cadr rectangles) | ||||||
|  | 						  (create-region)) | ||||||
|  | 		     "blue rectangle"))) | ||||||
|  | 
 | ||||||
|  | 	(handle-event  | ||||||
|  | 	 (lambda (e) | ||||||
|  | 	   (let ((args (event-args e)) | ||||||
|  | 		 (type (event-type e))) | ||||||
|  | 	     (case type | ||||||
|  | 	       ;; Zeichnen... | ||||||
|  | 	       ((expose) (begin | ||||||
|  | 			   (for-each (lambda (rect color) | ||||||
|  | 				       (set-gcontext-foreground! gc color) | ||||||
|  | 				       (fill-rectangle win gc rect)) | ||||||
|  | 				     rectangles colors) | ||||||
|  | 			   #t)) | ||||||
|  | 	       ;; Hit-Tests | ||||||
|  | 	       ((button-press) | ||||||
|  | 		(let* ((x (cdr (assq 'x args))) | ||||||
|  | 		       (y (cdr (assq 'y args))) | ||||||
|  | 		       (rs (filter (lambda (r-n) | ||||||
|  | 				     (point-in-region? (car r-n) | ||||||
|  | 						       x y)) | ||||||
|  | 				   regions-alist))) | ||||||
|  | 		  (for-each (lambda (region-name) | ||||||
|  | 			      (display "You clicked: ") | ||||||
|  | 			      (display (cdr region-name)) | ||||||
|  | 			      (newline)) | ||||||
|  | 			    rs) | ||||||
|  | 		  ;; break if none was hit. | ||||||
|  | 		  (not (null? rs)))) | ||||||
|  | 	       ))))) | ||||||
|  | 
 | ||||||
|  |     (map-window win) | ||||||
|  |     (let loop () | ||||||
|  |       (display-flush-output dpy) | ||||||
|  |       (let ((e (next-event dpy))) | ||||||
|  | 	(if (handle-event e) | ||||||
|  | 	    (loop) | ||||||
|  | 	    (close-display dpy)))))) | ||||||
|  | 
 | ||||||
|  | (regions) | ||||||
|  | 	 | ||||||
|  | 
 | ||||||
|  | 
 | ||||||
|  | ,exit | ||||||
|  | y | ||||||
|  | EOF | ||||||
|  | @ -0,0 +1,33 @@ | ||||||
|  | #!/bin/sh | ||||||
|  | 
 | ||||||
|  | ../../scx <<EOF | ||||||
|  | 
 | ||||||
|  | ,batch on | ||||||
|  | ,open xlib | ||||||
|  | ,batch off | ||||||
|  | 
 | ||||||
|  | (define (scxev) | ||||||
|  |   (let* ((dpy (open-display)) | ||||||
|  | 	 (black (black-pixel dpy)) | ||||||
|  | 	 (white (white-pixel dpy)) | ||||||
|  | 	 (win (create-window (display-default-root-window dpy) | ||||||
|  | 			     300 200 | ||||||
|  | 			     'event-mask '(all-events) | ||||||
|  | 			     'background-pixel white)) | ||||||
|  | 	 ) | ||||||
|  |     (set-wm-name! win '("scx Event Listener")) | ||||||
|  |     (map-window win) | ||||||
|  |     (let event-loop () | ||||||
|  |       (display-flush-output dpy) | ||||||
|  |       (let ((e (wait-event dpy))) | ||||||
|  | 	(display (event-type e)) (display " Event, Data:\n") | ||||||
|  | 	(display (event-args e)) (newline) (newline) | ||||||
|  | 	 | ||||||
|  | 	(event-loop)) | ||||||
|  |       (close-display dpy)))) | ||||||
|  | 
 | ||||||
|  | (scxev) | ||||||
|  | 
 | ||||||
|  | ,exit | ||||||
|  | y | ||||||
|  | EOF | ||||||
		Loading…
	
		Reference in New Issue
	
	 frese
						frese