qt-light 1.0 for C5
git-svn-id: https://code.call-cc.org/svn/chicken-eggs/release/5/qt-light@38001 fca3e652-9b03-0410-8d7b-ac86a6ce46c4
This commit is contained in:
Felix L. Winkelmann
commit
a3b9f5c072
|
|
@ -0,0 +1,196 @@
|
|||
#!/bin/sh
|
||||
#|
|
||||
exec "$CHICKEN_CSI" -s "$0" "$@"
|
||||
|#
|
||||
|
||||
;; chicken-compile-qt-extension.scm
|
||||
|
||||
(module main ()
|
||||
|
||||
(import scheme
|
||||
(chicken base)
|
||||
(chicken condition)
|
||||
(chicken file)
|
||||
(chicken file posix)
|
||||
(chicken foreign)
|
||||
(chicken format)
|
||||
(chicken pathname)
|
||||
(chicken platform)
|
||||
(chicken process)
|
||||
(chicken process-context)
|
||||
(chicken string)
|
||||
shell
|
||||
srfi-1)
|
||||
|
||||
(define setup-verbose-mode (make-parameter #f))
|
||||
(define run-verbose (make-parameter #f))
|
||||
|
||||
(define (quit fstr . args)
|
||||
(flush-output)
|
||||
(fprintf (current-error-port) "~?~%" fstr args)
|
||||
(exit 1))
|
||||
|
||||
(define (file-execute-access? p)
|
||||
(and (file-exists? p)
|
||||
(file-readable? p)
|
||||
(file-executable? p)))
|
||||
|
||||
(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")
|
||||
(and (file-execute-access? "/opt/local/bin/qmake") "/opt/local")
|
||||
(quit "please set the QTDIR environment variable") ) )
|
||||
|
||||
(define (chicken-prefix)
|
||||
(let ((csc-path (get-environment-variable "CHICKEN_CSC")))
|
||||
(let-values (((_ _ dir-elems) (decompose-directory csc-path)))
|
||||
(pathname-directory (make-absolute-pathname (drop-right dir-elems 2) "csc")))))
|
||||
|
||||
(define prefix (chicken-prefix))
|
||||
(define libpath (make-pathname prefix "lib"))
|
||||
(define incpath (make-pathname prefix "include"))
|
||||
(define cincpath (make-pathname incpath "chicken"))
|
||||
(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 macosx (eq? (software-version) 'macosx))
|
||||
(define outfile #f)
|
||||
|
||||
(define install_name_tool
|
||||
(and macosx
|
||||
"/usr/bin/install_name_tool"))
|
||||
|
||||
(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" "-emit-inline-file"
|
||||
"-feature" "-debug-level" "-consult-types-file" "-no-feature"
|
||||
"-consult-inline-file" "-emit-import-library" "-module" "-link"
|
||||
"-D" "-K" "-X" "-j" "-I" "-o" "-R" "-C" "-L" "-emit-link-file"
|
||||
"-unroll-limit" "-types"))
|
||||
|
||||
(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"))
|
||||
(run (csc -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)))
|
||||
(cincdir (qs (normalize-pathname cincpath))))
|
||||
(print
|
||||
#<#EOF
|
||||
SOURCES=#{(string-intersperse cppfiles)}
|
||||
QT+=uitools gui widgets multimedia
|
||||
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} -I#{cincdir}
|
||||
unix:QMAKE_CXXFLAGS_RELEASE+=-w `#{csc} -cflags` -I#{incdir} -I#{cincdir}
|
||||
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} -I#{cincdir} -DHAVE_CHICKEN_CONFIG_H -DPIC
|
||||
win32:QMAKE_CXXFLAGS_RELEASE+=-w -I#{incdir} -I#{cincdir} -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)
|
||||
(display mkfile)
|
||||
(run (,gmake -f ,mkfile clean ,(if mingw32 "release" "all")))
|
||||
(cp
|
||||
(make-pathname
|
||||
(if mingw32 "release" #f)
|
||||
(if mingw32 name (string-append "lib" name))
|
||||
(cond (mingw32 "dll")
|
||||
(macosx "1.0.0.dylib")
|
||||
(else "so.1.0.0")))
|
||||
output)
|
||||
(when macosx
|
||||
(run (,install_name_tool -change "libchicken.dylib" ,(make-pathname libpath "libchicken" "dylib") ,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)))
|
||||
(copy-file 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"))
|
||||
(run ("csc" ,fname "-t" "-c++" ,@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 (append cppfiles (list "main.cpp")) hfiles))))))
|
||||
|
||||
(main (command-line-arguments))
|
||||
|
||||
)
|
||||
|
|
@ -0,0 +1,36 @@
|
|||
(import qt-light
|
||||
(chicken condition)
|
||||
(chicken io)
|
||||
(chicken port)
|
||||
(chicken pretty-print))
|
||||
|
||||
(define a (qt:init))
|
||||
(define w (qt:widget
|
||||
(call-with-input-file "editor.ui"
|
||||
(lambda (p) (read-string #f p)))))
|
||||
(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,0 +1,47 @@
|
|||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<ui version="4.0">
|
||||
<class>Form</class>
|
||||
<widget class="QWidget" name="Form">
|
||||
<property name="geometry">
|
||||
<rect>
|
||||
<x>0</x>
|
||||
<y>0</y>
|
||||
<width>633</width>
|
||||
<height>471</height>
|
||||
</rect>
|
||||
</property>
|
||||
<property name="windowTitle">
|
||||
<string>Form</string>
|
||||
</property>
|
||||
<layout class="QHBoxLayout" name="horizontalLayout">
|
||||
<property name="margin">
|
||||
<number>0</number>
|
||||
</property>
|
||||
<item>
|
||||
<widget class="QTextEdit" name="editor">
|
||||
<property name="font">
|
||||
<font>
|
||||
<family>Lucida Console</family>
|
||||
<pointsize>12</pointsize>
|
||||
</font>
|
||||
</property>
|
||||
<property name="styleSheet">
|
||||
<string notr="true">QTextEdit {
|
||||
background: black;
|
||||
color: white;
|
||||
}
|
||||
</string>
|
||||
</property>
|
||||
<property name="verticalScrollBarPolicy">
|
||||
<enum>Qt::ScrollBarAlwaysOff</enum>
|
||||
</property>
|
||||
<property name="horizontalScrollBarPolicy">
|
||||
<enum>Qt::ScrollBarAlwaysOff</enum>
|
||||
</property>
|
||||
</widget>
|
||||
</item>
|
||||
</layout>
|
||||
</widget>
|
||||
<resources/>
|
||||
<connections/>
|
||||
</ui>
|
||||
|
|
@ -0,0 +1,69 @@
|
|||
;;;; egg-browser.scm
|
||||
|
||||
|
||||
(import qt-light regex matchable
|
||||
(chicken file)
|
||||
(chicken io)
|
||||
(chicken string)
|
||||
(chicken pathname)
|
||||
(chicken platform)
|
||||
(chicken sort))
|
||||
|
||||
|
||||
(define *application* (qt:init))
|
||||
(define *window*
|
||||
(qt:widget (call-with-input-file "egg-browser.ui"
|
||||
(lambda (p) (read-string #f p)))))
|
||||
(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) "*.egg-info"))) string<?)))
|
||||
(qt:clear *list*)
|
||||
(qt:clear *props*)
|
||||
(for-each (cut qt:add *list* <>) eggs)
|
||||
(set! (qt:property *count* "text") (number->string (length eggs))) ) )
|
||||
|
||||
(define (extension-information egg)
|
||||
(with-input-from-file
|
||||
(make-pathname (repository-path) egg "egg-info")
|
||||
read))
|
||||
|
||||
(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 (qt:item *list* row))))
|
||||
(if info
|
||||
(sort
|
||||
(map (match-lambda
|
||||
((name) (->string name))
|
||||
((name vals ...) (conc name ": " (string-intersperse (map ->string vals) " ")))
|
||||
(_ "") )
|
||||
info)
|
||||
string<?)
|
||||
'("") ) ) )
|
||||
(set! (qt:property *ubutton* "enabled") #f) ) ) )
|
||||
|
||||
(define (uninstall)
|
||||
(and-let* ((i (qt:property *list* "currentRow"))
|
||||
(name (qt:item *list* i)) )
|
||||
(when (zero? (qt:message (conc "Are you sure you want to uninstall `" name "' ?")
|
||||
button1: "Yes" button2: "No") )
|
||||
(set! (qt:property *count* "text") (number->string (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,0 +1,117 @@
|
|||
<ui version="4.0" >
|
||||
<class>EggBrowser</class>
|
||||
<widget class="QWidget" name="EggBrowser" >
|
||||
<property name="geometry" >
|
||||
<rect>
|
||||
<x>0</x>
|
||||
<y>0</y>
|
||||
<width>581</width>
|
||||
<height>529</height>
|
||||
</rect>
|
||||
</property>
|
||||
<property name="windowTitle" >
|
||||
<string>CHICKEN Egg Browser</string>
|
||||
</property>
|
||||
<widget class="QPushButton" name="exitButton" >
|
||||
<property name="geometry" >
|
||||
<rect>
|
||||
<x>450</x>
|
||||
<y>480</y>
|
||||
<width>120</width>
|
||||
<height>40</height>
|
||||
</rect>
|
||||
</property>
|
||||
<property name="text" >
|
||||
<string>Exit</string>
|
||||
</property>
|
||||
</widget>
|
||||
<widget class="QLabel" name="countPrefixLabel" >
|
||||
<property name="geometry" >
|
||||
<rect>
|
||||
<x>10</x>
|
||||
<y>480</y>
|
||||
<width>70</width>
|
||||
<height>31</height>
|
||||
</rect>
|
||||
</property>
|
||||
<property name="text" >
|
||||
<string>Installed:</string>
|
||||
</property>
|
||||
<property name="alignment" >
|
||||
<set>Qt::AlignCenter</set>
|
||||
</property>
|
||||
<property name="wordWrap" >
|
||||
<bool>false</bool>
|
||||
</property>
|
||||
</widget>
|
||||
<widget class="QPushButton" name="refreshButton" >
|
||||
<property name="geometry" >
|
||||
<rect>
|
||||
<x>320</x>
|
||||
<y>480</y>
|
||||
<width>120</width>
|
||||
<height>40</height>
|
||||
</rect>
|
||||
</property>
|
||||
<property name="text" >
|
||||
<string>Refresh</string>
|
||||
</property>
|
||||
</widget>
|
||||
<widget class="QLabel" name="countLabel" >
|
||||
<property name="geometry" >
|
||||
<rect>
|
||||
<x>91</x>
|
||||
<y>480</y>
|
||||
<width>70</width>
|
||||
<height>31</height>
|
||||
</rect>
|
||||
</property>
|
||||
<property name="text" >
|
||||
<string/>
|
||||
</property>
|
||||
<property name="wordWrap" >
|
||||
<bool>false</bool>
|
||||
</property>
|
||||
</widget>
|
||||
<widget class="QListWidget" name="eggProperties" >
|
||||
<property name="geometry" >
|
||||
<rect>
|
||||
<x>260</x>
|
||||
<y>10</y>
|
||||
<width>310</width>
|
||||
<height>460</height>
|
||||
</rect>
|
||||
</property>
|
||||
</widget>
|
||||
<widget class="QPushButton" name="uninstallButton" >
|
||||
<property name="enabled" >
|
||||
<bool>false</bool>
|
||||
</property>
|
||||
<property name="geometry" >
|
||||
<rect>
|
||||
<x>190</x>
|
||||
<y>480</y>
|
||||
<width>120</width>
|
||||
<height>41</height>
|
||||
</rect>
|
||||
</property>
|
||||
<property name="text" >
|
||||
<string>Uninstall</string>
|
||||
</property>
|
||||
</widget>
|
||||
<widget class="QListWidget" name="eggList" >
|
||||
<property name="geometry" >
|
||||
<rect>
|
||||
<x>10</x>
|
||||
<y>10</y>
|
||||
<width>240</width>
|
||||
<height>460</height>
|
||||
</rect>
|
||||
</property>
|
||||
</widget>
|
||||
</widget>
|
||||
<layoutdefault spacing="6" margin="11" />
|
||||
<pixmapfunction>qPixmapFromMimeSource</pixmapfunction>
|
||||
<resources/>
|
||||
<connections/>
|
||||
</ui>
|
||||
|
|
@ -0,0 +1,11 @@
|
|||
(import qt-light protobj
|
||||
(chicken io))
|
||||
|
||||
(define a (qt:init))
|
||||
(define w (qt:widget (call-with-input-file "hello.ui" (lambda (p) (read-string #f p)))))
|
||||
(print (? w pointer))
|
||||
(define b (qt:find w "quitButton"))
|
||||
(print b)
|
||||
(qt:connect b "clicked()" a "quit()")
|
||||
(qt:show w)
|
||||
(qt:run)
|
||||
|
|
@ -0,0 +1,54 @@
|
|||
<ui version="4.0" >
|
||||
<class>Form</class>
|
||||
<widget class="QWidget" name="Form" >
|
||||
<property name="geometry" >
|
||||
<rect>
|
||||
<x>0</x>
|
||||
<y>0</y>
|
||||
<width>295</width>
|
||||
<height>144</height>
|
||||
</rect>
|
||||
</property>
|
||||
<property name="windowTitle" >
|
||||
<string/>
|
||||
</property>
|
||||
<widget class="QLabel" name="label" >
|
||||
<property name="geometry" >
|
||||
<rect>
|
||||
<x>40</x>
|
||||
<y>30</y>
|
||||
<width>160</width>
|
||||
<height>31</height>
|
||||
</rect>
|
||||
</property>
|
||||
<property name="font" >
|
||||
<font>
|
||||
<pointsize>15</pointsize>
|
||||
<weight>75</weight>
|
||||
<bold>true</bold>
|
||||
</font>
|
||||
</property>
|
||||
<property name="text" >
|
||||
<string>Hello, world!</string>
|
||||
</property>
|
||||
<property name="alignment" >
|
||||
<set>Qt::AlignCenter</set>
|
||||
</property>
|
||||
</widget>
|
||||
<widget class="QPushButton" name="quitButton" >
|
||||
<property name="geometry" >
|
||||
<rect>
|
||||
<x>180</x>
|
||||
<y>90</y>
|
||||
<width>75</width>
|
||||
<height>31</height>
|
||||
</rect>
|
||||
</property>
|
||||
<property name="text" >
|
||||
<string>Quit</string>
|
||||
</property>
|
||||
</widget>
|
||||
</widget>
|
||||
<resources/>
|
||||
<connections/>
|
||||
</ui>
|
||||
Binary file not shown.
|
After Width: | Height: | Size: 13 KiB |
Binary file not shown.
|
After Width: | Height: | Size: 494 B |
|
|
@ -0,0 +1,167 @@
|
|||
|
||||
(import qt-light gl glu srfi-18)
|
||||
|
||||
(define *test-ui* #<<EOF
|
||||
<ui version="4.0" >
|
||||
<class>Form</class>
|
||||
<widget class="QWidget" name="Form" >
|
||||
<property name="geometry" >
|
||||
<rect>
|
||||
<x>0</x>
|
||||
<y>0</y>
|
||||
<width>469</width>
|
||||
<height>301</height>
|
||||
</rect>
|
||||
</property>
|
||||
<property name="sizePolicy" >
|
||||
<sizepolicy>
|
||||
<hsizetype>0</hsizetype>
|
||||
<vsizetype>0</vsizetype>
|
||||
<horstretch>0</horstretch>
|
||||
<verstretch>0</verstretch>
|
||||
</sizepolicy>
|
||||
</property>
|
||||
<property name="minimumSize" >
|
||||
<size>
|
||||
<width>469</width>
|
||||
<height>301</height>
|
||||
</size>
|
||||
</property>
|
||||
<property name="maximumSize" >
|
||||
<size>
|
||||
<width>496</width>
|
||||
<height>301</height>
|
||||
</size>
|
||||
</property>
|
||||
<property name="windowTitle" >
|
||||
<string>Form</string>
|
||||
</property>
|
||||
<widget class="QPushButton" name="pushButton_2" >
|
||||
<property name="geometry" >
|
||||
<rect>
|
||||
<x>130</x>
|
||||
<y>210</y>
|
||||
<width>191</width>
|
||||
<height>41</height>
|
||||
</rect>
|
||||
</property>
|
||||
<property name="text" >
|
||||
<string>Exit</string>
|
||||
</property>
|
||||
</widget>
|
||||
<widget class="QPushButton" name="pushButton" >
|
||||
<property name="geometry" >
|
||||
<rect>
|
||||
<x>100</x>
|
||||
<y>50</y>
|
||||
<width>261</width>
|
||||
<height>71</height>
|
||||
</rect>
|
||||
</property>
|
||||
<property name="text" >
|
||||
<string>Oink!</string>
|
||||
</property>
|
||||
</widget>
|
||||
<widget class="QCheckBox" name="checkBox" >
|
||||
<property name="geometry" >
|
||||
<rect>
|
||||
<x>180</x>
|
||||
<y>160</y>
|
||||
<width>111</width>
|
||||
<height>24</height>
|
||||
</rect>
|
||||
</property>
|
||||
<property name="text" >
|
||||
<string>Good?</string>
|
||||
</property>
|
||||
</widget>
|
||||
<widget class="QLabel" name="label" >
|
||||
<property name="geometry" >
|
||||
<rect>
|
||||
<x>370</x>
|
||||
<y>200</y>
|
||||
<width>81</width>
|
||||
<height>81</height>
|
||||
</rect>
|
||||
</property>
|
||||
<property name="text" >
|
||||
<string/>
|
||||
</property>
|
||||
</widget>
|
||||
</widget>
|
||||
<resources/>
|
||||
<connections/>
|
||||
</ui>
|
||||
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,0 +1,90 @@
|
|||
<ui version="4.0" >
|
||||
<class>Form</class>
|
||||
<widget class="QWidget" name="Form" >
|
||||
<property name="geometry" >
|
||||
<rect>
|
||||
<x>0</x>
|
||||
<y>0</y>
|
||||
<width>469</width>
|
||||
<height>301</height>
|
||||
</rect>
|
||||
</property>
|
||||
<property name="sizePolicy" >
|
||||
<sizepolicy>
|
||||
<hsizetype>0</hsizetype>
|
||||
<vsizetype>0</vsizetype>
|
||||
<horstretch>0</horstretch>
|
||||
<verstretch>0</verstretch>
|
||||
</sizepolicy>
|
||||
</property>
|
||||
<property name="minimumSize" >
|
||||
<size>
|
||||
<width>469</width>
|
||||
<height>301</height>
|
||||
</size>
|
||||
</property>
|
||||
<property name="maximumSize" >
|
||||
<size>
|
||||
<width>496</width>
|
||||
<height>301</height>
|
||||
</size>
|
||||
</property>
|
||||
<property name="windowTitle" >
|
||||
<string>Form</string>
|
||||
</property>
|
||||
<widget class="QPushButton" name="pushButton_2" >
|
||||
<property name="geometry" >
|
||||
<rect>
|
||||
<x>130</x>
|
||||
<y>210</y>
|
||||
<width>191</width>
|
||||
<height>41</height>
|
||||
</rect>
|
||||
</property>
|
||||
<property name="text" >
|
||||
<string>Exit</string>
|
||||
</property>
|
||||
</widget>
|
||||
<widget class="QPushButton" name="pushButton" >
|
||||
<property name="geometry" >
|
||||
<rect>
|
||||
<x>100</x>
|
||||
<y>50</y>
|
||||
<width>261</width>
|
||||
<height>71</height>
|
||||
</rect>
|
||||
</property>
|
||||
<property name="text" >
|
||||
<string>Oink!</string>
|
||||
</property>
|
||||
</widget>
|
||||
<widget class="QCheckBox" name="checkBox" >
|
||||
<property name="geometry" >
|
||||
<rect>
|
||||
<x>180</x>
|
||||
<y>160</y>
|
||||
<width>111</width>
|
||||
<height>24</height>
|
||||
</rect>
|
||||
</property>
|
||||
<property name="text" >
|
||||
<string>Good?</string>
|
||||
</property>
|
||||
</widget>
|
||||
<widget class="QLabel" name="label" >
|
||||
<property name="geometry" >
|
||||
<rect>
|
||||
<x>370</x>
|
||||
<y>200</y>
|
||||
<width>81</width>
|
||||
<height>81</height>
|
||||
</rect>
|
||||
</property>
|
||||
<property name="text" >
|
||||
<string/>
|
||||
</property>
|
||||
</widget>
|
||||
</widget>
|
||||
<resources/>
|
||||
<connections/>
|
||||
</ui>
|
||||
|
|
@ -0,0 +1,485 @@
|
|||
/* main.cpp */
|
||||
|
||||
|
||||
#include <QtGui>
|
||||
#include <QtUiTools>
|
||||
#include <QGLWidget>
|
||||
#include <QtMultimedia/QSound>
|
||||
#include <chicken.h>
|
||||
#include <assert.h>
|
||||
|
||||
|
||||
#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 bool(QObject::connect(w1, sig, w2, slot)); }
|
||||
QWidget *qt_find(QWidget *parent, char *name) { return parent->findChild<QWidget *>(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.toLatin1().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.toLatin1(); 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<QPixmap>());
|
||||
}
|
||||
|
||||
|
||||
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,0 +1,62 @@
|
|||
/* 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,0 +1,13 @@
|
|||
((synopsis "A lightweight Qt 5 interface")
|
||||
(category ui)
|
||||
(license "BSD")
|
||||
(dependencies bind protobj matchable miscmacros shell)
|
||||
(author "felix winkelmann")
|
||||
(components
|
||||
(program chicken-compile-qt-extension)
|
||||
(extension
|
||||
qt-light
|
||||
(custom-build "chicken-compile-qt-extension.scm")
|
||||
(csc-options ;
|
||||
"-O3" "-d1" "-X" "bind" "-s" "-k" "-emit-link-file" "qt-light.link" "-o" "qt-light.o")
|
||||
)))
|
||||
|
|
@ -0,0 +1,221 @@
|
|||
;;;; 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> qt:classname
|
||||
<qt-object> <qt-widget> <qt-pixmap> <qt-application>
|
||||
<qt-receiver> <qt-timer> <qt-sound> <qt-text-edit>
|
||||
<qt-action>
|
||||
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 base)
|
||||
(chicken bitwise)
|
||||
(chicken foreign)
|
||||
(chicken format)
|
||||
(chicken fixnum)
|
||||
(chicken string)
|
||||
bind
|
||||
miscmacros
|
||||
srfi-4 srfi-1 protobj matchable
|
||||
)
|
||||
|
||||
|
||||
(define <qt>
|
||||
(% (current-root-object)
|
||||
(class '<qt>)
|
||||
(pointer #f)
|
||||
(print (lambda (self #!optional (port (current-output-port)))
|
||||
(fprintf port "#<~a>" (? self class))))))
|
||||
|
||||
(define <qt-object> (% <qt> (class 'qt-object)))
|
||||
(define <qt-sound> (% <qt-object> (class 'qt-sound)))
|
||||
(define <qt-widget> (% <qt-object> (class 'qt-widget)))
|
||||
(define <qt-application> (% <qt-object> (class 'qt-application)))
|
||||
(define <qt-pixmap> (% <qt> (class 'qt-pixmap)))
|
||||
(define <qt-receiver> (% <qt-object> (class 'qt-receiver)))
|
||||
(define <qt-timer> (% <qt-object> (class 'qt-timer)))
|
||||
(define <qt-text-edit> (% <qt-widget> (class 'qt-text-edit)))
|
||||
(define <qt-action> (% <qt-object> (class 'qt-action)))
|
||||
|
||||
(define (qt:->pointer i) (and i (? i pointer)))
|
||||
(define (qt:pointer->widget p) (and p (% <qt-widget> (pointer p))))
|
||||
(define (qt:pointer->object p) (and p (% <qt-object> (pointer p))))
|
||||
(define (qt:pointer->timer p) (and p (% <qt-timer> (pointer p))))
|
||||
(define (qt:pointer->application p) (and p (% <qt-application> (pointer p))))
|
||||
(define (qt:pointer->pixmap p) (and p (% <qt-pixmap> (pointer p))))
|
||||
(define (qt:pointer->receiver p) (and p (% <qt-receiver> (pointer p))))
|
||||
(define (qt:pointer->sound p) (and p (% <qt-sound> (pointer p))))
|
||||
(define (qt:pointer->text-edit p) (and p (% <qt-text-edit> (pointer p))))
|
||||
(define (qt:pointer->action p) (and p (% <qt-action> (pointer p))))
|
||||
|
||||
|
||||
(bind-rename/pattern "qt_" "qt:")
|
||||
(bind-type qtwidget c-pointer qt:->pointer qt:pointer->widget)
|
||||
(bind-type qtapplication c-pointer qt:->pointer qt:pointer->application)
|
||||
(bind-type qtpixmap c-pointer qt:->pointer qt:pointer->pixmap)
|
||||
(bind-type qtobject c-pointer qt:->pointer qt:pointer->object)
|
||||
(bind-type qttimer c-pointer qt:->pointer qt:pointer->timer)
|
||||
(bind-type qtreceiver c-pointer qt:->pointer qt:pointer->receiver)
|
||||
(bind-type qtsound c-pointer qt:->pointer qt:pointer->sound)
|
||||
(bind-type qttextedit c-pointer qt:->pointer qt:pointer->text-edit)
|
||||
(bind-type qtaction c-pointer qt:->pointer qt:pointer->action)
|
||||
|
||||
#>
|
||||
#define ___safe
|
||||
#define ___bool int
|
||||
#define ___out
|
||||
<#
|
||||
|
||||
#>
|
||||
extern "C" {
|
||||
#include "prototypes.h"
|
||||
}
|
||||
<#
|
||||
|
||||
(bind-file* "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) ) ) )
|
||||
|
||||
(! <qt-object> 'delete
|
||||
(lambda (self) (qt:deleteobject self)))
|
||||
|
||||
(! <qt-pixmap> '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 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)) )
|
||||
|
||||
(! <qt-timer> stop
|
||||
(lambda (self) (qt:stoptimer self)))
|
||||
|
||||
(! <qt-sound> stop
|
||||
(lambda (self) (qt:stopsound self)))
|
||||
|
||||
(define (qt:stop x) (@ x stop))
|
||||
|
||||
(define qt:add-action qt:addaction)
|
||||
(define qt:remove-action qt:removeaction)
|
||||
|
||||
)
|
||||
Ŝarĝante…
Reference in New Issue