[graphic-forms-cvs] r459 - in branches/graphic-forms-newtypes: . src/uitoolkit/system src/uitoolkit/widgets

junrue at common-lisp.net junrue at common-lisp.net
Tue Apr 3 04:45:20 UTC 2007


Author: junrue
Date: Tue Apr  3 00:45:18 2007
New Revision: 459

Added:
   branches/graphic-forms-newtypes/src/uitoolkit/widgets/progressbar.lisp
Modified:
   branches/graphic-forms-newtypes/NEWS.txt
   branches/graphic-forms-newtypes/graphic-forms-uitoolkit.asd
   branches/graphic-forms-newtypes/src/uitoolkit/system/system-constants.lisp
   branches/graphic-forms-newtypes/src/uitoolkit/system/system-types.lisp
   branches/graphic-forms-newtypes/src/uitoolkit/widgets/top-level.lisp
   branches/graphic-forms-newtypes/src/uitoolkit/widgets/widget-classes.lisp
Log:
initial steps toward progress-bar implementation; fixed typo in top-level override for pack method

Modified: branches/graphic-forms-newtypes/NEWS.txt
==============================================================================
--- branches/graphic-forms-newtypes/NEWS.txt	(original)
+++ branches/graphic-forms-newtypes/NEWS.txt	Tue Apr  3 00:45:18 2007
@@ -1,7 +1,10 @@
 
 . Latest CFFI is required to take advantage of built-in support for the
-  stdcall calling convention (FIXME: change checked in this past Feb., need
-  to narrow down which snapshot actually has it).
+  stdcall calling convention.
+
+. Ported the library to Allegro CL 8.0.
+
+. Upgraded to LispWorks 5.0.1 (note: 4.4.6 is no longer supported)
 
 . Implemented simple-mode status bars, which have a single text field.
   Multi-part status bars, and nested widget support, will be added in a
@@ -14,10 +17,6 @@
 . Greatly expanded the symbols for accessing predefined colors, and now
   provide access to system color settings in a similar manner.
 
-. Ported the library to Allegro CL 8.0.
-
-. Upgraded to LispWorks 5.0.1 (note: 4.4.6 is no longer supported)
-
 . Implemented a new graphics context function GFG:CLEAR that is a convenient
   way to fill a window or image with a background color.
 

Modified: branches/graphic-forms-newtypes/graphic-forms-uitoolkit.asd
==============================================================================
--- branches/graphic-forms-newtypes/graphic-forms-uitoolkit.asd	(original)
+++ branches/graphic-forms-newtypes/graphic-forms-uitoolkit.asd	Tue Apr  3 00:45:18 2007
@@ -143,6 +143,7 @@
                        (:file "menu")
                        (:file "menu-item")
                        (:file "menu-language")
+                       (:file "progressbar")
                        (:file "event")
                        (:file "scrolling-helper")
                        (:file "scrollbar")

Modified: branches/graphic-forms-newtypes/src/uitoolkit/system/system-constants.lisp
==============================================================================
--- branches/graphic-forms-newtypes/src/uitoolkit/system/system-constants.lisp	(original)
+++ branches/graphic-forms-newtypes/src/uitoolkit/system/system-constants.lisp	Tue Apr  3 00:45:18 2007
@@ -848,6 +848,34 @@
 (defconstant +out-screen-outline-precis+        9)
 (defconstant +out-ps-only-precis+              10)
 
