source: project/gl-display-glx/samples/s02.scm @ 3547

Last change on this file since 3547 was 3547, checked in by thu, 14 years ago

commit before removal of non gl-display files

  • Property svn:executable set to *
File size: 3.4 KB
Line 
1#! /bin/sh
2#|
3exec csi -s $0 "$@"
4|#
5
6(require-extension srfi-18)
7(require-extension gl-display-glx)
8(require 'gl-display-events-util)
9(require 'gl-display-event-queue)
10(require 'gl-util)
11(require 'gl-proj)
12
13(define *display* (gl-display:create 'width 400 'height 400))
14;(gl-display:make 1280 800)
15(gl-util:initialize)
16(gl-proj:viewport *display*)
17(gl-proj:perspective *display*)
18(gl-proj:orthographic *display*)
19(enable-backface-culling)
20
21(print "screen width  : " (gl-display:screen-width *display*))
22(print "screen height : " (gl-display:screen-height *display*))
23
24;-------
25
26(gl:Enable gl:BLEND)
27(gl:BlendFunc gl:ONE gl:ONE_MINUS_SRC_ALPHA)
28
29;-------
30
31(define *continue* #t)
32(define *record-point-flag* #f)
33(define *points* '())
34(define (add-point x y)
35  (set! *points* (cons x (cons y *points*))))
36(define *in-command* #f)
37(define *command* "")
38(define *x* 0)
39(define *y* 0)
40
41(define (char-for-command? o)
42  (or (char-alphabetic? o)
43      (char-numeric? o)
44      (char-whitespace? o)))
45
46(define (event-for-command event)
47  (if (key-pressed? event)
48    (let ((key (gl-display:event-key event)))
49      (if *in-command*
50        (cond ((eq? key #\))
51               (begin (print "endcommand")
52                      (set! *in-command* #f)
53                      (events:send 'commands (list 'command (gl-display:time)
54                                                   (read (open-input-string (string-append *command* ")")))))
55                      (set! *command* "")
56                      #t))
57              ((char-for-command? key)
58               (begin (set! *command* (string-append *command* (string key)))
59                      #t))
60              (else #f))
61        (if (eq? key #\()
62          (begin (print "command")
63                 (set! *in-command* #t)
64                 (set! *command* "(")
65                 #t)
66          #f)))
67    #f))
68
69(events:handle 'gui
70    (lambda (event)
71      (let ((e-for-c (event-for-command event)))
72        (cond (e-for-c (print "command " *command*))
73              ((space-key-pressed? event)  (events:send 'space 'dummy))
74              ((escape-key-released? event)(events:send 'commands (list 'command (gl-display:time) '(quit))))
75              ((up-key-pressed? event)    (set! *y* (- *y* 5)))
76              ((down-key-pressed? event)  (set! *y* (+ *y* 5)))
77              ((left-key-pressed? event)  (set! *x* (- *x* 5)))
78              ((right-key-pressed? event) (set! *x* (+ *x* 5)))
79              ((lmb-pressed? event) (set! *record-point-flag* #t))
80              ((lmb-released? event) (set! *record-point-flag* #f))
81              ((mouse-moved? event)
82               (when *record-point-flag*
83                 (add-point (gl-display:event-x event) (gl-display:event-y event))
84                 (print "moved " (gl-display:event-x event) "," (gl-display:event-y event))))
85              (else (noop #|write-event event|#))))))
86
87(define (quit) (set! *continue* #f))
88(events:handle 'space (lambda _ (print "space")))
89(events:handle 'commands (lambda (event)
90    (print "command: " event)
91    (let ((command (third event)))
92      (unless (null? command)
93        (condition-case (eval command)
94          (var () (print "an exception occured in the command")))))))
95
96(define (render)
97  (clear)
98  (gl:LoadIdentity)
99  (gl:Translatef (- *x*) (- *y*) -2)
100  (square-xy 20)
101  (gl:Translatef 100 100 0)
102  (textured-square-xy 100)
103  (points_2 *points*)
104  (gl-font:print "-- test --")
105  (gl:Translatef 0 0 0)
106  (gl:Color3f 0 0 0)
107  (gl-font:print *command*)
108  (gl-display:swap *display*))
109
110(define (go)
111  (let loop ()
112    (when *continue*
113      (process-events *display* (lambda (event) (events:send 'gui event)))
114      (events:schedule)
115      (render)
116      (thread-sleep! 0.02)
117      (loop)))
118  (gl-display:destroy *display*))
119
120;(thread-start! go)
121(require-extension gl-font)
122(gl-font:create)
123(gl:Enable gl:TEXTURE_2D)
124(go)
Note: See TracBrowser for help on using the repository browser.