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