Changeset 17972 in project


Ignore:
Timestamp:
04/30/10 14:55:18 (9 years ago)
Author:
felix winkelmann
Message:

bb for release 4

Location:
release/4/bb/trunk
Files:
1 added
7 moved

Legend:

Unmodified
Added
Removed
  • release/4/bb/trunk/bb.meta

    r17971 r17972  
    1 ;;; bb.meta -*- Hen -*-
     1;;; bb.meta -*- Scheme -*-
    22
    3 ((egg "bb.egg")
    4  (synopsis "An easy-to-use GUI toolkit based on FLTK")
     3((synopsis "An easy-to-use GUI toolkit based on FLTK")
    54 (license "BSD")
    65 (category ui)
    7  (needs silex easyffi)
     6 (needs silex easyffi matchable)
    87 (doc-from-wiki)
    9  (author
    10    "<a href=\"mailto:felix@call-with-current-continuation.org\">felix</a>")
    11  (files "bb.setup" "bb-support.cpp" "bb.h" "bb.scm" "Table.h" "Table.cxx" "bb.html"))
     8 (author "felix winkelmann")
     9 (files "bb.setup" "bb-support.cpp" "bb.h" "bb.scm" "Table.h" "Table.cxx"))
  • release/4/bb/trunk/bb.scm

    r17971 r17972  
    3434
    3535
    36 (use easyffi)
     36(module bb (bb:make-widget
     37            bb:make-widgets bb:property bb:widget? bb:message bb:add! bb:remove!
     38            bb:get-input bb:init bb:set-menu-item-active!
     39            bb:group bb:run bb:redraw bb:show bb:select-file bb:select-directory
     40            bb:rgb bb:image bb:select-color
     41            bb:event bb:image-data
     42            bb:root-element bb:find-element bb:find-widget bb:element-content
     43            bb:render bb:element? bb:element-widget bb:element-children bb:element-parent bb:element-id
     44            bb:element-tag bb:element-attributes)
     45
     46(import scheme chicken foreign)
     47
     48(use extras srfi-1 utils srfi-4 easyffi data-structures matchable)
    3749
    3850(foreign-parse/declare #<<EOF
     
    5668)
    5769
    58 (declare
    59  (uses extras srfi-1 utils srfi-4)
    60  (export bb:make-widget bb:make-widgets bb:property bb:widget? bb:message bb:add! bb:remove!
    61          bb:get-input bb:init bb:set-menu-item-active!
    62          bb:group bb:run bb:redraw bb:show bb:select-file bb:select-directory
    63          bb:rgb bb:image bb:select-color
    64          bb:event bb:image-data) )
    65 
    6670(define-record widget type ptr name resources parent children)
    6771
     
    7579    (lambda scheme
    7680      (unless initd
    77         (set! initd (bb:Start (:optional scheme #f))) )
     81        (set! initd (bb:Start (optional scheme #f))) )
    7882      initd) ) )
    7983
     
    478482
    479483(define (bb:make-widgets str fw fh . cmap)
    480   (let ([cmap (:optional cmap '())])
     484  (let ([cmap (optional cmap '())])
    481485    (let-values ([(frames w h) (find-frames str)])
    482486      (let ([wf (/ fw w)]
     
    512516                      (bb:SetCallback widget (read (open-input-string str))) ]
    513517                     [(#\' . str)
    514                       (for-each bb:AddItem widget (string-split str ",")) ]
     518                      (for-each (cut bb:AddItem widget <> 0) (string-split str ",")) ]
    515519                     [(#\# . str)
    516520                      (bb:SetImage widget -1 (bb:image (string->symbol str)))
     
    732736
    733737(define (bb:get-input label . def)
    734   (bb:GetInput label (:optional def #f)) )
     738  (bb:GetInput label (optional def #f)) )
    735739
    736740(define bb:AddMenuItem
     
    740744                       [(pair? cb) (eval `(lambda () ,cb))]
    741745                       [else cb] ) ]
    742              [u (bb:AddMenuItem menu text (:optional sc #f) (location BBGenericCallback))] )
     746             [u (bb:AddMenuItem menu text (optional sc #f) (location BBGenericCallback))] )
    743747        (set! callback-table (alist-cons u cb callback-table)) ) ) ) )
    744748
     
    775779         (bb:AddItem
    776780          w text
    777           (let ((m (:optional more -1)))
     781          (let ((m (optional more -1)))
    778782            (case m
    779783              ((#t) 1)
     
    842846
    843847(define (bb:select-file m p . f)
    844   (bb:SelectFile m p (:optional f #f)) )
     848  (bb:SelectFile m p (optional f #f)) )
    845849
    846850(define (bb:select-directory m . f)
    847   (bb:SelectDir m (:optional f #f)) )
     851  (bb:SelectDir m (optional f #f)) )
    848852
    849853(define bb:rgb
     
    912916;;; SXML stuff:
    913917
    914 (declare
    915  (export bb:root-element bb:find-element bb:find-widget bb:element-content
    916          bb:render bb:element? bb:element-widget bb:element-children bb:element-parent bb:element-id
    917          bb:element-tag bb:element-attributes) )
    918 
    919918(define-record element
    920919  tag                                   ; symbol
     
    940939
    941940(define (bb:find-element id . root)
    942   (let loop ([root (:optional root (bb:root-element))])
     941  (let loop ([root (optional root (bb:root-element))])
    943942    (if (eq? id (element-id root))
    944943        root
     
    10661065          [(char=? #\% (string-ref x (sub1 (string-length x))))
    10671066           (inexact->exact (round (* (string->number (substring x 0 (sub1 (string-length x)))) n 0.01))) ]
    1068           [else (error "invalid dimensional property" elt x)] ) )
     1067          [else (error "invalid dimensional property" elt0 x)] ) )
    10691068  (let loop ([elt elt0] [w #f] [h #f])
    10701069    (let* ([tag (element-tag elt)]
     
    11051104     (old) ) ) )
    11061105
     1106)
  • release/4/bb/trunk/bb.setup

    r17971 r17972  
    55
    66(case (build-platform)
    7   [(msvc)
    8    (let ([fltk (or (getenv "FLTK")
    9                    (missing) )]
    10          [flu (getenv "FLU")])
    11      (make/proc
    12        (list (list "bb-support.obj" '("bb-support.cpp" "bb.h")
    13                    (lambda ()
    14                      (run (cl -O2 -c
    15                               ,(if flu (string-append "-DBB_USE_FLU -I" flu) "")
    16                               ,(string-append " -I" fltk " -I" fltk "/FL") bb-support.cpp))
    17                      (run (cl -O2 -c
    18                               ,(string-append " -I" fltk) Table.cxx))
    19                      ) ) )
    20        "bb-support.obj")
    21 
    22      (run (csc bb.scm -s -O2 -d0 -W
    23                -L "\"bb-support.obj Table.obj fltk.lib\""
    24                -L "\"fltkimages.lib fltkgl.lib fltkjpeg.lib fltkpng.lib fltkz.lib\""
    25                -L "\"user32.lib opengl32.lib gdi32.lib ole32.lib comctl32.lib\""
    26                -L "\"wsock32.lib shell32.lib advapi32.lib\""
    27                -L ,(string-append "\"/libpath:" fltk "/lib\"")
    28                ,(if flu (string-append "-L \"" flu "/lib/flulib.lib\"") "") ) ) )]
    297  [(mingw32)
    30    (let ([fltk (or (getenv "FLTK")
    31                    (missing))]
    32          [flu (getenv "FLU")])
     8   (let ((flu (getenv "FLU")))
    339     (make/proc
    3410       (list (list "bb-support.o" '("bb-support.cpp" "bb.h")
    3511                   (lambda ()
    3612                     (run (g++ -Os -fomit-frame-pointer -c
     13                               -DWIN32 -mwindows -mno-cygwin
    3714                              ,(if flu (string-append "-DBB_USE_FLU -I" flu) "")
    38                               ,(string-append " -I" fltk) bb-support.cpp))
     15                              bb-support.cpp))
    3916                     (run (g++ -Os -fomit-frame-pointer -c
    40                               ,(string-append " -I" fltk) Table.cxx)) ) ) )
     17                               -DWIN32 -mwindows -mno-cygwin
     18                               Table.cxx)) ) ) )
    4119       "bb-support.o")
    4220
    43      (run (csc bb.scm -s -O2 -d0 -W
     21     (run (csc bb.scm -s -O3 -d1 -J
    4422               -L "\"bb-support.o Table.o -lfltk\""
    4523               -L "\"-lfltk_images -lfltk_gl -lfltk_jpeg -lfltk_png -lfltk_z\""
    4624               -L "\"-luser32 -lopengl32 -lgdi32 -lole32 -luuid -lcomctl32\""
    4725               -L "\"-lwsock32 -lshell32 -ladvapi32\""
    48                -L ,(string-append "\"-L" fltk "/lib\"")
     26               -lfltk -lole32 -luuid -lcomctl32 -lwsock32
    4927               ,(if flu (string-append "-L \"-L" flu "/lib -lflu\"") "")
    5028               -ld g++) ) )]
     
    6341        "bb-support.o")
    6442
    65       (run (csc bb.scm -c -O2 -d0 -unit bb -o bb-static.o))
    66       (run (ar cru bb-static.a bb-static.o bb-support.o Table.o))
    67       (run (csc bb.scm -s -O2 -d0
     43      (run (csc bb.scm -s -O3 -J -d1
    6844                -L "\"bb-support.o Table.o `fltk-config --use-images --use-gl --ldflags --libs`\""
    6945                ,(if has-flu? "-L \"`flu-config --ldflags`\" -L \"`flu-config --libs`\" " "")
    7046                -ld g++) ) ) ] )
    7147
     48(compile -s -O3 -d0 bb.import.scm)
     49
    7250(install-extension
    7351 'bb
    74  '("bb-static.a" "bb.so" "bb.html")
    75  `((version 1.26)
    76    ,@(cond-expand
    77       (msvc '())
    78       (else '((static "bb-static.a")
    79               (static-options "`fltk-config --use-images --use-gl --ldstaticflags`") ) ) )
    80    (documentation "bb.html")))
     52 '("bb.so" "bb.import.so")
     53 `((version 1.27)))
    8154
    8255;;; vim: ft=scheme
Note: See TracChangeset for help on using the changeset viewer.