← Back to branch summary

~ubuntu-branches/ubuntu/quantal/gclcvs/quantal

« back to all changes in this revision

Viewing changes to gcl-tk/demos/mkHScale.lisp

  • Committer: Bazaar Package Importer
  • Author(s): Camm Maguire
  • Date: 2004-06-24 15:13:46 UTC
  • Revision ID: james.westby@ubuntu.com-20040624151346-xh0xaaktyyp7aorc
Tags: 2.7.0-26
C_GC_OFFSET is 2 on m68k-linux

Show diffs side-by-side

added added

removed removed

Lines of Context:
gcl-tk/demos/mkHScale.lisp
 
1
;;# mkHScale w
 
2
;;
 
3
;; Create a top-level window that displays a horizontal scale.
 
4
;;
 
5
;; Arguments:
 
6
;;    w -       Name to use for new top-level window.
 
7
 
 
8
(in-package "TK")
 
9
 
 
10
(defun mkHScale (&optional (w '.scale2)) 
 
11
    (if (winfo :exists w :return 'boolean) (destroy w))
 
12
    (toplevel w)
 
13
    (dpos w)
 
14
    (wm :title w "Horizontal Scale Demonstration")
 
15
    (wm :iconname w "Scale")
 
16
    (message (conc w '.msg) :font :Adobe-times-medium-r-normal--*-180* :aspect 300 
 
17
            :text "A bar and a horizontal scale are displayed below.  (if :you click or drag mouse button 1 in the scale, you can change the width of the bar.  Click the \"OK\" button when you're finished.")
 
18
    (frame (conc w '.frame) :borderwidth 10)
 
19
    (button (conc w '.ok) :text "OK" :command (tk-conc "destroy " w))
 
20
    (pack (conc w '.msg) (conc w '.frame) (conc w '.ok) :side "top" :fill "x")
 
21
 
 
22
    (frame (conc w '.frame.top) :borderwidth 15)
 
23
    (scale (conc w '.frame.scale) :orient "horizontal" :length 280 :from 0 :to 250 
 
24
            :command (tk-conc "setWidth " w ".frame.top.inner") :tickinterval 50 
 
25
            :bg "Bisque1")
 
26
    (frame (conc w '.frame.top.inner) :width 20 :height 40 :relief "raised" :borderwidth 2 
 
27
            :bg "SteelBlue1")
 
28
    (pack (conc w '.frame.top) :side "top" :expand "yes" :anchor "sw")
 
29
    (pack (conc w '.frame.scale) :side "bottom" :expand "yes" :anchor "nw")
 
30
 
 
31
 
 
32
    (pack (conc w '.frame.top.inner) :expand "yes" :anchor "sw")
 
33
    (funcall (conc w '.frame.scale) :set 20)
 
34
)
 
35
 
 
36
(defun setWidth (w width) 
 
37
    (funcall w :config  :width ${width} :height 40)
 
38
)