+ 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