+;;;
+;;; progress bar messages and style bits
+;;;
+
+(defconstant +pbm-setrange+                #x0401) ; (WM_USER+1)
+(defconstant +pbm-setpos+                  #x0402) ; (WM_USER+2)
+(defconstant +pbm-deltapos+                #x0403) ; (WM_USER+3)
+(defconstant +pbm-setstep+                 #x0404) ; (WM_USER+4)
+(defconstant +pbm-stepit+                  #x0405) ; (WM_USER+5)
+(defconstant +pbm-setrange32+              #x0406) ; (WM_USER+6)
+(defconstant +pbm-getrange+                #x0407) ; (WM_USER+7)
+(defconstant +pbm-getpos+                  #x0408) ; (WM_USER+8)
+(defconstant +pbm-setbarcolor+             #x0409) ; (WM_USER+9)
+(defconstant +pbm-setbkcolor+              #x2001) ; CCM_SETBKCOLOR
+(defconstant +pbm-setmarquee+              #x040a) ; (WM_USER+10)
+(defconstant +pbm-getstep+                 #x040d) ; (WM_USER+13)
+(defconstant +pbm-getbkcolor+              #x040e) ; (WM_USER+14)
+(defconstant +pbm-getbarcolor+             #x040f) ; (WM_USER+15)
+(defconstant +pbm-setstate+                #x0410) ; (WM_USER+16)
+(defconstant +pbm-getstate+                #x0411) ; (WM_USER+17)
+
+(defconstant +pbs-marquee+                   #x08)
+(defconstant +pbs-smoothreverse+             #x10)
+
+(defconstant +pbst-normal+                 #x0001)
+(defconstant +pbst-error+                  #x0002)
+(defconstant +pbst-paused+                 #x0003)
+
 (defconstant +pderr-printercodes+          #x1000)
 (defconstant +pderr-setupfailure+          #x1001)
 (defconstant +pderr-parsefailure+          #x1002)

Modified: branches/graphic-forms-newtypes/src/uitoolkit/system/system-types.lisp
==============================================================================
--- branches/graphic-forms-newtypes/src/uitoolkit/system/system-types.lisp	(original)
+++ branches/graphic-forms-newtypes/src/uitoolkit/system/system-types.lisp	Tue Apr  3 00:45:18 2007
@@ -320,6 +320,10 @@
   (incupdate      BOOL)
   (reserved       :unsigned-char :count 32))
 
+(defcstruct pbrange
+  (low            INT)
+  (high           INT))
+
 (define-foreign-type rect-pointer-type () ()
   (:actual-type :pointer)
   (:simple-parser rect-pointer))

Added: branches/graphic-forms-newtypes/src/uitoolkit/widgets/progressbar.lisp
==============================================================================
--- (empty file)
+++ branches/graphic-forms-newtypes/src/uitoolkit/widgets/progressbar.lisp	Tue Apr  3 00:45:18 2007
@@ -0,0 +1,84 @@
+;;;;
+;;;; progressbar.lisp
+;;;;
+;;;; Copyright (C) 2007, Jack D. Unrue
+;;;; All rights reserved.
+;;;;
+;;;; Redistribution and use in source and binary forms, with or without
+;;;; modification, are permitted provided that the following conditions
+;;;; are met:
+;;;; 
+;;;;     1. Redistributions of source code must retain the above copyright
+;;;;        notice, this list of conditions and the following disclaimer.
+;;;; 
+;;;;     2. Redistributions in binary form must reproduce the above copyright
+;;;;        notice, this list of conditions and the following disclaimer in the
+;;;;        documentation and/or other materials provided with the distribution.
+;;;; 
+;;;;     3. Neither the names of the authors nor the names of its contributors
+;;;;        may be used to endorse or promote products derived from this software
+;;;;        without specific prior written permission.
+;;;; 
+;;;; THIS SOFTWARE IS PROVIDED BY THE AUTHORS AND CONTRIBUTORS "AS IS" AND ANY
+;;;; EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+;;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DIS-
+;;;; CLAIMED.  IN NO EVENT SHALL THE AUTHORS AND CONTRIBUTORS BE LIABLE FOR ANY
+;;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
+;;;; (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
+;;;; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
+;;;; ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+;;;; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+;;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+;;;;
+
+(in-package :graphic-forms.uitoolkit.widgets)
+
+;;;
+;;; helper functions
+;;;
+
+(declaim (inline pb-get-pos))
+(defun pb-get-pos (p-bar)
+  "Returns the current position of a progress bar."
+  (gfs::send-message (gfs:handle p-bar) gfs::+pbm-getpos+ 0 0))
+
+(defun pb-get-range (p-bar)
+  "Returns the range of a progress bar."
+  (cffi:with-foreign-object (r-ptr 'gfs::pbrange)
+    (gfs::send-message (gfs:handle p-bar) gfs::+pbm-getrange+ 0 (cffi:pointer-address r-ptr))
+    (cffi:with-foreign-slots ((gfs::low gfs::high) r-ptr gfs::pbrange)
+      (gfs:make-span :start gfs::low :end gfs::high))))
+
+(declaim (inline pb-get-step))
+(defun pb-get-step (p-bar)
+  "Returns the step increment for a progress bar."
+  (gfs::send-message (gfs:handle p-bar) gfs::+pbm-getstep+ 0 0))
+  
+(declaim (inline pb-set-pos-absolute))
+(defun pb-set-pos-absolute (p-bar pos)
+  "Sets the absolute position of a progress bar and redraws it; returns the previous position."
+  (gfs::send-message (gfs:handle p-bar) gfs::+pbm-setpos+ (logand pos #xFFFF) 0))
+
+(declaim (inline pb-set-pos-delta))
+(defun pb-set-pos-delta (p-bar delta)
+  "Updates the position of a progress bar by delta and redraws it; returns the previous position."
+  (gfs::send-message (gfs:handle p-bar) gfs::+pbm-deltapos+ (logand delta #xFFFF) 0))
+
+(defun pb-set-range (p-bar span)
+  "Sets the range of a progress bar; returns the previous range."
+  (let ((result (gfs::send-message (gfs:handle p-bar)
+                                   gfs::+pbm-setrange32+
+                                   (logand (gfs:span-start span) #xFFFFFFFF)
+                                   (logand (gfs:span-end span) #xFFFFFFFF))))
+    (gfs:make-span :start (gfs::lparam-low-word result)
+                   :end (gfs::lparam-high-word result))))
+
+(declaim (inline pb-set-step))
+(defun pb-set-step (p-bar increment)
+  "Sets the step increment for a progress bar; returns the previous increment."
+  (gfs::send-message (gfs:handle p-bar) gfs::+pbm-setstep+ (logand increment #xFFFF) 0))
+
+(declaim (inline pb-stepit))
+(defun pb-stepit (p-bar)
+  "Advances the progress bar's position by its step increment and redraws it; returns the previous position."
+  (gfs::send-message (gfs:handle p-bar) gfs::+pbm-stepit+ 0 0))

Modified: branches/graphic-forms-newtypes/src/uitoolkit/widgets/top-level.lisp
==============================================================================
--- branches/graphic-forms-newtypes/src/uitoolkit/widgets/top-level.lisp	(original)
+++ branches/graphic-forms-newtypes/src/uitoolkit/widgets/top-level.lisp	Tue Apr  3 00:45:18 2007
@@ -195,7 +195,7 @@
   (when (and (maximum-size self) min-size)
     (update-top-level-resizability self (gfs:equal-size-p min-size (maximum-size self)))))
 
-(defmethod pack ((win window))
+(defmethod pack ((win top-level))
   (if (find :fixed-size (style-of win))
     (let ((size (gfw:preferred-size win -1 -1)))
       (setf (gfw:minimum-size win) size

Modified: branches/graphic-forms-newtypes/src/uitoolkit/widgets/widget-classes.lisp
==============================================================================
--- branches/graphic-forms-newtypes/src/uitoolkit/widgets/widget-classes.lisp	(original)
+++ branches/graphic-forms-newtypes/src/uitoolkit/widgets/widget-classes.lisp	Tue Apr  3 00:45:18 2007
@@ -218,6 +218,12 @@
   (item-manager))
 
 (define-control-class
+  progressbar
+  "msctls_progress"
+  'event-select
+  "This class represents controls that provide visual feedback for progress.")
+
+(define-control-class
   scrollbar
   "scrollbar"
   'event-scroll



More information about the Graphic-forms-cvs mailing list