#|-------------------- 0.95 |# "./examples/" 0
#|-------------------- 0.95 |# "./examples/egg-browser.scm" 1999
;;;; egg-browser.scm
(use qt-light posix regex utils matchable)
(define *application* (qt:init))
(define *window* (qt:widget (read-all "egg-browser.ui")))
(define *list* (qt:find *window* "eggList"))
(define *props* (qt:find *window* "eggProperties"))
(define *count* (qt:find *window* "countLabel"))
(define *ubutton* (qt:find *window* "uninstallButton"))
(define (refresh)
(let ((eggs (sort (map pathname-file (glob (make-pathname (repository-path) "*.setup-info"))) string) eggs)
(set! (qt:property *count* "text") (number->string (length eggs))) ) )
(define (item-changed)
(set! (qt:property *ubutton* "enabled") #t)
(qt:clear *props*)
(let ((row (qt:property *list* "currentRow")))
(if (positive? row)
(for-each
(cut qt:add *props* <>)
(let ((info (extension-information (string->symbol (qt:item *list* row)))))
(if info
(sort
(map (match-lambda
((name) (->string name))
((name vals ...) (conc name ": " (string-intersperse (map ->string vals) " ")))
(_ "") )
info)
stringstring (sub1 (string->number (qt:property *count* "text")))))
(set! (qt:property *ubutton* "enabled") #f)
(system* "chicken-uninstall ~s" name)
(refresh) ) ) )
(qt:connect (qt:find *window* "exitButton") "clicked()" *application* "quit()")
(qt:connect (qt:find *window* "refreshButton") "clicked()" refresh)
(qt:connect *list* "currentItemChanged(QListWidgetItem *, QListWidgetItem *)" item-changed)
(qt:connect *ubutton* "clicked()" uninstall)
(qt:show *window*)
(refresh)
(qt:run)
#|-------------------- 0.95 |# "./examples/edit.scm" 673
(use qt-light utils extras)
(require-library chicken-syntax)
(define a (qt:init))
(define w (qt:widget (read-all "editor.ui")))
(define e (qt:find w "editor"))
(qt:insert e "Select some Scheme code and\npress CTRL-E to evaluate it.\n")
(define action (qt:shortcut w "Ctrl+E"))
(qt:connect
action "triggered()"
(qt:receiver
(lambda ()
(let ((code (qt:selection e)))
(qt:insert e code)
(qt:insert
e
(with-output-to-string
(lambda ()
(handle-exceptions ex
(begin
(print-error-message ex)
(print-call-chain))
(pp (eval (with-input-from-string code read)))))))))))
(qt:add-action e action)
(qt:show w)
(qt:run)
#|-------------------- 0.95 |# "./examples/editor.ui" 1129
Form
0
0
633
471
Form
0
-
Lucida Console
12
QTextEdit {
background: black;
color: white;
}
Qt::ScrollBarAlwaysOff
Qt::ScrollBarAlwaysOff
#|-------------------- 0.95 |# "./examples/egg-browser.ui" 2573
EggBrowser
0
0
581
529
CHICKEN Egg Browser
450
480
120
40
Exit
10
480
70
31
Installed:
Qt::AlignCenter
false
320
480
120
40
Refresh
91
480
70
31
false
260
10
310
460
false
190
480
120
41
Uninstall
10
10
240
460
qPixmapFromMimeSource
#|-------------------- 0.95 |# "./examples/hello.scm" 223
(use qt-light utils protobj)
(define a (qt:init))
(define w (qt:widget (read-all "hello.ui")))
(print (? w pointer))
(define b (qt:find w "quitButton"))
(print b)
(qt:connect b "clicked()" a "quit()")
(qt:show w)
(qt:run)
#|-------------------- 0.95 |# "./examples/hello.ui" 1103
Form
0
0
295
144
40
30
160
31
15
75
true
Hello, world!
Qt::AlignCenter
180
90
75
31
Quit
#|-------------------- 0.95 |# "./examples/lisp-lizard.png" 13450
PNG
IHDR x V R gAMA OX2 tEXtSoftware Adobe ImageReadyqe< 4 IDATx}U[ &<0!gT$+`kZ]UW5aMYs2arNsg <5]]]u==RTUf99' |r;II~f}t G&ɫl;z<G G=p~Cӹqg,|Yzָf״A|
yu9$pmjYԆdzG9!PFk+bݛUHj(?vhע~)8鸝F߹a '@Ljq AH5#/|mjpHȢ Ӎz ɴ=墁ђS)?3#{ һX :Su@h_H<M'п[h B :jEDTDtꐆ)X"%B^Lf\@EѤg ].NRq;*gG3"@y^=iz;`Mv9Tg]<1,\TC*j$^6x/c )*C`*> [xXUҫQ jс+
WAc}-l Ӆ0dgyݍߐ`)Oz ;v5
5OԤhj l;i6G҅
PZZ9 3C;gUTvBB 99 D/ PGFwL|<3g@݆[g ]
=<:zwpQ꼆$y#uV|Bbab9ʳQ_ ըgM:!:*NW^z*cCU˄ 8 d"\aFq~uZgr(t풁˦ +u?&fc6##p]b#mgo410[dH(z뫨OO|ydTkl6 N
^ٱ]$jYI>mn~4 w?ZKioDLxѷOI vcİ lY_oÅ3QW?xߑgB+k ͧʕ<ONBE ^ dc ,"N GvF"h$" )`j~XtT){7 *uyj@KgoC]ض\**!Xj?INdcpS]}P uǼ͒\Td;pDGFnksi: c or٤ Jv7T{ y t6漳{!!> t( ?op6ޜtmسwuw3D&Un၇ҵVL^վW6qo,ng % WPzՈ
#Z%vΥs ZHصA @U Pt7{-Wv4Iջl>,[W~4)~f& :n }g0H^oΤ?`CY- j
~D%j?P.9_l#ZDc#۫g, Wf %[1$ŋJbm̗K`ls?lڒ/TnDv 5 [D |q]zGCQu@ȃמ bmt*GF*X
ƀA7>m%_C1|j*ͳڔ^ g
(PڜBSï e w#a@ 0K>ڀ
C-nMFM <*AvE҄\YiBDEizLj%BΈ'|)3ox77iX䱋&j|3܍ueLT,pVϢ@V(}uӹGJkɞ%EcĊo HAvq~ߛ v-|~ / ё.t0B. IB=._:HQ 'Jra @C'2ؒAjS$(MT;2"K3ڵM$ c
`Ok[ j#ZRAOh?K0{ {I:Ҁ
- Ff}{FRRIRKQZKb`EA!@BjV:GVT6J8zEqUCӋth h=q't_,d+UEXC" >0/T`q?6m %miҔa0%~~c< fǝ7@T#@&)^kᦫg`1hd}^ YF k{.༏]
5Ix}l bTa h R
zML@Vf>
b`4^3P"-KfJ7-A3ߺ0
J,>. *~-ӇcʤbQp|-Z˧sN4#>gFȴpUNG&h4HXTS B~S2e$JTzիY &&g5n^<E-O=.*̋$J>]kb1'ӾϽ4;kHjY [K*Пd#T2ȈPL$Gi9W6`d5dp UK S JgGi~@ $RGFmK}WXXCK]NI?L{kڝt
,w]9l^D&\]Z^K{? nzP=o~<([m
2[ő_cDJ'U hLi!cD
mEa#2ׂ!61 o9Bt7TOFiދ#>$AFZ:9]s:aZVG 0vo); n֝G`:i[1^~g w4>/UUu'7蓎sL p{VÍǜUQD~FHQccg 36KmaHzeb蠶ص EC1DT|GEwb>^p'Ci/|%N( '0bѻ[zuI1QRelT8쑍8|` 蕁7?Y m
xF I>Y>3@)x DyZjUlC&
A~9Z0Ub=}#NƠSZֲy)c&^A*(zOo$y/ #N>V]z҅)ᑒ1]hOIgU'h9lv Ķ-ϫ4IVqls~k O.F&St|VaLsC5K< qpﹿmZ`, %nrwW2^nb"GI[vpVj}Z峏.[AbQko:Q?
@iE}
XEUՐ H9)! |&qK1~Xc -z3a
")L$+3tk1)ex ꪋb( 3&wcŚ|VNk~W^OJUaCH|Oh9!+;lp\ Xtp_yʕ&\bK0̆*cMUvri߁J1K| %/ 0C,bMz3 i3!t?2z 6j !SVVVa|Ꙉ%ݎ<%eutRWTܞlU"j%0bp&Po8*rŋI
NwER\U ۮ ݧᩗĢ%[d``#
ִ0?.kVbx 2[EkN=qhR|'vWx!;`/g
I+yAECQ(9w}p9ᢁop8s+EzKzS
EZ h8ch&aېdj6-60R<9`$ma7:3D"c~횓ϿgQ5LW-nr;oZ_b}mchϮ
+i+`2&+5,WG{|u{Ja+Q@|ڌy@ VJz_!ZG@ϗI]ƍʖ=1 266zQ{Vm,¦GHV1WĐj >S0_+6Em.aT U57L TGt۷M@ }1 hZ#ϭ͇q=FEU#ZZ߅9
i /E=w0I'۱xEþЏ)TLDlKR:nt6Vt!PlUWfmʵEn{_IՊJK3O;#Ϳd+%uJSXX'HlojŌg WvFGJHAӌp %iTocˎRBnYݞf3_U哻amyPt "`Ƅ`i]o|U'nwN6eڳK2Ɯ%Z xw f?m/܄ʪ !b0[p>xyo?01yBgv3ѰHx ƙ2PT$;5bHkw@SGJpϣٸiZ/Xp% E&&Dzo ȵ90ifb* & '.+SOe {RJׯ$տ_/C1ZB|>T 5 C"^R\jx+y} b EGj RڼA5R
l{M!Li)ok60e,f#CV '?>mif/vaCH
E]1aie2غ\"e㪨{H]s|Aq-E23A҈:d!';a&ŪК$X|N
(-G.lxG˺uGcڬXrWo,$pyHRa B ~]CLCb.?$ rt܌jVR#cWъ;eBtn9nnE{еCr}ںDձϼ_| ӧİAg[ZJ ŨS3N.WaSQ!ؚ[܀牴q%E%:*GXc퉉=رe X*G^#qŝ ȝb0i\?A_K#lSLَƆ zRt"1ݗW+o[N@+Ǹ1Ym&y+UqMSTEE/SO8
5 x.a.&T 5 N^zr3ؘXH ĄO?|}^ K,{Sp!x S_ GkKJ=v6q 9[BU ټ8=P. RL`@ClźBZ_$:bMVnpBm} qpmvbEaY媺MIW3' %dޟW! q o:z`>[Ͽ k9O5n/o8n{l Y)cJz!Rd?J4.A!WN'^ͲS˅[wDj> gƈA%@sqs nS(!fWHH!\W̃Dۯ(R<Ԡ|KxX<~id~ޢ@6Y\ +|Mxch뷞xu+pmuwc&ԩQav3yd9f)x]"4${wO]}h
aomV6J_$5X0<b8\?œiGUPհfx<:-A_ E̙ 'e v[sːMl6[1; 9}.7? cن}MU>ĬOoRy -m-1dJ9=8dl
@^_{H R%tyTweھl, SߛS{n~|u .o (/A~QVY>N=yq5q()xxgK.EXX+/yN &dsNhAu(jJv`XX1' DZ4( RTQ\RF!Fё:,Y~ {UjU(}"?3 wsMBP euJ3żoO`/˛Ml1`r!My{0QKMXdVI}}$=9L9zh.>+?M2G͑I^D[p NFySq62Fj<#?ذWMSz`JL]X %N`L-Xz *?2嫏M'u{37j1[k%vaR[E\B{a!A gҸAdQZվ)fs}зG*1XX{M}}D8ve}EE;~A%a >EDb4:1h)%j3-L4]z-ɓK
MVG?jVf s9^Wځ@Έ!`9--iWڸ5<FwTJVJASMYLy2?ӣWfw~ Mf2d½]4#.a҃d
+ PNe5K t vIq}msDLSiN88 fj5Ŝ:ԫkGnN-
f ih.YuV=^mAm]
xmDv#mcK1 Zѻ"ƻm
Ÿ"f2%Y\jC! Bk o>]oׁrlQ"զGpLѭΓfd*s y1YW6ehE]rtWtk?O-ZԆi5V4RdY
Ek`->@ϸ &5lYU+ϼ3CX5hU.PۭAsGj3@Okp4&Փf1uX.5dӅ\
!/; 5`V@U\8 UdIO lu*KBŭE
j w*zcQL/Z=JaN 8|%$xicUiB ]oRz#FEK$%J7o;̈~gCJp(5-igo7ebjEY%
LEY؛/B0ARMhS:yc ,A"
@XtIBΉhO>7+AU (a9#U\
]yqlٌodǞ cC\h[ jrV[ %ecb#932^[5cJu
7g.\r@T C}Y:%2 :KIn 5'vjh#}gqoQ{"Fz3絽`QiƖ2op8ghߏUl#ˎTK7hy(@6q=^wI {+6ZzNǀ^>ç
XM~%sb,]g(}iʁ`բ?Amƌ>#-40(V_MsPı@u~% > W䡲0O>gJƭ,o fǽdqRz¬y7M uP2%4ify.o-t ߬k
: 0vd[L$ДPinW&hGrƫx %x@zLv00-^y+IzH6Xgˬf>pric[va1Ҕ6l-%,Xrqy3;RE}3hpQ uT?(WGZJftoS'vkN xj9f}lr[ C$c3&T O7.ZWqO=
ot=v4\miC&;?~1ƕ
Hhc懛\_ h}~-X_bK3ple~j5 ϋZ>M+u QOssu *QQJ
Ǵsĵ1^>V,iGyEuF1@E5@x.î}>s:o`T9NIO/+&F ܨ2kR- E2`xݤCl9Wlqėj=QWS
D_~"l)
LCY)k#}JvX䷉ךg'Ej P2KV دG`NTaj9go S쨞!^TJãqْVbؒ&}XE&;!}o)kĊ\*h'>{#JjJjnpN>>zu2
uft>,٫%8kxa?wUNM'MjVń~[Wk;6:[Uus/w>V/R+Wt\9'cB1R]Go( z4^G$G%0\LiqN%.|vL*s,Og0Ooa:S{b I70&vǸYZ$=~4TT:|eAf$/]aKGUU-N$l#>kq{t{x h+ԃjypۡ[p-Aj:6g.튾ؔ @{ (yA^1CVGE(sY6AIL.|6l(qkV=J-nS\8A j+JL>Y;{S@
V/FuVd'3ӣ $|Ҩ|p8K̗=U13QIL&حi,^3P{웆H{< s:I;Nee3'sjɬqm:sbz:'e lԑع ٍKn'_ q]su>ԭTT}|D8_b
u'1P&qR%R#L%fHxIQ8LÚ̞Ck6[TI>4ӧƹ&eqq{n)d'MeQ\lW|]ۇzyu>#Vxz) pxg>r%o˄=%+sɚ_ }S_Wŷ7'@8 ^|gzfSaVeD9q˃,
b@x /h v54SIe?jY ,\Q
Lj89x aX0y%XjpnR*Ql 5f(,Psǐ6VXwcL Ab삎{ o^tB*em666* sw aᒽJ ɁJVob.9< 4I6e˹ῦŃWt֢[
DS>kY/=zM_F Du>\#T_%.9R- ~RǨg~9;8圮|v'xL`)dpc4Ϭ-͓lm2d~P^m#{[+Vh+Q^,aB1&*w.t$Bxy/&KM4Ū9w6l="A (B+.
kP^dQ]xj=у[==tE&.f}
cOoK&vhuFtex9vwxS=l u e'_e%OG+riz յ =ĸPS7m̋zbNxCزK h5= IhpJũ1볝FnNbb˫&f%K
oE`ﶂd"{sfY]SqĮ!A_#R{*ɺqFO$ L\-6pd6 xB 'vځ%3bz~za ?A['$*K%mv?oܨ,"pOxW%G
' vsMYQVvӿ nioC]GƬy;ƄbĠ68ol{%Ga
Q#EvDC;cR"u<
|y>)|⥵j|oG eβȋ]rܛQie&GVOe eeVNQn8jᗿ^@DD4=ɼϨ /wNK6CTGڊ"FrkK ڵO#8KfYvг'LV/Qa~}`tÈ<{UjvU*q A]<`T0Am6K w?~h߯*648W|rc҇]rgVqR ɱqa Rؘ IѲzk\L,s+džiD\\8˪,t#:,vGrcm+WΌiಡic{)Av=HeNby̼Jj#IE=z֘we.3yR!?XcۼR,^'INLwaa:W%jE>ڿ6dɘEX6ҚZ(sLG lA=nF"<7 ȯko폶d =0\%Iprqbй]H:KŮ4b:U*:^Aq56(2*T9%AB:' F \^2Y* IENDB`
#|-------------------- 0.95 |# "./examples/lisp1pz.png" 494
PNG
IHDR P D `PLTE .0- !OQN..B$S-XhFHGegdir?]]z~zc^xsȤo bKGD H pHYs tIME
$B
IDAT8˵C04,vMM lLJ=:t ]:5odfw(?"0-K7YE\4ik$$tx櫯L)ғă &
`
/ŅXR.ɪ pomxwIjf?/ܩOb_ڬn]7Ӡ"%pգ60T P;<ƭvr^!j3 ] pֻR G&M1 ޓ H ~G' \S" IENDB`
#|-------------------- 0.95 |# "./examples/test.scm" 3728
(use utils gl glu srfi-18)
(use qt-light)
(define *test-ui* #<
Form
0
0
469
301
0
0
0
0
469
301
496
301
Form
130
210
191
41
Exit
100
50
261
71
Oink!
180
160
111
24
Good?
370
200
81
81
EOF
)
(define app (qt:init))
(define w (qt:widget *test-ui* #f))
(print w)
(define pb (qt:find w "pushButton_2"))
(assert pb)
(pp pb)
(define cb (qt:find w "checkBox"))
(assert cb)
(pp cb)
(define i (qt:pixmap "lisp1pz.png"))
(when i (pp (##sys#slot i 1)))
(define f #f)
(define s (qt:sound "blip.wav"))
(pp s)
(define r (qt:receiver (lambda ()
(qt:message "Oink!")
(set! (qt:property cb "checked") f)
(set! f (not f)) ) ) )
(qt:connect (ensure identity (qt:find w "pushButton_2")) "clicked()" (qt:receiver (lambda () (print "exit") (exit))))
(qt:connect (ensure identity (qt:find w "pushButton")) "clicked()"
(qt:receiver
(lambda ()
(qt:play s)
(pp (qt:get-open-filename "yo" ".")))))
(qt:connect app "aboutToQuit()" (qt:receiver (lambda () (print "about to quit"))))
(when i (set! (qt:property (qt:find w "label") "pixmap") i))
(define a 0)
(define g
(qt:gl
"gl" w
(cut gl:ClearColor 0 0 0 1)
(lambda (w h)
(when (zero? h) (set! h 1))
(gl:Viewport 0 0 w h)
(gl:MatrixMode gl:PROJECTION)
(gl:LoadIdentity)
(glu:Ortho2D -1 -1 1 1))
(lambda ()
(gl:Clear (bitwise-ior gl:COLOR_BUFFER_BIT gl:DEPTH_BUFFER_BIT))
(gl:MatrixMode gl:MODELVIEW)
(gl:LoadIdentity)
(gl:Rotatef a 0 0 1)
(gl:Begin gl:POLYGON)
(gl:Vertex2f -0.5 -0.5)
(gl:Vertex2f -0.5 0.5)
(gl:Vertex2f 0.5 0.5)
(gl:Vertex2f 0.5 -0.5)
(gl:End) ) ) )
(set! (qt:property g "pos") '#s32(0 0))
(set! (qt:property g "size") '#s32(100 100))
(qt:show w)
(qt:show g)
(qt:connect app "lastWindowClosed()" (qt:receiver (lambda () (print "closed") (exit))))
(define t (qt:timer 0.01))
(qt:connect
t "timeout()"
(qt:receiver
(lambda ()
(set! a (+ a 0.3))
(qt:update g) ) ) )
(qt:start t)
(qt:run)
#|-------------------- 0.95 |# "./examples/test.ui" 1865
Form
0
0
469
301
0
0
0
0
469
301
496
301
Form
130
210
191
41
Exit
100
50
261
71
Oink!
180
160
111
24
Good?
370
200
81
81
#|-------------------- 0.95 |# "./prototypes.h" 2986
/* prototypes.h */
qtapplication qt_init();
qtwidget qt_create(char *string, qtwidget parent);
___safe void qt_show(qtwidget widget);
void qt_hide(qtwidget widget);
___safe ___bool qt_run(___bool once);
void qt_deleteobject(qtobject widget);
void qt_deletepixmap(qtpixmap widget);
qtpixmap qt_pixmap(char *filename);
___bool qt_connect(qtwidget w1, char *sig, qtobject w2, char *slot);
qtwidget qt_find(qtwidget parent, char *name);
qtobject qt_receiver(char *name, C_word proc);
int qt_message(char *caption, char *text, qtwidget parent, char *b0, char *b1, char *b2);
const char *qt_classname(qtobject w);
___bool qt_setstringproperty(qtwidget w, char *prop, char *val);
___bool qt_setboolproperty(qtwidget w, char *prop, ___bool val);
___bool qt_setintproperty(qtwidget w, char *prop, int val);
___bool qt_setfloatproperty(qtwidget w, char *prop, double val);
___bool qt_setcharproperty(qtwidget w, char *prop, char val);
___bool qt_setpixmapproperty(qtwidget w, char *prop, qtpixmap val);
___bool qt_setpointproperty(qtwidget w, char *prop, int *val);
___bool qt_setpointfproperty(qtwidget w, char *prop, double *val);
___bool qt_setrectproperty(qtwidget w, char *prop, int *val);
___bool qt_setrectfproperty(qtwidget w, char *prop, double *val);
char *qt_getstringproperty(qtwidget w, char *prop);
___bool qt_getboolproperty(qtwidget w, char *prop);
int qt_getintproperty(qtwidget w, char *prop);
qtpixmap qt_getpixmapproperty(qtwidget w, char *prop);
C_word qt_getpointfproperty(qtwidget w, char *prop, C_word pt);
C_word qt_getpointproperty(qtwidget w, char *prop, C_word pt);
C_word qt_getrectfproperty(qtwidget w, char *prop, C_word rc);
C_word qt_getrectproperty(qtwidget w, char *prop, C_word rc);
C_word qt_getsizefproperty(qtwidget w, char *prop, C_word sz);
C_word qt_getsizeproperty(qtwidget w, char *prop, C_word sz);
double qt_getfloatproperty(qtwidget w, char *prop);
int qt_getcharproperty(qtwidget w, char *prop);
int qt_propertytype(qtwidget w, char *prop);
qtwidget qt_gl(char *name, qtwidget parent, C_word proc);
void qt_update(qtwidget w);
qttimer qt_timer(double secs);
void qt_start(qttimer t);
void qt_stoptimer(qttimer t);
void qt_stopsound(qtsound t);
void qt_play(qtsound t);
qtsound qt_sound(char *filename);
void qt_clearlistwidget(qtwidget w);
void qt_addcomboboxitem(qtwidget w, char *s);
void qt_addlistwidgetitem(qtwidget w, char *s);
void qt_addtreewidgetitem(qtwidget w, char *s);
char *qt_listwidgetitem(qtwidget w, int i);
char *qt_getexistingdirectory(qtwidget p, char *cap, char *dir, int opts);
char *qt_getopenfilename(qtwidget p, char *cap, char *dir, char *filter, int opts);
char *qt_getsavefilename(qtwidget p, char *cap, char *dir, char *filter, int opts);
void qt_setheaders(qtwidget w, char *s);
char *qt_selection(qttextedit w);
void qt_insert(qttextedit w, char *s);
qtaction qt_shortcut(qtwidget w, char *k);
void qt_addaction(qtwidget w, qtaction a);
void qt_removeaction(qtwidget w, qtaction a);
int qt_charencoding(int mode);
#|-------------------- 0.95 |# "./main.cpp" 12524
/* main.cpp */
#include
#include
#include
#include
#include
#define ___safe
#define ___bool int
#define ___out
static int qt_char_encoding = 1; // 0=latin1, 1=utf8, 2=ascii
class SimpleReceiver: public QObject
{
Q_OBJECT
void *thunk;
public:
SimpleReceiver(char *name, C_word proc) {
setObjectName(name);
thunk = CHICKEN_new_gc_root();
CHICKEN_gc_root_set(thunk, proc);
}
~SimpleReceiver() { CHICKEN_delete_gc_root(thunk); }
public slots:
void slot() { C_callback(CHICKEN_gc_root_ref(thunk), 0); }
};
class GLWidget: public QGLWidget
{
void *thunk;
public:
GLWidget(char *name, QWidget *parent, C_word proc) : QGLWidget(parent) {
setObjectName(name);
thunk = CHICKEN_new_gc_root();
CHICKEN_gc_root_set(thunk, proc);
}
~GLWidget() { CHICKEN_delete_gc_root(thunk); }
protected:
// Set up the rendering context, define display lists etc.:
void initializeGL() { C_save(C_fix(0)); C_callback(CHICKEN_gc_root_ref(thunk), 1); }
// setup viewport, projection etc.:
void resizeGL(int w, int h) { C_save(C_fix(1)); C_save(C_fix(w)); C_save(C_fix(h)); C_callback(CHICKEN_gc_root_ref(thunk), 3); }
// draw the scene:
void paintGL() { C_save(C_fix(2)); C_callback(CHICKEN_gc_root_ref(thunk), 1); }
};
#define qtobject QObject *
#define qtapplication QApplication *
#define qtreceiver SimpleReceiver *
#define qtwidget QWidget *
#define qtpixmap QPixmap *
#define qttimer QTimer *
#define qtsound QSound *
#define qttextedit QTextEdit *
#define qtaction QAction *
extern "C" {
#include "prototypes.h"
}
#include "main.moc"
QApplication *qt_init()
{
QApplication *app = new QApplication(C_main_argc, C_main_argv);
QObject::connect(app, SIGNAL(lastWindowClosed()), app, SLOT(quit()));
return qApp;
}
QWidget *qt_create(char *string, QWidget *parent)
{
QUiLoader loader;
QBuffer buf;
buf.open(QBuffer::ReadWrite);
buf.write(string);
buf.seek(0);
QWidget *w = loader.load(&buf, parent);
buf.close();
return w;
}
___bool qt_run(___bool once)
{
if(once) {
qApp->processEvents();
return 1;
}
else return qApp->exec();
}
void qt_show(QWidget *w) { w->show(); }
void qt_hide(QWidget *w) { w->show(); }
void qt_deleteobject(QObject *o) { delete o; }
void qt_deletepixmap(QPixmap *o) { delete o; }
___bool qt_connect(QWidget *w1, char *sig, QObject *w2, char *slot) { return QObject::connect(w1, sig, w2, slot); }
QWidget *qt_find(QWidget *parent, char *name) { return parent->findChild(QString(name)); }
QObject *qt_receiver(char *name, C_word proc) { return new SimpleReceiver(name, proc); }
char *qstrdata(const QString &str)
{
static char *strbuf = NULL;
static int strbuflen = 0;
int len = str.size();
if(strbuf == NULL || strbuflen < len) {
strbuf = (char *)realloc(strbuf, strbuflen = len * 2);
assert(strbuf != NULL);
}
char *ptr;
switch(qt_char_encoding) {
case 1: ptr = str.toLatin1().data(); break;
case 2: ptr = str.toUtf8().data(); break;
case 3: ptr = str.toAscii().data(); break;
}
memcpy(strbuf, ptr, len + 1);
return strbuf;
}
int qchrdata(const QChar chr)
{
switch(qt_char_encoding) {
case 1: return chr.toLatin1(); break;
case 2: return chr.unicode(); break;
default: return chr.toAscii(); break;
}
}
qtpixmap qt_pixmap(char *filename)
{
QPixmap *px = new QPixmap(filename);
if(px->isNull()) {
delete px;
return 0;
}
return px;
}
int qt_message(char *caption, char *text, QWidget *parent, char *b0, char *b1, char *b2)
{
return QMessageBox::information(parent, caption, text, b0, b1, b2);
}
#define propsetter(name, type) \
___bool qt_set ## name ## property(QWidget *w, char *prop, type val) \
{ \
const QMetaObject *mo = w->metaObject(); \
int i = mo->indexOfProperty(prop); \
if(i == -1) return 0; \
else return mo->property(i).write(w, val); \
}
propsetter(string, char *)
propsetter(bool, ___bool)
propsetter(int, int)
propsetter(float, double)
propsetter(char, char)
___bool qt_setpixmapproperty(QWidget *w, char *prop, qtpixmap val)
{
const QMetaObject *mo = w->metaObject();
int i = mo->indexOfProperty(prop);
if(i == -1) return 0;
else return mo->property(i).write(w, *val);
}
___bool qt_setpointproperty(QWidget *w, char *prop, int *val)
{
const QMetaObject *mo = w->metaObject();
int i = mo->indexOfProperty(prop);
if(i == -1) return 0;
else {
switch(mo->property(i).type()) {
case QVariant::Point: return mo->property(i).write(w, QPoint(val[ 0 ], val[ 1 ]));
case QVariant::Size: return mo->property(i).write(w, QSize(val[ 0 ], val[ 1 ]));
default: return false;
}
}
}
___bool qt_setpointfproperty(QWidget *w, char *prop, double *val)
{
const QMetaObject *mo = w->metaObject();
int i = mo->indexOfProperty(prop);
if(i == -1) return 0;
else {
switch(mo->property(i).type()) {
case QVariant::PointF: return mo->property(i).write(w, QPointF(val[ 0 ], val[ 1 ]));
case QVariant::SizeF: return mo->property(i).write(w, QSizeF(val[ 0 ], val[ 1 ]));
default: return false;
}
}
}
___bool qt_setrectproperty(QWidget *w, char *prop, int *val)
{
const QMetaObject *mo = w->metaObject();
int i = mo->indexOfProperty(prop);
if(i == -1) return 0;
else return mo->property(i).write(w, QRect(val[ 0 ], val[ 1 ], val[ 2 ], val[ 3 ]));
}
___bool qt_setrectfproperty(QWidget *w, char *prop, double *val)
{
const QMetaObject *mo = w->metaObject();
int i = mo->indexOfProperty(prop);
if(i == -1) return 0;
else return mo->property(i).write(w, QRectF(val[ 0 ], val[ 1 ], val[ 2 ], val[ 3 ]));
}
char *qt_getstringproperty(QWidget *w, char *prop)
{
const QMetaObject *mo = w->metaObject();
int i = mo->indexOfProperty(prop);
return qstrdata(mo->property(i).read(w).toString());
}
int qt_getcharproperty(QWidget *w, char *prop)
{
const QMetaObject *mo = w->metaObject();
int i = mo->indexOfProperty(prop);
return qchrdata(mo->property(i).read(w).toChar());
}
int qt_getintproperty(QWidget *w, char *prop)
{
const QMetaObject *mo = w->metaObject();
int i = mo->indexOfProperty(prop);
return mo->property(i).read(w).toInt();
}
double qt_getfloatproperty(QWidget *w, char *prop)
{
const QMetaObject *mo = w->metaObject();
int i = mo->indexOfProperty(prop);
return mo->property(i).read(w).toDouble();
}
___bool qt_getboolproperty(QWidget *w, char *prop)
{
const QMetaObject *mo = w->metaObject();
int i = mo->indexOfProperty(prop);
return mo->property(i).read(w).toBool();
}
qtpixmap qt_getpixmapproperty(QWidget *w, char *prop)
{
const QMetaObject *mo = w->metaObject();
int i = mo->indexOfProperty(prop);
return new QPixmap(mo->property(i).read(w).value());
}
C_word qt_getpointfproperty(QWidget *w, char *prop, C_word pt)
{
const QMetaObject *mo = w->metaObject();
int i = mo->indexOfProperty(prop);
QPointF qpt = mo->property(i).read(w).toPointF();
*((double *)C_data_pointer(C_block_item(pt, 1))) = qpt.x();
((double *)C_data_pointer(C_block_item(pt, 1)))[ 1 ] = qpt.y();
return pt;
}
C_word qt_getpointproperty(QWidget *w, char *prop, C_word pt)
{
const QMetaObject *mo = w->metaObject();
int i = mo->indexOfProperty(prop);
QPoint qpt = mo->property(i).read(w).toPoint();
*((int *)C_data_pointer(C_block_item(pt, 1))) = qpt.x();
((int *)C_data_pointer(C_block_item(pt, 1)))[ 1 ] = qpt.y();
return pt;
}
C_word qt_getrectfproperty(QWidget *w, char *prop, C_word pt)
{
const QMetaObject *mo = w->metaObject();
int i = mo->indexOfProperty(prop);
QRectF qpt = mo->property(i).read(w).toRectF();
*((double *)C_data_pointer(C_block_item(pt, 1))) = qpt.x();
((double *)C_data_pointer(C_block_item(pt, 1)))[ 1 ] = qpt.y();
((double *)C_data_pointer(C_block_item(pt, 1)))[ 2 ] = qpt.width();
((double *)C_data_pointer(C_block_item(pt, 1)))[ 3 ] = qpt.height();
return pt;
}
C_word qt_getrectproperty(QWidget *w, char *prop, C_word pt)
{
const QMetaObject *mo = w->metaObject();
int i = mo->indexOfProperty(prop);
QRect qpt = mo->property(i).read(w).toRect();
*((int *)C_data_pointer(C_block_item(pt, 1))) = qpt.x();
((int *)C_data_pointer(C_block_item(pt, 1)))[ 1 ] = qpt.y();
((int *)C_data_pointer(C_block_item(pt, 1)))[ 2 ] = qpt.width();
((int *)C_data_pointer(C_block_item(pt, 1)))[ 3 ] = qpt.height();
return pt;
}
C_word qt_getsizefproperty(QWidget *w, char *prop, C_word pt)
{
const QMetaObject *mo = w->metaObject();
int i = mo->indexOfProperty(prop);
QSizeF qpt = mo->property(i).read(w).toSizeF();
*((double *)C_data_pointer(C_block_item(pt, 1))) = qpt.width();
((double *)C_data_pointer(C_block_item(pt, 1)))[ 1 ] = qpt.height();
return pt;
}
C_word qt_getsizeproperty(QWidget *w, char *prop, C_word pt)
{
const QMetaObject *mo = w->metaObject();
int i = mo->indexOfProperty(prop);
QSize qpt = mo->property(i).read(w).toSize();
*((int *)C_data_pointer(C_block_item(pt, 1))) = qpt.width();
((int *)C_data_pointer(C_block_item(pt, 1)))[ 1 ] = qpt.height();
return pt;
}
int qt_propertytype(qtwidget w, char *prop)
{
const QMetaObject *mo = w->metaObject();
int i = mo->indexOfProperty(prop);
if(i == -1) return 0;
else {
switch(mo->property(i).type()) {
case QVariant::Bool: return 1;
case QVariant::Char: return 2;
case QVariant::Double: return 3;
case QVariant::Int:
case QVariant::UInt: return 4;
case QVariant::LongLong:
case QVariant::ULongLong: return 3;
case QVariant::String: return 5;
case QVariant::Pixmap: return 6;
case QVariant::PointF: return 7;
case QVariant::RectF: return 8;
case QVariant::SizeF: return 9;
case QVariant::Point: return 10;
case QVariant::Size: return 11;
case QVariant::Rect: return 12;
default: return 0;
}
}
}
const char *qt_classname(qtobject w) { return w->metaObject()->className(); }
qtwidget qt_gl(char *name, qtwidget parent, C_word proc) { return new GLWidget(name, parent, proc); }
void qt_update(qtwidget w) { w->update(); }
qttimer qt_timer(double secs)
{
QTimer *tm = new QTimer();
tm->setInterval((int)(secs * 1000));
return tm;
}
void qt_start(qttimer t) { t->start(); }
void qt_stoptimer(qttimer t) { t->stop(); }
void qt_stopsound(qtsound t) { t->stop(); }
void qt_clearlistwidget(qtwidget w) { ((QListWidget *)w)->clear(); }
void qt_addcomboboxitem(qtwidget w, char *s) { ((QComboBox *)w)->addItem(s); }
void qt_addlistwidgetitem(qtwidget w, char *s) { ((QListWidget *)w)->addItem(s); }
void qt_addtreewidgetitem(qtwidget w, char *s)
{
QStringList lst = QString(s).split("|");
((QTreeWidget *)w)->addTopLevelItem(new QTreeWidgetItem(lst));
}
char *qt_listwidgetitem(qtwidget w, int i) {
return qstrdata(((QListWidget *)w)->item(i)->text());
}
qtsound qt_sound(char *filename) { return new QSound(filename); }
void qt_play(qtsound s) { s->play(); }
char *qt_getexistingdirectory(qtwidget p, char *cap, char *dir, int opts)
{
return qstrdata(QFileDialog::getExistingDirectory(p, cap, dir, (QFileDialog::Option)opts));
}
char *qt_getopenfilename(qtwidget p, char *cap, char *dir, char *filter, int opts)
{
return qstrdata(QFileDialog::getOpenFileName(p, cap, dir, filter, 0, (QFileDialog::Options)opts));
}
char *qt_getsavefilename(qtwidget p, char *cap, char *dir, char *filter, int opts)
{
return qstrdata(QFileDialog::getSaveFileName(p, cap, dir, filter, 0, (QFileDialog::Options)opts));
}
void qt_setheaders(qtwidget w, char *s) { ((QTreeWidget *)w)->setHeaderLabels(QString(s).split("|")); }
char *qt_selection(qttextedit t)
{
QString txt = ((QTextEdit *)t)->textCursor().selectedText();
txt.replace(QChar(QChar::ParagraphSeparator), '\n');
return qstrdata(txt);
}
void qt_insert(qttextedit t, char *s)
{
QTextEdit *te = (QTextEdit *)t;
QTextCursor c = te->textCursor();
c.insertText(s);
}
qtaction qt_shortcut(qtwidget w, char *key)
{
QAction *a = new QAction(w);
a->setShortcut(QKeySequence(key));
return a;
}
void qt_addaction(qtwidget w, qtaction a) { ((QWidget *)w)->addAction((QAction *)a); }
void qt_removeaction(qtwidget w, qtaction a) { ((QWidget *)w)->removeAction((QAction *)a); }
int qt_charencoding(int mode)
{
if(mode) return qt_char_encoding = mode;
else return qt_char_encoding;
}
#|-------------------- 0.95 |# "./chicken-compile-qt-extension.scm" 4918
;;;; chicken-compile-qt-extension.scm
(module main ()
(import scheme chicken)
(use files utils setup-api srfi-1 extras data-structures posix)
(define (quit fstr . args)
(flush-output)
(fprintf (current-error-port) "~?~%" fstr args)
(exit 1))
(define QTDIR
(or (get-environment-variable "QTDIR")
(and (file-execute-access? "/usr/bin/qmake") "/usr")
(and (file-execute-access? "/usr/local/bin/qmake") "/usr/local")
(quit "please set the QTDIR environment variable") ) )
(define prefix chicken-prefix)
(define libpath (make-pathname prefix "lib"))
(define incpath (make-pathname prefix "include"))
(define binpath (make-pathname prefix "bin"))
(define csc (make-pathname binpath "csc"))
(define keepfiles #f)
(define qmake (make-pathname QTDIR "bin/qmake"))
(define mingw32 (eq? (build-platform) 'mingw32))
(define outfile #f)
(define gmake
(cond ((memq (software-version) '(freebsd netbsd openbsd))
"gmake")
(mingw32 "mingw32-make")
(else "make")))
(define options-with-arguments
'("-debug" "-output-file" "-heap-size" "-nursery" "-stack-size" "-compiler"
"-unit" "-uses" "-keyword-style" "-optimize-level" "-include-path"
"-database-size" "-extend" "-prelude" "-postlude" "-prologue" "-epilogue"
"-inline-limit" "-profile-name" "-disable-warning" "-emit-inline-file"
"-types" "-feature" "-debug-level" "-heap-growth" "-heap-shrinkage"
"-heap-initial-size" "-consult-inline-file" "-emit-import-library"
"-static-extension" "-D" "-K" "-X" "-j" "-I" "-o" "-n" "-R" "-C" "-L"
"-cc" "-cxx" "-ld" "-rpath" "-framework"))
(define (filter-options args)
(let loop ((args args) (opts '()) (files '()))
(if (null? args)
(values (reverse opts) (reverse files))
(let ((arg (car args))
(more (cdr args)))
(cond ((string=? "-k" arg) (set! keepfiles #t))
((string=? "-v" arg)
(setup-verbose-mode #t)
(run-verbose #t))
((member arg '("--help" "-h" "-help"))
(compile -h))
((and (string=? "-o" arg) (pair? more))
(set! outfile (car more))))
(if (and (> (string-length arg) 1)
(char=? #\- (string-ref arg 0)))
(if (member arg options-with-arguments)
(if (null? more)
(loop more (cons arg opts) files)
(loop (cdr more) (cons* (car more) arg opts) files))
(loop more (cons arg opts) files))
(loop more opts (cons arg files)))))))
(define (compile-qt-extension cppfiles hfiles)
(let* ((cppfile (car cppfiles))
(pro (pathname-replace-extension cppfile "pro"))
(name (pathname-file cppfile))
(mkfile (qs (pathname-replace-extension cppfile "make")))
(output (or outfile (make-pathname #f name "so"))))
(with-output-to-file pro
(lambda ()
(let ((csc (qs (normalize-pathname csc)))
(libdir (qs (normalize-pathname libpath)))
(incdir (qs (normalize-pathname incpath))))
(print #<#EOF
SOURCES=#{(string-intersperse cppfiles)}
CONFIG+=uitools qt
TEMPLATE=lib
HEADERS=#{(string-intersperse hfiles)}
TARGET=#{name}
unix:QMAKE_LFLAGS_RELEASE+= `#{csc} -libs -ldflags` -L#{libdir}
unix:QMAKE_CFLAGS_RELEASE+=-w `#{csc} -cflags` -I#{incdir}
unix:QMAKE_CXXFLAGS_RELEASE+=-w `#{csc} -cflags` -I#{incdir}
unix:QMAKE_CFLAGS_WARN_ON=-w
unix:QMAKE_CXXFLAGS_WARN_ON=-w
win32:QMAKE_LFLAGS_RELEASE+=-L#{libdir}
win32:QMAKE_CFLAGS_RELEASE+=-w -I#{incdir} -DHAVE_CHICKEN_CONFIG_H -DPIC
win32:QMAKE_CXXFLAGS_RELEASE+=-w -I#{incdir} -DHAVE_CHICKEN_CONFIG_H -DPIC
win32:QMAKE_CFLAGS_WARN_ON=--w
win32:QMAKE_CXXFLAGS_WARN_ON=-w
win32:LIBS+=-lchicken -lm -lws2_32
QT+=opengl
EOF
) ) ))
(run (,qmake ,(qs pro) -o ,mkfile))
(delete-file* output)
(run (,gmake -f ,mkfile clean ,(if mingw32 "release" "all")))
(cp
(make-pathname
(if mingw32 "release" #f)
(if mingw32 name (string-append "lib" name))
(if mingw32 "dll" "so.1.0.0"))
output)
) )
(define (rm-f . files)
(for-each
(lambda (fname)
(when (setup-verbose-mode) (print " rm -f " (qs fname)))
(delete-file* fname))
files))
(define (cp from to)
(when (setup-verbose-mode)
(print " cp " (qs from) " " (qs to))
(file-copy from to)))
(define (main args)
(let-values (((opts files) (filter-options args)))
(let ((cppfiles
(filter-map
(lambda (fname)
(let ((ext (pathname-extension fname)))
(cond ((member ext '("scm" "ss"))
(compile -t -c++ ,(qs fname) ,@opts)
(pathname-replace-extension fname "cpp"))
((member ext '("cxx" "c++" "cpp"))
fname)
(else #f))))
files))
(hfiles
(filter
(lambda (fname)
(let ((ext (pathname-extension fname)))
(member ext '("h" "hpp"))))
files)))
(if (null? cppfiles)
(quit "no Scheme or C++ files to process")
(handle-exceptions ex
(begin
(flush-output)
(print-error-message ex (current-error-port))
(exit 1))
(compile-qt-extension cppfiles hfiles))))))
(main (command-line-arguments))
)
#|-------------------- 0.95 |# "./qt-light.meta" 542
;;; qt.meta -*- Scheme -*-
((synopsis "A leightweight Qt 4 interface")
(category ui)
(license "BSD")
(depends easyffi protobj matchable miscmacros)
(doc-from-wiki)
(author "felix winkelmann")
(files "main.cpp" "qt-light.scm" "examples/hello.scm" "examples/egg-browser.scm" "examples/test.ui" "examples/test.scm" "examples/hello.ui" "examples/editor.ui" "examples/lisp-lizard.png" "examples/lisp1pz.png" "examples/egg-browser.ui" "examples/edit.scm" "qt-light.setup" "prototypes.h" "qt-light.meta" "chicken-compile-qt-extension.scm"))
#|-------------------- 0.95 |# "./qt-light.scm" 7541
;;;; qt-light.scm
(module qt-light (qt:init
qt:widget qt:show qt:hide qt:run
qt:delete qt:message qt:connect qt:find
qt:widget qt:receiver qt:pixmap qt:timer
qt:property qt:gl qt:update qt:start qt:stop
qt:clear qt:add qt:item qt:classname
qt:get-open-filename qt:get-save-filename qt:get-directory
qt:sound qt:play qt:set-headers
qt:selection qt:insert
qt:shortcut
qt:add-action qt:remove-action
qt:char-encoding)
(import scheme chicken
(except foreign foreign-declare)
easyffi
miscmacros)
(use srfi-4 srfi-1 protobj matchable data-structures extras)
(define
(% (current-root-object)
(class ')
(pointer #f)
(print (lambda (self #!optional (port (current-output-port)))
(fprintf port "#<~a>" (? self class))))))
(define (% (class 'qt-object)))
(define (% (class 'qt-sound)))
(define (% (class 'qt-widget)))
(define (% (class 'qt-application)))
(define (% (class 'qt-pixmap)))
(define (% (class 'qt-receiver)))
(define (% (class 'qt-timer)))
(define (% (class 'qt-text-edit)))
(define (% (class 'qt-action)))
(define (qt:->pointer i) (and i (? i pointer)))
(define (qt:pointer->widget p) (and p (% (pointer p))))
(define (qt:pointer->object p) (and p (% (pointer p))))
(define (qt:pointer->timer p) (and p (% (pointer p))))
(define (qt:pointer->application p) (and p (% (pointer p))))
(define (qt:pointer->pixmap p) (and p (% (pointer p))))
(define (qt:pointer->receiver p) (and p (% (pointer p))))
(define (qt:pointer->sound p) (and p (% (pointer p))))
(define (qt:pointer->text-edit p) (and p (% (pointer p))))
(define (qt:pointer->action p) (and p (% (pointer p))))
#>?
___declare(substitute, "qt_;qt:")
___declare(type, "qtwidget;c-pointer;qt:->pointer;qt:pointer->widget")
___declare(type, "qtapplication;c-pointer;qt:->pointer;qt:pointer->application")
___declare(type, "qtpixmap;c-pointer;qt:->pointer;qt:pointer->pixmap")
___declare(type, "qtobject;c-pointer;qt:->pointer;qt:pointer->object")
___declare(type, "qttimer;c-pointer;qt:->pointer;qt:pointer->timer")
___declare(type, "qtreceiver;c-pointer;qt:->pointer;qt:pointer->receiver")
___declare(type, "qtsound;c-pointer;qt:->pointer;qt:pointer->sound")
___declare(type, "qttextedit;c-pointer;qt:->pointer;qt:pointer->text-edit")
___declare(type, "qtaction;c-pointer;qt:->pointer;qt:pointer->action")
<#
#>
extern "C" {
#include "prototypes.h"
}
<#
#>?
#include "prototypes.h"
<#
(define-enum encoding->int int->encoding
unused latin1 utf8 ascii)
(define (qt:char-encoding #!optional enc)
(if enc
(qt:charencoding
(or (encoding->int enc)
(error 'qt:char-encoding "invalid encoding mode" enc)))
(int->encoding (qt:charencoding 0))))
(define qt:connect
(let ((qt:connect qt:connect))
(lambda (from sig to #!optional (slot "slot()"))
(qt:connect
from (string-append "2" sig)
(if (procedure? to) (qt:receiver to) to)
(string-append "1" slot)) ) ) )
(define qt:receiver
(let ((qt:receiver qt:receiver))
(lambda (thunk #!optional (name (gensym "qt:receiver")))
(qt:receiver (->string name) thunk) ) ) )
(! 'delete
(lambda (self) (qt:deleteobject self)))
(! 'delete
(lambda (self) (qt:deletepixmap self)))
(define (qt:delete o) (@ delete o))
(define qt:message
(let ((qt:message qt:message))
(lambda (text #!key (caption "") parent (button1 "OK") (button2 "Cancel") button3)
(qt:message caption text parent button1 button2 button3) ) ) )
(define (qt:widget fname #!optional parent)
(qt:create fname parent) )
(define qt:property
(getter-with-setter
(lambda (w p)
(let ((p (->string p)))
(case (qt:propertytype w p)
((5) (qt:getstringproperty w p))
((4) (qt:getintproperty w p))
((3) (qt:getfloatproperty w p))
((1) (qt:getboolproperty w p))
((2) (integer->char (qt:getcharproperty w p)))
((6) (qt:getpixmapproperty w p))
((7) (qt:getpointfproperty w p (make-f64vector 2)))
((8) (qt:getrectfproperty w p (make-f64vector 4)))
((9) (qt:getsizefproperty w p (make-f64vector 2)))
((10) (qt:getpointproperty w p (make-s32vector 2)))
((11) (qt:getsizeproperty w p (make-s32vector 2)))
((12) (qt:getrectproperty w p (make-s32vector 4)))
(else (error "unknown property" w p)) ) ) )
(lambda (w p x)
(let* ((p (->string p))
(ok (cond ((string? x) (qt:setstringproperty w p x))
((fixnum? x) (qt:setintproperty w p x))
((flonum? x) (qt:setfloatproperty w p x))
((char? x) (qt:setcharproperty w p (char->integer x)))
((boolean? x) (qt:setboolproperty w p x))
((s32vector? x)
(if (fx= (s32vector-length x) 2)
(qt:setpointproperty w p x)
(qt:setrectproperty w p x) ) )
((f64vector? x)
(if (fx= (f64vector-length x) 2)
(qt:setpointfproperty w p x)
(qt:setrectfproperty w p x) ) )
((eq? (? x class) 'qt-pixmap) (qt:setpixmapproperty w p x))
(else (error "unknown property" w p)) ) ) )
(unless ok (error 'qt:property/setter "unable to set widget property" w p x) ) ) ) ) )
(define qt:gl
(let ((qt:gl qt:gl))
(lambda (name parent init resize paint)
(qt:gl
name parent
(match-lambda*
((0) (init))
((1 w h) (resize w h))
(_ (paint)) ) ) ) ) )
(define qt:run
(let ((qt:run qt:run))
(lambda (#!optional once)
(qt:run once) ) ) )
(define (qt:add w x)
(cond ((string=? "QComboBox" (qt:classname w)) (qt:addcomboboxitem w x))
((string=? "QListWidget" (qt:classname w)) (qt:addlistwidgetitem w x))
((string=? "QTreeWidget" (qt:classname w)) (qt:addtreewidgetitem w x))
(else (error 'qt:add "invalid widget" w x)) ) )
(define (qt:item w i) (and (positive? i) (qt:listwidgetitem w i)))
(define qt:clear qt:clearlistwidget)
(define (qt:set-headers w x)
(cond ((string=? "QTreeWidget" (qt:classname w)) (qt:setheaders w x))
(else (error 'qt:set-headers "invalid widget" w x)) ) )
(define (file-dialog-options loc os)
(let loop ((os os))
(cond ((null? os) 0)
((assq (car os)
'((show-dirs-only: . 1) (dont-resolve-symlinks: . 2) (dont-confirm-overwrite: . 4)
(dont-use-sheet: . 8) (dont-use-native-dialog: . 16) ) )
=> (lambda (a) (loop (bitwise-ior (cdr a) (loop (cdr os))))) )
(else (error loc "invalid file-dialog option" (car os))) ) ) )
(define (qt:get-open-filename cap dir #!key parent (options '()) filter)
(qt:getopenfilename parent cap dir filter (file-dialog-options 'qt:get-open-filename options)) )
(define (qt:get-save-filename cap dir #!key parent (options '()) filter)
(qt:getsavefilename parent cap dir filter (file-dialog-options 'qt:get-save-filename options)) )
(define (qt:get-directory cap dir #!key parent (options '()))
(qt:getexistingdirectory parent cap dir (file-dialog-options 'qt:get-directory options)) )
(! 'stop
(lambda (self) (qt:stoptimer self)))
(! 'stop
(lambda (self) (qt:stopsound self)))
(define (qt:stop x) (@ x stop))
(define qt:add-action qt:addaction)
(define qt:remove-action qt:removeaction)
)
#|-------------------- 0.95 |# "./qt-light.setup" 517
;;;; qt.setup -*- Scheme -*-
(parameterize ((command-line-arguments
'("-O3" "-d1" "-X" "easyffi" "-j" "qt-light" "qt-light.scm" "main.cpp"
"-o" "qt-light.so" "-k" "-v") ) )
(load "chicken-compile-qt-extension.scm"))
(compile -s -O3 -d0 qt-light.import.scm)
(install-extension
'qt-light
`("qt-light.so" "qt-light.import.so")
'((version 0.95)))
(compile -O3 -d0 -b chicken-compile-qt-extension.scm)
(install-program
'chicken-compile-qt-extension
'("chicken-compile-qt-extension")
'((version 0.95)))