source: project/gl-display-glx/samples/s03-repl.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.7 KB
Line 
1#! /bin/sh
2#|
3exec csi -s $0 "$@"
4|#
5
6(require-extension gl-display-glx)
7(require-extension gl-font)
8(require 'gl-display-events-util)
9(require 'gl-display-event-queue)
10(require 'gl-util)
11(require 'gl-proj)
12
13
14(define *display* (gl-display:create 'width 400 'height 400))
15(gl-font:create-from-path "/usr/share/fonts/truetype/ttf-dejavu/DejaVuSansMono.ttf")
16(gl-util:initialize)
17(gl-proj:viewport *display*)
18(enable-backface-culling)
19
20;-------
21
22(gl:Enable gl:BLEND)
23(gl:BlendFunc gl:ONE gl:ONE_MINUS_SRC_ALPHA)
24
25;-------
26
27(define *continue* #t)
28
29(require 'srfi-13)
30
31(define *buffer* "")
32(define (buffer:empty)
33  (set! *buffer* ""))
34(define (buffer:left-paren)
35  (set! *buffer* (string-append *buffer* "(")))
36(define (buffer:right-paren)
37  (set! *buffer* (string-append *buffer* ")")))
38(define (buffer:char char)
39  (set! *buffer* (string-append *buffer* (string char))))
40(define (buffer:backspace)
41  (unless (string-null? *buffer*)
42    (set! *buffer* (string-drop-right *buffer* 1))))
43(define (buffer:form)
44  (read (open-input-string *buffer*)))
45(define (buffer:string)
46  *buffer*)
47
48;(define old-out-port (current-output-port))
49(define *output-buffer* "")
50;(define *output-buffer* (open-output-string))
51;(current-output-port *output-buffer*)
52;(current-output-port old-out-port)
53
54(define (char-for-command? o)
55  (and (char? o)
56       (or (char-alphabetic? o)
57           (char-numeric? o)
58           (char-whitespace? o)
59           (case o
60             ((#\") #t)
61             (else #f)       
62             ))))
63
64; TODO write a procedure to map a key to a command
65; to create shortcuts easilly.
66
67(define (event-for-shortcut event)
68  (if (key-released? event)
69    (let ((key (gl-display:event-key event)))
70      (cond ((eq? key #\esc)
71             (events:send 'commands (list 'command (gl-display:time) '(quit)))
72             #t)
73            (else #f)))
74    #f))
75
76(define (event-for-command event)
77  (if (key-pressed? event)
78    (let ((key (gl-display:event-key event)))
79      (cond ((eq? key #\()
80             (buffer:left-paren)
81             #t)
82            ((eq? key #\))
83             (buffer:right-paren)
84             #t)
85            ((eq? key #\return)
86            ;(events:send 'commands (list 'command (gl-display:time) '(print "command")))
87             (events:send 'commands (list 'command (gl-display:time) (buffer:form)))
88             (buffer:empty)
89             #t)
90            ((eq? key #\backspace)
91             (buffer:backspace))
92            ((char-for-command? key)
93             (buffer:char key)
94             #t)
95            (else #f)))
96    #f))
97
98(events:handle 'gui
99    (lambda (event)
100      (cond ((event-for-shortcut event))
101            ((event-for-command  event)))))
102
103(define (quit) (set! *continue* #f))
104(events:handle 'commands (lambda (event)
105    (print "command: " event)
106    (let ((command (third event)))
107      (unless (null? command)
108        (set! *output-buffer*
109          (with-output-to-string
110            (lambda _
111              (condition-case (eval command)
112                              (var () (print "an exception occured in the command"))))))))))
113
114(define *y-rot* 0)
115(define (y-rot)
116  (set! *y-rot* (if (= *y-rot* 360) 1 (+ *y-rot* 1))))
117(define (render)
118  (clear)
119  (gl:Color3f 0 0 0)
120  (gl-proj:perspective *display*)
121  (load-identity)
122  (gl:Translatef 0 2 -8)
123  (square-xy 2)
124 
125  (gl:Translatef 0 -2 0)
126  (gl-util:axis 2)
127 
128  (gl:Translatef 0 -2 0)
129  (gl:Rotatef *y-rot* 0 1 0)
130  (y-rot)
131  (gl-util:cube 2)
132 
133  (preserving-matrices
134    (gl:Color3f 0.2 0.3 1)
135    (gl-proj:orthographic *display*)
136    (gl:Translatef 4 28 0)
137    (gl-font:print (string-append "> " (buffer:string)))
138    (load-identity)
139    (gl:Translatef 4 8 0)
140    (gl-font:print (string-append "; " *output-buffer*)))
141  (gl-display:swap *display*))
142
143(define (go)
144  (let loop ()
145    (when *continue*
146      (process-events *display* (lambda (event) (events:send 'gui event)))
147      (events:schedule)
148      (render)
149      (thread-sleep! 0.02)
150      (loop)))
151  (gl-display:destroy *display*))
152
153(go)
Note: See TracBrowser for help on using the repository browser.