source: project/release/4/qt/test.scm @ 15639

Last change on this file since 15639 was 15639, checked in by felix winkelmann, 10 years ago

ported to CHICKEN 4

File size: 3.5 KB
Line 
1(use utils gl srfi-18)
2
3#+(not macosx) (use qt)
4
5(define *test-ui* #<<EOF
6<ui version="4.0" >
7 <class>Form</class>
8 <widget class="QWidget" name="Form" >
9  <property name="geometry" >
10   <rect>
11    <x>0</x>
12    <y>0</y>
13    <width>469</width>
14    <height>301</height>
15   </rect>
16  </property>
17  <property name="sizePolicy" >
18   <sizepolicy>
19    <hsizetype>0</hsizetype>
20    <vsizetype>0</vsizetype>
21    <horstretch>0</horstretch>
22    <verstretch>0</verstretch>
23   </sizepolicy>
24  </property>
25  <property name="minimumSize" >
26   <size>
27    <width>469</width>
28    <height>301</height>
29   </size>
30  </property>
31  <property name="maximumSize" >
32   <size>
33    <width>496</width>
34    <height>301</height>
35   </size>
36  </property>
37  <property name="windowTitle" >
38   <string>Form</string>
39  </property>
40  <widget class="QPushButton" name="pushButton_2" >
41   <property name="geometry" >
42    <rect>
43     <x>130</x>
44     <y>210</y>
45     <width>191</width>
46     <height>41</height>
47    </rect>
48   </property>
49   <property name="text" >
50    <string>Exit</string>
51   </property>
52  </widget>
53  <widget class="QPushButton" name="pushButton" >
54   <property name="geometry" >
55    <rect>
56     <x>100</x>
57     <y>50</y>
58     <width>261</width>
59     <height>71</height>
60    </rect>
61   </property>
62   <property name="text" >
63    <string>Oink!</string>
64   </property>
65  </widget>
66  <widget class="QCheckBox" name="checkBox" >
67   <property name="geometry" >
68    <rect>
69     <x>180</x>
70     <y>160</y>
71     <width>111</width>
72     <height>24</height>
73    </rect>
74   </property>
75   <property name="text" >
76    <string>Good?</string>
77   </property>
78  </widget>
79  <widget class="QLabel" name="label" >
80   <property name="geometry" >
81    <rect>
82     <x>370</x>
83     <y>200</y>
84     <width>81</width>
85     <height>81</height>
86    </rect>
87   </property>
88   <property name="text" >
89    <string/>
90   </property>
91  </widget>
92 </widget>
93 <resources/>
94 <connections/>
95</ui>
96EOF
97)
98
99(define app (qt:init))
100(define w (qt:widget *test-ui* #f))
101(print w)
102(define pb (qt:find w "pushButton_2"))
103(assert pb)
104(pp pb)
105(define cb (qt:find w "checkBox"))
106(assert cb)
107(pp cb)
108(define i (qt:pixmap "lisp1pz.png"))
109(when i (pp (##sys#slot i 1)))
110(define f #f)
111(define s (qt:sound "blip.wav"))
112(pp s)
113(define r (qt:receiver (lambda () 
114                         (qt:message "Oink!")
115                         (set! (qt:property cb "checked") f)
116                         (set! f (not f)) ) ) )
117(qt:connect (ensure identity (qt:find w "pushButton_2")) "clicked()" (qt:receiver (lambda () (print "exit") (exit))))
118(qt:connect (ensure identity (qt:find w "pushButton")) "clicked()" 
119            (qt:receiver 
120             (lambda ()
121               (qt:play s)
122               (pp (qt:get-open-filename "yo" ".")))))
123(qt:connect app "aboutToQuit()" (qt:receiver (lambda () (print "about to quit"))))
124(when i (set! (qt:property (qt:find w "label") "pixmap") i))
125
126(define a 0)
127
128(define g
129  (qt:gl 
130   "gl" w 
131   (cut gl:ClearColor 0 0 0 1)
132   noop
133   (lambda ()
134     (gl:Clear gl:COLOR_BUFFER_BIT)
135     (gl:MatrixMode gl:MODELVIEW)
136     (gl:LoadIdentity)
137     (gl:Rotatef a 0 0 1)
138     (gl:Begin gl:POLYGON)
139     (gl:Vertex2f -0.5 -0.5)
140     (gl:Vertex2f -0.5 0.5)
141     (gl:Vertex2f 0.5 0.5)
142     (gl:Vertex2f 0.5 -0.5)
143     (gl:End) ) ) )
144
145(set! (qt:property g "pos") '#s32(0 0))
146(set! (qt:property g "size") '#s32(100 100))
147(qt:show w)
148(qt:show g)
149
150(qt:connect app "lastWindowClosed()" (qt:receiver (lambda () (print "closed") (exit))))
151
152(define t (qt:timer 0.01))
153
154(qt:connect
155 t "timeout()"
156 (qt:receiver
157  (lambda ()
158    (set! a (+ a 0.3))
159    (qt:update g) ) ) )
160
161(qt:start t)
162
163(qt:run)
Note: See TracBrowser for help on using the repository browser.